PNÿÛDSD ROOT SET -SOURCE- 2040 15 JAN 81 22-2362 ÙMP ÿý ÿ92064-18177 1650 S C0122 &PURGF RTE-M FLPY PURGE SUB             H0101 °YþúASMB,L,R,C * NAME: PURGE * SOURCE: 92064-18177 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM PURGE,7 92064-16058 REV.1650 760819Q * HED PURGE ENT PURGE EXT OPEN,EXEC EXT .ENTR,CLOSE * * SUP * * PURGE IS THE FILE DELETION ROUTINE FOR THE RTE * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL PURGE(IDCB,IERR,NAME,IS,ILU) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK * WHICH IS USED BY PURGE AS A * WORKING BUFFER. IDCB IS FREE * FOR OTHER USE AFTER A PURGE. * * IERR IS THE ERROR RETURN LOCATION. * * NAME IS THE NAME OF THE FILE TO BE PURGED. * * IS IS THE FILE'S SECURITY CODE. * * ILU IS THE DISC THAT THE FILE IS ON. * IF ILU >0 THEN ON DISC LABELED ILU * IF ILU <0 THEN ON DISC AT LOGICAL UNIT (-ILU) * * ERRORS RETURNED BY PURGE ARE: * * CODE REASON * 0 NO ERRORS * -1 DISC READ/WRITE ERROR * -6 FILE (OR DISC) NOT FOUND * -7 ILLEGAL SECURITY CODE * -8 FILE IS OPEN TO SOME OTHER PROGRAM * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * -16 ATTEMPT TO PURGE A TYPE 0 FILE * * SKP PURGE NOP LDA DZERO STA NAME STA SC STA LU LDA PURGE STA DURGE JMP DURGE+1 * * DCB NOP IERR NOP aHþúNAME DEF ZERO SC DEF ZERO LU DEF ZERO SPC 1 DURGE NOP ENTRY POINT JSB .ENTR DO ENTRY ROUTINE DEF DCB LDA N10 NOT ENOUGH PRAM LDB NAME ERROR CPB DZERO ? JMP EXIT YES-EXIT CLA CLEAR THE TRUNCATE WORD STA LNG AND SPC 1 JSB OPEN NO; GO DEF OPRTN OPEN DEF DCB,I EXCLUSIVELY DEF IERR,I TO DEF NAME,I CALLER DZERO DEF ZERO DEF SC,I PASS THE SECURITY CODE DEF LU,I AND THE DISC ID OPRTN SSA OPEN ERROR? JMP EXIT YES; EXIT SZA,RSS NO; TYPE ZERO JMP EX16 YES - ILLEGAL PURGE SPC 1 LDA DCB GET ADDRESS ADA .7 OF LDB A,I SECURITY SSB,RSS IF MISMATCH JMP EX7 GO SET ERROR EXIT SPC 1 ADA N2 ADDRESS OF FILE LENGTH LDA A,I GET FILE LENGTH ARS SET TO BLOCK LENGTH STA LNG SET FOR TRUNCATE CODE SPC 1 CLOS JSB CLOSE CLOSE THE FILE AND TRUNCATE TO ZERO DEF *+4 (I.E. PURGE IT) DEF DCB,I FILE DEF LU DUMMY ERROR RETURN DEF LNG TRUNCATE WORD ADDRESS LDB IERR,I GET CURRENT ERROR CODE SSB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET THE ERROR CODE JMP DURGE,I AND EXIT SPC 2 EX7 LDA .7 SET ERROR CMA,INA,RSS CODE AND SKIP EX16 LDA N16 STA IERR,I SET CODE IN USER AREA JMP CLOS GO CLOSE THE FILE SPC 3 N2 DEC -2 N10 DEC -10 .7 DEC 7 N16 DEC -16 LNG NOP ZERO NOP D.RTR ASC 3,D.RTR SPC 2 XEQT EQU 1717B A EQU 0 B EQU 1 SPC 2 END EQU * END /¿ ÿÿ ÿý ÿ92064-18178 1650 S C0122 &OPENF RTE-M FLPY OPEN SUB             H0101 ÔøþúASMB,R,L,C * NAME: OPEN * SOURCE: 92064-18178 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM OPEN,7 92064-16058 REV.1650 761116 * HED OPEN * ENT OPEN EXT EXEC,CLOSE,RMPAR,$OPEN,$LIBR,$LIBX EXT .DRCT,$CON * * EXT .ENTR,.P1,.P2,.P3,.P4,.P5,CLD.R SUP * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS ‘þú USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * * SKP * * OPEN NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA OP STA SC STA LU STA IBLK CLA RESET ZERO WORD STA ZERO LDA OPEN STA DPEN JMP DPEN+1 * * MIGHT NEED TO CLEAR ZERO * DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXIT NO; ERROR - EXIT SPC 1 JSB CLOSE CLOSE DEF *+2 IF DEF DCB,I OPEN SZA SKIP IF NO ERRORS CPA N11 OR IF NOT OPEN CLE,RSS JMP EXIT ELSE TAKE ERR EXIT * LDB NAME FETCH ADDRESS OF NAME PARM LDA B,I GET NAME WORD1 CPA MJ.. CHECK FOR MAJIC LU INB,RSS SO FAR SO GOOD JMP NORM NOPE--NORMAL OPEN LDA B,I FETCH NEXT TWO CHARS CPA LU.. CHECK FOR LAST PART OF "LU.." INB,RSS GOT IT,ADVANCE TO LU WORD JMP NORM CONTINUE * * * * FOUND MAGIC NAME * BUILD DUMMY DCB INFO * LDA B,I FETCH ASCII LU Xþú STA TEMP1 SAVE IT ALF,ALF POSITION FIRST DIGIT TO LOW END AND B17 ISOLATE IT STA VALUE SAVE FOR MULT. LDA .10 FETCH BASE FOR CONVERSION MPY VALUE CONVERT TO BINARY STA VALUE SAVE RESULT LDA TEMP1 FETCH ORIGINAL ASCII VALUES AND B17 ISOLATE SECOND DIGIT ADA VALUE INCLUDE CONVERTED VALUE JSB TYPER GO GET DEVICE TYPE AND SUB-CHNL * * DEVICE TYPE RETURNS IN (A) * SUB-CHNL IS IN "SUBC" * * IF LU WAS NOT ASSIGNED, A ERROR-18 (ILLEGAL LU) EXIT * IS TAKEN FROM TYPER * LDB B100 FETCH EOF CODE FOR MT TYPE DEVICES ADA N7K SEE IF TYPE GREATER THAN 17 SSA,RSS WELL? JMP STEOF YES IT IS--GO STORE THE EOF CODE * * CHECK FOR 2644\5\7 CTU'S * LDA EQT5 RESTORE TYPE CODE CPA B24K IS THIS DVR05 RSS YES--SKIP JMP BRF NOPE GO TRY SOMETHING ELSE LDA SUBC FETCH SUBCHANNEL CPA .1 LCTU? JMP STEOF YES --GO SET EOF CODE(B100) CPA .2 RCTU? JMP STEOF YES-- SEE ABOVE^^^^^^^^^^^^ * * BRF LDB B1000 EOF CODE FOR PUNCH CPB EQT5 IT'S ALSO TYPE CODE FOR DVR02 RSS YEP IT'S A PUNCH--USE EOF CODE IN B LDB B1100 EVERYONE ELSE DEFAULTS TO 1100B STEOF STB EOF SAVE CODE * * * * SET UP REQUIRED DCB ADDRESSES * * LDA DCB INA STA DCB1 INA STA DCB2 INA STA DCB3 INA STA DCB4 INA STA DCB5 INA STA DCB6 INA STA DCB7 ADA .2 STA DCB9 ADA .5 STA DCB14 * * * * BUILD DCB INFO * LDA DUM SET DUMMY STA DCB,I DCB FLAG LDA EQT5 FETCH TYPE CODE STA DCB1,I SAVE IT CLA STA DCB2,I SET TYPE * LDA OP,I FETCH SUBFUNCTION AND B3700 áþú ISOLATE GOOD BITS IOR VALUE INCLUDE LU STA DCB3,I SAVE IT LDA EOF INCLUDE EOF CODE NOW IOR VALUE STA DCB4,I SET FOR DCB MOVE * * LDA BOTHW CODE FOR RW,SP,SC MATCH STA DCB5,I STA DCB6,I STA DCB7,I * LDA XEQT STA DCB9,I * CLA,INA STA DCB14,I * LDA VALUE FETCH LU AGAIN SZA IF ZERO LU--ALLOW WRITE ONLY JMP NOZRO NOT ZERO-CONTINUE INA SET FOR WRITE ONLY STA DCB6,I SAVE READ WRITE CODE * * SEE IF PRE-FUNCTION IS REQUIRED * NOZRO LDB OP,I FETCH OPTION WORD BLF,BRS POSITION TO SLB THE INHIBIT BIT(#13) LDA EQT5 PUNCH? CPA B1000 PUNCH? JMP IH? GO SEE IF LEADER HAS BEEN INHIBITED CPA B400 PHOTO READR LDA B700 CONTROL CODE TO SET EOT SZA,RSS IF NOT ONE OF ABOVE SKIP CONTROL JMP SPCN1 SPCFN LDB VALUE FETCH LU IOR B COMBINE FOR CONTROL WORD STA VALUE DON'T NEED LU ANY MORE-- * JSB EXEC DEF SPCN1 DO DEF .3 SPECIAL PRE-FUNCTION--(SET EOT DEF VALUE IF PHOTO READR,PUNCH LEADER ON PUNCH) * * * * SPCN1 CLA JMP EXIT2 * * * B400 OCT 400 B700 OCT 700 BOTHW OCT 100001 DUM OCT 177400 B17 OCT 17 .10 DEC 10 B100 OCT 100 B1000 OCT 1000 N7K OCT 170777 B24K OCT 2400 B1100 OCT 1100 SPC 2 DCB1 NOP DCB2 NOP DCB3 NOP DCB4 NOP DCB5 NOP DCB6 NOP DCB7 NOP DCB9 NOP DCB14 NOP MJ.. ASC 1,LU LU.. ASC 1,.. TEMP1 NOP VALUE NOP EQT5 NOP SUBC NOP EOF NOP * * * INHIBIT BIT SET? * * IH? SLB,RSS IF INHIBIT BIT NOT SET JMP SPCFN GO DO LEADER * CLA STA DCB1,I PREVENT TRAILER ON CLOSE JMP SPCN1 DON'T DO LEADER SPC 5 * * * * TYPER SUBROUTINE * FETCHES DEVICE TYPE AND SUB-CHNL * LDA LU * JSB þúTYPER * RETURNS DEVICE TYPE IN (A) * * * * * TYPER NOP STA VALUE * JSB EXEC DEF STRTN DEF STAT DEF VALUE DEF EQT5 DEF EOF DEF SUBC * STRTN JMP ERN18 BAD LU EXIT * * LDA EQT5 AND TYPE ISOLATE TYPE CODE BITS STA EQT5 * * LDB MIDSK MINIMUM DISK DRIVER TYPE-1 ADB A IF LESS--OK SSB WELL??? JMP TYPER,I IT'S OK SO GET OUT * LDB MADSK MAXIUM DISK DRIVER TYPE+1 ADB A CHECK IT SSB OK IF GREATER OR ZERO JMP ERN17 * JMP TYPER,I * * STAT OCT 100015 TYPE OCT 37400 MADSK OCT 162000 NEG TYPE 34 MIDSK OCT 164400 NEG TYPE 27 ND18 DEC -18 ND17 DEC -17 * * * ILLEGAL LU(ASSIGNED TO DISK) OPEN * ERN17 LDA ND17 RSS * BAD LU EXIT * ERN18 LDA ND18 JMP EXIT2 * * SKP * * * * NORMAL FILE OPEN * **************** * * NORM LDB $CON,I FETCH WORD HOLDING NEW RUN FLAG SSB,RSS IF NOT SET--SKIP JMP NORM2 * JSB $LIBR GO NOP PRIV ELB,CLE,ERB AND CLEAR STB $CON,I IT. * * * JSB $LIBX DEF *+1 DEF *+1 RETURN TO NON-PRIV MODE * * NORM2 LDA NAME,I LDB OP,I AND OPTION ERB EXCLUSIVE BIT TO E CME INVERT AND RAL,ERA SET IN SIGN OF A STA .P3 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF SZA,RSS CHECK FOR NULL FROM ON PROCESSOR LDA BLK FILL WITH BLANK SZB,RSS SAME CHECK LDB BLK FILL WITH BLANKS DST .P4 LDA .11 FETCH OPEN CODE STA .P1 SET IN CALL LDA LU,I FETCH CR\LU STA .P2 SET IN CALL JSB CLD.R GO GET D.RFP * JSB RMPAR YES; GET THE RETURN DEF *+2 ˆþú CODES DEF ID TO LOCAL AREA LDA ID GET ERROR WORD SSA IF ERROR JMP EXIT EXIT DLD ID+1 ELSE SET DST DCB,I THE DCB FOR $OPEN CLO SET O LDA OP,I TO RAR,SLA,RAR INDICATE STO UPDATE OPTION ERA AND E FOR TYPE 1 OVER-RIDE STA LU SAVE FLAG LDA DCB GET DCB ADDRESS LDB SC,I AND SECURITY CODE JSB $OPEN AND GO SET UP THE DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF ID+4 ADDRESS OF NO OF SECTORS PER TRACK JMP OPEN1 ERROR - CLOSE AND EXIT SSA IF OPEN PROTECT SSB AND CODE MISMATCH THEN SKIP JMP OPEN2 ELSE GO EXIT - GOOD OPEN SPC 2 LDA N7 SET EXIT CODE OPEN1 STA ID IN ID JSB CLOSE ILLEGAL OPEN SO CLOSE DEF *+2 THE DEF DCB,I FILE OPEN2 LDA ID SEND ERROR CODE LDB LU GET SUB FUNCTION FLAG SLB IF NOT SET SZA OR NOT TYPE ZERO JMP EXIT THEN EXIT SPC 1 LDB DCB CACULATE DCB SUB FUNCTION ADB .3 ADDRESS STB SC SAVE IT LDA OP,I GET THE OPTIN SUB FUNCTION AND B3700 MASK IT OFF STA B AND SAVE IT LDA SC,I GET THE CURRENT WORD AND B77 SAVE THE LU ADA B ADD IN THE NEW SUB FUNCTION STA SC,I SET IT IN THE DCB CLA CLEAR A AND EXIT SPC 1 EXIT LDB DCB IF NO ERRORS, ADB .2 THEN REPLACE THE SIZE SSA,RSS WITH THE TYPE LDA B,I IF NO ERRORS EXIT2 STA ERR,I SET THE ERROR CODE JMP DPEN,I AND RETURN SPC 2 SPC 3 DZERO DEF ZERO N10 DEC -10 N11 DEC -11 ID NOP NAME1 BSS 4 N7 DEC -7 ZERO NOP .1 OCT 1 .2 DEC 2 .3 DEC 3 .59*($ OCT 5 B3700 OCT 3700 B77 OCT 77 BLK ASC 1, .11 DEC 11 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END ÄV*ÿÿ ÿý  ÿ92064-18179 1650 S C0122 &CREAF RTE-M FLPY CREAT SUB             H0101  4þúASMB,R,L,C * NAME: CREAT * SOURCE: 92064-18179 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CREAT,7 92064-16058 REV.1650 761024 * HED CREAT ENT CREAT EXT CLOSE,$OPEN,.ENTR EXT $LIBR,$LIBX,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT NAM..,RMPAR EXT EXEC EXT D.R SUP * * * CREAT IS THE FILE CREATION MODULE OF THE REAL TIME * FILE MANAGEMENT PACKAGE. * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK) * O R * IER = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK) * * W H E R E: * * IDCB IS THE ADDRESS OF A 144-WORD ARRAY WHICH * CREAT WILL USE AS A SCRATCH AREA. IF * ISIZE<0 THEN THE CREATED FILE IS ALSO * OPENED TO THIS DATA CONTROL BLOCK. * * IERR IS THE ADDRESS TO WHICH THE ERROR CODE * IS RETURNED. THIS INFORMATION IS ALSO * RETURNED IN THE A REGISTER. * * ERROR CODES ARE: * * >0 THE CREAT WAS SUCCESSFUL - THE #SECTORS IS RETURNED * -1 THE DISC IS DOWN * -2 DUPLICATE NAME * -4 FILE TOO LONG * -6 CARTRIDGE NOT FOUND * -10 NOT ENOUGH PARAMETERS IN THE CALL * -13 DISC LOCKED * -14 DIRECTORY FULL * -15 ILLEGAL NAME * -16 ILLEGAL TYPE OR SIZE * * * * NAME IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME. * THE NAME MUST CONTAIN ONLY LEGAL ASCII * CHARACTERS INCLUDKúþúING EMBEDDED BLANKS. COMMAS, * + SIGN, - SIGN ARE NOT ALLOWED. * IN ADDITION THE FIRST * CHARACTER MUST BE NON-NUMERIC AND NON-BLANK. * * ISIZE A TWO-WORD ARRAY. WORD 1 IS THE SIZE IN * 124-WORD DOUBLE SECTORS. WORD 2 IS USED * ONLY FOR TYPE 2 FILES AND IS THE RECORD LENGTH. * * ITYPE IS THE FILE TYPE--MUST BE >0. * * IS (OPTIONAL); IS THE FILE'S SECURITY CODE. * IF IS>0 THE FILE IS WRITE PROTECTED. * IF IS<0 THE FILE IS OPEN PROTECTED. * IF IS=0 OR IS NOT CODED THE FILE IS PUBLIC. * * ILU (OPTIONAL); DIRECTS THE CREAT TO: * IF ILU<0 THEN THE DISC AT LOGICAL UNIT (-ILU). * IF ILU>0 THEN THE DISC WITH LABEL ILU. * IF ILU=0 OR NOT CODED, THE FIRST AVAILABLE * DISC WITH ENOUGH ROOM IS USED. * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * * SCHEDULE PARAMETERS FOR D.RFP * * P1. FUNCTION CODE (1) * P2. +CR\-LU * P3. NAME 1,2 * P4. 3,4 * P5. 5,6 * (A) TYPE * (B) FILE SIZE * W27 RECORD SIZE * W28 SEC CODE * SKP CREAT NOP LDA DZERO STA SC STA LU STA TYPE STA IBLK LDA CREAT STA DREAT JMP DREAT+1 * DCB NOP IERR NOP NAME NOP SIZE NOP TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF DCB LDA TYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER þú10 NO - ERROR EXIT JSB CLOSE GO CLOSE THE DCR (IF OPEN) DEF *+2 DEF DCB,I SZA NO ERROR CPA N11 AND NOT OPEN ERROR - OK RSS SO SKIP IF THIS IS THE CASE JMP EXIT ELSE EXIT SOME CLOSE ERROR * * * JSB NAM.. GO CHECK THE NAME DEF *+2 DEF NAME,I SZA IF OK SKIP JMP EXIT ELSE EXIT ERROR SPC 2 LDA NAME,I GOOD NAME SO STA .P3 SET ISZ NAME UP DLD NAME,I SKELETON DIRECTORY DST .P4 ENTRY IN BUF LDA TYPE,I SZA TYPE MUST BE SSA >0 JMP ER16 NOT >0 ; ERR STA .P6 LDB SIZE,I GET THE SIZE BLS DOUBLE TO GET 64-WORD SECTORS SSB MUST BE >0 OR CCB SET TO -1 SZB,RSS IF ZERO JMP ER16 ERROR STB .P7 SET ISZ SIZE STEP TO RECORD SIZE CPA .2 IF NOT TYPE TWO CLA,RSS THEN JMP CREA4 SKIP SIZE TEST LSR 10 SHIFT TO A FOR DIVIDE DIV SIZE,I IF OVER FLOW THE RECORD SIZE TO SMALL SOC IF OK SKIP JMP ER4 ELSE ERROR FILE TOO LARGE CREA4 LDA SIZE,I LDB .P6 GET TYPE CPB .1 IF TYPE=1 LDA .128 SET SIZE TO 128 CPB .2 IF TYPE TWO SIZE MUST BE GIVEN SSA,RSS SIZE GIVEN? RSS YES; OR NOT TYPE TWO SKIP JMP ER4 ELSE ERROR CREA3 STA .P8 SET RECORD SIZE LDA SC,I SET STA .P9 SECURITY CODE CLA,INA SET STA .P1 FUNCTION CODE LDA LU,I SET STA .P2 THE LU/CR WORD * * SAVE WDS 27 AND 28 OF IDSEG * THEN PASS PARMS 8&9 IN THEIR SPOT * * UPON RETURN FROM D.RFP RESTORE ORIGIONAL CONTENTS * * LDA XEQT FETCH IDSEG ADDRESS ADA .26 ADVANCE ½þúTO ADDRESS OF WD27 STA T27 SAVE IT DLD A,I FETCH 27&28 DST WD27 SAVE EM DLD .P8 FETCH PARMS 8&9 JSB ST267 SET THEM INTO IDSEG DLD .P6 SET A&B=PARMS 6&7 JSB CLD.R GO CALL D.RFP * * SPC 2 SPC 2 JSB RMPAR YES; DEF *+2 CALL RMPAR DEF .P1 TO GET RETURN CODES * * RESET 27&28 * DLD WD27 JSB ST267 * LDA .P1 GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA .P2 YES; SET UP STA DCB,I TO CALL LDB DCB $OPEN CLE,INB TO LDA .P3 OPEN STA B,I THE LDA DCB FILE LDB SC,I STO SET UP FOR A UPDATE OPEN JSB $OPEN SET UP REST OF DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF .P5 ADDRESS OF NO OF SECTORS/TRACK JMP EXIT DISC ERROR - EXIT LDA TYPE,I GET TYPE ADA N3 IF 3 OR MORE SSA SKIP TO WRITE EOF JMP EXIT0 NOT RANDOM ACCESS FILE CCA SET WRITTEN ON AND EOF FLAG IN DCB LDB DCB GET WRITE FLAG ADB .13 ADDRESS STA B,I SET WRITTEN ON FLAG ADB .3 STEP TO THE BUFFER AND SET EOF STA B,I IN FIRST WORD OF BUFFER EXIT0 LDA .P1 NO; USE D.RTR RETURN FOR ERROR EXIT STA IERR,I SET ERROR CODE JMP DREAT,I AND EXIT SPC 3 ER4 LDA N4 SET ERROR JMP EXIT CODE ER10 LDA N10 AND JMP EXIT EXIT SPC 3 ER16 LDA N16 GET THE ERROR CODE JMP EXIT TAKE EXIT SPC 3 TMP NOP N16 DEC -16 N10 DEC -10 N11 DEC -11 N3 OCT -3 N4 OCT -4 .1 OCT 1 .2 DEC 2 .3 OCT 3 .4 DEC 4 .9 DEC 9 .5 DEC 5 .13 DEC 13 .128 DEC 128 DLU NOP TRACK NOP ZERO NOP DZERO DEF ZE«ÿRO .P6 NOP .P7 NOP .P8 NOP .P9 NOP T27 NOP WD27 BSS 2 .26 DEC 26 * * ST267 NOP JSB $LIBR NOP DST T27,I JSB $LIBX DEF ST267 * * SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END }ÿÿ ÿý ÿ92064-18180 1650 S C0122 &NAMFF RTE-M FLPY RENAME SUB             H0101 Ã9þúASMB,R,L,C * NAME: NAMF * SOURCE: 92064-18180 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM NAMF,7 92064-16058 REV.1650 761118 * HED NAMF EXT EXEC,.ENTR,CLOSE,NAM..,OPEN EXT CLD.R,.P1,.P2,.P3,.P4,.P5 ENT NAMF * * NAMF IS THE FILE NAME CHANGE MODULE OF THE * RTE FILE MANAGEMENT PACKADGE. * * CALLING SEQUENCE: * * CALL NAMF(IDCB,IERR,NAME,NNAME,IS,ILU) * * WHERE: * IDCB IS A 144 WORD DATA CONTROL BLOCK * THIS AREA IS FREE AFTER THE CALL. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE RETURNED HERE AND IN * THE A REGISTER. * DEFINED ERRORS ARE: * * * 0 NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -6 CARTRIDGE OR FILE NOT FOUND * -7 INVALID SECURITY CODE * -8 FILE CURRENTLY OPEN * -10 NOT ENOUGH PARAMETERS * -13 THE REQUIRED DISC IS LOCKED * -15 ILLEGAL NEW NAME * * NNAME THE NEW 6 CHARACTER FILE NAME * * IS OPTIONAL - THE FILE SECURITY CODE * * ILU OPTIONAL - THE FILES DISC ID. * * PRECEEDING CONSTANTS * N7 DEC -7 .7 DEC 7 N10 DEC -10 SPC 3 NAMF NOP ENTRY POINT LDA DZERO X REP 3 STA *-X+NNAME CLA STA ZERO LDA NAMF STA DAMF JMP DAMF+1 * * DCB DEF ZERO IERR DEF ZERO NAME DEF ZERO NNAME DEF ÃþúZERO IS DEF ZERO ILU DEF ZERO * * DAMF NOP JSB .ENTR FETCH PARAM ADDRESSES DEF DCB TO LOCAL LIST SPC 1 LDA N10 LOAD FOR NOT ENOUGH PRAM REJECT LDB NNAME NEW NAME SUPPLIED? CPB DZERO JMP EXIT NO; GO EXIT SPC 1 JSB NAM.. YES;NEW NAME DEF NAM.R LEGAL DEF NNAME,I FOR A FILE NAME? NAM.R SZA JMP EXIT NO; EXIT JSB OPEN CALL DEF OPRTN TO DEF DCB,I OPEN DEF IERR,I THE DEF NAME,I FILE DEF ZERO EXCLUSIVELY DEF IS,I WITH DEF ILU,I USER PRAMS OPRTN SSA SUCESSFUL OPEN? JMP EXIT NO; EXIT LDA DCB YES; CHECK ADA .7 THE LDB A,I SECURITY LDA N7 CODE SSB,RSS MATCH? JMP CLOEX NO; CLOSE AND EXIT * * * LDA .2 STA .P1 LDB DCB LDA B,I STA .P2 INB LDA B,I STA .P3 DLD NNAME,I DST .P4 LDA NNAME ADA .2 LDA A,I JSB CLD.R * * LDA B,I ERROR FLAG TO A STA NAME SAVE IT SPC 1 EXR4 RSS SKIP ERROR ENTRY CLOEX STA NAME SAVE ERROR CODE JSB CLOSE CLOSE DEF CLOR1 THE DEF DCB,I FILE CLOR1 LDB NAME GET ERROR CODE SZB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET RETURN ERROR JMP DAMF,I EXIT TO USER SPC 3 * FOLLOWING CONSTANTS SPC 1 ZERO NOP DZERO DEF ZERO SPC 2 * TEMPS REFERENCED ONLY BY DEFS SPC 1 .2 DEC 2 SPC 2 * ASSEMBLY AIDS SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * PROG. LENGTH SPC 1 END ý0 ÿÿ ÿý ÿ92064-18181 1650 S C0122 &CLOSF RTE-M FLPY CLOSE SUB             H0101 °:þúASMB,R,L,C * NAME: CLOSE * SOURCE: 92064-18181 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLOSE,7 92064-16058 REV.1650 761019 * HED CLOSE ENT CLOSE EXT EXEC,.ENTR,R/W$,CLD.R,.P1,.P2,.P3,.P4 SUP * * THIS IS THE CLOSE SUBROUTINE--A PART OF THE * REAL-TIME FILE MANAGEMENT PACKAGE * * THE ASSEMBLY CALL TO CLOSE A FILE IS: * * JSB CLOSE * DEF RTN RETURN ADDRESS * DEF IDCB DATA CONTROL BLOCK ADDRESS * DEF IERR (OPTIONAL) ERROR CODE RETURNED HERE AND IN A REG * DEF IRX (OPTIONAL) NO. OF 128 WORD DOUBLE *RTN SECTORS TO BE DELETED FROM THE FILE * * ERRORS ARE: * 0 NONE * -1 DISC DOWN * -10 NOT ENOUGH PARAMETERS * -11 FILE NOT OPEN * -13 DISC LOCKED * * * SKP CLOSE NOP LDA DZERO STA IDCB STA IRX LDA DM STA IERR CLA STA ZERO STA .P1 FUNCTION CODE FOR CLOSE LDA CLOSE STA DLOSE JMP DLOSE+1 * * * IDCB DEF ZERO DCB ADDRESS IERR DEF IDCB ERROR CODE ADDRESS IRX DEF ZERO TRUNICATE CODE ADDRESS SPC 1 DLOSE NOP ENTRY POINT JSB .ENTR TRANSFER THE ADDRESSES DM DEF IDCB LDA IDCB IF NO PARAMETERS CPA DZERO THEN JMP ER10 ERROR EXIT INA STEP TO WORD TWO LDB A,I FETCH OFFSET SECTOR STB .P3 SAVE FOR D.RTR CALL ADA .8 ADD 8 TO GET THE THE OI‡þúPEN FLAG STA OPNFL SAVE THE OPEN FLAG ADDRESS LDB A,I GET THE OPEN FLAG ADA N2 BACK UP TO THE STA SC SAVE THE SECURITY CODE ADDRESS CPB XEQT FILE OPEN? CLE,RSS YES SKIP JMP ER11 NO; ERROR EXIT LDB IDCB GET THE DCB ADDRESS * LDA B,I IF MAGIC LU OPEN CPA FAKE DON'T CALL D.RFP JMP DUMMY JUST CLOSE DCB AND GET OUT * JSB R/W$ CALL TO FLUSH THE BUFFER JMP EXIT DISC ERROR EXIT LDB IDCB GET THE TYPE FLAG ADB .2 LDA B,I A SZA IF ZERO NO TRUNCATE LDA IRX,I DISC FILE SET TRUNCATE CODE ALS ADJUST FOR 64 WORD SECTORS ADB .13 STEP TO EXTENT WORD LDB B,I IF NOT SZB FIRST EXTENT CLA DO NOT ALLOW TRUNCATION LDB SC,I GET THE SECURITY FLAG SSB,RSS IF BAD SC CLA DIS ALLOW TRUNCATION CMA,INA SET NEGATIVE STA .P4 SAVE FOR D.RFP * LDA IDCB,I SET DIRECTORY ADDRESS FOR D.RFP STA .P2 JSB CLD.R SCHED D.RFP RSS SKIP MAGIC LU EXIT WORK * DUMMY CLB SPC 2 CLA STA OPNFL,I CLEAR THE OPEN FLAG LDA B,I YES; GET ERROR RETURN STA IRX SAVE THE ERROR CODE * * * * IF MAGIC LU OPEN AND PUNCH-- * THEN DO TRAILER----- * LDB IDCB FETCH DCB ADDRESS LDA B,I FETCH CONTENTS CPA FAKE IF MAGIC LU OPEN-- RSS CONTINUE JMP EXI ELSE--ALL DONE * INB ADVANCE TO DEVICE TYPE WORD LDA B,I FETCH IT ADB .3 ADVANCE TO EOF CODE STB CLOSE SAVE ITS ADDRESS CPA PUNCH IS IT A PUNCH??? RSS YEP--GO DO TRAILER JMP EXI NOPE--SO ALL DONE * * * JSB EXEC DEF EXI 8d DEF .3 CONTROL CALL DEF CLOSE,I EOF CODE * EXI LDA IRX RESTORE ERROR CODE * EXIT STA IERR,I SET THE ERROR CODE JMP DLOSE,I EXIT ERROR CODE IN A SPC 3 ER11 CCA FILE NOT OPEN - ERROR 11 ER10 ADA N10 NOT ENOUGH PRAMS - ERROR 10 JMP EXIT GO EXIT SPC 3 FAKE OCT 177400 PUNCH OCT 1000 N10 DEC -10 N2 DEC -2 .2 OCT 2 .3 OCT 3 .8 DEC 8 .13 DEC 13 SC NOP OPNFL NOP ZERO NOP DZERO DEF ZERO SPC 2 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ÿÿ ÿý ÿ92064-18182 1650 S C0122 &CLDRF RTE-M FLPY DIR PRG CALL SUB             H0101 ”þúASMB,R,L,C * NAME: CLD.R * SOURCE: 92064-18182 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLD.R,7 92064-16058 REV.1650 761013 * HED CALL ROUTINE FOR D.RF 761013B ENT CLD.R,.P1,.P2,.P3,.P4,.P5 EXT EXEC,$D.RF,$OPSY,$CON * * * THIS ROUTINE PROVIDES A CENTRAL * CALLING POINT FOR THE SCHEDULING * OF D.R. * * * RTE-M1 MAY NOT HAVE THE SCHEDULING * ABILITY FOUND IN M2 & M3. THEREFORE * THIS ROUTINE WILL DO A DIRECT ENTRY * IN THE M1 ENVIRONMENT IF THE DIRECTORY * MANAGER ($D.RF1) WAS NOT RELOCATED INTO * THE RESIDENT LIBRARY. * * * * .P1 NOP .P2 NOP .P3 NOP .P4 NOP .P5 NOP TMPA NOP TMPA2 NOP * CLD.R NOP ENTRY POINT DST TMPA SAVE THE A AND B REGS LDA $D.RF FETCH THE SUBROUTINE FLAG SSA,RSS WAS M1 VERSION LOADED?(DUMMY ENT =-1) JMP M1 YES--GO DO DIRECT ENTRY IF M1 * LDA TMPA RESTORE A JSB EXEC NOW SCHED DEF BACK D.R WITH DEF SCED WAIT AND QUEUE DEF D.RF PASSING DEF .P1 THE FIVE TEMPS IN THE CALL. DEF .P2 FOUR MORE PARMS MAY BE PASSED BY DEF .P3 USING WDS 27&28 OF CALLERS ID SEG DEF .P4 ALONG WITH THE A AND B REGS. D.R CAN THEN DEF .P5 DETERMINE HIS FATHERS ID ADDRESS AND PROCEDE * TO FETCH ANY EXTRA PARMS AS REQUIRED * BACK JMP ERR8 SC6,  HEDULE ERROR * EXIT TO CALLING PROG. * RETURN PARMS MAY BE FETCHED BY RMPAR * * JMP CLD.R,I * * M1 LDA $OPSY FETCH OP SYS TYPE CPA N7 ALLOW RE-ENTRANT CALL ONLY IN M1 RSS OK---SKIP JMP ERR26 NO!!!! GIVE ERROR AND ABORT * JSB $D.RF DIRECT ENTRY TO D.R IN LIBRARY DEF M1BK DEF .P1 * M1BK JMP CLD.R,I EXIT, SEE ABOVE FOR INFO ON RETURN PARMS * * N7 DEC -7 * SCED OCT 100027 D.RF ASC 3,D.RFP * * ERR8 LDA E8 SCHEDULE ERROR RSS ERR26 LDA E26 ATTEMPT TO USE M1 SUB IN 2/3 SYS STA CPE SET THE ERROR CODE * LDA $CON,I FETCH LU FOR MESSAGE AND B77 ISOLATE LU STA LU SAVE IT FOR CALL * JSB EXEC DEF P1TN DEF .2 DEF LU DEF EBUF DEF .5 * P1TN LDB XEQT FETCH IDSEG ADDRESS ADB .12 ADVANCE TO NAME LDA B,I MOVE STA PN1 FIRST WORD INB DLD B,I FETCH NEXT TWO STA PN2 SET WORD 2 SWP GET LAST WORD TO A AND HBYTE ISOLATE HIGH BYTE IOR B40 INCLUDE BLANK STA PN3 SET INTO BUF * JSB EXEC DEF P2TN DEF .2 DEF LU DEF ABUF DEF .8 * P2TN JSB EXEC DEF *+2 DEF .6 * * .2 OCT 2 .5 OCT 5 .6 OCT 6 .12 DEC 12 B40 OCT 40 B77 OCT 77 HBYTE OCT 177400 LU NOP E8 ASC 1,08 E26 ASC 1,26 EBUF ASC 4, FMGR 0 CPE BSS 1 ABUF ASC 1, PN1 NOP PN2 NOP PN3 NOP ASC 4, ABORTED .8 DEC 8 * * XEQT EQU 1717B B EQU 1 * * END EQU * END  ÿÿ ÿý ÿ92064-18183 1650 S C0122 &DD.RF RTE-M FLPY DUMMY ENT             H0101 ¥1ASMB,R,L,C * NAME: DD.RF * SOURCE: 92064-18183 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DD.RF,7 92064-16058 REV.1650 761010 * ENT $D.RF * * THIS ROUTINE SUPPLIES A DUMMY ENTRY POINT FOR CLD.R * ONLY IF WE ARE NOT IN A M1 SYSTEM. IN WHICH CASE, THE * DIRECTORY MANAGER MUST HAVE BEEN RELOCATED INTO THE MEM- * RESIDENT LIBRARY. IF THIS WAS NOT DONE, THIS ENTRY POINT * WILL CAUSE THE PROGRAM TO BE ABORTED (FMGR 026). * * * * * * $D.RF OCT -1 * END øûÿÿ ÿý ÿ92064-18184 1650 S C0122 &READF RTE-M FLPY READ/WRITE SUB             H0101 ,lþúASMB,R,L,C * NAME: READF * SOURCE: 92064-18184 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM READF,7 92064-16058 REV.1650 761115 * HED READF ENT READF,WRITF EXT EXEC,R/W$,.ENTR,P.PAS EXT RW$UB,$KIP EXT D$XFR EXT RFLG$ SUP * * * THIS IS THE RTE FILE MANAGEMENT PACKAGE * READ/WRITE SUBROUTINE. * * THIS ROUTINE WILL READ OR WRITE ANY TYE FILE. * * * CALLING SEQUENCE: * * CALL READF(IDCB,IERR,IBUF,IL,L,N) * * O R * * IER = READF(IDCB,IERR,IBUF,IL,L,N) * * TO READ, O R * * CALL WRITF(IDCB,IERR,IBUF,IL,N) * * O R * * IER = WRITF(IDCB,IERR,IBUF,IL,N) * * TO WRITE. * * * W H E R E: * * IDCB IS THE 144 WORD DATA CONTROL BLOCK * FOR THE REFERENCED FILE. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE AS FOLLOWS: * * CODE ERROR CONDITION * 0 OR >0 NO ERROR * -1 A REQUIRED DISC OR DEVICE IS DOWN * -5 ILLEGAL RECORD NUMBER OR * ATTEMPT TO READ A RECORD NOT WRITTEN * -7 INVALID SECURITY CODE FOR * WRITE (FILE IS READ ONLY) * -10 A REQUIRED PARAMETER IS MISSING * -11 THE DCB IS NOT OPEN * -12 SOF OR EOF SENSED ON READ * -17 ILLEGAL REQUEST TO A TYPE ZMuþúER0 FILE * * IER SEE IERR - RETURNED AS FUNCTION * * IBUF IS THE BUFFER TO BE USED TO READ OR WRITE. * * IL IS THE REQUESTED TRANSFER LENGTH IN WORDS. * * L IS THE LENGTH AS READ IN WORDS. * * N IS THE REQUESTED RECORD NUMBER * IF N>0 OR IF N<0 THE RELATIVE RECORD * NUMBER FROM THE CURRENT POSITION. * N IS LEGAL ON TYPE 1 AND 2 FILES ONLY. * * * O P T I O N S: * * IL IS OPTIONAL ON TYPE 1 AND 2 FILES. * ON TYPE 1 FILES, 128 IS USED; * ON TYPE 2 FILES THE RECORD LENGTH IS USED. * * L IS OPTIONAL AT ALL TIMES. * * N IS OPTIONAL AND IS IGNORED ON FILES * OF TYPES OTHER THAN 1 AND 2. IF NOT * SUPPLIED, ZER0 IS USED. * THE FIRST RECORD IN A FILE IS RECORD #1. * * * E X T E R N A L S: * * RW$UB IS USED TO READ OR WRITE WORDS * FROM OR TO FILES OF TYPE 2 OR * ABOVE. IT HANDLES ALL SECTOR, * TRACK, AND EXTENT SWITCHING FOR * THESE FILES AND ALSO WRITES AND/OR * READS BLOCKS FROM THE FILE AS * REQUIRED. READS ARE CONDITIONAL * ON RFLG$. A GLOBAL FLAG WHICH * MUST BE NON-ZER0 BEFORE A READ * IS EXECUTED. * * RW$UB CALLING SEQUENCE IS: * * LDB #WORDS * LDA DCB ADDRESS * CLE/CCE WRITE/READ * JSB RW$UB CALL * DEF UBUF ADDRESS OF USER'S BUFFER * JMP ERROR ERROR RETURN (A = CONDITION) * -- NORMAL RETURN SKP WRITF NOP WRITE ENTRY POINT LDA WRITF TRANSFER RETURN ADDRESS STA DEADF TO READ ENTRY JMP RST AND GO TO PRESET ENTRY PARMS * READF NOP READ ENTRY POINT LDA READF FETCH AND STA DEADF TRANSFER RETURN ADDRESS TO DUMMY ENTRY mèþúCCA SET RST STA ENTFG ENTRY FLAG(POS FOR WRITF/NEG FOR READF) * * * PRE-SET ENTRY PARMS * LDA N17 STA BUF LDA DMBUF STA IL LDA DZER0 STA L STA N CLA STA ZER0 STA DM JMP DEADF+1 GO FETCH CALL PARMS * * SPC 3 DCB NOP DCB POINTER IERR NOP ERROR BOX BUF OCT -17 USER BUFFER ADDRESS IL DEF DM REQUEST LENGTH L DEF ZER0 RETURN LENGTH N DEF ZER0 RECORD NUMBER * * DEADF NOP READ ENTRY POINT JSB .ENTR TRANSFER THE DEF DCB PARAMETERS LDA DCB SET UP THE CLB,CLE DCB JSB P.PAS ADDRESSES N17 DEC -17 TMP NOP USE FIRST TWO AS BFSZ EQU TMP TMP1 NOP TEMP STORAGE TYPE NOP ADDRESS OF TYPE LU0 NOP LU (FOR 0 FILE) TRACK EQU LU0 ALSO TRACK EOF0 NOP EOF CODE (0 FILE) BSECT EQU EOF0 ALSO SECTOR SPAC NOP SPACING CODE (0 FILE) SIZE EQU SPAC ALSO FILE SIZE RL NOP RECORD LENGTH SCMO NOP SECURITY/OPEN MODE #SC/T NOP SECTORS/TRACK OCFLG NOP OPEN FLAG TR NOP CURRENT TRACK SECT NOP CURRENT SECTOR BUFPT NOP CURRENT POSITION RWFLG NOP READ/WRITE FLAG RC NOP RECORD COUNT TMP2 NOP BUFD NOP SPC 2 LDA N10 PRESET FOR MISSING PRAM ERROR LDB BUF BUFFER MUST BE SSB SUPPLIED JMP EXIT ELSE MISSING PRAM * LDB OCFLG,I IF NOT OPEN LDA N11 CPB XEQT THEN RSS JMP EXIT EXIT FILE NOT OPEN * LDB ENTFG GET READ WRITE FLAG LDA SCMO,I AND SECURITY CODE ARS,ALR CLEAR LEAST AND SIGN BITS STA BFSZ SAVE BLOCK LENGTH XOR SCMO,I GET THE SECURITY CODE/›]þúUDATE FLAG SSB,RSS IF WRITE SSA AND JMP SCOK BAD SECURITY * LDA N7 THEN EXIT STA IERR,I SET THE ERROR CODE JMP DEADF,I RETURN * * ENTFG NOP SPC 2 SCOK RRL 1 SHIFT SIGN TO LOW A STA RFLG$ USE A READ FLAG LDB L,I GET N FOR WRITE SLA,ARS IF READ LDB N,I GET READ N LDA TYPE,I GET TYPE CPA .2 TWO JMP LTEST GO TEST FOR EOF * CPA .1 IF TYPE ONE CLA,RSS SKIP JMP EOFTS ELSE GO TO EOF TEST * RANDOM ACCESS FILE SPC 1 STA RWFLG,I INHIBIT R/W$ WRITE FOR TYPE ONE FILES LDA .128 FOURCE LENGTH TO 128 FOR TYPE 1 FILES STA RL,I FOR THE POSITION ROUTINE SPC 1 LTEST LDA IL,I GET THE REQUEST LENGTH SSA IF EOF REQUEST THEN JMP EXIOK GO EXIT NO ACTION * SZB POSITION OPTION? SSB YES IF <0 ADB RC,I ADD CURRENT POSITION STB TMP2 SAVE RESULT CCA ADA B MULTIPLY RECORD LENGTH SSA IF NEG RECORD NO JMP EOFEX TAKE ERROR EXIT * MPY RL,I BY THE DESIRED RECORD DIV BFSZ COMPUTE THE BLOCK AND OFFSET STB OCFLG SAVE THE OFFSET CLB NOW COMPUTE THE SECTOR ADDRESS MPY BFSZ OF THE BLOCK ASR 6 EVEN SECT ADDRESS TO A STA TMP SAVE CMA CHECK FOR ADA SIZE,I EOF SSA IF NOT EOF SKIP JMP EOFEX TAKE ERROR EXIT * LDA TMP RESTORE A ADA BSECT,I ADD THE BASE SECTOR DIV #SC/T,I DIVIDE BY NO. SECT/TRACK ADA TRACK,I ADD BASE TRACK-A = TRACK DST TMP SAVE NEW TR/SECTOR ADDRESS CPA TR,I IF SAME CCA AS CPB SECT,I CURRENT LDB 0 POSITION vJþú CLE,SSB THEN JMP RACS SKIP * LDB DCB ELSE JSB R/W$ WRITE THE CURRENT BLOCK JMP EXIT IF NECESSARY * DLD TMP THEN SET DST TR,I THE NEW SPC 2 ADDRESS RACS LDA OCFLG SET THE OFFSET ADA BUFD ADD BUFFER ADDRESS STA BUFPT,I AND SET THE POINTER LDA TMP2 SET THE STA RC,I NEW RECORD NUMBER SPC 2 EOFTS LDA BUFPT SET THE INDIRECT ADA MSIGN BIT ON STA BUFPT THE BUFFER POINTER LDA TYPE,I GET FILE TYPE CMA,INA,SZA,RSS IF 0 JMP TYP00 OR 1 * INA,SZA,RSS GO DO 0/1 THING JMP .1TYP * INA,SZA,RSS IF TYPE 2 JMP TWOTY GO DO READ TEST * INTS LDA RWFLG,I GET THE IN CORE FLAG CCE,SZA IF IN CORE JMP TWOSP GO TEST FOR TWO * LDB DCB ELSE READ JSB R/W$ THE BLOCK JMP EXIT ERROR EXIT SPC 2 TWOSP LDA TYPE,I GET THE TYPE AGAIN TWORW LDB RL,I GET THE RECORD LENGTH (TYPE 2) CPA .2 IF TYPE 2 JMP .2RW GO DO READ WRITE SPC 2 * * TYPE 3 AND ABOVE READ/WRITE LOOP * LDA ENTFG SET READ WRITE FLAG ELA IN E 0=> WRITE 1=>READ LDB BUFPT,I GET CURRENT WORD SSB,RSS IF <0 THEN EOF JMP RDLEN NO <0 - SKIP * LDA RWFLG,I EOF RAR,RAR SET (READ) OR CLEAR (WRITE) ELA,RAL EOF SENT STA RWFLG,I BIT IN DCB LDA ENTFG GET THE DIRECTION AGAIN SSA,RSS IF WRITE JMP SWRI GO BACK UP THE COUNT IF REQUIRED * * READ AT EOF * EOFT0 STA L,I FOR EOF HERE WITH A = -1 CLA,SEZ IF FIRST EOF SKIP EOFEX LDA N12 ELSE EOF ERROR SSA,RSS IF FIRST EOF THEN ISZ RC,I STEP THE RECORD COUNT JMP EXIT GO EXIT * * WRITE AT EOF * SWRI CLA,SEZ ëþú IF THE EOF WAS PASSED TO THE USER CCA THEN BACK UP THE RECORD COUNT ADA RC,I SO WE DON'T COUNT TWO OF STA RC,I THEM CLB,CLE RECOVER THE E BIT FOR WRITE STB RFLG$ CLEAR THE READ FLAG RDLEN CCB,SEZ IF READ JMP RDLE1 SKIP WRITE CHECKS * LDA IL,I GET REQUEST LENGTH CMA,CCE,SSA,INA,RSS IF WRITE EOF JMP EOFWR GO WRITE EOF * ADA BUFPT,I COMPARE NEW LENGTH TO OLD LDB RFLG$ GET READ FLAG CLE,SZA IF NEW LENGTH = OLD SZB,RSS OR IF NOT UPDATE JMP RDLE2 CONTINUE WRITE SPC 1 ERR5 LDA N5 ELSE UPDATE ERROR JMP EXIT GO EXIT SPC 1 RDLE1 LDA DMBUF GET LENGTH RETURN ADDRESS RDLE2 CLB,SEZ,INB,RSS IF WRITE LDA IL USE REQUEST LENGTH STA BUA SET ADDRESS OF BUFFER LDA DCB SET THE DCB ADDRESS JSB RW$UB GO READ FIRST LENGTH WORD BUA DEF L,I JMP EXIT ERROR EXIT * LDB A .2RW LDA ENTFG GET READ/WRITE FLAG ELA TO E CLA,SEZ,RSS IF WRITE THEN SKIP JMP WRIT WRITE SO SKIP * LDA IL CHECK IF LENGTH SUPPLIED CPA DMBUF IF COMPARE THEN NO LENGTH CLA,RSS NOT SUPPLIED SO FORCE TRANSFER LDA B SUPPLIED SO CHECK FOR RECORD CMA,INA TOO LONG FOR ADA IL,I BUFFER SSA SKIP IF OK LDB IL,I TOO LONG SO USE SUPPIED LENGTH STB L,I SET AS RETURN LENGTH WRIT STA SKIP SAVE RESIDUE FOR SKIP AFTER READ LDA DCB DCB TO A JSB RW$UB READ THE RECORD DEF BUF,I TO USER BUFFER JMP EXIT ERROR EXIT * LDB TYPE,I GET FILE TYPE CPB .2 IF 2 JMP EXIOK-1 THEN DONE - GO EXIT * LDA DCB SET UP TO SKIP LDB SKIP THE RESIDUE CMB,SSB,INB SET + NO WORDS SKIP IF >0 JMñ¢þúP NOSKP <0 SO DON'T SKIP * JSB $KIP GO SKIP THE WORDS JMP EXIT ERROR EXIT * NOSKP LDA ENTFG ELSE ELA SET TO CLA,SEZ,RSS READ /WRITE THE LDA IL TWIN WORD STA BUFAA WORD LDA DCB TO DUM CLB,INB OR FROM JSB RW$UB USER. BUFAA NOP JMP EXIT ERROR - EXIT * CPA BUA,I IF TWIN MISMATCH CCB,RSS JMP ERR5 THEN BAD RECORD - EXIT * LDA RFLG$ GET READ FLAG CLE,SZA,RSS IF NOT READING JMP EOFWR GO SET EOF IN FILE * EXT0 ISZ RC,I STEP THE RECORD COUNT EXIOK CLA DONE - OK SO JMP EXIT EXIT SPC 2 EOFWR STB BUFPT,I SET EOF IN DCB ELB,RBL SET UP THE EOF READ FLAG AND THE STB RWFLG,I WRITTEN ON AND EOF FLAG IN THE DCB JMP EXT0 GO EXIT SPC 2 TWOTY LDB RFLG$ GET READ WRITE FLAG SZB IF READING JMP INTS GO TEST FOR IN CORE * JMP TWOSP ELSE GO WRITE. SPC 2 * * TYPE 0 OR 1 FILE -- TRANSFER FROM CORE * .1TYP LDA IL GET LENGTH ADDRESS LDB A,I GET LENGTH CPA DMBUF IF NOT SUPPLIED THEN LDB .128 USE 128 STB IL SAVE LOCALLY ADB B177 ROUND UP LSR 7 GET # OF SECTORS COVERED STB SKIP SAVE ROUNDED LENGTH ADB RC,I = # OF 128 WORD RECORDS STB TMP SAVE NEW RECORD # ADB N1 SUBTRACT 1 (RECORD #'S START AT 1) BLS CONVERT TO 64 WORD SECTORS CMB,INB SUBTRACT ADB SPAC,I FROM FILE SIZE SSB IF OUT OF FILE JMP EOFEX TAKE EOF EXIT SPC 2 LDA SKIP GET ROUNDED LENGTH LSL 7 SET TO CORRECT POSITION LDB ENTFG AND SSB,RSS RESET IF STA IL WRITE LDA IL GET XFER LENGTH FOR D$XFR SSB IF READ THEN ÕÜþú STA L,I SET THE RETURN LENGTH ELB SET E FOR DXFR$ CALL LDB BUF GET THE BUFFER ADDRESS STB BUFA SET IT IN THE CALL LDB DCB GET THE DCB ADDRESS JSB D$XFR GO DO THE TRANSFER BUFA NOP JMP EXIT ERROR RETURN * LDA TMP SET THE NEW STA RC,I RECORD COUNT JMP EXIOK AND EXIT SPC 1 TYP00 LDB ENTFG IF READ STB TMP SET READ WRITE FLAG FOR EOF TEST LDA RL,I GET THE READ WRITE LEGAL FLAG SSB,RSS IF WRITE RAR SHIFT THE WRITE FLAG TO BIT 15 SSA,RSS TEST THE FLAG JMP EX17 ILLEGAL REQUEST GO EXIT SPC 1 CCA IF READ SSB THEN JMP TYP01 SKIP * CPA IL,I EOF? JMP EOFW0 YES; GO MAKE CONTROL RQ SPC 1 TYP01 CLA,CCE,INA SET UP THE REQUEST CODE SSB,RSS FOR THE CALL INA AND ELA,RAR STA RQ IT. JSB EXEC CALL DEF RTN THE DEF RQ EXEC DEF LU0,I FOR DEF BUF,I I/O DEF IL,I TO/FROM USER BUFFER. RTN JMP EX17 DRIVER REJECTED CALL - ERROR. ISZ TMP TEST READ WRITE JMP EXT0 GO EXIT IF WRITE * STB L,I SET THE RETURN LENGTH SPC 1 RAL,CLE,ELA PUT THE DOWN BIT IN E ALF,RAL SHIFT THE EOF BIT RAL TO BIT 15 SSA IF EOF BIT SET JMP EOF00 GO DO EOF THING * SZB IF ZER0 WORDS READ THEN SKIP JMP EXT0 ELSE GO EXIT GOOD XFER * AND B70 MASK THE HIGH ORDER TYPE BIT SEZ,CCE,SZA IF NOT DOWN OR IF TYPE <10 THEN EOF JMP TYP00 ELSE RETRY THE XFER SPC 1 EOF00 CCA,CLE JMP EOFT0 DO EOF TYPE ZER0 EXIT SPC 2 EOFW0 JSB EXEC WRITE TYPE ZER0 EOF DEF EOFRT RETURN ADDRESS DEF .3I †´640CATCH ERRORS DEF EOF0,I DEF N1 EOFRT RSS IF ERROR RETURN THE CODE JMP EXIOK SPC 3 EX17 LDA N17 SET UP ILLEGAL REQUEST FLAG JMP EXIT GO EXIT SPC 2 * * * C O N S T A N T S N1 OCT -1 .1 OCT 1 .2 OCT 2 .3I DEF 3,I .128 DEC 128 MSIGN DEF 0,I DZER0 DEF ZER0 ZER0 NOP DMBUF DEF DM DM NOP N11 DEC -11 N10 DEC -10 N7 OCT -7 N12 DEC -12 N5 OCT -5 B177 OCT 177 B70 OCT 70 SPC 5 SKIP NOP RQ NOP SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 PLENG EQU * END ìÙ6ÿÿ ÿý  ÿ92064-18185 1650 S C0122 &POSTF RTE-M FLPY POST SUB             H0101 ÜþúASMB,R,L,C * NAME: POST * SOURCE: 92064-18185 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM POST,7 92064-16059 REV.1650 761024Q * HED POST - CLEAR THE DCB BUFFER ENT POST EXT .ENTR,R/W$ * * * THE POST ROUTINE CLEARS THE DCB BUFFER BY POSTING ANY * DATA THAT NEEDS TO BE WRITTEN ON THE DISC. IT WILL IN * ALL CASES CLEAR THE INCORE FLAG SO THE NEXT FILE * ACCESS WILL FOURCE A DISC READ. * * POST IS TO BE USE WITH THE RN LOCK FEATURE AS * FOLLOWS: * * POST * LOCK * * DO YOUR THING * * POST * UNLOCK * * CALLING SEQUENCE: * * CALL POST(DCB,ER) * * WHERE: * * DCB IS THE DCB ARRAY * ER IS THE OPTIONAL RETURN ERROR CODE * * POST NOP CLA PRE-SET STA ER CALL LDA POST PARMS STA DOST MOVE PARM ADDRESS JMP DOST+1 TO DUMMY ENTRY POINT * DCB NOP ER NOP DOST NOP ENTRY POINT JSB .ENTR GET THE PRAM ADDRESSES DEF DCB LDB DCB CHECK ADB D9 THAT THE DCB LDA B,I IS OPEN CPA XEQT YES? JMP OK YES! * LDA N11 NO RETURN ERROR EREX STA ER,I SET THE ERROR CODE CLB SET ER ADDRESS STB ER FOR NEXT TIME JMP DOST,I EXIT * OK LDB DCB GET THE DCB ADDRESS CLE SET E FOR WRITE JSB R/W$ GO POST THE BUFFER JMP EREX DISC ERROR GO EXIT * W¾   CLA ALL IS GOOD SET OK ERROR CODE JMP EREX AND GO EXIT * D9 DEC 9 N11 DEC -11 XEQT EQU 1717B A EQU 0 B EQU 1 END óp ÿÿ ÿý  ÿ92064-18186 1650 S C0122 &RWNDF RTE-M FLPY REWIND SUB             H0101 äHþúASMB,R,L,C * NAME: RWNDF * SOURCE: 92064-18186 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RWNDF,7 92064-16059 REV.1650 760817 * HED RWNDF ENT RWNDF EXT .ENTR,RWND$,EXEC EXT R/W$ * THE MODULE OF THE RTE FILE MANAGER PERFORMS * THE REWIND OR RESET FUNCTION * * A FILE IS RESET TO EXTENT 0 RECORD 1 VIA RWND$ * A TYPE ZERO UNIT IS REWOUND VIA AND EXEC CALL * * * CALLING SEQUENCE * * CALL RWNDF(IDCB,IER) * * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK ARRAY * * IER IS THE ERROR RETURN LOCATION. * ERRORS ARE RETURNED IN THE A REG * ALSO. * ERRORS CODES ARE: * 0 NO ERROR * -11 DCB NOT OPEN * * SPC 2 * PRE CONSTANT AREA SPC 1 .3 DEC 3 TYPE NOP .2 OCT 2 .7 DEC 7 .5 DEC 5 SPC 3 RWNDF NOP LDB DFDM PRESET STB DCB ENTRY STB IER ADDRESSES LDA RWNDF MOVE RETURN ADDRESS STA DWNDF TO DUMMY ENTRY POINT JMP DWNDF+1 GO DO IT * DCB DEF DCB IER DEF DCB SPC 1 DWNDF NOP ENTRY POINT JSB .ENTR FETCH DFDM DEF DCB PRAM ADDRESSES SPC 1 LDB DCB GET DCB ADDRESS ADB .2 INDEX TO TYPE AND STB TYPE SET ADDRESS ADB .7 INDEX TO OPEN FLAG AND LDA B,I FETCH CPA XEQT OPEN? CLA,INA,RSS YES; SEÿ;  T AWRWND RECORD COUNT/SKIP JMP NOOPN NO; TAKE ERROR EXIT ADB .5 INDEX TO RECORD COUNT AND STA B,I SET RECORD COUNT LDA TYPE,I GET TYPE CLE,SZA IF NOT ZERO JMP DISC GO DO DISC THING SPC 1 ISZ TYPE TYPE =0 -STEP TO LU LDA TYPE,I FETCH LU AND AND B77 ISOLATE IT THEN ADA B400 ADD THE REWIND BIT STA TYPE AND SAVE FOR EXEC SPC 1 JSB EXEC CALL EXEC TO DEF EXRTN REWIND DEF .3 TYPE DEF TYPE ZERO FILE EXRTN CLA,RSS SET ERROR CODE AND SKIP TO EXIT NOOPN LDA N11 NOT OPEN- EXIT -11 EXIT STA IER,I SET ERROR CODE JMP DWNDF,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 B77 OCT 77 B400 OCT 400 N11 DEC -11 SPC 3 DISC LDB DCB SET UP AND JSB R/W$ WRITE THE BLOCK IF NECESSARY JMP EXIT IF ERROR EXIT SPC 1 LDB DCB DISC FILE-CALL CLA RWND$ JSB RWND$ TO SET UP DCB JMP EXIT ERROR RETURN JMP EXRTN NORMAL RETURN SPC 2 * POST CONSTANT AREA SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ]ï ÿÿ ÿý  ÿ92064-18187 1650 S C0122 &APOSN RTE-M FLPY ABS POSN SUB             H0101 ú`þúASMB,R,L,C * NAME: APOSN * SOURCE: 92064-18187 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM APOSN,7 92064-16059 REV.1650 761021 * HED APOSN ENT APOSN EXT $KIP,NX$EC,RFLG$,.ENTR,LOCF SPC 1 * THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING * OF RTE FILES * * CALLING SEQUENCE: * * CALL APOSN(IDCB,IERR,IREC,IRS,IOFF) SPC 1 * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK * * IERR IS AN ERROR RETURN FLAG. POSSIBLE ERRORS, * 0 NO ERROR * -1 DISC DOWN * -5 SPACING BEYOND END OF DEFINED EXTENT * -9 ATTEMPT TO POSITION TYPE ZERO FILE * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 SOF IE IREC <1 * * IREC THE RECORD NUMBER TO BE READ NEXT * * IRS (REQUIRED FOR 3 & ABOVE ONLY) THE * RELATIVE BLOCK OF THE NEXT RECORD * * * IOFF THE BLOCK OFFSET OF THE NEXT * RECORD (REQUIRED FOR TYPE 3 AND * ABOVE ONLY) * SPC 5 * PRE CONSTANT STORAGE SPC 2 TYPE NOP .2 DEC 2 .5 DEC 5 N11 DEC -11 N3 DEC -3 RC EQU TYPE SPC 5 APOSN NOP CLA PRE-SET CALL PARMS STA IRC STA IOFF LDA APOSN STA DPOSN MOVE ENTRY ADDRESS TO DUMMY ENTRY POINT. JMP DPOSN+1 GO FETCH CALL PARMS * DCB NOP ER NOP IRC NOP IRS NOP IOFF NOP SPC 1 DPOSN NOP ENTRY POHþúINT JSB .ENTR FETCH PRAM DEF DCB ADDRESSES SPC 1 CLB,INB SET THE READ STB RFLG$ FLAG LDB DCB COMPUTE ADB .2 TYPE STB TYPE AND ADB .5 STEP TO BLOCK LENGTH LDA B,I FETCH ARS,ALR AND ALF,ALF CONVERT RAL TONUMBER OF 128 WORD BLOCKS STA BLKSZ SAVE ADB .2 STEP TO OPEN FLAG LDA N11 IS LDB B,I DCB CPB XEQT OPEN? INA,RSS YES; SKIP JMP EXIT NO; EXIT INA SET A= 9 LDB TYPE,I IS FILE TYPE SZB,RSS ZERO? JMP EXIT YES; EXIT ADB N3 IF TYPE 1 OR 2 LDA IRC TEST FOR RECORD PRAM SSB,RSS ELSE TEST LDA IOFF FOR FULL PRAM SZA,RSS LIST JMP ER10 NOT ENOUGH PRAMS - EXIT SSB IF 1 OR 2 JMP RCSET GO SET RECORD NO. SPC 1 JSB LOCF USE LOCF TO DEF LOCRT GET DEF DCB,I CURRENT DEF ER,I RELATIVE DEF RC SECTOR DEF CIRS ADDRESS LOCRT CLB CALL LDA DCB SKIP JSB $KIP TO JMP EXIT SET UP NX$EC CLB CACULATE LDA CIRS THE RELATIVE DIV BLKSZ BLOCK CMA,INA NUMBER STA CIRS CLB LDA IRS,I DESIRED DIV BLKSZ AND SWP SET FOR ADB CIRS NS$EC CALL SZB,RSS IF ALREADY THERE JMP RCSET SKIP POSITION CALL JSB NX$EC POSITION WITH NX$EC JMP EXIT ERROR - EXIT RCSET RRL 7 LDB DCB GET DCB ADB .12 COMPUTE BUFFER POINTER ADDRESS STB CIRS ADB IOFF,I COMPUTE DESIREDED ADB .4 CONTENTS ADB A ADD THE NO OF 128 WORD BLOCKS STB CIRS,I AND SET u‹ ISZ CIRS STEP TO THE ISZ CIRS RECORD NUMBER LDB IRC,I SET RECORD NUMBER SZB ZERO SSB OR NEG JMP ER12 EXIT ERROR STB CIRS,I SET THE RECORD NUMBER CLA,RSS OK - EXIT ER10 LDA N10 EXIT STA ER,I SET ERROR CODE JMP DPOSN,I RETURN. SPC 2 ER12 LDA N12 SEND EOF ERROR JMP EXIT SPC 2 * POST CONSTANTS SPC 1 N12 DEC -12 .4 DEC 4 .12 DEC 12 N10 DEC -10 BLKSZ NOP CIRS NOP SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ”Îÿÿ ÿý  ÿ92064-18188 1650 S C0122 &LOCFF RTE-M FLPY LOCF SUB             H0101 ÂïþúASMB,R,L,C * NAME: LOCF * SOURCE: 92064-18188 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LOCF,7 92064-16059 REV.1650 760819 * HED LOCF ENT LOCF EXT P.PAS,.ENTR SPC 2 * * * LOCF RETURNS THE CURRENT STATUS OF A * RTE FILE TO THE CALLER. * SPC 1 * * THE FORTRAN CALLING SEQUENCE IS: * SPC 1 * CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) * SPC 1 * * W H E R E: * SPC 1 * IDCB IS THE DATA CONTROL BLOCK FOR THE FILE. * * IERR IS THE ERROR CODE RETURN. * POSSIBLE CODES ARE: * 0 - NO ERROR * -11 - DCB NOT OPEN * -10 - NOT ENOUGH PARAMETERS * * IREC IS THE RECORD NUMBER OF THE NEXT RECORD. * * IRS IS THE RELATIVE SECTOR OF THE NEXT RECORD./2 * * IOFF IS THE OFFSET IN THE SECTOR OF THE NEXT RECORD. * * JSEC IS THE NO. OF SECTORS IN THE FILE (OR EXTENT). * * JLU IS THE FILE'S LOGICAL UNIT. * * JTY IS THE FILE'S TYPE. * * JREC IS THE RECORD SIZE. * SPC 1 * ALL PARAMETERS AFTER IREC ARE OPTIONAL. * SKP LOCF NOP LDA DFDM STA IER STA IREC STA IRS STA IOFF STA JSEC STA JLU STA JTY STA JREC * LDA LOCF STA DOCF JMP DOCF+1 * SPC 5 DCB NOP IER DEF DM IREC DEF DM IRS DEF DM IOFF DEF DM JSEC DEF DM JLU DEF DM JTY DEF DM JREC DEF DM `þúDOCF NOP ENTRY JSB .ENTR GET DFDCB DEF DCB PARAMETERS ADDRESSES LDA N10 NOT ENOUGH LDB IREC PRAM CPB DFDM TEST JMP EXIT NOT ENOUGH - EXIT LDA DCB SET A TO GET DCB CLB,CCE SET TO GET ERB,CLE ACTUAL WORDS JSB P.PAS CALL TO PASS N16 DEC -16 DCB LU NOP PARAMETERS AD NOP TYP NOP TRK NOP SEC NOP #SEC NOP SIZE NOP COUNT NOP SEC/T NOP OPCLS NOP CTRK NOP CSEC NOP BUFPT NOP TMP NOP REC NOP EXNO NOP LDB OPCLS IS LDA N11 FILE CPB XEQT OPEN? JMP OK YES; JUMP EXIT STA IER,I NO; SET EXIT CODE JMP DOCF,I EXIT SPC 3 OK LDB REC GET AND STB IREC,I SET RECORD NO. LDB #SEC SET STB JSEC,I THE FILE SIZE IN SECTORS LDA TYP GET THE TYPE CMA,INA,SZA,RSS SET NET AND TEST FOR ZERO JMP TYPST ZERO SO JUMP ADA .2 IF THREE OR GREATER SSA THEN JMP NOTRA JUMP NOT RANDOM ACCESS CCA COMPUTE THE OFFSET ADA REC AND BLOCK MPY SIZE FOR STA TMP TYPE AND B177 ONE AND STA IOFF,I TWO XOR TMP FILES ASR 7 NOW JMP STRS GO STORE IT NOTRA LDA DCB COMPUTE CMA,INA CURRENT ADA BUFPT BUFFER OFFSET ADA N16 ADJUST FOR BUFFER ADDRESS CLB RE ADDJUST OFFSET TO DIV .128 128 WORD BLOCK BASE STB IOFF,I STA TMP SAVE OVERFLOW LDA #SEC GET AND CLE,ERA DIVIDE BY TWO TO GET BLOCKS MPY EXNO COMPUTE EXTENT OFFSET STA EXNO AND SAVE LDA TRK COMPUTE RELATIVE CMA,INA SECTOR ADA CTRK CTRK-TRK MPY SEC/T (CTRK-TRK)*#SEC/TRACK LDB SEC CMB,INB ½ ADA B (CTRK-TRK)*#S/TR-SEC ADA CSEC (CTRK-TRK)*#S/TR-SEC+CSEC CLE,ERA CONVERT TO BLOCKS ADA EXNO ADD #BLOCKS IN PREVIOUS EXTENTS ADA TMP ADD THE BLOCK OVER FLOW STRS STA IRS,I AND PASS TO CALLER TYPST LDB TYP GET AND SET STB JTY,I TYPE LDA LU GET LU (DISC FILE) SZB,RSS IS IT A DISC FILE? LDA TRK NO; USE TYPE 0 LU AND B77 MASK STA JLU,I AND SET LDA SIZE GET THE RECORD STA JREC,I SIZE AND SET IT CLA NO ERRORS JMP EXIT RETURN SPC 4 B177 OCT 177 .128 DEC 128 .2 DEC 2 N10 DEC -10 N11 DEC -11 N9 DEC -9 B77 OCT 77 DFDM DEF *+1 DM NOP A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END mýÿÿ ÿý  ÿ92064-18189 1650 S C0122 &FCONF RTE-M FLPY FCONT SUB             H0101 œOþúASMB,R,L,C * NAME: FCONT * SOURCE: 92064-18189 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FCONT,7 92064-16059 REV.1650 761024 * HED FCONT ENT FCONT EXT .ENTR,EXEC * * THIS IS THE TYPE ZERO CONTROL ROUTINE OF * THE RTE FILE MANAGEMENT PACKAGE. * * A STANDAD RTE CONTROL REQUEST IS ISSUED * TO THE DEVICE VIA THE EXEC IF THE * PCB IS OPEN TO A TYPE ZERO FILE. * CALLING SEQUENCE * CALL FCONT(IDCB,IERR,ICON1,ICON2) * WHERE: * IDCB IS THE DATA CONTROL BLOCK FOR * THE FILE. * IERR IS THE LOCATION FOR RETURNED * ERRORS. * POSSIBLE ERRORS ARE: * 0 NO ERRORS * -11 DCB NOT OPEN * -12 EOF SENSED * >0 NOT A TYPE ZERO FILE (IERR=TYPE) * ICON1 IS CONTROL WORD #1 - THE DEVICE * LU IS MURGED INTO THE LOW * 6 BITS OF THIS WORD * ICON2 IS CONTROL WORD TWO - OPTIONAL * ZERO IS USED IF NOT SPECIFIED * ON RETURN A = IERR * B = DEVICE STATUS SPC 3 * PRE CONSTANT AREA .2 OCT 2 .3 OCT 3 TYPE NOP .7 OCT 7 N10 DEC -10 SPC 3 FCONT NOP LDB DZERO STB IDCB PRE-SET STB IERR STB ICON1 CALL STB ICON2 PARMS CLB STB ZERO LDA FCONT STA DCONT MOVE PARM ADDRESS TO DUMMY ENTRY JMP DCONT+1 * * IDCB DEF ZERO ßqþú PARAMETER IERR DEF ZERO ADDRESS ICON1 DEF ZERO AREA ICON2 DEF ZERO SPC 1 DCONT NOP ENTRY POINT JSB .ENTR FETCH PARAMETERS DEF IDCB * LDA N10 FETCH ERROR CODE LDB ICON1 FOR NOT ENOUGH PARMS CPB DZERO OK????? JMP EXIT NOPE--GET OUT * LDB IDCB GET DCB ADB .2 ADDRESS STB TYPE OF TYPE ADB .7 AND LDB B,I OPEN FLAG CPB XEQT OPEN? JMP OK YES, CONTINUE LDA N11 NO; SEND NOT OPEN ERROR EXIT STA IERR,I TO CALLER LDB DZERO RESET X REP 4 ENTRY STB *-X+IDCB ADDRESS CLB CLEAR DUMMY STB ZERO ZERO LDB STAT STATUS TO B AND JMP DCONT,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 N11 DEC -11 DZERO DEF ZERO ZERO NOP STAT NOP SPC 1 B77 OCT 77 SPC 3 OK LDA TYPE,I GET FILE TYPE SZA ZERO? JMP EXIT NO; EXIT : TYPE IN A SPC 1 ISZ TYPE YES; STEP TO WORD WITH LU LDA TYPE,I GET LU AND B77 AND ISOLATE THEN STA B SAVE LDA ICON1,I GET THE FUNCTION AND B1777 MAKE SURE THE LOW END IS ZERO IOR B PUT THEM TOGETHER STA ICON1 SET FOR CALL JSB EXEC CALL EXEC TO DEF EXRTN DO DEF .3 THE DEF ICON1 CONTROL DEF ICON2,I FUNCTION EXRTN STA STAT SAVE STATUS FOR RETURN AND B200 MASK EOF BIT SZA EOF ? LDA N12 YES; SEND EOF CONDITION JMP EXIT GO; EXIT SPC 3 * POST CONSTANT AREA SPC 1 B1777 OCT 177700 B200 OCT 200 N12 DEC -12 SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END [å ÿÿ ÿý  ÿ92064-18190 1650 S C0122 &IDCBF RTE-M FLPY IDCBS SUB             H0101 }=ASMB,R,L,C * NAME: IDCBS * SOURCE: 92064-18190 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCBS,7 92064-16059 REV.1650 750609 * HED IDCBS EXT .ENTR ENT IDCBS * IDCB NOP IDCBS NOP JSB .ENTR FETCH PARAM ADDR DEF IDCB LDB IDCB ADB D9 GET THE OPEN FLAG LDA B,I FROM WORD 9 OF THE DCB CPA XEQT IS THIS FILE OPENED? JMP OPEND YES LDA MD11 NO, ERROR -11 JMP EXIT * OPEND ADB MD7 BACK UP TO WORD 2 LDA B,I CPA D1 FILE TYPE 1? CLA OR 0? SZA,RSS YES, SET BUFFER SIZE=0 * JMP RTNOK * NOT12 ADB D5 ADVANCE TO WORD 7 LDA B,I GET SIZE WORD ARS,ALR BUT CLEAR BITS 0 AND 15 RTNOK ADA D16 ADD 16 TO BUFFER SIZE EXIT JMP IDCBS,I RETURN DCB SIZE IN A * A EQU 0 B EQU 1 XEQT EQU 1717B D1 DEC 1 D2 DEC 2 D5 DEC 5 D9 DEC 9 D16 DEC 16 MD11 DEC -11 MD7 DEC -7 * END ¥ÿÿ ÿý ÿ92064-18191 1650 S C0122 &$OPEN RTE-M FLPY $OPEN UTILITY             H0101 ù{þúASMB,L * NAME: $OPEN * SOURCE: 92064-18191 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $OPEN,7 92064-16059 REV.1650 740801 * HED $OPEN EXT EXEC EXT RWND$ ENT $OPEN SUP * * $OPEN IS A ROUTINE OF THE RTE FILE MANAGEMENT PACKAGE. * * $OPEN IS CALLLED BY OPEN AND CREAT TO SET UP THE * DCB. IT READS THE DIRECTORY INFORMATION * AND TRANSFERS THE INFORMATION FROM THERE * TO THE DCB. IT ALSO INITIALIZES THE REST * OF THE DCB. * * CALLING SEQUENCE: * (IT IS ASSUMED THAT WORDS 1 & 2 OF THE DCB ARE SET UP.) * * A = DCB ADDRESS * B = SECURITY CODE (EXPECTED) * E = 1 IF TYPE 1 OVERRIDE * O = 1 IF AN UPDATE OPEN * * JSB $OPEN * DEF IBLK DEF OF LENGTH OF DCB OR ZERO * DEF #SECT DEF OF WORD CONTAINING #SEC/TRACK * IN THE HIGH HALF (PASSED FROM D.RTR) * JMP ERR ERROR RETURN * NORMAL RETURN * ON A NORMAL RETURN: * A = FILE SECURITY CODE * B = SECURITY CODE/UPDATE FLAG * * ON AN ERROR RETURN, EITHER * A = -1 DISC ERROR OR * A = -9 TYPE ZERO OVERRIDE ERROR * IN EITHER CASE THE DCB IS NOT SET UP. * * $OPEN NOP ENTRY STB SC SAVE THE SECURITY CODE SSB IF NEGATIVE CMB,INB SET POS STB SC2 AND SAVE STA DCB AND THE DCB ADDRESS STA DCB2 LDA A,I GET THE DIRECTORY AND B77 ADDRESS STA LU Ùþú AND SET XOR DCB,I TO ALF,ALF READ RAL,RAL THE STA TRACK DIRECTORY ISZ DCB BLOCK LDA DCB,I GET THE SECTOR AND B377 MASK STA SECT AND XOR DCB,I SET ALF,ALF GET THE LDB DCB OFFSET ADB .4 AND SIZE STB SIZE ADB .11 AND STB BUF COMPUTE BUFFER ADDRESS ADB .3 AND ADB A OFFSET STB PRMA TO ISZ DCB THE PRAMS CLB,SEZ,INB IF TYPE 1 OVERRIDE STB DCB,I SET TYPE SEZ AND CCB THE STB TPFLG OVERRIDE SKIP FLAG JSB EXEC READ DEF RTN THE DEF .1 BLOCK DEF LU TO BUF NOP THE DEF .128 DCB DEF TRACK DEF SECT RTN CCA SET A FOR DISC ERROR CPB .128 DISC ERROR? CLB,RSS NO SKIP JMP EREX EXIT - ERROR ADA BUF COMPUTE THE EXTENT ADDRESS STB A,I AND SET THE EXTENT TO ZERO LDA N9 LDB PRMA,I GET FILE TYPE SZB,RSS IF ZERO ISZ TPFLG AND OVERRIDE FLAG SET RSS JMP EREX EXIT - ERROR SPC 1 LDB N5 OF - SET TO MOVE 5 NXT LDA PRMA,I PARAMETERS ISZ TPFLG IF OVERRIDE SET SKIP STA DCB,I SET PARAMETER ISZ DCB STEP ADDRESS ISZ PRMA STEP SOURCE INB,SZB AND COUNT - DONE? JMP NXT NO; DO NEXT ONE LDA PRMA,I CLE,SZA CPA SC CCE MATCH SO SET E CPA SC2 MATCH WITH POS OF NEG CCE YES SO SET E ERB MATCH - SET FLAG SOC SET UPDATE INB FLAG STB SC SAVE SECæ„þúURITY CODE LDA $OPEN,I GET THE SIZE IN WORDS LDB A,I TO THE B REG LSR 7 DIVIDE BY 128 TO GET BLOCKS SZB,RSS IF ZERO THEN INB USE ONE BLS CONVERT TO SECTORS NXBUF STB TPFLG SAVE IT LDA SIZE,I GET THE FILE SIZE CLB DIV TPFLG DIVIDE TO GET N SZB,RSS IF NO REMAINDER JMP BFOK THEN THE SIZE IS OK LDB N2 ELSE TRY ONE SMALLER ADB TPFLG THAN THE CURRENT JMP NXBUF ONE BFOK LDA TPFLG GET THE BUFFER SIZE LSL 6 CONVERT SECTORS TO WORDS ADA SC ADD THE SECURTITY CODE AND UPDATE FLAG STA DCB,I SET IN DCB ISZ $OPEN STEP TO NEXT PRAM ISZ DCB SET NUMBER OF SECTORS / TRACK ADD LDB $OPEN,I GET THE WORD LDB B,I FROM THE CALL LSR 8 SET TO LOW B STB DCB,I PUT IT IN THE DCB ISZ $OPEN STEP RETURN ADDRESS CLA OPEN EXTENT ZERO LDB DCB2 GET THE DCB ADDRESS JSB RWND$ SET REST OF DCB JMP $OPEN,I ERROR EXIT ADB N2 SET B TO THE RECORD NO ADDRESS CLA,INA SET THE RECORD NO STA B,I TO 1. ISZ DCB STEP TO THE OPEN FLAG ADDRESS LDA XEQT GET THE CURRENT ID ADDRESS STA DCB,I SET THE OPEN FLAG LDA PRMA,I RESTORE SECURITY CODE LDB SC AND MATCH - UPDATE FLAG RSS EREX ISZ $OPEN STEP TO ERROR RETURN ISZ $OPEN STEP AND JMP $OPEN,I AND RETURN SPC 3 SIZE NOP SC2 NOP SC NOP DCB NOP DCB2 NOP LU NOP TRACK NOP B77 OCT 77 B377 OCT 377 SECT NOP N9 DEC -9 .4 DEC 4 .11 DEC 11 .3 DEC 3 PRMA NOP TPFLG NOP .1 DEC 1 .128 DEC 128 N5 DEC -5 N2 OCT -2 SPC 2 XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END ÿÿ ÿý ÿ92064-18192 1650 S C0122 $RW$UB RTE-M FLPY DISK UTILITY             H0101 N(þúASMB,L,R,C * NAME: RW$UB * SOURCE: 92064-18192 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RW$UB,7 92064-16059 REV.1650 750422 * HED RW$UB * * RW$UB READS AND WRITES A WORD OR BLOCK OF WORDS ON A RTE FILE * CALLING SEQUENCE: * SET E=1 FOR READ * E=0 FOR WRITE * LDA DCB SET A TO DCB ADDRESS * LDB COUNT SET B TO THE NO OF WORDS TO BE XFERED * JSB RW$SUB CALL * DEF BUF BUFFER CONTAING (WRITE) OR RECIEVING (READ) * JMP ERROR ERROR RETURN CODE IN A * --- NORMAL RETURN * EXT RWND$,R/W$ EXT EXEC,P.PAS EXT RFLG$ ENT RW$UB,NX$EC ENT $KIP RW$UB NOP ENTRY CMB,INB,SZB,RSS SET NEGATIVE SKIP IF NOT ZERO JMP ZER0 ZERO GO RETURN STB COUNT NEGATIVE CLB,SEZ,RSS COUNTER LDB RSS SET READ/WRITE SWITCH STB NEXTW RSS IF WRITE, ELSE NOP JSB PRAM GO GET THE PRAMETERS ADA B CALCULATE CMA,INA THE # ADA BUFPT,I OF REMAINING STA LEFT WORDS AND SET LDB BUFPT,I GET THE POINTER TO B LDA RW$UB GET USER BUFFER LDA A,I GET ADDRESS RAL,CLE,SLA,ERA IF INDIRECT JMP *-2 TRY AGAIN ISZ RW$UB STEP RETURN STA PTR SET USER POINTER NEXTW RSS OR NOP IF WRIT JMP READ DO READ THING LDA PTR,I WRITE; GET WORD STA B,I SET IT IN DCB RDW ISZ PTR STEP POINTER INB STEP DCB ADDRESS q]þú ISZ LEFT ANY ROOM LEFT? RSS RSS YES; SKIP JMP ENDBL NO; GO WRITE IT OUT CONT ISZ COUNT STEP WORD COUNT-DONE? JMP NEXTW NO; DO NEXT WORD STB BUFPT,I RESET THE BUFFER POINTER LDB NEXTW IF WRITE SZB THEN STB FLAG,I SET THE WRITTEN ON FLAG EX ISZ RW$UB YES; STEP THE RETURN ADDRESS JMP RW$UB,I RETURN SPC 2 ZER0 ISZ RW$UB STEP FOR GOOD RETURN JMP EX EXIT SPC 2 ENDBL LDB TYPE,I IF TYPE TWO CPB .2 THEN LDB COUNT IF COUNT IS INB,SZB,RSS EXAUSTED JMP CONT JUST CONTINUE LDB NEXTW GET THE READ WRITE FLAG SZB IF WRITE THEN STB FLAG,I SET THE BIT IN THE DCB CLB,INB SET FOR NEXT BLOCK JSB NX$EC GO GET IT JMP RW$UB,I ERROR - RETURN LDB BLKLN OK - CMB,INB RESET STB LEFT LEFT COUNTER LDB BUFA AND BUFFER POINTER JMP CONT AND CONTINUE SPC 1 READ LDA B,I GET THE WORD STA PTR,I SET IN USER BUFFER JMP RDW RETURN TO WRITE CODE SPC 2 COUNT NOP BUFA NOP SPC 2 $KIP NOP SKIP ENTRY STB COUNT SAVE THE WORD COUNT JSB PRAM GO SET THE PRAMS CMA,INA COMPUTE THE BUFFER ADA BUFPT,I OFFSET ADA COUNT ADD THE COUNT STA B SET UP FOR DIVID ASR 16 EXTENT THE SIGN DIV BLKLN DIVIDE BY BLOCK LENGTH SSB SKIP IF POSITIVE ADA N1 ELSE ADDJUST THE BLOCK SSB IF NEGATIVE ADB BLKLN ADJUST TO POSITIVE ADB BUFA COMPUTE THE NEW BUFFER ADDRESS SWP PUT BUFFER ADDRESS IN A BLOCK IN B SZB,RSS IF ZERO THE GO TO EXIT JMP *+3 JSB NX$EC GO GET THE BLOCK JMP $KIP,I ERROR RETURN STA BUFPT,I SET THE BUFFER ADDRESS IN THE DCB "6þú ISZ $KIP SET TO NORMAL RETURN JMP $KIP,I MAKE NORMAL RETURN SPC 1 PRAM NOP FETCH DCB ADDRESS SUBROUTINE CLB,CLE SET UP JSB P.PAS AND DEC -16 FETCH DCB NOP DCB TMP NOP TYPE NOP TR NOP SEC NOP #SEC NOP SAV NOP PTR NOP USED AS LOCAL SEC/T NOP LEFT NOP USED AS LOCAL ONLY CTRK NOP CSEC NOP BUFPT NOP FLAG NOP BLKLN NOP EXT# NOP LDB PTR,I GET THE BLOCK LENGTH WORD BRS,BLR CLEAR THE LEAST AND SIGN BITS STB BLKLN SET THE BLOCK LENGTH STA BUFA SET THE BUFFER ADDRESS JMP PRAM,I RETURN TO CALLER SKP * NX$EC COMPUTES THE ADDRESS OF THE NEXT SECTOR * FOR ALL READ/WRITE ACCESSES AND FOR * SEQUENTIAL POSITIONING. * * CALLING SEQUENCE: * * LDB RELATIVE BLOCK NO. * JSB NX$EC * DISCERR/EOF RETURN (ON EXTENDABLE FILES EODISC) * NORMAL RETURN * * NX$EC WRITES THE CURRENT SECTOR BUT DOES NOT * SET THE RELATIVE POSITION POINTERS * THE TARGET BLOCK IS READ. * IF RFLG$ IS NON 0. * * * NX$EC NOP STA SAV SAVE THE A REG LDA B CONVERT BLOCKS CLB,CLE TO MPY BLKLN SECTORS ASR 6 AND STA SECOF SAVE LDB DCB GO WRITE THE CURRENT JSB R/W$ BLOCK JMP NX$EC,I IF ERROR RETURN LDA TR,I COMPUTE THE CMA,INA RELATIVE SECTOR ADA CTRK,I ADDRESS MPY SEC/T,I IN THE FILE LDB SEC,I AND CMB,INB THEN ADB A ADD ADB CSEC,I THE ADB SECOF CHANGE ASR 16 EXTEND TO A DIV #SEC,I DIVIDE BY FILE SIZE SSB IF NEGATIVE ADA N1 REMAINDER SSB CORRECT ADB #SEC,I RESULT SZA IF DIFFERENT EXTENT JMP EXTND )S GO GET ITS ADDRESS NX$E1 ADB SEC,I COMPUTE THE NEW LSR 16 TRACK AND DIV SEC/T,I SECTOR ADA TR,I ADDRESSES STA CTRK,I AND SET THEM STB CSEC,I IN THE DCB LDA RFLG$ IF FLAG CLEARED CCE,SZA,RSS THEN DO NOT JMP NORD READ LDB DCB SET UP TO JSB R/W$ READ AND DO IT JMP NX$EC,I ERROR RETURN NORD ISZ NX$EC STEP AND LDA SAV RESTOR A JMP NX$EC,I RETURN SPC 5 EXTND STB TMP SAVE THE RELATIVE SECTOR ADA EXT#,I ADD CURRENT EXTENT NUMBER LDB TYPE,I GET THE TYPE SSA,RSS IF LESS THAN ZERO CPB .2 OR IFIF TYPE 2 THEN JMP SOF END OF FILE LDB DCB GO SET UP JSB RWND$ THE EXTENT JMP NX$EC,I ERROR RETURN LDB TMP GET THE SECTOR OFFSET JMP NX$E1 AND GO COMPUTE THE ADDRESS SOF LDA N12 ELSE EOF JMP NX$EC,I RETURN SECOF NOP SPC 2 N1 OCT -1 .2 DEC 2 N12 DEC -12 SPC 2 A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END Εÿÿ ÿý ÿ92064-18193 1650 S C0122 &R/W$ RTE-M FLPY READ/WRITE UTILITY             H0101 £yþúASMB,R,L,C * NAME: R/W$ * SOURCE: 92064-18193 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM R/W$,7 92064-16059 REV.1650 760801 * HED R/W$ EXT EXEC ENT R/W$ ENT D$XFR ENT D.R * * R/W$ WRITES THE CURRENT SECTOR BLOCK IF IT HAS * BEEN WRITTEN ON OR READS UNCONDITIONALLY. * * CALL SEQUENCE: * * SET E=0 FOR WRITE E=1 FOR READ * LDB DCB SET B TO DCB ADDRESS * JSB R/W$ * JMP DERR ERROR RETURN (A = -1) * NORMAL RETURN * R/W$ NOP STB RC SAVE THE DCB ADDRESS ADB .7 INDEX TO THE BLOCK SIZE LDA B,I FETCH THE BLOCK SIZE ARS,ALR CLEAR THE LEAST AND SIGN BITS ADB .6 INDEX TO THE WRITTEN ON FLAG STB WOFLG SAVE ITS ADDRESS ADB .3 INDEX TO THE BUFFER ADDRESS STB BUFA SET IN CALL LDB WOFLG,I GET THE WRITTEN ON FLAG SEZ,SLB,RSS IF NOT WRITTEN ON (SKIP ON READ) JMP EXIT EXIT LDB RC GET THE DCB ADDRESS JSB D$XFR DO THE TRANSFER BUFA NOP JMP R/W$,I ERROR - RETURN LDB RC GET THE REQUEST CODE CCE,SLB,RSS IF THIS IS A WRITE CALL EXIT CLA,CLE CLEAR THE IN CORE FLAGS ERA,ALS CLEAR WRITTEN ON FLAG AND SET IF READ STA WOFLG,I RESET ISZ R/W$ TAKE OK JMP R/W$,I EXIT SPC 2 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .8 DEC 8 RC NOP TRAC¢æþúK NOP AT TRACK SECT NOP AND SECTOR LU NOP WOFLG NOP B77 OCT 77 SPC 2 * DISC TRANSFER CALL SEQUENCE * * E=0 FOR WRITE * E=1 FOR READ * B= DCB ADDRESS * A= LENGTH (NO. OF WORDS) * JSB D$XFR CALL TO HERE * DEF BUFR BUFFER ADDRESS (MUST BE DIRECT) * JMP ERR ERROR RETURN (A=-1) * NORMAL RETURN SPC 2 D$XFR NOP ENTRY POINT STA LSAVE SAVE LENGTH CLA,SEZ,INA,RSS SET UP THE REQUEST CODE INA AND STA RC SET IT LDA B,I CONFIGURE THE CON WORD AND B77 * * MUST HAVE "Z" OPTION TO RUN IN RTE 2/3 SYSTEM * IFZ ADA PRC XIF * STA LU ADB .8 GET THE NUMBER OF SECTORS PER TRACK STB #SC/T ADDRESS AND SAVE IT ADB .2 GET THE TRACK ADDRESS DLD B,I AND DST TRACK SAVE IT LDA D$XFR,I GET THE BUFFER ADDRESS STA BUF SAVE IT ISZ D$XFR STEP TO ERROR RETURN ADDRESS LDA B GET THE SECTOR ADDRESS TO A CMA,INA SET NEGATIVE AND NXTR ADA #SC/T,I CACULATE NUMBER OF WORDS LEFT ON THIS ASL 6 ON THIS TRACK STA #WORD SET FOR TRANSFER CMA,INA SET MAX COUNT NEGATIVE LDB LSAVE GET REMAINING COUNT ADA B AND SUBTRACT SSA IF LESS THAN REST OF TRACK STB #WORD RESET COUNT TO RIGHT NUMBER STA LSAVE SET REMAING WORDS FOR NEXT TIME JSB EXEC CALL EXEC TO DEF ERTS DEF RC WRITE/READ DEF LU FROM THE DISC BUF NOP AT THE SPECIFIED BUFFER DEF #WORD SIZE DEF TRACK TRACK AND DEF SECT SECTOR ERTS CCA SET UP FOR ERROR EXIT CPB #WORD ERROR? CLA,RSS NO ERROR SKIP JMP D$XFR,I ERROR RETURN ADB BUF UP DATE THE BUFFER STB BUF ƒw ADDRESS STA SECT SET THE SECTOR ADDRESS FOR NEW TRACK ISZ TRACK STEP THE TRACK ADDRESS LDB LSAVE GET THE REMAINING LENGTH CMB,SSB,INB,SZB CHECK IF ANY LEFT JMP NXTR NO CONTINUE XFER ISZ D$XFR END SO JMP D$XFR,I MAKE THE NORMAL RETURN SPC 2 LSAVE NOP #SC/T NOP #WORD NOP A EQU 0 B EQU 1 UNL * IFZ * PRC OCT 74000 * XIF * LST D.R ASC 3,D.RTR SPC 1 END EQU * SPC 1 END ÿqÿÿ ÿý ÿ92064-18194 1650 S C0122 &RWND$ RTE-M FLPY READ/WRITE UTILITY             H0101 ©·þúASMB,R,L,C * NAME: RWND$ * SOURCE: 92064-18194 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RWND$,7 92064-16059 REV.1650 760629 * HED RWND$ ENT RWND$ EXT CLD.R,.P1,.P2,.P3,.P4 ENT RFLG$ * * RWND$ IS A MODULE OF THE REAL TIME FILE * MANAGEMENT PACKAGE. IT IS INVOKED * TO SET OR RESET WORDS 11 THROUGH 16 * OF THE DCB. THE RECORD COUNT IS RESET IF EXTENT 0. * * CALLING SEQUENCE: * * LDA EXTENT# SET A TO DESIRED EXTENT * LDB DCB SET B TO DCB ADDRESS * JSB RWND$ CALL * JMP ERR ERROR EXIT (A=CODE) * --- NORMAL RETURN * SPC 3 TMP NOP TMP2 NOP RWND$ NOP ENTRY POINT STA .P4 SET THE EXTENT# LDA B,I FETCH TRACK AND LU STA .P2 SAVE IT INB ADVANCE TO OFSET/SECTOR LDA B,I FETCH IT STA .P3 SAVE FOR D.R ADB .2 STB TMP ADB .12 INDEX TO EXTENT# LDA .P4 FETCH REQUESTED EXTENT# CPA B,I IF SAME - CONTINUE JMP SETUP WITH SETUP LDA RFLG$ GET READ WRITE FLAG LDB .6 GET READ EXTENT OPEN REQUEST CODE SZA,RSS IF WRITE ADB .2 ADD TWO TO GET WRITE EXTENT OPEN REQUEST STB .P1 SET IT FOR CALL TO D.RTR JSB CLD.R * SPC 1 LDA B,I YES; ANY ERRORS? SSA FROM D.RTR? JMP RWND$,I YES; RETURN SPC 1 õ   ADB .3 NO; STEP TO TRACK LDA B,I GET TRACK STA TMP,I SET IN DCB INB STEP TO SECTOR LDA B,I GET AND AND B377 MASK LDB TMP GET DCB ADDRESS INB SET STA B,I SECTOR IN DCB SETUP LDB TMP SET THE DCB FROM THE ADB .7 TRACK & SECTOR WORDS LDA TMP,I SET JSB SET TRACK ISZ TMP AND LDA TMP,I SECTOR JSB SET WORDS. LDA B SET THE ADA .4 BUFFER JSB SET ADDRESS. CLA CLEAR THE READ/ JSB SET WRITE FLAGS LDA .P4 GET EXTENT# INB SKIP JSB SET SET THE EXTENT # ISZ RWND$ STEP JMP RWND$,I AND RETURN SPC 3 SET NOP STA B,I SET THE WORD IN THE DCB INB STEP DCB ADDRESS JMP SET,I RETURN SPC 3 .2 OCT 2 .3 OCT 3 .4 OCT 4 .7 OCT 7 .6 DEC 6 .12 DEC 12 .9 DEC 9 B377 OCT 377 RFLG$ NOP GLOBAL READ WRITE FLAG XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END  ÿÿ ÿý ÿ92064-18195 1650 S C0122 &PPASF RTE-M FLPY PARM PASS SUB             H0101 yþúASMB,R,L,Z,C * NAME: P.PAS * SOURCE: 92064-18195 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM P.PAS,7 92064-16059 REV.1650 740801 ENT P.PAS * HED P.PAS * P.PAS IS USED TO SET UP ADDRESS OR TO MOVE * INFORMATION FROM THE CALL AREA * * CALLING SEQUENCE: * * E=0 SET UP CALL AREA * E=1 MOVE FROM CALL AREA * B=0 SET ADDRESSES ONLY * B=100000 MOVE PARAMETERS * A = ADDRESS OF OTHER AREA OR FIRST ADDRESS * * JSB P.PAS * DEC -N N= NO. OF WORDS TO BE SET UP * BSS N CALL AREA BUFFER * IF B IS 0, THIS WILL BE A * LIST OF ADDRESSES; IF B=100000, * THIS WILL BE THE WORDS AT THE * ADDRESS PROVIDED IN A. * * P.PAS NOP ADB LOAD CONFIGURE THE LOAD STB NEXT AND SET IT LDB P.PAS,I GET THE COUNT STB COUNT AND SET ISZ P.PAS STEP TO PRAM AREA LDB P.PAS ADDRESS TO B SEZ IF FROM SWP SWAP ADDRESSES STB DEST SAVE THE DESTINATION ADDRESS NEXT LDB A GET ADDRESS OR IF LDB A,I STB DEST,I A WORD - SET IF ISZ DEST STEP DESTINATION INA STEP FROM ISZ COUNT STEP COUNT - DONE? JMP NEXT NO; GET NEXT ONE SEZ YES; EXIT TO JMP A,I END OF CALL JMP DEST,I SEQUENCE SPC 5 COUNT NOP DEST NOP LOAD LDB A TEST NOP SPC 2 A EQU 0 B EQá  U 1 END EQU * END æ1 ÿÿ ÿý ÿ92064-18196 1650 S C0122 &FDCB0 RTE-M FLPY LIBR DCB1             H0101 ¨ÒASMB,R,L * NAME: IDCB0 * SOURCE: 92064-18196 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB0,7 92064-16059 REV.1650 761215 * ENT IDCB0 IDCB0 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END !Œÿÿ ÿý ÿ92064-18197 1650 S C0122 &FDCB1 RTE-M FLPY LIBR DCB             H0101 ©ÂASMB,R,L * NAME: IDCB1 * SOURCE: 92064-18197 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB1,7 92064-16059 REV.1650 761214 * ENT IDCB1 IDCB1 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END &‹ÿÿ ÿý ÿ92064-18198 1650 S C0122 &FDCB2 RTE-M FLPY LIBR DCB             H0101 ªÃASMB,R,L * NAME: IDCB2 * SOURCE: 92064-18198 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB2,7 92064-16059 REV.1650 761214 * ENT IDCB2 IDCB2 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END +‹ÿÿ ÿý ÿ92064-18199 1650 S C0122 &FDCB3 RTE-M FLPY LIBR DCB             H0101 «ÄASMB,R,L * NAME: IDCB3 * SOURCE: 92064-18199 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB3,7 92064-16059 REV.1650 761214 * ENT IDCB3 IDCB3 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 0‹ÿÿ ÿý ÿ92064-18200 1650 S C0122 &FDCB4 RTE-M FLPY LIBR DCB             H0101 £¼ASMB,R,L * NAME: IDCB4 * SOURCE: 92064-18200 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB4,7 92064-16059 REV.1650 761214 * ENT IDCB4 IDCB4 NOP 143 OF THESE FOLOWW UNL REP 143 NOP LST END /Šÿÿ ÿý ÿ92064-18201 1650 S C0122 &FDCB5 RTE-M FLPY LIBR DCB             H0101 ¤½ASMB,R,L * NAME: IDCB5 * SOURCE: 92064-18201 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB5,7 92064-16059 REV.1650 761214 * ENT IDCB5 IDCB5 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 1‚ÿÿ ÿý ÿ92064-18202 1650 S C0122 &FDCB6 RTE-M FLPY LIBR DCB             H0101 ¥¾ASMB,R,L * NAME: IDCB6 * SOURCE: 92064-18202 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB6,7 92064-16059 REV.1650 761214 * ENT IDCB6 IDCB6 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 6‚ÿÿ ÿý ÿ92064-18203 1650 S C0122 &FDCB7 RTE-M FLPY LIBR DCB             H0101 ¦¿ASMB,R,L * NAME: IDCB7 * SOURCE: 92064-18203 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB7,7 92064-16059 REV.1650 761214 * ENT IDCB7 IDCB7 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END ;‚ÿÿ ÿý! ÿ92064-18204 1650 S C0122 &FDCB8 RTE-M FLPY LIBR DCB             H0101 §ÀASMB,R,L * NAME: IDCB8 * SOURCE: 92064-18204 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB8,7 92064-16059 REV.1650 761214 * ENT IDCB8 IDCB8 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END @‚ÿÿ ÿý" ÿ92064-18205 1650 S C0122 &FDCB9 RTE-M FLPY LIBR DCB             H0101 ¨ÁASMB,R,L * NAME: IDCB9 * SOURCE: 92064-18205 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB9,7 92064-16059 REV.1650 761214 * ENT IDCB9 IDCB9 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END E‚ÿÿ ÿý# ÿ92064-18207 1913 S 0122 &MSYLB RTE-M SYSTEM LIBRARY             H0101 ASMB,L * NAME: MSYLB * SOURCE: 92064-18207 * RELOC: 92064-16081 * PGMR: H.C. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MSYLB 92064-16081 REV.1913 790126 END ˆkÿÿ ÿý$ ÿ92064-18208 1901 S C0122 &MALRN RESOURCE NUMBER SUBR             H0101 "þúASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: MALRN * SOURCE: 92064-18208 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MALRN,6 92064-16081 REV.1901 780719 * EXT $RNTB,$ERAB,$LIST,$XEQ ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD SUP A EQU 0 B EQU 1 * * $ALRN THIS ROUTINE ALLOCATES AN RN IF POSSIBLE * TO THE USER WHOSE ID SEGMENT ADDRESS IS * AT XEQT. * * OPTIONS/CALLING SEQUENCE: * * < IDNO MUST BE USER ID SEG # OR 377 IF GLOBAL * LDB =B1 TO ALLOCATE FROM BOTTOM OF THE RN TABLE * LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE * * JSB $ALRN * * < RETURN A=RN WORD (USER FORMAT) IF SUCESSFUL * A=0 IF NO RN'S AVAILABLE NOW * RQP6 IS SET TO RN ADDRESS IN RN TABLE * * * * $ALRN NOP STB TEMP4 SAVE THE INCREMENT LDA $RNTB GET THE LENGTH OF THE RN TABLE CMA,INA SET NEGATIVE. * STA TEMP2 SET THE COUNT LDA D$RN GET THE RN TABLE ADDRESS JSB $DRAD MAKE INTO DIRECT ADDR STA D$RN SAVE FOR LATER SSB,RSS IF BOTTOM UP INA,RSS SET TO FIRST WORD ADA $RNTB ELSE SET TO LAST WORD * ALRN1 LDB A,I SEARCH FOR SZB,RSS AN AVAILABLE JMP ALRN2 SLOT. FOUND * ADA TEMP4 STEP THE ADDRESS ISZ TEMP2 SKIP IF END JMP ALRN1 ELSE TRY NEXT ONE * CLA N–žþúO RN'S AVAILABLE NOW STA RNADR JMP $ALRN,I SO EXIT WITH A=0 * ALRN2 STA RNADR SAVE LOCATION CMA,INA SET TO CACULATE RN NUMBER * LDB IDNO GET THE USER ID NUMBER BLF,BLF ROTATE TO HIGH HALF STB RNADR,I SET THE ASSIGNMENT IN THE TABLE ADA D$RN COMPUTE RN NUMBER CMA,INA SET POSTIVE ADA B ADD THE USER ID FLAG JMP $ALRN,I RETURN * * $RNSU LDB RQOP GET NO-WAIT OPTION FLAG SSB IF NO WAIT JMP EXRNW THEN EXIT * $LUSU STA XTEMP,I SET THE SUSPEND FLAG JSB $LIST AND PUT THE PROG IN LIST OCT 503 NUMBER 3. JMP $XEQ GO THE THE DISPATCHER * EXRNW LDB D5 ENTRY FOR 6/7 RETURN $RNEX LDA RNADR TEST THE RN LOCATION ADDRESS CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP LDB D4 NO RN STATUS LDA RNADR,I GET THE RN SEZ,SZA,RSS SKIP IF ALLOCATE PROBLEMS CLB ELSE SET DEALLOCATED FLAG IF RN IS ZERO AND B377 MASK TO LOCK BITS SZA IF LOCKED INB STEP B TO SO INDICATE CPA B377 IF GLOBAL INB STEP AGAIN STB RQST,I SET THE STATUS WORD $LUEX LDB XEQT SET THE RN BIT IN HIS ADB D20 ID-SEGMENT LDA B,I IOR B400 STA B,I LDA RQRTN PUSH UP HIS STA XSUSP,I RETURN ADDRESS JMP $XEQ ** GO TO THE DISPATCHER ** * * * $DRAD NOP ADDR IS GIVEN IN A RSS GET DIRECT ADDRESS LDA A,I IF NOT ALREADY RAL,CLE,SLA,ERA JMP *-2 JMP $DRAD,I RETURN DIRECT ADDR IN A D$RN DEF $RNTB * * D5 DEC 5 D4 DEC 4 D20 DEC 20 B377 OCT 377 B400 OCT 400 TEMP2 NOP TEMP4 NOP * RQOP EQU 1701B RQP2 IS RN/LU REQUEST CODE RQNO EQU 1702B RQP3 IS ADDR OF RN/LU NUMBER RQST EQU 1703B RQP4 IS ADDR OF RN/LU STATUS IDNO EQU 1704B =$ RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS ADDR OF RN IN RN TABLE RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B * ORG * PROGRAM LENGTH END ÿÿ ÿý' ÿ92064-18209 1709 S C0122 &MRNRQ RESOURCE NUMBER ALLOC             H0101 D!þúASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: MRNRQ * SOURCE: 92064-18209 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MRNRQ,6 92064-16081 REV.1709 741120 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$DRAD EXT $ALRN,$LIBR,$PVCN,$RNSU,$RNEX ENT RNRQ * SUP A EQU 0 B EQU 1 * * * * RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER * CALLS THAT CAN ALLOCATE, DEALLOCATE * SET AND CLEAR THE RN. IF A RN REQUEST CAN NOT * BE GRANTED BECAUSE OF NONE AVAILABLE OR * CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS * SUSPENDED UNTIL THE RN BECOMES AVAILABLE * * THE EXEC CALL IS: * * EXT RNRQ * * JSB RNRQ * DEF *+4 * DEF OPTION OPTION ADDRESS * DEF RN RN NUMBER ADDRESS/RETURN * DEF STAT RN STATUS RETURN ADDRESS * * * WHERE: * OPTIN BSS 1 OPTION WORD * RN BSS 1 RN WORD * STAT BSS 1 RN STATUS * * THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE * REQUEST AS FOLLOWS: * * BIT MEANING IF SET * BIT 0 SET THE RN LOCALLY * BIT 1 SET THE RN GLOBALLY * BIT 2 CLEAR THE RN * BIT 3 ALLOCATE AN RN LOCALLY * BIT 4 ALLOCATE AN RN GLOBALLY * BIT 5 DEALLOCATE THE RN * BIT 14 DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B * BIT 15 RETURN EVEN IF REQUEST NOT GRANTED * * A LOCALLY ALÂPþúLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR * A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER * GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY * ANY PROGRAM. * * IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING * PRESEDENCE IS FOLLOWED: * * 1) LOCAL ALLOCATE (SKIP 2 IF DONE) * 2) GLOBAL ALLOCATE * 3) DEALLOCATE * 4) LOCAL SET (SKIP 5 IF DONE) * 5) GLOBAL SET * 6) CLEAR * * THIS IMPLIES THAT RN MAY BE ALLOCATED,SET,AND CLEARED IN * THE SAME REQUEST. * A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. * THERE ARE TWO RN CODE WORDS: * A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER * REQUESTS). * B) THE RN TABLE CODE WORD. * * THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) * AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS * * THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER * IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF * THE WORD. * * GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 * AVAILABLE/UNLOCKED IS CODED AS 0. * * RN STATUS IS AS FOLLOWS: * * VALUE MEANING * 0 NORMAL DEALLOCATE RETURN * 1 RN IS CLEAR (UNLOCKED) * 2 RN IS LOCKED LOCALLY TO CALLER * 3 RN IS LOCKED GLOBALLY * 4 NO RN AVAILABLE NOW * 5 NOT DEFINED * 6 RN IS LOCKED LOCALLY TO OTHER PROGRAM * 7 RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE. * * STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED * AND THE NO WAIT BIT WAS SET * * POSSIBLE ERRORS FROM THIS CODE ARE: * * ERROR MEANING * * RN00 NO BITS SET IN THE OPTION WORD. * RN01 NO RN'S IN THE SYSTEM (EVER). * RN02 ILLEGAL RN NUMBER. * RN03 RELEASE OR UNLOCK OF UNOWNED RN. * RN REQUEST PROCESSOR * œõþú SKP RNRQ NOP ENTRY JSB $LIBR PRIVILEGED NOP CLA SINCE WE DON'T PLAN TO RETURN STA $PVCN VIA $LIBR, CLEAR CNTR LDA D$RN JSB $DRAD GET DIRECT ADDR OF RN TABLE STA D$RN * CCA ADA RNRQ SET CALLING ADDR IN SUSP. WORD STA XSUSP,I IN CASE OF SUSPENSION LDA RNRQ,I SET RETURN ADDR JSB $DRAD WORRY ABOUT FTN CALLS STA RQRTN IN CASE OF ABORT * ISZ RNRQ LDB RNRQ,I LDA B,I GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E SEZ,RSS NO ABORT OPTION? JMP ABCAL NO, NORMAL CALL * LDB XSUSP ADB D7 GET ADDR OF STATUS LDA B,I RAL,ERA PUT E IN BIT15 STA B,I OF STATUS WORD ISZ RQRTN BUMP RETURN ADDR * ABCAL ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQNO ADDR OF RN NUMBER ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQST GET ADDR OF RETURN STATUS LDB RQRTN IF RETURN ADDR CMB,INB IS LESS THAN ADB RNRQ THIS NOW, SSB,RSS THEN JMP ERN02 ABORT WITH RN02 * LDB XEQT GET THE ID SEGMENT NUMBER JSB $IDNO TO B STB IDNO SAVE FOR EVERYBODY STB TEMP6 SAVE FOR ME LDA RQOP GET THE OPTION WORD AND B77 IF NO BITS SET THEN CLB SET B FOR ERROR EXIT SZA,RSS TAKE JMP ERN00 ERROR EXIT * AND B30 MASK TO THE ALLOCATE BITS SZA,RSS IF NO ALLOCATION REQUESTED JMP DAL GO TEST FOR DEALLOCATE * AND B10 LDB B377 SZA,RSS GLOBAL ALLOCATE? (BIT 4) STB IDNO YES, SET IDNO TO 377B CCB SET TO SCAN FROM TOP JSB $ALRN ALLOC AN RN AND SET RNADR STA RQNO,I SET IN THE USER AREA SZq¾þúA SKIP IF ALLOCATION FAILED JMP DALX ELSE GO TEST DALLOCATION * LDA D$RN GET SUSPEND FLAG JMP $RNSU CHECK IF NEED TO SUSPEND * DAL LDA RQNO,I GET THE RN USER SUPLIED WORD AND B377 ISOLATE THE RN#. STA B TEST THE RN CMB,INB TO SEE IF IN THE ADB $RNTB TABLE CLE,SZA IF ZERO OR SSB BIGGER THAN LEGAL JMP ERN02 GO BOOM! * ADA D$RN INDEX INTO THE RN TABLE STA RNADR SET THE RN ADDRESS LDA A,I GET THE RN ENTRY XOR RQNO,I IS IT OWNED AND C377 BY THE SAME USER HE THINKS? CLE,SZA JMP ERN03 NO TOO BAD ABOUT THAT! * DALX LDA RQOP TEST FOR AND B40 DEALLOCATE SZA,RSS BIT SET? JMP SET NO GO DO THE SET THING * LDA RQNO,I GET THE RN AND ALF,CLE,ALF MAKE SURE HE OWNS IT AND B377 OWNER ID# TO A CPA B377 IF GLOBAL RSS OR CPA TEMP6 HE IS OWNER CLA,RSS THEN SKIP THE JMP ERN03 BAD NEWS SEND 'RN03' (WATCH E) * STA RNADR,I CLEAR THE RN ASSIGNMENT LDA D$RN RESCHEDULE JSB $SCD3 ALLOCATION WAITERS JMP CLRN2 GO DO CLEAR SCHEDULING * SET LDA RNADR,I GET THE RN AND B377 MASK TO CURRENT LOCK LDB RQOP GET THE FLAG WORD CCE,SLB,RSS IF LOCK ERB,SLB THEN JMP LOKRN GO DO LOCK * CLRN LDB RQOP CHECK FOR CLEAR RBR,RBR FLAG. IF NOT CLE,SLB,RSS SET JUST JMP EXRN EXIT * SZA IF NEVER LOCKED, THEN OK. CPA B377 IF GLOBALLY LOCKED RSS CPA TEMP6 OR LOCKED BY CALLER RSS THEN OK, ELSE JMP ERN03 SEND 'RN03' (WATCH E) * XOR RNADR,I CLEAR THE RN. STA RNADR,I RESTORE THE WORD * CLRN2 JSB SRNW SCHEDULE THE WAITERS EXRN CLB,œ\INB SET THE CLEAR FLAG JMP $RNEX EXIT TO DISPATCHER PROPERLY * * LOCK RN ROUTINE * LOKRN LDB B377 GET GLOBAL FLAG SEZ IF LOCAL LDB TEMP6 REPLACE WITH LOCAL SZA IF NOT LOCKED CPA TEMP6 OR LOCKED TO CALLER CMA,INA,RSS THEN OK CONTINUE JMP LKSUS ELSE SUSPEND THIS GUY. * LOKIT ADA B SET LOCK FLAG LESS CURRENT ENTRY ADA RNADR,I SET THE LOCK FLAG STA RNADR,I IN THE RN TABLE LDA B SET A=ID OF NEW LOCKER JMP CLRN GO TEST FOR CLEAR OPTION * LKSUS LDA RNADR GET THE SUSPEND FLAG JMP $RNSU AND GO SUSPEND SPC 2 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (RNADR) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA RNADR GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN * * ERN02 LDB D2 RN02 ERROR RSS ERN03 LDB D3 RN03 ERROR ERN00 LDA ASRN USE RN JMP $ERAB GO BOOM!#$#$%&'" * ASRN ASC 1,RN SKP * LU UNLOCK REQUEST * * D$RN DEF $RNTB D2 DEC 2 D3 DEC 3 D7 DEC 7 B377 OCT 377 C377 OCT 177400 B77 OCT 77 B10 OCT 10 B30 OCT 30 B40 OCT 40 * TEMP6 NOP * RQRTN EQU 1677B RETURN POINT ADDRESS IDNO EQU 1704B USERS ID SEG # RNADR EQU 1705B RN ADDR IN RN TABLE XEQT EQU 1717B ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU 1730B 'POINT OF SUSPENSION' * RQOP EQU 1701B RQP2 USED FOR RN OPTION NUMBER RQNO EQU 1702B RQP3 USED FOR ADDR OF RN NUMBER RQST EQU 1703B RQP4 USED FOR ADDR OF RN STATUS ORG * PROGRAM LENGTH END wÉÿÿ ÿý * ÿ92064-18210 1901 S 0122 &MLURQ LU LOCK             H0101 á!þúASMB,R,L,C ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: MLURQ * SOURCE: 92064-18210 * RELOC: 92064-16081 * PGMR: G.A.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MLURQ,6 92064-16081 REV.1901 780719 EXT $ERAB,$RNTB,$IDNO,$SCD3,$LUSU,$DRAD EXT $LIBR,$PVCN,$ALRN,$LUEX,$ULLU ENT LURQ * SUP A EQU 0 B EQU 1 * * * * THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU * TO HIS PROGRAM EXCULSIVELY. ANY OTHER PROGRAM IS * PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER * A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O * ON A LOCKED LU (ASSUMING IT IS NOT LOCKED TO HIM) * * THE WAITING PROGRAM WILL BE RESTARTED WHEN THE * LU IS UNLOCKED. ALL LU'S LOCKED TO A PROGRAM WILL BE * UNLOCKED WHEN THE PROGRAM TERMINATES. LU'S MAY * ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING * CALL. * * CALL TO LOCK/UNLOCK AN LU * * EXT LURQ * * JSB LURQ * DEF *+4 * DEF IOPT ADDRESS OF OPTION FLAG WORD * DEF LUARY ADDRESS OF ARRAY OF LU'S * DEF NOLU ADDRESS OF NUMBER OF LU'S TO LOCK/UNLOCK * RETURN - - * . * . * . *LUARY DEC N1 ARRAY OF LU'S TO BE LOCKED * DEC N2 ONLY THE LEAST 6 BITS ARE USED. * . * . * . *IOPT DEC OPTION OPTIONS FOR THIS CALL SEE BELOW *NOLU DEC NO NUMBER OF LU'S IN THE ARRAY * * OPTIONS ARE: * IOPT MEANING * 0 UNLOCK SPECIFIED LU'S * 100000B IµþúUNLOCK ALL OWNED LOCKS * 1 LOCK WITH WAIT THE SPECIFIED LU'S * 100001B LOCK WITHOUT WAIT THE SPECIFIED LU'S. * * TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED * IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. * IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY * HAS ONE OR MORE LU'S LOCKED HE WILL BE ABORTED 'LU01' * * ON A NO WAIT RETURN THE A REGISTER INDICATES THE * STATUS AS FOLLOWS: * * A REGISTER MEANING * -1 NO RN AVAILABLE AT THIS TIME * 0 REQUEST SUCESSFUL * 1 ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO * ANOTHER PROGRAM * * POSSIBLE ABORT ERRORS ON THIS REQUEST ARE: * ERROR MEANING * LU01 HE HAS OTHERS LOCKED AND WAIT OPTION * LU02 ILLEGAL LU * LU03 NOT ENOUGH PRAMETERS * RN01 SYSTEM HAS NO RN'S * RN03 HE DOESN'T OWN THE LOCK HE IS TRYING TO RELEASE * * INTERNAL FUNCTION: * * THE USER IS ASSIGNED AN RN WHICH IS LOCKED TO HIM. * THE DRT ENTRY FOR EACH LOCKED LU CONTAINS A POINTER * TO THE RN USED TO DO THE LOCK. * * ALL A PROGRAMS LU LOCKS ARE CONNECTED WITH THE SAME RN * AND THE DRT FIELD IS 5 BITS WIDE, THUS A TOTAL * OF 31 (0 IS RESERVED FOR NO LOCK) PROGRAMS * MAY HAVE LU'S LOCKED AT THE SAME TIME. * THE DRT ENTRY IS IN BITS 6-10 OF THE DRT ENTRY. * SKP LURQ NOP JSB $LIBR PRIVILEGED ENTRY NOP CLA CLEAR CNTR SINCE WE DON'T STA $PVCN PLAN TO RETURN VIA $LIBX LDA D$RN JSB $DRAD GET DIRECT ADDR OF RN TABLE STA D$RN * CCA ADA LURQ SET CALLING ADDR IN SUSP. WORD STA XSUSP,I IN CASE OF SUSPENSION LDA LURQ,I SET RETURN ADDR JSB $DRAD (WORRY ABOUT FTN CALLS.) STA RQRTN IN CASE OF ABORT * ISZ LURQ LDB LURQ,I LDA B,I þú GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E SEZ,RSS NO-ABORT OPTION? JMP ABCAL NO, NORMAL CALL * LDB XSUSP ADB D7 GET ADDR OF STATUS LDA B,I RAL,ERA PUT E INTO BIT15 STA B,I OF STATUS WORD ISZ RQRTN BUMP RETURN ADDR * ABCAL ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQTB ADDR OF LU ARRAY ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQSZ ADDR OF NUMBER OF LU'S LDA BIT15 CPA RQOP IF REQ IS RELEASE ALL JMP LUUL3 SKIP PARAMS CHECK * LDB RQRTN MAKE SURE THERE ARE CMB,INB ENOUGH PARAMETERS ADB LURQ ELSE SSB,RSS REJECT JMP ELU03 WITH LU03 ERROR * LDB XEQT HERE ON LU LOCK CALL JSB $IDNO GET THE USERS ID NUMBER STB IDNO SET FOR ALLOCATE, ECT BLF,BLF PUT USER OWN/LOCK ADB IDNO FLAG IN STB TEMP6 TEMP6 LDA RQSZ,I GET THE # OF LU'S CMA,INA,SZA IF NEG OR ZERO, SSA,RSS JMP ELU03 'LU03' ERROR * STA TEMP5 SET COUNTERS STA TEMP4 FOR THE TWO LOOPS LDA LUMAX GET THE DRT SIZE CMA SET NEG OF MAX LU STA TEMP3 STA TEMP9 SET FOR BOTH LOOPS LDB RQTB GET THE LU ARRAY ADDRESS STB RQP7 AND SET LDA RQOP GET THE OPTION FLAG SLA,RSS IF THIS IS NOT LOCK REQ, JMP LUUL1 GO TO RELEASE CODE * * CHECK IF AN RN HAS ALREADY BEEN ASSIGNED * FOR THIS PROGRAMS LU LOCKS. * ISZ TEMP3 STEP LU COUNTER LDB DRT GET THE DRT ADDRESS LULK1 LDA B,I GET LU ENTRY AND B3700 MASK TO LU LOCK FLAG STA RQP8 SAVE THE LOCK FLAG ALF,ALF ROTATE TO RAL,CLE,RAL LOW AND USE TO ADA D$RN INDEX INTO THE RN TABLþúE LDA A,I GET RN CODE CPA TEMP6 IF OWNED AND LOCKED BY CALLER JMP LULK8 BY CALLER, JUMP * CCE,INB ELSE STEP DRT ISZ TEMP3 ADDRESS IF NOT END JMP LULK1 CONTINUE SEARCH * CLA CLEAR ALLOCATED FLAG STA RQP8 * LULK2 CCB TEST TO SEE IF ALL ADB DRT THE LU'S HE WANTS LDA RQP7,I ARE AVAILABLE AND B77 GET THE LU FROM HIS ARRAY SZA,RSS .CHECK FOR LU 0 JMP ELU02 . REJECT AS ILLEGAL ADB A AND INDEX INTO THE DRT ADA TEMP9 IF GREATER THAN MAX. CCE,SSA,RSS LU ON SYSTEM JMP ELU02 GO ISSUE 'LU02' ABORT * LDA B,I GET THE DRT ENTRY AND B3700 MASK OUT THE LOCK CODE SZA IF AVAILABLE CONTINUE JMP LULK5 ELSE GO SUSPEND * LULK3 ISZ RQP7 STEP LU ARRAY ISZ TEMP4 AND COUNT DONE? JMP LULK2 NO TRY NEXT LU. * LDA RQP8 GET THE ALLOCATED FLAG SZA IF AN RN ALREADY ALLOCATED JMP LULK4 GO SET UP * * NO RN ASSIGNED SO ALLOCATE ONE * CLB,INB ASSIGN FROM LOW END OF TABLE JSB $ALRN AND B377 SET RN NUMBER IN A STA B AND B AND B37 IF RN>37B CPA B OR ZERO SZA,RSS THEN GO JMP LULK7 HANG HIM UP. * BLF,BLF MOVE NUMBER TO RBR,RBR BITS 6-10 STB RQP8 AND SET FOR LOCK LOOP LDB TEMP6 GET THE LOCAL LOCK FLAG STB RNADR,I AND SET IN RN TABLE * LULK4 CCB SET ALL REQUESTED LU'S ADB DRT LOCKED TO LDA RQTB,I THE CURRENT AND B77 CALLER. ADB A DRT ADDRESS TO B LDA B,I GET DRT ENTRY IOR RQP8 SET LOCK FLAG STA B,I RESET IN THE DRT ISZ RQTB STEP ARRAY ADDRESS ISZ TEMP5 IF NOT DONE JMP LULK4 DO THE NdPþúEXT ONE * LULKS CLA SET A TO SHOW LULKF STA XA,I SUCESSFUL COMPLETION JMP $LUEX EXIT VIA LU-RN EXIT CODE * LULK5 ALF,ALF IF LOCK IS TO CALLER RAL,RAL THEN ADA D$RN THE LOCK STA RNADR IS TO LDA A,I BE IGNORED CPA TEMP6 TO CALLER? JMP LULK3 YES OK * * LOCKED TO SOME OTHER PROGRAM * CLA,INA SET FAILURE FLAG LULK6 LDB RQOP IF SUSPEND OPTION SSB SUSPEND OPTION? JMP LULKF YES, EXIT LDA RNADR NO, SUSPEND PROGRAM JMP $LUSU * * * ALLOCATION FAILED - * LULK7 CLB IF BECAUSE >32B SZA THEN STB RNADR,I RELEASE THE RN LDB D$RN SET SUSP FLAG STB RNADR IN RNADR AND CCA SET THE COMPLETION FLAG JMP LULK6 GO EXIT * * HE HAS AT LEAST ONE LU LOCKED ALREADY * TO PREVENT DEAD LOCK HE MUST NOT CODE * WAIT ON SUBSEQUENT CALLS * LULK8 LDA RQOP GET THE OPTION FLAG ERN01 CME,SSA AND THIS CALL WITH JMP LULK2 WAIT THEN * CLB,INB,RSS SEND 'LU01' ELU02 LDB D2 LU ERROR RSS ELU03 LDB D3 LU ERROR LDA ASLU LU ERROR JMP $ERAB GO BOOM!#$#$%&'" * ASLU ASC 1,LU * * * LUUL1 CCB ELSE ADB DRT SCAN HIS LDA RQP7,I ARRAY AND B77 AND SZA,RSS .CHECK FOR LU 0 JMP ELU02 . REJECT AS ILLEGAL ADB A DO THE THING ADA TEMP3 IF ILLEGAL LU CCE,SSA,RSS SEND 'LU02' ERROR JMP ELU02 * LDA B,I GET THE DRT ENTRY AND B3700 MASK LOCK FLAG STA TEMP9 SAVE IN CASE FOUND ALF,ALF ROTATE TO RAL,RAL LOW A AND ADA D$RN USE TO INDEX THE RN TABLE STA RNADR SAVE THE ADDRESS LDA A,I GET THE FLAG CPA TEMP6 HIS? RSS YES SKIP E$ï$"RROR EXIT JMP ELU03 NO- TOO BAD, YOU LOSE. * LDA B,I UNLOCK THE XOR TEMP9 LU STA B,I ISZ RQP7 STEP HIS ARRAY ADDRESS ISZ TEMP4 DONE? JMP LUUL1 NO TRY NEXT ONE * LDA RNADR SCHEDULE ANY WAITING PROGRAMS JSB $SCD3 * ISZ TEMP3 TEST IF ANY LU'S LDB DRT STILL LOCKED LUUL2 LDA B,I BY CALLER AND B3700 IF SO CPA TEMP9 JUST JMP LULKS EXIT * INB STEP DRT ADDRESS ISZ TEMP3 AN COUNT / DONE? JMP LUUL2 NO TRY NEXT * CLA NO LU'S LOCKED STA RNADR,I DEALLOCATE THE RN LDA D$RN SCHEDULE ANY ALLOCATION JSB $SCD3 WAITERS AND JMP LULKS EXIT * LUUL3 LDB XEQT RELEASE ALL JSB $ULLU LU'S LOCKED BY JMP LULKS CALLER AND RETURN * D$RN DEF $RNTB D2 DEC 2 D3 DEC 3 D7 DEC 7 BIT15 OCT 100000 B377 OCT 377 B3700 OCT 3700 B77 OCT 77 B37 OCT 37 * TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP9 NOP * DRT EQU 1652B LUMAX EQU 1653B * RQOP EQU 1701B RQTB EQU 1702B RQSZ EQU 1703B IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS RN ADDR IN RN TABLE * RQRTN EQU 1677B RQP7 EQU 1706B RQP8 EQU 1707B XEQT EQU 1717B XSUSP EQU 1730B XA EQU 1731B ORG * PROGRAM LENGTH END —?$ÿÿ ÿý! , ÿ92064-18211 1709 S C0122 &MPRTN PARAMETER RETURN             H0101 ±þúASMB,L ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: MPRTN * SOURCE: 92064-18211 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MPRTN,6 92064-16081 REV.1709 761122 ENT PRTM ENT PRTN EXT $LIBR,$LIBX SPC 2 * THIS ROUTINE IS USED TO PASS FIVE PARAMETERS TO THE PROGRAM * THAT SCHEDULED THE CALLER WITH WAIT. IT DOES NOT HONOR THE * NO PARAMETERS BIT. * * THE SCHEDULING PROGRAM MAY RECOVER THESE PARAMETERS WITH RMPAR. * * THE WAIT FLAG IS CLEARED SO THE CALLER SHOULD HAVE HIGHER * PRIORITY THAN THE SCHEDULER TO PREVENT A SWAP. * * CALLING SEQUENCE: * * JSB PRTN * DEF *+2 STANDARD FORTRAN SEQUENCE * DEF PRAM ADDRESS OF THE FIVE RETURN PRAMATERS * JSB EXEC PROGRAM SHOULD COMPLETE * DEF *+2 * DEF SIX SPC 3 PRTN NOP ENTRY POINT JSB $LIBR GO DO PRIVLEDGE THING COUNT NOP LDA PRTN GET THE ADDRESS OF THE CALL PRAMS LDB A,I GET RETURN ADDRESS STB RTN SAVE IT INA STEP TO PRAM ADDRESS LDA A,I GET PRAM ADDRESS RAL,CLE,SLA,ERA REMOVE POSSIBLE INDIRECT JMP *-2 IF INDIRECT TRY AGAIN STA PRTN SAVE THE PRAM ADDRESS LDA KEYWD GET HEAD OF THE KEY WORD LIST STA PRTM SAVE IT LOCALLY JMP NEXT1+1 GO SCAN THE LIST SPC 1 NEXT CLB,INB ADD ONE ADB A TO IT TO GET THE WAIT ID ADDRESS STB ID ALSO THE P¨­þúRAM SAVE ADDRESS SAVE IT LDB B,I GET THE WORD CPB XEQT THIS THE SCHEDULING PROGRAM? JMP FOUND LOOKS GOOD GO CHECK THE STATUS NEXT1 ISZ PRTM STEP KEYWORD ADDRESS LDA PRTM,I GET NEXT ENTRY SZA IF END OF LIST EXIT JMP NEXT NOT END TRY NEXT ID SPC 1 EXIT LDA OP1 RESET THE OPTION FOR PRTN ENTRY STA OPTIN JSB $LIBX EXIT TO THE SYSTEM EXIT ROUTINE DEF RTN RETURN ADDRESS SPC 1 RTN NOP ID NOP STAT NOP SPC 2 FOUND LDB D5 CACULATE LAST PRAM ADDRESS ADB A TO B STB LAST SAVE IT FOR TESTING ADB D10 CALCULATE THE STATUS ADDRESS STB STAT SAVE IT LDB B,I GET STATUS OF SCHEDULER BLF,SLB IS HE WAITING? OPTIN CCE,RSS (OR CLE,INA,RSS FOR PRTM) JMP NEXT1 NO TRY NEXT PGM ERB,CLE,ELB CLEAR WAIT BIT(SAVE E-REG.) BLF,BLF ROTATE B THE REST BLF OF THE WAY AROUND OVER SEZ,CLE,INA ADVANCE POINTER. STB STAT,I SAVE STATUS WITHOUT WAIT BIT IF PRTN. LDB PRTN,I GET FIRST PRAM STB A,I SET PRAM ISZ PRTN STEP ADDRESS CPA LAST LAST PRAMETER? CLB,INB,RSS YES B_1 AND SKIP JMP OVER NO GO DO NEXT ONE ADA D5 YES SET TO B REG ADDRESS LDB ID GET ADDRESS OF PRAM AREA STB A,I SET BREG SAVE TO POINT TO PRAMS JMP EXIT DONE RETURN TO PGM SPC 3 OP1 CCE,RSS INARS CLE,INA,RSS PRTM ENTRY A OPTION LAST NOP D5 OCT 5 D10 DEC 10 SPC 2 PRTM NOP OPTIONAL ENTRY FOR FOUR JSB $LIBR PRAMETER PASS WITH OUT CLEARING NOP THE WAIT BIT LDA INARS GET THE OPTIONAL INSTRUCTION STA OPTIN SET IT IN THE CODE LDA PRTM GET THE RETURN ADDRESS STA PRTN SET IT IN THE MAIN ENTRY POINT JMP COUNT+1 GO TO MAIN LINE ANã D DO THE JOB SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END ß#ÿÿ ÿý"* ÿ92064-18212 1709 S C0122 &MEQLU EQ/LU CONVERSION             H0101 ´îþúASMB,R,L,C ** EQLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -EQLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: MEQLU * SOURCE: 92064-18212 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MEQLU,6 92064-16081 REV.1709 741120 ENT EQLU EXT $LIBR,$LIBX * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB EQLU -OR- JSB EQLU -OR- CALL EQLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP EQLU NOP ENTRY JSB $LIBR PRIVLAGED ROUTINE NOP STB EQT4 SAVE B-REG FOR LATER TEST LDA EQLU,I GET ADRS OF RETURN ADDRESS ISZ EQLU BUMP TO POSSIBLE PRAM. LDB EQLU,I GET POSS. ADDRS OF PRAM. CPA EQLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STA EQLU SET RETURN POINT FOR $LIBX STB LUADR SET PASSED PRAM. ADDRESS CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O7~"  7 MASK OF SUBCHANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER JSB $LIBX RETURN A=BIN. VALUE, B= ASCII VALUE DEF EQLU SPC 1 EQT4 NOP LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END ² ÿÿ ÿý#* ÿ92064-18213 1709 S C0122 &MDRCT DIRECT ADDRESS             H0101 lÂASMB,L HED .DRCT ROUTINE * NAME: MDRCT * SOURCE: 92064-18213 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MDRCT,7 92064-16081 REV.1709 741120 SPC 1 ENT .DRCT * CALLING SEQUENCE * THIS ROUTINE TRACKS DOWN POSSIBLE INDIRECT ADDRESSES * * JSB .DRCT * DEF ADDR * RETURN IS TO HERE WITH A THE ADDRESS * B IS UN ALTERED E IS LOST .DRCT NOP LDA .DRCT LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ .DRCT JMP .DRCT,I A EQU 0 END Kÿÿ ÿý$* ÿ92064-18214 1826 S C0122 &MREIO RE-ENTRANT I/O             H0101 ]ºþúASMB,L,C ** REIO ** * NAME: MREIO * SOURCE: 92064-18214 * RELOC: 92064-16081 * PGMR: G.A.A. * DATE: OCT. 2,1974 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MREIO,7 92064-16081 REV.1826 780426 EXT .DFER,$LIBR,$LIBX,EXEC,.ENTR ENT REIO SUP SPC 1 * THIS ROUTINE DOES REENTRENT I/O IF THE USERS BUFFER * IS 3 OR MORE WORDS ABOVE THE LOW MAIN ADDRESS * THIS RESTRICTION IS ENFORCED BECAUSE THE USERS BUFFER * IS USED AS A TDB FOR THE REENTRANT PROCESSOR AND THUS * THREE WORDS ARE REQUIRED AHEAD OF IT. * * THESE THREE WORDS ARE SAVED LOCALLY AND THE TDB IS SET UP * AFTER THE I/O HAS COMPLETED THE WORDS ARE RESTORED. * * IF THE BUFFER IS TOO CLOSE TO THE LOW MAIN THE I/O IS PREFORMED * IN THE STANDARD MANNER. THIS IS ALSO TRUE IF THE BUFFER IS * MORE THAN 129 WORDS LONG (TO CONSERVE SYSTEM MEMORY). * * CALLING SEQUENCE: * * THE SAME AS THE EXEC I/O CALL WITH OUT THE TRACK/SECTOR WORDS. * RQ BSS 4 PRAMETER ADDRESS AREA REIO NOP ENTRY POINT JSB .ENTR FETCH THE PRAMETERS DEF RQ LDA RQ+3,I PULL PRAMETERS IN LOCALLY STA RQ+3 INCASE THEY ARE LDA RQ,I ARE IN THE THREE WORD STA RQ AREA AHEAD OF LDA RQ+1,I THE BUFFER STA RQ+1 * LDA RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE AND STA TDBA SET UP THE LIBR/LIBX STA TDBA2 CALLS CMA SET NEGATIVE AND TEST LDB XEQT .CHECK FOR LOW MAIN ADDRESS INTRUSION ½   ADB D22 ADA B,I CLE,SSA,RSS IF BELOW THE FENCE JMP DIRIO GO DO DIRECT I/O. * JSB .DFER ELSE SAVE THE THREE WORDS DEF S1 IN LOCAL SAVE AREA DEF TDBA,I LDB RQ+3 GET THE REQUEST LENGTH SSB,RSS IF POSITIVE SKIP CONVERSION JMP RE1 * BRS CONVERT CHARACTERS TO CMB,INB WORDS AND SET POSITIVE RE1 ADB D3 ADD THREE WORDS FOR TDB LENGTH STB A AND PUT IN A FOR LENGTH TEST ADA N133 SUBTRACT 133 (129 + 3 + 1) CLE,SSA,RSS IF POSITIVE OF ZERO JMP DIRIO DO IT DIRECT * CLA,CCE SET ZERO IN WORD ONE AND DST TDBA,I LENGTH IN WORD TWO OF THE TDB JSB DOIO GO DO THE I/O S1 OCT 0,0,0 RETURN SKIPS THREE WORDS DST RQ SAVE THE REGISTERS JSB .DFER RESTORE THE THREE WORDS DEF TDBA,I DEF S1 DLD RQ RESTORE THE A AND B REGS. JMP REIO,I AND EXIT TO USER. * DOIO NOP JSB $LIBR TELL THE SYSTEM WE ARE TDBA DEF * RENT DIRIO JSB EXEC DO THE I/O CALL DEF EX RETURN ADDRESS DEF RQ DEF RQ+1 DEF RQ+2,I DEF RQ+3 EX RSS SKIP IF ERROR EXIT ISZ REIO ELSE STEP RETURN ADDRESS SEZ,RSS IF DIRECT JMP REIO,I EXIT * JSB $LIBX ELSE EXIT RENT TDBA2 DEF * SECTION D3 DEC 3 +3 WORDS * N133 DEC -133 N3 DEC -3 D22 DEC 22 XEQT EQU 1717B A EQU 0 B EQU 1 ORG * END Dª ÿÿ ÿý%, ÿ92064-18215 1709 S C0122 &MIFBR BREAK TEST             H0101 IAASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: MIFBR * SOURCE: 92064-18215 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MIFBR,7 92064-16081 REV.1709 741120 * ENT IFBRK EXT $LIBR,$LIBX SPC 2 * CALLING SEQUENCE: * * IF(IFBRK(IDMY)) 10,20 * * WHERE: 10 BRANCH WILL BE TAKEN IF SET & WILL CLEAR IT. * 20 BRANCH WILL BE TAKEN IF NOT SET * * JSB IFBRK * DEF *+1 * A-REG. = -1 IF SET, ELSE A-REG = 0 * BREAK BIT WILL ALWAYS BE CLEARED IF SET! SPC 1 IFBRK NOP ENTRY FROM FTN LDA IFBRK,I GET P+1 ADDRESS STA IFBRK SET RETURN ADDRESS LDB XEQT GET IDSEG ADDRESS OF THIS PROG ADB D20 GET ID(21) ADDRESS LDA B,I GET CONTENTS AND BIT12 MASK DOWN TO BIT 12 SZA,RSS SET? JMP IFBRK,I NO, RETURN A=0 JSB $LIBR TURN OFF INTERRUPTS NOP XOR B,I YES, CLEAR IT STA B,I RESTORE WORD 21 CCA RETURN A-REG. = -1 JSB $LIBX DEF IFBRK SPC 1 D20 DEC 20 BIT12 OCT 10000 XEQT EQU 1717B B EQU 1 END Y—ÿÿ ÿý&, ÿ92064-18216 1709 S C0122 &MCORA MEMORY LIMIT             H0101 Y§ASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: MCORA * SOURCE: 92064-18216 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCORA,7 92064-16081 REV.1709 741120 ENT COR.A * * ROUTINE TO FIND THE ADDRESS OF THE FIRST WORD OF AVAIL MEM. * FOR A GIVEN ID SEGMENT * * CALLING SEQUENCE: * * LDA IDSEG GET ID SEGMENT ADDRESS TO A * JSB COR.A CALL THIS ROUTINE * RETURN A= FIRST WORD OF AVAIL MEM (MEM2 FROM ID) * COR.A NOP ADA .14 INDEX TO THE NAME 5 WORD LDB A,I GET THE WORD BLF,BLF ROTATE THE BLF,SLB SHORT ID FLAG TO LOW B AND TEST INA,RSS SHORT SO INDEX TO MEM ADA .8 LONG SO INDEX TO MEM INA INDEX TO MEM2 LDA A,I SET IT IN A JMP COR.A,I RETURN * .14 DEC 14 .8 DEC 8 A EQU 0 END ºÜÿÿ ÿý'- ÿ92064-18217 1709 S C0122 &MKCVT OCTAL TO ASCII CONVERSION             H0101 –LASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: MKCVT * SOURCE: 92064-18217 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MKCVT,6 92064-16081 REV.1709 741120 ENT KCVT * * EXT $CVT1,.ENTP,$LIBR,$LIBX * NUMBR BSS 1 * KCVT NOP JSB $LIBR NOP JSB .ENTP DEF NUMBR LDA NUMBR,I CCE JSB $CVT1 JSB $LIBX DEF KCVT END Xÿÿ ÿý(. ÿ92064-18218 1709 S C0122 &MPARS SYSTEM PARSE             H0101 i²ASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: MPARS * SOURCE: 92064-18218 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MPARS,6 92064-16081 REV.1709 741120 ENT PARSE * EXT $PARS,.ENTP,$LIBR,$LIBX * CMBUF BSS 1 BFLEN BSS 1 BUFR BSS 1 * PARSE NOP JSB $LIBR NOP JSB .ENTP DEF CMBUF LDA BUFR STA BUFR1 LDA CMBUF LDB BFLEN,I JSB $PARS BUFR1 BSS 1 JSB $LIBX DEF PARSE END "$ÿÿ ÿý)/ ÿ92064-18219 1709 S C0122 &MTMVL TIME VALUES             H0101 }kASMB,L ROUTINE TO CONVERT TIME HED TMVAL * NAME: MTMVL * SOURCE: 92064-18219 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MTMVL,6 92064-16081 REV.1709 741120 ENT TMVAL EXT $LIBX,$LIBR,.ENTP,$TIMV * * * CALLING SEQUENCE (FORTRAN) * * CALL TMVAL(ITM,ITMAR) * * WHERE ITM IS THE TWO WORD NEGATIVE TIME IN TENS OF * MS. AND ITMAR IS A 5 WORD ARRAY TO RECIEVE THE * TIME. THE ARRAY WILL BE SET UP AS: * * 1. TENS OF MS. * 2. SECONDS * 3. MINUTES * 4. HOURS * 5. CURRENT SYSTEM DAY OF YEAR (NOT RELATED TO CALL VALUES) * ITM NOP ITM1 NOP * TMVAL NOP JSB $LIBR NOP JSB .ENTP GET PRAMS DEF ITM * LDA ITM1 SET ADDRESS STA RQP2 FOR SYSTEM ROUTINE CLA AND ZAP THE STA RQP3 YEAR ADDRESS DLD ITM,I GET THE TIME JSB $TIMV CONVERT IT JSB $LIBX EXIT DEF TMVAL * RQP2 EQU 1701B RQP3 EQU RQP2+1 END Öêÿÿ ÿý*0 ÿ92064-18220 1709 S C0122 &MCNMD DECIMAL TO ASCII CONV.             H0101 úASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: MCNMD * SOURCE: 92064-18220 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCNMD,6 92064-16081 REV.1709 741120 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMD * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMD SPC 2 * * DEFINE EXTERNAL * EXT $LIBR,$LIBX,.ENTP,.DFER,$CVT3 SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMD NOP ENTRY POINT INTO ROUTINE JSB $LIBR TURN OFF THE "LIGHT" NOP JSB .ENTP GO GET PRAMS DEF BINA CCE SET FOR BINARY TO DEC. CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I WHERE TO PUT IT FROM NOP JSB $LIBX AND RETURN DEF CNUMD END Ëÿÿ ÿý+1 ÿ92064-18221 1709 S C0122 &MCNMO OCTAL TO ASCII CONVERSION             H0101 SASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: MCNMO * SOURCE: 92064-18221 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCNMO,6 92064-16081 REV.1709 741120 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMO * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMO SPC 2 * * DEFINE EXTERNAL * EXT $LIBR,$LIBX,.ENTP,.DFER,$CVT3 SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMO NOP ENTRY POINT INTO ROUTINE JSB $LIBR TURN OFF THE "LIGHT" NOP JSB .ENTP GO GET PRAMS DEF BINA CLE SET FOR BINARY TO OCTAL CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I FROM NOP JSB $LIBX AND RETURN DEF CNUMO END $ñÿÿ ÿý,2 ÿ92064-18222 1709 S C0122 &MIPRS INVERSE PARSE             H0101 º{þúASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: MINPR * SOURCE: 92064-18222 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MINPR,6 92064-16081 REV.1709 741119 SUP PRESS EXTRANEOUS LISTING ENT INPRS EXT $LIBR,$LIBX,.ENTP,$CVT3 SPC 1 A EQU 0 B EQU 1 HED INPRS : DESCRIPTION * CALLING EXAMPLE : * FTN,L * PROGRAM R$PN$(2,10) * INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),IC), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS) * CALL PARSE(BUFFER,IB,PARBUF) * <"ON" REQUEST - PARBUF(2)="ON" ?> * * * CALL INPRS(PARBUF,PARBUF(33)) * IC = MESSS(BUFFER,IB) * * * GO TO 1 * END SPC 2 * THE BUFFER 'PARBUF' LOOKS LIKE : SPC 2 * PARBUF(1) * PRAM(1) TYPE * (2) * VALUE(1) * (3) * (2) * (4) * (3) * (5) * PRAM(2) TYPE * (6) * VALUE(1) * (7) * (2) * (8) * (3) SPC 1 * ET CETERA SPC 1 * PARBUF(33)* NUMBER OF PARAMETERS PARSED SPC 2 * WHERE : TYPE = 0 => NULL PARAMETER * 1 => NUMERIC PARAMETER IN VALUE(1) * ‹Eþú 2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) HED INPRS : MAIN BUF NOP #P NOP INPRS NOP JSB $LIBR NOP JSB .ENTP DEF BUF SPC 2 LDA #P,I SET PRAM CMA,INA,SZA,RSS COUNTER JMP EXIT NO PRAMS EXIT STA #P INIT COUNTER LDB BLANK USE LEADING BLANK SPC 2 LOOP EQU * LDA BUF GET VALUE FOR INA THIS ENTRY LDA A,I AND IF SSA NEGATIVE ADB B21 CONVERT BLANK TO 1. LDA BUF,I GET PRAM SPEC STB BUF,I STORE ", " OR " " BACK ISZ BUF STEP TO VALUE CMA,INA,SZA,RSS IF ZERO JMP NULL THEN NULL PRAM SPC 2 INA,SZA,RSS IF ONE JMP NUMBR THEN NUMERIC SPC 2 ISZ BUF MUST BE ASCII,SO LOOP2 EQU * IT'S OK ISZ BUF AS ISZ BUF IS. LDB COMMA GET ", " ISZ #P DONE ? JMP LOOP NO-GET NEXT PRAM. SPC 2 EXIT EQU * JSB $LIBX YES-EXIT DEF INPRS TO CALLER SPC 2 NULL EQU * LDB BLANK FOR NULL STB BUF,I PRAM , REPLACE LDA B WITH STO EQU * ISZ BUF SIX DST BUF,I BLANKS JMP LOOP2 & GET NEXT PRAM. SPC 2 NUMBR EQU * NUMERIC PRAM PROC. LDA BUF,I GET NUMBER CCE,SSA VALUE IF CLE NEG,SET FOR OCTAL CONVERSION JSB $CVT3 CONVERT TO ASCII ERB SET E IF NEG. LDB A,I GET HIGH DIGIT SEZ,INA STEP & IF OCTAL ADB B104C CONVERT '1' TO 'B' STA T SAVE ADDRESS LDA A,I GET NEXT DIGIT RRL 8 ROTATE 1ST 2 DIGITS TO 'B'REG STB BUF,I STORE 1ST 2 DIGITS ISZ T STEP TO LAST 2 DIGITS ALF,ALF LDB T,I GET LAST 2 DIGITS RRL 8 †â ROTATE TO RIGHT ORDER JMP STO GO STORE IT HED INPRS : CONSTANTS B21 OCT 21 B104C OCT 10400 COMMA ASC 1,, BLANK ASC 1, T NOP HED INPRS - END END x¯ÿÿ ÿý-5 ÿ92064-18223 1709 S C0122 &.MVW MOVE WORDS SUBROUTINE             H0101 (+ASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92064-18223 * RELOC: 92064-16081 * PGMR: G.A.A * HED MOVE WORD ROUTINE TO SIMULATE 105777B MICROCODE INSTR * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .MVW,7 92064-16081 REV.1709 751021 RP=105777B ENT .MVW .MVW EQU * *** MOVE NOP STA FROM MICRO CODE MOVE REPLACEMENT SUB LDA MOVE,I GET THE COUNT LDA A,I TO A ISZ MOVE STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA FROM,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ FROM FROM ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA FROM PUT NEXT LOCATION IN A FOR PURISTS JMP MOVE,I AND RETURN * * A EQU 0 B EQU 1 FROM NOP COUNT NOP END ·Îÿÿ ÿý.4 ÿ92064-18224 1913 S C0122 $CLBM HDR FOR RTE-M /COMPILER LIB             H0101 Ì­ASMB,R,L,C HED COMPILER LIBRARY HEADER ROUTINE(RTE-M) NAM $CLIB,7 92064-12007 REV.1913 790105 $CLIB * END 3cÿÿ ÿý/5 ÿ92064-18225 1901 S C0122 >F.C GET FILES /COMPILER LIB             H0101 õ"þúASMB,R,L,C NAM GTF.C,7 92064-16090 780815 REV. 1901 $CLIB * * * * * NAME: GTF.C * SOURCE: 92064-18225 * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * CALLING SEQUENCE: JSB GTF.C * * * ERROR CODE RETURNED IN A REGISTER * STRING LENGTH RETURNED IN B REGISTER * * ENT GTF.C * EXT .DRCT,MGLU,IFTTY UNKNOWN ROUTINES(POS FTN LIB) EXT CLOSE,OPEN,READF,WRITF,RMPAR RTE-M REF MAN EXT .MVW ASMB MAN EXT C.TRN,C.TTY COMPILER LIB * * GTF.C NOP * JSB RMPAR DEF *+2 DEF ANSW LDA C.TTY+2 FETCH CONSOLE LU AND =B77 ISOLATE IT STA CON1 SAVE IT * * * OPEN INPUT FILE/LU * LDA ANSW FETCH ANSWER NAME/LU LDB =B157777 IS THIS A NAME ? ADB A OR AN LU ?? SSB,RSS JMP OP1 IT'S A NAME--DO NORMAL OPEN * SZA,RSS IF DEFAULT LDA CON1 USE MTM TERMINAL STA LU SAVE FOR CONVERSION * * CALL ROUTINE TO CREATE FILE NAME LU..XX XX ::= LU # * (IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED * FILE NAME "LU..99" IS RETURNED. THIS WILL GENERATE * A ERROR -18 (BAD LU) IN THE OPEN ROUTINE.) * JSB MGLU CALL ROUTINE TO BUILD MAGIC NAME DEF *+3 DEF LU ADDRESS OF LU TO BE CONVERTED DEF ANSW SET IT FOR OPEN CALL * OP1 JSB OPEN DEF OP2 DEF GDCB DEF ERR DEF ANSW DEF OPOP * OP2 LDA ERR SSA JMP GTF.C,I * * SEE IF INTERACTIVE * ‡ŠþúJSB .DRCT FETCH DEF GDCB DIRECT ADDRESS OF DCB ADA =B2 ADVANCE TO TYPE WORD LDB A,I FETCH IT SZB CONTINUE IF ZERO JMP DFILE NON-INTERACTIVE * INA ADVANCE TO LU LDA A,I FETCH IT STA X JSB IFTTY DETERMINE IF INTERACTIVE DEF RTN DEF X RTN RSS DFILE CLA STA INT 0=NO,1=YES * * LDA STAA INA INA STA STAD PRESET STRING POINTER LDA .5 STA LEN PRESET STRING LENGTH (ALLOWS FOR RU,X, , , ) LDA =B-3 FETCH LOOP CNTR STA CNTR SET IT * * SET UP ADDRESSES * INPT LDA PNT2 ADA CNTR LDA A,I STA MSAD ADA .5 INA STA LNAD INA STA RDAD * * IF NOT INTERACTIVE-SKIP PROMPT * LDA INT SZA,RSS JMP RT1 JSB WRITF DEF RT1 DEF GDCB DEF ERR DEF MSAD,I DEF .5 * * * FETCH REPLY * RT1 JSB READF DEF RT2 DEF GDCB DEF ERR DEF RDAD,I REPLY DEF .20 DEF LNAD,I READ LENGTH * RT2 LDA ERR SZA JMP EX0 ERROR EXIT FROM READ * ISZ CNTR JMP INPT * LDA =B-3 RESET COUNTER STA CNTR OUTPT LDA PNTR ADA CNTR LDA A,I ADA .5 STA DFAD INA STA LNAD INA STA RDAD * * LDB LNAD,I LOAD LENGTH WORD LDA INT CHECK SINCE DEFAULT ON TERMINAL = EOF SZA,RSS JMP RT3 SSB,RSS EOF FROM TERM = ZERO RECORD AS FROM FILE SZB,RSS CLB STB LNAD,I RT3 SSB JMP EX12 ERROR EXIT LDA RDAD SZB JMP RPLY ISZ LNAD,I INSERT DEFAULT IF REQD ISZ LEN LDA DFAD RPLY ADB LEN STB LEN INCREMENT STRING LENGTH LDB CMA STB STAD,I LDB STAD INB JSB .MVW6` DEF LNAD,I NOP STB STAD INCR STRING PNTR * * ISZ CNTR JMP OUTPT * * EXIT * * EXCLS JSB CLOSE DEF *+2 DEF GDCB * LOAD RUN STRING * LDB .CTRN JMP *+2 LOOP LDB B,I RBL,CLE,SLB,ERB CLEAR INDIRECTS JMP LOOP LDA STAA JSB .MVW DEF LEN NOP LDA ERR LOAD ERROR CODE LDB LEN LOAD STRING LENGTH BLS (CHARACTERS,NO WORDS ARE EXPECTED) JMP GTF.C,I * * ERROR EXIT * * EX0 CLB STB LEN EX12 LDA =D-12 STA ERR SET MASTER ERRORCODEWORD JMP EXCLS * * * LOOP VARIABLES * * WORD 1- 5 PROMPT * 6 LENGTH OF REPLY * 7 DEFAULT * 8-21 REPLY * INP ASC 4,INPUT? OCT 3537 (BELL/BACK ARROW) ASC 1, 5 BSS 14 LENGTH WORD + 13W REPLY OUT ASC 4,OUTPUT? OCT 3537 ASC 1, 4 BSS 14 LST ASC 4,LIST? OCT 3537 ASC 1, 6 BSS 14 * DEF INP DEF LST DEF OUT PNTR DEF * DEF INP DEF OUT DEF LST PNT2 DEF * CNTR BSS 1 DFAD BSS 1 LNAD BSS 1 RDAD BSS 1 MSAD BSS 1 * * RUN STRING * LEN BSS 1 CMA OCT 26040 LEFT JUST COMMA AND BLANK STAA DEF STR STR ASC 2,RU,X X IS PLACEHOLDER FOR COMPILER NAME BSS 38 STAD BSS 1 * * GDCB BSS 144 DCB BUFFER AREA FOR INPUT .CTRN DEF C.TRN LOCAL POINTER TO LIB ERR BSS 1 ANSW BSS 5 OPOP OCT 411 OPEN OPTION CON1 BSS 1 A EQU 0 B EQU 1 INT BSS 1 LU BSS 1 X BSS 1 .5 OCT 5 .20 OCT 24 END šüÿÿ ÿý08 ÿ92064-18232 1740 S 0122 &MSAFD SOURCE FLEX. DISC BACKUP             H0101 -þúFTN4 C C VERSION 8 / 13 / 77 SL C PROGRAM SAFD C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C C C C C************************************************************** C SOURCE (&MSAFD) PART NUMBER = 92064-18232 * C RELOCATABLE (%MSAFD) PART NUMBER = 92064-16086 * C DATE = 1740 * C************************************************************** C C C C C C DIMENSION LU(5),IREG(2),IHEDD(33) DIMENSION IBUF(3840),IBF(3712) INTEGER FIRST,LAST C CCCCCCCCCCCC DIMENSION MEST(31),IHEAD(33),IH2(30),IH22(30) CCCCCCCCCCCCC DIMENSION MESS1(18),MESS2(14),MESS3(17),MESS4(21) DIMENSION MESS7(11),IPBUF(33),MESS19(16) DIMENSION MESS8(2),MESS9(11),MESS10(22),MESS11(22) DIMENSION MESS13(18),MESS14(6),MESS17(15),MESS18(12) DIMENSION MESS20(6),MESS15(22),MESS12(15),MESS16(15) C CCCCCCCCCCCCCC EQUIVALENCE (ITPE,IHEAD),(ITRAK,IHEAD(2)) EQUIVALENCE (ISEC,IHEAD(3)),(IH2,IHEAD(4)) EQUIVALENCE (IH22,IHEDD(4)) CCCCCCCCCCCCCCC EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) C C CCCCCCC DATA MEST/2HEN,2HD ,2HOF,2H C,2HAR,2HTR,2HID,2HGE,2H O,2HR , & 2HMA,2HG ,2HTA,2HPE,2H R,2HEA,2HCH,2HED,2H. ,2HIN, & 2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H ,2H , & 2H)./ DATA MESS1/6412B,2HEN,2HTE,2HR ,2HCA,2HRT,2HRI,2HDG,2HE ,2HOR, & 2H M,2HAG,2H T,2HAP,2HE ,2HLU,2H: ,2H _/ DATA MESS2/6412B,2HEN,2HTE,2HR ,2HFL,2HEX,2HIB,2HLE,2H D,2HIS, & 2HC ,2HLU,2H: ,2H _/ DATA MESS3cþú/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HFL,2HEX, & 2HIB,2HLE,2H D,2HIS,2HC ,2HLU,2H? / DATA MESS4/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HCA,2HRT, & 2HRI,2HDG,2HE ,2HOR,2H M,2HAG,2H T,2HAP,2HE ,2HLU, & 2H? / DATA MESS7/6412B,2HEN,2HTE,2HR ,2HTA,2HPE,2H H,2HEA,2HDE,2HR:, & 2H _/ DATA MESS8/2HST,2HOP/ DATA MESS9/6412B,2HFI,2HLE,2HS ,2HSA,2HVE,2HD ,2HON,2H T,2HAP, & 2HE / DATA MESS10/2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC ,2HSA,2HVE,2H O, & 2HR ,2HRE,2HST,2HOR,2HE?,2H (,2HSA,2H,R,2HE,,2HNO, & 2H):,2H _/ DATA MESS11/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HEN,2HOU,2HGH,2H T, & 2HRA,2HCK,2HS ,2HON,2H F,2HLE,2HXI,2HBL,2HE ,2HDI, & 2HSC,2H? / DATA MESS12/2HEN,2HTE,2HR ,2HMA,2HG ,2HTA,2HPE,2H F,2HIL,2HE , & 2HNU,2HMB,2HER,2H: ,2H _/ DATA MESS13/6412B,2HFI,2HLE,2HS ,2HRE,2HST,2HOR,2HED,2H O,2HN , & 2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC.,6412B/ DATA MESS14/6412B,2HHE,2HAD,2HER,2H I,2HS:/ DATA MESS15/2HER,2HRO,2HR ,2H- ,2HWR,2HON,2HG ,2HTA,2HPE,2H. , & 2HIN,2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H , & 2H ,2H)./ DATA MESS16/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HPO,2HSI,2HTI, & 2HVE,2H N,2HUM,2HBE,2HR?/ DATA MESS17/2HER,2HRO,2HR ,2H- ,2HEO,2HT ,2H- ,2HFI,2HLE,2H N, & 2HOT,2H F,2HOU,2HND,2H? / DATA MESS18/6412B,2HTE,2HRM,2HIN,2HAT,2HE ,2H(Y,2HES,2H,N,2HO), & 2H: ,2H _/ DATA MESS19/2HTO,2H C,2HON,2HTI,2HNU,2HE ,2HHI,2HT ,2HAN,2HY , & 2HKE,2HY/,2HRE,2HTU,2HRN,2H _/ DATA MESS20/6412B,2HTA,2HPE,2H #,2H ,2H / C CALL RMPAR(LU) IF(LU)1,2,32 1 STOP 2 LU=1 32 IF(LU.LE.63)33,1 33 ILU=LU+400B C CCCCCCCCCCCCCCCCCCCC JLNTH=3840 CCCCCCCCCCCCCCCCCCCC C GET SAVE OR RESTORE C 5 CALL REIO(2,ILU,ME·kþúSS10,22) X=REIO(1,ILU,IBUF,10) IF(IBUF(1).EQ.2HSA)GO TO 15 IF(IBUF(1).NE.2HRE)GO TO 8000 GO TO 2000 C C GET FLEXIBLE DISC LU 15 CALL REIO(2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 18 IDISC=IPBUF(2) LASTTR=IPBUF(6) C 16 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 10 18 CALL REIO(2,ILU,MESS3,17) 20 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 15 IF(IBUF(1).NE.2HYE)GO TO 20 GO TO 8000 C C GET CARTRIDGE OR MAG TAPE LU C 10 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) MTLU=IPBUF(2) IC=IPBUF(1) IF(IC.NE.1)GO TO 12 C CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 13 IF(IAND(ISUB,37B).EQ.1B)GO TO 14 IF(IAND(ISUB,37B).EQ.2B)GO TO 14 12 CALL REIO(2,ILU,MESS4,21) 22 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 10 IF(IBUF(1).NE.2HYE)GO TO 22 GO TO 8000 13 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 12 C C FIND PLACE ON TAPE TO BEGIN THE SAVE 7 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) IF(INUM.LE.0)GO TO 4 IF(IC.EQ.1)GO TO 6 4 CALL REIO(2,ILU,MESS16,15) GO TO 7 6 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 6 8 IF(INUM.EQ.1)GO TO 14 REWIND MTLU 19 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 19 DO 9 I=2,INUM X=EXEC(3,MTLU+1300B) 3 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 9 CALL REIO(2,ILU,MESS17,15) GO TO 7 9 CONTINUE GO TO 17 Æ·þú14 REWIND MTLU C 17 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 17 C 30 DO 31 I=1,30 IH2(I)=2H 31 CONTINUE C CALL REIO(2,ILU,MESS7,11) CALL REIO(1,ILU,IH2 ,30) C C C HAVE ALL LU'S, NOW GO COPY THE DISC... C COPY ALL DIRECTORY TRACKS FIRST, FOLLOWED BY C ALL TRACKS USED BY FMP (UN-USED TRACKS WON'T BE COPIED) C X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) FIRST=IBUF(5) LAST=IBUF(10) IF(LAST.EQ.LASTTR)LAST=LAST-1 LOWDIR=IBUF(8) C C WRITE TAPE HEADER C CCCCCCCCCCCCCCCCCC ITPE=1 ISEC=0 CALL EXEC(2,MTLU+100B,IHEAD,33) CCCCCCCCCCCCCCCCCC C C GO WRITE TRACK TO TAPE C ASSIGN 42 TO JJ C GO TO 1000 C C READ A TRACK C 40 CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) C C C GO WRITE THE TRACK TO TAPE C GO TO 1000 42 IF(ITRAK.EQ.LOWDIR)GO TO 45 ITRAK=ITRAK-1 GO TO 40 C 45 ASSIGN 49 TO JJ DO 49 ITRAK=FIRST,LAST CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) GO TO 1000 49 CONTINUE C GO TO 90 C C THIS ROUTINE RETURNS TO JJ C 1000 ICOUN=1 DO 1500 ISEC=0,58,2 C C C THIS SECTION DOES A DYNAMIC STATUS CHECK ON THE CARTRIDGE C TAPE LOOKING FOR EOT CONDITION. IF FOUND, A MESSAGE IS ISSUED C TO INFORM THE OPERATOR, AND THE PROGRAM IS SUSPENDED. C C 1001 X= EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1) GOTO 1001 ISTAT=IAND(IA,40B) IF (ISTAT.EQ.0) GO TO 1050 C C WE MUST HAVE REACHED EOT C C TELL THE OPERATOR ABOUT IT C ITPE=ITPE+1 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C C WRITE A HEADER ON THE NEW TAPE C C C REWIND MTLU C 1042 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTATKuþú.EQ.1)GO TO 1042 CALL EXEC(2,MTLU+100B,IHEAD,33) C C C THIS SECTION TRANSFERS 1 TRACK FROM IBUF TO CARTRIDGE TAPE C 128 WORDS AT A TIME. C 1050 X=EXEC(2,MTLU+100B,IBUF(ICOUN),128) ICOUN=ICOUN+128 C 1500 CONTINUE GOTO JJ C C C C 90 ENDFILE MTLU ENDFILE MTLU C C END: REWIND TAPE C 99 REWIND MTLU CALL REIO(2,ILU,MESS9,11) C GO TO 5 C C RESTORE FLEXIBLE DISC C C ENTER FLEXIBLE DISC LU C 2000 CALL REIO(2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2008 IDISC=IPBUF(2) LASTTR=IPBUF(6) C C CHECK TO MAKE SURE ITS A FLEXIBLE DISC 2005 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 2004 2008 CALL REIO(2,ILU,MESS3,17) 2021 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2000 IF(IBUF(1).NE.2HYE)GO TO 2021 GO TO 8000 C C C GET CARTRIDGE OR MAG TAPE LU C 2004 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2001 MTLU=IPBUF(2) C C CHECK TO MAKE SURE ITS A CARTRIDGE OR MAG TAPE 5000 CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 2002 C CHECK FOR SUBCHANNEL (LEFT OR RIGHT CARTRIDGE) IF(IAND(ISUB,37B).EQ.1B)GO TO 2003 IF(IAND(ISUB,37B).EQ.2B)GO TO 2003 2001 CALL REIO(2,ILU,MESS4,21) 2023 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2004 IF(IBUF(1).NE.2HYE)GO TO 2023 GO TO 8000 2002 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 2001 C C FIND PLACE ON TAPE TO BEGIN RESTORE 2012 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) C IF(INUM.LE.0)GO TO 1999 IF(IC.EQ.1)GO TO 2006 1999 CALL REIO(2,ILU,ME÷gþúSS16,15) GO TO 2012 2006 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2006 2013 IF(INUM.EQ.1)GO TO 2003 REWIND MTLU 2009 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2009 DO 2014 I=2,INUM X=EXEC(3,MTLU+1300B) 4050 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4050 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2014 CALL REIO(2,ILU,MESS17,15) GO TO 2012 2014 CONTINUE GO TO 2007 2003 REWIND MTLU C C ENTER FLEXIBLE DISC LU 2007 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2007 C C INITIALIZE IHEAD TO ZERO 2010 DO 2011 I=1,30 IH2(I)=2H 2011 CONTINUE C C READ THE FIRST TAPES HEADER AND PUT IN IHEAD. 4000 CALL EXEC(1,MTLU+100B,IHEAD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEAD(4),30) MESS20(5)=KCVT(IHEAD(1)) CALL REIO(2,ILU,MESS20,6) 4005 CALL EXEC(2,ILU,MESS18,12) X=EXEC(1,ILU,IBUF,1) IF(IBUF(1).EQ.2HYE)GO TO 8000 IF(IBUF(1).NE.2HNO)GO TO 4005 IF(IHEAD.EQ.1)GO TO 2030 ITPE=1 SEC=0 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C REWIND MTLU 4001 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4001 GO TO 5000 C PROMPT LAST TRACK ON VIRGIN DISC 2030 X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR DO 2015 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) 2015 CONTINUE C C IDIR GETS # OF DIRECTORY TRACKS C IVIR GETS AVAILABLE FMP TRACKS ON VIRGIN DISC C LAST GETS AVAILABLE FMP TRACKS ON TAPE C CHECK TO SEE IF DISC CAN HOLD FILES ON TAPE C IDIR=IBUF(9) IVIR=ITRAK+IDIR LAST=IBUF(10)-1 IF(IVIR.GE.LAST)GO TO 2020 CALL EXEC(2,ILU,MESS11,22) GO TO 8000 C C LOWDIR GETS LOWEST DIRECTORY TRACK C FIÒhþúRST GETS FIRST AVAILABLE TRACK FOR FMP 2020 LOWDIR=IBUF(8) FIRST=IBUF(5) C ASSIGN 2042 TO JJ ASSIGN 2062 TO KK C GO TO KK C 2040 DO 2041 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE C 3000 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3000 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2041 ITPE=ITPE+1 3001 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2098 REWIND MTLU 2029 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2029 C DO 3002 J=1,30 IH22(J)=2H 3002 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 3003 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 3004 3003 CONTINUE C C CHECK FOR THE RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2039 3004 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) GO TO 2098 C 2039 ITRAK=IHEDD(2) ISEC=IHEDD(3) 2041 CONTINUE GO TO KK C C DECREMENT THE TRACK NUMBER 2042 IF(ITRAK.EQ.LOWDIR)GO TO 2045 ITRAK=ITRAK-1 GO TO 2040 C C FROM FIRST TO LAST TRACK FILL UP BUFFER ONE TRACK AT A TIME. 2045 ASSIGN 2049 TO JJ ASSIGN 2060 TO KK DO 2049 ITRAK=FIRST,LAST DO 2048 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE 2047 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2047 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2048 ITPE=ITPE+1 2051 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2052 REWIND MTLU 2056 X=EXEC(3,MTLU+600B) Q0.* ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2056 C DO 2053 J=1,30 IH22(J)=2H 2053 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 2054 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 2055 2054 CONTINUE C C CHECK TO SEE IF RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2048 2055 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C GO TO 2052 2048 CONTINUE GO TO KK 2049 CONTINUE GO TO 2099 C C ELIMINATE THE FIRST SECTOR IN THE FIRST TRACK 2060 K=1 DO 2061 J=129,3840 IBF(K)=IBUF(J) K=K+1 2061 CONTINUE C C WRITE ONTO DISC CALL EXEC(2,IDISC,IBF,3712,ITRAK,2) ASSIGN 2062 TO KK GO TO JJ C 2062 CALL EXEC(2,IDISC,IBUF,JLNTH,ITRAK,0) GO TO JJ C C 2099 REWIND MTLU C C FILES RESTORED TO FLEXIBLE DISC CALL REIO(2,ILU,MESS13,18) GO TO 5 8000 CALL EXEC(2,ILU,MESS8,2) END END$ Í00ÿÿ ÿý1 > ÿ92064-18232 2001 S C0122 &MSAFD RTE-M FLEX DISC BACKUP             H0101 íþúFTN4,L C C C FLEXIBLE DISC BACKUP UTILITY C C NAME: SAFD C SOURCE: 92064-18232 C RELOC: 92064-16086 C PROGMR: SL,JRS,JUF C C C C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C **************************************************************** C C PROGRAM SAFD(3,89),92064-16086 REV.2001 790907 C DIMENSION LU(5),IREG(2),IHEDD(33) DIMENSION IBUF(3840),IBF(3712) INTEGER FIRST,LAST C CCCCCCCCCCCC DIMENSION MEST(31),IHEAD(33),IH2(30),IH22(30) CCCCCCCCCCCCC DIMENSION MESS1(18),MESS2(14),MESS3(17),MESS4(21) DIMENSION MESS7(11),IPBUF(33),MESS19(16) DIMENSION MESS8(2),MESS9(11),MESS10(22),MESS11(22) DIMENSION MESS13(18),MESS14(6),MESS17(15),MESS18(12) DIMENSION MESS20(6),MESS15(22),MESS12(15),MESS16(15) C CCCCCCCCCCCCCC EQUIVALENCE (ITPE,IHEAD),(ITRAK,IHEAD(2)) EQUIVALENCE (ISEC,IHEAD(3)),(IH2,IHEAD(4)) EQUIVALENCE (IH22,IHEDD(4)) CCCCCCCCCCCCCCC EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) C C CCCCCCC DATA MEST/2HEN,2HD ,2HOF,2H C,2HAR,2HTR,2HID,2HGE,2H O,2HR , & 2HMA,2HG ,2HTA,2HPE,2H R,2HEA,2HCH,2HED,2H. ,2HIN, & 2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H ,2H , & 2H)./ DATA MESS1/6412B,2HEN,2HTE,2HR ,2HCA,2HRT,2HRI,2HDG,2HE ,2HOR, & 2H M,2HAG,2H T,2HAP,2HE ,2HLU,2H: ,2H _/ DATA MESS2/6412B,2HEN,2HTE,2HR ,2HFL,2HEX,2HIB,2HLE,2H D,2HIS, & 2HC ,2HLU,2H: ,2H _/ DATA MESS3/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HFL,2HEX, & 2HIB,2HLE,2H D,2HIS,2HC ,2HLU,2H? / DATA MESS4/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HCA,2HRT,ú³þú & 2HRI,2HDG,2HE ,2HOR,2H M,2HAG,2H T,2HAP,2HE ,2HLU, & 2H? / DATA MESS7/6412B,2HEN,2HTE,2HR ,2HTA,2HPE,2H H,2HEA,2HDE,2HR:, & 2H _/ DATA MESS8/2HST,2HOP/ DATA MESS9/6412B,2HFI,2HLE,2HS ,2HSA,2HVE,2HD ,2HON,2H T,2HAP, & 2HE / DATA MESS10/2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC ,2HSA,2HVE,2H O, & 2HR ,2HRE,2HST,2HOR,2HE?,2H (,2HSA,2H,R,2HE,,2HNO, & 2H):,2H _/ DATA MESS11/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HEN,2HOU,2HGH,2H T, & 2HRA,2HCK,2HS ,2HON,2H F,2HLE,2HXI,2HBL,2HE ,2HDI, & 2HSC,2H? / DATA MESS12/2HEN,2HTE,2HR ,2HMA,2HG ,2HTA,2HPE,2H F,2HIL,2HE , & 2HNU,2HMB,2HER,2H: ,2H _/ DATA MESS13/6412B,2HFI,2HLE,2HS ,2HRE,2HST,2HOR,2HED,2H O,2HN , & 2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC.,6412B/ DATA MESS14/6412B,2HHE,2HAD,2HER,2H I,2HS:/ DATA MESS15/2HER,2HRO,2HR ,2H- ,2HWR,2HON,2HG ,2HTA,2HPE,2H. , & 2HIN,2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H , & 2H ,2H)./ DATA MESS16/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HPO,2HSI,2HTI, & 2HVE,2H N,2HUM,2HBE,2HR?/ DATA MESS17/2HER,2HRO,2HR ,2H- ,2HEO,2HT ,2H- ,2HFI,2HLE,2H N, & 2HOT,2H F,2HOU,2HND,2H? / DATA MESS18/6412B,2HTE,2HRM,2HIN,2HAT,2HE ,2H(Y,2HES,2H,N,2HO), & 2H: ,2H _/ DATA MESS19/2HTO,2H C,2HON,2HTI,2HNU,2HE ,2HHI,2HT ,2HAN,2HY , & 2HKE,2HY/,2HRE,2HTU,2HRN,2H _/ DATA MESS20/6412B,2HTA,2HPE,2H #,2H ,2H / C CALL RMPAR(LU) IF(LU)1,2,32 1 STOP 2 LU=1 32 IF(LU.LE.63)33,1 33 ILU=LU+400B C CCCCCCCCCCCCCCCCCCCC JLNTH=3840 CCCCCCCCCCCCCCCCCCCC C GET SAVE OR RESTORE C 5 CALL REIO(2,ILU,MESS10,22) X=REIO(1,ILU,IBUF,10) IF(IBUF(1).EQ.2HSA)GO TO 15 IF(IBUF(1).NE.2HRE)GO TO 8000 GO TO 2000 C C GET FLEXIBLE DISC LU 15 CALL REIO(ê»þú2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 18 IDISC=IPBUF(2) LASTTR=IPBUF(6) C 16 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 10 IF(ITYPE.NE.32B)GO TO 18 CALL EXEC(1,IDISC,IBUF,1,10000,0) IF(IBUF(1).EQ.60)GO TO 10 18 CALL REIO(2,ILU,MESS3,17) 20 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 15 IF(IBUF(1).NE.2HYE)GO TO 20 GO TO 8000 C C GET CARTRIDGE OR MAG TAPE LU C 10 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) MTLU=IPBUF(2) IC=IPBUF(1) IF(IC.NE.1)GO TO 12 C CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 13 IF(IAND(ISUB,37B).EQ.1B)GO TO 14 IF(IAND(ISUB,37B).EQ.2B)GO TO 14 12 CALL REIO(2,ILU,MESS4,21) 22 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 10 IF(IBUF(1).NE.2HYE)GO TO 22 GO TO 8000 13 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 12 C C FIND PLACE ON TAPE TO BEGIN THE SAVE 7 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) IF(INUM.LE.0)GO TO 4 IF(IC.EQ.1)GO TO 6 4 CALL REIO(2,ILU,MESS16,15) GO TO 7 6 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 6 8 IF(INUM.EQ.1)GO TO 14 REWIND MTLU 19 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 19 DO 9 I=2,INUM X=EXEC(3,MTLU+1300B) 3 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 9 CALL REIO(2,ILU,MESS17,15) GO TO 7 9 CONTINUE GO TO 17 14 REWIND MTLU C 17 X=EXEC(3,MTLU+600B) ISTAT=IAND(II¢þúA,1) IF(ISTAT.EQ.1)GO TO 17 C 30 DO 31 I=1,30 IH2(I)=2H 31 CONTINUE C CALL REIO(2,ILU,MESS7,11) CALL REIO(1,ILU,IH2 ,30) C C C HAVE ALL LU'S, NOW GO COPY THE DISC... C COPY ALL DIRECTORY TRACKS FIRST, FOLLOWED BY C ALL TRACKS USED BY FMP (UN-USED TRACKS WON'T BE COPIED) C X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) FIRST=IBUF(5) LAST=IBUF(10) IF(LAST.EQ.LASTTR)LAST=LAST-1 LOWDIR=IBUF(8) C C WRITE TAPE HEADER C CCCCCCCCCCCCCCCCCC ITPE=1 ISEC=0 CALL EXEC(2,MTLU+100B,IHEAD,33) CCCCCCCCCCCCCCCCCC C C GO WRITE TRACK TO TAPE C ASSIGN 42 TO JJ C GO TO 1000 C C READ A TRACK C 40 CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) C C C GO WRITE THE TRACK TO TAPE C GO TO 1000 42 IF(ITRAK.EQ.LOWDIR)GO TO 45 ITRAK=ITRAK-1 GO TO 40 C 45 ASSIGN 49 TO JJ DO 49 ITRAK=FIRST,LAST CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) GO TO 1000 49 CONTINUE C GO TO 90 C C THIS ROUTINE RETURNS TO JJ C 1000 ICOUN=1 DO 1500 ISEC=0,58,2 C C C THIS SECTION DOES A DYNAMIC STATUS CHECK ON THE CARTRIDGE C TAPE LOOKING FOR EOT CONDITION. IF FOUND, A MESSAGE IS ISSUED C TO INFORM THE OPERATOR, AND THE PROGRAM IS SUSPENDED. C C 1001 X= EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1) GOTO 1001 ISTAT=IAND(IA,40B) IF (ISTAT.EQ.0) GO TO 1050 C C WE MUST HAVE REACHED EOT C C TELL THE OPERATOR ABOUT IT C ITPE=ITPE+1 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C C WRITE A HEADER ON THE NEW TAPE C C C REWIND MTLU C 1042 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 1042 CALL EXEC(2,MTLU+100B,IHEAD,33) C C C THûþúIS SECTION TRANSFERS 1 TRACK FROM IBUF TO CARTRIDGE TAPE C 128 WORDS AT A TIME. C 1050 X=EXEC(2,MTLU+100B,IBUF(ICOUN),128) ICOUN=ICOUN+128 C 1500 CONTINUE GOTO JJ C C C C 90 ENDFILE MTLU ENDFILE MTLU C C END: REWIND TAPE C 99 REWIND MTLU CALL REIO(2,ILU,MESS9,11) C GO TO 5 C C RESTORE FLEXIBLE DISC C C ENTER FLEXIBLE DISC LU C 2000 CALL REIO(2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2008 IDISC=IPBUF(2) LASTTR=IPBUF(6) C C CHECK TO MAKE SURE ITS A FLEXIBLE DISC 2005 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 2004 IF(ITYPE.NE.32B)GO TO 2008 CALL EXEC(1,IDISC,IBUF,1,10000,0) IF(IBUF(1).EQ.60)GO TO 2004 2008 CALL REIO(2,ILU,MESS3,17) 2021 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2000 IF(IBUF(1).NE.2HYE)GO TO 2021 GO TO 8000 C C C GET CARTRIDGE OR MAG TAPE LU C 2004 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2001 MTLU=IPBUF(2) C C CHECK TO MAKE SURE ITS A CARTRIDGE OR MAG TAPE 5000 CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 2002 C CHECK FOR SUBCHANNEL (LEFT OR RIGHT CARTRIDGE) IF(IAND(ISUB,37B).EQ.1B)GO TO 2003 IF(IAND(ISUB,37B).EQ.2B)GO TO 2003 2001 CALL REIO(2,ILU,MESS4,21) 2023 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2004 IF(IBUF(1).NE.2HYE)GO TO 2023 GO TO 8000 2002 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 2001 C C FIND PLACE ON TAPE TO BEGIN RESTORE 2012 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) C IF(INUM.LE.0)GO TO 1999 IF(IC.eƒþúEQ.1)GO TO 2006 1999 CALL REIO(2,ILU,MESS16,15) GO TO 2012 2006 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2006 2013 IF(INUM.EQ.1)GO TO 2003 REWIND MTLU 2009 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2009 DO 2014 I=2,INUM X=EXEC(3,MTLU+1300B) 4050 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4050 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2014 CALL REIO(2,ILU,MESS17,15) GO TO 2012 2014 CONTINUE GO TO 2007 2003 REWIND MTLU C C ENTER FLEXIBLE DISC LU 2007 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2007 C C INITIALIZE IHEAD TO ZERO 2010 DO 2011 I=1,30 IH2(I)=2H 2011 CONTINUE C C READ THE FIRST TAPES HEADER AND PUT IN IHEAD. 4000 CALL EXEC(1,MTLU+100B,IHEAD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEAD(4),30) MESS20(5)=KCVT(IHEAD(1)) CALL REIO(2,ILU,MESS20,6) 4005 CALL EXEC(2,ILU,MESS18,12) X=EXEC(1,ILU,IBUF,1) IF(IBUF(1).EQ.2HYE)GO TO 8000 IF(IBUF(1).NE.2HNO)GO TO 4005 IF(IHEAD.EQ.1)GO TO 2030 ITPE=1 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C REWIND MTLU 4001 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4001 GO TO 5000 C C PROMPT LAST TRACK# ON DISC TO BE RESTORED C 2030 X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR DO 2015 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) 2015 CONTINUE C C IDIR GETS # OF DIRECTORY TRACKS C LOWDIR GETS LOWEST DIRECTORY TRACK C MAX GETS LAST TRACK# ON TAPE TO BE RESTORED C IDIR=IBUF(9) LOWDIR=IBUF(8) MAX=LOWDIR-IDIR-1 C C CHECK TO SEE IF DISC CAN HOLD FILES ON TAPE C IF(MAX.LT.ITRAK)ITRAK=MAX IF(MAX.EQ.ITRAK)GO TO 2020 CALL EXEC(2,IL@þúU,MESS11,22) GO TO 8000 C C FIRST GETS FIRST AVAILABLE TRACK FOR FMP C LAST GETS AVAILABLE FMP TRACKS ON TAPE C 2020 FIRST=IBUF(5) LAST=IBUF(10) C ASSIGN 2042 TO JJ ASSIGN 2062 TO KK C GO TO KK C 2040 DO 2041 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE C 3000 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3000 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2041 ITPE=ITPE+1 3001 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2098 REWIND MTLU 2029 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2029 C DO 3002 J=1,30 IH22(J)=2H 3002 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 3003 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 3004 3003 CONTINUE C C CHECK FOR THE RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2039 3004 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) GO TO 2098 C 2039 ITRAK=IHEDD(2) ISEC=IHEDD(3) 2041 CONTINUE GO TO KK C C DECREMENT THE TRACK NUMBER 2042 IF(ITRAK.EQ.LOWDIR)GO TO 2045 ITRAK=ITRAK-1 GO TO 2040 C C FROM FIRST TO LAST TRACK FILL UP BUFFER ONE TRACK AT A TIME. 2045 ASSIGN 2049 TO JJ ASSIGN 2060 TO KK IF(FIRST.NE.0)ASSIGN 2062 TO KK IF(ITYPE.EQ.32B)ASSIGN 2062 TO KK DO 2049 ITRAK=FIRST,LAST DO 2048 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE 2047 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2047 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2048 ITPE=ITPE+1 2051 MEé…0.*ST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2052 REWIND MTLU 2056 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2056 C DO 2053 J=1,30 IH22(J)=2H 2053 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 2054 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 2055 2054 CONTINUE C C CHECK TO SEE IF RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2048 2055 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C GO TO 2052 2048 CONTINUE GO TO KK 2049 CONTINUE GO TO 2099 C C ELIMINATE THE FIRST SECTOR IN THE FIRST TRACK 2060 K=1 DO 2061 J=129,3840 IBF(K)=IBUF(J) K=K+1 2061 CONTINUE C C WRITE ONTO DISC CALL EXEC(2,IDISC,IBF,3712,ITRAK,2) ASSIGN 2062 TO KK GO TO JJ C 2062 CALL EXEC(2,IDISC,IBUF,JLNTH,ITRAK,0) GO TO JJ C C 2099 REWIND MTLU C C FILES RESTORED TO FLEXIBLE DISC CALL REIO(2,ILU,MESS13,18) GO TO 5 8000 CALL EXEC(2,ILU,MESS8,2) END END$ v…0ÿÿ ÿý2 ? ÿ92064-18233 1805 S C0122 &RU.. RTE-M RUN COMMANDD             H0101 ßsSPL,L,O ! NAME: RU.. ! SOURCE: 92064-18233 ! RELOC: 92064-16087 ! PGMR: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME RU..(7) " 92064-16087 REV.1805 771103" ! ! LET EXEC BE SUBROUTINE,EXTERNAL !ERROR PRINTING ! ! ! ! ! THIS ROUTINE MAKES AN EXEC SCHEDULE WITH WAIT AND QUEUE ! (ICODE=23) FOR THE PROGRAM NAME SPECIFIED. ! ! IF THE PROG CANNOT BE FOUND, RETURNS AN ERROR 61 ! IF THE SCHEDULE OPTION WAS NOT IN THE SYSTEM, RETURNS ERROR 62 ! LET A BE CONSTANT(0) ! ! RU..: SUBROUTINE (NO,LIS,ER) GLOBAL ! LIS6_[LIS5_[LIS4_[LIS3_[LIS2_[LIS1_ \ ! SETUP PARAMETER ADDRESSES @LIS+1]+4]+4]+4]+4]+4 ! IF LIS#3 THEN [ER_10;RETURN] !PROGRAM NAME MUST BE ASCII ! ER_0 !PRESET ERROR RETURN EXEC(100000K+23,$LIS1,$LIS2,$LIS3,\ !ATTEMPT THE SCHEDULE WITH $LIS4,$LIS5,$LIS6) !THE NO-ABORT OPTION. ! GOTO EEREX !EXEC ABORTED OUR REQUEST !EITHER M1 WITHOUT %MMP OR !PROG NOT FOUND ! RETURN ! ! EEREX: AREG_$A ER_[IF AREG="SC" THEN 61, ELSE 62] RETURN END END END$ ¬ ÿÿ ÿý39 ÿ92064-18234 1805 S C0122 &MDUTF RTE-M MCDC COMMAND             H0101 Û³þúASMB,R,L,C * NAME: MCDC. * SOURCE: 92064-18234 * RELOC: 92064-16055 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MCDC.,7 92064-16055 REV.1805 771128B * * ENT MC..,RC.. EXT EXEC,.ENTR,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT DS.F1,DS.DF,DS.LU,D.LB,D.LT USED BY FM.UT EXT IMESS,FID.,CONV. * * MOUNT/DISMOUNT SUBROUTINE * * N NOP LIS NOP ER NOP MC.. NOP JSB .ENTR DEF N ISZ LIS LDA LIS,I FETCH FIRST PARAMETER SZA,RSS MUST NOT BE ZERO JMP EX50 ELSE, RETURN ERROR=50 * SSA CMA,INA ALLOW NEG NUMBERS STA LU * LDA LIS ADA D4 ADVANCE TO LAST TRACK PARAMETER STA LSTRK SAVE IT * MOUNT CARTRIDGE SUBROUTINE * THIS ROUTINE PERFORMS THE FOLLOWING: * -CHECK DRIVER TYPE (MUST BE DISC) * -DETERMINE MAX LAST TRACK * -DOES VALIDITY CHECK ON DISK * PASSES CONTROL TO DIRECTORY MANAGER (D.RFP) WHO THEN: * -FINDS DIRECTORY SPACE * -CHECKS FOR DUPLICATE DRN OR LU * -WRITES DIRECTORY ENTRY IN MEMORY RESIDENT LIBRARY (%TBLFP) * JSB EXEC GET STATUS ON LU DEF STRTN TO DETERMINE DRIVER TYPE DEF STCOD (100015B) DEF LU DEF EQT5 STRTN JMP BADLU IF LU IS UNDEFINED, EXIT LDA EQT5 AND DTYPE (36000B) CPA DISC (14000B) JMP GDLU BADLU LDA N18 JMP EXMC * CHECK FOR DVR30, IF SO, SKIP THIS SECTION GDLU LDA EQT5 AND TFLD TYPE CODE FIELD (37400B) CPA DISC TYPE 30 ? B¾þú JMP DVR30 YES LDA D9999 STA TRACK REQUEST READ FROM TRACK 9999 JSB RD16 RETURNS ACTUAL LAST TRACK IN B CCA ADB A * IF LAST TRACK NOT GIVEN, USE MAX LAST TRACK LDA LSTRK,I PASSED LAST TRACK SZA,RSS IF ZERO JMP DVR30+1 USE MAX LAST TRACK * LAST TRACK CANNOT BE > MAX LAST TRACK CMA,INA ADB A SUBTRACT FROM MAX LDA D56 SSB JMP EXMC (LAST TRACK IS > MAX) DVR30 LDB LSTRK,I LDA D55 SZB,RSS JMP EXMC STB TRACK * READ CARTRIDGE DIRECTORY JSB RD16 READ SECTOR 0 OF DIRECTORY TRACK * DO VALIDITY CHECK ON DIRECTORY * LDA DBUF FIRST WORD SSA,RSS MUST HAVE SIGN SET JMP NOINT (NOT INITIALIZED) LDA DBF3 WORD 3 (DRN) MUST BE POS NON-ZERO SSA,RSS SZA,RSS JMP NOINT LDA DBF8 WORD 8(# OF DIRECTORY TRACKS MUST BE NEG) SSA,RSS JMP NOINT LDA DBF7 FETCH LOWEST DIRECTORY TRACK CMA,INA SET IT NEG ADA DBF4 FIRST AVAIL. MUST BE < DIRECT. SSA,RSS JMP NOINT LDB DBF9 NEXT AVAIL. FMP TRACK SSB MUST BE A POSITIVE VALUE JMP NOINT CMB,INB ADB DBF7 AND--MUST BE LESS THAN OR EQUAL SSB TO LOWEST DIRECTORY TRACK JMP NOINT CLA STA NLIS CLEAR LOCK WORD * * IT IS OK!, SET UP DIRECTORY MANAGER CALL STUP LDA D7 P1=7 STA .P1 LDA LU P2=-LU STA .P3 CMA,INA P3=LU STA .P2 LDA TRACK P4=LAST TRACK STA .P4 LDA DBF3 P5=DISC REFERENCE STA .P5 LDA NLIS SET PARM #6 LDB N2 SET PARM #7 JSB CLD.R GOTO DIRECTORY MANAGER * FETCH ERROR RETURN LDA B,I (B IS POINTING TO ERROR) EXMC STA ER,I CLA STA DS.DF \PþúSTA DS.F1 FORCE NEW READ OF MASTER DIRECTORY JMP MC..,I * * * DISC WAS NOT INITIALIZED SO LOCK TO FMGR * NOINT LDA XEQT SET THIS PROG AS LOCKER (FMGR) STA NLIS SET AS LOCK PARM CLA CLEAR STA DBF3 LABEL IF NOT INIT JMP STUP CONTINUE * * EX50 LDA D50 JMP EXMC * * RD16 NOP READ A BLOCK JSB EXEC DEF R16X DEF .1 DEF LU DEF DBUF DEF .16 DEF TRACK DEF ZERO R16X JMP RD16,I * STCOD OCT 100015 EQT5 EQU N LU NOP TRACK NOP ZERO NOP * XEQT EQU 1717B * .1 DEC 1 .16 DEC 16 DTYPE OCT 36000 DISC OCT 14000 TFLD OCT 37400 DBUF BSS 16 DBF3 EQU DBUF+3 DBF4 EQU DBUF+4 DBF7 EQU DBUF+7 DBF8 EQU DBUF+8 DBF9 EQU DBUF+9 * A EQU 0 B EQU 1 * DISM - DISMOUNT SUBROUTINE PERFORMS THE FOLLOWING* * CALLS THE DIRECTORY MANAGER TO PLACE A LOCK ON THE * REQUESTED DISC - THIS ASSURES THAT NO ACTIVE OPEN * FILES EXIST ON THE DISC. * * CALLS THE DIRECTORY MANGER TO CLEAR THE DIRECTORY * ENTRY FOR THE DISC & CLOSE UP ANY GAPS IN THE * DIRECTORY CAUSED BY THE DISMOUNT. * * NN NOP NLIS NOP NER NOP RC.. NOP JSB .ENTR DEF NN * ISZ NLIS ADVANCE TO DRN PARAMETER LDB NLIS,I FETCH IT LDA D55 PRE-FETCH ERROR CODE SZB,RSS -LU OR +DRN MUST BE GIVEN JMP EXDC ELSE ERROR EXIT STB .P2 SAVE DRN/LU FOR D.RFP * * CALL FID. TO VERIFY THAT THE DISC IS MOUNTED AND HAS * BEEN INITIALIZED. * JSB FID. DEF *+2 DEF NLIS,I -LU OR DRN * SZA OK? JMP MONT? NO-EITHER NOT MOUNTED OR NO DIRECTORY * * THE DISC IS MOUNTED AND IT HAS A DIRECTORY * * * LDA D3 SET FUNCTION CODE STA .P1 FOR DISC LOCK JSB CLD.R GOTO CLD.R LDA B,I FETCH ERROR CODE SZA Ãþú JMP EXDC ERROR EXIT * DISC IS LOCKED SO NO OPEN FILES EXIST * SET UP DISMOUNT CALL TO DIRECTORY MANAGER * (IF NOT LOCKED, THEN NO DIRECTORY EXISTS) * * OK2 LDA D7 SET FUNCTION CODE STA .P1 FOR DIRECTORY MODIFICATION * * .P2 STILL CONTAINS THE -LU/DRN * CLB SET P3=0 & SUBFUNCTION (P7 WHICH STB .P3 IS PASSED VIA B) =0 FOR DISMOUNT JSB CLD.R LDA B,I FETCH ERROR CODE STA NER,I PASS IT BACK TO FMGR * * THE CALL TO FID. CAUSED THE LAST TRACK OF THE DISC TO BE SAVED * IN THE GLOBAL "D.LT". CONVERT AND PRINT IT. * JSB CONV. DEF *+4 DEF D.LT,I DEF MS DEF D4 * JSB IMESS ISSUE MESSAGE TO LOG DEF *+4 DEF D2 DEF MSS DEF D8 * JMP BYE * * * * IF MOUNTED, THE CALL TO FID. CAUSED THE GLOBALS DS.LU (DISC LU) * AND D.LB (DISC LABEL) TO THE SPECIFIED VALUES FOR THE DISC * * TO PROVE THAT THE DISC IS MOUNTED, THE LU/DRN PASSED MUST * MATCH ONE OF THE ABOVE GLOBALS. * MONT? LDA D54 PRE-FETCH ERROR CODE LDB NLIS,I FETCH THE PASSED -LU/DRN SSB WHAT WAS IT? JMP WLU IT WAS AN LU * CPB D.LB,I IT WAS A LABEL,IS IT MOUNTED? JMP OK2 YEP--GO DO DISMOUNT JMP EXDC * WLU CMB,INB SET LU POS CPB DS.LU,I IS IT MOUNTED? JMP OK2 YEP--CONTINUE EXDC STA NER,I BYE CLA STA DS.DF STA DS.F1 FORCE A NEW READ OF DISC DIRECTORY JMP RC..,I * * * LSTRK EQU NN MSS ASC 7,LAST TRACK MS NOP * N2 OCT -2 N18 DEC -18 D2 DEC 2 D3 DEC 3 D8 DEC 8 D6 DEC 6 D7 DEC 7 D4 DEC 4 D50 DEC 50 D54 DEC 54 D55 DEC 55 D56 DEC 56 D9999 DEC 9999 END À ÿÿ ÿý4 > ÿ92064-18235 1940 S C0122 &IFTTY RTE-M IFTTY SUBR             H0101 ò£þúASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED - IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92064-18235 * RELOC: 92064-16081 * PGMR: C.M.M.,J.U.F. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFTTY,7 92064-16081 REV.1940 790719 ENT IFTTY,.TTY EXT EXEC * * ROUTINE TO DETERMINE IF THE SPECIFIED LU IS INTERACTIVE * CALLED AS FOLLOWS: * * IFLAG = IFTTY(LU) JSB IFTTY * DEF *+2 * DEF LU * * * IFLAG = A REG = -1 IF THE LU IS INTERACTIVE * = 0 IF THE LU IS NON-INTERACTIVE * B REG = UPPER BYTE = DEVICE TYPE * LOWER BYTE = SUBCHANNEL NUMBER * * * .TTY EQU * IFTTY NOP ENTRY DLD IFTTY,I GET RETURN ADDRESS & LU # LDB B,I GET THE LU # STA IFTTY SAVE RETURN ADDRESS STB ANLU# AND LU # SZB,RSS IF LU 0 JMP UNDEF RETURN LU IS UNDEFINED * JSB EXEC SEE IF THE LU IS INTERACTIVE DEF *+6 DEF B15I STATUS REQUEST DEF ANLU# THE LU WE WANT THE INFO ABOUT DEF YTEMP EQT WORD 5 PLACED HERE DEF DTYPE EQT WORD 4 PLACED HERE DEF ZTEMP SUB CHANNEL IN LOWER 5 BIT HERE * JMP UNDEF IT AIN'T EVEN AN LU !!!! LDA DTYPE GET EQT WORD 4 AND M77 ISOLATE I/O SELECT CODE SZA,RSS IF LU ASSIGNED TO ZERO JMP UNDEF RETURN ITS NOT INTERACTIVE LDA YTEMP GET EQT WORD 5 AND MEQT KE‚e  EP ONLY THE EQT TYPE FIELD LDB A AND SAVE IT LDA ZTEMP GET THE SUBCHANNEL BITS AND M37 STA ZTEMP ADA B CONFIGURE B REGISTER RETURN WORD STA DTYPE SZB,RSS IF DVR 00 THEN JMP ITSIN ITS INTERACTIVE CPB M2400 IF DVR 05 THEN JMP DVR05 DO ONE MORE CHECK FOR SUB CHANNEL CPB M3400 IS IT DVR07 ? JMP DVR05 THEN DO DVR05 CHECK JMP ITSNT ELSE ITS NOT INTERACTIVE * UNDEF CLB CLEAR STB DTYPE DEVICE TYPE / SUBCHANNEL # JMP ITSNT RETURN ITS NOT INTERACTIVE * DVR05 LDA ZTEMP GET THE SUBCHANNEL # SZA,RSS IF = 0 THEN ITS INTERACTIVE ITSIN CCA,RSS SET INTERACTIVE FLAG ITSNT CLA SET NON INTERACTIVE FLAG LDB DTYPE JMP IFTTY,I RETURN TO CALLER * * B15I OCT 100015 M2400 OCT 2400 M37 OCT 37 M77 OCT 77 M3400 OCT 3400 MEQT OCT 37400 ANLU# NOP DTYPE NOP YTEMP NOP ZTEMP NOP A EQU 0 B EQU 1 END ,• ÿÿ ÿý5< ÿ92064-18237 1805 S C0122 COMPILER LIB OPEN             H0101 0 THEN THE # OF SECTORS IN THE FILE * D.RP2 = TRACK AND LOGICAL UNIT * D.RP3 = OFFSET AND SECTOR NUMBER * D.RP4 = TRACK NUMBER (LU IF TYPE = 0) * D.RP5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER * D.RP6 = SECURITY CODE OF THE FILE * D.RP7 = TYPE OF THE FILE * * OPEN LDA .2 CALL LDB C.CR ROUTINE TO JSB GEX.C OPEN A FILE DEF C.NAM JMP ERR * LDA D.RP7 CHECK TO SEE IF FILE TYPE MATCHES LDB OPTYP CPB .1 BINARY FILE OPEN?? JMP BIN YES! CPB .3 LIST FILE OPEN? JMP LST YES! * CKSC LDA D.RP6 IS SECUR¿þúITY CPA C.SC CODE OF FILE SAME AS USER SUPPLIED? JMP RETRN YES, OK! SSA FILE WRITE PROTECTED? JMP E7 YES, ILLEGAL SECURITY CODE! ISZ TMP SOURCE FILE READ? JMP E7 NO, NO CAN WRITE ON EITHER! RETRN LDB D.RP1 TYPE 0 FILE? LDA D.RP4 A=LU#,B=#SECTRS SZB,RSS JMP OPNL1 YES JSB SETUP SET UP THE FCB * * LINK THE FCB INTO THE LIST - HEAD IS GLOBAL CALLED C.HLK * LDA C.HLU,I SET TRACK LU STA C.FLU,I INTO PRIMARY LU RET1 CLA,INA STA C.WRD,I CLEAR WORD PTR LDA C.HLK GET HEAD LDB C.FCB GET ADDRESS OF FILE CONTROL BLK STB C.HLK AND SET IT IN HEAD POINTER SZA HEAD LINK PTR EMPTY? STA C.FCB,I NO, SO PLACE ADDRESS IN NEW FCB CLA CLEAR ERROR RETRUN JMP EXIT TAKE P+2 EXIT * BIN CPA .5 BINARY FILE? JMP CKSC YES! JMP E16 NO, ILLEGAL FILE TYPE * LST CPA .3 SOURCE FILE? JMP CKSC YES! CPA .4 SOURCE FILE? JMP CKSC YES! JMP E16 NO ,ILLEGAL FILE TYPE * E202 LDA M202 NO SOURCE NAMR RSS E15 LDA M15 BAD NAMR RSS E16 LDA M16 ILLEGAL TYPE RSS E201 LDA M201 NO BINARY ERROR RSS E200 LDA M200 BAD FCB FORMAT ERROR RSS TAKE P+1 ERROR EXIT E7 LDA M7 SECURITY CODE ERROR RSS EXIT ISZ OPN.C TAKE P+2 EXIT ERR JMP OPN.C,I EXIT * * WRITE BINARY (TYPE=5) FILE * WRITB LDA C.TYP IS NAME SZA,RSS A NULL? JMP E201 YES SET ERROR TO 201 SO NOT TO OUTPUT BINARY LDA C.NAM IS AND HIMSK FIRST CPA MINUS CHARACTER A MINUS? RSS YES , USE SOURCE NAME EXECPT FOR FIRST CHAR JMP CRE CREATE A TYPE 5 FILE! SMNAM CLA,INA GET SOURCE JSB GTNAM NAMR LDþúA C.FST IS FIRST CHARCTER CPA AMPSD AND AMPERSAND? RSS YES! JMP E15 NO! LDA C.NAM USE SOURCE AND B377 IOR PERCT NAMR EXCEPT STA C.NAM REPLACE FIRST CHAR BY % CRE LDB PERCT SET UP FOR POSSIBLE DUPLICATE FILE NAME CHECK LDA .5 JMP CREAT CREATE FILE OR OPEN IT * * * WRITE SOURCE FILE - LIST(CREATE TYPE 4 FILE) * WRITS LDA C.TYP IS NAMR SZA,RSS A NULL? JMP LU6 YES, SET LU TO 6 LDA C.NAM IS AND HIMSK FIRST CPA MINUS CHARACTER A MINUS? RSS YES, CREATE OR OPEN FILE WITH SAME NAME AS SOURCE JMP CRE1 CREATE FILE NAME WITH SOURCE NAMR * CLA,INA GET LIST JSB GTNAM NAMR LDA C.FST IS FIRST CPA AMPSD CHARACTER OF SOURCE NAME AN AMPERSAND? RSS YES, CREATE OR OPEN ('NAMR) JMP E15 ILLEGAL NAME LDA C.NAM STUFF IN AND B377 IOR APOST APOSTROPHE STA C.NAM CRE1 LDA .4 CREATE TYPE 4 FILE LDB APOST SET UP CREAT STB TMP APOSTROPHE FOR POSSIBLE DUPLICATE FILE NAME CHECK JSB CRE.C AND GO TO TO IT NOP ERROR, DO SPECIAL CHECK CPA M2 DUPLICATE NAME? JMP CKNAM YES, CHECK IF SAME AS SOURCE NAMR SSA,RSS ANY OTHER ERROR? JMP RETRN SETUP FCB JMP ERR YES, PASS ON THRU * * CHECK NAME TO SEE IF IT STARTS WITH A (') FOR LIST OR (%) FOR * BINARY. IF SO OPEN IT AND USE IT IF NOT THEN ERR 15. * CKNAM LDA C.NAM GET AND HIMSK FIRST CHARACTER CPA TMP IS IT A (') FOR LIST OR (%) FOR BINARY? JMP OPEN YES, OPEN EXISTING FILE JMP E15 NO, GIVE ERROR * * * * * WRITE SCRATCH FILE (GET TRACK FOR RTE-II,RTE-III, AND RTE-IV) * (OPEN SCRATCH FILES FOR RTE-M) * WRTSC LDA .4 JSB GEX.êþúC GET SCRATCH FILE JMP ERR JMP RETRN SET UP FCB * * * * OPEN LOGICAL UNIT DEVICE * LU6 LDA .6 DEFAULT TO LU 6 RSS OPNLU LDA C.NAM GET LU FROM OPNL1 STA LU SET CONTROL LU IOR B600 SET V AND K BITS TO ECHO AND PRINT COLUMN ONE ON LP CPB .1 BINARY? JMP WRTBN YES! CPB .4 SOURCE INPUT? JMP INSRC YES! SZA,RSS INPUT SOURCE-GUARANTEE REWINDABILITY? JMP INSRC YES! STA C.FLU,I SET LU SSA CMA,INA STA LU * DTTY2 JSB EXEC REQUEST STATUS DEF RT1 DEF .13 DEF LU DEF EQ5 DEF EQ4 DEF SPC * * RT1 LDA EQ5 CHECK FOR DVR00 AND TYPE SZA,RSS JMP GOOD YEP--TAKE GOOD EXIT * ADA NDVR5 CHECK FOR DVR05 SZA,RSS JMP SBCNL YEP--SO FAR SO GOOD--GO CHECK FOR SUB CHNL 0 * JMP LULK * SBCNL LDA SPC FETCH SUB CHNL AND B77 SZA JMP LULK NOT ZERO * GOOD LDA PRMPT SET PROMPT STA C.??,I CHARACTERS UP OPN1 LDA C.FID,I SET SIGN IOR SIGN BIT TO SHOW STA C.FID,I IT IS AN LU. LDA C.FID,I IS THIS AND B17 A REWINDABLE SOURCE CPA .2 READ OPERATION? RSS YES! JMP RET1 NO! * LDA .4 GET SCRATCH JSB GEX.C FILE JSB ERR JSB SETUP SET UP FCB LDA C.HLU,I AND ALSO STA C.SLU,I SETUP SECONDARY LU JMP RET1 * LULK JSB LURQ LOCK DEF *+4 DEF B101 THE DEF C.FLU,I DEF .1 DEVICE CPA .1 LU ALREADY LOCKED? JMP OPN1 YES! SZA,RSS REQUEST MAKE IT? JMP OPN1 YES! JSB EXEC NO RESCHEDULE DEF *+6 DEF .12 DEF .0 AGAIN 15 SECONDS FROM NOW DEF .2 DEF .0 þú DEF M15 JMP LULK * WRTBN IOR B100 SET BINARY STA C.FLU,I FLAG LDA LU IOR B1000 SET OUTPUT LEADER CONT STA LU JSB EXEC OUTPUT CONTROL FUNCTION DEF *+3 DEF .3 DEF LU JMP DTTY2 * INSRC LDA LU IOR B700 SET END-OF PAPER TAPE JMP CONT * SIGN DEF 0,I * * INDIRECT ROUTINE * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I * * GET THE DEFAULT FILE NAMR INTO GLOBAL STORAGE * * CALLING SEQUENCE: * A = DEFAULT PARAMETER NUMBER * JSB GTNAM * * GTNAM NOP ADA M1 COMPUTE MPY .10 OFFSET WITHIN BUFFER ADA TRNON LDB TOADD MOVE DATA JSB .MVW TO BUFFER DEF .8 NOP LDA C.CR IS CARTRIDGE SZA,RSS NUMBER SUPPLIED? LDA C.TRN+5 NO, USE SOURCE CR! STA C.CR JMP GTNAM,I RETURN * * * SET UP DATA IN FCB * SETUP NOP LDB C.BFF LDA B100K SET UP BUFFER STA B,I CCA INB STA B,I FLAGS LDA D.RP1 MAKE SECTORS/FILE INTO BLOCKS/FILE RAR STA C.#SC,I AND SAVE IN FCB LDA D.RP2 AND B77 ISOLATE FILE LU AND STA TMP SAVE IT CMA,INA SET MINUS LU STA C.TRN+5 SOURCE FILE NAMR FOR LIST, BINARY DEFAULTS LDB C.#SC,I GET FILE SIZE LDA D.RP4 GET START STA C.STR,I TRACK AND SET IN FCB STA C.HTR,I IN BOTH CURRENT AND HEAD TRACK LDA TMP DISC FILE! IOR PROBT OR IN DISC UNPROTECT BITS STA C.HLU,I SET IN FCB LDA D.RP5 EXTRACT AND B377 START SECTOR STA C.SSC,I SET START BLOCK XOR D.RP5 EXTRACT ALF,ALF #BLOCKS/TRACK RAR STA C.S/T,I SET UP NUMBER OF BLOCKS/TRACK IN FCB JMP SETUP,I * * * * * CONSTANTS AND B‚ç0.*UFFERS * TRNON DEF C.TRN TOADD DEF C.NAM TURN ON STRING ADDRESS TMP BSS 1 OPTYP BSS 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .8 DEC 8 .10 DEC 10 .12 DEC 12 .13 DEC 13 M1 DEC -1 M2 DEC -2 M7 DEC -7 M15 DEC -15 M16 DEC -16 M200 DEC -200 M201 DEC -201 M202 DEC -202 B17 OCT 17 B77 OCT 77 B100 OCT 100 B377 OCT 377 B600 OCT 600 B700 OCT 700 B1000 OCT 1000 HIMSK OCT 177400 TYPE OCT 37400 NDVR5 OCT -2400 EQ4 NOP EQ5 NOP LU NOP SPC NOP B101 OCT 100001 B100K OCT 100000 PROBT OCT 74000 PRMPT BSS 1 MINUS OCT 26400 MINUS CHARACTER AMPSD OCT 23000 AMPERSAND PERCT OCT 22400 PERCENT CHARACTER APOST OCT 23400 APOSTROPHE CHARACTER SPC 2 END ·b0ÿÿ ÿý6 C ÿ92064-18238 1805 S C0122 COMPILER LIB CLOSE             H0101 `yþúASMB,R,L,C HED COMPILER LIBRARY CLOSE ROUTINE NAM CLO.C,7 92064-18238 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18055 * * * CLOSE FILE ROUTINE * * THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND REMOVE IT * FROM THE LIST. IT WILL THEN BE CLOSED. IF IT IS A SCRATCH FILE * THE TRACKS WILL BE RETURNED TO THE SYSTEM. IF IT IS A READ FILE * IT WILL BE CLOSED. IF IT IS WRITE FILE THE * FCB WILL BE CHECKED TO SEE IF THE BUFFER NEEDS TO BE WRITTEN OUT * AND IF SO IT WILL BE WRITTEN OUT PRIOR TO CLOSING. * ALSO IF THE FILE DOES NOT HAVE EXTENTS IT WILL BE TRUNCATED. * * * * * * * CALLING SEQUENCE: * * JSB CLO.C * DEF FCB * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * * * ENTRY POINT: * ENT CLO.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT GEX.C D.RTR REPLACEMENT ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT GE#SC WRITE OUT BUFFER ROUTINE EXT D.RP1 ERROR PARAMETER FROM D.RTR CALL EXT C.HLK HEAD OF FCB LINKED LIST EXT C.LNK FCB LINK WORD EXT C.FCB ADDRESS OF FCB EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WOzœþúRD EXT C.RSC CURRENT OFFSET SECTOR NUMBER EXT C.BFF FCB BUFFER ADDRESS WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS EXT C.CNT FCB CONTROL ROUTINE ADDRESS * EXT C.FCB ADDRESS OF FCB * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * * * A EQU 0 B EQU 1 * CLO.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES DEC 0 CLA STA SECTS SET FOR NO TRUNCATION LDA AHEAD GET ADDRESS OF NEXT LDB A,I PTR AND ALSO PTR SZA,RSS IS IT EMPTY? JMP CLO.C,I ERROR EXIT CPB C.FCB IS IT THE ONE WE'RE LOOKING FOR JMP FND YES, GOT IT LDA B NO, CONTINUE ON DOWN THE LIST JMP NEXT FND LDB B,I REMOVE STB A,I IT BY CONNECTING NEXT TO PREVIOUS FCB * LDA C.#SC,I IS THIS A LOGICAL SZA,RSS UNIT? JMP EXIT YES, JUST EXIT * LDA C.FID,I DETERMINE AND B17 FCB TYPE CPA .2 SCRATCH? JMP CLSSC CLOSE SCRATCH FILE SZA,RSS READ FCB JMP CLSRD CLOSE READ FCB * CLSWR LDA C.BFF,I SHOULD BUFFER SSA,RSS BUFFER BE FLUSHED? JMP TRUN NO! CLA CLOSE WRITE FCB CLB JSB GE#SC AND FLUSH BUFFER JMP CLO.C,I ERROR RETURN * * TRUNCATE IF NO EXTENTS * TRUN LDA C.EXT,I ÿò IS SZA AND EXTENTS? JMP CLSRD YES! LDA C.RSC,I DETERMINE CMA,INA ADA C.#SC,I NUMBER OF UNUSED RAL ADA M2 SECTORS CMA,INA COMPLEMENT STA SECTS JMP CLSRD CLOSE FILE * * * CLOSE SCRATCH FILE * CLSSC LDA .5 CALL CLOSE GEX.C TO RETURN SCRATCH FILE JSB GEX.C JMP EXIT YES! * * CLOSE READ FILE * CLSRD CLA CLOSE FILES CLB JSB GEX.C DEF SECTS JMP CLO.C,I ERROR EXIT P+1 EXIT ISZ CLO.C JMP CLO.C,I OK RETURN P+2 * * CONSTANTS AND BUFFERS * AHEAD DEF C.HLK ADDRESS OF HEAD OF LINKED LIST SECTS NOP NUMBER OF SECTORS TO TRUNCATE ID BSS 5 .1 DEC 1 .2 DEC 2 .5 DEC 5 M2 DEC -2 B17 OCT 17 END ‡‹ÿÿ ÿý7? ÿ92064-18239 1805 S C0122 COMPILER LIB SPACE             H0101 cmþúASMB,R,L,C HED COMPILER LIBRARY SPACE ROUTINE NAM SPC.C,7 92064-18239 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18058 * * * LINE SPACE ROUTINE * * THIS ROUTINE WILL EJECT PAGES AND SPACE LINES ON LISTINGS * * * * * * * CALLING SEQUENCE: * * JSB SPC.C * DEF FCB * DEF FUN * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * WHERE FUN < 0 INDICATES PAGE EJECT IF LINE PRINTER * FUN > 0 SPACE 'FUN' LINES. * * * * ENTRY POINT: * ENT SPC.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT WRTC. WRITE ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS EXT C.CNT FCB CONTROL ROUTINE ADDRESS * EXT C.PR1 PARAMETER ONE †þúADDRESS * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = R IS READ SOURCE GUARANTEE REWINDABLILITY * * * A EQU 0 B EQU 1 * SPC.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES M1 DEC -1 LDB C.PR1,I GET CONTROL FUNCTION WORD LDA C.FID,I GET FILE/LU FLAG SSA IS THIS LU? JMP LUDEV YES! * * THIS A FILE SO WRITE EITHER A M1 FOR PAGE EJECT OR WRITE * THE NECESSARY LINE FOR LINE SPACING. * LDA LBUF SET UP BUFFER STA C.PR1 FOR WRITE SSB PAGE EJECT? JMP EJCTF WRITE A M1 IN COL 1 OF A LINE TO DO PAGE EJECT CMB,INB SET UP LINE STB CTR COUNTER WRT LDB .1 WRITE A JSB WRTC. A BLANK LINE(ONE CHAR) JMP ERROR ERROR RETURN ISZ CTR DONE? JMP WRT NO! JMP RETRN YES! * * EJECT PAGE * EJCTF LDA PBUF SET UP STA C.PR1 PAGE EJECT BUFFER LDB .1 JSB WRTC. WRITE A MINUS ONE FOR PAGE EJECT JMP ERROR ERROR RETURN JMP RETRN * LUDEV LDA C.FLU,I SET UP CONTROL WORD AND B77 MASK EXTRANEOUS BITS IOR B1100 MASK IN LINE CONTROL FUNCTIONS STA LU STB CTR SET CONTROL FUNCTION JSB EXEC PERFORM DEF *+4 DEF .3 CONTROL FUNCTION DEF LU DEF CTR RETRN ISZ SPC.C GOOD RETURN ERROR JMP SPC.C,I RETURN * * CONSTANTS AND VARIABLES * .1 DEC 1 .3 DEC 3 B77 OCT 77 B1100 OCT 1100 CTR NOP LINE COUNTER LU NOP LOGICAL UNIT LBUF DEF *+1 ASC 1, BLANKS PBUF DEF .1 END Eu ÿÿ ÿý8@ ÿ92064-18240 1805 S C0122 COMPILER LIB REWIND             H0101 xþúASMB,L,C NAM RWN.C,7 92064-18240 770523 REV. 1726 $CLIB * * NAME: RWN.C * SOURCE: 92060-18059 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE PROVIDES THE REWIND FUNCTION FOR THE COMPILER * LIBRARY/ SPC 3 * PROC REWIND(FCB); * RECORD FCB; * BEGIN * BOOLEAN READWRITEFLAG := FALSE; * ADDRESSETUP; * IF WRITEBUFFER THEN * [ IF FCB.UNITRECORD THEN * [ FCB.UNITRECORD := FALSE; * FCB.FLU := FCB.SLU] * GETNEXTSECTOR(FALSE); * IF ERROR THEN GO ERROR EXIT;] * FCB.EXTENT# := 0; * GEX.C(3,FALSE); * ^ * +---------READWRITEFLAG = WRITE * IF RETURNP1 < 0 THEN * GO ERROR EXIT; * FCB.STARTTRACK := RETURNP4; * FCB.STARTSECTOR := RETURNP5 AND @377; ] * FCB.OFFSETBLOCK :=0; * FCB.RECORD# := 0; * BUFFERVALID := FALSE; * FCB.BP ;= 1; * END OF REWIND SKP ENT RWN.C EXT ADS.C ADDRESS SETUP PROC EXT C.FLU FCB PRIMARY FILE LU EXT C.HLU FCB HEAD LOGICAL UNIT EXT C.SLU FCB SECONDARY FILE LU EXT C.FAD FCB FILE DIRECTORY ADDRESS EXT C.HTR FCB HEAD TRACK EXT C.STR FCB START TRACK EXT C.SSC FCB START SECTOR EXT C.RSC FCB OFFSET BLOCK EXT C.FID FCB ID EXT C.EXT FCB EXTENT # EXT C.BFF FCB BUFFER POINTER EXT C.WRD FCB WORD OFFSET POINTER EXT C.RC# FCB RECORD NUMBER EXT GES.C THE DISC READ/WRITE ROUTINE EXT GEX.C THE HIDE THE FMGR/OPSYS ROUTINE EXT D.RP1 D.RTR RETURN PARAM‚µ  ETER 1 EXT D.RP4 D.RTR RETURN PARAMETER 4 EXT D.RP5 D.RTR RETURN PARAMETER 5 EXT EXEC GUESS WHO B EQU 1 SPC 2 * PROC REWIND(FCB); * RECORD FCB; * BEGIN * BOOLEAN READWRITEFLAG := FALSE; RWFLG OCT 0 SPC 2 RWN.C BSS 1 ENTRY POINT * ADDRESSETUP; JSB ADS.C DEC 0 * IF WRITEBUFFER THEN LDA C.BFF,I SSA,RSS JMP L0 * [ IF FCB.UNITRECORD THEN LDA C.FID,I SSA,RSS JMP LA * [ FCB,UNITRECORD := FALSE ELA,CLE,ERA STA C.FID,I * FCB.FLU := FCB.SLU; LDA C.SLU,I STA C.FLU,I * [ GETNEXTSECTOR(FALSE); LA EQU * CLA JSB GES.C * IF ERROR THEN GO ERROR EXIT;] JMP RWN.C,I * FCB.EXTENT# := 0; L0 EQU * CLA STA C.EXT,I * GEX.C(3,FALSE); LDA =D3 JSB GEX.C DEF RWFLG * IF RETURNP1 < 0 THEN * GO ERROR EXIT; JMP RWN.C,I * FCB.STARTTRACK := RETURNP4; LDA D.RP4 STA C.STR,I * FCB.STARTSECTOR := RETURNP5 AND @377; ] LDA D.RP5 AND =B377 STA C.SSC,I * FCB.OFFSETBLOCK := 0; L2 EQU * CLA STA C.RSC,I * FCB.RECORD# := 0; STA C.RC#,I * BUFFERVALID := FALSE; STA C.BFF,I * FCB.BP ;= 1; INA STA C.WRD,I * END OF REWIND ISZ RWN.C JMP RWN.C,I END (– ÿÿ ÿý9@ ÿ92064-18250 1805 S C0122 COMPILER LIB BIN-R FCB             H0101 «uþúASMB,R,L,C HED COMPILER LIBRARY BINARY FILE CONTROL BLOCK NAM C.BIN,7 92064-18250 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18077 * * * * WRITE BINARY - RECORD ORIENTED * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 9 * +---„þú---------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.BIN * EXT C.BBI BINARY BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ S¿_ OURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.BIN NOP LINK OCT 14001 DEFAULT PARAMETER #3, WRITE BINARY FILE NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BBI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END d7ÿÿ ÿý:B ÿ92064-18251 1805 S C0122 COMPILER LIB LST FCB             H0101 ŠrþúASMB,R,L,C HED COMPILER LIBRARY LIST FILE CONTROL BLOCK NAM C.LST,7 92064-18251 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * SOURCE PART NUMBER : 92060-18078 * * * * WRITE LIST FILE - LINE SPACE AND EOF * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 9 * Úþú +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.LST * EXT C.BLI LIST BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE = 0 FOR pë READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.LST NOP LINK OCT 10003 DEFAULT PARAMETER #2, WRITE LIST FILE OCT 1 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BLI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END üÐÿÿ ÿý;C ÿ92064-18252 1805 S C0122 COMPILER LIB SCR FCB 0             H0101  bþúASMB,R,L,C HED COMPILER LIBRARY SCRATCH #0 FILE CONTROL BLOCK NAM C.SC0,7 92064-18252 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18079 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR!6þúD 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.SC0 * EXT C.BS0 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE 4¾ = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC0 NOP LINK OCT 00002 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS0 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END ·ÿÿÿ ÿý<D ÿ92064-18253 1805 S C0122 COMPILER LIB SCR FCB 1             H0101 ¢bþúASMB,R,L,C HED COMPILER LIBRARY SCRATCH #1 FILE CONTROL BLOCK NAM C.SC1,7 92064-18253 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18080 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR%-þúD 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.SC1 * EXT C.BS1 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE 6¾ = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC1 NOP LINK OCT 00102 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS1 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END ºÿÿÿ ÿý=E ÿ92064-18254 1805 S C0122 COMPILER LIB SCR FCB 2             H0101 ¤bþúASMB,R,L,C HED COMPILER LIBRARY SCRATCH #2 FILE CONTROL BLOCK NAM C.SC2,7 92064-18254 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18081 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR(.þúD 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWIDABLE SOURCE * * * ENT C.SC2 * EXT C.BS2 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE ³ = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC2 NOP LINK OCT 00302 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS2 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END ¾ÿÿÿ ÿý>F ÿ92064-18255 1805 S C0122 COMPILER LIB SCR BFR 0             H0101 ¯eASMB,R,L,C HED COMPILER LIBRARY SCRATCH BUFFER #0 NAM C.BS0,7 92064-18255 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18089 * * * SOURCE I/O BUFFER * ENT C.BS0 BUFFER ENTRY POINT * * * C.BS0 BSS 129 * * END ”ÿÿ ÿý?E ÿ92064-18256 1805 S C0122 COMPILER LIB INITIALIZE             H0101 ÈíþúASMB,R,L,C HED COMPILER LIBRARY INITIALIIZE SUBROUTINE IFZ NAM SUP.C,7 92060-18091 770515 REV. 1726 $CLIB XIF IFN NAM SUP.C,7 92064-18256 770515 REVM. 1726 $CLIB XIF * * * Z OPTION GETS YOU AN RTE-II/RTE-III VERSION * N OPTION GETS YOU AN RTE-M VERSION * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18091 * * * * ENTRY POINT: ENT SUP.C * * EXTERNALS: * EXT C.TRN TURN ON STRING FROM 'RUN' EXT EXEC EXT .MVW MOVE WORDS ROUTINE UNL IFZ LST EXT NAMR PARSE TURN ON STRING UNL XIF IFN LST EXT GTF.C GET FILE NAMES EXT C.HLK HEAD OF LINKED FCB'S EXT C.SN0 SOURCE NAME ADDRESS EXT C.BN0 BINARY NAME ADDRESS EXT C.LN0 LIST NAME ADDRESS EXT C.PC0 PAGE COUNT EXT RMPAR UNL XIF LST * * * * * CALLING SEQUENCE: * * JSB SUP.C * DEF STRING * ERROR RETURN * NO ERROR RETURN * * * A < 0 INDICATES THE ERROR * B = STRING LENGTH IN WORDS * * * WHERE: STRING IS A FIFTEEN WORD ARRAY CONTAINING THE TIME IN THE * FORMAT "12:01 PM MON., 29 DEC., 1982" * * * NOTE: THIS ROUTINE CAN BE CALLED ONCE AT THE BEGINNING OF THE LANGUAGE * PROCESSOR. AFTER THAT IT WILL BE USED AS A BUFFER FOR THE OTHER * ROUTINES OF THE COMPILER LIBRARY. * IT WILL ALSO GET THE LANGUAGE TURN ON STRING FROM THE OPERATING * SYSTEM AND STORE &åþúIT IN THE GLOBAL ARRAY C.TRN. ONLY THE FIRST * FOUR PARAMTERS ARE RECOVERED. * SUP PRESS * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D1 DEC 1 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 M3 DEC -3 M80 DEC -80 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 O4 OCT 4 * * SUP.C NOP UNL IFN LST JSB RMPAR DEF *+2 DEF PBUFF CLA CLEAR OUT STA C.HLK FOR RESTART UNL XIF LST DATE JSB EXEC DEF *+4 DEF O13 GET TIME DEF ITIME DEF IYEAR LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY ¯ùþú CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB SUP.C,I GET RETURN ADDRESS LDA TMSGA AND THE TIME ARRAY JSB .MVW MOVE IT DEF D15 NOP * UNL IFN LST JSB GTF.C GET THE FILE NAMES DEF *+6 DEF * DEF PBUFF DEF C.SN0 SOURCE FILE NAME DEF C.BN0 BINARY FILE NAME DEF C.LN0 LIST FILE NAME LDB PBUFF+3 STB C.PC0 SETUP THE PAGE COUNT SSA ERROR? JMP ERROR YES * LDB ATRN RSS LDB B,I RBL,CLE,SLB,ERB MAKE ADDR DIRECT JMP *-2 STB ATRN * * UNL XIF IFZ LST CLA LDB ADATE STA B,I CLEAR OUT PROGRAM INB PRIOR TO ISZ MD60 READING IN TURN ON STRING JMP *-3 * JSB EXEC GET TURN ON DEF *+5 STRING FROM DEF D14 :RU,,STRING DEF D1 AND STORE ON TOP OF THIS ROUTINE ADATE DEF DATE DEF M80 * STB LEN SAVE LENGTH OF PASSED STRING * SKIP OVER 'RU,' * GETPR JSB NAMR SKIP DEF *+5 BUFFA DEF C.TRN OVER FIRST DEF DATE DEF LEN TWO PARAMETERS DEF D1 SSA DONE? JMP DONE YES! LDA M3 INA DONE FIRST STA M3 SSA TWO? JMP GETPR NO! CPA O4 FINISHED? JMP DONE YES! LDA BUFFA INCREMENT RSS LDA A,I RAL,CLE,SLA,ERA STRIP OFF INDIRECT JMP *-2 ADA D10 TO NEXT STA BUFFA PARAMETER POSITION JMP GETPR UNL XIF LST DONE ISZ SUP.C ERROR ISZ SUP.C LDB D15 STRING LENGTH PASSED ON JMP SUP.C,I RETURN * SPC 2 PD00 NOP CONVERT TO 2 ASCII DIGITS CLB Ñ¢ DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 LEN EQU PD00 D14 DEC 14 D15 DEC 15 O5 OCT 5 O7 OCT 7 D31 DEC 31 D153 DEC 153 D366 DEC 366 UNL IFN LST ATRN DEF C.TRN PBUFF BSS 5 UNL XIF LST * SPC 1 * ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * END Õ¹ÿÿ ÿý@I ÿ92064-18257 1940 S C0122 &LOGLU RTE-M LOGLU SUBR             H0101 ç˜þúASMB,R,L,C ** LOGLU - RETURNS LU FROM $CON ENTRY POINT HED - LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92064-18257 * RELOC: 92064-16081 * PGMR: R.T.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOGLU,7 92064-16081 REV.1940 790717 ENT LOGLU EXT $CON * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * CALLED AS FOLLOWS: * * LU = LOGLU(IDUMY) JSB LOGLU * DEF *+2 * DEF IDUMY * * * LU = A REG = LU # OF LU AT WHICH 'RU' OR 'ON' WAS ENTERED. * OR IF SCHEDULED BY A FATHER, THE LU AT WHICH * THE FATHER WAS SCHEDULED. * = 1 IF PROGRAM SCHEDULED BY INTERUPT OR TIME LIST * B REG = ASCII LU # * IDUMY = -1 SET TO NON-SESSION MODE SINCE RTE-M * DOES NOT SUPPORT SESSION MONITOR * * LOGLU NOP ENTRY DLD LOGLU,I GET RETURN ADDRESS & DUMMY ADDRESS STB DUMMY SAVE DUMMY ADDRESS STA LOGLU &RETURN ADDRESS CCA SO SET SESSION INDICATOR STB DUMMY,I GIVE ANSWER TO CALLER * SPC 1 *************************************************************** * SESSION MONITOR LU RETRIEVAL CODE TO BE INSERTED HERE * *************************************************************** SPC 1 * LDA $CON,I .FETCH TERM LU # AND B77 .MASK OUT LU STA LU# * CLB .SET UP FOR INTEGER DIVIDE Ý~   DIV D10 NOW CONVERT LU TO ASCII ALF,ALF ADB A ADB ASC00 B = ASCII LU # LDA LU# A = BINARY LU # JMP LOGLU,I RETURN * * * D10 DEC 10 B77 OCT 77 DUMMY NOP LU# NOP ASC00 ASC 1,00 A EQU 0 B EQU 1 END !* ÿÿ ÿýAH ÿ92064-18258 1901 S C0122 &GMM.M GET MEMRY /COMPILER LIB             H0101 úDþúASMB,L,C HED COMPILER LIBRARY - GET MAIN MEMORY * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * SOURCE: 92064-18258 * * * NAM GMM.C,7 92064-16089 780921 REV. 1901 $CLIB EXT LIMEM ENT GMM.C * * THIS COMPILER LIBRARY ROUTINE SCANS THE CALLER-PROVIDED SEGMENTS' * ID SEGMENTS AND RETURNS THE AMOUNT OF MAIN MEMORY BETWEEN THE * HIGHEST USED AND THE END OF MAIN MEMORY. THIS IS THE AREA THAT * MAY BE USED AS SYMBOL TABLE AREA BY THE CALLER. * * CALLING SEQUENCE: JSB GMM.C * DEF #SEGS NUMBER OF SEGMENTS * DEF ENTRY POINT OF A ROUTINE WHICH * HAS THE FOLLOWING CALLING SEQUENCE: * RETURNS: A = FWAM * B = LWAM * * * JSB * DEF SEG# SEGMENT NUMBER (POSITIVE) * SEG# < #SEGS * * RETURNS: B = ADDRESS OF THE REFERENCED SEGMENT'S * (SEG#) NAME (5 CHARACTERS) * * DEF not reqd if #SEGS is zero * GMM.C NOP ENTRY JSB LIMEM GET DATA FROM SUP DEF *+4 DEF NSEG JUST A ZERO DEF CMIN DEF ENTRY CCB COMPUTE THE LWAM ADB ENTRY ADB CMIN FROM THE # OF WORDS AND ORG ISZ GMM.C STEP RETURN ADDRESS XIF LDA CMIN A=FWAM ISZ GMM.C JMP GMM.C,I EXIT * BKLWA EQU 1777B A EQU 0 B EQU 1 CMIN NOP ENTRY NOP NSEG NOP END ?V  ÿÿ ÿýBI ÿ92064-18259 1901 S C0122 &OLY.M LOAD OVRLY /COMPILER LIB             H0101 kASMB,L,C HED COMPILER LIBRARY - GET SEGMENT * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * SOURCE: 92064-18259 * * NAM OLY.C,7 92064-16089 780815 REV. 1901 $CLIB EXT SEGLD SUP EQU SEGLD ENT OLY.C ENT C.OLY ADDRESS OF CURRENT SEGS ID * * THIS COMPILER LIBRARY ROUTINE LOADS A NEW SEGMENT INTO MEMORY * AND TRANSFERS CONTROL TO IT. * * CALLING SEQUENCE: JSB OLY.C * DEF SEGID POINTER TO SEGMENT NAME * * OLY.C NOP ENTRY LDA OLY.C,I STA C.OLY SEGMENT NAME JSB SEGLD CALL THE SUPERVISOR DEF *+3 C.OLY NOP DEF SEGL ISZ OLY.C SHOULD NOT RETURN JMP OLY.C,I IF IT RETURNS, EXIT * SEGL OCT 100010 END °3ÿÿ ÿýCI ÿ92064-18260 1901 S C0122 &END.M END /COMPILER LIB             H0101 ¤•þúASMB,R,L,C HED COMPILER LIBRARY END ROUTINE NAM END.C,7 92064-16089 781006 REV. 1901 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92064-18260 * * * END ROUTINE * * THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND CLOSE ALL * FILES. * * * * * * * CALLING SEQUENCE: * * JSB END.C * DEF COMLST THIS LIST IS NOT USED IN RTE-M * ERROR RETURN * * * * ENTRY POINT: * ENT END.C * * EXTERNALS: * EXT LIMEM RETURN MEMORY EXT EXEC SYSTEM EXEC EXT PRTN PARAMETER RETURNER EXT CLO.C CLOSE ROUTINE EXT C.HLK HEAD OF FCB LIST * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * * * * END.C NOP LDA C.HLK GET ADDRESS OF END1 STA FCB OF FCB SZA,RSS END? JMP EXIT YES! JSB CLO.C CLOSE FCB FCB NOP JMP ERROR ERROR! LDA FCB,I GET NEXT FCB ADDRESS JMP END1 AND CLOSE IT * ERROR ISZ END.C STEP TO RETURN JSB LIMEM RETURN MEMORY DEF *+2 DEF M1 JMP END.C,I ERROR RETURN * EXIT JSB EXEC DEF *+2 DEF .6 * .6 DEC 6 M1 DEC -1 END d  ÿÿ ÿýDK ÿ92064-18261 1901 S C0122 &GMS.M GET MEM SG /COMPILER LIB             H0101 èEASMB,L,C HED COMPILER LIBRARY - GET MAIN MEMORY * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * SOURCE: 92064-18261 * * * NAM GMS.C,7 92064-16089 780726 REV. 1901 $CLIB EXT LIMEM ENT GMS.C * * THIS COMPILER LIBRARY ROUTINE RETURNS THE FREE MEMORY BOUNDS FOR * THE CURRENT SEGMENT OF A SEGMENTED PROGRAM. * * CALLING SEQUENCE: JSB GMS.C * RETURNS: A = FWAM * B = LWAM * * GMS.C NOP ENTRY JSB LIMEM GET BOUNDS FROM SUP DEF *+6 DEF ZERO DEF DUM DEF DUM DEF FWAM DEF NUMWD CCB COMPUTE LWAM ADB NUMWD FROM NUMBER ADB FWAM AND DIMIT LDA FWAM FWAM TO A JMP GMS.C,I RETURN * ZERO NOP DUM NOP FWAM NOP NUMWD NOP A EQU 0 B EQU 1 END šÿÿ ÿýEK ÿ92064-18262 1901 S C0122 &GEX.M D.RTR INTF /COMPILER LIB             H0101 GþúASMB,L,C NAM GEX.C,7 92064-16090 781101 REV. 1901 $CLIB SPC 3 * NAME: GEX.C * SOURCE: 92064-18262 * PGMR: EARL STUTES * * CALLING SEQUENCE: LDA function * LDB cr * JSB GEX.C * DEF parameter *iff function<=3 * SPC 3 *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * USE ASMB,Z FOR RTE M * USE ASMB,N FOR RTE II-III-IV SPC 3 * THIS PROCEDURE HANDLES SEVERAL OF THE DIFFERENCES BETWEEN RTE-II AND * RTE II-III AND RTE-M FOR THE COMPILER LIBRARY * PROC CALLD.RTR(FUNCTION,PRAM,CR); * VALUE FUNCTION,CR; INTEGER FUNCTION,CR; * POINTER PRAM; * FUNCTION IS PASSED IN THE A REGISTER * CR IS PASSED IN THE B REGISTER * PRAM IS A POINTER TO THE SET OF DATA NEEDED BY THE FUNCTION REQUESTED * * THE FUNCTION VALUES ARE: * 0 => CLOSE * 1 => CREATE * 2 => OPEN NEW FILE * 3 => OPEN EXTENT * 4 => OPEN SCRATCH FILE * 5 => CLOSE SCRATCH FILE * * THE PARAMETERS ARE DEFINED BY THE FUNCTION: * * 0 => PRAM = POINTER TO THE NUMBER OF SECTORS TO BE DELETED * 1 => PRAM = A POINTER TO THE SKELETON DIRECTORY ENTRY IN CORE * 2 => PRAM = POINTER TO THE NAME BUFFER * 3 => PRAM = POINTER TO THE READ/WRITE FLAG * * THE RETURNED PARAMETERS WILL BE RETRIEVED AND PLACED * VARIABLES VISIBLE TO THE CALLER * THE FIRST FIVE ARE THOSE COMING DIRECTLY FROM D.RTR * THE 6TH & 7TH ARE THOSE PARAMETERS NEEDED BY THE NEW OPEN FUNCTION ENT .R1 D.RTR RETURN PARAMETER #1 ENT .R2 D.RTR RETURN PARAMETER #2 ENT .R3 D.RT|óþúR RETURN PARAMETER #3 ENT .R4 D.RTR RETURN PARAMETER #4 ENT .R5 D.RTR RETURN PARAMETER #5 ENT .R6 D.RTR RETURN PARAMETER #6 SECURITY CODE ENT .R7 D.RTR RETURN PARAMETER #7 TYPE CODE * BEGIN * CASE FUNCTION OF * MAKECLOSECALL; * MAKECREATCALL; * MAKEOPENCALL; * MAKEOPENEXTCALL; * DOSCRATCHOPENTRICK; * DOSCRATCHCLOSETRICK; * ESAC; * FETCHRETURNPRAMETERS; * IF ERROR THEN * GO ERROR EXIT; * IF FUNCTION = NEWOPEN THEN * GETP6&P7; * END OF CALLD.RTR SKP ENT GEX.C ENT PROBT EXT EXEC GUESS WHO EXT P.PAS PARAMETER PASSING EXT C.FAD FCB FILE DIRECTORY WORD EXT C.BFF FCB BUFFER POINTER EXT C.FID FCB ID WORD EXT C.EXT FCB EXTENT COUNTER EXT C.HLU FCB HEAD LU EXT C.S/T FCB SECTORS / TRACK EXT C.HTR FCB HEAD TRACK EXT C.STR FCB CURRENT START TRACK EXT C.FLU FCB LOGICAL UNIT EXT C.#SC FCB BLOCKS / EXTENT EXT LIMEM RTE-M GET MEMORY LIMITS PROCEDURE EXT $LIBR TURN OFF MEMORY PROTECT EXT $LIBX TURN MEMORY PROTECT BACK ON A EQU 0 B EQU 1 PROBT OCT 74000 DISC PROTECT BITS MYID EQU 1717B FUNCT BSS 1 THE PASSED IN FUNCTION PARAMETER CR BSS 1 THE PASSED IN CR PARAMETER .R6 BSS 1 FSCTR EQU .R6 SCTRS BSS 1 EITHER CURRENT SECTOR OR #OF SECTORS TRACK BSS 1 THE TRACK BEING WRITEN ON OR READ FROM .R7 BSS 1 DLU EQU .R7 THE DISC LU IN USE .M1 DEC -1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 .9 DEC 9 QSKED DEC 23 EXEC SCHEDULE REQUEST CODE .128 DEC 128 .NAME DBL NAME A NECESSARY BYTE POINTER NEWOP DEC 11 NEW OPEN FUNCTION CODE D.RFP ASC 3,D.RFP SPC 2 GEX.C DEF LIMEM THIS IS REALLY THE ENTRY POINT DST FUNCT SAVE PASSED PARAMETERS ADA JTAB FUNCTION CASE STATMENT NOþú JMP A,I SPC 2 JTAB DEF JTBL JTBL JMP CLOSE JMP CREAT JMP NOPEN JMP EOPEN JMP SOPEN JMP SCLOS SPC 3 SPC 3 CREAT JSB INDC. INB .PRAM IS STILL IN B STB .R2 INB STB .R3 ADB =D5 LDA MYID SET UP THE ID POINTER ADA =D26 STA IDPTR LDA B,I FETCH THE RECORD SIZE INB LDB B,I FETCH THE SECURITY CODE JSB STFID GO STUFF THE ID FOR D.RFP LDB .PRAM ADB =D3 LDA B,I GET THE TYPE CODE INTO A ADB =D3 LDB B,I GET THE FILE SIZE INTO B JSB EXEC CALL D.RFP DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF CR DEF .PRAM,I DEF .R2,I DEF .R3,I JMP FETCH EXIT CASE SPC 3 NOPEN JSB INDC. LDA .PRAM,I MAKEOPENCALL IOR =B100000 SET THE EXCLUSIVE OPEN BIT IN THE NAME STA .PRAM,I INB STB .R2 INB STB .R3 LDA NEWOP STA FUNCT FIX UP THE FUNCTION CALL FOR RTE-M JSB EXEC CALL D.RFP DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF CR DEF .PRAM,I DEF .R2,I DEF .R3,I JMP FETCH EXIT CASE SPC 3 EOPEN EQU * JSB INDC. LDA .PRAM,I MAKEOPENEXTCALL LDB =D6 SZA,RSS ADB =D2 STB FUNCT LDA C.EXT STA .PRAM JMP CEXEC SPC 2 CLOSE JSB INDC. CEXEC JSB EXEC MAKECLOSECALL DEF *+6+1 DEF QSKED DEF D.RFP DEF FUNCT DEF C.FAD,I DEF C.FAD+1,I DEF .PRAM,I JMP FETCH * SCRATCH OPEN FOR THE RTE-M SYSTEM * 1. CREATE A NEW FILE WITH PROG NAME * 2. IF (RETURNP1 = -2) OR (RETURNP1 >= 0) THEN * OPEN THE FILE EXCLUSIVE * 3. IF ANY ERROR THEN TAKE ERROR EXIT * 4. FETCH THE RETURN PARAMETERS AND NORMAL EXIT ûþú* BUILD SCRATCH FILE NAME SOPEN LDA C.FID,I ALF,ALF RAL,RAL AND =B17 IOR =B60 LDB .NAME SBT LDA MYID ALS ADA =D24 MBT .5 * SET RECORD SIZE IN ID LDA MYID ADB =D26 STA IDPTR CLA * SET SECURITY CODE IN ID CLB JSB STFID * TYPE CODE IN A LDA =D3 * FILE SIZE IN B LDB =D24 * SCHEDULE D.RFP JSB EXEC DEF *+7+1 DEF QSKED DEF D.RFP DEF .1 DEF .0 DEF NAME DEF NAME+1 DEF NAME+2 * PICK UP THE RETURN PARAMETERS LDA B,I * IF NOT((RETURNP1 = -2) OR (RETURNP1 >= 0)) THEN SSA,RSS JMP OPNIT CPA =D-2 JMP OPNIT * GO ERROR EXIT JMP GEX.C,I * OPEN THE FILE EXCLUSIVE OPNIT LDA NAME IOR =B100000 STA NAME LDA =D11 STA FUNCT JSB EXEC DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF .0 DEF NAME DEF NAME+1 DEF NAME+2 * GO FINISH UP JUST LIKE A NEW OPEN JMP FETCJ SPC 3 SCLOS LDA C.#SC,I GET NUMBER OF SECTORS TO PURGE CMA,INA STA SC1 JSB EXEC DEF *+6+1 DEF QSKED DEF D.RFP DEF .0 DEF C.FAD,I DEF C.FAD+1,I DEF SC1 JMP GEX.C,I * ESAC; SPC 3 FETCH ISZ GEX.C FETCJ JSB GETPR LDA .R1 CHECK FOR ERRORS SSA JMP GEX.C,I * IF FUNCTION = NEWOPEN THEN LDA FUNCT CPA NEWOP JMP *+2 JMP NOTOP EN * GETP6&P7; LDA .R2 AND =B77 STA DLU LDA .R2 ALF,ALF RAL,RAL AND =B1777 STA TRACK LDA .R3 AND =B377 STA FSCTR JSB EXEC FETCH THE DIRECTORY ENTRY DEF *+6+1 DEF .1 DEF DLU DEF C.BFF,I DEF .128 DEF TRACK DEF FSCTR LDA .R3 FETCH THE TYPE CODE ALF,ALF AND Ëš=B377 ADA =B3 ADA C.BFF LDB A,I STB .R7 ADA =B5 FETCH THE SECURITY CODE LDB A,I STB .R6 JMP FILID NOTOP CPA .1 JMP *+2 JMP EXIT FILID DLD .R2 DST C.FAD,I EXIT ISZ GEX.C JMP GEX.C,I SPC 3 INDC. BSS 1 CLEAR INDIRECTS AND FETCH THE PARAMETER POINTER LDB GEX.C ILOOP LDB B,I RBL,CLE,SLB,ERB CLEAR THE I-BIT AND TEST JMP ILOOP STB .PRAM JMP INDC.,I GETPR BSS 1 FETCH THE D.RFP RETURN PARAMETERS LDA B CLB,CCE ERB JSB P.PAS DEC -5 .R1 BSS 1 .R2 BSS 1 .R3 BSS 1 .R4 BSS 1 .R5 BSS 1 JMP GETPR,I SPC 3 STFID BSS 1 STUFF THE ID SEGMENT WORDS WITH THE RIGHT DATA JSB $LIBR NOP DST IDPTR,I JSB $LIBX DEF STFID .PRAM EQU .R1 NAME EQU .R2 TRLU EQU .R4 IDPTR BSS 1 SC1 BSS 1 IMYID EQU .R5 NLU EQU .R5 END qUÿÿ ÿýF P ÿ92064-18263 1901 S C0122 &SUP.M INITIALIZE /COMPILER LIB             H0101 RGþúASMB,L,C HED COMPILER LIBRARY INITIALIZE SUBROUTINE -- SUP.C NAM SUP.C,7 92064-16090 781106 REV. 1901 $CLIB * * SOURCE: 92064-18263 * * * * CALLING SEQUENCE: * * JSB SUP.C * DEF STRING * ERROR RETURN * RETURN * * A<0 INDICATES THE ERROR * B ::= STRING LENGTH IN WORDS * * STRING IS A 15 WORD ARRAY WHERE YOU WANT THE TIME STRING * (FORMAT: 12:01 PM MON., 29 DEC., 1982 ) * PROCEDURE SUP.C(TIMESTRING); * STRING TIMESTRING; * BEGIN * GLOBAL BOOLEAN SONFLAG; * GLOBAL INTEGER TURN_ON_STRING; * GLOBAL STRING LIBRARYTIME; * INTEGER ARRAY MONTHS[0:23] := "MAR.APR.MAY JUNEJULYAUG. * SEP.OCT.NOV.DEC.JAN.FEB."; * INTEGER ARRAY DAYS[0:14] := "FRI.SAT.SUN.MON.TUE.WED.THU."; * C.TTY(3) := LOGLU OR 400B * FETCH_TURN_ON_STRING; * IF LENGTH(TURN_ON_STRING) = 113 THEN * SONFLAG := TRUE * ELSE * BEGIN * TURN_ON_STRING_LENGTH := B; * BUILD_THE_TIMESTRING; * END; * PASS_TIME_STRING_TO USER; * END OF SUP.C; SKP * PROCEDURE SUP.C(TIMESTRING); ENT SUP.C * STRING TIMESTRING; * BEGIN * GLOBAL BOOLEAN SONFLAG; EXT C.SON THE I WAS SCHEDULED BY SOMEBODY FLAG EXT C.CRD THE DEFAULT CARTRIDGE NUMBER EXT C.HLK THE HEAD LINK POINTER * GLOBAL INTEGER ARRAY EXT C.TTY THE FCB FOR THE LOGLU EXT LOGLU THE ROUTINE TO RETRN USERS LU * GLOBAL INTEGER TURN_ON_STRING; EXT C.TRN THE TURN ON STRING IN ALL ITS GLORY EXT C.LEN THE LENGTH OF THE TURN ON STRING * GLOBAL STRING LIBRARYTIME; EXT C.TIM THE LIBRARY TIME STRING EXT EXEC GUES WHO EXT .MVW THE MOVE WORDS ROUTINE EXT GTF.C DISGUISES RTE-M AS RUN STRING CAPABLE SPC 5 A EQU 0 B EQU 1 D1 DEC 1 O13 OCT 13 D222 DEC -222 THE MAX LENGTH OF THE C.TRN BUFFER ":" ASC 1, : D14 DEC 14 .CTIM DEF C.TIM A LOCAL &åþúPOINTER TO THE GLOBAL * INTEGER ARRAY TIME[MSEC,SEC,MINUT,HOUR,DAY,YEAR]; TIME EQU * MSEC BSS 1 ALSO TEMPORARY B REGISTER SAVER SEC BSS 1 MINUT BSS 1 HOUR BSS 1 DAY BSS 1 YEAR BSS 1 * INTEGER ARRAY MONTH[0:23] := MONTH DEF *-1 ASC 12,MAR.APR.MAY JUNEJULYAUG. ASC 12,SEP.OCT.NOV.DEC.JAN.FEB. * INTEGER ARRAY DAYS[0:14] := DAYS DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. D15 DEC 15 SKP ************** START PROGRAM *************** SUP.C BSS 1 * C.TTY(3) := LOGLU OR 400B STB MSEC BSAVE ONLY JSB LOGLU DEF *+2 DEF * IOR =B400 STA C.TTY+2 CLB STB C.HLK STB C.SON STB C.CRD LDB MSEC BSAVE ONLY * FETCH_TURN_ON_STRING; JSB GTF.C * BEGIN * TURN_ON_STRING_LENGTH := B; L1 EQU * STB C.LEN * BUILD_THE_TIMESTRING; JSB EXEC DEF *+3+1 DEF O13 DEF TIME DEF YEAR LDA MINUT JSB PD00 LDB ":" IOR =B30000 PUT IN LEADING ZERO IF NECESSARY RRR 8 B=UNITS-BLANK;A= ":"-TENS DST C.TIM+1 LDA HOUR TEST FOR AM OR PM LDB =APM ADA =D-12 SSA,RSS JMP PM LDB =AAM LDA HOUR PM STB C.TIM+3 SZA,RSS LDA =D12 HOUR := 12 JSB PD00 STA C.TIM+0 LDA YEAR ADA =D-1900 JSB PD00 CONVERT THE YEAR STA C.TIM+14 LDB DAY ADB =D-60 LDA YEAR AND =D3 SZA LEAP YEAR CHECK SSB ADB =D-1 SSB ADB =D366 ADB =D31 LDA B RAL,RAL ADA B MULTIPLY BY 5 CLB DIV =D153 STA TIME SAVE THE MONTH FOR A WHILE LDA B CLB DIV =D5 INA JSB PD00 GET DAY OF MONTH STA C.TIM+8 LDB TIME NOW GET THE MONTH BLS ADB MONTH INDEX INTO MONTH TABLE DLD „ B,I DST C.TIM+10 CCA ITS TIME TO GET THE DAY OF THE WEEK ADA YEAR ARS,ARS ADA YEAR ADA DAY CLB DIV =D7 BLS ADB DAYS INDEX INTO DAY TABLE DLD B,I DST C.TIM+5 * END; SPC 3 * PASS_TIME_STRING_TO_USER; L2 LDA .CTIM JMP *+2 ILOP1 LDA A,I RAL,CLE,SLA,ERA JMP ILOP1 LDB SUP.C ILOP2 LDB B,I RBL,CLE,SLB,ERB JMP ILOP2 JSB .MVW DEF D15 NOP LDB D15 ISZ SUP.C ISZ SUP.C JMP SUP.C,I SPC 3 PD00 BSS 1 CLB DIV =D10 SZA ADA =A 0 ALF,ALF ADA B IOR =A 0 JMP PD00,I * END OF SUP.C; END Ciÿÿ ÿýGO ÿ92064-18264 1940 S C0122 &MLUEX RTE-M MLUEX SUBR             H0101 ì¡þúASMB,R,L,C NAM MLUEX,7 92064-16081 REV.1940 790717 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * RELOCATABLE 92064-16081 * SOURCE 92064-18264 * EXT .MVW,EXEC,.ENTR ENT XLUEX * * NOTE: * DO NOT CHANGE THE ORDER OF XLUEX,RTN1,FRTN * XLUEX NOP LDA XLUEX .FETCH ADDRESS OF 'DEF RTN' LDB A,I .FETCH 'RTN' ADDRESS STA YLUEX .SET UP FOR PRAM ADDRESS TRANSFER CMA .CALCULATE PARAMETER COUNT ADA B STA CNT STB XLUEX .SET RETURN ADDRESS JMP MVPRM .DO THE PRAMETER FETCH * TOP LDB .PRAM .SET RETURN ADDRESS ADB CNT STB RTN1 .IN THE FAKED CALL LDA .FRTN .PUT IN RETURN CODE JSB .MVW DEF .3 NOP * * THE FOLLOWING CODE WILL FILTER OUT THE IO REQUESTS * ONLY THOSE REQUESTS WILL HAVE THE SECOND PARAMETER * CHANGED TO A SINGLE WORD QUANITY * LDB TABLE STB TEMP .SET TABLE LENGTH LDB .TABL .SET TABLE ADDRESS LDA PRAM,I AND M77 .FETCH ICODE WORD TOP2 CPA B,I .IF A MATCH - PATCH ICNWD JMP DOIT ISZ TEMP .DONE ? INB,RSS .NO LOOK MORE JMP NODO .YES FINISHED NOT AN IO REQUEST JMP TOP2 * DOIT DLD ICNWD,I .FETCH THE DOUBLE WORD LU/FUNCTION CODE AND M77 .ELIMINATE ANY BITS ABOVE 5 IOR B .BLEND IN FUNCTION CODE STA TEMP .SET UP TEMP WITH PROPER VALUE LDA .TEMP .CHANGE PARAMETER ADDRESS STA ICNWD * NODO JSB EXEC .DO THE EXEC CALL RTN1 NOP PRAM NO³Ö  P ICNWD NOP REP 12 NOP YLUEX NOP MVPRM JSB .ENTR .PRAM DEF PRAM JMP TOP * FRTN JMP XLUEX,I .P+1 RETURN POINT ISZ XLUEX JMP XLUEX,I .P+2 RETURN POINT .3 DEC 3 TEMP NOP .TEMP DEF TEMP M77 OCT 77 CNT NOP .FRTN DEF FRTN .TABL DEF TABLE TABLE DEC -8 DEC 1,2,3,13,17,18,19,20 A EQU 0 B EQU 1 END S ÿÿ ÿýHO ÿ92064-18264 2013 S C0122 &MLUEX EXTENDED EXEC             H0101 ~‘þúASMB,R,L,C ** XLUEX EXTENDED EXEC ** * NAME: MLUEX * SOURCE: 92064-18264 * RELOC: 92064-16081 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MLUEX,7 92064-16081 REV.2013 800110 * EXT .MVW,EXEC,.ENTR ENT XLUEX * * NOTE: * DO NOT CHANGE THE ORDER OF XLUEX,RTN1,FRTN * XLUEX NOP LDA XLUEX .FETCH ADDRESS OF 'DEF RTN' LDB A,I .FETCH 'RTN' ADDRESS STA YLUEX .SET UP FOR PRAM ADDRESS TRANSFER CMA .CALCULATE PARAMETER COUNT ADA B STA CNT STB XLUEX .SET RETURN ADDRESS JMP MVPRM .DO THE PRAMETER FETCH * TOP LDB .PRAM .SET RETURN ADDRESS ADB CNT STB RTN1 .IN THE FAKED CALL LDA .FRTN .PUT IN RETURN CODE JSB .MVW DEF .3 NOP * * THE FOLLOWING CODE WILL FILTER OUT THE IO REQUESTS * ONLY THOSE REQUESTS WILL HAVE THE SECOND PARAMETER * CHANGED TO A SINGLE WORD QUANITY * LDB TABLE STB TEMP .SET TABLE LENGTH LDB .TABL .SET TABLE ADDRESS LDA PRAM,I AND M77 .FETCH ICODE WORD TOP2 CPA B,I .IF A MATCH - PATCH ICNWD JMP DOIT ISZ TEMP .DONE ? INB,RSS .NO LOOK MORE JMP NODO .YES FINISHED NOT AN IO REQUEST JMP TOP2 * DOIT DLD ICNWD,I .FETCH THE DOUBLE WORD LU/FUNCTION CODE AND M77 .ELIMINATE ANY BITS ABOVE 5 IOR B .BLEND IN FUNCTION CODE STA TEMP .SET UP TEMP WITH PROPER VALUE LDA .TEMP .CHANGE PARAMETER ADDRESS STA ICNWD * NODO JSB EXEC²ˆ   .DO THE EXEC CALL RTN1 NOP PRAM NOP ICNWD NOP REP 12 NOP YLUEX NOP MVPRM JSB .ENTR .PRAM DEF PRAM JMP TOP * FRTN JMP XLUEX,I .P+1 RETURN POINT ISZ XLUEX JMP XLUEX,I .P+2 RETURN POINT .3 DEC 3 TEMP NOP .TEMP DEF TEMP M77 OCT 77 CNT NOP .FRTN DEF FRTN .TABL DEF TABLE+1 TABLE DEC -8 DEC 1,2,3,13,17,18,19,20 A EQU 0 B EQU 1 END [* ÿÿ ÿýIP ÿ92064-18265 1940 S C0122 &MLUTR RTE-M MLUTR SUBR             H0101 öªASMB,R,L NAM MLUTR,7 92064-16081 REV.1940 790717 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * RELOCATABLE 92064-16081 * SOURCE 92064-18265 * EXT .ENTR ENT LUTRU SESLU NOP SYSLU NOP LUTRU NOP JSB .ENTR DEF SESLU LDA SESLU,I .FETCH LU STA SYSLU,I .GIVE IT BACK NO CHANGE JMP LUTRU,I END 1#ÿÿ ÿýJP ÿ92064-18266 2013 S C0122 &MSESN RTE-M DUMMY SESSION             H0101 Y²ASMB,R,L,C ** SESSN DUMMY SESSION ** * NAME: MSESN * SOURCE: 92064-18266 * RELOC: 92064-16081 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MSESN,7 92064-16081 REV.2013 800118 * ENT SESSN,DTACH,ICAPS ENT GTERR,PTERR,$DSCS ENT $BMON,$CL1,$CL2 EXT .ENTP * IPRAM NOP IERR NOP OPTIONAL ERROR RETURN SESSN NOP CLB STB IERR CLEAR ERROR RETURN JSB .ENTP DEF IPRAM CCA INDICATES NO SESSION LDB IERR SZB ERROR PARAMETER SUPPLIED? STA IERR,I YES - STORE IERR CLA,CLE CAPABILITY ZERO FOR ICAPS CME E=1 INDICATES NO SESSION JMP SESSN,I * DTACH EQU SESSN ICAPS EQU SESSN GTERR EQU SESSN PTERR EQU SESSN * $DSCS DEC -1 INDICATES NO SESSION $BMON NOP $CL1 EQU $BMON $CL2 EQU $BMON END b¬ÿÿ ÿýKQ ÿ92065-18001 2001 S C0122 &MBCM0 BASIC MAIN (SOURCE)             H0101 Ò‡þúASMB,R HED <> 92065-16001 NAM BASIC,3,90 92065-16001 REV.2001 791019 * * DATE 5-13-77 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * SOURCE: 92065-18001 * * ************************************************************* * ENT FINDV,ERRPT,DRQST,GETCR,OUTCR,BCKSP,LETCK ENT PRMT,REED,WRITE,PEXMK,RDYPT,OUTER,INTCK,KEYBD * * * EXT DBUG * * ENT DIGCK,FNDPS,OUTIN,ENOUT,NUMOT ENT PRNIN,OUTLN,NUMCK,SSYMT,MVTOH,RUN,COMND ENT PLIST,LOADT,INDCK,.IENT,OLNCK EXT REIO,.FLUN,EXEC EXT MVNAM,FILRD,FILWR,CLFIL EXT BASC5,BASC3,BASC2 * EXT ..FCM,.PACK,RMPAR,BASC1 COM TEMPS(30),PNTRS(61),SPEC(10) ************************************** * * * BASIC MAIN CONTROL * * * ************************************** * * THIS PART OF THE INTERPRETER REMAINS CORE RESIDENT DURING * THE EXECUTION OF BASIC. IT INTERPRETS AND EXECUTES ALL * OF THE SYSTEM COMMANDS BY LOADING THE APPROPRIATE SEGMENT * AND TRANSFERRING EXECUTION TO IT. UPON COMPLETION, THE * SEGMENTS RETURN EXECUTION TO THIS PROGRAM.IN ADDITION, IT * PROVIDES FOR ALL USER COMMUNICATION WITH THE INTERPRETER. * THERE ARE 8 SEGMENTS WHICH MAY CALLED BY THE MAIN CONTROL: * * SEGMENT #1: CHECKS SYNTAX AND TRANSLITERATES CODE * SEGMENT #2: LISTS THE PROGRAM * SEGMENT #3: CHECKS THE PROGRAM PRIOR TO EXECUTION * SEGMENT #4: EXECUTES THE PROGRAM * SEGMENT #5: EXECUTES COMMANDS * SEGMENT #6: EXECUTES MORE COMMANDS * SEGMEü¦þúNT #8: EXECUTES NON-TIME DEPENDENT STATEMENTS * * * TO RUN BASIC USE: * * *ON,BASIC,CONSOLE LU,LIST LU,INPUT LU,OUTPUT LU, ERROR LU * * OR * * *ON,BASIC,NA,ME,XX,CONSOLE LU,LIST LU * * WHERE: NAMEXX = THE COMMAND FILE NAME * *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVERSTORE FLAG FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF¦Rþú PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME SYFLG BSS 1 SYNTAX SEGMENT FLAG TEMPT BSS 15 * RDYA DEF READY QMRKA DEF QMARK ACKNA DEF ACKNW SPC 1 SUP PRESS MULTIPLE LISTING SPC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .9 DEC 9 .12 DEC 12 .15 DEC 15 .32 DEC 32 .9999 DEC 9999 B77 OCT 77 B700 OCT 700 MSK OCT 177400 M1 DEC -1 M2 DEC -2 M4 DEC -4 M7 DEC -7 M14 DEC -14 M80 DEC -80 MSK3 EQU M7 * QMARK ASC 1,?_ : ACKNW ASC 1,>_ : READY OCT 6412 ASC 6,BASIC READY SKP ********************** * * * BASIC MAIN CONTROL * * * ********************** BASIC NOP ENTRY * JSB RMPAR FETCH LOGICAL DEF *+2 UNIT NUMBERS DEF TTYPR LDA .9999 SET FLAG TO STA PFLAG TO ENABLE BASIC INIT. JSB BASC3 .INIITALIZE CODE HLT 01 SPC 1 RDYPT LDA TTYPR SET UP STA LUOUT INPUT AND STA LUINP OUTPUT DEVICE UNITS LDB 1717B GET ADB .12 CURRENT LDA 1,I PROGRAM STA READY+1 NAME INB AND LDA 1,I STORE STA READY+2 IN INB THE LDA 1,I READY AND MSK MESSAGE ADA .32 STA READY+3 -äþúLDA M14 PRINT LDB RDYA THE BASIC'S 'NAME' JSB WRITE AND 'READY' * JSB DBUG * DEF *+1 JMP PRMT PROMPT! SPC 1 * EXECUTION RETURNED HERE FROM SEGMENT #1 SPC 1 * * PFLAG MAY HAVE THE FOLLOWING VALUES: * * PLFAG = -1 INPUT FROM TAPE * PFLAG = 0 INPUT FROM KEYBOARD * PFLAG = 1 INPUT FROM PROGRAM FILE * PFLAG = 2 INPUT FROM SPECIFIED LU # * PFLAG = 3 LOAD B&M TABLE FLAG * PFLAG = 4 INPUT FROM COMMAND FILE * PFLAG = 5 RUN A PROGRAM BY NAME * PFLAG = 9999 EXECUTE INITIALIZATION IN SEG 3(ONCE ONLY) * PEXMK LDA PFLAG SZA IS TAPE FLAG SET? JMP MORTP GET RECORD FROM PHOTO RDR * * EXECUTION RETURNED HERE FROM SEGMENTS #5 AND #6 * PRMT LDA TTYPR INITIALIZE STA LUOUT INPUT AND STA LUINP OUTPUT DEVICES UNITS CLA,INA INITIALIZE STA LOLIM LOW LIMIT STA LORUN LDA .9999 INITIALIZE STA HILIM HIGH LIMIT STA HIRUN CLA STA DRQST CLEAR DATA REQUEST FLAG STA PFLAG CLEAR TAPE INPUT FLAG STA SYFLG CLEAR SYNTAX SEGMENT FLAG STA MERGF CLEAR OUT MERGE FLAG CCA SET FOR STA FLTYP NO TYPE 0 I-O LDA M2 LDB ACKNA JSB WRITE PRINT '>' WITH NO CR-LF JMP GTRCD INPUT RECORD SPC 1 * PROCESS DATA REQUEST SPC 1 DRQST NOP LDA LUINP IS THIS JSB KEYBD . A KEYBOARD DEVICE ? JMP GTRCD NO LDA M2 LDB QMRKA JSB WRITE PRINT '?' AND WAIT SPC 1 * INPUT RECORD FROM TTY SPC 1 GTRCD LDA M80 LDB .INBF JSB REED GET RECORD FROM TTÿÿ SPC 1 * PROCESS RECORD SPC 1 RPRCS CMA SET A = -1ÿÿ# CHARS STA ICCNT SET CHAR COUNT STA TEMP8 SET FOR ERROR PRINT OUT LDB .INBF LOAD BUFFER ADDRESS ¬þú CLE,ELB SHIFT LEFT,LEAST BIT USED AS STB INBFA ODD/EVEN FLAG INA,SZA,RSS NULL RECORD ? JMP GTRCD YES, INPUT AGAIN LDB DRQST SZB,RSS DATA REQUEST? JMP RPRC0 NO DATA REQUEST,GO CHECK RECORD CLA STA DRQST CLEAR DATA REQUEST FLAG JMP 1,I AND FAKE THE RETURN THRU DRQST SPC 1 * LOAD SYNTAX SEGMENT AND BRANCH TO IT SPC 1 RPRC0 JSB GETCR GET FIRST CHARACTER JMP GTRCD UNLESS THERE ISN'T ONE CKRCD LDB SBUFA INITIALIZE SYNTAX STB SBPTR BUFFER POINTER STA 1,I PUT FIRST CHAR IN SYNTAX BUFFER CPA DLMTR LIST NEXT LINE COMMAND? JMP COMND YES, LIST IT! JSB LETCK IS THIS A LETTER? JSB BASC1 .GO TO SYNTAX CHECKERE JMP COMND YES, GO TO COMMAND PHASE * * SKP * EXECUTION RETURNED HERE WHEN ERROR OCCURS * SET FOR PRINTING ERROR MESSAGE SPC 1 OUTER CCA SET L.U. NEGATIVE FOR FLAG STA LUOUT TO INDICATE ERROR MESSAGE JMP PLIST BRANCH TO LIST SEGMENT SPC 1 * EXECUTION RETURNED HERE AFTER PRINTING ERROR MESSAGE * SET FOR LOADING SYNTAX SEGMENT AGAIN SPC 1 ERRPT CLA CLEAR SYNTAX SEGMENT FLAG STA SYFLG STA PFLAG AND FILE FLAG INA SET FOR END STA REC# OF COMMAND FILE INPUT JMP PEXMK GO WAIT FOR INPUT * PROCESS SYSTEM COMMANDS SPC 1 * LOAD COMMAND SEGMENT SPC 1 * COMES HERE THROUGH SYNTAX SEGMENT (A) CONTAINS FIRST * CHARACTER OF COMMAND * COMND CLB CLEAR SYNTAX FLAG STB SYFLG JSB BASC5 .CALL COMMAND PROCESSOR SPC 1 * PROCESS 'RUN' COMMAND SPC 1 RUN JSB BASC3 .CALL EXECUTE PROCESSOR SPC 1 SPC 1 * PROCESS 'SAVE' & 'LIST' COMMAND SPC 1 PLIST JSB BASC2 .CALL LIST & SAVE PROCESSOR SPC 1 * PROCESS 'LOAD' COMMAN7sþúD SPC 1 LOADT LDA READR SET L.U. TO READER LDB PFLAG .LU SPECIFIED? CPB .2 RSS .OR "RUN FROM" ? CPB .5 LDA LUINP .YES DO NOT CHANGE LUINPUT STA LUINP AND B77 ISOLATE L.U. # IOR B700 MÿÿGE IN FUNCTION CODE STA LENTH SAVE IT JSB EXEC CALL EXEC DEF *+3 DEF .3 TO SET EOT BIT DEF LENTH * MORTP LDA M80 LDB .INBF JSB REED GET RECORD FROM READER CPA M2 END OF TAPE? JMP LOAD0 .CHECK FOR RUN FROM COMMAND SZA,RSS JMP MORTP NULL RECORD JMP RPRCS GO PROCESS RECORD * LOAD0 LDA FLFIL .CHECK FOR FILE INPUT INA,SZA,RSS JSB CLFIL .YES - CLOSE THE FILE LDA PFLAG CPA .5 .RUN ? JMP RUN .YES EXECUTE PROGRAM JMP RDYPT .NO PROMPT * *********************** * * * UTILITY SUBROUTINES * * * *********************** * * THE FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE * BASIC INTERPRETER AND THEREFORE ARE CORE RESIDENT. THEY * ARE DEFINED IN THE SEGMENTS AS BEING EXTERNAL. * * ******************************* * * * INDIRECT CHECK * * * ******************************* * INDCK NOP CHASE INDIRECT CHAIN RSS AND RETURN DIRECT POINTER IN A LDA 0,I GO ANOTHER LEVEL RAL,CLE,SLA,ERA SKIP IF NOT INDIRECT JMP *-2 JMP INDCK,I REAL ADDRESS, EXIT * ******************** * * * CHECK FOR LETTER * * * ******************** LETCK NOP CHARACTER IN (A) LDB 0 ADB D133 ASCII 133B SSB,RSS OR GREATER? JMP LETCK,I YES, EXIT WITH CHARACTER IN (A) ADB .26 NO, ASCII 101B SSB,RSS OR GREATER? ISZ @þúLETCK YES JMP LETCK,I NO * .26 DEC 26 D72 OCT -72 D133 OCT -133 ******************* * * * CHECK FOR DIGIT * * * ******************* DIGCK NOP CHARACTER IN (A) LDB 0 ADB D72 ASCII 72B SSB,RSS OR GREATER? JMP DIGCK,I YES, RETURN WITH CHARACTER ADB .10 NO, ASCII 60B SSB OR GREATER? JMP DIGCK,I NO ISZ DIGCK YES, SET 'SUCCESS' EXIT, LDA 1 LOAD DIGIT INTO (A), JMP DIGCK,I AND RETURN SKP ***************************** * * * ADD CHAR TO OUTPUT BUFFER * * * ***************************** OUTCR NOP CHARACTER IN (A) STA TEMP4 SAVE CHARACTER ISZ OCCNT COUNT IT LDB OCCNT FIRST CHARACTER SLB OF BUFFER WORD? ISZ OTBFA YES, MOVE TO FRESH WORD LDA OTBFA,I LOAD BUFFER WORD SLB SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TEMP4 ADD NEW CHARACTER SLB POSITION ALF,ALF WORD AND STA OTBFA,I STORE IT JMP OUTCR,I ****************************** * * * GET CHAR FROM INPUT BUFFER * * * ****************************** GETCR NOP ISZ ICCNT ANY CHARACTERS LEFT? RSS JMP GETCR,I NO, END-OF-FILE EXIT LDB INBFA LOAD BUFFER ADDRESS ISZ INBFA UPDATE FOR NEXT TIME CLE,ERB SET CHARACTER FLAG LDA 1,I LOAD CURRENT BUFFER WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 MASK EXTRANEOUS BITS CPA BLANK BLANK? JMP GETCR+1 YES, FETCH NEXT CHARACTER ISZ GETCR UPDATE RETURN ADDRESS JMP GETCR,I AND EXIT * B177 OCT 177 M256 DEC -256 *************************** oþú * * * BACKSPACE OVER ONE CHAR * * * *************************** BCKSP NOP CCA BACKSPACE ADA ICCNT OVER STA ICCNT LAST CCA CHARACTER IN ADA INBFA INPUT STA INBFA BUFFER JMP BCKSP,I SKP ***************************** * * * INITIALIZE FOR NEW LINE * * * ***************************** * PRNIN NOP CCA INITIALIZE ADA .OTBF BUFFER STA OTBFA POINTER CLA INITIALIZE STA OCCNT CHARACTER COUNTER JMP PRNIN,I SPC 1 ************************* * * * OUTPUT COMPLETED LINE * * * ************************* OUTLN NOP LDA OCCNT OUTPUT LDB .OTBF A JSB WRITE LINE JSB PRNIN CLEAN UP OUTPUT BUFFER STA TYPE RESET PARTIAL LINE COUNTER JMP OUTLN,I * * ***************************** * * * CHECK FOR LINE OVERFLOW * * * ***************************** * * AT ENTRY, A = NUMBER OF CHARACTERS * TO BE OUTPUT, EXCLUSIVE * OF TRAILING BLANKS. * THIS ROUTINE CHECKS FOR LINES OVER 72 * CHARACTERS, AND OUTPUTS THEM BEFORE * FIGURING THE END OF FIELD FOR NUMERIC * FORMATTING. THE END OF FIELD COLUMN * NUMBER IS RETURNED IN TEM10. * OLNCK NOP STA BCKSP SAVE REQUEST LENGTH TEMPORARILY ADA OCCNT FIGURE LENGTH OF BUFFER ADA TYPE FIGURE COLUMN OF RESULT CMA,INA ADA .80 TOO MANY CHARACTERS ? SSA JSB OUTLN YES, OUTPUT LINE FIRST LDA BCKSP RE@‹þúCOVER REQUEST LENGTH ADA OCCNT AND FIGURE ADA .3 THE END-OF-FIELD STA TEM10 COLUMN NUMBER JMP OLNCK,I * .80 DEC 80 SKP ******************************* * * * FIND OUT THE DEVICE TYPE * * * ******************************* * * ON INPUT (A) = LU NUMBER * ON EXIT (A) = DVR NUMBER * (B) = SUBCHANNEL # * FINDV NOP STA SLU .SET UP STATUS EXEC CALL JSB EXEC . TO FETCH EQUIP TYPE CODE DEF FIND1 . AND SUBCHANNEL NUMBER DEF .13 DEF SLU DEF EQT5 DEF EQT4 DEF SBCHN * FIND1 LDA SBCHN .FETCH SUBCHANNEL AND AND MSK0 . REMOVE DOWN BIT LDB 0 .LEAVE IN B REG LDA EQT5 ALF,ALF .FETCH EQUIP TYPE CODE AND B77 JMP FINDV,I * .13 DEC 13 SLU NOP EQT5 NOP EQT4 NOP SBCHN NOP * * ******************************** * * DETERMINE IF LU# IS KEYBOARD DEVICE * * A(ENTRY) IS LU# * ON EXIT A UNCHANGED * EXIT P+1 NOT A KEYBOARD DEVICE * EXIT P+2 IS A KEYBOARD DEVICE * ******************************* * KEYBD NOP STA KEY1 .SAVE LU # AND B77 .STRIP OFF CONTROL BITS JSB FINDV .ISOLATE LU# CPA .5 . IS IT DVR05 ? JMP KEY2 .CHECK FOR CTU OR PRINTER SZA .IS IT DVR00? JMP KEYBD,I .NO EXIT P+1 KEYS ISZ KEYBD LDA KEY1 .RESTORE LU # JMP KEYBD,I KEY2 SZB,RSS .IS IT THE DISPLAY? JMP KEYS .YES JMP KEYBD,I KEY1 NOP .5 DEC 5 MSK0 OCT 377 SKP ******************** * * * FIND A STATEMENT * * * ******************** * * UPON ENTRY (A) = SEQUENCE NUMBER TO BE FOUND. IF (A) * IS LARGER THAN ANY SEQUENCE NUMBER IN THE PROGRAM, EXIT * TO (P+1) WITH (B) POINTING TO LAST WORD+1 OF T`þúHE PROGRAM * IF (A) FALLS BETWEEN TWO SEQUENCE NUMBERS, EXIT TO (P+2) * WITH (B) POINTING TO THE STATEMENT WITH THE LARGER SEQUENCE * NUMBER. IF A STATEMENT IN THE PROGRAM HAS THE SEQUENCE * NUMBER THEN EXIT TO (P+3) WITH (B) POINTING TO THIS STATEMENT. * FNDPS NOP STA TEMP3 SAVE SEQUENCE NUMBER LDB PBUFF STARTING ADDRESS FNDP1 CPB PBPTR END OF PROGRAM? JMP FNDP4 YES, EXIT VIA (P+1) LDA TEMP3 SUBTRACT PROGRAM CMA,INA SEQUENCE NUMBER FROM ADA 1,I S-BUFFER SEQUENCE NUMBER SZA,RSS EQUAL? ISZ FNDPS YES, SET EXIT TO (P+3) SSA,RSS NO, P-SEQ NO > S-SEQ NO ? JMP FNDP3 YES, SET EXIT TO (P+2) LDA 1 POINT (A) TO INA PROGRAM ADDRESS INCREMENT ADB 0,I COMPUTE NEW ADDRESS JMP FNDP1 FNDP3 ISZ FNDPS FNDP4 STB TEMP3 SAVE STATEMENT ADDRESS JMP FNDPS,I ***************************** * * * MOVE WORDS TO HIGHER CORE * * * ***************************** MVTOH NOP LDB TEMP2 FETCH SOURCE ADDRESS MVTO1 CPB TEMP3 ALL RELOCATION DONE? JMP MVTOH,I YES, EXIT CCA BACK UP ADB 0 ADA TEMP4 SOURCE AND STA TEMP4 DESTINATION LDA 1,I MOVE STA TEMP4,I WORD JMP MVTO1 SKP *********************** * * * SEARCH SYMBOL TABLE * * * *********************** * * SSYMT IS CALLED WITH THE IDENTIFIER TO SEARCHED FOR IN * (A). IT RETURNS WITH THE ADDRESS OF THE MATCHING ENTRY * IN (B) OR (B)=-1 IF THERE IS NO MATCHING ENTRY. * * THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS: * * 1. TYPE 1 (ONE DIMENSION) SEARCH FOR CORRESPONDING * TYPE 1 OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE ENTRY TO TYPE 1. * * 2. TYPE 2 (TWO DIMENSIONS) SEARCH FOR CORESPONDING * TYPES OR TYPElþú 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE ENTRY TYPE TO TYPE 2. * * 3. TYPE 3 (UNDIMENSIONED) SEARCH FOR CORRESPONDING * TYPE 3 OR TYPE 1 OR TYPE 2 ARRAY. * SSYMT NOP STA STEMP STORE IDENTIFIER AND .15 ISOLATE IDENTIFIER TYPE ADA M4 SSA,INA JMP *+4 JUMP IF ARRAY TYPE LDA STEMP RESTORE A STA 1 STORE IN B JMP SYMT1+3 SSA SKIP IF UNDIMENSIONED JMP SYMT1 LDA STEMP RESTORE A AND MSK3 177771B SET TYPE TO 1 STA 1 INB SET TYPE IN B TO 2 JMP *+4 SYMT1 CCB SET DIMENSIONED FLAG IN B LDA .3 IOR STEMP SET TYPE TO UNDEFINED STA STEMP+1 STORE A STB STEMP+2 STORE B LDB SYMTF START OF SYMBOL TABLE JMP SYMT4 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY CPA STEMP COMPARE WITH IDENTIFIER JMP SSYMT,I MATCH ? RETURN CPA STEMP+1 COMPARE WITH DIFFERENT DIM. JMP SYMT3 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. JMP SYMT3 LDA 1,I AND .15 ISOLATE ENTRY TYPE CPA .15 FUNCTION ? JMP *+5 YES ADA M4 SSA ARRAY ? INB YES INCREMENT POINTER INB INCREMENT POINTER ADB .2 ADD 2 TO POINTER SYMT4 CPB SYMTA SYMBOL TABLE EXHAUSTED? ? CCB,RSS YES JMP SYMT2 NO, CHECK NEXT ENTRY FOR MATCH LDA STEMP RETRIEVE SYMBOL JMP SSYMT,I RETURN WITH B NEGATIVE SYMT3 LDA STEMP RESTORE A ISZ STEMP+2 DIMENSIONED IDENTIFIER? RSS NO, SKIP STA 1,I YES CHANGE 1ST WORD OF ENTRY TO JMP SSYMT,I APPROPRIATE DIMENSION TYPE SKP ************************* * * * FORMATTER SUBROUTINES * * * ************************* * * THE FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE * BASIC INTERPRETER TO PERFORM I/O FO—þúRMATTING OPERATIONS. * IN GENERAL, THEY PROVIDE FOR ASCII-TO-BINARY AND BINARY- * TO-ASCII CONVERSIONS. * ******************** * * * PRINT A NUMBER * * * ******************** * * ENTER WITH A FLOATING PT NUMBER IN (A) AND (B). PRINT * THE NUMBER AND APPEND BLANKS TO REACH THE PRINT POSITION * SPECIFIED BY TEM10 ON RETURN FROM 'NUMOT'. * ENOUT NOP CCE ENABLE SIGN JSB NUMOT OUTPUT NUMBER ENOU0 LDB TEM10 FIELD CMB,INB ADB OCCNT SSB,RSS FULL? JMP ENOUT,I YES! LDA .32 NO, SO JSB OUTCR OUTPUT A BLANK JMP ENOU0 AND TRY AGAIN * MINFX DEC -0.099999959 MAXFX DEC -999999.5 NMBFA DEF *+1 NUMBF BSS 6 LDVSR DEF *+1 DEC 10000 DEC 1000 DEC 100 .10 DEC 10 M1000 DEC -1000 SKP ************************ ** * *** OUTPUT A NUMBER * ** * ************************ * * ENTER WITH A FLOATING POINT NUMBER IN (A) AND (B) AND (E) = 1 * IF A SIGN IS WANTED. DETERMINE THE FORM OF THE NUMBER AND * SET TEM10 ACCORDINGLY. NON-INTEGERS ARE ROUNDED AFTER CONVERSION * TO DECIMAL. TRAILING ZEROS ARE SUPPRESSED ON NUMBERS WITHOUT * EXPONENTS. * NUMOT NOP STA NUMBF SAVE HIGH MANTISSA SEZ,RSS SIGN? JMP NUMO1 NO SSA,RSS YES, NEGATIVE NUMBER? JMP *+5 NO JSB ..FCM YES, NEGATE NUMBER STA NUMBF SAVE HIGH MANTISSA LDA .45 LOAD '-' RSS CLA LOAD '+' STA SIGN SAVE SIGN LDA NUMBF RETRIEVE HIGH MANTISSA NUMO1 STB NUMBF+1 SAVE LOW MANTISSA JSB IFIX INTEGER? JMP NUMO2 NO SOC YES, 16-BIT INTEGER? JMP NUMO2 NO * * ** OUTPUT AN INTEGER ** * * STB NUMBF SAVE INTEGER ADB M1000 LDA .3 SSB,RSUþúS 3 DIGIT INTEGER? ADA .3 NO, ALL INTEGERS ARE 6 DIGITS OR LESS JSB OLNCK CHECK FOR LINE OVERFLOW LDA SIGN YES SZA SIGN? JSB OUTCR YES, OUTPUT IT LDA NUMBF NO JSB OUTIN OUTPUT THE INTEGER JMP NUMOT,I * * ** OUTPUT A FLOATING POINT NUMBER ** * * NUMO2 LDA M2 SET 'FIXED' STA FFLAG FLAG FALSE DLD NUMBF LOAD NUMBER FAD MAXFX IS NUMBER SSA,RSS < 999999.5 ? JMP NUMO3 NO DLD NUMBF YES, IS FAD MINFX NUMBER * LESS THAN SSA,RSS 0.09999995 ? ISZ FFLAG NO, SET 'FIXED' FLAG TRUE NUMO3 DLD NUMBF LOAD NUMBER STA MANT1 UNPACK JSB .FLUN STB MANT2 NUMBER STA EXP CLA INITIALIZE STA EXPON DECIMAL EXPONENT CPA EXP ZERO EXPONENT? JMP NUMO5 YES NUMO0 JSB MBY10 NO LDA EXP MULTIPLY CMA,SSA,INA,SZA NUMBER BY 10 JMP *+3 UNTIL IT IS ISZ EXPON GREATER JMP NUMO0 THAN 1 JSB DBY10 DIVIDE BY 10 LDA EXPON NUMO4 LDB EXP DIVIDE CMB,INB NUMBER SSB,RSS BY 10 JMP NUMO5 UNTIL STA EXPON IT IS JSB DBY10 LESS CCA THAN ADA EXPON 1 JMP NUMO4 NUMO5 CMA SET EXPONENT STA EXPON TO TRUE VALUE-1 LDB M6 SET DIGIT STB DIGCT COUNTER LDB NMBFA SET BUFFER STB NMPTR POINTER * * ** CONVERT MANTISSA TO ASCII ** * * NUMO6 JSB GETDG STORE A ADA .48 DECIMAL STA NMPTR,I DIGIT ISZ NMPTR ·úþú ISZ DIGCT SIXTH DIGIT? JMP NUMO6 NO JSB GETDG YES, ADA M5 NEXT DIGIT SSA >= 5 ? JMP NUMO9+1 NO * * ** ROUND ASCII MANTISSA ** * * LDB NMPTR NUMO7 ADB M1 LOAD LAST LDA 1,I DIGIT INA INCREMENT IT CPA .58 WAS IT A 9 ? RSS YES JMP NUMO9 NO CPB NMBFA LEADING DIGIT? JMP NUMO8 YES LDA .48 NO, OVERLAY STA 1,I A 0 JMP NUMO7 NUMO8 ISZ EXPON BUMP DECIMAL NOP EXPONENT AND LDA .49 OVERLAY A 1 NUMO9 STA 1,I LDA EXPON IS NUMBER SSA,RSS LESS THAN 1 ? JMP NMO11 NO STA TEMP6 YES LDA .48 LDB NMPTR NMO10 ISZ TEMP6 COUNT ZEROS NOP PLUS 1 ADB M1 LAST CPA 1,I DIGIT 0? JMP NMO10 YES LDA TEMP6 NO, ALL SIGNIFICANCE SSA IN SIX DIGITS? JMP NMO11 NO CCA YES, SET STA FFLAG 'FIXED' FLAG TRUE NMO11 LDA .9 COMPUTE ISZ FFLAG FIELD ADA .3 WIDTH JSB OLNCK CHECK FOR LINE OVERFLOW LDA SIGN YES SZA SIGN? JSB OUTCR YES, OUTPUT IT LDB M7 SET OUTPUT STB DIGCT DIGIT COUNTER LDB NMPTR CCA FIXED CPA FFLAG FORMAT? JMP *+5 NO LDA EXPON YES, SET CMA INDICATOR TO STA TEMP6 DECIMAL POINT JMP NMO16 STA TEMP6 SET INDICATOR FOR DECIMAL POINT JMP NMO14 NO * * ** DELETE TRAILING ZEROS ** * * NMO12 LDA DIGCT AT RIGHT OF INA DECIMAL CPA TEMP6 POINT? JMP *+6 NO STA DIGC®#þúT YES, DELETE ZERO NMO16 ADB M1 LAST LDA 1,I DIGIT CPA .48 0? JMP NMO12 YES CCA NO, FIXED CPA FFLAG FORMAT? JMP NMO14 NO LDA EXPON YES, LEADING SSA,RSS DECIMAL POINT? JMP NMO14 NO STA TEMP6 YES, SET LEADING ZEROS COUNTER * * ** OUTPUT MANTISSA ** * * LDA .46 OUTPUT A RSS DECIMAL POINT NMO13 LDA .48 OUTPUT JSB OUTCR A ZERO ISZ TEMP6 MORE LEADING ZEROS? JMP NMO13 YES ISZ DIGCT NO, COUNT DECIMAL POINT NMO14 LDB NMBFA SET STB NMPTR DIGIT POINTER JMP *+5 NMO15 ISZ TEMP6 DECIMAL POINT NEXT? JMP *+3 NO LDA .46 YES, LOAD IT JMP *+3 LDA NMPTR,I LOAD NEXT ISZ NMPTR DIGIT JSB OUTCR OUTPUT CHARACTER ISZ DIGCT MORE DIGITS? JMP NMO15 YES ISZ FFLAG NO, EXPONENT? JMP NUMOT,I NO * * ** OUTPUT THE EXPONENT ** * * LDA E JSB OUTCR OUTPUT AN 'E' LDA .45 OUTPUT LDB EXPON SSB AN CMB,INB,RSS LDA .43 EXPONENT STB EXPON JSB OUTCR SIGN LDA EXPON CLB COMPUTE DIV .10 ADA .48 EXPONENT'S ADB .48 STB EXPON 10'S DIGIT JSB OUTCR OUTPUT IT LDA EXPON OUTPUT JSB OUTCR 1'S DIGIT JMP NUMOT,I SKP ********************* * * * OUTPUT AN INTEGER * * * ********************* OUTIN NOP INTEGER IN (A) LDB M4 SET DIGIT STB DIGCT COUNTER LDB LDVSR SET DIVISOR STB TEMP7 ADDRESS CLB SUPPRESS STB TEMP6 ZEROES "þúOUTI1 DIV TEMP7,I DIVIDE INTEGER STB TEMP5 CURRENT DIVISOR CPA TEMP6 LEADING ZERO? JMP OUTI2 YES! ADA .48 NO, TURN OFF STA TEMP6 ZERO SUPPRESSION JSB OUTCR OUTPUT DIGIT OUTI2 CLB LDA TEMP5 RETRIEVE REMAINDER ISZ TEMP7 SET FOR NEXT DIVISOR ISZ DIGCT ALL DIVISOR USED? JMP OUTI1 NO! ADA .48 YES, OUTPUT JSB OUTCR LAST DIGIT JMP OUTIN,I * .43 DEC 43 .45 DEC 45 .46 DEC 46 .48 DEC 48 .49 DEC 49 .58 DEC 58 E OCT 105 M5 DEC -5 M6 DEC -6 * ****************************** * * * ASCII-TO-BINARY CONVERSION * * * ****************************** NUMCK NOP CHARACTER IN (A), SIGN SETE CLB STB EXP ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB TEMP3 SET 'NUMBER' FLAG FALSE CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXP SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXP EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 ]Âþú BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXP BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP NUMCK,I NO, EXIT VIA (P+1) CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR JMP NUMER CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GETCR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GETCR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SKP SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMóáþúA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) EXP BSS 1 EXPONENT ISZ SBPTR STA SBPTR,I STORE ISZ SBPTR NUMBER IN STB SBPTR,I PROPER ISZ SBPTR LOCATION JSB BCKSP FETCH JSB GETCR FIRST LDA .10 UNUSED CHARACTER ISZ NUMCK NUMER ISZ NUMCK RETURN JMP NUMCK,I VIA (P+2) OR (P+3) SKP *************************************** * * * INTEGERIZE FLOATING POINT nUMBER * * * *************************************** * * ENTER WITH A F.P. NUMBER IN (A) AND (B). IF EXPONENT * EXCEEDS 23, NUMBER HAS INTEGER SIGNIFICANCE EXIT TO (P+1) * ALL OTHER CASES EXIT TO (P+2) WITH 32 BIT INTEGER RIGHT * JUSTIFIED IN (A) AND (B). ON EXIT (O) = 1 IF NUMBER IS EXACTLY * REPRESENTABLE AS 16 BIT INTEGER. IF EXPONENT IS NEGATIVE, TRUN- * CATE TO 0 OR -1 APPROPRIATELY AND LET (O) = 1. OTHERWISE RIGHT * JUSTIFY INTEGER AND EXIT WITH LAST BIT LOST IN (E). * IFIX NOP STO SET OVERFLOW FLAG STA MANT1 SAVE (A) CLA OCT 101050 LSR 8, GET EXPONENT ALF,ALF IN (A) AND BLF,BLF MANTISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR SMASK YES, PROPAGATE SIGN SSA EXPONENT NON-NEGATIVE? JMP IFIX3 NO, RETURN 0 OR -1 ADA M16 SSA EXPONENT LESS THAN 16? YyþúCLO YES, CLEAR OVERFLOW ADA M8 SSA,RSS EXPONENT LESS THAN 24? JMP IFIX,I NO, ERROR EXIT, NO FRACTION * ADA M8 STA MANT2 SAVE SHIFT COUNT LDA MANT1 RETRIEVE HIGH MANTISSA JMP IFIX2 * IFIX1 CLE,SLA,ARS LONG RIGHT SHIFT CME SLB,ERB STO SET OVERFLOW IF 1 LOST IFIX2 ISZ MANT2 DONE? JMP IFIX1 NO, SHIFT SOME MORE ISZ IFIX DONE, SKIP (P+1) JMP IFIX,I RETURN (P+2) * IFIX3 LDA MANT1 NEGATIVE EXPONENT, RETRIEVE (A) CLE,SSA CCA,RSS TRUNCATE TO -1 OR 0 CLA,RSS CCB,RSS CLB JMP IFIX2+2 SKIP RETURN * SMASK OCT 77600 M16 DEC -16 M8 DEC -8 SKP ********************************************* * * * SUBROUTINE TO COMPUTE THE ENTIER OF A&B * * * ********************************************* * * ENTER WITH NUMBER IN (A) AND (B). IF EXPONENT > 14 THEN * EXIT TO (P+1), ELSE EXIT TO (P+2) WITH THE ENTIER OF THE * ARGUMENT IN (A). * .IENT NOP JSB IFIX JMP .IENT,I OVERFLOW XOR 1 (A) SHOULD BE FULL OF SIGN BITS SSA (B) SHOULD HAVE A SIGN TOO JMP .IENT,I IT DOESNT, ERROR EXIT CPA 1 IF (A) WAS ZERO JMP *+3 ALL IS OK CMA IF (A) WAS -1 CPA 1 ISZ .IENT ALSO OK, SKIP RETURN JMP .IENT,I LEAVE WITH RESULT IN A AND B. SKP ********************* * * * FORMAT AN INTEGER * * * ********************* INTCK NOP CHARACTER IN (A) CLB STORE STB INTGR PARTIAL RESULT INTC1 JSB DIGCK DIGIT? JMP INTC2 NO CLO LDB INTGR MULTIPLY ADB 1 PARTIAL ADB 1 RESULT ADB INTGR BY ADB 1 10}²þú ADB 0 ADD LATEST DIGIT SOC OVERFLOW? JMP INTC3 YES STB INTGR STORE PARTIAL RESULT JSB GETCR NO, FETCH LDA .10 NEXT CHARACTER JMP INTC1 INTC2 LDB INTGR ZERO SZB,RSS INTEGER? JMP INTC3 YES STB SBPTR,I NO, RECORD IT LDB INTCK,I INTEGER LDB 1,I TOO ADB INTGR LARGE? SSB,RSS JMP INTC3 YES LDB INTGR NO, ISZ SBPTR RETURN WITH ISZ INTCK INTEGER IN (B) INTC3 ISZ INTCK SET FOR 'FAIL' RETURN JMP INTCK,I SKP *********************** * * * GET DIGIT TO OUTPUT * * * *********************** GETDG NOP JSB MBY10 MULTIPLY BY 10 LDB EXP GET EXPONENT IN (B) CMB,INB AS NEGATIVE AND HIMSK KEEP 5 HIGH BITS OF (A) RAL NORMALIZE TO BIT 15 SSB,INB ROTATE INTEGER JMP *-2 INTO (A) AND MSK0 EXTRACT STA TEMP5 DIGIT LDB EXP ROTATE CMB,INB RAR BACK SSB,INB JMP *-2 XOR MANT1 REMOVE LDB MANT2 DIGIT JSB NORML NORMALIZE REMAINDER LDA TEMP5 LOAD (A) WITH DIGIT JMP GETDG,I ********************************** * * * MULTIPLY UNPACKED NUMBER BY 10 * * * ********************************** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXP MULTIPLY ADB .3 BY STB EXP 8 LDB MANT2 LOAD MANTISSA CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA r©þúSSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXP OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I SKP ******************************** * * * DIVIDE UNPACKED NUMBER BY 10 * * * ******************************** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXP 'TENTH' TO STB EXP MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER ÿÿNTISSA MPY TENTH MULITPLY BY ONE-TENTH (63416) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA* SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO MPY TENTH SAME FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I * TENTH OCT 63146 HIMSK OCT 174000 ******************************* * * * NORMALIZE (A), (B) AND EXP * * * ******************************* NORML NOP STA TEMP3 SET LEFT-SHIFT CLA COUNTER STA FERR TO ZERO LDA TEMP3 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA EXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ FERR COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,½OþúSSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, - UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA FERR COMPUTE CMA,INA CORRECTED ADA EXP EXPONENT STA EXP VALUE LDA MANT1 JMP NORM1 SKP SPC 3 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 STEMP EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 FFLAG EQU TEMPT+1 DPFLG EQU TEMPT+2 NMPTR EQU TEMPT+3 DIGCT EQU TEMPT+4 FERR EQU TEMPT+5 FILE ERROR FLAG MANT1 EQU TEMPT+8 MANT2 EQU TEMPT+9 EXPON EQU TEMPT+10 LENTH EQU TEMPT+11 INTGR EQU TEMPT+1 SKP ******************* * * * I/O SUBROUTINES * * * ******************* * * THE FOLLOWING SUBROUTINES ARE PRIMARILY USED BY THE BASIC * MAIN CONTROL FOR DOING I/O. THE INDIVIDUAL SEGMENTS MAY * ALSO CONTAIN SOME SPECIALIZED I/O ROUTINES. * *********************** * * * PRINT A LINE * * * *********************** WRITE NOP ENTRY SSA,RSS IF LENGTH > 0, MAKE CMA,INA NEGATIVE FOR CHARS STA LENTH SAVE IT STB WBUF1 SAVE BUFFER ADDRESS LDA FLFIL .CHECK FOR FILE SAVE-RESTORE INA,SZA,RSS JMP WRFIL .YES- CALL FILE WRITE JSB REIO RE-ENTRANT I/O DEF *+5 DEF .2 TO PRINT DEF LUOUT WBUF1 BSS 1 LINE ON DEF LENTH JMP WRITE,I TTY * WRFIL JSB FILWR .WRITE INTO A FILE DEF *+3 DEF LENTH .REQUEST LENGTH DEF WBUF1,I .BUFFER ADDRESS * SSB .ERROR ? RSS .YES - CLOSE THE FILE JMP WRITE,ÑŠˆ„I .NO CONTINUE WR1 JSB CLFIL .GO TO CLOSE FILE ROUTINE JMP RDYPT . AND GO HOME * ************************ * * * READ A LINE * * * ************************ REED NOP ENTRY ADA M1 BUMP CHARACTER COUNT BY ONE TO CHECK FOR STA LENTH LONG INPUT LINES STB KBUF1 AND ADDRESS LDA FLFIL .IS THIS A FILE INPUT? INA,SZA,RSS JMP RDFIL .YES READ A RECORD JSB REIO CALL REIO DEF *+5 DEF .1 TO READ A DEF LUINP KBUF1 BSS 1 LINE OF ASCII DEF LENTH * CPB .81 .CHECK FOR INPUT LINES GREATER RSS . THAN 81 CHARACTERS. IF LONGER JMP CONT . PRINT AN ERROR AND STOP REED2 LDA RERLN LDB RERBF JSB WRITE JMP PRMT * CONT STA MANT1 STB LENTH AND .32 END OF SZA TAPE? JMP REED1 .YES SET EOF INDICATOR LDA MANT1 .CHECK FOR EOF STATUS AND B200 SZA .YES EOF SET EOF INDICATOR REED1 LDB M2 YES LDA 1 NO, RETURN WITH JMP REED,I LENGTH IN (A) * RDFIL JSB FILRD . READ A RECORD DEF *+3 DEF LENTH DEF KBUF1,I SSB .AN ERROR ? JMP WR1 .CLOSE FILE - GO HOME CPA .82 .GREATER THAN 80 CHARACTERS ?? JMP REED2 .YES GENERATE AN ERROR CPA M1 .AN EOF ? ADA M1 .YES - SO SET THE FLAG JMP REED,I .1 DEC 1 B200 OCT 200 .81 DEC 81 .82 DEC 82 RERBF DEF *+1 ASC 16,NUMBER OF CHARACTERS EXCEEDS 80 RERLN DEC -32 * * END BASIC Ô‹Šÿÿ ÿýLh ÿ92065-18002 1726 S C0322 &MBC10 RTE-M BASIC SYNTAX SUBR             H0103 û6þúASMB,R HED <> 92065-16001 NAM BASC1,7 92065-16001 REV.1726 770523 * DATE REV CODE 9-24-76 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. 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. * ************************************************************** * * * * SOURCE: 92065-18002 * * * ************************************************************* * * ENT BASC1,QUOTE,DIM EXT PLIST,PEXMK,GETCR,LETCK,DIGCK,INTCK,MVTOH EXT BCKSP,FNDPS,NUMCK,OUTER EXT FCNS,FCNCT,INDCK COM TEMPS(30),PNTRS(61),SPEC(10) **************************************************** * * * SEGMENT #1: CHECK SYNTAX AND TRANSLITERATE * * * **************************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER A RECORD IS INPUT WITH A NUMBER AS THE FIRST CHAR. IT * WILL CONVERT AN ASCII STATEMENT RECORD INTO THE SPECIAL BINARY * CODE WHICH IS USED BY THE LIST AND EXECUTION SEGMENTS OF THE * INTERPRETER. AFTER EACH STATEMENT IS PROCESSED, EXECUTION IS * RETURNED TO THE MAIN CONTROL PROGRAM. THE GENERAL FORM OF THE * TRANSLITERATED CODE IS SHOWN BELOW: * * WORD #1 - LINE NUMBER * WORD #2 - # WORDS IN TRANSLITERATED STATEMENT * WORD #3 > WORD #N - OPERATORS, CONSTANTS, ETC. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDREtYþúSS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP SUP PRESS MULTIPLE LISTINGS SPC 1 oåþúTEMPT BSS 14 .2 DEC 2 .3 DEC 3 .10 DEC 10 B42 OCT 42 B4000 OCT 4000 LETOP OCT 32000 OPMSK OCT 77000 OPDMK OCT 100777 FRMSK OCT 100757 M1 DEC -1 M2 DEC -2 M3 DEC -3 M9 DEC -9 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG STBAS DEF SYNTB-26,I SKP ********************************** * * * PRINT NAME TABLE FOR OPERATORS * * * ********************************** QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD ASC 1," COMMA OCT 2000 ARE THE BASIC CODE OPERATOR ASC 1,, SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE ASC 1,; RPARN OCT 4001 OPERATOR'S HIERARCHICAL ASC 1,) RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS ASC 1,] SCMMA OCT 6002 BELONGING TO FORMULAS. THE ASC 1,, ASSOP OCT 7002 UNLABELLED WORD GIVES THE ASC 1,= PLUS OCT 10007 ASCII REPRESENTATION OF THE ASC 1,+ MINUS OCT 11007 SINGLE CHARACTER OPERATORS. ASC 1,- TIMES OCT 12010 ASC 1,* DIV OCT 13010 ASC 1,/ EXPS OCT 14012 ASC 1,^ GTR OCT 15005 ASC 1,> LSS OCT 16005 ASC 1,< UNEQL OCT 17005 ASC 1,# EQUAL OCT 20005 ASC 1,= UNMIN OCT 21011 ASC 1,- LBRAC OCT 22020 ASC 1,[ LPARN OCT 23020 ASC 1,( UPLUS OCT 24011 ASC 1,+ OROP OCT 25003 MSFLG NOP ANDOP OCT 26004 DFLAG NOP NOTOP OCT 27011 PRFLG NOP GTREQ OCT 30005 UFLAG NOP LSSEQ OCT 31005 SKP * DIM OCT 33003 ASC 2,DIM COM OCT 34003 ASC 2,COM DEF OCT 35003 ASC 2,DEF REM OCT 36003 ASC 2,REM IF OCT 40002 ASC 1,IF FOR OCT 41003 ASC 2,FOR NEXT OCT 42004 ASC 2,NEXT END OCT 45003 ASC 2,END DATA OCT 51004 ASC 2,DATA * LET OCT 32003 THESE STATEMENTS MAY FOLLOW AN ASC 2,LET GO²ùþúTO OCT 37004 'IF' OPERATOR ASC 2,GOTO GOSUB OCT 43005 ASC 3,GOSUB RTRN OCT 44006 ASC 3,RETURN STP OCT 46004 ASC 2,STOP WAIT OCT 47004 ASC 2,WAIT CALL OCT 50004 ASC 2,CALL READ OCT 52004 ASC 2,READ PRNT OCT 53005 ASC 3,PRINT INPUT OCT 54005 ASC 3,INPUT RSTOR OCT 55007 ASC 4,RESTORE PAUSE OCT 56005 ASC 3,PAUSE TRAP OCT 66004 ASC 2,TRAP * FAIL OCT 57005 ASC 3,FAIL: THEN OCT 60004 ASC 2,THEN * USING OCT 61005 ASC 3,USING * TO OCT 75002 ASC 1,TO STEP OCT 76004 ASC 2,STEP OF OCT 77002 ASC 1,OF NOT OCT 27003 ASC 2,NOT AND OCT 26003 ASC 2,AND OR OCT 25002 ASC 1,OR * GTE OCT 30002 ASC 1,>= LTE OCT 31002 ASC 1,<= AUNEQ OCT 17002 ALTERNATE UNEQUAL SIGN ASC 1,<> * LEN OCT 3 ASC 2,LEN #SIGN OCT 73001 ASC 1,# EOF OCT 62003 ASC 3,EOF SKP ************************************* * * * BRANCH TABLE FOR STATEMENT SYNTAX * * * ************************************* SYNTB DEF LETS LET DEF DIMS DIM DEF COMS COM DEF DEFS DEF DEF REMS REM DEF GOTOS GO TO DEF IFS IF DEF FORS FOR DEF NXTS NEXT DEF GOTOS GOSUB DEF ENDS RETURN DEF ENDS END DEF ENDS STOP DEF WAITS WAIT DEF CALLS CALL DEF DATAS DATA DEF READS READ DEF PRINS PRINT DEF INPTS INPUT DEF RSTRS RESTORE DEF PAUS PAUSE DEF SYNE2-1 FAIL DEF SYNE2-1 THEN DEF SYNE2-1 USING NOP SPCECIAL SYNTAX REP 3 NOP .PLACE HOLDERS DEF TRAPS TRAP SPC 1 * #STND DEC -23 # STANDARD OPERATORS IN TABLE ³þú * #PSIF DEC -12 # OPERATORS ALLOWED PAST 'IF' * SKP *********************************** * * * CHECK SYNTAX AND TRANSLITERATE * * * *********************************** BASC1 NOP * * LDA SBPTR,I GET FIRST CHAR IN BUFFER SPC 1 * DETERMINE SEQUENCE NUMBER SPC 1 SYNTX CPA .45 MINUS SIGN(DELETE CURRENT LINE)? JMP DLLIN YES JSB INTCK RECORD DEF MAXSN SEQUENCE NUMBER JMP SYE25 STA TEMP3 SAVE CHAR LDA LOLIM IS SEQUENCE CMA,INA NUMBER >= ADA 1 TO THE SSA LOW LIMIT? JMP PEXMK NO, IGNORE STMT LDA 1 IS SEQUENCE CMA,INA NUMBER <= ADA HILIM TO THE SSA HIGH LIMIT? JMP PEXMK NO, IGNORE STMT STB .LNUM SAVE LINE NUMBER * * LDB FWAMM SET UP INB SEARCH STB SUBS1 POINTERS STB SUBS2 STB SUBS3 STB SUBS4 LDA TEMP3 RECOVER CHAR ISZ SBPTR SAVE SPACE FOR LENGTH WORDR; LDB SBUFA SET INB TEMP TO STB TEMP (SBUFF)+1 SPC 1 * DETERMINE STATEMENT TYPE SPC 1 CPA .10 NULL STATEMENT? JMP DLSTM DELETE STATEMENT! LDB #STND -# OF STANDARD MNEMONICSR JSB TBSRH FIND STATEMENT TYPE DEF DIM START AT TOP OF LIST RSS NO ERROR IF NOT FOUND JMP PSTIF FOUND SUBR LDB FWAMM,I GET MNEM COUNT SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS1 JSB TBSRH LOOK IN MNEMONIC TABLE SUBS1 DEF 0 SS1 JMP TRYLT TRY LET STATEMENT PSTIF LDB M9 SET MULTIPLE STORE STB MSFLG TO FALSE LDB PBPTR NULL CPB PBUFF PROGRAM? RSS JMP SYNT1 NO LDB FWAM INŠ,þúSURE NO STB PBUFF SPURIOUS COMMON STB PBPTR EXISTS SYNT1 STB TEMPS POINTER CLB SET DEFINE FLAG STB DFLAG TO FALSE STB PRFLG SET PARAMETER FLAG TO FALSE STB FROMF SET FROM FLAG CLEAR STA 1 * SYNT5 LDA FWAMM IS ENTRY IN CMA,INA THE STANDARD BASIC ADA TBLPT STATEMENT TABLE? SSA,RSS NAMED SUBROUTINE? JMP NMSBR YES LSR 9 COMPUTE ADDRESS OF SYNTAX STB SFLAG SET STRING FLAG TO OFF ADB STBAS ROUTINE AND JMP 1,I BRANCH TO IT ** *** TRY IMPLIED LET ** TRYLT LDB M1 SET TO SMALL NEG. NO. STB TBLPT SO TO SKIP NAMED SUB. SYNTAX JSB BCKSP BACK UP TO START FORMULA PROCESSOR LDA LETOP STA SBPTR,I DUB IN "LET" CODE JMP PSTIF SKP ** * *** *** ** LET STATEMENT SYNTAX ** *** *** * LETS LDA SBPTR ENABLE STRING STA SFLAG VARIABLE ISZ MSFLG SET MULTIPLE STORE FLAG ON JSB FSC FETCH FORMULA ISZ SFLAG STRING VARIABLE FOUND? JMP LET1 NO! JSB SYMCK YES, DEMAND ASSIGNMENT OPERATOR! DEF ASSOP-1 JMP SYNE2-1 NO ASSIGNMENT OPERATOR! JSB RSTOP RECORD STRING OPERATOR JSB SNULL RECORD END-OF-FORMULA JMP EOST DEMAND END SPC 1 LET1 ISZ SFLAG DID STORE OCCUR? JSB ERROR NO SYNE2 EQU * * ****************************** * * * CHECK FOR END OF STATEMENT * * * ****************************** EOST CPA .10 END OF STATEMENT? JMP ACTST YES,ACCEPT STATEMENT! NOEOF JSB ERROR CHARACTERS AFTER LEGAL END-OF-STATEMENT ***************************** * * * CALL STATEMENT SYNTAX * * * ***************************** * ºþú * THE CALL SYNTAX CHECK MAKES EXTENSIVE USE OF THE MNEMONIC AND * BRANCH TABLES TO DETERMINE THE CORRECTNESS OF THE SUBROUTINE * CALL AND THE ORDINAL POSITION OF THE SUBROUTINE WITHIN THE * BRANCH TABLE, SO THAT THE EXECUTE SEGMENT OF BASIC CAN COMPUTE * THE ADDRESS OF THE SUBROUTINE. CERTAIN ERRORS CAN BE CAUSED * BY THE INCORRECT USE OF PARAMETERS IN THE CALLING SEQUENCE OF * A SUBROUTINE. BELOW IS A SIMPLE TABLE INDICATING LEGAL PARAMETERS: * * * DIRECTION OF PARAMETER TRANSFER * +---------------------------------------------------+ * ! TYPE OF PARAMETER ! BASIC TO SUB. ! SUB. TO BASIC ! * +---------------------------------------------------! * ! SIMPLE VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! ARRAY VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! ARRAY ELEMENT ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! EXPRESION ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * * * * THE MNEMONIC TABLE CONTAINS THE ASCII NAME OF THE SUBROUTINE, * THE NUMBER OF CHARACTERS IN THE SUBROUTINE, AND THE NUMBER OF * PARAMETERS IN THE SUBROUTINE CALLING SEQUENCE. THE FORMAT OF * EACH ENTRY IS SHOWN BELOW. * * * 15 0 * +-------------------------------+ * !F! ! ! ! ! ! ! !P!P€Œþú!P!P!C!C!C!C! * +-------------------------------+ * ! 1ST CHARACTER ! 2ND CHARACTER ! * +-------------------------------+ * ! 3RD CHARACTER ! ETC. ! * +-------------------------------+ * * WHERE : * F = 1 IF FUNCTION * F = 0 IS SUBROUTINE * PPPP = NUMBER OF PARAMTERS * CCCC = NUMBER OF CHARACTERS IN NAME * * * THE BRANCH TABLE CONTAINS INFORMATION REGARDING THE ADDRESS * OF THE SUBROUTINE, PARAMETER CONVERSION (REAL TO INTEGER OR * INTEGER TO REAL), TYPE OF PARAMETER, AND DIRECTION THAT THE * PARAMETER IS REUIRED TO GO ( BASIC TO SUBROUTINE OR SUBROUTINE * TO BASIC). * * * 15 0 * +-------------------------------+ * !D!D!D!D!D!P!P!P!P!P!S!S!S!S!S!S! ADDRESS * +-------------------------------+ * !X!A!A!A!A!A!A!A!A!A!A!A!A!A!A!A! ARRAY * +-------------------------------+ * !X!T!T!T!T!T!T!T!T!T!T!T!T!T!T!T! TO FROM * +-------------------------------+ * !F!I!I!I!I!I!I!Y!I!I!I!I!I!I!I!I! CONVERSION * +-------------------------------+ * * * WHERE: * DDDDD = IDENTIFICATION LETTER * PPPPP = OVERLAY NUMBER * SSSSSS = SUBROUTINE NUMBER WITHIN OVERLAY * A = 1 IF ARRAY, 0 IF NON-ARRAY * T = 1 IF FROM SUBROUTINE, 0 IF TO SUBROUTINE * F = 1 IF INTEGER FUNCTION * F = 0 IF REAL FUNCTION * I = 1 IF CONVERSION TO INTEGER REQUIRED * I = 0 IF NO CONVERSION REQUIRED * X = BIT POSITION NOT USED * * * CALLS JSB GETCR FETCH AND JMP NOEOF RECORD LDB FWAMM,I GET MNEM COUNT SZB,RSS JMP SS2 .IF NULL TABLE SKIP TABLE SEARCH JSB TBSRH LOOK FOR SUBROUTINE NAME òUþúSUBS2 DEF 0 SS2 JSB ERROR NOT FOUND CALER JMP PSTIF DO POST-IF STATEMENT * ** *** NAMED SUBROUTINE SYNTAX (NO 'CALL' PREFIX) ** NMSBR CLA SET TO STA TEMP7 INDICATE SUBROUTINE * GET FIRST WORD OF MNEMONIC TBL ENTRY LDA PRPTR,I IS THIS SSA REALLY A SUBROUTINE? JSB ERROR NO! SYNE3 EQU * FUNCT STA TEMP6 SAVE PARAMETER WORD RRR 4 COUNT AND .15 FROM CMA BEING DESTROYED STA PCNT BY FSC CMA SAVE COUNT LSL 9 LEFT JUSTIFY STA TEMP3 FOR INTERP. CODE LDA FWAMM,I COMPUTE OFFSET IN MNEMONIC TBL CMA,INA ADA COUNT AND SAVE IT FOR LATER STA TCCNT THIS ORDINAL POSITION OF SUB. ENTRY LDB TEMP6 FORTRAN SSB FUNCTION? JMP CALL1 YES! ADA B5000 NO, ADD IN CALL OP CODE CALL4 STA SBPTR,I STORE IN INTERP. CODE ISZ SBPTR UPDATE INTERP. CODE PTR. LDA COMMA COMMA CODE STA SBPTR,I STUFF IT (WIPE OUT LEFT PAREN) ISZ PCNT ANY PARAMETERS REQUIRED? JMP NAMSB YES LDB B4000 FUDGE A RIGHT PAREN STB SBPTR,I LDA TEMP7 DID WE PROCESS A AND OPDMK FORTRAN CPA FRMSK FUNCTION JMP FSC10+1 YES! JSB GETCR FETCH NEXT CHARACTER LDA .10 ISZ SBPTR JMP CALL5 * CALL1 ADA TEMP3 STUFF IN JMP CALL4 PARM COUNT INSTEAD OF B50000 * * CALL2 CCB JSB SYMCK COMMA? DEF COMMA-1 JMP CALL3 NO ISZ PCNT YES, MORE PARAMS REQUIRED? JMP PRMCK YES, LOOK FOR PARAMETER. SYE11 JSB ERROR WRONG NUMBER OF PARAMS. * * PROCESS SUBROUTINE AND FUNCTION PARAMETERS * NAMSB LDA TCCNT GET ORDINAL NUMBER ALS,ALS AND MULTIPLY BY 4 ADA .2 AND ADD 2 TO GET ADA FWAMB POSITION IN Ó þúBRANCH TBL THEN LDA 0,I GET THE TO/FROM PARAMETER WORD STA TOFRM SAVE FOR CHECKING EACH PARAMETER PRMCK LDA TOFRM GET TO/FROM WORD CCB SLA,RSS IS IT SET? CLB NO! THEN SET THE FLAG TO 0 STB FROMF YES! THEN SET IT NON-ZERO ARS SHIFT TO STA TOFRM FOR NEXT PARAMETER JSB GETCR GET THE FIRST PARAMETER CHARACTER LDA .10 CPA B42 IS IT A STRING LITERAL? JMP CALL6 YES! JSB LETCK IS IT A LETTER? JSB PERR NO, CHECK FOR PARAMETER ERROR JSB BCKSP NO, PUT CHAR BACK JSB FRCUR SAVE VARIABLES LDA SBPTR SET TO STA SFLAG ALLOW STRING VARIABLES JSB FSC FETCH CLB CLEAR STB FROMF TO/FROM FLAG ISZ SFLAG STRING? RSS NO! JMP CALL7 YES! CALL8 JSB FPOP RESTORE VARIABLES JMP CALL2 PARAMETER FORMULA * CALL3 ISZ PCNT ALL PARAMETERS PRESENT? JMP SYE11 NO JSB RPCK YES, FETCH RIGHT PARENTHESIS STA 1 SAVE CHARACTER LDA TEMP7 FORTRAN AND OPDMK FUNCTION CPA FRMSK BEING PROCESSED? JMP FSC19 YES, COMPLETE SYNTAX CHECK LDA 1 RESTORE CHARACTER * CALL5 CCB JSB TBSRH IS CALL FOLLOWED BY "FAIL:"? DEF FAIL JMP EOST JSB GETCR YES. ANALYZE REST OF STMT. JMP NOEOF ISZ SBPTR JMP FAILS * CALL6 JSB PERR CHECK FOR PARAMETER ERROR ISZ SBPTR POINT AT PLACE TO PUT " OPERATOR CCB JSB SYMCK PUT IN " OPERATOR DEF QUOTE-1 NOP LDA B42 SPECIFY STRING TERMINATOR JSB CHRST PUT STRING IN INTERP CODE JSB SNULL ADD NULL AFTER STRING CONSTANT JSB GETCR FETCH NEXT CHARACTER LDA .10 JMP CALL2 * CALL7 JSB SNULL PUT NULL AFTER STRING Dþú CCB STB SFLAG RESET SFLAG JMP CALL8 * * * A CHECK IS MADE HERE TO SEE IF THE SUBROUTINE PARAMETER * (A STRING LITERAL, CONSTANT OR EXPRESSION) IS BEING * RETURNED FROM A SUBROUTINE AS INDICATED BY THE BRANCH TABLE * PERR NOP LDB FROMF FLAG SZB,RSS SET? JMP PERR,I NO! CPA .41 RIGHT PAREN? JMP PERR,I YES, OK THEN! CPA B135 RIGHT BRACKET? JMP PERR,I YES, OK CPA B54 COMMA? JMP PERR,I YES, OK THEN! CLA CLEAR STA FROMF FROM FLAG JSB ERROR NO, ILLEGAL PARAMETER SYE16 EQU * B5000 OCT 50000 .15 DEC 15 .41 DEC 41 B54 OCT 54 B135 OCT 135 SKP * ******************** * * * TRAP STATEMENT * * * ******************** * TRAPS CCB SET FOR STB CCODE NEG SEQ NUMBER CASE JSB FSC FETCH TRAP # FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE6-1 YES CCB GET JSB TBSRH GOSUB SYNTAX DEF GOSUB JSB ERROR NOT FOUND SYNE6 JSB GETCR CHECK NOP FOR (-) SIGN CPA .45 IS IT? JMP TRAP1 YES! JSB BCKSP GET BACK TO LAST CHAR TRAP2 CCB SET FOR STB RFLAG ERROR RETURN HERE JSB PRGIN GET SEQUENCE NUMBER DEF MAXSN RSS GOOD RETURN JSB CKZER IS NUMBER=0? JSB BCKUP BACK UP TO SEQ NUMBER LDB SBPTR,I NEGATE ISZ CCODE SEQUENCE NUMBER CMB,INB STB SBPTR,I IF NECESSARY ISZ SBPTR RESET PTR JMP EOST END-OF-STATEMENT PROCESSING * TRAP1 CLB SET FOR STB CCODE (-) FOUND JMP TRAP2 * CKZER NOP IF SZB B=0 JMP SYE25 THEN STORE STB SBPTR,I IT IN INTERP. ISZ SBPTR ELSE PRINT JM8êHFBP CKZER,I ERROR MESSAGE * SKP * ************************ * * * DIM STATEMENT SYNTAX * * * ************************ DIMS ISZ DFLAG SET DFLAG TO TRUE LDA SBPTR ENABLE STRING STA SFLAG VARIABLE JSB ARRYS CHECK AN ARRAY JMP ACTST DONE JMP DIMS+1 WAS A COMMA, CONTINUE ************************ * * * COM STATEMENT SYNTAX * * * ************************ COMS CLB SET ARRAY POINTER STB TEMPS+7 INITIALLY TO ZERO ISZ SBPTR SAVE SPACE FOR ISZ SBPTR COMMON SIZE WORD STB SBPTR,I INSERT NULL ISZ DFLAG SET DEFINE FLAG TO TRUE COMS1 CCA SET COMMON FLAG STA PRFLG TO TRUE LDA SBPTR ENABLE STA SFLAG STRING VARIABLES JSB ARRYS CHECK AN ARRAY RSS DONE JMP COMS1 MORE ARRAYS LDB SBUFA CALCULATE WHERE ADB .3 COMMMON SIZE GOES LDA TEMPS+7 RECORD COMMON STA 1,I SIZE JMP ACTST EXIT * SKP ¤ÏHÿÿþú************************ * * * DEF STATEMENT SYNTAX * * * ************************ DEFS JSB LTR JMP SYNE4 FIRST LDA TEMP1 ALF,ALF TWO CHARACTERS IOR TEMP2 CPA FN 'FN'? RSS YES JMP SYNE4 NO JSB LTR LETTER FOLLOWS? SYNE4 JSB ERROR NO LDA TEMP1 YES, RECORD A LDB .58 FUNCTION JSB STROP NAME LDA TEMP2 RETRIEVE CHARACTER JSB LPCK LEFT PARENTHESIS? IOR FLGBT YES, SET FORMAL STA SBPTR,I PARAMETER BIT JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JSB ERROR SUBSCRIPTED VARIABLE FOUND SYNE5 JSB RPCK RECORD A RIGHT PARENTHESIS CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO LDA M2 YES, ADA SBPTR RETRIEVE LDA 0,I PARAMETER AND MSK1 AND STA PRFLG SAVE IT JSB FSC FETCH DEFINING FORMULA JMP EOST END-OF-STATEMENT TEST * .58 DEC 58 B200 OCT 200 MSK1 OCT 777 FN ASC 1,FN * * ************************ * * * REM STATEMENT SYNTAX * * * ************************ REMS LDA B200 DUMMY STRING TERMINATOR JSB CHRST FETCH CHARACTER STRING JMP ACTST *********************** * * * IF STATEMENT SYNTAX * * * *********************** IFS ISZ SBPTR FETCH JSB GETCR NEXT CHARACTER JMP SYNE7-1 ILLEGAL IF STMT STA SBPTR,I FOUND, SAVE IT CCB LOOK JSB TBSRH FOR 'EOF' DEF EOF JMP IF0 NONE FOUND JSB LUCHK .LOOK FOR THE LU # JSB ERROR .NO PROPER LU # FOUND SYE27 JMP *-1 JMP IFS2 .LU FOUND LOOK FOR THEN XX IF0 JSB BCKSP RESTORE bèþú JSB BCKUP AS WAS ON ENTRY STB SFLAG ENABLE STRING FORMULA JSB FSC GET DECISION FORMULA ISZ SFLAG STRING? JMP FAILS NO! STA TEMP1 YES,SAVE NEXT CHAR LDB M3 MULTI-CHARACTER JSB TBSRH OPERATOR DEF GTE PRESENT? RSS NO! JMP STER4 YES, PUT IT AWAY LDA TEMP1 CHAR IN (A) LDB M4 SEARCH 4 OPERATORS JSB SYMCK SINGLE CHAR REL OPERATOR DEF GTR-1 PRESENT? JSB ERROR ILLEGAL REL OPERATOR STER4 JSB RSTOP STORE STRING JSB SNULL SET END-OF-FORMULA FAILS CCB LOOK FOR JSB TBSRH 'THEN' DEF THEN JMP IFS1 NOT FOUND IFS3 CLB FOUND, GET STATEMENT JMP GOTO0 LABEL NUMBER IFS1 LDB #PSIF FOR FOLLOWING JSB TBSRH OPERATOR DEF LET RSS JMP PSTIF FOUND, GO CHECK SYNTAX LDB FWAMM,I FOR FOLLOWING SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS3 JSB TBSRH NAMED SUBROUTINE SUBS3 DEF 0 SS3 JSB ERROR NOT FOUND SYNE7 JMP PSTIF FOUND, GO CHECK SYNTAX * IFS2 CCB .LOOK FOR 'THEN' JSB TBSRH DEF THEN JMP SYNE7-1 .NOT FOUND (ONLY THEN LEGAL AFTER END) JMP IFS3 .GET GOTO SYNTAX M4 DEC -4 MAXSN DEC -10000 * * *********************************** * * * GOTO AND GOSUB STATEMENT SYNTAX * * * *********************************** GOTOS LDA INBFA SAVE CURRENT STA TEMP6 BUFFER POINTER LDA ICCNT AND COUNTER STA TEMP7 CCB SET 'PRGIN' FOR RETURN GOTO0 STB RFLAG ON ERROR JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER JMP GOTO2 FOUND END-OF-STATEMENT? GOTO3 JSB BCKUP BACK UP SYNTAX POINTER LDB TEMP6 RESTORE CURRENT ýéþú STB INBFA BUFFER POINTER LDB TEMP7 AND COUNTER STB ICCNT LDA SBPTR,I ERASE AND OPMSK 'INTEGER FOLLOWS' STA SBPTR,I FLAG JSB FSC FETCH FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE8-1 YES CCB THE 'OF' JSB TBSRH DEF OF JSB ERROR MISSING SYNE8 CLB SET 'PRGIN' FOR EXIT STB RFLAG ON ERROR GOTO1 JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER CCB JSB SYMCK COMMA NEXT? DEF COMMA-1 JMP EOST NO, END-OF-STATEMENT? JMP GOTO1 YES GOTO2 CPA .10 END-OF-STATEMENT? JMP EOST YES JSB BCKUP NO, MUST JMP GOTO3 BE A FORMULA SKP ************************ * * * FOR STATEMENT SYNTAX * * * ************************ FORS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND CCB JSB SYMCK ASSIGNMENT DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO JSB FSC YES, FETCH INITIAL VALUE FORMULA CCB THE JSB TBSRH 'TO' DEF TO JSB ERROR MISSING SYNE9 JSB FSC GET LIMIT FORMULA CPA .10 END-OF-STATEMENT? JMP ACTST YES JSB BCKUP NO, ERASE ZERO WORD CCB FOR JSB TBSRH THE 'STEP' DEF STEP JSB ERROR MISSING SYE10 JSB FSC GET STEP SIZE FORMULA JMP EOST END-OF-STATEMENT TEST ************************* * * * NEXT STATEMENT SYNTAX * * * ************************* NXTS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND JMP EOST END-OF-STATEMENT TEST ****************************************************~þú** * * * END, STOP, RESTORE, RETURN, PAUSE STATEMENT SYNTAX * * * ****************************************************** ENDS ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACTST YES JMP NOEOF NO ************************* * * * WAIT STATEMENT SYNTAX * * * ************************* WAITS CLB DISALLOW STRINGS STB SFLAG JSB GETCR GET FIRST CHAR JMP FSCE1 NO PAREN ERROR ISZ SBPTR JSB LPCK FETCH LEFT PAREN JSB FSC FETCH FORMULA JSB RPCK FETCH RIGHT PAREN JMP EOST END-OF-STATEMENT TEST SKP * ********************* * * * PAUSE STATEMENT * * * ********************* * PAUS CLB DISALLOW STB SFLAG STRINGS ISZ SBPTR JSB GETCR GET FIRST CHAR JMP ACTST IF NO PARAMETER IT'S OK JSB LPCK FETCH LEFT PAREN JSB GETCR GET FIRST CHAR OF PARAMETER JMP SYE25 BAD! CLB SET STB SIGN SIGN POSITIVE JSB NUMCK NUMBER? JMP SYE25 NO! JMP SYE25 NO! JSB NUMOP FIX UP PRECEDING OPERATOR JSB RPCK FETCH LEFT PAREN JMP EOST *********************** * * * RESTORE STATEMENT * * * *********************** * RSTRS JSB GETCR END OF STMT? JMP RSTR1 YES! JSB BCKSP NO,DEMAND JSB PRGIN SEQUENCE NUMBER DEF MAXSN JMP EOST DEMAND END-OF-STATEMENT RSTR1 ISZ SBPTR RECORD DUMMY OPERAND JMP ACTST ACCEPT STATEMENT * ************************* * * * DATA STATEMENT SYNTAX * * * ************************* DATAS CLA STA SIGN CLEAR SIGN À‰þú JSB GETCR JSB ERROR END-OF-INPUT CONDITION SYE12 CLB,INB SET SIGN CPA .43 '+' ? JMP DATA4 YES CCB CPA .45 NO, '-' ? JMP DATA4 YES DATA1 JSB NUMCK NO, NUMBER? JMP DATA3 NO JSB ERROR BAD EXPONENT NUMER JSB NUMOP FIX UP PRECEDING OPERATOR DATA2 CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA JMP EOST END-OF-STATEMENT TEST JMP DATAS FETCH ANOTHER NUMBER DATA3 CPB SIGN SIGN FOUND? (B)=0 RSS NO! JSB ERROR YES,SOLITARY SIGN SYE26 ISZ SBPTR DEMAND A JSB GETST STRING CONSTANT JMP DATA2 DATA4 STB SIGN RECORD SIGN JSB GETCR JMP EOST END-OF-INPUT CONDITION JMP DATA1 * .43 DEC 43 .45 DEC 45 * ******************* * * *LU CHECK * * * ******************* LUCHK NOP ISZ SBPTR .BUMP TO NEXT CHARACTER JSB GETCR . AND FETCH IT JMP LUCHK,I .END OF FILE RETURN ISZ LUCHK CCB JSB SYMCK .A "#"? DEF UNEQL-1 JMP LUCHK,I .NO - NOT A SPECIFIED LU ISZ LUCHK .YES CHECK FOR JSB FSC . LU VARIABLE OR CONSTANT JMP LUCHK,I .EXIT - VALID LU * ************************** * * * READ STATEMENT SYNTAX * * * ************************** READS JSB LUCHK .AN LU READ ? JMP SYE13-1 .MUST HAVE ARGUMENTS JMP READ1 .NO ! TRY INTERNAL READ CCB JSB SYMCK DEF SMCLN-1 JMP SYE13-1 .MUST HAVE SEMICOLON JMP INPTS .FETCH ARGUMENT LIST READ1 JSB BCKSP .RESTORE POINTERS JSB BCKUP * ************************** * * * INPUT STATEMENT SYNTAX * * * ************************** INPTS LDB SBPTR ENABLE STRING STB SFLAG ¯÷þúVARIABLE JSB VAROP RECORD VARIABLE OPERAND JSB ERROR MISSING SYE13 NOP CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA RSS JMP INPTS IS, FETCH NEXT ITEM JSB SNULL APPEND END-OF-FORMULA JMP EOST END OF STATEMENT TEST * ************************************ * * * PRINT STATEMENT SYNTAX CHECKER * * * ************************************ * * * PRINT USING CODE GOES HERE SOMEDAY * PRINS JSB LUCHK .A #,LU PRINT? JMP ACTST .END OF RECORD - DONE JMP PRIN5 .NOT A #LU PRINT CCB .LOOK FOR A SEMICOLON JSB SYMCK DEF SMCLN-1 JMP ACTST .NONE FOUND NULL PRINT JMP PRIN0 .YES - LU SPECIFIED PRIN5 JSB BCKUP .NO - CRT/CONSOLE JSB BCKSP .RESTORE POINTERS PRIN0 ISZ SBPTR ADVANCE SYNTAX PTR JSB GETCR MORE STATEMENT? JMP ACTST NO! CCB YES, ENABLE STB TEMP,I FORMULA AND TAB CPA B42 QUOTE? RSS YES! JMP PRIN3 NO! PRIN1 JSB GETST RECORD A STRING CONSTANT ISZ SBPTR CPA .10 END-OF-STATEMENT? JMP ACTST YES! CCB NO! STB TEMP,I PRIN2 CPA B42 QUOTE? JMP PRIN1 YES! LDB M2 NO! JSB SYMCK COMMA OR DEF COMMA-1 SEMICOLON? RSS NO! JMP PRIN0 YES! JSB SNULL ZERO NEXT WORD PRIN3 ISZ TEMP,I FORMULA OR TAB PERMITTED? SYE15 JSB ERROR NO! STA SBPTR,I NO! PRIN4 JSB BCKSP BACKUP JSB BCKUP POINTERS STB SFLAG ENABLE STRING VARIABLE JSB FSC RECORD FORMULA CCB WAS THIS A CPB SFLAG STRING VARIABLE JSB SNULL YES, OUTPUT A NULL WORD CPA .10 END-OF-STATEMENT? RSS YES! JMP PRIN2 ”†þú NO! JSB SNULL SET END-OF-FORMULA JMP ACTST ACCEPT STATEMENT SPC 3 *************************** * * * OUTPUT A NULL WORD * * * *************************** * SNULL NOP CLB STB SBPTR,I STORE 0 IN INTERPRETIVE ISZ SBPTR BUFFER AREA JMP SNULL,I SKP SKP ************************** * * * FORMULA SYNTAX CHECKER * * * ************************** FSC NOP CLA SET LEFT PARENTHESIS STA TEMPS,I COUNT TO ZERO FSC1 CCA SET UNARY FLAG STA UFLAG TO TRUE STA TEMP5 SET LEN FLAG OFF SPC 1 * PROCESS VARIABLE OPERAND SPC 1 FSC2 JSB VAROP LOOK FOR VARIABLE OPERAND JMP FSC9 NOT FOUND JMP FSC13 SUBSCRIPTED OR STRING VARIABLE FOUND JSB PERR CHECK FOR PARAMETER ERROR JSB LETCK FOLLOWED BY LETTER? JMP FSC6 NO LDB M2 YES, LOOK FOR JSB MCBCK 'AND' OR 'OR' LDA TEMP1 NOT FOUND, FETCH PREVIOUS ALF,ALF CHARACTER AND LEFT-JUSTIFY IT IOR TEMP2 ADD LATEST CHARACTER CPA FN 'FN'? JMP FSC4 YES JSB BCKSP GO BACK ONE SPACE LDA TEMP1 CCB JSB TBSRH IS THIS DEF LEN A LENGTH FUNCTION? RSS NO! JMP FSC15 YES! LDB FCNCT IS FUNCTION IN MNEMONIC TABLE? LDA TEMP1 A = CHARACTER JSB TBSRH FUNCTION DEF FCNS JMP FSC16 NOT FOUND LDA FCNCT FOUND FUNCTION SO COMPUTE OFFSET IN CMA,INA TABLE ADA COUNT FSC18 ALF IOR FLGBT ADD FLAG BIT JMP FSC5 FSC16 LDB FWAMM,I GET TABLE LENGTH SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS4 JSB TBSRH IS THERE SUBS4 DEF 0 FORTRAN FUNCTION SS4 JMP FSC3 NO! n?þú LDA FRMSK YES, CODE OCT 36 CCB INDICATES ADB SBPTR A FORTRAN FUNCTION STA TEMP1 SAVE IT LDA 1,I RETRIEVE PREVIOUS AND OPMSK OPERATOR IOR TEMP1 AND COMBINE WITH FUNCTION STA 1,I FUNCTION STA TEMP7 SET TEMP7 AS FORTRAN FNCT FLAG LDA PRPTR,I IS IT REALLY SSA,RSS A FORTRAN FUNCTION? JSB ERROR NO! SYNE1 EQU * JMP FUNCT YES,CHECK SYNTAX OF IT FSC3 ISZ UFLAG 'NOT' PERMITTED? JMP FSC8-2 NO CCB SEARCH FOR JSB TBSRH 'NOT' DEF NOT JMP FSC8-2 'NOT' NOT FOUND CCB RETRIEVE ADB SBPTR PREVIOUS WORD LDA 1,I WORD AND OPMSK SET TO STA 1,I NULL OPERAND JMP FSC14 SPC 1 * LEN FUNCTION FOUND? SPC 1 FSC15 CLA SET LEN FLAG! STA TEMP5 LDA B37 LEN OP CODE IS FIXED JMP FSC18 AT OCT 37 SPC 1 * PROCESS USER-DEFINED FUNCTIONS (FNA, FNB, ...) SPC 1 FSC4 JSB GETCR IDENTIFYING JMP SYNE4 FUNCTION JSB LETCK LETTER? ?q JMP SYNE4 NO ADA D100 YES, ALF ASSEMBLE AND FSC5 ADA .15 SAVE STA TEMP1 FUNCTION IDENTIFIER CCB RETRIEVE ADB SBPTR PREVIOUS LDA 1,I PROGRAM WORD AND OPMSK EXTRACT OPERATOR, IOR TEMP1 APPEND OPERAND, STA 1,I AND RECORD ISZ TEMP5 IS "LEN" FLAG SET? JMP FSC17 YES! JSB GETCR LEFT PARENTHESIS FSCE1 JSB ERROR OR JSB LPCK LEFT BRACKET? JSB FRCUR YES, SAVE LOCAL VARIABLES OF FSC JSB FSC FETCH ACTUAL PARAMETER JSB FPOP RESTORE LOCAL VARIABLES OF FSC JSB RPCK FETCH RIGHT PARENTHESIS JMP FSC10+1 FSC7 LDB M2 CHECK FOR Jdþú JSB SYMCK RIGHT PARENTHESIS DEF RPARN-1 OR RIGHT BRACKET JMP FSC8 NOT FOUND LDA B4000 RECORD A STA SBPTR,I RIGHT PARENTHESIS LDA .41 RESTORE RIGHT PARENTHESIS CCB MATCHING ADB TEMPS,I LEFT SSB PARENTHESIS? JMP FSC8 NO STB TEMPS,I YES ISZ SBPTR JSB GETCR FETCH LDA .10 FSC6 CPA .10 END OF FORMULA? JMP FSC8 YES STA UFLAG NO, SET UNARY FLAG TO FALSE LDB M5 SEARCH FOR A MULTICHARACTER JSB MCBCK BINARY OPERATOR LDB MSFLG SEARCH JSB SYMCK FOR A DEF PLUS-1 BINARY OPERATOR CCB,RSS NOT FOUND JMP FSCM FOUND JSB SYMCK DEF ASSOP-1 OPERATOR? JMP FSC7 NO LDA M2 STA SFLAG YES, SET JMP FSC1 'STORE OCCURRED' FLAG JSB GETCR RETRIEVE LETTER LDA .10 FSC8 LDB TEMPS,I ALL LEFT PARENTHESES S\ SZB MATCHED? FSCE2 JSB ERROR NO STB SBPTR,I YES, RECORD AN ISZ SBPTR END-OF-FORMULA AND CCB JMP FSC,I EXIT WITH CHARACTER IN (A) SPC 1 * PROCESS "LEN" FUNCTION FOR STRING ARGUMENT SPC 1 FSC17 JSB GETCR RECORD JMP FSCE1 LEFT JSB LPCK PARENTHESIS JSB LTR LETTER NEXT? JSB ERROR NO, PARAMETER NOT STRING! STER2 CPA B44 YES, FOLLOEWED BY "$"? RSS YES! JMP STER2-1 NO, PARAMETER NOT STRING! LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARAIABLE CLA PLACE NULL STA SBPTR,I AFTER PARAMETER ISZ SBPTR JSB GETCR RECORD JMP FSCE2 RIGHT JSB RPCK PARENTHESIS JMP FSC10+1 SPC 1 * PROCESS CONSTANT OPERAND SPC 1 FSC9 CLB SET SIGN POSITIVE STB SIGN JS4VþúB NUMCK NUMBER? JMP FSC11 NO, TRY FOR LEFT PAREN JMP NUMER-1 JMP FSC10 FOUND IT! FSC19 LDA 1 RESTORE CHARACTER LDB M2 SET STORE STB SFLAG OCCURRED FLAG RSS FSC10 JSB NUMOP YES, FIX UP PRECEDING OPPERATOR LDB M9 UPDATE STB MSFLG MULTIPLE STORE FALG JMP FSC6 FSC11 CPA .40 LEFT JMP FSC12 PARENTHESIS CPA B133 OR LEFT BRACKET? JMP FSC12 YES ISZ UFLAG NO! SPC 1 * PROCESS UNARY OPERATORS SPC 1 FSCE3 JSB ERROR NO LDB UNMNC CPA .43 '+'? JMP *+4 YES CPA .45 NO, '-'? JMP *+3 YES JMP FSCE3 NO ADB B3000 STORE ISZ SBPTR UNARY STB SBPTR,I OPERATOR FSC14 LDB M9 UPDATE STB MSFLG MULTIPLE STORE FLAG JMP FSC2 FLAG SPC 1 FSC12 ISZ SBPTR IS LPAR, LDA LPARN RECORD IT AND OPMSK AND ISZ TEMPS,I COUNT IT STA SBPTR,I FSCM LDB M9 ENTER ON MULTICHAR OPR STB MSFLG UP DATE MULTIPLE STORE FLAG JMP FSC1 SPC 1 FSC13 CCB STRING VARIABLE CPB SFLAG FOUND? JMP FSC,I YES! JMP FSC6 NO! SKP ********************************************** * * * CHECK FOR A MULTICHARACTER BINARY OPERATOR * * * ********************************************** MCBCK NOP JSB TBSRH OR 'OR' DEF AND JMP MCBCK,I NOT FOUND JMP FSCM FOUND ******************************** * * * RESTORE FSC LOCAL QUANTITIES * * * ******************************** FPOP NOP STA TEMP1 SAVE CHARACTER LDB TEMPS ADB M7 STB TEMPS RESTORE S-STACK TOP INB VÓþúLDA 1,I STA MSFLG RESTORE MULTIPLE STORE FLAG INB LDA 1,I RESTORE STA PCNT PARAMETER COUNT INB LDA 1,I RESTORE FORTRAN STA TEMP7 FUNCTION FLAG INB LDA 1,I STA UFLAG RESTORE UNARY OPERATOR FLAG INB LDA 1,I STA FSC RESTORE FSC RETURN ADDRESSSÉ INB LDA 1,I RESTORE STA VAROP VAROP RETURN ADDRESS ISZ SFLAG RESTORE SFLAG VALUE NOP LDA TEMP1 RETRIEVE CHARACTER JMP FPOP,I ***************************** * * * SAVE FSC LOCAL QUANTITIES * * * ***************************** FRCUR NOP LDB TEMPS FETCH CURRENT S-STACK POINTER INB UPDATE IT LDA MSFLG DUMP MULTIPLE STORE STA 1,I FLAG ON S-STACK INB LDA PCNT SAVE STA 1,I PARAMETER COUNT INB LDA TEMP7 SAVE FORTRAN STA 1,I FUNCTION FLAG INB LDA UFLAG STACK UNARY OPERATOR STA 1,I FLAG INB LDA FSC STACK FSC STA 1,I RETURN ADDRESS LDA VAROP STACK VAROP RETURN ADDRESS JSB SSOV AND CHECK FOR S-STACK OVERFLOWO÷ CCA ADA SFLAG DISABLE SFLAG VALUE STA SFLAG JMP FRCUR,I * .40 DEC 40 B37 OCT 37 B44 OCT 44 B53 OCT 53 B133 OCT 133 B3000 OCT 3000 UNMNC OCT 21000 M5 DEC -5 M7 DEC -7 M16 DEC -16 D100 OCT -100 SKP ********************************************** * * * PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW * * * ********************************************** SSOV NOP STORE QUANTITY INB ADVANCE S-STACK POINTER STA 1,I SAVE ITEM IN (A) INB ADVANCE S-STACK POINTER STB ͼþúTEMPS AND RECORD IT CMB,INB ADB LWBM LAST WORD SSB EXCEEDED? FSCE4 JSB ERROR YES JMP SSOV,I **************************** * * * CHECK FOR SUBSCRIPT PART * * * **************************** SBSCK NOP CHARACTER IN (A) CLB CLEAR CALL SYNTAX STB FROMF TO-FROM FLAG LDB M2 LEFT BRACKET JSB SYMCK OR DEF LBRAC-1 LEFT PARENTHESIS? JMP SBSCK,I NO, RETURN VIA (P+1) ISZ SBSCK YES, SET RETURN TO (P+2) LDA ARYAD,I SET AND M16 ARRAY INA TO STA ARYAD,I SINGLE SUBSCRIPT LDA B2200 RECORD A STA SBPTR,I LEFT BRACKET CLB DIM OR COM CPB DFLAG STATEMENT? JMP SBSC3 NO CLB SET 'PRGIN' FOR STB RFLAG EXIT ON ERROR JSB PRGIN FETCH INTEGER DEF M256 SUBSCRIPT BOUND BLF,BLF SAVE STB TEMP1 BOUND LDB SFLAG STRING CPB M1 VARIABLE? JMP SBSC1 YES! CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC1 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB PRGIN FETCH SECOND DEF M256 INTEGER SUBSCRIPT BOUND RSS SBSC1 CLB,INB SET ONE-DIMENSIONAL CASE ISZ PRFLG COM STATEMENT? JMP SBSC2 NO STA TEMP2 SAVE CHARACTER LDA 1 IOR TEMP1 RETRIEVE FIRST BOUND JSB MDIM FIND STORAGE NEED ISZ SFLAG STRING RSS VARIABLE? JMP SBSC4 YES! SBSC5 ADA TEMPS+7 UPDATE COM STA TEMPS+7 STORAGE POINTER LDA TEMP2 RETRIEVE NEXT CHARACTER SBSC2 LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? JMP FSCE2 NO LDA LF ähNLHYES, RECORD A STA SBPTR,I RIGHT BRACKET ISZ SBPTR ADJUST S-BUFFER POINTER JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER LDB DFLAG DIM OR COM SZB STATEMENT? JMP SBSCK,I YES JSB FPOP RESTORE FSC LOCAL VARIABLES LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB FETCH LDB 1,I RETURN ADDRESS JMP 1,I AND EXIT SBSC3 LDA SBSCK SAVE LDB TEMPS RETURN ADDRESS JSB SSOV ON S-STACK JSB FRCUR SAVE FSC LOCAL VARIABLES LDB M9 SET MULTIPLE STORE FLAG STB MSFLG TO FALSE LDA ARYAD SAVE LDB TEMPS OPERAND JSB SSOV ADDRESS JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB RESTORE LDB 1,I OPERAND STB ARYAD ADDRESS CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC2 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD JMP SBSC2 SBSC4 ARS ADJUST SIZE INA OF COMMON ARS TO EQUAL INA SPACE FOR CHARS JMP SBSC5 PLUS SPACE FOR SIZE * LF OCT 5000 B2200 OCT 22000 M32 DEC -32 M256 DEC -256 SKP åÕNÿÿþú******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I JSB INDCK PEEL OFF INDIRECTS ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT BUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER STA PRPTR PTR AND SAVE IT LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * SKP TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR +þú SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' EXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND MSK0 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT * .7 DEC 7 .8 DEC 8 .32 DEC 32 ************************************* * * * CHECK SYNTAX OF ARRAY DEFINITIONS * * * ************************************* ARRYS NOP JSB ARRID FETCH ARRAY IDENTIFIER JSB SBSCK RECORD A SUBSCRIPT JSB ERROR MISSING SUBSCRIPT SYE20 CPA .10 END-OF-STATEMENT? JMP ARRYS,I YES, RETURN VIA (P+1) CCB NO, JSB SYMCK MUST BE DEF COMMA-1 A COMMA JMP NOEOF ISN'T ISZ ARRYS IS, RETURN JMP ARRYS,I VIA (P+2) ************************** * * * FETCH ARRAY IDENTIFIER * * * ************************** ARRID NOP JSB LTR FETCH LETTER JMP SYE20-1 NONE FOUND CPA B44 $ ? JMP ARRE1 YES ARRE2 LDA SBPTR NO,SAVE STA ARYAD OPERAND ADDRES LDA TEMP1 RECORD LDB .46 ARRAY JSB STROP IDENTIFIER LDA TEMP2 RETRIEVE FOLLOWING CHARACTER JMP ARRID,I ARRE1 LDA SFLAG STRING VARIABLE CPA SB±HþúPTR PERMITTED CCA,RSS YES! JSB ERROR STRING NOT PERMMITED STER5 STA SFLAG SET FLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARIABLE LDA TEMPS SET PTR TO DUMMY LOCATION STA ARYAD JSB GETCR FETCH NEXT CHAR LDA .10 JMP ARRID,I * .46 DEC 46 .47 DEC 47 .48 DEC 48 ****************************** * * * CHECK FOR VARIABLE OPERAND * * * ****************************** VAROP NOP JSB LTR LETTER? JMP VAROP,I NO, EXIT VIA (P+1) ISZ VAROP CPA .40 LEFT PARENTHESIS? JMP VARO5 YES CPA B44 DOLLAR SIGN? JMP VARO6 YES, STRING VARAIBLE! CPA B133 NO, LEFT BRACKET? JMP VARO5 YES ISZ VAROP NO JSB DIGCK DIGIT? JMP VARO1 NO LDA TEMP1 YES, RETRIEVE LETTER, ADB .48 AND RESTORE ASCII DIGIT STB TEMP1 JSB STROP RECORD VARIABLE JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER JMP VARO2 VARO1 LDA TEMP1 RETRIEVE LETTER, LDB .47 SET 'NO DIGIT', JSB STROP AND RECORD VARIABLE LDA TEMP2 RETRIEVE FOLLOWING CHARACTER VARO2 STA TEMP2 SAVE CHARACTER CLB INSIDE A CPB PRFLG DEF STATEMENT? JMP VAROP,I NO, EXIT VIA (P+3) CCB ADB SBPTR RETRIEVE LDA 1,I AND MSK1 OPERAND CPA PRFLG MATCH PARAMETER? JMP VARO4 YES VARO3 LDA TEMP2 NO, RETRIEVE JMP VAROP,I CHARACTER AND EXIT VIA (P+3) VARO4 LDA 1,I SET OPERAND TO IOR FLGBT ACTUAL PARAMETER STA 1,I AND RECORD IT JMP VARO3 VARO5 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE LETTER LDB .46 RECORD JSB STROP ›6þú ARRAY IDENTIFIER LDA B133 RETRIEVE LEFT BRACKET VARO7 JSB SBSCK FETCH SUBSCRIPT NOP JMP VAROP,I EXIT VIA (P+2) SPC 1 VARO6 LDA SFLAG STRING VARIABLE PERMITTED CPA SBPTR CCA,RSS YES! JSB ERROR NO, ILLEGAL STRING VARIABLE! STER1 STA SFLAG SET SFLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD STRING VARIABLE LDB B53 JSB STROP LDA TEMPS SET POINTER TO DUMMY STA ARYAD LOCATION JSB GETCR GET LDA .10 NEXT CHARACTER JMP VARO7 FETCH SUBSCRIPT SKP ****************** * * * FETCH A LETTER * * * ****************** LTR NOP JSB GETCR LDA .10 JSB LETCK LETTER? JMP LTR,I NO, EXIT VIA (P+1) ISZ LTR YES, STA TEMP1 SAVE IT JSB GETCR NEXT CHARACTER LDA .10 TO (A) STA TEMP2 SAVE SECOND CHARACTER JMP LTR,I EXIT VIA (P+2) ************************* * * * STORE AN OPERAND NAME * * * ************************* STROP NOP LETTER IN (A), NUMBER IN (B) ADA D100 NUMERICALLY ADJUST THE ADB D53 OPERAND NAME ALF COMBINE THE IOR 1 TWO PARTS IOR SBPTR,I COMPLETE OPERAND-OPERATOR PAIR STA SBPTR,I AND STORE IT ISZ SBPTR UPDATE S-BUFFER POINTER JMP STROP,I ****************************** * * * CHECK FOR LEFT PARENTHESIS * * * ****************************** LPCK NOP CHARACTER IN (A) LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP FSCE1 NO LDA B2300 YES, RECORD A STA SBPTR,I LEFT PARENTHESIS JMP LPCK,I EXIT * B2300 OCT 23000 D53 OCT -53 ************************** * ìÈþú * * BACK UP SYNTAX POINTER * * * ************************** BCKUP NOP CCB DECREMENT ADB SBPTR SYNTAX POINTER STB SBPTR BY 1 JMP BCKUP,I SKP ******************************* * * * CHECK FOR RIGHT PARENTHESIS * * * ******************************* RPCK NOP LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? ? JMP FSCE2 NO LDA B4000 YES, RECORD A STA SBPTR,I RIGHT PARENTHESIS ISZ SBPTR UPDATE SYNTAX BUFFER POINTER JSB GETCR FETCH LDA .10 FOLLOWING CHARACTER JMP RPCK,I * ************************* * * * RECORD STRING FORMULA * * * ************************* * * DEMAND A STRING VARIABLE OR A STRING CONSTANT. EXIT TO * ERROR IF NEITHER IS FOUND, ELSE EXIT WITH THE NEXT CHAR- * ACTER IN (A). * RSTOP NOP LDA SBPTR SEEK STA SFLAG STRING JSB VAROP OPERAND JMP RSTO1 FIRST CHARACTER NOT LETTER ISZ SFLAG STRING VARIABLE? JMP STER1-1 NO STRING FOUND! JMP RSTOP,I SPC 1 RSTO1 ISZ SBPTR JSB GETST DEMAND STRING CONSTANT JMP RSTOP,I SKP *************************** * * * FETCH A STRING CONSTANT * * * *************************** * * EXIT TO ERROR IF (A) # " UPON ENTRY. ELSE SAVE CURRENT PTR * AND PACK INPUT STRING INTO BUFFER WORD. EXIT TO ERROR IF NO * CLOSING " IS FOUND. RECORD OPENING " ALONG WITH COUNT OF * THE STRING CHARS AND EXIT WITH THE NEXT CHARACTER IN (A). * EXIT TO ERROR IF STRING EXCEEDS 255 CHARACTERS. * GETST NOP LDB SBPTR SAVE SYNTAX BUF PTR STB ARYAD CCB LOOK FOR JSB SYMCK QUOTE AND RECORD DEF QUOTE-1 OPERAT3öþúOR JMP STER1-1 NO STRING FOUND! LDA B42 SET QUOTE AS TERMINATOR JSB CHRST RECORD STRING CONSTANT LDA ARYAD,I CHECK FOR ADA M1400 TOO MANY CHARACTERS SSA,RSS JSB ERROR YES! STER3 JSB GETCR NO,FETCH NEXT CHAR LDA .10 END-OF-STATEMENT JMP GETST,I * M1400 OCT 176400 SKP *************************************** * * * FLAG OPERATOR WHICH PRECEDES NUMBER * * * *************************************** NUMOP NOP STA TEMP4 LDB M3 FETCH ADB SBPTR PRECEDING LDA 1,I OPERATOR IOR FLGBT ADD FLAG BIT STA 1,I REPLACE OPERATOR LDA TEMP4 JMP NUMOP,I ************************************ * * * FETCH AND RECORD PROGRAM INTEGER * * * ************************************ PRGIN NOP LDA SBPTR,I SET IOR FLGBT 'INTEGER ADA .3 FOLLOWS' STA SBPTR,I OPERAND LDA PRGIN,I GIVE ADDRESS STA PRGI1 TO INTCK ISZ SBPTR ISZ PRGIN JSB GETCR JMP PRGI2 JSB INTCK FETCH PRGI1 NOP RSS JMP PRGIN,I RETURN VIA P+2 PRGI2 ISZ RFLAG RETURN ON ERROR? JMP PRGI3 .CHECK FOR DIM ERROR ISZ PRGIN YES JMP PRGIN,I RETURN VIA P+3 * PRGI3 CLB CPB DFLAG .DIM STATEMENT? SYE25 JSB ERROR JMP STER3-1 .YES **************************** * * * PROCESS CHARACTER STRING * * * **************************** CHRST NOP STA TEMP2 REM SENDS US (A)=B200 LDB SBPTR SAVE PTR TO CHAR COUNT WORD STB TEMP9 SZA IF A=0 SUPPRESS BLANKS STB BLANK ANYTHING GOES ON INPUT JSB GETCR FIRST CHAR CAN EVEN BE TERMINATOR ö?þú JMP CHRS5 NO MORE CHARS CPA TEMP2 TERMINATOR? JMP CHRS3 YES! CHRS1 ISZ TEMP9,I INCREMENT CHAR COUNT ALF,ALF ISZ SBPTR STA SBPTR,I STORE IN LEFT HALF OF WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR ISZ TEMP9,I INCREMENT CHAR COUNT IOR SBPTR,I STA SBPTR,I STORE RIGHT HALF IN WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR JMP CHRS1 SPC 1 CHRS2 NOP JSB GETCR GET NEXT CHARACTER JMP CHRS5 NO MORE CHARACTERS CPA TEMP2 TERMINATOR CHARCTER? CHRS3 CLA,RSS YES! JMP CHRS2,I ISZ SBPTR STA SBPTR,I NULL OPERATOR FOLLOWS STRING LDA .32 STA BLANK BEGIN IGNORING BLANKS AGAIN JMP CHRST,I SPC 1 CHRS5 JSB BCKSP IN CASE WE NEED TO SENSE THIS LATER LDA TEMP2 CPA B200 ARE WE DOING A REM JMP CHRS3 YES, ALL OK! SZA,RSS DOING A FILES STMT? JMP CHRS3 YES! LDA .32 RESTORE BLANK STA BLANK DELIMITER JSB ERROR NO, MISSING TERMINATOR SYE14 EQU * * ******************** * * * DELETE STATEMENT * * * ******************** DLLIN LDA .LNUM GET CURRENT LINE # RSS AND DELETE IT DLSTM LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS FIND STATEMENT TO BE DELETED JMP PEXMK DOESN'T JMP PEXMK EXIST CLA ZERO WORD SKIP FOR DESTINATION STB LOLIM INB ADDRESS OF SOURCE WORD SKIP IN B JSB CLPRG CLOSE UP PROGRAM LDA LOLIM,I SET UP STA .LNUM TO INA JSB FNDPS LIST NOP NEXT NOP STB HILIM STATEMENT JMP PLIST SKP ******************** * * * ACCEPT STATEMENT * * * ******************** ACTST LDA SBUFA COMPUTE CMA,INA œþú LENGTH ADA SBPTR OF STATEMENT STA TEMP,I AND RECORD IT LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS SEARCH ON SEQUENCE NUMBER JMP ACCS1 APPEND STATEMENT TO PROGRAM JMP ACCS4 INSERT STATEMENT IN PROGRAM INB REPLACE STATEMENT IN PROGRAM LDA MERGF IS MERGE SSA FLAG SET? JMP PEXMK YES, DON'T OVERLAY OLD STMT LDA 1,I COMPARE LENGTHS OF CMA,INA STATEMENT BEING REPLACED ADA TEMP,I AND STATEMENT SZA,RSS REPLACING IT JMP ACCS2 EQUAL SSA,RSS JMP ACCS4+1 SHORTER LDA TEMP,I LONGER, JSB CLPRG CLOSE UP PROGRAM JMP ACCS2 ACCS1 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? ACCS2 CLB YES, SET COUNTER TO ZERO LDA SBUFA INITIALIZE STA TEMP2 SOURCE ADDRESS ACCS3 LDA TEMP2,I TRANSFER WORD FROM STA TEMP3,I S-BUFFER TO PROGRAM SPACE ISZ TEMP2 INCREMENT SOURCE AND ISZ TEMP3 DESTINATION ADDRESSES INB BUMP COUNTER CPB TEMP,I ENTIRE STATEMENT MOVED? JMP ACCS5 YES JMP ACCS3 NO ACCS4 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? JSB MVTOH MAKE JMP ACCS2 ROOM * ACCS5 LDA .INBF MOVE LDB .OTBF STATEMENT JSB MVW TO DEC 36 OUTPUT NOP BUFFER LDA TEMP8 FOR CHAR CMA EDITTING STA OCCNT JMP PEXMK EXIT THIS PHASE *************************** * * * DELETE SPACE IN PROGRAM * * * *************************** CLPRG NOP REFERENCE LOCATION IN TEMP3 ADA TEMP3 SKIP (A) LOCATIONS FROM TEMP3 STA TEMP4 AND SAVEóÇþú DESTINATION ADDRESS LDB 1,I SKIP TO END OF STATEMENT BEING ADB TEMP3 DELETED, SOURCE ADDRESS IN (B) CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP CLPRG,I ************************************ * * * CHECK FOR PROGRAM SPACE OVERFLOW * * * ************************************ OVCHK NOP NEW WORD REQUIREMENT IN (A) LDB PBPTR SET SOURCE ADDRESS STB TEMP2 FOR PROGRAM RELOCATION ADB 0 SET DESTINATION STB TEMP4 ADDRESS CMB,INB ENOUGH ADB LWBM FREE SSB SPACE? JMP FSCE4 NO, PROGRAM SPACE OVERFLOW LDB TEMP4 YES, RELOCATE FREE STB PBPTR PROGRAM SPACE POINTER JMP OVCHK,I * * * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATION ADDR ISZ MVW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA MERGF IF†’þú FLAG IS SSA,RSS SET THEN CHECK FOR = LINE #'S JMP ERRO1 NOT SET * LDA .LNUM YES, SEARCH JSB FNDPS PROGRAM TO SEE NOP THERE IS ALREADY RSS A STMT WITH THIS LINE NUMBER JMP PEXMK FOUND ONE, IGNORE ERROR THEN * ERRO1 LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE * ERBS DEF ERR-1 *************** * * * ERROR TABLE * * * *************** ERR DEF NUMER ILLEGAL EXPONENT DEF SYNE1 NOT A FORTRAN FUNCTION DEF SYNE2 MISSING ASSIGNMENT OPERATOR DEF SYNE3 NOT A SUBROUTINE CALL DEF SYNE4+1 MISSING OR BAD FUNCTION NAME DEF SYNE5 MISSING OR BAD SIMPLE VARIABLE DEF SYNE6 MISSING OR BAD TRAP NUMBER DEF SYNE7 MISSING OR ILLEGAL 'THEN' DEF SYNE8 MISSING OR ILLEGAL 'OF' DEF SYNE9 MISSING OR ILLEGAL 'TO' DEF SYE10 MISSING OR ILLEGAL 'STEP' DEF CALER MISSING OR ILLEGAL SUBROUTINE DEF SYE11+1 WRONG NUMBER OF PARAMETERS DEF SYE12 MISSING OR ILLEGAL DATA ITEM DEF SYE13 ILLEGAL READ OR INPUT VARIABLE DEF SYE14 NO CLOSING QUOTE DEF SYE15+1 MISSING OR BAD LIST DELIMITER DEF SYE16 ILLEGAL PARAMETER DEF STER1 ILLEGAL STRING VARIABLE DEF STER2 PARAMETER NOT STRING DEF SYE20 MISSING OR ILLEGAL SUBSCRIPT DEF STER3 STRING OR DIM LARGER THAN 255 DEF STER4 ILLEGAL STRING RELATIONAL OPERATOR DEF STER5 STRING NOT PERMMITED DEF FSCE1+1 MISSING LEFT PARENTHESIS DEF FSCE2+1 MISSING RIGHT PARENTHESIS Só DEF ‚„þúFSCE3+1 UNDECIPHERABLE OPERAND DEF ARRE2 MISSING OR BAD ARRAY IDENTIFIER DEF SYE25+1 MISSING OR BAD INTEGER DEF SYE26 SIGN WITHOUT NUMBER DEF NOEOF+1 CHARACTERS AFTER STATEMENT END DEF FSCE4+1 OUT OF CORE DURING SYNTAX DEF MER9 ARRAY TOO LARGE SKP ****************************************** * * * FIND AND STORE ONE-CHARACTER OPERATORS * * * ****************************************** SYMCK NOP CHARACTER IN (A) STB COUNT -(ENTRIES TO BE SEARCHED) ALF,ALF POSITION IOR .32 CHARACTER LDB SYMCK,I STARTING TABLE ENTRY - 2 ISZ SYMCK SET RETURN ADDRESS SYMC1 ADB .2 UPDATE TABLE POINTER CPA 1,I MATCH? JMP SYMC2 ISZ COUNT NO, CONTINUE SEARCH? JMP SYMC1 YES ALF,ALF NO, RESTORE AND B177 CHARACTER JMP SYMCK,I AND EXIT SYMC2 CCA GET ADA 1 INFORMATION LDA 0,I WORD AND OPMSK AND STA SBPTR,I STORE IT CPA B1400 JMP FSC14 ISZ SYMCK RETURN VIA JMP SYMCK,I (P+2) * B177 OCT 177 MSK0 OCT 377 B1400 OCT 14000 SKP **************************** * * * COMPUTE STORAGE OF ARRAY * * * **************************** MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND MSK0 STA COUNT STORE # COLUMNS LDA 1 ALF,ALF AND MSK0 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY COUNT COMPUTE 2*ROWS*COLUMS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN * TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMPô›HFB6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 PCNT EQU TEMPS+11 COUNT EQU TEMPT+1 SFLAG EQU TEMPT+2 CCODE EQU TEMPT+2 ARYAD EQU TEMPT+3 RFLAG EQU TEMPT+4 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU TEMPT+9 PRPTR EQU TEMPT+10 PARAMETER PTR TCCNT EQU TEMPT+11 ORDINAL NUMBER OF SUBROUTINE FROMF EQU TEMPT+12 FROM SUB. PARAMETER FLAG TOFRM EQU TEMPT+13 TO/FROM WORD * END THÿÿ ÿýO+{ ÿ92065-18003 2001 S C0122 &MBC10 BASIC LISTR SUBR (SOUR             H0101 ×þúASMB,R HED <> 92065-16001 NAM BASC2,7 92065-16001 REV.2001 791022 * * DATE 8-29-79 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * * SOURCE: 92065-18003 * * * ************************************************************* * ENT BASC2 EXT EXEC,RDYPT,FNDPS,OUTCR,OUTIN,INTCK,INDCK EXT WRITE,ERRPT,NUMOT,GETCR,FCNS EXT QUOTE,DIM,MESGA,CLFIL EXT IFBRK,FINDV,PRMT COM TEMPS(30),PNTRS(61),SPEC(10) ************************************** * * * SEGMENT #2: LIST THE PROGRAM * * * ************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER THE 'LIST' OR 'SAVE' COMMANDS ARE GIVEN. IT WILL RE- * CONSTRUCT A USER PROGRAM, LINE BY LINE, CONVERTING IT FROM THE * TRANSLITERATED FORM TO ASCII. IT THEN OUTPUTS THIS ASCII TO * THE LIST DEVICE. * * IN ADDITION, THIS SEGMENT IS LOADED WHENEVER AN ERROR OCCURS. IT * WILL PRINT OUT THE APPROPRIATE ERROR MESSAGE AND THEN RETURN * EXECUTION TO THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PŠþúROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE FLAG SAVFL EQU PNTRS+40 .SAVE COMMAND FLAG ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 7 STTYP DEF DIM FOPBS DEF QUOTE-2 LNBFA DEF LNBFF-1 ERBFA DEF ERBUF AFCNS DEF FCNS SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .0 DEC 0 .1 DEC 1 .3 DEC 3 .7 DEC 7 .10 DEC 10 .1Ý*þú5 DEC 15 .32 DEC 32 .34 DEC 34 .40 DEC 40 B23 OCT 23 .45 DEC 45 .73 DEC 73 .G50 OCT 50000 B36 OCT 36 B37 OCT 37 B40 EQU .32 B44 OCT 44 B60 OCT 60 B100 OCT 100 F OCT 106 N OCT 116 B177 OCT 177 B77 OCT 77 B200 OCT 200 B777 OCT 777 MSK0 OCT 377 B1100 OCT 1100 COMWD OCT 34000 REMOP OCT 36000 FOROP OCT 41000 NEXOP OCT 42000 NSBOP OCT 56000 ONOP OCT 73000 OPMSK OCT 77000 TYPFL OCT 100017 OPDMK OCT 100777 M1 DEC -1 M2 DEC -2 M3 DEC -3 M5 DEC -5 M21 DEC -21 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG SPC 3 ERBUF ASC 5, IN LINE LNBFF BSS 2 BLNK DEF *+1 ASC 2, _ : ALEN DEF *+1 OCT 3 ASC 2,LEN FORCT NOP 'FOR'-'NEXT' SPACE COUNTER LNCNT NOP LINE COUNTER CRLF DEF *+1 OCT 6412 SKP ******************** * * * LIST THE PROGRAM * * * ******************** BASC2 NOP CLA INITIALIZE STA LNCNT LINE COUNTER STA FORCT .RESET FOR/NEXT COUNTER LDA FOPBS .SET OPERATOR PRINT ADDRESS JSB INDCK . DIRECT STA FOPBS LDA STTYP .SET SYNTAX TABLE POINTER JSB INDCK . DIRECT STA STTYP LDA LUOUT IS IT ERROR SSA MESSAGE ENTRY? JMP PRMES YES! LDB LOLIM SET PTR STB TEMPS TO PROGRAM START LDB PRINT ASSUME PRINTER LDA PFLAG BUT CHECK FLAG FOR SURE SSA -1 IF PUNCH LDB PUNCH ITS A PUNCH REQUEST CMA,SSA,INA,SZA PFLAG <= 0? RSS .NO SPEC LU # STB LUOUT SAVE OUTPUT DEVICE L.U. SPC 1 * IF LINE PRINTER LIST DEVICE - MOVE FORM TO NEW PAGE * IF PUNCH LIST DEVICE - PUNCH LEADER ON TAPE SPC 1 LDA FLFIL .OUTPUTTING ON FILE ? þú INA,SZA,RSS JMP LIST1 .YES - IGNOR DEVICE CONTROLS LDA FLFIL .CHECK FOR FILE SAVE INA,SZA,RSS .FILE THIS TIME? JMP LIST1 .YES LDA LUOUT JSB FINDV .FETCH DRIVER NUMBER CPA .2 .PUNCH TYPE DEVICE ? JMP LIS40 . YES - OUTPUT LEADER CPA .10 .LINE PRINTER ? JMP LIS41 .YES THROW A PAGE CPA .5 RSS .IT IS A CRT LINE PRINTER ? JMP LIST1 .NO SPECIAL PROCESSING CPB .4 LIS41 JSB HEAVE .YES A LINE PRINTER JMP LIST1 .CONTINUE * LIS40 LDA LUOUT .FORM LEADER PUNCH IOR B1000 . CONTROL WORD STA LIS51 JSB EXEC .PUNCH LEADER DEF *+3 DEF .3 DEF LIS51 SPC 1 * INITIALIZE FOR CONVERTING A STATEMENT SPC 1 LIST1 LDB TEMPS MORE CPB HILIM PROGRAM? JMP LIS13 NO * CCA INITIALIZE ADA .OTBF OUTPUT STA OTBFA BUFFER POINTER CLA INITIALIZE STA OCCNT CHAR COUNT SKP * JSB OUTBL .YES - SET BLANKS AS FIRST CHAR JSB OUTBL . IN LINE ISZ LNCNT UPDATE LINE COUNTER SPC 1 * OUTPUT LINE NUMBER SPC 1 LDA TEMPS,I OUTPUT STA .LNUM JSB OUTIN SEQUENCE NUMBER JSB OUTBL .OUTPUT BLANK LDB FORCT JSB FORSP INDENT 'FOR'-'NEXT' LOOP ISZ TEMPS FETCH LDA TEMPS,I STATEMENT LENGTH CMA,INA SET INA WORD STA LCNTR COUNTER LIST3 ISZ TEMPS MORE ISZ LCNTR STATEMENT? JMP LIST4 YES * * IF NO MORE STATEMENT THEN CHECK FOR AN ODD # OF BYTES. * MAKE EVEN FOR WORD ORIENTATED DEVICES. * LDA OCCNT SLA,RSS .CHECK THE OUTPUT BUFFER FOR ODD JMP LIS30 .EVEN ALREADY - DON'T CHANGE THE BUFFER LDA B40 .ODD - ADD A SPACE JSB OUTCR !þúSPC 1 * CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE SPC 1 LIS30 JSB IFBRK IS DEF *+1 ATTENTION SZA FLAG SET? JMP LIS13 YES, GO TO READY * * LDB .OTBF OUTPUT LDA OCCNT STATEMENT JSB WRITE TO PERIPHERAL JMP LIST1 * SPC 1 * CONVERT THE OPERATOR SPC 1 LIST4 LDA TEMPS,I AND OPMSK SZA,RSS NULL OPERATOR? JMP LIST5 YES * CONT STA TEMP2 SAVE OPERATOR ALF,ALF SINGLE ARS LDB 0 CHARACTER ADA M21 SSA,RSS OPERATOR? JMP LIS12 NO BLS YES INB LOAD ADB FOPBS SYMBOL'S LDA 1,I ASCII WORD ALF,ALF ADJUST AND MSK0 CHARACTER CPA .34 " ? JMP LIS14 YES JSB OUTCR NO SKP * CONVERT THE OPERAND SPC 1 LIST5 LDA TEMPS,I AND OPDMK SAVE STA TEMP3 OPERAND SSA FLAG BIT SET? JMP LIST9 YES SZA,RSS NO, NULL OPERAND? JMP LIST3 YES AND TYPFL ISOLATE TYPE PART CPA .15 FUNCTION? JMP LIST8 YES SPC 1 * OUTPUT LETTER-DIGIT COMBINATIONS SPC 1 LIST6 LDA TEMP3 RRR 4 AND B177 OUTPUT ADA B100 JSB OUTCR LETTER LDA TEMP3 YES AND .15 RESTORE SZA,RSS STRING? JMP LIS16 YES! ADA M5 NO! SSA LETTER-DIGIT? JMP LIST3 NO! ADA B60 DIGIT LIS17 JSB OUTCR OUTPUT DIGIT JMP LIST3 SPC 1 LIS16 LDA B44 '$' JMP LIS17 SPC 1 LIST8 LDA F OUTPUT JSB OUTCR LDA N 'FN' JSB OUTCR LDA TEMP3 OUTPUT RRR 4 AND B177 LETTER ADA B100 JSB OUTCR JMP LIST3 Üþú SPC 1 * OUTPUT FLOATING-POINT CONSTANTS SPC 1 LIST9 XOR FLGBT SZA NUMBER? JMP LIS10 NO ISZ TEMPS YES LDA TEMPS,I ISZ TEMPS LDB TEMPS,I ISZ LCNTR ISZ LCNTR CCE OUTPUT JSB NUMOT THE NUMBER JMP LIST3 SPC 1 * OUTPUT FUNCTION NAMES SPC 1 LIS10 AND .15 CPA .3 INTEGER? JMP LIS11 YES CPA .15 NO, FUNCTION? RSS YES JMP LIST6 NO, MUST BE A PARAMETER LDA TEMP3 COMPUTE RRR 4 AND B37 COMPUTE INTERNAL FUNCTION NO. CPA B37 IS IT LEN FUNCTION? JMP LENF YES CPA B36 FORTRAN FUNCTION? JMP FRFCT YES! STA TEMP2 CODE CMA STA TEMP5 NO. OF MNEMONICS TO SKIP LDA AFCNS GET ADDR. OF FUNCTION MNEM. JSB INDCK MAKE DIRECT STA 1 ADDR OF MNEMONIC ENTRIES IN BREG NXFCN ISZ TEMP5 IS THIS IT? RSS NO! JMP LFCN YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXFCN CHECK NEXT ENTRY LFCN JSB MCOPY OUTPUT FUNCTION NAME JMP LIST3 * LEN FUNCTION FOUND LENF LDB ALEN ADDRESS OF PRINT JMP LFCN BUFFER FOR LEN FRFCT ISZ TEMPS ISZ LCNTR JMP MCAL1 PRINT FORTRAN FUNCT MNEM SPC 1 * OUTPUT INTEGER CONSTANTS SPC 1 LIS11 ISZ TEMPS OUTPUT ISZ LCNTR LDA TEMPS,I INTEGER SSA MINUS SIGN REQUIRED? JMP LIS19 YES! LIS18 JSB OUTIN JMP LIST3 OPERAND * LIS19 LDA .45 OUTPUT JSB OUTCR MINUS SIGN LDA TEMPS,I COMPLEMENT CMA,INA TO OBTAIN JMP LIS18 ABSOLUTE VALUE SPC 1 * O&lþúUTPUT OPERATOR SPC 1 LIS12 JSB OUTBL .OUTPUT BLANK * LDA TEMP2 IS THIS CPA FOROP A 'FOR' STATEMENT? JMP LIS21 YES, INDENT 'FOR' STATEMENT LIS22 LDA TEMP2 CPA NEXOP IS THIS A 'NEXT' STMT? RSS YES! JMP *+4 NO! LDB FORCT DECREMENT ADB M1 FOR STB FORCT COUNT CPA .G50 CALL? JMP MCALL YES. PRINT CALL STATEMENT JSB MCOUT OUTPUT LDA TEMP2 OPERATOR CPA REMOP IS IT A REMARK STATEMENT? JMP LIS15 YES LDA TEMP2 COM STMT? CPA COMWD RSS YES! JMP *+5 NO! ISZ TEMPS YES, SKIP ISZ TEMPS OVER COMMON SIZE ISZ LCNTR AND DECREMENT ISZ LCNTR LENGTH COUNTER LDA BLANK OUTPUT A BLANK JMP LIST5-1 AND LOOK FOR OPERANDS. * LIS15 JSB OUTST OUTPUT STRING JMP LIST3 SPC 1 LIS21 ISZ FORCT INCREMENT COUNT LDB .1 AND INDENT JSB FORSP 'FOR' STATEMENT JMP LIS22 ONE MORE TIME SPC 1 * IF PUNCH LIST DEVICE - PUNCH TRAILER ON TAPE SPC 1 LIS13 LDA FLFIL .CHECK FOR FILE INPUT INA,SZA,RSS JMP CLOSE .YES CLOSE IT LDA LUOUT JSB FINDV .FETCH DRIVER NUMBER CPA .5 .2640.44.45 RSS .YES JMP LIS49 . NO TRY SOMETING ELSE CPB .1 .IS IT A MINITAPE? JMP EOF .YES LEFT ONE CPB .2 JMP EOF .YES - RIGHT ONE CPB .4 .CRT PRINTER ? JMP LIS50 .YES - THROW A PAGE LIS49 CPA .10 .A LINE PRINTER ? JMP LIS50 .YES THROW A PAGE CPA .2 .IS IT THE PUNCH ? JMP EOF .PUNCH LEADER CPA B23 .CHECK FOR 9 TR MT JMP LIS48 .IF IT IS FORM A EOF WRITE REQUEST * ENLST JMP RDYPT .FINISHED - GO TO OPERATOR * LIS50 JSB HEAV þúE JMP ENLST * LIS48 LDA B100 .FETCH 9 TR MT FUNCTION BITS RSS .AND JMP OVER CT AND PT FUNCTION BITS EOF LDA B1000 IOR LUOUT .FORM EOF REQUEST STA LIS51 JSB EXEC .PUNCH LEADER -OR- DEF *+3 . WRITE 2644/45 EOF DEF .3 DEF LIS51 JMP ENLST * CLOSE JSB CLFIL .CLOSE OUTPUT FILE JMP ENLST * B1000 OCT 1000 .5 DEC 5 .2 DEC 2 .4 DEC 4 LIS51 NOP ******************************* * * * INDENT 'FOR'-'NEXT' LOOPS * * * ******************************* * FORSP NOP SZB,RSS NEED ANY SPACES? JMP FORSP,I NO! SSB TOO MANY 'NEXT'S' ? JMP FORSP,I YES! CMB,INB SET STB TEMP3 COUNTER LDA M1 . SAVE OR PUNCH CPA SAVFL JMP FORSP,I .YES - A SAVE CPA PFLAG JMP FORSP,I YES, DON'T INDENT FORS0 LDA B40 OUTPUT JSB OUTCR SPACE LDA B40 OUTPUT ANOTHER JSB OUTCR SPACE ISZ TEMP3 DONE? JMP FORS0 NO! JMP FORSP,I YES! * SKP * OUTPUT QUOTE STRING SPC 1 LIS14 LDB TEMPS,I OUTPUT QUOTE STRING BLF,BLF TEST BIT 8 SLB SUPPRESS QUOTES? JMP LIS13 YES! JSB OUTCR OUTPUT " JSB OUTST OUTPUT QUOTE STRING LDA .34 OUTPUT " JMP LIS17 * ********************* * * * OUTPUT FORMFEED * * * ********************* * HEAVE NOP AND B177 MAKE SURE V-BIT IS 0 IOR B1100 FORM TAB COMMAND STA LENTH JSB EXEC DO IT TO IT DEF *+4 DEF .3 DEF LENTH DEF M3 JMP HEAVE,I * * ************************************** * * * OUTPUT BLANKS IF LISTING * * *)¢þú ************************************** * OUTBL NOP LDA SAVFL .TEST FOR PUNCH OR SAVE CPA M1 JMP OUTBL,I .YES - NO BLANKS LDA .32 .NO - INSERT BLANKS JSB OUTCR JMP OUTBL,I SKP ******************* * * * OUTPUT A STRING * * * ******************* OUTST NOP LDA TEMPS,I AND B177 GET STRING COUNT CMA,INA,SZA,RSS NULL STRING? JMP OUTST,I YES! STA TEMP6 NO, SAVE NEG OF COUNT OUTS1 ISZ TEMPS MOVE TO NEXT PAIR OF CHARS ISZ LCNTR BUMP COUNTER LDA TEMPS,I GET THEM ALF,ALF POSITION TO OUTPUT LEFT CHARACTER JSB OUTS2 OUTPUT CHAR LDA TEMPS,I GET CHAR PAIR AGAIN JSB OUTS2 OUTPUT RIGHT HAND CHAR JMP OUTS1 SPC 1 OUTS2 NOP AND B177 JSB OUTCR ISOLATE AND OUTPUT CHAR ISZ TEMP6 WAS IT LAST CHAR JMP OUTS2,I NO! JMP OUTST,I YES! * ********************************** * * * OUTPUT A MULTICHARACTER SYMBOL * * * ********************************** MCOUT NOP LDB STTYP ADDRESS OF STATEMENT OPERATORS MCOU1 LDA 1,I LOAD INFORMATION WORD AND OPMSK COMPARE WITH CPA TEMP2 OPERATOR CODE JMP MCOU2 EQUAL LDA 1,I UNEQUAL, AND .7 COMPUTE ADA .3 ENTRY ARS LENGTH ADB 0 COMPUTE ADDRESS OF NEXT ENTRY JMP MCOU1 MCOU2 JSB MCOPY GO OUTPUT SYMBOL JMP MCOUT,I * MCOPY NOP LDA 1,I COMPUTE AND .7 ENTRY CMA,INA LENGTH STA DIGCT AND SAVE IT CLE,INB SET FOR FIRST CHARACTER STB TEMP3 SAVE SYMBOL ADDRESS MCOU3 LDA TEMP3,I LOAD WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 EXTRACT CHrþúARACTER JSB OUTCR OUTPUT IT SEZ,CME SET FOR NEXT CHARACTER ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL ISZ DIGCT MORE CHARACTERS? JMP MCOU3 YES JMP MCOPY,I ******************************* * * * LIST A CALL STATEMENT * * * ******************************* * MCALL JSB MCOUT OUTPUT 'CALL" JSB OUTBL .OUTPUT SPACE MCAL1 LDA TEMPS STA TEMP7 CLEAR FORT FCT FLAG LDA 0,I GET OPERATOR WORD AND B777 GET MNEMONIC TBL OFFSET CMA USE OFFSET TO FIND MNEMONIC STA TEMP5 NO. OF MNEMONICS TO SKIP LDB FWAMM GET ADDR. OF SUB. MNEMONICS INB NXSUB ISZ TEMP5 IS THIS IT? RSS NO! JMP LCALL YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXSUB CHECK NEXT ENTRY LCALL JSB MCOPY LIST THE CALL MNEMONIC LDA TEMP4 GET LAST CHAR (SEE OUTCR) CPA .40 LAST CHAR "("? JMP MCAL2 YES, SUPPRESS SPACE JSB OUTBL .OUTPUT A BLANK MCAL2 ISZ TEMPS POINT AT FIRST PARAM ISZ LCNTR UPDATE INTERMEDIATE CODE COUNTER JMP LIST5 SKP * * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATION ADDR ISZ MV†5þúW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I *********************** * * * PRINT ERROR MESSAGE * * * *********************** * * PRMES LDA ERTTY RESET OUTPUT STA LUOUT L.U. # TO ERROR DEVICE * LDA FLFIL .OUTPUTTING ON FILES ? INA,SZA,RSS JSB CLFIL .YES - CLOSE FILE SO THAT ERROR PRINTS LDA TEMP3 .FETCH ERROR # * CMA,INA MAKE NEGATIVE AND STA LCNTR SAVE FOR COUNTER LDB MESGA SET TABLE PNTR TO START PRMS1 LDA 1,I GET LENGTH OF MESSAGE INB MOVE PNTR TO MESSAGE ISZ LCNTR INDEX ERROR CNTR, IS IT = 0? RSS NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG JMP PRMS1 GO INDEX ERROR COUNTER * * DISK FILE ERRORS ARE NEGATIVE AND COME HERE * * * PRMS2 JSB WRITE PRINT FIRST PART OF MESSAGE LDA .10 INITIALIZE STA OCCNT OUTPUT LDA LNBFA BUFFER STA OTBFA LDA .LNUM OUTPUT SZA,RSS COMMAND ERROR? JMP ERRP2 YES, DON'T PRINT OUT LINE# JSB OUTIN NO! LDA OCCNT LINE LDB ERBFA JSB WRITE NUMBER * LDA TEMP8 IS CHAR SSA,RSS COUNT CMA,INA WITHIN ADA .73 A REASONABLE SSA RANGE? JMP ERRP1 NO, GO TO MAIN! LDA .INBF YES, MOVE LDB .OTBF BAD STMT JSB MVW FROM INPUT DEC 36 BUFFER TO NOP OUTPUT BUFFER LDA TEMP8 MAKE CMA STATEMENT STA OCCNT LENGTH POSITIVE LDA PFLAG KEYBOARD SZA,RSS INPUT? JMP ERRP\ HFB1 YES, EXIT LDA .OTBF,I ARE FIRST TWO CPA BLNK,I CHARACTERS BLNKS? JMP PRMS3 YES, DON'T INSERT BLANKS LDA .3 OUTPUT LDB BLNK TWO JSB WRITE BLANKS PRMS3 LDA OCCNT REPRINT LDB .OTBF THE JSB WRITE STATEMENT * ERRP1 JMP PRMT YES, RETURN TO IT THEN * ERRP2 LDA M2 PRINT LDB CRLF CARRIAGE RETURN/LINE FEED JSB WRITE JMP ERRP1 * TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 LENTH EQU TEMPT+1 TBUFA EQU TEMPT+2 TCNTR EQU TEMPT+3 LCNTR EQU TEMPT+4 DIGCT EQU TEMPT+5 FERR EQU TEMPT+6 END DHÿÿ ÿýPa ÿ92065-18004 2001 S C0122 &MBC30 BASIC PRE EXECUTE SUBR             H0101 ÒþúASMB,R HED <> 92065-16001 NAM BASC3,7 92065-16001 REV.2001 791022 * * * DATE 2-09-77 * * SOURCE: 92065-18004 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. 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. * ************************************************************** ENT BASC3 ENT GETNM,CHRCK EXT LIMEM,MNTBL,BRTBL,INDCK EXT EXEC,OUTER,SSYMT,TRAP,BCKSP,GETCR,DIGCK EXT RDYPT,BASC4 COM TEMPS(30),PNTRS(61),SPEC(10) ********************************************** * * * SEGMENT #3: PRE-EXECUTION PROCESSING * * * ********************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * ONCE TO PERFORM BASIC SYTEM INITIALIZATION AND ALSO * WHENEVER THE 'RUN' COMMAND IS GIVEN. IT WILL CONSTRUCT THE * SYMBOL TABLE, CHECK FOR-NEXT LOOPS AND DETERMINE ARRAY STORAGE * ALLOCATIONS FOR THE USER PROGRAM. UPON COMPLETION, IT RETURNS * TO THE MAIN CONTROL PROGRAM WHICH THENS LOADS THE EXECUTION * SEGMENT AND BRANCHES TO IT. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUÃÅþúT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVE-RESTORE FLAG FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 15 TEMPORARIES * ERBS DEF ERR-1 MBUF DEF TEMPS MNADD DEF MNTBL BTADD DEF BRTBL * SUP PRESS MULTIPLE LISTINGS SPC 1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .27 DEC 27 .28 DEC 28 .30 DEC 30 .32 DEC 32 .33 DEC 33 .34 DEC 34 .37 DEC 37 .63 DEC 63 .9999 ½÷þúDEC 9999 CALOP OCT 50000 DATOP OCT 51000 B400 OCT 400 B757 OCT 757 B1000 OCT 1000 B777 OCT 777 D72 OCT -72 HIMSK OCT 177400 SLASH OCT 57 STDIM OCT 5001 STANDARD DIMENSIONS FOR ARRAYS STRDM OCT 400 STANDARD DIMENSIONS FOR STRINGS COMOP OCT 34000 COMMON OPERATOR FILOP OCT 63000 OPMSK OCT 77000 DEFOP OCT 35000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M16 DEC -16 M40 DEC -40 M99 DEC -99 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER * SKP **************************** * * * PRE-EXECUTION PROCESSING * * * **************************** TEMPX NOP BASC3 NOP * ***************************************************** * * ** BASIC SYSTEM INITIALIZATION - ONCE ONLY CODE ** * * ***************************************************** * LDA PFLAG IS THIS AN CPA .9999 AN INITIALIZATION? RSS YES! JMP PREEX NO, DO PRE-EXECUTION * SPC 1 * DEFINE COMPILER BUFFERS AND USER AREA SPC 1 JSB LIMEM .FETCH MEMORY LIMITS DEF *+4 DEF .1 DEF FWAM .SET FIRST WORD AVAIL MEMORY DEF TEMPX .USE LAST WORD AVAIL TEMP FOR #WORDS LDB TEMPX .CALCULATE ADDRESS OF LAST WORD ADB FWAM ADB M40 ADB M2 .OFFSET BY TWO FOR LINE CHECK > 80 CHAR STB .INBF SET INPUT BUFFER ADDRESS ADB M40 SET OUTPUT STB .OTBF BUFFER ADDRESS ADB M1 SET SYMBOL TABLE STB SYMTA ADDRESS ADB M99 SET SYNTAX STB SBUFA BUFFER ADDRESS ADB M1 SET LAST WORD STB LWBM BASIC AVAILABLE MEMORY CLB INITIALIZE STB TYPE STB SLSTM STB FLFIL * LDA MNADD JSB INDCK .SmùþúET FIRST WORD OF MNEMONIC TABLE STA FWAMM * LDA BTADD JSB INDCK .SET FIRST WORD OF BRANCH TABLE INA STA FWAMB * * * LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER TO STA .LNUM ZERO INITIALLY CCA INITIALIZE STA FLTYP TYPE 0 FILE LDA SLASH INITIALIZE CHAR STA DLMTR EDIT DELIMTER SPC 1 * SET LOGICAL UNIT NUMBERS SPC 1 CLA,INA SET UP STA REC# RECORD NUMBER LDA TTYPR SZA,RSS L.U. # ENTERED? CLA,INA NO, SET TO #1 IOR B400 SET ECHO BIT STA TTYPR STA ERTTY .SET ERROR TO TTY LU LDA PRINT LIST OUTPUT SZA,RSS L.U. # ENTERED? LDA TTYPR NO, SET TO CONSOLE L.U.# STA PRINT LDA READR AUXILLARY INPUT SZA,RSS L.U. # ENTERED? LDA .5 NO, SET TO #5 IOR B400 YES, ADD CONTROL BIT STA READR LDA PUNCH AUXILLARY OUTPUT SZA,RSS L.U. # ENTERED? LDA .4 NO, SET TO #4 STA PUNCH JMP RDYPT START UP BASIC SPC 1 * SKP * * PREEX EQU * PRE-EXECUTION PROCESSING FOR SPEC SYNTAX BAS3 LDA PBUFF NULL CPA PBPTR PROGRAM? JMP RDYPT YES STA MPTR INITIALIZE PROÿÿGRAM POINTER LDA M16 ADA M1 STA TEMP4 CLA INITIALIZE COMMON STA COML SIZE TO ZERO * LDB PBUFF START OF PROGRAM MLO10 CPB PBPTR ALL COMMON JMP MLO14 STMTS CHECKED? ADB .2 NO LDA 1,I GET NEXT STMT TYPE INB AND OPMSK CPA COMOP COMMON STMT? RSS YES! JMP MLO11 NO! LDA 1,I Ê6þú FETCH COMMON SIZE ADA COML AND UPDATE STA COML COMMON COUNTER MLO11 ADB M2 STATEMENT SIZE ADB 1,I CALCULATE ADDRESS ADB M1 OF NEXT STATEMENT JMP MLO10 SPC 1 MLO14 LDB PBUFF GET START OF PROG CPB PBPTR END OF PROG? JMP MLO15 YES ADB .2 NO, GET LDA 1,I THE STATEMENT AND OPMSK OP CODE ADB M1 SET ADB 1,I (B) TO ADB M1 NEXT STATEMENT JMP MLO14+1 SPC 1 MLO15 STB FCORE SET FOR-TABLE POINTER LDA COML ANY COMMON INA JSB CKOVF IS BLOCK TOO BIG? CMA,INA ALLOCATE COMMON ADA LWBM STA SYMTA SYM TBL END = COM START -1 STA SYMTF SYM TBL START(EMPTY) INA STA COML START OF COMMON SPC 1 MLOP1 LDB MPTR,I STB .LNUM SET LINE NUMBER LDB MPTR ISZ MPTR ADB MPTR,I COMPUTE LOCATION OF NEXT STB MNPTR STATEMENT AND STORE THIS ISZ MPTR LDA MPTR,I FETCH THE FIRST WORD IN THE ARS STATEMENT AND SAVE ALF,ALF THE STATEMENT TYPE AND .63 STA TYP CPA .30 NO, REM STATEMENT? STB MPTR YES, SET TO SKIP IT CPA .28 COMMON? ISZ MPTR YES, SKIP CPA .28 OVER ISZ MPTR SIZE CPA .43 NO, PRINT STATEMENT? STB MPTR YES, SET TO SKIP IT CCA NO, SET STA MWDNO 'FIRST VARIABLE' JMP MLOP2+1 FLAG * MLO13 AND B777 YES, ISOLATE OPERAND LDB MPTR CPA B757 IS THIS A USER DEFINED FUNCTION? JMP *+4 YES, SO INCREMENT PAST CALL#-PARAMETER COUNT * INDEX THE PROGRAM POINTER BY SZA,RSS AN AMOUNT APPROPRIATE TO THE ADB .2 OPERAND. THE FOLLOWING APPLIES CPA .3 OPERAND = 0 ADD 2 TO P]þúOINTER INB OPERAND =3 ADD 1 TO POINTER STB MPTR * SKP * PROCESS OPERAND SPC 1 MLOP2 ISZ MPTR INCREMENT WORD-OF-STATEMENT PTR LDA MPTR STATEMENT CPA MNPTR EXHAUSTED? JMP MLOP5 YES LDA MPTR,I NO AND OPMSK 'QUOTE' CPA B1000 OPERATOR? JMP MLP4A YES, SET TO SKIP CPA CALOP CALL OPERATOR? JMP MLOP2 YES! SKIP LDA MPTR,I NO SSA 'CONSTANT' OPERAND? JMP MLO13 YES AND B777 NO SZA,RSS NULL OPERAND? JMP MLOP2 YES STA MBOX1 NO, SAVE IT AND .15 PROGRAMMER-DEFINED CPA .15 FUNCTION? JMP MLOP6 YES ADA M4 NO SSA ARRAY VARIABLE? JMP MLOP7 YES SPC 1 * PROCESS SIMPLE VARIABLE SPC 1 LDA MBOX1 NO, SIMPLE VARIABLE JSB SSYMT ALREADY IN SSB,RSS SYMBOL TABLE? JMP MLOP3 YES LDA MNEG NO LDB MNEG+1 ENTER STA MBOX1+1 IT WITH STB MBOX1+2 'UNDEFINED' LDA M3 VALUE JSB ESYMT MLOP3 LDB TYP LDA MBOX1 CPB .34 NEXT STATEMENT? JMP MLOP4 YES SPC 1 * PROCESS 'FOR' STATEMENT SPC 1 CPB .33 NO, FOR STATEMENT? ISZ MWDNO YES, FIRST VARIABLE? JMP MLOP2 NO ISZ FCORE DEMAND LDB FCORE SPACE CPB SYMTF FOR NEW JMP MER8-1 ENTRY STA FCORE,I SAVE VARIABLE NAME JMP MLOP2 SPC 1 * PROCESS 'NEXT' STATEMENT SPC 1 MLOP4 LDB FCORE FOR-TABLE CPB PBPTR EMPTY? JSB ERROR YES MER3 CPA FCORE,I NO, MATCH LATEST ENTRY? RSS YES JMP MER3-1 NO ADB M1 REMOVE STB FCORE MATCHED JMP MLOP2 ENTRY SPC 1 SPC 1 * PºRþúROCESS 'END' STATEMENT SPC 1 MLP4A XOR MPTR,I SET POINTER TO ADA .3 CLOSING ARS QUOTES ADA MPTR STA MPTR JMP MLOP2+1 SPC 1 MLOP5 CPA PBPTR PROGRAM EXHAUSTED? RSS YES JMP MLOP1 NO LDA TYP YES CPA .37 END STATEMENT? JMP M1LOP YES JSB ERROR NO SPC 1 * PROCESS 'DEF' STATEMENT SPC 1 MLOP6 LDA MPTR,I ISOLATE AND OPMSK PRECEDING OPERATOR CPA DEFOP 'DEF' ? RSS YES JMP MLOP2 NO GO TO PROCESS NEXT WORD LDA MBOX1 SEARCH SYMBOL TABLE FOR JSB SSYMT THE FUNCTION SSB,RSS JSB ERROR FOUND. ERROR MULTIPLY DEFINED MER4 LDA MPTR ADA .3 ENTER THE FUNCTION INTO THE STA MBOX1+1 SYMBOL TABLE TOGETHER WITH LDA M2 ITS ENTRY POINT IN THE SOURCE JSB ESYMT CODE JMP MLOP2 GO TO PROCESS THE NEXT WORD SPC 1 * PROCESS ARRAY VARIABLE SPC 1 MLOP7 CPA M4 IF STRING VARIABLE INA FORCE TO SINGLE DIMENSION STA 1 (B)=ARRAY TYPE LDA TYP CPA .27 DIM STATEMENT? JMP MLOP8 YES CPA .28 NO, COM STATEMENT? JMP MLOP8 YES JSB MSYMT NO, LOOK FOR IT IN SYMBOL TABLE JMP MLOP2 FOUND CLA NOT THERE STA MBOX1+1 ENTER IT WITH STA MBOX1+2 DIMENSIONS AND STA MBOX1+3 DIMENSIONALITY JMP MLOP0 UNDEFINED SPC 1 * PROCESS 'COM' AND 'DIM' STATEMENT SPC 1 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT ISZ MPTR LDA MPTR,I PICK UP FIRST DIMENSION ALF,ALF SHIFT TO M. S. PART OF WORD CPB M3 IS THIS A SINGLE DIMENSION ARRAY JMP *+5 YES, JUMP ISZ MPTR NO, INDEX POINTER TO THE LOC. ISZ MPTR OF SECOND DIMENSION AND PACK IOR MPTR,I INTO A EþþúWITH THE FIRST DIMENSION RSS IOR .1 STA MBOX1+2 SET UP TO STORE PACKED STA MBOX1+3 DIMENSIONS IN FORMAL AND ACTUAL CLA SLOTS AND UNDEFINED FLAG IN STA MBOX1+1 STORAGE ALLOCATION SLOT SPC 1 JSB MSYMT IN SYMBOL TABLE? JMP MLOP9 NO LDA TYP YES CPA .28 RSS IS STMT A COM JMP MLOP0 NO, JUMP LDA MBOX1+2 YES PICK UP PACKED DIMENSIONS JSB MDIM COMPUTE STORAGE REQUIRED SWP LDA MBOX1 IS IT A AND .15 STRING SZA,RSS VARIABLE? JMP STRM1 YES! LDA COML POINTER TO NEXT FREE LOC IN COM STRM2 STA MBOX1+1 STORE IN STORAGE ALLOCATION SLOT ADA 1 UPDATE POINTER BY THE AMOUNT OF STA COML STORAGE ASSIGNED. MLOP0 LDA M4 ENTER THE FOUR WORD ENTRY JSB ESYMT PREVIOUSLY SET UP IN MBOX1 INTO JMP MLOP2 SYMBOL TABLE AND CONTINUE SKP * STRM1 BRS SET UP INB POINTER BRS FOR STRINGS LDA COML,I SET UP AND B377 STA COML,I STRING HEADER LDA MBOX1+2 AND M256 IOR COML,I STA COML,I LDA COML INCREMENT INA TO FIRST WORD OF STRING DATA JMP STRM2 MLOP9 ADB .2 CHECK THE FORMAL DIMENSIONS LDA 1,I LOCATION TO SEE IF THE DIMENSION SZA IS ALREADY DEFINED JSB ERROR ERROR, DOUBLY DIMENSIONED MER5 LDA TYP CPA .28 COM STMT? JSB ERROR ERROR MISPLACED COM STMT MER5A LDA MBOX1+2 STA 1,I STORE THESE DIMENSIONS IN FORMAL INB AND ACTUAL SLOTS IN SYMBOL TABLE STA 1,I ENTRY JMP MLOP2 GO TO PROCESS NEXT WORD SPC 1 * CHECK FOR UNMATCHED 'FOR' STATEMENTS SPC 1 M1LOP LDA FCORE ALL FORS CPA PBPTR MATCHED? RSS YES JSB ERROR NO MER6 LDB SYMTþúF SPC 1 * CHECK ARRAY VARIABLE DIMENSIONS SPC 1 M2LOP CPB SYMTA MORE SYMBOLS? RSS NO, EXECUTE PROGRAM! JMP M7LOP YES LDA FCORE LDB FCORE ADA .20 ALLOCATE LIST SPACE STA FCORE CLA MCLOP STA 1,I AND CLEAR ALL SLOTS INB CPB FCORE RSS JMP MCLOP LDA .1 SET UP TRAP JSB TRAP TABLE (B)=-1 IF TABLE IS IN USE NOP JSB BASC4 GOTO SEGMENT #4 * M7LOP LDA 1,I YES AND .15 ACCOUNT FOR ADB .2 A FUNCTION CPA .15 IS IT? JMP M2LOP YES INB SZA,RSS STRING SYMBOL? JMP M5LOP YES! ADA M4 SIMPLE VARIABLE SSA,INA,RSS IS IT? JMP M2LOP YES SZA,RSS NO, # OF SUBSCRIPTS KNOWN? JSB ERROR NO * SKP MER10 INA SAVE STA MBOX1+1 FLAG STB MBOX1 SAVE POINTER LDA 1,I DEFINED SZA ARRAY? JMP M3LOP YES LDA STDIM NO, LOAD ISZ MBOX1+1 APPROPRIATE ADA .9 STANDARD DIMENSIONS STA 1,I RECORD AS ADB M1 FORMAL AND ACTUAL STA 1,I DIMENSIONS SPC 1 * ALLOCATE ARRAY STORAGE SPC 1 M3LOP JSB MDIM SAVE STORAGE STA MBOX1+1 REQUIREMENT LDB MBOX1 LOAD ADB M2 ADDRESS OF LDA 1,I ELEMENT SPACE SZA DEFINED IN COM? JMP M4LOP YES LDA FCORE NO, USE CURRENT STA 1,I FREE-CORE ADDRESS ADA MBOX1+1 UPDATE FREE-CORE STA FCORE ADDRESS CMA,INA OUT ADA SYMTF OF SSA SPACE? JSB ERROR YES MER7 LDB MBOX1+1 DIMENSIONS TO CMB,INB 'UNDEFINED' ADB FCORE M6LOP LDA MNEG STA 1,I INB LDA MNEG+1 STA òêþú1,I INB CPB FCORE DONE? RSS JMP M6LOP NO! M4LOP LDB MBOX1 ADVANCE POINTER INB TO NEXT SYMBOL JMP M2LOP SPC 1 * SET UP STRING SYMBOLS SPC 1 M5LOP LDA 1,I DEFINED? AND M256 SZA,RSS DEFINED? LDA STRDM NO, LOAD STANDARD DIMENSIONS STA 1,I ADB M1 STA 1,I STA MBOX1 SAVE DIMENSION ADB M1 LDA 1,I DEFINED IN COMMON? SZA JMP M8LOP YES! LDA FCORE NO, SET UP STA 1,I ADDRESS OF STRING IN SYMBOL TBL LDA MBOX1 SET UP DIMENSIONS STA FCORE,I IN STRING HEADER ISZ 1,I BUMP ADDRESS TO ACTUAL STRING DATA ALF,ALF COMPUTE INA THE NUMBER ARS OF WORDS IN INA STRING ADA FCORE STA FCORE CMA,INA ADA SYMTF MORE CORE? SSA JMP MER7-1 NO! M8LOP ADB .3 JMP M2LOP CHECK NEXT SYMBOL SKP * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * THE A REG=NEXT CHAR * CALLING SEQUENCE * JSB GETNM * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER * GETNM NOP JSB GETCR GET NEXT CHAR LDA .10 CPA .10 EOF? JMP GETNM,I YES, RETURN CLB,CLE CLEAR E AND B REG STB TEMP1 CLEAR OUT SUM WORD STB TEMP2 CLEAR OUT DIGIT RECIEVED WORD CPA .43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA .45 IS IT A "-" CCB,CCE SET B=-1, SET E =READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ,RSS READ ANOTHER CHAR? JMP *+3 NO! GTNMA JSB GETCR YES LDA .10 EOF! JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA TEMP1 GET PARTICAL SUM IN TzþúA REG STB TEMP1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY .10 MULTIPLY PARTICAL SUM BY 10 ADA TEMP1 AND IN NEXT DIGIT STA TEMP1 SAVE NEW SUM ISZ TEMP2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB TEMP2 DID WE GET ANY DIGITS? SZB,RSS JMP GETNM,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB TEMP1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ GETNM GET DIGIT RETURN JMP GETNM,I RETURN * .10 DEC 10 .15 DEC 15 .20 DEC 20 .45 DEC 45 .43 DEC 43 .9 DEC 9 B377 OCT 377 B54 OCT 54 B72 OCT 72 M256 DEC -256 SPC 2 SKP * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * IS EITHER AN END OF LINE ".10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN * NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA .10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA B72 IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN SKP * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS BYTE * B REG CONTAINS BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA TEMP7 SAVE IN TEMP LOCATION CLE,ERB CHANGE FROM BYTE TO WORD ADD LDA 1,I GET WORD SEZ,RSS RIGHT OR LEFT HALF ALF,ALF LEFT AND HIMSK MASK ALL BUT UPPER 8 BITS IOR TEMP7 OR IN NEW BYTE SEZ,RSS LEFT OR RIGHT ALF,ALF LEFT STA 1,I STORE WORD BACK ELB,CLE GET BYTE ADDRESS AGAIN Û þú JMP SBYTE,I RETURN SPC 2 ************************* * * * ENTER SYMBOL IN TABLE * * * ************************* ESYMT NOP STA MBIN1 SAVE NEGATIVE OF LENGTH OF ENTRY ADA SYMTF STA SYMTF MOVE SYMBOL TABLE START LOCATOR STA MBIN2 UP BY THE LENGTH OF ENTRY CMA,INA CHECK THAT THE SYMBOL TABLE AND ADA FCORE FOR TABLE DO NOT OVERLAP SSA,RSS JSB ERROR OVERLAP ERROR MER8 LDB MBUF POINTER TO REQD ENTRY LDA 1,I TRANSFER ENTRY TO THE SYMBOL STA MBIN2,I TABLE INB ISZ MBIN2 ISZ MBIN1 JMP MER8+1 JMP ESYMT,I RETURN ********************************* * * * SEARCH SYMBOL TABLE FOR ARRAY * * * ********************************* MSYMT NOP B GIVES ARRAY TYPE -3 = 1 DIM, STB MBIN1 -2 = 2DIM, -1 = UNDIMENSIONED LDA MBOX1 LOAD IDENTIFIER JSB SSYMT SEARCH SYMBOL TABLE SSB,RSS JMP MSYMT,I FOUND, RETURN ISZ MBIN1 IF ARRAY UNDIMENSIONED RSS JMP MSYM JUMP TO NOT FOUND EXIT ISZ MBIN1 SET UP TO CHECK THAT ARRAY DOES AND .15 SZA,RSS STRING? JMP MSYM YES, DONT CHECK FURTHER LDA MBOX1 ADA .2 NOT APPEAR IN THE TABLE WITH ADA M1 DIFFERENT DIMENSIONS. CHANGE JSB SSYMT TYPE 2 TO 1 & TYPE 1 TO 2 AND SSB,RSS SEARCH AGAIN JSB ERROR FOUND, INCONSISTENT DIMENSIONS MSYM ISZ MSYMT NOT FOUND, INCREMENT RETURN JMP MSYMT,I ADDRESS AND RETURN * ************************************* * * * COMPUTE STORAGE REQUIRED BY ARRAY * * * ************************************* MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND B377 STA TEMP8 STORE # OF COLмþúUMNS LDA 1 ALF,ALF AND B377 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY TEMP8 COMPUTE 2*ROWS:COLUMNS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN SKP ****************************** * * CHECK FOR COMMON BLOCK OVERFLOW * ****************************** * CKOVF NOP STA TEMP5 .SAVE BLOCK SIZE ADA PBPTR .WILL WE ADA .256 . DESTROY CMA,INA . THE PROGRAM ADA LWBM . IF WE CONTINUE SSA . JMP MER7-1 .YES ERROR LDA TEMP5 JMP CKOVF,I .NO - EXIT * .256 DEC 256 SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .34 ADJUST FOR SEG 1 ERRORS STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE *************** * * * ERROR TABLE * * * *************** ERR DEF MER5A COM STATEMENT OUT OF ORDER DEF MER4 FUNCTION DEFINED TWICE DEF MER6 UNMATCHED FOR DEF MER3 NEXT WITHOUT MATCHING FOR DEF MSYM DIMENSIONS NOT COMPATIBLE DEF MLOP6 LAST STATEMENT NOT 'END' DEF MER5 VARIABLE DIMENSIONED TWICE DEF MER10 ARRAY OF UNKNOWN DIMENSIONS DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE DEF MER8 SYMBOL TABLE OVERFLOW SKP MBOX1 EQU TEMPS MBIN1 EQU TEMPT+1 MBIN2 EQU TEMPT+2 MNPTR EQU TEMPT+3 TYP EQU TEMPT+4 NAME EQU TEMPT+5 SC EQU TEMPT+8 LU EQU TE¬‘TRNMPT+9 COML EQU TEMPT+10 MWDNO EQU TEMPT+11 MPTR EQU SBPTR FERR EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 * END ±óTÿÿ ÿýQd ÿ92065-18005 2001 S C0122 &MBC40 BASIC EXECUTE SUBR (SO             H0101 ÿ×þúASMB,R HED <> 92065-16001 NAM BASC4,7,99 92065-16007 REV. 2001 791019 * * DATE REVISED 7-21-78 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * SOURCE 92065-18005 * * ENT BASC4,ETAB,ERND,ESGN,ESWR,XERR,SERR,OCT,TIM ENT ETYP EXT FINDV,BCKSP,WRITE,DRQST,GETCR,MVTOH,OUTER EXT IFBRK,ENOUT,NUMCK,OUTCR,..FCM,INDCK,.IENT EXT OUTLN,OUTIN,TRAP,FCNEX,.MBT EXT PRNIN,SSYMT,FNDPS,.PACK,COMND EXT EXP,ALOG,RMPAR EXT EXEC,OLNCK,KEYBD EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT EXT BASC8 * COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #4: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * AFTER THE SUCCESSFUL COMPLETION OF THE PRE-EXECUTION PROCESSING * SEGMENT. IT WILL EXECUTE THE USER PROGRAM, LINE BY LINE, BY * EXAMINING THE TRANSLITERATED CODE AND BRANCHING TO THE VARIOUS * EXECUTION SUBROUTINES. UPON COMPLETION, IT RETURNS EXECUTION TO * THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMT–þúBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP HSTPT BSS 1 HIGH-STACK POINTER TSTPT BSS 1 TEMPORARY STACK POINTER LSTPT BSS 1 LOW-STACK POINTER LSTAK BSS 1 LOW-STACK ADDRESS PRADD °ÕþúBSS 1 PROGRAM EXECUTION NXTST BSS 1 SEQUENCING INFORMATION DSTRT BSS 1 DATA NXTDT BSS 1 STATEMENT DCCNT BSS 1 POINTERS SPC 1 SUP PRESS MULTIPLES LISTING SPC 1 XH BSS 1 XL BSS 1 TT1 BSS 1 TT2 BSS 1 TT3 BSS 1 TT4 BSS 1 EOL BSS 1 TAB END-OF-LINE FLAG STRFG BSS 1 STRING CONSTANT FLAG * FOPBS DEF QUOTE-1 ARBAS DEF AROTB-6,I XECBR DEF XECTB-26,I ADATA DEF DATA FINCA DEF FINCH ADDRESS OF FETCH INPUT ROUTINE FSCHA DEF FSCH ADDRESS OF FETCH SOURCE CHAR ROUTINE * TRMSA DEF *+1 TRACE ASC 4,*TRACE A EQU 0 B EQU 1 SKP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .10 DEC 10 .15 DEC 15 .20 DEC 20 .32 DEC 32 LFTAR OCT 137 CTRLQ OCT 21 B40 EQU .32 B42 OCT 42 B77 OCT 77 B377 OCT 377 B777 OCT 777 B2000 OCT 2000 RSS OCT 2001 B3000 OCT 3000 SCCNT OCT 3002 DATA OCT 51004 DATOP OCT 51000 ENDOP OCT 45000 #OP OCT 17000 SPLOP OCT 65000 OPMSK OCT 77000 ATMSK OCT 10000 INF OCT 77777 INTFL OCT 100003 OPDMK OCT 100777 WRFLG OCT 100001 M1 DEC -1 M2 DEC -2 M3 DEC -3 M6 DEC -6 M15 DEC -15 M20 DEC -20 M21 DEC -21 D31 OCT -31 M73 DEC -73 M256 DEC -256 M1000 DEC -1000 HALF OCT 40000 OCT 0 HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG HIMSK EQU M256 AFCNX DEF FCNEX ADDRESS OF BRANCH ENTRIES FOR FUNCTIONS SKP *************************** * * * EXECUTION BRANCH TABLES * * * *************************** * * THE EXECUTION BRANCH TABLES ARE THE BASIS FOR EXECUTING A BASIC * USER PROGRAM. FOR EACH OPERATOR IN BASIC THERE IS A UNIQUE CODE * NUMBER. THIS CODE NUMBER, WHEN ADDED TO A REFERENCE ADDRESS, ,• * FORMS A POINTER TO ONE OF THE ADDRESSES IN THESE BRANCH TABLES. * THE ADDRESS WHICH IS POINTE¸þúD TO IN THE TABLE, IS THE ADDRESS OF * THE CORRESPONDING EXECUTION SUBROUTINE. * XECTB DEF ELET LET DEF XEC4 DIM DEF XEC4 COM DEF XEC4 DEF DEF XEC4 REM DEF EGOTO GO TO DEF EIF IF DEF EFOR FOR DEF ENEXT NEXT DEF EGOSB GOSUB DEF ERTRN RETURN DEF EEND END DEF EEND STOP DEF EWAIT WAIT DEF ECALL CALL DEF XEC4 DATA DEF EREAD READ DEF EPRIN PRINT DEF EINPT INPUT DEF ERSTR RESTORE DEF EPAZ PAUSE DEF XEC4 FAIL DEF EGOTO THEN DEF XEC4 USING NOP .PLACE HOLDERS NOP NOP DEF 0 SPECIAL SYNTAX DEF ETRAP TRAP * SKP DEF FORMX,I EXIT ON EMPTY STACK BSS 5 DUMMY ADDRESSES AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FORM1 '(' DEF FOR11 UNARY '+' DEF EOR OR DEF EAND AND DEF ENOT NOT DEF EGORE '>=' DEF ELORE '<=' * SKP ***************************** * * * OPERATOR PRECEDENCE TABLE * * * ***************************** * * THIS TABLE IS USED BY THE FORMULA EVALUATION SUBROUTINE TO * DETERMINE THE HIERARCHICAL PRECEDENCE OF THE FORMULA-TYPE * OPERATORS. BITS 15-9 OF THE LABELLED WORD ARE THE BASIC * CODE OPERATOR AND BITS 3-0 ARE THE PRECEDENCE FOR THE * OPERATOR. QUOTE OCT 1000 COMMA OCT 2000 SEMIC OCT 3000 * RPARN OCT 4001 RBRAC OCT 5001 SCüVþúMMA OCT 6002 ASSOP OCT 7002 PLUS OCT 10007 MINUS OCT 11007 TIMES OCT 12010 DIV OCT 13010 EXPS OCT 14012 GTR OCT 15005 LSS OCT 16005 UNEQL OCT 17005 EQUAL OCT 20005 UNMIN OCT 21011 LBRAC OCT 22020 LPARN OCT 23020 UPLUS OCT 24011 OROP OCT 25003 ANDOP OCT 26004 NOTOP OCT 27011 GTREQ OCT 30005 LSSEQ OCT 31005 * SKP *********************** * * * EXECUTE THE PROGRAM * * * *********************** BASC4 NOP CPB M1 (B)=-1 IF TRAP TABLE IS BUSY RSS YES ITS BUSY SO DONT ALLOW TRAP POLING JMP BASX NO, OK TO USE IT LDA RSS STORE RSS IN 'JSB TRAP' STA TRAPX STA ETRAP BASX LDA SLSTM RETURN SZA FROM SEGMENT 7 OR 8? JMP XEC4 YES, CONTINUE WITH NEXT STMT * * LDA FWAM SET FOR RANDOM NUMBER GENERATOR STA XH INITIALIZE INA RANDOM STA XL VARIABLE SPC 1 * INITIALIZE THE DATA POINTER SPC 1 CCA SET STA DCCNT 'NO STA DSTRT DATA' LDB PBUFF CONDITION STB NXTDT LDA ADATA,I SEARCH FOR FIRST JSB STSRH DATA STATEMENT JMP XEC2 NONE FOUND STB DSTRT SAVE STATEMENT LOCATION JSB SETDP SET DATA POINTER SPC 1 * INITIALIZE STACK POINTERS SPC 1 XEC2 JSB SETPT INITIALIZE PTRS LDA LORUN FIRST STMNT CPA .1 OF PROGRAM? JMP XEC3 YES! JSB FNDPS NO, FIND IT NOP JMP XEC5-1 CAN'T FIND IT * XEC3 LDA 1,I GET FIRST STATEMENT NUMBER STA NXTST AND SET UP FOR STB TEMP1 POINTERS JMP XEC5 SKP * FIND NEXT STATEMENT TO BE EXECUTED SPC 1 XEC4 LDA TTYPR RESTORE STA LUINP CONSOLE STA LUOUT LOGICAL UNITS LDA FCORE SET TEMPORARY STVßþúA TSTPT STACK POINTER LDA NXTST XEC44 SZA,RSS END OF PROGRAM? JMP EEND YES LDB HIRUN .CHECK FOR RUN LIMIT CMB ADB A .BEYOND THE LIMIT ? SSB,RSS JMP EEND .YES - END LDB PRADD PROSPECTIVE ADDRESS CPA 1,I DESIRED STATEMENT? JMP XEC6 YES XEC43 JSB FNDPS NO, FIND STATEMENT NOP NON-EXISTENT JSB ERROR STATEMENT XEC5 LDA 1,I GET NEW LINE NO. XEC6 STA .LNUM STB TEMP1 * LDB 1717B GET ID SEG ADDRESS ADB .20 GET ADDRESS OF THE RIGHT WORD LDA 1,I GET THE WORD AND ATMSK OPERATOR ATTENTION SZA FLAG SET? JMP OPEND YES, STOP THE PRESSES! LDB TEMP1 RESTORE B WITH ADDR OF NEXT STATEMENT LDA M1000 STA FILE# .SET TO STANDARD I/O TRAPX JSB TRAP CHECK FOR INTERRUPT JMP TRERR ERROR RETURN SSA,RSS JMP EGOS2 INTERRUPT, DO GOSUB JSB FLWST SETSX LDA TEMPS,I AND OPMSK EXTRACT STATEMENT TYPE CONT ALF,ALF POSITION RAR IT ADA XECBR COMPUTE EXECUTION ADDRESS JMP 0,I BRANCH TO EXECUTION CODE SKP ***************** * * ** EXECUTE LET ** * * ***************** * * ELET CLA,INA ENABLE FOR STRING CONSTANT STA STRFG IN FORMULA JSB FORMX JMP XEC4 * * ******************* * * ** EXECUTE FOR ** * * ******************* * EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? JMP EFOR1 NO STA TEMP2 YES, SAVE SOURCE ADDRESS ADA .6 SAVE STA TEMP4 DESTINATION ADDRESS STB TEMP1 SAVE FOR-VARIABLE ADDRESS JSB MVTOH COMPRESS STACK LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS CLA,RSS COMPUTE NEW EFOR1 LDA M6 TOP OF ADA ‰þúHSTPT FOR-STACK STA HSTPT POINTER STA TEMP1 CMA,INA STACK ADA LSTPT SSA,RSS OVERFLOW? JMP E1 YES. ERROR 57. STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS JSB FORMX INITIALIZE FOR-VARIABLE ISZ TEMPS ISZ TEMP1 SAVE LDA TEMP1 LIMIT STA ENEX2+1 ADDRESS JSB FETCH FETCH STA TEMP1,I AND ISZ TEMP1 STORE STB TEMP1,I LIMIT ISZ TEMP1 LDB M2 SET FOR STEP SIZE STB FDATA SIGN CHECK LDA TEMPS,I LOOK FOR SZA FOLLOWING ' STEP' JMP EFOR2 FOUND LDA HONE NOT FOUND, CMB,INB,RSS DEFAULT IS 1.0 EFOR2 JSB FETCH SSA STEP SIZE NEGATIVE? ISZ FDATA YES STA TEMP1,I SAVE ISZ TEMP1 STEP STB TEMP1,I SIZE ISZ TEMP1 SET POINTER LDA NXTST TO STATEMENT STA TEMP1,I FOLLOWING THE FOR EFOR3 LDA NEXTX FIND LDB PRADD 'NEXT' JSB STSRH STATEMENT NOP JSB FLWST FIND FOLLOWING STATEMENT AND B777 SAME CPA ETAB FOR-VARIABLE? RSS YES JMP EFOR3 NO LDB HSTPT,I LOAD DLD 1,I LOAD VALUE OF FOR VARIABLE JMP ENEX2-2 CHECK ACCEPTABILITY * * NEXTX OCT 42004 * ** EXECUTE NEXT ** * ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY JMP XEC4 NONE PRESENT STA HSTPT RESET TOP OF STACK STB ENEX1+1 SAVE FOR-VARIABLE ADDRESS INA SAVE LIMIT STA ENEX2+1 ADDRESS ADA .2 SAVE STEP SIZE STA TEMP1 ADDRESS LDB M2 SET STEP SIZE STB FDATA SIGN CHECK LDA TEMP1,I LOAD ISZ TEMP1 STEP LDB TEMP1,I SIZE ISZ TEMP1 SSA CHECK ISZ FDATA SI¦®þúGN ENEX1 JSB .FAD INCREMENT FOR-VARIABLE NOP DST ENEX1+1,I AND SAVE VALUE STA EFMT STB NFMT ENEX2 JSB .FSB COMPUTE FOR-VARIABLE - LIMIT NOP ISZ FDATA POSITIVE STEP SIZE? ELA YES, COMPLEMENT SIGN SSA NO, NON-NEGATIVE RESULT? JMP ENEX3 NO LDA TEMP1,I YES, GO TO FIRST STA NXTST JMP XEC4 STATEMENT OF LOOP * ENEX3 LDA HSTPT FAILS, ADA .6 ERASE STA HSTPT STACK ENTRY JMP XEC4 SKP ***************** * * * EXECUTE PRINT * * * ***************** EPRIN LDA HSTPT SAVE HI STK PTR IN CASE STA HTEMP OF END-OF-FILE EXIT JSB VALLU .A #,LU ? STA LUOUT .YES - SAVE * EPR01 JSB PRNIN INITIALIZE OUTPUT BUFFER JSB FLUPT FIND ANY PARTIAL LINE FLAG AND B377 AND ISOLATE THE STA TYPE CHARACTER COUNT CLA,RSS TURN ON EPR02 CCA TURN OFF STA EOL END-OF-LINE FLAG EPR04 LDB TEMPS MORE CPB PRADD STATEMENT? JMP EPR19 NO,EXIT PRINT EXECUTION LDA 1,I AND OPDMK EXTRACT OPERAND SZA NULL JMP EPR07 NO,GO TO EVALUATION EPR05 LDB TEMPS INB CPB PRADD MORE STATEMENT? JMP EPR19 NO, EXIT PRINT PROCESSING LDA 1,I YES, EXTRACT AND OPMSK OPERATOR CPA B2000 "," ? JMP EPR10 YES,GO TO COMMA EXECUTION CPA B3000 ";" ? JMP EPR14 YES, TURN OFF END-LINE FLAG CPA ENDOP "END" JMP EPR19 .EXIT PRINT OPERATION I/O SZA NULL OPERATOR? JMP EPR07 NO,EVALUATE FORMULA EPR06 ISZ TEMPS YES, STEP CODE POINTER, JMP EPR04 AND EXAMINE OPERANND. * EPR07 CLA,INA STA STRFG ALLLOW STRING CONSTANTS CCA AND PRESET TAB FLAG STA EOL ugþú JSB FORMX EVALUATE NEXT EXPRESSION ISZ EOL WAS IT A TAB? JMP EPR12 YES, EXECUTION DONE LDB HSTPT,I WAS IT A STRING? SSB JMP EPR11 YES, GO PROCESS IT JSB OPCHK QUALIFY THE OPERAND DLD 1,I NO JSB ENOUT OUTPUT THE NUMBER CLA AND REMEMBER THAT STA TABFG IT WAS NUMERIC OUTPUT JMP EPR12 * EPR12 ISZ HSTPT POP VARIABLE PTR OFF HI STK JMP EPR05 * EPR10 CLA CPA EOL WAS THERE A TAB LAST? JSB EDELM NO,EXECUTE COMMA CLA,INA STA TABFG EPR14 ISZ TEMPS STEP CODE POINTER JMP EPR02 AND TURN OFF END-LINE FLAG * EPR11 LDA M2 PREPARE JSB PSTR PRINT STA TEMP8 STRING STB TPRME LDB TEMPS ADB M1 STB TEMPS LDB M3 LDA TNULL NO,GET STRING LENGTH CMA STA EDELM AND SAVE FOR LATER JSB OLNCK CHECK LINE OVERFLOW LDA .OTBF FIGURE STARTING CLE,ELA CHARACTER ADA OCCNT ADDRESS STA TEMP5 FOR TRSTR ADA EDELM UPDATE OUTPUT CLE,ERA POINTER SEZ,RSS ADA M1 STA OTBFA SINCE TRSTR WON'T LDA OCCNT AND ALSO ADA EDELM UPDATE THE STA OCCNT CHAR COUNT LDA FSCHA JSB TRSTR OUTPUT THE CHARACTERS CLA,INA STA TABFG AND REMEMBER NO BACKSPACING JMP EPR05 EXAMINE THIS OPERATOR * EPR19 CLA ISZ EOL TERMINATE THIS LINE? JMP EPR20 YES,GO TO OUTPUT LDA LUOUT IS THIS AND B77 A JSB FINDV LINEPRINTER? CPA .10 JMP EPR15 YES! LDA LFTAR NO, ADD TRAILING JSB OUTCR LEFT ARROW LDB M1 AND CORRECT FOR IT EPR21 ADB OCCNT MANUFACTURE ADB TYPE LOGICAL UNIT LDA LUOUT Ï(þú AND COUNT AND B77 WORD INCLUDING ALF,ALF ALL CHARACTERS IOR 1 OUTPUT, EXCEPT '_' EPR20 STA TEMP1,I UPDATE OR RELEASE LU/COUNT WORD JSB OUTLN AND OUTPUT THIS RECORD JMP XEC4 * EPR15 LDA LUOUT SET IOR B2000 HONESTY STA LUOUT MODE CLB JMP EPR21 * * * VALIDATE LU # FOR READ AND PRINT * * VALLU NOP LDA M1000 .PRESET FOR NON #,LU CASE STA FILE# LDA TEMPS .LOOK FOR # OPERAND INA LDA A,I AND OPMSK CPA #OP .DO WE HAVE A # ? RSS .FOUND IT - FETCH LU VALUE JMP VAL1 .NOT FOUND LET LU BE STA FILE# .SET TO ALTERNATE LU # ISZ TEMPS .MOVE TO EVALUATE LU CLA STA STRFG .DISABLE STRINGS JSB FETCH .FETCH LU VALUE JSB IFIX .CONVERT TO INTEGER STA VAL2 .SAVE RESULT ISZ TEMPS .SKIP OVER NULL RECORD LDA TEMPS,I FETCH SEMICOLON CPA B3000 .VARIABLE ATTACHED? JMP VAL3 .CHECK FOR STRING CONSTANT FOLLOWING VAL4 LDA VAL2 .RESTORE VALUE JMP VALLU,I & EXIT VAL1 ISZ VALLU .JMP OVER LU SET JMP VALLU,I VAL2 NOP * VAL3 LDB TEMPS .THIS IS AKLUDGE TO COMPENSATE INB . FOR FORMX LDA B,I .CHECK TO SEE IF NEXT DATA AND OPMSK . IS A STRING CONSTANT ALF,ALF . IF IT IS DO NOT INCREMENT TEMPS CPA .2 JMP VAL4 ISZ TEMPS .IF IT NOT ,SKIP OVER 3000 IN JMP VAL4 . INTERPRETTIVE CODE * SKP *********************** * * * FIND LU/COUNT WORD * * * *********************** * FLUPT NOP LDA LUOUT CREATE THE AND B77 SEARCH TARGET STA LUTMP LDB M20 INITIALIZE STB TEMP7 COUNTER ADB FCORE AND FIGURE START O“ÌþúF LIST CCA INITIALIZE STA TEMP1 EMPTY SLOT POINTER STA TEMP3 AND FLAG FLUP1 LDA 1,I EXAMINE A WORD SZA EMPTY ? JMP FLUP2 NO ISZ TEMP3 YES, IS THIS THE FIRST JMP FLUP4 NO, SKIP TO NEXT STB TEMP1 YES, SAVE POINTER JMP FLUP4 AND SKIP TO NEXT FLUP2 ALF,ALF POSITION AND AND B77 ISOLATE LU BYTE CPA LUTMP DOES IT MATCH ? JMP FLUP3 YES FLUP4 INB NO, TRY AGAIN ISZ TEMP7 UNLESS THERE JMP FLUP1 AREN'T ANY MORE * CLA MATCH NOT FOUND LDB TEMP1 WAS THERE AN EMPTY SSB SLOT ? JMP E1 NO, OUT OF STORAGE JMP FLUPT,I YES, QUIT WITH A = 0, B = ADDR * FLUP3 LDA 1,I MATCH FOUND STB TEMP1 RETURN WITH A = LU/COUNT WORD JMP FLUPT,I AND B = POINTER THERETO SKP *************************** * * * SPACE FOR A COMMA * * * *************************** * EDELM NOP CLB STB OUTLN SET FLAG FOR LINE OVERFLOW LDA OCCNT ADA TYPE FIGURE CURRENT COLUMN DIV .15 TAKE COLUMN .MOD. 15 SZB,RSS RIGHT ON ? JMP EDELM,I YES, QUIT NOW LDA 1 NO, COMPUTE ADA M15 BLANKS REQUIRED STA TEMP3 FOR SPACING CMA,INA JSB OLNCK CHECK FOR LINE OVERFLOW LDA OUTLN WAS THERE OVERFLOW ? SZA JMP EDELM,I YES, QUIT NOW EDEL0 LDA .32 NO, EMIT A SPACE JSB OUTCR ISZ TEMP3 KEEP ON DOING IT JMP EDEL0 UNTIL FIELD IS FULL JMP EDELM,I * LUTMP EQU EDELM SKP *************** * * * EXECUTE TAB * * * *************** ETAB NOP JSB .IENT SMALL INTEGER? JMP TABXT bƒþú NO ADA M73 EXCEED SSA,RSS 72? JMP ETAB1 YES! CMA,INA NO, COMPUTE ADA M73 BLANKS ADA OCCNT REQUIRED ADA TYPE SZA,RSS ARE WE RIGHT ? JMP TABXT YES SSA,RSS TOO FAR TO THE RIGHT ? JMP ETAB2 YES STA TEMP3 NO, DRIFT TO THE RIGHT ETAB0 LDA .32 WRITE BLANKS JSB OUTCR RIGHT ISZ TEMP3 JMP ETAB0 TABXT CLB STB EOL SET TAB FLAG TRUE JMP ETAB,I AND EXIT * ETAB1 JSB OUTLN OUTPUT THE LINE JMP TABXT * ETAB2 LDB TABFG CAN WE SZB LEAN TO THE LEFT ? JMP TABXT NO CMA,INA SAVE NEGATIVE STA TEMP3 BLANK COUNT LDB OCCNT ETAB3 LDA OTBFA,I FETCH LAST WORD SLB LOW OR HIGH BYTE ? ALF,ALF HIGH BYTE -> LOW BYTE AND B377 AND ISOLATE THE BYTE CPA .32 IS IT A BLANK ? RSS YES JMP TABXT NO, QUIT NOW ADB M1 BACK UP STB OCCNT ONE CHARACTER SLB NEW WORD ? JMP ETAB4 NO LDA OTBFA YES ADA M1 STEP BUFFER POINTER STA OTBFA BACK TOO ETAB4 ISZ TEMP3 COUNT BLANKS REMOVED JMP ETAB3 AND CONTINUE JMP TABXT UNLESS COUNT EXHAUSTED SKP ********************* * ** *** EXECUTE NOT ** ** * ********************* * ENOT JSB STTOP LOAD OPERAND JMP EEQL1 ********************* * ** *** EXECUTE AND ** ** * ********************* EAND JSB BINOP VALIDATE JMP *+2 OPERANDS NOP ANDS SZA,RSS FIRST OPERAND ZERO? JMP FALSE YES LDA ANDS-1,I JMP ENEQ1 CHECK SECOND OPERAND ********************* * ** *** EXECUTE OR ** ** * ********************* EOR JSB BINOP VALIDATE JMP`Åþú *+2 NOP IOR *-1,I TRUE IF EITHER OPND JMP ENEQ1 NON-ZERO. SKP ****************** * * ** EXECUTE IF ** * * ****************** * EIF DLD TEMPS,I CPB EOFOP .END OF FILE CHECK? SSA .EOF RETURNED? CLA,INA,RSS ALLOW STRING JMP EIF1 .YES! STA STRFG CONSTANTS! JSB FETCH FETCH VALUE OF FORMULA STA EFMT SAVE RESULT FOR SINGLE STEPPING STB NFMT SZA,RSS RESULTANT TRUE? JMP XEC4 NO ISZ TEMPS ADVANCE TO NEXT OPERATOR EIF4 LDB TEMPS (B) = PTR TO INTERP. CODE JMP SETSX GO EVALUATE 'THEN' PART * EIF1 ISZ TEMPS JSB VALLU .FETCH LU # NOP . < SYNTAX SEG CHECKS FOR '#LU' > STA EIF2 .SET LU # JSB EXEC DEF EIF5 .MAKE A STATUS CALL ON THE DEVICE DEF .13 DEF EIF2 DEF EIF3 EIF5 LDA EIF3 ALF,ALF .POSITION EOF BIT TO BIT 15 SSA JMP EIF4 .TRUE - DO THEN PART ALS,ALS .SHIFT TO EOT BIT SSA,RSS .SET? JMP XEC4 .FALSE - DO NEXT STATEMENT JMP EIF4 .TRUE - DO THEN PART .13 DEC 13 EIF2 NOP .LU NUMBER EIF3 NOP .STATUS WORD EOFOP OCT 62000 .EOF OPERATOR CODE * ********************* * * ** EXECUTE GO TO ** * * ********************* * EGOTO CLA SET FLAG TO 'GOTO' MODE JMP EGOS0 FIND REFERENCED STATEMENT SKP ********************* * * ** EXECUTE INPUT ** * * ********************* * EINP1 JSB WDRQS PRINT '?' AS WARNING JSB DRQST YES, CALL FOR MORE JSB QCHEK CHECK FOR STOP CHARACTER EINP2 JSB CONST CONVERT AND STORE NUMBER JMP EINP1 NOT NUMBER LDB TEMPS END-OF- INB CPB PRADD STATEMENT? JMP EIN15 -¥þúYES CPA .10 NO, INSURE MORE INPUT EINPT JSB DRQST CALL FOR INPUT JSB QCHEK CHECK FOR STOP CHARACTER EINP5 LDA TEMPS,I .CHECK FOR NULL RECORD SZA,RSS . IF NULL THEN SKIP OVER JMP EINP6 JSB FORMX COMPUTE VARIABLE ADDRESS LDB HSTPT,I IS IT A SSB STRING VARIABLE? JMP EINP4 YES! ADB M1 STORE ISZ HSTPT ADDRESS-1 IN STB SBPTR POINTER JMP EINP2 EINP6 ISZ TEMPS JMP EINP5 * EINP4 CMB EXTRACT LDA 1,I PHYSICAL LENGTH ALF,ALF LENGTH OF AND B377 DESTINATION STRING CMA SET IT AS END ADA TSTPT,I OF UNSPECIFIED STA TPRME DESTINATION STRING CCA PREPARE JSB PSTR DESTINATION STRING LDB TNULL SAVE LENGTH STB TEMP7 ALLOWANCE EIN14 JSB GETCR FETCH CHARACTER NOP CPA B42 QUOTE? RSS YES! JSB BCKSP NO,STRING BEGINS HERE CLB TURN OFF STB BLANK SUPPRESSION LDA FINCA ADDRESS OF INPUT ROUTINE JSB TRSTR TRANSFER STRING CLB ALL REQUESTED CPB TNULL CHARACTERS TRANSFERRED JMP EIN10 YES! CPB PS1 NO,TRANSFER LENGTH SPECIFIED JMP EINP9 NO STA TEMP7 YES, SAVE (A) CCA FINISH STA TPRME ADA TNULL TRANSFER STA TNULL LDA FSCHA WITH BLANKS JSB TRSTR LDA TEMP7 RESTORE (A) EINP7 CPA .10 TRANSFER ENDED BY END-OF-INPUT JMP EIN13 YES! EINP8 JSB GETCR NO, WAS IT A QUOTE LDA .10 EXIT WITH JMP EIN13 NEXT CHARACTER EINP9 LDB TEMP6,I SET LOGICAL ADB TNULL TO ACTUAL STB TEMP6,I STRING LENGTH JMP EINP7 EIN10 CPB PS1 LENGTH OF STRING SPECIFIED? JMP EIN12 NO! ½íþúEIN11 JSB GETCR YES! JMP EIN13 IMPLIED CLOSING QUOTE CPA B42 QUOTE? JMP EINP8 YES! JMP EIN11 NO, LOOK FOR " OR END-OF-INPUT EIN12 JSB GETCR END-OF-INPUT NEXT? JMP EIN13 YES! CPA B42 NO,CLOSING QUOTE? JMP EINP8 YES! LDA TEMP7 NO, DESTINATION STRING EXCEEDED! STA TNULL RESTORE LDA SBPTR DESTINATION STRING STA TEMP5 PARAMETERS LDA B40 SET TO SKIP BLANKS STA BLANK JSB WDRQS PRINT EXTRA QUESTION MARK AS WARNING JSB DRQST GET A NEW DATA RECORD JSB QCHEK AND CHECK FOR STOP CHARACTER JMP EIN14 * EIN13 LDB B40 RESTORE STB BLANK BLANK SUPRESSION JMP EINP2+2 * * RESET PARTIAL LINE FLAG PENDING ON LUINP * EIN15 LDA LUINP .SET LUOUT = LUINP STA LUOUT JSB FLUPT .CHECK FOR ANY PARTIAL LINE FLAG SZA,RSS JMP XEC4 .NONE - NEXT STATEMENT CLA STA 1,I .YES - RESET FLAG JMP XEC4 .NOW THEN NEXT STATEMENT * * QCHEK NOP LDA .INBF,I FETCH FIRST WORD CPA QQ .CHECK FOR THE QQ STOP JMP OPEND .IF FOUND STOP PROCESSING ALF,ALF POSITION FIRST BYTE AND B377 AND ISOLATE IT CPA CTRLQ IS IT A '^Q' ? JMP OPEND YES, TAKE ORDERLY ABORT EXIT JMP QCHEK,I NO, RETURN * QQ ASC 1,QQ SKP * * OUTPUT WARNING ? IF KEYBOARD DEVICE * WDRQS NOP LDA LUINP .CHECK FOR CRT DEVICE JSB KEYBD JMP E13-1 .NOT A KEYBOARD - ISSUE ERROR LDA M2 LDB QMRKA .PRINT ? JSB WRITE JMP WDRQS,I .AND RETURN * QMRKA DEF QMARK QMARK ASC 1,?_ * * ******************** * * ** EXECUTE TRAP ** * * ******************** * ETRAP NOP RSS SKIP ERROR MESSAGE IF NOT BUSY JSB ERROR TRAP TABLE BUSY TEØ[þúRR4 EQU * JSB FETCH GET TRAP # JSB IFIX MAKE INTEGER CMA,INA MAKE NEGATIVE STA TEMP4 SAVE IT LDB TEMPS ADB .2 SKIP OVER 'GOSUB' AND FLAG LDA 1,I GET SEQ NO. STA TEMP5 SAVE IT SSA POSITIVE? CMA,INA NO, MAKE IT SO JSB FNDPS MAKE SURE JMP XEC5-1 STATEMENT JMP XEC5-1 EXISTS LDB TEMP5 GET SEQ NO. LDA TEMP4 GET TRAP NO. JSB TRAP SET UP TRAP VS. SEQ NO. TRERR RSS TRAP ERROR JMP XEC4 CPA .1 TRAP TABLE FULL? JSB ERROR YES! TERR1 CPA .2 ILLEGAL TRAP COMBINATION? JSB ERROR YES! TERR2 JSB ERROR NO, MUST BE SCHEDULED BUT DELETED TASKED TERR3 EQU * SKP ********************* * * ** EXECUTE GOSUB ** * * ********************* * EGOSB CCA SET FLAG TO EGOS0 STA RFLAG 'GOSUB' MODE LDA 1,I INB SIMPLE BRANCH AND OPDMK STATEMENT? CPA INTFL JMP EGOS1 YES! JSB FETCH NO, COMPUTE JSB SBFIX BRANCH INDEX JMP XEC4 UNSUITABLE RESULT LDB 0 BLS COMPUTE ADB TEMPS 'ADDRESS' ADB .2 ADDRESS LDA 1 CMA WITHIN ADA PRADD STATEMENT RANGE SSA JMP XEC4 NO! EGOS1 LDA 1,I YES, LOADR BRANCH ADDRESS ISZ RFLAG 'GOTO' MODE? JMP EGOS3 YES LDB NXTST LOAD (B) WITH EGOS2 STA NXTST RETURN SEQUENCE NUMBER JSB SLWST STACK RETURN ON LOW-CORE STACK ADA M21 GOSUBS NESTED 20 DEEP? CPA LSTAK JSB ERROR YES! E2 JMP XEC4 NO! EGOS3 STA NXTST SAVE STMT # JMP XEC4 EXECUTE IT * * *********************** * * ** EXECUTE RESTORE ** * * ********************þú*** * ERSTR LDA TEMPS,I CHECK TO SEE ISZ TEMPS IF THERE IS ANY LDB DSTRT DATA STATEMENTS CPB M1 IMPOSSIBLE ADDRESS? JMP XEC4 YES, SO IGNORE IT SSA,RSS FOLLOWED BY SEQ NUMBER JMP E7 NO! LDA TEMPS,I YES, SO USE IT JSB FNDPS CONVERT THE NOP TO ABSOLUTE CORE ADDRESS JMP XEC5-1 UNDEFINED STATEMENT REFERENCED LDA 1 FOUND A STATEMENT ADA .2 NOW CHECK TO LDA 0,I SEE IF AND OPMSK THIS IS CPA DATOP A DATA STATEMENTNT RSS YES IT IS! JSB ERROR NO, NOT A DATA STMNT E7 JSB SETDP SET DATA POINTERS JMP XEC4 DONE * ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP JSB OPCHK VALIDATE TOP (SECOND) OPERAND LDA BINOP INA STB 0,I POST ITS ADDRESS ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD & VALIDATE FIRST OPERAND JMP BINOP,I * ** *** EVALUATE FORMULA AND RETURN RESULT ** ** FETCH NOP JSB FORMX EVALUATE FORMULA JSB OPCHK ISZ HSTPT UNSTACK RESULT ADDRESS DLD 1,I LOAD (A&B) WITH VALUE JMP FETCH,I EXIT SKP ******************************** * * ** EXECUTE SUBSCRIPT COMMA ** * * ******************************** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I SSB STRING VARIABLE? JMP ESCM2 YES! ADB .2 FETCH SUBSCRIPT LDA 1,I BOUNDS AND B377 EXTRACT STA OUTLN COLUMN BOUND LDA 1,I EXTRACT ALF,ALF ROW AND B377 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO. ERROR 49. >Íþú LDA LSTPT,I CLB,INB CPB OUTLN COLUMN MATRIX? JMP ESCM1 YES. MPY OUTLN NO, COMPUTE ADDRESS * DISPLACEMENT DUE TO ROWS ESCM1 CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB OUTLN ACTUAL CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO. ERROR 49. E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS STB TEMP7 AND SAVE BASE FOR ECALL CCB ADB LSTPT UNSTACK STB LSTPT * JMP FORM1 GO TO FORMULA PROCESSOR * ESCM2 JSB RSCHK PUT STRING LDB M2 SUBSCRIPTS ADB LSTPT ON STB LSTPT TEMPORARY INB STACK DLD 1,I RRR 16 CORRECT ORDER DST TSTPT,I OF SUBSCRIPTS JMP FORM1 SKP ** *** INTEGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT DLD 1,I FETCH SUBSCRIPT JSB .IENT INTEGER? JMP E6-1 NO. ERROR 49. SEZ,RSS YES, ROUND AND ADA M1 BIAS BY -1 SSA POSITIVE INTEGER? JMP EBS1 CHECK FOR NEG SUBSCRIPT ERROR EBS2 STA LSTPT,I SAVE IN OPERATOR STACK ISZ HSTPT POP OPERAND STACK JMP ESBS,I EBS1 LDB HSTPT IS THIS ADB .2 A STRING LDB 1,I VARIABLE? SSB,RSS JMP E6-1 NO, ERROR NEG SUBSCRIPT! CPA M1 IF STRING -1 JMP EBS2 IS OK JMP E6-1 EVERY OTHER NEG VALUE BAD ** *** EXECUTE STORE ** ** ESTR LDB TEM10 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR10 NO, DEFER STORE CPB TEMP5 YES, FIRST STORE OPERATOR USED? JMP ¿îþúESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMP8 DESTINATION LDA TEMP5 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMP8,I PART OF SOURCE STB EFMT ISZ TEMP8 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMP8,I PART OF SOURCE STB NFMT ISZ HSTPT POP STACK JMP FOR11 RETURN TO FORMULA ÿÿOCESSOR * ESTR2 LDA HSTPT,I STRING OPERANDS SSA JMP ESTR3 YES! JSB OPCHK SAVE ADDRESS STB TEMP5 OF QUANTITY ISZ HSTPT POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE * ESTR3 LDA M2 PREPARE JSB PSTR SOURCE STA TEMP8 STRING STB TPRME CCA PREPARE JSB PSTR DESTINATION STRING LDB PBPTR SAVE CORE POINTER STB EST1 LDA TEMP8 TRANSFER CMA TO ADA TEMP5 HIGHER SSA CORE? JMP ESTR4 NO ADA TPRME YES ADA .2 OVERLAPPING SSA,RSS TRANSFER? JMP ESTR4 NO LDA TEMP5 YES, SAVE STA EST2 DESTINATION ADDRESS INB SET DESTINATION BLS ADDRESS TO START STB TEMP5 OF FREE CORE LDA TNULL SAVE TRANSFER STA EST3 LENGTH CMA,INA ALLOCATE ARS SPACE FOR JSB OVCHK INTERMEDIATE LDA FSCHA STRING JSB TRSTR TRANSFER STRING TO FREE CORE LDA EST3 RESTORE TRANSFER STA TNULL LENGTH STA TPRME RESET ACTUAL SOURCE LENGTH LDA EST1 SET SOURCE INA ADDRESS TO ALS INTERMEDIATE STA TEMP8 STRING LDA EST2 RESTORE ORIGINAL STA TEMP5 DESTINATION STRING ESTR4 LDA FSCHA JSB TRSTR COMPLETE TRANSFER LDM¾þúA EST1 RESTORE FREE STA PBPTR CORE POINTER JMP FORM9 EXECUTE END-OF-FORMULA ISZ PBPTR DEFER ISZ PBPTR EXECUTION LDA BASSO GUARANTEE ASSIGNMENT STA PBPTR,I OPERATOR ON STACK JMP FORM4+6 * BASSO OCT 7402 EST1 BSS 1 EST2 BSS 1 EST3 BSS 1 TNULL BSS 1 TPRME BSS 1 CP0 BSS 1 CP1 BSS 1 SKP ***************** * * *** CALL ADD ** * * ***************** * EFAD JSB BINOP JSB .FAD NOP JMP FORM0 ********************** * * ** CALL SUBTRACT ** * * ********************** * EFSB JSB BINOP GET OPERAND DIFFERENCE JSB .FSB NOP JMP FORM0 ********************** * * ** CALL MULTIPLY ** * * ********************** * EFMP JSB BINOP JSB .FMP NOP JMP FORM0 ********************** * * ** CALL DIVIDE ** * * ********************** * EFDV JSB BINOP JSB .FDV NOP JMP FORM0 SKP ********************** * * ** EXECUTE ^ ** * * ********************** * EPWR JSB BINOP EVALUATE ARGUMENTS JMP *+2 EPWRA NOP ADDRESS OF POWER STA UTEMP SAVE BASE STB UTEMP+1 SZA BASE ZERO? JMP PCHK1 NO LDA EPWRA,I BASE ZERO; SZA,RSS IS POWER ZERO? JSB ERROR YES! POWER SSA,RSS NO; POWER POSITIVE? JMP FALSE YES, RETURN ZERO JSB ERROR NO. ERROR 70. ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FORM0 * PCHK1 DLD EPWRA,I FETCH POWER JSB .IENT INTEGERIZE JMP EPWR1 OVERFLOW SOS BITS LOST ? JMP EPWR1 NO, IS INTEGER. LDA UTEMP REAL POWER. FETCH BASE LDB UTEMP+1 SSA wþú NEGATIVE BASE? JSB ERROR YES. ERROR 51. BASER EQU * JSB ALOG TAKE NATURAL LOG OF BASE JSB ERROR LOG ERROR LOGER JSB .FMP MULTIPLY BY POWER DEF EPWRA,I JSB EXP EXPONENTIATE JSB ERROR EXP ERROR EXPER JMP FORM0 * EPWR1 STA TT1 INTEGER; CALC BY MULTIPLICATION. LDB HONE INITIALIZE RESULT TO 1.0 STB TT3 LDB .2 STB TT4 SSA CMA,INA TAKE ABSOLUTE VALUE IPWR1 SLA,RSS TEST (SHIFTED) POWER JMP IPWR3 WAS EVEN. STA TT2 LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP MULTIPLY RESULT-SO-FAR DEF TT3 STA TT3 SAVE PARTIAL STB TT4 RESULT LDA TT2 IPWR3 ARS STA TT2 SZA,RSS DONE? JMP IPWR4 YES. LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP SQUARE IT DEF UTEMP STA UTEMP STB UTEMP+1 LDA TT2 JMP IPWR1 * IPWR4 LDA TT1 GET ORIGINAL POWER SSA POSITIVE POWER? JMP IPWR5 NEGATIVE. RETURN RECIPROCAL. LDA TT3 YES,LOAD LDB TT4 RESULT JMP FORM0 * IPWR5 LDA HONE LOAD LDB .2 1.0 JSB .FDV DIVIDE BY RESULT DEF TT3 JMP FORM0 RETURN RESULT * * ****************** * * ** EXECUTE <= ** * * ****************** ** ELORE JSB COMPR COMPARE OPERANDS SSA < ? JMP TRUE NO! JMP EEQL+1 YES! ** SKP ***************** * * ** EXECUTE = ** * * ***************** ** EEQL JSB COMPR COMPARE OPERANDS EEQL1 SZA EQUAL? JMP FALSE NO! JMP TRUE YES! ** ***************** * * ** EXECUTE # ** * * ***************** ** ENEQL JSB COMPR COMPARE OPERANDS ENEQ1 SZA NOT EQUAL? Usþú JMP TRUE NO! JMP FALSE YES! ** ***************** * * ** EXECUTE > ** * * ***************** ** EGTRT JSB COMPR COMPARE OPERANDS SSA < ? JMP FALSE YES! JMP ENEQL+1 NO! ** ***************** * * ** EXECUTE < ** * * ***************** ** ELST JSB COMPR COMPARE OPERANDS CMA,RSS ** ****************** * * ** EXECUTE >= ** * * ****************** ** EGORE JSB COMPR COMAPARE OPERANDS SSA < ? JMP FALSE YES! JMP TRUE NO! ** FALSE CLA LOAD CLB ZERO JMP FORM0 ** *** EXECUTE UNARY - ** ** EUMIN JSB STTOP LOAD NUMBER JSB ..FCM NEGATE IT JMP FORM0 ** *** EXECUTE LEFT BRACKET ** ** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP BUMP STACK JSB RSCHK LDA HSTPT IS THIS ADA .2 A STRING LDA 0,I VARIABLE? SSA JMP ELB1 YES TRUE LDA HONE NO,ARRAY SO LDB .2 LOAD DEFAULT 0 JMP FORM0 ELB1 CLA SET DEFAULT CLB SUBSCRIPT TO BE JMP FORM0 FINALLY -1 SKP * *********************************** * * * COMPARE TOP OPERANDS ON STACK * * * *********************************** * * ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE * STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND AND * POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL. * COMPR NOP LDA HSTPT,I STRING SSA ARGUMENTS? JMP COMP1 YES! JSB BINOP NO, COMPARE JSB .FSB NUMERICAL NOP JMP COMPR,I OPERANDS SPC 1 COMP1 LDA M2 PREPARE JSB PS¼:þúTR COMPARISON STA TEMP8 STRING STB TPRME LDA TNULL SAVE SPECIFIED STA CP0 LENGTH LDA M2 PREPARE JSB PSTR TEST STRING STB CP1 SAVE ACTUAL LENGTH ISZ TSTPT RESERVE SPACE ISZ TSTPT FOR RESULT JSB BHSTP BUMP HI STACK COMP2 ISZ CP0 MORE SPECIFIED STRING JMP COMP3 YES! CLB NO, LOAD A NULL JMP COMP4 CHARACTER COMP3 JSB FSCH LOAD NEXT LDA B40 COMPARISON LDB 0 CHARACTER COMP4 ISZ TNULL MORE SPECIFIED TEST STRING? JMP COMP6 YES! CLA NO, LOAD NULL CHARACTER COMP5 CMB,INB COMPARE ADA 1 CHARACTERS SZA,RSS EXIT ON NOT EQUAL SZB,RSS OR BOTH NULL JMP COMPR,I CHARACTERS JMP COMP2 COMP6 LDA CP1 MORE ACTUAL INA,SZA TEST STRING? JMP COMP7 YES! LDA B40 NO, LOAD A BLANK JMP COMP5 COMP7 STA CP1 LDA TEMP5 EXTRACT CLE,ERA LDA 0,I NEXT SEZ,RSS ALF,ALF TEST AND B377 ISZ TEMP5 CHARACTER JMP COMP5 * * ** ************************** * * *** FETCH A DATA ITEM ** * * ************************** * * UPON ENTRY (B)=1 IF NUMBER IS REQUESTED OR (B)=2 IF A * STRING IS REQUESTED. TYPE MATCH IS CHECKED. NUMBERS RETURN * IN (A) AND (B) STRINGS ARE PREPARED A SOURCE STRINGS. * FDATA FILLS FROM A FILE IF ONE IS REFERENCED BY THE CALLER. * FDATA MOVES TO NEW FILE RECORDS OR AS NECESSARY. * ** FDATA NOP STB TEMP8 SAVE DATA TYPE FDAT1 ISZ DCCNT MORE DATA? JMP FDAT2 YES LDA DATA NO, SEARCH LDB NXTDT FOR NEXT JSB STSRH DATA STATEMENT JSB ERROR NONE FOUND. ERROR 56 E4 JSB SETDP INITIALIZE THE Õþú JMP FDAT1 DATA POINTERS * FDAT2 LDB TEMP8 RESTORE TYPE ISZ DCCNT UPDATE LDA NXTDT,I POINTER ISZ NXTDT CORRECT RBR TYPE XOR 1 OF DATA? SSA JSB ERROR NO! E5 SSB,RSS YES, STRING? JMP FDAT3 YES! DLD NXTDT,I LOAD ISZ NXTDT DATA ISZ NXTDT UPDATE POINTER ISZ DCCNT AND COUNTER JMP FDATA,I FDAT7 LDA 1,I LOAD STRING HEADER INB SET CLE,ELB SOURCE STB TEMP8 ADDRESS CLE,ERB AND B377 SET CMA TRANSFER STA TPRME LENGTH CMA,INA ADJUST ARS RECORD ADB 0 PAST STB TEMP3,I STRING JMP FDATA,I FDAT3 LDA NXTDT,I SET ISZ NXTDT LDB NXTDT START-OF-STRING RBL CHARACTER STB TEMP8 ADDRESS AND B377 SET CMA TRANSFER STRING STA TPRME LENGTH CMA,INA UPDATE ARS LDB 0 ADA NXTDT DATA STA NXTDT ADB DCCNT STB DCCNT POINTERS JMP FDATA,I SKP ** *** SET FOR FOLLOWING STATEMENT ** ** FLWST NOP (B) HOLDS PRESENT ADDRESS LDA 1 COMPUTE INA ADDRESS LDA 0,I OF ADA 1 NEXT STA PRADD STATEMENT CPA PBPTR END OF PROGRAM? CLA,RSS YES, SET LINE NO. TO 0 LDA 0,I RECORD THE STA NXTST SEQUENCE NUMBER ADB .2 FETCH STB TEMPS FIRST WORD LDA 1,I OF CURRENT JMP FLWST,I STATEMENT * *** SEARCH STACK FOR GIVEN FOR-VARIABLE ** ** FVSRH NOP LDA TEMPS,I FETCH AND B777 FOR-VARIABLE STA ETAB SAVE FOR-VARIABLE JSB SSYMT FIND ADDRESS IN 0íþú INB SYMBOL TABLE LDA HSTPT SAVE STA TEMP3 STACK TOP FVSR1 CPA SYMTF STACK BOTTOM? JMP FVSRH,I YES, EXIT VIA (P+1) CPB 0,I MATCHING FOR-VARIABLE? JMP FVSR2 YES ADA .6 NO, MOVE TO JMP FVSR1 NEXT STACK ENTRY * FVSR2 ISZ FVSRH EXIT JMP FVSRH,I VIA (P+2) SKP * * * ******************* * * * EXECUTE PAUSE * * * ******************* * EPAZ LDA .2 GO TO RSS SEGMENT 8 * * ********************** * * * EXECUTE END/STOP * * * ********************** * EEND LDA .3 GO TO RSS SEGMENT 8 SKP * * ******************************** * * * EXECUTE OPERATOR ATTENTION * * * ******************************** * OPEND LDA .4 GO TO CLB SEGMENT 8 STB TEMP3 CLEARING ERROR FLAG * * SEG8 STA SLSTM SET SLOW STATEMENT FLAG JSB BASC8 PULL JMP XEC4 .EXECUTE NEXT STATEMENT * .4 DEC 4 SKP ******************** * * * EXECUTE CALL * * * ******************** * * * THE GENERAL FLOW THRU ECALL IS AS FOLLOWS: * * 1. CONTROL IS PASSED TO ECALL OR FCALL WHEN A * CALL OR FORTRAN FUNCTION IS FOUND RESPECTIVELY. * * 2. IF IT IS A CALL THEN THE SIMULATE FLAG IS CHECKED * AND IF SET CONTROL IS PASSED TO SEGMENT 7 TO SIMULATE * THE CALL STATEMENT. * * 3. THEN THE PARAMETERS OF THE CALL ARE STACKED ONE BY ONE * ON THE HIGH STACK. EACH PARAMETER IS A THREE WORD ENTRY. * THE DESCRIPTOR TRIPLET HAS THE FOLLOWING FORM, DEPENDING ON * THE PARAMETER TYPE DISCOVERED BY ECALL: * * SIMPLE VARIABLES ARRAYS STRINGS * -----------------Îþú----------------------------------------- * HSTPT+2 ! ARGUMENT POINTER ! ELEMENT POINTER ! -BASE ADDRESS - 1 ! * !----------------------------------------------------------! * HSTPT+1 ! ARGUMENT POINTER ! ARRAY BASE PTR ! CHARACTER ADDRESS ! * !----------------------------------------------------------! * HSTPT ! 2:REAL / 1:INTG ! ARRAY SIZE (WDS)! -STRG LNGTH (CHAR)! * ---------------------------------------------------------- * * 4. FOR FORTRAN FUNCTIONS THE SAME THINGS ARE DONE FOR * PARAMETERS BUT THE CALL # AND PARAMETER COUNT FROM THE * INTERPRETIVE CODE IS STACKED ON THE LOW STACK. DURING * EXECUTION OF THE STATEMENT THE INTERMEDIATE RESULTS ARE * STACKED ON THE TEMPORARY STACK AND POPPED OFF AS REQUIRED. * * 5. AFTER SCANNING THE LIST, THE * PARAM CT. IS PUT ON THE HIGH STACK. AT THIS TIME THE * HIGH STACK CONTAINS THE PARAMETER COUNT AND THREE WORD ENTRIES * FOR EACH OF THE PARAMETERS ALL IN REVERSE ORDER ON THE HIGH * STACK. I.E. LAST PARAMETER ON TOP. * * 6. NEXT THE SUBROUTINE NUMBER IS USED TO FIND THE * CORRECT BRANCH TABLE ENTRY AND THE CONTROL WORD AND * PARAMETER CONVERSION WORDS ARE RETRIEVED FROM THE TABLE. * FROM THE CONTROL WORD, THE NAME OF THE OVERLAY IS BUILT, * AND THE SUBROUTINE NUMBER IS SAVED FOR THE OVERLAY. SKP * 7. THEN THE PARAMETERS ARE WRITTEN OUT TO SYSTEM AVAILABLE * MEMORY WITH CLASS I/O. THE FIRST RECORD WRITTEN IS THE HIGH * STACK WHICH IS USED BY THE OVERLAY AS A PARAMETER DESCRIPTION. * THEN EACH PARAMETER IS WRITTEN OUT, ACCORDING TO THE TABLE * ON THE NEXT PAGE. * * 8. THE OVERLAY IS THEN SCHEDULED. THE OVERLAY READS IN * ALL PARAMETERS FROM SYSTEM AVAILABLE MEMORY, BUILDS * A SUBROUTINE CALL PARAMETER ADDRESS LIST, INTEGERIZES AS * REQUIRED, AND TRANSFERS CONTROL TO THE SUBROUTINE * SPaÞþúECIFIED BY THE BRANCH TABLE CONTROL WORD. * * 9. UPON COMPLETION OF THE SUBROUTINE THE PARAMETERS ARE * RECONVERTED AS REQUIRED, AND WRITTEN OUT USING * CLASS I/O TO SYSTEM AVAILABLE MEMORY. * CONTROL IS THEN RETURNED TO BASIC AND * THE PARAMETERS ARE READ IN FROM SYSTEM AVAILABLE MEMORY * AND PLACED BACK INTO THEIR RESPECTIVE PLACES, IF THE * RETURNED VALUE FLAG IS SET FOR THAT PARAMETER, AND IF * THE SUBROUTINE RETURNED NO ERROR FLAG. * * 10. CONTROL IS THEN PASSED TO THE NEXT STATEMENT FOR CALLS, AND * BACK INTO THE FORMX ROUTINE FOR FORTRAN FUNCTIONS, UNLESS * AN ERROR OCCURRED. * * ERROR CONDITIONS FROM THE OVERLAY ARE ALWAYS FATAL FOR * FORTRAN FUNCTIONS, AND ARE FATAL FOR CALLS UNLESS * THE BASIC PROGRAM LINE CONTAINS A "FAIL:" STATEMENT. * FOREGROUND/BACKGROUND COMMUNICATION ERRORS AND * OVERLAY ABORT ERRORS ARE ALWAYS FATAL. SKP * THIS TABLE DESCRIBES THE ACTION OF ECALL IN TRANSFERRING * ARGUMENTS FROM THE PARAMETER LIST SPECIFIED IN THE BASIC * PROGRAM TO THE OVERLAY ROUTINE IN THE FOREGROUND. * * THE ACTION TAKEN BY THE INTERPRETER DEPENDS ON THE CONTENTS * OF THREE PARAMETER CONVERSION WORDS OBTAINED FROM THE * BRANCH TABLE, SPECIFYING THE ATTRIBUTES OF THE ARGUMENTS * EXPECTED BY THE OVERLAY ROUTINE: * WORD 0 -- ROUTINE CONTROL WORD * WORD 1 -- ARRAY IDENTIFIER WORD * WORD 2 -- RETURNED VALUE WORD * WORD 3 -- INTEGER CONVERSION WORD * * * FORMAL * ARGUMENT : ARRAY/SIMPLE RETURN/NO INTEGER/REAL * ACTUAL !--------------------------------------------------------! * ARGUMENT: ! ! ! FIX ON CALL ! * SIMPLE ! PASS VARIABLE ! SAVE RETURN ! AND ! * VARIABLE ! ! IF BIT = 1 ! FLOAT ON RETURN ! * gÜþú !--------------------------------------------------------! * ! PASS ARRAY IF 1 ! PASS VALUE(S) ! FIX ALL VALUES ! * ARRAY ! WITH POINTER TO ! SAVE RETURN(S)! AND ! * VARIABLE ! GIVEN ELEMENT ! IF BIT = 1 ! FLOAT ON RETURN ! * ! PASS ELEMENT IF 0 ! ! ! * !--------------------------------------------------------! * ! PASS STRING OR ! ! \ / ! * STRING ! SUBSTRING IF 1 ! SAVE STRING ! \/ ! * VARIABLE ! PASS 2 CHARACTERS ! OR SUBSTRING ! /\ ! * ! IF 0 ! IF 1 ! / \ ! * !--------------------------------------------------------! * ! PASS STRING OR ! SYNTAX ERROR ! \ / ! * STRING ! SUBSTRING IF 1 ! IF BIT = 1 ! \/ ! * CONSTANT ! PASS 2 CHARACTERS ! PASS ONLY IF 0 ! /\ ! * ! ! ! / \ ! * !--------------------------------------------------------! * ! ! SYNTAX ERROR ! FIX ON CALL ! * SIMPLE ! PASS CONSTANT ! IF BIT =1 ! AND ! * CONSTANT ! ! PASS ONLY IF 0 ! FLOAT ON RETURN ! * ! ! ! IF BIT = 1 ! * !--------------------------------------------------------! * ! SYNTAX ERROR ! ! ! * REAL ! IF BIT = 1 ! SYNTAX ERROR ! FIX VALUE ! * EXPRESSION ! PASS VALUE IF ! IF BIT = 1 ! ON CALL ! * ! BIT = 0 ! ! ! * !--------------------------------------------------------! SKP * ECiÕþúALL JSB BHSTP CLA .RESET ERRCD BEFORE CALL STA ERRCD FCALL LDA FORMX SAVE RETURN STA HSTPT,I FROM FORMX JSB CALL0 .INITIALIZE FOR THE CALL LDB TEMPS,I STACK CALL ID WORD JSB SLWST ON LOW STACK LDA B AND B777 .CALCULATE THE ADDRESS OF ALS,ALS . BRANCH TABLE ENTRY ADA FWAMB STA TMPC6 . AND SAVE LDB A,I STB SUBLC INA LDB A,I .FETCH ARRAY FLAG WORD STB TMPC1 . AND SAVE ADA .2 .BUMP TO CONVERT FLAG WORD LDB A,I . AND SAVE STB TMPC2 CLB JSB SLWST INIT ARGUMENT CNTR INB & STB STRFG STRING FLAG CALL2 ISZ TEMPS FETCH NEXT CALL3 LDA TEMPS,I INTERPRETIVE WORD SZA,RSS NULL? JMP CBKSP YES,BACK UP 1 CPA LFPAR SUBCRIPTED VARIABLE? JMP CBKSP YES, BACK UP TO OPND-ID AND OPMSK CPA B4000 RIGHT PARENTHESIS? JMP CALL5 YES, END OF LIST JSB FORMX EVALUATE ARGUMENT * LDA HSTPT,I FETCH ARGUMENT ADDRESS SSA STRING? JMP STVAL YES CMA NO, CHECK FOR ARRAY LDB PBPTR LOW END OF ARRAY STORAGE ADB 0 SSB,RSS ABOVE? JMP CSVAL NO,MUST BE CONSTANT LDB FCORE HIGH END OF ARRAY STORAGE ADB M2 DECREMENT FOR 1'S COMP -1 ADB 0 SSB ABOVE? JMP COVAL .YES-MUST BE INTERMED.,COM OR VARIABLE COVAR LDB TEMP7,I NO,FETCH ARRAY BASE ADDR FROM SYMBOL TBL. ISZ TEMP7 POINT TO ARRAY SIZE LDA TEMP7,I FETCH ARRAY SIZE STB TEMP7 SAVE BASE ADDR TEMPORY CLB MULTIPLY RRR 8 COLUMN * BLF,BLF ROW STB TEMP3 TO CALCULATE MPY TEMP3 ARRAY SIZE. RRR 15 CONVERT SIZE TO WORDS IN B LDA TEMP7 :þúFETCH BASE ADDR JMP CSVPT PUT BASE ADDR & SIZE ON HISTK. * COVAL LDB SYMTA .IS THE POINTER TO A ADB M1 . COMMON VARIABLE ? ADB 0 SSB JMP COVAR .YES * CSVAL CMA BACK TO ADDRESS LDB .2 LENGTH =2 CSVPT STB TEMP3 SAVE SIZE TEMPORARY JSB BHSTP STA HSTPT,I SAVE BASE OR CHAR ADDR JSB BHSTP LDA TEMP3 SAVE LENGTH STA HSTPT,I +=WORDS, -=CHARS ISZ LSTPT,I ADD TO ARG COUNT JSB DOPRM .PROCESS THIS PARAMETER JMP CALL2 CHECK FOR MORE * STVAL LDA M2 SOURCE STRING FLAG JSB PSTR PREPARE STRING. RTN A=ADDR, B=LENGTH SWP EXCHANGE REGS CMA STA TEMP7 SAVE ACTUAL STRING LEN LDA TEMP6,I GET ARRAY DIMENSION AND HIMSK AND ADA TEMP7 STUFF IN ACTUAL LENGTH CMA,INA AND SAVE STA TEMP3 LOGICAL-PHYSICAL LENGTH (2'S COMPLMT) SWP JSB BHSTP UNDO STACK BUMP FROM PSTR JMP CSVPT+1 SAVE IT ALL ON HISTK * CBKSP LDB TEMPS BACK UP ADB M1 TO LAST STB TEMPS INTERPRETIVE JMP CALL3 WORD * * END OF ARGUMENT SCAN * B4000 OCT 4000 LFPAR OCT 122000 SKP * * INITIALIZE ROUTINE * CALL0 NOP LDA ADPRM INA STA TMPC2 .ZERO ALL PARAMETER POINTERS STA RTNAD .SET RETURN ADDRESS LDA M15 CLB STB TMPC2,I ISZ TMPC2 INA,SZA .DONE ? JMP *-3 . NO DO ALL 15 JMP CALL0,I ************************************** * * DUMMY CALL AREA * THIS ROUTINE IS CONFIGURED FOR THE * ACTUAL SUBROUTINE CALL * ************************************** * SUBCL NOP JSB SUBLC,I RTNAD DEF *+16 PRAM DEF * REP 14 DEF * JMP SUBCL,I * SUBLC DEF * LCPRM DEF * .LOCAL STORAGE FOR INTEGER IPRAM BSS 15 . ~”þúADPRM DEF PRAM-1 TMPC1 NOP .ARRAY FLAGS TMPC7 NOP .RETURN FLAGS TMPC2 NOP .CONVERT FLAGS NOP .PLACE HOLDER TMPC3 NOP .# PARAMETERS TMPC4 NOP .CALL I.D. ARRAY ADDRESS RTN TMPC5 NOP .# ELEMENTS IN INTEGER ARRAY TMPC6 NOP .ADDRESS OF BRANCH TABLE TMPC8 NOP .REAL ARRAY ADDRESS ARRAD EQU TMPC7 ABREG BSS 2 RRL16 OCT 100100 SKP * ********************************************** * * ROUTINE TO CONAFIGURE ROUTINE CALL * * LOWSTACK = # OF PARAMETERS * LOWSTACK-1 = CALL I.D. * HIGHSTACK HAS THREE WORD PARAMETER DESCRIPTOR * ********************************************** * DOPRM NOP LDA TMPC2 SLA .CONVERT TO INTEGER ? JSB ICONV .YES - DO IT JSB CDEF .NO - FIX PARAMETER ADDRESS IN CALL * LDA TMPC1 LDB TMPC2 RRR 1 .POSITION FOR NEXT PARAMETER STA TMPC1 STB TMPC2 ISZ RTNAD .BUMP RETURN ADDRESS JMP DOPRM,I .EXIT * * CDEF NOP LDA HSTPT,I .FETCH PARAMETER TYPE SSA .REAL / INTEGER / ARRAY ? JMP STRNG .NO - IT'S A STRING CPA .1 .INTEGER ? JMP INT .YES CPA .2 .REAL VARIABLE ? JMP REAL .YES LDA HSTPT .IT IS AN ARRAY ADA .2 .MOVE TO ARRAY ADDRESS LDA A,I . AND FETCH IT CDEF2 LDB TMPC2 .AN INTEGER ARRAY ? SLB LDA ARRAD .YES INCERT PROPER ADDRESS CDEF1 LDB ADPRM ADB LSTPT,I .INCREMENT TO PARAM POSITION STA B,I .STUFF PARAM ADDRESS JMP CDEF,I * INT LDA LCPRM ADA LSTPT,I .CALCULATE INTEGER STORE JMP CDEF1 * REAL LDA HSTPT INA LDA A,I .FETCH PARAMETER ADDRESS JMP CDEF2 * STRNG JSB ULWST .POP LOW STACK AND SAVE STB TMPC3 . # PRAM JSB ULWST . AND CALL ID STB TMPC4 lþú LDA LSTPT .COMPUTE STRING PARAMETER ADDRESS INA STA ARRAD .SAVE FOR INCLUSION IN SUB CALL LDA HSTPT ADA .2 .FETCH BASE ADDRESS AND LDA A,I . DETERMINE IF STRING CONSTANT ADA PBPTR SSA .CONSTANT ? JMP STRG1 .NO CONTINUE LDA HSTPT,I .FETCH LENGTH AND " CODE AND B377 .ELIMINATE " CODE STA B ALF,ALF .MOVE LENGTH TO UPPER BYTE ADA B .REINSERT LENGTH STA HSTPT,I .UPDATE HIGH STACK STRG1 LDA HSTPT,I ALF,ALF .POSITION PHYSICAL SIZE IOR LBYTE .FILL UPPER BITS CMA,INA .NEGATE STA STRLG .SAVE FOR MOVE BYTES LDA HSTPT,I .COMPUTE LOGICAL LENGTH CMA,INA AND B377 STA B .PUT ON LOW STACK JSB SLWST LDA HSTPT .FIND BYTE ADDRESS OF STRING INA LDA A,I STA STRPT .SAVE FOR MOVE BYTES CALL LDB LSTPT .COMPUTE BYTE ADDRESS IN LOWSTACK CLE,INB ELB STB SSTR . AND SAVE TEMP JSB .MBT . MOVE STRING DEF STRLG NOP CLE,ERB .COMPUTE NEW LOWSTACK ADDRESS SEZ INB STB LSTPT . AND SAVE CMB,INB .CHECK FOR STACK OVERFLOW ADB HSTPT SSB .OVERFLOW ? JMP E1 .YES LDB STRPT .PLACE BYTE ADDRESS OF STRING ON JSB SLWST . LOWSTACK LDB SSTR .ALSO PLACE BYTE ADDRESS OF STRING JSB SLWST . IN THE LOWSTACK LDB STRLG .ALSO THE STRING LENGTH IN LOW STACK JSB SLWST LDB TMPC4 .REPLACE CALL ID JSB SLWST LDB TMPC3 .REPLACE #PRAM JSB SLWST JMP CDEF1-1 .SET CALL PARAMETER * STRLG NOP STRPT NOP SSTR NOP SKP *********************************************** * * ICONV IS THE PARAMETER CONVERT ROUTINE * FOR SUBROUTINE ENTRY * ********************************ëþú************** * ICONV NOP LDA TMPC1 SLA .ARRAY PARAMETER TYPE ? JMP ICON1 .YES LDA HSTPT .NO - FETCH THE PARAMETER ADDRESS LDB HSTPT,I .CHECK FOR ARRAY ELEMENT ADB M3 SSB,RSS INA .YES FETCH ELEMENT POINTER INA LDA A,I DLD A,I .FETCH VALUE ITSELF JSB IFIX . CONVERT TO INTEGER LDB LCPRM ADB LSTPT,I .COMPUTE ADDRESS OF TEMP STA B,I . STORE AND SAVE STB ARRAD .SAVE ADDRESS JMP ICONV,I .EXIT * ICON1 LDB HSTPT INB LDA B,I .FETCH ARRAY BASE ADDRESS INB LDB B,I .FETCH ELEMENT ADDRESS CMB,INB .NEGATE AND COMPUTE # ELEMENTS LEFT ADA B ADA HSTPT,I .COMPUTE SIZE OF PASSED ARRAY ARS . DIVIDE BY 2 = # ELEMENTS CMA,INA STA TMPC5 STA SUBCL .USE SUBCL AS TEMP/ SAVE ARRAY SIZE INA,SZA,RSS .IF REAL THEN ERROR JSB ERROR E15 JSB ULWST .POP LOW STACK AND STB TMPC3 . SAVE # PARAM JSB ULWST STB TMPC4 . AND CALL I.D. LDA LSTPT .STACK TEMPORARILY THE FIXED ARRAY INA .BUMP TO NEXT ADDRESS STA ARRAD . ON THE LOW STACK - SAVE ADDRESS LDA HSTPT ADA .2 LDA A,I .ARRAY BASE ADDRESS STA TMPC8 . AND SAVE ICON2 DLD TMPC8,I JSB IFIX LDB A JSB SLWST .STACK THIS ELEMENT ISZ TMPC8 ISZ TMPC8 .BUMP ARRAY PTR ISZ TMPC5 .DONE ? JMP ICON2 .NO LDB ARRAD .YES - STORE ARRAY LOCATION WITH JSB SLWST . ARRAY ON LOW STACK LDB SUBCL .ALSO SAVE ARRAY SIZE JSB SLWST . ON LOW STACK LDB TMPC4 .YES RESTORE # PARAM JSB SLWST LDB TMPC3 . AND CALL I.D. TO LOW STACK JSB SLWST JMP ICONV,I SKP CALL5 JSB BHSTP MAKE ROOM ON HI STACK ¾zþú JSB ULWST AND UNSTACK STB HSTPT,I ARGUMENT COUNT * EXECUTE SUBROUTINE JSB SUBCL * ****************************** * * SUBROUTINE RETURN PARAMETERS * HANDLING * ****************************** * DST ABREG .SAVE RETURN VALUE * LDB HSTPT,I .FETCH # PARAMETERS ISZ HSTPT . & POP STACK CMB,INB,SZB,RSS . FOR PARAMETER FLAGS JMP RTN6 . NO PARAMETERS SKIP CONVERSION STB TMPC3 ADB .16 ADB RRL16 .FORM ROTATE INSTRUCTION STB RTN1 . AND STORE STB RTN2 JSB ULWST .ELIMINATE CALL I.D. STB CALID . SAVE FOR RETURN PROCESSING LDA TMPC6 .FETCH B&M ADDRESS INA DLD A,I .FETCH ARRAY AND RETURN RTN1 RRL 1 . FLAGS DST TMPC1 .SET ARRAY & RETURN FLAGS LDA TMPC6 ADA .3 LDA A,I CLB RTN2 RRL 1 DST TMPC2 .SET INTEGER FLAG TEMP * RTN5 LDA TMPC7 .RETURN ? SSA,RSS JMP RTN8 .NO - LOOK FOR STRING UNSTACK LDA TMPC2 SSA,RSS .INTEGER ? JMP RTN8 .NO - CHECK FOR STRING LDA TMPC1 SSA,RSS .ARRAY ? JSB RTN3 .NO - RETURN INTEGER JSB RTN4 .YES - RETURN ARRAY * FIN ISZ HSTPT .UNSTACK PARAMETER DESCRIPTOR ISZ HSTPT ISZ HSTPT * ISZ TMPC3 .MORE PARAMETERS ? RSS JMP RTN6 .NO - CHECK FOR FUNCTION * DLD TMPC1 .POSITION PARAM FLAGS RRL 1 . FOR NEXT ONE DST TMPC1 LDA TMPC2 RRL 1 DST TMPC2 JMP RTN5 .PROCESS NEXT PARAMETER * RTN6 LDA CALID .FETCH CALL I.D. AND OPMSK CPA CALOP .IS IT A SUBROUTINE ? JMP RTN10 .YES LDA ERRCD .NO - A FUNCTION SZA .ANY ERROR RETURNED? JMP E15-1 . YES - FATAL FOR FUNCTIONS JSB BHSTP JSB RSCHK .MAKE ROOM FOR RESULT ON LDA TMPCô.þú6 ADA .3 .IS THIS AN INTEGER FUNCTION ? LDA A,I SSA,RSS JMP RTN11 .NO - RETURN VALUE AS RECEIVED LDA ABREG JSB FLOAT .YES - RETURN REAL VALUE JMP RTN12 RTN11 DLD ABREG . TEMP STACK RTN12 ISZ TEMPS .STEP PAST RIGHT ) JMP FOR12 .CONTINUE WITH FORMULEA * RTN10 ISZ HSTPT .POP HIGH STACK LDB ERRCD SZB,RSS .ANY ERROR RETURN ? JMP XEC4 .NO - PROCESS NEXT STATEMENT CPB MNEG .IS THIS A FATAL ERROR? JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS LDB PRADD .END OF STATEMENT ? CPB TEMPS JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS .NO - FAIL OPTION USED LDB TEMPS .SKIP OVER FAIL OP CODE JMP SETSX . AND PROCESS REST OF CODE * .16 DEC 16 CALID NOP CALOP OCT 50000 * * RTN8 LDA HSTPT,I . IS IT A STRING SSA,RSS JMP FIN .NO - MOVE TO NEXT PARAMETER JSB ULWST .YES - FETCH STRING DATA STB STRLG . FROM LOWSTACK JSB ULWST . :LENGTH STB SSTR . :LOWSTACK BYTE ADDRESS JSB ULWST . :STRING BYTE ADDRESS LDA SSTR .COMPUTE NEW LOWSTACK ADDRESS CLE,ERA ADA M1 STA LSTPT .AND SAVE LDA TMPC7 .CHECK FOR NO RETURN SSA,RSS JMP RTN9 .YES NO RETURN LDA SSTR .READY FOR MOVE BYTES TO STRING STORE JSB .MBT DEF STRLG NOP LDA HSTPT INA .CHECK FOR SUBSTRING RETURN LDB A,I .FETCH CHARACTER ADDRESS INA LDA A,I .COMPUTE BYTE ADDRESS OF BASE CMA,CLE STA SSTR .SAVE INA .MOVE TO FIRST CHAR BYTE ADDRESS ELA CPA B .BASE = CHAR? JMP STRUP . YES - FIX NEW LOGICAL LENGTH RTN9 JSB ULWST .NO - POP LOWSTACK JMP FIN .MOVE TO NEXT PARAMETER * STRUP JSB ULWST STB A AND B377 ç“þú.FETCH RETURNED LOGICAL LENGTH STA B LDA SSTR,I .FETCH STRING LENGTH WORD AND LBYTE .REMOVE OLD LOGICAL LENGTH IOR B .MERGE AND STORE BACK STA SSTR,I JMP FIN .MOVE TO NEXT PARAMETER * LBYTE OCT 177400 * ****************************** * * RETURN INTEGER PARAMETER * ****************************** * RTN3 NOP ISZ RTN3 .SET FOR PROPER RETURN LDA TMPC3 CMA,INA ADA LCPRM .ADDRESS OF PARAMETER LDB HSTPT INB LDB B,I .FETCH ADDRESS OF VARIABLE STB TMPC4 LDA A,I .FETCH VALUE JSB FLOAT DST TMPC4,I .FLOAT & STORE JMP RTN3,I * ******************************** * * RETURN INTEGER ARRAY * ******************************** * RTN4 NOP JSB ULWST .FETCH ARRAY SIZE FROM STB TMPC5 . LOW STACK AND SAVE JSB ULWST .FETCH ARRAY LOCATION FROM LOW STB TMPC4 . STACK AND SAVE ADB M1 .COMPUTE NEW LOW STACK ADDRESS STB LSTPT . AND SET IT LDA HSTPT .COMPUTE ELEMENT ADDRESS OF REAL ADA .2 . ARRAY AND SAVE IN SUBCL AS TEMP LDA A,I STA SUBCL * RTN7 LDA TMPC4,I JSB FLOAT .CONVERT TO REAL DST SUBCL,I ISZ TMPC4 .STEP TO NEXT ELEMENT ISZ SUBCL ISZ SUBCL ISZ TMPC5 .DONE ? JMP RTN7 .NO - DO ANOTHER JMP RTN4,I .YES - EXIT SKP ****************** * * * EXECUTE WAIT * * * ****************** EWAIT NOP ISZ TEMPS POINT (TEMPS) TO FORMULA JSB FETCH FETCH EVALUATED FORMULA SSA NEGATIVE JMP XEC4 YES JSB IFIX CONVERT TO INTEGER SOC LARGE INTEGER LDA MNEG YES CMA NO STA TEMP2 SAVE COUNT (<0) ADA .74 AND CHECK FOR SSA,RSS SHORT WAIT JMP COíÑþúUNT GO COUNT FOR < 75 MS CCB LDA TEMP2 DIV .10 TENS OF MILLISECONDS STA TEMP2 JSB EXEC CALL SYSTEM DEF *+6 FOR DELAY DEF .12 DEF .0 THIS PRGRM DEF .1 BY 10'S OF MS DEF .0 ONLY ONCE DEF TEMP2 FOR THIS LONG JMP XEC4 ABANDON REMAINDER(SYSTEM UNCERTAINTY) * COUNT LDA TEMP2 RECOVER COUNT EWAI1 INA,SZA,RSS WAIT? JMP XEC4 NO! LDB M280 YES SET INNER LOOP INB,SZB MORE? JMP *-1 YES! JMP EWAI1 NO! * .0 DEC 0 .12 DEC 12 .74 DEC 74 M280 DEC -280 SKP ********************** * * * EXECUTE RETURN * * * ********************** ERTRN LDB LSTPT RETURN STACK CPB LSTAK EMPTY? JSB ERROR YES. ERROR 55. E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS ADB M1 RESET STB LSTPT STACK POINTER SSA,RSS IF NEGATIVE STMT NUMBER, JMP XEC43 STA 1 THIS IS RETURN FROM SCHED TASK. LDA M256 HANDLED BY SPECIAL HOOK JSB TRAP IN TRAP ROUTINE. JMP TRERR ERROR JMP XEC43 SKP * * ** EXECUTE READ ** * EREAD LDA HSTPT SAVE HI STK PTR STA HTEMP JSB VALLU .READ #,LU ? JSB EREA4 .SET NEW LUINP LDA FILE# CPA M1000 . READ FROM A DATA STMT? JMP EREA6 .YES LDA LUINP .NO - READ FROM LU AND B77 .SET EOT CONDITION TO IGNOR IOR B700 . PAPER TAPE LEADER STA EREA5 JSB EXEC DEF *+3 DEF .3 DEF EREA5 JMP EINPT .NOW READ FROM THE DEVICE * EREA5 NOP B700 OCT 700 * EREA6 LDB TEMPS EREA1 CPB PRADD JMP XEC4 JSB FORMX NO, EVALUATE NEXT ADDRESS LDA HSTPT,I RECORD ADDRESS SSA STRING VARIAB™6þúLE? JMP EREA2 YES! STA OUTLN CLB,INB JSB FDATA GET DATA ITEM STA OUTLN,I STORE ISZ OUTLN DATA STB OUTLN,I ITEM ISZ HSTPT EREA3 LDB TEMPS INB JMP EREA1 EREA4 NOP STA LUINP JSB KEYBD .DETERMINE IF NEW DEVICE JMP EREA4,I . IS KEYBOARD LDA LUINP IOR B400 . IT IS SO INSERT ECHO BIT STA LUINP STA LUOUT .SET OUTPUT DEVICE FOR "?" JMP EREA4,I SPC 1 EREA2 LDB .2 PREPARE JSB FDATA SOURCE STRING CCA PREPARE JSB PSTR DESTINATION STRING LDA FSCHA JSB TRSTR TRANSFER STRING JMP EREA3 * * * ** *** SEARCH FOR STATEMENT OF GIVEN TYPE ** ** STSRH NOP TYPE IN (A), ADDRESS IN (B) AND OPMSK (77000) EXTRACT STMT TYPE STA TEMP4 STSR1 CPB PBPTR PAST LAST STATEMENT? JMP STSRH,I YES LDA 1 EXTRACT ADA .2 PROGRAM LDA 0,I STATEMENÿÿ AND OPMSK TYPE CPA TEMP4 DESIRED TYPE? JMP STSR2 YES LDA 1 NO, FETCH INA STATEMENT LENGTH ADB 0,I COMPUTE NEW ADDRESS JMP STSR1 * STSR2 ISZ STSRH FOUND IT, SKIP RETURN JMP STSRH,I * ** *** SET POINTER TO START OF DATA STATEMENT ** ** SETDP NOP STATEMENT ADDRESS IN (B) INB LOAD LDA 1,I STATEMENT LENGTH CMA,INA SET INA DATA COUNTER STA DCCNT TO 1-STATEMENT LENGTH INB SET 'NEXT DATA' POINTER ONE STB NXTDT WORD ABOVE FIRST CONSTANT JMP SETDP,I SPC 1 SETPT NOP LDB SYMTF INITIALIZE STB HSTPT POINTERS TO LDB FCORE 'HIGH CORE' STACK, STB TSTPT ADB .23 STB LSTAK AND 'LOW' STB LSTPT ST~WþúACK CMB DO ADB HSTPT STACKS SSB MEET? JMP E1 YES LDB PBUFF BEGIN JMP SETPT,I EXECUTION * .23 DEC 23 .9 DEC 9 SKP ** *** ALLOT SPACE FOR INTERMEDIATE RESULT ** ** RSCHK NOP LDA TSTPT ALLOT ADA .2 STA TSTPT SPACE ADA M1 OVERFLOW INTO CPA LSTAK LOW-CORE STACK? RSS YES JMP RSCHK,I NO LDA LSTAK SAVE INA LOWER STA TEMP3 STACK BOUND ADA .9 UPDATE STA LSTAK STACK BOTTOM LDA LSTPT SET INA SOURCE STA TEMP2 ADDRESS ADA .9 UPDATE STA LSTPT STACK TOP INA SET DESTINATION STA TEMP4 ADDRESS CMA,INA OVERFLOW ADA HSTPT INTO SSA HIGH-CORE STACK? JMP E1 YES. ERROR 57. JSB MVTOH NO, MOVE JMP RSCHK,I LOW-CORE STACK SKP ** *** BUMP HIGH STACK POINTER ** ** BHSTP NOP CCB ADVANCE ADB HSTPT STB HSTPT POINTER CPB LSTPT OVERFLOW? JMP E1 YES JMP BHSTP,I NO ** *** VERIFY LEGITIMACY OF OPERAND ** ** OPCHK NOP LDB HSTPT,I OPERAND ADDRESS TO (B) SSB STRING OPERAND? JMP OPCH2 YES LDA 1,I HIGH PART OF CPA MNEG OPERAND 100000B? INB,RSS YES JMP OPCH1 NO; OK. LDA 1,I IS LOW PART OF OPERAND 376B? CPA B376 JSB ERROR YES. VALUE NOT DEFINED. (50) E8 ADB M1 OPCH1 CPB TSTPT TEMPORARY? JMP OPCH3 YES JMP OPCHK,I OPCH2 CMB,INB SET ADDRESS TRUE ISZ HSTPT UNSTACK OPERAND OPCH3 LDA TSTPT UNSTACK TEMP STACK ADA M2 STA TSTPT JMP OPCHK,I * B376 OCT 376 LBOP OCT 22000 M4 DEC -4 SKP * ž­þú* ************************** * * ** EVALUATE A FORMULA ** * * ************************** * FORMX NOP FORMULA BEGINS IN (TEMPS) CLB INITIALIZE OPERATOR JSB SLWST STACK FORM1 LDA TEMPS,I FETCH OPERAND ISZ TEMPS SET FOR NEXT WORD OF FORMULA AND OPDMK (100777) EXTRACT OPERAND STA TEMP5 AND SAVE IT SZA,RSS NULL OPERAND? JMP FORM2 YES JSB BHSTP SET STACK FOR OPERAND ADDRESS SSA FLAG BIT SET? JMP FORM4 YES JSB SSYMT FETCH OPERAND ADDRESS INB,SZB,RSS EXISTANT? JMP E8-1 NO. ERROR 50. AND .15 YES CPA .15 USER DEFINED FUNCTION? JMP FORM6 YES STB HSTPT,I NO LDB 1,I LOAD PTR TO VALUE SZA STRING VARIABLE? JMP FORM2 NO! LDA TEMPS,I YES AND OPMSK FOLLOWED BY CPA LBOP SUBSCRIPT? JMP FORM2-2 YES! STB TEMP8 NO! JSB RSCHK CREATE TEMPORARY CLA RECORD CCB DST TSTPT,I (0,-1) LDB TEMP8 RETRIEVE AND CMB,INB NEGATE STRING ADDRESS STB HSTPT,I STACK OPERAND ADDRESS FORM2 LDA TEMPS,I FETCH AND OPMSK OPERATOR ALF,ALF POSITION IT CPA .2 STRING CONSTANT? JMP FORM3 YES! FORM8 RAR LDB 0 LOAD ADDRESS OF ADB FOPBS OPERATOR'S INFORMATION WORD ADA M4 NON-FORMULA SSA OPERATOR? CLB YES ADA D31 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I LOAD INFORMATION WORD AND B777 SAVE STA TEM10 PRECEDENCE XOR 1,I RECOVER OPR NO. ARS STA TEMP5 IDENTIFICATION JMP FOR11 * * EVALUATION™hþú ROUTINES RETURN VALUE HERE. * FORM0 DST TSTPT,I STACK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS FOR11 LDA LSTPT,I DOES OPERATOR AND B377 ON TOP OF CMA OPERATOR STACK ADA TEM10 HAVE HIGHER SSA PRECEDENCE? JMP FORM9 YES, EXECUTE IT RSS * FOR10 ISZ LSTPT LDB TEM10 RETRIEVE PRECEDENCE ADB M15 NO, LEFT PARENTHESIS SSB OR LEFT BRACKET? ADB .15 NO, RESTORE PRECEDENCE ADB TEMP5 COMBINE IDENTIFICATION JMP FORM1-1 WITH PRECEDENCE AND STACK SKP * ***************************** * * * PROCESS STRING CONSTANT * * * ***************************** * * WHEN STRING CONSTANTS ARE STACKED, AN APPROPRIATE * ENTRY IS PLACED ON THE TEMPORARY STACK SO THAT ALL * STRING OPERANDS HAVE THE SAME FORM: A NEGATED BASE * ADDRESS ON THE OPERAND STACK AND A TWO WORD ENTRY ON * THE TEMPORARY STACK CONTAINING THE START-OF-STRING * AND END-OF-STRING DESIGNATORS BIASED BY -1 (DEFAULT * START-OF-STRING DESIGNATORS HAVE A STACK VALUE OF 0, * DEFAULT END-OF-STRING DESIGNATORS HAVE S STACK VALUE * OF -1). IN THE CASE OF SUBSCRIPTED STRING VARIABLES, * THE TEMPORARY IS CREATED WHEN THE ']' IS SCANNED THE * ENTRY FOR NON-SUBSCRIPTED STRING OPERANDS IS CREATED * WHEN THEY ARE SCANNED. * FORM3 CLA,INA PRINT STATEMENT CPA STRFG STRING CONSTANT? JSB STSTR NO,STACK STRING CONSTANT! JMP FORM8 EXECUTE END OF FORMULA * FORM4 CPA FLGBT CONSTANT? JMP FORM5 YES AND .15 NO CPA .15 PRE-DEFINED FUNCTION? JMP FORM7 YES LDB TEMP8 NO, MUST BE A JMP FORM2-1 PARAMETER * FORM5 LDB TEMPS LOAD CONSTANT ADDRESS ISZ TEMPS MOVE POINTER TO ISZ TEMPS NEXT CODE WORD 3þú JMP FORM2-1 * * HERE FOR USER-DEFINED FUNCTION (FNA, FNB, ETC.) * FORM6 STB TEMP5 SAVE SYMBOL TABLE POINTER LDB TSTPT SAVE CURRENT POINTER JSB SLWST TO TEMPORARY STACK LDB TEMP5,I JSB SLWST SAVE FUNCTION ADDRESS LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS LDA TEMPS SWITCH LDB LSTPT,I FORMULA POINTER STB TEMPS TO FUNCTION'S STA LSTPT,I FORMULA LDB TEMP8 SET LDA HSTPT,I PARAMETER POINTER ISZ LSTPT TO NEW PARAMETER, ISZ HSTPT SAVING PREVIOUS STB LSTPT,I SETTING ON STA TEMP8 LOW-CORE STACK CPA TSTPT PROTECT PARAMETER IF JSB RSCHK ON TEMPORARY STACK JSB FORMX EVALUATE FUNCTION LDA LSTPT,I RESTORE OLD STA TEMP8 PARAMETER POINTER LDA LSTPT CUT BACK ADA M3 LOW-CORE STA LSTPT STACK INA RESTORE ORIGINAL LDB 0,I TEMPORARY STACK STB TSTPT POINTER INA RESTORE LDB 0,I ORIGINAL STB TEMPS FORMULA POINTER JSB STTOP POP RESULT FOR12 DST TSTPT,I STORE HIGH WORD ISZ HSTPT LDB HSTPT,I RESTORE FORMX STB FORMX RETURN ADDRESS LDA TSTPT STACK ADDRESS STA HSTPT,I OF RESULT JMP FORM2 * * HERE FOR PREDEFINED FUNCTION (SIN, ETC.) * FORM7 LDA TEMP5 OPERAND IDENTIFIES FUNCTION CPA FRMSK FORTRAN FUNCTION? JMP FCALL YES! RRR 4 AND .31 FUNCTION OFFSET ALS MULT BY 2 FOR OFFSET IN BR TBL LDB 0 MOVE TO B FOR SLWST JSB SLWST STACK CALL NUMBER LDA FORMX SAVE CURRENT STA l<þúHSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS JSB ULWST POP FUNCT # OFF LOW STACK * CLA SET INST. FOLLOWING FUNCT. CALL STA SKIPE TO NOP LDA AFCNX COMPUTE THE ADDRESS JSB INDCK OF THE CORRECT ADB 0 ENTRY IN THE BRANCH TABLE DLD 1,I A = WORD THAT INDICATES STA SKIPE 'RSS' OR 'NOP' FOR ERROR STB FADRS B=ADDRESS OF FUNCTION LDA HSTPT,I IS THIS A SSA STRING VARIABLE? JMP FOR13 YES, MUST BE LEN FUNCTION! LDA FADRS .CHECK THE FUNCTION FOR AND MCMSK . MICRO CODE CPA B105K RSS .YES JMP EXSUB .NO LDB FADRS STB EXFUN .SET UP INSTRUCTION JSB STTOP GET THE ARGUMENT OF THE FUNCTION EXFUN JSB FADRS,I EXECUTE THE FUNCTION!!! SKIPE NOP MODIFIED TO AN 'RSS' IF ERROR RETURN JMP FOR12 FUNCTION EXECUTION COMPLETE JSB ERROR THERE WAS AN ERROR FNERR EQU * * EXSUB LDB FINST STB EXFUN JMP EXFUN-1 * * FADRS NOP FUNCTION ADDRESS GOES HERE FINST JSB FADRS,I MCMSK OCT 177000 B105K OCT 105000 * SPC 1 * LENGTH FUNCTION (LEN) SPC 1 FOR13 LDA HSTPT,I GET STRING LENGTH CMA,INA AND CONVERT ADA M1 TO FLT PT LDA 0,I AND B377 JSB FLOAT FLOAT STRING LENGTH JMP FOR12 * * * HERE TO EXECUTE AN OPERATOR (+, *, ETC.) * FORM9 LDA LSTPT,I EXECUTE OPERATOR; UNSTACK CCB OPERATOR ADB LSTPT INFORMATION STB LSTPT WORD ALF,ALF COMPUTE AND B177 SUBROUTINE SZA,RSS END FORMULA? JMP FORMX,I YES, EXIT ADA ARBAS GET ADDRESS JMP 0,I EXECUTE * .31 DEC 31 B177 OCT 177 FRMSK ðþúOCT 100757 * *************************** * * * FETCH TOP OF STACK * * * *************************** ** STTOP NOP JSB OPCHK VALIDATE JSB RSCHK OPERAND LDB HSTPT,I SAVE DLD 1,I LOAD JMP STTOP,I SKP ******************************* * * * STACK (B) ON LOW CORE STACK * * * ******************************* SLWST NOP ISZ LSTPT LDA LSTPT CPA HSTPT STACK OVERFLOW E1 JSB ERROR YES STB LSTPT,I JMP SLWST,I * ************************************ * * ** UNSTACK LOW CORE STACK ON (B) ** * * ************************************ * ULWST NOP LDB LSTPT,I POP CCA STACK ADA LSTPT STA LSTPT JMP ULWST,I * *************************** * * * STACK STRING CONSTANT * * * *************************** * STSTR NOP JSB BHSTP SET STACK FOR OPERAND LDA TEMPS STACK NEGATIVE CMA OF STRING STA HSTPT,I ADDRESSES LDA TEMPS,I COMPUTE AND B377 STRING CCB LENGTH ADB 0 -1 ADA .3 UPDATE ARS INTRA-STATEMENT ADA TEMPS POINTER STA TEMPS PAST STRING JSB RSCHK CREATE TEMPORARY CLA RECORD DST TSTPT,I (0,(B)) JMP STSTR,I SKP * **************************** * * * PREPARE STRING OPERAND * * * **************************** * * THE STRING ADDRESS ON TOP OF THE OPERAND STACK IS COMBINED * WITH THE SUBSCRIPTS IN A PSUEDO-ENTRY ON THE TEMPORARY STACK * TO FORM A STRING OPERAND. (A)=-2 UPON ENTRY FOR A SOURCE * STRINþúG (A)=-1 FOR A DESTINATION STRING. THE ADDRESS OF * THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMPS+5 * FOR SOURCE STRINGS (A)= TEMPS+5 UPON EXIT. THE SOURCE * STRING LENGTH IN CHARACTERS (1'S COMPLEMENT) IS IN (B) * UPON EXIT. THE FOLLOWING * CONDITIONS EXIT TO ERROR: NEGATIVE STRING LENGTH, REQUESTED * DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR * REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY * WITH TWO UNCONNECTED PARTS. THE LOGICAL LENGTH OF A * DESTINATION STRING IS ADJUSTED AS NEEDED. * PSTR NOP STA PS0 SAVE MODE FLAG JSB OPCHK UNSTACK OPERAND STB PS1 SET FLAG POSITIVE CLE,ELB SAVE ADDRESS OF FIRST STB TEMP5 CHARACTER OF STRING ERB SAVE ADB M1 POINTER TO STB TEMP6 STRING LENGTH LDB TSTPT LOAD ADB .2 START-OF-STRING LDA 1,I DESIGNATOR STA MPT SAVE IT ADA TEMP5 RECORD CHARACTER ADDRESS STA TEMP5 OF START-OF-STRING STA SBPTR SAVE ADDRESS INB LOAD LDA 1,I END-OF-STRING DESIGNATOR INA,SZA SPECIFIED? JMP PSTR2 YES CCA NO CPA PS0 'SOURCE' MODE? JMP PSTR1 NO LDA TEMP6,I YES LOAD STRING'S AND B377 LOGICAL LENGTH JMP PSTR2 * PSTR1 STA PS1 SET FLAG TO -1 LDA TPRME COMPUTE CMA END-OF-STRING ADA MPT DESIGNATOR PSTR2 STA NQT SAVE IT CMA IS LENGTH ADA MPT OF SPECIFIED STRING SSA,RSS NEGATIVE? JSB ERROR YES STER1 STA TNULL ADA B400 NO SSA >255 JMP STER3-1 STRING OVERFLOW LDA TEMP6,I DOES AND B377 START-OF-STRING CMA CHARACTER ISZ PS0 RELATE TO INA Ë·þú PREVIOUS ADA MPT VALUE SSA,RSS OF STRING JMP PSTR3 NO LDA TEMP6,I YES,EXTRACT ISZ PS0 END-OF- ALF,ALF PERMITTED-STRING AND B377 DESIGNATOR CMA COMPUTE DIFFERENCE FROM ADA NQT END OF SPECIFIED STRING -1 CLB,INB 'SOURCE' CPB PS0 MODE? JMP PSTR5 NO LDB TNULL YES,SPECIFIED SOURCE STRING INA CONTAINED WITHIN SSA,RSS DEFINED SOURCE STRING ADB 0 NO, CORRECT LENGTH JMP PSTR4 OF ACTUAL SOURCE STRING * PSTR3 ISZ PS0 'SOURCE' MODE? JSB ERROR NO, NON-CONTIGUOUS STRING STER2 CCB YES SET ACTUAL LENGTH TO 0 PSTR4 LDA TEMP5 LOAD START-OF-STRING JMP PSTR,I CHARACTER ADDRESS PSTR5 SSA,RSS PHYSICAL STORAGE OVERFLOW? JSB ERROR YES, STRING OVERFLOW STER3 ISZ PS1 END-OF-STRING SPECIFIED? JMP PSTR7 YES * PSTR6 LDA TEMP6,I NO AND M256 RESET IOR NQT LOGICAL LENGTH STA TEMP6,I OF STRING JMP PSTR,I * PSTR7 LDA TEMP6,I IS NEW AND B377 DESTINATION CMA STRING ADA NQT LONGER SSA,RSS THAN OLD? JMP PSTR6 YES JMP PSTR,I * PS0 BSS 1 MPT BSS 1 PS1 BSS 1 NQT BSS 1 B400 OCT 400 TRS0 BSS 1 *********************** * * * TRANSFER A STRING * * * *********************** * * THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S * COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO * A DESTINATION STRING BEGINNING WITH THE CHARACTER * ADDRESSED BY TEMP5. * TRSTR NOP STA TRFCH SAVE FETCH CHAR ROUTINE ADDR ISZ TNULL MORE TRANSFER STRING? RSS YES JMP TRSTR,I NO JSB TRFCH,I FETCH A SOURCE CHARACTER LDA B4úÖþú0 NONE LEFT,LOAD A BLANK STA TRS0 SAVE IT LDB TEMP5 LOAD CLE,ERB DESTINATION LDA 1,I WORD SEZ,RSS SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TRS0 COMBINE WITH SEZ,RSS NEW CHARACTER ALF,ALF AND STORE STA 1,I WORD ISZ TEMP5 INCREMENT DESTINATION ADDRESS JMP TRSTR+2 * **************************** * * * FETCH CHARACTER STRING * * * **************************** * * CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT * IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO * MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH * NEXT CHARACTER IN (A). * FSCH NOP LDA TPRME MORE CHARACTERS? INA,SZA,RSS JMP FSCH,I STA TPRME YES, UPDATE CHARACTER COUNT LDA TEMP8 LOAD CHARACTER CLE,ERA ADDRESS LDA 0,I EXTRACT SEZ,RSS NEXT CHARACTER ALF,ALF AND B377 ISZ TEMP8 UPDATE CHARACTER ADDRESS ISZ FSCH JMP FSCH,I * *************************** * * * FETCH INPUT CHARACTER * * * *************************** * * EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A). * IF THE CHARACTER IN (A) IS A QUOTE OR THE INPUT RECORD IS * EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER * THE SITUATION ). * FINCH NOP ISZ FINCH JSB GETCR FETCH NEXT CHARACTER JMP FINC1 END-OF-INPUT CPA B42 QUOTE? JMP TRSTR,I YES! JMP FINCH,I FINC1 LDA .10 SET END-OF-INPUT JMP TRSTR,I * ********************** * * * CHECK FOR ENOUGH * * * ********************** * OVCHK NOP NEW WORD REQUIREMNET IN (A) ADA PBPTR CHECK STA PBPTR }8þúCMA FOR ADA LWBM OVERFLOW SSA,RSS JMP E1 OUT OF STORAGE JMP OVCHK,I SKP * ****************************** * * * ROUND SUBSCRIPT TO INTEGER * * * ****************************** SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB .FAD SET FOR ROUNDING DEF HALF JSB IFIX CONVERT TO INTEGER SOC WAS IT INTEGER? JMP SBFIX,I NO ADA M1 YES, BIAS BY -1 SSA,RSS POSITIVE INTEGER? ISZ SBFIX YES JMP SBFIX,I NO ******************** * * * INPUT A CONSTANT * * * ******************** CONST NOP JSB GETCR JMP CONST,I CLB SET SIGN STB SIGN POSITIVE INB CPA .43 '+' ? JMP CONS1 YES CPA .45 NO, '-' ? CCB,RSS YES JMP CONS2 NO CONS1 STB SIGN RECORD SIGN JSB GETCR FETCH NEXT JMP E13-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND JSB ERROR BAD EXPONENT PART E14 ISZ CONST SUCCESSFULLY FOUND JMP CONST,I EXIT VIA (P+2) CONS3 CPB SIGN SIGN FOUND? ( (B) = 0) CCA,RSS NO JSB ERROR YES, SOLITARY SIGN E13 JMP CONST,I EXIT VIA (P+1) .43 DEC 43 .45 DEC 45 SKP ********************** * * ** COMPUTE RND(X) ** * * ********************** * * THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE * FORMULAS: * * X(N)=A*X(N-1)+C(MOD 2^30) (A=5^11,C=2^30*(1/2-1/SQR(12))) * RND =X/2^30 MIN (1-2^-23) * ERND NOP SSA,RSS POSITIVE ARGUMENT? JMP ERND1 YES, USE PREVIOUS VALUE RBL,CLE,ERB NO, MAKE A ELA STA RNDX1 A NEW SEED STB RNDX2 ERND1 EQU * LDA RNDX1 COMPUTE FIRST MPÍCþúY RNDA2 CROSS PRODUCT. STA RNDX1 SAVE (ONLY NEED LOW ORDER PART) LDA RNDX2 COMPUTE 2ND MPY RNDA1 CROSS PRODUCT. ADA RNDX1 ADD IN FIRST. ADA RNDC1 ADD IN HIGH PART OF C. STA RNDX1 SAVE TOTAL. (THIS IS HIGH PART). CLE LDA RNDX2 COMPUTE LOW ORDER PRODUCT. MPY RNDA2 ADA RNDC2 ADD IN LOW PART OF C. SEZ ADD ANY CARRY INTO INB B. RAL,CLE,ERA E_A(15),A(15)_0. STA RNDX2 SAVE LOW ORDER RESULT. ELB SHIFT HIGH ORDER PART & ADD IN ADB RNDX1 PREVIOUS TOTAL. ELB,CLE,ERB CLEAR BIT 15 AND STORE. STB RNDX1 RAL SHIFT A ADJACENT TO B. SWP EXCHANGE REGISTERS AND JSB .PACK PACK. NOP CPB .2 TEST FOR RESULT=1.0 RSS JMP ERND,I EXIT IF NOT. LDA INF SET RESULT TO 1-2^-23 LDB M256 JMP ERND,I RNDA1 DEC 1490 A DIV 2^15 RNDA2 DEC 3805 A MOD 2^15 RNDC1 OCT 16441 C DIV 2^15 RNDC2 OCT 7701 C MOD 2^15 RNDX1 BSS 1 RNDX2 BSS 1 M5 DEC -5 SKP ***** * ** OCT ** BASIC FUNCTION TO CONVERT INTEGER FOR * OCTAL OUTPUT. ACTUALLY CONVERTS INTEGER * TO FLOATING POINT QUANTITY WHICH WILL * PRINT OUT AS OCTAL VALUE * * CALLING SEQUENCE: * * DLD FLOATING EQUIVALENT OF INTEGER * JSB OCT * RETURN (FLOATING PT VALUE IN .A.8.B.) * ***** * OCT NOP JSB IFIX CONVERT TO INTEGER LDB M5 INITIALIZE STB CNTR DIGIT COUNTER LDB ATBL INITIALIZE POINTER STB TEMP3 TO DIGIT TABLE STA 1 MOVE INTEGER TO .B. RBL USE SIGN BIT CLA AS VALUE SLB FOR FIRST INA DIGIT IN STA TEMP3,I TABLE OCT01 BLF,RBR POSITION NEXT OCTAL DIGIT LDA 1 AND .7 AND ISOLATE .þúIT IN .A. ISZ TEMP3 BUMP POINTER TO TABLE STA TEMP3,I AND MAKE ENTRY ISZ CNTR BUMP COUNTER, MORE DIGITS? JMP OCT01 YES, GET THEM NOW * ** BUILD FLOATING POINT NUMBER * LDB M6 RESET STB CNTR DIGIT COUNTER LDB ATBL REINITIALIZE STB TEMP3 POINTER TO DIGIT TABLE CLA CLB DST VALUE INITIALIZE FLOATING PT VALUE OCT02 LDA TEMP3,I GET NEXT DIGIT ISZ TEMP3 BUMP TO NEXT ENTRY JSB FLOAT CONVERT TO FLOATING POINT JSB .FAD USE TO UPDATE VALUE DEF VALUE ISZ CNTR BUMP DIGIT COUNTER, DONE ? RSS JMP OCT,I YES, RETURN JSB .FMP NO, MULTIPLY BY 10, DEF FD10 DST VALUE UPDATE VALUE JMP OCT02 AND DO FOR NEXT DIGIT * ** STORAGE ** * VALUE BSS 2 CNTR BSS 1 ATBL DEF *+1 BSS 6 FD10 DEC 10. .7 DEC 7 * **************************** * * * READ ERROR CODE FUNCTION * * * **************************** * XERR NOP LDA ERRCD JSB FLOAT FLOAT CODE JMP XERR,I RETURN IN A-B REGISTERS * ***************************** * * * SET ERROR CODE SUBROUTINE * * * ***************************** * ERRCD NOP SERR NOP JSB IFIX CONVERT TO INTEGER STA ERRCD SAVE JMP SERR,I * ******************* * * * TIME FUNCTION * * * ******************* * TIM NOP JSB IFIX FIX INPUT PARAMETER STA TEMP3 AND SAVE JSB EXEC GET DEF *+4 TIME DEF .11 FROM DEF ATBL+1 THE DEF ATBL+6 SYSTEM LDA TEMP3 DETERMINE ADA .2 WHICH ADA ATBL TIME THE USER WANTS LDA 0,I GET IT JSB FLOAT AND FLOAT èõþúIT JMP TIM,I RETURN * .11 DEC 11 * SKP **************** * * * SGN FUNCTION * * * **************** * ESGN NOP CLB SZA,RSS ZERO? JMP ESGN,I YES! SSA,RSS NO, POSITIVE? LDB .2 YES, SET EXPONENT LDA FLGBT LOAD MANTISSA SZB POSITIVE? RAR YES, CORRECT MANTISSA JMP ESGN,I * * ******************************************** * * ** EXECUTE SWITCH REGISTER TEST FUNCTION ** * * ******************************************** ESWR NOP JSB .IENT CONVERT TO 16 BIT INTEGER JMP FNERR-1 TOO BIG LDB 0 AND .15 CPA 1 NUMBER OUTSIDE RANGE 0-15? RSS NO JMP FNERR-1 YES LIA 1 READ SWITCH REGISTER SZB,RSS IS THIS THE SWITCH? JMP ESWR1 YES RAR MOVE TO NEXT SWITCH ADB M1 JMP *-4 * ESWR1 AND .1 ISOLATE THAT BIT JSB FLOAT CONVERT TO FLOATING POINT JMP ESWR,I RETURN * * SKP * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA ERBS ERROR ADDRESS IN (A) LDB ERROR ERROR SOURCE IN (B) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .45 ACCOUNT FOR SHORTENED TABLE STA TEMP3 SAVE IT LDA .3 JMP SEG8 PRINT ERROR MESSAGE, AFTER CLEANING HOUSE * * * ******************************************** * * * COMPUTE DATA TYPE * * * **************************épþú****************** * UPON ENTRY (A) AND (B) MUST HAVE A F.P. 0 TO REFERENCE * THE DATA STATEMENT. RETURNS 1,2,3 IF THE DATA ITEM IS * A NUMBER,STRING,END-OF-FILE RESPECTIVILY. * ETYP NOP .DUMMY ENTRY POINT ALLOWS USE SZA,RSS .DATA STATEMENT REFERENCE ? JMP ETYP3 .YES - ONLY ONE ALLOWED IN M BASIC JSB ERROR . OF MURTB BRTBL FNER1 EQU * * ETYP1 JSB FLOAT .PUT RESULT INTO FLOATING PT JMP ETYP,I .AND EXIT ETYP2 LDB NXTDT .OUT OF DATA ? LDA DATA JSB STSRH JMP ETYP5 .YES JSB SETDP .NO , SET DATA POINTERS ETYP3 CCA .MORE DATA IN CURRENT STATEMENT? CPA DCCNT JMP ETYP2 .NO LDB NXTDT,I .YES LOAD TYPE WORD CLA,INA .SET NUMBER SSB,RSS .IS IT A NUMBER? LDA .2 .NO SET TO STRING JMP ETYP1 ETYP5 LDA .3 JMP ETYP1 SKP *************** * * * ERROR TABLE * * * *************** ERBS DEF * ERR DEF E1+1 OUT OF STORAGE DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN WITH NO PRIOR GOSUB DEF E4 OUT OF DATA DEF E5 WRONG DATA TYPE DEF E6 SUBSCRIPT OUT OF BOUNDS DEF E7 STATEMENT REFERENCED NOT DATA DEF E8 UNDEFINED VALUE ACCESSED DEF E13 BAD DATA ITEM DEF E14 BAD EXPONENT DEF E15 .SUB. OR FUNCTION PARAMETER ERROR DEF TERR1 TRAP TABLE FULL DEF TERR2 BAD TRAP/SEQ # COMBINATION DEF TERR3 SCHEDULED BUT DELETED TASK DEF TERR4 TRAP TABLE BUSY DEF STER1 NEGATIVE STRING LENGTH DEF STER2 NON-CONTIGUOUS STRING DEF STER3 STRING OVERFLOW DEF XEC5 UNDEFINED STATEMENT REFERENCE DEF BASER NEGATIVE NUMBER TO REAL POWER DEF POWER ZERO TO ZERO POWER DEF ZRTNG ZERO TO NEGATIVE POWER DEF FNERR OUT OF RANž.><8GE IN FUNCTION DEF LOGER LOG OF NEG ARGUMENT DEF EXPER EXP OF NEG ARGUMENT DEF FNER1 .ILLEGAL FUNCTION SKP NFMT EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 EFMT EQU TEMPS+12 RFLAG EQU TEMPS+13 HTEMP EQU TEMPS+14 NUMO1 EQU TEMPS+15 UTEMP EQU TEMPS+16 TWO WORD ARRAY TRFCH EQU TEMPS+18 ADDRESS OF FETCH CHAR ROUTINE FERR EQU TEMPS+19 FILE ERROR FLAG FILE# EQU TEMPS+20 FILE REFERENCE NUMBER RCRD# EQU TEMPS+21 RECORD REFERENCE NUMBER EORFL EQU TEMPS+22 END-OF-RECORD FLAG DADDR EQU TEMPS+23 FILE LOCATION PTR FILT EQU TEMPS+24 FILE REQUEST TYPE RQ2 EQU TEMPS+25 TABFG EQU TEMPS+26 * END î>ÿÿ ÿýR9Œ ÿ92065-18006 1726 S C0122 &MBC50 RTE-M BASIC COMMAND SUBR             H0101 +þúASMB,R HED <> 92065-16001 NAM BASC5,7 92065-16001 REV.1726 770512 * * DATE REVISED 5-12-77 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * * SOURCE: 92065-18006 * * * ************************************************************* * * ENT BASC5 EXT GETNM,CHRCK,LIMEM,MVNAM EXT TRAP,PRMT,INTCK,FNDPS,EXEC EXT RUN,PLIST,LOADT,DIGCK,LETCK EXT FINDV,WRITE,INDCK,OUTER,GETCR COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #5: EXECUTE THE COMMAND * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER A STATEMENT IS FOUND THAT DOES NOT START WITH A STATE- * MENT NUMBER.THE STATEMENT IS THEN CHECKED TO SEE IF IT IS * A LEGAL COMMAND WITH PROPER SYNTAX. IF SO THE CORRECT COMMAND * ROUTINE IS EXECUTED AND CONTROL RETURNED TO * MAIN CONTROL, ELSE AN ERROR MESSAGE IS PRINTED. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTR òþúS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVE-RESTORE FLAG SAVFL EQU PNTRS+40 .SAVE COMMAND FLAG PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 22 TEMPORARIES SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .1 DEC 1 .2 DEC 2 .6 DEC 6 .7 DEC 7 .8 DEC 8 .10 DEC 10 .9999 DEC 9999 B13 OCT 13 B14 OCT 14 B105 OCT 105 MAXSN DEC +10000 TEMAD DEF TEMP8 BIT BUCKET LENGC EQU LUOUPÞþúT-FWAM LENCM ABS LENGC A EQU 0 B EQU 1 SKP * CMDCT DEC -11 -NUMBER OF COMMANDS * CMDS EQU * * * * COMMAND MNEMONICS START HERE * OCT 3 ASC 2,RUN EXECUTE PROGRAM * OCT 3 ASC 2,DEL DELETE PROGRAM * OCT 4 ASC 2,SAVE SAVE PROGRAM * OCT 4 ASC 2,LIST LIST PROGRAM * OCT 4 ASC 2,LOAD LOAD PROGRAM * OCT 3 ASC 2,BYE TERMINATE BASIC * * OCT 5 ASC 3,MERGE MERGE PROGRAM * * DEC 6 ASC 3,REWIND REWIND TAPE * DEC 4 ASC 2,WEOF WRITE END-OF-FILE * DEC 5 ASC 3,SKIPF SKIP FILE FORWARD * DEC 5 ASC 3,BACKF SKIP FILE REVERSE * * ********************************************************************** * * * THE FOLLOWING TABLE DEFINES ENTRY POINTS FOR EXECUTION * OF COMMANDS. * ********************************************************************** * * * * CMDEX DEF *+1 DEF $RUN EXECUTE PROGRAM DEF $DEL DELETE DEF $SAVE SAVE DEF $LIST LIST DEF $LOAD LOAD DEF $BYE TERMINATE BASIC DEF $MERG MERGE PROGRAM DEF $REW REWIND TAPE DEF $WEOF WRITE END-OF-FILE DEF $SKIP SKIP FILE FORWARD DEF $BACK SKIP FILE REVERSE SKP *************************** * * * CHECK FOR LEGAL COMMAND * * * *************************** * BASC5 NOP LDA .32 SETUP STA BLANK TO SKIP BLANKS STA SAVFL .RESET SAVE FLAG * * LDA SBPTR,I GET FIRST LETTER CPA DLMTR PRINT NEXT LINE COMMAND? JMP PNEXT YES, DO IT TO IT LDB CMDCT SEARCH FOR LEGAL COMMAND JSB TBSRH DEF CMDS JMP CERR1-1 .CAN'T FIND IT - ERROR ADA CMDCT DETERMINE ORDINAL # IN B&M TABLE CMA,INA ù4þú ADA COUNT ADA CMDEX INCREMENT TO ENTRY PT ADDRESS LDA 0,I GET ADDRESS OF COMMAND JSB INDCK MAKE DIRECT JMP 0,I EXECUTE THE COMMAND * JMP PRMT GO TO 'READY' * * * SKP * HERE FOR: DEL [] * $DEL JSB GETCR FETCH NEXT CHARACTER JMP DEL1 EOF! CPA B105 'E'? JMP DEL2 YES, MAYBE 'DELETE'? JSB PGOLM NO, FETCH LINE #'S NOP EOF DETECTED? LDA LOLIM GET PROGRAM'S LDB HILIM LIMITS AND STA TEMP4 SAVE DESTINATION ADDRESS CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP PRMT DEL1 JSB SCR DELETE PROGRAM JMP PRMT RETURN * DEL2 CCB SEARCH FOR JSB TBSRH 'ETE' DEF ETE JMP CERR1-1 NOT FOUND JMP $DEL OK! * ETE OCT 3 ASC 2,ETE * SKP * * HERE FOR: RUN [] FROM * $RUN JSB GETCR FETCH NEXT CHAR JMP RUN EOF! JSB LIMCK LIMITS LEGAL LDB LOLIM SET UP STB LORUN RUN LDB HILIM LIMITS STB HIRUN FOR EXECUTION LDB .1 RESTORE STB LOLIM LIMITS LDB .9999 SO ALL STB HILIM OF PROG GETS LOADED CPA .10 LOAD PROGRAM? JMP RUN NO! LDB .5 .ASSUME "RUN FROM" COMMAND STB PFLAG JSB FROMS CHECK "FROM" SYNTAX JSB SCR DELETE CURRENT PROGRAM JMP LOADT NO! * .5 DEC 5 * SKP * * HERE FOR: SAVE,CHANGE OR LIST [] ON * * LISTF=0 FOR L4¹þúIST COMMAND AND # 0 FOR SAVE * $LIST CLA SET DEFAULT TO JMP $SAVE+1 LIST FLAG FOR TYPE 0 FILE SPC 1 $SAVE CCA SET DEFAULT TO STA PFLAG PUNCH DEVICE STA SAVFL .SET SAVE COMMAND FLAG CLA RESET SAVE1 STA TEMP6 PURGE FLAG LDA PBUFF INITIALIZE STA LOLIM LIMITS LDA PBPTR TO INCLUDE STA HILIM ALL OF PROGRAM JSB GETCR FETCH NEXT NON-BLANK CHAR JMP PLIST EOF! JSB PGOLM GET PROGRAM LIMITS JMP PLIST EOF DETECTED, ASSUME DEFAULT JSB ONS MORE, CHECK "ON" SYNTAX JMP PLIST * SKP * * HERE FOR: >/ LIST NEXT LINE * PNEXT JSB GETCR GET FIRST CHAR JMP PNEX2 EOF, NO STMT # JSB DIGCK NUMBER? JSB ERROR INVALID NUMBER CER14 ADA .48 JSB INTIN FETCH NUMBER DEF MAXSN SZB,RSS ZERO? JMP CER14-1 YES, BAD! LDA 1 JMP PNEX3 * PNEX2 LDA .LNUM GET CURRENT LINE # CPA .9999 LAST STATEMENT OF PROG? PNEX1 CLA YES! INA NO, GET PNEX3 JSB FNDPS AND DETERMINE WHAT JMP PNEX1 THE NEXT ONE NOP IF ANY LDA 1,I THEN STA .LNUM SET UP STB LOLIM LIMITS INA JSB FNDPS FIND NOP POSITION NOP OF NEXT STB HILIM STATEMENT JMP PLIST ONE LINE ONLY * SPC 3 * HERE FOR: BYE * * $BYE LDA .2 OPEN JSB TRAP UP NOP TRAP TABLE JSB LIMEM .RELEASE MEMORY DEF *+4 DEF M32 DEF * DEF * JSB EXEC TERMINATE BASIC PROGRAM DEF *+2 DEF .6 * * SKP * * * HERE FOR: LOAD OR MERGE [] FROM * $MERG CCA SET FLAG SO 'ACTST' 35þúDOESN'T OVERLAY STMTS STA MERGF IN SYNTAX SEGMENT * $LOAD STA PFLAG SET FOR DEFAULT INPUT JSB GETCR GET NEXT CHAR JMP LTAPE LOAD FROM DEFAULT DEVICE JSB LIMCK FETCH PROG LIMITS CPA .10 EOF ? RSS .YES USE DEFAULT DEVICE LDB .2 .ASSUME SPEC LU# LOAD/MERGE STB PFLAG JSB FROMS CHECK "FROM"SYNTAX LTAPE LDA MERGF IS THIS A SZA,RSS 'MERGE'? JSB SCR NO, DELETE PROGRAM! JMP LOADT NO, LOAD AND CHECK SYNTAX * * * JSB ERROR NONE FOUND * CERR1 NOP * HERE FOR: REWIND * $REW LDA .4 SET CONTROL JMP FCNT REWIND SPC 1 $WEOF LDA .1 SET CONTROL JMP FCNT WRITE EOF SPC 1 $SKIP LDA B13 SET CONTROL JMP FCNT FOR SKIP FILE FORWARD SPC 1 $BACK LDA B14 SET CONTROL FOR BACK SPACE FILE FCNT CLB RRL 6 SET UP STA ICODE CONTROL WORD * JSB GETCR GET FIRST CHAR JMP CERR1-1 NO NAME FOUND JSB INTIN .INPUT LU # AND CHECK OCT 1653 . FOR MAXIMUM LU LDA B * IOR ICODE .INSERT LU# RETURNED IN A STA ICODE JSB EXEC .PERFORM REWIND DEF *+3 DEF .3 DEF ICODE .CONTROL WORD FOR CONTROL JMP PRMT .RETURN TO PROMPT * ICODE BSS 1 .3 DEC 3 .4 DEC 4 SKP * ******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I JSB INDCK PEEL OFF INDIRECTS ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT fþúBUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' UþúEXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND MSK0 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT * M32 DEC -32 OPMSK OCT 77000 MSK0 OCT 377 SKP * ****************************************************** * * FIND REQUESTED PROGRAM CORE LIMITS * * CALL SEQ: (A)=NEXT CHAR * JSB PGOLM * RETURN: P+1: EOF DETECTED * P+2: MORE INPUT TO COME * (A)=NEXT CHAR * LOLIM=LOW CORE LIMIT * HILIM=HI CORE LIMIT * ***************************************************** * PGOLM NOP JSB LIMCK FETCH PROGRAM LIMITS STA TEMP5 SAVE NEXT CHAR LDA LOLIM JSB FNDPS FIND POSITION NOP OF 1ST STATEMENT NOP STB LOLIM SAVE IT LDA HILIM INA JSB FNDPS FIND POSITION NOP OF LAST STATEMENT NOP STB HILIM SAVE IT LDA TEMP5 RETRIEVE NEXT CHAR CPA .10 EOF ?? JMP PGOLM,I YES, TAKE P+1 RETURN ISZ PGOLM JMP PGOLM,I NO, TAKE P+2 EXIT * * SKP ******************************************************** * * FETCH PROGRAM LIMITS FROM INPUT BUFFER * ACCORDING TO THE FOLLOWING SYNTAX: * ...... * ...... * ...... * CALL SEQ: (A)=NEXT CHAR * JSB LIMCK * RETURN: (A)=NEXT CHAR * LOLIM = LO LIMIT ; HILIM = HIGH LIMIT * ******************************************************** * LIMCK NOP CLB,INB SET UP STB LOLIM DEFAULT LIMITS LDB .9999 1-9999 STB HILIM LDB M2 STB TEMP4 RSS LIM3 JSB GETCR FETCH NEXT CHAR Pþú NOP LIM1 JSB DELM DELIMITER ? JMP LIM3 YES, IGNORE CPA .43 PLUS? JMP LIM3 YES! CPA .45 MINUS? JMP CERR2-1 YES, VERY BAD JSB DIGCK DIGIT ? JMP LIMCK,I NO,EXIT ADA .48 YES, JSB INTIN FETCH # DEF MAXSN & SZB,RSS ZERO? JMP CERR2-1 YES, BAD STB HILIM SAVE IT ISZ TEMP4 DONE ? RSS JMP LIM2 STB LOLIM NO, CONTINUE JMP LIM1 LIM2 INB INSURE CMB,INB LOLIM<=HILIM ADB LOLIM SSB,RSS JSB ERROR INVALID LIMITS CERR2 LDB .32 OK, SET UP FOR STB BLANK FREE FORMAT INPUT RSS FETCH NEXT JSB GETCR NON-DELIMITER NOP JSB DELM CHARACTER JMP *-3 (A)=NEXT CHAR JMP LIMCK,I & RETURN * .43 DEC 43 .45 DEC 45 .48 DEC 48 .32 DEC 32 M2 DEC -2 * **************************************************** * * DELM WILL TEST FOR A DELIMITER * **************************************************** * DELM NOP CPA .32 BLANK? JMP DELM,I YES, P+1 RETURN CPA B54 COMMA? JMP DELM,I YES ISZ DELM NEITHER TAKE JMP DELM,I P+2 RETURN * B54 OCT 54 * * * ***************************************************** * * INTIN WILL BUILD AN INTEGER FROM INPUT * * CALL SEQ: (A)=CURRENT CHAR * JSB INTIN * DEF (MAX #) * RETURN: (B)=INTEGER * ***************************************************** * INTIN NOP STA TEMP5 SAVE CUR. CHAR. LDA INTIN,I FETCH JSB INDCK MAXIMUM LDA A,I CMA,INA STA INTI1 ALLOWABLE ISZ INTIN LIMIT LDA SBPTR SAVE STA TEMP1 SBPTR LDA TEMAD STATUS STA SBPTR LDA TEMP5 Íþú RECOVER CUR.CHAR. JSB INTCK FETCH INTEGER DEF INTI1 JMP CERR8-1 STA TEMP5 LDA TEMP1 RESTORE STA SBPTR SBPTR STATUS LDA TEMP5 JMP INTIN,I * INTI1 NOP SKP **************************************************** * * SET FROM / TO FLAG * * ***************************************************** * FROMS NOP LDB .2 STB FRMTO .SET FROM FLAG CCB JSB TBSRH DEF FROM JMP CERR1-1 .NOT FOUND SYNTAX ERROR * JSB GETCR JMP CERR8-1 JSB FILCK .CHECK FOR FILE NAME OK JMP FROMS,I .YES GO BACK JSB INTIN .BUILD LU # OCT 1653 .LUMAX SZA,RSS JMP CERR8-1 .NOT VALID LU STB LUINP JMP FROMS,I .EXIT- SUCCESSFUL * JSB ERROR .INVALID LU # CERR8 EQU * * FROM OCT 4 ASC 2,FROM ON OCT 2 ASC 1,ON * * ONS NOP CLB,INB STB FRMTO .SET FROM/TO FLAG CCB .LOOK FOR "ON" JSB TBSRH DEF ON JMP CERR1-1 .NOT FOUND SYNTAX ERROR JSB GETCR .FETCH NEXT CHARACTER JMP CERR8-1 .ERROR IF NO LU# SPECIFIED JSB FILCK .CHECK FOR FILE NAME OK JMP ONS,I .YES GO BACK JSB INTIN .BUILD LU # OCT 1653 SZA,RSS JMP CERR8-1 .NOT VALID LU STB LUOUT LDB .2 .SET PFLAG TO LU INPUT STB PFLAG JMP ONS,I .EXIT WITH LU * SKP D53 OCT -53 FILCK NOP JSB LETCK CHECK FOR ALPHA RSS .NOT ALPHA - CHECK SPEC CHAR JMP FILE .GO PROCESS FILES LDB A ADB D53 .ALLOW !#$%&'()* SSB,RSS . AS FIRST CHAR JMP NFILE .NO FILE NAME ADB .10 SSB,RSS JMP FILE .YES LIGIT NFILE CLB .NO FILE RESET FLAG STB FLFIL ISZ FILCK .EXIT NO FILE JMP FILCK,I * FILE JSB MVì{þúNAM .CHECK FOR FILE HANDLER JMP NFILE .NO HAND CCB STB FLFIL .SET FILE FLAG JMP FILCK,I SKP **************************************************** * * SCRATCH SUBROUTINE * * CALL SEQ: JSB SCR * RETURN: P+1: NORMAL * *************************************************** * SCR NOP LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER STA .LNUM TO 0 INITIALLY JMP SCR,I * ************ * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP CLA RESET STA PFLAG FILE FLAG STA .LNUM AND DO NOT PRINT LINE # FLAG LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .71 ACCOUNT FOR LENGTH OF TABLE STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE * .71 DEC 71 ERBS DEF ERR-1 SKP *************** * * * ERROR TABLE * * * *************** ERR DEF CERR1 NOT A VALID COMMAND DEF CERR2 INVALID LIMITS DEF CERR8 INVALID LU DEF CER14 INVALID STATEMENT NUMBER * TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 COUNT EQU TEMPT+1 JREC EQU TEMPT+2 FRMTO EQU TEMPT+3 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU S3HFBTEMPT+9 FERR EQU TEMPT+10 TYP EQU TEMPT+11 NAME EQU TEMPT+12 ARRAY OF 5 WORDS SC EQU TEMPT+15 LU EQU TEMPT+16 NNAME EQU TEMPT+17 ARRAY OF 3 WORDS * END Ð Hÿÿ ÿýSd ÿ92065-18007 1650 S C0122 &MBC80 RTE-M SLOW STATEMENT SUBR             H0101 3sþúASMB,R HED <> 92065-16001 NAM BASC8,7 92065-16001 REV.1650 761022 * * REVISED 3-31-76 * * SOURCE 92065-18007 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. 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. * ************************************************************** ENT BASC8,ERROR EXT IFBRK,TRAP,RDYPT,OUTER,OUTLN,OUTIN,WRITE,FINDV EXT IFIX,PRNIN,REED,SERR,FLOAT,.ENTR COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #8: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE EXECUTE PHASE OF * BASIC TO PERFORM CERTAIN FUNCTION WHICH ARE NOT TIME CRITICAL. * CONTROL IS PASSED TO THIS SEGMENT WITH THE VARIABLE 'XSEG7' IN- * DICATING WHICH FUNCTION IS TO BE PERFORMED. AFTER COMPLETION OF * THE FUNCTION, CONTROL IS RETURNED TO EXECUTE SEGMENT 4 AND * EXECUTION OF THE USER'S PROGRAM IS RESUMED. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 )°þúCURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP HSTPT BSS 1 HIGH-STACK POINTER PRADD BSS 1 PROGRAM EXECUTION TEMPT BSS 7 SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .2 DEC 2 B200 OCT 200 B377 OCT 377 HIMSK OCT 177400 M2 DEC -2 M10 DEC -10 M16 DEC -16 M20 DEC -20 M32 DEC -32 PMESS DEF *+1 OCT 6412 ASC 4,PAUSE _ : QMARK DEF *+1 ASC 1,?? AMESS DEF &þú*+1 OCT 6412 ASC 15,OPERATOR TERMINATION IN LINE _ : GO ASC 1,GO CTRLQ OCT 10400 SKP * ********************************* * * * OVERFLOW STMT ADDRESS TABLE * * * ********************************* * XECTB DEF * STATEMENT ADDRESS TABLE NOP .PLACE HOLDER DEF EPAZ 2-PAUSE STMT DEF EEND 3-STOP END STMT DEF OPEND 4-END STMT * SKP **************************************** * * * EXECUTE THE OVERFLOW STMT FROM SEG 4 * * * **************************************** * BASC8 NOP LDA SLSTM EXECUTE ADA XECTB REQUEST LDA 0,I FROM SEGMENT 4 JMP 0,I * SPC 3 ********************* * * ** EXECUTE PAUSE ** * * ********************* * EPAZ LDA M10 WRITE LDB PMESS 'PAUSE' JSB WRITE MESSAGE JSB PRNIN INITIALIZE FOR NUMBER ISZ TEMPS LDB TEMPS ANY CPB PRADD PARAMETER? JMP EPAZ1 NO! ISZ TEMPS DLD TEMPS,I GET PARAMETER JSB IFIX INTEGERIZE EPAZ2 JSB OUTIN PRINT NUMBER JSB OUTLN EPAZ3 LDA M2 READ LDB .INBF INPUT JSB REED 'GO' LDA .INBF,I CPA GO 'GO'? JMP BASC8,I .RETURN AND HIMSK CPA CTRLQ ABORT PROGRAM? JMP OPND1 YES, BUT DO NOT PUSH AND SHOVE LDA M2 NO, SO LDB QMARK OUTPUT JSB WRITE DOUBLE '??' JMP EPAZ3 EPAZ1 CLA ZERO JMP EPAZ2 PAUSE SKP ************************ * * ** EXECUTE END/STOP ** * * ************************ * * OPEND JSB IFBRK CLEAR ATTENTION DEF *+1 BIT OPND1 LDA ERTTY C}þú SET UP STA LUOUT ERROR LU LDB AMESS PRINT LDA M32 MESSAGE JSB WRITE INDICATING JSB PRNIN OPERATOR LDA .LNUM TERMINATION JSB OUTIN OF JSB OUTLN PROGRAM EEND EQU * OUTPUT LDB FCORE SET UP POINTER ADB M20 TO OUTPUT ANY STB TEMP4 PARTIAL LINES LULOP LDA TEMP4,I IN THE LU TABLE SZA,RSS IS THIS SLOT ASSIGNED ? JMP LUNXT NO, TRY THE NEXT ONE ALF,ALF YES, ISOLATE THE LU AND B377 IOR B200 STA LUOUT SAVE THE LU WORD JSB FINDV AND DISCOVER THE EQUIPMENT TYPE STA 1 ADA M16 IS THIS DEVICE TYPE SSA,RSS < 20(8) ? JMP LUNXT NO, TRY THE NEXT STA FLTYP YES, SET FOR NON-FILE WRITE CLA SET UP A NULL LDB PMESS WRITE OPERATION JSB WRITE ON THIS LU LUNXT ISZ TEMP4 POINT TO THE NEXT LU WORD LDA TEMP4 AND CHECK IF CPA FCORE WE ARE DONE RSS YES JMP LULOP NO, GO BACK FOR ANOTHER * CLA CLEAR STA SLSTM SEG 8 FLAG LDA .2 CLEAR JSB TRAP TRAP TABLE NOP LDA TEMP3 WAS THIS AN SZA ERROR EXIT ? JMP OUTER YES ! STA .LNUM RESET POINTER TO START OF PROGRAM JMP RDYPT NO, GO TO READY * * SKP ************************************ * * * ERROR MESSAGE PROCESSOR FOR * TRAP AND SCHED MODULES * * * ************************************ * B2000 OCT 2000 IERR DEF * ERMSG DEF * ERROR NOP JSB .ENTR .FETCH ERROR # AND MESSAGE DEF IERR LDA IERR,I .FETCH ERROR NUMBER JSB FLOAT .MAKE REAL FOR SERR INȨPUT JSB SERR .POST ERROR NUMBER IN ERRCD * LDA ERTTY .SET HONESTY MODE IN OUTPUT IOR B2000 . CRT STA LUOUT LDA ERRL .PRINT "ERROR" LDB ERRM JSB WRITE LDA ERMSG,I .FETCH MESSAGE LENGTH ISZ ERMSG LDB ERMSG .FETCH MESSAGE ADDRESS JSB WRITE . AND OUTPUT LDA M2 LDB DSHM .PRINT " -" JSB WRITE JSB PRNIN . RESET OUTPUT BUFFER LDA IERR,I .FETCH ERROR CODE JSB OUTIN .CONVERT TO ASCII JSB OUTLN . OUTPUT LDA LINEL .OUTPUT "IN LINE " LDB LINEM JSB WRITE LDA ERTTY .SET ERROR CRT TO NORMAL MODE STA LUOUT JSB PRNIN .CONVERT LINE # TO ASCII LDA .LNUM JSB OUTIN .AND PRINT JSB OUTLN JMP ERROR,I .EXIT * ERRL DEC -6 ERRM DEF *+1 ASC 3,ERROR DSHM DEF *+1 ASC 1, - LINEL DEC -8 LINEM DEF *+1 ASC 4,IN LINE * TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 END °×ÿÿ ÿýT ^ ÿ92065-18008 2001 S C0122 &MESGA BASIC ERROR MESSSAGE T             H0101 /þþúASMB,R HED <> 92065-16002 NAM MESGA,7 92065-16002 REV. 2001 791019 * ENT MESGA * DATE 5-12-77 * * SOURCE 92065-18008 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR SYNTAX (SEG1) PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERROR STANDARD ERRORS MESSG DEC 17 ASC 9,ILLEGAL EXPONENT_ : DEC 23 ASC 12,NOT A FORTRAN FUNCTION_ : DEC 28 ASC 14,MISSING ASSIGNMENT OPERATOR_ : DEC 22 ASC 11,NOT A SUBROUTINE CALL_ : DEC 29 ASC 15,MISSING OR BAD FUNCTION NAME_ : DEC 31 ASC 16,MISSING OR BAD SIMPLE VARIABLE_ : DEC 27 ASC 14,MISSING OR BAD TRAP NUMBER_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'THEN'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'OF'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'TO'_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'STEP'_ : DEC 30 ASC 15,MISSING OR ILLEGAL SUBROUTINE_ : DEC 27 ASC 14,WRONG NUMBER OF PARAMETERS_ : DEC 29 ASC 15,MISSING OR ILLEGAL DATA ITEM_ : DEC 31 ASC 16,ILLEGAL READ OR INPUT VARIABLE_ : DEC 17 ASC 9,NO CLOSING QUOTE_ poþú : DEC 30 ASC 15,MISSING OR BAD LIST DELIMITER_ : DEC 18 ASC 9,ILLEGAL PARAMETER_ : DEC 24 ASC 12,ILLEGAL STRING VARIABLE_ : DEC 21 ASC 11,PARAMETER NOT STRING_ : DEC 29 ASC 15,MISSING OR ILLEGAL SUBSCRIPT_ : DEC 30 ASC 15,STRING OR DIM LARGER THAN 255_ DEC 35 ASC 18,ILLEGAL STRING RELATIONAL OPERATOR_ : DEC 21 ASC 11,STRING NOT PERMITTED_ : DEC 25 ASC 13,MISSING LEFT PARENTHESIS_ : DEC 26 ASC 13,MISSING RIGHT PARENTHESIS_ : DEC 23 ASC 12,UNDECIPHERABLE OPERAND_ : DEC 30 ASC 15,MISSING OR BAD ARRAY VARIABLE_ : DEC 27 ASC 14,ILLEGAL OR MISSING INTEGER_ : DEC 20 ASC 10,SIGN WITHOUT NUMBER_ : DEC 31 ASC 16,CHARACTERS AFTER STATEMENT END_ : DEC 15 ASC 8,OUT OF STORAGE_ : DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 28 ASC 14,NO LU NUMBER REFERENCE FOUND SPC 1 * ERROR MESSAGES FOR PRE-EXECUTION (SEG3) PHASE SPC 1 DEC 27 ASC 14,COM STATEMENT OUT OF ORDER_ : DEC 23 ASC 12,FUNCTION DEFINED TWICE_ : DEC 14 ASC 7,UNMATCHED FOR_ : DEC 26 ASC 13,NEXT WITHOUT MATCHING FOR_ : DEC 26 ASC 13,DIMENSIONS NOT COMPATIBLE_ : DEC 25 ASC 13,LAST STATEMENT NOT 'END'_ : DEC 27 ASC 14,VARIABLE DIMENSIONED TWICE_ : DEC 28 ASC 14,ARRAY OF UNKNOWN DIMENSIONS_ : Ø þú DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 15 ASC 8,OUT OF STORAGE_ : DEC 22 ASC 11,SYMBOL TABLE OVERFLOW_ : SPC 1 * ERROR MESSAGES FOR EXECUTE (SEG4) PHASE SPC 1 DEC 15 ASC 8,OUT OF STORAGE_ : DEC 22 ASC 11,GOSUBS NESTED 20 DEEP_ : DEC 27 ASC 14,RETURN WITH NO PRIOR GOSUB_ : DEC 12 ASC 6,OUT OF DATA_ : DEC 16 ASC 8,WRONG DATA TYPE_ : DEC 24 ASC 12,SUBSCRIPT OUT OF BOUNDS_ : DEC 30 ASC 15,REFERENCED STATEMENT NOT DATA_ : DEC 29 ASC 15,UNDEFINED STATEMENT ACCESSED_ : DEC 9 ASC 5,BAD DATA_ : DEC 13 ASC 7,BAD EXPONENT_ : DEC 37 ASC 19,SUB. OR FUNCT. TERMINATED ABNORMALLY_ : DEC 16 ASC 8,TRAP TABLE FULL_ : DEC 24 ASC 12,ILLEGAL TRAP/SEQ NUMBER_ : DEC 33 ASC 17,TRAP ROUTINE NOT MEMORY RESIDENT_ : DEC 16 ASC 8,TRAP TABLE BUSY_ : DEC 23 ASC 12,NEGATIVE STRING LENGTH_ : DEC 22 ASC 11,NON-CONTIGUOUS STRING_ : DEC 16 ASC 8,STRING OVERFLOW_ : DEC 30 ASC 15,UNDEFINED STATEMENT REFERENCE_ : DEC 30 ASC 15,NEGATIVE NUMBER TO REAL POWER_ : DEC 19 ASC 10,ZERO TO ZERO POWER_ : DEC 23 ASC 12,ZERO TO NEGATIVE POWER_ : DEC 25 ASC 13,OUT OF RANGE IN FUNCTION_ Œ? : DEC 25 ASC 13,LOG OF NEGATIVE ARGUMENT_ : DEC 17 ASC 09,EXP OUT OF RANGE_ DEC 17 ASC 9,ILLEGAL FUNCTION_ SPC 1 * ERROR MESSAGES FOR COMMAND (SEG 5) PHASE SPC 1 DEC 15 ASC 8,INVALID COMMAND DEC 14 ASC 7,INVALID LIMITS DEC 30 ASC 15,INVALID LU OR STATEMENT NUMBER DEC 24 ASC 12,INVALID STATEMENT NUMBER * END Ãcÿÿ ÿýU^ ÿ92065-18009 1650 S C0122 &MESCD RTE-M BASIC ERROR CODES             H0101 2 þúASMB,R,L HED <> 92065-16003 NAM CODGA,7 92065-16003 REV. 1650 761022 * * SOURCE 92065-18009 * * ENT MESGA * DATE 9-18-76 * SUP *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR SYNTAX (SEG1) PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERROR STANDARD ERRORS CODGA EQU MESGA MESSG DEC 3 ASC 2,01_ ILLEGAL EXPONENT_ : DEC 3 ASC 2,02_ NOT A FORTRAN FUNCTION DEC 3 ASC 2,03_ MISSING ASSIGNMENT OPERATOR_ : DEC 3 ASC 2,04_ NOT A SUBROUTINE CALL_ : DEC 3 ASC 2,05_ MISSING OR BAD FUNCTION NAME_ : DEC 3 ASC 2,06_ MISSING OR BAD SIMPLE VARIABLE_ : DEC 3 ASC 2,07_ MISSING OR BAD TRAP NUMBER_ : DEC 3 ASC 2,08_ MISSING OR ILLEGAL 'THEN'_ : DEC 3 ASC 2,09_ MISSING OR ILLEGAL 'OF'_ : DEC 3 ASC 2,10_ MISSING OR ILLEGAL 'TO'_ : DEC 3 ASC 2,11_ MISSING OR ILLEGAL 'STEP'_ : DEC 3 ASC 2,12_ MISSING OR ILLEGAL SUBROUTINE_ : DEC 3 ASC 2,13_ WRONG NUMBER OF PARAMETERS_ : DEC 3 ASC 2,14_ MISSING OR ILLEGAL DATA ITEM_ : DEC 3 ASC 2,15_ ILLEGAL READ OR INPUT VARIABLE_ : DEC 3 ASC 2,16_ NO CLOSING QUOTE_ : DEC 3 ASC 2,17_ MISSING OR BAD LIST DELIMITER_ : DEC 3 ASC 2,18_ ILLEGAL PARAMETER_ : DEC 3 ASC 2,19_ ,ILLEGAL STRING VARIABLE_ : DEC 3 Šþú ASC 2,20_ PARAMETER NOT STRING_ : DEC 3 ASC 2,21_ MISSING OR ILLEGAL SUBSCRIPT_ : DEC 3 ASC 2,22_ STRING LONGER THAN 72 CHARACTERS_  : DEC 3 ASC 2,23_ ILLEGAL STRING RELATIONAL OPERATOR_ : DEC 3 ASC 2,24_ STRING NOT PERMITTED_ : DEC 3 ASC 2,25_ MISSING LEFT PARENTHESIS_ : DEC 3 ASC 2,26_ MISSING RIGHT PARENTHESIS_ : DEC 3 ASC 2,27_ UNDECIPHERABLE OPERAND_ : DEC 3 ASC 2,28_ MISSING OR BAD ARRAY VARIABLE_ : DEC 3 ASC 2,29_ ILLEGAL OR MISSING INTEGER_ : DEC 3 ASC 2,30_ SIGN WITHOUT NUMBER_ : DEC 3 ASC 2,31_ CHARACTERS AFTER STATEMENT END_ : DEC 3 ASC 2,32_ OUT OF STORAGE_ : DEC 3 ASC 2,33_ ARRAY TOO LARGE_ : DEC 3 ASC 2,75_ NO LU NUMBER REFERENCE FOUND SPC 3 * ERROR MESSAGES FOR PRE-EXECUTION (SEG3) PHASE SPC 3 DEC 3 ASC 2,34_ ,COM STATEMENT OUT OF ORDER_ : DEC 3 ASC 2,35_ FUNCTION DEFINED TWICE_ : DEC 3 ASC 2,36_ UNMATCHED FOR_ : DEC 3 ASC 2,37_ NEXT WITHOUT MATCHING FOR_ : DEC 3 ASC 2,38_ DIMENSIONS NOT COMPATIBLE_ : DEC 3 ASC 2,39_ LAST STATEMENT NOT 'END'_ : DEC 3 ASC 2,40_ VARIABLE DIMENSIONED TWICE_ : DEC 3 ASC 2,41_ ARRAY OF UNKNOWN DIMENSIONS_ : DEC 3 ASC 2,42_ ARRAY TOO LARGE_ : DEC 3 ASC 2,43_ OUTÏ)þú OF STORAGE_ : DEC 3 ASC 2,44_ SYMBOL TABLE OVERFLOW_ : SPC 3 * ERROR MESSAGES FOR EXECUTE (SEG4) PHASE SPC 3 DEC 3 ASC 2,45_ OUT OF STORAGE_ : DEC 3 ASC 2,46_ GOSUBS NESTED 20 DEEP_ : DEC 3 ASC 2,47_ RETURN WITH NO PRIOR GOSUB_ : DEC 3 ASC 2,48_ OUT OF DATA_ : DEC 3 ASC 2,49_ WRONG DATA TYPE_ : DEC 3 ASC 2,50_ SUBSCRIPT OUT OF BOUNDS_ : DEC 3 ASC 2,51_ REFERENCED STATEMENT NOT DATA_ : DEC 3 ASC 2,52_ UNDEFINED VALUE ACCESSED_ : DEC 3 ASC 2,53_ BAD DATA_ : DEC 3 ASC 2,54_ BAD EXPONENT_ : DEC 3 ASC 2,55_ SUB. OR FUNCT. TERMINATED ABNORMALLY_ : DEC 3 ASC 2,56_ TRAP TABLE FULL_ : DEC 3 ASC 2,57_ ILLEGAL TRAP/SEQ NUMBER_ : DEC 3 ASC 2,58_ SCHEDULED BUT DELETED TASK_ : DEC 3 ASC 2,59_ TRAP TABLE BUSY_ : DEC 3 ASC 2,60_ NEGATIVE STRING LENGTH_ : DEC 3 ASC 2,61_ NON-CONTIGUOUS STRING_ : DEC 3 ASC 2,62_ STRING OVERFLOW_ : DEC 3 ASC 2,63_ UNDEFINED STATEMENT REFERENCE_ : DEC 3 ASC 2,64_ NEGATIVE NUMBER TO REAL POWER_ : DEC 3 ASC 2,65_ ZERO TO ZERO POWER_ : DEC 3 ASC 2,66_ ZERO TO NEGATIVE POWER_ : DEC 3 ASC 2,67_ OUT kOF RANGE IN FUNCTION_ : DEC 3 ASC 2,68_ LOG OF NEGATIVE ARGUMENT_ : DEC 3 ASC 2,69_ EXP OF NEGATIVE ARGUMENT_ : DEC 3 ASC 2,70_ ILLEGAL FUNCTION_ SPC 3 * ERROR MESSAGES FOR COMMAND (SEG 5) PHASE SPC 3 DEC 3 ASC 2,71 INVALID COMMAND DEC 3 ASC 2,72 INVALID LIMITS DEC 3 ASC 2,73 INVALID LU OR STATEMENT NUMBER DEC 3 ASC 2,74 INVALID STATEMENT NUMBER * END CODGA ôÿÿ ÿýV_ ÿ92065-18010 1901 S C0122 &MBTG TABLE GENERATOR MAIN             H0101 &¡þúFTN4,L, PROGRAM RTMTG (), 92065-16004 REV. 1901 780705 C C DATA BUFFERS AND STOREAGE C INTEGER FUNC1,FUNC2,A,E,F,R,X,AI(6),AO(6) DIMENSION IBUF(72),IDCB1(144),IDCB2(144) DIMENSION IBUF4(6),IBUF5(6) C C C C C RTM BRANCH AND MNEMONIC TABLE GENERATOR C MIKE SCHOENDORF C OCTOBER 22,1976 C C SOURCE: 92065-18010 C RELOCATEABLE: 92065-16004 REV.1901 770518 C C C C C C MAXIMUM READ LENGTH FROM SESSION CONSOLE C IL=72 C C "RTMTG" C CALL MESS1 C C > C 50 CALL MESS2 C C INITIALIZE END OF FILE, COMMAND, EDIT, ERROR, MESSAGE LENGTH C AND LINE NUMBERS INDICATORS. C E=0 FUNC1=0 FUNC2=0 IERR=0 LEN=0 NUMB=0 C C GET COMMAND FUNCTION C CALL READ1(FUNC1,IERR) C C IF NOT EDIT, TABLE, LIST, OR END COMMANDS ERROR EXIT. C IF (IERR .NE. 0) GO TO 90 C C EDIT COMMAND C IF (FUNC1 .EQ. 4)GO TO 995 C C GET INPUT AND OUTPUT FILE NAMES C CALL GTFIL(5,IERR,0,AI,AO) C C CHECK FOR GTFIL ERR C IF (IERR .NE. 0)GO TO 910 C C OPEN INPUT FILE C CALL OPEN(IDCB1,IERR,AI(2),410B) C C CHECK FOR OPEN ERROR C IF (IERR .LT. 0)GO TO 920 C C IF OUTPUT FILE FOR TABLE, OPEN WITH 110B C IF (FUNC1 .EQ. 2)GO TO 95 C C OPEN OUTPUT FILE (LIST, EDIT) C CALL OPEN(IDCB2,IERR,AO(2),210B) C C CHECK FOR OPEN ERROR C 55 IF (IERR .LT. 0)GO TO 70 C C GO PROCESS EDIT, LIST, AND TABLE COMMANDS C 60 GO TO (100,700,800)FUNC1 C C OPEN ERROR ON OUTPUT FILE. CHECK IF FILE EXISTS. C 70 IF (IERR .EQ. -6)80,920 C C FILE DOESN'T EXIST, CREATE IT. C 80 IF (FUNC1 .EQ. 2)GO TO 85 C C CREATE TYPE 4 OUTPUT FILE C CALL CREAT(IDCB2,IERR,AO(2),30,4,AO(6),AO(1)) C C CHECK FOR CREATE ERROR C IF (IERR .LT. 0)990,60 C C CREATE TYPE 5 OUTPUT FILE C 85 CALL CREAT(IDCB2,IERR,AO(2),30,5,AO(6),AO(1)) C C CHECK FOR CREEþúATE ERROR C IF (IERR .LT. 0)990,60 C C COMMAND ERROR C 90 CALL ERR2 GO TO 50 C C OPEN OUTPUT FILE (TABLES) C 95 CALL OPEN(IDCB2,IERR,AO(2),110B) GO TO 55 C C C EDIT C C C C INITIALIZE ADD, FIND, LINE NUMBER, DELETE LINE NUMBER INDICATORS. C 100 A=0 F=0 N=0 X=0 C C "BRANCH AND MNEMONIC SOURCE EDIT" C CALL MESS3 C C - (PROMPT) C 110 CALL MESS9 C C GET EDIT COMMAND C 130 CALL READ2(FUNC2,NUMB,IERR) C C IF NOT END, ABORT, ADD, DELETE, END, FIND, OR REPLACE, C COMMAND ERROR. C IF (IERR .NE. 0)GO TO 190 C C GO TO ABORT, ADD, DELETE, END, FIND, REPLACE OR C FIND NEXT LINE. C GO TO(400,900,200,300,500,600,550)FUNC2 C C COMMAND ERROR C 190 CALL ERR2 GO TO 110 C C C ADD C C C C IF FIND PREVIOUS COMMAND, GO WRITE THE LINE. C 200 IF (F .EQ. 1)GO TO 260 C C READ FROM INPUT FILE C 210 CALL READ3(IBUF,LEN) C C IF NO INPUT, ADD ERROR C IF (LEN .EQ. 0) GO TO 960 C C WRITE ON OUTPUT FILE C CALL WRITF(IDCB2,IERR,IBUF,LEN) C C SET ADD FLAG INDICATOR C A=1 C C GET NEXT EDIT COMMAND, IF NO WRITE ERROR. C IF (IERR .NE. 0)950,110 C C WRITE PENDING LINE TO OUTPUT FILE C 260 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CLEAR FIND FLAG INDICATOR C F=0 C C GET NEXT EDIT COMMAND, IF NO WRITE ERROR.OMMAND C IF (IERR .NE. 0)950,210 C C C DELETE (N) C C C C CLEAR DELETE LINE NUMBER INDICATOR C 300 X=0 C C IF "FIND" PREVIOUS COMMAND, DON'T READ NEXT LINE. C IF (F .EQ. 1)GO TO 320 C C IF DONE, GO PROMPT C 310 IF (X .EQ. NUMB)GO TO 110 C C READ NEXT LINE FROM INPUT FILE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C IF END OF FILE, OUTPUT TO SESSION CONSOLE "EOF" C IF (LEN .EQ. -1)GO TO 350 C C CLEAR "ADD" FLAG INDI‰9þúCATOR C A=0 C C N = CURRENT LINE NUMBER C N=N+1 C C X = NUMBER OF LINES DELETED C 315 X=X+1 C C CHECK IF FINISHED C GO TO 310 C C IF NO LINES TO DELETE GET NEXT EDIT COMMAND C 320 IF (NUMB .EQ. 0)GO TO 110 C C CLEAR "FIND" PREVIOUS COMMAND INDICATOR C F=0 GO TO 315 C C SET "EOF" INDICATOR C 350 E=1 C C "EOF" C CALL MESS6 GO TO 110 C C C END C C C C IF AT END OF INPUT, CLOSE INPUT AND OUTPUT FILES. C 400 IF (E .EQ.1)GO TO 900 C C IF "FIND" LAST COMMAND, GO WRITE LINE. C IF (F .EQ. 1)GO TO 420 C C READ NEXT LINE C 410 CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C IF AT END OF FILE, GO CLOSE INPUT AND OUTPUT FILES. C IF (LEN .EQ. -1)GO TO 900 C C WRITE PENDING LINE TO OUTPUT FILE C 420 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,410 C C C FIND C C C C CHECK FOR END OF FILE C 500 IF (E .EQ. 1)GO TO 350 C C CHECK IF "ADD" PREVIOUS COMMAND C IF (A .EQ. 1)GO TO 570 C C CHECK IF "REPLACE" PREVIOUS COMMAND C IF (R .EQ. 1)GO TO 570 C C CHECK IF "FIND" PREVIOUS COMMAND C IF (F .EQ. 1)GO TO 530 C C CHECK IF AT START OF INPUT FILE C 505 IF (N .EQ. 0)GO TO 580 C C IF LINE SOUGHT IS LESS THAN CURRENT LINE, ERROR C IF LINE SOUGHT = CURRENT LINE STOP LOOKING C IF LINE SOUGHT > CURRENT LINE, KEEP LOOKING. C 510 IF (NUMB-N)970,540,520 C C CLEAR "ADD" FLAG INDICATOR C 520 A=0 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 980 C C GO WRITE LINE C 530 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C N = CURRENT LINE NUMBER C N=N+1 C C CLEAR "FIND" FLAG INDICATOR C F=0 C Æ¿þúC CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,510 C C CHECK FOR END OF FILE C 540 IF (E .EQ. 1)GO TO 350 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 350 C C CHECK IF READ ERROR C IF (IERR .NE. 0)GO TO 930 C C OUTPUT CURRENT LINE NUMBER C CALL MESS4(N) C C OUTPUT CURRENT LINE C CALL MESSA(IBUF,LEN) C C SET "FIND" FLAG INDICATOR C F=1 C C GO GET NEXT EDIT COMMAND C GO TO 130 C C C FIND NEXT LINE C C C C CHECK FOR END OF FILE C 550 IF (E .EQ. 1)GO TO 350 C C N = CURRENT LINE NUMBER C N=N+1 C C IF "FIND" PREVIOUS COMMAND, WRITE PENDING LINE, C ELSE SET FOR NEXT LINE READ. C IF (F .EQ. 1)560,565 C C WRITE PENDING LINE C 560 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C SET LINE SOUGHT = PENDING LINE C 565 NUMB=N C C GO READ LINE C GO TO 590 C C CHECK IF AT START OF FILE C 570 IF (N .EQ. 0)GO TO 580 C C CHECK IF LINE SOUGHT <, =, OR > PENDING LINE. C IF (NUMB-N)970,970,580 C C SET TO GET NEXT LINE C 580 N=N+1 C C CLEAR "ADD" AND "REPLACE" INDICATORS C 590 A=0 R=0 GO TO 510 C C C REPLACE C C C C IF AT END, OUTPUT "EOF" TO SESSION CONSOLE. C 600 IF (E .EQ. 1)GO TO 350 C C SET "REPLACE" FLAG INDICATOR C R=1 C C IF "FIND" PREVIOUS COMMAND, GET REPLACEMENT LINE C IF (F .EQ. 1)GO TO 610 C C N = CURRENT LINE NUMBER C N=N+1 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 350 C C OUTPUT CURRENT LINE NUMBER C CALL MESS4(N) C C OUTPUT CURRENT LINE C CALL MESSA(IBUF,LEN) C C GET REPLACEMENT LINE C 61f þú0 CALL READ3(IBUF,LEN) C C CHECK FOR REPLACEMENT ERROR C IF (LEN .EQ. 0)GO TO 985 C C CLEAR FIND AND ADD FLAG INDICATORS C F=0 A=0 C C WRITE ON OUTPUT FILE C CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,110 C C C BRANCH AND MNEMONIC TABLE GENERATOR C C C C "BRANCH TABLE GENERATOR" C 700 CALL MESS7 C C N = NUMBER OF BRANCH TABLE ENTRIES C N=0 C C FORMAT NAM RECORD C C NAM BMTBL C CALL NAMRC(IBUF) C C OUTPUT NAM RECORD C CALL WRITF(IDCB2,IERR,IBUF,17) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT ENTRY RECORD C C ENT BRTBL C CALL ENTBT(IBUF) C C OUTPUT ENTRY RECORD C CALL WRITF(IDCB2,IERR,IBUF,7) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT DBL RECORD C C BRTBL DEF *+1 C CALL ENTBR(IBUF) C C OUTPUT DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF,6) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C READ NEXT BRANCH TABLE ENTRY C 720 CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 750 C C GO PARSE LINE C CALL PARS1(IBUF,LEN,IBUF4,IBUF5,IERR) C C CHECK FOR SYNTAX ERROR C IF (IERR .NE. 0)GO TO 790 C C N = BRANCH TABLE NUMBER ENTRY C N=N+1 C C WRITE EXTERNAL RECORD C CALL WRITF(IDCB2,IERR,IBUF4,6) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C WRITE DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF5,9) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C GET NEXT BRANCH TABLE ENTRY C GO TO 720 C C DETERMINE IF INPUT IS FROM PAPER TAPE C 750 CALL RWIND(X,IDCB1,IERR) C C CHECK FOR ERROR IN DETERMINING INPUT DEVICE C IF (IERR .NE. 0)GO TO 99Yþú1 C C REWIND INPUT FILE C CALL RWNDF(IDCB1,IERR) C C CHECK FOR REWIND ERROR C IF (IERR .LT. 0)GO TO 991 C C IF PAPER TAPE INPUT OUTPUT MESSAGE C IF (X .EQ. 1)760,780 C C "REWIND SOURCE FILE" C 760 CALL MESS8 C C PAUSE UNTIL REWIND IS DONE, THEN ENTER GO,RTMTG TO CONTINUE. C PAUSE C C MNEMONIC TABLE GENERATOR C 780 CALL MES10 C C FORMAT ENTRY RECORD C C ENT MNTBL C CALL ENTMT(IBUF) C C OUTPUT ENTRY RECORD C CALL WRITF(IDCB2,IERR,IBUF,7) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT DBL RECORD C C MNTBL DEC -X C C WHERE X IS THE NUMBER OF BRANCH TABLE ENTRIES C CALL ENTMN(IBUF,N) C C OUTPUT DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF,6) C C CHECK FOR WRITE ERROR C IF(IERR .NE. 0)GO TO 950 C C SET MNEMONIC TABLE ENTRY NUMBER = 0 C N=0 C C NUM = DBL RECORD LENGTH C 785 NUM=0 C C READ NEXT MNEMONIC TABLE ENTRY C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 795 C C GO PARSE ENTRY C CALL PARS2(IBUF,LEN,IBUF4,IERR,NUM) C C CHECK FOR SYNTAX ERROR C IF (IERR .NE. 0)GO TO 788 C C STEP TO NEXT MNEMONIC TABLE ENTRY C N=N+1 C C WRITE DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF4,NUM) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,785 C C STEP TO NEXT MNEMONIC TABLE ENTRY C 788 N=N+1 C C SYN ERR IN LINE "N" C CALL ERR11(N) C C READ NEXT LINE C GO TO 785 C C STEP TO NEXT MNEMONIC TABLE ENTRY C 790 N=N+1 C C SYN ERR IN LINE "N" C CALL ERR11(N) C C READ NEXT LINE C GO TO 720 C C FORMAT END RECORD C 795 CALL ENDRC(IBUF) C C WRITE END RECORD C CALL WRITF(IDCB2,IERR,IBUF,4) C C CHECK FOR WRITE ERROR C ÎOþúIF (IERR .NE. 0)GO TO 950 C C CLOSE INPUT FILE C CALL CLOSE(IDCB1,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)GO TO 940 C C WRITE END OF FILE C CALL FCONT(IDCB2,IERR,100B) C C CHECK FOR END OF FILE ERRROR C IF (IERR .LT. 0)GO TO 940 C C CLOSE OUTPUT FILE C CALL CLOSE(IDCB2,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)GO TO 940 C C GET NEXT COMMAND C GO TO 50 C C C LIST (ADD LINE NUMBERS TO INPUT FILE ENTRIES) C C C C N = CURRENT LINE NUMBER C 800 N=0 C C "LIST" C CALL MESS5 C C STEP TO NEXT LINE C 810 N=N+1 C C PUT LINE NUMBER (N) IN OUTPUT BUFFER C CALL CNUMD(N,IBUF) C C PUT NEXT LINE IN OUTPUT BUFFER C CALL READF(IDCB1,IERR,IBUF(6),IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 900 C C ADD 2 BLANKS TO OUTPUT BUFFER C IBUF(4)=20040B IBUF(5)=20040B C C SET OUTPUT LINE LENGTH C LEN=LEN+4 C C GO WRITE LINE WITH ITS LINE NUMBER ATTACHED C CALL WRITF(IDCB2,IERR,IBUF(2),LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C PROCESS NEXT LINE C GO TO 810 C C C ABORT C C C C CLOSE INPUT FILE C 900 CALL CLOSE(IDCB1,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)901,905 C C CHECK IF DCB OPEN C 901 IF (IERR .EQ. -11)905,906 C C WRITE END OF FILE C 905 CALL FCONT(IDCB2,IERR,100B) C C CHECK FOR END OF FILE ERROR C IF (IERR .LT. 0)GO TO 940 C C CLOSE OUTPUT FILE C CALL CLOSE(IDCB2,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)907,50 C C CLOSE ERROR C 906 CALL ERR5 C C GO CLOSE OUTPUT FILE C GO TO 905 C C CHECK IF DCB OPEN C 907 IF (IERR .EQ. -11)50,940 C C C ERROR MESSAGES C C C C GTFIL ERR C 910 CALL ERR1A w0.* GO TO 995 C C OPEN ERR C 920 CALL ERR3 GO TO 50 C C READ ERR C 930 CALL ERR4 GO TO 900 C C CLOSE ERR C 940 CALL ERR5 GO TO 995 C C WRITE ERR C 950 CALL ERR6 GO TO 900 C C ADD ERR C 960 CALL ERR7 GO TO 110 C C SEQ ERR C 970 CALL ERR8 GO TO 110 C C LINE ERR C 980 CALL ERR9 GO TO 110 C C REPL ERR C 985 CALL ERR10 GO TO 110 C C CREATE ERR C 990 CALL ERR12 GO TO 900 C C REWIND ERR C 991 CALL ERR13 GO TO 900 C C "RTMTG FINISHED" C 995 CALL MESS0 END END$ r&0ÿÿ ÿýW d ÿ92065-18011 1650 S C0122 &DTRAP RTE-M BASIC DUMMY TRAP             H0101 ASMB,L,R NAM TRAP,7 92065-16005 REV.1650 761022 ENT TRAP TRAP NOP ISZ TRAP JMP TRAP,I END TRAP ‘eÿÿ ÿýX^ ÿ92065-18012 1709 S C0222 &MTGS0 TABLE GEN. SUBROUTINE             H0102 CÛþúASMB,R HED SUBROUTINES FOR BRANCH AND MNEMONIC TABLE GENERATOR NAM RTMSR,7 92065-16006 REV.1709 770309 * * ******************************************************* * * * RTM TABLE GENERATOR SUBROUTINES * MIKE SCHOENDORF * OCTOBER 22, 1976 * * SOURCE: 92065-18012 * RELOCATEABLE: 92065-16006 * * ******************************************************* * * * ENTRY POINT NAMES * * ENT ENDRC,ENTBR,ENTBT,ENTMN,ENTMT ENT ERR1A,ERR2,ERR3,ERR4,ERR5,ERR6 ENT ERR7,ERR8,ERR9,ERR10,ERR11,ERR12 ENT ERR13,MESS0,MESS1,MESS2,MESS3 ENT MESS4,MESS5,MESS6,MESS7,MESS8 ENT MESS9,MES10,MESSA,NAMRC,PARS1,PARS2 ENT READ1,READ2,READ3,RWIND * * * EXTERNAL REFERENCE NAMES * * EXT CNUMD,.ENTR,EXEC,IMESS EXT LOCF,PARSE SUP SKP * * * PROMPTS/ERROR MESSAGES * * CALLING SEQUENCE: * * LDA LNGTH MESSAGE LENGTH * LDB ADDRS MESSAGE ADDRESS * JSB MESSI OUTPUT TO SESSION CONSOLE * OCT 2 * RETURN * * * * "RTMTG FINISHED" * * MESS0 NOP JSB .ENTR DEF MESS0 LDA D16 LDB MES00 JSB MESSI OCT 2 JMP MESS0,I * MES00 DEF *+1 ASC 8,"RTMTG FINISHED" * * "RTMTG" * MESS1 NOP JSB .ENTR DEF MESS1 LDA B7 LDB MES01 JSB MESSI OCT 2 JMP MESS1,I * B7 OCT 7 * MES01 DEF *+1 ASC 4,"RTMTG" SKP * * > * MESS2 NOP JSB .ENTR DEF MESS2 CLA,INA LDB MES02 JSB MESSI OCT 2 JMP MESS2,I * MES02 DEF *+1 ASC 1,> * * "BRANCH AND MNEMONIC SOURCE EDIT" * MESS3 NOP JSB .ENTR DEF MESS3 LDA D33 LDB MES03 JSB MESSI OCT 2 JMP MESS3,I * D33 DEC 33 * MES03 DEF *+1 ASC 17,"BRANCH AND MNEMONIC SOURCE EDIT" [„þú* * PENDING LINE NUMBER (N) * N1 NOP MESS4 NOP JSB .ENTR DEF N1 LDA N1,I GET CURRENT LINE NUMBER STA NUMB1 JSB CNUMD CONVERT TO ASCII DEF *+3 DEF NUMB1 AND PUT IN OUTPUT BUFFER DEF BUFA1 LDB BUFAD ADB B3 LDA BLANK STA 1,I INB LDA BKARO ADD BACK ARROW TO SUPPRESS STA 1,I CARRIAGE RETURN-LINE FEED LDA D10 LDB BUFAD JSB MESSI OCT 2 JMP MESS4,I * B4 OCT 4 * NUMB1 NOP * BKARO OCT 20137 SKP * * "LIST" * MESS5 NOP JSB .ENTR DEF MESS5 LDA B6 LDB MES05 JSB MESSI OCT 2 JMP MESS5,I * B6 OCT 6 * MES05 DEF *+1 ASC 3,"LIST" * * EOF (END OF FILE) * MESS6 NOP JSB .ENTR DEF MESS6 LDA B3 LDB MES06 JSB MESSI OCT 2 JMP MESS6,I * B3 OCT 3 * MES06 DEF *+1 ASC 2,EOF * * "BRANCH TABLE GENERATOR" * MESS7 NOP JSB .ENTR DEF MESS7 LDA D24 LDB MES07 JSB MESSI OCT 2 JMP MESS7,I * D24 DEC 24 * MES07 DEF *+1 ASC 12,"BRANCH TABLE GENERATOR" SKP * * "REWIND SOURCE FILE" * MESS8 NOP JSB .ENTR DEF MESS8 LDA D20 LDB MES08 JSB MESSI OCT 2 JMP MESS8,I * D20 DEC 20 * MES08 DEF *+1 ASC 10,"REWIND SOURCE FILE" * * - (PROMPT) * MESS9 NOP JSB .ENTR DEF MESS9 LDA B2 LDB MES09 JSB MESSI OCT 2 JMP MESS9,I * MES09 DEF *+1 OCT 26537 * * "MNEMONIC TABLE GENERATOR" * MES10 NOP JSB .ENTR DEF MES10 LDA D26 LDB ME010 JSB MESSI OCT 2 JMP MES10,I * ME010 DEF *+1 ASC 13,"MNEMONIC TABLE GENERATOR" * D26 DEC 26 * * PENDING LINE IS OUTPUT * IBUF0 NOP LEN3 ΧþúNOP MESSA NOP JSB .ENTR DEF IBUF0 LDA LEN3,I CMA,INA LDB IBUF0 JSB MESSI OCT 2 JMP MESSA,I SKP * * * ERROR MESSAGES * * * * GTFIL ERROR * * ERR1A NOP JSB .ENTR DEF ERR1A LDA D9 LDB ERR01 JSB MESSI OCT 2 JMP ERR1A,I * D9 DEC 9 * ERR01 DEF *+1 ASC 5,GTFIL ERR * * COMMAND ERROR * ERR2 NOP JSB .ENTR DEF ERR2 LDA D11 LDB ERR02 JSB MESSI OCT 2 JMP ERR2,I * D11 DEC 11 * ERR02 DEF *+1 ASC 6,COMMAND ERR * * OPEN ERROR * ERR3 NOP JSB .ENTR DEF ERR3 LDA D8 LDB ERR03 JSB MESSI OCT 2 JMP ERR3,I * D8 DEC 8 * ERR03 DEF *+1 ASC 4,OPEN ERR SKP * * READ ERROR * ERR4 NOP JSB .ENTR DEF ERR4 LDA D8 LDB ERR04 JSB MESSI OCT 2 JMP ERR4,I * ERR04 DEF *+1 ASC 4,READ ERR * * CLOSE ERROR * ERR5 NOP JSB .ENTR DEF ERR5 LDA D9 LDB ERR05 JSB MESSI OCT 2 JMP ERR5,I * ERR05 DEF *+1 ASC 5,CLOSE ERR * * WRITE ERROR * ERR6 NOP JSB .ENTR DEF ERR6 LDA D9 LDB ERR06 JSB MESSI OCT 2 JMP ERR6,I * ERR06 DEF *+1 ASC 5,WRITE ERR SKP * * ADD ERROR * ERR7 NOP JSB .ENTR DEF ERR7 LDA B7 LDB ERR07 JSB MESSI OCT 2 JMP ERR7,I * ERR07 DEF *+1 ASC 4,ADD ERR * * SEQ ERROR * ERR8 NOP JSB .ENTR DEF ERR8 LDA B7 LDB ERR08 JSB MESSI OCT 2 JMP ERR8,I * ERR08 DEF *+1 ASC 4,SEQ ERR * * LINE ERROR * ERR9 NOP JSB .ENTR DEF ERR9 LDA D8 LDB ERR09 JSB MESSI OCT 2 JMP ERR9,I * ERR09 DEF *+1 ASC 4,LINEþˆþú ERR * * REPL ERROR * ERR10 NOP JSB .ENTR DEF ERR10 LDA D8 LDB ER010 JSB MESSI OCT 2 JMP ERR10,I * ER010 DEF *+1 ASC 4,REPL ERR SKP * * SYN ERR IN LINE XXX * LINE NOP ERR11 NOP JSB .ENTR DEF LINE LDA LINE,I LINE NUMBER STA NUMB1 JSB CNUMD CONVERT TO ASCII DEF *+3 DEF NUMB1 AND PUT IN OUTPUT BUFFER DEF ER11P LDA D22 LDB ER011 JSB MESSI OCT 2 JMP ERR11,I * ER011 DEF *+1 ASC 8,SYN ERR IN LINE ER11P BSS 3 * D22 DEC 22 * * CREATE ERROR * ERR12 NOP JSB .ENTR DEF ERR12 LDA D10 LDB ER012 JSB MESSI OCT 2 JMP ERR12,I * D10 DEC 10 * ER012 DEF *+1 ASC 5,CREATE ERR * * REWIND ERROR * ERR13 NOP JSB .ENTR DEF ERR13 LDA D10 LDB ER013 JSB MESSI OCT 2 JMP ERR13,I * ER013 DEF *+1 ASC 5,REWIND ERR SKP * * * SUBROURINE TO DETERMINE BRANCH-MNEMONIC TABLE * COMMAND (EDIT, TABLE, LIST, OR END) * * FUNC1 NOP ERRP1 NOP READ1 NOP JSB .ENTR DEF FUNC1 JSB READX GET INPUT FROM SESSION CONSOLE LDA M4 DETERMINE COMMAND LDB CTABL JSB SCAN JMP R1ERR ERROR CLB SET TO NO ERROR RD1ER STA FUNC1,I SAVE COMMAND TYPE STB ERRP1,I SAVE ERROR TYPE JMP READ1,I R1ERR CLB,INB CLA JMP RD1ER * M4 DEC -4 * * * SUBROUTINE TO DETERMINE EDIT COMMAND * (END, ABORT, ADD, DELETE, FIND, REPLACE, * FIND(/)-NEXT LINE * FUNC2 NOP NUMB NOP ERRP2 NOP READ2 NOP JSB .ENTR DEF FUNC2 JSB READX GET INPUT FROM SESSION CONSOLE LDA M7 LDB ETABL JSB SCAN DETERMINE EDIT COMMAND JMP R2ERR ERROR STA FUNC2,I SAVE EDIT COMMAND TYPE JSB PNMRA PAì|þúRSE FOR # IN DEL AND FIND COMMANDS CLA NO LINE NUMBER CLB NO ERROR RD2ER STA NUMB,I SAVE LINE NUMBER STB ERRP2,I SAVE ERROR CODE JMP READ2,I R2ERR CLB,INB ERROR CLA SET FOR NO FUNCTION STA FUNC2,I JMP RD2ER * M7 DEC -7 SKP * * COMMAND AND EDIT LOOK-UP TABLES. * * BITS 15-8 #CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE(TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THESE TABLES IS USED IN DETERMINING * THE OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS * TABLE IS OF PARAMOUNT IMPORTANCE. * * * COMMAND LOOK-UP TABLE * CTABL DEF CTABS CTABS ABS 2000B+AEDIT-CMTBL EDIT ABS 2400B+ATABL-CMTBL TABLE ABS 2000B+ALIST-CMTBL LIST ABS 1400B+AEND-CMTBL END * * EDIT LOOK-UP TABLE * ETABL DEF ETABS ETABS ABS 1400B+AEND-CMTBL END ABS 2400B+ABORT-CMTBL ABORT ABS 1400B+ADD-CMTBL ADD ABS 3000B+ADELE-CMTBL DELETE ABS 2000B+AFIND-CMTBL FIND ABS 3400B+AREPL-CMTBL REPLACE ABS 400B+ASLSH-CMTBL FIND(/)-NEXT LINE * * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS OF NO IMPORTANCE. * CMTBL DEF * AEDIT ASC 2,EDIT ATABL ASC 3,TABLE ALIST ASC 2,LIST AEND ASC 2,END ABORT ASC 3,ABORT ADD ASC 2,ADD ADELE ASC 3,DELETE AFIND ASC 2,FIND AREPL ASC 4,REPLACE ASLSH ASC 1,/ SKP * * SUBROUTINE TO INPUT FROM SESSION CONSOLE FOR * ADD EDIT COMMAND. * IBUF NOP LEN NOP READ3 NOP JSB .ENTR DEF IBUF LDA D72 BUFFER LENGTH LDB IBUF BUFFER ADDRESS JSB MESSI READ UP TO 72 CHARACTERS OCT 1 STB TEMP1 SAVE CHARACTER LENGTH INB CONVER TO # OF WORDS BRS STB LEN,I AND SAVE STB 0 LDB IBUF,I ADD BLANK TO LAST ADB 0 CHARACTER OF LAST WORD ADB M1 Ýþú ONLY IF ODD # OF CHARACTERS LDA TEMP1 SLA,RSS JMP READ3,I EVEN # OF CHARACTERS, EXIT LDA 1,I AND UPCM IOR B40 STA 1,I JMP READ3,I * TEMP1 NOP * D72 DEC 72 * * SUBROUTINE TO READ FROM SESSION CONSOLE * READX NOP LDA D72 BUFFER LENGTH LDB QBUFA BUFFER ADDRESS JSB MESSI READ FROM CONSOLE OCT 1 STB QQCHC SAVE # OF CHARACTERS CLA RESET INCOMING STA QQCNT CHARACTER POINTERS LDA QBUFA STA QQPTR JMP READX,I * QBUFA DEF QIBUF QIBUF BSS 72 * QQCHC NOP QQCNT NOP QQPTR NOP SKP * * SUBROUTINE TO OUTPUT THE NAM RECORD BMTBL * * NAM BMTBL * * IBUF1 NOP NAMRC NOP JSB .ENTR DEF IBUF1 LDA IBUF1 OUTPUT BUFFER ADDRESS LDB TABL1 NAM RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -17 DATA BUFFER LENGTH JMP NAMRC,I * * NAM RECORD DATA * TABL1 DEF *+1 OCT 10400 OCT 20000 OCT 1256 OCT 41115 OCT 52102 OCT 46040 OCT 177777 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 SKP * * SUBROUTINE TO OUTPUT THE ENT RECORD BRTBL * * ENT BRTBL * * IBUF2 NOP ENTBT NOP JSB .ENTR DEF IBUF2 LDA IBUF2 OUTPUT BUFFER ADDRESS LDB TABL2 ENTRY RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -7 DATA BUFFER LENGTH JMP ENTBT,I * * ENT RECORD DATA * TABL2 DEF *+1 OCT 3400 OCT 40001 OCT 21225 OCT 41122 OCT 52102 OCT 46000 OCT 0 SKP * * SUBROUTINE TO OUTPUT THE DBL RECORD BRTBL DEF *+1 * * BRTBL DEF *+1 * IBUF3 NOP ENTBR NOP JSB .ENTR DEF IBUF3 CLA,INA SET STA LDADR LOADÚºþú ADDRESS STA IDNUM AND EXTERNAL ID NUMBER TO 1 LDA B4400 SET RECORD COUNT TO 9 WORDS STA RLCNT LDA B6014 SET WORD 2 OF DBL RECORD TO PROGRAM STA INSTR FOR LOAD ADD. & 4 FOR # INST. WORDS LDA MNEG SET RELOCATION INDICATOR TO STA RLIND EXTERNAL REFERENCE LDA IBUF3 OUTPUT BUFFER ADDRESS LDB TABL3 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -6 DATA BUFFER LENGTH JMP ENTBR,I * * DBL RECORD DATA * TABL3 DEF *+1 OCT 3000 OCT 60101 OCT 100102 OCT 0 OCT 20000 OCT 1 * B4400 OCT 4400 B6014 OCT 60104 MNEG OCT 100000 SKP * * SUROUTINE TO PUT THE NAM, ENT, EXT, DBL, AND END * RECORDS IN THE OUTPUT BUFFER. * STORE NOP STA IBUFF OUTPUT BUFFER STB TABL ADDRESS OF RECORDS LDA STORE,I GET DATA BUFFER LENGTH STA COUNT STOR1 LDA TABL,I GET NEXT DATA WORD STA IBUFF,I STORE IN OUTPUT BUFFER ISZ TABL INCREMENT TO NEXT DATA WORD ISZ IBUFF INCREMENT TO NEXT OUTPUT BUF ADD ISZ COUNT DONE? JMP STOR1 NO ISZ STORE SET RETURN ADDRESS JMP STORE,I * COUNT NOP IBUFF NOP TABL NOP SKP * * SUBROUTINE TO PARSE SOURCE FILE AND CREATE * RELOCATEABLE BRANCH TABLE OUTPUT. * IBUF4 NOP LEN1 NOP IBUF5 NOP IBUF6 NOP IERR1 NOP PARS1 NOP JSB .ENTR DEF IBUF4 LDA IERR1 SET ERROR RETURN ADDRESS STA IERR LDA LEN1,I INPUT LENGTH LDB IBUF4 INPUT ADDRESS JSB INIT GO INITIALIZE LDA IBUF5 CREATE EXTERNAL RECORD AND PUT IN JSB EXTRC OUPUT BUFFER JSB PRAMS CHECK IF THERE ARE ANY PARAMETERS JMP PARSC NO PARAMETERS, INPUT BUFFER EMPTY JMP PARSB NO PARAMTERS, CHECK FOR FUNCTION TYPE PARSA JSB PARAM CHECK PARAMETER TYPES ISZ PRMCT INCREMENT # OFþú PARAMETERS JSB OTPUT FORMAT OUTPUT WORD JSB EPRAM DONE WITH PARAMETERS? JMP PARSA NO, GET NEXT ONE JMP PARSC YES, INPUT BUFFER EMPTY PARSB JSB INTRL CHECK FOR FUNCTION TYPE JMP PARSC NO ENTRY POINT NAME JSB TEQUL CHECK NEXT 2 CHARS FOR "T=" LDA IBUF5 REPROCESS ENTRY POINT NAME JSB EXTRC AND OVERLAY SUBROUTINE NAME PARSC LDA WORDX SET WORD 9 BIT 15 IN DBL RECORD IOR WORD3 IF FUNCTION IS AN INTEGER STA WORD3 LDA FTN SET WORD 8 BIT 15 IN DBL RECORD IOR WORD2 IF FTN STA WORD2 LDA IBUF6 PUT DBL RECORD IN OUTPUT BUFFER JSB DBLRC ISZ IDNUM INCREMENT EXT ID NUMBER JMP PARS1,I * IERR NOP PRMCT NOP WORDX NOP SKP * * SUBROUTINE TO INITIALIZE BRANCH AND * MNEMONIC TABLE GENERATOR * INIT NOP SZA,RSS JMP ERR1 RAL STA QQCHC SAVE # OF CHARACTERS CLA STA QQCNT RESET INCOMING CHAR POINTER STA WORD1 INITIALIZE STA WORD2 OUTPUT STA WORD3 BUFFER STA WORDX ENTRIES STA PRMCT # OF PARAMETERS STA CHRCT # OF CHARS. IN SUB. NAME STA IERR,I CLEAR ERROR CODE STA FUNC CLEAR FUNCTION BIT STA FTN CLEAR FTN BIT STB QQPTR JMP INIT,I * FTN NOP FUNC NOP * ERR1 CLA,INA SET FOR ERROR RETURN STA IERR,I JMP PARS1,I SKP * * SUBROUTINE TO GENERATE AN EXTERNAL RECORD FOR THE NAME OF THE * FUCTION OR SUBROUTINE. IF ENTRY IS SUPPLIED, IT WILL OVERLAY * THE FUNCTION OR SUBROUTINE NAME FOR BRANCH TABLE ENTRIES. * * EXTRC NOP STA IBUFF DESTINATION ADDRESS LDB BLANK INITIALIZE ADA B4 OUTPUT BUFFER STB 0,I INA STB 0,I LDA B3000 RECORD LENGTH STA IBUFF,I ISZ IBUFF LDA B1001 RECORD IDENT-#…«þú ENTRIES STA IBUFF,I ISZ IBUFF ISZ IBUFF LDA IBUFF DESTINATION ADDRESS JSB MOVE. MOVE SYMBOL NAME FROM INPUT BUFFER ISZ IBUFF ISZ IBUFF LDA IBUFF,I SET EXTERNAL ID NUMBER AND UPCM IOR IDNUM STA IBUFF,I LDA IBUF5 STA IBUFF ADA B3 LDB 0,I CALCULATE CHECKSUM INA ADB 0,I INA ADB 0,I ADB B1001 LDA IBUFF AND STORE IN WORD3 ADA B2 STB 0,I OF EXTERNAL RECORD JMP EXTRC,I * B2 OCT 2 BLANK OCT 20040 B3000 OCT 3000 B1001 OCT 100001 UPCM OCT 77400 SKP * * SUBROUTINE TO CHECK IF THERE ARE ANY PARAMETERS * PRAMS NOP CLA INITIALIZE PARAMETER COUNT STA PRMCT JSB NXTC GET NEXT NON BLANK CHARACTER JMP PRAMS,I NO MORE ISZ PRAMS CPA COMMA IF COMMA, NO PARAMETERS JMP PRAMS,I NO PRAMS., EXIT CPA LPARN MUST HAVE LEFT PARENTHESIS RSS JMP ERR1 NONE, ERROR EXIT ISZ PRAMS SET RETURN ADDRESS JMP PRAMS,I * LPARN OCT 50 SKP * * SUBROUTINE TO DETERMINE TYPE OF PARAMETER. * POSSIBLE TYPES (I,R,IA,RA,IV,RV,IVA,RVA). * * 0 = I * 1 = R * 2 = IA * 3 = RA * 4 = IV * 5 = RV * 6 = IVA * 7 = RVA * * ABOVE VALUES STORED IN "TYPE" ON EXIT. * PARAM NOP CLB STB TYPE INIT TYPE JSB NXTC GET NEXT CHAR. JMP ERR1 NONE, ERROR EXIT CPA I = I? JMP PARA1 YES CPA R = R? RSS YES JMP ERR1 NO, ERROR EXIT ISZ TYPE PARA1 JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT LDB B2 CPA RPARN RIGHT PARENTHESIS? JMP PARA3 YES, EXIT CPA COMMA COMMA? JMP PARA3 YES, EXIT CPA A = A? JMP PARA4 YES CPA V = V? RSS Á‘<:6YES JMP ERR1 NO, ERROR EXIT LDB B4 ADB TYPE STB TYPE JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA A = A? JMP PARA5 YES PARA6 CPA RPARN RIGHT PARENTHESIS? JMP PARA3 YES, EXIT CPA COMMA COMMA? JMP PARA3 YES, EXIT JMP ERR1 NO, ERROR EXIT PARA5 LDB TYPE SET PARAMTER TYPE ADB B2 STB TYPE JMP PARAM,I * PARA3 JSB BAKUP BAKUP INPUT STRING JMP PARAM,I * PARA4 ADB TYPE STB TYPE JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE JMP PARA6 * A OCT 101 I OCT 111 R OCT 122 V OCT 126 * TYPE NOP SKP A¥<ÿÿþú* * SUBROUTINE TO FORMAT OUTPUT BUFFER FOR DBL * INSTRUCTION WORDS 1, 2, AND 3. * OTPUT NOP LDA PRMCT 16 PARAMETERS? CPA D16 JMP ERR1 YES, ERROR EXIT LDB OTBL OUTPUT BUFFER ADDRESS STB OUTBL LDA ARRAY ADD. OF WORD 1 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER LDA VALRT ADD OF WORD 2 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER LDA CONVT ADD. OF WORD 3 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER JMP OTPUT,I * D16 DEC 16 * OTBL DEF WORD1 * * SUBROUTINE TO GET VALUE FROM DATA BUFFER AND PUT IT * IN THE OUTPUT BUFFER FOR DBL RECORDS. * FORMT NOP ADA TYPE PARAMETER TYPE LDB 0,I GET VALUE FOR PARAMETER LDA PRMCT CMA,INA FORM1 ISZ 0 RSS JMP FORM2 DONE RBL POSITION BIT IN OUTPUT WORD JMP FORM1 FORM2 LDA OUTBL,I MERGE WITH EXISTING OUTPUT WORD IOR 1 STA OUTBL,I ISZ OUTBL JMP FORMT,I * OUTBL NOP SKP * * THE FOLLOWING BUFFERS ARE USED TO LOOK-UP * THE BIT PATTERNS FOR PARAMETERS THAT ARE * PASSED TO THE SUBROUTINE OR FUNCTION. * * * PARAMETER IS AN ARRAY * * ARRAY DEF *+1 OCT 0 I OCT 0 R OCT 1 IA OCT 1 RA OCT 0 IV OCT 0 RV OCT 1 IVA OCT 1 RVA * * PARAMETER IS RETURNED FROM SUBROUTINE * VALRT DEF *+1 OCT 0 I OCT 0 R OCT 0 IA OCT 0 RA OCT 1 IV OCT 1 RV OCT 1 IVA OCT 1 RVA * * CONVERT PARAMETER TO REAL ON RETURN FROM SUBROUTINE * CONVT DEF *+1 OCT 1 I OCT 0 R OCT 1 IA OCT 0 RA OCT 1 IV OCT 0 RV OCT 1 IVA OCT 0 RVèþúA SKP * * SUBROUTINE TO CHECK IF FINISHED PROCESSING PARAMETERS. * EPRAM NOP JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA COMMA COMMA? JMP EPRAM,I YES, MORE PARAMETERS ISZ EPRAM CPA RPARN MUST END WITH RIGHT PARENTHESIS RSS YES JMP ERR1 NO, ERROR EXIT JSB NXTC GET NEXT CHARACTER JMP EPRAM,I NO MORE ISZ EPRAM SET RETURN ADDRESS CPA COMMA COMMA? RSS YES JMP ERR1 NO, ERROR EXIT JMP EPRAM,I * COMMA OCT 54 RPARN OCT 51 * * SUBROUTINE TO CHECK FOR "T=" ASCII CHARACTERS * * TEQUL NOP JSB NXTC2 GET NEXT 2 CHARACTERS CPA T= = T=? JMP TEQUL,I YES JMP ERR1 NO, ERROR EXIT * T= ASC 1,T= SKP * * SUBROUTINE TO DETERMINE IF SUBROUTINE IS TO BE * TREATED AS A FUNCTION (REAL OR INTEGER). * INTRL NOP JSB NXTC2 GET NEXT 2 CHARACTERS CCB CPA IN =IN CLB,INB YES CPA RE =RE CLB YES CPA FT =FT JMP INTR3 YES CPA EN =EN JMP INTR1 YES SSB IF NONE OF ABOVE JMP ERR1 ERROR EXIT LDA 1 SAVE TYPE OF SUBROUTINE RAR STA WORDX JSB NXTC2 GET NEXT 2 CHARACTERS LDB WORDX INTEGER? SSB JMP TGCHK YES CPA AL =AL? RSS YES JMP ERR1 NO, ERROR EXIT INTR2 LDA MNEG SET FUNC BIT IF EITHER REAL OR INTG STA FUNC JSB NXTC GET NEXT CHARACTER JMP INTRL,I NO MORE CPA COMMA =COMMA? RSS YES JMP ERR1 NO, ERROR EXIT JSB NXTC2 GET NEXT 2 CHARACTERS CPA FT =FT JMP INTR3 YES INTR4 ISZ INTRL SET RETURN ADDRESS CPA EN =EN? RSS YES JMP ERR1 ¥ìþú NO, ERROR EXIT JMP INTRL,I TGCHK CPA TG =TG? JMP INTR2 YES JMP ERR1 NO, ERROR EXIT INTR1 ISZ INTRL SET RETURN ADDRESS JMP INTRL,I * INTR3 JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA N =N RSS JMP ERR1 NO, ERROR EXIT LDA MNEG SET FTN BIT STA FTN JSB NXTC GET NEXT CHARACTER JMP INTRL,I NO MORE, EXIT CPA COMMA =COMMA RSS JMP ERR1 NO, ERROR EXIT JSB NXTC2 GET NEXT 2 CHARACTERS JMP INTR4 CHECK FOR ENT * AL ASC 1,AL EN ASC 1,EN FT ASC 1,FT IN ASC 1,IN RE ASC 1,RE TG ASC 1,TG * N OCT 116 SKP * * SUBROUTINE TO PUT DBL RECORD IN OUTPUT BUFFER. * A REGISTER ON ENTRY CONTAINS ADDRESS OF OUTPUT * BUFFER. * DBLRC NOP LDB LDADR CALCULATE ADB IDNUM ADB WORD1 ADB WORD2 CHECKSUM ADB WORD3 ADB B1601 STB CKSUM AND SAVE LDB TABL4 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -9 DATA BUFFER LENGTH LDA LDADR INCREMENT LOAD ADDRESS ADA B4 BY 4 STA LDADR AND SAVE JMP DBLRC,I * * DBL RECORD DATA * TABL4 DEF *+1 RLCNT OCT 4400 INSTR OCT 60104 CKSUM OCT 0 LDADR OCT 0 RLIND OCT 100000 IDNUM OCT 0 WORD1 OCT 0 WORD2 OCT 0 WORD3 OCT 0 * B1601 OCT 160104 SKP * * SUBROUTINE TO DETERMINE IF INPUT IS FROM A PHOTO-READER. * IF YES, SET X = 1 ON EXIT. * X NOP IDCB1 NOP ERRP3 NOP RWIND NOP JSB .ENTR DEF X LDA IDCB1 DATA CONTROL BUFFER OF INPUT FILE JSB LOCFS GET ITS LOGICAL UNIT JMP WIND1 ERROR JSB EXEC DETERMINE INPUT TYPE DEF *+4 DEF D13 DEF JLU DEF IEQT5 CLB LDA IEQT5 AND B374K CPA B400 PHOTO-READER? CLB,INã9þúB YES STB X,I SAVE INPUT TYPE CLA,RSS WIND1 CLA,INA STA ERRP3,I SET ERROR CODE JMP RWIND,I * B400 OCT 400 B374K OCT 37400 D13 DEC 13 * IEQT5 NOP JLU NOP SKP * * SUBROUTINE TO OUTPUT THE ENTRY RECORD ENT MNTBL * * ENT MNTBL * IBUF7 NOP ENTMT NOP JSB .ENTR DEF IBUF7 LDA LDADR SET LOAD ADDRESS STA LDAD1 ADA B2662 CALCULATE STA CKSU1 CHECKSUM AND SAVE LDA IBUF7 OUTPUT BUFFER ADDRESS LDB TABL5 ENTRY RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -7 DATA BUFFER LENGTH JMP ENTMT,I * * ENTRY RECORD DATA * TABL5 DEF *+1 OCT 3400 OCT 40001 CKSU1 OCT 0 OCT 46516 OCT 52102 OCT 46000 LDAD1 OCT 0 * B2662 OCT 26621 SKP * * SUBROUTINE TO OUTPUT THE DBL RECORD MNTBL DEC -X * (WHERE X = TO THE NUMBER OF SUBROUTINES DEFINED * IN THE BRANCH TABLE). * * MNTBL DEC -X * IBUF8 NOP NUMBR NOP ENTMN NOP JSB .ENTR DEF IBUF8 LDA LDADR SET LOAD ADDRESS STA LDAD2 ISZ LDADR INCREMENT LOAD ADDRESS FOR 1ST DBL REC LDA NUMBR,I NUMBER OF SUBROUTINES CMA,INA STA MNTBL SAVE FOR DBL RECORD ADA LDAD2 CALCULATE ADA B6010 CHECKSUM STA CKSU2 AND SAVE LDA IBUF8 OUTPUT BUFFER ADDRESS LDB TABL6 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -6 DATA BUFFER LENGTH JMP ENTMN,I * * DBL RECORD DATA * TABL6 DEF *+1 OCT 3000 B6010 OCT 60101 CKSU2 OCT 0 LDAD2 OCT 0 OCT 0 MNTBL OCT 0 SKP * * SUBROUTINE TO PARSE SOURCE FILE AND CREATE * RELOCATEABLE MNEMONIC TABLE OUTPUT. * IBUF9 NOP LEN2 NOP IBF10 NOP IERR2 NOP NUM NOP PARS2 NOP JSB .ENTR DEF IBUF9 LDA PARS2 SET RETURN ADDRESS STA PARS1 ”Þþú LDA IERR2 SET ERROR RETURN ADDRESS STA IERR LDA LEN2,I INPUT LENGTH LDB IBUF9 INPUT BUFFER JSB INIT GO INITIALIZE LDA OTBL MOVE SUROUTINE NAME TO OUTPUT JSB MOVE. BUFFER JSB ADPAR ADD LEFT PAREN IF PARAMETERS EXIST JMP PARSM INPUT BUFFER EMPTY JMP PARSN NO PARAMETERS, CHECK IF FUNC. SUB. JSB PRAMS CHECK IF THERE ARE ANY PARAMETERS JMP PARSM INPUT BUFFER EMPTY JMP PARSN NO PARAMETERS, CHECK IF FUNC. SUB. PARSL JSB PARAM CHECK FOR NUMBER OF PARAMETERS ISZ PRMCT INCREMENT # OF PARAMETERS JSB EPRAM DONE WITH PARAMETERS? JMP PARSL NO, GET NEXT ONE JMP PARSM YES, INPUT BUFFER EMPTY PARSN JSB INTRL CHECK FOR FUNCTION SUBROUTINE NOP FORGET ENTRY POINT NAME PARSM JSB DBLR2 FORMAT DBL RECORD LDA CHRCT SAVE RECORD LENGTH ADA B6 STA NUM,I JMP PARS2,I * CHRCT NOP * B40 OCT 40 SKP * * SUBROUTINE TO OUTPUT THE END RECORD * IBUFA NOP ENDRC NOP JSB .ENTR DEF IBUFA LDA IBUFA OUTPUT BUFFER ADDRESS LDB TABL7 END RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -4 DATA BUFFER LENGTH JMP ENDRC,I * * END RECORD DATA * TABL7 DEF *+1 OCT 2000 OCT 120000 OCT 120000 OCT 0 * * SUBROUTINE TO ADD LEFT PARENTHESIS TO THE DBL RECORDS FOR * ALL MNEMONIC TABLE ENTRIES THAT HAVE AT LEAST ONE PARAMETER. * ADPAR NOP JSB NXTC GET NEXT CHARACTER JMP ADPAR,I NO MORE, DON'T ADD LEFT PAREN. ISZ ADPAR SET RETURN ADDRESS CPA COMMA COMMA? JMP ADPAR,I YES, NO PARAMETERS ISZ ADPAR SET RETURN ADDRESS CPA LPARN LEFT PARENTHESIS? JMP ADPA3 YES JMP ERR1 ERROR EXIT ADPA4 JSB BAKUP BACKUP INPUT JMP ADPAR,I ADPA3 LDA MOVE3,I ADD LEFT PAENTHESIS zþú AND UPCM LDB CHRCT SLB,RSS TO JMP ADPA1 UPPER CHARACTER IF EVEN IOR LPARN AND LOWER CHARACTER IF ODD STA MOVE3,I AND SAVE ADPA2 ISZ CHRCT ADD ONE TO CHAR COUNT FOR PAREN JMP ADPA4 EXIT ADPA1 ISZ MOVE3 GET DESTINATION ADDRESS LDA LPBLK ADD LEFT PAREN-BLANK STA MOVE3,I JMP ADPA2 * LPBLK ASC 1,( SKP * * SUBROUTINE TO GET NEXT 2 ASCII CHARACTERS * NXTC2 NOP JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT ALF,ALF SHIFT TO UPPER BITS STA WORDA JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT IOR WORDA MERGE WITH FIRST CHARACTER JMP NXTC2,I * WORDA NOP SKP * * SUBROUTINE TO PUT THE MNEMONIC TABLE DBL * RECORD INTO THE OUTPUT BUFFER. * DBLR2 NOP LDA FUNC FUNCTION SUBROUTINE STA IDNUM -Y-X WORD LDA PRMCT WHERE Y = NUMBERS OF PARAMETERS ALF IOR IDNUM AND IOR CHRCT X = # OF CHARS. IN NAME STA IDNUM CLA REL INDICATOR = ABSOLUTE STA RLIND LDA CHRCT CONVERT NUMBER OF CHARACTERS INA IN NAME TO WORDS ARS STA CHRCT ADA B6 DBL RECORD LENGTH ALF,ALF IS 6 MORE STA RLCNT SAVE IN DBL RECORD LENGTH WORD LDA CHRCT SET WORD 2 OF DBL RECORD ADA B6010 STA INSTR LDA INSTR CALCULATE ADA LDADR ADA RLIND ADA IDNUM ADA WORD1 CHECKSUM ADA WORD2 ADA WORD3 STA CKSUM AND SAVE LDA CHRCT GET TOTAL RECORD LENGTH ADA B6 CMA,INA STA NUMWD LDA IBF10 OUTPUT BUFFER ADDRESS LDB TABL4 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER NUMWD DEC -9 DATA BUFFER LENGTH LDA LDADR ADJUST LOAD ADDRESS INA ADA _þúCHRCT STA LDADR JMP DBLR2,I SKP * * * ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP LDA QQCNT DECREMENT CHAR COUNT ADA M1 STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB M1 DECREMENT POINTER STB QQPTR JMP BAKUP,I * M1 DEC -1 SKP * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COM%þúMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 SKP * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I * B377 OCT 377 * CCNT NOP COUNTER CNT NOP OFFSET COUNTER CNTR NOP NUMBER OF ENTRIES TO SEARCH NCHAR NOP NUMBER OF CHARACTERS PTR NOP MNEMONIC TABLE ADDRESS PTR2 NOP POINTER TO ASCII COMMAND QQCN1 NOP CHARACTER STREAM QQPT. NOP POINTERS TEMP NOP TEMP STORAGE SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS CLA,INA STA CHRCT JSB NXTC GET NEXT NON BLANK CHAR JMP ERR1 NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA LPARN LEFT PAREN? JMP MOV02 CPA B40 BLANK JMP MOV02 CPA COMMA JMP MOV02 ISZ CHRCT IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA LPARN LEFT PAREN? JMP MOV02 CPA B40 BLANK? JMP MOV02 CPA COMMA JMP MOV02 ISZ CHRCT ISZ MOVE3 BUMP OUTPUT‘­þú POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA CHRCT MORE THAN 5 CHARACTERS CMA,INA ADA B5 SSA JMP ERR1 YES LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I YES, BUFFER IS OK IOR B40 NO, APPEND A BLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I * B5 OCT 5 * MOVE3 NOP DESTINATION ADDRESS * SPC 1 SKP * * SUBROUTINE TO GET LOGICAL UNIT NUMBER OF FILE * LOCFS NOP STA IDCB JSB LOCF DEF *+8 DEF IDCB,I DCB BUFFER DEF IERR ERROR CODE DEF IREC NEXT RECORD NUMBER DEF IRB RELATIVE BLOCK OF NEXT READ DEF IOFF BLOCK OFFSET OF NEXT READ DEF JSEC NUMBER OF SECTORS IN THE FILE DEF JLU FILE LOGICAL UNIT SSA,RSS ISZ LOCFS JMP LOCFS,I * IDCB NOP IOFF NOP IRB NOP IREC NOP JSEC NOP SKP * * SUBROUTINE TO INPUT-OUTPUT FROM-TO SESSION CONSOLE. * MESSI NOP CMA,INA STA IL MESSAGE LENGTH STB IBUF MESSAGE ADDRESS LDA MESSI,I STA INOUT INPUT OR OUTPUT ISZ MESSI JSB IMESS DEF *+4 DEF INOUT INPUT/OUTPUT MESSAGE DEF IBUF,I MESSAGE ADDRESS DEF IL CHARACTER COUNT JMP MESSI,I * IL NOP INOUT NOP * * SUBROUTINE TO CONVERT ASCII INPUT TO DECIMAL OUTPUT. * PNMRA NOP JSB NXTC GET NEXT CHARACTER JMP PNMRA,I NO MORE JSB BAKUP LDA BLANK STA BUFA1+1 STA BUFA1+2 LDA BUFAD JSB MOVE. PUT ASCII CHARS IN BUFFER JSB PARSE PARSE INPUT DEF *+4 DEF BUFA1 DEF B6 DEF RBUF LDA RBUF+1 ISZ PNMRA JMP PNMRA,I BUFAD DEF *+1 BUFA1 BSS 3 RBUF BSS 33 SKP ** NXTC ** GET NEXT NON-BL=<:6ANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP *-3 YES ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. ISZ QGETC SKIP EXIT JMP QGETC,I * B177 OCT 177 * SKP SKP END åM<ÿÿ ÿýZt ÿ92065-18013 1726 S C0122 &ACFIL BASIC FILE HANDLER             H0101 ¤ÌþúASMB,R,L NAM ACFIL,7 92065-16008 REV 1726 770512 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * * SOURCE 92065-18013 * * ENT MVNAM,FILRD,FILWR,CLFIL EXT READF,CLOSE,CREAT,OPEN,WRITF EXT $LIBR,$LIBX,$CVT1,.ENTR,EXEC EXT NAMR,.MBT,GETCR,.ENTR,EXEC COM TEMPS(30),PNTRS(61),SPEC(10) TTYPR EQU PNTRS+34 FLFIL EQU PNTRS+39 A EQU 0 B EQU 1 * DCB NOP REP 15 NOP BSS 128 * IPBUF BSS 10 .PARAMETER BUFFER FOR NAMR INBUF BSS 14 .NAMR INPUT BUFFER LENTH NOP .INPUT TEXT LENGTH ISTRC NOP * .1 OCT 1 M26 DEC -26 DPBUF DEF IPBUF CHAR NOP TEMP NOP SOUR DBR CHAR DEST DBL INBUF .DESTINATION BYTE ADDRESS SKP *************************************************** * * * THIS ROUTINE WILL MOVE THE FILENAME INTO A * * BUFFER FOR NAMR PROCESSING. THE FIRST CHARATER * * IS IN THE A REGISTER THE RETURN IS THROUGH * * P+2 TO INDICATE THE MODULE IS PRESENT FOR BASIC* * THE RETURN TROUGH P+1 IS FOR THE DUMMY VERSION * * OF THIS ROUTINE * *************************************************** * * MVNAM NOP STA CHAR .SAVE FIRST CHAR LDA M26 STA TEMP .CLEAR BUFFERS LDA DPBUF CLB AGAIN STB A,I INA ISZ TEMP JMP AGAIN * LDA .1 .SET FIRST CHARACTER COUNT STA ISTRC LDB DEST .SET UP FOR MOVING NAMR STB TEMP . INTO THIS ROUTINE TOP LDA SOUR JSB .MBT .MOVE THE CHARACTER DEF .1 NOP ÉŸþú ISZ LENTH STB TEMP .SET UP FOR NEXT CHARACTER JSB GETCR JMP DONE .MOVE CHARACTERS UNTIL EOR STA CHAR LDB TEMP JMP TOP * DONE JSB NAMR .PROCESS NAMR RECORD DEF *+5 DEF IPBUF DEF INBUF DEF LENTH DEF ISTRC * ISZ MVNAM JMP MVNAM,I .EXIT WITH NAMR PROCESSED SKP ***************************************************** * * * THIS IS THE FILE READ ROUTINE FOR RETREIVING * * BASIC PROGRAMS FROM DISC. THIS ROUTINE WILL * * OPEN A SPECIFIED FILE IF NOT OPEN ALREADY. AND * * WILL GENERATE AN FMGR ERROR MESSAGE IF ANY FMP * * ERRORS ARE RETURNED * ***************************************************** * * M1 DEC -1 ZERO NOP IERR NOP ALEN NOP * BLEN DEF * BLOC DEF * FILRD NOP JSB .ENTR .FETCH PARAMETERS DEF BLEN * LDA DCB+9 CPA 1717B .CHECK FOR OPEN JMP RD3 .YES OPEN JSB DOOP .NO OPEN IT * RD3 LDB BLEN,I CMB,INB .CHANGE TO POSITIVE AND CLE,ERB . DIVIDE BY 2 SEZ .ADD ONE FOR ODD # CHAR INB STB TEMP * RD1 JSB READF DEF RD2 .READ A RECORD DEF DCB DEF IERR DEF BLOC,I DEF TEMP DEF ALEN DEF ZERO * RD2 LDA IERR SSA .FMP ERROR ? JSB ERROR .PRINT ERROR MESSAGE LDA ALEN .SET REGISTERS CLE,ELA .A= NUMBER ACTUAL CHARACTERS LDB IERR .B= FMP ERROR CODE JMP FILRD,I SKP **************************************************** * * * THIS ROUTINE WILL WRITE A RECORD OF BASIC * * SOURCE TO A FILE ON DISC. IT WILL OPEN OR * * CREATE A FILE IF IT IS NOT ALREADY OPEN * * IT WILL GENERATE A FMGR ERROR MESSAGE FOR ANY * L¦þú* ERROR RETURN FROM A FMP CALL * **************************************************** * * UBYTE OCT 177400 LSPC OCT 40 * BFLEN DEF * BFLOC DEF * FILWR NOP JSB .ENTR .FETCH PARAMETERS DEF BFLEN * LDA DCB+9 .CHECK FOR FILE OPEN CPA 1717B JMP WR3 .YES OPEN JSB OP.CR .OPEN OR CREATE IT * WR3 LDB BFLEN,I .MAKE BUFFER LENGTH POSITIVE CMB,INB CLE,ERB . AND DIVIDE BY 2 SEZ INB ADD ONE FOR ODD STB TEMP SEZ,RSS .PAD WITH BLANK? JMP WR1 .NO ADB M1 .COMPUTE LAST WORD ADDRESS ADB BFLOC LDA B,I .FETCH LAST WORD OF BUFFER AND UBYTE .REMOVE LOW BYTE IOR LSPC .INSERT A SPACE STA B,I . SET INTO THE BUFFER * WR1 JSB WRITF .WRITE THE RECORD DEF WR2 DEF DCB DEF IERR DEF BFLOC,I DEF TEMP * WR2 LDA IERR SSA .ERROR? JSB ERROR .PRINT FMP MESSAGE WR4 CLA LDB IERR .SET A = 0 SET B=FMP ERROR CODE JMP FILWR,I .EXIT SKP **************************************************** * * * CHECK FOR FILE EXISTANCE - CREATE ONE IF NOT * * * **************************************************** * * .4 DEC 4 M6 DEC -6 OP.CR NOP JSB OPEN .TRY TO OPEN THE FILE DEF OP.1 DEF DCB DEF IERR DEF IPBUF DEF ZERO DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.1 LDA IERR .FILE NOW OPEN? SSA,RSS .NO TRY TO CREATE IT JMP OP.CR,I .YES RETURN CPA M6 .SIMPLY NOT FOUND ? JMP OP.2 .CREATE JSB ERROR .NO SOME OTHER PROBLEM JMP WR4 .PRINT MESSAGE AND GO * * CREATE IT * OP.2 LDA .4 .FORCE TO TYPE 4 STA =þúIPBUF+6 LDA IPBUF+7 .SIZE DECLARED ? LDB LSPC SZA,RSS .IF NOT FORCE TO 32 BLOCKS STB IPBUF+7 JSB CREAT DEF OP.3 DEF DCB DEF IERR DEF IPBUF .NAME DEF IPBUF+7 .SIZE DEF IPBUF+6 .TYPE DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.3 LDA IERR .CREATED PROPERLY ? SSA,RSS JMP OP.CR,I .YES CONTINUE WITH WRITE JSB ERROR .NO PRINT FMGR MESSAGE JMP WR4 .EXIT WITH NO WRITE SKP ************************************************ * * * OPEN FOR READ A RECORD * * * ************************************************ * * DOOP NOP JSB OPEN DEF OOP.1 DEF DCB DEF IERR DEF IPBUF .NAME DEF ZERO DEF IPBUF+4 .SECURITY CODE DEF IPBUF+5 .CRN * OOP.1 LDA IERR SSA,RSS .ERROR? JMP DOOP,I .NO JMP RD2 .YES PRINT MESSAGE * ******************************************************* * * * CLOSE THE PROGRAM FILE * * ******************************************************* * CLFIL NOP JSB CLOSE .CLOSE THE FILE DEF CL.1 DEF DCB DEF IERR DEF ZERO * CL.1 CLA .RESET FILE FLAG STA FLFIL LDA IERR .CHECK FOR CLOSE ERROR SZA,RSS JMP CLFIL,I .NO ERROR JSB ERROR .PRINT ERROR MESSAGE JMP CLFIL,I SKP ********************************************** * * * FMP ERROR MESSAGE PRINT * * * ********************************************** * TWO DEC 2 M8 DEC -8 ERROR NOP JSB $LIBR NOP LDê7A IERR LDB SPMIN .SET BUFFER TO - OR + SSA,RSS LDB SPSP .IT IS + STB PBUF+2 SSA CMA,INA .MAKE ERROR CODE POSITIVE CCE .SET FOR DECIMAL CONVERTION JSB $CVT1 .CONVERT TO ASCII STA PBUF+3 JSB $LIBX .EXIT PRIVILEDGED MODE DEF *+1 DEF *+1 JSB EXEC .WRITE OUT TO CONSOLE DEF ERR.1 DEF TWO DEF TTYPR DEF PBUF DEF M8 * ERR.1 JMP ERROR,I PBUF ASC 4,FMGR SPMIN ASC 1, - SPSP ASC 1, END ›pÿÿ ÿý[ e ÿ92065-18014 1726 S C0122 &DUFIL DUMMY FILE HANDLER             H0101 ÉçASMB,R NAM DUFIL,7 92065-16009 REV 1726 770512 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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. * ************************************************************** * * * * SOURCE 92065-18014 * * ENT MVNAM,FILRD,FILWR,CLFIL EXT EXEC,PRMT COM TEMPS(30),PNTRS(61),SPEC(10) LUOUT EQU PNTRS+28 A EQU 0 B EQU 1 FLFIL EQU PNTRS+39 * ENTRY NOP CLA RESET FILE FLAG STA FLFIL * JSB EXEC .OUTPUT ERROR MESSAGE DEF EXIT DEF TWO DEF LUOUT DEF ERRBF DEF BFLEN * EXIT JMP ENTRY,I * TWO DEC 2 ERRBF ASC 15, ERROR - FILE HANDLER ABSENT BFLEN DEC -29 * MVNAM EQU ENTRY FILRD EQU ENTRY FILWR EQU ENTRY CLFIL EQU ENTRY END U,ÿÿ ÿý\b ÿ92065-18015 2001 S C0122 &MBASR BASIC NAM REC (SOURCE)             H0101 0¥ASMB,R * * NAME: MBASR * SOURCE: 92065-18015 * PROGMR: RICH * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM MBASR 92065-16001 REV.2001 791019 END @ÿÿ ÿý]c ÿ92067-18001 1805 S C0122 &4PVMP RTE-IV PRIV. MAPPING ROUT.            H0101 J†þúASMB,R,L,C ** RTE-IV PRIVILEGED MAPPING SUBROUTINE ** HED RTE-IV PRIVILEGED DRIVER'S MAPPING SUBROUTINE * DATE: 8/17/77 * NAME: PVMP4 * SOURCE: 92067-18001 * RELOC: 92067-16001 * PGMR: E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PVMP4,8 92067-16001 REV.1805 771219 ENT $PVMP EXT $DVPT,$MATA,$MRMP A EQU 0 B EQU 1 * * * * ****************** NOTICE ********************** * ** $PVMP IS DESIGNED FOR USE BY PRIVILEGED ** * ** DRIVERS. EXTREME CAUTION SHOULD BE TAKEN ** * ** BY THE DRIVER WHEN CHANGING THE USER MAP. ** * ** ** * ** THE USER MAP MUST BE SAVED BEFORE CALLING ** * ** $PVMP AND THEN RESTORED BEFORE RETURNING ** * ** CONTROL TO THE POINT OF INTERRUPT!!! ** * ****************** NOTICE ********************** * * CALLING SEQUENCE: * * LDA IDADR (A) HAS ID SEG ADDR * JSB $PVMP CALL SUBROUTINE TO MAP USER * (A)=0 ERROR, PROG NOT IN PTTN * (A)#0 OK, PROGRAM MAPPED * * * * $PVMP NOP CALLED ONLY BY PRIVILEGED DRIVERS STA XIDA TEMP SAVE OF ID ADDR LDB A ADA D8 LDA A,I GET PROG'S POINT OF SUSPENSION SZA,RSS IF IT IS ZERO, TAKE JMP $PVMP,I ERROR EXIT, (A)=0 * ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP * ADB D7 GET MPID WORD LDA B,§„þúI AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR STA XMAT SAVE MAT ENTRY ADDR ADA D2 LDA A,I CPA XIDA IS PROG STILL IN PARTITION? JMP XDMOK YES ,CONTINUE * CLA NO, ERROR JMP $PVMP,I RETURN (A)=0 * XDMOK CCA CAX (X)=-1 READ 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DFDMR (B)=ADDR OF SAVE AREA XMM SAVE REG USED FOR MAPPING USER BP * LDB XMAT (B)=MATA ENTRY ADDR ADB D3 FOR SAVE & RESTORE MAP REGS LDA B,I GET PTTN'S FIRST PAGE # AND B1777 WHICH IS THE PHYSICAL BP STA B (B) = PAGE # OF BP CLA,INA CAX (X) = 1 TO SET ONE REGISTER LDA $DVPT (A)=REG # OF DRIVER PARTITION XMS MAP IN THE PHYSICAL BP * LDA $DVPT GET DRIVER PTTN PAGE # ALF,ALF SHIFT TO BITS 10-14 RAL,RAL TO FORM LOGICAL ADDRESS IOR B1740 OFFSET TO BP COPY AREA USA SET USER MAP REGISTERS * CLA,INA CAX (X)=1 WRITE 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DVMPR (B)=SAVED DRIVER PTTN REG VALUE XMS RESTORE REG USED FOR MAPPING USER BP JMP $PVMP,I RETURN (A)=NONZERO * MRPV LDA $MRMP USA SET MEM RES MAP JMP $PVMP,I RETURN (A)=NONZERO * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 B77 OCT 77 B1740 OCT 1740 B1777 OCT 1777 MATSZ EQU D7 XIDA NOP XMAT NOP DFDMR DEF DVMPR ADDR OF STORAGE FOR DRIVER MAP REG DVMPR NOP DRIVER MAP REGISTER CONTENTS * BSS 0 SIZE OF SUBROUTINE END 9) ÿÿ ÿý^f ÿ92067-18002 2013 S C1222 &4LDR RTE-IVA LOADER             H0112 ˜8þúASMB,Q,C,N * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-IV <2013> IFN NAM LOADR,4,90 92067-16002 REV.2013 791211 XIF IFZ NAM LOADR,4,90 92067-16446 REV.1913 790502 XIF * * ENT LOADR * * EXT $MATA,NAMR EXT $MNP,$MBGP,$MRTP,$MCHN,$SDA,$COML EXT $PLP,$DLP,$IDEX EXT REIO,OPEN,CLOSE,READF,$CVT3,LURQ,LOGLU EXT LOCF,APOSN,WRITF,CREAT,POST,POSNT EXT IFBRK,EXEC,$LIBR,$LIBX,PRTN EXT FTIME IFZ EXT .OWNR,PTERR,$SSCT,$STRK XIF * * NAME: RTE LOADER * SOURCE: 92067-18002 * RELOC: 92067-16002 * PGMR: C.M.M. * SUP PRESS EXTRANIOUS LISTING * SKP *1 LOADR ERROR CODES *0 ALL LOADR ERRORS ARE REPORTED TO THE LIST DEVICE. THE LIST * DEVICE MAY BE SPECIFIED AT LOAD TIME OR DEFAULTED. THE DEFAULT * LIST DEVICE IS SPECIFIED UNDER 'LIST = ' AT THE BEGINING OF THIS * DOCUMENT. * THE LOADR ERROR CODES ARE LISTED BELOW. NOTE THAT ERROR CODES * 19, 20, 21, 22, REFER TO RTE 4 ONLY. ERROR CODE 23 REFERS TO * RTE 3 ONLY. *0 LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * * 01 * - CHECKSUM ERROR (WAS IT A RELOCATABLE FILE ?) * 02 * - ILLEGAL RECORD * 03 * - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * (YOUR PROGRAM + MSEG SIZE IS TOO LARGE) * 04 * - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) * 05 * - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) * 06ÙÉþú * - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) * 07 * ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) * 08 - NO TRANSFER ADDR (ONLY SUBROUTINES WERE LOADED WHERE'S THE MAIN?) * 09 * - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) * 10 - ILLEGAL PARAMETER IN RU STATEMENT OR IN STATEMENT PRIOR TO * A RELOCATE STATEMENT. * 11 - ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) * 14 * - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T * 16 - ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 18 - REQUESTED # OF PAGES EXCEEDS LARGEST POSSIBLE * ADDRESS SPACE FOR THAT PROGRAM. * 19 - EMA DECLARED TWICE OR DECLARED IN A PROGRAM SEGMENT * OR A REFERENCE TO THE EMA LABEL BEFORE THAT LABEL WAS * DECLARED EMA OR AN ATTEMPT TO DECLARE THE SAME LABEL AS * AN ENT RECORD (IE DUPLICATE ENT). EMA MUST BE DECLARED * IN THE MAIN. ANY INDIVIDUAL RELOCATABLE MODULES THAT * PRECEED THE MAIN MAY NOT HAVE EMA REFERENCES. EMA * REFERENCES MAY APPEAR ANYWHERE IN THE MAIN. EMA REFERENCES * IN SEGMENTS OR SUBROUTINES MAY APPEAR ANYWHERE WITHIN THE * MODULE BUT THAT MODULE MUST NOT BE RELOCATED BEFORE THE MAIN * 20 - NO ID EXTENSIONS AVAILABLE FOR YOUR EMA PROGRAM * 21 - PROGRAMS EMA SIZE IS TOO LARGE FOR CURRENT SYSTEMS * PARTITIONS. * 23 - ATTEMPT TO LOAD A SEGMENTED PROGRAM INTO REAL TIME PARTITION. * 24 - ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. * 25 - ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTEèUþúRED WITHIN A FILE. * 26 - NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH LOAD. * THIS ERROR CODE IS EXTREMELY RARE. IT CAN OCCUR WHEN * LOADING A SEGMENTED PROGRAM WHERE THERE WERE ENOUGH * LONG + SHORT ID SEGMENTS TO SUCCESSFULLY LOAD THE LAST * SEGMENT IN THE PROGRAM WHILE THE LAST SEGMENT LOAD WAS * GOING ON. HOWEVER, WHEN THE LOADR WENT TO CREATE THE * ID SEGMENTS NOT ENOUGH LONG + SHORT SEGMENTS WERE FOUND. * IN THIS CASE SOME ID SEGMENTS WERE CREATED BUT OTHERS * WERE NOT. IF THE PROGRAM IS RUN AN SC05 ERROR WOULD * RESULT. THE CORRECT ACTION IS TO OFF OR PURGE ALL ID'S * CREATED, FREE UP ADDITIONAL ID SEGMENTS, AND PERFORM THE * LOAD OVER AGAIN. * 27 - ATTEMPT TO ACCESS AN EMA EXTERNAL (ARRAY) WITH OFFSET * OR INDIRECT. TO ACCESS EMA ARRAYS USE THE H-P SUPPLIED * SUBROUTINES .EMAP & .EMIO . * 28 - UNDEFINED EXTERNALS EXIST. THIS IS PROBABLY THE MOST * COMMON ERROR FOR THE LOADR. BASICLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. * 29 - ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF * THAT PROGRAM EXIST. THE PROGRAM CAN'T BE PURGED BECAUSE * THE DISC SPACE CAN'T BE RELEASED OR THE OTHER PROGRAMS * WILL BE OUT TO LUNCH. THE PROPER COURSE HERE IS TO GET * RID OF ALL THE COPIED PROGRAMS (VIA OF,XXXXX COMMAND) AND * TRY THE LOAD AGAIN. * 30 - ATTEMPT TO REPLACE A COPIED PROGRAM. THE 'OP,RP' COMMAND * MAY NOT BE USED WITH A COPY OF A PROGRAM. YOU MUST REPLACE * THE ORGINAL. * 31 - L O A D R AND ONLY THE PROGRAM NAMED L O A D R MAY DO PERMINANT * LOADS OR PURGES. * 32 - DUPLICATE PROGRAM NAME. YOU HAVE ALREADY LOADED THE * SAME PROGRAM TWICE WITHOUT OFFING THE ORIGINAL. WE * WERE NICE THE SECOND TIME AND RENAMED YOUR PROGRAM * CALLED XXXXX TO ..XXX THE THIRD TIME WE DON'T RENAME. * 33 - NOT ENO&ÕþúUGH ID SEGMENTS TO FINISH THE LOAD. CALL THE * SYSTEM MANAGER TO FREE UP SOME ID SEGS. * 34 - ATTEMPT TO REPLACE A PROGRAM THAT WAS EITHOR NOT * DORMANT OR STILL IN A PARTITION. DO AN ' OF ' ON * THE PROGRAM & TRY AGAIN. * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 32 - DUPLICATE PROGRAM NAME. YOU TRIED TO LOAD A * PROGRAM XXXXX BUT A PROGRAM CALLED XXXXX WAS ALREADY * IN THE SYSTEM, SO WE RENAMED YOUR PROGRAM TO * ..XXX AND CONTINUED THE LOAD. SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM THE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * L * CHAR 1 * CHAR 2 * *..................................................* * U * CHAR 3 * CHAR 4 * *..................................................* * CHAR 5 * ORDINAL * *..................................................* * TYPE * V* * S * *..................................................* * V = 0/1 ABS ADDRESS / BP LINK ADDRESS * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * * * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * Ñœþú BIT 15 = 1 MEANS THE ENTRY IS FROM SYS LIBRARY * BIT 15 = 0 MEANS THE ENTRY FROM MODULE * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * BIT 15 = 1 SYMBOL REFERENCED BY CURRENT MODULE * BIT 15 = 0 SYMBOL NOT REFERENCED BY CURRENT MODULE * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL NUMBER * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 3 - EMA ENTRY THE SYMBOL IS CONSIDERED DEFINED. * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATION ). * V WILL ONLY BE SET IF THE REFERENCE IS TO EMA. * TYPE : * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * TYPE = 0 PROG RELOCATABLE * 1 BP RELOCATABLE * 2 COMMON RELOCATABLE * 3 ABSOLUTE * 4 INSTRUCTION REPLACEMENT * * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP §þú BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THE BUFFERS BELOW AT YOUR UNDYING & EVERLASTING * PERIL !!!!!!! * IDCB3 BSS 144 LIST FILE DCB NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM RECORD BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 COMMAND FILE DCB SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 18 ID INFO TO BE MOVED INTO SYS ID AREA * .BUF EQU * END OF BUFFERS IN OVERLAYED CODE SKP * * ORG IDCB3 * LOAD ASC 3,LOADR * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITIONS IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE SPC 1 LOADR JSB LOGLU GET THE DEFAULT LU DEF *+2 DEF MYLU# STA MYLU# * JSB .OWNR GET THE OWNER WORD FOR THE ID STA OWNER * SPC 1 * THIS CODE IS PLACED HERE BECAUSE IT NEED ONLY EXECUTE * ONCE AND THEN I CAN USÑ-þúE THE AREA FOR OVERLAY PURPOSES SPC 1 * LDA SECT2 GET THE # SECTRS PER TRACK ON LU 2 MPY P64 A = # WORDS PER TRACK STA D6144 SAVE FOR LATER. * LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR XLA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN XLA B,I SET UP LOADR SYMBOL TABLE TO STA BLST START FROM LOADR'S HIGH STA PLST MAIN ADDR AND GROW UP STA TLST TOWARD HIGH CORE. STA SLST STA FLST ADB N7 (B)=ADDR OF LOADR ID'S WORD 15 XLA B,I GET LOADR'S PROG TYPE LDB BKLWA GET ADDR OF LOADR'S LAST WORD AND P7 SPC 1 CPA P2 SKIP IF LOADR IS BG LDB RTLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR * LDB XEQT GET MY ID ADDRESS ADB P12 & CHECK IF I'M 'THE' L O A D R XLA B,I CPA LOAD CHECK 1ST TWO CHARACTERS INB,RSS OK ! ISZ TLOAD SET TEMP LOAD ONLY FLAG XLA B,I CPA LOAD+1 3RD & 4TH CHARS OK ? INB,RSS YES. ISZ TLOAD NO XLA B,I GET LAST CHAR AND M7400 IOR P32 APPEND A BLANK CPA LOAD+2 RSS PERM LOADS OK ! ISZ TLOAD * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ e†þú NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" LDA SYSLN GET # OF,SYSTEM ENTRY POINTS ADA DSCLN ADD # OF USER ENTRY POINTS STA #ENTS TO GET TOTAL # OF ENTS * * SKP JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB GTCMD GET THE COMMAND FILE * * JSB NAMRR NOW GET THE INPUT FILE NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * JSB NAMRR NO, GO GET FMT PARAMETERS SSA JMP SEFIL LDB IPBUF GET THE FIRST OP JSB TEST CHECK IT OUT LDB IPBUF+1 NOW DO THE JSB TEST 2ND ONE LDB IPBUF+2 AND NOW THE LAST JSB TEST ONE. * JSB NAMRR NO, GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL LDA IPBUF GET THE # Ó¢þú STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * ******************CHECK OUT COMMAND FILE********************* * * SEFIL LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA WAS A COMMAND FILE ENTERED ? JMP SEFIX YES * LDB TYPE1 NO CMND FILE. WAS A RELO FILE ENTERED ? SZB WELL . JMP CNFLT YES, NO CMND BUT DO HAVE A RELO FILE * LDA B1777 NO CMND & NO RELO !!!! STA ISTRC FAKE OUT NAMR JSB GTCMD & FORCE A COMMAND ENTRY LU LDA TYPE2 GET THE TYPE * SEFIX ERA,SLA IS IT A FILE OR A LU ? JMP FOPEN A FILE ! JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * M200 OCT 200 MYLU# DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 TLOAD NOP 0 = PERM LOADS OK. SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  * LDA LISTU GET THE LIST LU LDB DOLST AND THE LU LOCK SUB ENTRY POINT SZB,RSS NOW IF DOLST NEVER CALLED SZA AND LIST LU NEVER RESET, THEN JMP CNFL1 SET UP USER CONSOLE AS DEFAULT * CLA,INA SET LU NOT FILE FLAG STA IPBUF+3 * LDA MYLU# CCB SET B TO -1 CPB BATCH BATCH MODE? LDA P6 YES, DEFAULT TO LU 6 STA IPBUF JSB DOLST NOW GO SET THE LU & LOCK IT * CNFL1 LDA EDFLG GET THE EDITING FLAG LDB TLOAD AND THE PERM LOAD OK FLAG. SZA THIS A PERM LOAD ? SZB,RSS THEN THIS BETTER BE THE L O A D R JMP CHEKR OK! * NOPUG LDA ERR31 YOU LOSE JMP ABOR ERR31 ASC 1,31 * * CHEKR LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5Jþú THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * * LDA #PGS DID HE SUPPLY A NEGATIVE SIZE ? SSA WELL ? JMP ER.17 SEND THE TURKEY A LOVE MESSAGE. LDA #PTTN GET THE PART'N SPECIFIED IF ANY SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SSA BUT IF NEG JMP ER.16 FLUSH HIM. SPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * XLA $MNP YES, DO SIZE CHECK NOW. GET MAX # PART'NS * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 7 * (PTTN# - 1) + $MATA MPY P7 IS ADDR OF ENTRY XLB $MATA ADA B XLB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 XLA A,I AND B1777 REMOVE RESERVED FLAG STA #PGPT SAVE #PAGES IN PTTN CMA ADA #PGS ENOUGH PAGES IN SSA SPECIFIED PTTN? JMP PGSOK YES SZA OK IF EQUAL LDA #PGS NO, BUT WAS SPECIFIC SZA SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN XLA $MBGP GET MAX BG PARTN STA #MXBG XLA $MRTP GET MAX RT PARTN STA #MXRT «»þú* * *E * CMMST LDB PTYPE GET THE PROG TYPE XLA $PLP ASSUME ITS A TYPE 2 OR TYPE 3 RBR,RBR IS IT ? SLB,RSS WELL ?! JMP SETLP YES * XLA $DLP NO, ITS A LARGE BG PROG TYPE = 4 LDB COMTP GET THE COMMON TYPE ADB #MPFT ADD IN SSGA SZB,RSS ANY COMMON ? JMP SETLP NO. * XLA $SDA THE FIND PG # OF START OF SYSDVR AREA ALF,ALF CONVERT TO PG # RAL,RAL SETLP STA URFWA SET THE LOAD POINT OF PROG. * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SUBTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA * * LEDT4 LDA COMTP GET THE COMMON TYPE SZA,RSS ANY COMMON JMP LCLCM NO JUST LOCAL COMMON LDB PTYPE GET THE PROG TYPE CPA P1 SYS COMMON OR REVERSE COMMON ? JMP STRAT SYS COMMON. * CPB P2 IS IT A RT PROGRAM ? JMP ITSBG YES, SO USE BG COMMON JMP ITSRT NO, A BG PROG SO USE RT COMMON * STRAT CPB P2 IS IT A RT PROG JMP ITSRT ITSBG LDA P3 SET MPFT FENCE STA #MPFT LDA BKORG GET START OF BG COMMON LDB BKCOM AND THE LENGTH JMP STUF ITSRT LDA P2 STA #MPFT NOW DO RT LIKE BG ABOVE LDA RTORG LDB RTCOM STUF STA COMAD STB MXCOM JMP CMEXI GO LOOK FOR ÛPþúSSGA. * LCLCM CCA SET THE LOCAL COMMON FLAG STA COMIN LDA P5 NOW ASSUME PROG BG OR RT LDB PTYPE GET THE PROG TYPE CPB P4 IS IT A LBG PROG ? CLA YES STA #MPFT * CMEXI LDA P4 WELL, DOES HE WANT SSGA ? LDB SSGA SZB 0/1 NO/YES STA #MPFT * * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPREL SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FROM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA CWABP INITIALIZE ALLOCATION WORD STA SEGB AND SEGMENT BASE PAGE STA IDA ADDRESS OF BASE ID SEG (NONE EXIST YET) STA TLOAD POINTER TO ZAP THE AREA WITH STA TFIX LOW END OF FIXUP TABLE (AGAIN NONE EXIST) LDA BKLWR SET LWA STA LWABP OF AREA * CLA STA MBUF CLEAR VALID MODULE PRESENT FLAG * LDA XEQT GET THE LWA + 1 OF THIS PROGRAM ADA P23 XLA A,I CMA,INA MAKE NEG ADA FWABP ADD START OF DUMMY BASE PAGE SSA ANY OVERLAP JMP LOVER YES, THIS IS A SYMBOL TABLE OVERFLOW * CLA LDI7 STA TLOAD,I DUMMY ISZ TLOAD BASE INB,SZB PAGE JMP LDI7 AREA * LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA MAPOF ALLOCATE ROOM FOR X,Y REGS & MAP REGS STA SEGM SEGMENT BASE STA TPREL HIGHEST USED MEMORY ADDRESS STA PPREL * LDB OPCOD GET THE LAST OPCODE õåNLH CPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. #SECT SHOULD BE 0. * CCB STB NUPLS SET NO. PROGS LOADED = -1 STB PLFLG SET LOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG OMIT ENTERING DEBUG INTO LST gYNÿÿþú SKP * * ENTER '.BBUG' INTO LST * JSB LSTX SET CURRENT LST ADDRES NOP LDA CHRDE GET CHARS . , D STA LST1,I SET NAME 1,2 INTO LST LDA CHRBU GET CHARS B,U STA LST2,I SET NAME 3,4 INTO LST LDA UCHRG GET UPPER CHAR G STA LST3,I SET NAME 5 INTO LST LDA P2 SET LST4 = UNDEF SYMBOL & STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 JMP ABOR * ERR17 ASC 1,17 CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP SKP 2 *********************************************************************** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * L-10 ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP A»þú GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUMP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 17,LIPULBRTSCRCNCSSDBPETERPRSBGLENLDC OPP NOP ERROR CODE LDJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF LB BG PROGRAM (LARGE) DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF BG PRIVLEDGED PROGRAM DEF LE LIST ENTRY POINTS DEF NL NO LISTING DESIRED DEF DC THIS PROGRAM NOT TO BE COPIED ! DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADING THE PROGRAM *AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT *CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * SSGA = 0/1 DON'T USE"`þú / USE SSGA * COMTP = 0 ... NO COMMON ( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * DO3 LDA TYPE2 GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING * DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE CMND TYPE ERB,SLB IF ITS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO LDA TLOAD IS THIS ' THE ' LOADR SZA,RSS YES JMP CHEKR SO ALL'S WELL.ND OK. JMP NOPUG FORGET IT . * LB LDA P4 BACKROUND PROGRAM (LARGE) BG2 STA PTYPE JMP TEST,I RT LDA P2 JMP BG2 BG LDA P3 JMP BG2 * NC CLA,RSS SC CLA,INA SC2 STA COMTP JMP TEST,I RC LDA P3 JMP SC2 * SS CLA,INA STA #MPFT STA SSGA SSGA FLAG JMP TEST,I * DB CLA,INA STA DBFLG STA OPCOD JMP TEST,I * TE CLA,RSS PE CLA,INA PM2 STA EDFLG CLB CLEAR OWNER FLAG SZA FOR PERMINANT STB OWNER LOADS. JMP TEST,I RP LDA P2 JMP PM2 * RS JMP TEST,I THE 'RS' OPTION WAS A MISTAKE. CMM * LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I DC LDA M2000 GET THE DON'T COPY FLAG STA COPY? AND SET UP FOR LATER JMP TEST,I GET THE NEXT COMMAND * * SKP * * THIS ROUTINE SETS UP THE LIST DEVICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB ANY LU SUPPLIED OR IS IT NULL ? JMP DOALU YES, SO FIX THE LU * INB NULL SUPPLIED, SO SET DEFAULT Bªþú STB IPBUF+3 * LDA MYLU# STA IPBUF * * JSB CLOS3 CLOSE ANY OLD FILE * DOALU LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU SZA,RSS IS THERE ONE ? JMP ZIPLU NO . JSB INTER IS IT INTERACTIVE ? RSS NO! JMP ZIPLU YES, DON'T LOCK IT * JSB LURQ UNLOCK ANY PREVIOUS LOCK DEF *+2 DEF MSIGN * JSB LURQ NOW LOCK THE NON INTERACTIVE LU DEF *+4 DEF P1 SPECIFY LOCK DEF IPBUF SPECIFY THE LU DEF P1 AND THE # OF LU'S * LDA IPBUF GET THE LU IOR M200 SET V BIT TO USE COLUMN 1 ZIPLU STA LISTU AND SET IT UP * JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 DEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3 ERROR CODE TO A JSB FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREATEcþú IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP JMP PRERR MUST BE AN ERROR * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES SSA,RSS IF NEG SZA,RSS OR ZERO JMP PRERR IT'S AN ERROR. STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * ********************************************************************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TYPE PRIORITY HIGH MAIN LOW MAIN REQ'D SIZE EMA SIZE PTTN * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "" OR "" * * * LLIST JSB SPACE LDŠþúB LLM1 PRINT LDA P76 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N38 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET XLB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP GTNBR TERMINATION * ADB P12 SET TO NAME AREA. XLA B,I GET NAME 1,2, STA LLM1+1 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB XLA B,I SET NAME 3,4 STA LLM1+2 IN MESSAGE. INB XLA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+3 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * XLA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+5 AND STORE. * XLA B,I GET THE WORD AGAIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * CLB STB OPCOD INSURE AN OCTAL CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN XLA A,I GET IT LDB LLM18 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD XLA A,I LDB LLM13 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LLþúOW BP XLA A,I GET THE WORD LDB LLM23 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP XLA A,I LDB LLM28 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL4 YES * XLB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY XLA B,I GET THE PRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM8 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * LDA ZTEMP GET THE PROG TYPE AGAIN CPA P1 MEM RES ? JMP LL4 YES, SO WE'RE DONE * * XLB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD XLA B,I GET THE SIZE STA XTEMP SAVE IT AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+28 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4. NO, SO GO DO OUTPUT * AND M77 SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+37 SAVE IT * LL4. XLB ABT1,I GET THE ID SEG AGAIN ADB D28 GET TO EMA WORD XLA B,I PULL IT IN SZA,RSS ANY EMA DECLARED ? JMP LL4 NO, SO WE'RE DONE WITH THIS LINE * STA LLIST SAVE WORD AND B1777 KEEP EMA SIZE LDB LLM30 GET THE ADDRESS JSB CONVD AND CONVERT * LDA LLIST NOW GET THE MSEG SIZE FROM THE ALF ID EXTENSION RAL,RAL ½þú AND M77 XLB $IDEX ADA B XLA A,I NOW HAVE THE MSEG ADDRESS XLA A,I NOW HAVE THE MSEG WORD AND M37 JSB CNV99 STA LLM1+34 * * LL4 LDA P76 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD XLA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * * GTNBR LDA P3 INSURE DECIMAL CONVERSION STA OPCOD JSB BLKID LDA BID5 GET # OF LONG LDB L#1 GET ADDRESS JSB CONVD CONVERT * LDA BID6 GET # OF SHORT IDS LDB L#2 JSB CONVD * LDA BID11 GET # OF ID EXTS LDB L#3 JSB CONVD * JSB SPACE LDA P64 PRINT THE INFO LDB L#IDS JSB DRKEY AND AS PORKY PIG WOULD SAY : * JMP EXIT THA-THA-THA-THA-THATS ALL FOLKS !!!!! * * * PURGE CLA,INA GO SET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZB RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU LDA FILE2 GET THE CMND FÚpþúILE LU # AND M77 KEEP ONLY LOWER BITS JSB INTER SEE IF IT'S INTERACTIVE JMP TRLST NOPE GOTIT IOR M400 SET ECHO BIT STA LISTU AND SET THE LU JMP TRYAG GO PRINT THE MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP ONLY LU JSB INTER GO SEE IF ITS INTERACTIVE JMP LDI5 THAT'S NOT EITHOR, SO FLUSH HIM ! JMP GOTIT * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM2+1 GET AN ASCII BLANK STA NAM12,I AND INITIALIZE BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TOO !) SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * L#IDS DEF *+1 ASC 22,XXXXXX FREE LONG IDS, XXXXXX FREE SHORT IDS, ASC 10,XXXXXX FREE ID EXTS * L#1 DEF L#IDS+1 L#2 DEF L#IDS+12 L#3 DEF L#IDS+23 LLM1 DEF *+1 ASC 20,NAME TYPE PRIORITY LO MAIN HI MAIN ASC 18, LO BP HI BP SIZE EMA MSEG PART'N SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, LLM3 DEF *+1 ASC 9, * LLM13 DEF LLM1+12 LLM18 DEF LLM1+17 LLM23 DEF LLM1+20 LLM28 DEF LLM1+24 LLM8 DEF LLM1+7 LLM30 DEF LLM1+30 P24 DEC 24 P25 DEC 25 P76 DEC 76 N38 DEC -38 D28 DEC 28 LLM2 DEF *+1 ASC 5, PNAME ?_ * * * ADJST NOP XLA ABT1,I GET THE ID ADDRESS AGAIN LDB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 ^þú THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+1 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+2 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+3 JMP LIST?,I SUCCESS !!! JMP LL2 SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVERLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3 LOCAL/SYS/REVERSE M60 OCT 60 ERR25 ASC 1,25 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD /APPEND DEBUG XTEMP NOP YTEMP NOP ZTEMP NOP BKLWR NOP LAST WORD OF AVAIL MEMORY #PGPT NOP # OF PAGES IN PART'N * * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * LSCAN SEARCHES FOR AN ENTRY IN LST IDENTICAL TO THE NAME IN TBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSCAN * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): END OF LST. CURRENT LST ADDRES POINT TO THE NEXT * AVAILABLE ENTRY IN LST. * (N+2): NAME FOUND IN LST. CURRENT LST ADDRES POINT * TO THIS ENTRY. * LSCAN NOP JSB INLST INITIALIZE LSTX LDB TLST ENTX1 CPB PLST END OF LST ? JMP SLSTS YES - GO MAKE NEW ENTRY LDA B,I RAL,CLE,ERA CPA TBUF NAME 1,2 EQUAL ? JMP *+3 YES ADB P5 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I CPA TBUF+1 NA8ŒB@ LDA IPBUF GET THE 1ST PARSED WORD SZA IF = 0 OR CPA PROMT+4 = ASCII BLANK THEN JMP SE?? BETTER BE A SE,0, OR SE,, COMMAND * LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * DLOAD JSB NAMRR GO PARSE THE INPUT TO GET NEW LOAD ADDRESS LDA IPBUF+3 GET THE TYPE OF PARAMETER SLA RAR,SLA ONLY NUMERIC ALLOWED. NO ASCII. JMP PRERR SHAME ON YOU ! LDA PPREL GET THE CURRENT LOAD ADDRESS CMA,INA AND MAKE SURE THAT THE NEW LOAD ADA IPBUF ADDRESS IS ABOVE THE OLD ONE SSA IS IT ? JMP PRERR NO, SEND AN ERROR LDB IPBUF GET THE ADDRESS AGAIN SSB IF NEGATIVE JMP PRERR ITS AN ERROR ALSO CLA OK, SO CLEAR THE UNUSED AREA ADB N1 UP TO BUT NOT INCLUDING THE WORD SPECIFIED JSB OUTAB OUTAB WILL CHECK TO SEE IF HE SET THE * LDA TPREL LOAD POINT TOO HIGH FOR THIS LOAD STA PPREL RESET THE LOAD POINT JMP NXTOP LOAD POINT TOO HIGH. NOW GET NEXT CMND. * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN FLIB NOZIþúP 0/-1 NOT/IS A LIBRARY FILE SCAN SVTP1 NOP OLD INPUT FILE TYPE WORD STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE CPA LO WAS IT A CHANGE LOAD ADDRESS CMND ? JMP DLOAD YES, SO GO SET UP NEW LOAD ADDRESS CPA SL WAS IT A SEARCH LIBRARY COMMAND ? JMP SELIB THEN DO IT JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * GTLIB JSB NAMRR PARSE FOR NEXT INPUT SSA ANY ERRORS ? JMP PRERR YES, NOTHING TO PARSE * LDA IPBUF+3 GET THE TYPE WORD AND P3 KEEP ONLY TYPE CPA P3 WAS THE INPUT ASCII ? RSS YES. SO ITS OK FOR NOW. JMP PRERR NO, LU'S ARE NOT LIBRARY FILES. * LDB LPNTR GET THE POINTER TO THE LAST LIB FILE CPB END TOO MANY LIB FILES ? JMP PRERR THATS AN ERROR TOO. STB NXTAD OK. SO MOVE NAME & SC & CART # TO BUFFER AREA * LDA N3 MOVE COUNT JSB MOVE DEF IPBUF SOURCE NXTAD NOP DESTINATION SET ABOVE * LDB LPNTR GET THE SOURCE ADDR ADB P3 ADD MOVE COUNT LDA IPBUF+4 GET THE SECURITY CODE STA B,I & STUFF IT INB BUMP POINTER LDA IPBUF+5 GET THE CART REF # STA B,I AND STUFF THAT TOO. INB STB LPNTR RESET THE POINTER ADDRESS FO NEXT LIB. JMP NXTOP GET THE NEXT COMMAND. * XEQTR JSB GTCMD ‘Ùþú CLOSE OUT OLD FILE & OPEN NEW. JSB BREAK CHECK IF ABORT DESIRED LDA TYPE2 GET THE TYPE WORD ERA,SLA FILE OR LU JMP FOPEN FILE JMP LREAD LU * SELIB JSB LIBSC SCAN THE LIBRARIES JMP NXTOP GO GET NEXT COMMAND * * * THE FOLLOWING ARE THE LEGAL COMMAND FILE COMMANDS * DS ASC 1,DI TR ASC 1,TR SL ASC 1,SL LI ASC 1,LI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE FO ASC 1,FO EN ASC 1,EN .A ASC 1,/A AB ASC 1,AB /E ASC 1,/E EX ASC 1,EX LO ASC 1,LO AS2RK OCT 25000 AN * ECHO? NOP LPNTR DEF LIBRY POINTER TO LIBRARY NAME BUFFERS SPC 1 * * * IERR2 NOP ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 DEC 1 OPEN OPTION (NON EXCLUSIVE) IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO THE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JSB FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************€kþú************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : * PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARAMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE H,þúANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JSB FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR NOP SAVE RETURN ADDRESS STB EFILE SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO ASCII * STA B SAVE ASCII AND M774K GET THE UPPER BYTE CPA B20K IS IT A BLANK ? ADB B10K YES, SO FILL IN LEADING BLANK WITH A ZERO STB EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I IT STA EFBUF+11 INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * JSB PTERR POST ERROR TO SCB DEF *+2 DEF EFBUF+1 * * LDA DFLAG GET INTEACTIVE FLAG SZA,RSS WE INTERACTIVE ? JMP PRNIT NO,JUST GO PRINT IT * LDA LISTU SAVE THE LIST LU STA QTEMP LDA FILE2 REPLACE WITH INTERACTIVE LU STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * PRNIT LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP LDI5 NO, DO THE REST OF THE ERROR THING * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP STA TYPE3 AND TYPE OF LIST DEVICE WORD * JMP NXTOP GO GET NEXT COMMAND * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 M774K OCT 77400 B20K OCT 20000 B10K OCT 10000 * * *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR AND IGNORES ANY ERROR RETURNS. AFTER ALL WHAT ELSE *CANþú YOU DO ?? * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB,CLE STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE RSS NOT INTERACTIVE JMP USEL2 IS INTERACTIVE USEL1 LDA MYLU# ITS NOT, SO USE START UP LU USEL2 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR-0XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SASþúVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 IF DVR07 SUBCHANNEL = 0 RSS JMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LG, LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA ÅõB@ * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA MBUF GET "VALID NAME" FLAG SZA,RSS NAME READ? JMP CPRNM,I NO, EXIT JSB PRNAM PRINT NAME DEF MBUF JMP CPRNM,I EXIT * * CLASSIFY RECS BY TYPE LDRC LDA RIC GET REC IDENTIFICATION CODE LDB PLFLG GET LOADING FLAG CPA P1 TYPE = NAM ? JMP NAMRX YES - PROCESS NAM REC SZB SKIP - NOT LOADING JMP NMERR REC OUT OF SEQUENCE CPA P2 TYPE = ENT? À/þú JMP ENTR YES - PROCESS ENT REC CPA P3 TYPE = DBL? JMP DBLR YES - PROCESS REC CPA P4 TYPE = EXT? JMP EXTR YES - PROCESS EXT REC CPA P6 TYPE = EMA? JMP EMARC YES - PROCESS EMA RECORD * * * MUST BE AN END RECORD. SKP * * *** PROCESS END RECORD *** * * * JSB BREAK SEE IF WE SHOULD BREAK LDA IGNOR SZA,RSS LATEST SUBROUTINE LOADED ? JMP RESET YES, PROCESS AS NORMAL. * LDA BID3 NO, THEN RESTORE CURRENT STA CWABP FW AVAILABLE ON BASE PAGE. LDA BID4 AND END OF LST. STA PLST JMP NOCLR SKIP CLEARING OF BIT15 IN LST1 * * TEST FOR OVERFLOW OF COMMON * RESET LDA MCOMX GET COMMON LENGTH OF LAST MODULE CMA,INA SUBTRACT FROM INITIAL SET LENGTH ADA MXCOM SSA,RSS IF SAME OR LESS JMP NOCLR THEN OK * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR06 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. ERR06 ASC 1,06 MCOMX NOP LEN OF LAST MODULE SCANNED/LOADED * NOCLR LDA XBUFA RESET ADDR OF CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF LBUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET PRIMARY ENTRY POINT FLAG SLA,RSS SKIP - HAS PRIMARY ENTRY POINT xþú JMP NOPRE OMIT PROCESSING NO ENTRY POINT SKP * * * PRINT MEMORY MAP LDA IGNOR SZA WAS LATEST SUBROUTINE LOADED? JMP NOPRE NO,SO DON'T DO PRIMARY ENTRY PT STUFF LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA LBUF+3 GET WORD 3 OF END REC ADA PPREL ADD PROG RELOC BASE STA PRENT,I SET IN ID SEGMENT LDA MBUF GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT LDA MBUF+1 GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR * LDB MSEG NOW GET THE SEGMENT LOAD FLAG ERB,ERB TO E. LDB PTYPE GET THE PROG TYPE SEZ THIS A SEGMENT OR MAIN ? LDB M25 SEGMENT, SO SET TYPE & SEG BIT. IOR B * STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NPAR STORE PRIORITY SZA FROM NAME REC STA PRIOR,I IF NON-ZERO. LDA NPAR+1 IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. AND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA B IN 15-13 LDA NPAR+2 AND AND M7770 EXECUTION MULTIPLE IOR B IN 11-00 STA RESL,I LDA NPAR+5 GET SECONDS MPY P100 SCALE TO TMS ADA NPAR+6 TMS+SCALED SECONDS STA NPAR+5 SAVE LDA NPAR+3 GET HOURS MPY P60 SCALE TO MINUTES ADA NPAR+4 ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA NPAR+5 TMS+SCALED SECONDS SEZ WASá]NLH THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * >ÄNÿÿþú SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND THE ID IF ONE JMP NOPRE NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG  RSS THEN CHECK FOR COPIES OF THE PROGRAM JMP IDSN1 ELSE BE FRIENDLY & RENAME THE PROGRAM * JSB COPY. B-REG = ID ADDR/ SEE IF ANY COPIES OF PROG JMP NOPRE WE GOT BACK ! MUST NOT BE ANY COPIES. * * IDSN1 LDA MBUF GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA MBUF+1 NAME MESSAGE BUFFER STA MESS7+13 LDA MBUF+2 STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 INVALID RESET PROG NAME LDA RENAM GET ASCII '##' STA MBUF SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. LDA P4 LDB WNG32 NOW SEND A WARNING MESSAGE JSB SYOUT JMP IDSN REPEAT DUPLICATE PROG NAME SCAN * IDSN2 LDA ERR32 GET ERROR MESSAGE & JMP ABOR ABORT THYSELF. SPC 1 ERR32 ASC 1,32 WNG32 DEF *+1 ASC 2,W 32 P27 DEC 27 M25 OCT 25 M7770 OCT 7777 NPAR BSS 7 NAME RECORD PARAMETERS RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE CCA STA PLFLG SET 'LOOK FOR NAM' FLAG LDA IGNOR SZA,RSS IF LAST SCAN USEFUL JSB MAPPR THEN PRINT MEM MAP & UPDAT BASE * JSB INLST INITIALIZE LSTX LDB TLST CPORD CPB PLST END OF LST ? JMP SLTST YES - SET UP NEXT OPERATION ADB P2 CLEAR POSSIBLE ORDINAL LDA B,I FROM LST 3. AND M7400 STA B,I ADB P3 JMP CPORD CONTINUE CLEARING PR¡(þúOG ORDINALS SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA MBUF LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? YES, CHECK ON NEXT OPERATION. * * LDA MSEG IS THIS A SEGMENTED PROGRAM ? CPA P2 WELL ? RSS YES JMP LDRIN NO,GET NEXT RECORD * LDA PROGT THIS MODULE A SEGMENT ? CPA P5 WELL ? RSS YES JMP LDRIN NO, GO GET THE NEXT RECORD. * LDA LIBFL WE, SCANNING AT THE MOMENT ? SZA WELL ? JMP LDRIN NO, GET THE NEXT MODULE * CCA SET THE LIBRARY SCAN FLAG STA LIBFL CLA,INA SET THE SCAN TILL NEXT SEGMENT FLAG STA SCSEG JMP LDRIN GO GET THE NEXT SEGMENT * * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SEGM NOP SKP * * * PROCESS EMA RECORD. * * EMARC LDA LIBFL GET THE LIB SCAN FLAG SZA WE SCANNING ? JMP LDRIN YES SO IGNOR THE WHOLE THING * LDA EMABP ANY PREVIOUS DECELERATION ? SZA WELL ? JMP LL19 YES, ITS AN ERROR * * *E LDB ALBUF GET THE RECORD BUFFER ADDRESS INB INDEX TO EMA WORD LDA B,I & PULL IT IN AND B1777 KEEP ONLY EMA SIZE STA EMASZ * ADB P2 NOW GET THE SYMBOL NAME LDA B,I CHARS 1 & 2 STA TBUF * INB CHARS 3 & 4 LDA B,I STA TBUF+1 * INB CHAR 5 & ORDINAL # LDA B,I STA TBUF+2 * INB & MSEG SIZE LDA B,I AND M37 STA MSGSZ * JSB LSCAN SEE IF THIS SYMBOL PREVIOUSLY REFERENCED RSS JMP LL19 AN ERROR LDA MSEG IS THIS A SEGMENT ? ièþú CPA P2 WELL ? JMP LL19 THATS AN ERROR ALSO * LDA TBUF NOW PUT THE LABEL IN THE SYMBOL TABLE STA LST1,I LDA TBUF+1 STA LST2,I LDA TBUF+2 STA LST3,I * LDA TLST UPDATE END OF SYMBOL TABLE STA PLST * LDA B200 NOW SET SYM TABLE V BIT ADA P3 SET SYMBOL AS EMA TYPE(DEFINED) STA LST4,I & PUT IN SYMBOL TABLE * JSB ALLOC GET A BP LINK STA LST5,I & PUT ABS ADDRESS IN TABLE STB EMABP SAVE DUMMY ADDRESS LOCALLY * LDB #PGS *E SZB ANY SPECIFIED SIZE GIVEN? JMP NOPG1 YES, CHECK AGAINST 32K MAX * LDA MSGSZ GET THE MSEG SIZE INA ACCOUNT FOR I/O OVERFLOW CPA P1 IF JUST 1 INA THEN SET MIN MSEG SIZE ALF,ALF NOW ADJUST TO # OF PAGES RAL,RAL CMA,INA & SET NEW UPPER BOUNDS FOR CODE ADA B7777 SPACE STA LWA JMP NOPG *E * NOPG1 LDA URFWA GET LOAD PT IN # PGS ALF *E RAL,RAL CONVERT TO # PAGES ADA B ADD # OF PAGES SPECIFIED LDB MSGSZ *E INB ACCOUNT FOR I/O OVERFLOW PAGE CPB P1 DEFAULTED EMA? INB YES, BUMP FOR MINIMUM SIZE ADA B (A) = # PAGES REQUIRED CMA,INA WITH EXTRA BP INA TAKE OUT EXTRA BP ADA D32 SUBTRACT FROM 32K LOGICAL SSA EXCEEDED 32K? JMP ER.18 YES. * NOPG JSB BLKID GO COUNT ID SEGS LDA BID9 SEE IF THERE ARE ANY SZA,RSS ID EXTENSIONS JMP LL20 IF NOT ABORT THYSELF JMP LDRIN GET THE NEXT RECORD * LL19 LDA ERR19 JMP ABOR ER.18 LDA ERR18 JMP ABOR ERR18 ASC 1,18 LL20. JSB $LIBX RETURN FROM PRIV PROCESSING DEF *+1 DEF *+1 LL20 LDA ERR20 JMP ABOR ERR19 ASC 1,19 ERR2'Yþú0 ASC 1,20 EMABP NOP MSGSZ NOP EMASZ NOP B7777 OCT 77777 * * * * MAPPR NOP LDB PLGTH GET LEN WORD SSB IF COMPILER PRODUCED JMP MAPP1 FORGET THE BSS FILL OR COM FILL * ADB N1 ELSE SET TO RELATIVE ADDR OF ADB PPREL GET REAL CORE ADDR STB A INA CPA TPREL WAS IT LOADED? JMP MAPP1 YES SKIP THE FILL * CLA NO FILL THE BSS WITH ZERO'S JSB OUTAB OUTPUT FILL WORDS MAPP1 JSB PRMAP PRINT MEM MAP & UPDATE BASES JMP MAPPR,I RETURN * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA MSEG GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ MSEG NO, SO SET IT. CLA RESET THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SEGM GET THE SEGMENT BASE ADDRESS CPB PPREL IF SAME AS CURRENT SEGMENT THEN JMP NAMR3 LAST SEGMENT LOADED. THIS IS NEW ONE * * ISZ #SEGS INCREMENT THE # OF SEGMENTS ENCOUNTERED FLAG LDA N60 GET NEG COUNT JSB MOVE DEF LBUF SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE IS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * JSB LOCF OK SO SAVE OUR POSITION IN THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC RECORD # IN FILE USED IN JUST A SECOND DEF IRB DEF IOFF * SSA,RSS ANY ERRORS ? JMP *+3 NO * LDB F1 GET THE FILE NAME JSB FLERR AND REPORT * JMP SCANX RESCAN THE FILE * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESSjþúCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO/YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND WHILE SCAN FOR NEXT SEG. RSRSC NOP 0/-1 NOT OK/OK TO RESCAN FILE * * NAMR3 CCA SET FLAG TO STA RSRSC OK TO RESCAN FILE JMP NAMR1 NOW * * SKP * PROCESS NAM REC NAMRX SZB,RSS SKIP - VALID REC SEQUENCE JMP NMERR REC OUT OF SEQUENCE LDA FWABP GET DUMMY BP BASE CMA,INA AND SUBTRACT FROM ADA CWABP CURRENT DUMMY BP LOCATION. ADA BPFWA ADD OFFSET TO REAL BP BASE STA BPREL AND SET AS NEW BP REL BASE CLA SET UP FLAG TO 'NOT IGNORE' STA IGNOR LDA LBUF+9 GET PGM TYPE STA PROGT AND SAVE IT. LDA LIBFL IF SCANNING TILL NEXT SEG,THEN ADA SCSEG LOOK AT THE SEG ELS IF JUST SZA SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB LBUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL SEG FOUND OPERATION ? SZA WELL ? ISZ #NAMS YES, SO COUNT THE NAMS LDA LBUF+8 GET COMMON LENGTH STA MCOMX SET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP COMOK NO COMMON, TEST B.P. LENGTH LDB LIBFL IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP COMOK ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP COMOK ASSUME COMMON OK TILL 'END' IS READ * LDB URFWA GET THE BASE LOAD ADDRESS ADB MAPOF ACCOUNT FOR THE X&Y REGISTERS & MAP REGS CPB TPREL COMPARE TO HIGH MAIN RSS = , SO COMMON DECLRATION OK JMP CMERR COMMON ERROR STA MXCOÛþúM FIRST COMMON, SET MAX LENGTH LDA FWA ADJUST RELOCATION BASES SPC 1 ADA MAPOF 2 WORDS FOR X-Y REG SAVE SPC 1 STA COMAD SET FWA OF COMMON (LOCAL) LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA COMAD ADA MXCOM COMPUTE COMMON UPPER BOUND + 1 SPC 1 SPC 1 STA PPREL SET AS LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP NAMR2 OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS NAMR2 LDA LWA CMA,INA COMPUTE LENGTH LEFT OVER AFTER ADA PPREL COMMON ALLOCATION. SSA SKIP IF INVALID COMMON LENGTH JMP COMOK COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR ERR03 ASC 1,03 ERR09 ASC 1,09 * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP ABOR SYMAD BSS 1 ADDR OF SYMBOL RELOCATION MXCOM NOP MAX COMMON LENGTH * * COMOK CLA SET UP FLAG TO STA PLFLG "NAM HAS BEEN READ" JSB SEMAP SET PROG NAME IN MEM MAP LDA PLST SAVE STA BID4 END OF LST ADDR LDA CWABP NEXT AVAILABLE WORD ADDR ON BP STA BID3 CCA LDB LIBFL GET THE LIB SCAN FLAG SZB WE SCANNING ? STA IGNOR YES, SET FLAG "TO IGNORE" LDA LBUF+7 GET BP LENGTH SZA,RSS ANY BP RELOCATION ? JMP CKSUB NO, THEN GO CHECK FOR SEG LOAD. CMA,INA SET NEGATIVE LENGTH OF STA ABT1 BASE PA<þúGE AREA NEEDED. BPCLR JSB ALLOC MOVE CWABP BY SAME ISZ ABT1 ZEROED AND MOVED ALL ? JMP BPCLR NO, THEN DO MORE. * CKSUB JSB SAVIT YES, SO LOOK FOR REWIND POINT LDA NAM#1 1ST NAM IN FILE SZA YES JMP LDRIN NO, GET NEXT REC CCB RESET STB NAM#1 SO WE KNOW WE DID IT LDA PROGT GET TYPE SZA,RSS IF ZERO ISZ #NAMS INC #NAMS CMA,INA ELSE MAKE IT NEG ADA P5 ADD 5 SSA IF WAS GREATER THAN 5 ISZ #NAMS INC #NAMS JMP LDRIN GET THE NEXT RECORD * PROGT NOP PROG TYPE BEING SCANNED NAM#1 NOP 0/-1 1ST NAM IN FILE/NOT 1ST NAM IN FILE P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * THE INLST AND LSTX SUBROUTINES SET THE ADDRES FOR THE CURRENT * ENTRY IN THE LOADER SYMBOL TABLE (LST). * * INITIALIZE LSTX * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST IN TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INLST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INLST NOP LDA BLST GET STARTING ADDR OF LST STA TLST SET CURRENT LST ADDR JMP INLST,I RETURN * * SPECIAL ROUTINE "SILST" * * THIS ROUTINE INITIALIZES THE LST FOR THE * BACKGROUND SEGMENT AREA ONLY, IF MAIN/SEGMENT * LOADING IS BEING DONE. IT USES THE CONTENTS * OF "SLST" - SLST IS INITIALIZED TO BE = TO * "BLST" BUT IS CHANGED AFTER THE "MAIN" PROG * IS LOADED TO BE THE ADDR OF THE ENTRY * FOLLOWING THE LAST ENTRY FOR THE MAIN. * * SAME CALLING SEQUENCE AS FOR "INLST". * SILST NOP LDA SLST SET SEGMENT LST ADDR STA TLST AS CURRENT ADDR. JMP SILST,I * * THIS ROUTINE INITIALIZES START OF LST TO BEGIN JUST * AFTER THE END OF RESIDENT LIB LST (START OF THE LST * BUILT FROM USER'S PROG) * FNLST NOP LDA FLST STwxþúA TLST JMP FNLST,I * * * SET CURRENT LST ADDRES * * THE LSTX SUBROUTINE SETS THE CURRENT LST ADDRES FROM TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * LSTX NOP LDA TLST GET CURRENT LST ADDR CPA PLST END OF LST? RSS YES - CONTINUE ISZ LSTX NO - INCR RETURN ADDR STA LST1 SET WORD 1 ADDR INA STA LST2 SET WORD 2 ADDR INA STA LST3 SET WORD 3 ADDR INA STA LST4 SET WORD 4 ADDR INA STA LST5 SET WORD 5 ADDR INA STA TLST SET NEXT LST ADDR CMA,INA ADA TFIX ADD FWA OF DUMMY ID SEGMENT AREA SSA,RSS IF RESULT = 0 OR <0, SZA,RSS THEN ERROR JMP LOVER OVERFLOW. JMP LSTX,I -OK, RETURN. * * * * SCAN TO SEE IF ANY UNDEFINED * (REGS MEANINGLESS ON ENTRY AND RETURN) * JSB LSTX1 * (P+1) RETURN - NO UNDEFINED * (P+2) RETURN - UNDEFINED EXIST * LSTX1 NOP JSB FNLST START LST FROM USER MAIN LDA MSEG BUT IF CPA P2 LOADING A SEGMENT JSB SILST THEN START FRM SEGMENT'S LST. LDB TLST GET CURRENT LST ADDR LSTX2 CPB PLST END OF LST ? JMP LSTX1,I YES - RETURN (P+1) ADB P3 LDA B,I GET LST4 AND P7 MASK IN STATUS CPA P2 UNDEF EXT ? JMP YEXT YES ADB P2 POINT TO NEXT SYMBOL JMP LSTX2 SEE NEXT SYMBOL YEXT ISZ LSTX1 UNDEF FOUND - BUMP RETURN ADDR JMP LSTX1,I RETURN (P+2) SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP æ1þú JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 * * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINT OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA DBFLG IS DEBUG ALLOWED ? SZA,RSS WELL ? JMP DEBUG,I NO, SO FORGET IT * LDA IGNOR YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDA MBUF GET PROG NAME 1,2 CPA DB1 CHARS = D,B? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+1 GET PROG NAME 3,4 CPA DB2 CHARS = U,G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG >þúIS NOT 'DEBUG' LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA DB3 CHAR = R? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' * JSB SILST INITIALIZE FOR SEGMENT DSCAN JSB LSTX SET LST ADDRES HLT 0 'DEBUG' NOT FOUND IN LST LDA LST1,I GET NAME 1,2 CPA CHRDE CHARS = D,E? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST2,I GET NAME 3,4 CPA CHRBU CHARS = B,U? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR CPA UCHRG CHAR = G? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY * LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN STATUS CPA P2 UNDEFINED ? HLT 0 'DEBUG' IS UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT POINT LDB LST5,I AND PUT IT INTO ENTRY POINT JSB OUTAB 'DEBUG'(ON THE DISC) * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA PPREL ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I RETURN * DB1 ASC 1,DB DB2 ASC 1,UG DB3 OCT 51000 R DB1X ASC 1,.S ASC 1,TD OCT 41000 * * PROCESS ENT,EXT RECS * ENTR CCA,RSS ENT REC PROCESSOR EXTR CLA EXT REC PROCESSOR STA NXFLG SET ENT/EXT FLAG = -1/0 * LDA LIBFL GET THE LIBRARY SCAN FLAG SZA,RSS SCANNING LIBRARY JMP ADDON NO LDA PROGT YES, SO GET THE PROGRAM TYPE CPA P5 IS IT A SEGMENT ? JMP LDRIN YES, SO FORGET IT ADDON LDA LBUF+1 GET NO. SYMBOLS AND M37 ISOLATE SYMBOLS CMA,INA STA EXCNT SET ENT/EXT SYMBOL COUNT LDB ALBUF GET AD¼×þúDR OF LBUF ADB P3 NEXSY LDA B,I GET SYMBOL 1,2 STA TBUF SAVE NAME 1,2 INB LDA B,I GET SYMBOL 3,4 STA TBUF+1 SAVE NAME 3,4 INB LDA B,I GET SYMBOL 5 STA TBUF+2 SAVE NAME 5 INB STB SYMAD SAVE SYMBOL ADDR (FOR ENT) * LDB NXFLG GET ENT/EXT FLAG SZB,RSS SKIP - SET ENT ABSOLUTE ADDR JMP NOTEN OMIT SETTING ABS. ADDR FOR EXT AND P7 MASK IN RELOCATION BASE TYPE STA ENTYP SAVE ENT TYPE CLB CPA P4 IF TYPE 4 ENT JMP TYP4 THEN GO SET IT UP. ADA ENTRL ADD RELOCATION BASE ADDR LDB A,I GET PROPER RELOCATION BASE TYP4 ADB SYMAD,I ADD TO GET ABSOLUTE ADDR STB OPRND AND SAVE IT NOTEN JSB LSCAN SCAN LST FOR NAME JMP ENTX3 END OF LST * LDA LST4,I SET UP STATUS OF AND P3 SYMBOL MATCHED WITH. STA ENTST LDA LIBFL SZA,RSS SCANNING LIB ? JMP NRML NO LDA NXFLG SZA,RSS PROCESSING ENT ? JMP NRML NO LDA ENTST GET SYMBOL STATUS CPA P2 ENT MATCHED WITH EXT ? RSS YES - THEN IT IS OK. JMP ENTX5 NO - THEN FORGET IT. NRML LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP - PROCESS ENT JMP ENTX4 COMPLETE EXT PROCESSING * LDA ENTST GET STATUS OF SYMBOL CPA P2 IF STATUS = 2 (UNDEF SYMBOL) JMP ENT2X THEN SET ENT ABS VALUE FOR EXT * * DUPLICATE ENTRY POINT * CPA P3 AN EMA ENTRY PERHAPS ? JMP LL19 YES JSB CPRNM PRINT MODULE NAME JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * ERR07 ASC 1,07 * ENT2X LDA ENTYP GET ENT TYPE ALF,ALF POSITION ENT TYPE LDB LIBFL GET LIB SCAN FLAG SZB,RSS IF SCANNING LIB INA ~HFB THEN SKIP THIS INSTRUCTION STA LST4,I SET LST4 CLA STA IGNOR SET TO 'NOT IGNORE' FOR LIB INA STA NUPLS SET FLAG FOR 'SOME LIB LOADED' LDA OPRND OPERAND IN IT STA LST5,I SET VALUE INTO LST. JSB FIXAL FIX ALL REFERENCES JMP ENTX5 COMPLETE ENT PROCESSING * SKP * ENTX3 JSB SELST SET NAME INTO LST LDB NXFLG GET ENT/EXT FLAG SZB,RSS PROCESSING EXT ? JMP EXTNM YES LDA ENTYP ALF,ALF POSITION ENT TYPE LDB LIBFL SZB,RSS LIB SCAN ? INA NO, THEN SET STATUS = 1. STA LST4,I SET LST4 LDA OPRND SET SYMBOL VALUE STA LST5,I AND SET JMP ENTX5 IN LST5. COMPLETE ENT PROCESSING. * EXTNM LDA P2 STATUS = 2 FOR EXT STA LST4,I SET UP LST4 FOR EXT ENTX4 LDA TBUF+2 GET CHAR 5, ORDINAL STA LST3,I SET ORDINAL INTO LST ENTX5 LDB SYMAD GET SYMBOL ADDR LDA NXFLG GET ENT-EXT FLAG SZA SKIP - EXT INB INCR SYMBOL ADDR FOR ENT ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NEXSY PROCESS NEXT SYMBOL JMP LDRIN READ NEXT REC * EXCNT BSS 1 EXT/ENT SYMBOL COUNT NXFLG BSS 1 EXT/ENT FLAG ENTYP BSS 1 ENT TYPE BEING PROCESSED ENTST BSS 1 STATUS OF LST SYMBOL MATCHED M100 OCT 100 N5 DEC -5 * * M”Hÿÿþú SKP * PROCESS DBL REC DBLR LDA IGNOR SZA REC TO BE IGNORED ? JMP LDRIN YES, GET NEXT REC. * LDA LBUF+1 GET INSTRUCTION COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA ALBUF GET ADDR OF LBUF ADA P4 ADJUST FOR FIRST RELOCATION BYTE STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET WORD 2 OF DBL REC AND M300 ISOLATE REL TYPE FOR LOAD ADDR STA DBLBS SAVE FOR LATER LDB LBUF+3 GET THE RELOCATION ADDRESS CPA M100 IF = 1 JMP MBASE THEN PROG RELOCATABLE. ADB BPREL RELOCATE THE LOAD ADDRESS FOR BP. SZA IF = 0 THEN BASE PAGE RELOCATABLE JMP RCERR ELSE ERROR 2 - ILLEGAL REC. JMP DBL0 FOR BP REL, AVOID FWA RESET. * MBASE ADB PPREL RELOCATE THE LOAD ADDRESS FOR MAIN MEM. ISZ DBLFL (SKIPS ONLY IF 1ST DBL OF NEW SEGMENT) JMP DBL0 * * ADJUST PROGRAM RELOCATION BASE TO LOAD ADDR IN * FIRST DBL RECORD IN EACH LOADING OPERATION TO * NOT ALLOCATE DISC SPACE FOR BSS AREAS AT THE * BEGINNING OF A PROGRAM. ALSO,THIS ALLOWS FOR * A PSEUDO COMMON REGION BETWEEN A "MAIN" PROG * AND ALL SEGMENTS IF THE SAME SIZE BSS AREA IS * DECLARED AT THE BEGINNING OF EACH SEGMENT. * LDA LBUF+3 ADJUST FWA TO BSS DISPLACEMENT ADA FWA ON DISC LOWER BOUND. STA FWA SET NEW FWA FOR LOAD OPERATION STA TPREL DBL0 STB DBLAD SET THE LOAD ADDRESS DBL1 LDB CURAL,I GET RELOCATION BYTE STB REKEY SAVE RELOCATION RYTE LDA N5 STA INSCN SET RELOCATION BYTE COUNT ISZ CURAL INCR CURRENT LBUF ADDR DBL2 LDA REKEY GET RELOCATION BYTE ALF,RAR ROTATE TO LOW A STA REKEY SET NEXT RELOCATION BYTE AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES b)þú- GET LINK ADDR CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR EXT WITH OFFSET CPA P6 BYTE ADDR ? JMP DBL6 YES ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDA A,I SET RELOCATION BASE ADA CURAL,I ADD CURRENT INSTRUCTION WORD DBL3 LDB DBLAD GET LOAD ADDRESS TO B JSB OUTAB OUTPUT ABSOLUTE PROG WORD ON DISC DBL9 ISZ CURAL INCR CURRENT LBUF ADDR ISZ EXCNT SKIP - ALL INSTRUCTIONS OUT RSS NO - CONTINUE JMP LDRIN GET NEXT REC ISZ DBLAD INCR CURRENT DBL RELOCATION ADDR ISZ INSCN SKIP - GET NEW RELOCATION BYTE JMP DBL2 PROCESS NEXT INSTRUCTION JMP DBL1 GET NEXT RELOCATION BYTE DBL4 LDA CURAL,I GET CURRENT DBL WORD AND M377 ISOLATE ORDINAL STA EXORD AND SAVE IT. CLA STA OFSET SET OFFSET = 0 JSB DBLEX SET BP LINK ADDR FOR EXT JMP DBL9 INSTRUCTION IS OUTPUT BY DBLEX * DBL5 LDA CURAL,I GET CURRENT WORD FROM LBUF RAR,RAR POSITION AND AND M377 MASK IN ORDINAL IF ANY SZA,RSS ANY ORDINAL ? JMP DBL5M NO - GO PROCESS MEM REF. * STA EXORD SET UP ORDINAL LDB CURAL GET LBUF ADDR INB BUMP TO WHERE OFFSET IS LDA B,I GET OFFSET STA OFSET AND SET OFFSET VALUE. JSB DBLEX SET BP LINK FOR EXT REF ISZ CURAL INCREMENT LBUF ADDR JMP DBL9 GO INDEX TO NEXT WORD DBL5M LDA CURAL,I GET NEXT WORD FROM LBUF ISZ CURAL INCR CURRENT LBUF ADDR JSB MREF SET ADDR FOR MEM REF INSTR JMP DBL3 OUTPUT ABSOLUTE PROG WORD DBL6 LDA CURAL,I GET WORD 1 OF THE GROUP ALF POSITION AND AND M17 MASK IN TYPE. SZA IF NON-ZERO JMP RCERR THEN ILLEGAL REC ERROR LDA CURAL,I ELSE GET WORD 1 AGAIN AND P3 MASK IN RELOCA¸hþúTION TYPE LDB ENTRL GET RELOCATION BASE ADB A LDB B,I FROM TABLE RBL AND COVERT TO BYTE ADDR ISZ CURAL LDA CURAL,I GET WORD 2 (BYTE ADDR) SSA IF SIGN BIT SET JMP RCERR THEN ILLEGAL REC. ADA B ADD BASE BYTE ADDR TO GET INSTRUCTION JMP DBL3 GO TO OUTPUT ON DISC OR BP * DBLBS NOP LOAD ADDR INDICATOR OFSET NOP OFFSET FOR AN EXT M17 OCT 17 * * SKP * *********** LIBRARY FILE SCAN MODULE ************ * * LOADX JSB LSTX1 ANY UNDEFS ? JMP LOADQ NO, GO LOOK FOR PRIMARY ENTRY POINT OR SYS LIB JSB LIBSC GO SCAN FOR LIBRARIES JMP LOADQ GO SCAN SYSTEM LIBRARY * * SKP LIBSC NOP LDA START,I ANY LIBRARIES TO SEARCH ? SZA,RSS WELL ? JMP LIBSC,I NO, SO FORGET THE WHOLE THING. * * * LIBRARY FILE(S) EXIST * * LDB TYPE1 OK, BUT IS THERE ALSO A CURRENT INPUT STB SVTP1 FILE THAT WE ARE RELOCATING ? SZB,RSS WELL ? JMP LOADK NO INPUT FILE, BUT A LIBRARY FILE EXISTS. * * *********** LIBRARY EXISTS BUT WE HAVE AN INPUT FILE OPEN ************ * * ERB,SLB FILE OR LU OPEN ? RSS FILE. JMP LOADK LU. * JSB CLOS1 CLOSE THE INPUT FILE SSA,RSS ANY ERRORS ? JMP LOADK NO LDB F1 YES JSB FLERR * * ****** SET UP FOR LIBRARY SCAN ******** * * * LOADK LDA START GET THE 1ST LIB FILE PARAMETERS STA F1 SET INTO ERROR FLAG STA INCX AND THE OPEN CALL ADA P3 SET SEC CODE & CART ALSO STA INCY INA STA INCZ * NXLIB JSB OPEN OPEN THE LIB FILE DEF *+8 DEF IDCB1 DEF IERR1 INCX NOP NAME DEF IPTN1 NONEXCLUSIVE OPEN INCY NOP SECURITY CODE INCZ NOP CART REF DEF IDümþúCBS # OF WORDS TO USE * LDB P3 SET FILE IN USE FLAG STB TYPE1 * SSA,RSS ANY ERRORS JMP STFLG NO, GO READ THE RELO CODE. LDB F1 YES, JSB FLERR GO SEND ERROR MESSAGE * RWNDL JSB POSTX (KLUGE FIX FOR FMGR APOSN BUG) JSB APOSN REWIND THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS JMP STFLG NO * LDB F1 YES JSB FLERR * STFLG CCA SET FLAGS STA LIBFL LIB SCAN STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST STA FLIB LIB FILE SCAN IN PROGRESS FLAG CLA STA LGOU LG NOT IN USE STA SLIBF NOT A SYS LIB SCAN JMP RREAD HOP TO IT ! * * LBRTN JSB CLOS1 CLOSE THE FILE SSA,RSS ANY ERRORS JMP *+3 NO. LDB F1 YES JSB FLERR SEND ERROR * JSB LSTX1 ANY UNDEFS ? JMP LOADW NO, SO FORGET ABOUT THE REST OF THE LIB SEARCH * LDA INCX SET UP NEXT LIBRARY ADA P5 LDB A,I IS THERE A NEXT LIB ? SZB WELL ? CPB END WELL ? JMP LOADW NOPE. * STA F1 SET ERROR POINTER & STA INCX SET UP THE OPEN CALL LDA INCY ADA P5 STA INCY * LDA INCZ ADA P5 STA INCZ * JMP NXLIB GO GET 'EM ROVER ! * ANOP NOP * LOADW CLA LIB SCAN DONE STA FLIB * LDA DEFF1 SET ORGINAL F1 BACK UP STA F1 * LDA SVTP1 GET THE OLD TYPE WORD . STA TYPE1 & RESET SZA,RSS WAS A PREVIOUS FILE OPEN ? JMP LIBSC,I NO, SO RETURN * ERA,SLA YES, FILE OR LU RSS FILE JMP LIBSC,I LU SO RETURN * JSB OPENN OPEN THE ORGINAL FILE JSB APOSN POSITION FILE TO CORRECTa þú DEF *+6 DEF IDCB1 AREA DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA,RSS ANY ERRORS JMP LIBSC,I NO, SO RETURN * LDB F1 GET THE FILE NAME JSB FLERR REPORT THE ERROR * * * * START DEF LIBRY LIBRY BSS 5 LIBRARY FILE 1 BSS 5 LIBRARY FILE 2 BSS 5 LIBRARY FILE 3 BSS 5 LIBRARY FILE 4 BSS 5 LIBRARY FILE 5 BSS 5 LIBRARY FILE 6 BSS 5 LIBRARY FILE 7 BSS 5 LIBRARY FILE 8 BSS 5 LIBRARY FILE 9 BSS 5 LIBRARY FILE 10 END DEF * END OF LIBRARY AREA SKP * * * LOAD FROM PROG LIB * LOADQ LDA TYPE1 SEE IF THERE STILL A FILE OPEN. ERA,SLA IF THERE IS RSS (THERE IS) JMP LOADZ (THERE ISN'T) * JSB POSTX THEN THIS MUST BE A SEGMENTED PROGRAM * AND WE ARE GOING TO DO A LIB SCAN. * IF WE CALL POST THEN WE CAN USE THE * 256 WORDS AS BUFFER SPACE FOR THE SCAN. * * LOADZ LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JMP ABOR SO ABORT THYSELF LOADN CCA SET FLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LIBFL 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLAG STA LSTBK SET UP POINTERS TO DISC LIB SUCH LDB SYSLN GET THE START OF USER ENTS LDA PTYPE GET PROG TYPE CPA P3 PRIV PROG ? CLB YES, SO SET SCAN TO 0 STB DCNT LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRA—LþúNSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA MSEG GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LOAD LDA OP? YES, GET THE LAST OPCODE CPA SE WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA #ENTS IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT JSB FNLST INITIALIZE TO START OF USER LST LDA MSEG IF SEG LOAD CPA P2 THEN JSB SILST INITIALIZE LST FOR SEG ONLY JSB MATCH SCAN LST FOR MATCHING NAME JMP SYLOK+1 NO MATCH - CHECK NEXT SYMBOL * GTSUB LDA TBUF+3 MATCH !(GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * ALF,ALF SET TYPE TO HIGH END STA B,I SET IN SYMBOL TABLE LST4 STA GTENT SAVE FOR ENT TYPE CHECK BELOW INB SET TO LST5 LDA TBUF+4 GET SYMBOL VALUE STA B,I SET IN LST5 ADB N4 SET TO LST1 STB LST1 SET FOR FIXUP * LDB GTENT GET THE SYMBOL TYPE SZB IS IT MEM RES ? JMP GTMEM NO2þú, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. CMA NO. SO IF THE ADDRESS XLB $DLP IS ABOVE START OF COMMON ADA B SSA,RSS THEN CHECK FURTHER JMP GTMEM ELSE CONTINUE XLB $COML GET LENGTH OF COMMON BLF,BLF CONVERT TO PAGES RBL,RBL ADA B ADD TO CURRENT LOCATION SSA,RSS IF POS, THEN THE ENT IS IN COMMON JMP LL24 AND ITS AN ERROR. * GTMEM JSB FIXAL FIX ALL REFERENCES JMP SYLOK+1 CONTINUE SCAN * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGNOR STA PLFLG STA NUPLS JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA * LL24 JSB PRNAM PRINT EXTERNAL NAME DEF TBUF LDA ERR24 JMP ABOR ERR24 ASC 1,24 * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 BIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETEª_þúRMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB LDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORD JMP GTENT,I RETURN DONE SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP #ENTS NOP TOTAL # OF ENTS IN SYSTEM SPC 1 * * LIBFL NOP SLIBF NOP REKEY NOP INSCN NOP ERR08 ASC 1,08 * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * COUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP JSB LSTX1 ANY UNDEFINED ? JMP RNDEX NO LDB SYSLN SET UP FOR LIB SCAN LDA PTYPE GET PROG TYPE CPA P3 PRIV ? CLB YES, SET START OF SCAN = 0 STB DCNT SET UP THE START OF THE SCAN JMP CSUBR,I RETURN * * SCANrƒþú OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? JSB LSTX1 INITIALIZE LST & ANY UNDEF ? JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING CONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA MSEG IS THE PROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE IUNDF LDA ERR28 NO, SO ABORT THYSELF JMP ABOR * ERR28 ASC 1,28 * SKP * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS Ûhþú JSB SYOUT PRINT: UNDEFINED EXTS JSB FNLST INITIALIZE LSTX * LDA MSEG IF LOADING CPA P2 A SEGMENT, INITIALIZE JSB SILST FOR IT IN LST. * XSCAN JSB LSTX SET LST ADDRES JMP PSUSP END OF EXTS LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED SYMBOL ? RSS YES - THEN SKIP JMP XSCAN TRY NEXT LST ENTRY ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB LST1 GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS IGNOR NOP UN# NOP SKP * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT Øîþú LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB P3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,INB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CLE,ERB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * LDA LISTU GET THE LU TO WRITE TO AND M77 WITHOUT ANYTHING ELSE LDB MYLU# GET MY DEFAULT LU # SZA,RSS NULL OR BIT BUCKET ? STB LISTU YES THEN SET IT UP * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JSB FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSA3êþúGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (ASCII) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP STA MERR+1 SET CODE INTO ERROR MESSAGE LDA P4 LDB MESS5 MESS5 = ADDR: L XX JSB SYOUT PRINT: L XX JMP ERROR,I RETURN JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 4,L 77 * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SET COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN * * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYOUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OUTPUT MESSAGE * JMP SYÑóNLHOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: ASC 15 DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N20 DEC -20 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG ŒéNÿÿþú SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (18 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM4 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * EMAID * SHIGH * SESW1 * SESW2 * SESW3 * IDEX1 * IDEX2 * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT*æþú FLAG LDA N20 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA TFIX THE FIXUP TABLE STA SET2 SET NEW END LDB TFIX CURRENT ADDRESS TO B STA TFIX SET NEW END OF FIXUP TBL. SETI0 CPB IDA END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA TFIX CMA,INA TEST FOR SYMBOL ADA PLST OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA IDA SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA IDA FOR NEW ADDR. LDB IDA SET CLA DUMMY SETI STA B,I ID INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA IDA LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG INA STA EMAID SET EMA WORD INA STA SHIGH HIGH MAIN + LARGEST SEG + 1 INA STA SESW1 SESSION MONITOR WORD # 1yþú INA STA SESW2 SESSION MONITOR WORD # 2 INA STA SESW3 SESSION MONITOR WORD # 3 INA STA IDEX1 ID EXTENSION WORD # 1 INA STA IDEX2 ID EXTENSION WORD # 2 * * LDA P99 INITIALIZE STA PRIOR,I PRIORITY = 99 * IFN LDA MYLU# SET LU # CMA,INA STA SESW3,I XIF * CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P99 DEC 99 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG IDA NOP FWA OF CURRENT DUMMY ID SEGMENT EMAID NOP ADDRESS OF EMA WORD SHIGH NOP ADDRESS OF HIGH MAIN + SEG + 1 SESW1 NOP SESSION WORDS 1 - 3 SESW2 NOP SESW3 NOP IDEX1 NOP ID EXTENSION WORD 1 IDEX2 NOP ID EXTENSION WORD 2 SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA,RSS IF ENOUGH JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE * NOIDS LDA P20 LDB þ”þúSETM JSB SYOUT LDA ERR33 JMP ABOR NOW ABORT THE POOR GUY * ERR33 ASC 1,33 * * DBLEX HANDLES ALL DBL EXTERNAL REFERENECS & EMA REFERENCES. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND 'OFSET' SHOULD HAVE A FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * EXORD = EXT ORDINAL # * OFSET = OFFSET OF INSTRUCTION * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBLEX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (A) HAS INSTRUCTION TO BE OUTPUT * DBLEX NOP JSB INLST INITIALIZE LSTX LDB PLST ADB P2 SET END PNTR STB PRMAP LDB TLST ADB P2 DBLF CPB PRMAP END OF LST ? JMP ORD? ORDINAL NOT FOUND * LDA B,I GET LST3 AND M377 MASK IN ORDINAL ADB P5 POINT TO NEXT LST1 CPA EXORD ORDINALS EQUAL ? RSS YES - SKIP JMP DBLF NO - CHECK NEXT LST ENTRY * ADB N7 BACK UP TO CURRENT SYMBOL STB TLST AND SET UP FOR LSTX JSB LSTX HLT 0 I HAVE ALLREADY CHECKED!! LDA REKEY SET THE DBL AND M7 TYPE STA T1FIX FOR FIXIT OR... LDA CURAL,I GET THE INSTRUCTION AND M1740 ISOLATE IT STA T2FIX AND SAVE IT ALSO LDA LST4,I GET WORD 4 OF LST ENTRY AND P3 ISOLATE THE TYPE CPA P3 IS IT EMA ? JMP EMDBL YES, SO PROCESS EMA EXTERNAL REFERENCE * CPA P2 IS SYMBOL DEFINED? JMP DBLE0 NO GO BUILD A FIX UP * JSB FIXIT YES FIX IT UP AND OUTPUT IT JMP DBLEX,I RETURN * DBLE0 LDB TFIX GET CURRENT END ADB N4 PUSH DOWN STB TFIX THE BOTTOM OF THE TABLE CMB,INB WAS THERE ROOM? ADB PLST SSB,RSS WELL?? JMP LOVER NOPE DID HIM IN * LDB TF·ñþúIX YES JSB FIXX SET UP THIS ENTRY * LDA LST1 SET STA FIX2,I THE LST ENTRY LDA T2FIX COMBINE IOR T1FIX THE INSTRUCTION AND DBL TYPE STA FIX3,I AND SET IT LDA OFSET GET THE OFSET STA FIX4,I AND SET IT LDA DBLAD NOW FOR THE ADDRESS STA FIX1,I JMP DBLEX,I EXIT * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * ERR14 ASC 1,14 * * PROCESS EMA EXTERNAL REFERENCE. * EMDBL LDA T1FIX GET THE TYPE OF DBL RECORD CPA P4 TYPE 4 ? RSS YES, SO ALL'S WELL JMP LL27 NO, ITS AN ERROR LDA T2FIX GET THE INSTRUCTION CODE SSA INDIRECT BIT SET ? JMP LL27 THAT'S AN ERROR ALSO * ADA MSIGN NOW SET THE SIGN BIT ADA LST5,I AND ADD THE BP LOCATION IN LDB DBLAD GET THE ABSOLUTE ADDRESS JSB OUTAB AND OUTPUT THE WORD JMP DBLEX,I RETURN * * LL27 LDA ERR27 JMP ABOR ABORT LOAD ERR27 ASC 1,27 * SKP * * THE OUTAB ROUTINE IS CALLED TO OUTPUT A WORD TO THE DISC * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE STB A SAVE IT ADB FWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TPREL BEYOND LAST WORD PUT OUT? INA SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TPREL NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED ò§þú* * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN OF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SEGM SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 ABSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * SKP * * FIXAL FIXES UP REFERENCES * TO ENTRY POINTS NOT DEFINED WHEN REFERENCED * BY TAKING THE INFORMATION FROM THE CURRENTúÒþú FIXUP TABLE ENTRY * AND BUILDING AN APPROPIATE INSTRUCTION FROM IT. * * THE FIX UP TABLE HAS 4- WORDS PER ENTRY AS FOLLOWS: * ....................................................... * ********************************************************************* * FIX1 MEMORY ADDRESS TO BE FIXED (-1 INDICATEDS AN EMPTY ENTRY) * * FIX2 SYMBOL TABLE ADDRESS OF EXT FOR THIS INSTRUCTION * * FIX3 INST OP CODE. BITS 2-0 = DBL TYPE (REKEY) 0,1,2,3,4,5 * * FIX4 OFSET FROM DBL RECORD. * *********************************************************************** * FIXAL EXTRACTS THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND LEAVES IT WHERE 'FIXIT' CAN FIND IT. THIS IS DONE TO ALLOW * 'FIXIT' CODE TO BE USED WITHOUT THE FIXUP TABLE OVER HEAD WHEN * DOING CODE THAT DOES NOT REQUIRE FIXUPS. * FIXAL NOP LDA LST1 LST1 MUST POINT TO SYM TAB ENTRY STA TLST JSB LSTX SET UP PROPER SYM TAB ENTRY HLT 0 * LDB IDA GET ORGION FIXA2 CPB TFIX END OF TABLE? JMP FIXA3 GO PACK THE TABLE * ADB N3 DOWN TO THE LDA B,I SYM. TBL. ENTRY ADB N1 SET B TO ORGION OF ENTRY CPA LST1 THIS ONE? JMP FIXA1 YES GO DO IT * JMP FIXA2 AROUND WE GO * FIXA1 JSB FIXX SET THE BASE ADDS IN FIX1-FIX4 LDA FIX3,I GET THE DBL CODE AND P7 AND STA T1FIX SET IT XOR FIX3,I GET THE MASKED INSTRUCTION STA T2FIX AND SET IT LDA FIX4,I GET THE OFFSET STA OFSET AND SET IT LDA FIX1,I GET THE MEMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CCA STA FIX1,I RELEASE THE FIXUP TABLE ENTRY STA FIX2,I * LDB FIX1 CONTINUE JMP FIXA2 SEARCH * FIXA3 LDB IDA TABLE GET THE BASE ADDRESS PKF00 CPB TFIX IF EMPTY JMP FIXAL,I JUST EXIT * ADB N4 ß2þú INDEX TO FRONT OF ENTRY STB SET1 SET ADDRESS OF FIRST AVAILABLE ENTRY LDA B,I IS IT? SSA,RSS IT IS IF IT IS <0. JMP PKF00 NO AROUND WE GO * PKF01 LDA N4 SET UP A MOVE COUNTER STA SET2 TO MOVE THE NEXT ENTRY PKF02 CPB TFIX IS THERE ANOTHER ENTRY? JMP PKF05 NO GO PATCH UP TFIX * ADB N4 YES CHECK IT LDA B,I STILL IN USE? SSA WELL JMP PKF02 NO TRY NEXT ONE * PKF03 STA SET1,I YES MOVE IT DOWN INB ISZ SET1 STEP THE ADDRESSES LDA B,I GET THE NEXT WORD ISZ SET2 FOUR WORDS MOVED YET? JMP PKF03 NO * LDA SET1 YES SET UP FOR THE NEXT ADA N8 EMPTY SLOT STA SET1 ADB N4 ALSO B JMP PKF01 TRY THE NEXT ENTRY * PKF05 LDA SET1 END OF THE FIX UP LIST ADA P4 SET THE ADDRESS STA TFIX OF THE LAST VALID ENTRY IN TFIX JMP FIXAL,I RETURN * * SKP * * * FIXIT CONFIGURES THE INSTRUCTION THAT FIXAL SET UP * * FIXIT NOP THIS ROUTINE BUILD A INSTRUCTION AND PUTS IT OUT LDA LST4,I GET THE SYMBOL TYPE ALF,ALF AND P7 TO A CPA P4 IF REPLACE OP JMP FIX05 GO DO IT * LDA LST5,I GET THE SYMBOL VALUE ADA OFSET ADD THE OFFSET STA OPRND SET FOR SCANNERS AND M0760 ISOLATE PAGE BITS CMA,CLE,INA SET E IF PAGE ZERO LDA T2FIX GET THE OPCODE SEZ IF BASE PAGE REF JMP FIX04 USE DIRECT LINK * LDB T1FIX GET THE DBL TYPE CPB P4 IF TYPE 4 THEN JMP FIX01 ALWAYS USE LINK * SZA ELSE USE LINK CPA MSIGN ONLY IF NOT A DEF JMP FIX04 A DEF DO DIRECT LINK * LDA OPRND CHECK IF A LINK NEEDED XOR DBLAD AND M0760 ISOLATE PAGE INFO SZA IN N/ÀþúOT SAME PAGE JMP FIX01 MUST USE LINK * LDA OPRND EXT REF WITH OFFSET TO SAME PAGE AND MPAG ISOLATE THE PAGE OFFSET IOR M2000 AND INDIRECT BIT ADD CURRENT PAGE ADA T2FIX BIT AND THE INSTRUCTION CODE JMP FIX03 GO SEND IT TO THE DISC * FIX01 LDB OPRND IF OPCODE LDA T2FIX SSA IS INDIRECT ADB MSIGN ADD A SIGN BIT STB OPRND JSB SCAN SCAN FOR A LINK JMP FIX02 SUCCESS * JSB ALLOC NO LINK FOUND ALLOCATE ONE STB T3FIX SAVE ACTUAL MEMORY ADDRESS OF IMAGE LDB OPRND AND STB T3FIX,I SET THE OPERAND INTO IT LDB A GET ACTUAL ADDRESS FIX02 LDA T2FIX INSTRUCTION TO A IOR MSIGN ADD THE INDIRECT IOR B AND THE BASE PAGE ADDRESS FIX03 LDB DBLAD GET THE ADDRESS TO B JSB OUTAB SEND THE WORD JMP FIXIT,I RETURN * FIX04 ADA OPRND DIRECT DEF ADD IN OPERAND JMP FIX03 GO PRODUCE IT * FIX05 LDA LST5,I REPLACE OP JMP FIX03 SEND IT * * * FIXX SETS UP FIX1-FIX4 * * ON ENTRY B=FIX1 ADDRESS * FIXX NOP STB FIX1 INB STB FIX2 INB STB FIX3 INB STB FIX4 JMP FIXX,I SO YOU EXPECTED COMMENTS YET! * * * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP T1FIX NOP DBL WORD TYPE FROM REKEY IE THE R FROM THE RRRRR FIELD T2FIX NOP THE INSTRUCTION OP CODE IN THE PROPPER UPPER BITS T3FIX NOP JUST A TEMP TO HOLD A DUMMY BP ADDR FOR A MOMENT TFIX NOP EXORD BSS 1 SET2 NOP SET1 NOP M1740 OCT 174000 MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT SKP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED.Ûþú * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB $CVT3 DO THE CONVERSION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * * THE SEMAP SUBROUTINE SETS THE NAME OF THE CURRENT PROG * INTO THE MEMORY MAP AND SETS THE PROG LENGTH. * IT ALSO EXTRACTS THE PRIORITY AND TIME PARAMETERS * FROM THE NAME RECORD AND STORES THEM INTO 'NPAR'. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SEMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SEMAP NOP LDA LBUF+3 GET PROG NAME 1,2 STA MBUF SET NAME INTO MEMORY MAP LDA LBUF+4 GET PROG NAME 3,4 STA MBUF+1 SET NAME IN MEMORY MAP LDA LBUF+5 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR B40 ADD BLANK CHAR STA MBUF+2 SET NAME IN MEMORY MAP LDA LBUF+6 GET PROG LENGTH STA PLGTH SAVE PROG LENGTH * LDA N7 MOVE PRIORITY,RESOLUTION CODE, JSB MOVE EX MUL,HRS,MINS,SECS, DEF LBUF+10 AND TENS OF MS TO DEF NPAR NPAR * LDA LBUF GET THE REC LENGTH ALF,ALF AND ADA N17 SUBTRACT 17 LDB P10 GET #WORDS IN MAP MESS. SSA,RSS IF NAM REC > 17 WORDS ADB A ADD DIFFERENCE TO MAP LENGTH BLS CONVERT TO WORDS STB NODE SAVE FOR MAP OUTPUT CPB P20 IF NO EXTRA WORDS JMP SEMAP,I EXIT * CMA,INA SET TO MOVE THE REST OF THE NAM JSB MOVE REC TO DEF LBUF+17 MBUF Dþú DEF MBUF+10 JMP SEMAP,I RETURN SPC 1 PLGTH BSS 1 PROG LENGTH B40 OCT 40 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA PRMAP SAVE WORD COUNT LDA MOVE,I GET SOURCE STA LSCAN SET IN LSCAN ENTRY ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB LSCAN,I GET A WORD STB A,I PUT IT AWAY ISZ LSCAN STEP SOURCE INA AND DEST. ADDRES ISZ PRMAP DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT SPC 1 * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, THE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDA PPREL GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA ADA TPREL GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDA NODE LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN * LDA PLIST GET THE LIST OPTION SZA IF HE WANTS ENTS WE GIVE HIM LINKS TOO. JMP PRMA1 NO ENTS OF BP LINKS ASKED FOR * LDA FWABP GET THE ORGINE OF DUMMY BP CMA,INA AND FROM IT CALCULATE THE ADA CWABP CURRENT REAL BP ADDRESS ADA BPFWA NOW WE HAVE IT. LDB BPMSG SO CONVERT TO ASCII JSB CONVD * LDA P1*’þú8 GET THE MSG LENGTH LDB BPADR AND THE ADDRESS JSB DRKEY AND REPORT TO THE USER JSB SPACE SPACE A LINE * PRMA1 LDA TPREL GET NEXT AVAIL ADDR STA PPREL SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * BPADR DEF *+1 ASC 18, BP LINKAGE XXXXX BPMSG DEF BPADR+7 * NODE NOP MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TLST MACH? CPB PLST END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MATCH JMP MATCH,I RETURN (P+2) * * Ü¢NLHHNÿÿþú SKP * * SCAN DUMMY LINKAGE AREA FOR OPERAND * * SCAN LOOKS THROUGH THE DUMMY BASE PAGE TO FIND IF A * BP LINK HAS ALREADY BEEN ALLOCATED FOR THIS WORD. * ON RETURN : * * (P+1) - MATCH FOUND AND REG-A = 0 * AND REG-B = ABSOLUTE LINK ADDR * * (P+2) - NO MATCH - REGS ARE MEANINGLESS. * SCAN NOP LDB FWABP GET THE LOWER BOUND LDA OPRND AND THE OPERAND SRC CPB CWABP END OF ALREADY ALLOCATED LINKS ? JMP NOTFD DO NOT FOUND RETURN CPA B,I IS THIS THE GUY ? JMP FOUND YES ! INB NO, BUMP POINTER & TRY AGAIN JMP SRC * NOTFD ISZ SCAN MAKE THE NOT FOUND RETURN JMP SCAN,I * FOUND LDA FWABP NOW CALCULATE THE ABSOLUTE ADDRESS CMA,INA ADB A ADB BPFWA JMP SCAN,I MAKE THE FOUND RETURN * OPRND NOP ADDRESS OF WORD WE'RE LOOKIN FOR. CWABP NOP NEXT DUMMY LINK ADDR TO BE ALLOCATED FWABP NOP ADDR OF 1ST WORD OF DUMMY LINK AREA * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ABSOLUTE BASE PAGE ADDR * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA CWABP GET NEXT AVAILABLE BP ADDR ISZ CWABP INCR CURRENT BP ADDR LDB A CMB,INB SET B = - CURRENT BP ADDR ADB LWABP GET LWA BP LINKAGE. SSB,RSS SKIP - BP OVERFLOW JMP ALLO1 JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR ALLO1 CLB STB A,I ZERO THE LINK WORD LDB FWABP SUBTRACT FWA BP AREA CMB,INB FROM CURRENT ADDR, ADA B TO GET RELATIVE ADDR.èþú ADA BPFWA ADD FWA OF ACTUAL AREA FOR LDB CWABP ABS ADDR, B=DUMMY AREA ADB N1 JMP ALLOC,I ADDR. -RETURN. * ERR04 ASC 1,04 BASE PAGE OVERFLOW * * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECT * LINK THROUGH BASE PAGE. * * CALLING SEQUENCE: * A = FIRST WORD OF MEMORY REFERENCE GROUP * B = IGNORED * JSB MREF * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * MREF NOP STA ABT4 SAVE (A) TEMPORARILY AND P3 ISOLATE RELOCATION BASE TYPE LDB ENTRL GET RELOCATION ADDR PNTR ADB A ADD OFFSET TO GET PROPER PNTR LDB B,I GET RELOCATION BASE ADDR LDA ABT4 RESTORE (A) ADB CURAL,I ADD CURRENT INSTRUCTION ADDR AND M1740 ISOLATE INSTRUCTION CODE SSA SKIP - DIRECT REFERENCE ADB MSIGN SET SIGN OF ADDR = 1 STA INSTR SAVE INSTRUCTION CODE LDA DBLAD GET CURRENT RELOCATION ADDR AND M0760 ISOLATE CURRENT PAGE NO. STA PAGNO SAVE CURRENT PAGE NO. LDA B GET CURRENT ADDR AND M0760 ISOLATE PAGE NO. OF ADDR SZA,RSS BASE PAGE REFERENCE? JMP DBL8 YES CPA PAGNO CURRENT PAGE REFERENCE? JMP DBL7 YES, NO LINK NEEDED STB OPRND SAVE ABSOLUTE OPERAND JSB SCAN SCAN DUMMY LINK AREA JMP LNFND LINK FOUND JSB ALLOC ALLOCATE LINK STA TBUF SAVE BP LINK ADDR LDA OPRND GET CURRENT OPERAND STA B,I SET OPERAND IN DUMMY BASE PAGE. LDA TBUF GET BP LINK ADDR SMLNK IOR MSIGN ADD INDIRECT BIT MREF0 IOR INSTR ADD INSTRUCTION CODE TO ADDR JMP MREF,I RETURN LNFND SWP JMP SMLNK GO TO USE SAME LINK * DBL7 LDA B IT'S CURR PAGE AND ðÜþúM1777 SO REMOVE PAGE BITS FROM ADDR IOR M2000 AND SET CURR PAGE BIT JMP MREF0 ADD INSTR TO ADDR, RETURN * DBL8 LDA B IT'S BASE PAGE JMP MREF0 JUST ADD INSTR TO ADDR, RETURN * M1777 OCT 1777 INSTR BSS 1 PAGNO BSS 1 * * * SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM XSA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN * EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 * SKP * * NORMAL LOAD TERMINATION * NODEX LDA #PTTN IF NO PTTN SPECIFIED SZA THEN JMP NODEY CHECK INPUT #PAGES * XLB $MBGP GET THE MAX BG PROG LDA PTYPE & PROG TYPE CPA P2 IS PROG BG? RSS JMP *+3 XLB $MRTP NO, GET MAX RT SIZE * LDA EMABP *E SZA IF EMA, RSS JMP *+3 XLB $MCHN USE MAX MOTHER PTTN SIZE * LDA #PGS GET THE # OF PAGES REQUESTED CMA,INA & CHECK AGAINST MAX SIZE ADA B *E INA ACCOUNT FOR BP SSA DID HE ASK FOR TOO MUCH? JMP ER.18 YES, SO FLUSH HIM * NODEY LDA EMABP ANY EMA DECLARATION ? SZA,RSS WELL ? JMP NOEMA NO. * LDA MSEG THIS A SEGMENTED PROG ? SZA,RSS WELL ? JMP SEMBP NO, SO SET UP THE EMA BP LINK * LDA MSEGF YES, BUT IS THIS%¿þú THE LAST SEGMENT ? CPA P3 WELL RSS YES, SO SET THE EMA BP LINK JMP NOEMA NO, DON'T PUT THE LINK IN BP YET * SEMBP LDA SHIGH,I GET HIGHEST LOAD POINT SZA,RSS THIS IT ? LDA TPREL NO. NOW WE HAVE IT ADA M1777 ALLIGN TO NEXT PAGE AND M0760 STA EMABP,I AND STUFF INTO DUMMY BP * LDA #PGS GET SPECIFIED INPUT PAGES SZA,RSS ANY SPECIFIED? JMP NOEMA NO, FORGET IT * ADA N1 DON'T COUNT BP TWICE! ALF,ALF CONVERT #PAGES TO WORDS RAL,RAL *E ADA URFWA ADD TO LOAD PT STA EMABP,I PUT START ADDR MSEG INTO DUMMY BP * NOEMA LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE JSB INLST INITIALIZE LSTX ELIST JSB LSTX SET CURRENT LST ADDRES JMP NOLST END OF LST LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 IF STILL UNDEFINED JMP ELIST THEN DON'T LIST IT * LDA LST1,I GET NAME 1,2 CCE,SSA IF UN USED LIB ENTRY JMP ELIST DON'T LIST IT. * STA EMES+2 SET NAME 1,2 INTO BUFFER RAL,ERA SET THE SIGN BIT SO IT IS LISTED ONCE STA LST1,I RESET IN LST LDA LST2,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER * LDA LST4,I GET THE TYPE OF CONTENTS OF LST5 AND B200 SZA,RSS IS V BIT SET JMP GOTAD NO, LST5 IS VALUE LDA BPFWA 5þú GET THE ADDR OF FIRST REAL AVAIL LINK CMA,INA ADA LST5,I ADD LINK ALLOCATED TO GET OFFSET INTO ADA FWABP DUMMY LINK TABLE LDA A,I NOW GET THE ADDRESS RSS GOTAD LDA LST5,I GET THE DEFINING ADDRESS LDB EMES GET ADDR OF 'NNNNN ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TPREL SET STA MEM2,I ADDR LDA FWABP CALCULATE RELATIVE CMA,INA CURRENT BP ADDR ADA CWABP AND ADD FWA OF REAL ADA BPFWA AREA FOR LAST ADDR AND STA MEM4,I SET IN ID SEGMENT LDA FWABP IF SEGMENT BEING LOADED, CMA,INA SUBTRACT FWABP FROM SEGB ADA SEGB (SEGMENT BASE) AND ADD ADA BPFWA TO REAL FWA OF BASE PAGE, STA MEM3,I SET AS LOW BOUND OF BP. LDA SEGB GET CURRENT LOWER BOUND OF BP, CMA,INA ADA CWABP ADD CURRENT BP LINK ADDR LDB MSEG (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA PPREL = TO DISPLACEMENT ADA M177 TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDA SEGB SET FWA OF CURRENT BASE PAGE STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. -+þú LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA PPREL STA MTMP+2 PPREL LDA DBLAD STA MTMP+3 DBLAD LDA SEGB STA MTMP+4 FWABP LDA CWABP STA MTMP+5 CWABP. * NOLS1 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS1 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA MSEG SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREAK LAST CHANCE TO BREAK THE PROGRAM * LDA MSEG CHECK FOR SPECIAL SZA,RSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 LDB PLST IF MAIN LOADED, SAVE END OF CPA P1 LST AS BEGINNING OF STB SLST SEGMENT AREA OF LST. * LDB SLST ERASE PREVIOUS STB PLST SEGMENT LST ENTRIES. STB TLST * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, JMP MSGP3 SKIP. JMP MSGP4 CONTINUE. MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 DRSET ASC 1,BS * * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * LDA DRSET RESET .DBUG TO .DBSG TO GET#þú SEGMENTS STA CHRBU SUBROUTINE THAT ACCESSES DBUG. * JSB SILST INITIALIZE FOR SEGMENT AREA, JSB LSTX SET ADDRES FOR NEXT LST ENTRY NOP LDA CHRDE PUT STA LST1,I ".DBSG" LDA CHRBU IN STA LST2,I NEXT LDA UCHRG LST ENTRY STA LST3,I FOR SEGMENT. LDA P2 SET LST4 = UNDEF SYMBOL STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. * LDA N3 GET # OF WORDS TO MOVE JSB MOVE MOVE EM DEF DB1X SOURCE DEF DB1 DESTINATION (SAVES 6 BP LINKS) * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA MSEG CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ MSEG SET 'MSEG' = 2. LDA PPREL SAVE SEGMENT STA SEGM BASE ADDR LDA CWABP SAVE BASE PAGE LOWER BOUND STA SEGB FOR LINK AREA FOR SEGMENTS. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SEGM RESET LOWER STA PPREL BOUNDS VALUES FOR STA FWA PPREL , FWA STA TPREL LDA SEGB STA CWABP CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA PLFLG NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LIBFL * * LDA IDA (A) = ID SEGMENT ADDR(DUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TOþú STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF LBUF DESTINATION * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * * MESS4 DEF *+1 PRAM ASC 6, READY PRAMX ASC 17, AT SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 LDA SLST SAVE SLST VALUE TEMPORARILY STA LSTX AND SET IT EQUAL TO FLST LDB FLST TO FOOL LSTX1 TO INITIALIZE STB SLST LST FROM START. JSB LSTX1 ANY UNDEFINED ? JMP MSGP9 NO - THEN DON'T OUTPUT MESSAGE LDA LSTX SET ACTUAL VALUE OF SLST BACK STA SLST LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT ISZ MSEG JSB PUDF GO REPORT THE UNDEFINEDS CCA ADA MSEG STA MSEG LDA FORCD GET THE FORCE LOAD FLAG SSA,RSS DO WE IGNOR UNDEFS ? JMP IUNDF NO SO ABORT THYSELF. MSGP9 LDA LSTX RESET ORIGNAL VALUE OF SLST STA SLST LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESEFûþúT "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA PPREL PPREL LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA MTMP+5 STA CWABP CWABP CLA SET STARTING TRACK STA STRAK AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDB EMABP GET THE EMA FLAG SZB,RSS ANY EMA DECLARED ? JMP NTRM. NO. * LDA MSGSZ GET THE SUPPLIED MSEG SIZE SZA WAS ANY SUPPLIED JMP SETMS YES * LDA B,I GET THE EMA DEFINING ADDRESS ALF & CONVERT TO PAGE # RAL,RAL CMA ACCOUNT FOR I/O OVERFLOW ADA P32 NOW HAVE MAX POSSIBLE MSEG * STA MSGSZ NO, USE MAX POSSIBLE SETMS ADA MSIGN NOW SET NON STANDARD MSEG BIT STA IDEX1,I AND PUT IN DUMMY ID SEGMENT * LDA EMASZ GET THE EMA SIZE LDB EMABP,I & START PAGE OF MSEG RBL PLACE INTO PROPER FIELD SZA,RSS WAS EMA SIZE DEFAULTED ? ADB M2000 YES, SO SET DEFAULT BIT STB IDEX2,I & PLACE IN DUMMY ID * LDA URFWA NOW CHECK OUT EMA SIZE ALF FIRST GET PROG SIZE RAL,RAL AND M37 CMA,INA LDB EMABP,I GET NEXT PAGE ADDÐÙþúRESS BLF RBL,RBL ADB A NOW HAVE PROG SIZE ADB EMASZ NOW HAVE REQ'D SIZE CMB,INB STB MESSM SAVE IT * LDA #PTTN WAS A PARTITION SPECIFIED ? SZA,RSS WELL ? JMP GTMCN NO * CCA YES ADA #PTTN MPY P7 INDEX TO PROPER ENTRY ADA P4 XLB $MATA OF $MATA TABLE ADA B XLA A,I GET THE AND B1777 # OF PAGES * JMP GTMC1 * GTMCN XLA $MCHN GET MAX SIZE SZA IS IT 0. JMP GTMC1 NO XLA $MBGP ASSUME BG LDB PTYPE CPB P2 IS IT ? RSS NO JMP *+3 XLA $MRTP NO * GTMC1 ADA MESSM NOW ADD IN SIZE SSA OK ? JMP LL21 NO. * NTRM. LDA SHIGH,I CALCULATE # OF PAGES VALUE FOR ID SZA,RSS PROG SEGMENTED ? LDA TPREL NO * LDB URFWA GET LOAD POINT CMB MAKE NEG (ACCOUNT FOR HIGH MAIN '+' 1 ADA B A = # OF WORDS OF CODE ALF NOW ACCOUNT FOR PAGES RAL,RAL AND M37 ADA P2 ACCOUNT FOR BASE PAGE & CURRENT PAGE STA MES11+1 SAVE FOR # OF PAGES RELOCATED MESSAGE LDB #PGS GET ANY SUPPLIED SIZE SZB,RSS ANY SUPPLIED ? STA #PGS NO, SO USE CODE SIZE * CCB OK, SO BUILD ID SEG WORD 22 ADB #PTTN PUT PART'N WORD IN BITS 0-5 CCE,SSB SET BIT 15 IF PARTITION REQUESTED CLB,RSS IF NO PARTITION THE SET TO 0 RBL,ERB * CCA GET # PGS REQ'D LESS BP ADA #PGS ADA MSGSZ ADD IN MSEG SIZE ALF,RAR # PGS IN BITS 14 - 10 IOR #MPFT MEM PROT FENCE INTO BITS 9-7 ALF,ALF RAR IOR B SAVE THE WORD STA PG.PT FOR THE MVIDS ROUTINE * * LDA FWABP SET UP ADDR ADA N20 Í.þú OF DUMMY STA IDA ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * * CONTROL TRANSFERS HERE FOR TEMPORARY LOADS & FOR PERM LOADS * WHERE NO PREVIOUS DISC SPACE IS AVAILABLE FOR THE PROG. * NTRM7 LDA IDA ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE IN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB IDA NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER IN³þúA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSED (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB IDA GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID ÝNLHHNÿÿþú SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB IDA SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ÌþúADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LDA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE CURRENT DISC LU CPB P3 IS IT LU 3 ? RAL,ERA THEN DON'T FORGET THE SIGN BIT. LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB IDA GET CURRENT ID SEG ADDR ADB P8 /†þú (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LD0¦þúB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA MSEG DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * SPC 1 NTRM4 LDA MES11+1 GET THE # OF PAGES RELOCATED JSB CNV99 CONVERT TO ASCII STA MES11+1 AND PUT INTO USER INFO BUFFER * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE * LDB P3 STB OPCOD SPECIFY DECIMAL CONVERSION * * LDA EMABP SZA,RSS ANY EMA ? JMP LOUT NO . LDA MSGSZ YES JSB CNV99 GET ASCII MSEG SIZE STA AMSEG+2 LDA EMASZ GET EMA SIZE SZA,RSS DEFAULTED ? JMP EDFLT YES LDB AEMAD GET ADDRESS OF ASCII JSB CONVD CONFERT IT JMP LOUT * EDFLT LDA N4 JSB MOVE DEF IDFLT DEF AEMA+2 * LOUT LDA #PGS GET # OF PAGES OF CODE LDB EMABP AND EMA DECLARATION SZB,RSS ANY EMA ? JMP *+4 NO ADA EMASZ YES, SO ADD EMA SIZE CPA #PGS IF DEFAULTED INA ADD 1 LDB PGRQD GET ADDRESS JSB CONVD AND CONVERT TO ASCII * * LDA P72 GET CHAR COUNT LDB MES11 & ADDRESS JSB DRKEY NOW GO TELL THGE FOLKES * * PTNCK LDB PTYPE CHECK #PAGES REQ'D DOESN'T LDA #MXBG CPB P2 RT OR BG PROG LDA #MXRT * INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P4 (A†Jþú)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 2,W 17 CODE > PTTN SIZE * MES11 DEF *+1 ASC 18,00 PAGES RELOCATED 0000 PAGES REQ'D AEMA ASC 9, NO PAGES EMA AMSEG ASC 9, NO PAGES MSEG P72 DEC 72 PG.PT NOP WORD 22 OF ID SEG OF MAIN AEMAD DEF AEMA PGRQD DEF MES11+10 IDFLT ASC 4,DEFAULT * SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB WORD WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB WORD IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * JSB FTIME TELL THE FOKES THE TIME DEF *+2 DEF PRAMX+2 * LDA P46 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY Lþú* * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 RELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 P46 DEC 46 TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP XLA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE _·þúSTA ABT1 KEYWORD LIST ADDR. * MIDN1 XLB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE XLA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. XLA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 XLA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ ABT1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) XLB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ASL11 SEND L11 MESSAGE JMP ABOR AND ABORT SPC 2 ASL11 ASC 1,11 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP * THE COPY. SUBROUTINE CHECKS TO MAKE SURE THAT ALL PROGRAM * PURGES OR REPLACES DON'T RUN AFOUL OF COPIED PROGRAMS. THE * PROBLEM TO AVOID IS RELEASING THE DISC TRACKS THAT THE PROGRAM * YOU ARE PURGING OR REPLACING RESIDES ON IF OTHER COPIES OF * THAT PROGRAM'S ID SEGMENT ARE STILL LAYING AROUND. * IF THE PROGRAM TO BE PURGED IS A COPY THAT'S OK. IF THE PROGRAM * YOU ARE REPLACING IS A COPY,c‘þú THAT'S NOT OK. * * * CALLING SEQUENCE JSB COPY. * B - REG = ID ADDRESS OF PROG TO PURGE * * * COPY. NOP STB IDADR SAVE THE ID ADDRESS OF PROG TO BE PURGED ADB P14 GET TO TYPE BIT XLA B,I AND P7 THIS A CPA P5 SEGMENT ? JMP COPY.,I THEN NOT TO WORRY. * ADB P17 NOW GET 2ND SESSION WORD XLA B,I AND M1000 IS THIS PROGRAM SZA A COPY ? JMP CHKED YES, SEE IF THIS IS A REPLACE * XLA B,I GET THE WORD AGAIN. THIS PROG NOT A COPY AND M2000 BUT ARE COPIES POSSIBLE ? SZA JMP COPY.,I NO, SO ALLS WELL * ADB N5 OK, THIS PROG NOT A COPY, BUT COPIES POSSIBLE. XLA B,I GET THE DISC ADDRESS OF THE PROG STA DSKAD AND SAVE. * LDA KEYWD GET THE KEYWORD ADDRESS STA KEY AND SET UP FOR SEARCH * DSRCH XLB KEY,I GET THE PROG ID ADDRESS CPB IDADR THIS THE PROG WE'RE WORKING ON ? JMP NXTID THEN GET NEXT ID * SZB,RSS ANY MORE ID'S ? JMP ITOK? NO SO SEE IF ALLS WELL * ADB P12 GET THE NAME WORD XLA B,I SZA,RSS IF THE ID IS EMPTY FORGET CHECK JMP NXTID AND LOOK AT THE NEXT ONE * ADB P2 NOW LOOK AT THE TYPE XLA B,I AND M20 CPA M20 THIS A SEGMENT ? JMP ITOK? YES, WERE DONE, SEE IF EVERYTHING OK * ADB P12 OK, SO INDEX TO THE DISC ADDRESS OF XLA B,I IF IT IS THE SAME AS THE ONE WE ARE CPA DSKAD GOING TO REPLACE THEN THAT'S A NO NO. JSB PRTER PRINT THE OFFENDING PROGRAM NAME & CONTINUE * NXTID ISZ KEY BUMP ID POINTER & JMP DSRCH LOOK AT THE NEXT ID SEG. * ITOK? LDA ERFLG ANY ERRORS ? SZA,RSS WELL ? JMP COPY.,I NO, SO CONTINUE WITH THE LOAD. * LDA ERR29 GET THE ERROR CODE & ‰&þú JMP ABOR ABORT THYSELF * CHKED LDA EDFLG GET THE EDITING FLAG SZA,RSS WE DOING A REPLACE OPERATION ? JMP COPY.,I NO, JUST PURGING A PROG. * LDA ERR30 YOU CAN'T REPLACE A COPIED PROG ! JMP ABOR * * KEY NOP M1000 OCT 1000 ERFLG NOP COPIED PROGRAM ERROR FLAG N14 DEC -14 DSKAD NOP IDADR NOP ERR29 ASC 1,29 ERR30 ASC 1,30 DBUF1 DEF *+1 NBUF BSS 3 * * * THE PRTER ROUTINE JUST PRINTS THE ERRORS THAT COPY. FINDS. * IT WILL TELL THE USER OF ALL PROGS THAT ARE COPYS OF THE * ORGINAL THAT HE IS TRYING TO REPLACE. * * * CALLING SEQUENCE JSB PRTER * B-REG = ADDRESS OF ID WORD 26 * * PRTER NOP ADB N14 BACK UP TO THE PROGRAM' NAME WORD. XLA B,I AND PULL NAME IN LOCALLY STA NBUF * INB XLA B,I STA NBUF+1 * INB XLA B,I STA NBUF+2 * * LDA P5 GET THE CHAR COUNT LDB DBUF1 & ADDRESS JSB SYOUT &AND PRINT THE PROGRAM NAME ISZ ERFLG BUMP THE ERROR FLAG JMP PRTER,I RETURN SKP UREAD NOP DISC READ SUBROUTINE JSB EXEC READS 64 WORDS DEF *+7 DEF P1 DEF P2 ALBUF DEF LBUF DEF P64 DEF TRACK DEF SECTR JMP UREAD,I * TRACK NOP SECTR NOP * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * IFN TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! ADA DM1K SUBTRACT 1024 DIV D6144 DIVIDE BY TRK SIZE STA TRACK WE NOW HAVE THE TRACK LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) ADA D18 ADD IN STARTING SECTR OF OP SYþbþúS STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 XIF * * * IFZ * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! DIV D6144 DIVIDE BY TRK SIZE STA TRACK TO RELATIVE TRACK ADD THE ABSOLUTE START TRACK XLA $STRK ADA TRACK STA TRACK OF THE OP SYSTEM. NOW HAVE THE TRACK. LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) * XLB $SSCT GET THE START SECTR OF OP SYS ADA B ADD IN RELATIVE SECTR TO GET ABS SECTR OF PATCH STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 XIF * * *THIS IS A GENERAL PURPOSE DISC PATCH SUBROUTINE * CALLING SEQUENCE JSB SYRUW * A REG = MEMORY ADDRESS (LOCATION) * B REG = REPLACEMENT VALUE * THE MEMORY LOCATION WILL BE CHANGED TO A DISC ADDRESS * AND THE CONTENTS OF THE B REG WILL BE PLACED THERE * THIS ROUTINE SHOULD ONLY BE USED TO MODIFY OP SYSTEM * LOCATIONS !!!!!! * SYRUW NOP UPDATE $BGFR &ëÚB@< $RTFR ON DISC SWP FIX FROM DFINE TO WORK IN LOADR (CMM) STB UPDT1 JSB TRK GET THERE TRACK ADDRESS JSB UREAD READ THEIR SECTOR LDA WORD GET THE ADDRESS ADA ALBUF WITHIN THE SECTOR LDB UPDT1 GET CONTENTS OF THE NEW $RTFR WORD STB A,I STICK IT INTO THE BUFFER * ISZ P1 NOW MAKE IT A WRITE JSB UREAD PATCH ON DISC CLA,INA FIX P1 STA P1 JMP SYRUW,I UPDT1 NOP * IBÿÿþú SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT RELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,RBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) STA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK |Uþú# LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TPREL FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TPREL HIGH LOAD +1 !!!!!!!!!!!!! * STB TPREL SET NEW ADDR. LDA MSEG GET THE MSEG FLAG CPA P2 THIS A SEGMENT ? RSS YES. JMP ABOUT,I NO, JUST RETURN LDA SHIGH,I GET THE PAST HIGH CMA,INA ADA B IS THIS HIGH BIGGER ? SSA,RSS WELL ? STB SHIGH,I YES, SO SET UP NEW HIGH MAIN +SEG + 1 JMP ABOUT,I * TEMPQ NOP * * OVERFLOW OF TRACK ALLOCATION * * AB3 LDB TRAKB GET THE BASE TRACK ADB #TRAK ADD IN THE # OF TRACKS SO FAR LDA TRKLU GET THE LU OF THE TRACK ÞLþúCPA P3 = LU # 3 ? ADB TATSD YES SO ADD IN # OF TRKS ON SYS DIS ADB TAT NOW ADD ADDRESS OF START OF TAT XLA B,I THIS TRACK FREE ? SZA WELL ? JMP AB10 NO * ISZ #TRAK YES SO BUMP TRACK # LDA XEQT GET MY ID ADDRESS JSB SYSET POST TO TAT JMP AB0 AND CONTINUE LOADING. * AB10 LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK CLB SET UP TO MPY LDA #TRAK MPY NO. OF TRACKS MPY ABT4 TIMES SECTS PER TRACK SZB ONE WORD HLT 3 SSA 15 BITS HLT 4 CMA,INA NEG TOTAL # SECTS REQUIRED STA #SECT SAVE OFF JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT DEF P128 DEF ABT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA ø»þú RESET TO ZERO STA ABT10 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 THEN CONTINUE TO LOAD. * CLA IF NOT DOING MAIN/SEGMENT CPA MSEG LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY ID SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY OÚ_þúNCE. LDA IDA (A)= STARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY * THE CONTENTS OF "IDA" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AR¸%þúEA. * * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (IDA) = ADDR. OF DUMMY * ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA KLUGE GET THE KLUGE FLAG SZA,RSS ARE WE DOING THE STUPID SYS MOVE JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * THIS KLUGE WAS NOT MY DOING (C.M.M.) * LDB IDA ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINATION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED * (B) = FIRST WORD DESTINATION ADDR * STRFR eÈþúNOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND COUNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * * DMYMV LDB IDA SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N20 THEN SET MOVE COUNT=-20. STB NUMWD JSB BLKID GET CURRENT ID EXT LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN USE BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFER. JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB NAMOK SEE IF PROG NAME STILL OK. LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG ID. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCATION. LDB BID8 GET # OF SMALL IDS W/O2þú DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB IDA ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA N5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO PRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR TRANSFER ADDR PNTRS JMP MOVID DO MebþúOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P31 INDEX TO 2ND SESSION WORD XLA B,I & PULL IT IN. AND B170K KEEP ONLY UPPER 4 BITS IOR COPY? SET UP THE COPY BIT IOR OWNER AND THE OWNER WORD STA SESW2,I & SET INTO THE 2ND SESSION WORD. * LDB ABT11 GET THE DESTINATION ID ADDR AGAIN ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS INB (B) = ADDR OF EMAID LDA N5 A = -5 FOR EMAID TO SESW3 JSB STRFR TRANSFER ADDRESS POINTERS * * * * LDA EMABP GET THE EMA FLAG SZA ANY DECLARED ? JMP DOEMA YES LDA N18 NO. CHANGE THE MOVE COUNT STA NUMWD TO 18. (IE DON'T USE ID EXTENSION) JMP MOVID GO MOVE THE DUMMY ID SEGMENT * DOEMA LDB BID9 GET THE ADDRESS OF THE ID EXT TO USE SZB,RSS IS THERE ONE ? JMP LL20. NO, EN ERROR LDA N2 SET FOR TRANSFER (ADDRESS IF ID EXTENSION) JSB STRFR SET UP THE POINTERS * LDA BID10 GET THE ID EXT # ALF,ALF ROTATE TO UPPER END RAL,RAL LDB EMASZ GET THE EMA SIZE SZB,RSS WAS IT DEFAULTED INA SET A FLAG ADA B NO, SO USE SPECIFIED SIZE STA EMAID,I AND PUT IN DUMMY ID SEGMENT * * SKP ¡3þú * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR AND SOURCE TOO. STB SRAD2 LDB NUMWD STB NUMW2 ALSO # OF WORDS TO MOVE KEPON LDB KLUGE ARE WE DOING KLUDGY SZB SYS ID TO SYS ID? JMP KEPNX YES, GO DO CROSS MAP LDA SRADR,I NO, GET WORD FROM SOURCE ID JMP *+3 AND CONTINUE KEPNX XLA SRADR,I KLUDGE - DO CROSS MAP LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD XSA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT DEF *+1 PROCESSING DEF *+1 * CLA CLEAR SESSION WORD FOR DISC XFER STA SESW3,I LDA COPY? STA SESW2,I & KEEP ONLY COPY BIT FOR DISC * * LDB ABT10 GET THE EDIT FLAG SZB,RSS PERM ADDITION ? JMP NODSK NO, SO DON'T USE THE DISC * LDB DESA INITIALIZE SOURCE POINTERS STB DESAM DODSK LDB KLUGE ARE WE DOING KLUDGE? SZB SYS ID MOVE TO SYS ID? JMP DDSKX YES, GO DO XMAP LOAD LDA SRAD2,I NO, JUST GET THE WORD JMP *+3 AND KEEP GOING DDSKX XLA SRAD2,I KLUDGE - CROSS MAP LOAD LDB DESAM,I GET THE DESTINATION JSB SYRUW FIX THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 ARE WE DONE ? JMP DODSK NO, SO PLAY IT AGAIN SAM * NODSK ISZ MVIDS SET UP THE SUCCESSFUL RETURN * LDB ABT11 ADB P14 GET THE PROG TYPE WE JUST LAID DOWN ®Èþú XLA B,I AND P7 CPA P5 SEGMENT ? JMP MVIDS,I YES, SO WERE DONE. * LDB ABT11 MAIN, SO DO SOME MORE PROCESSING STB #IDAD SAVE THE ID ADDRESS * LDA PG.PT GET PAGES/ PART'N WORD ADB P21 AND ADDRESS JSB SYSET AND SET UP THE WORD * LDB ABT10 PERM LOAD ? SZB,RSS JMP MVIDS,I NO, WE'RE DONE * LDA PG.PT LDB ABT11 ADB P21 JSB SYRUW * JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID LL21 LDA ERR21 JMP ABOR ERR21 ASC 1,21 P31 DEC 31 N18 DEC -18 NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID ? JMP NOIDS LONG LDA ERR26 SHORT JMP ABOR ABORT THYSELF WITH A L-26 ERROR ERR26 ASC 1,26 B170K OCT 170000 COPY? NOP 0/2000 COPIES OK/DON'T COPY OWNER NOP OWNER WORD FOR TARGET ID SEG * SKP * * THE NAMOK ROUTINE CHECKS THE IDS IN THE SYSTEM TO MAKE * SURE THAT THE PROGRAM JUST RELOCATED STILL HAS A UNIQUE * NAME. THAT IS, THAT SOMEBODY DIDN'T SNEAK AN RP IN ON US. * * * NAMOK NOP LDA SSFLG GET THE LONG/SHORT ID FLAG LDB IDA AND THE DUMMY ID ADDRESS SSA,RSS SHORT OR LONG ? INB 0 = LONG INB -1 = SHORT * STB NAM12 INB SET UP NAME FOR TEST STB NAM34 INB STB NAM5 * CCA SET UP FLAG FOR # OF TESTS STA NMFLG SET PROG NAME FLAG * ONEMR JSB MIDN FIND THE ID IF ONE JMP NAMOK,I NONE SO OK $ÆþúLDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGNORE DUPLICATE, JMP NAMOK,I AND CONTINUE. * LDA NAM12,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA NAM34,I NAME MESSAGE BUFFER STA MESS7+13 LDA NAM5,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM * JSB $LIBX RETURN TO INT PROCESSING DEF *+1 DEF *+1 * JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 ABORT THE GUY LDA RENAM GET ASCII '##' STA NAM12,I SET PROG NAME 1,2 = '..' LDB SSFLG IF MAIN, SET INTO OUTPUT MESSAGE SSB,RSS STA MESS4,I LDA P5 LDB NAM12 JSB SYOUT TELL THEM THE NEW NAME * JSB $LIBR NOP JMP ONEMR REPEAT DUPLICATE PROG NAME SCAN * SKP * * SUBROUTINE: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP JSB SETAB * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA # OF ADA ABT7,I BASE PAGE WORDS C#SXX CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TO²íNLHTAL JMP C#S,I RETURN. * * * * * SUBROUTINE: "C#SMX" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * IT USES CROSS LOADS BECAUSE THE ID SEGMENT IS NOT A * DUMMY ID SEGMENT, RATHER, IT IS AN ID IN MEMORY. * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#SMX * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#SMX NOP JSB SETAB * XLA ABT4,I DETERMINE CMA,INA # OF XLB ABT5,I MAIN WORDS ADA B STA ABT1 XLA ABT6,I DETERMINE CMA,INA # OF XLB ABT7,I BASE PAGE WORDS ADA B LDB C#SMX SET RETURN STB C#S JMP C#SXX * * SETAB NOP STA ABT4 INA STA ABT5 SET UP THE ADDR OF BOUNDS INA STA ABT6 INA STA ABT7 JMP SETAB,I * * ðONÿÿþú SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BID7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * BID9 = ADDRS OF 1ST AVAIL ID EXTENSION, = 0 IF NONE * BID10 = ORDINAL # OF THE FREE ID EXT * BID11 = # OF FREE ID EXTENSIONS * * (NOTE: ABOVE PARAMETERS ARE ZERO IF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA BID9 ADDRESS OF FREE ID EXT STA BID10 FREE ID EXTENSION'S ORDINAL # STA BID11 # OF FREE ID EXTENSIONS STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. * XLA $IDEX GET THE ADDR OF ID EXTENSION BLOCK STA IDEX AND SAVE JMP *+3 CNTEX ISZ IDEX BUMP POINTER ISZ BID10 BUMP ID E/þúXTENSION # XLA IDEX,I GET THE ADDRESS SZA,RSS IF END OF LIST JMP BLK1A GO TO ID SEGS XLB A,I ELSE GET THE CONTENTS OF 1ST WORD SZB IS THIS ONE FREE ? JMP CNTEX NO STA BID9 SAVE THE ADDRESS ISZ BID11 COUNT IT AS FREE NXIDX ISZ IDEX BUMP POINTER XLA IDEX,I GET THE ADDRESS SZA,RSS FINISHED ? JMP BLK1A YES, COUNT REST OF IDS XLA A,I GET THE 1ST WORD SZA,RSS IS IT FREE ? ISZ BID11 YES, SO COUNT IT JMP NXIDX GO LOOK AT THE NEXT ONE * BLK1 ISZ KEYPT BUMP KEYWORD ADDR BLK1A XLB KEYPT,I GET KEYWORD SZB,RSS IF END OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG XLA B,I IF NAM12=0 SZA,RSS THEN ITS A BLANK ID JMP BLK2 CPA P1 CHECK FOR REPLACE OPERATION FLAG JMP BLK2 CPA P2 JMP BLK2 * JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA XLB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. XLB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? STB BID2 NO, SET ADD>þúR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL XLA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#SMX DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THEN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION XLB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#SMX DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION XLB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,÷þúI NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP BID9 NOP BID10 NOP BID11 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT IDEX NOP POINTER TO ID EXTENSION LIST DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * SKP * * * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * "#SECT" CONTAINS -# OF SECTORS REQUIRED * * A AND B MEANINGLESS * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECOME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * * THE NUMBER OF SECTORS PER TRACK MAY DIFFER)§þú BETWEEN WHERE * THE LOADR HAS TRACKS NOW AND WHERE THE NEWLY REQUESTED * TRACKS ARE. CONSEQUENTLY, WE'D BETTER CHECK THE NUMBER OF * SECTORS WE REALLY WANT AGAINST THE NUMBER WE GET. * THE INITIAL REQUEST FOR TRACKS FALLS OUT BECAUSE #SECT= 0 * IE #SECTS IS NOT SET SO IT = 0 * * CLB SET UP TO MPY LDA #TRAK NO. OF TRKS MPY TRKS# TIMES SECTS PER TRK SZB SHOULD FIT IN ONE WORD HLT 1 SSA SHOULD FIT IN 15 BITS HLT 2 ADA #SECT SUBTRACT # OF SECTS REQUIRED * SSA,RSS HAVE ENOUGH? JMP ITRK2 POS,YES, CONTINUE * JSB EXEC NEG,NO,RELEASE DEF *+5 WHAT WE JUST GOT DEF P5 DEF #TRAK DEF TRAKB DEF TRKLU * ISZ #TRAK AND ASK FOR MORE JMP ITRK9 * * ITRK2 LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF |¦þúDISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY FLAG FOR TRACKS #SECT NOP NEG # SECTORS REQUIRED SKP * * 'EDIT' COMPLETION * ED00 LDA MSEG GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#SMX # SECTORS STA ED60 AND SAVE * LDB ED25 JSB COPY. ANY COPIES OF THIS PROG ? * * LDB TAT NO, SO SET THE SIGN BIT XLA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. ADB P2 (B)=NAM5 ADDR OF MATCHED ID XLA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. STA SWPID SAVE THE TYPE FOR A MOMENT CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD XLA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET XLA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET XLA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL JMP ED003 * * ADB P4 GET LAST PARTITION PROGRAM WAS IN XLA B,I AND M77 KEEP ONLY PARTITION Ûþú MPY P7 NOW INDEX INTO $MATA TABLE XLB $MATA ADA B ADA P2 GET RESIDENT PROG XLA A,I CPA ED25 DID PROG TERM SERIALLY REUSABLE ? RSS YES, YOU LOSE JMP ED004 * * * SKP ED003 LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT LDA ERR34 AND ABORT THYSELFZERO JMP ABOR * ERR34 ASC 1,34 MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 LDB OPCOD GET THE OPERATION FLAG CPB P4 THIS A PURGE ? CLB,RSS YES, SET NAME = 0 CLB,INB SET REPLACE FLAG INTO ID * KEEPS OTHER LOADRS & FMGR HONEST JSB $LIBR TURN OFF INTERUPTS NOP XSB LH1,I ZERO ISZ LH1 NAME XSB LH1,I IN ISZ LH1 CORE XLA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) XSA LH1,I * CLA LDB SWPID GET THE PROGRAM TYPE CPB P5 IS IT A SEGMENT ? JMP NOZAP FORGET ABOUT ID EXTENSION * LDA LH1 NOW GET THE ADDRESS OF ADA P14 THE ID EXT WORD XLA A,I PULL IT IN SZA,RSS ANY ID EXTENSION JMP NOZAP NO. * ALF YES RAL,RAL GET THE # TO LOW END AND M77 & KEEP ONLY THE # XLB $IDEX ADD START OF TABLE ADA B XLA A,I NOW HAVE THE ADDRESS CLB XSB A,I AND ZAP THE WORD NOZAP JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * SZA,RSS WAS THERE AN ID EXT ? JMP TKREL NO, GO RELEASE THE TRACKS SWP YES, SO ZAP THE DISC AS WELL. JSB SYRUW * * RELEASE "OLD" TRACKS * TKREL LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOr`þúP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DISC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 RSS JMP *+3 XLA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, >¿þúJMP NTRM7 GO TO USE FIRST BLANK. * LDA IDA GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 THEN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST ADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 XLB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) XLA B,I IF SZA,RSS = JMP ED17 0, CHECK FURTHER. CPA P1 JMP ED17 ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR XLA B,I GET THE TYPE OF PROGRAM AND P7 CPA P1 MEM RES ? JMP ED12 YES, FORGET IT * JSB MEM? GET ADDR OF MEM1 NOP (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN XLA B,I SZA,RSS IF NO DISC ALLOCATION TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * SSA TRACK ALLOC ON LU 3 ? JMP ED12 YES, FORGET THIS TOO CMA,INA IS THE TRACK ABOVE THE ADA DSCLB THE LIB OF SYS ENTRY POINTS ? SSA WELL ? JMP ED12 WELL, WE CAN'T USE THAT EITHER * LDA B ADA N4 (A)=MEM1 ADDR JSB C#SMX GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS 'lþú USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. XLA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRM7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB IDA GET DUMMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 XLA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKIHsþúD FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BID2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 GET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE AREA DEF P1 DEF DSKUN DEF LBUF DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF LBUF DEF P64 DEF ED66 DEF ED67 * Žþú ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CLA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGN SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB IDA STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA MSEG PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA IDA SET ADDR OF ADA N9 NEXT SHORT DUMMY STA IDA ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA IDA INA * ED181 CLB,INB ìþNLH CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. ôtNÿÿþú SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TACKS STB FIX SAVE B REG FOR A MOMENT LDA IDA SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE * LDB A ID ADR TO B REG ADB P14 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 B = ADDR OF DMAIN XLA B,I GET THE DISC SPACE SSA IF ON LU 3 FORGET IT JMP SWPID,I * CMA,INA IF NOT BELOW DISC LIB ENTS ADA DSCLB THEN SSA JMP SWPID,I FORGET IT ALSO * LDA ED25 STA IDA SET IT IN IDA FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG STA KLUGE & KLUGE FLAG (THE PERSON WHO WROTE THIS * SHOULD BE SHOT !!!!!!!!!) LDB FIX GET THE B-REG BACK JSB MVIDS AND CALL MVIDS TO SET UP THE KLUGE. NOP IGNOR ERROR RETURN CLB CLEAR KLUGE FLAG STB KLUGE LDB DREL RESTORE STB IDA THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * KLUGE NOP FLAG USED ONLY BY SWPID FOR MOVING MEM1 - DMAIN * FROM NEW ID TO THE OLD ONE. * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMA©ÓþúIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL JSB MODID ISZ DREL ISZ SWPID DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM HLT 0 ** SHOULD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * A = # OF TRACKS TO RELEASE * B = DISC SWAP WORD * * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. (ED64 = TAT ADDRESS) LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64 BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR XLA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TAB,þúLE. ISZ ED62 JMP DR JMP DREL,I SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TATLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR STB FIX & SAVE NXTRK LDA DREL GET ID SEGMENT ADDR TO A XLB FIX,I THIS TRACK BELONG?? CPA B RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 ISZ FIX STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * * IFN * THESE TWO DUMMY SUBS MAKE THIS LOADR COMPATIBLE WITH * THE SESSION MONITER LOADR * * PTERR NOP LDA PTERR,I JMP A,I * * * .OWNR NOP CLA JMP .OWNR,I XIF MAPOF DEC 34 * SKP * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = =ñþúPRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE MSEG NOP SEGMENTED PROG FLAG * 0 = NOT SEGMENTED PROGGMENTED FLAG * 1 = SEGMENTED PROG BUT WE'RE LOADING MAIN * 2 = SEG PROG & WE'RE LOADING A SEGMENT OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU NOP LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE WORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF LST1 NOP LST WORD 1 ADDR LST2 NOP LST WORD 2 ADDR LST3 NOP LST WORD 3 ADDR LST4 NOP LST WORD 4 ADDR LST5 NOP LST WORD 5 ADDR PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4 NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG NUPLS NOP NO. UTILITY PROGS LOADED TPREL NOP CURRENT MAX PROG RELOC ADDR DBLAD NOP DATA BLOCK RELOCATION ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT LBUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA LWABP NOP BASE PAGE AREA. SEGB 2UþúNOP SEGMENT BASE PAGE LOWER BOUND DBLFL NOP FIRST DBL REC: -1,YES; 0,NO. FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P20 DEC 20 M7 EQU P7 M20 OCT 20 M77 OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE RBTAD DEF *+1 RELOCATION BASE TABLE NOP PPREL NOP CURRENT PROG BASE BPREL NOP BASE PAGE BASE COMAD NOP COMMON BASE NOP ABSOLUTE BASE BLOK# NOP UCHRG OCT 43400 MSIGN OCT 100000 CHRDE ASC 1,.D CHRBU ASC 1,BU AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 BLST NOP BEGINNING OF LOADER SYMBOL TABLE PLST NOP END OF LST TLST NOP CURRENT LST ADDR. SLST NOP INITIALIZE FOR SEGMENT AREA. FLST NOP FWA OF LST SET FOR USER'S PROG OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * SPC 1 #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR ERR16 ASC 1,16 SPC 1 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON7$" AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS SYSLN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 SPC 1 SPC 1 BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA * BSS 0 SIZE OF LOADR SPC 3 END LOADR ªK$ÿÿ ÿýj ÿ92067-18003 1926 S C0222 &4MTM1 RTE-IV MULTI TERMINAL MONITOR             H0102 ²¾þúASMB,R,L,C HED PRMPT - MTM PROMPTER * NAME: PRMPT * SOURCE: 92067-18003 * RELOC: PART OF 92067-16003 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRMPT,1,5 92067-16003 REV.1926 790506 SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,TRMLU,$LIBR,$LIBX,IDGET,$RNTB,$BMON EXT $LIBR,$LIBX,$MTM * * THIS INTERRUPT ROUTINE REPLACES (AUXTY IN RTE) WITH (PRMPT IN RTE II). * IT IS SCHEDULED ON INTERRUPT BY DVR00 IF THAT TERMINAL HAS BEEN * PROPERLY ENABLED (ON,CNTRL,LU,20) * PRMPT : DETERMINES LU IN ASCII & BINARY * OUTPUTS A ZERO LENGTH RECORD * OUTPUTS "LU>_" * REQUESTS A CLASS READ TO THE INTERRUPTING LU * SCHEDULES R$PN$,2,10 WITH :CLASS #,EQT4,LU,ASCII LU * W/O WAIT * TERMINATES,SAVING RESOURCES * PRMPT EQU * STB EQT4 SAVE INTERRUPTING DEVICE'S EQT WORD 4 ADDRESS JSB TRMLU OBTAIN LU IN BINARY & ASCII DEF *+1 SZA,RSS FOUND ONE ? JMP EXIT NO,TERMINATE. STA LU YES,SAVE LU IOR B400 READY PRINT BACK STA RLU SAVE READ LU + CNTRL IN RLU XOR B2500 FORM CONTROL WORD... STA CONWD * STB ASCLU SAVE ASCII LU BLF,BLF ROTATE FOR NAME STB PNAM+2 FORM NAME OF FMGR FOR THE TERMINAL * SPC 1 * CHECK IF DEVICE IS OPERABLE SPC 1 LDB DRT GET START OF DEV REF TAB ADB LU INDEX TO PROPER ENTRY ADB DM1 STB LU1 SAVE THE ADDRESS ADB LUMAX GET TO DRT PART 2 LDªþúA B,I PULL IT IN SSA IS THE LU DOWN ? JMP EXIT YES SO FORGET IT * LDB EQT4 NOW GET INB EQT 5 LDA B,I AND MEQT GET THE EQT TYPE FOR STA DVTYP DVR07 CHECK * LDA B,I GET IT AGAIN RAL,RAL GET STATUS BITS AND D3 CPA D1 IS EQT DOWN ? JMP EXIT YES SO FORGET IT * LDA LU1,I GET THE DRT ENTRY AND M3700 NOW THE LOCK BITS SZA,RSS IS THE DEVICE LOCKED ? JMP DISAB NO, SO WRITE OUT THE PROMPT. * ALF,ALF YES SO CONFIGURE A RN BYPASS WORD RAL,RAL STA RN# ADA RNTB NOW GO TO RN # TABLE XLA A,I AND B377 GET THE OWNER TO ALF,ALF TO UPPER END IOR RN# CONFIGURE THE WORD DISAB STA RN# * LDA DVTYP GET THE DRIVER TYPE CPA DVR07 IS IT DVR07 ? JMP DVR7A YES * JSB EXEC DISABLE THE TERMINAL TO AVOID DEF *+10 MULTIPLE PROMPTS.... DEF D3 DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * JMP ZEROL GO SEND ZERO LENGTH RECORD * DVR7A LDA LU SEND EDIT MODE REQUEST TO DVR07 IOR B2300 STA CONWD JSB EXEC DEF *+10 DEF D3 DEF CONWD DEF IM DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * ZEROL JSB EXEC RESPOND WITH DEF *+10 ZERO LENGTH RECORD DEF DS2 DEF LU DEF BUFF DEF D0 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# NOP * LDA PNAM+2 FINISH NAME SET UP AND B377 KEEP LOW CHAR. ONLY IOR "G" ADD HIGH ORDER G FOR FMGXX STA PNAM+1 SET 'GX' SKP * JSB IDGET LOOK UP THE ID ADDRESS DEF *+2 DEF PNAM SEZ 0˜þú JMP PROMT NO GO DO PROMPT * ADA D8 GET POINT OF SUSP. XLB A,I GET ADDRESS SZB IF NOT ZERO JMP PROMT DO STD. PROMPT * ADA D12 GET ADDRESS OF SESSION BIT WORD STA IDA SAVE IT FOR LATER ADA D12 GET THE SESSION WORD STA SESWD SAVE IT FOR LATER TOO * * *1926DLS* FROM G.M. FOR RTE-IVB * DLD DEFAD *DEFINE LOCATION OF DST LISEV * LIST AND SEVERITY PARMS LDA $BMON *FETCH FILE MANAGER TYPE FLAG SZA,RSS *IF IVA VERSION JMP OK! *GO SCHEDULE HIM * DLD DEFAD *ELSE REVERSE SWP *THE ORDER OF LIST AND SEVERITY DST LISEV *FOR FILE MANAGER TURN-ON * OK! JSB EXEC TRY TO SCHEDULE 'FMGLU' DEF *+1+9 DEF DS10 (NO ABORT) DEF PNAM DEF LU PASS IT THE TERMINAL LU DEF LU LOG LU LISEV DEF LU LIST LU DEF D1 SEVERITY OF ONE DEF D1 DUMMY DEF STNG TURN ON STRING DEF D4 LENGTH IS 4 JMP PROMT IF ERROR - DO PRMPT-R$PN$ THING! SZA A=0 IF ALL'S WELL... JMP PROMT ELSE, DO PRMPT-R$PN$ AS NORMAL. * * *1926DLS* END CHANGES JSB $LIBR GO PRIV NOP XLA IDA,I GET THE SESSION BIT WORD IOR SESS XSA IDA,I SET SESSION BIT IN ID LDB LU GET OUR LU # CMB,INB MAKE NEG XSB SESWD,I AND SET UP FMGR'S LOG LU JSB $LIBX DEF *+1 DEF *+1 LDA ASCSP SET UP PROMPT BUFFER... STA ASCLU+1 JSB EXEC OUTPUT "LU> FMGLU" DEF *+10 DEF DS2 DEF LU DEF ASCLU DEF N9 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * NOP * LDA DVTYP GET THE DEVICE TYPE CPA DVR07 IS IT DVR07 ? JMP EXIT YES, SO JU%|þúST EXIT LDA CONWD RE-ENABLE THE TERMINAL AND B77 IOR B2000 STA CONWD JSB EXEC DEF *+10 DEF D3 DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# JMP EXIT * PROMT LDA ASCBK SET BACK-ARROW IN PROMPT STA ASCLU+1 MESSAGE * JSB EXEC DEF *+10 "LU>_" DEF DS2 DEF LU DEF BUFF DEF D2 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# NOP SPC 1 LDA $MTM GET ANY PREVIOUS CLASS # ALLOCATED STA CLASS AND USE IT. SPC 1 JSB EXEC PERFORM CLASS I/O READ DEF *+10 DEF DS17 DEF RLU DEF * DEF DM80 *1926DLS* DEF LU DEF EQT4 DEF CLASS DEF NOP DEF RN# NOP SSA ERROR RETURN? JMP EXIT YES-BEAT IT ! * ZAPIT JSB SVMTM NO, SO SAVE CLASS # SPC 1 JSB EXEC SCHEDULE R$PN$ W/O WAIT DEF *+1+3 IGNORE SCHEDULE ERRORS SINCE DEF D10 R$PN$ IN CLASS 'GET' SUSPEND DEF R$PN$ DEF CLASS * * * EXIT JSB EXEC TERMINATE DEF *+1+3 & SAVE DEF D6 RESOURCES DEF D0 DEF D1 JMP PRMPT RESTART HERE ON INTERRUPT * * * * * SVMTM NOP JSB $LIBR GO PRIV NOP LDA CLASS GET CLASS # STA $MTM AND SAVE IN TABLE AREA 1 CLA NEVER DO THIS SUB AGAIN STA ZAPIT JSB $LIBX DEF SVMTM RETURN * * SKP ****************2 WORD VALUE DON'T TOUCH****** DEFAD DEF LU *1926DLS* FROM G.M. DEF D1 *1926DLS* FROM G.M. ********************************************** IDA NOP "G" OCT 43400 B377 OCT 377 SESS OCT 20000 EQT4 BSS 1 LU BSS 1 B77 OCT 77 B400 OCT 40ü60 B2000 OCT 2000 B2500 OCT 2500 RLU BSS 1 DS2 OCT 100002 D2 OCT 2 D3 OCT 3 *1926DLS* DEL NEXT LINE CONWD NOP LU1 NOP DRT EQU 1652B LUMAX EQU 1653B BUFF EQU * ASCLU ASC 2,00>_ PROMPT MESSAGE PNAM ASC 3,FMGXX FMGR FOR THE TERMINAL ASCSP ASC 1,> * ASCBK ASC 1,>_ * N9 DEC -9 D6 DEC 6 D0 DEC 0 D1 DEC 1 DM1 DEC -1 M3700 OCT 3700 D4 DEC 4 D8 DEC 8 D12 DEC 12 STNG ASC 4,::HI::-2 TR TO 'HI' TO START UP CLASS NOP NOP NOP DM80 DEC -80 D10 DEC 10 DS10 OCT 100012 R$PN$ ASC 3,R$PN$ DS17 OCT 100021 RNTB DEF $RNTB+0 RN# NOP MEQT OCT 37400 B2300 OCT 2300 IM OCT 71401 DVR07 OCT 3400 DVTYP NOP SESWD NOP A EQU 0 B EQU 1 END PRMPT ÚÿÿþúASMB,R,L,C * ASMB,Z FOR THE WHZAT SCHEDULING OPTION HED R$PN$ MTM RESPONSE * NAME: R$PN$ * SOURCE: 92067-18003 * RELOC: PART OF 92067-16003 * PGMR: G.A.A.,C.M.M. * DATE: AUGUST 1,1974 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM R$PN$,1,5 92067-16003 REV.1926 790506 SUP PRESS EXTRANEOUS LISTING EXT EXEC,TRMLU,$RNTB,$WORK,$$OP EXT $LIBX,$LIBR,IDGET,$MESS,$PVCN * A EQU 0 B EQU 1 * * SPC 2 R$PN$ EQU * ENTRY POINT,SCHED BY PRMPT SPC 2 XLA B,I GET CLASS # AND C160K MASK OFF CLASS NO ONLY STA RQCLS & SAVE IT IOR B20K SET FOR SAVE CLASS STA CLASS & SAVE IT ! JSB BUFF INITILIZE ID ADDS (NOP AFTER FIRST CALL) SPC 2 WAIT JSB EXEC CLASS I/O GET DEF *+1+7 DEF D21 DEF CLASS DEF BUFF DEF DM80 *1926DLS* DEF LU DEF ID DEF RCLAS * LDA RCLAS RAR,SLA WAS THIS A READ RETURN? JMP WAIT NO, WAIT * SPC 1 * SEE IF WE CAN WRITE TO THE LU W/O BEING SUSPENDED SPC 1 * LDA DRT GET START OF DEV REF TAB ADA LU INDEX TO PROPER ENTRY ADA DM1 STA LU1 SAVE THE ADDRESS ADA LUMAX GET TO DRT PART 2 LDA A,I PULL IT IN SSA IS THE LU DOWN ? JMP ENABL YES SO FORGET IT * LDA ID NOW GET INA EQT 5 LDA A,I RAL,RAL GET STATUS BITS AND D3 CPA D1 ÷~þú IS EQT DOWN ? JMP ENABL YES SO FORGET IT * LDA LU1,I GET THE DRT ENTRY AND M3700 NOW THE LOCK BITS SZA,RSS IS THE DEVICE LOCKED ? JMP SETRN NO, DO IT ! * ALF,ALF YES, SO CONFIGURE LOCK ID WORD RAL,RAL STA RN# ADA RNTB XLA A,I GET THE OWNER OF THE RN # AND B377 ALF,ALF IOR RN# SETRN STA RN# * LDA ID GET THE EQT INA TYPE WORD LDA A,I AND MEQT KEEP ONLY DEVICE TYPE FOR STA DVTYP LATER DVR07 CHECK * * WRITES & READS TO THIS TERMINAL ARE OK . STB IB YES, SAVE XFER LOG CHARS SZB,RSS IF ZERO-LENGTH JMP ENABL SKIP PROCESSING CODE. * * SPC 2 LDA BUFF TEST FOR FLUSH COMMAND CPA ASCFL JMP FL YES-FLUSH THIS LU'S BUFFER * CPA "BR" IF BREAK JMP BRPR GO DO BREAK * CPA "AB" IF ABORT JMP ABPR GO DO ABORT THING * IFZ CPA WHZAT WHZAT CALL? JMP WHPR YES GO DO IT XIF SPC 2 PROCS EQU * NO-PROCESS REQUEST JSB MESSX BUFFR DEF BUFF * * MES SZA,RSS ANY MESSAGE RETURNED ? JMP ENABL NO. * * JSB EXEC & DISPLAY DEF *+10 SYSTEM DEF D18 MESSAGE DEF LU DEF BUFF DEF IA DEF LU DEF ID DEF RQCLS DEF NOP DEF RN# SPC 2 JMP ENABL NOW WAIT SPC 2 FL EQU * LDA DVTYP GET DEVICE TYPE CPA DVR07 IF ITS DVR07 JUST JMP WAIT FORGET IT. * LDA B2300 SET UP CNWRD IOR LU TO FLUSH STA CONWD JSB EXEC PERFORM DEF *+10 I/O DEF D3 CONTROL DEF CONWD DEF CONWD DEF RQCLS DEF NOP DEF NOP DEF NOP DEF NOP DEF $EþúRN# SPC 2 ENABL EQU * LDA DVTYP GET THE DEVICE TYPE CPA DVR07 IS IT DVR07 ? JMP WAIT YES SO DON'T SEND DVR CONTROL REQUEST LDB ID RETRANSLATE JSB TRMLU INCASE LU WAS REASSIGNED DEF *+1 IOR B2000 STA CONWD JSB EXEC DEF *+10 DEF DS3 REENABLE THE TERMINAL DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * JMP WAIT JMP WAIT SPC 2 BRPR LDB IB IF IB MORE THAN BRS,BRS 3 CHAR. SZB THEN JMP PROCS LET SYSTEM HANDLE * JSB GETID GET THE LOWEST ID SEGMENT BRSET JSB $LIBR GO PRIV NOP ADB D5 INDEX TO BRAKE LOCATION XLA B,I GET THE WORD IOR BIT12 SET THE FLAG XSA B,I RESET THE WORD JSB $LIBX GET OUT DEF *+1 DEF ENABL RE- ENABLE THE TERMINAL * * ABPR JSB GETID GET LOWEST ID SEZ,RSS IF IT IS FMGR JMP BRSET GO SET BREAK IN STEAD * ADB N3 XLA B,I GET NAME STA NAM1 INB STEP TO NAM 2 XLA B,I GET IT STA NAM2 INB NOW NAM 3 XLA B,I AND C377 IOR B40 ADD BLANK PAD STA BUFF SET IN FIRST WORD OF BUFFER LDA IB GET THE OLD LENGTH ADA D8 WE ADDED 8 CHARACTERS STA IB JSB MESSX SEND THE MESSAGE DEF OF JMP MES * IFZ WHPR JSB EXEC RUN WHZAT TO THIS TERMINAL DEF WHEX WITHOUT WAIT & WITHOUT ABORT DEF D10I DEF WHZAT DEF LU WHEX NOP IGNOR ERROR JMP ENABL GO TO NEXT TRICK * WHZAT ASC 3,WHZAT D10I DEF 10,I XIF SPC 2 GETID NOP SUBROUTINE TO TRACK DOWN THE LOWEST ID LDA LU CONVERT THE LU INTO CLB THIS²Dþú GUY'S DIV D10 FMGXX IOR "G0" FORM 'GX' PART OF FMGXX STA PNAM+1 SET IT ADB "G0" ADJUST LOW X TO ASCII BLF,BLF ROTATE IT STB PNAM+2 SET LOW X IN HIGH PART OF WORD 3 JSB IDGET GET THE ID ADDRESS DEF *+2 DEF PNAM OF THIS FMGR SEZ GET ONE?? JMP PROCS NO DO STANDARD TRICK * NXSON STA B SET IN B AND STB IA SET IN IA ADB D15 INDEX TO THE STATUS XLA B,I GET IT TO A ALF,SLA WAITING FOR A SON?? JMP TRK YES TRACK DOWN * JMP GETID,I NO THIS IS IT * TRK ISZ IA SET TO PICK UP SON'S ID XLA IA,I GET THE SON'S ID CPA D.RTR IF D.RTR OR JMP GETID,I * CPA SMP SMP THEN STOP JMP GETID,I HERE * CCE SET E TO SHOW NOT FIRST ONE JMP NXSON GO GET IT * * * * SKP * THE MESSX SUBROUTINE IS A PERTERBATION OF THE RELEASED * MESSS SYSTEM LIBRARY ROUTINE. IT DOES ALL THE FUNCTIONS * THAT THE RELEASED ROUTINE DOES AND ALSO SETS UP THE LOG LU * IN WORD 32 OF THE PROGRAMS ID SEGMENT. * IN ADDITION, IT AVOIDS .ENTR AND SPENDS MINIMAL TIME WITH * THE INTERUPT SYSTEM OFF. * * ********************************************************************** * * * MODIFY THIS SUBROUTINE AT YOUR UNDYING AND EVERLASTING * * PERIL !!!! * * * * YOU SEE, $MESS DOES NOT ALWAYS RETURN, IE IT'S AN * * OPEN SUBROUTINE. * * * * WHEN THE PROG IS REDISPATCHED GUESS WHERE CONTROL IS * * TRANSFERED ? £Dþú * ********************************************************************** * * * CALLING SEQUENCE : JSB MESSX * DEF BUFFR INPUT MESSAGE BUFFER * * LU = LOG LU * IB = POS CHAR COUNT * * ON RETURN : A = 0 IF NO MESSAGE * ELSE IA = NEG CHAR COUNT * AND BUFF CONTAINS MESSAGE * * * MESSX NOP JSB $LIBR GO PRIV !!!! NOP * LDA HERE AM I ALREADY HERE ? SZA,RSS WELL ? JMP EXITR YES, SO I DON'T WANT TO BE HERE NOW. * CLA NO STA HERE BUT NOW I'M HERE STA $PVCN (RESET PRIV NEST CNTR SO SYS STAYS UP) * LDA MESSX,I GET THE BUFFER ADDRESS LDB IB GET THE CHAR COUNT (POS) JSB $MESS PASS MESSAGE TO SYSTEM. * SZA,RSS ANY MESSAGE RETURNED ? JMP CHECK NO, SO CHECK FOR RU & ON * XLB A,I GET THE CHAR COUNT (NEG) STB IA AND SAVE FOR MESSAGE OUTPUT * CMB,INB MAKE POS INB ACCOUNT FOR ODD CHAR BRS CONVERT TO WORDS CBX SET MOVE COUNT INA SOURCE (A NOT = 0 FOR RETURN) LDB BUFFR DESTINATION MWF MOVE WORDS FROM ALT MAP TO THIS MAP * SPC 2 * EXITR CLB,INB NOW SET A FLAG SO STB HERE I KNOW I'M NOT HERE & SO STB $PVCN THE PRIV RUN RETURNS CORRECTLY * ISZ MESSX SET RETURN JSB $LIBX RETURN TO INTERUPT PROCESSING DEF MESSX SPC 2 * CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. INB LDA MESSX,I TEST FOR ON OR RUN LDA A,I COMMANDS. CPA .ON JMP DP1 TEST 1ST PRAM CPA .RU JMP DP1 JMP DP2 SEE IF SYSTEM PARSED A RU OR ON COMMAND. * SPC 2 DP1 XLA B,xùþúI GET 1ST PRAM THAT SYSTEM DID SZA,RSS WAS THERE ONE ? LDA LU NO. SO GET THE LU XSA B,I AND GIVE IT TO THE PROGRAM. * DP2 XLA $$OP,I GET THE 1ST PRAM PARSED BY SYSTEM CPA .ON ON ? JMP DP3 CPA .RU RU ? JMP DP3 * RETRN CLA NO, SET NO MESSAGE FLAG & JMP EXITR RETURN. * DP3 ADB D13 GET TO THE STATUS WORD XLA B,I PULL IT IN AND D7 KEEP ONLY THE STATUS FIELD CPA D1 MEM RES PROG ? ADB DM4 ADB D18 INDEX TO THE SESSION WORD LDA LU GET THE LU CMA,INA MAKE NEG XSA B,I AND SET AS THE LOG LU JMP RETRN RETURN TO CALLER * * * "BR" ASC 1,BR "G0" ASC 1,G0 "AB" ASC 1,AB PNAM ASC 3,FMGXX CURRENT MASTER FMGR BIT12 OCT 10000 D8 DEC 8 DM4 DEC -4 D7 DEC 7 D13 DEC 13 DM1 DEC -1 DRT EQU 1652B LUMAX EQU 1653B LU1 NOP M3700 OCT 3700 D10 DEC 10 D1 DEC 1 SMP NOP ADDRESS OF SMP'S ID D.RTR NOP ADDRESS OF D.RTR'S ID D5 DEC 5 B40 CLE C377 OCT 177400 COMPLEMENT OF 377B D15 DEC 15 N3 DEC -3 * PRAM NOP BEGIN 5 WORD PRAM BUFFER CLASS EQU PRAM IA NOP PLEASE IB NOP DO NOT LU NOP RE-ARRANGE ID NOP THESE CONSTANTS D21 DEC 21 D3 DEC 3 DS3 OCT 100003 C160K OCT 17777 KEEP BITS 0-12 DM80 DEC -80 *1926DLS* OF ASC 2,OF, DON'T MOVE THE NEXT 4 WORDS NAM1 NOP NAM2 NOP BUFF BSS 40 MUST FOLLOW THE OF, CODE *1926DLS* ORG BUFF NOP INIT SUB. NEEDED ONLY ONCE JSB IDGET GET D.RTR'S ID DEF *+2 DEF D. SEZ CLA IF NONE SET TO ZERO STA D.RTR SAVE IT JSB IDGET NOW GET SMP'S DEF *+2 DEF SM SEZ IF NONE CLA USE ZERO ST•$*($A SMP CCB GET THE CALL TO HERE ADB BUFF AND CLA CLEAR STA B,I IT JMP BUFF,I RETURN * SM ASC 3,SMP D. ASC 3,D.RTR * LEFT EQU BUFF+26-* ERROR IF NEGATIVE ORR OUT OF THE BUFFER D18 DEC 18 HERE DEC 1 FLAG FOR IN OR OUT OF MESSX .ON ASC 1,ON .RU ASC 1,RU B377 OCT 377 RNTB DEF $RNTB+0 RN# NOP RCLAS NOP ASCFL ASC 1,FL CONWD NOP B2300 OCT 2300 B2000 OCT 2000 DVR07 OCT 3400 NOP NOP MEQT OCT 37400 DVTYP NOP B20K OCT 20000 RQCLS NOP EOP EQU * SPC 2 END R$PN$ —%*ÿÿ ÿýl~ ÿ92067-18004 1926 S 0122 RTE-IV POWER FAIL DRIVER              H0101 ’þúASMB,R,L,C RTE-IV POWER FAIL/AUTO RESTART DRIVER HED DVP43 - RTE-IV POWER FAIL / AUTO RESTART * NAME: DVP43 * PGMR: G.A.A.,E.J.W. * SOURCE: 92067-18004 * RELOC: 92067-16004 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVP43,0 92067-16004 REV.1926 790506 ENT $POWR,IP43,CP43 EXT $CVEQ,$SCLK,$TIME,$XEQ,$UPIO,$LIST,$MESS EXT $CIC,$PWR5,$DVMP,$DRVM,$UIN SUP * * * * THIS IS THE RTE-IV POWER FAIL AUTO RESTART ROUTINE. * * W A R N I N G ! ! ! * ******************** * DVP43 MUST BE INSTALLED IN THE RTE-IV SYSTEM AS A DRIVER * IN THE SYSTEM DRIVER AREA. THIS DRIVER DOES ITS OWN MAPPING. * * DVP43 REQUIRES AN EQT ENTRY: * 04,DVP43,M * * DVP43 REQUIRES A DRT ENTRY: * XX,## * * DVP43 REQUIRES AN INTERRUPT TABLE ENTRY: * 04,ENT,$POWR * * * * IT WORKS AS FOLLOWS: * * ON POWER FAILURE: * 1. BOTH DMA CHANNELS (PORT A AND B) ARE STOPPED * 2. ALL REGISTERS ARE SAVED, ALSO RETURN ADDRESS * 3. ALL FOUR MAPS ARE SAVED. * 4. TURN OFF POWER-FAIL INTERRUPTS UNTIL POWER RETURNS * * ON POWER UP: * 1. ALL FOUR MAPS ARE RESTORED * 2. THE EQT ADDRESS FOR THIS ROUTINE IS FOUND, IT * IS SET TO TIME OUT IN ONE TICK, AND THE "I WILL * HANDLE TIME OUT" BIT IS SET. * 3. THE CURRENT SYSTEM TIME IS SAVED (THIS WILL BE THE * TIME OF POWER FAILURE). * 4. THE CLOCK IS RESTARTED BY CALLING $SCLK WHICH WILL * SET UP FOR AN IMMEDIATE INTERRUPT. * 5. A RETURN WITH ALL ™þúREGISTERS RESTORED IS MADE TO THE * POINT OF THE POWER FAIL INTERRUPT. * * * ON THE FOLLOWING TIME OUT ENTRY THE FOLLOWING ACTION IS * TAKEN: * * 1. EACH EQT ENTRY IS CHECKED AND) * A) IF BUSY IT'S POWER FAIL FLAG IS SET (BIT 13 OF * THEN THE DRIVER IS ENTERED AT I.XX. THE FACT THAT * IT IS A POWER FAIL ENTRY MAY BE DETECTED BY * CHECKING THE BUSY BIT (ON NORMAL ENTRIES IT IS * NOT SET.) * * B) IF THE DEVICE IS BUSY AND IT'S POWER FAIL BIT * IS NOT SET THE DEVICE WILL BE SET DOWN, THE * POWER FAIL ROUTINE TIME OUT WILL BE SET BACK * TO ONE TICK AND THE CLOCK RESTARTED AND THE * SYSTEM "UP" PROCESSOR WILL BE CALLED TO UP * THE DEVICE. THIS CAUSES THE SYSTEM TO REISSUE * THE LAST REQUEST AND TO REENTER THE TIME OUT * SECTION OF THIS REOUTNE. * THE IMPLICATIONS OF THIS ARE THAT DISC TRANSFERS * WILL BE RETRIED, TTY, PUNCH, PHOTO READER * REQUESTS WILL BE RE-DONE RESULSTING IN DOUBLE * LINES IN SOME CASES. * * SOME DEVICES WILL BE REPORTED DOWN IS THEIR POWER * WAS ALSO CUT E.G. MAGTAPE, DISC. THESE * DEVICES MAY BE UPPED BY THEIR DRIVERS WHEN THEY * COME BACK ON LINE E.G. THE DISC. * * C) IF THE DEVICE IS DOWN THE SYSTEM UP PROCESSOR WILL * BE CALLED TO UP THE DEVICE. THIS WILL CAUSE * THE DOWNED DEVICES TO HAVE NEW MESSAGES POSTED * ON THE SYSTEM TTY. * * 2. THE PROGRAM "AUTOR" WILL BE ABORTED AND RESCHEDULED. * (THE ABORT IS TO ALLOW FOR MOMENTARY POWER UPS.) * AUTOR SHOULD TAKE WHAT EVER ACTION IS NEEDED TO * BRING UP THE SYSTEM IN TERMS OF ENABLING TERMINALS - * COMMUNICATION LINES ETC. IN ORDER TO ALLOW TIME * SYNC. THIS ROUTINE WILL PROVIDE THE žþúTHREE WORD SYSTEM * TIME AT POWER FAILURE ON THE FIRST READ REQUEST * AFTER POWER UP. THE SECOND READ REQUEST WILL * RETURN THE SAME TIME BUT CAUSES THE ROUTINE TO * RESET TO HANDLE A TOTAL NEW POWER FAILURE HED POWER UP/DOWN ENTRY POINT/ DOWN CODE. $POWR NOP POWER UP/DOWN ENTRY SFC 4 UP? JMP UP YES GO DO UP THING. * JMP DOWN,I GO TO DOWN ROUTINE DOWN DEF DWN POINTS TO WAIT WHILE SENSITIVE * CODE IS EXECUTING. STF STF 0 TURN ON THE INTERRUPT SYSTEM SW2 NOP (CLF 0 IF NOT USER RETURN ELSE STC 5) JRS MEMST PSAVE,I RETURN TO PT OF PWR FAIL. * DOWNI DEF DOWN INDIRECT FOR EXIT TO AVOID INTERRUPT * EXIT2 LDA ASAVE RESTORE A REGISTER LDB BSAVE AND THE B REGISTER JSB DOWNI,I RESET DOWN SWITCH AND EXIT * * DOWN ROUTINE * DWN STF 6B STOP DMA! PREVENT LONG DMA STF 7B TRANSFER FROM JAMMING CPU STA ASAVE SAVE A-REG. STB BSAVE SAVE B-REG. ERA,ALS SOC SET LEAST A FOR INA "O-REG" SIGN FOR "E-REG" STA EOSAV SAVE E/O LDA $POWR SAVE INTERRUPT LOCATION STA PSAVE STX XSAVE SAVE X-REG STY YSAVE SAVE Y-REG * LIA 5 SAVE ADDRESS WHERE WE LIB 5 LAST VIOLATED IN CASE OF MP IN CPB A PROGRESS - IF SO THEN ALSO SSB,RSS XOR B SZA JMP *+3 STB $CIC RESET THE INTERRUPT LOCATION STB $PWR5 * CLA,INA CLEAR SWITCH, SET NONZERO WHEN STA SW2 DONE WITH SAVE SEQUENCE * LIA 2 SAVE THE DMA STA SDMA1 WORD COUNTS LIA 3 STA SDMA2 LIA 1 SAVE THE SWITCH STA SSAVE REGISTER RSA SAVE STATUS OF STA MEMST WHAT WAS LAST MAP USED CLA (A) = STARTING REG=Éþú # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX MD128 (X) = -128 TO SAVE ALL MAPS XMM LDA STC5 SET UP THE EXIT SFS 0 SWITCH BASED ON INTERRUPT SYSTEM LDA CLF0 STA SW2 WAIT CLC 4 SET UP FOR MOMENTARY HLT 0 POWER FAILURE /WAIT FOR POWER HED POWER UP ROUTINE UP LDA DWAIT SET SWITCH FOR DOWN ROUTINE STA DOWN TO AVOID LOSS OF INFORMATION. LDA SW2 SSA,RSS IF HALTED OR NOT ENOUGH TIME JMP HALT TO SAVE EVERYTHING ON WAY DOWN * CLC 0,C INIT THE WHOLE I/O SYSTEM. * STC 4 CAN NOW ALLOW A DOWN INTERRUPT. * CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX D128 (X) = +128 TO RESTORE ALL MAPS XMM * LDA MEMST GET MEU STATUS WORD AND B3777 SAVE FENCE ADDR AND PORTION BIT LFA LOAD FENCE * LDB EQT# SET UP TO SEARCH FOR CMB,INB THE POWER FAIL STB EQTCO EQT LDB EQTA ADDRESS INB * NEXT LDA B,I GET WORD #2 CPA DEFI. IS IT THE LOCAL IP43? JMP FOUND YES GO DO IT * ADB D15 NO INDEX TO NEXT EQT ISZ EQTCO IF END THEN SKIP JMP NEXT TRY NEXT ENTRY * HALT HLT 4,C CPU HALTED, LESS THAN 500US, JMP *-1 OR NO EQT ENTRY FOR POWER FAIL * FOUND ADB D2 INDEX TO WORD 4 LDA B,I FETCH IT IOR B10K SET THE "I WILL HANDLE TIME OUT" STA B,I BIT ADB D11 INDEX TO EQT15 CCA,CCE AND SET TIME OUT STA B,I FOR NEXT TICK. STB EQ15 SAVE EQT15 ADDRESS * LDB EQTCO *1926DLS* DEL NEXT LINE ADB EQT# GET EQT# OF POWER FAIL DRIVER ADB $DVMP GET THE FIRST WORD OF LDA B,I THE DRIVER MAP TABLE ENTRY AND B76K AND INSURE THAT THE SDA FLAG žãþú IOR SDAFL AND DO-MY-OWN-MAPPING FLAGS STA B,I ARE SET * LDA TIME+2 IF TIME IN HAND SZA THEN DO NOT JMP NIXTM SAVE IT AGAIN * DLD $TIME GET THE TIME OF DAY D$TM EQU *-1 DST TIME AND SAVE IT LDA D$TM GET ADDRESS RAL,CLE,SLA,ERA OF LDA A,I DAY/YEAR ADA D2 AND LDB A,I SAVE THE TIME OF YEAR STB TIME+2 TOO. * NIXTM CLA,CCE CLEAR THE EQT COUNT STA EQTCO FOR THE TIME OUT ROUTINE. LDA EQ5,I SET EQT IN PROCESS ALR,ERA BUSY STA EQ5,I SO WE UP IT AGAIN JSB $SCLK SET CLOCK FOR INTERRUPT LDA CLF0 SET EXIT SWITCH TO SYSTEM LDB MPTFL IF MP FLAG SZB SAYS WE STA SW2 WERE IN THE SYSTEM LDA DUMMY IF PRIV. SYS SZA,RSS MUST SET UP. WELL? JMP NOPRV OK SO DON'T. * IOR STF MAKE A STF DUMMY STA STFD PUT IT DOWN STFD NOP AND DO IT IOR STCD NOW MAKE A STC DUMMY STA STCD AND IOR CLCD A CLC DUMMY STA CLCD DO THE CLC CLCD CLC 0 NOW SZB IF IN SYSTEM ALSO STCD STC 0 DO THE STC. *1926DLS* NOPRV LDA EOSAV RESTORE THE REGISTERS CLO SLA,ELA STO LDA SDMA1 STC 2 OTA 2 LDA SDMA2 STC 3 OTA 3 * * LDX XSAVE RESTORE X-REG LDY YSAVE RESTORE Y-REG NOMX2 LDA SSAVE OTA 1 LDA FENCE OTA 5 LDA STFTB CONFIGURE THE TBG STF IOR TBG AND STA STFTB RESTORE IT JMP EXIT2 GO RETURN TO POINT OF INTERRUPT * SPC 3 STC5 STC 5 CLF0 CLF 0 DWAIT DEF WAIT ASAVE NOP BSAVE NOP EOSAV NOP * XSAVE NOP YSAVE NOP * MEMST NOP SMAPA DEF SMAP SMAP BSS 32 DO NOT CHANGE ORDER - SYSTEM MAP BSS 32 öþú -USER MAP BSS 32 -PORT-A MAP BSS 32 -PORT-B MAP MD128 DEC -128 D128 DEC 128 B3777 OCT 3777 * SDMA1 NOP SDMA2 NOP SSAVE NOP EQ5 NOP EQT IN PROCESS FLAG EQ15 NOP EQTCO NOP PSAVE DEF HALT P-REG SAVE (HLT DEF IF HALTED) TIME BSS 3 TIME SAVE LOCATION A EQU 0 B EQU 1 SPC 3 DEFI. DEF IP43 D15 DEC 15 D3 DEC 3 B10K OCT 10004 D2 DEC 2 SDAFL OCT 100001 B76K OCT 76000 HED TIME OUT SECTION CP43 NOP ENTRY HERE FOR TIME OUT ONLY CLA CLEAR THE EQT IN PROCESS FLAG STA SW2 CLEAR SWITCH TO SHOW NO PFAIL STA EQ5 STFTB STF 0 SET CLOCK FOR ANOTHER TIME OUT CCB SET UP TO TIME OUT AGAIN STB EQ15,I SET IN EQT15 * NOTIM LDA EQTCO GET CURRENT EQT COUNT CPA EQT# IF DONE JMP AUTOR GO START AUTOR * SZA,RSS IF FIRST TIME STB BSAVE SET BSAVE FOR AUTOR COUNT SZA,RSS STB EOSAV SET EOSAV FOR TIME CALL * ISZ EQTCO STEP THE EQT NUMBER LDA EQTCO GO SET UP JSB $CVEQ THE EQT ADDRESSES LDA EQT5,I GET EQT5 RAL,CLE,SLA IF DMA WAIT, CCE,SSA,RSS THEN FORGET RSS RESTART. JMP NOTIM * LDA EQT1,I CHECK IF SYS IS CLEARING SSA WELL? JMP NOTIM YES LET TIME OUT CATCH IT. * LDA EQT4,I DEVICE(CONTROLLER)IS UP, DOWN OR BUSY. ALF,RAR CHECK HIS "I KNOW ABOUT PF" SEZ,CCE,SLA BIT JMP DVR SET AND BUSY GO DO IT * LDA EQT5 EITHER CONTROLLER IS UP OR DOWN OR BUSY. STA EQ5 POWER FAIL BIT SET, SAVE EQT ADDRESS LDA EQT5,I INCASE WE GO DOWN WHILE PROCESSING. ALR,RAL SET CONTROLLER DOWN. ERA,RAR AND STA EQT5,I AND JMP $UPIO GO RESTART CONTROLLER AND ANY DOWNED DEVICES. * DVR JSB $DRVM å‰þú SET UP PROPER DRIVER MAP LDA EQT4,I GET SELECT CODE IN (A) AND B77 LDB EQT2,I GET I.XX ADDR IN (B) SEZ ENTER DRIVER IN USER MAP? JMP INUSE YES JSB B,I NO, ENTER I.XX IN SYSTEM MAP JMP NOTIM GO DO NEXT EQT. * INUSE JSB $UIN ENTER I.XX IN USER MAP JMP NOTIM GO DO NEXT EQT * * AUTOR ISZ BSAVE FIRST TIME HERE? JMP SAUTO NO - GO SCHEDULE AUTOR * LDA DOF YES - ABORT AUTOR LDB D11 BY CALLING SYSTEM JSB $MESS MESSAGE PROCESSOR JMP NOAUT ANY RETURN MEANS NO AUTOR * SAUTO JSB $LIST SECOND ENTRY OCT 201 SCHEDULE BY NAME DEF OF2 NOAUT CLA CLEAR THE TIME OUT STA EQ15,I FLAG IN EQT 15 JMP $XEQ START THE SYSTEM * DOF DEF *+1 ASC 2,OFF, OF2 ASC 4,AUTOR,1 D11 DEC 11 B77 OCT 77 N3 DEC -3 D4 DEC 4 HED TIME REQUEST SECTION IP43 NOP LDA EQT6,I GET THE REQUEST CODE RAR,SLA IF NOT READ GO COMPLETE JMP REJ * LDA EQT8,I MUST HAVE A ADA N3 THREE WORD SSA BUFFER JMP REJ ELSE IGNOR * LDA EQT7,I BUFFER ADDRESS TO A LDB TIME SET THREE WORD XSB A,I TIME MESSAGE INA IN LDB TIME+1 USER XSB A,I BUFFER INA LDB TIME+2 XSB A,I CCA IF FIRST CALL AFTER TIME OUT CPA EOSAV AFTER POWER UP ISZ EOSAV SET FLAG TO ZERO AND SKIP JMP CLEAR NOT FIRST ENTRY JMP * I.EX LDB D3 SET TLOG = 3 REJ LDA D4 FOR IMMEDIATE COMPLETION JMP IP43,I RETURN TO USER * CLEAR CLA SECOND OR LATER ENTRY STA TIME+2 CLEAR THE TIME IN HAND FLAG JMP I.EX AND EXIT * * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DiþúEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN Ø640EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF $POWR END $POWR Rê6ÿÿ ÿým { ÿ92067-18005 1805 S C0122 &4AUTR RTE-IV AUTO RESTART SRC             H0101 X(þúFTN,L C NAME: AUTOR C SOURCE: 92067-18005 C RELOC: 92067-16005 C PGMR: G.A.A. C E.J.W.,750505 C D.L.S.,760622 C E.J.W.,771219 C C PROGRAM AUTOR(2,1),92067-16005 REV.1805 771219 DIMENSION ITM(3),ITMX(5) EQUIVALENCE (ITM(1),REG),(ITM(2),IB) C C SCAN THE LU'S TO FIND THE LU FOR C THE PFAIL DRIVER DO 5 I= 1,64 C DO A STATUS CALL C CALL EXEC(100015B,I,IEQT5,IEQT4) C C IGNOR UNDEFINED,AND UNASSIGNED LU'S. GO TO 5 C IS DRIVER TYPE EQUAL TO 43? C 600 IF (IAND(IEQT5,37400B)-21400B)5,15,5 C C YES, IS THE SELECT CODE=4? C 15 IF (IAND(IEQT4,77B)-4)5,17,5 C 5 CONTINUE C POWER FAIL LU NOT FOUND WRITE (1,700) 700 FORMAT("POWER FAIL LU NOT FOUND. TIME OF POWER FAIL UNKNOWN") C C SET TO USE LU ZERO LU=0 GO TO 20 C LU FOUND SET TO GET FAIL TIME 17 LU=I C CALL THE PFAIL DVR TO GET FAIL TIME 20 CALL EXEC(1,LU,ITM,3) C CONVERT THE DOUBLE INTEGER TO: C HR,MIN,SEC.TENS OF MS CALL TMVAL(ITM,ITMX) C GET THE YEAR OFFSET FROM DAYS IB=ITM(3)/365 C ADD THE BASE YEAR TO GET ACTUAL YEAR IY=IB+1970 C SUBTRACT THE YEARS TO GET DAYS AND C CORRECT FOR DAY ZERO. ID=ITM(3)-IB*365+1 C FLOAT THE TENS OF MS VALUE REG=ITMX(1) C COMPUTE SECONDS INTO ONE FLOATING WORD REG=REG/100.+FLOAT(ITMX(Tþú2)) C ***************************** C THE FOLLOWING DO LOOP MAY BE C MODIFIED IF DESIRED. C IT SERVES TWO FUNCTIONS: C 1) BY SENDING A MESSAGE TO EACH TTY C THE DRIVER WILL RESET THE TTY C INTERFACE TO REENABLE ANY C TERMINALS (MUST ISSUE A STC). C 2) ANY USERS AT THE TERMINALS ARE C INFORMED THAT THE LAST LINE MAY C NOT HAVE BEEN TRANSMITTED C CORRECTLY. C ***************************** C C FORMAT TO PRINT THE TIME C 40 FORMAT("POWER FAILED AT "I2":"I2":"F6.3" ON DAY "I3" OF "I4) C C SCAN FOR ALL THE TTY TYPE DEVICES DO 30 I=1,64 C DO STATUS CALL CALL EXEC(100015B,I,IEQT5,ISTA2,ISTA3) C IGNOR UNDEFINED,AND UNASSIGNED LU'S GO TO 30 C CHECK IF TYPE 0 DEVICE (I.E. A TTY) 1 IF(IAND(IEQT5,37400B))25,2,25 C CHECK IF TYPE 5 DEVICE 25 IEQT5=IEQT5-2400B IF(IAND(IEQT5,37400B))30,27,30 C IF TYPE 5 DEVICE, CHECK TO SEE IF C SUBCHANNEL 0(I.E. A CONSOLE) 27 IF(IAND(ISTA3,37B))30,2,30 C IF FIND A DEVICE, WRITE TIME ON IT. 2 WRITE(I,40)ITMX(4),ITMX(3),REG,ID,IY 30 CONTINUE C ***************************** C USER POWER FAIL RECOVERY CODE C SHOULD BE ADDED HER±? E. C REMEMBER IF POWER FAILS C WHILE IN THIS CODE IT C MAY RUN FOR A FEW C SECONDS AFTER POWER IS C RESTORED AND THEN BE ABANDONED C AND RESTARTED FROM THE C TOP. C ***************************** C C SECOND CALL ON PFAIL ROUTINE RESETS C TO SAVE TIME ON NEXT FAILURE. CALL EXEC(1,LU,ITM,3) STOP END END$ |Oÿÿ ÿýnv ÿ92067-18006 2001 S C0122 &$CNFX CONFIGURATOR EXTENSION             H0101 0\þúASMB,R,Q,C,Z IFN HED RTE IV-A CONFIGURATOR EXTENSION 92067-16006 XIF IFZ HED RTE IV-B CONFIGURATOR EXTENSION 92067-16516 XIF * NAME: $CNFX * SOURCE: 92067-18006 * RELOC: 92067-16006 RTE IVA CONFIGURATOR EXTENSION * RELOC: 92067-16516 RTE IVB CONFIGURATOR EXTENSION * PGMR: S. KAPOOR,D.VENHAUS * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM $CNFX,3 92067-16006 REV.1940 790906 XIF IFZ NAM $CNFX,3 92067-16516 REV.2001 791029 XIF EXT $PCHN,$EXIT,$WRRD,$USRS,$ABDP,$TRTB,$TREN,$NPGQ EXT $GDPG,$SAVE,$SMTB EXT $PARS,$CVT3,$MATA,$MNP,$MCHN,$MBGP,$MRTP EXT $CFR,$BGFR,$RTFR,$IDEX,$SDA,$PLP,$CMST,$SBTB EXT $MPS2,$ENDS * SUP * A EQU 0 B EQU 1 KEYWD EQU 1657B HED CONSTANTS AND MESSAGES .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .9 DEC 9 .11 DEC 11 .12 DEC 12 .14 DEC 14 .15 DEC 15 .16 DEC 16 .18 DEC 18 .19 DEC 19 .28 DEC 28 .32 DEC 32 .33 DEC 33 * B77 OCT 77 B37 OCT 37 B140K OCT 140000 * .10 DEC 10 * YE ASC 1,YE NO ASC 1,NO E ASC 1, E R ASC 1,R S ASC 1,S RT ASC 1,RT BG ASC 1,BG PARTN ASC 15,PART'N XX, XXXX,(XXXX) PAGES? APRTN DEF PARTN+8 PAGES ASC 4, PAGES? APGS DEF PAGES SPGS ASC 7,,(XXXX) PAGES? ASPGS DEF SPGS SPACE ASC 1, MSG23 ASC 10,CURRENT SIZE OF SAM: MSG24 ASC 10,DEFAULT: WORDS MSG25 ASC 10,EXTENSION: PAGES * MSG29 ASC 14,CURRENT PART'N DEFINITIONS: MSG31 ASC 11,CàþúURRENT PART'N REQMTS: MSG32 ASC 4,REALTIME MSG33 ASC 5,BACKGROUND MSG35 ASC 9,MAX PROGRAM SIZE: MSG36 ASC 11,W/OUT COMMON: PAGES MSG37 ASC 11,W/ COMMON: PAGES MSG38 ASC 11,W/ TABLE II: PAGES MSG39 ASC 10,MAX # OF PART'NS: MSG40 ASC 11,PAGES REMAINING: * A$SMT DEF $SMTB+0 E$SMT DEF $SMTB+9 USRST NOP ABDPG NOP SUBPR NOP PGSRM NOP MEMSZ NOP LSTLU NOP ECHO NOP SAVE BSS 4 TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP STSME NOP SMEXS NOP ENDSM NOP * HED PRINT INFORMATION ON MEMORY ORGANIZATION * $CNFX XLA $PCHN GET MEMORY SIZE STA MEMSZ SAVE IT XLA $WRRD GET LIST DEVICE LU# STA LSTLU XLA $TRTB GET ECHO FLAG STA ECHO LDB .10 JSB WRLST DEF MSG23 CURRENT SIZE OF SAM: XLB $SAVE+2 GET # OF WORDS IN SAM DEFAULT XLA $SAVE+13 HAVE TWO PIECES ADA B ADD THE TWO PIECES CCE CONVERT TO DECIMAL ASCII JSB $CVT3 INA POINT TO LAST FOUR DIGITS DLD A,I SET UP MESSAGE DST MSG24+5 DEFAULT: XXXX WORDS LDB .10 JSB WRLST PRINT IT DEF MSG24 LDA $MPS2 # OF PAGES IN SAM EXT ALF,RAL RAL # OF PAGES IN LOW 6 BITS AND B77 A REG HAS # OF PAGES IN SAM EXT STA SMEXS SAVE SIZE OF SAM EXT CCE CONVERT TO ASCII DECIMAL JSB $CVT3 ADA .2 POINT TO LOW 2 DIGITS LDA A,I GET ASCII VALUE STA MSG25+6 SET UP MESSAGE LDB .10 JSB WRLST PRINT DEF MSG25 EXTENSION: XX PAGES LDA $SBTB+1 # OF PAGES IN DRIVER PARTITIONS ADA $SBTB+3 # OF PAGES IN MEM RES BASE PAGE ADA $SBTB+5 # OF PAGES IN MEM RES PARTN ADA $ENDS # OF PAGES UPTO SAM DEFAULT STA STSME PHSICAL START PAGE OF SAM EXT IOR BIT15 SJS $GDPG FIND THE FIRST GOOD PAGE FOR SAM EXT ›óþúJMP SMER1 ERROR NO MORE PAGES LEFT STA STSME START PAGE OF SAM EXT STRPG CCE CONVERT TO ASCII DECIMAL JSB $CVT3 INA DLD A,I ASCII VALUE DST MSG26+19 SET UP MESSAGE LDB .21 JSB WRLST PRINT MESSAGE DEF MSG26 PHSICAL START PAGE OF SAM EXT XX LDA $ENDS FIND # OF PAGES AVAIL FOR SAM EXT CMA,INA ADA .32 # OF PAGES BET END OF LOG MEM AND SAM DEFAULT STA TEMP SAVE IT LDB STSME PHSICAL START PAGE OF SAM EXT CMB,INB ADB MEMSZ (MEMSZ-START OF SAM EXT) CMA,INA - ADA B (32-$ENDS) SSA,RSS WHICH IS GREATER? LDB TEMP THE SMALLER QUANTITY IS MAX SIZE OF SAME EXT STB MXSME MAX. PAGES AVAIL FOR SAM EXT LDA B CCE JSB $CVT3 CONVERT IT TO ASCII DECIMAL ADA .2 LDA A,I GET ASCII VALUE STA MSG27+18 SET UP MESSAGE LDB .19 JSB WRLST DEF MSG27 MAX PAGES AVAIL FOR SAM EXT: XX * HED RECONFIGURE SAM EXTENSION CLA CLEAR $SMTB LDB A$SMT CL$SM XSA B,I CPB E$SMT END OF $SMTB? JMP SMEXQ YES INB NO JMP CL$SM SMEXQ LDB .18 JSB QUERY DEF MSG28 CHANGE SAM EXTENSION?(#PAGES/" "CR) LDA PRSBF SZA,RSS NULL? JMP NOCHG YES, NO CHANGE IN SAM EXT CLA LOWER LIMIT LDB APRSB POINTER TO PARSE BUFFER JSB TST# TEST VALIDITY OF RESPONSE MXSME NOP MAX AVAIL MEM FOR SAM EXT JMP SMERR ERROR RSS NOCHG LDA SMEXS SAM EXT SIZE GENERATED STA SMEXS * * CHANGE SYSTEM MAP FOR NEW SAM EXT CMA,INA,SZA,RSS SAM EXT SIZE IS 0? JMP NOSME YES STA TEMP1 -VE OF SAM EXT SIZE CLA,INA CAX LDA $ENDS LOGICAL START PAGE OF SAM EXT STA TEMP5 LDA A$SMT START ðþúOF $SMTB STA TEMP2 SAVE IT FOR POINTER VALUE LDA STSME PHYSICAL START PAGE XSA TEMP2,I SET INITIAL START PAGE FOR SAM EXT STA TEMP3 ISZ TEMP2 POINT TO # OF PAGES IN CHUNK ENTRY SMELP IOR BIT15 SJS $GDPG FIND NEXT GOOD PAGE JMP SMER1 ERROR CPA TEMP3 BAD PAGE ENCOUNTERED? JMP INCR NO LDB TEMP2 CPB E$SMT END OF $SMTB REACHED? JMP SMER2 YES, ERROR ISZ TEMP2 NO, POINT TO NEXT ENTRY XSA TEMP2,I START PHYSICAL PG FOR NEXT CHUNK OF SAM EXT ISZ TEMP2 INCR XLB TEMP2,I INCREMENT #PGS IN THIS CHUNK OF SAM EXT INB XSB TEMP2,I STA B ADB B40K WRITE PROTECT SAM EXTENSION LDA TEMP5 XMS STORE PAGE # IN DMS REG BLS,RBR CLEAR BIT 14 ISZ TEMP1 INCREMENT COUNTER RSS NOT DONE YET JMP SMELC DONE ISZ TEMP5 INCREMENT LOGICAL PAGE # ISX LDA B STA TEMP3 JMP SMELP STORE NEXT PAGE * SMERR LDA A10 ERROR JSB ERROR JMP SMEXQ SMER2 LDA A22 TOO MANY BAD PAGES IN SAM EXT JSB ERROR JMP SMEXQ * A10 ASC 1,10 A22 ASC 1,22 A12 ASC 1,12 B40K OCT 40000 .22 DEC 22 N2 DEC -2 MSG26 ASC 21,SAM EXTENSION STARTS AT PHYSICAL PAGE MSG27 ASC 19,MAX PAGES AVAIL FOR SAM EXTENSION: MSG28 ASC 18,CHANGE SAM EXTENSION?(#PAGES/" "CR) * SMER1 LDA A12 JSB ERROR JMP SMEXQ * NOSME LDA $ENDS NO CHANGE IN SAM EXT STA ENDSM END OF SYSTEM LDA STSME START OF USER PARTN AREA XSA $USRS CLA STA $MPS2 XSA $SAVE+4 JMP RWPRO READ-WRITE PROTECT REST OF THE REG * * SMELC STA ENDSM A REG HAS END OF LOG SYS PAGE XSB $USRS START PAGE OF USER PARTITIONS LDB SMEXS # OF PAGE IN SAM EXT BLF,BLF # OF WORDS IN SAM EXT RBL,RBL CPA .32 Š3þú DID SAM EXT END AT LOG PAGE 31? RSS THEN LAST ADDRESS MUST BE 77775B CLA,RSS LDA N2 ADB A XSB $SAVE+4 # OF WORDS IN SAM EXT LDA SMEXS SAM EXT SIZE ALF,ALF RAL,RAL MOVE IT TO BITS 10-25 ADA STSME START PAGE SAM EXT STA $MPS2 * RWPRO CLA,INA READ WRITE PROTECT REST OF CAX THE REGISTERS IN THE SYSTEM MAP LDA ENDSM LOGICAL PAGE SAM EXT ENDS RWPRL CPA .32 LOGICAL REG # IS 32? JMP PRTDF YES DONE LDB B140K READ WRITE PROTECT NEXT REG XMS ISX JMP RWPRL * HED PARTITION DEFINITIONS * PRTDF LDB .14 JSB WRLST DEF MSG29 CURRENT PART'N DEFINITIONS: JSB PRNPR PRINT LIST OF PARTITION DEFINITIONS LDB .11 PRINT LIST OF JSB WRLST DEF MSG31 CURRENT PART'N REQMTS: LDB .4 JSB WRLST REALTIME DEF MSG32 CLB INDICATE TO ROUTINE TO PRINT STB TYPE PART'N REQMTS FOR REAL TIME PROGS JSB PGREQ LDB .5 JSB WRLST BACKGROUND DEF MSG33 ISZ TYPE JSB PGREQ PART'N REQMTS FOR BG PROGS LDB .9 JSB WRLST DEF MSG35 MAX PROGRAM SIZE LDA $CMST START OF COMMON AREA CMA,INA CCE,INA ADA .32 32-$CMST+1 STA MXWOC JSB $CVT3 CONVERT TO ASCII DECIMAL ADA .2 LDA A,I SET UP MESSAGE STA MSG36+7 W/OUT COMMON : XX PAGES LDB .11 JSB WRLST DEF MSG36 LDA $SDA START OF SYSTEM DRIVER AREA CMA,INA INA ADA .32 32-$SDA+1 CCE CONVERT MAX ADDRESS SPACE WITH COMMON JSB $CVT3 TO ASCII DECIMAL ADA .2 LDA A,I STA MSG37+7 W/ COMMON : XX PAGES LDB .11 JSB WRLST DEF MSG37 LDA $PLP LOAD POINT FOR PRIV PROGS ALF RAL,RAL Õ3þú GET PAGE # IN LOW BITS AND B37 MASK PAGE# CMA,INA INA ADA .32 32-#PAGES UPTO TABLE AREA II+1 CCE CONVERT # OF PAGES IN MAX ADDR SPACE FOR JSB $CVT3 A PRIVILEGED PROGRAM TO ASCII DECIMAL ADA .2 LDA A,I STA MSG38+7 LDB .11 JSB WRLST W/ TABLE II: DEF MSG38 LDA $MNP MAX # OF PARTITIONS CCE JSB $CVT3 ADA .2 LDA A,I GET ASCII VALUE STA MSG39+9 SET UP MESSAGE LDB .10 JSB WRLST PRINT IT DEF MSG39 MAX # OF PART'NS : XX XLA $USRS START PAGE OF USER PARTITION AREA CMA,INA ADA MEMSZ MEMSZ-$USRS STA PGSRM PAGES REMAINING FOR USER PARTITION CCE DEFINITIONS JSB $CVT3 CONVERT IT TO ASCII DECIMAL INA DLD A,I SET UP THE MESSAGE DST MSG40+9 PAGES REMAINING: XX LDB .11 JSB WRLST DEF MSG40 * * DEFINE USER PARTITIONS * DFNPR LDB $MATA SET ALL WORDS IN MAT TO 0 STB MATAD START ADDRESS OF MAT LDA $MNP # OF WORDS TO BE CLEARED SZA,RSS MAX # OF PARTITIONS IS 0? JMP QPERM YES,SKIP REST OF MEMORY RE-CONFIGURATION MPY .7 EACH ENTRY HAS 7 WORDS STA B CLA VALUE FOR REGISTERS JSB SETM SET MEMORY MATAD NOP START OF MAT LDA $MNP CMA,INA -VE OF # OF PART'NS ALLOWED STA TEMP COUNTER TO SET LINK WORDS OF ALL MAT LDA $MATA ENTRIES TO -1 CCB INITL STB A,I STORE VALUE IN ENTRY ADA .7 POINT TO NEXT ENTRY ISZ TEMP JMP INITL NOT DONE YET * XLA $USRS SAVE START OF USER PARTITIONS STA USRST XLA $ABDP SAVE CURRENT BAD PAGE POINTER STA ABDPG * STDFN CLA START OF PARTITION DEFINITION STA SUBPR CLEAR FLAG FOR SUBPART'N DEF'N STA PRxeþúTN# LDA $MATA START OF MAT STA PRPNT SET UP POINTER TO MAT ENTRIES * STCHN CCA SJS $PCHN START OF PART'N DEF'N SZA,RSS FOR THIS CHUNK OF MEMORY JMP THRLS 0,DONE WITH PART'N DEF'N FOR ALL OF MEM CLB INITIALIZE FLAG FOR END OF SUBPARTITION STB ERFLG * XLB $USRS NEW START OF USER AREA STB SAVE SAVE IT STA #PGS # OF PAGES IN BLOCK FROM MEM STA SAVE+1 SAVE IT LDB PRPNT POINTER IN MAT STB SAVE+2 SAVE IT LDB PRTN# PARTITIONS DEFINED SO FAR STB SAVE+3 SAVE IT * CCE CONVERT # OF PAGES IN CHUNK JSB $CVT3 TO ASCII DECIMAL INA POINT TO LAST 4 ASCII DIGITS DLD A,I DST MSG50+9 AND SET UP MESSAGE LDB .15 JSB WRTTY DEFINE PART'NS FOR PPPP PAGES: DEF MSG50 * IFN LDB .9 XIF * IFZ LDB .12 XIF * JSB WRTTY DEF MSG41 #PAGES,RT(M)/BG(M)/S(,R) PRTNQ LDA PRTN# CONVERT PARTITIONS DEFINED SO FAR CCE,INA + 1 INTO ASCII DECIMAL JSB $CVT3 ADA .2 POINT TO LAST 2 ASCII DIGITS LDA A,I STA PARTN+4 LDA #PGS #PAGES REMAINING TO BE DEFINED IN THIS BLOCK CCE CONVERT TO ASCII DECIMAL JSB $CVT3 INA POINT TO LAST 4 DIGITS LDB SUBPR DEFINING SUBPARTITIONS? SSB JMP SETSB YES, SETUP MESSAGE FOR SUBPARTITIONS * DLD A,I GET THE ASCII # OF PAGES DST PARTN+6 SET # OF PAGES REMANINING IN MESSAGE LDA APGS MOVE " PAGES?" IN MESSAGE LDB APRTN MVW .4 LDB .12 LENGTH OF PARTITION DEFINITION MESSAGE JMP QPRTN * SETSB DLD A,I GET # OF PAGES LEFT IN MOTHER PART'N DST SPGS+1 LDA ASPGS MOVE ",(XXXX) PAGES?" INTO MESSAGE LDB APRTN MVW .7 LDA SV#PG # OF PAGES LŽàþúEFT IN MAIN MEM CCE CONVERT TO DECIMAL ASCII JSB $CVT3 INA DLD A,I GET LEAST 4 DIGITS DST PARTN+6 SET # PAGES LEFT IN MESSAGE LDB .15 LENGTH OF MESSAGE QPRTN JSB QUERY PARTITION DEFINITION PROMPT DEF PARTN PART'N XX? LDA PRSBF CPA .2 ASCII RESPONSE? RSS YES JMP TSTTY NO, TEST TYPE OF PART'N JSB END? /E ENTERED? RSS YES JMP CHK/R NO, THEN CHECK FOR /R LDA ERFLG ONLY /E OR /R PERMITTED AS A RESPONSE? SSA JMP STCHN YES, THEN /E VALID LDA SUBPR DEFINING SUBPARTITIONS? SSA,RSS JMP #PGSE NO, THEN ERROR JSB RSTSB YES, THEN END SUBPART'N DEFINITION JMP ENPR2 * CHK/R LDA PRSBF+1 CPA /R RESTART ? RSS JMP TSTTY NO LDA PRSBF+2 CPA SPACE JMP RSTOR RESTART PARTITION DEFINITIONS * TSTTY LDA ERFLG END OF SUBPARTITION FLAG SET? SSA JMP #PGSE YES,ONLY /E OR /R ALLOWED FOR A RESPONSE LDA PRSBF+6 TEST FOR VALID PART'N TYPE CPA SPACE RSS * IFZ CPA M BGM OR RTM? XIF * RSS YES, THEN OK JMP TYPER NOT A SPACE THEN ERROR LDB PRSBF+5 TEST FOR VALID PART'N TYPE CLA 0 IF BACKGROUND CPB BG BACKGROUND? JMP SETYP YES INA CPB RT REALTIME? JMP SETYP YES CPB S SUBPARTITION? CCA,RSS -1 IF SUBPARTITION JMP TYPER INVALID TYPE ERROR SETYP STA TYTMP SAVE TYPE OF PART'N LDB SUBPR DEFINING SUBPARTITIONS? SSB,RSS JMP NOSUB NO SSA,RSS PART'N TYPE IS S? JSB RSTSB NO, THEN END SUBPARTITION DEFINITION JMP TESTR TEST FOR RESERVE PARAMETER NOSUB SSA PARTITION TYPE IS S? JMP TYPER YES, THEN ERROR |Äþú* TESTR LDB PRSBF+8 TEST FOR R PARAMETER SZB,RSS NULL? JMP SETR YES LDB PRSBF+9 CPB R R? RSS YES JMP RSRVE NO, THEN ERROR LDA PRSBF+10 GET NEXT CHAR CPA SPACE BLANK? CLB,INB,RSS YES, THEN OK JMP RSRVE NO, ERROR SETR STB RTMP RTMP IS 1 IF RESERVED PART'N * LDA .2 GET # OF PAGES REMAINING LDB APRSB IN THIS CHUNK JSB TST# TEST IF # PAGES DEFINED IS #PGS NOP GREATER THAN REMAINING # PAGES IN CHUNK JMP #PGSE ERROR * STA PGTMP GET PAGES FOR THIS PART'N CMA,INA # OF PAGES REMAINING ADA #PGS IN BLOCK OF MEM CPA .1 1 PAGE LEFT IN CHUNK? RSS YES JMP SET#P NO ISZ PGTMP INCREMENT # OF PAGES IN PRV PART'N CLA CLEAR # OF PAGES REMAINING IN CHUNK SET#P STA #PGS NEW # PAGES LEFT IN CHUNK LDA PRPNT POINTER TO CURRENT MAT ENTRY CLB STB A,I CLEAR LINK WORD ADA .3 POINT TO WORD 3 OF MAT ENTRY XLB $USRS START PAGE FOR THIS PART'N STB A,I SET UP MAT WORD INA LDB RTMP PARTITION RESERVE PARAMETER RBR BIT 15 IS SET IF R PARM ADB PGTMP WAS SPECIFIED - # PAGES IN LOW BITS ADB N1 -1 TO EXCLUDE BASE PAGE STB A,I SET UP WORD 4 OF MAT ENTRY INA LDB TYTMP REAL TIME OR BACKGROUND PART'N SSB 'S' ENTERED? LDB SVTYP YES, THEN USE TYPE OF MOTHER PART'N RBR BIT 15 SET IF REALTIME PART'N STB A,I SET UP WORD 5 OF MAT LDB SUBPR DEFINING SUBPARTITIONS? SSB JMP SBPRT YES * IFZ LDA PRSBF+6 BGM OR RTM? CPA M JMP DEFSB YES, THEN PROMPT FOR SUBPARTITIONS XIF * LDA .2 LDB APRSB ADDRESS OF PARSE BUFFER JSB TST# ò9þú # OF PAGES FOR PART'N LESS THAN MXWOC NOP MAX ADDRESSABLE SPACE W/OUT COMMON? JMP MPART YES, DEFINE MOTHER PART'N * ENPRT XLA $USRS START OF USER PART'N PAGE ADA PGTMP ADD # PAGES DEFINED FOR PART'N XSA $USRS TO GET NEW START USER PAGE ENPR1 LDA PRPNT POINT TO NEXT MAT ENTRY ADA .7 STA PRPNT ISZ PRTN# INCREMENT PART'NS DEFINED SO FAR LDA PRTN# # OF PARTITIONS DEFINED SO FAR CPA $MNP IS EQUAL TO MAX # PART'NS? JMP MX#PR YES, THEN DONE ENPR2 LDA #PGS # PAGES LEFT IN CHUNK SZA 0? JMP PRTNQ NO JMP STCHN YES, THEN DEFINE MORE PART'NS * MX#PR LDB SUBPR DEFINING SUBPARTITIONS? SSB JSB RSTSB YES, END SUBPARTITION DEFINITION LDA #PGS # OF PAGES LEFT IN THIS CHUNK SZA 0? JMP RDFNQ NO, THEN REDEFINE PART'NS? CCA SJS $PCHN ANY MORE PAGES LEFT IN MEM? SZA,RSS JMP THRLS NO, THEN THREAD LISTS * RDFNQ LDA A20 MAX # PART'NS DEFINED AND JSB ERROR PAGES LEFT UNDEFINED IN MEM RSTOR LDA USRST RESTORE START OF USER PART'NS XSA $USRS LDA ABDPG RESTORE POINTER TO BAD PAGE LIST XSA $ABDP JMP DFNPR REDEFINE PARTITIONS * M ASC 1,M A20 ASC 1,20 MSG50 ASC 15,DEFINE PART'NS FOR PAGES: * IFN MSG41 ASC 9,#PAGES,RT/BG/S(,R) XIF * IFZ MSG41 ASC 12,#PAGES,RT(M)/BG(M)/S(,R) XIF * * DEFINE MOTHER PARTITIONS * MPART LDB .11 JSB QUERY SUBPARTITIONS?(YES/NO) DEF MSG43 LDA PRSBF+1 CPA NO JMP ENPRT NO, THEN CONTINUE NORMALLY CPA YE RSS YES JMP MPART ILLEGAL RESPONSE DEFSB CCA,CCE SET E REG FOR FUTURE USE STA SUBPR SET FLAG TO INDICATE DEFINING SUBPARTITIONS LDA TYTMP SAVE PART'N TYPE OF THIS MOTHER PART'N STA SVTYP LD¥þúA #PGS STA SV#PG SAVE # OF PAGES LEFT IN CHUNK LDA PGTMP STA #PGS # OF PAGES IN MOTHER PART'N XLA $USRS ADA PGTMP ADD # OF PAGES DEFINED FOR MOTHER PART'N STA SVUSR SAVE START PAGE FOR NEXT PART'N LDA PRPNT SET M BIT IN MAT ENTRY ADA .3 FOR THE MOTHER PART'N LDB A,I RBL,ERB E REG SET PREVIOUSLY STB A,I ADA .3 POINT TO SUBPART'N LINK WORD LDB PRPNT STB A,I POINT SLW OF MOTHER PART'N TO ITSELF STA PRVSL SAVE TO USE FOR NEXT SLW JMP ENPR1 * SBPRT LDB PRVSL,I YES,POINT PREV. SLW TO THIS SUBPART'N ENTRY LDA PRPNT STA PRVSL,I ADA .6 SET UP THIS PARTN'S SLW STA PRVSL STB A,I LDA #PGS SZA END SUBPART DEF'N IF # PAGES LEFT IS 0 JMP ENPRT JSB RSTSB END SUBPARTITION DEFINITION JMP ENPR1 * RSTSB NOP ROUTINE TO END SUBPARTITION DEF'N LDA SVUSR RESTORE START USER PART'N PAGE # XSA $USRS FOR NEXT PART'N TO BE DEFINED LDA SV#PG STA #PGS RESTORE # PAGES LEFT IN CHUNK CLA STA SUBPR CLEAR SUBPART'N DEFINITION FLAG JMP RSTSB,I RETURN * #PGSE LDA A13 INVALID PARTITION SIZE JSB ERROR LDA #PGS # OF PAGES LEFT IN CHUNK IS 0? SZA JMP PRTNQ NO, PROMPT FOR LAST PART'N DEF'N CCA YES, THEN SET FLAG TO INDICATE STA ERFLG ONLY /E OR /R WILL BE ALLOWED FOR A RESPONSE JMP PRTNQ PROMPT FOR PART'N DEF'N * TYPER LDA A14 INVALID PARTITION TYPE RSS * RSRVE LDA A15 INVALID PARTITION RESERVATION PARAMETER JSB ERROR DISPLAY ERROR JMP PRTNQ QUERY PARTN# AGAIN * A13 ASC 1,13 A14 ASC 1,14 A15 ASC 1,15 ERFLG NOP SV#PG NOP SVUSR NOP PRVSL NOP TYTMP NOP SVTYP NOP PGTMP NOP RTMP NOP MSG43 ASC 11,SUBPARTITIONS?(YES/NO) PRSBF BSS 33¹þú PRPNT NOP PNTBG NOP PNTRT NOP PNTCH NOP ADTBL DEF *+1 ABGFR DEF $BGFR ARTFR DEF $RTFR ACFR DEF $CFR AMBGP DEF $MBGP AMRTP DEF $MRTP AMCHN DEF $MCHN AMPS2 DEF $MPS2 LSHDR NOP MXPRT NOP PRTSZ NOP PRVPN NOP CURPN NOP CURKY NOP PRTMP NOP RDBUF BSS 80 BIT15 OCT 100000 .N7 DEC -7 HED THREAD PARTITION LISTS * * THREAD PARTITIONS JUST DEFINED INTO BG,RT AND CHAIN FREE LISTS * FREE LISTS IN AN INCREASING ORDER ACCORDING TO THEIR SIZE * THRLS CLA CLEAR LIST HEADERS STA $BGFR STA $RTFR STA $CFR STA $MCHN STA $MBGP STA $MRTP LDA .N7 COUNTER RMOVI LDB ADTBL,I REMOVE INDIRECTS FROM ENT POINT ADDRESSES RSS LDB B,I RBL,CLE,SLB,ERB JMP *-2 STB ADTBL,I ISZ ADTBL INA,SZA JMP RMOVI LDA $MATA SET POINTER AT THE BEGINING OF MAT STA PRPNT LDA ABGFR ADDRESS OF LIST HEADER FOR BG STA PNTBG POINTER FOR THE BG LIST LDA ARTFR ADDRESS OF LIST HEADER FOR RT STA PNTRT POINTER FOR THE RT LIST LDA ACFR ADDRESS OF LIST HEADER FOR CHAIN LIST STA PNTCH POINTER FOR THE CHAIN LIST LDA $MNP MAX # OF PARTITIONS ALLOWED CMA,INA USE AS COUNTER STA PRTMP * * THRDL LDA PRPNT GET POINTER TO MAT LDB A,I IS THE LINK WORD -1? SSB JMP THRDN YES, THEN DONE THREADING LISTS ADA .3 POINT TO WORD 4 OF MAT ENTRY LDB A,I SSB,RSS IS THE M BIT SET? CLB,RSS NO, THEN NOT A MOTHER PARTN LDB ACFR YES, SET LST HEADER FOR CHAIN LIST STB LSHDR CURRENT POINTER LDB AMCHN ADDR OF MAX SIZE CHAINED PART'N ENT PNT STB MXPRT INA POINT TO WORD 5 OF MAT ENTRY LDB A,I RBL,CLE,ERB GET BIT 15 IN E REG AND CLEAR IT STB PRTSZ SIZE OF PARTITION TO COMPARE INA NO LD3þúB LSHDR SZB LIST HEADER ALREADY SET? JMP STPRT YES, SET MAX PART'N SIZE LDA A,I NO SSA,RSS RT BIT SET? JMP BGPRT NO, THEN BACKGROUND PART'N LDB ARTFR YES, RT PARTN, POINTER FOR RT LIST LDA AMRTP MAX RT PART'N SIZE ENTRY POINT JMP STPNT BGPRT LDA AMBGP MAX BG PART'N SIZE ENTRY POINT LDB ABGFR BG PART'N SIZE ENTRY POINT STPNT STA MXPRT POINTER TO MAX PART'N SIZE STB LSHDR HEADER FOR CURRENT LIST STPRT LDA PRTSZ GET PART'N SIZE CMA,SEZ,INA RESERVE PARTITION? JMP STCRP YES, SET CURRENT POINTER ADA MXPRT,I SIZE OF CURRENT PART'N SSA,RSS IS GREATER THAN PREVIOUS ONE? JMP STCRP NO LDA PRTSZ YES STA MXPRT,I NEW MAX PART'N SIZE FOR GIVEN LIST STCRP LDB B,I GET VALUE STB CURPN CURRENT POINTER CLA CLEAR STA PRVPN PREVIOUS POINTER TLOOP LDB CURPN GET CURRENT POINTER SZB,RSS 0? JMP TPLEX YES, THEN DONE WALKING THRU LIST ADB .4 NO, GET PART'N SIZE LDA B,I PART'N SIZE OF CURRENT PART'N ELA,CLE,ERA CLEAR R BIT IF SET CMA,INA IN LIST < PART'N SIZE OF NEW PART'N ADA PRTSZ TO INSERTED IN THE LIST?T SSA JMP TPLEX YES,THEN FOUND PLACE TO INSERT NEW PART'N LDB CURPN NO, THEN CURRENT POINTER BECOMES STB PRVPN PREVIOUS POINTER LDA B,I CONTENTS OF LINK WORD OF STA CURPN CURRENT PART'N BECOMES THE CURRENT POINTER JMP TLOOP CHECK NEXT PARTITION IN LIST * TPLEX LDA PRPNT POINTER TO NEW PART'N TO BE INSERTED LDB PRVPN GET PREVIOUS POINTER SZB IS THE CURRENT POINTER TO LIST HEADER? JMP PRINS NO, THEN INSERT PART'N STA LSHDR,I YES POINT LIST HEADER TO PART'N JMP FORWD ADJUST FORWARD POINTER IN MAT * PRINS STA PRVPN,I PREV PART'N POvuþúINTS TO NEW PART'N FORWD LDA CURPN NEW PART'N POINTS TO CURRENT PART'N STA PRPNT,I * PARTITION HAS BEEN INSERTED * INSERT NEXT PART'N IN MAT IN PROPER LIST ENTHR LDA PRPNT ADA .7 POINT TO NEXT ENTRY STA PRPNT POINTER FOR NEW PART'N ISZ PRTMP MAX # OF PART'NS ALLOWED INSERTED? JMP THRDL NO, REPEAT PROCESS FOR ALL PART'NS * * ALL PARTITIONS ARE THREADED IN FREE LISTS * * THRDN DLD NEW SET UP MESSAGE FOR DST MSG29+2 NEW PART'N DEFINITIONS: LDB .12 JSB WRLST PRINT MESSAGE ON LIST DEVICE DEF MSG29+2 NEW PART'N DEFINITIONS: CCE E REG SET TO INDICATE CALLING FROM USER MAP JSB PRNPR PRINT LIST OF NEW PART'N DEFINITIONS * HED UNASSIGN PROGRAMS * UNASSIGN PROGRAMS IF THEY DO NOT FIT IN * THE PARTITIONS THEY WERE ORIGINALLY ASSIGNED TO * LDB .10 JSB WRLST CALLING PRINT ROUTINE FROM USER MAP DEF MSG44 UNASSIGNED PROGS: XLA KEYWD START OF KEYWORD TABLE STA CURKY CURRENT POSITION IN KEY WORD TABLE IDLP LDA CURKY,I GET NEXT ID SEG ADDRESS SZA,RSS 0? JMP IDONE YES, THEN DONE UNASSIGNING ADA .14 NO, POINT TO WORD 15 LDB A,I GET VALUE TO CHECK IF A LSR 4 SHORT ID SEGMENT SLB SS BIT SET? JMP ENLP YES, THEN LOOK AT NEXT ID SEGMENT LDB CURKY,I ADB .21 NO, A LONG ID SEG LDA B,I GET CONTENTS OF WORD 21 SSA,RSS RP BIT SET? JMP ENLP NO, PROG NOT ASSIGNED TO A PART'N AND B77 YES, GET PART'N # LDB CURKY,I ADDRESS OF ID SEGMENT JSB FIT PROG STILL FITS IN PART'N? RSS NO JMP ENLP YES * UNASN LDA SPACE NO, THEN UNASSIGN PROG LDB SPACE DST RDBUF CLEAR 3 WORDS IN BUFFER STA RDBUF+1 THEY WILL HOLD PROG NAME LDB CURKY,I ADDRESS OF ID SEG s+þúADB .21 GET WORD 21 OF ID SEG LDA B,I AND B777C 77700B - CLEAR BIT 15 AND BITS 0-5 STA B,I STORE IT BACK * LDA CURKY,I REPORT NAME OF PROGRAM ADA .12 LDB A,I GET FIRST 2 CHARS OF PROG NAME STB RDBUF INA LDB A,I CHARS 3 & 4 OF PROG NAME STB RDBUF+1 INA LDA A,I MASK 5TH CHAR AND B1774 CLEAR LOW BYTE IOR B40 INSERT SPACE IN LOW BYTE STA RDBUF+2 LDB .3 JSB WRLST DEF RDBUF PRINT NAME OF PROG * ENLP ISZ CURKY POINT TO NEXT ENTRY IN KEY WORD TABLE JMP IDLP EXAMINE NEXT ID SEGMENT * HED MODIFY PROGRAM PAGE REQUIREMENTS IDONE LDA CURKY GET THE LAST+1 ADDR IN KEYWORD LIST ADA N1 POINT TO LAST ENTRY IN KEYWORD LIST LDA A,I GET CONTENTS STA CURKY SAVE ADDRESS OF LAST ID SEGMENT LDB .18 JSB WRTTY MODIFY PROG PAGE REQMTS?(/E TO END) DEF MSG45 LDB .6 JSB WRTTY PNAME,#PAGES DEF MSG46 MDPRM CLB,INB JSB QUERY HYPHEN PROMPT DEF HYPHN JSB END? /E ENTERED? JMP ASNPR YES,DONE WITH PROG SIZE MODFICATION * NXTPR LDB APRSB NO INB POINT TO PROGRAM NAME IN PARSE BUFFER JSB TNAME GET ID SEG ADDRESS OF PROGRAM SEZ FOUND IT? JMP MDPRE NO SUCH PROG OR SHORT ID SEG STB IDSGA FOUND PROGRAM'S ID SEG ADDRESS * * MODIFY PROGRAM SIZE * ADB .14 POINT TO TYPE WORD LDA B,I AND B17 GET PROGRAM TYPE CPA .2 REAL TIME DISC RES PROG? RSS YES CPA .3 BACKGROUND DISC RES PROG? RSS YES CPA .4 LARGE BACKGROUND DISC RES PROG? RSS YES JMP MDPRE NO, THEN WRONG PROGRAM TYPE ADB .8 LOW MAIN ADDRESS LDA B,I CLB LSL 6 LOW MAIN PAGE# I—ÓþúN B REG CMB,INB ADB .33 MAX # OF PAGES ALLOWED FOR PROG STB UPRLM LDA IDSGA GET ID SEGMENT ADDRESS OF PROG ADA .28 WORD 29 OF ID SEGMENT LDB A,I GET CONTENTS SZB EMA PROGRAM? JMP EMAE YES, THEN ERROR INA POINT TO WORD 29 OF ID SEGMENT LDB A,I HIGH ADDR + 1 OF LARGEST SEGMENT ADA N6 POINT TO WORD 24 OF ID SEG SZB,RSS SEGMENTED PROGRAM? LDB A,I NO, THEN HIGH ADDRESS+1 OF MAIN LDA IDSGA ID SEGMENT ADDRESS ADA .22 LDA A,I CMA -(LOW MAIN+1) ADA B HIGH ADDR + 1 - (LOW MAIN + 1) CLB LSL 6 ADB .2 #PAGES USED TO RELOCATE PROG + BASE PAGE STB A USE AS LOW LIMIT FOR MODIFYING PROG SIZE LDB APRSB ADDRESS OF PARSE BUFFER ADB .4 CONTAINING # OF PAGES JSB TST# TEST THE # OF PAGES FOR VALIDITY UPRLM NOP JMP PGSE INVALID # OF PAGES ADA N1 SUBTRACT 1 TO EXCLUDE BASE PAGE ALF,ALF # OF PAGES IN BITS 10-14 RAL,RAL STA TEMP SAVE #PAGES FOR NOW LDB IDSGA ID SEGMENT ADDR OF PROG ADB .21 POINT TO WORD 21 LDA B,I GET CONTENTS AND B1017 101777B - CLEAR # PAGES FROM WORD 21 ADA TEMP ADD THE NEW VALUE STA B,I RESTORE WORD BACK IN ID SEG JMP MDPRM PROMPT FOR NEXT ENTRY * MDPRE LDA A16 NO SUCH PROG OR SHORT ID SEG JMP *+2 EMAE LDA A21 PAGE REQMTS OF AN EMA PROG CANNOT BE MODIFIED JSB ERROR JMP MDPRM * PGSE LDA A19 PROGRAM SIZE INCORRECT JMP EMAE+1 * B17 OCT 17 N6 DEC -6 .8 DEC 8 B1017 OCT 101777 A21 ASC 1,21 A19 ASC 1,19 NEW ASC 2,NEW MSG44 ASC 10,UNASSIGNED PROGRAMS: MSG45 ASC 18,MODIFY PROG PAGE REQMTS?(/E TO END) MSG46 ASC 6,PNAME,#PAGES MSG47 ASC 16,ASSIGN PROG PART'NS?(/E TO END) MSG48 ASëþúC 7,PNAME,PART'N# HYPHN ASC 1,- IDSGA NOP * HED ASSIGN PROGRAMS TO PARTITIONS ASNPR LDB .16 JSB WRTTY ASSIGN PROG PART'NS?(/E TO END) DEF MSG47 LDB .7 JSB WRTTY PNAME,PART'N# DEF MSG48 ASGNQ CLB,INB JSB QUERY HYPHEN PROMPT DEF HYPHN JSB END? JMP QPERM YES, DONE WITH PROG ASSIGNMENT LDB APRSB INB JSB TNAME FIND ID SEG ADDRESS FOR PROG SEZ FOUND IT? JMP ASPRE NO, NO SUCH PROG OR SHORT ID SEG STB TEMP YES, SAVE THE ID SEG ADDRESS ADB .14 POINT TO WORD 15 OF ID SEG LDA B,I AND B17 GET TYPE CPA .2 RSS CPA .3 RSS CPA .4 RSS JMP ASPRE NEITHER TYPE 2,3, OR 4 LDB APRSB ADB .4 POINT TO PART'N# VALUE IN PARSE BUF CLA LOW LIMIT JSB TST# TEST VALIDITY OF PART'N # PRTN# NOP # OF PARTITIONS DEFINED JMP PARTE ERROR IN PART'N# SZA,RSS IF PART NO. ZERO, THEN UNASSIGN JMP ASGNU ADA N1 SUBTRACT 1 TO HAVE PART'N # START FROM 0 STA TEMP1 SAVE PART'N # LDB TEMP ID SEG ADDRESS JSB FIT DOES THE PROG FIT IN PART'N? JMP NOFIT NO, ERROR * LDB TEMP YES, CHANGE ID SEG WORD 21 ADB .21 LDA B,I AND B777C MASK OUT RP BIT & PART'N# ADA TEMP1 NEW PART'N # ADA BIT15 RP BIT SET STA B,I RESTORE VALUE BACK JMP ASGNQ PROMPT AGAIN FOR NEXT ENTRY * ASGNU LDB TEMP ID SEG ADDRESS ADB .21 CHANGE WORD 21 LDA B,I AND B777C MASK OUT RP BIT AND STA B,I PUT BACK JMP ASGNQ GO GET SOMEMORE COMMANDS * ASPRE LDA A16 NO SUCH PROG OR SHORT ID SEG OR NOT TYPE 2,3,4 ASGN1 JSB ERROR JMP ASGNQ * PARTE LDA A17 JMP ASGN1 * NOFIT LDA A18 JMP ASGN1 * A16 þúASC 1,16 A17 ASC 1,17 A18 ASC 1,18 .21 DEC 21 B777C OCT 77700 N1 DEC -1 MSG49 ASC 21,NEW MEM CONFIGURATION PERMANENT?(YES/NO) /R ASC 1,/R * HED MAKE MEMORY RECONFIGURATION PERMANENT * QPERM LDB .21 JSB QUERY NEW MEM CONFIGURATION PAERMANENT?(YES/NO) DEF MSG49 LDA PRSBF+1 CPA /R RESTART MEMORY RE-CONFIGURATION? JMP RSTRT YES CPA YE JMP MEMPR YES CPA NO RSS JMP QPERM ERRORNEOUS RESPONSE, ASK AGAIN SJP $EXIT EXIT THRU $CNFG RSTRT SJP $NPGQ RESTART MEMORY RE-CONFIGURATION * * MAKE MEM CONFIGURATION PERMANENT * COPY MAT ON DISC MEMPR XLA $SMTB+2 SZA 0? JMP PR$SM NO XSA $SMTB XSA $SMTB+1 PR$SM LDA A$SMT LDB .10 LENGTH OF TABLE ADB BIT15 SJS $TRTB * LDA $MNP MAX ALLOWABLE PART'NS MPY .7 EACH MAT ENTRY IS 7 WORDS LONG STA B LENGTH OF MAT ADB BIT15 LDA $MATA START ADDRESS OF MAT SJS $TRTB WRITE IT ON DISC * * COPY ALL ID SEGMENTS TO DISC XLA KEYWD ADDRESS OF FIRST ID SEG LDA A,I CAX SAVE THIS VALUE ADA .14 POINT TO WORD 14 OF ID SEGMENT LDA A,I GET CONTENTS LSR 4 CXB FIRST ID SEGMENT ADDRESS SLA IS IT A SHORT ID SEGMENT? ADB .11 YES, THEN ADJUST START ADDRESS CBX SAVE THIS VALUE LDA CURKY GET ID SEGMENT ADDRESS OF LAST ID SEGMENT ADA .14 LDA A,I LSR 4 LDB CURKY SLA,RSS SHORT ID SEGMENT? ADB .13 NO ADB .19 ADJUST LAST WORD ADDRESS OF ID SEGMENT LIST CXA ADDRESS OF FIRST ID SEGMENT CMA ADB A LAST ADDR -START ADDR + 1 ADB BIT15 # OF WORDS IN ID SEGMENTS CXA START ADDRESS OF ID SEGMENTS SJS $TRTB TRANSFER ID çÝþúSEGMENTS TO DISC * LDA AMPS2 MAKE $MPS2 PERMANENT CCB SJS $TREN * * CHANGE VALUES OF $MCHN,$MBGP,$MRTP,$BGFR,$RTFR * AND $CFR ENTRY POINTS ON DISC * LDA AMCHN ADDRESS OF $MCHN ENTRY POINT CCB SJS $TREN TRANSFER ENTRY POINT TO CORRESP LOC ON DISC LDA AMBGP CCB SJS $TREN LDA AMRTP CCB SJS $TREN LDA ACFR CCB SJS $TREN LDA ABGFR CCB SJS $TREN LDA ARTFR CCB SJS $TREN CCA XSA $GDPG INDICATE SYSTEM MAP IS CHANGED FOR SAM EXT SJP $EXIT DONE * .13 DEC 13 HED SUBROUTINES TO READ, WRITE AND PRINT INFO ON SYSTEM CONSOLE * * * * END? - ROUTINE TO DETERMINE IF /E WAS ENTERED AS * A RESPONSE * CALLING SEQUENCE: JSB END? * RETURNS: LOC P IF /E WAS ENTERED * P+1 OTHERWISE * * END? NOP LDA PRSBF+1 GET FIRST WORD OF RESPONSE CPA /E IS IT /E? RSS YES JMP NOTEN LDA PRSBF+2 GET SECOND WORD OF RESPONSE CPA SPACE 2 SPACES? JMP END?,I YES, THEN RESPONSE IS /E NOTEN ISZ END? JMP END?,I RESPONSE NOT /E * /E ASC 1,/E * * QUERY - ROUTINE * CALLING SEQUENCE: B REG = # OF WORDS IN BUFFER TO DISPLAY * QUERY NOP CCA SET FLAG TO INDICATE ENTRY THRU QUERY JMP CONTQ WRTTY NOP SECOND ENTRY FOR ROUTINE TO WRITE TO TTY LDA WRTTY STA QUERY SET UP RETURN ADDRESS CLA CLEAR FLAG TO INDICATE ENTRY THRU WRTTY CONTQ STA WFLAG LDA QUERY,I STA QBUFR CLA,INA CAY LU# IN Y REG INA REQ CODE IS 2 FOR WROTE ADB BIT15 SET BIT 15 IN B REG TO INDICATE CALLING SJS $WRRD FROM USER MAP QBUFR NOP ISZ WFLAG JMP RQUER RETURN * READ RESPONSE CLA,INA LU # CAY IN Y REG LDSÏþúA B401 REQUEST CODE LDB .80 80 WORDS TO READ ADB BIT15 INDICATE CALLING FROM USER MAP SJS $WRRD ARDBF DEF RDBUF BLS CONVERT TO # OF CHARS READ LDA ARDBF JSB $PARS CALL PARSE BUFFER APRSB DEF PRSBF RQUER ISZ QUERY JMP QUERY,I RETURN * .80 DEC 80 B401 OCT 401 WFLAG NOP B1777 OCT 1777 * * * WRLST - ROUTINE TO WRITE BUFER ON LIST DEVICE AND THE * SYSTEM CONSOLE IF ECHO IS REQUESTED * CALLING SEQUENCE: B REG = BUFFER LENGTH * JSB WRLST * DEF BUFR BUFFER ADDRESS * * WRLST NOP STB TEMP4 SAVE LENGTH OF BUFFER LDA WRLST,I GET BUFFER ADDRESS STA CNBF STA LSBF LDA ECHO ECHO REQUIRED? SZA JMP NECHO NO JSB WRTTY YES, SEND BUFFER OUT TO CONSOLE CNBF NOP * NECHO LDA LSTLU SEND BUFFER OUT TO LIST DEVICE CAY LDA B202 LDB TEMP4 ADB BIT15 SJS $WRRD LSBF NOP ISZ WRLST JMP WRLST,I RETURN * B202 OCT 202 * * * TST# - ROUTINE TO TEST VALIDITY OF A GIVEN # * CALLING SEQUENCE: A REG = LOWER LIMIT OF RANGE FOR # * B REG = POINTER TO 4 SET OF WORDS * FOR $# IN PARSE BUFFER * RETURN: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * NUMBER IS IN THE A REG * * TST# NOP CBX SAVE CONTENTS OF B REG LDB B,I TYPE OF VALUE CPB .1 NUMERIC? RSS YES JMP TSTE NO, THEN ERROR RETURN CXB RETRIEVE VALUE OF B REG INB LDB B,I GET VALUE CMA,INA -VE OF LOWER LIMIT ADA B VALUE-LOWER LIMIT SSA VALUE > UPPER LIMIT? JMP TSTE YES, THEN ERROR LDA B CMA,INA ADA TST#,I UPPER LIMIT-VALUE SSA VALUE>UPPER LIMIT? JMP TSTE YES,õ²þú ERROR LDA B ISZ TST# NORMAL RETURN TSTE ISZ TST# JMP TST#,I RETURN * * * ERROR - ROUTINE PRINTS ERROR MESSAGE * CALLING SEQUENCE: A REG = ERROR# IN ASCII * JSB ERROR * ERROR NOP STA ERR00+6 LDB .7 LENGTH OF BUFFER JSB WRTTY DISPLAY ON CONSOLE DEF ERR00 JMP ERROR,I RETURN * ERR00 ASC 7,CONFIG ERR * * * PRNPR - ROUTINE TO PRINT A LIST OF PARTITION DEFINITIONS * CALLING SEQUENCE: JSB PRNPR * * PRNPR NOP LDA $MNP MAX # OF PARTITIONS CMA,INA STA TEMP USE AS COUNTER CLA,INA STA TEMP3 USE TEMP3 FOR PART'N # COUNTER LDA $MATA START OF MATA ENTRIES STA TEMP1 PARTL LDA TEMP1,I CONTENTS OF 1ST WORD OF MAT ENTRY CPA N1 -1? JMP PRNPR,I YES,RETURN - END OF MAT ENTRIES LDA TEMP3 GET PART'N # CCE CONVERT IT TO ASCII DECIMAL JSB $CVT3 ADA .2 LDA A,I GET PART'N # IN ASCII STA MSG30+4 SET UP MESSAGE LDA TEMP1 NO ADA .3 POINT TO WORD 4 STA TEMP1 LDA A,I GET CONTENTS STA TEMP2 SAVE IT ISZ TEMP1 5TH WORD OF MAT ENTRY LDA TEMP1,I LDB SPACE SSA R BIT SET? LDB COMAR YES STB MSG30+13 INCLUDE R IN THE MESSAGE * NPGS AND B1777 # OF PAGES IN PART'N INA ADD BASE PAGE CCE CONVERT TO ASCII DECIMAL JSB $CVT3 INA DLD A,I LAST 4 DIGITS DST MSG30+6 # OF PAGES IN PARTITION ISZ TEMP1 POINT TO WORD 6 LDA TEMP1,I LDB BG SSA BG PART'N? LDB RT NO, REAL TIME ISZ TEMP1 7TH WORD LDA TEMP1,I GET CONTENTS SZA,RSS SLW ZERO? JMP RTBGS YES, THEN NOT A SUBPART LDA TEMP2 GET CONTENTS OF WORD 4 SSA,RSS M BIT SET? LDB S ðþú NO, THEN SUBPARTITION * RTBGS STB MSG30+12 LDB .14 BUFFER LENGTH JSB WRLST PRINT IT DEF MSG30 PART'N XX = XX PAGES,[(RT,BG OR S) [,R] ISZ TEMP1 POINT TO NEXT MAT ENTRY ISZ TEMP3 INCREMENT PART'N # ISZ TEMP INCREMENT -VE COUNTER JMP PARTL NEXT PARTITION DATA JMP PRNPR,I RETURN ALL PART'NS DONE * COMAR ASC 1,,R MSG30 ASC 14,PART'N = PAGES, * * * PGREQ - ROTUINE TO PRINT REAL TIME AND BACKGROUND * PROGRMAS' PAGE REQIUREMENTS * * CALLING SEQEUNCE : TYPE = 0 FOR REALTIME PROGRAMS * = 1 FOR BACKGROUND PROGRAMS * PGREQ NOP XLA KEYWD START OF KEYWORD LIST STA TEMP KEYLP LDA TEMP,I GET ADDRESS OF AN ID SEGMENT SZA,RSS 0? JMP PGREQ,I YES, THEN DONE ADA .14 POINT TO WORD 15 OF ID SEG LDA A,I KEYWORDS ARE ADJUSTED TO POINT TO WORD 15 AND B27 OF LONG SHORT ID SEGMENTS LDB TYPE SZB LOOKING FOR REALTIME PROGS? JMP BKG NO, BACKGROUND CPA .2 IS THE TYPE 2 FOR REALTIME? JMP PRNPG YES, THEN PRINT PG REQMTS KEYEN ISZ TEMP NO, THEN LOOK AT NEXT ID SEG JMP KEYLP * BKG CPA .3 TYPE 3 FOR BG DISC RES PROG? JMP PRNPG YES, PRINT CPA .4 BG DISC RESIDENT WITHOUT TABLE AREA II? RSS YES JMP KEYEN NO, LOOK AT NEXT ID SEG LDB ASTER * FOR PROG WITHOUT TABLE AREA II RSS PRNPG LDB SPACE NOT A PRIV PROG STB MSG34+8 LDA TEMP,I GET ID SEG ADDRESS ADA .12 POINT TO WORD 13 CAX SAVE ADDRESS DLD A,I GET FIRST 4 CHARS OF NAME OF PROG DST MSG34 SET UP MESSAGE CXA ADA .2 POINT TO WORD 15 LDA A,I GET CONTENTS AND B1774 MASK UPPER BYTE IOR B40 INSERT BLANK IN LOW BYTE STA MSG34+2 LDA TEMP,I IDÂåþú SEG ADDRESS ADA .28 LDA A,I GET CONTENTS OF WORD 29 LDB SPACE SZA EMA PROG? LDB E YES, THE INSERT E IN MESSAGE STB MSG34+9 LDA TEMP,I JSB PRGSZ DETERMINE # PAGES REQD BY PROG INA INCREMENT TO INCLUDE BASE PAGE CCE JSB $CVT3 INA POINT TO ASCII VALUE DLD A,I DST MSG34+3 LDA TEMP,I GET ID SEG ADDR OF PROG ADA .21 POINTO TO WORD 22 OF ID SEG LDA A,I GET CONTENTS OF WORD 22 OF ID SEG SSA,RSS RP BIT SET? JMP WRPGR NO AND B77 PROG IS ASSIGNED TO A PART'N INA PART'N # STARTING FROM 1 CCE CONVERT TO ASCII DEC JSB $CVT3 ADA .2 LDA A,I STA MSG34+14 LDB .15 LENGTH OF BUFFER RSS WRPGR LDB .10 WITHOUT PART'N # JSB WRLST DEF MSG34 PNAME XXXX PAGES [*] [E] [PART'N XX] JMP KEYEN LOOK FOR NEXT PROGRAM * ASTER ASC 1, * B1774 OCT 177400 B27 OCT 27 B40 OCT 40 TYPE NOP MSG34 ASC 15,PNAME PAGES PART'N * * * TNAME - SEARCH KEYWORD LIST FOR PROGRAM NAME * CALLING SEQUENCE: B REG = ADDRESS OF ASCII PROGRAM NAME * JSB TNAME * RETURNS: A REG = 0 IF PROGRAM NOT FOUND (E=1) * B REG = ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E REG = 0 IF STANDARD ID SEGMENT * E REG = 1 IF SHORT ID SEGMENT OR NOT FOUND * * TNAME NOP STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCREMENT TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND B1774 MASK OFF X STA TEMP5 SZA IF NULL CHAR. FORCE ERROR RETURN XLA KEYWD STA TEMP TN005 LDA TEMP,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST RETURN ADA .12 Å­þú LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 5,X CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND B1774 MASK OFF X CPA TEMP5 COMPARE CHAR 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ TEMP INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB TEMP,I LOAD B WITH ID SEG ADDRESS JMP TNAME,I EXIT * * * SETM - ROUTINE TO SET MEMORY TO A GIVEN VALUE * CALLING SEQUENCE: A REG = VALUE * B REG = # OF LOCATIONS TO CHANGE * JSB SETM * DEF LOC STARTING LOCATION * * SETM NOP CAX SAVE VALUE OF A REG IN X LDA SETM,I STARTING LOC STA TEMP ADDRESS OF LOC ISZ SETM CMB,INB -VE COUNT CXA VALUE IN A SETLP STA TEMP,I STORE VALUE INB,SZB,RSS INCREMENT COUNTER JMP SETM,I RETURN ISZ TEMP POINT TO NEXT MEM LOC JMP SETLP * * * FIT - ROUTINE TO TEST IF GIVEN PROGRAM CAN * FIT INTO THE PARTITION # PASSED AS PARAMETER * CALLING SEQUENCE: A REG = PART'N # STARTING AT 0 * B REG = ID SEG ADDRESS * JSB FIT * RETURNS: LOC P IF PROGRAM DOES NOT FIT IN PART'N * LOC P+1 IF THE PROGRAM DOES FIT * FIT NOP STB TEMP4 SAVE ID SEGMENT ADDRESS MPY .7 GET ADDRESS OF PART'N ENTRY IN MAT ADA $MATA ADDRESS OF MAT LDB A,I SSB IS PART'N DEFINED? JMP FIT,I NO, THEN ERR•ÕþúOR RETURN ADA .4 WORD 5 OF MAT ENTRY LDB A,I ELB,CLE,ERB CLEAR R BIT IF SET STB TEMP5 SAVE # OF PAGES IN PART'N LDA TEMP4 GET ID SEG ADDRESS OF PROG JSB PRGSZ FIND # PAGES REQD BY THIS PROG CMA,INA ADA TEMP5 # PAGES IN PART'N - # PAGES REQD BY PROG SSA PROGRAM FITS? JMP FIT,I NO, THEN ERROR RETURN ISZ FIT YES JMP FIT,I RETURN TO LOC P+1 * * * PRGSZ - ROUTINE TO DETERMINE # PAGES REQD BY * A PROGRAM NOT INCLUDING BASE PAGE * CALLING SEQUENCE: A REG = ID SEGMENT ADDRESS * JSB PRGSZ * RETURNS: A REG = # OF PAGES REQD. BY PROG * B REG = 0 IF NON-EMA PROGRAM * = -1 IF EMA PROGRAM * * PRGSZ NOP STA TEMP3 SAVE ID SEG ADDRESS FOR LATER USE ADA .21 LDA A,I GET WORD 21 OF ID SEG ALF # OF PAGES IN LOW BITS RAL,RAL AND B37 # OF PAGES REQUIRED BY PROG CAX SAVE VALUE LDA TEMP3 GET ID SEG ADDRESS ADA .28 EMA PROG? LDB A,I SZB,RSS JMP NOEMA NO CLA YES, EMA PROG RRL 6 GET ID SEG EXT # STB TEMP3 SAVE EMA SIZE VALUE LEFT IN B REG ADA $IDEX ID SEG EXT ADDRESS LDA A,I ADDRESS OF FIRST WORD OF ID SEG EXT LDA A,I CONTENTS OF FIRST WORD OF ID SEG EXT AND B37 GET BITS 0-4 - MSEG SIZE CMA,INA LDB TEMP3 ROTATE VALUE SAVED IN TEMP BLF,BLF RBL,RBL TO GET EMA SIZE ADA B - MSEG SIZE CXB ADA B + # PAGES IN PROGRAM CCB SET B TO INDICATE EMA PROG JMP PRGSZ,I RETURN NOEMA CXA # PAGES REQUIRED BY PROGRAM CLB B = 0 TO INDICATE NON-EMA PROG JMP PRGSZ,I RETURN * END $CNFX nœš––œÿÿ ÿýoŽ ÿ92067-18007 1926 S 0222 RTE-IV WHZAT              H0102 Ë+þúASMB,R,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * HED WHZAT FOR RTE-IV NAM WHZAT,1,1 92067-16007 REV.1926 790506 * * NAME: WHZAT * SOURCE: 92067-18007 * RELOC: 92067-16007 * PRGMR: E.J.W. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL EXT $MATA,$MNP * A EQU 0 B EQU 1 * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B * * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * ON,WHZAT,LU * * 09:51:50:710 * ********************************************************************** * PT SZ PRGRM,T ,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME * * ********************************************************************** * 0 ** MEM *1 *09000 ***** 1 * 2 2 R$PN$*1 *00010 *************** 3,CL 032 * 3 5 PROGA*3 *00097 ******************************* 6 * 4 5 PROGB*3 *00097B*************** 3,LULK 40,LKPRG=PROGA * 5 17 PROGC*3E*00097 *************** 3,RN 031,LKPRG=PROGD * 3A27 PROGD*4 *00097 *************** 3,RESOURCE * 5 7 PROGE*3 *00097 *************** 3,CLASS # * 2 4 QUIKR*3 *00099 0 **********************************00:00:00:000 * 6 7 FMGR *3 *00090 *************** 3,EDITR'S QUEUE * 3 7 EDITR*3 *00050 ************************* 5 * 6 15 ASMB *3 *00099 *************** 3,LU,EQ DN , 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN 6, 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN *********00:00:00:000 * 7 7 FMG07*3 *00050 *************** 3,BL,EQT 7 * 2 3 WHZAT*4 *00001 ***** 1 * 0 *ä2þú* RENSB*1 *00060 ******************** 4 * 3 6 PROGF*4 *00096 *************** 3,RN 031,LKPRG=GLOBL * 6 7 ED26 *3 *00050 ********** 2, 16(2[00000010]) * ********************************************************************** * DOWN LU'S, 6, 14 ************************************************************************ * DOWN EQT'S, 5, 6 * ********************************************************************** * 09:51:50:710 * * * BRIEF EXPLANATION OF SOME OF THE ABOVE. * * PT SZ COLUMN HEADING (PARTITION NUMBER AND PARTITION SIZE) * 0 ** IN RTE-IV MEANS MEMORY RESIDENT PROGRAM * 5 8 IN RTE-IV MEANS PARTITION #5 IS USED AND 8 PAGES IN USE * 11 IN RTE-IV MEANS SCHEDULED PROGRAM IS NOT YET IN PARTITION * * 'A' AFTER THE PARTITION # MEANS THE PROGRAM WAS ASSIGNED * 'E' AFTER THE PROGRAM'S TYPE MEANS IT IS AN EMA PROGRAM * 'B' AFTER THE PROGRAM'S PRIORITY MEANS RUNNING UNDER BATCH * WHEN A PROGRAM IS IN STATE 3[WAIT],THE REASON FOR BEING IN THAT * STATE WILL BE SPECIFIED ACCORDING TO THE FOLLOWING RULES : * IDSEG(2) ::= $RNTB => 'RN ALLOCATION' * ::= DRT(#[6:10])=RN# => 'LU # LOCKED' * ::= >$RNTB,<$RNTB+[$RNTB] => 'RN LOCKED' * ::= $CLAS => 'CLASS ALLOCATION' * ::= >$CLAS,<$CLAS+[$CLAS] => 'CLASS GET' * ::= 4 => 'DEVICE(LU OR EQT) DOWN' * ::= SON'S IDSEG ADDRESS => 'SON'S NAME' * ::= EQT ADDRESS => 'BL,EQT#NN' * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IV * ON,WHZAT,LU,1 * * 09:00:21:250 * ********************************************************************** * PTN# SIZE PAGES BG/RT PRGRM * ********************************************************************** * 1 7 42- 48 BG FMG11 * 2 15 49- 63 BG EDITR * 3 16 64- 79 RT WHZAT * 4M 48 80- 127 BG EMAPR * 5C 16 80- 95 BG * 6C 16 96- 111 BG * 7C 16 112- 127 BG * 8M 64 128- 191 RT * 9SR 16 128- 143 RT * 10S 16 144- 159 RT PROGQ * 11S 16 160- 175 RT SAMPL * 12SR 16 176- 191 RT * 13 R 64 192- 255 BG EMAID * 14 * 15 * ********************************************************************** * 09:00:21:310 * * SKP WHAT XLA B,I CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 STA CRTLU SAVE LU FOR OUTPUT INB XLA B,I STA PARM2 SAVE SECOND PARAMETER INB XLA B,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES SPC 2 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE JSB STARS ERASE EOL + A LINE OF ASTERISKS * LDA PARM2 SZA WAS SECOND PARAMETER GIVEN? JMP WHATP YES, SHOW PARTITIONS * SPC 2 LDA .HEAD ERASE EOL + COLUMN HEADER LDB DM74 JSB PRINT JSB STARS ERASE EOL + A LINE OF ASTERISKS CLA ZERO IDSEG # STA IDCNT AND AWAY WE GO ! SPC 2 SKP MAIN JSB SETPT BEGIN MAIN CODE. INIT STACK LDA KEYWD GET ADDRESS OF KEYWORD BLOCK ADA IDCNT ADD ON IDSEG # TO INDEX XLA A,I TO THIS LOOP'S WORK STA IDPNT IDSEG(1) * SZA,RSS IF ZERO, JMP FINIS THEN WE'RE THRU WITH ID SEG'S * LDB D15 ELSE VERIFY JSB IDWRD THAT THIS AND B17 IDSEG(16[4-0])=PROG STATUS STA STATS PROGRAM IS SZA NOT DORMANT ? JMP PROCS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDWRD THAT THIS ALF,výþúSLA IDSEG(18[12])=TIME LIST INDICATOR JMP PROCS PROG IS IN TIME LIST ! JMP BUMP0 ELSE NEXT INDEX(IDSEG #) * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D21 DEC 21 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 35 .STAK DEF STACK STKPT NOP .TM. DEF STACK+31 .DNTM DEF STACK+26 .LAST DEF STACK+36 ASTER OCT 0,0 UNL REP 35 ASC 1,** LST .ASTE DEF ASTER .STAR DEF ASTER+2 DM4 DEC -4 D7 DEC 7 SPC 4 PROCS EQU * LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM? RSS JMP PRLNG NO, PROCESS DISC RESIDENT * LDA .RSDT YES, RESIDENT PROGRAM JSB MVBYT PRINT IT IS IN PARTITION 0 DEF D6 * JMP NAME GO GET PROGRAM NAME * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM (PARTITION #) STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PTTN SZA NO, WAS IT IN ANY PTTN? JMP PRPTN YES, ASSIGNED OR IN PTTN (NOT 1) * LDB D8 JSB IDWRD SZA HAS PROGRAM BEEN SUSPENDED BEFORE? JMP PRPT YES, THEN PARTITION #1 IS OK. * LDA .SPAC NO, PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG DO ASSIGNMENT INDICATOR * PRPT CLA PRPTN INA CONVERT TO ASCII JSB .ASC2 AND ADD TO STACK * PRASG LDA .SPAC LDB NUM SSB WAS PROG ASSIGNED TO PTTN? LDA .A YES, PUT 'A' IN LINE JSB MVBYT ELSE PUT A SPACE IN DEF D1 OUTPUT LINE * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 COyþúNVERT TO ASCII LDA .SPAC JSB MVBYT PUT A SPACE DEF D1 * * NAME LDA IDPNT CALC 'FROM' JSB MVNAM MOVE NAME TO OUTPUT STACK * JSB PSTAR PUSH AN ASTERISK SPC 2 TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD ALF,ALF CHECK FOR SHORT ID ALF,SLA,ALF SHORT ? JMP FINIS YES,STOP ID CHECK AND D7 MASK OFF IDSEG(15[2-0]) STA NUM SAVE PROG TYPE FOR A WHILE JSB .ASC1 & STORE BYTE LDB D28 GET EMA WORD FROM ID SEG LDA NUM CPA D1 IS IT MEM. RES. PROG? CLA,RSS YES, SKIP EMA STUFF JSB IDWRD LDB .SPAC SZA IS IT EMA? LDB .E YES, PUT 'E' IN LINE LDA B ELSE USE SPACE JSB MVBYT DEF D1 JSB PSTAR PUSH AN ASTERISK * PRIOR LDB D6 GET PROG PRIORITY JSB IDWRD IN 'A'REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD LDB .SPAC SSA IF RUNNING UNDER BATCH, LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT DEF D1 SPC 2 LDA STATS CALC STATUS COLUMN SZA,RSS DORMANT ? JMP M NO ASTERISKS NECESSARY MPY D5 5 CHARS PER COLUMN STA NUM SET UP MOVE LDA .STAR 'A'REG=SOURCE JSB MVBYT MOVE BYTES,R/L DEF NUM BER OF BYTES * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC2 & PUSH ONTO STACK * LDA STATS GET STATUS CPA D2 I O SUSPEND ? JMP EQT YES-PROCESS EQT# CPA D3 WAIT LIST ? JMP WAIT YES-PROCESS WAIT LDA .SPAC ADD ONE MORE SPACE JSB MVBYT DEF D1 JMP TLIST CHECK TLIST SPC 2 EQTPT NOP #EQTS NOP .RSDT DEF *+1 ASC 3, 0 ** .A DEF *+1 ASC 1,AA .B DEF *+1 P´þú ASC 1,BB .E DEF *+1 ASC 1,EE D28 DEC 28 SKP EQT CLA PROG'S IN I/O SUSPEND STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 (15 WORDS EQT) ADA EQTA ADD ON EQT AREA BASE STA EQTPT SAVE THIS EQT'S ADDRESS XLA A,I GET CONTENTS OF EQT'S FIRST WORD * IDSLP SZA,RSS SCAN SUSPEND LIST. NULL LIST? JMP NXTEQ YES-GO TO NEXT EQT CPA IDPNT NO-POINTS TO OUR ID SEG ? JMP FNDEQ YES-GO PROCESS. SSA IF INDIRECT MUST BE GARBAGE JMP NXTEQ XLA A,I NO-NEXT LIST ELEMENT JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT CNTR FOR NEXT EQT ENTRY LDA #EQTS ARE WE THRU ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES-MUST BE OSCAR JMP EQTLP NO- GOTO EQT LOOP * OSCAR LDA .EXEC MOVE " ,EXEC" ONTO STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST SPC 2 .EXEC DEF *+1 ASC 3,, EXEC .CMBL EQU .EXEC COMMA, BLANK B140K ABS 140000B .LPAR DEF *+1 ASC 1,( .LBRK DEF *+1 ASC 1,[ .IOBE DEF *+1 ASC 1,]) * SPC 2 FNDEQ EQU * PUSH ", EQ(L[DEV.STAT]) *" LDA .CMBL MOVE COMMA AND BLANK JSB MVBYT DEF D2 LDA #EQTS CALC EQT # INA JSB .ASC2 CONVERT TO ASCII LDA .LPAR PUSH "(" ONTO STACK JSB MVBYT DEF D1 * LDB EQTPT GET DEV.LOG.STATUS ADB D4 LDA B,I ALF,ALF STA EQST SET UP FOR BINARY STATUS ALF,ALF AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONV TO ASCII & STORE LDA .LBRK PUSH "[" ONTO STACK JSB MVBYT DEF D1 * LDA DM8 SET UP LOGICAL STATUS STA CNT COUNTER BINLP LDA EQST CONVERT STATUS WORÞsþúD TO BINARY RAL ROTATE CCW STA EQST SAVE IT AND D1 MASK OFF LSB(IT) JSB .ASC1 CONV TO ASCII & STORE ISZ CNT DONE 8 ? JMP BINLP NO-LOOP * LDA .IOBE MOVE LAST PART OF MESSAGE JSB MVBYT PUSH DEF D2 JMP TLIST CHECK TLIST SPC 2 DM8 DEC -8 D20 DEC 20 REASN NOP TEST EQU REASN EQST NOP SKP WAIT LDA .EXEC PUSH "," ONTO STACK JSB MVBYT FOR EXPLANATION DEF D1 * CLB,INB GET IDSEG(2) JSB IDWRD STA REASN CPA .RNTB RESOURCES LOCK ? JMP RESLK YES-PUSH "RESOURCE" ONTO STACK * CPA .CLAS NO-CLASS LOCK ? JMP CLSLK YES-PUSH "CLASS #" ONTO STACK * CPA D4 NO-DEVICE DOWN ? JMP DEVDN YES-PUSH "DEVICE DOWN" ONTO STACK * JSB TSTWD RNTBL<=IDSEG(2)<=[RNTBL] ? .RNTB DEF $RNTB+0 JMP RNLCK YES-PUSH "RN LOCK" ONTO STACK * JSB TSTWD CLASS<=IDSEG(2)<=[CLASS] ? .CLAS DEF $CLAS+0 JMP CLGET YES-PUSH "CLASS GET" ONTO STACK * LDA 1650B EQT <= IDSEG(2) <= #EQTS CMA,INA - S.A. OF EQT ADA REASN + POINTER SSA IF -, THEN POINTER < EQT S.A. JMP SONID FORGET IT CLB RESULT IS ADD REL S.A.EQT DIV D15 MOD 15 INA + 1 STA TEMP = EQT # CMA,INA -EQT# ADA 1651B + # EQT'S SSA,RSS IF POS,THEN VALID EQT # JMP BL SO PROCESS IT * SONID LDA REASN GET SON'S IDSEG ADDRESS JSB MVNAM MOVE SON'S NAME ONTO STACK LDB D15 JSB IDWRD ALF,SLA JMP TLIST BIT 12 SET, HAVE SON * LDA .QUE BIT 12 CLEAR, SON YET TO BE JMP PUSH8 SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEpeþúMP JSB .ASC2 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE RESLK LDA .RN?? PUSH "RN ??" ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK LDA .CL?? PUSH "CL ??" ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST SPC 2 .EQDN DEF *+1 ASC 5,LU/EQ DN DEVDN LDA .EQDN PUSH "LU,EQ DN" ONTO STACK JSB MVBYT DEF D8 LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE, IT IS EQT ADDR JMP DVDNE OF DOWN DEVICE * JSB .ASC4 PUT LU LEADING BLANKS * CCA FIND EQT NO. FOR LU ADA REASN AND B77 ADA DRT LDA A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT JMP FNDEQ GO PRINT EQT STUFF. * DVDNE CMA,INA SAVE EQT ADDR OF DOWN DEVICE STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR CMA,INA CLB DIV D15 AND DIVIDE BY 15 *1926DLS*DEL NEXT LINE STA #EQTS LDA .SPAC PUT 4 BLANKS FOR LU# JSB MVBYT DEF D4 JMP FNDEQ PUT OUT EQT INFO SPC 2 B37 OCT 37 @DRT EQU 1652B @LUMX EQU 1653B .RNLK DEF *+1 ASC 2,RN 00,LKPRG=PROGA . .LKPR DEF *+1 ASC 4,,LKPRG= * RNLCK STA RN SAVE RN# TEMP LDA @DRT GET DRT ADDRESS STA PTR SET UP POINTER LDA @LUMX GET MAX # OF LU'S CMA,INA SET UP COUNTER STA CNT LLOOP EQU * SEARCH FOR LU LOCK LDA PTR,I GET DRT ENTRY RRR 6 POSITION LU LOCK RN AND B37 & MASK IT CPA RN LU LOCK ? JMP LULCK YES-PROCESS IT ISZ PTR NO LOOP x²þú ISZ CNT JMP LLOOP LDA .RNLK PUSH "RN LK" ONTO STACK JSB MVBYT DEF D4 LDA RN PROCESS RNLCK JSB ZASC3 JSB PLOCK PUT PROG NAME INTO MESSAGE JMP TLIST SPC 2 .LULK DEF *+1 ASC 3,LULK 00,LKPRG=PROGA . * LULCK LDA .LULK PUT "LULK" ONTO STACK JSB MVBYT DEF D4 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC3 PUT LU# IN MESSAGE JSB PLOCK PUT PROG NAME IN MESSAGE JMP TLIST SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK JSB MVBYT DEF D7 LDA .RNTB ADA RN XLA A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD XLA A,I JSB MVNAM MOVE NAME JMP PLOCK,I * PLCK9 LDA .GLBL JSB MVBYT MOVE NAME 'GLOBL' DEF D5 JMP PLOCK,I * .GLBL DEF *+1 ASC 3,GLOBL M1 DEC -1 RN NOP PTR NOP CNT NOP .CLGT DEF *+1 ASC 3,CL .SPAC DEF .CLGT+2 CL# NOP * CLGET STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST LDB D17 IDSEG(18[12])=TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTTM YES-CONV NEXT TIME JMP DUMP NO-PRINT WHAT WE'VE GOT. SPC 2 D8 DEC 8 SPC 2 NXTTM LDA .TM. CALC # OF STARS TO FILL LINE CLE,ELA CMA,INA ADA STKPT CMA,INA SSA,RSS MORE THAN WE CAN FIT? JMP NXTM2 NO, OK * JSB OUTPT YES, LU/DN MSG TOO LONG LDA .DNTM COPY LINE AFTER PRINTING IT CLE,ELA AND ADD TIME STUFF TO IT STA STKPT JMP NXTTM * NXTM2 STA NUM & SAVE IT LDA .STAR SET UP FOR MOVE JSB ‚KþúMVBYT DEF NUM * LDA IDPNT ADA D18 JSB CNVTM * DUMP JSB OUTPT DISPLAY STACK BUMP0 ISZ IDCNT JMP MAIN SPC 2 FINIS JSB STARS EOL + 70 ASTERISKS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. LDA .DNLU PRINT LINE HEAD. JSB MVBYT DEF D9 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE NEED MORE LINES * LDA DRT GET LU TABLE AREA ADDRESS, ADA LUMAX POSITION TO WORD TWO STA EQTPT TABLE AND SAVE. CLA INITIALIZE STA #EQTS COUNTER. * DNLU1 LDA EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION TO START ADA STKPT SEE IF TOO FULL YET. SSA LINE FULL YET? JMP DNLU2 NO, DO IT * JSB OUTPT YES, DUMP LINE LDA PTR SET UP NEW LINE STA STKPT JUST LIKE THE PREVIOUS DNLU2 LDA .CMBL YES--PROCESS IT. JSB MVBYT PUSH A ','. DEF D1 LDA #EQTS CONVERT LU# JSB .ASC3 TO ASCII. NXTLU ISZ EQTPT INCREMENT DRT WORD 2 POINTER. LDA #EQTS IF LAST, CPA LUMAX THEN GO RSS DUMP LINE. JMP DNLU1 ELSE CONTINUE. * JSB OUTPT PRINT STACK. JSB STARS E0L + LINE OF ASERISKS. * JSB SETPT RESET STACK FOR DOWN EQTS LDA .DNEQ PRINT LINE HEAD JSB MVBYT DEF D10 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE WE NEED ANOTHER LINE * LDA EQTA GET EQT TABLE AREA ADDRESS ADA D4 INDEX TO STATUS STA EQTPT PUSH POINTER CLA INIT STA #EQTS EQT COUNTER DEVLP LDA EQTPT,I FIND EQT'S. GET STATUS ISZ #EQTS RAL,RAL POSITION AND D3 & MASK CPA D1 E—þú IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION ADA STKPT TO SEE IF FULL YET? SSA FULL YET? JMP DNEQ2 NO, DO IT * JSB OUTPT DUMP LINE LDA PTR SET UP FOR ANOTHER LINE STA STKPT JUST LIKE THE PREVIOUS DNEQ2 LDA .CMBL PUSH "," JSB MVBYT DEF D1 LDA #EQTS CONV EQT# TO ASCII JSB .ASC3 NXTDV LDA EQTPT BUMP ADA D15 TO NEXT STA EQTPT EQT STATUS WORD LDA #EQTS WAS THIS THE LAST CPA EQT# RSS YES-DUMP IT JMP DEVLP NO-CONTINUE SPC 2 DONE JSB OUTPT PRINT STACK DONE1 JSB STARS EOL + LINE OF ASTERISKS EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF CRTLU RSTRT JMP WHAT RESTART SPC 2 ZERO OCT 0 D18 DEC 18 DM6 DEC -6 RNTBL NOP CLASS NOP NUM NOP D4 DEC 4 .DNEQ DEF *+1 ASC 5,DOWN EQT'S .DNLU DEF *+1 ASC 5,DOWN LU'S D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 10,PT SZ PRGRM,T ,PRIOR ASC 10,*DRMT*SCHD*I/O *WAIT ASC 10,*MEMY*DISC*OPER * NE ASC 5,XT TIME *** SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 SPC 2 STBYT NOP LDB TO OCT 105764 JSB SBT STB TO JMP STBYT,I SPC 2 * ('A'REG = WORD ADDRESS OF FROM) * JSB MVBYT * DEF COUNT * MVBYT NOP CLE,ELA LDB STKPT DST FROM LDA MVBYT,I ISZ MVBYT STA .MVBY DLD FROM OCT 105765 JSB MBT .MVBY NOP NOP STB STKPT ‰Õþú JMP MVBYT,I SPC 2 PSTAR NOP LDA .STAR JSB MVBYT DEF D1 JMP PSTAR,I SPC 2 SETPT NOP LDA .STAK ADA D2 CLE,ELA STA STKPT JMP SETPT,I SPC 2 OUTPT NOP LDA .STAK LDB .STAK CLE,ELB CONV TO BYTES CMB,INB ADB STKPT ADD ON CURRENT BYTE POSITION CMB,INB JSB PRINT JMP OUTPT,I SPC 2 STARS NOP LDA .ASTE LDB DM74 JSB PRINT JMP STARS,I * DM74 DEC -74 SPC 2 * 'A'REG = UPPER LIMIT * 'B'REG = LOWER LIMIT * TEST = ??????????? * JSB TESTR * RETURN -'A'REG : POS => FALSE NEG => TRUE . TESTR NOP CMB,CLE,INB ADB TEST LDB TEST CMB,SEZ,CLE,INB ADB A ERA SIGN = E. E=0 FALSE E=1 TRUE JMP TESTR,I SPC 2 TSTWD NOP LDB TSTWD,I GET ADDR OF TABLE ISZ TSTWD XLA B,I GET UPPER LIMIT BY ADDING ADA B SIZE OF TABLE TO ADDR STB SAVEB SAVE ADDR OF TABLE AS LOWER LIMIT JSB TESTR SSA,RSS ISZ TSTWD LDA SAVEB CMA,INA ADA TEST JMP TSTWD,I SPC 2 * (A) = ID SEG ADDR * JSB MVNAM * MVNAM NOP MOVE NAME FROM ID SEG TO OUTPUT LINE ADA D12 LDB D3 CBX MOVE 3 WORDS FROM SYSTEM MAP LDB DWRD1 BECAUSE MBF REQUIRES MWF DEST. TO BE AT EVEN WORD LDA DWRD1 JSB MVBYT DEF D5 JMP MVNAM,I * WORD1 NOP WORD2 NOP WORD3 NOP SPC 2 PRINT NOP STA .BUFF STB CNT JSB EXEC DEF *+1+4 DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * TOD NOP JSB SETPT LDA @TIME JSB CNVTM JSB OUTPT JMP TOD,I SPC 2 @TIME DEF $TIME+0 MS NOP SEC NOP MIN NOP HOURS NOP DAY NOP .HOUR ²NLHDEF HOURS .COLN DEF *+1 ASC 1,:: .ZERO DEF *+1 ASC 1,00 SPC 2 CNVTM NOP LDB D3 MOVE 3 WORDS OF TIME CBX TO USER MAP FROM SYS MAP LDB DWRD1 MWF JSB TMVAL CONVERT INTO COMPONENTS DEF *+1+2 DWRD1 DEF WORD1 DEF MS LDA .HOUR STA PTR LDA DM4 STA CNT JMP TLOOR * TLOOP LDA .COLN PUSH A ":" OUT JSB MVBYT DEF D1 TLOOR LDA PTR,I JSB .ASC2 CONVERT TIME TO ASCII CCA ADA PTR STA PTR ISZ CNT JMP TLOOP * LDA .ZERO ADD "0" FOR LAST NUMBER JSB MVBYT TO MULTIPLY BY 10 FOR MS DEF D1 JMP CNVTM,I RETURN WITH ASCII VALUES IN ARRAY TIME SPC 2 IDWRD NOP ADB IDPNT XLA B,I JMP IDWRD,I SPC 2 * 'A'REG = BINARY VALUE * 'B'REG = 5 MINUS NUMBER OF DIGITS TO BE CONVERTED * 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES * JSB ASCII * 'A'REG = LAST BYTE * 'B'REG = BYTE ADDRESS UPDATED * ASCII NOP STA VAL CLA ELA STA FILL LDA STKPT STA TO LDA B (A)=(B)=DIGIT COUNT CODE ADB DM4 STB CCNTR SZB,RSS IF ONLY ONE DIGIT JMP LSTDG GO TO LAST DIGIT CODE ADA .N10K ADJUST POWERS OF TEN TO STA QPNTR NUMBER OF DIGITS DESIRED q2NÿÿþúLOOP LDA VAL CLB DIV QPNTR,I DIVIDE BY POWER OF TEN STB VAL SAVE REMAINDER (LOWER DIGITS) SZA JMP ASCNV CPA FILL LEADING ZEROES WANTED? JMP LZERO NO, BLANK OUT IF E#0 ORIGINALLY ASCNV IOR B60 NOT 0 OR LEADING 0 WANTED STA FILL SO INSURE NO 0 GETS LOST ASCST JSB STBYT ISZ QPNTR INCRE TO NEXT POWER OF TEN ISZ CCNTR BUMP DIGIT COUNTER JMP LOOP MORE THAN 1 DIGIT LEFT LSTDG LDA VAL IOR B60 DO LAST DIGIT EVEN IF ZERO JSB STBYT STB STKPT (B) IS STILL NEXT BYTE ADDR JMP ASCII,I * LZERO LDA B40 REPLACE LEADING ZEROES JMP ASCST WITH BLANKS SPC 2 .ASC1 NOP CONVERT 1 DIGIT TO ASCII CLE LDB D4 JSB ASCII JMP .ASC1,I SPC 2 .ASC2 NOP CONVERT BINARY TO ASCII CLE LDB D3 JSB ASCII JMP .ASC2,I SPC 2 .ASC3 NOP CONVERT 3 DIGITS, LEADING BLANKS CLE LDB D2 JSB ASCII JMP .ASC3,I SPC 2 ZASC3 NOP CONVERT 3 DIGITS, LEADING ZEROES CCE LDB D2 JSB ASCII JMP ZASC3,I SPC 2 .ASC4 NOP CONVERT 4 DIGITS, LEADING BLANKS CLB,CLE,INB JSB ASCII JMP .ASC4,I SPC 2 .ASC5 NOP CONVERT 5 DIGITS, LEADING BLANKS CLB,CLE JSB ASCII JMP .ASC5,I SPC 2 ZASC5 NOP CONVERT 5 DIGITS, LEADING ZEROES CLB,CCE JSB ASCII JMP ZASC5,I SPC 2 VAL NOP .N10K DEF N10K N10K DEC 10000,1000,100,10 D1 DEC 1 D10 EQU N10K+3 QPNTR NOP CCNTR NOP FILL NOP SAVEB EQU VAL B40 OCT 40 B60 OCT 60 SKP WHATP LDA .PHED LDB DM38 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB STARS '**********' * CLA,INA STA PTN# INIT PARTITION NUMBER XLA $MATA STA PTNAD INITz”þú PARTITION ADDR XLA $MNP GET # OF PARTITIONS SZA,RSS JMP DONE IN CASE BOO-BOO MPY D7 ADA PTNAD CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN JSB SETPT LDA PTN# BEGIN PARTITION LINE JSB .ASC2 CONVERT # TO ASCII * XLA PTNAD,I GET LINK WORD SSA,RSS PARTITION DEFINED? JMP CKPTN YES, CHECK STUFF * IFZ * LDB D3 UNDEFINED BUT WAS JSB PTNWD THIS DUE TO A SZA,RSS PARITY ERROR ? JMP UNDEF NO * LDA .PERR GET THE PARITY ERROR JSB MVBYT MESSAGE & DEF D16 JMP DMPTN DUMP IT * XIF UNDEF LDA .UNDF NO, PRINT 'NOT DEFINED' JSB MVBYT DEF D14 JMP DMPTN DUMP LINE, PROCESS NEXT * CKPTN LDB D3 JSB PTNWD GET WORD 4 SSA,RSS IS IT MOTHER PTTN? JMP NTMOM NO * LDA .M FILL IN 'M' JMP DOMCS * NTMOM LDB D4 JSB PTNWD GET WORD 5 RAL SSA,RSS IS SUBPTTN IN CHAIN MODE? JMP NTCHN NO * LDA .C FILL IN 'C' JMP DOMCS * NTCHN LDB D6 JSB PTNWD GET WORD 7 STA B LDA .SPAC USE SPACE IF NOT SUBPTTN SZB LDA .S ELSE FILL IN 'S' DOMCS JSB MVBYT DO 'M' 'C' OR 'S' DEF D1 * CKRES LDB D4 JSB PTNWD CALC ADDR OF RES-SIZE CLE,ELA RAR KEEP ONLY 10 BITS AND B1777 (STATUS JUNK IN HIGH BITS) STA PTSIZ SAVE SIZE OF PART. LDA .SPAC OUTPUT SPACE IF NOT RESERVED SEZ ELSE LDA .R USE 'R ' IF RESERVED JSB MVBYT DEF D1 * LDA PTSIZ GET PART. SIZE (MAX=1024) INA ADD 1 FOR BASE PAGE JSB .ASC5 CONVERT TO ASCII + OUTPUT * LDA .SPAC JSB MVBYT 2 MORE SPACES DEF D2 * LDB D3 q7þú JSB PTNWD ADDR OF START PAGE # AND B1777 PAGE # IN LOW 10 BITS ONLY STA PAGE# JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDA .DASH JSB MVBYT PUT "-" ON OUTPUT STACK DEF D1 * LDA PAGE# ADA PTSIZ CALCULATE LAST PAGE # JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDB D5 JSB PTNWD CLE,ELA PUT RT-BG BIT INTO (E) LDA .BG 'BG " IF BACKGROUND SEZ ELSE LDA .RT ' RT' IF REAL-TIME JSB MVBYT CLASS PARTITION DEF D7 * LDB D2 JSB PTNWD SZA,RSS EMPTY? JMP NOPRG YES, PRINT '' JSB MVNAM MOVE NAME TO OUTPUT * DMPTN JSB OUTPT DUMP OUTPUT STACK ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D7 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? JMP DONE1 YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD XLA B,I JMP PTNWD,I SPC 2 .PHED DEF *+1 OCT 0,0 ASC 17,PTN# SIZE PAGES BG/RT PRGRM * .UNDF DEF *+1 ASC 7, .PERR DEF *+1 ASC 8, * .R DEF *+1 ASC 1,RR * .S DEF *+1 ASC 1,SS * .C DEF *+1 ASC 1,CC * .M DEF *+1 ASC 1,MM * .DASH DEF *+1 ASC 1,- * .BG DEF *+1 ASC 4, BG * .NONE DEF *+1 ASC 3, .RT DEF *+1 ASC 4, RT * B1777 OCT 1777 DM38 DEC -38 PTSIZ EQU STATS PTNAD EQU EQTPT PTN# EQU IDCNT LPTAD EQU IDPNT PAGE# EQU #EQTS UNS END WHAT •™ÿÿ ÿýqˆ ÿ92067-18008 1926 S C0122 &LGTAT RTE-IV LOG TAT TABLE             H0101 ‘OþúASMB,L * * DATE:790504 * NAME:LGTAT * SOURCE: 92067-18008 * RELOC: 92067-16008 * PGMR:RD * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LGTAT,3,99 92067-16008 REV.1926 790504 SUP ENT LGTAT EXT $CVT3,$LIBR,$LIBX,IFBRK EXT EXEC,$IDEX A EQU 0 B EQU 1 LGTAT XLA B,I INPUT PARAMETERS ARE STORED AWAY CLE,SZA,RSS SCHED WITH PARAMETER? CLA,CCE,INA DEFAULT TO LU 1 IOR M200 SET "V" BIT IN CONTROL WORD STA LU OUTPUT DEVICE INB XLA B,I GET OPTION STA LU+1 INB XLA B,I GET SPECIAL LU PARAMETER SZA,RSS IN CASE OF PREV RUN LDA LU SEZ DEFAULT NEEDED STA LU YES LDA FWA FIRST WORD ADDRESS OF TAT STA TAT * LDA D2 SET LU # TO 2 STA LUDSK CLA STA TRKCT CLEAR COUNTERS STA CTR STA CNTR STA TRCTR STA ITRCT STA CTRCT LDA TLG TAT LENGTH STA TATLG LDA SLG NUMBER OF TRACKS ON SYSTEM DISC STA TATSD ADA TATLG ADD NUMBER OF TRACKS ON SYSTEM DISC * TO TRACK LENGTH TO GET NUMBER OF TRACKS ON AUX. DISC CMA,INA MAKE RESULT POSITVE STA TATAD NUMBER OF TRACKS ON AUX. DISC LDA LU+1 CHECK FOR DESIRED OPTION SZA,RSS IF IT IS NOT ONE, DON'T PRINT TABLE JMP HIGH HEADING JSB EXEC EXEC CALL TO WRITE OUT TABLE HEADING DEF *+5 DEF D2 DEF LU DEF TBLHD STORAGE OF TAB ûþúLE HEADING DEF D23 JSB BAUD PRODUCE A BLANK LINE JSB EXEC EXEC CALL TO PRINT COLUMN #'S IN OUTPUT DEF *+5 DEF D2 DEF LU DEF TBL STORAGE CONTAINING COLUMN NUMBERS DEF D39 * * THE FOLLOWING CODE IS USED TO KEEP TRACK OF * THE NUMBER OF FREE TRACKS WHILE FINDING THE * THE LARGEST CONTIGUOUS BLOCK OF TRACKS * HIGH XLA TAT,I A REG HAS FWA OF TAT SZA IF TAT ENTRY =0 THEN INCREMENT BOTH CTRS JMP LABL TAT ENTRY IS NOT 0 CHECK COUNTER TO GET * LARGEST CONTIGUOUS BLOCK * ISZ ITRCT INCREMENT TOTAL AVAILABLE TRACK COUNTER ISZ CTRCT INCREMEMT CONTIGUOUS TRACK COUNTER JMP LBL1 GO ON WITH TRACK IDENTIFICATION * * SEE IF CURRENT MAX > OLD MAX # FREE TRACKS * LABL LDB CTRCT TRACK ENTRY MUST HAVE BEEN ZERO CMB,INB MAKE CONTIGUOUS TRACK CTR. NEGATIVE ADB TRCTR ADD TO TEMPORARY CONTIG. TRACK COUNTER SSB,RSS SKIP IF RESULT IS NEG. I.E. TEMPORARY * COUNT IS OF GREATER VALUE JMP LBL OLD TRACK COUNT IS OF GREATER VALUE * LDB CTRCT IN GOES NEW * REPLACE TEMP. TRACK COUNTER WITH STB TRCTR THE NEW CONTIGUOUS TRACK VALUE LBL CLB RESET CURRENT MAX CONTIG TRACK # STB CTRCT * * THIS CODE DETERMINES WHAT TO OUTPUT WHEN LGTAT * IS RUNNING AS A PROGRAM. THE CHOICES BEING THE * TRACK STATEMENTS OR STATEMENTS AND TABLE. * LBL1 LDB LU+1 SZB,RSS JMP THERE JUST CHECK FOR ALL FREE AND CONTIG, TRACKS JMP GOON IDENTIFY ALL TRACKS AND OUTPUT TABLE THERE ISZ TATLG CHECK TO SEE IF FINISHED WITH CHECK JMP ARND NO,CONTINUE WITH CHECKS JMP WRONG YES,PRINT OUT TRACK STATEMENTS ARND ISZ TAT INCREMENT TAT ADDRESS JMP HIGH GET ANOTHER TAT ENTRY * * "NO." DETERMINES HOW MANY WORDS ARE PASSED TO THE BUFFER. * I.E. Tu¯þúHREE OR FOUR WORDS ARE STORED IN THE TABLE USED FOR * OUTPUT. THIS ALLOWS THE PASSING OF "SYSTEM" OR " SYSTEM " * TO THE OUTPUT TABLE KEEPING THE COLUMNS STRAIGHT AND THE * ENTRIES ALIGNED PROPERLY. * GOON LDB TRKCT CHECK FOR EVEN OR ODD SLA JMP ODD LDB ADFOR LOAD ADDRESS OF FOUR STB NO. JMP CONT ODD LDB ADFOR LOAD ADDRESS OF THREE STB NO. * * THIS CODE IDENTIFYS THE SYSTEM TRACKS IN THE * TAT. FURTHERMORE IT BREAKS THEM DOWN INTO THE * COMPONENTS OF LG, START OF THE LS AREA, LIBRARY, * ENTRY POINTS, MEMORY IMAGE PROGRAMS AND SWAPPED * PROGRAM TRACKS. * CONT CPA SYS CHECK TAT ENTRY FOR SYSTEM TRACKS JMP LG CHECK FOR LG TRACKS JMP FP NOT SYSTEM TRACKS, CHECK FOR FMP TRACKS LG LDA LGOTK GET DISC POINTER FOR LG AREA JSB FDISK CALL SUBROUTINE TO GET DISC INFORMATION LDA INPTR OBTAINED THE NUMBER OF TRACKS USED FOR AND M177 LG AREA ADA JTRAK ADD # OF TRACKS TO STARTING TRACK TO ADA SUB1 GET LAST TRACK OF LG AREA. * SUBTRACT ONE (TRACK COUNT STARTS AT ZERO) STA LGEND LAST TRACK OF LG AREA LDB LUD DETERMINE IF IT IS THE RIGHT LU CPB LUDSK JMP STR IT IS TH RIGHT LU JMP LS IT IS THE WRONG LU STR LDA JTRAK SEE IF TRACK ENTRY IS A LG TRACK CMA,INA THIS IS DONE BY CHECKING THE TRACK ADA TRKCT COUNTER AGAINST THE LOWER SSA AND HIGHER BOUNDS OF THE POSSIBLE JMP LS LG TRACKS----NOT AN LG TRACK LDA TRKCT CHECK TRACK COUNTER AGAINST CMA,INA THE HIGHER BOUND ADA LGEND SSA JMP LS NOT LG TRACK CHECK START OF LS AREA JMP PRTLG PRINT OUT LG TRACKS * * FIND THE START OF THE LS TRACKS * LS LDA SFCUN CHECK FOR START OF LS TRACKS JSB FDISK FIND TRACK ADDRESS AND LU # SZA IF TRACK ENTRY IS 0 TH9´þúEN UNDEFINED JMP RDJ LS TRACKS ARE NOT UNDEFINED LDA ADUND IN OUTPUT PRINT UNDEFINED FOR LDB ADLST START OF LS TRACKS. MVW D15 JMP LEN RDJ JSB HERE PASS TRACK ADDRESS TO CONVERSION * ROUTINE. PUT ASCII FORMAT IN STATEMENT * ALSO CONVERT LU ON WHICH THE TRACK ADDRESS * IS ON, THEN PLACE IN STATEMENT. INA LDB A,I STB LST+15 LOCATION OF LS STATEMENT INA LDB A,I STB LST+16 * * CONVERT NUMBERS FROM BINARY TO ASCII * JSB $LIBX DEF *+1 DEF *+1 LDA LUD JSB HERE INA LDB A,I STB LST+21 LOCATION OF LS STATEMENT INA LDB A,I STB LST+22 JSB $LIBX DEF *+1 DEF *+1 * * CHECK FOR ENTRY POINTS * LEN LDA DSCLB DISC ADDRESS OF LIBRARY ENTRY PTS. JSB FDISK PASS DISC PTR., TO FDISK STA ENTST GET STARTING TRACK LDB LUD CHECK FOR PROPER LU CPB LUDSK JMP HUH JMP FOO IT IS THE WRONG LU HUH LDA DSCLN CALCULATE LAST TRACK OF ENTRY POINTS ADA DSSUP ADD # OF SYS. TO USER ENTRY PTS. MPY D4 FIRST DETERMINE THE # OF SECTORS USED CLB BY MULT. BY 4 (4 WORDS PER ENTRY) DIV D64 THEN DIVIDING BY 64 (64 WORDS SECTOR) STA TEMP LDA DSCLB GET STARTING SECTOR AND M177 ADA SUB1 COMPENSATE FOR STARTING AT ZERO ADA TEMP ADD IN # OF SECTORS USED FOR STORAGE CLB DIV NSPTK DIVIDE BY # OF SECTORS/TRACK ADA ENTST ADD TO TRACK ADDRESS STA ENTND SUM IS LAST TRACK CONTAING ENTS. LDA ENTST CHECK AGAINST THE LOWER BOUND CMA,INA ADA TRKCT SSA JMP FOO LDA TRKCT CHECK THE HIGHER BOUND CMA,INA ADA ENTND SSA JMP FOO NOT ENTRY TRACKS JMP PRTEN IT IS ENTRY k”þúTRACK(S) * * CHECK FOR LIBRARY ROUTINES * FOO LDA LUDSK LIBRARY MUST BE ON SYSTEM DISC CPA D2 JMP TOP IT IS SYSTEM DISC JMP HARD IT'S NOT SYS. DISC, GO ON TOP LDA DSCUT DISC ADDRESS OF RTE LIBRARY JSB FDISK GET DISC INFORMATION CMA,INA CHECK TRACK BOUNDS ADA TRKCT SSA JMP HARD NOT LIBRARY TRACK LDA TRKCT CHECK FOR UPPER BOUND CMA,INA ADA ENTST LIBRY TRACKS START BEFORE ENTRY PTS. SSA JMP HARD NOT A LIBRARY TRACK JMP PRTLB PRINT OUT LIBRARY TRACKS HARD JSB PRGTR CHECK FOR MEM. IMAGE OR SWAPPED PROGRAM JMP PRTSY TRACKS ARE NONE OF THE ABOVE * DEFAULT IS SYSTEM TRACKS * CHECK FOR FMP TRACKS * FP CPA FMP JMP PRTFP JMP TO PRINT FMP * * CHECK FOR GLOBAL TRACKS CPA GLBL CHECK FOR GLOBAL TRACKS JMP PRGBL JUMP TO PRINT GLOBAL * * CHECK FOR PROGRAMS OWNING TRACKS * ON A SUCCESSFUL FIND OF PROGRAMS OWNING * A TRACK, THAT PROGRAM NAME IS OBTAINED * FROM THE ID SEGMENT MAP WHOSE ADDRESS * IS LOCATED IN THE TAT. * ALSO, THIS CODE IS USED TO GET NAMES * OF PROGRAMS THAT HAVE SWAPPED TRACKS * AND THAT ARE MEMORY IMAGE SOURCE PROGRAMS. * SZA,RSS IF TAT ENTRY IS 0, GO ON TO FREE TRACKS JMP FEE LDB B40 PLACE A BLANK IN TYPE STB TYPE ABOVE LDB TRKCT IF CTR IS ODD DO THE FOLLOWING CODE SLB,RSS THIS CODE PUTS A BLANK CHAR. JMP BELOW IN FRONT OF THE PROGRAM NAME. LDB ADNAM ADDRESS AS TO WHERE TO STORE THE PROG STB TEMPY NAME ADA D12 GET FIRST TWO CHARACTERS OF PROG NAME STA TEMP XLB A,I SHIFT UPPER BYTE TO LOWER BYTE POSITION BLF,BLF LDA B STA WORD AND M177 PUT A BLANK IN THE UPPER BYTE IOR B2000 STA TEMPY,I STORE BLANK AND FIRST CHAR, IN BUFFER ISZ TEMP GET THIRD AND FOUR¤‡þúTH CHAR. XLB TEMP,I BLF,BLF SHIFT UPPER BYTE TO LOWER BYTE POSITION STB WORD1 GET SECOND CHAR. IN UPPER BYTE POSITION LDA WORD AND B1774 STA WORD LDA B AND M177 GET 3RD CHAR. IN LOWER BYTE POSITION IOR WORD PUT 2ND AND 3RD CHAR. TOGETHER ISZ TEMPY STA TEMPY,I * LDA WORD1 GET 3RD AND 4TH CHAR. AND B1774 GET UPPER BYTE POSITION STA WORD1 ISZ TEMP XLB TEMP,I BLF,BLF GET 5TH CHAR. LDA B AND SHIFT TO LOWER BYTE POSITION AND M177 IOR WORD1 ISZ TEMPY STORE IN TEMPORARY IN LOCATION STA TEMPY,I * ISZ TEMPY PUT BLANKS IN LAST TWO CHARS. LDA B2000 POSITION IOR TYPE ALF,ALF STA TEMPY,I LDA ADNAM JMP BAD TRANSFER NAME TO OUTPUT BUFFER * BELOW LDB ADNAM THE FOLLOWING CODE DOES THE SAME STB TEMPY AS THE ABOVE BUT IT DOES NOT * PUT A BLANK IN FRONT OF THE PROG. NAME ADA D12 STORE PROGRAM NAME IN TEMPORARY HOLDING XLB A,I A REG HAS ADDRESS OF ID SEGMENT INDEX STB TEMPY,I IT BY 12 TO GET THE FIRST TWO CHAR. INA ISZ TEMPY XLB A,I STB TEMPY,I INA ISZ TEMPY XLB A,I LDA B AND B1774 AND IN A BLANK CHARACTER IOR TYPE STA TEMPY,I PRPRG LDA ADNAM LOAD ADDRESS OF PROGRAM NAME JMP BAD TRANSFER NAME TO OUTPUT BUFFER * FEE JMP PRTFR MUST BE A FREE TRACK * PRTSY LDA TRKCT GET READY TO PRINT SYSTEM SLA SKIP IF ODD JMP LAB LDA ADSYE LOAD A REG WITH ADD. OF SYSTEM(EVEN) JMP BAD LAB LDA ADSYO LOAD A REG WITH ADDRESS OF SYS(ODD) JMP BAD PRTFP LDA TRKCT GET READY TO PRINT FMP SLA JMP LB LDA ADFME FMP (EVEN) JMP BAD LB LDA ADFMO FMP (ODD) JMP BAD PRGBL LD þúA TRKCT GET READY TO PRINT GLOBAL SLA JMP LBLA LDA ADGBE JMP BAD LBLA LDA ADGBO JMP BAD PRTLG LDA TRKCT GET READY TO PRINT LG TRACKS SLA JMP LEFT LDA ADLGE JMP BAD LEFT LDA ADLGO JMP BAD PRTFR LDA TRKCT GET READY TO PRINT -- TO INDICATE FREE SLA JMP LBA LDA ADAVE JMP BAD LBA LDA ADAVO JMP BAD PRTEN LDA TRKCT GET READY TO PRINT ENTS SLA JMP DO LDA ADENE JMP BAD DO LDA ADENO JMP BAD PRTLB LDA TRKCT GET READY TO PRINT LIBRY SLA JMP OH LDA ADLBE JMP BAD OH LDA ADLBO JMP BAD * * "CTR" INDEXES THE POINTER TO THE APPROPRIATE POSITION * IN THE OUTPUT BUFFER. POINTER IS INCREMENTED ALTERNATELY * BY THREE OR FOUR. * BAD LDB TRKCT LOAD TRACK CTR. SLB,RSS SKIP IF ODD JMP ME GO TO ODD LDB CTR MAKE COUNTER THREE ADB D3 STB CTR JMP BALL ME LDB CTR MAKE COUNTER FOUR ADB D4 STB CTR BALL LDB ADTAB LOAD ADDRESS OF TABLE AND ADB CTR INDEX IT BY COUNTER MVW NO.,I PUT ENTRY IN TABLE, A REG. HAS ADDR. LDA CTR SEE IF FINISHED WITH LINE CPA D35 BY COMPARING WITH 35 JMP DOWN YES, PRINT OUT TABLE (ONE LINE) LDB TRKCT COMPARE CTR. WITH LENTGH OF SYS DISC INB CPB TATSD JMP .DWN PRINT LAST TRACKS ON SYSTEM DISC JMP LOW CHECK FOR TABLE COMPLETION * * PRINT OUT TABLE WITH TRACK IDENTIFIERS * .DWN LDA CTR STA TEMP LDB TRKCT SLB,RSS JMP BE LDB TEMP ADB D4 STB TEMP JMP TALL BE LDB TEMP ADB D3 STB TEMP TALL LDA ABLK LDB ADTAB ADB TEMP MVW ONE DOWN LDA CNTR CNTR IS AN INDEX OF TEN USED IN THE OUTPUT JSB HERE JMP TO CONVERSION ROUTINE LDB A,I O¦þú RETURN HERE FROM THE CONVERSION ROUTINE INA THREE WORDS OF TABLE LDB A,I STB TABLE INA LDB A,I STB TABLE+1 JSB $LIBX END PRIVILEGE STATUS DEF *+1 DEF *+1 * * PRINT OUT TABLE WITH TRACK IDENTIFIERS * JSB EXEC EXEC CALL TO WRITE OUT TABLE DEF *+5 DEF D2 DEF LU DEF TABLE BUFFER FOR TABLE OUTPUT DEF D39 LENGTH OF OUTPUT * * CHECK FOR BREAK FLAG IF SET THEN EXIT FROM PROGRAM * OTHERWISE CONTINUE ON. * JSB IFBRK DEF *+1 SZA JMP NOW EXIT FROM PROGRAM * BLANK OUT TABLE * LDA ADBLK LOAD ADDRESS OF BLANKS INTO A REG LDB ADTAB MVW D39 CLA CLEAR COUNTER STA CTR LDA CNTR ADA D10 STA CNTR LOW ISZ TATLG INCREMENT TATLG (NEGATIVE #) JMP TWO JMP KAYO * TWO LDB LUDSK DETERMINE SUBCHANNEL CPB D3 JMP .AUX NO NEED TO CHECK COMPLETION OF SYS DISC LDB TRKCT INCREMENT TRACK COUNTER INB CHECK FOR COMPLETION OF CPB TATSD SYSTEM DISC JMP SOON PRINT OUT AUX DISC HEADING .AUX ISZ TRKCT INCREMENT TABLE COUNTER ISZ TAT INCREMENT I.E. DECREMENT TABLE LENGTH JMP HIGH * * PRINT OUT AUX DISC HEADING * SOON JSB BAUD PRODUCE A BLANK LINE JSB BAUD JSB EXEC EXEC CALL TO WRITE OUT AUX DISC HEADING DEF *+5 DEF D2 DEF LU DEF AUXDS DEF D7 JSB BAUD LDA D3 SET LU # TO THREE. STA LUDSK LDA TATAD STA TATSD REPLACE SYS. COUNT WITH AUX. COUNT CLA STA TRKCT RESTART COUNTER FOR TABLE ENTRIES. STA CNTR RESTART INDEX COUNTER STA CTRCT RESET TEMP CONTIGUOUS TRACK COUNTER ISZ TAT INCREMENT TAT POINTER JMP HIGH CHECK ANOTHER ENTRY * * PRINT OUT WITH TABLE THE START OF THE LS@þú TRACKS * KAYO JSB EXEC LAST LINE MAY BE PARTIALLY FILLED DEF *+5 DEF D2 DEF LU DEF TABLE DEF D39 JSB BAUD PRODUCE A BLANK LINE JSB EXEC PRINT TRACK STATEMENT DEF *+5 DEF D2 DEF LU DEF LST DEF D24 * * THE FOLLOWING PREPARES AND OUTPUTS THE TRACK * STATEMENTS BY CONVERSION FROM BINARY TO ASCII * THROUGH THE "HERE" SUBROUTINE * WRONG LDA ITRCT COUNT OF TOTAL FREE TRACKS JSB HERE JUMP TO BINARY TO ASCII SUBROUTINE. LDB A,I STB PRTAT+12 INA LDB A,I STB PRTAT+13 INA LDB A,I STB PRTAT+14 JSB $LIBX COMPLETE EXEC CALL TO SYSTEM DEF *+1 DEF *+1 * JSB EXEC EXEC CALL TO PRINT TRACK STATEMENT DEF *+5 DEF D2 DEF LU DEF PRTAT BUFFER LOCATION DEF D15 * LDA TRCTR CONTIGUOUS TRACK COUNTER JSB HERE LDB A,I STB CTAT+16 STORE CONTIGUOUS TRACK COUNT IN LAST 3 INA WORDS OF CONTIGUOUS TRACK STAEMENT LDB A,I STB CTAT+17 INA LDB A,I STB CTAT+18 JSB $LIBX COMPLETE EXEC CALL TO SYSTEM DEF *+1 DEF *+1 * JSB EXEC DEF *+5 DEF D2 DEF LU DEF CTAT DEF D19 * JMP NOW * * FINDS THE SYSTEM OR AUXILIARY DISC WHERE THE * DISC POINTER (IN PACKED FORMAT) POINTS TO, * AS WELL AS THE TRACK. IF THE DISC POINTER IS * LESS THAN 0 THEN THE LU IS 3. ON RETURN * NSPTK =# SECTORS PER TRACK ON THE DISC * LUD = LOGICAL UNIT (DISC LU 2 OR 3) * JTRAK =TRACK ADDRESS * FDISK NOP STA INPTR STORE DISC POINTER AWAY LDB D2 STB LUD SSA,RSS IF THE DISC POINTER IS <0 THEN LU=3 JMP TOO LDB D3 STB LUD TOO ADB M1755 GET NUMBER OF SECTORS PER TRACK LDA B,I STA NSPTK * *FIND THE STARTING TRACK ADDRESS * LDA Y-þúINPTR AND B776C GET BITS 14 - 7 OF DISC POINTER CLB I.E. THE TRACK ADDRESS DIV D128 STA JTRAK JMP FDISK,I * * THIS SUBROUTINE DETERMINES IF THE TRACK ENTRY INDICATED BY * SYSTEM IN THE TAT, IS THE SWAPPED PROGRAM TRACK OR THE TRACK CONTAINING * MEMORY IMAGE VERSION OF A PROGRAM. THIS IDENTIFICATION IS * ACCOMPLISHED THROUGH THE SEARCH OF THE KEYWORD TABLE. * WHEN THE TAT POINTER IS EQUAL TO THE TRACK POINTER FOUND * IN A PROGRAM'S ID SEGMENT MAP, A TRACK IS IDENTIFIED. * PRGTR NOP LDA FWAK FWA OF KEYWORD BLOCK STA KEYWD TEN XLA KEYWD,I GET FWA OF KEYWORD TABLE SZA,RSS IF KEYWORD ENTRY IS 0 THEN FINISHED JMP PRGTR,I WITH CHECK,RETURN FROM SUBROUTINE ADA D14 GET NAME PORTION CONTAINING THE TYPE AND STA IDADR SHORT SEGMENT (SS) BIT XLA IDADR,I STA NAM3 CLB STB SHTID 0 IN SHTID INDICATES LONG ID SEGMENT AND M20 CHECK THE SS BIT (BIT 4) TO SEE IF IT SZA,RSS IS A LONG ID OR SHORT ID SEGMENT JMP LNGID IT IS A LONG ID SEGMENT LDB SUB1 ID SEGMENT IS OF SHORT FORM STB SHTID INDICATE IT BY -1 IN SHTID LNGID LDA NAM3 MAKE SURE IT'S A DISC RESIDENT PROGRAM AND M22 OR SHORT ID FOR SEGMENTS SZA JMP FROG LDA NAM3 CHECK FOR TYPE FOUR PROGRAMS AND M4 SZA,RSS JMP KEY FROG LDA M46 OCTAL 46 =& STA TYPE SET FLAG FOR MEMORY IMAGE PROG. TRACKS SSB,RSS PICK UP MEMORY ADDRESSES JMP FIVE ISZ IDADR CALCULATE # OF SECTORS USED FOR STORAGE XLA IDADR,I OBTAIN LOW AND HIGH MAIN ADDRESSES STA LWMAN ALSO, LOW AND HIGH BASE PAGE WORDS ISZ IDADR XLA IDADR,I AND THE DISC ADDRESS OF A PROGRAM STA MNHGH IN A SHORT ID SEGMENT ISZ IDADR XLA IDADR,I STA LOWBP ISZ IDADR XLA IDADR,I STA HGHBP –½þúISZ IDADR XLA IDADR,I STA KTRAK JMP SIX * * LONG ID SEGMENT * FIVE LDA IDADR GET MEMORY ADDRESSES OF THE PROG. ADA D8 FROM THE LONG ID SEG. STA IDADR ALSO GET THE DISC ADDRESS OF XLA IDADR,I THE PROGRAM STA LWMAN ISZ IDADR XLA IDADR,I STA MNHGH ISZ IDADR XLA IDADR,I STA LOWBP ISZ IDADR XLA IDADR,I STA HGHBP ISZ IDADR XLA IDADR,I STA KTRAK * * CALCULATE THE NUMBER OF SECTORS REQUIRED FOR * PROGRAM STORAGE. * SIX SZA,RSS IF DISC PTR. =0 THEN GET JMP KEY ANOTHER KEYWORD ENTRY LDA LWMAN CMA,INA MAKE NEGATIVE ADA MNHGH ADA D127 CLB DIV D128 CLE,ELA MULTIPLY BY TWO STA TEMP LDA LOWBP CMA,INA ADA HGHBP ADA D127 CLB DIV D128 CLE,ELA ADA TEMP STA NSCTS * * CHECK FOR PROGRAMS OWNING TRACKS * LDA KTRAK DISC PTR. PASSED AS PARAMETER JSB FDISK TO FDISK LDB LUD DETERMINES IF ON CORRECT LU CPB LUDSK JMP ONCE IT IS THE CORRECT LU JMP ING IT IS THE WRONG LU. ONCE CLB CALCULATE THE LAST TRACK LDA NSCTS ADA NSPTK TO ROUND UP RESULT ADA SUB1 DIV NSPTK ADA JTRAK SUM IS THE LAST TRACK ADA SUB1 STA LSTRK LDB TRKCT SEE IF LAST TRACK OF PROGRAM SOURCE CMB,INB IS GREATER THEN COUNTER OF TAT ADB LSTRK SSB JMP ING * * IF LSTRK >= TRKCT THEN GO CHECK * THE OTHER BOUND * LDB JTRAK CMB,INB ADB TRKCT SSB SKIP IF TRKCT IS LESS THAN START OF * SOURCE TRACKS JMP ING CHECK FOR SWAPPED TRACKS JMP IN SUCCESS IN FINDING SOURC TRACKS ING LDA SHTID CHECK FOR SHORT ID SEGMEÖKþúNT SZA IF SHORT SEG, SWAP TRACK CAN'T JMP KEY APPEAR. GET ANOTHER SEGMENT ISZ IDADR XLA IDADR,I STA KTRAK SZA,RSS IF WORD ID 0 THEN NO SWAP TRACKS JMP KEY JSB FDISK CLB STORAGE FOR # OF EMA TRACKS ISZ IDADR POINTER TO ID EXT XLA IDADR,I ID AND EMA SIZE-WORD 28 OF ID SEG. SZA,RSS IF IT'S ZERO,DON'T WORRY ABOUT EMA TRACKS JMP NOEMA AND B176C GET ID EXT OFFSET OUT OF UPPER 6 BITS ALF,RAL RAL PUT UPPER 6 BITS IN LOWER POSITION ADA $IDEX ADDRESS OF ID EXTENSION TABLE ADA SUB1 ADD IN OFFSET-ADDRESS OF ID EXT LDA A GET ADDRESS OF ID EXT. * ADA TWO COMPENSATE FOR STARTING AT ZERO * AND POINT TO WORD 2 OF ID EXT. LDA A GET # OF TRACKS FOR EMA SWAP AND M1777 LOWER 9 BITS CONTAIN INFO. STA B NOEMA LDA KTRAK COMPUTE LAST POSSIBLE SWAP TRACKS AND M177 ADA JTRAK ADA SUB1 ADA B ADD IN # OF EMA SWAP TRACKS. STA LSTRK LDB LUD CHECK FOR CORRECT LOGICAL UNIT CPB LUDSK JMP ZERO JMP KEY ZERO LDB M136 INDENTIFIER FOR SWAP TRACKS STB TYPE LDA TRKCT CMA,INA A REG CONTAINS LSTRK * * CHECK FOR UPPER BOUNDS OF POSSIBLE SWAPPED TRACKS * ADA LSTRK SSA POINTER FOR SUCCESS JMP KEY NO SUCCESS TRY TO GET ANOTHER ID SEGMENT LDB JTRAK CHECK TO SEE IF TRACK ENTRY COUNTER IS CMB,INB EQUAL TO OR GREATER THAN TRACK # ADB TRKCT OF SWAPPED TRACKS SSB JMP KEY * IN XLA KEYWD,I GET POINTER OF ID SEGMENT JMP ABOVE GET PROGRAM NAME FROM ID SEG. * NOTE: TYPE SYMBOL IS APPENDED TO PROG. NAME * KEY ISZ KEYWD GET ANOTHER KEYWORD ENTRY JMP TEN * SUBROUTINE THAT CONVERTS FROM BINARY TO ASCII. * øÜþú HERE NOP JSB $LIBR NOP CCE JSB $CVT3 JMP HERE,I * * WILL PRINT OUT ONE BLANK LINE WHEN CALLED * BAUD NOP JSB EXEC DEF *+5 DEF D2 DEF LU DEF BLNK DEF ONE JMP BAUD,I * * EXEC CALL TO TERMINATE PROGRAM * NOW JSB EXEC DEF *+7 DEF CODE DEF ZORO DEF SUB1 SERIAL REUSABLE DEF ZORO DEF LU+1 SAVE OPTION DEF LU * * ZORO DEC 0 INUMB DEC -1 SERIAL REUSEABLE BLNK ASC 1, USED TO PRODUCE A BLANK LINE ABLK DEF BLNK LU BSS 2 STORAGE FOR PARAMETERS TAT BSS 1 ADDRESS OF TRACK ASSIGN. TABLE TATLG BSS 1 LENGTH OF TAT (NEG. #) TATSD BSS 1 LENGTH OF SYSTEM DISC TATAD BSS 1 LENGTH OF AUX. DISC CNTR BSS 1 INDEX USED IN OUTPUT. CODE DEC 6 FWA EQU 1656B FWA OF TRACK ASSIGN. TABLE TLG EQU 1755B TABLE LENGTH SLG EQU 1756B SYSTEM DISC LENGTH TRCTR BSS 1 CONTIGUOUS TRACK COUNTER CTRCT BSS 1 TEMPORARY CONTIGUOUS TRACK COUNTER ITRCT BSS 1 FREE TRACK COUNTER PRTAT ASC 15,TOTAL AVAILABLE TRACKS = CTAT ASC 19,LARGEST CONTIGUOUS TRACK BLOCK = D10 DEC 10 D2 DEC 2 D3 DEC 3 D15 DEC 15 D19 DEC 19 D22 DEC 22 D24 DEC 24 D23 DEC 23 D35 DEC 35 D36 DEC 36 D39 DEC 39 NO. BSS 1 NUMBER OF WORDS MOVED INTO BUFFER TRKCT BSS 1 TAT ENTRY COUNTER AUXDS ASC 7,AUXILIARY DISC D7 DEC 7 TABLE ASC 20, ASC 19, TBL ASC 17,TRACK 0 1 2 3 ASC 22, 4 5 6 7 8 9 TBLHD ASC 23,TRACK ASSIGNMENT TABLE & =PROG ^ =SWAP ADTAB DEF TABLE CTR BSS 1 POINTER IN BUFFER SYS OCT 100000 REPRESENTATION OF SYS IN TAT FMP OCT 077776 REPRESENTATION OF FMP IN TAT FREE OCT 0 " " OF FREE IN TAT M200 OCT 200 AVALE ASC 3, -- AVALO ASC 4, -- SYSE ASC 3,SYSTEM SYSO ASC 4, SYSTEM FMGRO ASC áâþú4, FMP FMGRE ASC 3, FMP D4 DEC 4 ADFOR DEF D4 ADTHR DEF D3 ADSYE DEF SYSE ADSYO DEF SYSO ADFME DEF FMGRE GBE ASC 3,GLOBAL GBO ASC 4, GLOBAL ADFMO DEF FMGRO ADAVE DEF AVALE ADAVO DEF AVALO ADBLK DEF BLNKS BLNKS ASC 20, ASC 19, ONE DEC 1 GLBL OCT 077777 REPRESENTATION OF GLOBAL IN TAT ADGBE DEF GBE ADGBO DEF GBO SUB1 DEC -1 LGOTK EQU 1765B DISC POINTER TO LG TRACKS M177 OCT 177 M1777 OCT 1777 LGE ASC 3, LG LGO ASC 4, LG ADLGE DEF LGE ADLGO DEF LGO INPTR BSS 1 DISC POINTER JTRAK BSS 1 STARTING TRACK ADDRESS LGEND BSS 1 LAST TRACK OF LG AREA LUD BSS 1 LOGICAL UNIT CONTAINED IN DISC PTR LUDSK BSS 1 CURRENT LOGICAL UNIT NSPTK BSS 1 NUMBER OF SECTORS PER TRACK ENTST BSS 1 STARTING TRACK OF ENTRY PTS. ENTND BSS 1 LAST TRACK OF ENTRY PTS. D64 DEC 64 TEMP BSS 1 TEMPORARY STORAGE ENTE ASC 3, ENTS ENTO ASC 4, ENTS ADENE DEF ENTE ADENO DEF ENTO DSCLB EQU 1761B DISC ADDRESS OF LIB. ENTRY PTS. LIBE ASC 3,LIBRY LIBO ASC 4, LIBRY ADLBE DEF LIBE ADLBO DEF LIBO DSCUT EQU 1763B DISC ADDRESS OF RTE LIB PTS. DSCLN EQU 1762B # OF USER LIB. ENTRY PTS. DSSUP EQU 1764B # OF SYS. LIB. ENTRY PTS. B776C OCT 77600 B176C OCT 17600 SUB10 DEC -10 SFCUN EQU 1767B LS TRACK POINTER NAME ASC 4, ADNAM DEF NAME TEMPY BSS 1 TEMPORARY STORAGE LST ASC 24,THE LS TRACK(S) START AT TRACK OF LU UNDEF ASC 15,ARE UNDEFINED ADLST DEF LST+8 ADUND DEF UNDEF M1755 OCT 1755 B40 OCT 40 B1774 OCT 177400 D12 DEC 12 D14 DEC 14 D8 DEC 8 KEYWD BSS 1 ADDRESS OF KEYWORD BLOCK FWAK EQU 1657B FWA OF KEYWORD TABLE IDADR BSS 1 ID SEGMENT ADDRESS NAM3 BSS 1 LOWER PORTION OF ID SEGMENT NAME SHTID BSS 1 INDICATES LONG OR SHRT ID SEG. M20 OCT 20 M136 OCT 136 M26 OCT 26 M46 OCT 46 TYPE BSS 1 BLANK, &, OR ^ LWMAN BSS 1 LOWMAIN ADDRESS MNHGH BSS 1 YáZXT HIGH MAIN ADDRESS LOWBP BSS 1 LOW BASE PAGE ADDRESS HGHBP BSS 1 HIGH BASE PAGE ADDRESS KTRAK BSS 1 DISC PTR. OR SWAPPED DISC ADDRESS NSCTS BSS 1 NUMBER OF SECTORS USED ON THE DISC M22 OCT 22 D127 DEC 127 D128 DEC 128 M4 OCT 4 LSTRK BSS 1 LAST TRACK WORD BSS 1 WORD1 BSS 1 B2004 OCT 20040 B2000 OCT 20000 END LGTAT ‡ùZÿÿ ÿýr† ÿ92067-18009 1926 S C2822 &4GN01 RT4GN             H0128 ßÅþúASMB,R,L,C,N HED RT4GN ---- MAIN FOR ON-LINE GENERATOR NAM RT4GN,3,90 92067-16009 REV.1926 790427 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************************ * * NAME: RT4GN * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, RB, GAA * ************************************************************* SPC 2 * * * DEFINE ENTRY POINTS. * * OPERATOR INPUT SUBROUTINES: * ENT \PRMT PRINT COMMAND AND ACCEPT INPUT. ENT \READ \READ INPUT. ENT \RNME SPECIAL ENTRY TO READ SUBR. ENT \YENO ANALYZE YES/NO RESPONSE. ENT \DCON ANALYZE INPUT FOR OCTAL VALUE. ENT \GETC SUPPLY CHAR FOR GETNA & GETOC. ENT \GETN MOVE LBUF TO TBUF. ENT \GET# LBUF CHAR FROM ASCII TO OCTAL. ENT \GINT INITIALIZE LBUF SCAN. * * DIAGNOSTIC SUBROUTINES: * ENT \GNER PRINT DIAGNOSTIC. ENT \INER CALL ERROR AND CONTINUE. ENT \IRER CALL ERROR AND ABORT. ENT \ABOR \ABOR THE GENERATION. * * DISC FILE I/O SUBROUTINES: * ENT \CRET CREATE A FILE. ENT \CLOS CLOSE A FILE. ENT \TRUN CLOSE RTGEN OUTPUT FILE. ENT \CFIL CHECK FOR FILE ERRORS. ENT \MESS WRITE ON INTERACTIVE DEVICE. ENT \SPAC OUTPUT BLANK LINE. ENT \RNAM FIND A NAM RECORD IN A FILE. ENT \RBIN READ RELOCATABLE FILE. ENT \TERM PURGE ALL FILES ON ABORT. ENT \EXIT FINAL FILE CLEANR§þúUP * * CORE-IMAGE OUTPUT FILE SUBROUTINES. * ENT \DSKA INCR. DISC ADDRESS. ENT \DSKI INPUT CONTROL. ENT \DSKO OUTPUT CONTROL. ENT \DSKD I/O SUBROUTINE. * * DCB'S: * ENT \RDCB RELOCATABLE FILE DCB. ENT \NDCB NEW-NAM FILE DCB. ENT \BDCB BOOT DCB * * LST, IDENT, FIX-UP SUBS AND POINTERS. * ENT \ILST,\LSTS,\LSTX,\LSTE ENT \TLST,\PLST ENT \LST1,\LST2,\LST3,\LST4,\LST5 * ENT \INID,\IDXS,\IDX ENT \TIDN,\PIDN ENT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 ENT \ID12,\ID13,\ID14,\ID15,\ID16 * ENT \IFIX,\FIX,\PFIX,\TFIX ENT \FIX1,\FIX2,\FIX3,\FIX4 * ENT \LNKX,\LNK,\LNKS ENT \LNK1,\LNK2,\LNK3 * * LINKAGES FOR SEGMENT SUBR CALLS TO ANOTHER SEGMENT. * ENT \LODN LOADS A PROGRAM ENT \DPLD LOADS A DRIVER EXT \NLOD (RT4G4) * ENT \GNIO BUILDS I-O TABLES EXT \IOTB (RT4G5) * EXT \GENS BUILDS THE SYSTEM (RT4G3) * EXT \TB31 BUILDS $TB31 (RT4G1) EXT \TB32 BUILDS $TB32 (RT4G7) * ENT \FSEC CLEAN-UP BOOT EXTENSION AND HEADER RECORDS EXT \FSC0 (RT4G1) EXT \FSC5 (RT4G7) * ENT \SYTB BUILDS SYSTEM TABLES EXT \TBLS (RT4G5) * ENT \CLDP LOADS DRIVER PARTITIONS ENT \DDON EXT \\LDP (RT4G8) * ENT \PART PARTITION DEFINITION EXT \PDEF (RT4G6) * * POINTERS FOR CURRENT PAGE LINKAGE IMAGE AREA. * ENT \TBLK,\CPLM ENT \LRBP,\URBP,\IRBP ENT \CUBP,\UCBP,\ICBP,\CBPA * * MISCELLANEOUS SUBROUTINES: * ENT \CONV ENT \ABDO,\USER,\USRS,\SEGS,\SYS,\DSYS * * MISCELLANEOUS VARIABLES: * ENT \NAMN,\NAMB,\NAMO ENT \TRCM,\IACM,\TRCH ENT \SRET ENT \FMRR ENT \DPR2 ENT \BPAR ENT \OCTN ENäÍþúT \BUFL ENT \TCHR ENT \ADSK,\PREL,\NUMP ENT \ADBF ENT \MRT2 ENT \PTYP ENT \TMSK ENT \RNT,\PRV ENT \TBCH,\PIOC,\SWPF ENT \LBUF,\TBUF ENT \CURL,\CPL2 ENT \CMFL ENT \ABCO,\MXAB ENT \OLDA ENT \ADBP,\NABP ENT \OBUF ENT \TIME,\TIM1,\MULR ENT \CPLB,\ASKY,\SSID,\SKYA * SKP * * DEFINE EXTERNALS * EXT \PIP,LURQ,RMPAR,IFBRK EXT WRITF,EXEC,CLOSE EXT LOCF,APOSN EXT CREAT,OPEN,READF,CNUMD EXT .ENTR EXT COR.A,\DST0,\BOT0 EXT GETST EXT \DST5,\BOT5 * SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SPC 3 LST#T DEC 2 # LST TRACKS. IDT#T DEC 3 # IDENT TRACKS. FIX#T DEC 1 # FIX-UP TRACKS. SECWD DEC 128 # WORDS PER SECTOR. SKP * IDENT FORMAT * * WORD 1: \ID1 - NAME 1,2 * WORD 2: \ID2 - NAME 3,4 * WORD 3: \ID3 - (15-8) NAME 5 * (7-3) NOT USED * (2-0) USAGE FLAG * (2) MODULE WAS LOADED * (1) MUST LOAD MODULE (EXT DEFINED BY IT) * (0) MODULE WAS LOADED AS PART OF A SEGMENT * WORD 4: \ID4 - (15) MAIN PROGRAM * (14-0) COMMON LENGTH * WORD 5: \ID5 - (15) BASE/CURRENT PAGE LINKING FLAG * (14) NEW NAM RECORD FLAG * (13-4) EMA SIZE * (3-0) MAP OPTIONS * (2) LINKS * (1) MODULES * (0) GLOBALS * WORD 6: \ID6 - (15) EMA DECLARED * (14-10) MSEG SIZE * (9-7) NOT USED * (6-0) PROGRAM TYPE * (4) SSGA DECLARED * (3) REVERSE COMMON DECLARED * WORD 7: \ID7 - LOWEST DBL ADDRESS * WORD 8: \ID8 - DISK LENGTH FOR UTILITY REt«þúLOCATABLES * OR MAIN IDENT INDEX FOR SEGMENTS * OR (15-8) PROGRAM PAGE REQMTS * (7-0) KEYWORD INDEX * OR (15) EQT DEFINED * (14) SDA DECLARED * (13) SDA/OWN MAPPING DECLARED * (13-0) DRIVER LENGTH * WORD 9: \ID9 - FILE NAME 1,2 * WORD 10: \ID10 - FILE NAME 3,4 * WORD 11: \ID11 - FILE NAME 5,6 * WORD 12: \ID12 - SECURITY CODE * WORD 13: \ID13 - CARTRIDGE LABEL * WORD 14: \ID14 - RECORD NUMBER * WORD 15: \ID15 - RELATIVE BLOCK * WORD 16: \ID16 - BLOCK OFFSET * SKP * * LST FORMAT * * WORD 1: \LST1 - NAME 1,2 * WORD 2: \LST2 - NAME 3,4 * WORD 3: \LST3 - NAME 5, ORDINAL * WORD 4: \LST4 - IDENT INDEX OR 2 IF COMMON * 3 IF ABSOLUTE * 4 IF REPLACE * 5 IF UNDEFINED * 6 IF EMA * WORD 5: \LST5 - SYMBOL VALUE, OR IDENT INDEX IF EMA * * * * FIXUP TABLE FORMAT * * \FIX1: CORE ADDRESS * \FIX2: (15-11) INSTRUCTION CODE * (10) BYTE INSTR * (9) UPPER BP LINK * (2-0) DBL RECORD TYPE * \FIX3: OFFSET * \FIX4: INDEX OF LST ENTRY REFERENCED, * OR 0 IF A LOCAL SYMBOL * OR -1 IF .ZRNT * * * * * PROGRAM TYPES * * 0: SYSTEM * 1: MEMORY RESIDENT * 2: RT DISK RESIDENT * 3: BG DISK RESIDENT * 4: ENLARGED BG DISK RESIDENT * 5: BG SEGMENT * 6: LIBRARY/UTILITY * 7: UTILITY * 8: UTILITY LOAD ONLY TO SATISFY EXTERNAL REFERENCES. * 9: MEMORY RESIDENT USING BACKGROUND COMMON. * 10: RT DISC RESIDENT USING BACKGROUND COMMON. * 11: BG DISC RESIDENT USING FORGROUND COMMON. * 12: ENLARGED BG DISC RESIDENT USING REALTIME COMMON * 13: TABLE AREA II * 14: TYPE 6 LIBRARY/UTILITY THAT IS TO BE FOURCE LOADED TO THE LIBRARY. * 15: TABLE AREA I * 30: SUBSYSTEM GLOBAL MODULE * 17,18,19,20,25,26,27,28: TYPES 1,2É{þú,3,4,9,10,11,12 (RESP) W/SSGA ACCESS * 21-24,29,31-99:UNUSED (TYPE + 80 IS USED TO * DESIGNATE AUTO SCHEDULE AT STARTUP, BUT MAY * ONLY BE ENTERED IN PARM PHASE. +80 IS JUST * A FLAG TO PARM PHASE, NOT STORED IN ID-SEG.) SKP * * ERROR CODES * * 0/ HARDWARE/GENERATOR ERROR (SEND IN BUG REPORT) * 1: INVALID REPLY TO INITIALIZATION PARAMETERS * 2: INSUFFICIENT AMOUNT OF AVAILABLE MEMORY FOR TABLES * 3: RECORD OUT OF SEQUENCE * 4: INVALID RECORD TYPE * 5: DUPLICATE ENTRY POINTS * 6: COMMAND ERROR - PROGRAM INPUT PHASE * 7: LST,IDENT,FIXUP TABLE OVERFLOW * 8: DUPLICATE PROGRAM NAMES * 9: PARAMETER NAME ERROR * * 10: PARAMETER TYPE ERROR * 11: PARAMETER PRIORITY ERROR * 12: PARAMETER EXECUTION INTERVAL ERROR * 13: BG SEGMENT PRECEDES BG DISC RESIDENT * 14: CHECKSUM ERROR * 15: ILLEGAL CALL BY A TYPE 6 OR 14 PROGRAM TO A TYPE 7 * 16: BP LINKAGE AREA OVERFLOW * 17: TYPE 1 OUTPUT FILE OVERFLOW (ESTIMATE WAS NOT LARGE ENOUGH) * 18: MEMORY OVERFLOW * 19: TR STACK UNDERFLOW/OVERFLOW * * 20: INVALID COMMAND INPUT LU * 21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE * 22: LIST FILE ERROR * 23: INVALID S OR M OPERANDS * 24: INVALID SELECT CODE IN EQT ENTRY * 25: INVALID DRIVER NAME IN EQT ENTRY * 26: INVALID D,B,U,T,X,S,M OPERANDS IN EQT ENTRY * 27: INVALID DEVICE REFERENCE NO. * 28: INVALID INTERRUPT SELECT CODE * 29: INVALID INTERRUPT SELECT CODE ORDER * * 30: INVALID INT ENTRY MNEMONIC * 31: INVALID EQT NO. IN INT ENTRY * 32: INVALID PROGRAM NAME IN INT ENTRY * 33: INVALID ENTRY POINT IN INT ENTRY * 34: INVALID ABSOLUTE VALUE IN INT ENTRY * 35: MORE THAN 63 EQT OR 255 DRT ENTRIES DEFINED * 36: INVALID TERMINATING OPERAND IN INT ENTRY * 37: INVALID COMMON LENGTH IN SYS, LIB, OR SSGA MODULE..... * 38: ID-SEGMENT OF SEGMENT 3 NOT FOUND * 39: NOT USED * * 40: INVALID EMA PROGRAM TYPE * 41: MULTIPLE EMA DECLARATIONS * 42: INVALID REFERENCE TO EMA SYMBOL Ö·þú* 43: INVALID MSEG SIZE * 44: SAM EXCEEDS 32K LOGICAL ADDRESS SPACE * 45: INVALID PARTITION SIZE * 46: INVALID PARTITION TYPE * 47: INVALID PARTITION RESERVATION * 48: INVALID OR UNKNOWN ASSIGNED PROGRAM NAME * 49: INVALID PARTITION NUMBER * * 50: PROGRAM TOO LARGE FOR PARTITION SPECIFIED * 51: INVALID PAGE OVERRIDE SIZE * 52: ILLEGAL REFERENCE TO SSGA ENTRY POINT * 53: SUM OF PARTITION SIZES DOESN'T EQUAL # PAGES LEFT * 54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN * 55: PAGE REQ'MTS OF EMA PROGRAM CAN'T BE OVERRIDDEN * 56: SUBPARTITION SIZE OR SUM OF SIZES > THAN MOTHER PART'N SIZE * 57: MISSING SYSTEM ENTRY POINT * 58: ILLEGAL REF TO TYPE 0 SYSTEM ENTRY POINT BY NON-TYPE 3 MODULE * 59: DRIVER PARTITION OVERFLOW * * 60: LONG ID SEGMENT LIMIT OF 254 EXCEEDED * 61: PHYSICAL MEMORY OVERFLOW * 62: INVALID INSTRUCTION REFERENCE TO AN EMA SYMBOL SKP DBP EQU * FWA DUMMY BASE PAGE. * ************************************************ * * * THE NEXT 1K IS OVERLAID FOR DUMMY BASE PAGE * * WHEN RT4G3 BEGINS EXECUTION. * * * ************************************************ SPC 5 START NOP STB PARS5 JSB RMPAR DEF *+2 DEF PARS5 * * * SET UP COMMAND LU OR FILE, AND THE ERRLU * LDA PARS5 GET PARAMETER 1 SZA,RSS IF NOT SPECIFIED, THEN ISZ PARS5 DEFAULT TO LU 1 FOR INPUT AND B1774 MASK FOR TYPE SZA,RSS NUMERIC? JMP NOPRM YES, GO SET UP CMDLU * JSB GETST RETRIEVE PARAMETERS DEF *+4 DLBUF DEF \LBUF DEF P48 DEF \FMRR * RBL CONVERT TO CHARACTERS LDA DLBUF GET INPTU BUFFER ADDRESS JSB \PARS GO PARSE THE PARAMETER STRING DEF PARS2 INTO THE PARSE BUFFER AT WORD 2 JMP STRT2 * NOPRM LDB PARS5 SET UP THE COMMA\þúND LU STB PRS21 CLA,INA STA PARS2 PARAMETER TYPE 1 * STRT2 LDA RWSUB GET POTENTIAL R/W SUBFUCTION STA PARS5 SAVE FOR OPEN CALL * JSB STATE SET THE STATE FLAGS \IACM & CMDLU JMP INVLU INVALID INPUT LU SPECIFIED - GO RECOVER LDA CMDLU IF AN INTERACTIVE LU, SET THE LDB \IACM 1 MEANS INTERACTIVE SZB,RSS CLA,INA DEFAULT TO LU 1 STA ERRLU ERROR LU * JSB FOPEN GO OPEN FILE DEF *+3 DEF \IDCB DEF PARS5 LDA \FMRR SSA,RSS ANY ERRORS? JMP STRT3 NO CMA,INA SET POS. FOR CONVERT STA \FMRR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF \FMRR DEF FERMA ERROR MESSAGE ADDR LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 LDA DNAM MOVE THE FILE NAME LDB DFILE MVW P3 * JSB EXEC SEND ERROR TO OPERATOR LU DEF *+5 DEF P2 DEF ERRLU DEF FILEA+1 DEF P10 STRT4 CLB SET BACK TO LU 1 STB CMDLU STB \IACM INB STB ERRLU JMP NOPRM+1 START OVER * INVLU JSB EXEC INVALID INPUT LU SPECIFIED DEF *+5 ISSUE ERROR MESSAGE TO LU 1 (NOW DEF P2 DEFAULT ERRLU) DEF P1 DEF GNR20 DEF P5 JMP STRT4 SET UP THE INPUT LU * STRT3 CLA JSB PUSH GO PLACE ON STACK JSB \TERM ERROR RETURN - CAN'T HAPPEN! * LDA ERRLU WE'RE GOING TO OVERLAY 3 WORDS CMA,INA LDB DSTRT AT STRT3 - IN ORDER TO SETUP JSB \CONV THE ERROR COMMAND: LDA STRT3+2 "TR,ERRLU" STA TRCOM+2 STORE THE ASCII LU * LDA \CPLM NEGATE HIGH END OF CURRENT CMA,INA PAGE LINK LIMIT IMAGE STA \CPLM AREA SKP * ALLOCATE SPACE FOR FIX-UP,IDENT, AND LST TABLES: * * DETERMINE HOW MUCH CORE REMAINS BEYOND LONG>’þúEST * SEGMENT, DIVIDE INTO 3 BLOCKS FOR IN-CORE CHUNKS * OF TABLES, AND ALLOCATE DISC SPACE FOR TABLE STORAGE. * AVAILABLE CORE MUST BE AT LEAST 512 WORDS. * THE LST IS ALLOCATED LAST TO USE WASTED CORE FROM * FIXUP & IDENT BLOCKS. * LDA 1657B ADDR OF KEYWORD TABLE. STA TEMP1 TRY LDB TEMP1,I GET NEXT ID SEG ADDRESS SZB END OF TABLE IF ZERO JMP TRYY LDA ERR38 SEGMENT 3'S ID SEGMENT IS MISSING JMP NROOM+1 SEND ERROR & TERMINATE * TRYY ADB P12 GET TO NAME. LDA B,I GET FIRST TWO CHAR. * * DYNAMICALLY DETERMINE LONGEST SEGMENT * CPA AS.RT "RT4G3" = LONGEST SEGMENT. RSS MATCH. JMP NEXT INB LDA B,I GET SECOND TWO CHAR. CPA AS.GN RSS MATCH. JMP NEXT INB LDA B,I AND M7400 CPA AS.3 "3". JMP MATCH NEXT ISZ TEMP1 JMP TRY * MATCH LDA TEMP1,I GET ADDR OF IDSEG. JSB COR.A GET TO LWAM OF SEGMENT. INA GET FWAM. STA FWAM SAVE AS FIRST WORD AVAIL. MEM. CMA,INA GET SIZE OF UNDECLARED CORE. ADA LWAM LWAM SET BY RTE. STA NEXT LDA N512 MAKE SURE ENOUGH CORE. ADA NEXT AT LEAST 512 WORDS WORTH SSA JMP NROOM NO ROOM. BAIL OUT. LDA NEXT CLB DIV P4 ALLOCATE AVAILABLE MEMORY: STA TEMP1 1/4 TH FOR FIXUP TABLE, AND CMA,INA 3/8 TH'S EACH FOR IDENT AND LST ADA NEXT ARS DIVIDE BY 2 STA TEMP2 * * SET UP FIX-UP TABLE. * LDA TEMP1 CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB P6144 TO ONE TRACK STB A SETF0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA FX.#S SAVE # SECT PER FIX-UP BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH. STA LFIX 1þú OF DISC READS AND WRITES. CLB BLOCK MULTIPLE MUST END ON A TRACK LDA P6144 BOUNDARY AS WELL DIV LFIX SZB,RSS JMP SETF1 OK LDA LFIX ADA N128 DECREMENT SIZE BY ONE SECTOR JMP SETF0 SETF1 LDA LFIX CLB GET # 4 WORD ENTRIES IN DIV P4 THE BLOCK. STA EFIX SAVE # ENTRIES IN BLOCK. * LDA FWAM INITIALIZE FIX-UP POINTERS: STA BFIX FIRST ENTRY, CLA STA \PFIX # ENTRIES USED, STA \TFIX CURRENT ENTRY INDEX. STA B.F 1ST ENTRY NOW IN CORE. * * SET UP IDENT TABLE. THIS ONE HAS AN OFFSET OF +10. * LDA BFIX SET FWA IDENT AREA AT ADA LFIX STA BIDNT END OF FIX-UP AREA. LDA TEMP2 GET BLOCK CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB P6144 TO ONE TRACK STB A SETI0 CLB DIV SECWD SEE HOW MANY SECTORS FIT STA ID.#S MPY SECWD CONVERT TO WORDS FOR LENGTH STA LIDNT CLB BLOCK MULTIPLE MUST END ON LDA P6144 TRACK BOUNDARY AS WELL DIV LIDNT SZB,RSS JMP SETI1 OK LDA LIDNT DECREMENT BLOCK ADA N128 SIZE BY ONE SECTOR JMP SETI0 SETI1 LDA LIDNT CLB GET # 16 WORD ENTRIES IN DIV P16 THE BLOCK. STA EIDNT SAVE # ENTRIES IN BLOCK. * LDA P10 INITIALIZE IDENT POINTERS: STA \PIDN # ENTRIES USED +10, STA \TIDN CURRENT ENTRY INDEX, STA B.I 1ST ENTRY INDEX NOW IN CORE. * * SET UP LOADER SYMBOL TABLE (LST). * LDA BIDNT SET FWA LST AREA AT END ADA LIDNT STA BLST OF IDENT AREA. CMA,INA USE ALL OF REMAINING ADA LWAM AVAILABLE MEMORY. CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TîÕþúRACK) SZA LDB P6144 TO ONE TRACK STB A SETL0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA LS.#S SAVE # SECT PER LST BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH STA LLST OF DISC READS AND WRITES. CLB LDA P6144 BLOCK MULTIPLE DIV LLST MUST END ON TRACK SZB,RSS BOUNDARY AS WELL JMP SETL1 LDA LLST ADA N128 DECREMENT BY ONE SECTOR JMP SETL0 SETL1 LDA LLST CLB GET # 5 WORD ENTRIES IN DIV P5 THE BLOCK. STA ELST SAVE # ENTRIES. * CLA INITIALIZE LST POINTERS: STA \PLST # ENTRIES USED, STA \TLST CURRENT ENTRY INDEX, STA B.L 1ST ENTRY NOW IN CORE. SKP * * ALLOCATE DISC SPACE FOR FIX-UP, IDENT, LST. * LDA FIX#T GET # FIX-UP TRACKS, ADA IDT#T ADD # IDENT TRACKS, ADA LST#T ADD # LST TRACKS. IOR MSIGN SET NO SUSPEND BIT STA NEXT TOTAL # TRACKS TO ALLOCATE. * GETTR JSB EXEC DEF *+6 DEF P4 DEF NEXT # TRACKS REQUESTED. DEF FTRKA RETURNED: FIRST TRACK. DEF DSKLU RETURNED: WHICH DISC. DEF SECTK RETURNED: SECTORS/TRACK. * LDA FTRKA GET FIRST TRACK # SSA,RSS REQUEST GRANTED? JMP ALLOC YES JSB \SPAC JSB EXEC NO, TELL USER OF PROBLEM DEF *+5 DEF P2 DEF ERRLU DEF TRMSG DEF P14 "GENERATOR WAITING FOR TRACKS" * LDA NEXT TAKE OUT NO-SUSPEND BIT XOR MSIGN STA NEXT SUSPEND UNTIL TRACKS ARE AVAILABLE JMP GETTR * ALLOC LDA FX.#S GET # 128 WORD SECTORS. CLE,ELA MPY BY 2 (64 WORD SECTORS). CLB DIV SECTK FIND MULT. FACTOR PER WRITE. SZB,RSS IF A TRACK MULTIPLE LDB P96 THEN SET IT SO STB FX.#S # 64 WORD SECTORS PER BLOCK. * Vƒþú LDA ID.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB P96 STB ID.#S * LDA LS.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB P96 STB LS.#S * LDA FTRKA STA FX.BT FIX-UP START TRACK. STA FX.LT FIX-UP TRACK LAST READ. ADA FIX#T STA FX.ET FIX-UP LAST TRACK +1. STA ID.BT IDENT START TRACK. STA ID.LT IDENT TRACK LAST READ. ADA IDT#T STA ID.ET IDENT LAST TRACK +1. STA LS.BT LST START TRACK. STA LS.LT LST TRACK LAST READ. ADA LST#T STA LS.ET LST LAST TRACK +1. CLA STA FX.LS STA ID.LS STA LS.LS SKP * * GET NAME, SECUR, LABEL OF LIST FILE. * FNAME LDA P10 "LIST FILE?" LDB LSTFI JSB \RNME GET LIST FILE JSB \CRET GO CREATE THE FILE DEF *+5 DEF \LDCB DEF P64 DEF P3 DEF ZERO CLA JSB \CFIL CHECK FILE STATUS JMP FNAME ERROR ISZ LFERR 1=> ACKNOWLEDGE LIST FILE ERRORS * DLD PARS2 WAS NAME A FILE OR LU? CPA P1 RSS JMP FLNM0 FILE NAME, SO DEFAULT TO LSTLU=0 STB LSTLU SAVE THE LU - MAY NOT BE INTERACTIVE JSB EXEC DETERMINE THE DEVICE TYPE DEF *+6 DEF P13 DEF LSTLU DEF EQT5 DEF FNAME DEF ALLOC * CLB LDA FNAME IF BIT BUCKET WAS SPECIFIED, AND M77 DON'T MISTAKE IT FOR A TYPE SZA,RSS 00 DEVICE JMP SETIA * LDB LSTLU LDA EQT5 INTERACTIVE DEVICES ARE TYPE 0, OR ALF,ALF TYPE 5, SUBCHANNEL 0 AND M77 STA EQT5 CPA P7 IF A TYPE 7 DEVICE, THEN IT IS CLA AUTOMATICALLY INTERACTIVE CPA P5 LDA ALLOC GET TYPE 5 SUBCHANNEL AND M77 CLB SZA,RSS INB St™þúET INTERACTIVE SETIA STB IALST 0=NOT INTERACTIVE, 1=IT IS * SZB IF ITS INTERACTIVE JMP EC? THEN DON'T LOCK LULOC JSB LURQ DEF *+4 DEF IOPTN DEF LSTLU DEF P1 * SZA,RSS WAS IT SUCCESSFUL? JMP EC? YES JSB \SPAC JSB EXEC DEF *+5 DEF P2 DEF ERRLU DEF LUMSG DEF P17 "GENERATOR WAITING ON LIST LU LOCK" * LDA IOPTN SET THE WAIT BIT FOR NEXT CALL XOR MSIGN STA IOPTN JMP LULOC * * RE-OPEN THE LIST FILE WITH A NON-EXCLUSIVE OPEN SO IT CAN * BE EXAMINED CONCURRENT WITH GENERATION * FLNM0 JSB OPEN A CALL TO OPEN AN ALREADY DEF *+7 OPEN FILE WILL RESULT DLDCB DEF \LDCB IN IT BEING CLOSED AND DEF \FMRR RE-OPENED WITH THE OPTIONS DEF PARS2+1 DEF P1 DEF PARS3+1 DEF PARS4+1 LDA DLDCB GET DCB ADDRESS JSB \CFIL CHECK ERROR STATUS JMP FLNM0 * * ASK WHETHER ECHO IS DESIRED * AND OPEN IT IF SO * EC? LDA P5 LDB ECHOI JSB YE?NO JMP EC? INVALID REPLY STA ECHON 1 FOR YES, 0 FOR NO * CLA,INA SET UP FOR CREATION STA PARS2 OF DUMMY DCB IN TYP0 LDA ERRLU STA PARS2+1 LU ALREADY DETERMINED JSB FOPEN DEF *+3 DEF \EDCB DEF RWSUB * JSB \CFIL JSB \TERM RSS SKIP * * GET SIZE, NAME, SECUR, LABEL OF CORE-IMAGE RTE OUTPUT FILE. * JSB \INER INPUT ERROR EST# JSB \SPAC LDA P30 LDB FISIZ "EST. # TRACKS IN OUTPUT FILE?" JSB \READ LDA N3 JSB \DCON GET BINARY. JMP EST# ERROR. TRY AGAIN. STA NEXT ADA MIN15 CHECK FOR 15 TRACKS MIN. SSA JMP EST#-1 LDA NEXT MPY P48 GET # BLOCKS. SSA IF NEGATIVE THEN RETRY JMP EST#-1 STA NEXT * FLNAa·NLHM JSB \SPAC LDA P17 LDB OUTFI JSB \RNME "OUTPUT FILE NAME?" * LDA PARS2 CHECK FOR NUMERIC OR NULL ANSWER CMA,INA,SZA IF NULL(TYPE 0) INA,SZA,RSS OR NUMERIC(TYPE 1) RSS JMP FLNMC THEN ITS A LU JSB \INER JMP FLNAM * FLNMC JSB \CRET GO CREATE THE OUTPUT FILE DEF *+5 DEF ABDCB DEF NEXT # BLOCKS. DEF P1 TYPE 1 FILE. DEF ZERO CLA JSB \CFIL CHECK FILE ERROR JMP FLNAM RETRY...ERROR * * GET SYSTEM DISK TYPE * JSB \SPAC RSS JSB \INER INPUT ERROR TO "SYSTEM DISK?" STRT0 LDA P12 TO GET THE INITIAL SEGMENT LDB MES00 DEPENDS ON THE DISK TYPE JSB \READ MES00: "SYSTEM DISK?" LDA N4 JSB \DCON CONVERT 4 DEC DIGITS JMP STRT0 ERROR - TRY AGAIN CLB,INB CPA P7900 CHECK FOR A CLB 7900 CPA P7905 OR A 7905 CCB CPA P7906 OR A 7906 CCB CPA P7920 OR A 7920 CCB STB DTYPE 0=7900, -1=7905,7906,7920 SSB JMP STRT5 SZB IF NOT 7900 JMP STRT0-1 THEN ERROR rNÿÿþú* JSB SWAP SWAP IN SEGMENT 1 FOR 7900 DEC 1 DISK DEPENDENT SUBROUTINES JMP .NM * STRT5 JSB SWAP SWAP IN SEGMENT 7 FOR 7905 DEC 7 DISK DEPENDENT SUBROUTINES * * CREATE TEMPORARY FILE FOR MODIFIED NAM RECORDS. * .NM JSB CREAT CREATE @.NM.@ FILE NAME. DEF *+6 DNDCB DEF \NDCB DEF \FMRR DEF \.NM. DEF P64 DEF P5 * LDA \FMRR DUPLICATE NAME? CPA N2 RSS YES JMP .NMCH CHECK FOR OTHER ERRORS * ISZ NAMM BUMP TO NEXT SYMBOL JMP .NM AND TRY TO CREATE IT * .NMCH LDA DNDCB GET DCB ADDRESS AND CHECK FOR ANY JSB \CFIL OTHER ERRORS JSB \TERM YES, SO ABORT SKP * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * * TBG SELECT CODE? ENTER 2 OCTAL DIGITS * * PRIV. INT. SELECT CODE? ENTER 2 OCTAL DIGITS * * MEM.RES. ACCESS TABLE AREA II? ENTER YES OR NO * * RT MEMORY LOCK? ENTER YES OR NO * * BG MEMORY LOCK? ENTER YES OR NO * * SWAP DELAY? ENTER <= 3 DECIMAL DIGITS * * MEM SIZE? ENTER <= 4 DECIMAL DIGITS * * JSB \SPAC GET A NEW LDA \ADBP GET ADDRSS OF DUMMY BASE PAGE CMA,INA MAKE NEG STA \NABP SAVE * LDB D$REN ENTER .ZRNT IN THE LST JSB \LSTE LDA RSS SET IT UP AS STA \LST5,I A REPLACE WITH RSS LDA P4 STA \LST4,I ENT CLA STA \RNT INDEX IS 0 * LDB D$PRV DO SAME FOR .ZPRV JSB \LSTE LDA P4 STA \LST4,I LDA RSS STA \LST5,I CLA,INA STA \PRV SET FLAG FOR LOAD PHASE * LDB D$CLS ENTER $CLAS INTO JSB \LSTE THE SYMBOLâ!þú TABLE LDB D$LUS NOW ENTER $LUSW JSB \LSTE LDB D$RNT AND $RNTB JSB \LSTE LDB $LUAV AND $LUAV JSB \LSTE * LDB DTYPE SET UP THE DISC SPECIFICATIONS. SSB JMP SPEC5 JSB \DST0 7900 RSS RSS * SPEC5 JSB \DST5 7905 * * SET TIME BASE GENERATOR CHANNEL * JSB \SPAC NEW LINE CHNLT LDA P16 LDB MES30 MES30 = ADDR: TBG SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA \TBCH SET TBG CHANNEL NO. CLE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP CHNLT TRY AGAI N * * GET PRIV. INT. CARD ADDR. * JSB \SPAC NEW LINE DUMY LDA P23 LDB MES41 MES41 = ADDR: PRIV. INT. SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS JMP DUMY -ERROR, REPEAT INPUT. STA \PIOC SET ADDRESS OF DUMMY CARD CCE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP DUMY LDA P3 SET BOTH RT AND STA \SWPF BG SWAP FLAGS ALWAYS. SPC 1 JSB \SPAC MAPC? LDA P31 ASK: MEM. RES. ACCESS TABLE AREA II? LDB MSMP. JSB YE?NO JMP MAPC? ASK AGAIN IF BAD ANSWER STA \MRT2 SAVE 1 IF YES, 0 IF NO LDA "RT" NOW ASK JSB LOCK? 'RT MEMORY LOCK?' RAL,RAL ROTATE TO PROPER BIT POSITION IOR \SWPF COMBINE STA \SWPF AND SAVE * LDA "BG" NOW DO SAME FOR BACKGROUND JSB LOCK? ALF,RAR IOR \SWPF COMBINE STA \SWPF SAVE THE WORD. * SWPDL JSB \SPAC LDA P11 GET THE LDB MES33 SWAP DELAY JSB \READ LDA N3 CONVERT JSB \DCON Í%þú TO BINARY FROM DECIMAL JMP SWPDL ERROR TRY AGAIN * AND M7400 IF > 256 SZA,RSS THEN JMP SWPOK * JSB \INER BITCH AND JMP SWPDL TRY AGAIN * SWPOK LDA \OCTN COMBINE ALF,ALF WITH SWAP IOR \SWPF FLAG STA \SWPF AND SAVE * JSB \SPAC SKIP A LINE MEMSZ LDA P9 THEN ASK USER LDB MESS3 FOR NUMBER OF PAGES JSB \READ OF MAIN MEMORY LDA N4 GET 4 DECIMAL JSB \DCON DIGITS OR TRY AGAIN JMP MEMSZ IF ERROR STA \NUMP * ADA N48 CHECK FOR THE 48-PAGE MINIMUM SSA,RSS JMP BOUT OK BDSZ JSB \INER FLAG ERROR JMP MEMSZ AND ASK AGAIN * BOUT ADA N977 NOW CHECK FOR 1024 PAGE MAX SSA,RSS JMP BDSZ TOO BIG, ISSUE ERROR & RETRY LDB DTYPE FINISH THE DISC SET UP. SSB JMP SET05 JSB \BOT0 7900 BOOT RSS * SET05 JSB \BOT5 7905 BOOT * JMP SEGCN * N48 DEC -48 N977 DEC -977 SKP * * CHECK FOR VALID SELECT CODE RESPONSE TO TBG OR PI QUERY * * ON ENTRY: E-REG = 0 IF 0 RESPONSE NOT ALLOWED, IE, FOR TBG * ON ENTRY: E-REG = 1 IF 0 RESPONSE ALLOWED FOR PI QUERY * TBPI? NOP SZA,RSS ZERO RESPONSE? JMP TBG? YES, CHECK FOR VALIDITY * ADA N8 MUST BE >= 10 OCTAL SSA JMP TBRR NOPE * TBXT ISZ TBPI? JMP TBPI?,I * TBG? SEZ TBG OR PI? JMP TBXT PI IS OKAY TBRR JSB \INER SORRY! JMP TBPI?,I SPC 3 * * NOT ENOUGH CORE BEYOND LONGEST SEGMENT * FOR LST, IDENT, FIXUP TABLES. * NROOM LDA ERR02 JSB \GNER JSB \TERM * ERR02 ASC 1,02 ERR38 ASC 1,38 SEGMENT 3'S ID-SEGMENT MISSING SKP * * OVERLAID CONSTANTS. * FWAM NOP CALCULATED AT RUNTIME LWAM EQU 1777B END OF CORE * N4 DEC -4 MIN15 DEC ˜%þú-15 N128 DEC -128 N512 DEC -512 P1 DEC 1 P9 DEC 9 P11 DEC 11 P16 DEC 16 P23 DEC 23 P17 DEC 17 P30 DEC 30 P48 DEC 48 P96 DEC 96 P6144 DEC 6144 #WORDS PER TRACK P7900 DEC 7900 P7905 DEC 7905 P7906 DEC 7906 P7920 DEC 7920 B1774 OCT 177400 MSIGN OCT 100000 IOPTN OCT 1 FTRKA NOP RWSUB OCT 400 "RT" ASC 1,RT "BG" ASC 1,BG AS.RT ASC 1,RT AS.GN ASC 1,4G AS.3 OCT 31400 LONGEST SEG = RT4G3. TEMP1 NOP TEMP2 NOP DSTRT DEF STRT3 * D$REN DEF *+1 ASC 3,.ZRNT D$PRV DEF *+1 ASC 3,.ZPRV D$CLS DEF *+1 ASC 3,$CLAS D$LUS DEF *+1 ASC 3,$LUSW D$RNT DEF *+1 ASC 3,$RNTB $LUAV DEF *+1 ASC 3,$LUAV * TRMSG ASC 14,GENERATOR WAITING FOR TRACKS LUMSG ASC 17,GENERATOR WAITING ON LIST LU LOCK MES00 DEF *+1 ASC 6,SYSTEM DISC? LSTFI DEF *+1 ASC 5,LIST FILE? OUTFI DEF *+1 ASC 9,OUTPUT FILE NAME? ECHOI DEF *+1 ASC 3,ECHO? FISIZ DEF *+1 ASC 15,EST. # TRACKS IN OUTPUT FILE? MES30 DEF *+1 ASC 8,TBG SELECT CODE? MES41 DEF *+1 ASC 12,PRIV. INT. SELECT CODE? MES32 DEF *+1 ASC 8,RT MEMORY LOCK? MES33 DEF *+1 ASC 6,SWAP DELAY? MESS3 DEF *+1 ASC 5,MEM SIZE? MSMP. DEF *+1 ASC 16,MEM. RES. ACCESS TABLE AREA II? * P31 DEC 31 GNR20 ASC 5,GEN ERR 20 HED RTGEN SUBROUTINES. SPC 5 * * * LOCK? ASKS AND ANALIZES THE 'XX MEMORY LOCK?' QUESTION. * * CALLING SEQUENCE: * * LDA "RT" OR "BG" * JSB LOCK? * RETURN A=1 IF YES, 0 IF NO. * * LOCK? NOP STA MES32,I SET THE 'FG' OF 'BG' IN MESSAGE JSB \SPAC MAKE IT LOOK NEAT. LOCK1 LDA P15 GET THE LENGTH LDB MES32 GET MESSAGE ADDRESS JSB YE?NO GO ASK AND GET ANSWER JMP LOCK1 ERROR SO RETRY * JMP LOCK?,I RETURN P15 DEC 15 SKP * YE?NO ROUTINE SENDS A QUESTION TO THE TTY * AND READS AND ANALIZES THE RESPONSE * * CALLING ;þúSEQUENCE: * * LDA MESSAGE CHARACTER COUNT * LDB MESSAGE ADDRESS * JSB YE?NO * JMP ERROR * NORMAL RETURN A=1 FOR YES, 0 FOR NO. * YE?NO NOP JSB \READ GO PRINT MESSAGE AND GET ANSWER JSB \YENO ANALIZE THE ANSWER JMP YE?NO,I ERROR EXIT * CLA,RSS NO RETURN CLA,INA YES RETURN ISZ YE?NO STEP RETURN ADDRESS JMP YE?NO,I RETURN TO CALLER. SPC 5 * BSS 1650B+DBP-* BUF64 IS A TEMPORARY BUFFER USED BY \CFIL BUF64 BSS 2000B+DBP-* RESERVE 1K FOR DUMMY BASE PAGE. * SPC 5 *********************************************** * * * END OF AREA OVERLAID FOR DUMMY BASE PAGE. * * * *********************************************** SKP * DBPO EQU DBP \ADBP DEF DBPO ADDR OF DUMMY BASE PAGE \NABP NOP NEG OF RT4GN START * * CURRENT PAGE LINKAGE IMAGE AREA. * \TBLK BSS 3 \LRBP BSS 1 AREA 1: CR SYSTEM BP \URBP BSS 1 \IRBP BSS 1 \CUBP BSS 1 AREA 2: CURRENT PROG BP. \UCBP BSS 1 \ICBP BSS 1 * BSS 600 CURRENT PAGE LINKAGE IMAGE AREA. * \CPLM DEF * END OF CP LINK AREA. \CBPA DEF \CUBP ADDR OF CURRENT BP SPECS. SPC 2 \TIME BSS 1 \TIM1 BSS 1 \MULR BSS 1 * \RNT BSS 1 INDEX OF \RENT ENTRY \PRV BSS 1 INDEX OF \PRIV ENTRY * \CURL NOP CURRENT \LBUF ADDRESS. \CPL2 NOP ADDR OF HIGH CURRENT PAGE LINK SPECS. * \PREL NOP CURRENT PROGRAM RELOC ADDRESS \NUMP NOP MEM SIZE(PAGES) \TBCH NOP TIME BASE GENERATOR CHANNEL \PIOC NOP ADDR OF PRIVILEGED I/0 CARD \SWPF NOP SWAPPING FLAG = 0/1 = NO/YES DTYPE NOP TARGET DISK = 0/-1 = 7900/7905 \LBUF BSS 64 LOAD BUFFER \TBUF BSS 4 TEMP BUFFER SKP SEGCN JSB SWAP DO PROG INPUT PHASE. P2 DEC 2 ROLL IN RT4G2 Ôðþú JSB \PIP GO TO SEGMENT. * JSB SWAP GO GENERATE RTE! P3 DEC 3 JMP \GENS SPC 3 ******************************************************************************** * * CONTROL ROUTINES FOR INTER-SEGMENT CALLS: * ***************************************************************************** SPC 3 * * BUILD SYSTEM TABLES * \SYTB NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G5 DEC 5 * JSB \TBLS BUILD THE TABLES * JSB SWAP BRING BBACK RT4G3 DEC 3 JMP \SYTB,I SPC 3 * * LOAD A PROGRAM * \LODN NOP IN-CORE RT4G3 ISSUED CALL. JSB SWAP ROLL IN RT4G4. P4 DEC 4 * JSB \NLOD CALL LOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \LODN,I RETURN. SPC 3 * * BUILD I/O TABLES * \GNIO NOP IN-CORE RT4G3 ISSUED CALL. * * BUILD TRACK MAP TABLE FIRST ($TB31/$TB32) * LDB DTYPE DETERMINE DISC TYPE SSB JMP D05 * JSB SWAP ROLL IN RT4G1 FOR 7900 DISC DEC 1 JSB \TB31 CALL ROUTINE TO BUILD TMT JMP GET5 * D05 JSB SWAP ROLL IN RT4G7 FOR 7905/7920 DISCS DEC 7 JSB \TB32 CALL ROUTINE TO BUILD TMT * GET5 JSB SWAP ROLL IN RT4G5. P5 DEC 5 * JSB \IOTB BUILD THE TABLES IN RT4G5 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \GNIO,I RETURN. SPC 3 * * RELOCATE DRIVER PARTITIONS * \CLDP NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G8 P8 DEC 8 * JMP \\LDP CONTROL DP RELOCATION * \DDON JSB SWAP BRING BACK RT4G3 DEC 3 JMP \CLDP,I SPC 3 * * RELOCATE A PARTITION-RESIDENT DRIVER * \DPLD NOP IN-CORE RT4G8 ISSUED CALL JSB SWAP ROLL IN RT4G4 DEC 4 * JSB \NLOD CALL LíþúOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G8 DEC 8 JMP \DPLD,I SPC 3 * * PERFORM PARTITION DEFINITION * \PART NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G6 DEC 6 * JSB \PDEF DO PARTITION DEFINITION * JSB SWAP BRING BACK RT4G3 DEC 3 JMP \PART,I SPC 3 * * CLEAN-UP BOOT EXTENSION AND HEADER RECORDS * \FSEC NOP IN-CORE RT4G3 ISSUED CALL. LDB DTYPE DETERMINE DISK TYPE SSB JMP F05 * JSB SWAP ROLL IN RT4G1 (7900) DEC 1 JSB \FSC0 CALL "\FSC0" IN RT4G1. JMP BK3 * F05 JSB SWAP ROLL IN RT4G7 (7905,7920) DEC 7 JSB \FSC5 CALL "\FSEC" IN RT4G7 * BK3 JSB SWAP BRING BACK RT4G3. DEC 3 JMP \FSEC,I RETURN. SKP * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # * A AND B REG SAVED * SWAP NOP DST ABREG SAVE REGISTERS. CCA ADA SWAP,I GET SEG NUMBER. MPY P3 ADA RTGMA STA SWAPA JSB EXEC ROLL IN SEGMENT DEF *+3 - IT WILL COME BACK TO \SRET DEF P8 AFTER EXECUTING FRONT END CODE. SWAPA NOP \SRET ISZ SWAP GET RETURN ADDRESS DLD ABREG RESTORE REGISTERS. JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 * * * THE FOLLOWING ORDER MUST NOT BE CHANGED * RTGMA DEF *+1 ASC 3,RT4G1 7900 DISC SUBR. SEGMENT ASC 3,RT4G2 PARAMETER INPUT PHASE SEGMENT ASC 3,RT4G3 LOADING CONTROL SEGMENT ASC 3,RT4G4 LOADER SEGMENT ASC 3,RT4G5 I/O TABLE GENERATION SEGMENT ASC 3,RT4G6 PARTITION DEFINITION SEGMENT ASC 3,RT4G7 7905 DISC SUBR. SEGMENT ASC 3,RT4G8 DRIVER PART. LOADING CONTROL SEGMENT SKP * CONVERT A TO ASCII AT B * * THE \CONV SUBROUTINE CO|àþúNVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CONV NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR UBLNK ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CONV,I YES - RETURN * OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 P10 DEC 10 DEC 1 * N2 DEC -2 TCNT NOP SKP * * GET DIGIT FOR \CONV * * GETD PROVIDES THE ASCII CHARACTERS FOR \CONV. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I [þú ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR M60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * M60 OCT 60 RANAD NOP SKP * * SET UP LNK AREA * * \LNK, \LNKS, AND \LNKX MANAGE THE LINK AREA. * * THIS AREA IS COMPOSED OF TRIPLETS AND LINK AREA * IMAGES AS FOLLOWS: * * WORD1 THE ACTUAL CORE ADDRESS OF THE LINK AREA * WORD2 THE ACTUAL CORE ADDRESS OF THE LAST WORD+1 OF THE AREA * WORD3 THE ADDRESS OF THE LOADRS IMAGE OF THE AREA * * THE FIRST TWO ENTRIES ARE FOR BASE PAGE AS FOLLOWS: * * AREA 1 THE CORE RESIDENT SYSTEM BASE PAGE AREA * AREA 2 THE CURRENT PROGRAMS BASE PAGE AREA * * FOR THESE AREA THE IMAGE IS IN THE DUMMY BASE PAGE * FOR ALL OTHER ENTRIES (I.E. FOR CURRENT PAGE LINK AREAS) * THE IMAGE FOLLOWS THE THREE WORD DEFINITION OF THE AREA. * * IN ALL CASES THE LAST DEFINED AREA IS THE ONE THAT HAS A * WORD1 ADDRESS OF \CPL2, WHICH IS USUALLY THE HIGH * CURRENT PAGE LINK AREA FOR THE CURRENT PROGRAM * * \LNKX INITILIZES THE SCANNING OF THE LINKAGE AREA * \LNK SETS UP \LNK1, \LNK2, \LNK3 FOR THE NEXT ENTRY * P+1 RETURN INDICATING THERE IS NO NEXT ONE. * P+2 INDICATING THAT THE SET UP WAS DONE. * * \LNKS SETS UP \LNK1, \LNK2, \LNK3 GIVEN THAT THE FIRST WORD ADDRESS * IS KNOWN (AND PASSED IN THE A REGISTER) * \LNKX NOP LDA TLNK GET INITIAL ADDRESS STA \LNK1 SET IN \LNK1 JMP \LNKX,I RETURN SPC 3 \LNK NOP LDA \LNK1 GET CURRENT ADDRESS CPA \CPL2 IF LAST ENTRY JMP \LNK,I RETURN, END OF LST * LDA A,I GET THE ACTUAL ADDRESS AND M0760 IS<ÜþúOLATE THE PAGE ADDRESS SZA,RSS IF BASE PAGE DO THE BP THING JMP LNKB * LDA \LNK1,I ELSE CACULATE THE ADDRESS OF CMA,INA THE NEXT ADA \LNK2,I ENTRY ADA \LNK3,I BY SKIPPING OVER THE IMAGE LNKA JSB \LNKS SET UP THE NEW AREA ISZ \LNK SET OK RETURN ADDRESS JMP \LNK,I RETURN * LNKB LDA \LNK1 FOR BASE PAGE ADA P3 USE NEXT THREE JMP LNKA WORD AREA. SPC 3 \LNKS NOP STA \LNK1 SET THE LINK POINTERS UP INA STA \LNK2 INA STA \LNK3 JMP \LNKS,I AND RETURN SPC 3 \LNK1 NOP \LNK2 NOP \LNK3 NOP TLNK DEF \TBLK M0760 OCT 076000 SKP * * NUMERICAL INPUT CONTROL * * THE \DCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., DISK SIZES, TBG CHANNEL NO. AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB \DCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * \DCON NOP JSB \GET# GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB \GETC GET NEXT CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB \INER INVALID DIGIT ENTRY JMP \DCON,I RETURN ISZ \DCON INCR RETURN ADDRESS LDA \OCTN GET CONVERTED NUMBER JMP \DCON,I RETURN SKP * * GET CHAR FROM \LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * \GETN ANDÚ¸þú \GET#. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GETC * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * \GETC NOP LDA \CMFL \CMFL = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB \BUFL GET U/L FLAG IGNOR LDA \CURL,I GET CHAR FROM \LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA STAR IF STAR CLA TREAT AS END OF LINE SZA,RSS END OF BUFFER? JMP \GETC,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ \CURL INCR \LBUF ADDRESS STB \BUFL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS * CPA COMMA CHAR = COMMA? ISZ \CMFL RESET FLAG TO SHOW COMMA IN (SKIPS) JMP \GETC,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP \GETC,I RETURN WITH BLANK * COMMA OCT 54 STAR OCT 52 BLANK OCT 40 \BUFL NOP BUFFER U/L FLAG. \CMFL NOP COMMA FLAG= -1/0= NOT IN/IN. M377 OCT 377 SKP * * MOVE ALPHA FROM \LBUF TO \TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM \LBUF * TO \TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN \TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN \TBUF. * B = IGNORED * JSB \GETN * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * \GETN NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF DþúATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB ATBUF,I CLEAR WORD 1 OF TBUF CCA STA \CMFL SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM \LBUF LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I YES - RETURN OCHAR JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I RETURN * CURAT NOP CURRENT TBUF ADDR. ATBUF DEF \TBUF MAXC NOP MAX. CHAR COUNT. SKP * * CONVERT OCT/DEC ASCII TO BINARY * * THE \GET# SUBROUTINE CONVERTS THE NEXT CHARACTERS IN \LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB \GET# * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * \GET# NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX ×ïNLHNO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA \CMFL SET COMMA-IN FLAG CLA STA \OCTN \OCTN = OCTAL NUMBER GETNX JSB \GETC GET CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA \TCHR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA \OCTN GET PREVIOUS OCTAL NO. ADA A SET A = \OCTN X 2 ADA A SET A = \OCTN X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA \OCTN SET A = \OCTN X 5 ADA A SET A = \OCTN X 10/8 ADA \TCHR SET A = NEW OCTAL NO. STA \OCTN SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ \GET# INCR RETURN ADDRESS LDA \OCTN GET OCTAL EQUIVALENT ðÊNÿÿþúDGERR JMP \GET#,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP \GET#,I RETURN - ERROR * \TCHR NOP TEMP CHAR SAVE AREA. DIFLG NOP DATA-IN FLAG= -1/0= NOT IN/IN. DRANG NOP DIGIT RANGE. \OCTN NOP OCTAL DIGIT. L60 OCT -60 N10 DEC -10 N8 DEC -8 SKP * * INITIALIZE CHAR TRANSFER * * THE \GINT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING \LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GINT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * \GINT NOP LDA ALBUF ALBUF = ADDR OF \LBUF STA \CURL SET CURRENT \LBUF ADDRESS CCB STB \BUFL \BUFL = BUFFER U/L FLAG JMP \GINT,I SPC 10 * * INVALID TTY RESPONSE * * THE \INER SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \INER NOP LDA ERR01 SET INVALID DEVICE ERROR CODE JSB \GNER PRINT \GNER MESSAGE JMP \INER,I RETURN SPC 1 ERR01 ASC 1,01 SKP * SUBROUTINE TO READ INPUT * \RNME NOP READ FILE NAME. ISZ RMODE JSB \READ CLB STB RMODE JMP \RNME,I * * \READ NOP STA READ2 SZA,RSS IF ZERO, THEN NULL PROMPT LDB ALBUF SO PUT A BOGUS ADDRESS IN READB STB READ1 READ0 JSB \PRMT DEF *+6 READ1 NOP MSG BUFR NULL IF NO PROMPT. DEF READ2 ZERO LEN IF NO PROMPT. ALBUF DEF \LBUF DEF P80 DEF PARSA * STA PARNO SAVE PARAM RECORD LENGTH LDA \TBUF STA TEMP4 SAVE IT JSB \GINT CLA,INA JSB \GETN IF FIRST CHAR IS A BLANK CPA ÌþúBLANK OR A * THEN SKIP RECORD RSS JMP READ5 NOT SO CLA STA READ2 DON'T REISSUE PROMPT JMP READ0 * READ5 LDA TEMP4 STA \TBUF RESTORE LDB RMODE CHECK WHICH ENTRY. SZB JMP \READ,I LDA PARNO INA CLE,ERA CONVERT TO WORD ADDR. ADA ALBUF GET TO END OF BUFFER. CLB INSERT ZERO AT END. STB A,I JSB \GINT INITIALIZE \LBUF SCAN. LDA PARNO RETURN WITH RECORD LEN. JMP \READ,I SPC 1 READ2 NOP RMODE OCT 0 PARNO NOP TEMP4 NOP P80 DEC 80 SKP * * ANALYZE YES/NO RESPONSE * RETURN: (P+1) ERROR * (P+2) NO * (P+3) YES * \YENO NOP LDA N3 JSB \GETN JSB \GETC SZA MORE THEN 3 CHAR JMP YE/ER ERROR LDB ATBUF,I GET RESPONSE CPB YCHAR YE? LDA P2 YES - SET RETURN OFFSET FOR YES CPB NCHAR WAS IT NO? CLA,INA YES - SET RETURN FOR YES SZA,RSS STILL ZERO? JMP YE/ER YES - NOT YES OR NO - ERROR ADA \YENO ADJUST RETURN JMP A,I RETURN YE/ER JSB \INER ERROR - SEND MESSAGE JMP \YENO,I AND TAKE ERROR EXIT SPC 1 YCHAR ASC 1,YE NCHAR ASC 1,NO N3 DEC -3 SPC 5 * * NEW LINE (CR,LF) ON TTY * * THE \SPAC SUBROUTINE IS USED TO \SPAC UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \SPAC * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \SPAC NOP LDB DBLNK GET ADDRESS OF A BLANK CLA,INA SET CHARACTER COUNT = ONE JSB \MESS OUTPUT CR, LF ON TTY JMP \SPAC,I RETURN * DBLNK DEF UBLNK UBLNK OCT 20000 SKP * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENC²SþúE: * A = 2-DIGIT ASCII ERROR CODE, IF NEG THEN DON'T DO A TR,ERRLU * B = IGNORED * JSB \GNER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \GNER NOP PRINT ERROR MESSAGES CLE IF A IS NEG THEN SET IT POSITIVE SSA AND DON'T DO A TR CME SEZ CMA,INA STA AMERR+5 SET ERROR CODE INTO MESSAGE SEZ JMP EROUT LDA \IACM IS COMMAND LU INTERACTIVE ALREADY? SZA JMP EROUT YES * LDA \TRCH SAVE RETURN ADDRESS OF \TRCH IN CASE ITS STA \ABOR CALLING ERROR LDA \TRCM SIMULATE THE "TR,ERRLU" LDB B6 JSB \TRCH GO PUSH THE STACK LDA \ABOR RESTORE \TRCH RETURN ADDRESS STA \TRCH * LDA EOFFL NO MESSAGE IF EOF-GENERATED SZA JMP \GNER,I * EROUT JSB \SPAC LDA P10 LDB AMERR AMERR = MESSAGE ADDRESS JSB \MESS PRINT ERROR MESSAGE ISZ ERCNT BUMP ERROR COUNTER JMP \GNER,I RETURN * \TRCM DEF TRCOM TRCOM ASC 3,TR, XX EOFFL NOP ERCNT NOP ERROR COUNTER SKP * * IRRECOVERABLE ERROR EXIT * \IRER NOP JSB \GNER PRINT \GNER MESSAGE JSB \TERM IRRECOVERABLE ERROR * AMERR DEF *+1 ASC 5,GEN ERR ERROR MSG = ERR + CODE SPC 5 \ABOR NOP FORMERLY "HLT 0B". CCA ADA \ABOR GET ADDR OF \ABOR CALLER. LDB DER00 JSB \CONV PUT IN MESSAGE. LDA P18 LDB ABERR JSB \MESS DISPLAY ER00 AND ADDRESS. ISZ ERCNT BUMP ERROR COUNTER JSB \TERM ABORT (NO RETURN). * ABERR DEF ERR00 ERR00 ASC 9,GEN ERR 00 DER00 DEF ERR00+6 P18 DEC 18 SKP * * THE \INID,\IDXS AND \IDX SUBROUTINES ARE USED TO SET THE CURRENT * INDICES FOR THE ENTRY IN THE PROGRAM IDENTIFICATION * BLOCK TABLE (IDENT). THE INDEX OF THE NEXT ENTRY * IN THE IDENT TABLE IS CONTAINED IN \TIDN.®›þú ON RETURN FROM * \IDX, \TIDN CONTAINS THE INDEX OF THE NEXT AVAILABLE * ENTRY IN IDENT. THE ADDRESS OF THE FIRST ENTRY IS CONTAINED * IN BIDNT AND THE # ENTRIES USED IS IN \PIDN. * * \IDXS FINDS AN ENTRY IN THE TABLE. * * IF THE NEXT IDENT ENTRY OVERFLOWS INTO THE LAST LST ENTRY, * \IDX PRINTS A DIAGNOSTIC AND EXITS TO THE IRRECOVERABLE ERROR * SUBROUTINE. * * SET INITIAL IDENT ADDRESS * * \INID SETS THE INDEX OF THE FIRST ENTRY IN THE IDENT * TABLE AS THE CURRENT INDEX. * * NOTE. OFFSET = 10 TO AVOID PROBLEMS WITH VALUES * 1-5 IN LST WORD 4. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INID * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED * \INID NOP LDA P10 RESET CURRENT IDENT INDEX. STA \TIDN (HAS OFFSET OF 10) JMP \INID,I RETURN SKP * * \IDXS FINDS AN ID ENTRY IN THE IDENT TABLE. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE NAME TO FIND. * JSB \IDXS * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): CURRENT IDENT ADDRESSES ARE FOR THE NEXT FREE ENTRY IN * THE IDENT LIST. SYMBOL NOT FOUND. * (N+2): CURRENT IDENT ADDRESSES ARE FOR THE SPECIFIED PROGRAM. * \IDXS NOP JSB \INID INIT \TIDN TO 1ST IDENT. STB \INID SAVE POINTER TO ASCII NAME. * ** OTHER SUBS MAY WANT NAME PTR IN \INID ** * IDSX2 JSB \IDX SET IDENT ENTRY ADDRESSES. JMP \IDXS,I END OF TABLE. \ID1,\ID2,... SET. LDB \INID GET ADDR OF TARGET MATCH. LDA B,I CPA \ID1,I CHAR 1 & 2 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I CPA \ID2,I CHAR 3 & 4 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I XOR \ID3,I AND M7400 CHECK CHAR 5. SZA JMP IDSX2 NOT THIS ENTRY. ISZ \IDXS FOUND. TAKE SUCCESS RETURN. JMP \IDXS,I SKP ßþú * SET IDENT ADDRESSES FROM \TIDN * * \IDX SETS THE ADDRESSES OF THE CURRENT 11-WORD ENTRY IN THE * IDENT TABLE FROM THE INDEX OF THE CURRENT ENTRY (\TIDN). * THE \TIDN ENTRY MAY REFERENCE CURRENT/FORWARD/BACKWARD * BLOCKS. \IDX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \IDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): CURRENT IDENT ADDRESSES ARE THE ADDRESSES * OF THE NEXT AVAILABLE IDENT ENTRY, OR THE * END OF THE IDENT TABLE HAS BEEN REACHED. * (N+2): CURRENT IDENT ENTRY ADDRESSES (NOT END OF IDENT) * \IDX NOP STB \ID16 TEMP SAVE LDA B.I CHECK IF ENTRY IN CORE (DOT OK). CMA,INA ADA \TIDN SSA JMP IDX0 .LT. LOW ENTRY INDEX. * LDA B.I (NOT "B,I" - DOT OK) ADA EIDNT CMA,INA ADA \TIDN SSA JMP IDX2 IN CORE. * IDX0 LDA \TIDN .GT. HIGH ENTRY INDEX. ADA N10 CLB DIV EIDNT GET BLOCK NO. STA B.I TEMP SAVE... DOT OK. MPY ID.#S GET # SECTORS OFFSET. CLB DIV SECTK CHECK TRACK SPILL OVER. STB ID.CS REMAINDER= NEW CURR. SECTOR. ADA ID.BT STA ID.CT NEW CURRENT TRACK. * ADB ID.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK SSB,RSS JMP *+4 CLB STB ID.CS IF END NOT ON SAME TRACK, ISZ ID.CT START BLOCK ON NEXT TRACK * CPA ID.ET END OF IDENT DISK AREA? JMP LSERR YES. IDENT OVERFLOW! * JSB RDIDN WRITE/READ THE DISC. LDA B.I DOT OK. SET NEW LOW INDEX. MPY EIDNT ADA P10 ADD THE OFFSET. STA B.I DOT OK. IDX2 LDA \TIDN GET ADDR OF DESIRED ENTRY. ADA N10 ADJUST FOR OFFSET. CLB DIV EIDNT LDA B REMAINDER = OFFSET. ALF qHþú MULTIPLY BY 16 WORDS PER ENTRY ADA BIDNT STA \ID1 SET ADDRESS OF NAME 1,2 INA STA \ID2 SET ADDRESS OF NAME 3,4 INA STA \ID3 SET ADDRESS OF NAME 5, USE FLAG INA STA \ID4 SET ADDRESS OF COM/PROG LENGTH INA STA \ID5 SET ADDRESS OF LINKS-MAP OPT FLAGS. INA STA \ID6 SET ADDRESS OF M/S,PRIOR/DISK,TY INA STA \ID7 SET ADDRESS OF LOWEST DBL. INA STA \ID8 SET MAIN IDENT ADDR FOR BS INA STA \ID9 SET FILE NAME ADDRESSES. INA STA \ID10 INA STA \ID11 INA STA \ID12 SET ADDRESS OF SECURITY CODE INA STA \ID13 SET ADDRESS OF CR LABEL . INA STA \ID14 SET ADDRESS OF RECORD NUMBER INA STA \ID15 SET ADDRESS OF REL. BLOCK INA LDB \ID16 RESTORE B-REG STA \ID16 SET ADDRESS OF BLK OFFSET * LDA \PIDN CHECK IF END OF IDENT. CMA,INA ADA \TIDN SSA ISZ \IDX NOT END. P+2 EXIT. ISZ \TIDN SET NEXT IDENT ENTRY. JMP \IDX,I RETURN * B.I DEC 10 1ST ENTRY INDEX OF CUR CORE BLOCK. * (OFFSET = 10) SPC 3 * POINTERS FOR IDENT TABLE. * BIDNT NOP FWA CORE BLOCK. \TIDN NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PIDN NOP # ENTRIES USED + 10. EIDNT NOP # IDENT ENTRIES PER CORE BLOCK. LIDNT NOP # WORDS PER DISC WRITE/READ. ID.BT NOP START TRACK ID.LT NOP LAST TRACK ID.LS NOP AND SECTOR READ. ID.CT NOP CURRENT TRACK ID.CS NOP AND SECTOR (OR NEXT REQUIRED). ID.ET NOP ENDING TRACK ID.#S NOP # SECTORS PER BLOCK. * \ID1 NOP \ID2 NOP \ID3 NOP \ID4 NOP \ID5 NOP \ID6 NOP \ID7 NOP \ID8 NOP \ID9 NOP \ID10 NOP \ID11 NOP \IaëþúD12 NOP \ID13 NOP \ID14 NOP \ID15 NOP \ID16 NOP SKP * * SUBROUTINE TO WRITE-READ IDENT TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDIDN * RDIDN NOP LDA ID.LS GET LAST SECTOR ADDR. LDB ID.LT GET LAST TRACK ADDR. CPA ID.CS EQUAL TO CURRENT? RSS YES. JMP RDID1 NO. WRITE AND READ. CPB ID.CT SAME TRACK? JMP RDIDN,I YES, RETURN. * RDID1 LDA BIDNT STA WI1 STA WI2 * JSB EXEC WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WI1 NOP DEF LIDNT DEF ID.LT DEF ID.LS * JSB EXEC READ NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WI2 NOP DEF LIDNT DEF ID.CT DEF ID.CS * LDA ID.CT RESET TRACK & SECTOR ADDRS. STA ID.LT LDA ID.CS STA ID.LS JMP RDIDN,I SKP * * THE \ILST, \LSTS, \LSTE AND \LSTX SUBROUTINES ARE USED TO SET THE * CURRENT LOADER SYMBOL TABLE (LST) INDICES. THE INDEX OF THE * NEXT ENTRY IN LST IS CONTAINED IN \TLST. ON RETURN FROM \ILST, * \TLST CONTAINS THE INDEX OF THE NEXT AVAILABLE ENTRY IN LST, OR * THE INDEX OF THE END OF LST. THE ADDRESS OF THE FIRST ENTRY * IN LST IS AT BLST AND THE # ENTRIES USED IS IN \PLST. * * IF THE NEXT ENTRY IN LST OVERFLOWS CORE-DISC SPACE, * \LSTX PRINTS A DIAGNOSTIC AND EXITS * TO THE IRRECOVERABLE ERROR SUBROUTINE. * * \ILST SETS THE ADDRESS OF THE FIRST ENTRY IN LST. * \ILST NOP CLA STA \TLST RESET CURRENT LST INDEX. JMP \ILST,I RETURN SKP * * \LSTS SEARCHES THE LST FOR A SPECIFIED ENTRY. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE ASCII NAME TO BE FOUND. * JSB \LSTS * * RETURN: CONTENTS OF A AND B DESTROYED. * (N+1): THE END OF THE LST WAS FOUND WITH OUT FINDING THE * SYMBOL. THE LST ENTRIES ARE SET TO THE NEXT AVAILABLE * ENTRY. * ðOþú (N+2): THE CURRENT LST ADDRESS POINT TO THE FOUND ENTRY. * \LSTS NOP JSB \ILST INIT \TLST TO 1ST LST INDEX. STB \ILST SAVE PTR TO ASCII NAME * ** SOME SUBS EXPECT \LSTS TO STORE THIS ** * ** POINTER IN \ILST'S ENTRY POINT ** LSTS2 JSB \LSTX SET LST ENTRY ADDRESSES. JMP \LSTS,I END OF TABLE. \LST1,...,\LST5 SET. LDB \ILST GET ADDR OF TARGET MATCH. LDA B,I CPA \LST1,I CHAR 1 & 2 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I CPA \LST2,I CHAR 3 & 4 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I XOR \LST3,I AND M7400 CHECK CHAR 5. SZA JMP LSTS2 NOT THIS ENTRY. ISZ \LSTS FOUND. TAKE SUCCESS RETURN. JMP \LSTS,I SKP * SET LST ADDRESSES FROM \TLST * * \LSTX SETS THE CURRENT LST ADDRESSES FROM \TLST. THE \TLST ENTRY * MAY REFERENCE CURRENT-FORWARD-BACKWARD BLOCKS. \LSTX ASSURES * THAT THE PROPER CORE BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \LSTX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): THE END OF LST IS REACHED AND THE CURRENT * LST ADDRESSES ARE THE ADDRESSES OF THE NEXT AVAILABLE * ENTRY IN LST. * (N+2): CURRENT LST ADDRESSES ARE SET (NOT END OF LST). * \LSTX NOP STB \LST5 TEMP SAVE LDA B.L CHECK IF ENTRY IN CORE. CMA,INA ADA \TLST SSA JMP LSTX0 .LT. LOW ENTRY INDEX. * LDA B.L ADA ELST CMA,INA ADA \TLST SSA JMP LSTX2 * LSTX0 LDA \TLST .GT. HIGH ENTRY INDEX. CLB DIV ELST GET BLOCK NUMBER. STA B.L SAVE FOR LATER. MPY LS.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB LS.CS REMAINDER= NEW£2þú CUR. SECTOR. ADA LS.BT STA LS.CT NEW CURRENT TRACK. * ADB LS.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NOT ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB LS.CS ISZ LS.CT * CPA LS.ET END OF LST DISC AREA? JMP LSERR YES. LST OVERFLOW! * JSB RDSMB WRITE/READ THE DISC. LDA B.L SET NEW LOW INDEX. MPY ELST STA B.L LSTX2 LDA \TLST GET ADDR OF DESIRED ENTRY. CLB DIV ELST LDA B REMAINDER= OFFSET. MPY P5 ADA BLST STA \LST1 SET WORD 1 ADDR. INA STA \LST2 SET WORD 2 ADDR INA STA \LST3 SET WORD 3 ADDR INA STA \LST4 SET WORD 4 ADDR INA LDB \LST5 RESTORE B-REG STA \LST5 SET WORD 5 ADDR LDA \PLST CHECK IF END OF LST. CMA,INA ADA \TLST SSA ISZ \LSTX NOT END. P+2 EXIT. ISZ \TLST SET NEXT LST INDEX. JMP \LSTX,I RETURN * B.L OCT 0 1ST ENTRY INDEX NOW IN CORE. * LSERR LDA ERR07 JSB \IRER IRRECOVERABLE ERROR EXIT * ERR07 ASC 1,07 IDENT/LST/FIX-UP OVERFLOW. SKP * ENTER A NEW SYMBOL * * \LSTE SEARCHS THE LST FOR A SYMBOL AND IF NOT FOUND ENTERS IT * IN THE LST. * * CALLING SEQUENCE: * A = IGNORED * B = SYMBOL ADDRESS * JSB \LSTE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): SYMBOL IS NEW AND WAS ENTRED, LST ADDRESS ARE SET UP * (N+2): SYMBOL WAS IN LST. LST ADDRESS ARE SET UP. * \LSTE NOP JSB \LSTS SEARCH FOR THE SYMBOL JMP LSTE2 IF NOT FOUND GO ENTER * ISZ \LSTE STEP TO ALREADY IN LST EXIT JMP \LSTE,I AND EXIT * LSTE2 LDB \ILST,I GET THE FIRST CHARACTERS OF NEW STB \LST1,I SYMBOL AND SET IN THE LIST ISZ ý•þú\ILST STEP TO NEXT CHARACTERS LDA \ILST,I GET THE CHARACTERS STA \LST2,I AND SET ISZ \ILST STEP TO THE LAST CHARACTER LDA \ILST,I FETCH IT AND M7400 KEEP ONLY THE HIGH CHARACTER STA \LST3,I SET IT IN THE LST CLA CLEAR STA \LST4,I THE IDENT FLAG STA \LST5,I AND VALUE FIELDS ISZ \PLST BUMP # LST ENTRIES. JMP \LSTE,I EXIT BACK TO THE USER. SKP * * * POINTERS FOR LOADER SYMBOL TABLE (LST). * BLST NOP FWA CORE BLOCK. \TLST NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PLST NOP # ENTRIES USED. ELST NOP # LST ENTRIES PER CORE BLOCK. LLST NOP # WORDS PER DISC WRITE/READ. LS.BT NOP START TRACK LS.LT NOP LAST TRACK LS.LS NOP AND SECTOR READ. LS.CT NOP CURRENT TRACK LS.CS NOP AND SECTOR (OR NEXT REQUIRED). LS.ET NOP ENDING TRACK LS.#S NOP # SECTORS PER BLOCK. * \LST1 OCT 0 \LST2 OCT 0 \LST3 OCT 0 \LST4 OCT 0 \LST5 OCT 0 SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA LS.LS GET LAST SECTOR ADDRESS LDB LS.LT GET LAST TRACK ADDRESS CPA LS.CS IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB LS.CT HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING * WTSMT LDA BLST STA WS1 STA WS2 * JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF P2 DEF DSKLU WS1 NOP DEF LLST DEF LS.LT DEF LS.LS * JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU WS2 NOP DEF LLST DEF LS.CT DEF LS.CS * LDA LS.CT STA LS.LT LDA LS.CS STA LS.LS RESET TRACK SECTOR ADDRESS JMP RDSMÖsþúB,I AND RETURN SKP * * THE \IFIX AND \FIX SUBROUTINES ARE USED TO SET THE * CURRENT FIX-UP TABLE INDICES. * * \IFIX SETS THE INDEX OF THE FIRST ENTRY IN THE FIX-UP * TABLE AS THE CURRENT ENTRY. * \IFIX NOP CLA STA \TFIX JMP \IFIX,I SPC 5 * * \FIX SETS THE CURRENT FIX-UP ADDRESSES FROM \TFIX. * THE \TFIX ENTRY MAY REFERENCE CURRENT-FORWARD-BACKWARD * BLOCKS. FIX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \FIX * * RETURN: A LOST, B SAVED. * P+1 IF BEYOND END OF DEFINED FIX-UPS * P+2 IF DEFINED ENTRY. * \FIX NOP STB \FIX4 TEMP SAVE LDA B.F CHECK IF ENTRY IS IN CORE. CMA,INA ADA \TFIX SSA JMP FIX0A .LT. LOW ENTRY INDEX. * LDA B.F ADA EFIX CMA,INA ADA \TFIX SSA JMP FIX0C * FIX0A LDA \TFIX .GT. HIGH ENTRY INDEX. CLB DIV EFIX GET BLOCK NUMBER. STA B.F MPY FX.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB FX.CS REMAINDER = NEW CURRENT SECTOR. ADA FX.BT STA FX.CT NEW CURRENT TRACK. * ADB FX.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NO ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB FX.CS ISZ FX.CT * CPA FX.ET END OF FIX-UP DISC AREA? JMP LSERR YES. FIX-UP OVERFLOW! * JSB RDFIX WRITE/READ THE DISC. LDA B.F SET NEW LOW INDEX. MPY EFIX STA B.F FIX0C LDA \TFIX GET ADDR OF DESIRED ENTRY. CLB DIV EFIX LDA B REMAINDER = OFFSET. MPY P4 ADA BFIX STA \FIX1 SET WORD 1 ADDR. INA STA \FIX2 SET WORD 2 ADDR. INA STA \FIX3 SET WORD 3 ADDR. INA LDB \FIX”Ïþú4 RESTORE B-REG STA \FIX4 SET WORD 4 ADDR. LDA \PFIX CHECK IF END OF DEFINED FIX-UPS. CMA,INA ADA \TFIX SSA ISZ \FIX NOT END. P+2 EXIT. ISZ \TFIX SET NEXT FIX-UP ENTRY. JMP \FIX,I RETURN. * B.F OCT 0 LOW INDEX OF BLOCK IN CORE SKP * * * POINTERS FOR FIX-UP TABLE. * BFIX NOP FWA CORE BLOCK. \TFIX NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PFIX NOP # ENTRIES USED. EFIX NOP # FIX-UP ENTRIES PER CORE BLOCK. LFIX NOP # WORDS PER DISC WRITE/READ. FX.BT NOP START TRACK FX.LT NOP LAST TRACK FX.LS NOP AND SECTOR READ. FX.CT NOP CURRENT TRACK FX.CS NOP AND SECTOR (OR NEXT REQUIRED). FX.ET NOP ENDING TRACK FX.#S NOP # SECTORS PER BLOCK. * \FIX1 NOP \FIX2 NOP \FIX3 NOP \FIX4 NOP SKP * * SUBROUTINE TO READ/WRITE FIX-UP TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDFIX * RDFIX NOP LDA FX.LS GET LAST SECTOR ADDRESS. LDB FX.LT GET LAST TRACK ADDRESS. CPA FX.CS IS IT EQUAL TO CURRENT? RSS YES. JMP RDFX1 NO... WRITE AND READ. CPB FX.CT HOW ABOUT TRACK ADDRESS? JMP RDFIX,I SAME THING... DON'T TO ANYTHING. * RDFX1 LDA BFIX STA WX1 SET BUFFER ADDRESS. STA WX2 * JSB EXEC GO WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WX1 NOP DEF LFIX DEF FX.LT DEF FX.LS * JSB EXEC READ IN NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WX2 NOP DEF LFIX DEF FX.CT DEF FX.CS * LDA FX.CT RESET TRACK & SECTOR ADDRESSES. STA FX.LT LDA FX.CS STA FX.LS JMP RDFIX,I RETURN. SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM IN CASE OF ABORT * +NLH* JSB \TERM * * \TERM NOP LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS STA BLKS AND SAVE IT JSB \CLOS PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS * JSB CLOSE PURGE THE BOOT FILE(IF ANY) DEF *+4 DEF \BDCB DEF \FMRR DEF B1 JMP CONTA * * ENTER HERE FOR NORMAL CLEANUP AT END OF GENERATION * \EXIT JSB \CLOS CLOSE BOOT FILE (IF ANY) DEF *+3 IGNORING ANY ERRORS DEF \BDCB DEF ZERO * LDA DFIN LDB DAB GET ADDRESS INTO MESSAGE MVW P4 AND SENT "FINISHED" * CONTA LDB DFABM GET BUFFER ADDRESS LDA P14 AND COUNT JSB \LOUT SEND THE TERMINATION MESSAGE JSB \SPAC * LDA ERCNT NOW PRINT THE # OF ERRORS CMA,INA FOR THIS GENERATION LDB ERMSG JSB \CONV LDA P12 LDB ERMSG INB JSB \MESS * JSB CLOSE PURGE TEMP NEW NAM FILE. DEF *+4 DEF \NDCB DEF \FMRR DEF P64 * JSB \CLOS CLOSE LIST FILE DEF *+3 DEF \LDCB DEF ZERO * JSB \CLOS CLOSE RELOCATABLE INPUT FILE IF OPEN DEF *+3 DEF \RDCB DEF ZERO * JSB \CLOS CLOSE ANSWER FILE DEF *+3 DEF \IDCB DEF ZERO Å9Nÿÿþú* * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * LDA IALST ABORT MESSAGE ALREADY SZA PRINTED? JMP RELTR JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF P2 DEF ERRLU DFABM DEF ABMSG "RT4GN -------" DEF B7 * RELTR JSB EXEC RELEASE TRACKS DEF *+3 DEF P5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 DAB DEF *+4 ABMSG ASC 3,RT4GN ASC 4,ABORTED B1 OCT 1 B6 OCT 6 B7 OCT 7 BLKS NOP \.NM. ASC 1,@@ ASC 1,NM NAMM ASC 1,@A * ERMSG DEF *+1 ASC 7, ERRORS DFIN DEF *+1 ASC 4,FINISHED SKP * * SUBROUTINE TO WRITE ON INTERACTIVE COMMAND INPUT DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB \MESS * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * \MESS NOP DST ABREG SAVE A AND B REG FOR \LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA IALST IS THE LIST FILE AN I.A. LU? SZA JMP PRNT1 YES, SO DONT PRINT MESSAGE TWICE LDA \IACM IS THE COMMAND DEVICE I.A.? SZA,RSS JMP PRNT1 NO, SO DONT WRITE TO IT * JSB WRITF OUTPUT MESSAGE DEF *+5 DEF \IDCB TO THE INPUT DEVICE DEF \FMRR PRNTB NOP DEF PRNTA LENGTH * PRNT1 DLD ABREG GET LENGTH AGAIN JSB \LOUT WRITE TO FILE JMP \MESS,I AND RETURN SPC 1 PRNTA NOP M1 DEC -1 SKP * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 qVþú STA BYTCC SAVE IN DOWN COUNTER STB BYTCD SAVE B TEMPORARILY. LDB N40 TRUNCATE TO 40 WORDS. ADA P40 SSA STB BYTCC LDB BYTCD RESTORE B. LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND M7400 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 OTBUF ASC 1, PRINT BUFFER BSS 40 * B40 OCT 40 N40 DEC -40 P40 DEC 40 SKP * * SUBROUTINE TO WRITE ONTO A LIST FILE, AND OPTIONALLY ECHO TO CONSOLE * CALLING SEQUENCE * JSB \LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * \LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING * LDB LFERR IS THE LIST FILE IN ERROR MODE? SZB,RSS IE, PRE-CREATION OR POST-ERR22 JMP LF0 YES * JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF \LDCB DEF \FMRR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA * LDA \FMRR SSA,RSS JMP LF0 NO LISm·þúT FILE ERROR * CMA,INA SET POSITIVE FOR CONVERSION STA \FMRR JSB CNUMD CONVERT ERROR CODE TO ASCII DEF *+3 DEF \FMRR DEF FERMA ADDRESS OF ERROR MESSAGE LDA FERMA+2 PICK OFF CODE STA FILEA+6 LDB LDCBA NOW STORE THE FILE NAME STB PEMP JSB ADDCB IN THE MESSAGE NOP WON'T RETURN HERE LDB DFILE MOVE THE FILE NAME TO MVW P3 THE ERROR MESSAGE * JSB WRITF DEF *+5 SEND A BLANK LINE DEF \EDCB DEF \FMRR DEF C4040 DEF B1 * JSB WRITF SEND: DEF *+5 FMP ERR -XX DEF \EDCB DEF \FMRR DEF FILEA+1 (\CFIL WASN'T CALLED BECAUSE DEF P10 IT CALLS ... \LOUT) * ISZ ERCNT ISZ ERCNT LDA ERR22 STORE GEN ERROR CODE IN MESSAGE STA AMERR+5 JSB WRITF SEND: DEF *+5 GEN ERR 22 DEF \EDCB DEF \FMRR DEF AMERR+1 (\GNER WASN'T CALLED BECAUSE DEF P5 IT CALLS ... \LOUT) * ASKAG JSB WRITF ASK: DEF *+5 "OK TO CONTINUE?" DEF \EDCB DEF \FMRR DEF OKAY? DEF P8 * LDA ERRLU SET ECHO BIT IN IOR B400 EXEC CONTROL STA \FMRR WORD GETAN JSB EXEC RETRIEVE OPERATOR'S ANSWER DEF *+5 DEF B1 DEF \FMRR DEF ECBF DEF N2 SZB,RSS SKIP IF INPUT RECEIVED JMP GETAN ELSE GET AGAIN * CLA SET TO IGNORE ALL FUTURE LIST STA LFERR FILE ERRORS INA TURN ECHO ON STA ECHON * LDA ECBF OKAY? CPA YCHAR "YE" JMP LF0 YES-CONTINUE CPA NCHAR "NO" JSB \TERM NO-ABORT JMP ASKAG ASK AGAIN * LF0 LDA ECHON ARE WE TO ECHO? SZA,RSS JMP \LOUT,I NO * LDA IALST IS THE LIST FILE AN SZ‘„þúA,RSS INTERACTIVE LU? JMP LF1 NO, GO CHECK COMMAND INPUT LDB LSTLU IS THE LIST LU SAME AS CPB ERRLU LU OF OPERATOR CONSOLE? JMP \LOUT,I YES - DON'T ECHO * LF1 LDA \IACM IS THE COMMAND INPUT SZA,RSS FROM AN INTERACTIVE LU? JMP LF2 NO - SO PERFORM ECHO LDB CMDLU IS THE COMMAND LU THE CPB ERRLU SAME AS OP CONSOLE? JMP \LOUT,I YES - SO DON'T ECHO * LF2 LDA LSBF SET BUFFER ADDRESS STA ECBF JSB WRITF AND OUTPUT IT DEF *+5 DEF \EDCB DEF \FMRR ECBF NOP DEF LOUTA JMP \LOUT,I AND RETURN * ECHON NOP ECHO FLAG, 1=ON LOUTA NOP LFERR NOP LIST FILE ERROR ACKNOWLEDGER,0=NO,1=YES ERR22 ASC 1,22 LIST FILE GEN. ERROR CODE OKAY? ASC 8,OK TO CONTINUE? SKP * SUBROUTINE TO OPEN A RELOCATABLE FILE AND ADVANCE TO THE * NAM GIVEN IN THE CURRENT IDENT ENTRY. THE FILE IS LEFT OPEN. * THE NAM DESIRED MAY BE IN THE SAME FILE AS THE PREVIOUS ONE. * * CALLING SEQUENCE: * * A = BUFFER ADDRESS FOR NAM RECORD. * B = 0, DON'T COMPARE BUFFER FILE NAMES * JSB \RNAM * ERROR RETURN * NORMAL RETURN: A = # WORDS. * \RNAM NOP STA RDNMA SAVE BUFFER ADDRESS. SZB,RSS SKIP IF CHECK WANTED JMP RDNM1 LDB \DPR2 CHECK WHETHER \RBIN'S FILE NAME INB IS THE SAME AS IN IDENT. LDA B,I CPA \ID9,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA \ID10,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA \ID11,I INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID12,I SECURITY CODE INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID13,I CR LABEL JMP RDNM3 THE NAMES MATCH. GO SEARCH. * RDNM1 JSB CLOSE NAMES DO NOT MATCH. CLOSE THIS DEF *+3 FILE AND GET THE RIGHT ONE. Féþú DEF \RDCB DEF \FMRR * LDA P2 SET TYPE = ASCII. STA PARS2 LDA \ID9 STORE FILE NAME FROM IDENT. LDB DNAM MVW P3 LDA \ID12,I GET SECURITY CODE STA PRS31 LDA \ID13,I AND CR LABEL STA PRS41 * RDNM3 LDA RDNMA RESTORE BUFFER ADDRESS. CCB SIGNAL \RBIN TO CALL APOSN. JSB \RBIN READ NEXT RECORD FROM FILE. JMP \RNAM,I ERROR. SZA,RSS JMP RDNM3 EOF. MUST HAVE BEEN PAST THE NAM. * ISZ \RNAM SET FOR NORMAL EXIT. JMP \RNAM,I * RDNMA NOP RDNMB NOP SKP * SUBROUTINE TO GET NAME * * OPEN,READ AND CLOSE A RELOCATABLE FILE. * CALLING SEQUENCE * JSB \RBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * B REG: 0 = NULL * 1 = LOCATE BEFORE READ. * -1 = POSITION BEFORE READ. * UPON RETURN * A REG=0 EOF OR A = NUMBER OF WORDS. * \RBIN NOP STA RBINA SAVE BUFFER ADDRESS STB RBINB SAVE CODE. LDA \RDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBIN2 YES...DON'T RE OPEN ISZ ZERO SIGNAL A NON-EXCLUSIVE OPEN JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF \RDCB DEF B300 CLA STA ZERO RESET ZERO TO ZERO! JSB \CFIL JMP \RBIN,I RBIN2 LDA RBINB GET CODE. SZA,RSS JMP RBOPN ZERO = NO ACTION. * CPA M1 JMP RBIN3 -1 = PRE-POSITION THE FILE. ADA M1 1 = GET THE FILE POSITION. SZA JMP RBOPN UNDEFINED. ASSUME ZERO. * JSB LOCF GET POSITION OF NEXT DEF *+6 RECORD IN THE FILE. DEF \RDCB DEF \FMRR DEF \NAMN DEF \NAMB DEF \NAMO * JMP RBIN4 * RBIN3 JSB APOSN POSITION THE FILE. DEF *+6 DEF \RDCB DEF \FMRR DEF \ID14,I DEF \ID15,íþúI DEF \ID16,I * RBIN4 LDA DRDCB GET DCB ADDRESS JSB \CFIL FOR ERROR CHECKING JMP \RBIN,I * RBOPN JSB READF READ THE FILE DEF *+6 DRDCB DEF \RDCB DEF \FMRR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD LDA DRDCB JSB \CFIL SEE IF ANY ERROR JMP \RBIN,I ERROR...DO ERROR RETURN LDA RLEN GET LENGTH SZA,RSS IGNORE ZERO LENGTH RECORDS. JMP RBOPN ISZ \RBIN GET NORMAL RETURN. CPA M1 EOF? RSS JMP \RBIN,I NO JSB \CLOS YES...CLOSE FILE DEF *+3 DEF \RDCB DEF ZERO CLA TELL THEM END OF FILE JMP \RBIN,I AND RETURN SPC 2 RBINA NOP RELOC. INPUT BUFFER ADDRESS RBINB NOP " FILE POSITION FLAG RLEN NOP " RECORD LENGTH \NAMN NOP \NAMB NOP \NAMO NOP SKP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB FOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * ODCBA NOP SUBF NOP FOPEN NOP JSB .ENTR DEF ODCBA LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP FOPEN,I YES EXIT JSB OPEN TRY TO OPEN FILE DEF *+7 DEF ODCBA,I DEF \FMRR DEF PARS2+1 NAME DEF ZERO ALWAYS = 0 EXCEPT WHEN CALLED BY \RBIN DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT JMP FOPEN,I RETURN SKP * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 B×þú* * TYP0 NOP STA T0DCB LDA PARS2 CMA,INA,SZA IF NULL OR NUMERIC (TYPE 0,1) INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA PARS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA PARS2+1 CLA JSB SETIT SET DIRECTORY JSB SETIT ADDRESS TO ZERO JSB SETIT ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SETIT AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+6 DEF P13 DEF PARS2+1 DEF EQT5 DEF EQT4 DEF SUB05 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND M77 AND MASK STA EQT5 SAVE CPA P5 IF TYPE 5, MUST RSS JMP NOT05 LDA SUB05 DETERMINE ITS SUBCHANNEL AND M77 STA SUB05 SAVE THE SUBCHANNEL * LDA EQT5 NOT05 LDB B100 GET EOF CONTROL SUBFUNCTION CPA P5 RSS JMP TYP2 LDA SUB05 IF SUBCHANNEL 0 SZA,RSS JMP TYP3 JMP SEOF * TYP2 ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE * TYP3 LDB B1000 LDA EQT5 CPA P2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF CPA P7 IF A TYPE 7 DEVICE JMP SEOF THEN IT IS AUTOMATICALLY INTERACTIVE CPA P5 RSS JMP TYP4 LDA SUB05 NEED TO GET SUBCH ON A TYPE 5 SZA,RSS JMP SEOF * TYP4 LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SETIT SET IN DCB CLA JSB SETIT SET NO SPACING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SETIT AND SECURITY CODES AGREE 2’þú JSB SETIT AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SETIT SET OPEN FLAG LDA T0DCB ADA P3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SETIT TO ZERO INA JSB SETIT SET RECORD COUNT CLA STA \FMRR CLEAR ERROR CODE FOR TYPE 0 LDB EQT5 IF THIS IS A MT UNIT CPB P5 NO EOF IF A TYPE 5 DEVICE RSS CPB B23 THEN DON'T WRITE AN EOF JMP TYP0,I LDB T0DCB GET DCB ADDRESS ADB MD11 RESET TO WORD5, CONTROL FUNC LDB B,I GET CONTROL WORD STB SETIT SAVE IN TEMP LOCATION JSB EXEC DO AN EOF DEF *+4 DEF P3 DEF SETIT TEMP WHERE FUNCTION CODE LOCATED DEF MD17 FORCE A PAGE EJECT OR LEADER CLA JMP TYP0,I * * SETIT NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SETIT,I * * P7 DEC 7 T0DCB NOP EQT5 NOP MD17 DEC -17 MD11 DEC -11 B23 OCT 23 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 SPC 2 D60 DEC 60 SUB05 NOP TYPE 5 SUBCHANNEL SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB \CRET * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP \CRET NOP JSB .ENTR DEF CDCBA JSB FOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP \CRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF \FMRR JSB CREAT ~àþú TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF \FMRR DNAM DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP \CRET,I SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB \CLOS * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO \CLOS NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JMP FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF \FMRR DEF COPTN,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME LDA CLDCB,I SZA JMP \CLOS,I DONE WITH FILES LDA CLDCB MAKE SURE DUMMY DCB CLOSED. ADA D9 CLB STB A,I LDA CLDCB SEE IF LIST DCB CPA LDCBA RSS YES IT IS JMP \CLOS,I NO ADA P4 STA FCLS2 SAVE FOR EXEC CALL JSB EXEC DO A PAGE EJECT DEF *+4 DEF NABP3 CONTROL REQUEST FCLS2 NOP LU DEF MD17 PAGE EJECT CODE NOP JMP \CLOS,I AND RETURN * * D9 DEC 9 NABP3 OCT 100003 NO ABORT 3 * SKP * * SUBROUTINE TO CLOSE THE ABSOLUTE CORE IMAGE FILE * * CALLING SEQUENCE * JSB \TRUN * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * \TRUN NOP ASSUMES NO EXTENTS BEC TYPE 1 CLB LDA \FMRR GET \DSKD ERROR CODE SSA IF NEGATIVE THE EXACT SIZE WAS CORRECT JMP SETBL LDA ABDCB+3 TRK CMA,INA ADA ABDCB+10 CTRK - TRK MPY ABDCB+8 (CTRK - TRK) * #SEC/TR LDB ABDCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA ABDCB+11 (CTRK - TR²VþúK) * #S/TR - SEC + CSEC ARS CONVERT TO NUMBER OF BLOCKS LDB ABDCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG ADB A # OF BLKS - CURRENT BLK SETBL STB TMP JSB \CLOS DEF *+3 DEF ABDCB DEF TMP JMP \TRUN,I * TMP NOP ABDCB BSS 144 ABS FILE DCB SKP * * SUBROUTINE TO PRINT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB \PRMT * DEF *+6 * DEF PRINT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP \PRMT NOP JSB .ENTR DEF PMEMB PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH SZA SKIP IF NO QUESTION. JSB \MESS PRINT QUESTION PRMT5 LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DIDCB DEF \IDCB FROM INPUT DEVICE DEF \FMRR DEF PRADD,I DEF PRMTA DEF PRMTB LDA DIDCB GET DCB ADDRESS AND JSB \CFIL SEE IF WE HAD A FILE ERROR JMP INPRR LDA PRMTB GET LENGTH FOR PRINT ON FILE SSA,RSS IS IT A END OF FILE JMP PRMT2 NO LDA \IACM IF THE COMMAND INPUT IS FROM AN SZA INTERACTIVE LU, THEN JMP PRMT1 TRY AGAIN FOR RESPONSE LDA TR ELSE GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB P2 ISZ EOFFóþúL SIGNAL NO ERROR MESSAGE JMP PRMT3 * INPRR CLA STA \IACM FORCE A TR,ERRLU LDA ERR20 BY GNER JSB \GNER JMP PRMT1 TRY AGAIN * PRMT2 SZA,RSS IF 0-LENGTH RECORD JMP PRMT5 THEN SIMPLY SKIP & RETRY CLE,ELA CONVERT TO CHARACTERS STA PRMTB LDA IALST IF LIST DEVICE A FILE SZA,RSS (NON-INTERACTIVE) JMP PRMTL THEN ECHO INPUT CPA \IACM IF BOTH COMMAND AND LIST FILE RSS ARE INTERACTIVE, JMP PRMTL LDA LSTLU THEN SEE IF THEY'RE TO THE SAME CPA CMDLU LU JMP PRMTN YES, SO DON'T ECHO INPUT * PRMTL LDB PRADD GET INPUT LDA PRMTB JSB \LOUT WRITE IT ONTO LIST FILE * PRMTN LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB \TERM YES...GET OUT AND M7400 MASK TO HIGH BYTE ONLY CPA LCOMM IF A COMMA OR COLON RSS CPA LCOLN JMP PRMT6 THEN ASSUME A TR * PRMT7 LDA PRADD GET BUFFER ADDRESS LDB PPARS SET CORRECT PARSE BUFFER ADDRESS STB PADD LDB PRMTB CHARACTER COUNT JSB \PARS PADD NOP LDB PPARS GET FIRST 2 CHARS. INB LDA B,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT * INB YES - BUT CHECK LDA B,I FURTHER FOR A AND M7400 BLANK OR A CPA LBLNK COMMA IN CHARACTER 3 JMP PRMT6 CPA LCOMM RSS JMP PRMT4 PRMT6 LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB \TRCH GO DO TR THING CLA RESET IF EOF-GENERATED STA EOFFL JMP PRMT1 GO RETRY COMMAND PRMT4 LDA PRMTB GET ACTUAL REPLY LENGTH JMP \PRMT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR ASTER OCT 25000 * PRMTA NOP PRMTB NOP LBLNK OCT 20000 LCOMM OCT 26000 , LCÉFþúOLN OCT 35000 : B171 OCT 171000 SKP * * PARSE ROUTINE (MODIFIED VERSION OF $PARS) * * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB \PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 21 WORDS LONG AND CONTAINS UP TO 5 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * WSTAT = ADDR OF 21 WORDS OF OUTPUT BUF * PEMPP = CHARACTER ADDRESS * PEMP = PARAMETER FLAG ADDRESS * PEMP1 = TEMP BUFFER FETCH ADD. * PEMP2 = TEMP BUFFER STORE ADD. * PEMP3 = LAST INPUT CHAR.+1 ADD. * PEMP4 = PARAMETER VALUE ADDRESS. * PBUF = DEF PEMP5 (7 LOCATIONS) * PBUFS = DEF PEMP5+7 * \PARS NOP CLE,ELA MAKE CHARACTER ADD. STA PEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA PEMP3 AND SET IT. LDB N20 CLEAR PARAMETER AREA STB PEMP LDB \PARS,I CLA STA COMMT CLEAR COMMENT DETECTED FLAG MES1 STA B,I CLEAR INB ENTIRE ISZ PEMP OUTPUT JMP MES1 BUFFER * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA PBUF INITIALIZE PEMP BáˆNLHUFFER ADDRESS STA PEMP1 ADDRESS OF PEMP5 STA PEMP2 * DEC10 LDB PEMPP GET THE BUFFER CHAR ADDRESS CPB PEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ PEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COMMA SEE IF A COMMA JMP DEC60 YES CPA COLON SEE IF A COLON JMP DEC60 YES CPA STAR SEE IF AN ASTERISK (COMMENT) JMP DEC60-1 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB PEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB PBUFS IF SO JMP DEC10 SKIP STORE STA PEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ PEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATPEMPT NUMERIC CONVERSION OF PRAM. * ISZ COMMT SIGNAL COMMENT STARTED DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA \PARS,I PLUS THE OP CODE ADDRESS-1 STA PEMP SET FLAG ADDRESS ÍNÿÿþú CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA PEMP2 IF NO CHARACTERS CPA PBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * LDB PEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ PEMP1 YES, INCRE TO NEXT CHAR CPA PEMP1 (A) STILL = PEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB P10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB P8 SET FOR BASE 8 STB PEMP4 SET BASE ISZ PEMP,I SET FLAG TO 1 FOR NUMBER DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB PEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB P10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ PEMP1 STEP THE BUFFER ADDRESS LDA PEMP4 GET THE BASE TO A LDB PEMP1 AND THE NEXT CHAR. LOC. TO B CPB PEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB PEMP2 AND LAST CPA P10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA PBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA COMMT WAS A COMMENT BEGUN? SZA JMP DEC90 YES, EXIT LDA WSTAT,I IF LDB PEMP3 EOL OR CPB PEMPP 5 PRAMS LINE RSS THEN CPA P5 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ PEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB g@þúVALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB PBUF GET THE PEMP BUFFER POINTER DEC85 CPB PEMP2 END OF INPUT? JMP DEC70 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ \PARS STEP RETURN ADDRESS JMP \PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF PEMP5+6 ASCII 6TH CHAR STOP * * PEMP NOP PEMP1 NOP PEMP2 NOP PEMP3 NOP PEMP4 NOP PEMP5 NOP NOP NOP NOP NOP ASCI NOP ASCI1 NOP ASCI2 NOP * PEMPP NOP WSTAT NOP PBUF DEF PEMP5 PBUFS DEF PEMP5+7 DM58 DEC -58 COLON OCT 72 COMMT NOP SABRT NOP AASCI ASC 1, B377 OCT 377 N20 DEC -20 LASCI OCT 40 SKP SKP * SUBROUTINE TO DETERMIN IF STACK IS TO * * BE PUSHED OR POPPED * * IF PUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPPED, IT CLOSES THE CURRENT FILE, * OPENS THE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD * SPC 1 \TRCH NOP JSB \PARS B = LENGTH, A = ADDR DEF \BPAR LDA PARS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO PUSH * TR1 JSB \CLOS CLOSE THE CURRENT FILE DEF *+3 DEF \IDCB DFZER DEF ZERO JSB POP GO POP STACK JMP POPRR ERROR, NO MORE ENTRIES sþú STA RC SAVE RECORD COUNT JSB FOPEN OPEN PREVIOUS FILE DEF *+3 DEF \IDCB DEF B400 CLA JSB \CFIL JMP \TRCH,I FILE ERROR - STAY AT ERRLU LDA \IDCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP \TRCH,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE TR2 ISZ COUNT ARE WE THERE YET? RSS JMP \TRCH,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF \IDCB DEF \FMRR DEF PRADD,I DEF ZERO DEF RL LDA DIDCB GET DCB ADDRES AND SEE IF AN JSB \CFIL ERROR OCCURRED JMP \TRCH,I ERROR - STAY AT ERRLU LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND PUSH * TR3 LDA \IDCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB \CLOS GO CLOSE THE FILE DEF *+3 DEF \IDCB DEF ZERO LDA RC GET RECORD COUNT JSB PUSH GO PUSH STACK JMP PUSHR ERROR - STACK OVERFLOW JMP TR4 OPEN FILE JSB RECOV INVALID LU SPECIFIED LDA ERR20 RECOVER AND ISSUE JSB \GNER ERROR MESSAGE JMP \TRCH,I * TR4 JSB FOPEN GO OPEN NEW FILE DEF *+3 DEF \IDCB DEF B400 LDA \FMRR AN ERROR? SSA,RSS JMP \TRCH,I RETURN (MAY BE TO \CFIL ITSELF) STA PUSH SAVE ERROR VALUE LDA DNAM MUST SAVE THE FILE NAME LDB DFDIR BECAUSE RECOV/POP MAY OVERLAY MVW P3 IT IF A "TR,ERRLU" IS DONE JSB RECOV RECOVER PREVIOUS ENTRY LDA PUSH RESTORE STA \FMRR THE FMP ERROR CODE LDA DFDIR NOW MOVE THE FILE NAME LDB DNAM BACK INTO THE PARSE BUFFER MVW P3 FOR THE \CFIL CALL CLA áþú SIGNAL FILE NAME IN PARS2+1 JSB \CFIL ISSUE ERROR & TRANSFER TO ERRLU JMP \TRCH,I AND RETURN * PUSHR CCA ADA P:TR RESET THE POINTER FOR POP STA P:TR JSB RECOV RECOVER PREVIOUS ENTRY * POPRR CLA INSURE THAT A "TR,ERRLU" IS DONE STA \IACM LDA ERR19 TRANSFER STACK UNDERFLOW OR OVERFLOW JSB \GNER JMP \TRCH,I SKP RECOV NOP RECOVERS THE PREVIOUSLY OPEN STACK ENTRY JSB POP JMP NONET NONE THERE STA RC JSB FOPEN GO OPEN THE FILE DEF *+3 DEF \IDCB DEF B400 LDA RC STA \IDCB+14 JMP RECOV,I NONET CLA "TR,ERRLU" MUST BE DONE STA \IACM JMP RECOV,I * ERR19 ASC 1,19 ERR20 ASC 1,20 COUNT NOP RC NOP RL NOP B400 OCT 400 SKP * * SUBROUTINE TO PUSH AND POP A STACK * STACK DEFINITION * WORD 6= RECORD COUNT FOR NEXT RECORD TO READ * WORD 5= CARTRIDGE REFERENCE NUMBER * WORD 4= SECURITY CODE * WORD 3= 0 ELSE CH5 & CH6 * WORD 2= 0 ELSE CH3 & CH4 * WORD 1= LU ELSE CH1 & CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * PUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 6) * ASSUMES PARS2 CONTAINS INFO NEEDED * * CALLING SEQUENCE * LDA RC OF CURRENT FILE * JSB PUSH * (P+1) ERROR RETURN STACK OVERFLOW * (P+2) NORMAL RETURN * (P+3) ERROR RETURN INVALID LU * SPC 1 PUSH NOP STA P:TR,I SAVE CURRENT RECORD COUNT ISZ P:TR INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P:TR IF = JMP PUSH,I THEN OVERFLOW DLD PARS2 SAVE TYPE DST P:TR,I ISZ P:TR ISZ P:TR DLD PARS2+2 STORE CHARS 3-6 DST P:TR,I ISZ P:TR ISZ P:TR LDA PARS3+1 GET SECURITY CODE Ú€þú LDB PARS4+1 AND CRN DST P:TR,I ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU ISZ PUSH INVALID LU ISZ PUSH SET FOR NORMAL RETURN JMP PUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. COUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P:TR GET CURRENT POINTER ADA MD13 DECREMENT TO PREVIOUS ENTRY LDB STKAD GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB START OF STACK JMP POP,I NO MORE ENTRIES STA P:TR SET AS NEW POINTER DLD P:TR,I GET OLD ENTRY DST PARS2 ISZ P:TR INCREMENT TO WORDS 3 AND 4 ISZ P:TR DLD P:TR,I DST PARS2+2 ISZ P:TR ISZ P:TR DLD P:TR,I STA PARS3+1 STB PARS4+1 ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU NOP INVALID LU ERROR NOT POSSIBLE HERE LDA P:TR,I GET RECORD COUNT ISZ POP GET NORMAL RETURN JMP POP,I AND RETURN SPC 2 STKAD DEF *+2 POINT TO DEFAULT LU 1 BSS 1 DEC 1 INSERT LU 1 DEC 1 AT STACK BOTTOM BSS 5 WHERE THEY DON'T REALIZE IT STACK BSS 70 ALLOWS A NESTING LEVEL TO 10 ENDST DEF * P:TR DEF STACK-1 INITIAL POINTER AFTER HARD-CODE LU 1 MD13 DEC -13 SKP * * STATE SETS THE CURRENT "STATE" FLAGS \IACM AND CMDLU, * REFLECTING THE.NEW COMMAND INPUT DEVICE/FILE. * ASSUMES PARS2 AND PARS2+1 CONTAIN THE TYPE * AND FIRST PARAMTER, RESPECTIVELY * * CMDLU = LU #, ELSE 0 FOR ASCII FILE * \IACM = 0 IF A NON-INTERACTIVE LU, OR FILE * = 1 IF AN INTERACTIVE LU * * ÙéþúRETURN (P+1) ERROR - INVALID INPUT LU SPECIFIED * (P+2) NORMAL * STATE NOP DLD PARS2 GET WORD0 = PARAMETER TYPE CPA P2 & WORD1 = PARAMETER CLB A TYPE 2 IS A FILE NAME STB CMDLU SO IS 0, OR THE LU CPA P2 JMP STATF FILE NAME, GO SET \IACM TO 0 * SSB JMP STATE,I CAN'T BE < 0 ADB N64 CHECK IF LU > 63 SSB,RSS JMP STATE,I TOO BAD! * JSB EXEC GET LU TYPE FROM EQT DEF *+6 DEF NAB13 NO-ABORT 13 CALL DEF CMDLU DEF EQT5 DEF EQT4 DEF LUSUB JMP STATE,I EXEC ERROR RETURN LDA EQT4 CHECK FOR VALID LU AND M77 IF THE SELECT CODE IS 0 SZA,RSS THEN ITS THE BIT BUCKET JMP STATE,I WE'RE EXPECTING INUT FROM! * LDA EQT5 ALF,ALF GET TYPE TO LOW A AND M77 STA EQT5 SAVE IT CPA P7 IF TYPE 7 THEN IT IS CLA AUTOMATICALLY INTERACTIVE LDB CMDLU CPA P5 TYPE 5 ? LDA LUSUB YES, GO RETRIEVE ITS SUBCHANNEL AND M77 ???CHECK STATUS? CLB * STATF SZA,RSS TYPE 0, OR TYPE 5'S SUBCHANNEL 0? INB YES, SO AN INTERACTIVE DEVICE STB \IACM 0 = NOT IA, 1 = IA ISZ STATE JMP STATE,I * EQT4 NOP NAB13 OCT 100015 LUSUB NOP SKP * * FILE CHECK ROUTINE * * CALLING SEQUENCE: * A-REG = FILE'S DCB ADDRESS * = 0 IF A FILE OPEN OR CREATE CALL * \FMRR = RETURNED ERROR PARAMETER * JSB \CFIL * * (P+1) ERROR RETURN * (P+2) NORMAL RETURN * * \CFIL NOP LDB \FMRR GET FMP ERROR PARAMETER SSB,RSS ANY ERROR? JMP FNOER NO ISZ ERCNT BUMP COUNTER CMB,INB SET POS FOR CONVERT STB \FMRR STA PEMP SAVE FILE DCB ADDRESS * JSB CNUMD GET DEC ERROR CODE DEF *+3 ¥2þú DEF \FMRR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 & STORE IN MESSAGE LDB PEMP WAS IT AN OPEN/CREAT CALL SZB HAVING AN INVALIC DCB ADDRESS JSB ADDCB NO - CAN GET FILE NAME/LU FROM DCB * LDA DNAM ELSE GET FILE NAME FROM PARSE BUFFER LDB DFILE GET DEST ADDRESS MVW P3 IN ERROR MESSAGE AND MOVE FILENAME/LU * LDA \IACM DETERMINE IF WE ARE TO BRANCH TO SZA THE ERROR LU JMP ROUT NO, SINCE ALREADY GET INPUT FROM IA DEVICE * LDA \TRCH SAVE ITS RETURN ADDRESS STA \DSKA IN A TEMP LDA \TRCM SIMULATE A "TR,ERRLU" LDB B6 JSB \TRCH DO THE TR LDA \DSKA RESTORE THE RETURN ADDRESS STA \TRCH * ROUT JSB \SPAC LDA P20 LDB FILEA JSB \MESS SEND ERROR TO USER RSS FNOER ISZ \CFIL GET NORMAL RETURN IF NO ERROR * JSB IFBRK BREAK REQUESTED? DEF *+1 SZA JSB \TERM YES, DO ABORTIVE CLEANUP JMP \CFIL,I NORMAL RETURN SPC 2 FILEA DEF *+1 ASC 10,FMP ERR - DFILE DEF FILEA+8 DFERM DEF *+1 FERMA ASC 3, \FMRR NOP P20 DEC 20 SPC 4 * * GET THE FILE NAME/LU FROM THE DCB * ADDCB NOP ISZ ADDCB BUMP RETURN ADDRESS BY 1 LDA B,I GET FIRST DCB WORD AND CHECK FOR SZA,RSS AND ACTUAL FILE DCB JMP LUERR OR A LU - TYPE 0 DUMMY DCB * ***** ***** CHECK NEW DCB FORMAT AND BRANCH APPROPRIATELY ***** * LDB A GET LU OF AND M77 THE FILE DIRECTORY ENTRY STA PEMP1 AND SAVE BLF,RBL NOW GET THE TRACK # BLF,RBL FROM THE SAVE DCB LDA B WORD 0 AND AND M377 STA PEMP2 SAVE ISZ PEMP BUMP TO WORD 1 OF DCB LDA PEMP,I GET OFFSET/SECTOR LDB A AND SAVE FúþúAND M377 ISOLATE SECTOR STA PEMP3 BLF,BLF LDA B NOW ISOLATE AND M377 THE OFFSET STA PEMP4 AND SAVE * JSB EXEC READ THE PROPER SECTOR DEF *+7 THE FILE DIRECTORY DEF B1 DEF PEMP1 LU OF DIRECTORY ENTRY DFDIR DEF PEMP,I BUFFER ADDRESS IN OWN DCB DEF P128 DEF PEMP2 TRACK ADDRESS DEF PEMP3 SECTOR ADDRESS LDA PEMP GET BUFFER ADDRESS & ADA PEMP4 OFFSET INTO IT FOR THE FILE NAME JMP ADDCB,I EXIT TO MOVE THE NAME * LUERR ADB P3 POSITION TO WORD 3 LDA B,I OF DUMMY DCB AND M77 AND ISOLATE THE LU STA PEMP4 SAVE FOR CONVERSION JSB CNUMD TO ASCII DEF *+3 DEF PEMP4 DEF FERMA LDA "LU" MOVE 'LU' TO PRECEDE STA FERMA # IN DISPLAY LDA DFERM GET BUFFER ADDRESS JMP ADDCB,I FOR MOVE * "LU" ASC 1,LU P128 DEC 128 SKP * * INCREMENT DISK ADDRESS * * THE \DSKA SUBROUTINE INCREMENTS THE CURRENT DISK ADDRESS * TO PROVIDE THE ADDRESS OF THE SUCCEEDING SECTOR, * WHETHER THAT SECTOR IS ON THE SAME TRACK OR THE FOLLOWING * TRACK. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ... MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = CURRENT DISK ADDRESS * B = IGNORED * JSB \DSKA * * RETURN: * A = NEXT DISK ADDRESS * B = DESTROYED * \DSKA NOP STA B SAVE CURRENT ADDRESS AND M177 ISOLATE SECTOR NUMBER INA ADD 1. CPA SDS#T IF = TO MAX NO. ON SYS. DISC, CLA SET # = 0, STA DISKT AND SAVE NEW SECTOR #. LDA B ISOLATE ALF,ALF TRACK RAL ADDRESS AND M777 IN LOW A. CLB IF NEW CPB DISKT SECTOR # = 0, INA ADD 1 TO TRACK #. * ALóþþúF,RAL RESTORE TRACK # TO 14-07, RAL,RAL AND IOR DISKT INSERT SECTOR #. JMP \DSKA,I -RETURN. * DISKT NOP -TEMPORARY STORAGE M177 OCT 177 M777 OCT 777 SDS#T DEC 96 SYSTEM DISK SECTORS PER TRACK SKP * * DISK INPUT DRIVER * * THE \DSKI SUBROUTINE CONTROLS THE INPUT FROM THE DISK. * * THIS ROUTINE USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE * 64 WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKI * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKI NOP CLE,ERA SET EVEN SECTOR ADDRESS STB \DSKO SAVE CORE ADDRESS FOR MOVE LDB \OBUF+1 GET OUTBUFFER ADDRESS CPA \OBUF REQUESTED SECTOR IN OUTBUFFER? JMP DIS01 YES - GO MOVE * LDB INBUF+1 REQUESTED SECTOR IN INBUFFER? CPA INBUF ? JMP DIS01 YES GO MOVE * ELA SECTOR NOT IN CORE GO CCE TO DRIVER JSB \DSKD TO READ THE SECTOR LDA DCMND SET TO SHOW CLE,ERA SECTOR IN STA INBUF CORE LDB INBUF+1 GET BUFFER ADDRESS DIS01 LDA N64 SET COUNT FOR 64 STA DISKT WORDS SEZ IF ODD SECTOR ADB P64 ADD 64 TO LOCAL BUFFER ADDRESS DIS03 LDA B,I MOVE THE STA \DSKO,I ISZ \DSKO 64 INB WORDS ISZ DISKT TO THE JMP DIS03 USER BUFFER * JMP \DSKI,I RETURN SKP * * DISK OUTPUT DRIVER * * THE \DSKO SUBROUTINE CONTROLS ALL OUTPUT TO THE * DISC. IT USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE 64 * WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A*óþú = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKO NOP STB \DSKI SAVE CORE ADDRESS LDB DSKA GET LAST MAX ADDRESS CMB,INB SET NEG AND ADB A SUBTRACT FROM CURRENT ACCESS SSB,RSS IF CURRENT HIGHER STA DSKA THEN RESET MAX. CLE,ERA SET TO EVEN SECTOR CPA \OBUF SAME AS CURRENT SECTOR? JMP DIS02 YES - GO MOVE * ELA,CLE NO - SET TO WRITE CURRENT SECTOR STA \DSKA SAVE REQUEST ADDRESS LDA \OBUF GET BUFFER ADDRESS FOR CORE SECTOR LDB \OBUF+1 GET CORE ADDRESS OF THE SECTOR ELA,CLE CLEAR E FOR WRITE JSB \DSKD WRITE THE SECTOR LDA \DSKA GET THE REQUESTED SECTOR LDB \OBUF+1 AND LOCAL BUFFER ADDRESS CCE SET E FOR READ JSB \DSKD READ THE SECTOR LDA \DSKA SET TO SHOW IT IS IN CLE,ERA STA \OBUF CORE DIS02 LDB INBUF IF CURRENT WRITE BUFFER CPA B IS THE READ CCB BUFFER THEN STB INBUF SHOW READ BUFFER EMPTY LDB N64 SET COUNTER FOR STB DISKT 64 WORDS LDB \OBUF+1 GET THE LOCAL BUFFER ADDRESS SEZ IF ADDRESS IS ODD ADB P64 64 TO THE BUFFER LOCATION DIS04 LDA \DSKI,I MOVE STA B,I THE INB ISZ \DSKI TO THE ISZ DISKT LOCAL JMP DIS04 BUFFER AND * JMP \DSKO,I RETURN * DSKA NOP SPC 3 \OBUF OCT 2 DEF BUFOU OUTPUT BUFFER ADDRESS INBUF OCT -1 INBUF IN CORE FLAG (IMPOSSIBLE) DEF BUFIN INPUT BUFFER ADDRESS BUFIN BSS 128 INPUT BUFFER FOR DISC BUFOU BSS 128 OUTPUT BUFFER FOR DISC SKP * THE \DSKD SUBROUTINE PERFORMS ALL I/O TO THE CORE-IMAGE * RTE SYSTEM OUTPUT FILE. THROUGHOUT THE GENERATOR, DISC * ADDRESSES ARE USED AND MAINTAINED AS IN THE OFF-LINE * VERS£þúION SINCE RTE REQUIRES LOCATIONS OF ITEMS ON THE DISC. * DISC ADDRESSES ARE RELATIVE TO THE START OF THE DISC, THUS * ARE RELATIVE TO THE START OF THE OUTPUT FILE. * * \DSKD CONVERTS THE DISC ADDRESS IN THE A-REG (64 WORD BASIS) * TO A RECORD NUMBER WITHIN THE TYPE 1 OUTPUT FILE. READF * AND WRITF CALLS SPECIFY THIS RECORD NUMBER IN ORDER TO * SATISFY THE RANDOM ACCESS NATURE OF I/O TO THIS FILE. * * CALLING SEQUENCE: * * A = DISC ADDR ON A 64 WORD/SECTOR BASIS. * B = CORE ADDRESS. * IF B IS NEGATIVE, AND A IS POSITIVE, THEN WRITE HEADER #1 * IF B IS NEGATIVE, AND A IS NEGATIVE, THEN WRITE HEADER #2 * E = 1 FOR READ, * = 0 FOR WRITE. * * * RETURN - ALWAYS NORMAL, REGS DESTROYED. * \DSKD NOP SSB,RSS IF NEGATIVE,THEN WE'RE JMP DIS0 WRITING THE HEADER RECORD STB HEADR WSET FLAG CMB,INB SSA,RSS CHECK IF A IS NEGATIVE CLA,RSS NO, HEADER RECORD #1 CLA,INA HEADER RECORD #2 INA STA NUM FOR THE WRITE * DIS0 STB BUFR1 STORE CORE ADDR IN STB BUFR2 READF AND WRITF CALLS. CLB ELB STB \FMRR TEMP SAVE READ-WRITE CODE. * * COMPUTER RECORD NUMBER FROM THE DISC ADDRESS * LDB HEADR SSB JMP DIS1 HEADER RECORD - WRITE IT STA DCMND SAVE DISC ADDR. AND M177 ISOLATE SECTOR (64 BASIS). STA SECT1 XOR DCMND ISOLATE THE TRACK. ELA,CLE,ERA ALF,ALF RAL MPY SDS#T MULT. BY # 64 WD SECT/TRACK. ADA SECT1 ADD OFFSET. CLE,ERA FORM 128 WORD SECTOR # (0,1,2,,,) ADA P3 GET RECORD NUMBER (2,3,4,,,) STA NUM SAVE FOR CALL. * DIS1 LDA \FMRR SEE IF READ OR WRITE. SZA JMP READD * JSB WRITF WRITE. DEF *+6 DEF ABDCB DEF \FMRR BUFR1 NOP DEF IL DEF NUM * LDA \FMRR CHEô‚þúCK FOR END OF FILE. ADA P12 SZA JMP CHK NOT END. LDA ERR17 IRRECOVERABLE ERROR! JSB \IRER * READD JSB READF READ. DEF *+7 DABDC DEF ABDCB DEF \FMRR BUFR2 NOP DEF IL DEF LEN DEF NUM * * IGNORE -12 ERROR (EOF SENSED) ON READ: THAT RECORD * HAS NOT YET BEEN WRITTEN. BUFFER WILL CONTAIN * GARBAGE BUT OK FOR PACKING PURPOSES. * LDA \FMRR CPA N12 JMP \DSKD,I RETURN * CHK LDA DABDC JSB \CFIL CHECK FOR ERRORS. JSB \TERM ERROR - ABORT. CLA STA HEADR RESET JMP \DSKD,I NO ERROR, RETURN. * DCMND NOP SECT1 NOP NUM NOP IL DEC 128 LEN NOP N12 DEC -12 P12 DEC 12 ERR17 ASC 1,17 HEADR NOP HEADER RECORD FLAG SKP * * OUTPUT ABSOLUTE PROGRAM WORD * * \ABDO PUTS OUT THE CURRENT ABSOLUTE CODE WORD FOR THE PROGRAM * BEING LOADED. IT FILLS THE GAPS WITH ZERO CODES IF THE * CURRENT WORD FALLS BEYOND THE HIGHEST PREVIOUSLY GENERATED * WORD. * * \ABDO WORKS FROM A TABLE OF THREE WORDS WHICH DEFINE * THE CURRENT CODE SEGMENT'S DISC ADDRESS. THIS TABLE IS * AS FOLLOWS: * * ABDSK,I IS THE BASE DISC ADDRESS OF THE CURRENT CODE SEGMENT * \ABCO,I IS THE BASE CORE ADDRESS OF THE CURRENT CODE SEGMENT * \MXAB,I IS THE MAX CORE ADDRESS OBTAINED SO FAR IN THE SEGMENT * * \MXAB,I SHOULD BE INITILIZED TO \ABCO,I AND WILL BE UPDATED BY * THIS ROUTINE AS THE LOAD ADVANCES. * * THIS ROUTINE HAS NO RESTRICTIONS ON BACKING UP AND OVERLAYING. * * CALLING SEQUENCE: * A = CURRENT ABSOLUTE CODE WORD * B = CORE ADDRESS OF THE WORD * JSB \ABDO * * RETURN: A-REG HAS PREVIOUS CONTENTS OF MODIFIED WORD. * B-REG HAS CORE ADDRESS PLUS ONE * \ABDO NOP SSB IF LESS THAN ZERO THEN JMP \ABDO,I OVER FLOW OF MEM SO IGNOR * STB CASAV SAVE THE CORE ADDRESS STA INSAV WNLH AND THE CODE WORD ADB L2000 IF ADDRESS SSB IS ON THE JMP LABBP BASE PAGE GO DO SPECIAL * LDA \ABCO SAVE CURRENT BASE PRAM STA LABTM IN LOCAL TEMP LDB A,I IF THE CURRENT CORE LDA P5 ADDRESS IS LESS CPA \PTYP THAN THIS BASE AND SEG. LOAD CMB,INB,RSS JMP LAB01 NOT A SEG LOAD * ADB CASAV IF BOTH CONDITIONS TRUE SSB THEN JSB \USER SET UP TO FIX MAIN. LAB01 LDB CASAV RESTORE THE CORE ADDRESS CMB,INB COMPUTE OFFSET FROM OLD ADB \MXAB,I MAX INB AND STB LABSK SET THE SKIP COUNT (-# TO SKIP) LDA \MXAB,I GET THE CURRENT MAX INA PLUS ONE SSB,RSS IF NOT SKIPPING LDA CASAV USE GIVEN ADDRESS LDB \ABCO,I AND COMPUTE CORE CMB,INB ADDRESS OFSET ADA B FROM THE BASE ADDRESS SSA DIAGOSTIC HALT JSB \ABOR SHOULD NEVER BE NEGATIVE CLB PREPARE TO DIVIDE DIV P64 DIVIDE BY THE SECTOR SIZE ADB \ADBF SET DBUF OFFSET STB CURAD SET ADDRESS FOR TSTEL * STA B SAVE THE SECTOR COUNT sONÿÿþú LDA ABDSK,I GET THE BASE DISC ADDRESS CMB,INB,SZB,RSS SET THE COUNT NEGATIVE JMP FSTAD IF ZERO USE FIRST ADDRESS * STB ABCNT SET THE CALL COUNTER LABSA JSB \DSKA BUMP THE DISC ADDRESS ISZ ABCNT THE SPECIFIED NUMBER JMP LABSA OF TIMES * FSTAD STA NEWDA SET THE NEW DISC ADDRESS CPA \OLDA IF SAME AS OLD JMP LABIC SECTOR IS IN CORE * LDA \OLDA GET THE OLD ADDRESS LDB \ADBF AND BUFFER ADDRESS SSA,RSS IF REAL DISC ADDRESS JSB \DSKO WRITE THE BUFFER LDB LABSK GET THE SKIP COUNT CMB,INB SET POSITIVE LDA \ADBF IF FIRST WORD OF BUFFER CPA CURAD AND NOT BACKING SSB UP RSS JMP LABRD SKIP THE READ * LDB \ADBF READ IN THE SECTOR LDA NEWDA TO BE MODIFIED JSB \DSKI LABRD LDA NEWDA UPDATE THE DISC STA \OLDA ADDRESS LABIC LDA LABSK GET THE SKIP COUNT SSA,RSS IF NONE TO SKIP JMP LABOU JUST OPUTPUT THE WORD * LABFI CLA ELSE FILL JSB TSTEL WITH ZEROS ISZ LABSK DONE? JMP LABFI NO DO NEXT WORD * LABOU LDA INSAV GET THE WORD JSB TSTEL OUTPUT IT STB LBSAV SAVE PRIOR CONTENTS OF WORD LDA CASAV GET THE CORE ADDRESS LDB A IF NEW CMB,INB MAXIMUM ADB \MXAB,I THEN SSB SET STA \MXAB,I SET IT LDA LABTM RESET JSB SETDS THE PRAMETERS LDA \OLDA IF NEW MAX CMA,INA DISC ADDRESS ADA \ADSK THEN LABEX LDB CASAV INB SSA,RSS SKIP RETURN JMP LABX2 * LDA \OLDA AND STA \ADSK UP DATE THE DISC ADDRESS LABX2 LDA LBSAV SET PRIOR CONTENTS OF WORD JMP \ABDO,I AND THEN RETURN SPC 2 LABBP LDB CASAV GET THE CORE ADDRESS ADB \ADBP ADJUST FOR DUMMY xòþúBASE PAGE ADDRESS LDA B,I RETURN OLD STA LBSAV CONTENTS LDA INSAV OF WORD. STA B,I SET THE WORD CLA SET TO FOURCE EXIT JMP LABEX AND GO EXIT SPC 2 LABTM NOP NEWDA NOP \OLDA OCT -1 LABSK NOP INSAV NOP CASAV NOP ABDSK NOP \ABCO NOP \MXAB NOP LBSAV NOP USED HERE AND IN TSTEL * TO RETURN OLD VALUE OF * MODIFIED WORD. ABCNT NOP CURAD NOP L2000 OCT -2000 \ADSK NOP \PTYP NOP SKP * * SETDS SETS ABDSK,\MXAB,\ABCO TO A,A+1,A+2 * FOR USE BY \ABDO * SETDS NOP STA \ABCO SET INA THE STA \MXAB ADDRESS INA FOR STA ABDSK THE ABS OUTPUT ROUTINE JMP SETDS,I RETURN SPC 3 * \USER RESETS THE \ABDO SPECIFICATION ADDRESSES FOR * DRIVER PARTITIONS (FROM 2 ONWARD), MEMORY RESIDENT * PROGRAMS, AND DISK RESIDENT PROGRAMS * * CALLING SEQUENCE * * JSB \USER * \USER NOP LDA DUSER GET DEF TO USER ARRAY JSB SETDS AND SET IT UP JMP \USER,I RETURN SPC 3 * \USRS INITIALIZES THE \ABDO SPECIFICATION ADDRESSES FOR * \USER CODE USING THE CURRENT DISC ADDRESS,AND \PREL * FOR THE CORE ADDRESS. * * CALLING SEQUENCE: * * JSB \USRS * \USRS NOP JSB \USER SET UP THE ADDRESSES JSB SET SET UP THE ADDRESSES JMP \USRS,I RETURN SPC 2 * SET SETS THE CURRENT \PREL AND DISC ADDRESSES IN THE * CURRENT \ABDO SPECIFICATION TABLE * * CALLING SEQUENCE * * JSB SET * SET NOP LDA \ADSK GET CURRENT DISC ADDRESS STA ABDSK,I SET IT IN THE SPEC BUFFER LDA \PREL GET THE CURRENT CORE ADDRESS STA \ABCO,I AND SET STA \MXAB,I IT UP JMP SET,I RETURN SPC 2 * \SEGS SETS UP A NEW \ABDO AREA FOR SEGMENTS * THE SAÊáþúME AS \USRS. * \SEGS NOP JSB \SEG GO SET THE ADDRESSES JSB SET SET THE PRAMATERS JMP \SEGS,I RETURN SPC 2 * \SEG IS THE SEGMENT VERSION OF \USER * \SEG NOP LDA DSEGS GET THE ADDRESS JSB SETDS SET IT UP JMP \SEG,I RETURN SPC 3 * * \SYS SETS UP THE \ABDO SPECIFICATION ARRAY TO POINT AT THE * SYSTEM TABLE. * * CALLING SEQUENCE: * * JSB \SYS * \SYS NOP LDA \DSYS GET THE SYSTEM SPEC. ADDRERSS JSB SETDS SET UP THE ADDRESSES JMP \SYS,I RETURN SPC 2 \DSYS DEF *+1 OCT 2000 ***TEMP****** OCT 2000 ***TEMP****** NOP DUSER DEF *+1 BSS 3 DSEGS DEF *+1 BSS 3 SKP * * TEST FOR ABSOLUTE BUFFER FULL * * TSTEL PUTS OUT THE CURRENT ABSOLUTE BUFFER WHEN IT * CONTAINS 64 WORDS OF CODE. IN ADDITION, IT CHECKS FOR * * CALLING SEQUENCE: * A = CURRENT WORD * B = IGNORED * JSB TSTEL * * RETURN: A DESTROYED, B HAS OLD CONTENTS * OF ADDRESSED WORD. * TSTEL NOP LDB CURAD IF THE ADB N64 CURRENT ADDRESS CPB \ADBF IS THE END OF THE BUFFER JMP TSTFL THEN IT IS FULL * TSTOU LDB CURAD,I SAVE OLD WORD CONTENTS STA CURAD,I SET THE WORD ISZ CURAD BUMP THE ADDRESS JMP TSTEL,I AND RETURN * TSTFL STA SCW SAVE THE CURRENT WORD LDA \OLDA GET THE DISC ADDRESS LDB \ADBF AND BUFFER ADDRESS AND STB CURAD SET THE NEW BUFFER ADDRESS JSB \DSKO OUTPUT THE BUFFER LDA \OLDA UP DATE JSB \DSKA THE DISC STA \OLDA ADDRESS LDA SCW RESTORE THE CODE WORD JMP TSTOU AND GO OUTPUT IT * N64 DEC -64 SCW NOP \ADBF DEF *+1 DBUF BSS 64 HED RTGEN CONSTANTS AND WORKING STORAGE. * * * RTGEN CONSTANTS AND WORKING STORAGE. * P13 DEC 1316 P14 DEC 14 M77 OCT 77 P64 DEC 64 ZERO NOP M7400 OCT 177400 CMDLU NOP LSTLU NOP ERRLU DEC 1 DEFAULT VALUE \IACM NOP INTERACTIVE COMMAND DEVICE, 0=NO, 1=YES IALST NOP INTERACTIVE LIST DEVICE, 0=NO, 1=YES SECTK NOP DSKLU NOP \MRT2 NOP IIF MR'S ACCESS TABLE AREA II \TMSK NOP \CPLB NOP \ASKY NOP ADDR OF 1ST SHORT ID'S KEY WORD. \SSID NOP \SKYA NOP SPC 3 \DPR2 DEF PARS2 . EQU * PARS1 BSS 4 .. EQU * PARS2 BSS 1 PRS21 BSS 3 PARS3 BSS 1 PRS31 BSS 3 PARS4 BSS 1 PRS41 BSS 3 PARS5 BSS 1 PRS51 BSS 3 SPC 1 ORG . \BPAR BSS 21 ORG .. PARSA BSS 21 SPC 3 * * DEFINE DCB'S * \LDCB BSS 144 \EDCB BSS 144 \RDCB BSS 144 \IDCB BSS 3 INDB3 BSS 141 \NDCB BSS 144 \BDCB BSS 144 * SPC 2 END EQU * END START èÕÿÿþúASMB,R,L,C HED RTGN1 - 7900 SUBROUTINE SEGMENT. NAM RT4G1,5,90 92067-16009 REV.1926 790427 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G1 * SOURCE: 92067-18009 * RELOC: 92067-16009 * WRITTEN BY: KFH, JH, GAA * ****************************************************************** * * * ENTRY POINTS: * ENT \DST0,\BOT0 ENT \TB31 ENT \FSC0 * * * * EXTERNAL UTILITY SUBROUTINES: * EXT WRITF EXT \CRET,\FMRR,\CFIL,\DSKD EXT \MESS,\SRET,\RNME EXT \DCON,\SPAC,\READ,\GETN,\GINT,\GET#,\GETC EXT \INER,\YENO,\LSTE,\LSTS,\ABOR,\ABDO EXT \PREL EXT \PIOC,\TBCH * * EXT \LST5,\OBUF EXT \TBUF,\BDCB * A EQU 0 B EQU 1 SUP SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * BEG00 EQU * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDROÉþúESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT &þú KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 ¬Øþú CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDR‹ þúESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP BEGIN JMP \SRET SEÖþúGMENT'S ENTRY POINT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 2, MES1 DEF *+1 ASC 15,# TRKS, FIRST TRK ON SUBCHNL: * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E "?0" ASC 1,?0 MES5 DEF MES05 MES7 DEF MES07 TTEMP NOP STEMP NOP P23 DEC 23 N8 DEC -8 * ATB30 DEF TB30 HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST TRK ON SUBCHNL: * 0? * . ENTER TWO 3 DIGIT DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 7? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT SPC 3 \DST0 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB31 PUT TB31 IN THE LST JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHN SET DISK CHNL # FOR BOOTSTRAP. STA DCHNL SET DISK CHNL # ADA N8 MUST BE >= TO 10 OCTAL SSA,RSS JMP STB30-1 JSB \INER JMP CHNLD * JSB \SPAC SET UP TRACK MAP STB30 LDA P29 SEND MESSAGE: LDB MES1 # TRKS, FIRST TRK ON SUBCHNL: JSB \MESS PRINT MESSAGE LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT *TEMP„þú* STA INTMP AND CLEAR LOOPS ADA P8 SET # TRACKS ADDRESS STA TTEMP * TEMP * LDB N16 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT ADB "?0" ADD CONSTANT TO GET ?X BLF,BLF AND ROTATE TO GET X? STB MS3+2 SET IN MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P4 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N3 CONVERT 3 DIGITS JSB \GET# DECIMAL JMP TB30E ERROR - * STA TTEMP,I SET # TRACKS SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB \DCON 3 DECIMAL DIGITS AND CONVERT JMP TB30E+1 ERROR * STA STEMP,I SET FIRST TRACK OF CHANNEL LDA TTEMP,I GET CHANNEL SIZE STA DSIZE SET SYSTEM LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ TTEMP ADDRESSES ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P8 IS 8 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 8 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR CLA CLEAR STA TTEMP,I CURRENT # TRACKS JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ˆ•þú ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL * ADB M7400 IF GREATER THEN 256, CMB,SSB,INB,SZB RSS THEN ERROR JMP SETEM+1 JSB \INER SEND ERROR DIAGNOSTIC JMP ISYSC * SETEM CLA LDB ATB30 EXTRACT INFO ADB A CONCERNING SYSTEM LDB B,I SUBCHANNEL STB T#AC0 AND STORE VALUES FOR BOOT STB TBASE STARTING TRACK # * LDB A CLE,ERB STB UN#IT STB U#NIT * XOR P1 SET PLATTER NUMBER. ALF,ALF RAL STA H#AD STA B#MSK * LDA S#EKC ADA B STA S#EKC SET HEAD # IN SEEK COMMAND STA SKCMD * LDA R#DCM ADA B STA R#DCM AND IN THE \READ COMMAND STA R#CMD SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF RESTORE THE SIZE TO A AND Çþú STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SPC 1 AUX2 ADB M7400 IF SIZE IS GREATER CMB,SSB,INB,SZB JMP AUX4 THAN 256, THEN ERROR * STA AUXCH SET AUX CHANNEL LDA P96 SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 STSCR JMP \DST0,I RETURN TO MAIN LINE CODE * P96 DEC 96 M7400 OCT 177400 SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB \SPAC NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB \READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP #SEC1 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * þú CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A TEST FOR VALID SUBCHANNEL # ADB N8 SSB,RSS JMP TSTER NO GOOD * LDB ATB30 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB P8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA \TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHN INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ \TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * SPC 2 DCHN NOP HPDSK DEF I/OTB,I ADDRESS OF I/O INSTR LIST #DATA ABS I/OTB-I/OTC # OF DATA I/O INSTR #CMND ABS I/OTC-I/OTD # OF COMMAND I/O INSTR I/OTB DEF DSKDJ DATA CHANNEL DEF DSKDK DEF DSKDL DEF DSKDM DEF DSKDN DEF DSKDO DEF DSKPU*þúP DEF DSKDQ DEF DSKDR DEF DSKDS DEF DSKDZ I/OTC DEF DSKCL COMMAND CHANNEL DEF DSKCM DEF DSKCP DEF DSKCQ DEF DSKCR DEF DSKCS DEF DSKCT DEF DSKCU DEF DSKCV I/OTD EQU * HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION \BOT0 NOP CONFIGURE PAPER TAPE BOOTSTRAP LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES ISZ DCHN STEP TO COMMAND CHANNEL LDA #CMND GET NUMBER OF COMMAND CHANNEL INSTRUCTIONS JSB STDSK SET COMMAND CHANNEL ADDRESSES * LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR M0760 ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT * * SEND BOOT EXTENSION TO OUTPUT FILE * LDB ABOOT OUTPUT THE BOOT EXT ENSION CLA,CLE TO PSEUDO TRACK 0 SECTOR 0 JSB \DSKD IN CORE IMAGE OUTPUT FILE. SKP BOOT0 JSB \SPAC NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB \RNME GET THE NAME. * JSB \GINT IF 0 ANSWER, THEN CLA,INA NO BOOT WANTED JSB \GETN CPA ZERO JMP \BOT0,I * JSB \CRET CREATE BOOT FILE. DEF *+5 DEF \BDCB DEF P1 DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS. JMP BOOT0 ERROR- TRY AGAIN. * LDA NBLC GET BOOT LENGTH STA \TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ \TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE. DEF *+5 DEF \BDCB Q—þú DEF \FMRR DEF STRAP+1 DEF BOOTL * LDA \BDCB+2 IF ITS A TYPE 0 FILE SZA THEN WRITE AN EOF JMP \BOT0,I NO JSB WRITF DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF N1 JMP \BOT0,I RETURN TO MAIN. SPC 2 MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? P7 DEC 7 N1 DEC -1 M2300 OCT 2300 ZERO OCT 60 P6144 DEC 6144 P24 DEC 24 * SKP * GENERATE $TB31 TRACK MAP TABLE. * \TB31 NOP * GENERATE TB31 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA N16 GET NUMBER OF WORDS STA \TBUF+1 SET COUNT LDB $TB31 GET THE LST ENTRY JSB \LSTS FOR $TB31 JSB \ABOR BAD NEWS NO $TB31 ????? LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE * DSTB1 LDA \TBUF,I GET WORD FROM TABLE JSB \ABDO SEND TO DISC ISZ \TBUF STEP TABLE ADDRESS ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TO CMB,INB WRITE HEADER RECORD #2 CCA,CLE CONTAINING THE JSB \DSKD TRACK MAP TABLE IMAGE JMP \TB31,I EXIT * $TB31 DEF *+1 ASC 3,$TB31 * SKP * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * * \FSC0 NOP LDB ABOOT GET THE CLA,CCE BOOT FROM JSB \DSKD THE DISC LDB LWSLB STORE HIGH ADDRESS OF SYSTEM STB HIGH IN BOOT LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB \DSKD BACK TO THE DISC ´òNLH CLE DLD \OBUF FLUSH THE FINAL BUFFER. ELA,CLE FROM CORE JSB \DSKD * * STORE THE SYSTEM SUBCHANNEL INFORMATION IN THE FIRST * 6 WORDS OF HEADER RECORD #1, THEN WRITE IT. * * LDA SYSCH SET WORDS 1-6 IOR MSIGN SIGNAL AN RTE-IV SYSTEM FOR SWTCH STA TB30 SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 SYSTEM EQT # LDA CEQT STA TB30+2 # OF EQT'S LDA \PIOC STA TB30+3 PRIV INT CHANNEL LDA \TBCH STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET THE # OF DEFINED SUBCHANNELS BLF,BLF ROTATE TO HIGH BYTE IOR B MERGE WITH TTY CHANNEL STA TB30+5 AND SAVE LDB ATB30 CMB,INB CLA,CLE JSB \DSKD WRITE IT OUT * JMP \FSC0,I RETURN HED RTGN1 CONSTANTS AND WORKING STORAGE. N2 DEC -2 N3 DEC -3 N16 DEC -16 P1 DEC 1 P2 DEC 2 P4 DEC 4 P6 DEC 6 P8 DEC 8 P13 DEC 13 P15 DEC 15 P17 DEC 17 Ÿ4NÿÿþúP25 DEC 25 P29 DEC 29 P31 DEC 31 M77 OCT 77 M0760 OCT 76000 M1777 OCT 1777 M7700 OCT 177700 M1177 OCT 101777 BLANK OCT 40 MSIGN OCT 100000 * BSS BEG00+1600B-* SKP HED RT4GN DISC DRIVE I/O INSTRUCTION ADDRESSES HED RT4GN ** TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES, READ CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 GET DISC SC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+STIO+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+STIO+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ABS STB-O+STIO+I+I YES, THEN STORE IT BACK ABS ISZ-O+STIO MOVE ON TO THE NEXT INSTR ABS LDA-O+STIO ABS CPA-O+ENIO ALL DISC IO INSTR CONFIGURED? CLB,INB,RSS YES,SET B TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE THE NEXT ONE * ABS LDA-O+TBASE GET ABSOLUTE TRACK # ABS STA-O+T#ACK SAVE FOR ADDRESSSING ABS LDA-O+N#WDS SLOAD ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS N8%þúEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT RSS SKIP ADDRESS OF BENT ABS 2000B+BENT-OO DEFINE ADDRESS OF BENT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDA-O+T#ACK GET THE TRACK ADDRESS DSKDA OTA 0 AND SEND DSKDB STC 0,C IT ABS LDA-O+SKCMD GET THE SEEK DSKCA CLC 1 COMMAND AND DSKCB OTA 1 SEND IT DSKCC STC 1,C START SEEK ABS ADB-O+N#SCT SUBTRACK NUMBER PER SIDE SSB,RSS IF SIDE TWO ABS ADB-O+B400 ADD HEAD BIT SSB ELSE ABS ADB-O+P#SCT ADD BACK TO GET SECTOR ABS ADB-O+B#MSK ADD THE SUBCHANNEL HEAD BIT DSKDC SFS 0 WAIT FOR TRACK ABS JMP-O+DSKDC * DSKDD OTB 0 SEND HEAD/SECTOR WORD DSKDE STC 0,C TELL THE CONTROLLER ABS LDA-O+R#CMD GET THE READ COMMAND DSKCD SFS 0 WAIT FOR SEEK ABS JMP-O+DSKCD * DSKCE OTA 1 SEND READ COMMAND DSKDF STC 0,C SET UP FOR READ DSKCF CLC 1 STC 6,C START DMA DSKCG STC 1,C START READ DSKCH SFS 1 WAIT FOR END ABS JMP-O+DSKCH * STF 6 DISABLE DMA FOR STATUS DSKDG STC 0,C DO ABS LDA-O+U#NIT STATUS DSKCI CLC 1 DSKCJ OTA 1 ON UNIT DSKCK STC 1,C DSKDH SFS 0 WAIT FOR STATUS ABS JMP-O+DSKDH * DSKDI LIA 0 GET STATUS SLA,RSS IF BAD ABS JMP-O+GDST STATUS GOOD HLT31 HLT 31B STATUS HALT ABS JMP-O+HLT31 PREVENT FOR RESTARTING * GDST CLB SET SECTOR TO ZERO FOR REST OF SEGMENT ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS CLA AND ABS JMP-O+SLOAD ¢¶þú GO LOAD * * DATA AREA T#ACK DEC -128 MOVE COUNT FOR BBDL MOVE B400 OCT 400 P#WDS OCT 77600 N#WDS DEC -128 RECNT OCT 77600 CONFIGURED TO BBL ADDRESS #WDTK DEC 6144 SKCMD OCT 30000 P#SCT DEC 24 # OF SECTORS PER TRACK ON ONE SURFACE N#SCT DEC -24 B#MSK NOP SET BY THE GENERATOR R#CMD OCT 20000 U#NIT NOP SET BY THE GENERATOR SPCAD ABS 2000B-OO+START ADDRESS OF BOOT BEFORE RELOCATION TBASE NOP FIRST TRACK#-MUST BE AT START+143B FOR SWTCH STIO ABS 76000B-O+DSKDA START OF IO INSTRUCTIONS ENIO ABS 76000B-O+DSKDI+1 END OF I/O INSTRUCTIONS IOMSK OCT 172076 IOG OCT 102000 B77 OCT 77 HIGH NOP SC NOP * * BSS 2 CORRECT OFFSET FOR SWTCH * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 SET IN THE SWITCH REG? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THE REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+T#ACK DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+P#WDS+I+I YES GO EXECUTE THE BOOT * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADöþúA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP CPA EQU 052000B CPA I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED RT4GN PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. * SPC 3 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIMIT LIA 1 READ CONTENTS OF SWITCH REGISTER SSA,RSS RECONFIGURATION DESIRED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG ELA,CLE,ERA YES, CLEAR SIGN BIT CLB LSR 6 DISC SC IN THE A REG SZA,RSS SPECIFIED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG STA DSKSC-ADCON SAVE IT LDA DATA#-ADCON GET THE # OF DATA CHANNEL INSTRUCTIONS LDB DSKAD-ADCON GET THE ADDRESS OF I/O INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE DATA CHANNEL ISZ DSKSC-ADCON COMMAND CHANNEL LDA CMND#-ADCON GET # OF COMMAND CHANNEL INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE COMMAND CHANNEL JMP CNTNU-ADCON * SETDS LDA DSKDJ-ADCON ISOLATE CURRENT DISC SELECT CODE # AND DSKSC-ADCON ALF RAL,RAL MOVE IT TO BITS 6-11 STA DSKSC-ADCON SAVE IT LIA 1 READ SWITCH REGISTER CONTENTS AND CLRDS-ADCON CLEAR BITS 6-11 IOR DSKSC-ADCON INSERT DISC SC # IN BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA T#AC0-ADCON SEEK DSKDJ OTA 0 TO DSKDK STC 0,C FIRST üþúSYSTEM LDA S#EKC-ADCON TRACK DSKCL OTA 1 DSKCM STC 1,C AND DSKDS SFS 0 JMP *-1-ADCON HEAD * LDA H#AD-ADCON DSKDL OTA 0 START DSKDM STC 0,C SEEK LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 DSKDZ SFS 1 WAIT FOR JMP *-1-ADCON SEEK * LDA R#DCM-ADCON SET DSKCP CLC 1 UP DSKCQ OTA 1 THE DSKDN STC 0,C \READ STC 6,C DSKCR STC 1,C START \READ DSKCS SFS 1 WAIT JMP *-1-ADCON FOR IT * STF 6 CLEAR DMA FOR STATUS DSKDO STC 0,C DO LDA UN#IT-ADCON STATUS DSKCT CLC 1 DSKCU OTA 1 DSKCV STC 1,C DSKPP SFS 0 WAIT FOR JMP *-1-ADCON STATUS * DSKDQ LIA 0 RBL,CLE,ERB REMOVE SIGN BIT FROM ADDRESS SLA,RSS ANY ERRORS? JMP BTEXT-ADCON NO, GET READY TO GO TO THE EXTENSION * CPA JSTLD-ADCON IS THIS THE FIRST TIME? RSS YES, TRY AGAIN. HLT 11B NO HALT JMP S#ART-ADCON RETRY ON RESTART * BTEXT STB A CLEAR B REG FOR THE BOOT EXTENSION CLB JMP A,I GO EXECUTE THE BOOT EXTENSION * JSTLD OCT 040001 DM128 DEC -128 BADDD ABS START-O BADD ABS START-O+I+I THESE UN#IT NOP SEVEN H#AD NOP WORDS S#EKC OCT 30000 ARE R#DCM OCT 20000 SET BY DSKDR OCT 120000 THE T#AC0 NOP GENERATOR MASK OCT 177700 DSKSC OCT 77 CLRDS OCT 170077 I#OTB DEF DSKDJ-ADCON DATA CHANNEL DEF DSKDK-ADCON DEF DSKDL-ADCON DEF DSKDM-ADCON DEF DSKDN-ADCON DEF DSKDO-ADCON DEF DSKPP-ADCON DEF DSKDQ-ADCON DEF DSKDR-ADCON DEF DSKDS-ADCON DEF DSKDZ-ADCON I#OTC DEF DSKCL-ADCON COMMAND CHANNEL DEF DSKCM-ADCON DEF DSKCP-ADCON DEF œÙ$"DSKCQ-ADCON DEF DSKCR-ADCON DEF DSKCS-ADCON DEF DSKCT-ADCON DEF DSKCU-ADCON DEF DSKCV-ADCON I#OTD EQU * * DSKAD DEF I#OTB-ADCON,I ADDRESS OF IO INSTR LIST DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTR CMND# ABS I#OTC-I#OTD # OF COMMAND I/O INSTR * * CNFIG NOP STA LIMIT-ADCON SAVE # OF INSTR CLOOP LDA B,I GET INSTR WORD AND MASK-ADCON CLEAR LOW 6 BITS IOR DSKSC-ADCON ADD NEW DISC SELECT CODE STA B,I RESTORE INSTR WORD INB ISZ LIMIT-ADCON JMP CLOOP-ADCON CONFIGURE NEXT INSTR HNDR JMP CNFIG-ADCON,I RETURN * SPC 1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION * END EQU * * END BEGIN YJ$ÿÿþúASMB,R,L,C HED RT4G2 - PROGRAM INPUT PHASE SEGMENT NAM RT4G2,5,90 92067-16009 REV.1926 790427 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G2 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, JC, GAA, EJW * ****************************************************************** SPC 1 ENT \PIP * * EXTERNAL REFERENCE NAMES * EXT \LST1,\LST4,\LST5 EXT \CURL,\LBUF,\TBUF EXT \BPAR,\DPR2 EXT \PRMT,\LSTS,\ILST,\LSTX,\LSTE EXT \TLST,\PLST,\TIDN,\PIDN EXT \INID,\IDXS,\IDX EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 EXT \ID12,\ID13,\ID14,\ID15,\ID16 EXT \SRET,\RBIN EXT \RDCB,\CLOS,\ABOR EXT \GNER,\MESS,\SPAC,\TERM EXT \OCTN,\BUFL,\TCHR EXT \READ,\GETN,\GETC,\GET# EXT \NDCB,\FMRR,\CFIL,\RNAM EXT READF,WRITF EXT LOCF,RWNDF,APOSN EXT \NAMN,\NAMB,\NAMO EXT \IACM,\TRCM,\TRCH * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * ýíþú SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 Âþú ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MA&þúIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 M•þú LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * µLþú********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP LSWAP NOP * * RESOLVE ANY ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA BLINE SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ BLINE DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. SPC 1 N DEC -5 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 DNAM DEF \LBUF+3 DRDCB DEF \RDCB+0 DNDCB DEF \NDCB+0 SKP * * BEGIN PROGRAM INPUT PHASE (UNDER COMMAND CONTROL). * \PIP NOP JSB \SPAC JSB \SPAC LDA P17 LDB MESS7 JSB \MESS "PROG INPUT PHASE:" LDA \PLST SET BOTTOM OF PROGRAM STA SLST DEFINED LST (INDEX #) * JSB PRCMD PROCESS OPERATOR COMMANDS. * CLA STA SCH1 STA SCH4 * * CLEAR UNDEFINED EXTS AND SET TO TYPE 5 * LDA SLST INITIALIZE \LSTX STA \TLST IGNOR PREDEFINED ENTRIES CLST3 JSB \LSTX SET LST ADDRESSES JMP ENDLB SET USAGE FLAGS * LDA \LST4,I GET IDENT INDEX CMA,INA SSA SKIP - UNDEFINED EXT JMP CLST3 IGNORE DEFINED ENTRY POINT * LDA P5 SET UNDEFINEDS TO ZERO REPLACE ENTS STA \LST4,I SET TYPE UNDEFINED CLB STB \LST5,I CLEAR VALUE JMP CLST3 TRY NEXT LST ENTRY * ENDLB LDB D$LIR FIND THE LIBRARY JSB \LSTS ENTRY POINTS $LIBR JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 Öþú STA $LIBR SAVE FOR THE LOADER * LDB D$LIX DO SAME THING FOR $LIBX JSB \LSTS JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 STA $LIBX * JMP PARAM GO DO PARAM INPUT PHASE. * ER57 STB ENDLB SAVE ASCII ADDRESS IN TEMP LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER LDB ENDLB GET IT BACK LDA P5 CHARACTER COUNT JSB \MESS PRINT ENTRY POINT JSB \TERM ABORT ERR57 ASC 1,57 * * D$LIR DEF *+1 ASC 3,$LIBR D$LIX DEF *+1 ASC 3,$LIBX * P17 DEC 17 MESS7 DEF *+1 ASC 9,PROG INPUT PHASE: N1 DEC -1 SKP SPC 1 ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA ALBUF STA BLINE-1 LDA MD24 LDB BLANK STB BLINE-1,I ISZ BLINE-1 INA,SZA JMP *-3 JMP BLINE,I ***** STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS OR A COMMENT TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB N2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONEpfþú, IS IT A COMMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP CCA ADA QQCNT DECREMENT CHAR COUNT STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB N1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * ** PRCMD ** MAIN ENTRY POINT - CONTROL IS PASSED TO NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS OPERATOR COMMANDS. NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN COMST JMP'S HERE VIA NXTCM+1 LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * ***** CMER LDA ERR06 JSB \GNER JMP NXTCM GET NEXT COMMAND FROM TTY * ERR06 ASC 1,06 SKP ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND PNEUMONIC TABLE. * ***** PTABL DEF * DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST REL STATEMENT DEF DSPST DISPLAY STATEMENT DEF EOL /Eµæþú STATEMENT DEF LNKST LINKS STATEMENT ***** * * COMMAND PNEUMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE RELOCATE APPEARS BEFORE REL) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+ARELC-CMTBL REL ABS 3400B+ADISP-CMTBL DISPLAY ABS 1000B+AEND.-CMTBL /E ABS 2400B+ALINK-CMTBL LINKS CTABN EQU * LTABS ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ABS 1400B+AALL.-CMTBL ALL ITAB ABS 1000B+AIN..-CMTBL IN BTAB ABS 2000B+ABASE-CMTBL BASE CPTAB ABS 3400B+ACURN-CMTBL CURRENT TTAB ABS 1000B+ATR..-CMTBL TR ITABL DEF ITAB BTABL DEF BTAB CPTBL DEF CPTAB LTABL DEF LTABS MTABL DEF MTABS TTABL DEF TTAB ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS AOFF. ASC 2,OFF AALL. ASC 2,ALL AEND. ASC 1,/E AIN.. ASC 1,IN ACURN ASC 4,CURRENT ABASE ASC 2,BASE ATR.. ASC 1,TR * HYADD DEF *+1 PRPTA ASC 1,- * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP SKP * * SCANNER ROUTINE * ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR K¸¾þúEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? § þú SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I SKP * * INPUT COMMAND LINE * ***** * ** CMDIN ** INPUT NEXT COMMAND LINE * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR JSB \PRMT SEND \PRMT,READ REPLY DEF *+6 DEF PRPTA DEF P1 DEF QIBUF DEF D72 DEF \BPAR STA QQCHC JSB NXTC KLUDGE HERE JMP CMDIN+1 IF FIRST CHARACTER A *, OR IT'S CLA A BLANK LINE, THEN GO GET NEXT LINE STA QQCNT OTHERWISE RE-INIT POINTERS LDA QBUFA STA QQPTR JMP CMDIN,I AND RETURN * MOVE3 NOP SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBE„¸þúRED CHAR? RSS JMP MOVE.,I NO, BUFFER IS OK IOR B40 NO,APPEND A BLLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I SPC 1 SKP * * ****COMMAND PROCESSORS**** * ***** * ** REL COMMAND PROCESSOR. * ***** RELST CLA STA NREC CLEAR #GOOD RECORDS COUNTER STA RIC STA XNAM STA SERFG INA STA POSIN SIGNAL \RBIN TO CALL LOCF. JSB \CLOS CLOSE OPEN REL INPUT FILE...IF NOT CLOSED. DEF *+2 DEF \RDCB+0 JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 IS IT A COMMA? JMP CHFNM YES...CHECK FILENAME FURTHER CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. MOVE MODULE NAME INTO XNAM BUFFER * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? RSS YES JMP CMER NO, ERROR JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 COMMA? RSS YES JMP CMER NO,ERROR * CHFNM JSB NXTC GET THE FIRST FILENAME CHAR JMP CMER NO MORE CPA B54 COMMA? JMP CMER FILENAME PARAMETER MUST BE THERE CPA B53 PLUS? ( MINUS ALREADY SKIPPED) JMP CMER INVALID * LDB A NOW CHECK IF NUMERIC ADB L60 >= "1" ? SSB JMP LDRIN OK LDB A ADB L73 < A ":"? SSB,RSS JMP LDRIN OK JMP CMER LU CAN'T BE USED * B53 OCT 53 + L60 OCT -60 L73 OCT -73 XNAMA DEF XNAM SKP * ** DISPLAY COMMAND PROCESSOR * ***** DSPST LDA \IACM IF COMMANDS ARE FROM AND INTERACTIVE STA TIACM DEVICE, SZA JMP DISDN THEN DISPLAY ALREADY GOES TO THEM›NLH LDA \TRCM ELSE SIMULATE A "TR,ERRLU" LDB P6 JSB \TRCH * DISDN JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA ALBUF MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA N2 LDB LTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA B2 UNDEFS? JMP OLSTU CPA P1 TABLE? JMP OLSTE JMP CMER ERROR. SPC 2 DSP10 LDB ALBUF JSB \LSTS SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB \LST5,I GET VALUE LDA \LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA \LBUF+2 LDA DNAM JSB CONV CONVERT THE VALUE TO ASCII LDA P12 DSP25 LDB ALBUF JSB \MESS PRINT THE LINE DSP27 LDA TIACM DETERMINE STATE BEFORE THE DISPLAY SZA JMP NXTCM WAS ALREADY INTERACTIVE LDA \TRCM MUST POP THE "TR,ERRLU" ÁÜNÿÿþú LDB B2 WE PUT THERE JSB \TRCH WITH A "TR" ONLY JMP NXTCM * DSP30 LDA DSP40 MOVE "UNDEFINED" TO LBUF LDB DNAM MVW P5 LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED TIACM NOP TEMPORARY STORAGE OF \IACM * OLSTE CLA,INA,RSS ENTRY POINT LIST OPTION. OLSTU CLA LIST UNDEFINED SYMBOLS OPTION. STA TEMP2 SAVE LIST TYPE CLA CLEAR 'TR' INDICATOR STA MRP# SAVE *TEMP* JSB DELIM ADVANCE PAST DELIMITERS CCA SEARCH FOR LDB TTABL A TR AFTER THE DISPLAY JSB SCAN RSS NONE ISZ MRP# YES, A TR WAS DESIRED LDA TEMP2 GET LIST TYPE AGAIN JSB EPL DO LISTING LDB TEMP2 WERE UNDEFS SZB PRINTED JMP DSP27 NO SZA,RSS WERE THERE ANY? JMP DSP27 NO LDA MRP# DID THEY WANT A TR DONE? SZA JMP NXTCM YES, DO DON'T POP STACK JMP DSP27 NO, SEE IF WE DID A TR TO DISPLAY SKP * ** MAP COMMAND PROCESSOR * * MAPMD--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS ***** MAPST LDA N5 LDB MTABL JSB SCAN JMP CMER STA B LDA MAPMD CPB P1 MODULES? IOR B2 SET BIT 1 CPB B2 GLOBALS? IOR P1 SET BIT 0 CPB P3 LINKS? IOR P4 SET BIT 2 CPB P4 OFF? CLA RESET POINTER CPB P5 ALL? IOR B7 SET BITS 2-0 STA MAPMD JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAPST JMP NXTCM GET NEXT COMMAND SPC 1 STMP NOP SVAL NOP SKP * ** LINKS IN ** COMMAND PROCESSOR. * ***** LNKST CCA LDB ITABL JSB SCAN LOOK FOR "IN" JMP CMER CCA LDB BTABL JSB SCAN LOOK FOR "BASE" JMP *+3 6>þúNO. CLA YES. JMP LNK01 CCA LDB CPTBL JSB SCAN LOOK FOR "CURRENT" JMP CMER NEITHER. CLA,INA LNK01 STA LNKMD 0=BASE, 1=CURRENT. JMP NXTCM * SKP * ***** * ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP NXTC+1 GET ANOTHER CHARACTER ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I B55 OCT 55 SKP * * RECORD PROCESSING CONTROL * ******************************************************************** * THE TRANSFER OF CONTROL TO THE APPROPRIATE RECORD PROCESSORS IS * MADE FROM THIS SECTION. ******************************************************************** * LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA P5 JMP NXTCM GET NEXT COMMAND INCHK LDA ALBUF GET BUFFER WHERE TO PUT REL. LDB POSIN GET \RBIN FLAG. JSB \RBIN GET NEXT RELOCATABLE RECORD JMP CMER FILE ERROR ON INPUT SZA,RSS EOF? JMP NXTCM END OF FILE. * * CHECK FOR LEGAL RECORD TYPE * STA TEMP1 SAVE RECORD LENGTH CLA CLEAR \RBIN FLAG. STA POSIN LDA \LBUF+1 GET TYPE WORD ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE STA RIC SAVE FOR PROCESSING SZA IF RIC=0 ADA N7 OR GREATER THAN 6 SSA,RSS ERROR? JMP RCERR YES * * TEST CHECKSUM * LDB \LBUF GET RECORD LENGTH BLF,BLF ROTATE TO LOW B CPB TEMP1 MUST BE SAME AS RETURNED BY \RBIN RSS JMP CKERR NO - ASSUME CHECKSUM ERROR CMB,INB SET TO NEGATIVE ADB P3 úäþú ADD 3 FOR WORD COUNT IN CHECKSUM SSB,RSS TEST FOR SHORT (1,3) RECORD JMP RCERR SHORT LDA ALBUF GET BUFFER ADDRESS JSB CKSUM COMPUTE CHECKSUM CPA \LBUF+2 TEST WITH GIVEN CHECKSUM JMP LDRC OK, PROCESS RECORD * CKERR LDA ERR14 GET ERROR CODE JMP ERCOV AND SEND DIAGNOSTIC ERR14 ASC 1,14 * RCERR LDA ERR04 YES...TELL THEM ILLEGAL RECORD JMP ERCOV GO TEST & PRINT MESSAGE. * * PROCESS VALID RECORD * LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFG CPA P1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. CPA P5 IF END RECORD THEN PROCESS IT JMP ENDR SSB SKIP RECORD IF NOT LOADING. JMP INCHK CPA B2 IF RIC = 2, JMP ENTR GO PROCESS ENT RECORD. CPA P3 IF RIC = 3, GO TO JMP DBLR DBL RECORD PROCESSOR. CPA P4 EXT? JMP EXTR EXT RECORD PROCESSOR. CPA P6 EMA?? JMP EMAR GO PROCESS EMA RECORD * * PROCESSING FOR END RECORD. * ENDR CLA CLEAR FLAG FOR STA NAMR. NAM RECORD EXPECTED. STA SERFG SET PROG LOAD FLAG = LOADING INA STA POSIN SIGNAL \RBIN TO CALL LOCF SSB B STILL IS OLD SERFG JMP INCHK SKIP THIS END RECORD * * PROCESS END RECORD AND \LBUF+1 ISOLATE M/S RAR MOVE M/S TO SIGN POSITION IOR \ID4,I ADD TO COMMON SIZE STA \ID4,I SET M/S * LDA LWH1 COMPILED PROGRAM? SZA,RSS SKIP IF YES. JMP END2 * * SET NEW LENGTH OF COMPILED PROGRAM. * JSB LOCF SAVE CURRENT POSITION IN FILE. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS JSB \CFIL IN CASE OF FILE ERRO&åþúR JSB \TERM * LDA ACBUF READ NAM REC INTO CBUF. CCB JSB \RNAM JSB \ABOR ERROR. * LDA CBUF IF 9 WORD RECORD, MAKE ALF,ALF IT 17 WORDS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF * LDA LWH2 STORE PROGRAM LENGTH. IOR SIGN SET "COMPILED" BIT. STA CBUF+6 LDA ACBUF GET NAM BUFFER ADDRESS JSB CKSUM COMPUTE & STORE NEW CHECKSUM. STA CBUF+2 * JSB WRITF WRITE RECORD TO NEW NAM FILE. DEF *+5 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM \ABOR IF WRITE ERROR. * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * JSB APOSN RESTORE FILE POSITION. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM * END2 LDA XNAM IF XNAM ZERO, SZA CONTINUE PROCESSING RECORDS, JMP NXTCM ELSE GET NEXT COMMAND. JMP INCHK SKP * * PRELIMINARY NAM RECORD PROCESSING * ***** * * THIS PROCESSING OF NAM RECORDS OCCURS BEFORE DECIDING * WHETHER OR NOT TO RELOCATE A MODULE * ***** LDRC3 LDB NAMR. IS NAM 1ST RECORD? SZB IS NAM 1ST RECORD? JMP NMERR NO--SEQUENCE ERROR. LDB XNAMA LDA B,I SZA,RSS WAS A MODULE NAME SPECIFIED? JMP L.DC4 NO. CPA \LBUF+3 YES--DOES THIS MODULE MATCH THE NAME? INB,RSS JMP LDRC6 NO--SKIP IT LDA B,I CPA \LBUF+4 INB,RSS JMP LDRC6 LDA B,I XOR \LBUF+5 AND UPCM SZA JMP LDRC6 L.DC4 CLA STA SERFG CLEAR LOADING FLAG. ISZ NAMR. NAM NOT EXPECTED. JMP NA³ÀþúMR GO PROCESS NAM RECORD. * * RESET PROCESSING - PROGRAM FROM LIBRARY IS * TO BE DISCARDED. LDRC6 CLA STA NAMR. CCA STA SERFG RECORD SKIPPING MODE. JMP INCHK * NMERR LDA ERR03 MISSING END RECORD JMP ERCOV SKP * * CONSTANTS AND STORAGE FOR MAIN CONTROL SECTION * NREC NOP #GOOD RECORDS COUNTER. RIC OCT 0 HOLDS RECORD IDENTIFICATION CODE UPCM OCT 77400 UPPER CHARACTER MASK. SERFG NOP PROG LOAD FLAG: -1/0=NL/L. NAMR. NOP "NAM REC EXPECTED" FLAG. * D72 DEC 72 * ERR04 ASC 1,04 ERR03 ASC 1,03 * XNAM BSS 3 * BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) NBUF BSS 6 POSIN OCT 0 POSITIONING CODE FOR \RBIN SUBR. SKP * NAM RECORD PROCESSOR * NAMR LDA \PIDN SAVE CURRENT IDENT AND STA BUID LST ENTRY INDICES. LDA \PLST STA BULST FOR POSSIBLE MODULE PURGE LDB DNAM GET NAME ADDRESS JSB \IDXS SEARCH FOR THE ENTRY JMP ENTNA ENTER NAME * LDA ERR08 GET ERROR CODE - DUPLICATE NAMES CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET ADDRESS OF NAME IN IDENT JSB \MESS PRINT DUPLICATE PROG. NAME * JSB FINDN DID IT HAVE A MODIFIED NAM RECORD? JMP REPNA NO CLA,INA INVALIDATE THE RECORD LDB ACBUF ADB P3 STA B,I BY OVERWRITING THE NAME JSB NEWNM AND REWRITE THE RECORD JMP REPNA REPLACE REST OF IDENT * "DV" ASC 1,DV * ENTNA LDA \LBUF+3 GET NAME 1,2 STA \ID1,I SET NAME 1,2 IN IDENT CLE CLEAR DRIVER FLAG CPA "DV" WANT TO SET \ID8,I CCE IF ONE LDA \LBUF+4 GET NAME 3,4 STA \ID2,I SET NAME 3,4 IN IDENT LDA \LBUF+5 GET NAME 5 AND M7400 SAVE UPPER CHAR STA \ID3,IýÅþú SET NAME 5 IN IDENT ISZ \PIDN BUMP IDENT COUNTER. * REPNA LDA \LBUF+9 GET PROGRAM TYPE AND M177 ISOLATE TYPE STA \ID6,I SET TYPE IN IDENT SZA IF NOT A DRIVER CLE THEN DON'T SAVE LENGTH LDB \LBUF+8 GET COMMON LENGTH STB \ID4,I SAVE COMMON LENGTH * LDA LNKMD SET BASE/CURRENT LINKAGE RAR AND MAP OPTIONS. IOR MAPMD STA \ID5,I CLA,INA LDB \LBUF+6 COMPILED? SSB,RSS IF YES, SKIP & SET SWITCH CLA OTHERWISE, CLEAR SWITCH STA LWH1 LDA M7777 INITILIZE THE FIRST DBL ADDRESS STA \ID7,I TO MAX POSSIBLE CLA AND THE PROG. LENGTH TO STA LWH2 MIN. POSSIBLE SEZ IF A DRIVER, THEN STORE LDA B *TEMP* ITS SIZE HERE STA \ID8,I CLEAR BS IDENT MAIN ADDRESS LDA \DPR2 SET FILE NAME IN IDENT. INA LDB A,I STB \ID9,I INA LDB A,I STB \ID10,I INA LDB A,I STB \ID11,I ADA B2 POSITION TO SECURITY CODE LDB A,I STB \ID12,I SAVE IT ADA P4 POSITION TO CR LABEL LDB A,I STB \ID13,I LDA \NAMN STA \ID14,I SET RECORD NUMBER. LDA \NAMB STA \ID15,I SET RELATIVE BLOCK. LDA \NAMO STA \ID16,I SET BLOCK OFFSET. JMP LDRIN GET NEXT RECORD SKP * * DBL REC PROCESSOR * DBLR LDA \LBUF+3 GET THE RELOCATION ADDRESS CMA,INA IF LESS THAN CURRENT ADA \ID7,I MIN. SSA SKIP JMP DBLR1 ELSE JUST SKIP * LDA \LBUF+3 NEW MIN. SO SET IT STA \ID7,I IN THE IDENT. * DBLR1 LDA \LBUF+1 GET THE LENGTH AND M77 OF THE RECORD (NO. OF PROGRAM WORDS) ADA \LBUF+3 COMPUTE MAX. LOAD ADDRESS LDB A SAVE IN B CMB,INB IF‹¾þú THIS IS A NEW ADB LWH2 MAX. THEN SSB SET THE STA LWH2 NEW MAX. JMP LDRIN GO GET NEXT RECORD. SKP * * ENT/EXT RECORD PROCESSOR * ENTR CCA,RSS ENT PROCESSOR EXTR CLA EXT PROCESSOR STA NXFLG NXFLG = ENT/EXT FLAG LDA \LBUF+1 SET NO. SYMBOLS AND M37 ISOLATE NO. SYMBOLS CMA,INA STA EXCNT SET SYMBOL COUNT LDB ALBUF ALBUF = A(LBUF) ADB P3 P3 = +3 STB SYM12 SET STARTING SYMBOL ADDR * SETNX LDB SYM12 SET B FOR LSTE JSB \LSTE ENTR SYMBOL IN THE LST JMP ENTX3 NEW ENTRY GO FINISH. * * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENT JMP ENTX4 COMPLETE EXT PROCESSING * * PROCESS ENT REC * LDA SLST IF THIS IS A FORCED CMA SYMBOL ADA \TLST THEN SSA GIVE ERROR JMP DUPEN * LDA \LST4,I GET WORD 4 OF LST ENTRY SZA,RSS SKIP IF NON-ZERO (DEFINED) JMP ENTX2 MAKE ENTRY FOR DEFINED EXT * SSA SKIP IF ENTRY MADE JMP ENTX6 MAKE ENTRY FOR BS EXT * DUPEN LDA ERR05 SET CODE - DUPLICATE ENTRY POINT CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT \GNER MESSAGE LDA P5 LDB \LST1 \LST1 = ADDR OF SYMBOL JSB \MESS PRINT DUPLICATE ENTRY SYMBOL LDA \LST4,I GET THE CURRENT DEFINING ADA N5 VALUE AND IF NOT A SELF DEFINING SSA,RSS SYMBOL JMP ENTX2 GO REDEFINE THE SYMBOL * JMP ENTX5 ELSE GO REDEFINE ONLY IF NEW SELF DEF. * * ENT HERE SATISFYING A BG SEGMENT'S EXTERNAL * ENTX6 LDA \ID6,I GET CURRENT TYPE AND M7 ISOLATE TYPE CPA B2 RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS YES - CONTINUE (ERROR) êþú CPA P4 TYPE = BG DISK RESIDENT? RSS YES JMP ENTX2 MAKE ENTRY FOR UNDEFINED EXT * LDA ERR13 SET CODE = INVALID BG BS ORDER JMP ERCO1 ENTX2 CCA GET MAIN IDENT INDEX. ADA \TIDN STA \LST4,I ENTER IDENT INDEX IN WORD 4 JMP ENTX5 * ENTX3 LDA NXFLG GET EXT/ENT FLAG SZA SKIP IF EXT ENTRY JMP ENTX2 SET WORD 4 OF ENT ENTRY * * EXT DEFINES A NEW SYMBOL * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CCB GET MAIN IDENT INDEX ADB \TIDN CPA P5 TYPE = BS? CMB,RSS YES - SET \LST4 = BS REF, SKIP CLB NO - SET \LST4 = UNDEFINED STB \LST4,I YES - SET INDEX IN LST WORD 4 ENTX4 LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP ENTX5 NO - IGNORE BG SEG MAIN ADDR * * CHECK EXT REFERENCE BY A BG SEGMENT * CCA ADA \TIDN GET CURRENT IDENT INDEX. STA IMAIN SAVE IDENT INDEX. LDA \LST4,I GET IDENT INDEX. SZA SKIP IF UNDEFINED. SSA SKIP IF IDENT INDEX. JMP ENTX5 IGNORE UNDEFINED EXT * CPA B2 IF SPECIAL SYMBOL RSS FOR GET CPA P3 THE BS RSS BIT CPA P4 JMP ENTX5 CPA P6 IF AN EMA SYMBOL LDA \LST5,I THEN GET ITS IDENT INDEX * STA \TIDN SET IDENT INDEX FOR \IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND LDA \ID4,I GET M,S SSA,RSS SKIP IF MAIN JMP NTMAN SET FLAG FOR IGNORING BS REF * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA B2 TYPE = RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 TYPE = BG DISK RESIDENT? CCB,%€þúRSS SET FLAG FOR BS REF, SKIP NTMAN CLB SET FLAG FOR IGNORING BS REF STB \TCHR SET FLAG = 0/-1 = IGNORE/BS REF LDA IMAIN GET CURRENT IDENT INDEX. STA \TIDN SET FOR NEXT IDENT. JSB \IDX SET CURRENT IDENT ADDRESSES JSB \ABOR INDEX INVALID. ISZ \TCHR SKIP - SET IDENT ADDR FOR BS REF JMP ENTX5 IGNORE IF NOT MAIN BG DISK RES * LDA \LST4,I GET BG MAIN INDEX. CPA P6 IF AN EMA SYMBOL LDA \LST5,I THE MAIN IDENT IS HERE! STA \ID8,I SET MAIN IDENT INDEX IN BS IDENT ENTX5 LDA SYM12 GET SYMBOL ADDR ADA P3 ADJUST FOR BOTH ENT & EXT STA SYM12 SAVE THE ADDRESS FOR NEXT SYMBOL LDB NXFLG GET EXT/ENT FLAG SZB,RSS IF EXT SKIP THE SPECIAL SYMBOL JMP ENTX8 CODE * ADB SYM12 GET THE FLAG LDA B,I AND P15 ISOLATE THE SYMBOL TYPE LDB \LST4,I IF UNDEFINED MUST SZB,RSS BE A FOURCED JMP ENTX7 SYMBOL SO DON'T RESET * SZA IF PROGRAM CPA P1 OR BASE PAGE JMP ENTX7 THEN STANDARD SYMBOL SKIP * STA \LST4,I SET THE SPECIAL FLAG LDA SYM12,I GET THE VALUE STA \LST5,I AND SET IT ENTX7 ISZ SYM12 STEP TO THE NEXT SYMBOL ENTX8 ISZ EXCNT TEST SYMBOL COUNTER JMP SETNX PROCESS NEXT SYMBOL * JMP LDRIN GO GET NEXT RECORD. SKP * * EMA RECORD PROCESSOR * EMAR LDA \ID6,I HAS AN EMA ALREADY SSA BEEN DECLARED FOR THIS MODULE? JMP EER41 YES (ERROR+BACKUP) * AND M7 GET THE MODULE TYPE - EMA'S CPA B2 AN BE USED ONLY IN RSS REAL-TIME DR CPA P3 RSS PRIVILEGED DR CPA P4 RSS AND BACKGROUND DR JMP EER40 ELSE INVALID DECLARATION (SET TO TYPE 8) * * ENTER EMA SYMBOL INTO LST AS A TYPE 6 * ENLST LDB DNAM "þú JSB \LSTE ENTER EMA SYMBOL INTO LST JMP NEWEM NEW ENTRY LDA \LST4,I PREVIOUSLY DEFINED? SZA,RSS JMP NEWEM NO, JUST REFERENCED * LDA ERR05 DUPLICATE ENTRY POINT CMA,INA SEND ERROR JSB \GNER DIAGNOSTIC LDA P5 AND THE LDB \LST1 NAME JSB \MESS * NEWEM LDA P6 SET SYMBOL TYPE TO STA \LST4,I THAT OF AN EMA CCB SET ITS 'VALUE' TO ADB \TIDN THE IDENT INDEX OF STB \LST5,I THE MAIN PROGRAM DECLARING IT * LDB ALBUF GET EMA SIZE FROM INB WORD 2 OF EMA RECORD LDA B,I AND M1777 ISOLATE IT ALF ROTATE DECLARED SIZE IOR \ID5,I TO BIT (13-4) AND SET IN STA \ID5,I MODULE'S IDENT ENTRY * ADB P5 GET MSEG SIZE FROM WORD 7 LDA B,I OF EMA RECORD AND M37 ISOLATE IT ALF,RAL AND ROTATE THE DECLARED ALF,RAL SIZE TO BITS (14-10) IOR MSIGN SET BIT 15 FOR EMA IOR \ID6,I AND SET IN IDENT STA \ID6,I ENTRY JMP LDRIN GO GET NEXT RECORD * EER40 LDA ERR40 SEND ERROR DIAGNOSTIC FOR EMA CMA,INA DECLARATION BY A NON-DISC RESIDENT JSB \GNER PROGRAM LDB \ID1 GET ADDRESS OF NAME LDA P5 AND CHARACTER COUNT JSB \MESS PRINT PROGAM NAME LDA \ID6,I NOW SET ITS TYPE AS A AND M1776 'DELETED' PROGRAM IOR P8 OF TYPE = 8 STA \ID6,I UNTIL POSSIBLY RESET JMP ENLST DURING THE PARAMETER PHASE * M1777 OCT 1777 M1776 OCT 177600 MSIGN OCT 100000 ERR41 ASC 1,41 SKP * EER41 LDA ERR41 DUPLICATE EMA'S DECLARED * ERCOV LDB SERFG IF PROCESSING A SKIP SSB JMP INCHK THEN JUST CONTINUE * CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE ERCO1 JSB \GNER SEND ERROR MESSAGE * LDA NAMRÙþú. WAS A NAM RECORD EXPECTED? SZA,RSS SKIP IF ONE WASN'T JMP ERCO2 NEEDN'T BACK UP THE INDICES LDA SERFG WAS A SKIP BEING PROCESSED? SSA SKIP IF ONE WASN'T JMP ERCO3 NEEDN'T BACK UP INDICES * LDA BUID BACK UP THE IDENT LST STA \PIDN LDA BULST AND THE ENT LIST STA \PLST * ERCO2 CCA SET THE FLUSHING STA SERFG FLAG ERCO3 CLA STA NAMR. AND CLEAR THE NAM EXPECTED FLAG. JMP INCHK GO GET THE NEXT RECORD SKP * * SUBROUTINE TO COMPUTE CHECKSUM OF A RELOCATABLE RECORD. * * ON ENTRY: * A-REG = BUFFER ADDRESS CONTAINING RECORD * ON EXIT: * A-REG = CHECKSUM VALUE * CKSUM NOP LDB A,I GET RECORD LENGTH BLF,BLF CMB,INB NEGATE. ADB P3 SKIP WORDS 1-3. STB WDCNT RECORD WORD COUNTER. LDB A GET BUFFER ADDRESS INA LDA A,I GET WORD 2, INIT CHECKSUM ADB P3 SET TO WORD 4 ADA B,I ADD WORD TO CHECKSUM. INB INCREMENT ADDRESS ISZ WDCNT SKIP IF END OF RECORD JMP *-3 LOOP TILL DONE. JMP CKSUM,I EXIT. SKP BUID NOP SAVED IDENT INDEX BULST NOP SAVE LST INDEX N5 DEC -5 P1 DEC 1 P3 DEC 3 P4 DEC 4 P5 DEC 5 P8 DEC 8 P9 DEC 9 P12 DEC 12 P13 DEC 13 P15 DEC 15 P30 DEC 30 M7 OCT 7 M17 OCT 17 M37 OCT 37 M77 OCT 77 M177 OCT 177 M7400 OCT 177400 M7777 OCT 77777 ERR05 ASC 1,05 ERR08 ASC 1,08 ERR13 ASC 1,13 SYM12 NOP SLST NOP SIGN OCT 100000 * MES22 DEF *+1 ASC 3,(NONE) SKP * * PROCESSOR FOR END COMMAND * ***** * ** END COMMAND PROCESSOR * ***** * * PRINT LIST OF UNDEFINEDS, IF ANY, OR "NO UNDEFS" * EOL CLA JSB EPL JMP PRCMD,I END OF COMMANDS. * * ***** CONSTANTS ***** * MD24 DEC õþú-24 B2 OCT 2 B40 OCT 40 B51 OCT 51 B54 OCT 54 SKP * * SET PARAMETERS INTO IDENTS * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE TYPE, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME,TYPE * NAME,TYPE,PRIORITY * NAME,TYPE,PRIORITY,EXECUTION INTERVAL * * TYPE = 2 DECIMAL DIGITS (1-99) * PRIORITY = 5 DECIMAL DIGITS (0-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * NOTE: TYPE OF BG DISK RESIDENTS HAVING BG SEGMENTS MAY NOT * BE ALTERED WITHOUT DESTROYING RELATIONSHIP. * PARAM JSB \SPAC NEW LINE LDA P10 LDB MES24 MES24 = ADDR: PARAMETERS JSB \MESS PRINT: PARAMETERS * PARST CLA,INA LDB HYADD JSB \READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARST REPEAT PARAMETER INPUT * LDA N5 JSB \GETN MOVE CHARS FROM LBUF TO TBUF CPA "/E" CHARS = /E? JMP SETLB YES - CLOSE FILE. * CPA BLANK BLANK LINE OR COMMENT? JMP PARST YES TRY ANOTHER * JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP PANOK YES - CONTINUE * PANER LDA ERR09 PARAMETER NAME ERROR JMP PARER * PANOK LDB ATBUF FIND THE PROGRAM JSB \IDXS IN THE IDENT TABLE JMP PANER NOT FOUND- INVALID NAME * * SET TYPE LDA N2 JSB \GET# CONVERT TO OCTAL JMP PATER INVALID DIGIT * JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) 6NLH RSS YES - CONTIMUE CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP SET PROGRAM TYPE IN IDENT * PATER LDA ERR10 PARAMETER TYPE ERROR JMP PARER * SETYP CLB IF THIS IS THE SCHEDULED PGM CCA ADA \TIDN AGAIN CPA SCH1 THEN STB SCH1 CLEAR ITS FLAG LDB \OCTN GET CONVERTED NUMBER LDA \ID6,I GET CURRENT TYPE AND M177 TO A CPA B IF NO CHANGE JMP TYPOK SKIP CHECK * CPB P14 IF CHANGE IS TO CORE RES LIB CPA P6 MUST BE LEGAL CORE RES. LIB. MODULE RSS OK SKIP JMP PATER NOT OK, ERROR CPB P8 IF A DELETION JMP TYPOK THEN JUST CONTINUE * LDA \ID6,I EMA PROGRAM? SSA,RSS JMP TYPOK NO,NEEDN'T CHECK NEW TYPE LDA B GET NEW TYPE AND M7 ISOLATE CPA B2 RT DISK RESIDENT? JMP TYPOK YES, A VALID EMA TYPE CPA P3 PR DISK RESIDENT? JMP TYPOK OK HERE TOO CPA P4 BG DISK RESIDENT? JMP TYPOK AND HERE * LDA ERR40 NOT A VALID EMA TYPE JSB PNERR JMP PARST CONTINUE ERR40 ASC 1,40 ‘åNÿÿþú* TYPOK LDA \OCTN IF AUTO SCHED AND P64 BIT NOT SET SZA,RSS THEN JUST GO JMP SCH SET TYPE. SPC 1 LDB \OCTN AUTO SCHED...SUBTRACT ADB N80 80 FROM TYPE TO STB \OCTN GET REAL TYPE. * LDA \ID4,I M,S BIT TO E CLE,ELA LDA \ID6,I MERGE EMA INFO AND M7600 WITH TYPE. IOR B CCB ADB \TIDN B HAS IDENT INDEX. SPC 1 SEZ,RSS IF NOT MAIN PGM JMP SCH IGNOR IT AND M7 MASK TO THE ID TYPE SZA IF ZERO OR ADA N5 MORE THAN 4 SSA SKIP STB SCH1 ELSE SET PGM IDENT IN SCH FLAG SPC 1 SCH LDB \OCTN GET NEW TYPE LDA \ID6,I INTO IDENT 6 AND M7600 IOR B STA \ID6,I SPC 1 JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARST YES - GET NEXT PARAMETER RECORD * * SET NEW PROGRAM PRIORITY * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAPER PRIORITY ERROR * SSA IF NEGATIVE JMP PAPER THEN ERROR * JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = ZERO ? (END OF BUFFER) CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY * PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR CLB SIGNAL \RNAM TO IGNORE NAME IN PARSA LDA ACBUF GET THE NAM RECORD TO CBUF. JSB \RNAM JSB \ABOR ERROR. * JSB FINDN SEARCH FOR A MODIFIED NAM RECORD JMP SETPR DID'T HAVE ONE YE$ JMP SETPR FOUND, NOW MODIFY IT SKP * * SEARCH FOR A MODIFIED NAM RECORD BELONGING TO THE * CURRENT IDENT * * RETURN: (P+1) ONE DOES NOT EXIST YET * (P+2) FOUND ONE - POSI -þúTIONED TO IT * * BRANCHES TO PACLO ON FILE ERROR (FOR TERMINATION) * FINDN NOP CLA STA IRECW LDA \ID5,I CHECK IF NAM RECORD ALREADY HAS RAL MODIFIED VERSION (COMPILED PROG). SSA,RSS JMP FINDN,I NO. * JSB LOCF YES. SAVE CURRENT WRITE POINTERS. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB RWNDF REWIND THE FILE. DEF *+3 DEF \NDCB+0 DEF \FMRR+0 * LDA DNDCB JSB \CFIL JMP PACLO ERROR. * END1 JSB LOCF GET LOC. OF NEXT RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB READF READ THE RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF P60 DEF LEN * LDA DNDCB JSB \CFIL JMP PACLO ERROR. * LDA LEN CPA N1 JMP PACLO ERROR IF EOF. * LDB ACBUF COMARE NAM IN CBUF ADB P3 AGAINST NAM IN IDENT. LDA B,I CPA \ID1,I INB,RSS JMP END1 NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP END1 NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP END1 NO MATCH. * JSB APOSN MATCH. POSITION NEXT WRITE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * ISZ FINDN JMP FINDN,I RETURN (P+2) SKP * SETPR LDA CBUF ADJUST RECORD LENGTH FOR THOSE ALF,ALF NOT FIXED FOR COMPILED PROHýþúGRAMS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF LDB \OCTN GET PRIORITY SZB,RSS SKIP - PRIORITY ENTERED LDB P99 REPLACE ZERO PRIORITY WITH 99 LDA \ID6,I GET THE TYPE AND M177 AND ISOLATE IT SZA,RSS IF A SYSTEM PROGRAM USE CLB PRIORITY ZERO STB CBUF+10 SET NEW PRIORITY IN THE RECORD JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARWR YES - GO REWRITE THE NAM RECORD * * GET RESOLUTION CODE * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+11 SET IN THE NAM RECORD * * GET EXECUTION MULTIPLE * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M1600 ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA \OCTN GET CONVERTED NUMBER STA CBUF+12 SET IN THE NAM RECORD * * GET HOURS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+13 SET IN THE NAM RECORD * * GET MINUTES * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+14 SET IN THE NAM RECORD * * GET SECONDS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+15 SET IN THE NAM RECORD * * GET TENS OF MILLISECONDS * LDA N2 SET FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = 0? (END OF BUFFER) JMP PAIER eXþúNO - INVALID DELIMITER * LDA \OCTN GET CONVERTED NUMBER STA CBUF+16 SET IN THE NAM RECORD * PARWR JSB NEWNM BUILD NEW MODIFIED RECORD JMP PARST SKP * * COMPUTE AND STORE NEW CHECKSUM, WRITE RECORD TO * NEW NAM FILE, AND SET FLAG IN IDENT. * NEWNM NOP LDA ACBUF GET BUFFER ADDRESS CONTAINING RECORD JSB CKSUM STA CBUF+2 SAVE NEW CHECKSUM * JSB WRITF WRITE RECORD. DEF *+5 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL \ABOR IF WRITE ERROR. JMP PACLO * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * LDA IRECW WAS IT AN UPDATE WRITE? SZA,RSS JMP NEWNM,I NO. * JSB APOSN YES. GET BACK TO OLD PLACE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO * JMP NEWNM,I * IRECW NOP IRBW NOP IOFFW NOP IRECR NOP IRBR NOP IOFFR NOP P60 DEC 60 LEN NOP BIT14 OCT 40000 ACBUF DEF CBUF CBUF BSS 60 SKP * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA \OCTN GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A * PAIER LDA ERR12 PARAMETER INTERVAL ERROR PARER JSB PNERR SEND ERROR MESSAGE JMP PARST TRY AGAIN * PNERR NOP SUBROUTINE TO PRINT ERROR JSB \GNER PRINT \GNER MESSAGE JSB \SPAC NEW LINE JMP PNERR,I RETURN * * PACLO LDA \FMRR WRITE ERROR? SSA,RS"bþúS JMP PARST NO. * JSB \TERM \ABOR. SKP * * CHANGE ENTS SECTION * SETLB JSB \SPAC LDA P12 GET MESSAGE LENGTH LDB MES21 SEND MESSAGE JSB \MESS 'CHANGE ENTS?' * PENT CLA,INA LDB HYADD JSB \READ \READ THE ENT RECORD. SZA,RSS IF ZERO JMP PENT TRY AGAIN * LDA N5 TO JSB \GETN TBUF CPA "/E" IF '/E' JMP EXENT DONE GO TO NEXT SECTION * CPA BLANK IF '*' OR BLANK LINE JMP PENT TRY THE NEXT LINE * JSB \GETC GET THE NEXT CHAR CPA B40 IF COMMA JMP ENTOK OK * ENAME LDA ERR09 ELSE ERROR JMP EARER GO REPORT IT * ENTOK LDB ATBUF FIND THE JSB \LSTE DEFINE AND OR LOCATE LST NOP (DON'T CARE IF EARLIER DEFINED) * LDA \LST4,I CAN'T CHANGE THE TYPE OF CPA P6 AN EMA SYMBOL JMP EATER * LDA N2 GET TYPE FLAG JSB \GETN CARACTER CLE CPA "AB" IF ABSOLUTE CLB,CCE SET FLAG CPA "RP" IF REPLACE CLB,CCE,INB SET OTHER FLAG SEZ IF NONE OF THE ABOVE JMP ENTNO * EATER LDA ERR10 THEN SEND ERROR EARER JSB PNERR JMP PENT * ENTNO ADB P3 ADJUST TO ENT TYPE STB \IDXS SAVE IN TEMP JSB \GETC CHECK FOR COMMA CPA B40 AS NEXT CHARACTER RSS IF NOT JMP EATER BITCH * LDA \CURL SAVE CURRENT STA \ID1 POSITION LDA \BUFL FOR BACKING STA \ID2 UP LDA B7 GET NUMBER JSB \GET# ASSUMING OCTAL RSS IF ERROR MIGHT BE DECIMAL SO SKIP JMP ENTOC IT IS OCTAL SO GO SET UP * LDA \ID1 BACK UP THE SCANNER STA \CURL POSITION LDA \ID2 STA \BUFL LDA N7 NOW TRY JSB \GET# A DECIMAL COIþúNVERSION RSS ERROR EXPECTED ( 12345D) ON THE D JMP EATER NO ERROR SO WRONG INPUT * LDA \TCHR MAKE SURE ERROR CPA P20 WAS ON A "D" RSS YES SO FAR SO GOOD JMP EATER NO GO BITCH * ENTOC LDA \IDXS SET THE ENT TYPE STA \LST4,I AND LDA \OCTN VALUE STA \LST5,I IN THE SYMBOL TABLE JMP PENT GO GET NEXT SYMBOL. * EXENT JSB \SPAC SEND A \SPAC SKP * * SET LIBRARY, COM, TYPE TOTALS * * THIS SECTION IS EXECUTED WHEN THE PARAMETERS HAVE * BEEN COMPLETELY READ IN. IT COMPUTES THE MAXIMUM LENGTH OF * BOTH THE REAL TIME AND BACKGROUND COMMON AREAS. * IT ALSO COMPUTES THE NUMBER OF MEMORY RESIDENT, LONG, AND SHORT * (SEGMENT) ID SEGMENTS NEEDED TO RELOCATE THE PRESENT SET OF * PROGRAMS SPECIFIED BY IDENTS. THE NUMBER OF EMA EXTENSIONS NEEDED * IS ALSO COMPUTED BY COUNTING THE NUMBER OF EMA PROGRAMS. * * CLA STA SICNT CLEAR MEM.RES. ID SEG COUNT STA LICNT CLEAR LONG ID SEG COUNT STA SSCNT CLEAR SHORT ID SEG COUNT STA COMRT CLEAR RT COM LENGTH STA COMBG CLEAR BG COM LENGTH STA IXCNT CLEAR ID EXTENSION COUNT STA MRACM CLEAR MR ACCESS TO COMMON FLAG JSB \INID INITIALIZE \IDX SETIX JSB \IDX SET IDENT ADDRESSES JMP \PIP,I TERMINATE ID SEGMENT COUNT * LDA \ID6,I GET TYPE AND M17 ISOLATE TYPE AND REV COM BITS LDB \ID4,I GET COMMON LENGTH SWP AND M7777 MASK OFF M,S BIT SWP CPA P11 IF PR DISK RESIDENT USING RT COMMON RSS CPA P12 OR BG DISK RES USING RT COMMON RSS CPA P1 OR TYPE = MEMORY RESIDENT? JMP SMRRC YES, CHECK COMMON DECLARATION CPA B2 OR TYPE = RT DISK RESIDENT? JMP SETRC SET RT COMMON LENGTH * CPA P9 IF MEMORY RES. USING B ›þúG COMMON JMP SMRBC YES, CHECK COMMON DECLARATION CPA P10 LIKEWISE IF RT DSC RESIDENT RSS CPA P3 TYPE = PR DISK RESIDENT?? RSS CPA P4 TYPE = BG DISK RESIDENT? JMP SETBC SET BG COMMON LENGTH * LDA \ID6,I GET TYPE AGAIN AND M37 BUT LEAVE SSGA BIT ON CPA P14 IF CORE RES LIB. RSS CPA ZERO TYPE = SYSTEM? RSS CPA P6 TYPE = LIBRARY? RSS CPA P13 TYPE = TABLE AREA II? RSS CPA P15 TYPE = TABLE AREA I? RSS CPA P16 TYPE = SLOW BOOT? RSS CPA P30 TYPE = SSGA?? SZB,RSS SKIP - HAS INVALID COMMON JMP SETR1 PROCESS NEXT IDENT * LDA ERR37 SET CODE = INVALID COMMON CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET IDENT ADDRESS JSB \MESS PRINT PROG NAME FOR INVALID COM JMP SETIX PROCESS NEXT IDENT * SMRBC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETBC LDA COMBG GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMBG SET NEW MAX BG COMMON LENGTH JMP SETR1 CHECK TYPE * SMRRC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETRC LDA COMRT GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMRT SET NEW MAX RT COM LENGTH SETR1 LDA \ID4,I GET M/S }Éþú SSA,RSS SKIP IF MAIN JMP SETIX PROCESS NEXT IDENT * LDA \ID6,I AND M7 ISOLATE TYPE CPA P1 TYPE = RT RESIDENT? ISZ SICNT YES, COUNT MEM.RES. ID SEGMENT CPA B2 IF RT DISC RESIDENT RSS OR CPA P3 PRIVILEGED DISC RESIDENT RSS CPA P4 BACKGROUND DISK RESIDENT ISZ LICNT COUNT A LONG ID SEGMENT * CLE CLEAR EMA FLAG LDA \ID6,I GET TYPE,EMA BIT SSA SKIP IF NO EMA DECLARED CCE INDICATE EMA AND M17 ISOLATE TYPE TO DISTINGUISH CPA P5 BETWEEN TYPES 5 AND 13 ISZ SSCNT COUNT A SHORT ID SEGMENT SEZ,RSS EMA? JMP SETIX NO, GO PROCESS NEXT IDENT AND M7 MASK TYPE SZA EXCLUDE TYPE 8'S SINCE THEY'RE EMAS ARE INVALID ISZ IXCNT INCREMENT COUNT JMP SETIX CONTINUE SCAN * * ONLY4 OCT 20 BIT 4 SET ZERO OCT 0 N7 DEC -7 P6 DEC 6 P10 DEC 10 P11 DEC 11 P14 DEC 14 P16 DEC 16 P20 DEC 20 P64 DEC 64 P99 DEC 99 N80 DEC -80 "/E" ASC 1,/E "AB" ASC 1,AB "RP" ASC 1,RP M1600 OCT 160000 M7600 OCT 177600 IL NOP * MES24 DEF *+1 ASC 5,PARAMETERS MES21 DEF *+1 ASC 6,CHANGE ENTS? * ERR09 ASC 1,09 ERR10 ASC 1,10 ERR11 ASC 1,11 ERR12 ASC 1,12 ERR37 ASC 1,37 SKP ***** * ** EPL * ENTRY POINT LIST ROUTINE * * CALLING SEQUENCE: * (A): =0, LIST UNDEFINED EXTERNAL SYMBOLS. * =1, LIST ENTRY POINT SYMBOLS AND * * (P) JSB EPL * (P+1) (RETURN) A AND B DESTROYED * ***** EPL NOP ENTRY/EXIT POINT STA NBUF SAVE ENTRY PARAMETER. SZA,RSS UNDEFS? JMP EPL5 YES EPL0 JSB \ILST INITIALIZE SYMBOL TABLE POINTERS. EPL1 JSB \LSTX SET LST ENTRY ADDRESSES JMP EPL3 END OF SYMBOL TABLE JSB MLBUF MOVE ¬DþúSYMBOL TO LBUF LDB \LST4,I (B) = ENT. ADDRESS LDA NBUF (A) = ENTRY PARAMETER SZA IF ENT LIST REQUESTED JMP EPL2 GO DISPLAY. CMB,SSB,INB,SZB SKIP IF UNDEF OR BS REF. JMP EPL1 GO CHECK NEXT ENTRY. * LDA TEMP1 HEADING PRINTED? SZA JMP EPL8 YES. ISZ TEMP1 NO. SET FLAG AND LDA UNDFS PRINT "UNDEFS". LDB UNDFS+1 JSB \MESS * EPL8 LDB ALBUF LDA P5 JSB \MESS OUTPUT SYMBOL. JMP EPL1 CONTINUE SCAN * * LIST SYMBOL TABLE * EPL2 CMB,SSB,INB,SZB,RSS ENTRY DEFINED? JMP EPL1 NO JMP EPL8 PROCESS NEXT ENTRY IN LST. * * LIST UNDEFS * EPL5 LDA SLST SET BOTTOM OF PGM LST FOR SCAN. STA \TLST CLA CLEAR HEADING FLAG. STA TEMP1 JMP EPL1 * EPL3 LDA NBUF IF NO UNDEFS, ADA TEMP1 PRINT "NO UNDEFS". SZA JMP EPL,I * LDA EPL6 NO--PRINT "NO UNDEFS" LDB EPL6+1 JSB \MESS CLA JMP EPL,I SPC 1 EPL6 DEC 9 DEF *+1 ASC 5,NO UNDEFS SPC 1 * UNDFS DEC 7 DEF *+1 ASC 4, UNDEFS * * CONSTANT AND STORAGE SECTION FOR -EPL- . * M3 OCT -3 B7 OCT 7 B60 OCT 60 * * * MOVE CURRENT SYMBOL FROM SYMBOL TABLE TO LBUF * MLBUF NOP LDA \LST1 LDB ALBUF MVW P3 LDA \LBUF+2 MAKE 6TH CHAR. A BLANK IOR B40 STA \LBUF+2 JMP MLBUF,I SKP ***** * * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHARACTER (LEADING BLANK) * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS2þú OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A \SPAC. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * SPC 2 ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. CPA STAR IF * THEN END OF LINE RSS ISZ QGETC SKIP EXIT JMP QGETC,I * QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP STAR OCT 52 SKP * * CONSTANTS,AND MESSAGES * * ***** CONSTANTS ***** * B50 OCT 50 D15 DEC 15 B75 OCT 75 B177 OCT 177 B377 OCT 377 N2 DEC -2 LNKMD NOP LINKS FLAG. MAPMD NOP MAP FVnB@0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 Ž4þú ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LABS CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS N1 DEC -1 N2 DEC -2 N5 DEC -5 N7 DEC -7 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 P18 DEC 18 P20 DEC 20 P22 DEC 22 P24 DEC 24 P28 DEC 28 P30 DEC 30 P31 DEC 31 L2000 OCT -2000 M7 EQU P7 M37 EQU P31 M77 OCT 77 M177 OCT 177 M1000 OCT 1000 M1777 OCT 1777 M2000 OCT 2000 M1377 OCT 137777 M7777 OCT 77777 M3777 OCT 37777 M7400 OCT 177400 M7757 OCT 77577 * LWASM EQU M7777 LWSBP OCT 1645 * HLT0 HLT 0B MSIGN OCT 100000 UBLNK OCT 20000 D$STR DEF *+1 ASC 3,$STRT SKP * * LOAD ABSOLUTE SYSTEM * * THIS SEGMENT CONTROLS THE GENERATION OF * THE ABSOLUTE CODE FOR THE SYSTEM. EACH PROGRAM * IS LOADED BY TYPE AS FOLLOWS: * * (1) TABLE AREA I * (2) SSGA & COMMON * (3) SYSTEM DRIVER AREA * (4) TABLE AREA II * (5) SYSTEM * (Ä þú6) PARTITION DRIVERS * (7) RESIDENT LIBRARY * (8) MEMORY RESIDENTS * (9) RT DISK RESIDENTS * (10) PR DISK RESIDENTS (AND BG SEGMENTS) * (11) BG DISK RESIDENTS (AND BG SEGMENTS) * * EACH TYPE OF PROGRAM IS LOADED IN THE FOLLOWING MANNER: * * THE IDENTIFICATION BLOCK FOR THE PROGRAM IS LOCATED * IN IDENT. A CALL TO LOAD IS EXECUTED TO LOAD THIS PROGRAM AND * ALL CALLED SUBROUTINES. IF THE PROGRAM IS DISK RESIDENT, * THE BASE PAGE SECTION OF CODE IS WRITTEN ON THE DISK * IMMEDIATELY AFTER THE MAIN SECTION OF CODE. IF THE * PROGRAM IS RT DISK RESIDENT, THE BOUNDARIES OF THE LARGEST * SECTION OF BASE PAGE AND PROGRAM ARE SAVED. IF THE PROGRAM IS * A USER PROGRAM (OTHER THAN SYSTEM USER PROGRAM) AN ID SEGMENT IS * GENERATED. * SKP * * INITIALIZATION * \GENS LDB P64 GET FWA BP STB FSYBP SET ADDR OF FIRST SYS LINK JSB \SPAC NEW LINE * * CLEAR LST WORD 5 (SYMBOL VALUE) * JSB \ILST INITIALIZE LST ADDRESSES CLLST JSB \LSTX SET LST ADDRESSES JMP CLRID-1 CLEAR USAGE FLAGS CLA LDB \LST4,I GET TYPE ADB N7 IF SELF SSB,RSS DEFINING SKIP CLEAR STA \LST5,I CLEAR \LST WORD 5 LDA \LST3,I GET WORD 3 OF \LST ENTRY AND M7400 ISOLATE UPPER CHARACTER STA \LST3,I SET \LST WORD 3 WITH NO ORDINAL JMP CLLST CONTINUE CLEARING LST * * CLEAR PROGRAM USAGE FLAGS * JSB \INID INITIALIZE IDENT ADDRESSES CLRID JSB \IDX SET IDENT ADDRESSES JMP IDCLR ALL IDENT FLAGS CLEAR LDA \ID3,I GET USAGE FLAG AND M7400 SET FLAG = ZERO STA \ID3,I SET CLEARED USAGE FLAG JMP CLRID CLEAR NEXT IDENT FLAG * * CLEAR PAGE 1 FOR INDIRECT LINKS * IDCLR LDA L2000 STA WDCNT SET WORD COUNT = 2000(8) CLA LDB \ADBP GET ADDRESS OF PSEUDO BASE PAGE CLRBP STA B,I CLEAR WORD IN BASE PAGE AREA V¡þúINB INCR PAGE ADDRESS ISZ WDCNT SKIP - AREA CLEARED JMP CLRBP CONTINUE CLEARING SKP * * LOAD INITIALIZATION * SPC 1 CLA STA RBTA CLEAR THE RELOCATION BASE TABLE STA TPREL STA TPBRE STA COMAD+1 STA RELAD STA \TBLK RESET THE LNKX STARTER STA LIBFG SET "NOT LOADING RES LIB" STA KEYCT STA COMAD RESET COMMON RELOC BASE STA IDSAV STA MTYPE STA DPNUM NO DP'S YET SPC 1 * SET BOUNDS FOR BASE PAGE LINK SCANNING SPC 1 STA \LRBP SHOW NO LINKS IN RESIDENT STA \URBP BASE PAGE AREA SPC 1 STA DSKMB * * SET BP LINK PARAMETERS TO ALLOCATE TOP-DOWN * FROM THE SYSTEM COMMUNICATION AREA. * CCA STA BPINC SET INC = -1 STA DPFLG NOT DP RELOC MODE * ADA LWSBP SET FIRST LINK ADDR TO STA PBREL FIRST WORD BELOW SCOM * LDA FSYBP SET BP LINK ALLOCATION STA BPLMT LIMIT TO LOWEST WORD AVAILABLE SPC 1 STA \CUBP SET CURRENT SCAN AREA TO FIRST LINK ADDR ADA \ADBP AND SET MEMORY ADDR IN RT4GN STA \ICBP IMAGE OF THE AREA * LDA M1000 SET HIGH BASE PAG INDICATOR STA HIBP FOR FIXUP BUILDING SPC 1 LDA LWSBP CURRENT PROGS SCAN AREA ENDS AT STA \UCBP SYSTEM COMM AREA SPC 1 LDA \CBPA MARK CURRENT PAGE LINK STA \CPL2 AREA EMPTY STA CPLS SPC 1 * SET RELOCATION ADDRESSES SPC 1 LDA M2000 STA \PREL SYSTEM RELOC BASE = 2000B CLA STA DSKMR SPC 1 * SET INITIAL DISK ADDRESSES SPC 1 LDA P2 STA \ADSK SET AS CURRENT STA DSKBP AND AS LOC OF BASE PAGE SPC 1 * STORE BASE PAGE ON DISK, JUST TO SAVE SPACE FOR IT SPC 1 LDA M2000 GET UPPER ADDR+1 Nµþú CLB AND LOWER ADDRESS JSB BPOUT DUMP A BASE PAGE TO DISK SPC 1 * BUMP TO NEXT EVEN SECTOR SPC 1 JSB DSKEV ALIGN AT EVEN SECTOR STA \DSYS+3 AND SAVE IN \ABDO MAP SPC 1 * SET UP LABDO CONTROL WORDS TO ACCESS SYSTEM AREA OF DISK SPC 1 JSB \SYS SPC 1 * SET PROGRAM TYPE MASK TO LOOK AT WHOLE * TYPE FIELD WHEN SCANNING THROUGH IDENT LIST SPC 1 LDA M177 LOW SEVEN BITS STA \TMSK SKP * * BUILD I/O TABLES * SPC 1 JSB \GNIO BRING IN SEG 5, GO TO IT SPC 1 * * LOAD TABLE AREA I MODULES * LDA P15 SET MODULE TYPE STA \PTYP LODI JSB IDSCN SCAN IDENTS JMP PSEUD END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODI * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE AND LOAD JSB INCAD UPDATE \PREL AND PBREL JMP LODI PROCESS NEXT TA.I MODULE * PSEUD JSB NOTST TEST FOR PROGRAMS LOADED SPC 1 * * * ASK FOR OVERRIDE OF DRIVER PARTITION SIZE * LDA P16 SET MAX SIZE FOR STA TEMP2 DP LENGTH * CLB LDA P2 ASK IF THEY WANT TO CMA CHANGE THE JSB CHBND SIZE AND DEF MES32 THEN STORE DEF TEMP2 THE STA DPLN NEW SIZE * * LOAD THE SYSTEM DISK DRIVER (PLUS ANY OTHER DRIVERS * THAT WILL FIT) INTO DRIVER PARTITION #1 * CCA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD DP #1 * * LOAD SSGA MODULES * JSB \SPAC MAKE IT LOOK NICE LDA P30 STA \PTYP SET MODULE TYPE LDA P21 PASS MESSAGE LENGTH LDB MES31 AND ADDRESS JSB SETHD TO HEADER ROUTINE * SSGAL JSB IDSCN SCAN IDENTS JMP SETCM END OF IDENTS LDA \ID3,I PICK UP LOAD FLAG ×îþú CLB,INB IOR B SET LOADED BIT STA \ID3,I AND RESTORE JSB \LODN LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL JMP SSGAL THEN GO FIND NEXT * SETCM JSB NOTST TEST FOR PROGRAMS LOADED * * * SET UP THE REAL TIME COMMON AREA * JSB \SPAC LDA \PREL COMPUTE MAX SIZE BY STA RTCAD SUBTRACTING CURRENT CMA LOCATION FROM ADA M3777 LAST ALLOWED (APPROX. 37777) STA TEMP2 SAVE AS THE LIMIT * CLB LDA COMRT CMA ASK IF THEN JSB CHBND WANT TO DEF MES53 CHANGE THE SIZE DEF TEMP2 OF RT COMMON STA COMRT SAVE IT * LDA RTCAD LOAD STARTING ADDRESS LDB MES14+1 OF RT COMMON JSB \CONV AND STUFF IN MESSAGE LDA P20 LDB MES14 JSB \MESS AND PRINT IT JSB \SPAC SPC 1 * * SET UP BG COMMON * LDA COMRT SAVE BASE ADA \PREL ADDRESS OF STA BGCAD BG COMMON * ADA COMBG BUMP TO END OF DECLARED ADA N1 IOR M1777 ROUND TO END OF PAGE STA TEMP2 SAVE TEMPORARILY LDB BGCAD GET FWA BG COMMON CMB,INB AND SUBTRACT ADA B IN ORDER TO GET DEFAULTED INA SIZE STA COMBG AND SAVE NEW SIZE * LDB TEMP2 GET LAST WORD ADDRES CMB,INB AND SUBTRACT FROM LAST ADB M3777 ALLOWED ADDRESS STB TEMP2 AND SAVE AS UPPER LIMIT * CMA CLB,INB ASK IF THEY JSB CHBND WANT TO DEF MES57 CHANGE THE DEF TEMP2 SIZE OF BG COMMON * ADA COMBG UPDATE BG COMMON SIZE STA COMBG BY THAT SIZE * LDA BGCAD LOAD STARTING ADDR LDB MES18+1 OF BG COMMON JSB \CONV AND STUFF IN LDA P20 MESSAGE LDB MES18 JSB \MESS PRINT IT * ‹'þú LDA COMBG LOAD NEW SIZE OF BG CMA,INA COMMON AND LDB MES62+1 STUFF IN MESSAGE JSB \CONV (DECIMAL) LDA P16 LDB MES62 JSB \MESS AND PRINT IT JSB \SPAC * * WRITE HALTS ON DISK FOR RT AND BG COMMON AREAS * LDA COMRT GET TOTAL ADA COMBG COMMON SIZE LDB \PREL GET RELOC BASE SZA,RSS JMP NOCOM JUMP IF NO COMMON * CMA,INA SET LOOP COUNTER STA TCNT TO -(LENGTH OF COMMON) WTCOM LDA HLT0 GET HALT 0 VALUE JSB \ABDO WRITE ONE ISZ TCNT HALT AT A TIME JMP WTCOM UNTIL DONE * STB \PREL UPDATE RELOC BASE FOR SDA NOCOM STB FWSDA SAVE START ADDRESS OF SDA * SKP * * LOAD SYSTEM DRIVER AREA * SPC 1 CLA SET TO SCAN FOR STA \PTYP TYPE 0 MODULES LDA P18 PRINT HEADING LDB MES63 JSB SETHD AND INIT FOR LOADING * SDAL JSB SCDRV GET NEXT DRIVER JMP SYSTB END OF IDENTS JMP SDAL A PRD - GO GET NEXT DRIVER LDA \ID3,I PICK UP CLB,INB USAGE FLAG IOR B AND SET STA \ID3,I LOADED BIT * JSB \LODN LOAD THE MODULE JSB INCAD UPDATE PBREL & \PREL JMP SDAL PROCESS NEXT DRIVER SPC 1 * * RESERVE SPACE AND SET UP SYSTEM TABLES * IN TABLE AREA II. * SYSTB JSB NOTST TEST FOR PROGRAMS LOADED JSB \SYTB GO DO IT IN SEG 5 SPC 1 * * LOAD TABLE AREA II MODULES * LDA P13 SET MODULE TYPE STA \PTYP LODII JSB IDSCN SCAN IDENTS JMP ENDII END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODII IGNORE LOADED PROGRAMS * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE AND LOAD THE PROGRAM JSB INCAD UPDATE \PREL & PBREL JMåüþúP LODII PROCESS NEXT TA.II MODULE * ENDII JSB NOTST TEST FOR PROGRAMS LOADED * CCA GET LAST WORD USED BY ADA \PREL TABLE AREA II MODULES IOR M1777 AND ROUND TO END OF PAGE INA GET FIRST WORD ADDRESS OF NEXT PAGE STA FWPRV AND SAVE AS PRIV LOAD PT SKP * INITIALIZE FOR SYSTEM LOADING * LDA PBREL SAVE LAST(LOWEST) INA BP LINK USED STA LOLNK IN TABLE AREAS, ETC STA BPLMT AND USE A UPPER LIMIT FOR SYSTEM LINKS * CLA,INA RESET THE ALLOCATION OF LINKS UPWARD STA BPINC LDA FSYBP STARTING AT STA PBREL LOCATION 100 * CLA CLEAR THE HIGH BASE PAGE LINK STA HIBP REQUEST FOR NEW FIXUP ENTRIES * LDA \CBPA RESET THE CP LINK ARE POINTERS STA \CPL2 TO 'EMPTY': LAST CP AREA=LAST BP AREA STA CPLS LAST 'SAVE' CP AREA=LAST BP AREA * * LOAD SYSTEM MODULES * JSB \SPAC LDA \PREL GET STARTING RELOCATION STA FWSYS ADDRESS AND SAVE LDA P6 LDB MES12 PRINT: SYSTEM JSB SETHD AND INITIALIZE IDX CLA STA \PTYP SET TO SCAN SYSTEM MODULES * SYLD JSB IDSCN SCAN IDENTS FOR TYPE 0 MODULES JMP SYEND END OF IDENTS LDB \ID8,I CHECK IF AN EQT WAS DEFINED SSB FOR THIS MODULE, IN WHICH CASE JMP SYLD IT'S A DRIVER SO DON'T LOAD HERE LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED JMP SYLD IGNORE USED PROGRAM * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE & LOAD PROGRAM JSB INCAD UPDATE \PREL & PBREL JMP SYLD PROCESS NEXT SYSTEM PROGRAM * SYEND JSB NOTST TEST FOR PROGRAMS LOADED * CCA SET LAST WORD ADA \PREL USED BY SYSTEM STA LWSYS CODE JSB CPAG# CONVERT TO A PAGE # AND M37 HNLH AND SET AS LAST USED BY SYSTEM STA LPSYS AND SAVE SKP * * * LOAD SLOW BOOT, AND SET LWSLB - MUST BE <= 77577, * OR ELSE ABORT. * * LDB DCNFG GET BUFFER ADDRESS OF $CNFG JSB \IDXS NOW GO FIND ENTRY JMP ER57 NOT THERE - NO GOOD FOR YOU LDB \ID3,I SET USAGE FLAG INB IN WORD 3 STB \ID3,I TO INDICATE LOADED JSB \LODN NOW LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL LDA \PREL CHECK FOR OVERFLOW CMA,INA ADA M7757 PAST 77577 SSA,RSS JMP NOVF NO OVERFLOW * LDA ERR18 YES, MUST ABORT JSB \IRER ISSUE DIAGNOSTIC & ABORT * ER57 LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER INDICATING A MISSING SYSTEM MODULE LDA P5 NOW SEND THE MODULE LDB DCNFG NAME TOO JSB \MESS JSB \TERM ABORT THEM NOW ERR57 ASC 1,57 DCNFG DEF *+1 ASC 3,$CNFG * * NOVF CCA ADA \PREL STA LWSLB SAVE LAST USED ADDRESS STA B SAVE FOR CHECK IOR M1777 ROUND TO END OF CURRENT !Nÿÿþú CPA B PAGE - ANY CHANGE AT ALL? CLB,RSS IF NOT, THEN DON'T ZERO-FILL STA B JSB CPAG# GET THE PAGE # AND M37 STA LPSLB AND SAVE IT TOO! CLA MIGHT AS WELL SZB SKIP IF NO EXTRA WORDS ADDED TO ZERO JSB \ABDO ZERO-FILL THE REMAINDER * * INITIALIZE LOCATIONS 2 AND 3 IN THE BASE PAGE SO $STRT * WILL BE ENTERED FROM BOOT-UP * LDB D$STR GET THE LST ENTRY FOR $STRT JSB \LSTS GO FIND IT JSB \ABOR OH-OH, TOO BAD! LDB \ADBP GET ADDRESS FOR THE JMP,I START ADB P2 LDA JMP3I GET JMP 3,I CODE STA B,I AND SET IN BP LOCATION 2 INB INCREMENT TO BP LOCATION 3 LDA \LST5,I GET ADDRES OF $STRT STA B,I AND SET IN 3 * * * DUMP SYSTEM LINKS (AND TRAP CELLS) FROM THE LOW PART OF * BASE PAGE TO DISK, AND CLEAR THAT IMAGE AREA. THE PRD'S * AND ALL MEMORY AND DISK RESIDENT PROGRAMS CANNOT SHARE * (OR SEE) ANY LINKS BELOW HILNK ('HIGHEST SYSTEM LINK') * ANYHOW, SO THEY ARE NOT NEEDED IN THE GENERATER ANY LONGER. * THE AREA WILL BE USED FOR MEMORY AND DISK RESIDENT PROGRAM * LINKS. * LDA \ADSK SAVE THE CURRENT DISK ADDRESS STA TEMP4 LDA DSKBP BACK UP THE DISK ADDR TO THE STA \ADSK START OF THE SYSTEM BP * CLB START AT LOW ADDR AND LDA PBREL CONTINUE UP TO LAST SYS LINK JSB BPOUT AND WRITE THE LINKS THERE * LDA TEMP4 RESTORE THE STA \ADSK DISK ADDRESS * LDA P2 CLEAR BP IMAGE OF SYSTEM LDB PBREL LINKS, STARTING AT JSB CLRLT 2 * * * LOAD PARTITION-RESIDENT DRIVERS INTO DP'S #2 ONWARD * CLA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD 'EM ALL JSB NOTST TEST FOR PROGRAMS LOADED SKP * * INITIALIZE FOR MEMORY RESIDENT LIBRARY & PROGRAM LOADING * 'rþú LDA PBREL SAVE THE LOWEST INA BP LINK USED STA LOLNK BY THE PRD'S STA BPLMT AND AS UPPER LIMIT FROM NOW ON * * SET THE SYSTEM BASE PAGE SCAN AREA TO INCLUDE ONLY THE * UPPER PORTION OF BASE PAGE CONTAINING TABLE AREA, SSGA, * AND DRIVER LINKS. * STA \LRBP SAVE LOWEST DRIVER LINK AS LOWEST ADA \ADBP SYSTEM LINK, AND STA \IRBP SAVE THE RT4GN IMAGE ADDRESS LDA LWSBP SET LAST LINK BEFORE SCOM, +1 STA \URBP AS LAST SYSTEM LINK * CLA RESET FLAGS STA SDID STA HIBP CLEAR AGAIN * * CLEAR THE FIXUP TABLE HERE * STA \PFIX ALL REMAINING UNDEFS ARE LOST * INA SET THE BP LINK ALLOCATION STA BPINC UPWARDS INA STA PBREL FROM LOCATION 2 * * SET UP THE CURRENT PROGRAM'S BASE PAGE SCAN AREA * STA \CUBP SET LOWEST MEM RES LINK AT 2 ADA \ADBP AND SET ITS RT4GN STA \ICBP IMAGE ADDRESS LDA LOLNK SET THE LAST AVAILABLE MEM RES LINK,+1 STA \UCBP AS LOWEST (UPPER) SYSTEM LINK * LDA \CBPA CLEAR THE STA \CPL2 CURRENT PAGE STA CPLS LINK AREAS * * DETERMINE MEMORY RESIDENT LIBRARY LOAD POINT * LDB \MRT2 ARE MEMORY RESIDENTS TO SZB ACCESS TABLE AREA II? JMP MYES YES, SET LOAD ADDRESS LDA FWSDA GET FIRST WORD OF SDA LDB MRACM DID ANY MR DECLARE ACCESS TO COMMON/SSGA? SZB,RSS LDA LWDP1 NO, SET LOAD ADDRESS TO COMMON START JMP SETP YES,SET LOAD PT TO SAME AS SDA * MYES LDA FWPRV OTHERWISE GET PRIV LOAD POINT SETP STA \PREL SET RELOCATION ADDRESS STA LBCAD AND FIRST WORD OF MEMORY RES LIBRARY JSB DSKEV START MRL ON AN EVEN SECTOR BOUNDARY STA DSKMR AND SAVE THE ADDRESS JSB \USRS INITIALIZE THE \ABDO SPEC'S * CCA SET å5þúLIB FLAG TO SHOW LIB LOADING STA LIBFG SO ONLY TYPE 6 PROGRAMS WILL LOAD JSB CLRT6 GO CLEAR LOAD FLAGS FOR TYPE 6 PGMS * * LOAD LIBRARY * LDA P14 SET TO GET RESIDENT LIB. ROUTINES STA \PTYP LDA P24 LDB MES13 MES13 = ADDR: MEMORY RESIDENT LIBRARY JSB SETHD PRINT HEADING, INITIALIZE IDX LDLB JSB IDSCN SCAN IDENTS JMP LBEND END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED LIBRARY ROUTINE JMP LDLB IGNORE USED PROGRAM * LDA P14 IF THIS IS A FOURCE LOAD CPA \PTYP THEN STB \ID3,I SET THE LOADED FLAG JSB \LODN INITIATE AND \LODN MAIN PROGRAM JSB INCAD UPDATE BP, PROG RELOC ADDR JMP LDLB PROCESS NEXT LIBRARY PROGRAM * LBEND CLA,INA DID WE FINISH LOADING LIB FOR CPA \PTYP RESIDENT?? JMP COMTS YES, CONTINUE...... STA \PTYP NO, SET UP LDA M7 THE SCAN STA \TMSK MASK LDA P10 AND RESET STA CIDNT THE LST POINTERS JMP LDLB AND RESTART SPC 1 COMTS JSB NOTST PRINT "NONE" IF NO LIB JSB \SPAC SKIP A LINE SPC 1 * CLEAN UP AFTER LOADING LIBRARY SPC 1 CLA CLEAR THE STA LIBFG "LIBRARY LOADING" FLAG * * ZERO-FILL THE LAST PAGE CONTAINING THE MEMORY RESIDENT LIBRARY * IN ORDER TO START THE MEMORY RESIDENT PROGRAM AREA ON A PAGE * BOUNDARY. * CCA GET THE LAST WORD OCCUPIED ADA \PREL BY THE MRL, AND ROUND STA LEND IOR M1777 IT UP TO A PAGE INA BOUNDARY STA \PREL SAVE AS RELOCATION ADDRESS OF STA FWMRP THE MEMORY RESIDENT PROGRAM AREA * LDB LBCAD GET THE STARTING ADDR OF THE CMB,INB MRL, AND COMPUTE ITS SIZE ADA B (INCLUDING THE ZERO-FILL) JSB ¢þúCPAG# CONVERT TO # PAGES ADA FPMBP ADD TO THE MRBP PAGE # INA ADD MRBP SIZE STA FPMRP AND SET FIRST PAGE OF MEM RES PROGRAMS SPC 1 * RESET CP LINK AREA POINTERS SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA SKP * * LOAD MEMORY RESIDENT PROGRAMS * RRLDD LDA P16 LDB MES15 MES15 = ADDR: MEM RESIDENTS JSB SETHD PRINT HEADING, INITIALIZE IDX RRLD JSB IDSCN SCAN IDENTS JMP RREND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP RRLD IGNORE SUB LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP RRLD IGNORE LOADED PROGRAM * STB \ID3,I SET NEW USAGE FLAG JSB \USER RESET THE \ABDO MAP TO MEM RES SPEC'S JSB \LODN INITIATE AND LOAD MAIN PROGRAM * JSB \SYS RESET TO SYSTEM MAP TO CLA JSB GENID GENERATE ID SEGMENT, KEYWORD CLA NO PARTITION REQMT CCB ADB \TIDN IDENT INDEX (\TIDN POINTS TO NEXT ENTRY) JSB IDFIX GO SET MEM PROTECT INDEX NOP ERROR RTN NOT POSSIBLE HERE JSB INCAD UPDATE BP, PROG RELOC ADDR JMP RRLD PROCESS NEXT RT RESIDENT * RREND JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE JSB CCPLK PACK THE CURRENT PAGE LINKAGE AREA JSB BPDSA OUTPUT REMAINDER OF RECORD * * * DUMP THE MEMORY RESIDENT BASE PAGE TO DISK * STA DSKMB SAVE THE BASE PAGE DISK ADDRESS LDB P2 START AT LOW ADDRESS LDA PBREL AND DUMP ALL THE MEMORY JSB BPOUT RESIDENT LINKS ALLOCATED * * COMPUTE THE NUMBER OF PAGES OCCUPIED BY THE MEMORY RESIDENT * LIBRARY AND MEMORY RESIDENT PROGAMS. * CCA GET THE LAST WORD OCCUPIED BY ADA \PREL THE MEMORY RESIDENT PROGRAM AREA STžþúA EMRP IOR M1777 AND ROUND IT TO A PAGE INA BOUNDARY (IE,ZERO-FILL) LDB LBCAD GET THE STARTING ADDRESS OF THE CMB,INB MEMORY RES LIBRARY, AND COMPUTE ADA B THE ENTIRE MEMORY RESIDENT SIZE JSB CPAG# CONVERT TO # PAGES STA MRP# AND SAVE THE # PAGES OCCUPIED BY MEM RES ADA FPMBP ADD TO PAGE # OF MRBP INA ADD SIZE OF MRBP STA PAGE# AND SAVE THE NEXT PHYSICAL PAGE # * CMA,INA DETERMINE IF THERE EXISTS ADA \NUMP ENOUGH MEMORY PAGES FOR THE SSA,RSS MEMORY RESIDENT AREA JMP IRTDR INIT FOR RT DISK RESIDENTS * LDA ERR61 JSB \IRER ISSUE DIAGNOSTIC & TERMINATE ERR61 ASC 1,61 SKP * * INITIALIZE FOR REAL TIME DISK RESIDENT LOADING * IRTDR LDA P2 STA \PTYP SET TO FIND TYPE 2 PROGS STA MTYPE * JSB DEMTL DEMOTE ALL TYPE 6 AND 14 PROGS TO TYPE 7 * * SET BPLINK SCAN AREA FOR CURRENT PROGRAM AND BOUNDS * FOR BP LINK ALLOCATION. NOTE THAT THAT BP LINK ALLOCATION * REMAINS SET IN THE "UPWARD" DIRECTION FROM MEM RESIDENT * LOADING, AND LIMIT IS STILL LOLNK. SPC 1 LDA P2 SET LOWEST DISK LINK STA PBREL STARTING AT 2 STA \CUBP ADA \ADBP AND SAVE ITS IMAGE STA \ICBP ADDRESS. LDB LOLNK SET UPPER DISK LINK AS STB \UCBP BELOW SYS,LIB, AND SSGA LNKS * * CLEAR BASE PAGE IMAGE OF MEMORY RESIDENT PROGRAM LINKS SPC 1 LDA PBREL START CLEAR AT 2 & END BEFORE LOLNK JSB CLRLT AND GO DO IT SPC 1 * RESET CP LINK AREA POINTERS TO "EMPTY" SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA STA \CPLB (FOR PACK),AND FOR SEGMENT LOADING JMP RDLD SKIP RESETTING OF TYPE/HEADING FOR BG * TEMP3 NOP TEMP4 NOP SKçÔþúP * * LOAD RT & BG DISK RESIDENTS * SETBG LDA P3 SET BG PROGRAM TYPE LDB "BG" AND HEADING TYPE STB MS16 SAVE BG IN HEADING STA \PTYP BG DISK RESIDENT STA MTYPE RDLD LDA P17 LDB MES16 MES20 = ADDR: XX DISK RESIDENTS JSB SETHD PRINT HEADING INITIALIZE IDX BDLD JSB DSKEV LOAD DISC RESIDENTS ON EVEN SECTOR STA EMDSK SAVE IN CASE AN EMA PROG CLA KILL ANY LEFT OVER FIX UPS STA \PFIX STA SDID CLEAR SEGMENT COUNTER JSB IDSCN SCAN IDENTS JMP BDEND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP BDLD IGNORE SUBS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP BDLD IGNORE LOADED PROGRAM * * INITIALIZE FOR LOADING * STB \ID3,I SET NEW USAGE FLAG CCA STA EMLNK CLEAR EMA INDICATORS STA EMLST ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IDSAV SAVE MAIN IDENT INDEX FOR BS REF * LDA \PTYP GET CURRENT PROGRAM TYPE CPA P2 RSS CPA P3 ARE WE SETTING THE LOAD PT FOR JSB SETPV RT/BG PRIVILEGED PROGRAMS JSB SETRB OR BG PROGRAMS JSB \USRS SET UP A NEW USER JSB \LODN INITIATE AND \LODN MAIN PROGRAM * * BUILD ID SEGMENT, SEND LINKS TO DISK * JSB \SYS RESET TO SYSTEM MAP CCA JSB GENID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINDER OF RECORD LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBS SAVE DISK ADDR OF BP SECTION LDA TBREL GET UPPER BP ADDRESS LDB PBREL GET LOWER BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA TPREL GET CURRENT PROG RELOC ADDR STA BSPAD SAVE PROG RELOC ADDR FOR BS STA TPMAX SET HWM FOR MAIN JSB CCPLK PACK THE CP LINK AREA LDA \CPL2 UP DATE ÍöþúSTA CPLS THE LOW SAVE ADDRESS * LDA TBREL GET CURRENT BP RELOC ADDR STA BSBAD SAVE BP RELOC ADDR FOR BS * * SEARCH FOR THE PROGRAM'S SEGMENTS * LDA P5 STA \PTYP SET TYPE = BG SEGMENT JSB \INID INITIALIZE IDX BSLD JSB \IDX SET IDENT ADDRESSES JMP BSEND END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE MAIN BS IDENT INDEX LDA \ID4,I GET M OR S SSA,RSS SKIP IF MAIN BG SEGMENT JMP BSLD IGNORE SUBS LDA \ID6,I GET TYPE AND M37 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP BSLD NO - IGNORE IDENT * LDA \ID8,I GET BS MAIN \IDENT INDEX CPA IDSAV BS CALLS THIS BG MAIN? RSS YES - CONTINUE JMP BSLD NO - IGNORE BACKGROUND SEGMENT LDA \TIDN GET NEXT IDENT INDEX STA ABSID SAVE INDX FOR NEXT BG SEG SCAN CCB STB HDFLG SET HEADING FLAG FOR BG SEGMENT JSB DSKEV SET FOR EVEN SECTOR JSB \SEGS SET UP A NEW USER AREA LDA BSPAD RESET THE LDB \ABCO STA B,I BASE CORE ADDRESSES FOR LDB \MXAB STA B,I A SEGMENT LOAD JSB \LODN LOAD BG SEGMENT * LDA CPLS RESET THE CP LINK STA \CPL2 BOTTOM JSB \SYS RESET TO SYSTEM MAP JSB \SPAC NEW LINE CCA JSB GNSID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINING OF ABS REC * LDB TPREL SUBTRACT SEG'S HIGH ADDR LDA B FROM PREV MAX CMA,INA HIGH ADDR ADA TPMAX SSA IF NEW IS HIGHER STB TPMAX THEN STORE AS MAX * ISZ SDID SET SEGMENT FLAG FOR IDFIX LDA TBREL GET UPPER BP ADDRESS LDB BSBAD GET LOWER BS BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA BSBAÒPþúD GET BS BP RELOC ADDR LDB TBREL GET UPPER BOUND BP ADDRESS JSB CLRLT CLEAR BP LINKAGES LDA BSBAD GET BS BP RELOC ADDRESS STA TBREL SET BP RELOC ADDR LDA BSPAD GET BS PROG RELOC ADDRESS STA TPREL SET PROG RELOC ADDR LDA ABSID GET NEXT BG SEG IDENT INDEX STA \TIDN SET IDENT INDEX FOR IDX JMP BSLD LOAD NEXT BG SEGMENT * * * FIX ID SEGMENT OF MAIN * BSEND LDA TPMAX PASS MAX HIGH ADDR LDB \PREL AND LOW ADDR, THEN JSB PGREQ SET A-REG LDB IDSAV PASS PAGE REQMT & IDENT JSB IDFIX INDEX THEN FIX iD SEG. JMP CLBPL ERROR RETURN ON EMA'S * * UPDATE BP LINKS (IE, EMA) * LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBR SAVE CURRENT DISK ADDR OF ABS LDA DSKBS GET DISK ADDR FOR MAIN BP CODE STA \ADSK SET CURRENT BP CODE ADDRESS LDA BSBAD GET UPPER ADDR OF BP CODE LDB PBREL GET LOW ADDR FOR BP CODE JSB BPOUT OUTPUT BP CODE FOR MAIN DISK RES LDA DSKBR GET CURRENT DISK ADDRESS STA \ADSK SET CURRENT ABS DISK ADDRESS CLBPL LDA PBREL GET LOW BP ADDRESS LDB BSBAD GET UPPER BOUND BP CODE JSB CLRLT CLEAR BP LINKAGES * LDA MTYPE RESET THE MAIN PROGRAM TYPE STA \PTYP SET PROG TYPE = XX DISK RESIDENT JSB CLID3 CLEAR PROGS-LOADED FLAGS LDA IDSAV GET MAIN IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX LDA \CPLB RESET THE LOW SAVE ADDRESS STA CPLS RESET FOR BG MAIN STA \CPL2 PROGRAMS JMP BDLD LOAD NEXT BG DISK RESIDENT * BDEND LDA \PTYP CPA P4 RSS JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE LDA \PTYP SET PROPER HEADING AND TYPE CPA P4 IF PRIVILEGED PROGRAMS WERE JUST JMP PD DONE, THEN MOVE ON CPA P2 IF REAL-TIMEurþúS WERE JMP SETBG JUST DONE, THEN GO SET FOR BG'S INA ELSE SET FOR TYPE 4 BG'S STA \PTYP SET CURRENT PROGRAM TYPE STA MTYPE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG TO -1 LDA P10 START IDENT TABLE SCAN STA CIDNT BACK TO BEGINNING JMP BDLD AND PERFORM NEXT PASS SKP * * PERFORM PARTITION DEFINITION, FOLLOWED BY STORING THE DISK * RESIDENT LIBRARY AND LIBRARY ENTRY POINTS LIST ON DISK * PD JSB \PART PARTITION DEFINITION PHASE * JSB BPDSA OUTPUT REMAINDER OF LIBR LIST JSB \SYS BACK TO THE SYSTEM MAP SKP * * GENERATE BLANK ID SEGMENTS * ENDBI LDA CURAK MORE BLANK ID'S? CPA \ASKY ? JMP ENDRL NO HOW ABOUT SHORT ONES? * LDA N2 YES GENERATE A JSB GENID BLANK ID SEGMENT JMP ENDBI NEED ANOTHER? * ENDRL LDA \SKYA IF NEXT KEYWORD IS INA CPA IDSAD THEN TERMINATE JMP ENDSZ BLANK OUTPUT. * LDA N2 A=-2 FOR BLANK ID SEGMENT FLAG. JSB GNSID GENERATE ID SEGMENT. JMP ENDRL REPEAT TEST. * * PUT OUT DISK DICTIONARY ENDSZ LDA \ADSK GET CURRENT DISC ADDRESS. ALF,ALF ROTATE DISK TRACK NO. TO LOW A RAL ISOLATE AND M377 TRACK NUMBER. ADA P2 SET A = NUMBER OF USED TRACKS STA CURAT SAVE NO. OF USED TRACKS CMA,INA STA TCNT SET TRACK USAGE COUNT CLA STA \TBUF CLEAR \TBUF LDA ADICT SET THE TAT ADDRESS STA CURAI FOR OUTID SYSTR LDA MSIGN SET FLAG FOR SYSTEM-USED TRACK JSB OUTID OUTPUT TRACK-USED FLAG ISZ TCNT STEP THE COUNT JMP SYSTR MORE TO DO CONTINUE * USRTR JSB REMDO FLUSH FINAL SECTOR FROM DBUF SKP * * CLEAR SYSTEM COMMUNICATION AREA * * ¤Õþú THIS OVERLAYS 133 OCTAL WORDS * BELOW THE LABEL "USRTR". * LDA FWCMM GET ADDR OF SYS COMM AREA LDB NLCOM GET NEG. LENGTH OF COMM AREA STB WDCNT SET COUNT FOR CLEARING BP AREA CLB STB A,I CLEAR BP COMM AREA WORD INA ISZ WDCNT SKIP - AREA CLEARED JMP *-3 CONTINUE CLEARING BP AREA * * LDA AEQT 1650 - SET ADDRESS OF EQT'S STA EQTA GET ADDRESS OF EQT * LDA CEQT 1651 - SET NUMBER OF EQT'S STA EQT# SET NO. OF EQT ENTRIES * LDA ASQT 1652 - SET ADDRESS OF DRT STA DRT SET ADDR OF DEV REF TABLE * LDA CSQT 1653 - SET NUMBER OF DRT ENTRIES STA LUMAX SET NO. OF DEV REF TABLE ENTRIES * LDA AINT 1654 - SET ADDRESS OF INT STA INTBA SET ADDR OF INTERRUPT TABLE * LDA M72 1655 - SET NUMBER OF INT ENTRIES STA INTLG SET NO. OF INT ENTRIES * LDA ADICT 1656 - SET ADDRESS OF TRACK ALLOCATION TABLE STA TAT SET ADDR OF TAT * LDA KEYAD 1657 - SET ADDRESS OF KEYWORD TABLE STA KEYWD SET ADDR OF KEYWORD LIST * LDA \TBCH 1674 - SET SELECT CODE OF TBG STA TBG SET I/O ADDR FOR TBG * LDA TTYCH 1675 - SET EQT ADDRESS OF SYSTEM CONSOLE STA SYSTY SET EQT ADDR FOR SYS TELETYPE * LDB SCH4 1711 - SET ID SEGMENT ADDRESS, OR ZERO STB SKEDD IN SCHEDULED LIST * LDA \SWPF 1736 - SET SWAPPING FLAG STA SWAP SET SWAPPING FLAG * LDA \PIOC 1737 - SET ADDRESS OF PRIVILEGED STA DUMMY I/O CARD * LDA DSKSY 1740 - SET DISC ADDRESS OF STA IDSDA FIRST ID SEGMENT * LDA IDSP 1741 - SET POSITION OF FIRST STA IDSDP ID SEGMENT IN SECTOR * LDA P2 1742 - SET FIRST LINK FOR STA BPA1 RT DR'S STA BPA3 BG/PR DR'S (1744) * ½Sþú CCA 1743 - AND SAVE LOWEST ADA LOLNK DRIVER LINK AS LAST STA BPA2 DR LINK * LDA LBCAD 1745 - SET ADDRESS STA LBORG OF MEMORY RESIDENT LIBRARY * LDA RTCAD 1746 - SET REAL TIME COMMON ADDRESS STA RTORG SET RT COM ADDRESS * LDA COMRT 1747 - SET REAL TIME COMMON LENGTH STA RTCOM SET RT COM LENGTH * LDA BGCAD 1752 - SET BG COMMON ADDRESS STA BKORG * LDA COMBG 1753 - SET BACKGROUND COMMON STA BKCOM LENGTH * LDA LWASM 1777 - SET LAST WORD MEMORY STA BKLWA ADDRESS OF BG PARTITION * LDA P96 1757 - SET # OF SECTORS PER TRACK FOR STA SECT2 SYSTEM DISC (LU #2). * LDA ADS# 1760 - SET # OF SECTORS PER TRACK FOR STA SECT3 AUXILIARY DISC (LU #3). * LDA DSKLB 1761 - SET DISK ADDRESS OF LIBRARY STA DSCLB ENTRY POINTS LIST * LDA LBCNT 1762 - SET NUMBER OF USER-AVAILABLE STA DSCLN ENTRY POINTS IN LIB ENTRY PT LIST * LDA DSKUT 1763 - SET DISK ADDRESS OF RELOCATABLE STA DSCUT DISK RESIDENT LIBRARY * LDA SYCNT 1764 - SET NUMBER OF SYSTEM ENTRY STA SYSLN POINTS IN LIB ENTRY PT LIST * CLA,INA STA MPTFL 1770 - SET MEM PROTECT FLAG OFF * LDA DSIZE 1755 - SET NEGATIVE TAT LENGTH ADA DAUXN CMA,INA STA TATLG SET TOTAL DISK TABLE LENGTH * LDA DSIZE 1756 - SET SYSTEM DISC SIZE STA TATSD * LDA LWSYS INITIALIZE SYSTEM AVAILBLE MEMORY MAP: INA STA EQT1 ADDRESS OF SAM #1 LDB SAM#1 STB EQT2 SIZE OF SAM #1 ADA B STA EQT3 ADDRESS OF SAM #2 LDB SAM#2 STB EQT4 SIZE SAM #2 LDA LWTAI GET LAST WORD ADDRESS OF TABLE AREA I INA AND SET STARTING ADDRESS OF SAM#0 STA EQT5 CMA,INA COMPUTE SIZE‡¨þú BY SUBTRACTING ADA DPADD FROM START OF DRIVER PARTITION STA EQT6 AND SET * LDA NLCOM SET UP # WORDS. CMA,INA STA TEMP1 LDA FWCMM MOVE THE SYS COM LDB \ADBP AREA ADB LWSBP TO THE MVW TEMP1 THE DUMMY BASE PAGE SPC 2 * PUT OUT BASE PAGE * JSB DSKEV GET NEXT EVEN SECTOR ADDRESS STA DSKAV SAVE NEXT AVAILABLE DISK ADDR SPC 2 * WRITE UPPER PART OF SYSTEM BASE PAGE TO DISK. * * THE PORTION OF THE BASE PAGE CONTAINING SYSTEM * LINKS WAS ALREADY WRITTEN OUT. * SINCE WE PROBABLY ENDED THE LOWER PORTION IN * THE MIDST OF A SECTOR, IT IS MOST CONVENIENT TO * WRITE THE REMAINDER OF THE B.P. USING \ABDO, A * WORD AT A TIME, TO INSURE THAT NEW WORDS ARE * MERGED INTO THE APPROPRIATE POSITIONS ON DISK. * * WE TELL \ABDO WE ARE WRITING PAGE 1 WORDS VICE * PAGE 0 SINCE \ABDO WAS DESIGNED TO VECTOR ALL BASE * PAGE REFERENCES INTO THE IN-CORE "DUMMY BASE PAGE" * INSTEAD OF THE DISK. SPC 1 LDA DSKBP GET STARTING SECTOR OF SBP STA \DSYS+3 AND SAVE IN \ABDO MAP. LDA M2000 ****SET BASE CORE ADDR STA \DSYS+1 IN MAP. LDA M4000 AND SET MAX CORE ADDR SEEN STA \DSYS+2 IN MAP. JSB \SYS INITIALIZE THE MAP LDA LOLNK SAVE CORE ADDRESS OF LOWEST ADA \ADBP DRIVER LINK IN TEMPORARY. STA TEMP5 LDB LOLNK CONVERT TARGET BP ADDR TO PAGE 1 ADB M2000 ADDR TO FAKE OUT \ABDO. SPC 1 BLOOP LDA TEMP5,I PICK UP NEXT BP WORD AND JSB \ABDO WRITE TO DISK, INCREMENTING B ISZ TEMP5 REG (TARGET) AND TERMP5 CPB M4000 (SOURCE) EACH TIME UNTIL JMP BPEND END OF PAGE IS PASSED JMP BLOOP (TARGET ADDR = PAGE 2) SPC 1 TEMP5 BSS 1 LOCAL TEMPORARY SPC 1 BPEND LDA \OLDA FLUSH THE \ABDO BUFFER LDB \ADBF TO THE ¬aNLH JSB \DSKO DISC JSB \FSEC FLUSH THE FINAL SECTOR SKP * * GENERATION COMPLETE. PERFORM CLEAN-UP. * JSB \SPAC LDA P22 LDB MES23 MES23 = ADDR: *SYSTEM STORED ETC JSB \MESS PRINT: SYSTEM STORED ON DISK * LDA DSKAV CONVERT ALF,ALF LAST RAL USED AND M377 DISC CMA LDB ATBUF ADDRESS (TRACK #) TO DECIMAL JSB \CONV AND LDA \TBUF+2 STORE STA MES38+6 IN MESSAGE. LDA DSKAV CONVERT AND M177 SECTOR ARS CONVERT TO 128 WORD SECTORS CMA,INA (DECIMAL) LDB ATBUF # JSB \CONV AND LDA \TBUF+2 STORE STA MES38+11 IN LDA \TBUF+1 MESSAGE AND M377 ISOLATE 3RD DIGIT, IOR UBLNK ADD UPPER BLANK. STA MES38+10 LDA P28 PRINT MESSAGE: LDB MES38 "SYS SIZE: -5Nÿÿþú JSB \MESS TRK XX SEC XXX(10)" JSB \SPAC * * LDA DSKAV FORCE ACESS TO LAST RECORD LDB \ADBF SO TRUNCATE WILL WORK. JSB \DSKI JSB \TRUN CLOSE CORE-IMAGE FILE. * JMP \EXIT DO FINAL CLEANUP * * M4000 OCT 4000 M377 OCT 377 M72 OCT 72 P16 DEC 16 P96 DEC 96 P14 DEC 14 NLCOM OCT 177645 SPC 5 * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SKP *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * SYSTEM TABLE DEFINITION * * FWCMM DEF USRTR-133B . EQU USRTR-130B * XIDEX EQU .-3 ID EXTENSION ADDR OF CURRENT PROG XMATA EQU .-2 MAT ENTRY ADDR OF CURRENT PROG XI EQU .-1 ADDR OF I-REG SAVE AREA EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 DÄþú PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT SUSPEND' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA USER BASE PAGE LINK AREA BPA2 EQU .+59 LWA USER BASE PAGE LINK AREA BPA3 EQU .+60 FWA USER BASE PAGE LINK LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME COMMON RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF RT PARTITION AVMEM EQU .+65 LWA+1 OF REAL TIME PARTITION BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BACKGROUND PARTITION * * UTILITY PARAMETERS * TATLG EQU .+69 NEGATIVE LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF REì,þúS LIB ENTRY PTS DSCLN EQU .+74 # OF USER ENTRY POINTS IN LEP LIST DSCUT EQU .+75 DISC ADDR OF RELOC DISK RES LIBR SYSLN EQU .+76 # OF SYSTEM ENTRY POINTS IN LEP LIST LGOTK EQU .+77 LOAD-N-GO: LU, ST TRACK, # OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF BACKGROUND PARTITION HED RTGN3 - LOADING CONTROL SEGMENT SUBROUTINES. * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTS * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * IDFIX: SETS UP WORDS 21, 28 & 29 OF A LONG ID SEGMENT * AND BUILDS AN ID EXTENSION FOR EMA PROGRAMS * * WORD 21 FORMAT - BIT 15: 1=PARTITION ASSIGNED * 10-14: PARTITION SIZE REQMT. IN PAGES * NEGLECTING BASE PAGE (#PAGES-1) * 7-9: MEM PROTECT FENCE TBL INDEX * 6: RESERVED (0) * 0-5: ASSIGNED PARTITION NUMBER-1 * * WORD 28 - 15-10: ID EXTENSIþþúON INDEX * 9-0: EMA SIZE * * WORD 29 - HIGH MAIN ADDRESS OF LARGEST SEGMENT, ELSE 0 * * CALLING SEQUENCE: * * JSB \SYS (OR MAKE SURE \ABDO IS MAPPING SYSTEM) * A= #PAGES NEEDED BY PROGRAM INCL. BASE PAGE * B= INDEX OF IDENT ENTRY FOR PROG * JSB IDFIX * * * RETURN: * (P+1): ERROR ON MSEG SIZE OF EMA PROG * (P+"): NORMAL RETURN SPC 1 IDFIX NOP SZA DON'T INCLUDE BASE ADA M1 PAGE IN SIZE. STA IDTM1 SAVE PAGE REQMT STB \TIDN STORE DESIRED ENTRY INDEX JSB \IDX AND BRING INTO CORE JSB \ABOR NOT THERE * LDA \ID6,I WAS THIS AN EMA PROGRAM? SSA,RSS JMP SETMP NO, CONTINUE WITH MPFT INDEX * * DETERMINE PROGRAM'S MAXIMUM MSEG SIZE AND CHECK AGAINST * THE DECLARED SIZE IN ID6 (14-10), OR SET IF DEFAULTED * CCA ROUND THE HIGH MAIN OF THE PROGRAM OR ADA TPMAX ITS LARGEST SEGMENT TO THE START IOR M1777 OF THE NEXT PAGE INA STA EHM BITS 14-10 CONTAIN THE LOG START PAGE OF MSEG * JSB CPAG# GET THE PAGE # AND USE IT TO CMA,INA DETERMINE THE MAXIMUM MSEG SIZE ADA P31 SSA,RSS IF THERE DOES NOT EXIST AT SZA,RSS LEAST 2 PAGES (1 EACH FOR MSEG AND OVFLOW) JMP EER43 THEN DELETE PROG FROM SYS * STA MMSEG SAVE MAX MSEG SIZE LDA \ID6,I GET DECLARED JSB CPAG# SIZE FROM IDENT AND M37 SZA,RSS DEFAULTED? JMP MDFLT YES, USE MMSEG * STA B SAVE FOR LATER CMA,INA IS THE DECLARED MSEG SIZE GREATER ADA MMSEG THAN THE MAX? SSA,RSS JMP EMAF1 NO, ITS OK * * INVALID MSEG SIZE - BACK UP DISK ADDRESS AND GET RID OF * PROGRAM'S ID SEGMENT(S) * EER43 LDA ERR43 SEND ERROR DIAGNOSTIC CMA,INA JSB ´0þú\GNER JSB \SPAC * LDA EMDSK BACKUP THE DISK ADDRESSES STA \ADSK OVER THE EMA PROGRAM CCA AND THE KEYWORD POINTER ADA CURAK STA CURAK LDB N33 NOW THE LONG ID SEGMENT ADDRESS ADB SYSAD STB SYSAD STB CURAI SET FOR ZOUT LDB N33 CLEAR THE ENTIRE JSB ZOUT ID SEGMENT USED BY MAIN LDA \ID6,I GET PROGRAM TYPE AND M1776 AND MASK IT OUT IOR P8 SET IT TO A TYPE 8 MAIN (DELETED) STA \ID6,I AND STORE * LDA SDID WERE THERE ANY SZA,RSS SEGMENTS? JMP IDFIX,I NO ALF,RAR BACK-UP THE SHORT ID-SEG ADDRESS ADA SDID BY 9 WORDS EACH CMA,INA STA B SAVE FOR ZOUT ADA \SSID AND RESET THE NEXT STA \SSID SHORT ID-SEG ADDRESS ADA P11 BUMP TO ACTUAL START STA CURAI OF ID SEG JSB ZOUT AND CLEAR ALL OF THEM * LDA SDID NOW BACK UP THE CMA,INA KEYWORD COUNTER AS WELL ADA \SKYA STA \SKYA * JMP IDFIX,I ERR43 ASC 1,43 M1776 OCT 177600 P8 DEC 8 SPC 2 MDFLT LDA MMSEG GET MAXIMUM MSEG SIZE STA B ALF,RAL AND POSITION TO BITS 14-10 ALF,RAL IOR \ID6,I AND STORE IN IDENT ENTRY STA \ID6,I OF PROG * EMAF1 STB MMSEG SET CURRENT PROG'S MSEG ADB IDTM1 ADD TO CODE PAGE REQ'S STB IDTM1 AND SET FOR WORD 21 * * UPDATE ID SEGMENT WORD 28 OF AN EMA PROGRAM * LDB IDEXC GET INDEX OF NEXT EXTENSION BLF,RBL AND MOVE TO (15-10) BLF,RBL LDA \ID5,I GET THE DECLARED EMA SIZE ALF,ALF FROM IDENT ALF AND M1777 STA PGREQ *TEMP* SAVE * SZA,RSS DEFAULT? INA YES, SET TO 1 ADA B MERGE INDEX STA IDTM3 AND SAVE JSB IDFND GET ID SEG ADDRESSeÐþú ADB P28 POSITION TO WORD 28 LDA IDTM3 GET VALUE TO STORE JSB \ABDO AND DO IT * * BUILD THE ID EXTENSION FOR AN EMA PROGRAM: * WORD 0: (4-0) MSEG SIZE * WORD 1: (15-11) LOGICAL START PAGE OF MSEG * (10) =1 IF DEFAULT EMA SIZE * LDB IDEX GET ADDRESS OF NEXT ID ADB IDEXC EXTENSION ENTRY JSB DPRW FROM ID EXTENSION TABLE LDB A ADDRESS TO B-REG LDA MMSEG STORE MSEG SIZE JSB \ABDO IN WORD 0 STB IDTM3 SAVE ADDR LDA EHM GET LOG START PAGE AND M0760 OF MSEG IN 14-10 LDB PGREQ WAS EMA SIZE DEFULTED? SZB,RSS ADA M1000 YES, SET SO BIT 10 WILL BE SET RAL MOVE 'EM ALL LEFT 1 LDB IDTM3 GET ENTRY ADDRESS OF WORD 1 JSB \ABDO AND SEND IT * ISZ IDEXC BUMP # OF EXTENSIONS USED LDA EMLNK NOW STORE THE MSEG STARTING ADA \ADBP ADDRESS INTO THE ALREADY- LDB EHM ALLOCATED BASE PAGE LINK STB A,I SPC 2 * CHECK USE OF SSGA SPC 1 SETMP LDA \ID6,I GET PROG TYPE FROM \IDENT AND M20 AND ISOLATE THE SSGA BIT. SZA,RSS IF NOT USING SSGA, JMP NOSSC THEN GO CHECK OTHER COMMONS. SPC 1 LDA P4 IF USING SSGA, THEN PICK UP ITS JMP IDSET MPFT INDEX AND GO WRITE ID-SEG. SPC 1 * NOT USING SSGA; USE COMMON SIZE FROM IDENT * (EITHER SOME OR NONE), REVERSE COMMON BIT IN TYPE, * AND LOW TWO TYPE BITS TO INDEX INTO TABLE OF * MPFT INDICES. SPC 1 NOSSC LDA \ID6,I GET TYPE AGAIN AND SAVE BITS AND M13 0,1, AND REVERSE COMMON BIT(3) LDB \ID4,I PICK UP COMMON SIZE CLE,ELB CLEAR SIGN BIT SZB IF ANY, THEN SET BIT 2 IN A. IOR P4 SPC 1 ADA IDTB. USE BIT PATTERN IN A TO INÄþúDEX LDA A,I TABLE, AND PICK UP MPFT INDEX. SPC 1 * A CONTAINS MPFT INDEX, MERGE IN SIZE REQUIREMENT * AND WRITE DISK. SPC 1 IDSET CLB PUT MPFT INDEX AND RRR 3 IOR IDTM1 PAGE REQMT IN PROPER RRL 10 POSITIONS IN A-REG SPC 1 STA IDTM3 SAVE NEW ID WORD JSB IDFND FIND ID-SEG ADDRESS ADB P21 POINT TO ID-SEG WORD 21 LDA IDTM3 AND WRITE NEW CONTENTS JSB \ABDO TO DISK. SPC 1 LDA IDTM1 MERGE PARTITION SIZE ALF,ALF REQUIREMENT LESS 1 IOR \ID8,I INTO UPPER BYTE STA \ID8,I OF \IDENT WORD 8 * * IF A SEGMENTED PROGRAM THEN SET WORD 29 * ISZ IDFIX BUMP RETURN ADDR LDA SDID GET SEGMENT-ENCOUNTERED FLAG SZA,RSS ANY FOR THIS PROGRAM JMP IDFIX,I NONE, SO RETURN ADB P7 POSITION TO WORD 29 ADDR LDA TPMAX GET HIGH MAIN OF LARGEST JSB \ABDO SEGMENT AND STORE * JMP IDFIX,I EHM NOP MMSEG NOP N33 DEC -33 P11 DEC 11 SKP * CONSTANTS, ETC. SPC 1 IDTM1 BSS 1 IDTM3 BSS 1 M20 EQU P16 * M13 OCT 13 SPC 4 * INDEX LOOKUP TABLE * * TABLE CONTAINS MPFT INDICES * * THE INDEX TO THIS TABLE IS 4 BITS LONG: * * BITS 0,1: 00 - LBG DISK RES * (FROM TYPE) 01 - MEM RES * 10 - RT DISK RES * 11 - BG DISK RES * BIT 2: 0 - NO COMMON USED * 1 - COMMON USED * BIT 3: 0 - USE NORMAL COMMON * 1 - USE REVERSE COMMON SPC 1 IDTB. DEF *+1 INDEX OCT 0 0000-BG W/O COMMON OCT 1 0001-MR W/O COMMON OCT 5 0010-RT DR W/O COMMON P5 OCT 5 0011-BG DR W/O COMMON P3 OCT 3 0100-BG DR W/BG COMMON P2 y¡þúOCT 2 0101-MR W/RT COMMON OCT 2 0110-RT DR W/RT COMMON OCT 3 0111-BG DR W/BG COMMON OCT 0 1000-BG DR W/O COMMON (REVERSE) OCT 1 1001-MR W/O COMMON (REVERSE) OCT 5 1010-RT DR W/O COMMON (REVERSE) OCT 5 1011-BG DR W/O COMMON (REVERSE) OCT 2 1100-BG DR W/RT COMMON OCT 3 1101-MR W/BG COMMON OCT 3 1110-RT DR W/BG COMMON OCT 2 1111-BG DR W/RT COMMON * END OF TABLE SKP * * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR \ABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) B IS ID SEG ADDR * (INSURE PROG'S IDENT IS IN CORE) * JSB IDFND * SPC 1 IDFND NOP LDA M377 PICKUP KEYWD# IN IDENT AND \ID8,I WORD 8 AND ISOLATE IT ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. SPC 4 * DETERMINE PAGE REQUIREMENTS FOR A PROGRAM * * CALLING SEQUENCE: RETURN SEQUENCE: * A=HIGH MAIN ADDR+1 B,E DESTROYED * B=LOW MAIN ADDR A=PAGE REQUIREMENT * JSB PGREQ INCL. BASE PAGE. SPC 1 PGREQ NOP CMB B=-LOMAIN-1 ADA B A=NO. WORDS NEEDED-1 RRR 10 A=#PAGES-1 AND M37 CLEAN OUT BAD BITS ADA P2 A=#PAGES+1(I.E. INCL BASE PAGE) SPC 1 JMP PGREQ,I PAGE REQUIREMENTS. SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * C˜¿þúALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TBREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SKP * N6 DEC -6 P21 DEC 21 * MES13 DEF MS13 MES14 DEF *+2 DEF *+8 ASC 10,RT COM ADD MES15 DEF MS15 MES18 DEF *+2 DEF *+8 ASC 10,BG COM ADD MES16 DEF MS16 MES22 DEF *+1 ASC 3,(NONE) MES23 DEF MS23 MES12 EQU MES23 * MES38 DEF *+1 ASC 14,SYS SIZE: XX TRKS, XXX SECS * JMP3I JMP 3,I INITIAL JMP INSTRUCTION * MES31 DEF *+1 ASC 11,SUBSYSTEM GLOBAL AREA MES32 ASC 5,Æ þúDRIVR PART MES62 DEF *+2 DEF *+6 MES57 ASC 8,BG COMMON MES63 DEF *+1 ASC 9,SYSTEM DRIVER AREA MES64 DEF *+1 ASC 9,PARTITION DRIVERS MESDP DEF *+1 ASC 2,DP DO NOT REARRANGE MESPD NOP THESE FOUR ASC 1,: LINES * MES53 ASC 5,RT COMMON * P4 DEC 4 SPC 3 MS02 ASC 8,BP LINKAGE XXXXX MS13 ASC 12,MEMORY RESIDENT LIBRARY MS15 ASC 8,MEMORY RESIDENTS MS16 ASC 9,RT DISC RESIDENTS MS23 ASC 11,SYSTEM STORED ON DISC "BG" ASC 1,BG "PR" ASC 1,PR SKP * * FOR LBG DISK RESIDENTS, SET THE RELOCATION BASE AT * THE FIRST PAGE FOLLOWING THE DRIVER PARTITION, * OR, IF USED, COMMON. THIS ROUTINE IS CALLED BEFORE * RELOCATION OF EACH DISK RESIDENT PROGRAM SPC 1 SETRB NOP LDB LWDP1 GET LWA OF DP + 1 LDA \ID6,I GET PROG TYPE AND M20 ISOLATE SSGA BIT IN TYPE, IOR \ID4,I MERGE IN COMMON LENGTH, AND M7777 CLEAR SIGN BIT SZA AND IF HE USES EITHER LDB FWSDA SET RELOC BASE ABOVE COMMON. STB \PREL AND SAVE AS RELOCATION BASE. JMP SETRB,I RETURN SPC 3 * * SET THE RELOCATION BASE FOR PRIVILEGED PROGRAMS * AT THE PAGE BOUNDARY ABOVE TABLE AREA II. THIS * ROUTINE IS CALLED BEFORE THE RELOCATION OF EACH * RT/BG PRIVILEGED DISK RESIDENT PROGRAM. * SETPV NOP ISZ SETPV LDB FWPRV STB \PREL JMP SETPV,I SPC 3 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB M1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWÀûþúT BSS 1 SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * IDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * TEST FOR SOME PROGRAMS LOADED * * THE NOTST SUBROUTINE CHECKS FOR PROGRAMS OF THE CURRENT * TYPE LOADED. IT IS EXECUTED FOLLOWING COMPLETION OF THE * LOADING SEQUENCE FOR EACH PROGRAM TYPE. IF NO PROGRAMS OF * THIS TYPE HAVE BEEN LOADED, IT PRINTS THE MESSAGE * (NONE) ON THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB NOTST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * NOTST NOP ISZ LFLAG IF NO PROGRAMS LOADED JMP NOTST,I SEND: (NONE) LDA P6 LDB MES22 MES22 = ADDR: (NONE) JSB \MESS PRINT: (NONE) JMP NOTS^þúT,I SPC 3 MES02 DEF MS02 MES03 DEF MS02+5 SKP * * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 * CLWRD NOP SKP * * OUTPUT ABSOLUTE BASE PAGE CODE * * BPOUT OUTPUTS THE BASE PAGE SECTION OF CODE FOLLOWING LOADING OF * EACH DISK RESIDENT PROGRAM, BEGINNING WITH THE DISK * ADDRESS SPECIFIED IN \ADSK. * * CALLING SEQUENCE: * A = UPPER BP ADDRESS PLUS ONE * B = LOWER BP ADDRESS * JSB BPOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * BPOUT NOP CMA,INA COMPLEMENT UPPER ADDRESS ADA B ADD LOWER ADDRESS STA TCNT SAVE BP LENGTH ADB \ADBP ADJUST FOR BP ADDRESS STB CURAT SAVE CURRENT LOWER CORE ADDR SSA,RSS SKIP - SOME CODE IN BP JMP BPOUT,I RETURN - ALL CODE OUT LDA \ADSK GET CURRENT DISK ADDRESS BPSYO JSB \DSKO OUTPUT CURRENT BP SECTOR LDA \ADSK GET CURRENT DI—^NLHSK ADDRESS JSB \DSKA INCR DISK ADDRESS STA \ADSK SAVE NEXT DISK ADDRESS LDB TCNT GET CURRENT LENGTH ADB P64 STB TCNT SAVE COUNT FOR NEXT PASS SSB,RSS SKIP - MORE CODE TO PUT OUT JMP BPOUT,I RETURN - ALL CODE OUT LDB CURAT GET CURRENT LOW CORE ADDRESS ADB P64 STB CURAT SET NEXT CORE ADDRESS JMP BPSYO OUTPUT NEXT SECTOR TO DISK * P64 DEC 64 SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER * PROGRAMS. BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG ¼¤Nÿÿþú LDA P5 CPA \PTYP PROG = BG SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 LEAVE SET CPA P13 OR IF TABLE AREA II RSS CPA P15 OR TABLE AREA I JMP TRID3 THEN LEAVE SET * AND M7 NOT EVERYONE CAN REFERENCE A TYPE 6 (14,30) CPA P6 BUT USUALLY THE LIBRARY RTNS WILL BE 7'S JMP TRID3 THIS HAPPENS ONLY IN MRL AND MRP'S * CPA P7 IF A UTILITY SUBROUTINE JMP C2 THEN CLEAR IT SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT/EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO h+þúAN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 CPÍþúL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP M0760 OCT 076000 SKP * * GENERATE INT ENTRY,KEYWD,ID SEG * * GENID GENERATES THE CURRENT ID SEGMENT AND KEYWORD * FOR THE PROGRAM LOADED. IN ADDITION, IT GENERATES THE * LINKAGE REQUIRED IN THE INTERRUPT TABLE FOR THOSE PROGRAMS * WHICH ARE TO BE SCHEDULED UPON RECEIPT OF AN INTERRUPT. * * CALLING SEQUENCE: * A = 0 (GENERATE MEM.RES ID SEGMENT) * -1 (GENERATE LONG ID SEGMENT) * -2 (GENERATE BLANK LONG ID SEGMENT) * B = IGNORED * JSB GENID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * * GENID NOP STA PLFLG SAVE ID SEGMENT LENGTH FLAG CPA N2 IF BLANK GEN JMP BLID GO SEND THE KEY WORD * LDB SYSAD GET START ADDR FOR ID-SEG STB SCH3 SAVE START ADDR IN A TEMP STB SYSAD AND UPDATE BASE STB CURAI UPDATE OUTID PTR TOO. * * GENERATE INT ENTRY FOR USER SYS * LDA AILST GET THE ADDRESS OF INT IMAGE STA \CURL SET CURRENT INT ADDRESS LDA M72 GET NO. OF INT ENTRIES CMA,INA STA TCNT SAVE TOTAL INT COUNT GETIT LDA \CURL,I GET CURRENT WORD IN INT CMA,INA TEST NEGATIVE ENTRIES FOR ILIST CPA IMAIN EQUAL TO MAIN IDENT INDEX? RSS YES - CONTINUE JMP NOTPN IGNORE REF IF NOT CURRENT MAIN * LDA SYSAD GET ID SEG ADDRESS CMA,INA GET 2'S COMPLEMENT FOR INT ENTRY LDB AILST COMPUTE THE INT CORE CMB,INB ADDRESS ADB \CURL = ILST OFFSET PLUS ADB AINT ACTUAL CORE ADDRESS JSB \ABDO SENT THE ENTRY TO THE DISC NOTPN ISZ \CURL STEP TO THE NEXT ENTRY ISZ TCNT SKIP - INT EXHAUSTED JMP GETIT ANALYZE NEXT INT ENTRY * * GENERATE KEYWORD STKEY LDA IMAIN ¾šþú GET MAIN IDENT INDEX STA \TIDN SET ADDRESS FOR IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR NO IDENT FOUND SPC 1 LDB SYSAD CCA ADA \TIDN GET IDENT POINTER CPA SCH1 SCHEDULE PGM? STB SCH4 YES - SAVE ITS ID ADDRESS BLID LDA SYSAD GET THE ID-ADDRESS TO A LDB CURAK AND THE CURRENT CORE ADDRESS JSB \ABDO TO B AND OUTPUT TO THE DISC STB CURAK SET THE NEW ADDRESS LDB SYSAD GET THE ADDRESS LDA PLFLG GET THE ID SEGMENT LENGTH FLAG ADB P29 ADJUST FOR NEXT ID SEGMENT ADDR SZA SKIP - SHORT ID SEGMENT ADB P4 ADJUST FOR LONG ID SEGMENT STB SYSAD SET NEXT ID SEGMENT ADDRESS * * GENERATE ID SEGMENT * LDA PLFLG IF FLAG = -2 FOR CPA N2 BLANK OUTPUT, JMP GENID,I EXIT * LDA KEYAD SAVE KEYWORD CMA OFFSET FOR ADA CURAK LATER ACCESS TO ID-SEG. STA \ID8,I (TEMP SAVE) * LDB N6 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA CUPRI GET THE CURRENT PRIORITY JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PRENT GET PRIMARY ENTRY POINT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N2 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA SCH3 GET ADDRESS OF CURRENT ID SEG INA STEP TO PRAM LIST JSB OUTID OUTPUT B REG TO ID SEGMENT CLA SEND E/O REGS TO JSB OUTID THE ID SEGMENT LDA \ID1,I GET NAME 1,2 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID2,I GET NAME 3,4 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE STA B SAVE TYPE IN B LDA \ID3,I GET NAME 5 AND M7400 ISOLATE NAME 5 IOR B ADD TYPE TO NAME 5 JSB |þúOUTID OUTPUT WORD TO ID SEGMENT BUFFER CLA PRESET FOR DORMANT CCB ADB \TIDN IF THIS PGM TO BE CPB SCH1 SCHEDULED CLA,INA SET SCHEDULED FLAG JSB OUTID SET WORD IN ID CLA SET TIME LINK JSB OUTID TO ZERO AND OUTPUT LDA \MULR GET RESOLUTION CODE, EXEC MULT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \TIME GET LOW PART OF TIME JSB OUTID OUTPUT LS TO ID SEG LDA \TIM1 GET HIGH HALF JSB OUTID OUT MS HALF TO ID SEG LDB N2 ZEROS TO JSB ZOUT ID SEG 20 AND 21 * LDA \PREL GET CURRENT PROG RELOC ADDRESS ADA BSSDP ADD INITIAL PROG DISPLACEMENT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TPREL GET CURRENT RELOCATION ADDRESS CMA,INA CHECK ADA LWASM MEMORY OVERFLOW SSA,INA,SZA OK IF POS OR -1 JMP ER18 YES GO SEND THE BITCH * LDA TPREL NO SEND THE UPPER LIMIT GENI9 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PBREL GET LOW BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TBREL GET HIGH BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER ISZ PLFLG SKIP - CONTINUE WITH LONG ID SEG JMP SMWDS MEM.RES ID SEGMENT LDA DSKMN GET INITIAL MAIN DISK ADDRESS JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N3 ZEROES TO JSB ZOUT WORDS 27-29 * SMWDS LDB N3 ZERO THE SESSION MONITOR WORDS JSB ZOUT ID SEG 30, 31, & 32 JMP GENID,I RETURN - ID SEGMENT OUT * ER18 LDA ERR18 SEND ERROR 18 CMA,INA COMPLEMENT SO NO TR,ERRLU ON ERROR JSB \GNER MEMORY OVERFLOW LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP GENI9 GO FINISH THE ID-SEGMENT * ERR18 ASC 1,18 M1774 OCT 177400 N3 DEC -3 M1 DEC -1 ÿSþúP29 DEC 29 SPC 5 * * OUTPUT ZERO TO IDBUF * * ZOUT PUTS OUT ZEROES TO THE ID SEGMENT BUFFER. * * CALLING SEQUENCE: * A = IGNORED * B = NO. OF ZEROES TO GO OUT (NEG.). * JSB ZOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * ZOUT NOP STB TCNT SAVE NO. OF ZEROES TO GO OUT CLA JSB OUTID OUTPUT ZERO TO IDBUF ISZ TCNT SKIP - ALL ZEROES OUT JMP *-3 CONTINUE ZERO OUTPUT TO IBUF JMP ZOUT,I RETURN SKP * * GENERATE A SHORT BG/PR SEGMENT ID SEGMENT AND ITS ASSOCIATED * KEYWORD ENTRY. NOTE THAT THE CONTENTS OF THE KEYWORD IS 11 * LOCATIONS LESS THAN THE ACTUAL START OF THE SHORT ID * SEGMENT. THIS IS TO ALLOW FOR EASY ACCESS TO THE ID * SEGMENT'S PROGRAM NAME BY ALWAYS ADDING AN OFFSET OF * 12 TO THE CONTENTS OF THE KEYWORD LOCATION. * * CALLING SEQUENCE: * A = -1 (GENERATE SHORT ID SEGMENT) * = -2 (GENERATE BLANK SHORT ID SEGMENT) * B = IGNORED * * RETURN: CONTENTS OF A & B DESTROYED * GNSID NOP GENERATE SHORT SEGMENT ID-SEGMENTS STA PLFLG SAVE THE FLAG LDB \SKYA GET THE KEYWORD LDA \SSID ADDRESS AND ITS CONTENTS JSB \ABDO SEND THE KEY WORD TO THE DISC STB \SKYA SET THE NEW KEYWORD ADDRESS LDB \SSID GET THE ID- ADDRESS ADB P9 ADDJUST FOR NEXT TIME STB \SSID AND SAVE ADB P2 ADDJUST FOR ADDRESS OF CURRENT ID LDA PLFLG THIS A CPA N2 BLANK SHORTY? JMP BLSID YES GO DO BLANK THING * LDA PRENT NO GET THE PRIMARY ENTRY POINT JSB \ABDO SEND IT TO THE DISC LDA IMAIN GET THE IDENT INDEX STA \TIDN TO CURRENT JSB \IDX B-REG MUST NOT BE DESTROYED JSB \ABOR BETTER BE ONE LDA \ID1,I GET NAME 1,2 JSB \ABDO SEND TO THE DISC LDA \ID2,I GET NAME …éþú3,4 JSB \ABDO SEND IT LDA \ID3,I GET NAME 5 AND M7400 MASK IOR P21 SET TYPE AND SHORT FLAG JSB \ABDO SEND IT TO THE DISC LDA BSPAD GET THE MEMORY ADDRESS ADA BSSDP ADDJUST FOR LEADING BSS JSB \ABDO SEND MAIN 1 LDA TPREL GET AND CMA,INA CHECK FOR MAIN MEMORY ADA LWASM OVER FLOW SSA,INA,SZA IF OVER FLOW JMP BLSI3 GO REPORT IT * LDA TPREL OK SO PUT IT OUT BLSI0 JSB \ABDO SEND MAIN 2 LDA BSBAD GET AND JSB \ABDO SEND BP 1 LDA TBREL GET AND JSB \ABDO SEND BP 2 LDA DSKMN GET DISC ADDRESS BLSI2 JSB \ABDO JMP GNSID,I RETURN * BLSID ADB P3 FOR BLANK LDA P16 SET THE SHORT BIT ONLY JMP BLSI2 GO SEND IT. * BLSI3 LDA ERR18 SEND ERROR MESSAGE STB SIDS2 SAVE POINTER TO ID SEG CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER LDB SIDS2 LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP BLSI0 GO FINISH THE ID-SEGMENT * SIDS2 BSS 1 SPC 5 * * OUTPUT ID SEGMENT WORD TO IBUF * * OUTID PACKS THE WORDS FOR THE ID SEGMENTS IN THE ID SEGMENT * BUFFER AND WRITES THE BUFFER ON THE DISK WHEN IT CONTAINS * 64 WORDS. * * CALLING SEQUENCE: * A = CURRENT ID SEGMENT WORD * B = IGNORED * JSB OUTID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTID NOP LDB CURAI GET THE CURRENT ID-SEGMENT ADDRESS JSB \ABDO SEND THE WORD TO THE DISC STB CURAI SET THE ADDRESS FOR NEXT TIME JMP OUTID,I RETURN SKP * * OUTPUT REST (IF ANY) OF ABS. REC * * REMDO PUTS OUT THE CURRENT SECTOR IF IT CONTAINS ANY WORDS OF * ABSOLUTE CODE. THIS IS NORMALLY DONE ONLY AT THE END OF THE GEN * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * [8þú JSB REMDO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * REMDO NOP LDA \OLDA GET THE CURRENT DISC ADDRESS LDB \ADBF AND THE BUFFER ADDRESS SSA IF A GOOD ADDRESS JSB \DSKO OUTPUT THE CODE JSB BPDSA UPDATE THE DISC ADDRESS JMP REMDO,I RETURN SPC 5 * BPDSA ADVANCES THE DISK ADDRESS TO THE NEXT EVEN * DISC ADDRESS ASSUMING THE CURRENT DISC ADDRESS * IS NOT AVAILABLE. THIS IS NORMALLY DONE * AFTER EACH MAIN IS LOADED AND BEFORE THE BASE * PAGE IS OUTPUT. * * CALLING SEQUENCE: * * JSB BPDSA DOES NOT USE A/B RETURNS A=CURRENT DISC ADDRESS * BPDSA NOP LDA \ADSK BUMP JSB \DSKA THE DISC ADDRESS STA \ADSK AND RESET IT JSB DSKEV MAKE SURE IT IS EVEN JMP BPDSA,I RETURN SKP * * CHBND IS A ROUTINE TO ASK THE OPERATOR IF HE WANTS TO CHANGE * A BOUNDRY, GET HIS ANSWER AND CHECK IT FOR LEGALITY. * THE MESSAGES SENT ARE: * * XXXXXXXXXX YYYYY AND * CHANGE XXXXXXXXXX? WHERE XXXXXXXXXX IS A 10 CHARACTER * MESSAGE SUPPLIED AS PART OF THE CALL * AND YYYYY IS THE CURRENT BOUND IN OCTAL * OR DECIMAL. * LEGAL RESPONSES ARE: * * 0 NO CHANGE. * N WHERE N>YYYYY AND LESS THAN OR EQUAL TO * THE SUPPLIED LIMIT. * * CALLING SEQUENCE: * B = NON-ZERO IMPLIES DON'T CHECK LOWER BOUND * A = CURRENT YYYYY A > 0 MEANS OCTAL * JSB CHBND A < 0 MEANS DECIMAL(ONE'S COMPLEMENT) * DEF ADDRESS OF XXXXXXXXXX (5 WORD MESSAGE) * DEF UPPER LIMIT OF RESPONSE * * RETURN (ALWAYS P+3) A = NEW BOUND. * CHBND NOP STB BPDSA SAVE *TEMP* STA CBFLG SAVE DECIMAL FLAG SSA SKIP IF OCTAL REQUEST,ELSE INA MAKE DEC, REQUEST 2'S COMPLMNT STA TMPX SAVE DEFAULT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND `þú STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA \GNER TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ \GNER THE JMP CHNX MESSAGE * ISZ CHBND INDEX TO THE UPPER LIMIT STB TMPL SAVE THE ADDRESS FOR RETRY IN CASE CHOVR LDB TMPL OF ERROR LDA TMPX CONVERT THE NUMBER JSB \CONV TO THE BUFFER JSB \SPAC SEND A \SPAC LDB DMES GET THE ADDRESS LDA P16 AND SEND MESSAGE JSB \MESS "XXXXXXXXXX YYYYY" TO THE TTY LDA "?" PUT A "?" AFTER THE XXXXXXXXXX STA ME11S SET IT LDA P19 SEND MESSAGE AND GET LDB ADMES RESPONSE FOR JSB \READ " CHANGE XXXXXXXXXX?" LDA P5 CONVERT RESPONSE LDB CBFLG LOAD FLAG SSB DECIMAL REQUEST?? CMA,INA YES, ASK \GET# FOR DECIMAL JSB \GET# GET BINARY EQUIVALENT JMP CBERR ERROR - REPEAT * JSB \GETC END OF BUFFER? SZA,RSS JMP CHOK YES OK- * CBERR JSB \INER SEND ERR 01 JMP CHOVR AND REPEAT * CHOK LDA \OCTN GET VALUE LDB BPDSA GET FLAG IN B-REG SZB JMP BGCCH SPECIAL TREATMENT FOR BG COMMON SZA,RSS IF ZERO USE LDA TMPX SUPPLIED VALUE SSA GET ABS VALUE OF CMA,INA CURRENT TOO LDB TMPX GET -ABS VALUE SSB,RSS OF UPPER LIMIT. CMB,INB ADB A IF LIMIT LESS THAN SSB CURRENT THEN JMP CBERR ERROR * CHHI LDB CHBND,I GET UPPER BOUND LDB B,I TO B CMB IF GREATER THAN ADB A MAX SSB,RSS THEN JMP CBERR ERROR * ISZ CHBND ELSE EXIT JMP CHBND,I RETURN VALUE IN A * BGCCH ALF,AL‰þúF CONVERT PAGES RAL,RAL TO WORDS JMP CHHI AND CHECK HI BOUND ONLY SPC 2 CBFLG BSS 1 DECIMAL/OCTAL FLAG TMPX NOP TMPL NOP DMES DEF .XXX ADMES DEF *+1 ASC 4, CHANGE .XXX BSS 5 ME11S NOP BSS 3 "?" ASC 1,? P19 DEC 19 SKP * * THIS ROUTINE IS CALLED AFTER THE SYSTEM AND PRD'S ARE * LOADED, BUT BEFORE THE MEMORY RESIDENT LIBRARY. SPC 1 * CLEAR LOAD FLAGS FOR TYPE 6 PGMS * CLRT6 NOP * SET LIBRARY RESIDENT FLAGS JSB \INID INITIALIZE IDX SETLX JSB \IDX SET IDENT ADDRESSES JMP CLRT6,I END OF IDENTS LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE CPA P14 IF FOURCED CORE RES. RSS PROCESS CPA P6 TYPE = LIBRARY? RSS YES - CONTINUE JMP SETLX PROCESS NEXT IDENT * LDA \ID3,I TYPE = 6 - GET LOAD FLAG RAR,CLE,ELA LOAD BIT TO E - AND CLEARED STA \ID3,I RESET CLEARED FLAG SEZ,RSS WAS IT LOADED? JMP SETLX NO - CONTINUE JSB CLEAR CLEAR THE VALUES OF ITS ENTRY POINTS JMP SETLX AND CONTINUE ID SCAN SPC 3 * * CLEAR THE LST ENTRY POINT VALUES BELONGING TO THE CURRENT IDENT * CLEAR NOP JSB \ILST INITIALIZE \LSTX CLR1 JSB \LSTX SET CURRENT LST ADDRESSES JMP CLEAR,I END - CONTINUE ID SCAN CCA ADA \TIDN GET IDENT ADDRESS CPA \LST4,I ENT BELONGS TO CURRENT PROG? CLA,RSS YES - CONTINUE JMP CLR1 NO - TRY NEXT ENT STA \LST5,I SET LINK TO ZERO. JMP CLR1 CONTINUE SEARCH SKP * * DEMOTES ALL TYPE 6 AND 14 PROGRAMS ALREADY IN THE MEMORY RESIDENT * LIBRARY TO TYPE 7 UTILITY ROUTINES, CLEARING THEIR LOAD FLAGS AND * ENTRY POINT VALUES. * * DEMTL NOP DEMOTE TO TYPE 7 JSB \INID INITIALIZE IDX SL`B@0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * Ùbþú ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 2 MRTAD DEF TPREL RBTAD DEF RBTA AMLST DEF MLIST AMEM5 DEF MLIST+5 AMEM8 DEF MLIST+8 SKP * * PROGRAM CONSTANT FACTORS N1 DEC -1 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 NDAY OCT 177574,025000 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P16 DEC 16 P34 DEC 34 P60 DEC 60 P99 DEC 99 P100 DEC 100 P6K DEC 6000 M7 EQU P7 M17 EQU P15 M20 EQU P16 M1760 OCT 176000 M1777 OCT 1777 M7400 OCT 177400 M7777 OCT 77777 * BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN SKP LODR NOP * * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I HERE WE CHASE DOWN OUR OWN RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN FOR CALL * TO \NLOD OR \LOAD. * SPC 1 N DEC -4 LSTAA DEF *+1 ATBUF DEF \TBUF+0 LBUF5 DEF \LBUF+5 ALBUF DEF \LBUF+0 DNDCB DEF \NDCB+0 SKP SKP * * INITIATE MAIN PROGRAM LOADING * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOAD (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \NLOD NOP LDA \PTYP GET RELOCATION TYPE ˆ‡þúCPA P5 IF A SEGMENT RSS JMP NONES JSB \LOAD THEN JUST CALL \LOAD AND RETURN JMP \NLOD,I * * INDICATE VALIDITY OF SSGA REFERENCES * NONES LDA \ID6,I TYPE AND M20 LOOK AT SSGA BIT STA SSGAF SET SSGA FLAG (0=NO SSGA USE) CCB STB HDFLG SET HEADING FLAG LDB \PREL PICK UP BASE ADDRESS LDA LIBFG IF LIB LOAD SZA JMP NOADD THEN IGNORE LDA \ID6,I GET TYPE AGAIN AND M7 JUST PRIMARY BITS CPA P1 IF MEMORY RESIDENT ADB P2 BUMP START ADDR 2 FOR INDEX REG SAVE CPA P2 AND IF PROG IS DISK RESIDENT ADB P34 BUMP START ADDR FOR VIS +INDEX REG CPA P3 (EITHER RT OR BG) ADB P34 BUMP FOR VIS +INDEX REG SAVE CPA P4 ADB P34 BUMP FOR VIS + INDEX REG SAVE * NOADD STB TPREL LDA PBREL GET BP RELOCATION ADDRESS STA TBREL SET CURRENT BP RELOC ADDRESS JSB \LOAD LOAD PROGRAM LDA LIBFG IF NOT LIB LOAD SZA,RSS THEN JSB \SPAC NEW LINE JMP \NLOD,I RETURN SKP * * LOAD, LINK MAIN PROG & SUBS. * * \LOAD IS THE MAIN LOADING SUBROUTINE FOR GENERATING THE ABSOLUTE * CODE AND LINKING ALL CALLED SUBROUTINES. IT IS USED BY EACH * PROGRAM TYPE FOR LOADING. IT READS THE RELOCATABLE RECORDS FROM * THE DESIGNATED FILE, AND WRITES THE ABSOLUTE CODE * INTO THE CORE-IMAGE OUTPUT FILE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOADS (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \LOAD NOP (WAS "LOADS") JSB SFIX SET UP A FIX UP ENTRY CCA STA PLFLG SET FLAG = NO DBL RECS IN * LOADN LDA TPREL CLEAR THE CP LINK IMAGE JSB CCPLK AREA LDA TPREL SAVE FOR RESET STA LWH4 FOR NEXT PASS LDA TBREL STA þˆþúLWH3 CLA LOADX STA L01 * LDA LWH3 BP LINK LDB TBREL ADDRESSES JSB CLRLT LDA LWH3 STA TBREL RESTORE TBREL JSB CLIST BLANK MEMORY MAP BUFFER CLA CLEAR THE LIBRARY TRAP STA ADTRP WORDS STA LIBTP LDA AMLST AMLST = ADDR OF MEM MAP BUFFER STA AMAD SET CURRENT MEMORY MAP ADDRESS LDA HDFLG GET HEADING FORMAT FLAG STA TEMP2 SSA,RSS SKIP IF NEGATIVE (MAIN) ISZ AMAD INCR CURRENT MEM MAP ADDR LDA \ID1,I GET NAME 1,2 STA AMAD,I SET NAME 1,2 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID2,I GET NAME 3 4 STA AMAD,I SET NAME 3,4 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK (OCT 40) STA AMAD,I SET NAME 5 IN MEMORY MAP LDA \ID6,I PICK UP TYPE AND M177 AND ISOLATE CPA P13 IF TABLE AREA II TYPE RSS CPA P15 OR TABLE AREA I TYPE RSS THEN DON'T MASK BITS AND M7 MASK TO ACTUAL TYPE. STA LDTYP * * READ NAM RECORD. * LDA ALBUF READ NAM RECORD FROM FILE. STA \CURL CCB JSB \RNAM JSB \ABOR ERROR ON READ. SZA,RSS JSB \ABOR END OF FILE. CMA,INA SET COUNT WORD. STA LCNT * LDA \ID5,I CHECK IF NAM RECORD HAS RAL A MODIFIED VERSION. SSA,RSS JMP LOADC NO. * JSB RWNDF YES. SEARCH NEW NAM FILE DEF *+3 FOR REPLACEMENT RECORD. DEF \NDCB+0 DEF \FMRR+0 * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \ABOR * CREAD JSB READF DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF \LBUF DEF ñîþúP60 DEF LEN * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \ABOR * LDA LEN BETTER BE THERE! CPA N1 JSB \ABOR * LDB ALBUF COMPARE NAM IN \LBUF ADB P3 LDA B,I AGAINST CPA \ID1,I NAM IN IDENT. INB,RSS JMP CREAD NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP CREAD NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP CREAD NO MATCH. * LOADC JSB ZLOAD LOADING? JMP LH7 NO * LDA L01 SZA 1ST PASS? JMP LH7 YES * ISZ TEMP2 NO - TEST TEMPORARY HDFLG JMP SUBHD * JMP LH8 * LPAR OCT 50 LEFT PAREN. * LH7 ISZ HDFLG TEST REAL THING JMP SUBHD SKIP PRIORITY OUTPUT FOR SUB * LH8 LDA \ID6,I SET CURRENT LOAD TYPE AND M17 LOOK AT PRIMARY & REVERSE COMMON BITS CPA P5 DON'T CHANGE COMMON JMP COMOK FOR SEGMENTS (USE MAIN'S) LDB \ID4,I THIS IS A MAIN RBL,CLE,ERB GET RID OF M,S BIT STB COMSZ SET HIS COM SIZE AS LIMIT. LDB BGCAD GET BACKGROUND COMMON BOUND CPA P1 IF FORGROUND RSS CPA P2 RSS CPA P11 OR PRIVILEGED USING FORGROUND COMMON RSS CPA P12 OR BACKGROUND USING FOREGROUND COMMON LDB RTCAD USE FORGROUND COMMON ADDRESS STB COMAD SET THE COMMON BASE ADDRESS COMOK LDA \ADSK GET CURRENT DISK ADDRESS LDB L01 SZB,RSS IF 1ST PASS, STA DSKMN SAVE INITIAL MAIN DISK ADDRESS LDA \PTYP IF FOURCED SUBROUTINE AND M17 OR SSGA ROUTINE CPA P14 LOAD JMP SUBHD SEND SUB HEAD MAP * LDA LPAR GET LEFT PAREN (OCT 50) IOR AMAD,I CHANGE NAME 5, BLANK TO NAME 5,( STA AMAD,I SET NAME 5, LEFT PAREN IN MAP ”ùþúLDA \LBUF+10 GET PRIORITY FROM THE NAM RECORD SZA,RSS IF ZERO SET LDA P99 TO 99 SZB,RSS UNLESS SYSTEM WHICH CLA SET TO ZERO STA CUPRI SET FOR THE ID-SEG GENERATION CMA,INA SET TO NEGATIVE FOR DECIMAL CONV LDB ATBUF GET MESSAGE ADDRESS JSB \CONV CONVERT TO DECIMAL/OCTAL LDA \TBUF+1 GET HIGH TWO CHARACTERS STA MLIST+3 SET IN MAP LDA \TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS STA MLIST+4 SET PRIORITY IN MEMORY MAP LDA \LBUF+12 SET UP THE TIME PARAMETERS ASL 4 FIRST THE RESOLUTION LDB \LBUF+11 AND MULTIPLE BLS ASR 4 COMBINE STA \MULR SET FOR ID SEG GENERATOR LDA \LBUF+15 GET THE SECONDS MPY P100 CONVERT TO 10'S OF MS. ADA \LBUF+16 ADD 10'S OF MS. STA TEMP1 SAVE TEMP * LDA \LBUF+13 GET THE HOURS MPY P60 CONVERT TO MIN. ADA \LBUF+14 ADD MIN. MPY P6K CONVERT TO 10'MS CLE PREPARE FOR ADD ADA TEMP1 ADD 10'S MS. SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER PART ADA NDAY+1 SUBTRACT ONE DAY OF 10'S MS. SEZ,CLE IF OVER FLOW INB STEP HIGH ORDER DIGIT ADB NDAY DST \TIME SAVE DOUBLE WORD \TIME FOR ID-SEG. * SUBHD LDA TPREL GET CURRENT PROG RELOC ADDR LDB AMEM5 SET B = ADDR OF MEMORY MAP + 5 JSB \CONV CONVERT TO DECIMAL/OCTAL LDA MLIST PUT A ")" IN THE CPA BLNKS HIGH PART OF THE JMP SUBH2 ADDRESS IF NOT A SUBHEAD * LDA MLIST+5 I.E. IF MAIN ADA B4400 CONVERT BLANK TO ) STA MLIST+5 RESTORE IT. SUBH2 LDA \LBUF+1 GET RIC ALF,RAR ROTATE TO LOW A AND M7 ISOLATE RIC CPA P1 NAM RECORD? RSS YES - CONTINUE JSB \ABOR INVALID DISK RECORD LDA \LqsþúBUF+6 GET PROGRAM LENGTH STA PLGTH SAVE PROGRAM LENGTH RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT ADA TPREL COMPUTE THE LAST WORD ADDRESS ADA N1 LDB AMEM8 AND JSB \CONV CONVERT TO THE MAP * * SET RELOCATION BASE FOR ORB STUFF SPC 1 JSB ZLOAD IGNORE IF A PSEUDO-LOAD OF AN MRP CLB,RSS LDB \LBUF+7 GET SIZE OF BASE PAGE CODE LDA BPINC AND FIGURE OUT IF WE'RE GOING SSA UP OR DOWN IN BASE JMP SUBH3 PAGE. SPC 1 LDA TBREL GOING UP, SET STA TPBRE ORB BASE AT TBREL ADB TBREL INCREMENT LINK BASE LDA BPLMT SUBTRACT LIMIT CMA,INA FROM ADA B NEXT ADDR TO CHECK FOR JMP SUBH4 BASE PAGE OVERFLOW. SPC 1 SUBH3 CMB,INB GOING DOWN...SUBTRACT ORB LENGTH ADB TBREL FROM LINK BASE INB ADD ONE STB TPBRE TO GET ORB BASE. ADB N1 GET NEXT AVAILABLE LINK ADDR. LDA B CMA,INA SUBTRACT NEW BASE FROM LIMIT ADA BPLMT TO CHECK FOR OVERFLOW. SPC 1 SUBH4 SSA,RSS IF LIMIT IS EXCEEDED, WE JMP E16RR HAVE AN ERROR. * CONLD STB TBREL BASE PAGE LDA TPBRE JSB SETBP SET PROGRAM BASE PAGE IMAGE TO -1 LDA \LBUF GET RECORD SIZE ALF,ALF LOW ORDER A STA \LBUF SAVE IN RIGHT HALF JSB ZLOAD LOADING? JMP NOLD NO, SKIP * LDA L01 FIRST PASS? SZA,RSS NO, DO MAP JMP NOMP YES, NO MAP * ISZ LFLAG BUMP THE LOADED FLAG NOP IN CASE OF LEAP LDA \ID5,I CHECK FOR "MAP MODULES". RAR SLA,RSS JMP NOMP NO. BIT 1 NOT SET. * LDB LBUF5 THE SIXTH WORD IN \LBUF LDA N11 NUMBER OF WORDS STA TCNT TO MOVE TO \LBUF LDA AMLST ADDRESS OF NAME BUFFER]…þú STA WDCNT SAVE FOR POINTER LH1 LDA WDCNT,I GET NAME WORD, AND ADDRESS STA B,I STORE IN \LBUF INB BUMP B ISZ WDCNT BUMP NAME ADDRESS ISZ TCNT ALL DONE? JMP LH1 NO, DO MORE * LDA BLNKS GET TWO BLANKS STA B,I PUT THEM IN \LBUF BEFORE THE COMMENTS LDA \LBUF GET RECORD SIZE ADA N5 REDUCE TO MAP LENGTH ALS TIMES 2 FOR CHARACTER COUNT LDB LBUF5 ADDRESS OF MAP AND COMMENTS JSB \MESS PRINT ALL * * THE FOLLOWING ROUTINES LINK A PROGRAM THROUGH CURRENT PAGE * LINKS WHEN POSSIBLE. THIS IS POSSIBLE WHEN THE LENGTH * OF THE PROGRAM IS KNOWN AND WHEN THE PROGRAM IS NOT AN * ASSEMBLED TYPE 2, 3, 4, OR 5 PROGRAM. * NOMP LDA \ID4,I COMPARE AND M7777 CMA,INA THIS MODULE'S COMMON ADA COMSZ DECLARATION TO MAIN'S SSA,RSS ERROR IF GREATER. JMP NOM2 LDA ERR54 CMA,INA JSB \GNER NOM2 LDA L01 1ST OF 2 PASSES? SSA JMP NOLD NO - 1 PASS ONLY * SZA,RSS IF PASS ONE JMP LH12 GO CHECK FOR OPTION SPC 1 LDA CPL1 PASS TWO SO SET UP THE NOW STA \CPL2 KILL THE UPPER AREA JSB \LNKS SET FOR DEFINING CODE JMP LH10 GO SET THE BOUNDRYS SPC 1 LH12 JSB GETCP SET UP A CURRENT PAGE LINK AREA STA CPL1 USE FOR BOTH CLA AREAS STA CPL1H CLEAR THE COUNT WORDS STA CPL2H LDB \ID5,I DOES OPERATOR WANT CURRENT PAGE SSB LINKS IF POSSIBLE? IF YES - JMP LH222 GO SET UP * LH2 CCA JMP LOADX RESTART SPC 1 LH222 LDA PLGTH SSA,RSS NO CURRENT PAGE LINKS LDA LDTYP IF ASSEMBLED TYPE 2, 3,4, OR 5 CPA P2 JMP LH2 CPA P3 JMP LH2 CPA P4 JMP LH2 CPA P5 JMP w‡NLHLH2 * LDA TPREL GET ADDR STA B OF LAST WD IOR M1777 OF PAGE SPC 1 CMB,INB COMPUTE # WDS INB REMAINING ADB A ON PAGE STB TEMP2 SPC 1 LDA PLGTH COMPUTE # WDS RAL,CLE,ERA OF PROGRAM CMB,INB THAT FALL ADB A BEYOND THIS STB TEMP1 PAGE SPC 1 SSB PROGRAM FIT ON RSS THIS PAGE? SZB,RSS NO - SKIP JMP NOLOW YES GO SET UP THE HIGH AREA SPC 1 LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # WDS OF PROG CMB,INB ON CURRENT PAGE-OR- ADB A # WDS OF PROG ON SSB,RSS NEXT PAGE SPC 1 LDA TEMP1 DIVIDE THIS CLB MINIMUM BY DIV P4 FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP NOLOW OF LOW CURRENT PG LINK BUFF RSS SPC 1 LH10 LDA CPL1H GET PASS ONE DEFINED LENGTH LDB LWH4 SET NEW 1Nÿÿþú STB \LNK1,I LOWER LINK ADDRESS ADB A AND UPPER LIMIT STB TPREL OF LINK BUFFER STB \LNK2,I (ALSO PROGRAM LOAD ADDRESS) JSB CLRCP CLEAR THE CURRENT PAGE IMAGE SPC 1 JSB GETCP GET ANOTHER CP LINK AREA LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA STRIP POSSIBLE SIGN BIT ADA TPREL ADD THE BASE ADDRESS STA \LNK1,I SET ORGION OF HIGH LINK AREA IOR M1777 TOP IS INA FIRST WORD OF STA \LNK2,I NEXT PAGE JSB CLRCP GO CLEAR THE ALLOCATED AREA CLA CLEAR THE UPPER COUNT WORD STA CPL2H * NOLD LDB TPREL GET PROGRAM RELOCATION BASE STB RELAD SET CURRENT RELOCATION ADDRESS * * CLASSIFY ENT, EXT, DBL, END RECS * CCA FORCE FILE READ. STA LCNT CLSR1 JSB DBSET GET FIRST WORD IN RECORD. CLSRC LDA \CURL,I SAVE THE RECORD LENGTH FOR STA \TBUF DBL SKIP ROUTINE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET SECOND WORD IN RECORD LDB A SAVE WORD IN B ALF,RAR ROTATE RIC TO LOW A AND M7 ISOLATE RIC CPA P2 ENT RECORD? JMP DENTR PROCESS ENT RECORD CPA P3 DBL RECORD? JMP DDBLR PROCESS DBL RECORD CPA P4 EXT RECORD? JMP DEXTR PROCESS EXT RECORD CPA P6 EMA RECORD? JMP EMAR PROCESS EMA DECLARATION CPA P5 END RECORD? RSS YES - PROCESS END RECORD JSB \ABOR INVALID DISK RECORD * JSB ZLOAD LOADING? JMP CLSTX NO * NOLOW LDA L01 IF FIRST OF SSA,INA IF NOT CURRENT PAGE LINKING JMP PEND JUST GO END IT * CPA P1 IF PASS ONE JMP CPRST GO DO PASS TWO * * PASS TWO OUTPUT THE CP LINK AREAS AND UPDATE. * LDA CPL1 OUTPUT THE JSB ê!þúOUTCP LOW AREA LDA \CPL2 SET UP FOR THE JSB \LNKS HIGH AREA LDA CPL2H GET THE NUMBER ALLOCATED ADA \LNK1,I AND COMPUTE THE UPPER LIMIT STA \LNK2,I SET THE ACTUAL VALUE LDA \CPL2 NOW JSB OUTCP OUTPUT THE LINKS * PEND JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA TPREL GET CURRENT PROG RELOCATION BASE ADA \CURL,I ADD RELOCATION ADDRESS LDB HDFLG GET HEADING FLAG SZB,RSS SKIP UNLESS MAIN STA PRENT SAVE PRIMARY ENTRY POINT FOR ID CLSTX JSB \ILST INITIATE \LSTX CLST JSB \LSTX SET LST ADDRESSES JMP LSTCR END OF LST * LDA \LST3,I GET WORD 3 OF \LST (ORDINAL) AND M7400 ISOLATE UPPER CHAR - CLEAR ORD STA \LST3,I SET NAME 5 IN \LST JMP CLST CONTINUE CLEARING ORDINALS * LSTCR JSB ZLOAD WAS CURRENT PGM LOADED? JMP PLSCM NO SKIP ADDRESS UP DATE * LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA SET E = SIGN ADA TPREL ADD PROGRAM RELOCATION BASE ADA CPL2H REFLECT ANY CURRENT PAGE LINKS STA TPREL ALLOCATED LDB \ID5,I CHECK FOR "MAP LINKS" LDA TBREL CURRENT BP ADDRESS. RBR,RBR IF BIT 2 SLB IS SET JSB BPLNR REPORT THE BP LINKAGE * * SCAN FOR MODULES LEFT TO LOAD * PLSCM JSB \INID SCAN THE PLSCN JSB \IDX IDENTS FOR MODULES JMP CLFLG LEFT TO LOAD NONE SO GO EXIT * LDA \ID3,I GET THE FLAG WORD SLA,INA IF ALREADY LOADED JMP PLSCN TRY THE NEXT ONE * RAR,SLA,RAL IF MUST LOAD FLAG SET JMP ENTID GO LOAD IT * JMP PLSCN ELSE GO TRY NEXT IDENT. * * ENTID STA \ID3,I SET THE LOADED FLAG AND GO LOAD. JMP LOADN (\RNAM WILL CLOSE THE OLD FILE) * CLFLG CCA HANDLE ZERO LENGTH PROGRAMS. ADA TPREL ¸Gþú FILL FINAL BSS. STA TEMP1 CMA,INA LDB \MXAB ADA B,I SSA,RSS JMP BPCNT CLA LDB TEMP1 JSB \ABDO * * DON'T CLEAR LOAD FLAGS IF POSSIBLY A SEGMENTED PROGRAM * BPCNT LDA \PTYP GET CURRENT PROGRAM TYPE CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 OR BG DISK RESIDENT RSS CPA P2 OR RT DISK RESIDENT JMP \LOAD,I YES - DO NOT CLEAR LOADED FLAGS * JSB CLID3 CLEAR PROG-LOADED FLAGS JMP \LOAD,I RETURN - ALL FLAGS CLEARED * E16RR LDA ERR16 PRINT BP OVFLOW JSB \GNER MESSAGE LDB BPINC USE LIMIT CMB,INB +1 OR -1 AS BASE ADB BPLMT PAGE BASE (DEPENDS ON WHETHER * WE'RE GOING UP OR DOWN * ALLOCATING LINKS JMP CONLD CPRST LDB CPL1H SET UP THE NEW TPREL ADB LWH4 USE SUM OF OLD AND USED LINKS STB TPREL SET NEW ADDRESS JMP LOADX GO START THE FINAL PASS SPC 1 ERR54 ASC 1,54 ERR16 ASC 1,16 LEN NOP P30 DEC 30 M37 OCT 37 M77 OCT 77 M100 OCT 100 M177 OCT 177 M377 OCT 377 M0760 OCT 076000 M2000 OCT 2000 M1177 OCT 101777 N6 DEC -6 SKP * PROCESS ENT/EXT RECORDS DENTR CCA,RSS SET ENT FLAG AND SKIP DEXTR CLA SET EXT FLAG STA NXFLG SAVE ENT/EXT FLAG LDA B GET NO. ENTRIES IN EXT/ENT AND M37 ISOLATE SYMBOL COUNT CMA,INA STA EXCNT SET SYMBOL COUNTER JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF NXSYM LDA \CURL,I GET NAME 1,2 STA \TBUF SAVE NAME 1,2 IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET NAME 3,4 STA \TBUF+1 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I ûjþúGET NAME 5 STA \TBUF+2 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB ATBUF GET ADDRESS OF SYMBOL JSB \LSTS SET LST ADDRESSES JSB \ABOR ENT/EXT NOT FOUND IN LST * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENTRY JMP EXT1 PROCESS EXT * * PROCESS ENT * JSB ZLOAD IF NOT LOADING CURRENT PGM JMP NLENT SKIP LINK AND MAP * LDA \LST4,I IF THIS ENT IS SELF DEFINING ADA N6 SKIP IF PROGRAM * * EMA?? * SSA OR BASE PAGE RELOCATABLE JMP NLENT GO DO SELF DEFINING THING * LDA \TBUF+2 GET THE RELOCATION AND P7 INDICATOR ADA MRTAD RELOCATE THE LDB A,I SYMBOL ADB \CURL,I ADD CURRENT RELOCATION VALUE STB OPRND SAVE ABS ENTRY PT. ADDRESS STB \LST5,I SET VALUE IN THE \LST LDA L01 IF 1ST OF TWO SZA,RSS PASSES, SKIP JMP NLENT THE MAP AND FIX UP * LDA \ID5,I CHECK FOR "MAP GLOBALS". SLA,RSS SKIP - BIT 0 SET (LIST ENTS). JMP MLENT SUPPRESS PRINTING OF ENTS. * JSB CLIST CLEAR MEMORY MAP BUFFER LDA BLAST GET BLANK, ASTERISK STA MLIST+1 SET IN MAP LDA \LST1,I GET NAME 1,2 STA MLIST+2 SET IN MEMORY MAP LDA \LST2,I GET NAME 3,4 STA MLIST+3 SET IN MEMORY MAP BUFFER LDA \LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK SET LOWER CHARACTER = BLANK STA MLIST+4 SET NAME 5 IN MEM MAP LDA \LST5,I GET ABSOLUTE ENTRY PT. ADDRESS LDB AMEM5 GET ADDRESS OF MESSAGE JSB \CONV CONVERT TO DECIMAL/OCTAL LDA P16 LDB AMLST GET ADDRESS OF MEM MAP BUFFER JSB \MESS PRINT ENTRY POINT * MLENT JSB DAFIX **FIX UP ALL REFERENCES TO THIS SYMBOL **** NLENT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF ‰þú JMP EXEND PROCESS NEXT SYMBOL * EXT1 CCA SAVE CURRENT IDENT INDEX. ADA \TIDN STA \TBUF LDA \TBUF+2 GET ORDINAL STA \LST3,I SET ORDINAL IN \LST * LDA \LST4,I GET IDENT INDEX SZA IF ENTRY NOT DEFINED CPA P2 JMP LIBTS CPA P3 OR SELF-DEFINING RSS THEN CPA P4 SKIP THE LOAD JMP LIBTS AND JUST CONTINUE CPA P5 OR UNDEFINED JMP LIBTS CPA P6 JMP EMAX CHECK PROPER REFERENCE TO EMA * REFI STA \TIDN SET ID INDEX FOR \IDX STA \TBUF+3 SAVE FOR LATER. * * GET REFERENCED IDENT JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND IN LIST LDA \ID6,I GET TYPE AND M177 ISOLATE IT STA B SAVE IT LDA \ID4,I GET M/S BIT AND MSIGN ADA B MERGE TYPE STA \TBUF+1 SAVE M/S, TYPE LDA \ID3,I GET PROGRAM USAGE FLAG STA \TBUF+2 SAVE USAGE FLAG * * RESTORE CURRENT IDENT LDA \TBUF GET CURRENT IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX. JSB \IDX SET IDENT ADDRESSES JSB \ABOR CURRENT IDENT NOT FOUND IN LIST LDA \TBUF+1 GET M/S, TYPE FOR EXT REFERENCE RAL,CLE,ERA SET E = M/S * CPA P30 JUMP IF SSGA MODULE JMP CKSSC * SZA,RSS IF SYSTEM REFERENCE JMP SYSRF GO CHECK FOR PROPER CALLER CPA P16 OR REFERENCE TO CONFIGURATOR JMP SYSRF SAME CHECKS * * CPA P14 IF REFERENCE TO LIBRARY * RSS * CPA P6 ROUTINES * JMP LIBRF CHECK FOR MRL OR MR PROG'S * EXT23 CPA P7 TYPE = UTILITY? JMP UTLRF YES - TEST FOR LEGALITY OF REFERENCE * SEZ SKIP - NOT MAIN PROGRAM JMP EXEND IGNORE PROGRAM CALL LIBUT LDA \TBUF+2 GET PROGRAM USAGE FLAG OF EXT REF SLA Fþú SKIP - PROGRAM NOT LOADED JMP EXEND OMIT PROGRAM LIST ENTRY * LDA \TIDN SAVE CURRENT IDENT INDEX. ADA N1 STA \TBUF LDA \TBUF+3 GET BACK TO REFERENCED IDENT. STA \TIDN JSB \IDX JSB \ABOR LDA \TBUF+2 LDB \PTYP IF BACK GROUND SEGMENT CPB P5 THEN IOR P4 SET THE BS FLAG IOR P2 SET THE MUST LOAD FLAG STA \ID3,I RESTORE THE FLAG TO THE IDENT LDA \TBUF RESTORE CURRENT IDENT STA \TIDN INDEX JSB \IDX AND ADDRESSES. JSB \ABOR MUST BE THERE. * EXEND ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NXSYM NO - PROCESS NEXT SYMBOL * JMP CLSRC NO - CLASSIFY NEXT RECORD * * CHECK FOR LEGALITY OF TYPE 7 UTILITY REFERENCE * UTLRF LDA \PTYP GET CURRENT LOAD TYPE CPA P30 OKAY IF SSGA JMP LIBUT AND M7 ISOLATE CPA P6 IF LIBRARY RSS THEN ERROR JMP LIBUT OTHERWISE, OKAY * * CHECK LEGALITY OF TYPE 6 OR 14 LIBRARY REFERENCE * *LIBRF LDA \PTYP GET CURRENT LOAD TYPE * CPA P30 IF SSGA - THEN ERROR * JMP CALER SINCE IT CAN'T REF MRL * AND M7 MASK TO PROG CLASS * CPA P6 IF ANOTHER LIBRARY ROUTINE * JMP EXT23 (6 OR 14), THEN OKAY * CPA P1 SO IS ANY MEMORY * JMP EXT23 RESIDENT PROG * CALER LDA ERR15 SET ERROR CODE - ILLEGAL CALL * REFRR CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT THE NO-NO LDA P5 NOW TELL 'EM THE REFERENCEE LDB \LST1 GET ASCII ADDRESDS JSB \MESS AND DISPLAY JSB \SPAC JMP EXEND TEST FOR ANOTHER * ERR15 ASC 1,15 ERR52 ASC 1,52 ERR58 ASC 1,58 * * MAKE SURE PROGRAM HAS SSGA PRIVILEGES * CKSSC LDB SSGAF GET FLAG SZB IF SET, THEN JMP EXEND JUST CONTINUE LDA ERR52 ELSE SENͤþúD ERROR MSG JMP REFRR * * CHECK LEGALITY OF SYSTEM REFERENCE * SYSRF LDA \PTYP GET CURRENT LOAD TYPE SZA IF SYSTEM CPA P30 OR SSGA RSS THEN REFERENCE IS OK CPA P16 AS IS SLOW BOOT JMP EXT23 CONTINUE CPA P15 TABLE AREA I IS JMP EXT23 OKAY CPA P13 TABLE AREA II IS JMP EXT23 OKAY LDA MTYPE GET MAIN PROGRAM TYPE AND M7 CPA P3 BG PRIVILEGED PROGRAMS ONLY JMP EXT23 HAVE VALID REFERENCES * LDA ERR58 ILLEGAL SYSTEM REFERENCE JMP REFRR SEND THE DIAGNOSTIC * LIBTS LDA LIBFG LOADING MEM. RES. LIB? CLE,SZA,RSS JMP EXEND NO SO SKIP * LDA \TLST YES,SET UP LIB REPLACE CODE. ADA N1 CLB,CLE CPA \PRV REFERENCE TO .ZPRV? CLB,CCE,INB YES SET FLAGS CPA \RNT REFERENCE TO .ZRNT? CCB,CCE YES SET FLAGS SEZ,RSS IF NEITHER JMP EXEND TREAT NORMALLY * STB LIBTP ELSE SET THE TRAP FLAG STA TRPLB AND LST INDEX JMP EXEND AND CONTINUE * * PROCESS EXTERNAL REF TO EMA SYMBOL * EMAX LDA IDSAV IS THIS A VALID RERERENCE CPA \LST5,I TO AN EMA? JMP REFI YES - IT BELONGS TO THE CURRENT PROG * LDA ERR42 NO - INVALID EMA PROGRAM TYPE, OR A JMP REFRR NON-EMA PROGRAM, OR THE WRONG EMA SYMBOL * ERR42 ASC 1,42 SKP * * SKIPR LDA \TBUF SKIP A DBL RECORD ALF,ALF GET SAVED RECORD LENGTH CMA,INA AND SET NEGATIVE INA SKIP THE LENGTH STA \TBUF SET FOR COUNTER SKIPX JSB DBSET SKIP A WORD ISZ \TBUF DONE? JMP SKIPX NO DO NEXT ONE. * JMP CLSRC YES GO GET NEXT RECORD SKP * * PROCESS DBL RECORDS * DDBLR JSB ZLOAD IF NOT LOADING JMP SKIPR SKIP TO END * Ýþú LDA B GET COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA B COMPUTE THE RECORDS AND M100 RELOCATION LDB TPREL GET THE MAIN RELOCATION BASE SZA,RSS IF BASE PAGE LDB TPBRE REPLACE WITH BP BASE STB DBLAD AND SET THE RECORD BASE ADDRESS JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * LDB \CURL,I GET RELOCATION ADDRESS ADB DBLAD RELOCATE THE RECORD ADDRESS STB DBLAD SAVE RELOCATION ADDRESS LDB \ID7,I GET FIRST DBL ADDRESS ISZ PLFLG SKIP - FIRST DBL RECORD JMP DBL0 IGNORE SUBSEQUENT RECORDS * * COME HERE ON FIRST BSS OF MODULE * IF MODULE IS A SEGMENT THEN DON'T * STORE BSS ON DISK SINCE IT ONLY * INDICATES ADDRESSES SHARED WITH THE MAIN * CLA STA BSSDP ZERO LOAD POINT OFFSET LDA \ID6,I AND M17 GET PRIMARY MODULE TYPE CPA P5 RSS ADJUST LOAD PT FOR SEG JMP DBL0 START FROM REL LOC 0 * FOR ALL OTHERS STB BSSDP SAVE INITIAL PROG DISPLACEMENT LDA \ABCO ADB A,I DISC /CORE STB A,I BASE ADDRESS LDA \MXAB STB A,I AND THE MAX ADDRESS DBL0 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF DBL1 LDB \CURL,I GET RELOCATION BYTES STB REKEY SAVE FOR RELOCATION TYPE LDA N5 STA INSCN SET RELOCATION BYTE COUNT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * DBL2 LDA REKEY GET RELOCATION BYTES ALF,RAR ROTATE TO LOW A STA REKEY SAVE FOR NEXT INSTRUCTION WORD AND M7 ISOLATE CURRENT BYTE STA LSTOS *TEMP* SAVE DBL TYPE CPA P4 EXTERNAL,EMA REFERENCE? JMP DBL4 YES - RESOLVE OR FIXUP * CPA P5 MEMORY REFERENCE? JMP DBL5 YES †þú- CHECK FOR INDIRECT LINK * CPA P6 BYTE ADDRESS? JMP DBL6 YES - GO CACULATE THE ADDRESS. * ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDB A,I GET RELOCATION BASE ADB \CURL,I ADD CURRENT INSTRUCTION WORD CLA CLEAR THE INSTRUCTION JMP DBL42 AND GO JOIN THE TYPE 4 PROCESSOR * DBL6 LDA \CURL,I GET THE INSTRUCTION WORD IOR M2000 SET THE INTERNAL BYTE FLAG BIT JMP DBL56 JOIN THE DBL 5 CODE * DBL33 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF ISZ EXCNT SKIP - LAST INSTRUCTION OUT RSS NO - CONTINUE JMP CLSRC YES - CLASSIFY NEXT RECORD ISZ DBLAD INCR DBL RELOCATION ADDRESS ISZ INSCN SKIP IF NEW RELOCATION BYTE JMP DBL2 NO - PROCESS NEXT INSTRUCTION JMP DBL1 YES - GET NEXT RELOCATION BYTE * * * PROCESS DBL EXT RECORD * DBL4 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT CLB SET OFFSET TO ZERO DBL42 STA INSTR SAVE THE INSTRUCTION WORD JMP DBL54 GO TO TYPE 5 RECORD HANDLER * DBL5 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT DBL56 STA INSTR SAVE INSTRUCTION CODE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB \CURL,I GET ADDRESS TO B LDA INSTR GET THE INSTRUCTION ALF,RAL SET E ELA IF A BYTE ADDRESS LDA INSTR GET INSTRUCTION CODE AND P3 ISOLATE THE MR FIELD ADA MRTAD INDEX INTO THE BASE TABLE ADB A,I RELOCATE THE ADDRESS SEZ IF BYTE ADDRESS THEN ADB A,I DOUBLE THE ADDRESS LDA INSTR GET THE INSTRUCTION WORD AGAIN ARS,ARS MOVE ORDINAL TO LOW A. * * DBL TYPE 4 JOINS HERE * DBL54 AND M377 ISOLATE THE ORDINAL STA \FIX4,I SAVE ORD IN \FIX UP TBL (TEMP). STB \FIX3,I SAVE THE OFFSET/ ADDRES4ÎþúS LDA INSTR GET THE INSTRUCTION AGAIN AND M1760 ISOLATE THE OP CODE AND IOR HIBP MERGE BP LINK FLAG FOR FIXUP IOR LSTOS AND MERGE DBL RECORD TYPE STA \FIX2,I PUT IT IN THE \FIXUP TABLE LDA DBLAD GET THE RECORD ADDRESS STA \FIX1,I SET THE CORE ADDRESS IN THE TABLE LDA \FIX4,I GET THE ORDINAL SZA,RSS IF NONE JMP DBL57 GO OUTPUT THE INSTRUCTION * JSB LSTOS LOOK FOR ORDINAL IN LST'S JSB \ABOR HALT IF NOT THERE * LDA \TLST GET THE LST ENTRY INDEX ADA N1 LDB LIBFG GET THE LIB FLAG SZB,RSS IF NOT LOADING CORE RES LIB JMP DBL45 JUST CONTINUE * CPA TRPLB ELSE IS THIS A REFERENCE TO .ZRNT,.ZPRV ? RSS YES SKIP JMP DBL45 NO, CONTINUE * LDA $LIBR YES USE $LIBR INDEX INSTEAD STA \TLST JSB \LSTX JSB \ABOR LDA \FIX1,I GET THE CORE ADDRESS INA AND SET THE ADDRESS STA ADTRP TRAP LDA N3 STA ADTPF SET FOR FIRST ADDRESS DBL44 LDA \TLST GET NEW LST ENTRY AND CONTINUE DBL45 SZA,RSS 0 MEANS .ZRNT INDEX CCA SO SET A SPECIAL, DONT WANT 0 STA \FIX4,I \FIX UP TABLE LDA \LST4,I GET THE DEFINITION ADDRESS CPA P3 IF PREDEFINED RSS THEN GO CPA P4 SEND RSS CPA P5 OR UNDEFINED (NOP'ED) JMP DBL57 THE INSTRUCTION CPA P6 EMA? JMP DBL57 SEND INSTR CPA P2 JMP DBL58 GO ADJUST FOR COMMON * LDA \LST5,I ELSE IF SYMBOL CCE,SZA IS DEFINED JMP DBL57 GO SEND IT * DBL60 LDA L01 IF NOT LOADING SZA SKIP THE FIX ENTRY JSB SFIX UNDEFINED SYMBOL MAKE FIX ENTRY CCA MAKE SURE FIX ENTRY IS STA \FIX1,I FLAGED PROPERLY JMP DBL33 GO GET NEXT þúENTRY * DBL57 LDA \FIX1,I GET THE ADDRESS CPA ADTRP THIS A TRAP ADDRESS RSS YES SKIP JMP DBL61 NO, DO NORMAL LOAD * LDA ADTPF GET TRAP REASON FLAG INA,SZA,RSS LAST TRAP OF THREE? JMP ADDX1 YES GO DO X+1 THING * INA,SZA,RSS X ADDRESS? JMP ADDX YES GO DO X ADDRESS THING * LDA \TFIX SAVE INDEX OF ADA N1 THIS FIX-UP STA \TBUF+3 ENTRY. CLA MUST BE P+1 TRAP STA \FIX4,I SET LST \FIX INDEX TO ZERO ISZ ADTPF SET FOR X ADDRESS NEXT TRAP LDB \FIX3,I GET ADDRESS FROM \FIX LST STB ADTRP SET FOR NEXT STA \FIX3,I SET TO NOP INCASE NOT RENT LDA LIBTP GET FLAG THAT TELLS INA,SZA,RSS IF .ZRNT JMP DBL60 GO MAKE FIX ENTRY * DBL61 CCB SIGNAL CLEARING OF FIXUP ENTRY JSB DFIX SEND THE INSTRUCTION JMP DBL33 GO GET THE NEXT ENTRY * DBL58 LDA COMAD ENTRY POINT IS IN COMMON ADA \FIX3,I SO \FIX THE STA \FIX3,I THE OFFSET JMP DBL57 AND OUTPUT THE INSTRUCTION * ADDX STA \FIX3,I ZAP THE OFFSET ISZ ADTRP SET FOR NEXT TRAP ISZ ADTPF TRAP NEXT ADDRESS (X+1) LDA $LIBX REPLACE THIS ONE WITH STA \TLST $LIBX INDEX. JSB \LSTX SET IT UP JSB \ABOR LDA JSB SET INSTRUCTION IOR HIBP MERGE BP LINK BIT STA \FIX2,I TO A JSB JMP DBL44 GO SEND IT * NT2K OCT 175777 JSB JSB 0 * ADDX1 STA ADTRP CLEAR ALL TRAPS STA ADTPF LDB LIBTP GET TYPE FLAG INB,SZB IF .ZPRV JMP DBL61 JUST SEND THE WORD * INA SET TO FORCE A FIX IN DAFIX STA \TLST WHERE FIX4,I = 0 LDA \FIX3,I GET THIS DEF STA FIXTP SAVE FOR OTHER ENTRY. LDA \TBUF+3 GET BACK TO THE STA \TFIX JSB \FIX OTHER \FIX-UP ENŸ$þúTRY. JSB \ABOR LDA FIXTP SET DEF IN THAT ENTRY. STA \FIX3,I JSB DAFIX GO SEND BOTH INSTRUCTIONS JMP DBL33 GET THE NEXT INSTRUCTION SKP * * PROCESS AN EMA RECORD (DECLARATION VALID) * EMAR CCE TELL ALLOC NOT TO SCAN FOR A LINK, JSB ALLOC JUST TO GO AND GET ONE STA EMLNK AND SAVE IT JSB DBSET JSB DBSET * LDB \CURL POSITION TO WORD 4 OF RECORD JSB \LSTS AND FIND EMA SYMBOL IN LST JSB \ABOR NOT THERE! CCA GET ITS LST INDEX ADA \TLST AND SAVE AS THE STA EMLST "CURRENT" EMA SYMBOL * JSB DBSET JSB DBSET POSITION TO WORD 6 LDA \CURL,I AND GET THE SYMBOL&'S STA \LST3,I ORDINAL AND SET IN LST JSB DBSET POSITION TO WORD 7 JMP CLSR1 CONTINUE WITH NEXT RECORD SKP * * ZLOAD NOP TEST FOR LOADING CURRENT PGM LDA LIBFG LIB LOADING? SZA,RSS JMP *+3 NO; THEN LOADING - GO STEP ADDRESS LDA P6 YES; CURRENT PGM TYPE=6? CPA LDTYP LDTYP CONTAINS THE LOW 3 BITS OF TYPE ISZ ZLOAD LIB AND SIX OR NOT LIB STEP ADDRESS JMP ZLOAD,I RETURN SPC 1 FIXTP NOP TRPLB NOP LIBTP NOP ADTRP NOP ADTPF NOP BLAST ASC 1, * BLANK,ASTERISK HED RTGN4 - LOADER SEGMENT SUBROUTINES. * * LSTOS - SEARCHES LST'S FOR ONE WITH ORDINAL MATCHING * \FIX4,I * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN SEQUENCE: CONTENTS OF A AND B DESTROYED. * (N+1): CURRENT LST POINTERS SET UP FOR LAST LST. * ORDINAL NOT FOUND. * (N+2): CURRENT LST POINTERS SET TO LST CONTAINING * DESIRED ORDINAL. * LSTOS NOP JSB \ILST RESET TO START OF LST. LSTO2 JSB \LSTX SET ADDRS FOR NEXT ENTRY. JMP LSTOS,I IF AT END, TAKE FAILURE EXIT. * LDA \FIX4,I COMPARE ORDINALS. XOR \LST3,I æNLH AND M377 SZA JMP LSTO2 NO MATCH: TRY NEXT ENTRY. ISZ LSTOS NATCH: TAKE SUCCESS EXIT. JMP LSTOS,I SKP * DFIX DOES THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY * AFTER THE SYMBOL (IF ANY) IS DEFINED. * * NOTE: THIS IS AN ENHANCED VERSION OF THE DFIX IN SEGMENT 5 * * CALLING SEQUENCE: * * SET UP FIX1-4 AND LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANINGLESS * DFIX NOP STB CLEAR SAVE FIXUP CLEARING FLAG CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * WILL BE -1 FOR .ZRNT INDEX * BUT NO PROBLEM SINCE IT IS * A REPLACE OPERATION * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE ¢ZNÿÿþú CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 UNDEFINED? JMP ZFIX REPLACE WITH A NOP CPB P6 EMA? JMP EMARF CHECK TYPE FOR VALID REF * * VFIX LDB \FIX2,I GET INSTR WITH OPTIONAL BYTE, HIBP CBX BITS, AND DBL TYPE BLF,RBL IF THE BYTE SSB BIT IS SET, THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2 AGAIN AND M7 EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA NOW GET AND M1000 THE HIBP BIT STA LINKB AND SAVE LINK MODE CXA LEAVE ONLY THE AND M1740 INSTRUCTION (15-11) STA DINST LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA? * * CHECK FOR AN EXTERNAL WITH OFFSET * LFIX SZB,RSS JMP WFIX NOT AN EXT LDB DBLT REFERENCE WITH OFFSET? CPB P5 IE, A DBL TYPE 5 JMP CPFIX YES - GO SEE IF IT'S A DEF(FOR DIRECT LINK) * WFIX LDA DINST GET THE INSTRUCTION CLE,ELA ZAP THE INDIRECT BIT SZB IF EXT REFERENCE JMP IDEF GO USE A LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSIGN RESTORE THE SIGN BIT STA OPRND IN OPERAND(FOR™Šþú LINK STORAGE) SZB IF EXTERNAL REF STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR DINST INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO OUTPUT THE WORD AFIX ISZ CLEAR SHOULD THIS FIXUP ENTRY BE CLEARED? JMP DFIX,I NOPE CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB DINST IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXT REF WITH OFFSET (NOT A DEF) * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND THEN JMP XFIX MAKE THE INSTR DIRECT CLB,INB SET B(WE KNOW IT'S AN EXT) JMP WFIX GO GET A LINK * * CONFIGURE EMA REFERENCE * EMARF CLA LDB \FIX4,I CAN THIS MODULE REFERENCE CPB EMLST THIS EMA? RSS YES - IT IS THE CURRENT EMA SYMBOL JMP ZFIX NO, SO NOP THE INSTR (EXT FLAGGED ERROR) * LDA \FIX2,I WAS THIS AN SSA INDIRECT REF TO EMA? JMP EER62 YES - CAN'T ALLOW AND M7 OR WAS IT A REF WITH OFFSET CPA P5 JMP EER62 CAN'T ALLOW IT EITHER * LDA \FIX2,I GET AND AND M1yþú740 ISOLATE THE INSTRUCTION IOR MSIGN SET THE INDIRECT BIT IOR EMLNK MERGE THE ALLOCATED LINK JMP ZFIX AND SEND THE INSTR * EER62 LDA ERR62 SEND ERROR DIAGNOSTIC CMA,INA FOR EMA WITH OFFSET OR JSB \GNER INDIRECT CLA NOW NOP THE JMP ZFIX INSTR * ERR62 ASC 1,62 OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M1000 OCT 1000 M1740 OCT 174000 CLEAR NOP DINST NOP SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB \IFIX INITILIZE THE FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW ENTRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED FOR FIX UP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DP? RSS JMP NOCHG NO LDA DPNUM YES, DP # MUST BE >= 2 SZA,RSS JMP NOCHG MUST BE DP 1, SDA,TA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP - ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN`+þú FIRST CMA,INA IE, < DPADD ADA \FIX1,I SSA JMP CHNGM IT'S LESS * NOCHG JSB SETDM GO SET FIXUP MODE JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM FOR FIXUP * CHNGM JSB \SYS REBUILD SYSTEM MAP JSB SETDM GO SET FIXUP MODE JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET THE NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT * * SETDM NOP SET THE MODE FOR CLEARING OF FIXUPS LDB DPFLG IF WE'RE RELOCATING A DRIVER PARTITION LDA LDTYP THEN DON'T REUSE THE FIXUP ENTRY SZA OF THE DRIVER (LIBR RTNS OK) CCB JMP SETDM,I SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER PROGRAMS. * BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA \PTYP PROG = SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S BIT RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 THEN LEAVE SET CPA P13 OR IF TABLE AREA II RSS D[þú CPA P15 OR TABLE AREA I RSS CPA P30 OR SSGA JMP TRID3 LEAVE SETT * AND M7 IF A TYPE 6 THEN CLEAR LOAD FLAGS CPA P6 UNLESS THE MRL OR MRP'S ARE BEING LOADED JMP RFMRL GO TEST CURRENT LOAD TYPE * CPA P7 IF A UTILITY PROGRAM JMP C2 THEN CLEAR IT SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT-EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. * RFMRL LDA \PTYP GET CURRENT LOAD TYPE CPA P1 IF MEMORY RESIDENT PROG RSS CPA P14 OR MEMORY RES LIBRARY JMP TRID3 THEN DON'T CLEAR LOAD FLAGS JMP C2 OTHERWISE, DO IT SPC 4 * THE GETCP ROUTINE SETS UP AND INITILIZES A NEW CP LINK AREA * * CALLING SEQUENCE: * * JSB GETCP * * RETURN A = \LNK1,\CPL2 ADDRESS * GETCP NOP LDA \CPL2 USE CURRENT TOP JSB \LNKS SET ADDRESSES CLA FOOL THE LINK ROUTINE STA \CPL2 JSB \LNK SET ADDRESS FOR NEXT AREA CLA SET AREA TO ZERO SIZE STA \LNK1,I STA \LNK2,I LDA \LNK3 SET THE IMAGE ADDRESS INA STA \LNK3,I LDA \LNK1 SET NEW TOP AND A FOR EXIT STA \CPL2 JMP GETCP,I RETURN SKP * * GET [óþúBP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NON LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NON FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 CLE JSB ALLOC NON ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA ¼×þú\LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE A PROGRAM'S LINK AREA, * A DISGNOSTIC IS PRINTED. * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I WAS SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE * LINK MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS * OCCURS WHEN THE SYSTEM IS RESOLVING EXT REFERENCES FROM THE TABLE * AREAS, SSGA, OR SDA - WHERE THE LINKS MUST BE IN ALL MAPS. * * CALLING SEQUENCE: * E = 1, DO NOT SCAN FOR AN ALREADY EXISTING LINK * E = 0, SCAN FIRST * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP SEZ SCAN? JMP NOSCN NO LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBPþú CURRENT LINK ALLOCATION MODE JMP NORML THEN ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM * THE TABLE AREAS, DRIVERS, OR SSGA - SO USE A LINK * IN THEIR UPPER PORTION OF BASE PAGE. * LDA LOLNK HAS LAST SYSTEM LINKE CPA TBREL ALREADY USED IT? JMP ER16 YES ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP AND UPDATE LAST UPPER BPL USED STA BPLMT AND UPPER LIMIT FOR LOWER BPL'S LDB A GET IMAGE ADDRESS ADB \ADBP OF LINK JMP ALLO1 AND GO SET UP * NOSCN CLA,INA SET SKIP FLAG = 1 STA \LNK1 NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, 100 FOR SYS, AND 1644 FOR * TABLE AREAS/SSGA/SDA/PRD'S. BPINC SET TO -1 WHEN * LOADING TABLE AREAS,SSGA,SDA,PRD'S, AND TO +1 * OTHERWISE. BPLMT SET TO LOWEST TABLE AREA/SSGA/SDA LINK * FOR SYS, LAST SYS LINK FOR PRD'S, AND LOWEST DRIVER * LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FROM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE CMA,INA DON'T DO A TR JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * ’Qþú* PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THùfþúE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 \CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 \CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP SKP * * CLEAR THE CURRENT PAGE * * CLRCP CLEARS THE CURRENT PAGE LINKING IMAGE POINTED AT BY * THE CURRENT \LNK ENTRY. * CLRCP NOP LDA \LNK2,I COMPUTE CMA,INA NUMBER ADA \LNK1,I OF STA \LNK WORDS TO CLEAR SZA,RSS IF ZERO THEN JMP CLRCP,I EXIT * LDA \LNK3,I STA \LNKX GET ADDRESS OF AREA CLRC1 CLA CLEAR STA \LNKX,I A WORD ISZ \LNKX STEP TO NEXT ONE LDA \LNKX CHECK FOR ADA \CPLM OVERFLOW OF SSA,RSS IMAGE AREA JMP TRUN GO SHORTEN IF OVERFLOW * ISZ \LNK STEP COUNTER JMP CLRC1 IF NOT DONE DO NEXT ONE * JMP CLRCP,I RETURN * TRUN LDA \LNK3,I CACULATE MAX ADA \CPLM AREA SIZE CMA,SSA,INA IF NEGATIVE CLA SET TO ZERO ADA \LNK1,I ADD BASE ADDRESS STA \LNK2,I SET NEW UPPER END JMP CLRCP,I AND RETURN SKP * * OUTPUT CURRENT CURRENT PAGE * * OUTCP OUTPUTS THE AREA SPECIFIED BY \LNK1, \LNK2, AND \LNK3 * TO THE DISC. * * CALLING SEQUENCE: * * SET UP \LNK1, \LNK2, \LNK3 * JSB OUTCP * * RETURN REGISTERS MEANINGLESS * OUTCP NOP JSB \LNKS SET UP THE \LNK AREA LDA \LNK1,I GET THE CMA,INA NUMBER OF ADA \LNK2,I WORDS TO OUTPUT TO CMA,INA,SZA,RSà)þúS A AND IF ZERO JMP OUTCP,I RETURN * STA WDCNT SET THE COUNT LDA \LNK3,I GET THE ADDRESS OF THE FIRST WORD STA \TBUF AND SET IT LDB \LNK1,I GET THE CORE ADDRESS TO BE USED OUTC2 LDA \TBUF,I GET A WORD JSB \ABDO SEND IT TO THE DISC ISZ \TBUF STEP THE WORD ADDRESS ISZ WDCNT AND THE COUNT DONE? JMP OUTC2 NO DO THE NEXT WORD * JMP OUTCP,I YES RETURN SKP * * READ RELOCATABLE RECORD CONTROL * * DBSET ESTABLISHES THE ADDRESS OF THE NEXT WORD OF THE RELOCATABLE * RECORD IN \LBUF. IF \LBUF HAS BEEN PROCESSED, IT ISSUES A CALL TO * \RBIN TO READ ANOTHER RELOCATABLE RECORD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBSET * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DBSET NOP ISZ \CURL INCR CURRENT \LBUF ADDRESS ISZ LCNT SKIP - END OF \LBUF JMP DBSET,I RETURN LDA ALBUF READ NEXT RELOC RECORD. STA \CURL CLB JSB \RBIN JSB \ABOR ERROR (MSG ALREADY DISPLAYED). SZA,RSS JSB \ABOR EOF. CMA,INA SET COUNT. STA LCNT JMP DBSET,I RETURN. SPC 3 SPC 1 * SEND MESSAGE "BP LINKAGE XXXX" ROUTINE. SPC 1 BPLNR NOP LDB MES03 XXX IS IN A ON ENTRY. JSB \CONV LDA P16 LDB MES02 JSB \MESS JMP BPLNR,I * MES02 DEF MS02 MS02 ASC 8,BP LINKAGE XXXXX MES03 DEF MS02+5 SKP * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP ‡æHFBINCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 SPC 3 * SETBP SET THE SPECIFIED BASE PAGE IMAGE WORDS TO -1 * CALLING SEQUENCE: SAME AS CLRLT. * SETBP NOP STB CLRLT SAVE THE HIGH LIMIT CCB SET THE CLEAR WORD STB CLWRD TO -1 LDB CLRLT RESTORE B JSB CLRLT GO SET THE WORDS TO -1 ISZ CLWRD RESET CLEAR WORD TO 0 NOP ALWAYS SKIPPED JMP SETBP,I RETURN SPC 1 CLWRD NOP SKP * * CLEAR MEMORY MAP BUFFER * * CLIST CLEARS THE MEMORY MAP BUFFER WITH BLANKS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLIST * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CLIST NOP LDB AMLST AMLST = ADDR OF MLIST LDA N8 STA AMAD SET BUFFER LENGTH LDA BLNKS GET 2 BLANK CHARACTERS STA B,I CLEAR BUFFER WORD INB ISZ AMAD ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP CLIST,I RETURN SPC 2 B4400 OCT 4400 BLNKS ASC 1, * * END LODR vìHÿÿþúASMB,R,L,C HED RT4G5 - I/O TABLE GENERATION SEGMENT. NAM RT4G5,5,90 92067-16009 REV.1926 790427 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************** * * NAME: RT4G5 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH,JH,GAA * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \IOTB,\TBLS * * EXTERNAL REFERENCE NAMES * EXT \LSTS,\TLST EXT \LST1,\LST4,\LST5 EXT \IDXS,\IDX,\TIDN EXT \ID6,\ID8 EXT \IFIX,\FIX,\PFIX EXT \FIX1,\FIX2,\FIX3,\FIX4 EXT \LNKX,\LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 * EXT \CURL,\CPL2,\TBUF EXT \SYS,\USER EXT \SRET EXT \OCTN,\CONV,\GETN,\GINT,\GET#,\GETC,\DCON EXT \ADBP,\NABP,\CMFL EXT \READ,\SPAC,\GNER,\INER,\ABOR,\MESS,\IRER EXT \ABDO,\ADSK EXT \SSID,\ASKY,\SKYA EXT \PREL * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780126 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * ¬þú *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF•¡þú ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMAR¨ùþúY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC ^ùþúBSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * S<þú * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST ATB30 DEF TB30 SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * GIO LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * SPC 1 N DEC -1 LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * THIS SECTION OF CODE GENERATES THE I/O TABLES FOR THE SYSTEM. * THESE INCLUDE THE EQUIPMENT TABLE (EQT), DEVICE REFERENCE * TABLE (DRT), INTERRUPT TABLE (INT), AND DRIVER MAP TABLE (DVMAP). * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T><,X><,S><,M> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = EQT EXTENSION SIZE TO BE ENTERED * S = SYSTEM DRIVER AREA * M = SYSTEM DRIVER AREA WITH MAPPING * * IF T IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST BE NEXT ENTERED IN RESPONSE TO: * ' T = ' * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * COR7EþúRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * * GENERATE EQUIPMENT TABLE (EQT) * \IOTB NOP JSB \SPAC SEND A SPACE LDA P12 LDB MES30 JSB \MESS PRINT: TABLE AREA I: * JSB \SPAC MAKE IT LOOK NICE. LDA \PREL SET STARTING ADDRESS STA AEQT OF EQT'S CLA STA CEQT CLEAR NO. OF EQT ENTRIES STA SPLCO CLEAR THE SPOOL EQT COUNT STA BPONL ?AND THE BASE PAGE ONLY FLAG CCA SET DRT2 AND STA DRT2 DRT3 STA DRT3 TO IMPOSSIBLE NUMBERS LDA ATB30 ADA P6 SET FOR HEADER RECORD STA HEADR STORAGE JSB \SPAC LDA P22 LDB MES25 MES25 = ADDR: EQT TABLE ENTRY JSB \MESS PRINT: EQUIPMENT TABLE ENTRY * JSB SFIX GET A FIXUP ENTRY IF NEEDED SEQT JSB \SPAC SEND \SPAC LDA CEQT CPA P63 OVER LAST ALLOWED DEFINITION? JMP BLEQT YES, MAX OF 63 CMA LDB ATBUF THE CURRENT EQT JSB \CONV NUMBER TO ASCII LDA \TBUF+2 SET IN THE SETNO STA ME þúSEQ EQT MESSAGE BUFFER LDA P7 GET MESSAGE LENGTH LDB MESQE SEND MESSAGE "EQT XX?" AND JSB \READ GET EQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA "/E" CHARS = /E? JMP EQTFX YES - SET DEVICE REF TABLE (SQT) * LDA CEQT GET NUMBER OF DEFINED EQT'S CPA P63 IF OVER LIMIT JMP EQTOV THEN SEND ERROR UNTIL /E JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U * IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * BLEQT LDA BLNKS SET EQT # TO BLANKS JMP SETNO IN PROMPT * EQTOV LDA ERR35 SET CODE = OVER 63 DEFINED EQT'S CMA,INA SIGNAL NO TR TO THE OPERATOR JSB \GNER PRINT THE DIAGNOSTIC JMP SEQT CONTINUE UNTI /E ENTERED * CLDBU LDB \OCTN GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS CLA STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA IOSDM CLEAR SDA/MAPPING WORD STA XLNTH CLEAR EXTENSION LENGTH STA \FIX3,I CLEAR THE STA \FIX4,I FLAG WORDS STA \FIX2,I STA TVAL AND TIME OUT VALUE CCA STA TFLAG CLEAR TIME-OUT FLAG LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA "DV" CHAR = "DV"? CLA,INA,RSS YES - CONTINUE JMP DVERR INVALID DRIVER NAME JSB \GETN MOVE 1 CHAR TO \TBUF (CHAR 3) JMP STYPE GET DRIVER TYPE * DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * STYPE STA X. SAVE KEY CHARACTER (R FOR STD.) ôôþú LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF STA .YY SAVE 2 ASCII CHARS FOR I.XX,C.XX CCA ADA \CURL ADJUST CURRENT LBUF ADDR STA \CURL RESET \CURL TO CONVERT TYPE LDA P2 JSB \GET# GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME * LDB \OCTN GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA \FIX1,I STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG STA XFLAG SET EQT EXTEND FLAG STA SFLAG SET SDA FLAG STA MFLAG SET MAPPING FLAG * INDBU CCA STA \CMFL SET COMMA FLAG = NO COMMA IN JSB \GETC GET NEXT CHAR FROM LBUF CPA "D" CHAR = D? JMP SEDMA YES - SET DMA CODE * CPA "B" CHAR = B? JMP SETBU YES - SET BUFFERING CODE * CPA "T" CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG * CPA "X" CHAR = X? JMP SETEX YES GO SET UP EQT EXTENSION * CPA "S" CHAR = S? JMP SETSD YES - SET SDA CODE FOR DVMAP * CPA "M" CHAR = M? JMP SETSM YES = SET SDA/MAPPING CODE FOR DVMAP * UNERR LDA ERR26 SET CODE = INVALID D,B,T,X JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JMP TEQU GET THE TIME OUT VALUE * * EQTST JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX * CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR ¥ñþúNO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED * LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED * LDA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SETSD ISZ SFLAG SKIP - FIRST S ENTERED JMP UNERR DUPLICATE S'S ENTERED * LDA BIT14 SET BIT 14 = 1 JMP SETS2 IN IOSDM FOR DVMAP * SETSM ISZ MFLAG SKIP - FIRST M ENTERED JMP UNERR DUPLICATE M'S ENTERED * LDA BIT13 SET BIT 13 (MAPPING) IOR BIT14 AND BIT 14 (SDA) TO 1 SETS2 IOR IOSDM IN WORD FOR DVMAP STA IOSDM JMP EQTST TEST FOR NEXT OPERAND * SETEX ISZ \FIX1,I SKIP FIRST X ENTERED JMP UNERR NO BITCH * TEQU STA I.XX SAVE THE TYPE FLAG JSB \GETC GET THE NEXT CHARACTER CPA EQU IF NOT "=" RSS JMP UNERR BITCH * LDA N5 GET DECIMAL NUMBER JSB \GET# JMP UNERR ILLEGAL NUMBER SO BITCH * LDB I.XX GET THE TYPE FLAG CPB "X" IF EXTENSION JMP QEXT SAVE THE LENGTH OF THE EXTENSION STA TVAL SET THE TIME OUT VALUE JMP EQTST GO GET THE NEXT OPERAND * QEXT STA XLNTH SAVE EXTENSION SIZE STA \FIX3,I FOR BUILDING IT LDB \PREL SET ADDRESS OF ADB P12 EQT 13 STB \FIX2,I FOR LATER FIXUP JMP EQTST GET NEXT OPERAND * GENEQ LDA X. GET THE KEY CHARACTER STA SFLAG AND SAVE **TEMPORAY** CPA "R" IF R THEN USE LDA "." A PERIOD. IOR "INL" SET "I" IN UPPER HALF STA X. SET FOR LST SEARCH LDB ENT GET ADDRESS JSB \LSTS LOOK FOR SYMBOLn¦þú JMP DVERR ILLEGAL DRIVER ENT NOT FOUND. * LDA \LST4,I RETRIEVE IDENT INDEX OF STA \TIDN DRIVER MAIN, AND JSB \IDX SET IT UP JSB \ABOR BETTER BE THERE! LDA \ID6,I MUST BE A TYPE 0 MODULE AND M177 SZA JMP DVERR ELSE ERROR * LDB IOADD GET CHANNEL # CPB DCHNL WAS IT THE SYSTEM DISC RSS CHANNEL? JMP COMPS NO CLA MAKE SURE SDA JMP CHSM WASN'T SPECIFIED FOR IT * COMPS LDA \ID8,I WAS AN EQT PREVIOUSLY SSA,RSS DEFINED FOR THIS DRIVER? JMP SETFX NO, SO NEEDN'T CHECK AND SMBIT THE S,M SPECIFICATIONS CHSM CPA IOSDM (OR ABSENCE OF EITHER/BOTH) JMP SETFX OK, NEW CONFORMS WITH OLD, DISC NOT SDA * LDA ERR23 SET CODE = EQT DOESN'T DEFINE JSB \GNER SAME S,M SPECS FOR DRIVER - OR THE JMP SEQT SYSTEM DISC WAS SPECIFIED AS SDA * SETFX JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR, HIBP BIT, DIRECT ADDR STA \FIX2,I CLA STA \FIX3,I CLEAR OFFSET CCA SET ADA \TLST LST INDEX OF STA \FIX4,I I.XX STA TEMP2 SAVE FOR NOCXX LDA \PREL GET EQT2 ADDRESS WHERE INA I.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR CODE, HIBP BIT, STA \FIX2,I AND DIRECT ADDRESS CLA STA \FIX3,I CLEAR OFFSET LDA \PREL SET EQT3 ADDRESS ADA P2 WHERE C.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * LDA X. GET THE I. OR WHAT EVER XOR B5000 CHANGE IT TO C. OR WHAT EVER STA X. AND RESET LDB ENT SCAN THE LST JSB \LSTS FOR THE "C.YY" ENTRY POINT. JMP NOCXX C.XX NOT FOUND IN LST CCA SET LST ADA \TLST dîþúINDEX OF C.XX * STCXX STA \FIX4,I IN FIXUP ENTRY LDA X. IF THIS IS CPA "CS" DVS43 THEN LDA .YY COUNT CPA "43" A ISZ SPLCO SPOOL EQT * LDA IOADD SAVE THE CHANNEL AND AND M377 TYPE IN THE HEADER ALF,ALF RECORD LDB IOTYP BLF,BLF IOR B STA HEADR,I ISZ HEADR * CLA LDB \PREL GET THE ADDRESS JSB \ABDO PUT OUT I/O LIST POINTER CLA ENTRY POINT TO BE FIXED UP JSB \ABDO OUTPUT ABSOLUTE DVRXX ENT ADDR LDA C.XX GET DRIVER EXIT POINT JSB \ABDO OUTPUT ABSOLUTE DVRXX COMP. ADDR LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. JSB \ABDO OUTPUT D,B,U, CHANNEL * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,1 CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE JSB \ABDO OUTPUT EQUIPMENT TYPE, STATUS * ADB P6 INDEX TO EQT12 LDA XLNTH GET EXTENSION SIZE JSB \ABDO AND SEND IT TO THE DISC INB STEP TO EQT14 LDA TVAL GET THE TIME OUT VALUE SZA IF ZERO LEAVE IT CMA ELSE SET IT TO ONES COMPLEMENT JSB \ABDO SEND TIME OUT TO EQT INB SET THE ADDRESS STB \PREL OF THE NEXT EQT * LDB DDVMP GET DVMAP BUFFER ADDRESS ADB CEQT FOR STORAGE LDA IOSDM SET POSSIBLE S,M BITS IOR MSIGN AND EQT DEFINED BIT IOR \ID8,I STA \ID8,I IN DRIVER IDENT RAL POSITION S BIT TO 15 SSA SKIP IF NOT SDA JMP SDAEQ GO SET DVMAP ENTRY FOR SDA DRIVER * CCA GET DRIVER IDENT INDEX ADA \TIDN FOR SCAN ON RELOCATION èBNLH IOR BIT14 SET TO DISTINGUISH FROM SDA,PAGE # IN ENTRY STA B,I AND STORE IN DVMAP ENTRY JMP NEXTE SET UP FOR NEXT EQT * SDAEQ STB MFLAG SAVE DVMAP ENTRY ADDR **TEMP** LDB MSIGN BIT 15 MUST BE SET FOR SDA RAL POSITION M BIT TO 15 SSA SKIP IF NO MAPPING INB SET BIT 0 IF DRIVER MAPS STB MFLAG,I AND STORE IN DVMAP * NEXTE JSB SFIX GET A NEW FIXUP TABLE ENTRY IF NEEDED ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * NOCXX LDA TEMP2 C.XX NOT FOUND SO USE JMP STCXX I.XX INDEX SPC 2 MESQE DEF *+1 ASC 2,EQT DO NOT REARANGE THESE MESEQ NOP THESE THREE ASC 1,? LINES "CS" ASC 1,CS "43" ASC 1,43 D26 DEC 26 "R" OCT 122 "X" OCT 130 EQU OCT 75 ASCII "=" XFLAG NOP TVAL NOP "DV" ASC 1,DV "." OCT 56 "INL" OCT 44400 ASCII I NULL B5000 OCT 5000 §NÿÿþúBIT13 OCT 20000 HIDIR OCT 1005 HIGH BP,DIRECT LINK(DEF TO EXT) FOR FIXUPS SPC 5 EQTFX JSB \IFIX ALLOCATE AND SET UP NXEQF JSB \FIX EXTENDED EQTS JMP SDVMP END OF FIXUPS, GO BUILD DVMAP * LDA \FIX1,I GET THE TYPE FLAG SZA IF NOT ZERO THEN NOT JMP NXEQF AN EQT PATCH ENTRY * LDB \FIX2,I GET EQT13 ADDRESS LDA \PREL AND CURRENT CORE ADDRESS JSB \ABDO OUTPUT THE ADDRESS LDA \PREL RESERVE THE ADA \FIX3,I CORE STA \PREL CCA CLEAR THE FIX STA \FIX1,I ENTRY JMP NXEQF AND TRY THE NEXT ONE SPC 5 * * BUILD DRIVER MAP TABLE * SDVMP LDA CEQT SET LOOP COUNTER CMA,INA FOR NUMBER OF STA TEMP2 EQT'S DEFINED * LDB \PREL GET NEXT CORE ADDRESS SDMVL LDA DDVMP,I GET NEXT DVMAP ENTRY JSB \ABDO OUTPUT IT ISZ DDVMP BUMP BUFFER ADDRESS ISZ TEMP2 AND LOOP COUTER JMP SDMVL MORE TO GO * LDA \PREL SAVE ADDRES OF STA DVMAP DRIVER MAP TABLE ADB CEQT RESERVE SPACE FOR SECOND STB \PREL (BLANK HALF OF TABLE) * STB ASQT SET START OF DRT TABLE SKP * * SET DEVICE REFERENCE TABLE (DRT) * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CLA,INA STA CSQT SET SQT COUNT = 1 CCA STA LFLAG SET 1ST DEV REF INPUT FLAG = -1 LDA P22 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB \MESS PRINT: * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. CPA P256 OVER MAXIMUM ALLOWED? JMP BLDRT YES, GO BLANK THE # CMA,INA SET TO NEG. FOR DECIMAL CONV LDB ATBUF GET ADDRESS OF TBUF JSB \CONV CONVERT TO DECIMAL AT TBUF LDA \TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS AND M7400 ISOLATE UPPER CHAR CPA UASCZ CHAR = A{½þúSCII ZERO? LDA UBLNK YES - REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA \TBUF+2 GET 2-DIGIT DEV REF NO. AND M177 ISOLATE LOWER CHAR IOR B SET A = DEV REF CODE SET# STA MES28,I PUT DEV REF CODE IN MESSAGE JSB \SPAC NEW LINE LDA P11 LDB MES28 MES28 = ADDR: XX = EQT #? * JSB \READ GET SQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP SINTT YES - SET INTERRUPT TABLE LDA CSQT WAS THIS DRT ALLOWED? CPA P256 NO MORE THAN 255 JMP DRTOV OVER LIMIT JSB \GINT RE-INITIALIZE LBUF SCAN LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP SUBCH IGNOR SUBCHANNEL JSB \GETC COMMA ENCOUNTERED? SZA,RSS YES - GO GET SUBCHANNEL JMP SUBCH NO - DEFAULT IT TO ZERO * LDA N2 JSB \GET# GET TWO DECIMAL DIGITS JMP DRERR AND M37 KEEP MAX SIZE CPA \OCTN IF NOT SAME JMP SUBCH JMP DRERR THEN ERROR * BLDRT LDA BLNKS SET DRT # TO BLANKS JMP SET# WHEN MORE THAN 63 * DRTOV LDA ERR35 SET CODE = MORE THAN 63 DRT'S CMA,INA SIGNAL NO TR TO OPERATOR JSB \GNER PRINT DIAGNOSTIC JMP DEVRE CONTINUE UNTIL /E ENTERED * SUBCH STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? áþú RSS YES - CONTINUE CPB P2 SECOND ENTRY? RSS YES - CONTINUE JMP SESQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CPB P1 FIRST SQT ENTRY? RSS YES - CONTINUE (SET TTY CHANNEL) JMP SESQT PUT OUT DEV. REF. NO. TO SQT CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH STB TTYCH SET EQT ADDR IN TTY CHANNEL * ADB P3 RETRIEVE THE CHANNEL NO. JSB \ABDO TO INSERT IN THE HEADER RECORD STA TB30+127 PLACE IN LAST WORD FOR NOW ADB N1 RESTORE THE WORD JSB \ABDO * SESQT LDB CSQT SET UP TO TEST LDA TEMPS FOR PROPER SUB CHANNEL REFERENCES CPB P2 DEV. REF = 2? CPA SYSCH YES - SYSTEM SUB CHANNEL? RSS YES - YES OR NO -X SKIP JMP DRERR YES - NO - ERROR CPB P3 DEV. REF =3? CPA AUXCH YES - AUX SUB CHANNEL? JMP SETQT YES - YES OR NO - X - GO SETUP * LDA AUXCH GET THE CHANNEL SSA IF DISC ON DIFFERENT CONTROLER JMP SETQT GO SET IT UP * LDA TEMPL YES - NO - TEST FOR AUX UNIT DEFINED LDB DAUXN SZB SKIP IF NO AUX UNIT JMP DRERR AUX DEFINED SO ERROR * SZA NO AUX-UNIT WAS REF = 0? JMP DRERR NO - SO ERROR * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB CSQT SET UP TO TEST FOR ILLEGAL DISC REF. CPA DRT2 IF SAME AS SYSTEM DISC JMP DRERR ERROR CPB P2 IF SYSTEM DISC ENTRY STA DRT2 SET ’þúFOR FUTURE TESTING CPA DRT3 IF SAME AS AUX DISC JMP DRERR ERROR SZA,RSS IF ZERO SKIP JMP *+3 TEST FOR AUX ENTRY CPB P3 IF AUX ENTRY STA DRT3 SET FOR FUTURE TESTING LDB \PREL SET CORE ADDRESS JSB \ABDO OUTPUT SQT ENTRY ISZ \PREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY * DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB \GNER PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS NOP HEADR NOP D$CIC DEF $CIC P256 DEC 256 SKP SINTT LDA DRT2 GET EQT # FOR SYSTEM DISC AND M77 CCB AND OFFSET INTO THE DRIVER MAP TABLE ADB A IN ORDER TO GET THE ADB DVMAP JSB \ABDO IDENT INDEX OF THE SYSTEM STA SDID DISC DRIVER TO FORCE IT INTO ADB N1 DP #1 AT RELOCATION TIME JSB \ABDO RE-STORE SDID VALUE * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CCB ADB CSQT SUBTRACT 1 FROM SQT COUNT STB CSQT SET SQT COUNT * ADB \PREL THE FOLLOWING ALLOWS FOR TWO WORDS STB \PREL PER DRT ENTRY CLA ZERO THEM OUT STA ENDFL JSB \ABDO * * SET INTERRUPT TABLE (INT) * LDA \PREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA \ADSK GET CURRENT ABS. CODE DISK ADDR STA DSKIN SAVE INT CODE DISK ADDR LDA DCNT GET CURRENT ABS. CODE DBUF COUNT STA INTCN SAVE INT CODE DISK RECORD COUNT LDA P15 LDB MES29 MES29 = ADDR. * INT TABLE JSB \MESS PRINT: * INTERRUPT TABLE LDB AILST GET ADDRESS OF ILIST STB CURIL GET CURRENT ILIST ADDRESS JSB BUFCL CLEAR ILIST * LDB D$CIC GET LST INDEX FOR JSB \LSTS SYSTEM MODULE $CIC†‚þú JMP NOCIC NOT FOUNT, BAD!! CCA ADA \TLST FOR STORAGE IN STA JSCIC FIXUP ENTRIES * CLA ALLOCATE FIXUP ENTRIES FOR SETIL STA TCNT INT. LOCATIONS 0-3,5 * JSB SFIX GET A NEW FIXUP ENTRY LDA TCNT AND GO BUILD IT JSB INTFX FOR THIS LOCATION INA BUMP TO NEXT LOCATION CPA P4 SKIP LOCATION 4 INA (SET BELOW) CPA P6 DONE WITH THE LOOP? RSS YES JMP SETIL NO, CONTINUE FIXUP'S * LDB P4 INITIALIZE TRAP CELL FOUR ADB \ADBP ADJUST TO PSEUDO BASE PAGE LDA HLTB4 TO HALT(B) 4 STA B,I ADB P2 GET ADDR OF FIRST INT LOCATION, 6 STB MEM12 SET CURRENT BP ADDRESS JSB \SPAC * SETIN JSB SFIX GET A NEW FIXUP ENTRY IF NEEDED * CLA,INA NEW LINE LDB HYADD JSB \READ GET INT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP ENDIO YES - I/O TABLES COMPLETE JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR28 SET CODE = INVALID INT CHNL NO. JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I CLEAR FIXUP ENTRY JMP SETIN REPEAT INT REC INPUT * NOCIC LDA ERR21 SET CODE = CIC NOT FOUND IN LST JSB \IRER IRRECOVERABLE ERROR * SETCH LDA \OCTN GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. * LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "EQ" CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD * CPA "PR" CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD * CPA "EN"v¿þú CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD * CPA "AB" CHARS = AB? JMP INTAB YES - PROCESS INT ABS RECORD * IMNEM LDA ERR30 SET CODE = INVALID INT MNEMONIC JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * INTEQ LDA N2 JSB \GETN MOVE NEXT 2 CHARS TO \TBUF CPA UTCHR CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDB \OCTN GET EQT TABLE ENTRY NO. CMB,INB,SZB,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STB TCHR SAVE EQT NO. ADB CEQT ADD UPPER EQT REF. NO. SSB,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE * EQUER LDA ERR31 SET CODE = INVALID EQT NO. JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHR GET EQT REF. NO. LDA AEQT GET ADDR OF EQT INB,SZB,RSS SKIP - NOT FIRST EQT REFERENCE JMP SEQTI SET EQT ADDR IN INT TABLE * ADA P15 ADJUST FOR NEXT EQT ENTRY ADDR INB,SZB SKIP - EQT ADDRESS FOUND JMP *-2 CONTINUE EQT SEARCH * SEQTI LDB JSCIC GET $CIC INDEX JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UGCHR CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF FIND THE PROGRAM JSB \IDXS IN THE IDENT LIST JMP PRERR INVALID PROGRAM NAME LDB JSCIC GET $CIC INDEX LDA \TIDN GET CURRENT IDENT INDEX ADA N1 CMA,INA SET NEGATIVE JMP COMIN SET INTERRUPT TABLE, LOCATION * PRERR LDA ERR32 SET CODEö!þú = INVALID PROGRAM NAME JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * * INTEN LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UTCHR CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF FIND THE ENTRY JSB \LSTS IN THE \LST JMP ENERR INVALID ENTRY POINT LDA \LST4,I GET IDENT INDEX SZA,RSS SKIP - ENT IS DEFINED JMP ENERR INVALID ENTRY POINT STA \TIDN SET IDENT INDEX OF PROGRAM JSB \IDX SET IDENT ADDRESSES JSB \ABOR END OF IDENT LIST LDA \ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE SZA SKIP IF A SYSTEM PROGRAM JMP ENERR ERROR IF NOT LDB \ID8,I CHECK IF HAS AN EQT SSB,RSS SKIP IF DOES JMP SETEN NOT,SO ALWAY PRESENT IN SYS MAP RBL MOVE SDA BIT TO 15 SSB SKIP IF NOT SDA JMP SETEN MUST BE IN SDA IF A DRIVER * ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * * ALLOCATE A FIXUP FOR THE ENT * * SETEN LDA IJSB BUILD FIXUP TABLE ENTRY IOR HIBP SET TO UPPER LINK STA \FIX2,I AND STORE JSB 0,I CODE LDB INTCH AND THE INT LOCATION STB \FIX1,I CCA ADA \TLST STORE THE LST INDEX OF STA \FIX4,I THE ENT CLA CLEAR THE STA \FIX3,I OFFSET JSB SFIX MAY NEED ANOTHER FIXUP CLA CLB SET INT ENTRY & LOC TO 0 JMP COMIN * INTAB LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA USCHR CHARS = U,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB \GET# GET 6 OCTAL DIGITS, CONVERT JMP ABERR INVALID ÄþúABS DIGIT CLA LDB \OCTN GET ABSOLUTE VALUE * * THE 4 FORMATS ARE NOW: * ENT: A-REG = 0 B-REG = 0 * PRG: A-REG = - IDENT INDEX B-REG = $CIC IDENT INDEX * EQT: A-REG = EQT ADDRESS B-REG = $CIC IDENT INDEX * ABS: A-REG = 0 B-REG = ABSOLUTE VALUE * COMIN STA \TBUF SAVE INT TABLE CODE STB \TBUF+1 SAVE INT LOCATION CODE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP *+4 YES - CONTINUE * LDA ERR36 SET CODE = INVALID FINAL OPRND JSB \GNER PRINT DIAGNOSTIC JMP SETIN GET NEXT INT RECORD * LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR FILLM CMA,INA ADA \NABP ADJUST FOR BP LOCATION ADDR ADA MEM12 ADD CURRENT BP ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION * SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES LDA ERR29 SET CODE = INVALID INT CHNL ORDR JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I MARK ENTRY AS FREE JMP SETIN GET NEXT INTERRUPT RECORD * PFINT LDA \TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' * LDA \ADBP ADA P4 ADJUST LDB \TBUF+1 STORE INTO STB A,I TRAP CELL FOUR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 106004 TRAP CELL DEFAULT VALUE * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED FILLJ CLA SET INTERRUPT TABLE ENTRY = ZERO LDB \PREL GET ADDRESS JSB \ABDO OUTPUT ZERO TO INTERRUPT TABLE ISZ \PREL INCR CURRENT INT TABLE ADDRESS LDA MEM12 GO BUILD A FIXUP TO ADA \NABP JSB INTFX $CIC FOR THIS INT LOCATION JSB SFIX GET þúA NEW ENTRY ISZ MEM12 INCR CURRENT INT LOCATION ADDR ISZ CURIL STEP THE INT IMAGE ADDRESS ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLJ CONTINUE INT FILL-IN * STINT LDB \TBUF+1 IF THIS IS A "JSB $CIC,I" CPB JSCIC (IE, LST INDEX) JMP FXINT THEN GO BUILD A FIXUP STB MEM12,I ELSE PUT INT LOCATION CODE IN INT LOC STIN1 ISZ MEM12 INCR CURRENT BP LOCATION ADDR * LDA \TBUF GET INT TABLE CODE STA CURIL,I SET WORD IN INT IMAGE ISZ CURIL STEP IMAGE ADDRESS FOR NEXT TIME LDB \PREL GET CORE ADDRESS JSB \ABDO OUTPUT INT TABLE ENTRY ISZ \PREL INCR CURRENT RELOCATION ADDR ISZ ENDFL DONE WITH THE TABLE? JMP SETIN NO, GET NEXT LOCATION JMP ITAI YES, EXIT * FXINT LDA INTCH GO CHANNEL #(INT LOC.) JSB INTFX GO BUILD A JSB $CIC,I FIXUP FOR IT JSB SFIX AND GET A FREE ENTRY JMP STIN1 CONTINUE * ABERR LDA ERR34 SET CODE = INVALID ABS DIGIT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * ENDIO LDA M77 WERE ALL LOCATIONS CPA INTCH DEFINED? JMP ITAI YES,NEEDN'T FILL IN STA INTCH NO, MUST SiMULATE A CLB DEFINITION OF 77B STB \TBUF IN ORDER TO FILL IN ALL LDB JSCIC INTERRUPT LOCATIONS STB \TBUF+1 AND THE TABLE CCB SET FLAG STB ENDFL TO EXIT FROM FILLJ TO ITAI JMP FILLM GO SET LOOP COUNT * ITAI JSB \SPAC LDA P20 LDB MES30 JSB SETHD PRINT: TABLE AREA I MODULES JMP \IOTB,I AND INITIALIZE IDX * ENDFL NOP END OF TABLE FLAG = -1 ON LAST PASS P20 DEC 20 SPC 3 * BUILD A FIXUP ENTRY FOR A JSB $CIC,I * AT THE LOCATION IN A-REG * INTFX NOP STA \FIX1,I SAVE THE INSTRUCTION ADDRESS LDB IJSB GET THE INSTRUCTION ADB HIBP MERG˜ þúE IN THE HIGH BP LINK FLAG STB \FIX2,I AND SAVE LDB JSCIC GET LST INDEX OF STB \FIX4,I $CIC, AND SAVE CLB STB \FIX3,I CLEAR OFFSET JMP INTFX,I SKP * IOADD BSS 1 I/O ADDR (CHANNEL NO.) IN EQT IOSDM BSS 1 I/O SDA/MAPPING FLAG IN EQT IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT IOTYP BSS 1 I/O DRIVER TYPE IN EQT (OCTAL) DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT TFLAG BSS 1 TIME-OUT ENTRY FLAG FOR EQT SFLAG BSS 1 SDA ENTRY FLAG FOR EQT MFLAG BSS 1 MAPPING FLAG FOR EQT XLNTH BSS 1 EQT EXTENSION SIZE FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. JSCIC BSS 1 JSB CIC,I CODE FOR INTERRUPT LOC I.XX BSS 1 DRIVER ENTRY POINT C.XX BSS 1 DRIVER EXIT POINT SPC 3 MS28 ASC 6, = EQT #? MS29 ASC 8,INTERRUPT TABLE ENT DEF *+1 X. ASC 1,I. .YY NOP ASC 1, SPC 1 MES25 DEF *+1 ASC 11,EQUIPMENT TABLE ENTRY SPC 1 MES26 DEF *+1 ASC 11,DEVICE REFERENCE TABLE SPC 1 MES30 DEF *+1 ASC 10,TABLE AREA I MODULES MES31 DEF *+1 ASC 11,TABLE AREA II MODULES SPC 2 ERR21 ASC 1,21 $CIC NOT FOUND IN LST ERR23 ASC 1,23 DRIVER S,M SPEC'S DON'T CONFORM ERR24 ASC 1,24 INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,25 INVALID DRIVER NAME ERR26 ASC 1,26 INVALID D,B, OR T OPERAND ERR27 ASC 1,27 INVALID DEVICE REF. NO. ERR28 ASC 1,28 INVALID INT REC CHANNEL NO. ERR29 ASC 1,29 INVALID INT CHANNEL NO. ORDER ERR30 ASC 1,30 INVALID INT REC MNEMONIC ERR31 ASC 1,31 INVALID EQT NO. IN INT RECORD ERR32 ASC 1,32 INVALID PROGRAM NAME IN INT REC ERR33 ASC 1,33 INVALID ENTRY POINT IN INT RECORD ERR34 ASC 1,34 INVALID ABS VALUE IN INT REC ERR35 ASC 1,35 MORE THAN 63 EQT OR DRT ENTRIES ERR36 ASC 1,36 INVALID FINAL OPER+¬þúAND IN INT REC ERR58 ASC 1,58 MAX # PARTITIONS IS ,=0, >64 ERR60 ASC 1,60 TOTAL # ID SEGMENTS > 255 "/E" ASC 1,/E IJSB JSB 0 JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR "D" OCT 104 ASCII CHAR D "B" OCT 102 ASCII CHAR B "T" OCT 124 ASCII CHAR T "S" OCT 123 ASCII CHAR S "M" OCT 115 ASCII CHAR M BIT14 OCT 40000 BIT 14=1 $CIC ASC 3,$CIC "EQ" ASC 1,EQ "PR" ASC 1,PR "EN" ASC 1,EN "AB" ASC 1,AB UTCHR ASC 1,T UGCHR ASC 1,G USCHR ASC 1,S MES28 DEF MS28 MES29 DEF MS29 SPC 2 ZERO DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P11 DEC 11 P12 DEC 12 P13 DEC 13 P15 DEC 15 P24 DEC 24 P25 DEC 25 P28 DEC 28 P29 DEC 29 P32 DEC 32 P63 DEC 63 P64 DEC 64 N2 DEC -2 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 N65 DEC -65 LM100 OCT -100 M37 OCT 37 M77 OCT 77 M377 OCT 377 M177 OCT 177 M7000 OCT 177000 M7400 OCT 177400 SMBIT OCT 60000 MSIGN OCT 100000 BLANK OCT 40 BLNKS OCT 20040 HYADD DEF *+1 ASC 1,- UBLNK OCT 20000 TEMP3 NOP SKP * * GENERATE THE CLASS I/O TABLE ($CLAS) * \TBLS NOP JSB \SPAC JSB \SPAC LDA P13 LDB MES31 JSB \MESS PRINT: TABLE AREA II JSB \SPAC JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 18 CHARACTERS DEF MES04 '# OF I/O CLASSES?' DEF $CLS ADDRESS OF ENT NAME ADB \OCTN RESERVE ROOM STB \PREL FOR IT (SETS IT TO ZERO) * * GENERATE THE LU MAP TABLE ($LUSW) * JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 DEF MES05 '# OF LU MAPPINGS?' DEF $LUMP ADDRESS OF ASC ENT NAME LDA \OCTN INITILIZE THE TABLE CMA,INA TO STA \TBUF -1'S NXLUM CCA AND JSB \ABDO THEN ISZ qþú\TBUF JMP NXLUM RESET * STB \PREL THE RELOCATION ADDRESS * * GENERATE THE RN TABLE ($RNTB) * JSB RED2 SEND MESSAGE AND GET P22 DEC 22 ANSWER DEF MES06 '# OF RESOURCE NUMBERS?' DEF $RNTB ADDRESS OF ENT POINT NAME ADB \OCTN RESERVE THE TABLE AREA STB \PREL (SETS IT TO ZERO) * * SET UP THE BUFFER LIMITS ($BLLO,$BLUP) * BLGEN LDA D26 SEND MESSAGE 'BUFFER LIMITS (LOW,HIGH)?' LDB DMES7 AND GET ANSWER JSB \READ JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLGEN IF ERROR TRY AGAIN STA BLLO SAVE THE NEGATIVE VALUE * JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLGEN IF ERROR TRY AGAIN STA BLHI SAVE THE NEGATIVE VALUE * * GENERATE THE LU AVAILABILITY TABLE ($LUAV) * LDB $LUAV MAKE THE LUAV TABEL JSB \LSTS FIRST SET UP THE ENTRY JSB \ABOR IT BETTER BE THERE LDB \PREL GET THE CORE ADDRESS STB \LST5,I SET THE ADDRESS LDA SPLCO GET THE NUMBER OF ENTRYS CMA,INA,SZA IF ZERO SKIP THE TABLE GEN. JSB \ABDO SEND THE TABEL HEAD (IF NONE ZERO) ADB SPLCO ADJUST FOR THE TABLE SIZE ADB SPLCO (TWO WORD ENTRYS) STB \PREL SET THE NEW ADDRESS JSB DAFIX GO FIX UP ANY REFERENCES JSB \SPAC * LDA TBREL UPDATE ANY LINKS USED BY FIXUPS STA PBREL TO $CLAS,$LUSW,$RNTB,$BLLO,$BLUP,$LUAV * * CHECK IF MAX # OF LONG ID SEGMENTS ALREADY EXCEEDED * LDA LICNT IF MORE THAN 255 MAIN PROGRAMS TO BE ADA SICNT RELOCATED DURING GENERATION ADA N255 THEN WE'RE GONNA ABORT SSA AND LET THEM DECIDE JMP BLONG WHICH ONES TO DELETE LDA ERR60 JSB \IRER SEND DIAGNOSTIC & ABORT * * GET THE # OF BLANK ID SEGMENTS AND EXTENSIONS. * * LONG * BLONG LD­´NLHA P24 LDB MES42 PRINT: # OF BLANK ID SEGMENTS? JSB GETBL RETRIEVE ANSWER SZA,RSS IF ZERO, ADD 1 INA FOR BG ONLINE LOADING ADA LICNT ADD TO LONG ID SEGMENT COUNT LDB A SAVE ADA SICNT ADD CURRENT MRES. ID SEG COUNT ADA N255 IF > 254 MAXIMUM SSA THEN ERROR JMP BLON1 OK * LDA ERR60 SET ERROR CODE JSB \GNER DIAGNOSTIC JMP BLONG TRY AGAIN * N255 DEC -255 * * BLON1 STB LICNT SAVE LONG ID SEGMENT COUNT * * SHORT: * JSB \SPAC BSHOR LDA P29 LDB MES43 PRINT: # OF BLANK SHORT ID SEGMENTS? JSB GETBL RETRIEVE ANSWER ADA SSCNT ADD TO SEG ID SEGMENT COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUN SZA,RSS THEN ERROR JMP BSHO1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BSHOR TRY AGAIN * BSHO1 STB SSCNT SAVE SEG ID SEGMENT COUNT ADB LICNT ADD LONG ID SEGMENT COUNT žˆNÿÿþú ADB SICNT ADD SHORT ID SEGMENT COUNT INB ADD ONE FOR STOP WORD STB KEYCN AND SAVE KEYWORD COUNT * * EXTENSIONS: * JSB \SPAC BLEXT LDA P25 LDB MES44 PRINT: # OF BLANK ID EXTENSIONS? JSB GETBL RETRIEVE ANSWER SZA,RSS IF NO BLANKS INA THE SET TO 1 EXTRA ANYWAY ADA IXCNT ADD TO CURRENT ID EXTENSION COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUM SZA,RSS THEN ERROR JMP BEXT1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BLEXT * BEXT1 LDA B MAKE SURE THAT THE # OF CMA,INA EXTENSIONS IS LESS THAN ADA LICNT THE NUMBER OF LONG SSA,RSS ID SEGMENTS JMP BEXT2 JSB \INER ELSE ASK AGAIN JMP BLEXT * BEXT2 INB ADD ONE FOR STOP WORD STB IXCNT AND SAVE COUNT * * GET MAXIMUM # OF PARTITIONS TO BE DEFINED * JSB \SPAC GMNP LDA P24 LDB MES45 PRINT: MAXIMUM # OF PARTITIONS? JSB \READ SEND MESSAGE & GET ANSWER LDA N5 CHECK FOR 2 DECIMAL DIGITS JSB \GET# IN RESPONSE RSS ERROR JMP GMNP2 * GMNP1 JSB \INER SEND ERROR DIAGNOSTIC JMP GMNP TRY AGAIN * GMNP2 LDB N65 IF MORE THEN ADB A 64, THEN SSB,RSS JMP GMNP1 ERROR * STA MAXPT SAVE MAX # OF PARTITIONS * * RESERVE SPACE AND INITIALIZE ID EXTENSIONS * LDA \PREL GET CURRENT RELOC ADDR STA IDEX SET ADDRESS OF $IDEX TABLE ADA IXCNT ADD # OF EXTENSIONS (INCL STOP WORD) STA \PREL UPDATE CURRENT RELOC ADDR TO IDEX LIST CCB INITIALIZE ADB IXCNT LOOP COUNTER SZB,RSS SKIP IF > 0 EXTENSIONS JMP NOIDX GO SET STOP WORD ONLY * CMB,INB INITIALIZE EACH EXTENSION STB TEMP2 TO THE ENTRY ADDREV§þúSS LDB IDEX GET FIRST TABLE ADDRESS * SETX STA TEMP3 SAVE ADDRESS JSB \ABDO SET POINTER FROM TABLE TO LIST LDA TEMP3 RETRIEVE ADDRESS ADA P3 BUMP TO NEXT LIST ENTRY ISZ TEMP2 END OF LIST? JMP SETX NO CCB POSITION TO LAST WORD ADB A OF EXTENSION LIST RSS * NOIDX LDB IDEX GET STOP WORD CLA SET TO 0 STA IDEXC THE # OF EXTENSIONS USED JSB \ABDO ZERO-FILL THE ENTIRE LIST STB \PREL UPDATE RELOC ADDRESS * * SET UP THE KEYWORD AREA * STB KEYAD SET CURRENT KEYWORD ADDRESS STB CURAK SET FOR ID SEG GENERATION, TOO ADB KEYCN ADD TOTAL KEYWORD COUNT STB \PREL SET NEW RELOC ADDR FOR ID SEG STB SYSAD SET INITIAL ID SEGMENT ADDRESS STB IDSAD SET ADDRRESS OF FIRST ID SEG STB CURAI SET ADDRESS FOR OUTID LDA KEYAD COMPUTE THE KEYWORD ADDRESS ADA LICNT FOR SHORT ADA SICNT BACKGROUND SEGMENT ID SEGMENTS STA \SKYA AND SET IT STA \ASKY AND ALSO FOR BLANK GENERATION LDB IDSAD GET DISK ADDR OF FIRST ID SEGMENT CLA BY SENDING FIRST WORD JSB \ABDO TO THE DISK * * SET UP ID SEGMENT AREA * CCA BACK UP TO ID SEGMENT START ADA B AND MASK TO POSITION IN AND M77 SECTOR (MOD 640)F, THEN SAVE STA IDSP FOR BASE PAGE LATER LDA \ADSK GET CURRENT DISK ADDRESS STA DSKID SET DISK ID ADDRESS STA DSKSY SET INITIAL ID SEGMENT DISK ADDR * * SAVE SPACE FOR ID SEGMENTS * LDA P29 LENGTH OF SHORT ID SEGMENTS MPY SICNT TIMES # DESIRED (NEEDED+BLANKS) STA \OCTN SAVE COUNT LDA LICNT GET LONG ID SEGMENT COUNT MPY P33 TIME # DESIRED ADA \OCTN ADD THE SHORT COUNT ADA \PREL ADD THE BASE ADDRESS ñûþú STA \OCTN SAVE THE ADDRESS ADA N11 COMPUTE THE KEY ADDRESS FOR FIRST STA \SSID BG SEG ID SEGMENT & SAVE LDA SSCNT RESERVE ROOM FOR MPY P9 THE BG SEG ID SEGMENTS ADA \OCTN COMPUTE NEW MEMORY ADDRESS * * RESERVE SPACE FOR MEMORY ALLOCATION TABLE, * MEMORY RESIDENT PROGRAM MAP, AND MEMORY * PROTECT FENCE TABLE. * STA MAT. SAVE STARTING ADDRESS OF MAT STA \OCTN SAVE LDA MAXPT MULTIPLY # PARTITIONS MPY P7 BY # WORDS/ENTRY ADA \OCTN GET NEXT AVAILABLE MEMORY ADDR STA MAP. SAVE AS ADDR OF MRMP ADA P32 ADD LENGTH OF MAP STA MPFT. THEN SAVE START OF MPFT ADA P6 ADVANCE PAST MPFT * * RESERVE SPACE FOR THE DISC DICTIONARY * STA ADICT SAVE ADDR OF DISC DICTIONARY ADA DSIZE ADJUST FOR DISC DICT LENGTH ADA DAUXN PLUS AUX DISC LENGTH * STA \PREL SAVE NEW RELOCATION ADDRESS CCB RESERVE ALL THE SPACE SO FAR ADB A BY SENDING THE LAST WORD CLA THE ENTIRE SPACE WILL JSB \ABDO BE ZERO-FILLED * JSB \SPAC LDA P22 PRINT: TABLE AREA II MODULES LDB MES31 FOR NEXT STEP JSB SETHD AND INITIALIZE FOR SCANS JMP \TBLS,I RETURN * P33 DEC 33 SKP * * SETHD PRINTS THE HEADING AND INITIALIZES FOR IDENT * TABLE SCANNING. IT ALSO SET THE NO-PROGRAMS-LOADED- * YET FLAG. * SETHD NOP DST \TBUF SAVE THE MESSAGE SPECS JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT THE HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT FOR ORIGIN OF SCAN JMP SETHD,I RETURN SKP * THE BLSET ROUTINE SETS UP THE BUFFER LIMITS. * * CALLING ÓþúSEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL EXIT * BLSET NOP FIRST FIND LDB BLSET,I THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB \LSTS SEARCH FOR THE ENTRY JMP \ABOR IF NOT FOUND JUST EXIT * LDA N5 CONVERT A 5 DIGIT DECIMAL JSB \GET# LIMIT JMP BLERR ERROR TAKE ERROR EXIT * CMA,INA SET THE LIMIT NEGATIVE AND ISZ BLSET STEP TO OK RETURN JMP BLSET,I AND RETURN * BLERR JSB \INER SET ERROR 01 JMP BLSET,I AND TAKE ERROR RETURN SKP * * THE RED2 SUBROUTINE IS USED TO SET UP TABLES * WHICH START WITH THERE SIZE AS THE FIRST WORD * * CALLING SEQUENCE: * * JSB RED2 * DEC XX CHARACTER COUNT OF QUESTION. * DEF MESXX ADDRESS OF ASCII MESSAGE * DEF ENT ADDRESS OF ASCII ENTRY POINT NAME * RETURN B=NEXT AVAILABLE CORE LOCATION * REERR JSB \INER SEND ERROR 01 AND RSS RETRY * RED2 NOP ENTRY POINT RERED DLD RED2,I GET THE MESSAGE PRAMETERS JSB \READ GO SEND MESSAGE AND GET RESPONCE LDA N3 CONVERT 3 ASCII DIGITS JSB \DCON AS DECIMAL JMP RERED IF ERROR RETRY * AND M7400 IF NOT LESS THAN SZA 256 JMP REERR THEN ERROR * LDA \OCTN GET THE ANSWER AGAIN SZA,RSS IF ZERO INA SET TO ONE STA \OCTN AND RESET ISZ RED2 STEP ISZ RED2 TO THE SYMBOL ADDRESS LDB RED2,I FIND JSB \LSTS THE SYMBOL IN THE \LST JSB \ABOR MUST BE THERE LDB \PREL DEFINE THE SYMBOL STB \LST5,I LDA \OCTN OUTPUT THE FIRST JSB \ABDO WORD STB \PREL UPDATE THE ADDRESS JSB DAFIX \FIX UP ALL REFERENCES JSB \SPAC MAKE IT LOOK NICE.g¶þú LDB \PREL SET B FOR RETURN ISZ RED2 SET RETURN ADDRESS JMP RED2,I RETURN * SPC 2 MES04 ASC 9,# OF I/O CLASSES? MES05 ASC 9,# OF LU MAPPINGS? MES06 ASC 11,# OF RESOURCE NUMBERS? DMES7 DEF MES07 MES07 ASC 13,BUFFER LIMITS (LOW, HIGH)? $CLS ASC 3,$CLAS $RNTB ASC 3,$RNTB $LUMP ASC 3,$LUSW $BLLO ASC 3,$BLLO $BLHI ASC 3,$BLUP $LUAV DEF *+1 ASC 3,$LUAV SKP * * GETBL ASKS FOR THE # OF BLANK LONG ID SEGMENTS, SHORT * ID SEGMENTS, OR ID EXTENSIONS. AFTER RETRIEVING THE * RESPONSE, GETBL CHECKS THAT THE REPSONSE IS < 256. IF * NOT, AN ERROR DIAGNOSTIC IS GIVEN AND THE PROMPT IS RE- * ISSUED. * * ON ENTRY: A-REG = MESSAGE LENTGH * B-REG = MESSAGE ADDRESS * ON EXIT: A-REG = # OF BLANKS SPECIFIED * GETBL NOP STB TEMP1 SAVE MESSAGE ADDR STA TEMP2 AND LENGTH * GETB1 JSB \READ SEND MESSAGE & GET ANSWER LDA N3 CHECK FOR 3 DECIMAL JSB \GET# DIGITS IN REPSONSE JMP GETB2 INVALID REPLY AND M7400 CHECK FOR > 255 SZA MAXIMUM JMP MAXER * LDA \OCTN RETRIEVE CONVERTED ANSWER JMP GETBL,I AND RETURN * GETB2 JSB \INER SEND ERROR 01 JMP GETB3 RESET MESSAGE SPECS * MAXER LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC GETB3 LDB TEMP1 GET MESSAGE ADDR LDA TEMP2 AND LENGTH JMP GETB1 RE-PROMPT * * MES42 DEF *+1 ASC 12,# OF BLANK ID SEGMENTS? MES43 DEF *+1 ASC 15,# OF BLANK SHORT ID SEGMENTS? MES44 DEF *+1 ASC 13,# OF BLANK ID EXTENSIONS? MES45 DEF *+1 ASC 12,MAXIMUM # OF PARTITIONS? SKP * DFIX DOES THE FIXUP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRIES. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY AFTER THE * SYMBOL (IF ANY) IS DEFINED. * * CALLIÖpþúNG SEQUENCE: * * SET UP \FIX1-4 AND \LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANING LESS * DFIX NOP CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 IF UNDEFINED, THEN ITS JMP ZFIX A NOP REPLACEMENT * EMA'S?? * VFIX LDB \FIX2,I GET THE INSTR, WITH OPTIONAL BYTE, CBX HIBP, AND DBL TYPE BITS BLF,RBL IF BYTE BIT SET SSB THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2,I AGAIN AND M7 EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA AGAIN AND M1000 NOW EXTRACT THE HIBP BIT STA LINKB AND SAVE CXA AGAIN AND M1740 LEAVE ONLY THE INSTRUCTION STA \FIX2,I IN THE FIXUP ENTRY LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LIST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA??? * LFIX SZB,RSS CHECK FOR AN EXT WITH OFFSET JMP WFIX NOT AN EXT LDB DBLT GET DBL RECORD TYPE CPB P5 EXT REF WITH OFFSET? JMP CPFIX YES, GO SEE IF A DEF * WFIX LDA \FIX2,I GET THE INSTRUCTION CLE,ELA MOVE I”ÁþúNDIRECT BIT TO E-REG SZB IF EXT REFERENCE JMP IDEF THEN MUST USE A BP LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSIGN RESTORE THE SIGN BIT STA OPRND IN THE OPERAND (FOR THE LINK ADDR) SZB IF EXTERNAL REFERENCE STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR \FIX2,I INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO OUTPUT THE WORD AFIX CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB \FIX2,I IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXTERNAL REFERENCES WITH OFFSET - NOT A DEF * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND, THEN JMP XFIX MAKE IT DIRECT CLB,INB RESET B(WE KNOW IT'S AN EXT) JMP WFIX USE BP LINK * OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M7 EQU P7 M1000 OCT 1000 M1740 OCT 174000 SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JS.èþúB \IFIX INITILIZE THE \FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW ENTRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED WHEN A DRIVER * IN A DP>=2 RESOLVES AN FIXUP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DRIVER PARTITION? RSS JMP NOCHG NO LDA DPNUM YES, (DP# MUST BE >= 2) SZA,RSS JMP NOCHG NO, MUST BE DP #1,TA,SDA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN FIRST CMA,INA WORD OF DP ADA \FIX1,I IE, < DPADD SSA JMP CHNGM ITS LESS * NOCHG JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM * FOR DOING THE FIXUP * CHNGM JSB \SYS REBUILD THE SYSTEM MAP JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT SKP “þú* * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NONE LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NONE FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 JSB ALLOC NONE ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THÑßþúE IMAGE ADDRESS TO B SCN1 LDA \LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE THE CURRENT PROGRAM'S * ALLOCATED AREA, A DIAGNOSTIC IS PRINTED. * * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I HAD BEEN SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE LINK * MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS OCCURS WHEN * THE SYSTEM IS RESOLVING EXTERNAL REFERENCES FROM TABLE AREA I & II, * SSGA, AND SDA WHERE THE LINKS MUST BE PRESENT IN ALL MAPS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBP CURRENT BP ALLOCATaòþúION MODE, THEN JMP NORML ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM THE TABLE AREAS, * DRIVERS, OR SSGA - SO USE LINK IN UPPER BP AREA. * LDA LOLNK HAS LAST SYSTEM LINK ALREADY BEEN CPA TBREL USED? JMP ER16 YES, ERROR ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP, AND UPDATE LAST UPPER BP LINK USED STA BPLMT AND UPPER LIMIT FOR LOWER BP LINK'S LDB A GET IMAGE ADDRESS ADB \ADBP JMP ALLO1 AND GO SET IT UP * NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, AND 100 FOR SYS). BPINC * SET TO -1 WHEN LOADING THE TABLE AREAS, SSGA, AND ALL * DRIVERS, AND TO +1 OTHERWISE. BPLMT SET BELOW LOWEST * TABLE AREA/SSGA/SDA LINK FOR SYS, TO HIGHEST SYSTEM * LINK FOR PRD DRIVERS, AND TO LOWEST DRIVER LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FORM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * CLEAR BUFFER WITH OCTAL ZEROES * * THE BUFCL SUBROUTINE CLEARS A 64-WORD BUFFER WITH ZEROES. * * CALLING S—\HFBEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDA N64 STA WDCNT SET BUFFER LENGTH = 64 CLA STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP BUFCL,I RETURN SPC 5 * M0760 OCT 76000 M1177 OCT 101777 M2000 OCT 2000 N1 DEC -1 N64 DEC -64 ERR16 ASC 1,16 BP LINKAGE AREA FULL. * DDVMP DEF *+1 DUMMY DRIVER MAP TABLE BSS 64 * END GIO /:HÿÿþúASMB,R,L,C HED RT4G6 - PARTITION DEFINITION SEGMENT. NAM RT4G6,5,90 92067-16009 REV.1926 790427 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME RT4G6 * SOURCE PART # 92067-18009 * REL PART # 92067-16009 * WRITTEN BY: KFH,RB * ****************************************************************** * * * ENTRY POINT NAMES: * ENT \PDEF * * EXTERNAL REFERENCE NAMES: * EXT \LST1,\LST2,\LST3,\LST4,\LST5,\LSTX,\LSTS,\ILST EXT \ID1,\ID2,\ID3,\ID5,\ID6,\ID8 EXT \TIDN,\INID,\IDX,\IDXS EXT \TBUF,\LBUF EXT \ADSK,\DSKO,\DSKA EXT \CURL,\RNAM,\RBIN * EXT \SRET,\INER,\GETC EXT \MESS,\GNER,\GETN,\GET#,\GINT EXT \READ,\SPAC,\ABDO,\PTYP EXT \CONV,\OCTN EXT \SYS,\USRS,\ABCO,\MXAB EXT \MRT2,\TERM,\YENO EXT \NUMP EXT \ABOR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780112 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * **********************************************Cþú***************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LO9“þúNG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL P þúADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 FIRST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1{!þú=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * * * END OF COMMON STORAGE8Kþú BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP BLNKS ASC 1, BLANK OCT 40 M1777 OCT 1777 M7400 OCT 177400 M7700 OCT 177700 N1 DEC -1 N2 DEC -2 N32 DEC -32 N4 DEC -4 N5 DEC -5 P7 DEC 7 P10 DEC 10 P14 DEC 14 P18 DEC 18 P2 DEC 2 P20 DEC 20 P21 DEC 21 P22 DEC 22 P24 DEC 24 P26 DEC 26 P30 DEC 30 P3 DEC 3 P31 DEC 31 P4 DEC 4 P32 DEC 32 P33 DEC 33 P5 DEC 5 P6 DEC 6 M37 EQU P31 M7 EQU P7 TEMP3 NOP TEMP4 NOP * MES22 DEF *+1 ASC 3,(NONE) SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * PART LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * * N DEC -2 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 SKP * * * LIST PARTITION REQUIREMENTS FOR RT AND * BG (INCLUDING PR) DISC RESIDENTS * \PDEF NOP LDA P2 SET IDSCN TYPE TO STA \PTYP REAL TIME DISC RESIDENTS LDA "RT" STUFF 'RT' IN STA MSQ1 MESSAGE. * PQLP1 JSB \SPAC LDB MSQ1. SENT EITHER RT OR BG LDA P20 PARTITION REQMT JSB \MESS MESSAGE. * CLA SET FLAG FOR NO PROGRAMS STA PQFLG OF TYPE FOUND. PQLP0 LDA P10 REINIT IDENT PTRS STA \TIDN FOR SCAN PQLP2 JSB \IDX FIND PROG MATCHING \PTYP JMP PQDON (NO MORE) LDA \ID6,I GET THE TYPE ELA,RAR SAVE EMA BIT AND M7 ISOLATE IT CPA \PTYP WHAT WE ${þúWANTED? RSS YES! JMP PQLP2 NO TRY ANOTHER ISZ PQFLG INCR FLAG - AT LEAST ONE PROG SEZ IF ITS AN EMA PROGRAM JMP DEMA THEN GO DETERMINE ITS PG REQMTS * LDA \ID8,I PICK UP PAGE REQMT RRR 8 AND ISOLATE AND M37 IT. PQLP3 CMA GET -(PAGES +1) LDB MSQ2X AND STUFF JSB \CONV DECIMAL EQUIV IN MSG * LDA BLNKS PUT BLANKS STA MSQ2 LDA \ID1,I THEN PROGRAM NAME STA MSQ2+1 LDA \ID2,I IN MESSAGE... STA MSQ2+2 LDA \ID3,I AND M7400 IOR P32 STA MSQ2+3 * * SET OPTIONAL EMA OR LARGE BG INDICATORS * LDA BLNKS GET BLANKS IN CASE NEITHER OPTION LDB \ID6,I EMA BIT SET? SSB ADA "E" MERGE IN AN E LDB \PTYP PRIVILEGED PROGRAM? CPB P4 ADA AST MERGE IN A * STA MSQ2+9 STORE WORD IN MESSAGE * LDA P20 LDB MSQ2. JSB \MESS SEND THE MESSAGE JMP PQLP2 THEN LOOK FOR MORE PROGS * DEMA JSB PAGES GET THE PAGE REQMTS OF AN JMP PQLP3 EMA PROGRAM * PQDON LDA P3 GET THE PRIVILEGED TYPE LDB \PTYP AND THE CURRENT TYPE CPB P4 IF BG'S WERE JUST DISPLAYED JMP PQEND THEN EXIT FROM LOOP CPB A IF PR'S WERE JUST DONE LDA P4 THEN SET TO DO BG'S STA \PTYP SET TYPE TO SCAN CPB P3 RT -> PR JMP PQLP0 NO, PR -> BG * LDA "BG" STUFF 'BG' INTO STA MSQ1 INTO THE HEADER JSB NONE SEE IF AN RT'S DISPLAYED JMP PQLP1 SEND THE NEW HEADING * * * PRINT 'NONE' IF NO PROGRAMS OF THE CURRENT PARTITION * TYPE WERE DISPLAYED * NONE NOP LDA PQFLG ANY PROGRAMS FOUND? SZA IF AT LEAST ONE JMP NONE,I LDA P6 ELSE PRINT LDB MES22 "(NONE)". /¬þú JSB \MESS JMP NONE,I SKP * PQFLG BSS 1 * MSQ1. DEF *+1 MSQ1 ASC 10,XX PARTITION REQMTS: * MSQ2. DEF *+1 MSQ2 ASC 10, NNNNN XX PAGES MSQ2X DEF MSQ2+2 * MSQ3. DEF *+1 ASC 11,MAXIMUM PROGRAM SIZE:  * MSQ4. DEF *+1 MSQ4 ASC 4,W/ COM * "O" ASC 1,O AST OCT 05000 "E" OCT 45 PR. DEF *+1 ASC 4,W/ TA2 "?" ASC 1,? * MS62A DEF *+1 MES62 ASC 4, CHANGE MES61 ASC 9,1ST PART PG MS61A DEF MES61+6 MS61B DEF MES61 SKP * * PQADD PRINTS THE MAXIMUM PROGRAM ADDRESS SPACE FOR PROGRAMS * WITH AND WITHOUT COMMON, AND FOR PRIVILEGED PROGRAMS. * * ON ENTRY: A-REG = PAGE # PRECEDING THE PROGRAM AREA * B-REG = ASCII WORD TO STUFF INTO MESSAGE (EG, "O") * PQADD NOP *PRINT LARGEST PART MESSAGE* STB MSQ4+1 MAKE MESSAGE W/COM OR LDB MSQ2X W/O COM, THEN PUT SIZE ADA N32 JSB \CONV IN MESSAGE LDA MSQ4. LDB MSQ2. STUFF IN MSG MVW P4 HEAD,OVERLAYING HIGH-ORDER LDB MSQ2. ZEROS OF PAGE SIZE LDA P18 JSB \MESS PRINT MESSAGE JMP PQADD,I SPC 3 * * CONVERT THE ADDRESS IN THE A-REG TO A LOGICAL PAGE NUMBER * CPAG# NOP ALF,RAL ROTATE THE PAGE BITS RAL TO THE LOW BYTE AND M37 AND GET MASK THEM JMP CPAG#,I SPC 3 * * PRINT THE CURRENT SIZE OF SAM, GIVEN IN THE A-REG. * SAMSZ NOP LDB LWTAI GET LAST WORD ADDRESS OF TABLE AREA I INB AND SET STARTING ADDRESS OF SAM#0 CMB,INB DETERMINE SIZE BY SUBTRACTING ADB DPADD FROM START OF DRIVER PARTITION ADA B GET TOTAL SAM SIZE CMA,INA LDB MXSM PASS BUFFER ADDRESS JSB \CONV AND GET DECIMAL ASCII WORDS JSB \SPAC * LDB MSSM. PRINT THE MESSAGE LDA P24 JSB \MESS JMP SAMSZ,I * MSSM. DEF *+1 ASÕþúC 12,SYS AV MEM: XXXXX WORDS MXSM DEF MSSM.+7 HYADD DEF *+1 ASC 1,- SKP * * * LIST MAXIMUM PROGRAM SIZES * PQEND JSB NONE SEE IF ANY BG REQ'S WERE DISPLAYED JSB \SPAC LDA P22 LDB MSQ3. PRINT HEADER JSB \MESS LDB "O" PASS AN O (FOR W/O) CCA ADA FPCOM AND FIRST COMMON PAGE JSB PQADD AND PRINT MSG (MAX W/O COM) LDA FWSDA AND GET LAST COMMON PAGE JSB CPAG# ADA N1 LDB BLNKS PASS BLANKS IN B. JSB PQADD AND PRINT (MAX W/ COM) * LDB PR. TRICK PQADD TO STORE STB MSQ4. 'W/ TA2' IN MESSAGE CCA ADA FWPRV CALCULATE LAST PAGE JSB CPAG# CONTAINING TABLE AREA II JSB PQADD AND PRINT MAX PRIV PROG SPACE JSB \SPAC * * * COMPUTE SIZE OF SAM #1 * LDA LWSYS SET THE FIRST PAGE INA JSB CPAG# OCCUPIED BY SAM#1 STA FPSAM LDB LWSYS DETERMINE THE SIZE OF CMB,INB THE FIRST CHUNK OF SAM LDA LWSLB GET LAST WORD & ROUND IOR M1777 TO A PAGE BOUNDARY ADB A STB SAM#1 AND SAVE * LDA LPSLB COMPUTE THE MAXIMUM LOGICAL CMA,INA PAGE SIZE ALLOWABLE FOR ADA P31 SAM #2 SZA JMP SET2 GO SET THE UPPER LIMIT ADB N2 NO SAM #2: MUST DECREMENT SIZE OF STB SAM#1 SAM #1 SO LAST WORD IS 77776 * SET2 ADA PAGE# ADD TO NEXT PHYSICAL STA SAM2P PAGE AVAILABLE, AND SET AS UPPER LIMIT * LDB \NUMP IF MORE LOGICAL PAGES AVAILABLE CMA,INA THAN PHYSICAL PAGE STILL AVAILABLE ADA B THEN SET SAM #2 LIMIT TO LAST SSA STB SAM2P PHYSICAL PAGE * LDA SAM#1 DISPLAY THE SIZE OF THE JSB SAMSZ FIRST CHUNK * LDA PAGE# GET THE NEXT AVAILABLE CMA,INA DISPLAY DECIMAL LDB MS61A PHYSICAL PAGE É1þú# AND JSB \CONV CONVERT IT TO ASCII (DEC) JSB \SPAC LDB MS61B LDA P18 NOW DISPLAY: JSB \MESS "1ST PART PG XXXX" * * * REQUEST THE SIZE OF SAM #2 * LDA "?" CONVERT THE MESSAGE FOR STA MES61+6 THE QUERY GETPP LDB MS62A NOW ASK LDA P22 "CHANGE 1ST PART PG?" JSB \READ GET THE RESPONSE, TOO * LDA N5 GET THE DECIMAL RESPONSE JSB \GET# JMP SER44 INVALID RESPONSE, REPEAT * LDA \OCTN GET PAGE # SZA,RSS CHANGE? JMP NOSM2 NO, CLEAR SAM #2 SPECS LDB PAGE# COMPARE AGAINST CURRENT CMB,INB FIRST PAGE ADB A (MUST BE >= TO IT) SSB JMP SER44 TOO SMALL * LDB SAM2P GET PRESENT UPPER LIMIT CMB,INB ADB A CMB,SSB,INB,SZB LESS THAN OR EQUAL TO IT? JMP SER44 NO, MUST TRY AGAIN * LDB PAGE# GET NEXT AVAILABLE PHYSICAL PAGE STB SAM2P AND SET AS FIRST PAGE OF SAM #2 STA PAGE# AND RESET THE FIRST PART PAGE * CMB,INB DETERMINE THE PAGE SIZE OF ADA B SAM #2 NOSM2 STA PQFLG SAVE *TEMP* ALF,RAL AND CONVERT TO THE ALF,RAL #WORDS STA SAM#2 SZA,RSS ANYTHING ALLOCATED? JMP DISPS NO * LDA LPSLB IF SAM #2 ENDS ON THE 32K ADA PQFLG BOUNDARY (77777) CPA P31 (IE, THE NEXT LOGICAL PAGE AFTER RSS IT IS 32), THEN JMP DISPS LDB N2 MUST DECREMENT THE # OF WORDS ADB SAM#2 SO LAST WORD OF SAM #2 STB SAM#2 WILL BE 77776 * * DISPLAY TOTAL SAM SIZE * DISPS LDA SAM#1 ADA SAM#2 COMBINE THE TWO CHUNKS JSB SAMSZ FOR DISPLAY * LDA FPCOM SET THE MAXIMUM ADDRESSABLE CMA,INA (LOGICALLY) PAGE SIZE FOR A ADA P32 PARTITION STA MAXPG JMP DPINT Ï+þú CONTINUE * MAXPG NOP * SER44 LDA ERR44 SEND ERROR DIAGNOSTIC JSB \GNER FOR INVALID SAM #2 REPLY JMP GETPP TRY AGAIN SKP * * DEFINE DISK RESIDENT PROGRAM PARTITIONS * * CLEAR M.A.T. FIRST. SET LINK WORDS TO -1 TO * SHOW PARTITIONS UNDEFINED. * DPINT JSB \SYS MAP SYSTEM AREA ON DISK LDA MAXPT SET LOOP COUNTER TO CMA -(NO. OF PARTS +1) STA DPTMP AND SAVE * CLA CLEAR THE MAXIMUM PARTITION SIZES STA $MCHN+1 FOR MOTHER STA $MBGP+1 FOR BG STA $MRTP+1 AND FOR RT STA NEXTP SET THE CURRENT PART #, -1 STA DPMOM CLEAR FLAG BIT STA SUBMD * LDB MAT. GET ADDRESS OF FIRST MAT ENTRY STB MATA AND SAVE JMP DPCN2 ENTER LOOP AT BOTTOM SINCE * MAXPT MAY BE XERO * DPLP3 CCA SET LINK TO JSB \ABDO MINUS 1 DPLP4 CLA THEN SET NEXT JSB \ABDO 6 WORDS TO ZERO ISZ DPTM2 JMP DPLP4 DPCN2 LDA N6 REPEAT THE ABOVE STA DPTM2 TILL MAT IS ISZ DPTMP EXHAUSTED JMP DPLP3 * * * TELL USER HOW MANY PAGES LEFT * LDA PAGE# COMPUTE # OF CMA,INA REMAINING ADA \NUMP PAGES. STA DPARE SAVE SIZE OF PARTITION AREA CMA,INA \CONV NEEDS NEG PARM LDB MXM1 POINT TO SPOT IN MSG JSB \CONV STUFF DECIMAL INTO MSG JSB \SPAC LDB MSM1. LDA P22 JSB \MESS SEND SIZE LEFT * LDA MAXPT SZA,RSS JMP DPTHD IF NO PARTS ALLOWED...DON'T ASK JSB \SPAC LDB MSM2. LDA P18 JSB \MESS PRINT "DEFINE PARTITIONS:" SKP * * * PROMPT FOR PARTITION DEFINITION AND PARSE RESPONSE * DPRD JSB \SPAC LDA NEXTP GET CURRENT PARTITION #, LESS 1 CPA MAXPT OVER LAST ALLOWED PARTITION? JMP BL|ÀþúPT YES, SKIP UNTIL A /E IS ENTERED CMA CONVERT CURRENT PARTITION # LDB ATBUF TO ASCII JSB \CONV LDA \TBUF+2 SETP# STA MESPT,I AND STORE IN MESSAGE LDA P10 LDB MES63 DISPLAY: "PART XX" AND JSB \READ READ RESPONSE LDA N2 JSB \GETN GET FIRST TWO CHARACTERS CPA "/E" AND CONTINUE UNLESS JMP DPEND A /E WAS ENTERED * LDA NEXTP GET NUMBER OF DEFINED PARTITIONS CPA MAXPT IF OVER THE LIMIT JMP DPR49 THEN WARN THEM BEFORE TRYING FOR A /E JMP GETSZ ELSE PARSE THE DEFINITION * BLPT LDA BLNKS GET TWO BLANKS JMP SETP# AND GO STORE AS THE PART # * * GET PARTITION SIZE, BETWEEN 1 AND 1024 * GETSZ JSB \GINT REINITIALIZE PARSE LDA N4 AND ASK FOR UP TO 4 JSB \GET# DECIMAL DIGITS AS THE $# OF PAGES JMP DPR45 INVALID RESPONSE ADA N1 REDUCE BY ONE FOR BP STA DPSIZ AND SAVE * SSA CHECK IF JMP DPR45 BETWEEN CMA,INA 1 AND 1024 ADA M1777 PAGES ENTERED SSA BY USER. JMP DPR45 NO * JSB DPCHK MAKE SURE JMP DPR45 JMP DPR45 WE HIT A COMMA... * * GET PARTITION TYPE, EITHER "RT", "BG", OR "S" * LDA N2 GET UP TO 2 JSB \GETN CHARCTERS CPA "S" SUBPARTITION? JMP SUBOK GO CHECK IF MODE PERMITS * CLB CLEAR BIT 15 FLAG FOR WORD 3 CPA "BG" IF BG THEN JMP CLRSB FLAG STAYS AT 0 INB ELSE INCREMENT FLAG SO BIT 15 WILL BE SET CPA "RT" IF RT JMP CLRSB THEN OK CLA ERROR - STA SUBS? CLEAR THIS FIRST JMP DPR46 THEN GO FLAG ERROR * * SUBPARTITION WAS DECLARED - CHECK FOR PROPER DEFINITION MODE * AND SUBPARTITION SIZE * SUBOK LDA SUBMD WAS SUBPARTITION MODE ENABLE? NLHD BY SZA,RSS A PREVIOUSLY INDICATED MOTHER PARTITION? JMP DPR46 NO - CAN'T HAVE A SUBPART HERE * LDA DPSIZ IF THE SIZE OF THE SUBPARTITION IS CMA GREATER THAN THAT OF THE MOTHER ADA MOMSZ PARTITION SSA JMP DPR56 THEN DON'T ALLOW THE DEFINITION * LDA DPSIZ IF THE SUM OF THE SIZES OF THIS SUBPART ADA SUBT AND THE OTHER SUBPARTS IN THIS CHAIN LDB A CMA IS GREATER THAN THE PAGE ADA MOMSZ SIZE OF THE SSA MOTHER PARTITION JMP DPR56 THEN DON'T ALLOW THIS NEWEST DEFINITION * INB OK, SO SET THE SUBPARTITIONS STB SUBT PAGE TOTAL LDB MOMTY GET THE MOTHER PARTITION TYPE, FOR THE SUBPART JMP DPTYP AND GO CONTINUE WITH DEF'N * * CLEAR SUBPARTITION MODE FLAG ON A RT, BG DECLARATION * CLRSB CLA STA SUBMD * DPTYP STB DPTY SAVE TYPE INDICATOR CCA SET RESERVED FLAG = -1 STA DPRSV IN CASE PARAMETER IS OMITTED * * CHECK SIZE FOR POSSIBLE MOTHER PARTITION * CLB,INB TURN SUBPARTITION PERMISSION FLAG OFF O¥Nÿÿþú LDA DPSIZ GET PARTITION SIZE CMA,INA IS IT GREATER THAN THE ADA MAXPG MAXIMUM ADDRESSABLE SPACE? SSA LDB SUBMD YES, GET CURRENT SUBPARTITION MODE SZB,RSS IF IN REGULAR MODE (=0) ISZ SUBS? THEN CAN TURN IT ON * JSB DPCHK CHECK DELIMITER JMP DPR46 ERROR IF NOT A COMMA OR EOR JMP PROMT GO BUILD ENTRY IF EOR, CONTINUE IF COMMA * * * GET RESERVED FLAG * CLA,INA READ ONE JSB \GETN CHARACTER CPA "R" IF AN R ISZ DPRSV THEN SET FLG AND SKIP JMP DPR47 ELSE ERROR * JSB DPCHK CHECK DELIMITER JMP DPR47 ANY BUT "," OR EOR NOT ACCEPTED JMP PROMT EOR OK JMP DPR47 COMMA NOT WANTED * * PROMPT FOR A SUBPARTITION? * PROMT LDA SUBS? ARE WE TO PROMPT FOR POSSIBLE SZA,RSS SUBPARTITION DEFINITIONS? JMP DPSTO * JSB \SPAC LDA P14 ASK THE QUESTION LDB SUB? "SUBPARTITIONS?" JSB \READ AND GET THE RESPONSE JSB \YENO TO ANALYZE JMP PROMT INVALID RESPONSE JMP DPSTO "NO" SUBPARTITIONS WANTED * * DEFINE THE MOTHER PARTITION SPECIFICATIONS * ISZ SUBMD YES, ENABLE SUBPART DEFINITION MODE LDA MATA GET ADDRESS OF MAT ENTRY FOR THIS MOTHER STA MOMAD AND SAVE FOR LINK WORD OF LAST CHAIN MEMBER LDA DPSIZ SAVE MOTHER PARTITION SIZE INA FOR SUBPARTITION CHECKING STA MOMSZ * CLA CLEAR THE SUBPARITIONS' STA SUBT PAGE TOTAL LDB DPTY AND THE MOTHER PARTITION'S TYPE STB MOMTY WILL BE THE TYPE FOR THE SUBS ISZ DPMOM SET FLAG FOR MOTHER BIT IN WORD 3 JMP DPSTO GO BUILD ENTRY * SKP * * BUILD A NEW MAT ENTRY OF THE FORM: * * WORD 0 - FREE LIST LINKAGE SET AT DPTHD * WORD 1 - PRIORITY OF RESIDENT SET TO 0 * Ýþú WORD 2 - ID SEGMENT ADDRESS SET TO 0 * WORD 3 - (15) MOTHER PARTITION, (9-0) STARTING PG SET AT DPTHD * WORD 4 - (15) RESERVED PARTITION, (9-0) # PAGES * WORD 5 - (15) RT PARTITION * WORD 6 - SUBPARTITION LINK WORD * DPSTO LDB MATA GET MAT ADDRESS FOR THIS STB CURMT ENTRY AND SAVE CLA JSB \ABDO CLEAR FREE LIST LINK WORD * ADB P2 POSITION TO WORD 3 LDA DPMOM GET MOTHER PARTITION FLAG RAR JSB \ABDO AND SET OPTIONAL BIT 15 IN WORD LDA DPRSV GET RESERVED FLAG INA IF SET (0) THEN RAR SET BIT 15 IN MAT WORD IOR DPSIZ MERGE IN PART SIZE JSB \ABDO AND SEND WORD 4 * LDA DPTY NOW SET THE OPTIONAL TYPE BIT 15 RAR (1 IF RT) JSB \ABDO AND SEND WORD 5 * LDA SUBMD IS THIS PARTITION A CHAIN MEMBER (EITHER SZA MOTHER OR SUBPARTITION)? LDA MOMAD IF SO, GET ADDRESS OF MOTHER ENTRY JSB \ABDO AND SEND SLW, ELSE 0 STB MATA SAVE ADDRESS OF NEXT MAT ENTRY * * FOR EACH SUBPARTITION OF A CHAIN, WE MUST LINK THE PREVIOUS * SUBPARTITION (OR MOTHER PARTITION) TO IT VIA THE SLW * LDA SUBMD IF WE'RE IN SUBPARTITION MODE, AND THE SZA,RSS "SUBPARTITIONS?" QUERY WAS ASKED ON A JMP MDONE A PREVIOUS PARTITION, THEN AT LEAST LDB SUBS? ONE SUBPARTITION HAS BEEN DEFINED SZB SO THE SLW OF THE PREVIOUS MAT ENTRY JMP MDONE MUST BE SET TO THE CURRENT ENTRY * LDA CURMT SET THE SLW OF THE PREVIOUS ENTRY CCB (LAST WORD) TO THE ADDRESS OF THE ADB A CURRENT MAT ENTRY JSB \ABDO * MDONE CLA CLEAR THE SUB. QUESTION FLAG STA SUBS? STA DPMOM AND MOTHER BIT FLAG ISZ NEXTP BUMP THE NUMBER OF SUCCESSFULLY DEFINED JMP DPRD PARTITIONS, AND GO ASK FOR MORE ª¯þú SKP * * ALL PARTITIONS DEFINED, SO CHECK FOR THE ALLOCATION * OF ALL THE PAGES, THEN SORT THE ENTRIES INTO RT, BG * AND MOTHER FREE LISTS. * DPEND CLA CLEAR STA DPTOT THE PAGE USAGE LDA MAXPT SET UP LOOP COUNTER CMA,INA PER MAXIMUM NUMBER OF STA DPTMP MAT ENTRIES * * SCAN ALL PARTITION DEFINITIONS, INSURING THAT THE SUM * OF THEIR SIZES TOTALS THE NUMBER OF PAGES REMAINING * LDB MAT. GET ADDRESS OF PART #1'S ENTRY DPLP1 JSB DPRW READ LINK WORD SSA LINK <0? JMP COMPR YES, DONE WITH DEFINED ENTRIES ADB P2 POINT TO M BIT WORD JSB DPRW AND READ IT STA DPTM1 SAVE FOR LATER JSB DPRW READ LENGTH-1 AND M1777 ISOLATE IT AND GET INA TRUE VALUE STA DPTM2 AND SAVE * * SKIP THE SUBPARTITION PAGES IN SUM TOTAL * INB NOW GET THE SUBPARTITION LINK WORD JSB DPRW STB DPTM3 SAVE ADDRESS OF NEXT ENTRY FOR LATER LDB DPTM1 GET POSSIBLE MOTHER BIT SZA IF SLW IS NONZERO, THEN PARTITION IS SSB IN A CHAIN. THEN IF MOTHER BIT IS RSS SET, WE MUST INCLUDE HER PAGE SIZE IN TOTAL JMP SKIPS SUBPARTITION - SKIPS ITS PAGES * * ADD CURRENT PARITITION'S PAGE SIZE(INCLUDING ITS BP) * TO THE SUM TOTAL * LDA DPTM2 GET IS PAGE SIZE AGAIN ADA DPTOT AND ADD IT TO THE CURRENT TOTAL STA DPTOT AND UPDATE SKIPS LDB DPTM3 GET ADDRESS OF NEXT MAT ENTRY ISZ DPTMP BUMP LOOP COUNTER, AND JMP DPLP1 CONTINUE * COMPR LDA DPARE UNTIL DONE - DOES THE SUM CPA DPTOT TOTAL MATCH THE # OF AVAILABLE PAGES? JMP DPTHD YES, CONTINUE TO SORT * * ERROR - PARTITIONS DON'T TOTAL TO SIZE OF AVAIL AREA * LDA ERR53 JSB \GNER SEND ERR 53 MESSAGE, AND START JMP DPINT THE PARTIT? þúION DEF'N ALL OVER AGAIN SKP * * THREAD MAT ENTRIES INTO THREE LISTS: BG FREE LIST, RT * FREE LIST, AND CHAINED (MOTHER) FREE LIST - BASED UPON * INCREASING PAGE SIZES. * DPTHD LDA MAXPT SAVE CMA -MAX PT -1 STA DPTMP AS LOOP COUNTER LDA PAGE# STA DORG SET FIRST PAGE TO GIVE AWAY LDA MAT. GET ADDRESS OF FIRST MAT ENTRY STA DPTM2 SAVE IT JMP DPEN3 ENTER LOOP AT BOTTOM (IN CASE MAXPT = 0) * * BEGIN MAIN LOOP: INSERT PART DESCRIPTORS INTO LISTS * AND SET PARTITION START ADDRS INTO DESCRIPTORS * DPLP2 LDB DPTM2 GET ABS ADDR OF NEXT MAT ENTRY JSB DPRW AND READ ITS PRESENT LINK WORD SSA IF UNDEFINED PART THEN JMP MPSRT WE'RE DONE THREADING THE MAT * ADB P2 POINT TO START PAGE WORD IN ENTRY JSB \ABDO READ AND DESTROY FIELD STA DPRSV SAVE MOTHER BIT WORD JSB DPRW GET AND SAVE POSSIBLE R BIT STA HIBP *TEMP* AND M1777 ISOLATE THE LENGTH PART STA DPSIZ AND SAVE FOR COMPARISON INB JSB DPRW GET THE SLW LDB DPRSV SET FLAG INDICATING POSSIBLE ELB MOTHER PARTITION LDB DPORG GET DEF TO CURRENT PART ORIGIN SZA IF SLW IS NONZERO SEZ AND THE MOTHER BIT ISN'T SET RSS THEN WE HAVE A SUBPARTITION LDB DMORG SO GET THE DEF TO ITS ORIGIN (OFFSET OF MOTHER'S) STB TEMP1 SAVE THE ORIGIN DEF FOR THIS PARITION * LDA DPRSV GET POSSIBLE MOTHER BIT AGAIN IOR B,I MERGE START PAGE OF PARTITION LDB DPTM2 POSITION TO WORD 3 OF ENTRY ADB P3 JSB \ABDO AND STORE ON DISC * * UPDATE THE PARTITION ORIGINS MORG AND/OR DORG * LDA DMORG GET POINTER TO MORG CPA TEMP1 IS IT THE ORIGIN FOR THE CURRET SUBP JMP UPORG YES, GO UPDATE IT BEFORE NEXT SUBPäBþúART LDA DPRSV IF THIS WAS A MOTHER PARTITION CLE,ELA THEN SET MORG FROM THE CURRENT SEZ VALUE OF DORG(BEFORE UPDATE), ELSE LDA DORG CLEAR MORG FOR A NON-CHAINED PARTITION STA MORG AND SET * UPORG LDA DPSIZ GET SIZE OF CURRENT PARTITION INA MAKE IT THE TRUE LENGTH ADA TEMP1,I UPDATE THE PROPER ORIGIN STA TEMP1,I (EITHER DORG OR MORG) * * SET UP THE FREE LIST HEADERS FOR THREADING AND UPDATING * EITHER THE RT, BG, OR CHAINED LIST. * INB JSB DPRW GET THE RT FLAG AND MSIGN LEAVE JUST SIGN BIT LDB DPRSV GET MOTHER BIT FIRST STA DPRSV THEN SAVE THE RT BIT SSB,RSS SET LIST HEADERS ACCORDING TO TYPE JMP GETHD RT AND BG LDB DPC. GET CHAINED LIST HEADER POINTER LDA MCHN. AND MAXIMUM SIZE POINTER JMP SETHD GO SET CURRENT POINTERS * GETHD LDB DPBG. LOAD BG LIST HEAD IF SSA BG PARTITION LDB DPRT. ELSE RT LIST HEAD LDA MBGP. GET BG MAX POINTER CPB DPRT. LDA MRTP. OR THE RT MAX POINTER SETHD STB DPLH. SET ADDRESS OF LIST TO SCAN, AND STA MDPH. ADDRESS OF ITS MAX-SIZED PARTITION LDB B,I LOAD LIST HEAD CONTENTS * * CHASE DOWN FREE LIST TO FIND PLACE TO INSERT ENTRY * STB DPCUR SAVE FIRST AS CURRENT CLA STA DPPRV AND ZERO AS PREVIOUS * DPLL1 LDB DPCUR IF POINTER IS NULL SZB,RSS THEN JMP DPLEX WERE DONE ADB P4 ELSE POINT TO LEN OF CURRENT JSB DPRW READ/RESTORE LENGTH AND M1777 AND ISOLATE IT CMA,INA IF INSERTEE SIZE IS ADA DPSIZ LESS THAN CURRENT SSA THEN WERE JMP DPLEX DONE * LDB DPCUR ELSE SAVE CUR AS STB DPPRV PREVIOUS AND READ JSB DPRW NEXT LINK STA DPCUR ¦þú AND SET AS CURRENT JMP DPLL1 THEN LOOP BACK AND CONTINUE * * FOUND POSITION TO INSERT - IF DPPRV IS STILL ZERO, * THEN INSERTEE GOES AT TOP OF LIST. * DPLEX LDA DPTM2 A POINTS TO INSERTEE LDB DPPRV IS PREVIOUS GUY HEAD?? SZB JMP DPINS NO, INSERT IN LIST STA DPLH.,I YES,JUST MAKE HEAD POINT HERE JMP DPFOR THEN FIX FOW'D PNTR * * GO MAKE MAT(DPPRV) POINT TO INSERTEE * DPINS JSB \ABDO * * MAKE INSERTEE POINT TO NEXT MAT ENTRY DPCUR * DPFOR LDB HIBP IF THIS IS A RESERVED SSB PARTITION (HIBP < 0), THEN JMP DPFO1 DON'T UPDATE MAX PARTITION SIZE LDA MDPH.,I ELSE GET PRESENT MAXTITION SIZE CMA,INA & COMPARE WITH CURRENT PARTITION ADA B SIZE. SSA,RSS IF NEW MAX STB MDPH.,I THEN UPDATE $MRTP/$MGBP/$MCHN * DPFO1 LDA DPCUR SET LINK WORD LDB DPTM2 OF INSERTEE JSB \ABDO * LDA P7 POINT TO NEXT ADA DPTM2 MAT ENTRY STA DPTM2 DPEN3 ISZ DPTMP CONTINUE UNTIL MAT JMP DPLP2 IS EXHAUSTED JMP MPSRT SKP * ERROR ROUTINES, VARIABLES, AND CONSTANTS * DPR45 LDA ERR45 JMP DPERR DPR46 LDA ERR46 JMP DPERR DPR47 LDA ERR47 JMP DPERR DPR49 LDA ERR49 DPERR JSB \GNER SEND ERROR MESSAGE JMP DPRD GO REREAD ENTRY * ERR44 ASC 1,44 ERR45 ASC 1,45 ERR46 ASC 1,46 ERR47 ASC 1,47 ERR48 ASC 1,48 ERR49 ASC 1,49 ERR50 ASC 1,50 ERR51 ASC 1,51 ERR53 ASC 1,53 ERR55 ASC 1,55 ERR56 ASC 1,56 * APER1 LDA ERR48 JSB \GNER JMP APRD2 APER2 LDA ERR49 JMP APERR APER3 LDA ERR50 APERR JSB \GNER JMP APLOP MPR55 LDA ERR55 RSS MPER1 LDA ERR51 JSB \GNER JMP MPLOP DPR56 LDA ERR56 JMP DPERR * * MESPT DEF MES63+4 MES63 DEF *+1 ASC 5,PART ? SUB? DEF *+1 ASC 7,SUBPARTITIONS? * SUBS? NORKþúP NEXTP NOP SUBT NOP SUBMD NOP MOMSZ NOP MOMTY NOP MOMAD NOP DPMOM NOP MATA NOP CURMT NOP DPTM1 EQU MOMTY DPTM3 EQU CURMT * DPORG DEF DORG DORG NOP DMORG DEF MORG MORG NOP DPLH. NOP MDPH. NOP * MCHN. DEF $MCHN+1 DPC. DEF $CFR+1 MRTP. DEF $MRTP+1 DPRT. DEF $RTFR+1 MBGP. DEF $MBGP+1 DPBG. DEF $BGFR+1 SKP * * DETERMINE THE PAGE REQUIREMENTS OF AN EMA PROGRAM * BY SUBTRACTING THE MSEG SIZE FROM THE ID-SEGMENT WORD * 21 SIZE STORED IN ID8, AND THEN ADDING THE EMA SIZE * TO IT (1 IF EMA DEFAULTED). * PAGES NOP LDA \ID6,I GET MSEG SIZE OF PROGRAM FROM JSB CPAG# ID8 BITS 14-10 CMA,INA STA B AND SAVE LDA \ID8,I NOW GET THE PROGRAM PAGE ALF,ALF REQUIREMENTS AS STORED IN AND M377 ID-SEGMENT WORD 21 ADB A SUBTRACT THE MSEG SIZE FROM IT LDA \ID5,I NOW GET THE DECLARED EMA SIZE AND M3776 ISOLATE IT ALF,ALF ALF SZA,RSS WAS IT DEFAULTED? CLA,INA YES, SET TO 1 ADA B ADD THE PROGRAM SIZE+EMA SIZE JMP PAGES,I EXIT * M3776 OCT 37760 SKP * CHECK NEXT CHAR IN LBUF FOR DELIMITER * * RETURNS: * (N) NOT COMMA OF EOR * (N+1) END-OF-RECORD * (N+2) COMMA * DPCHK NOP JSB \GETC GET NEXT CHAR CPA BLANK JMP DPC1 JUMP IF COMMA SZA JMP DPC3 JUMP IF NOT COMMA OR EOR JMP DPC2 JUMP IF EOR DPC1 ISZ DPCHK DPC2 ISZ DPCHK DPC3 JMP DPCHK,I SPC 3 * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL: B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD * DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A ­Wþú JMP DPRW,I AND RETURN * DPRWT BSS 1 SPC 3 * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR \ABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) * IDFND NOP LDA M377 PICKUP KEYWD# AND AND \ID8,I ISOLATE IT FROM IDENT WORD 8 ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. * M377 OCT 377 SKP DPTMP BSS 1 DPTM2 BSS 1 * "RT" ASC 1,RT "BG" ASC 1,BG "S" ASC 1,S "R" OCT 122 "/E" ASC 1,/E * MSIGN OCT 100000 PNUM BSS 1 PART # (1 THRU 64)?????? DPSIZ BSS 1 PART SIZE(1 TO 1024 PAGES) DPTY BSS 1 PART TYPE (BG=0,RT=1) DPRSV BSS 1 PART RSV FLG (-1,NOT RES,0=RES) DPTOT BSS 1 DPARE BSS 1 SIZE OF DISK PART AREA IN PAGES DPCUR BSS 1 USED DURING FREE LIST BUILD DPPRV BSS 1 USED DURING FREE LIST BUILD SPC 3 MSM1 ASC 11,PAGES REMAINING: XXXXX MXM1 DEF MSM1+8 MSM1. DEF MSM1 * MSM2 ASC 9,DEFINE PARTITIONS: MSM2. DEF MSM2 SKP * * ALLOW USER TO ALTER THE PROGRAMS PAGE REQUIREMENTS * ONLY INCREASES ARE ALLOWED * * SEND MESSAGE: "MODIFY PROGRAM PAGE REQUIREMENTS?" * * USER RESPONDS WITH: PROGNAME,PARTSIZE OR /E * (PARTSIZE INCLUDES BASE PAGE) * * NOTE: THIS IS DONE BEFORE ASSIGNING PROGRAMS TO * PARTITIONS, SO WE DON'T NEED TO CHECK IF * PROGRAM WILL STILL FIT IN ITS ASSIGNED PARTITION * MPSRT LDA MAXPT DON'T PROMPT SZA,RSS IF NO PARTIIONS DEFINED JMP APEND JSB \SPAC LDA P33 LDB MSM5. JSB \MESS * * GET PROGRAM NAME, SET UP POINTERS TO IDENT * MPLOP JSB APRED USE CODE IN ASSIGN PART. ROUTINE JMNÌþúP APSRT JUMP OUT IF /E WAS ENTERED LDA \ID6,I WAS THIS AN EMA PROGRAM? SSA JMP MPR55 YES, CAN'T OVERRIDE ITS PG REQMTS * * CONVERT SIZE TO BINARY AND VERIFY * LDA N2 GET 2 DECIMAL DIGITS JSB \GET# FROM LBUF AND JUMP JMP MPER1 IF BAD DIGIT ADA N1 SAVE OVERRIDE LESS 1 STA DPSIZ * LDB DPID READ LO-MAIN ADB P22 ADDRESS JSB DPRW FROM ID-SEGMENT WORD 22 LSR 10 GET PAGE NUMBER AND M37 AND ISOLATE. ADA DPSIZ GET TOTAL PAGES CMA,INA AND COMPARE TO 32. ADA P32 SSA ERROR IF OVER 32. JMP MPER1 * LDA \ID8,I GET PAGE REQMT LSR 8 FROM IDENT. POSITION AND M37 AND ISOLATE. CMA,INA SUBTRACT REQMT ADA DPSIZ FROM REQUEST, AND SKIP IF SSA REQMT IS EQUAL OR LESS. JMP MPER1 ERROR IF OVERRIDE IS LESS * * OVERRIDE IS VALID, UPDATE SIZE REQMT IN ID-SEGMENT * (BUT NOT IN L ID8 TO ALLOW A RE-OVERRIDE) * LDB DPID DESTRUCTIVELY READ WORD21 ADB P21 (THE DMS WORD) FROM THE ID- JSB \ABDO SEGMENT. RRR 10 AND M7700 THEN MERGE IN NEW IOR DPSIZ PAGE REQUIREMENTS AND RRL 10 BACKUP THE ADDRESS TO ADB N1 WORD 21 AGAIN JSB \ABDO AND REWRITE IT JMP MPLOP GO READ NEXT SKP * * ALLOW USER TO ASSIGN A PROGRAM TO A PARTITION. * PROGRAMS THUS ASSIGNED WILL RUN IN NO OTHER * PARTITION. * * SEND MESSAGE: "ASSIGN PROGRAM PARTITIONS?" * * USER RESPONDS WITH/ PROGNAME,PART# OR /E * APSRT JSB \SPAC LDA P26 LDB MSM4. JSB \MESS * * READ RESPONSES (CALL INLINE SUBROUTINE) * APLOP JSB APRED JMP APEND END LOOP IF /E WAS ENTERED JMP APCNV ELSE CONTINUE * * ðzþúAPRED NOP APRD2 CLA,INA LDB HYADD JSB \READ GET RESPONSE. LDA N5 ASK FOR A 5 CHAR NAME,BUT JSB \GETN IF THE 1ST 2 CHARS ARE CPA "/E" /E THEN JMP APRED,I WE ARE DONE JSB DPCHK CHAR AFTER PROGRAM NAME JMP APER1 SHOULD BE A COMMA, OTHERWISE JMP APER1 WE HAVE AN ERROR. * * GO LOCATE PROGRAM IN IDENT TABLE * SET UP POINTERS \ID1,I THRU \ID16,I * PUT ID SEG ADDR IN 'DPID' * LDB ATBUF LOCATE IDENT JSB \IDXS AND SET POINTERS. JMP APER1 ERROR IF NOT FOUND LDA \ID6,I GET PROGRAM TYPE AND M7 IF BASIC TYPE-IS CPA P2 NOT 2 (RT DISK RES) RSS OR 3 (PR DISK RES) CPA P3 OR 4 (BG DISK RES) RSS CPA P4 THEN WE DONT MESS RSS AROUND WITH PARTITION JMP APER1 STUFF. ISZ APRED INCREMENT TO NORMAL RETURN POINT JSB IDFND GET THE ID-SEG ADDR STB DPID AND SAVE JMP APRED,I AND RETURN TO CALLER * DPID BSS 1 POINTER TO ID-SEG FOR NAMED PROG SKP * * CONVERT PARTITION NUMBER TO BINARY * AND VERIFY * APCNV LDA N2 GET A 2-DIGIT DECIMAL NUMBER JSB \GET# FROM LBUF AND MAKE IT BINARY JMP APER2 ERROR IF BAD DIGIT STA PNUM CMA,INA IF ENTRY IS MORE THAN MAX ADA MAXPT ESTABLISHED EARLIER OR SSA,RSS ZERO, CPA MAXPT THEN WE HAVE JMP APER2 AN ERROR. * JSB DPCHK IT'S ALSO AN ERROR IF NEXT JMP APER2 CHAR IS ANYTHING BUT RSS END OF JMP APER2 RECO~D. * * SEE IF PARTITION IS DEFINED * CCA ADA PNUM CONVERT PART. NUMBER TO MPY P7 ABS ADDRESS IN M.A.T. IN ADA MAT. STA DPTM2 TARGET SYSTEM AND SAVE IT. LD†þúB A JSB DPRW READ LINK FIELD IN M.A.T. ENTRY SSA IF IT IS NEGATIVE JMP APER2 THAT MEANS UNDEFINED PARTITION * * GOOD PARTITION NUMBER - SEE IF PROG WILL FIT * LDB DPTM2 READ SIZE OF ADB P4 THE SPECIFIED PARTITION JSB DPRW (LOW 10 BITS OF FIELD) AND M1777 AND SAVE IT STA DPSIZ LDB DPID READ WORD 21 (DMS WORD) FROM ADB P21 ID-SEGMENT AND SAVE IT JSB DPRW STA DPTMP * LDB \ID6,I IS THIS AN EMA PROGRAM? SSB,RSS JMP NONEM NO * * EMA PROGRAM - GET ITS PROGRAM SIZE + EMA SIZE * JSB PAGES GET THE # OF PAGES REQUIRED JMP CMPPG AND GO CHECK WITH PARTITION'S SIZE * NONEM RRR 10 ISOLATE SIZE FIELD FROM AND M37 ID-SEGMENT WORD 21 * * COMPARE PROGRAM REQMTS WITH PARTITION SIZE * CMPPG CMA,INA AND COMPARE WITH ADA DPSIZ PARTITION SIZE SSA ERROR IF PARTITION JMP APER3 IS SMALLAR THAN PROGRAM * * PROGRAM WILL FIT PARTITION: FIXUP ID-SEGMENT * LDA DPTMP PICK UP OLD CONTENTS OF AND M7700 ID-SEG WORD 21 IOR PNUM AND MERGE IN PARTITION ADA N1 NUMBER LESS 1 IOR MSIGN AND ASSIGNED LDB DPID BIT. THEN ADB P21 REWRITE THAT WORD JSB \ABDO IN ID-SEGMENT JMP APLOP GO BACK AND GET NEXT USER INPUT * MSM5 ASC 17,MODIFY PROGRAM PAGE REQUIREMENTS? MSM5. DEF MSM5 * MSM4 ASC 13,ASSIGN PROGRAM PARTITIONS? MSM4. DEF MSM4 SKP * * BUILD MEMORY PROTECT FENCE TABLE * * (MPFT. CONTAINS ABS ADDR OF TABLE IN TARGET SYSTEM) * * TABLE FORMAT: WORD LOGICAL FENCE ADDR FOR: * 0 - BG DISK RES PROG W/O COMMON * 1 - MEM RES PROG W/O COMMON * 2 - ANY PROG USING RT COMMON * 3 - ANY PROG USING BG¶œþú COMMON * 4 - ANY PROG USING SSGA * 5 - PRIVILEGED RT/BG PROGRAM WITHOUT COMMON * APEND JSB \SYS LET \ABDO KNOW WE'RE REFERING * TO SYSTEM ADDRESSES. LDA LWDP1 GET LAST WORD OF A DRIVER PARTITION, +1 STA $DLP+1 AND SAVE LOAD ADDRESS FOR DRP'S LDB MPFT. PROGRAM AND SAVE AS WORD 0 JSB \ABDO OF MPFT. * LDA FWMRP SAVE FIRST WORD ADDR OF MEM RES JSB \ABDO PROGS IN WORD 1. * LDA RTCAD AND FIRST WORD ADDR OF RT JSB \ABDO COMMON IN WORD 2. * LDA BGCAD AND FIRST WORD ADDR OF BG JSB \ABDO COMMON IN WORD 3. * LDA SSGA. AND FIRST WORD ADDR OF SSGA JSB \ABDO IN WORD 4. * LDA FWPRV AND FIRST WORD ADDRESS OF PRIVILEGED STA $PLP+1 PROGRAMS, SAVE THEIR LOAD POINT JSB \ABDO IN WORD 5 SKP * * * BUILD THE MEMORY RESIDENT PROGRAM MAP * CLA STA HIBP CLEAR RP/WP BIT FLAG LDA FWSDA GET START ADDRESS OF SDA LDB \MRT2 DO MR'S ACCESS TABLE AREA II? SZB,RSS YES LDB MRACM NO, DO THEY ACCESS COMMON? SZB,RSS LDA LWDP1 NO,GET START ADDRESS OF COMMON JSB CPAG# CONVERT TO A PAGE # STA TEMP2 AND SAVE AS LIMIT * LDB MAP. GET TABLE AREA II ADDRESS OF RESERVED LDA FPMBP MAP SPACE, AND SET THE JSB \ABDO PHYSICAL MR BASE PAGE # * CCA SET FLAG FOR SECOND PASS STA TEMP4 ( SETTING SDA & TA II PAGES) CLA CLEAR WRITE PROTECT BIT STA HIBP STA TEMP3 NOW SET FIRST PAGE TO STORE L1 ISZ TEMP3 BUMP PHYSICAL PAGE # LDA TEMP3 IF IT NOW EQUALS CPA TEMP2 THIS BLOCK'S LIMIT JMP L2 THEN DONE WITH LOOP IOR HIBP MERGE POSSIBLE WRITE PROTECT BIT JSB \ABDO AND SEND PAGE TO MAP JMP L1 ?ÐNLH CONTINUE * BIT14 OCT 40000 * * SEND THE PAGE #'S FOR SDA AND TABLE AREA II (IF INCLUDED) * L2 STA TEMP3 SAVE CURRENT PAGE LDA BIT14 SET WRITE-PROTECT BIT STA HIBP ISZ TEMP4 WAS THAT THE SECOND PASS THRU LOOP? JMP L3 SECOND, SO MOVE ON * LDA \MRT2 SHALL WE SEND THE PAGES FOR SZA,RSS SDA AND TA II? JMP L3 NO LDA LBCAD GET PAGE IMMEDIATELY FOLLOWING LAST JSB CPAG# TABLE AREA II PAGE STA TEMP2 AND SAVE AS CURRENT LIMIT JMP L1+1 GO RE-ENTER BLOCK * * SEND MRL PAGES AS WRITE-PROTECTED, THEN THE MRP PAGES * L3 LDA FPMBP GET THE PHYSICAL STARTING INA PAGE OF MRL STA TEMP3 AND SAVE ADA MRP# ADD # PAGES OCCUPIED BY STA TEMP2 MRL/MRP'S AND SAVE AS LIMIT LDA FPMRP GET FIRST PAGE OCCUPIED BY MRP'S STA TEMP4 SET A LIMIT OF WP-PAGES * L4 LDA TEMP3 GET NEXT PHYSICAL PAGE CPA TEMP2 IF END OF MEM RES ARE JMP LEFTO THEN GO FILL IN LEFTOVER REG'S žNÿÿþú* CPA TEMP4 IF THE LAST WRITE-PROTECTED RSS MRL PAGE WAS JUST WRITTEN JMP L5 (WASN'T) CLA THEN RESET THE W-P BIT STA HIBP FOR STORING IN THE MRP PAGES LDA TEMP3 L5 IOR HIBP MERGE POSSIBLE WP BIT JSB \ABDO AND SEND PAGE TO MAP ISZ TEMP3 BUMP PHYSICAL PAGE # JMP L4 CONTINUE * * COMPUTE THE # OF LEFTOVER REGISTER WORDS TO FILL IN MAP * LEFTO LDA MPFT. GET ADDRESS OF MPFT CMA,INA AND COMPARE WITH ADA B CURRENT MAP ADDRESS WORD SSA,RSS DONE WITH MAP? JMP STUFF YES, MOVE ON * STA TEMP2 SET LOOP COUNTER FOR REST OF MAP LDA BIT14 RESET WP BIT IOR MSIGN AND THE RP BIT STA HIBP CLA START PAGE #'S AT 0 AGAIN STA TEMP3 AND SAVE L6 IOR HIBP MERGE WP BIT JSB \ABDO SET THE WORD TO THE MAP ISZ TEMP3 BUMP PAGE # LDA TEMP3 AND GET IT ISZ TEMP2 BUMP LOOP COUNTER JMP L6 CONTINUE SKP * * STUFF CRITICAL VALUES INTO ENTRY POINTS DECLARED * IN SYSTEM MODULES. (TABLE DRIVEN FOR EASY CHANGE) * * * COMPLETE THE TABLE OF VALUES FIRST * STUFF LDA MAP. SET ADDR OF RESIDENT STA $MRMP+1 PROGRAM MAP. * LDA LPSLB SET LENGTH OF SYSTEM INA PLUS SAM#1 IN PAGES STA $ENDS+1 * LDA MAT. SET ADDR OF MEMORY ALLOCATION STA $MATA+1 TABLE * LDA MPFT. SET ADDR OF MEMORY PROTECT STA $MPFT+1 FENCE TABLE. * LDA SAM#1 GET NUMBER OF PAGES PARTIALLY IOR M1777 OR FULLY OCCUPIED BY SAM #1 INA JSB CPAG# ALF,RAL ALF,RAL INTO BITS (15-10) IOR FPSAM MERGE IN FIRST PAGE ADDR (0-9) STA $MPSA+1 AND SET IN TABLE. * LDA PQFLG GET PAGE SIZE OF SAM#2 ALF,RAL ALF,RAL POSITION TO BITSùiþú (15-10) IOR SAM2P MERGE IN FIRS PAGE ADDR (9-0) STA $MPS2+1 AND SET IN TABLE * LDA EMRP SET LWA MEM RES PROG STA $EMRP+1 STUFF IN TABLE * LDA DVMAP GET ADDRESS OF DRIVER MAP TABLE STA $DVMP+1 AND SET * LDA DPADD GET START ADDRESS OF A DP JSB CPAG# AND CONVERT TO A LOGICAL STA $DVPT+1 PAGE NUMBER AND SAVE * LDA DPLN GET PAGE SIZE OF THE DRIVER PARTITIONS STA $DLTH+1 * LDA MAXPT SET THE MAXIMUM ALLOWABLE STA $MNP+1 NUMBER OF PARTITIONS * LDA IDEX SET ADDRESS OF ID STA $IDEX+1 EXTENSION TABLE * LDA LEND SET LAST WORD ADDRESS +1 STA $LEND+1 OF MEMORY RESIDENT LIBRARY * LDA BLLO SET NEGATIVE LOWER BUFFER LIMIT STA $BLLO+1 LDA BLHI AND NEGATIVE UPPER BUFFER LIMIT STA $BLUP+1 * LDA DSKDP STORE SYSTEM SPECIFICATIONS INTO STA $SBTB+1 SLOW BOOT TABLE: LDA DPNUM DP DISK ADDRESS/ STA $SBTB+2 LDA DSKMB MRBP DISK ADDRESS STA $SBTB+3 LDA MRP# GET THE NUMBER OF MRL+MRP PAGES STA $SBTB+6 AND SAVE SZA IF NONE, THEN DON'T INDICATE A BP CLA,INA STA $SBTB+4 SET PAGE # FOR BP LDA DSKMR MR DISK ADDRESS/ STA $SBTB+5 * * LOOK UP ENTRIES IN MODULES AND STUFF IN * VALUES FROM TABLE. * LDA SCT. INITIALIZE A POINTER INTO STA SCTMP THE VALUE TABLE * SCLOP LDB SCTMP,I LOAD POINTER TO ENTRY NAME SZB,RSS IN TABLE JMP SCEND (ZERO MEANS END OF TABLE). JSB \LSTS FIND NAME IN LST AREA AND JMP ER57 \ABOR IF MISSING. * LDB \LST5,I GET ENTRY ADDRESS ISZ SCTMP LDA SCTMP,I AND DESIRED VALUE JSB \ABDO THEN STUFF IT IN MODULE. * SCL01 LDA SCTMP FIX VALUE-TABLE POINTER ADA P4 TO ADDRESS NEXT STA ÊØþúSCTMP 5-WORD ENTRY. JMP SCLOP LOOP BACK TILL DONE. * ER57 LDA ERR57 JSB \GNER LDA P5 NOW PRINT THE OFFENDER LDB SCTMP,I GET ITS ADDRESS JSB \MESS JSB \TERM ABORT ERR57 ASC 1,57 SKP * * THE FOLLOWING TABLE CONTAINS A 5-WORD * ENTRY FOR EACH OF THE SYSTEM ENTRY * POINTS TO BE STUFFED WITH A VALUE. THE * TABLE ENDS WITH A WORD CONTAINING ZERO. * * ENTRY STRUCTURE: * WORD 0 - POINTER TO ENTRY PT. NAME * WORD 1 - VALUE TO BE STUFFED IN ENTRY PT. * WORDS 2,3,4 - ENTRY POINT NAME * SCTAB EQU * $MRMP DEF *+2 NOP ASC 3,$MRMP $ENDS DEF *+2 NOP ASC 3,$ENDS $MATA DEF *+2 NOP ASC 3,$MATA $MPSA DEF *+2 NOP ASC 3,$MPSA $MPS2 DEF *+2 NOP ASC 3,$MPS2 $MPFT DEF *+2 NOP ASC 3,$MPFT $RTFR DEF *+2 NOP (VALUE SET WHEN PARTITIONS DEFINED) ASC 3,$RTFR $BGFR DEF *+2 NOP (VALUE SET EARLIER, AS ABOVE) ASC 3,$BGFR $CFR DEF *+2 NOP (VALUE SET EARLIER, AS ABOVE) ASC 3,$CFR $EMRP DEF *+2 NOP ASC 3,$EMRP $DVMP DEF *+2 NOP ASC 3,$DVMP $DVPT DEF *+2 NOP ASC 3,$DVPT $DLTH DEF *+2 NOP ASC 3,$DLTH $MNP DEF *+2 NOP ASC 3,$MNP $MCHN DEF *+2 NOP (VALUE SET EARLIER, AS ABOVE) ASC 3,$MCHN $MBGP DEF *+2 NOP (VALUE SET EARLIER, AS ABOVE) ASC 3,$MBGP $MRTP DEF *+2 NOP (VALUE SET EARLIER, AS ABOVE) ASC 3,$MRTP $IDEX DEF *+2 NOP ASC 3,$IDEX $DLP DEF *+2 (VALUE SET AT MPFT SETTING) NOP ASC 3,$DLP $PLP DEF *+2 (VALUE SET AT MPFT SETTING) NOP ASC 3,$PLP $LEND DEF *+2 NOP ASC 3,$LEND $BLLO DEF *+2 NOP ASC 3,$BLLO $BLUP DEF *+nþú2 NOP ASC 3,$BLUP DEC 0 *END OF TABLE* * $SBTB DEF *+7 BSS 6 ASC 3,$SBTB * SCT. DEF SCTAB SCTMP BSS 1 N6 DEC -6 * * * FILL IN THE SLOW BOOT TABLE * SCEND ISZ SCTMP BUMP POINTER PAST DEC 0 LDB SCTMP,I JSB \LSTS GET ADDRESS OF $SBTB JMP ER57 ABORT * LDA N6 STA DPTMP LDB \LST5,I SBTB ISZ SCTMP LDA SCTMP,I GET THE VALUE JSB \ABDO AND STUFF IT IN TABLE ISZ DPTMP BUMP LOOP COUNTER JMP SBTB CONTINUE SKP * * BUILD DISK RESIDENT RELOCATABLE LIBRARY BY STORING * ALL UTILITY SUBROUTINES ON DISK * LDA \ADSK GET DISK ADDRESS STA DSKUT AND SAVE FOR SCOM JSB \INID INITIALIZE IDENT SCAN GETLB JSB \IDX SET IDENT ADDRESSES JMP ENDU ALL UTILITY PROGRAMS MOVED LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE CPA P7 TYPE = UTILITY? RSS YES - MOVE JMP GETLB IGNORE OTHER PROGRAMS * LDB \ADSK SET CURRENT DISC ADDR STB \ID5,I IN \IDENT FOR LIB. DICT. * LDA ALBUF READ UTILITY PROG NAM RECORD. STA \CURL CCB JSB \RNAM JSB \ABOR ERROR ON READ. SZA,RSS JSB \ABOR END OF FILE. * LDA N64 INIT PACKING COUNT. STA TEMP2 LDA APBUF INIT PACK BUF ADDRESS. STA CURD * MOVEL JSB MVREL SEND RECORD TO OUT FILE. LDA \LBUF+1 WAS IT AN END RECORD? ALF,RAR AND M7 CPA P5 JMP MOVEN YES. * LDA ALBUF NO. READ NEXT RELOC RECORD. STA \CURL CLB JSB \RBIN JSB \ABOR SZA,RSS JSB \ABOR JMP MOVEL * MOVEN LDA CURD ANYTHING IN PACK BUF? CPA APBUF JMP GETLB NO. * CLA YES. FILL OUT WITH ZEROES. MREL1 STA CURD,IãŽþú ISZ CURD ISZ TEMP2 DONE? JMP MREL1 NO. LDA \ADSK YES. LDB APBUF JSB \DSKO FLUSH TO DISK. LDA \ADSK JSB \DSKA INCR. DISC ADDRESS. STA \ADSK * JMP GETLB SCAN IDENTS FOR NEXT UTILITY PROG. SPC 4 * * SUBR TO SEND RELOC UTILITY RECORD TO OUTFILE. * MVREL NOP LDA \LBUF ALF,ALF CMA,INA STA TEMP1 NEGATIVE WORD COUNT FOR \LBUF. * MREL2 LDA \CURL,I MOVE A WORD TO PACKING BUFR. STA CURD,I ISZ \CURL BUMP BUFFER POINTERS. ISZ CURD ISZ TEMP2 END OF BUFFER? JMP MREL3 NO. LDA \ADSK YES. OUTPUT PACK BUF TO DISK. LDB APBUF STB CURD JSB \DSKO LDA \ADSK UPDATE DISK ADDRESS. JSB \DSKA STA \ADSK LDA N64 RESET PACKING COUNT. STA TEMP2 * MREL3 ISZ TEMP1 END OF RELOC RECORD? JMP MREL2 NO. JMP MVREL,I YES. EXIT. * N64 DEC -64 APBUF DEF \PDEF+1 BUFR OVERLAYS FRONT END. CURD NOP SKP * * MAKE LIBRARY ENTRY POINT LIST * ENDU CLA STA LBCNT CLEAR LIBRARY ENTRY POINT COUNT STA RELAD CLEAR RELOCATION ADDR FOR \ABDO STA SYCNT CLEAR SYSTEM ENTRY POINT COUNT STA \PTYP CLEAR PASS # LDA \ADSK GET CURRENT ABSOLUTE DISK ADDR STA DSKLB SAVE LIBR ENTRY POINT LIST ADDR JSB \USRS OUTPUT THE LIB USING USER MAP LDA M2000 WITH 2000 FOR THE BASE LDB \ABCO STA B,I CORE BASE ADA N1 AND MAX LDB \MXAB STA B,I INLB JSB \ILST INITIALIZE LST SCAN LBLST JSB \LSTX SET CURRENT LST ADDRESSES JMP EPASS END OF LIST * LDA \LST4,I GET IDENT INDEX OF ENTRY POINT STA \TIDN AND SET FOR \IDX LDB \PTYP GET PASS # TO DETERMINE WHICH TYPES SZB TO SEND JMP PASS2 2 - USER AVAILABLE’þú ENTRY POINTS * * PASS 1 - SYSTEM (TYPE 0 & 16) ENTRY POINTS ARE SENT * ADA N9 IF A SELF-DEFINING SYMBOL SSA JMP LBLST THEN IGNORE IT FOR NOW JSB \IDX SET IDENT ADDRESSES OF MODULE JSB \ABOR NOT THERE LDA \ID6,I GET PROG TYPE AND M177 ISOLATE IT SZA IF NOT A TYPE 0 CPA P16 OR TYPE 16 CLA,RSS CLEAR TYPE JMP LBLST THEN SKIP IT JMP LBO OTHERWISE GO CLEAR THE TYPE FLAG AND SEND IT * P16 DEC 16 * * PASS 2 - TYPE 13,15,30 ENTRY POINTS, PLUS ALL COMMON, REPLACE, * AND ABSOLUTE ENTRY POINTS * PASS2 ADA N5 IF SELF-DEFINING SSA (TYPES 0-4 ONLY) JMP LBOU THEN SEND IT ADA N4 TYPES 5 AND 6 SSA (UNDEFS AND EMA) JMP LBLST ARE SKIPPED * JSB \IDX SET IDENT ADDRESSES JSB \ABOR INVALID IDENT ADDRESS LDA \ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE CPA P13 SEND TABLE AREA II'S ENTRY POINTS RSS CPA P15 AND TABLE AREA I'S RSS CPA P30 PLUS SSGA'S CLA,RSS JMP LBLST SKIP ALL OTHERS FOR THIS PASS * LBO STA \TIDN CLEAR THE TYPE FLAG * LBOU JSB LBOUT SEND THE ENTRY POINT JMP LBLST GO GET THE NEXT ONE * * END OF A PASS - CHECK WHICH ONE * EPASS LDB \PTYP GET PASS COUNT SZB WAS IT #1? JMP ENDSX NO - #2, SO EXIT LDA LBCNT GET # OF SYSTEM ENTRY POINTS STA SYCNT SENT, AND SAVE STB LBCNT CLEAR COUNT FOR USER EP'S ISZ \PTYP BUMP PASS COUNT JMP INLB AND LOOP THRU LST AGAIN * * * LBOUT NOP ROUTINE TO OUTPUT ENTRY POINTS LDA \LST1,I GET ENTRY POINT 1,2 LDB \MXAB GET THE CORE RELATIVE LOCATION LDB B,I INB OF THE NEXT RECORD JSB \ABDO OUTPUT NAME ú„*($1,2 LDA \LST2,I GET ENTRY POINT 3,4 JSB \ABDO OUTPUT NAME 3,4 LDA \LST3,I GET ENTRY POINT 5 AND M7400 ISOLATE UPPER CHAR ADA \TIDN ADD THE FLAG WORD JSB \ABDO OUTPUT NAME 5 LDA \LST5,I GET SYMBOL VALUE JSB \ABDO OUTPUT VALUE OF ENTRY PT ISZ LBCNT INCR ENTRY POINT COUNT JMP LBOUT,I RETURN * * * OUTPUT THE DICTIONARY (TYPE 7 ENTRY POINTS) * ENDSX JSB \ILST DICTIONARY IS IN ORDER SXEND JSB \LSTX OF DEFINITION JMP \PDEF,I END OF ENT'S GO WRAP UP * LDA \LST4,I GET THE IDENT INDEX STA \TIDN SET FOR IDX ADA N7 IF UNDEFINED OR SELF SSA DEFINING JMP SXEND SKIP THE SYMBOL * JSB \IDX GET THE IDENT ADDRESSES JSB \ABOR WOOPS! LDA \ID6,I GET THE TYPE AND M177 ISOLATE CPA P7 IF NOT LIBRARY CLA,INA,RSS JMP SXEND TRY THE NEXT ONE * STA \TIDN ELSE SET THE FLAG TO 1 LDA \ID5,I GET THE DISC ADDRESS STA \LST5,I AND SET IN VALUE WORD JSB LBOUT OUTPUT THE ENT JMP SXEND TRY THE NEXT ONE. * * N7 DEC -7 N9 DEC -9 M177 OCT 177 M2000 OCT 2000 P13 DEC 13 P15 DEC 15 * * END PART Y*ÿÿþúASMB,R,L,C HED RTGN7 - 7905,7920 SUBROUTINE SEGMENT. NAM RT4G7,5,90 92067-16009 REV.1926 790427 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G7 * SOURCE: 92067-18009 * REL: 92067-16009 * WRITTEN BY: KFH, GAA * ****************************************************************** SPC 3 * * 7905 SUBROUTINE ENTRY POINTS: * ENT \DST5 ENTRY FOR DSETU ENT \BOT5 ENTRY FOR PTBOT ENT \TB32 ENTRY FOR DSTBL. ENT \FSC5 ENTRY FOR FSECT. * * * * * EXTERNAL UTILITY SUBROUTINES: * EXT WRITF EXT \CRET,\FMRR,\CFIL,\DSKD EXT \MESS,\SRET,\RNME,\CONV EXT \DCON,\SPAC,\READ,\GETN,\GINT,\GET#,\GETC EXT \INER,\YENO,\LSTE,\LSTS,\ABOR,\ABDO EXT \PIOC,\TBCH,\BDCB * * EXT \LST5,\OBUF EXT \TBUF,\PREL * A EQU 0 B EQU 1 SUP SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * BEG55 EQU * TB30 BSS 128 TRACK MAP TABLE/1ÀþúHEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS ƒÜþú1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INÏiþúSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX ’ þúBSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * içþú * ********************************************************* * SKP * BEG05 JMP \SRET SEGMENT ENTRY POINT * DC EQU 0 ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR ATB30 DEF TB30 * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 3, 00? MES1 DEF *+1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES, ASC 14, UNIT, # SPARES FOR SUBCHNL: P68 DEC 68 LENGTH OF MESSAGE * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E SBUF BSS 3 DSBUF DEF SBUF MES5 DEF MES05 MES7 DEF MES07 * L2000 OCT -2000 M0760 OCT 76000 M77 OCT 77 M377 OCT 377 M1177 OCT 101777 M1777 OCT 1777 M74C OCT 7400 M7400 OCT 177400 M7600 OCT 177600 M7700 OCT 177700 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N8 DEC -8 P1 DEC 1 P2 DEC 2 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P15 DEC 15 P23 DEC 23 P17 DEC 17 P25 DEC 25 P31 DEC 31 BLANK OCT 40 STEMP NOP TTEMP NOP HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST CYL #, HEAD #, # SURFACES, UNIT, # SPARES FOR SUBCHNL? * 0? * . * . * . * . * 32? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT * * # 128 WORD SECTORS/TRACK? ENTER 3 DECIMAL DIGITS $$ SPC 3 \DST5 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB32 PUT TB32 IN THE LST JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SEL½©þúECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHANNEL NUMBER ADA N8 TEST FOR >= 10 OCTAL SSA,RSS JMP STB30-1 OK JSB \INER JMP CHNLD * JSB \SPAC SET UP TRACK MAP STB30 LDA P68 SEND MESSAGE: LDB MES1 # TRKS, FIRST CYL #, HEAD #, # SURFACES, JSB \MESS UNIT, # SPARES FOR SUBCHNL: LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT STA INTMP AND CLEAR LOOPS LDB M7600 =-128 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT LDA B CONVERT FOR THE MESSAGE CMA,INA LDB DSBUF JSB \CONV LDA SBUF+2 STA MS3+2 SET IN THE MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P5 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB \GET# DECIMAL JMP TB30E ERROR - * STA TTEMP SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30E GO UPDATE POINTERS * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA STEMP,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N5 MUST BE LESS THAN 5. SSA,RSs±þúS WELL? JMP TB30E NO - BITCH * BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE CCA NOW GET # SURFACES JSB GET MUST BE 1 TO 5. STA B SZA ADA N6 SSA,RSS WELL? JMP TB30E NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD STB BSHED CLA,INA NOW GET UNIT JSB GET MUST BE 0 TO 7. ADA BSHED GOOD - ADD THE HEAD WORD STA BSHED AND SAVE IT. CLA PREPARE FOR DEFAULT # SPARES STA \TBUF+1 NAMELY 0. JSB \GETC TEST FOR SPARES CPA BLANK WELL? RSS YES, SO SET TO CONVERT 2 DIGITS JMP TB30C NO, USE DEFAULT * LDA N2 JSB GET CONVERT THE # SPARES STA \TBUF+1 SAVE THE NUMBER JSB \GETC END OF LINE? SZA WELL? JMP TB30E NO - TOO BAD - AND YOU ALMOST * MADE IT TOO. TB30C ISZ STEMP STEP TO HEAD/UNIT WORD. LDA BSHED AND STA STEMP,I SALT IT AWAY. ISZ STEMP NOW THE # TRACKS LDA TTEMP WORD STA STEMP,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ STEMP STEP TO SPARES LDA \TBUF+1 AND STA STEMP,I SALT THAT AWAY TOO. LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUB±þúC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N4 DECIMAL DIGITS JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL ADB M7400 TEST FOR TOO MANY TRACKS CMB,SSB,INB,SZB OK? JMP SYSER NO GO BITCH * * SET VALUES FOR THE BOOT * RSS SETEM CLA SUBCHANNEL IN A RAL,RAL LDB ATB30 POSITION WITHIN TMT FOR INFO ADB A LDA B,I GET FIRST CYLINDER # STA PT#TR STA PT#T2 STA TBASE * INB LDA B,I LDB A AND M74C STA H#AD SET HEAD # FOR COMMANDS STA PT#H2 ALF,ALF STA BHD# * LDA B ALF AND M17 STA #HDS * LDA B AND M377 GOT THE UNIT LDB WA#KE NOW INCORPORATE IT ADB A IT INTO THE WAKEUP, STB WA#KE SEEK,AND \READ COMMANDS STB WAK * LDB PT#SK ADB A STB PT#SK STB SKCMD * LDB PT#AD ADB A STB PT#AD STB AD#RC * LDB R#DCM ADB A STB R#DCM STB R#CMD * LDB P#EN ADB A STB P#EN STB S#TAC * SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# #SECT PER TRACK TO ZERO, CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL þúJSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF GET BACK THE SIZE STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N4 JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT AUX1 STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SYSER JSB \INER SEND ERROR MESSAGE JMP ISYSC TRY AGAIN * AUX2 ADB M7400 TOO MANY TRACKS FOR AUX CMB,SSB,INB,SZB DISC? JMP AUX4 YES GO BITCH SPC 1 STA AUXCH SET AUX CHANNEL LDA P96 SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 * NOTE: THE FACT THAT ANY GIVEN DISC * ADDRESS IS ON A UNIT OTHER THAN * THE SYSTEM UNIT IS FLAGGED BY * ITS TRACK ADDRESS BEING GREATER THAN * 400 BY THE AMOUNT OF THE DESIRED * TRACK. STSCR JMP \DST5,I RETURN TO MAIN LINE CODE SPC 1 P96 DEC 96 P32 DEC 32 BSHED  þúNOP SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB \SPAC NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB \READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP #SEC1 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SPC 2 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA \TBUF AND GETS NEXT JSB \GETC INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP TB30E EMPTY LINE SO ERROR * LDA \TBUF GET TYPE/ # DIGITS JSB \GET# GET NUMBER JMP TB30E CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A ADB N32 TEST FOR SUBCHANNEL # >=32 SSB,RSS JMP TSTER * LDB A NUMBER TO B BLS,BLS INDEX INTO THE ADB ATB30 MAP TABLE ADDRESS ADB P2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURNa<þú ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN * N32 DEC -32 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA \TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHNL INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ \TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * I/OTB DEF DSK1 DEF DSK2 DEF DSK3 DEF DSK4 DEF DSK5 DEF DSK6 DEF DSK7 DEF DSKDR I/OTC EQU * HPDSK DEF I/OTB,I ADDRESS OF I/O INSTRUCTION LIST #DATA ABS I/OTB-I/OTC # OF DATA I/O INSTRUCTIONS SPC 2 HED MH RT4GN CONFIGURE AND COMPLETE INITILIZATION \BOT5 NOP CONFIGURE PAPER TAPE BOOTSTRAP LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES * LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR M0760 ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT RAL,CLE,ERA CLEAR THE SIGN BIT STA BADDD FOR THE PAPER BOOT LDA DDIV CONFIGURE THE DIVIDE AND M1777 IOR M0760 STA DDIV AND RESET IT * * SEND THE BOOT EXTENSION TO ABSOLUTE OUTPUT FILE * LDB ABOOT OUTPUT THE BOOT EXTENSION CLA,CLE TO THE DISC JSB \DSKD TRACK ZERO SECT ZERO SPC 3 BOOT0 JSB \SPAC NEW LI•gNLHNE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB \RNME GET THE NAME * JSB \GINT IF A 0 WAS ENTERED, THEN CLA,INA SKIP THE BOOT JSB \GETN CPA ZERO JMP \BOT5,I * JSB \CRET CREAT BOOT FILE DEF *+5 DEF \BDCB DEF P1 DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS JMP BOOT0 ERROR-TRY AGAIN * LDA NBLC GET BOOT LENGTH STA \TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ \TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF BOOTL * LDA \BDCB+2 SZA IF ITS A TYPE 0 FILE JMP \BOT5,I THEN WRITE AN EOF JSB WRITF DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 ŽûNÿÿþú DEF N1 * JMP \BOT5,I RETURN TO MAIN SPC 2 N1 DEC -1 M2300 OCT 2300 MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? ZERO OCT 60 * BSS BEG55+1600B-* HED RT4GN DISC DRIVE I/O INSTRUCTION ADDRESSES HED RT4GN ** TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES,GET CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 MASK SELECT CODE OF DISC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+HDA+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+HDA+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ABS STB-O+HDA+I+I YES, THEN STORE IT BACK ABS ISZ-O+HDA MOVE ON TO THE NEXT INSTR ABS LDA-O+HDA ABS CPA-O+HDA3 ALL DISC IO INSTR CONFIGURED? CLA,INA,RSS YES,SET A TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE NEXT ONE SLOAD ABS STA-O+BENT ABS LDA-O+T#ACK CLB DIV -O+#HDS GET RELATIVE TRACK/HEAD DDIV EQU *-1 ABS ADA-O+TBASE ADD TRACK ZERO TO GET ABS. TRACK ABS STA-9ÊþúO+CYLA1 SAVE FOR ADDRESSING ABS STA-O+CYLA3 SAVE FOR ADDRESSING ABS ADB-O+BHD# ADD THE BASE HEAD ADDRESS ABS LDA-O+BENT GET SECTOR TO A BLF,BLF PUT HEAD IN HIGH B AND ABS ADB-O+BENT ADD THE SECTOR RSS SKIP OVER ADDRESS OF BENT ABS 2000B-OO+BENT DEFINE ADDRESS OF BENT ABS STB-O+HDA SET THE HEAD/SECTOR ADDRESSES ABS STB-O+HDA3 SET THE HEAD/SECTOR ADDRESSES LSL 7 SECTOR TIMES 128 CMA,INA AND SUBTRACT FROM ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDB-O+D#PRM GET THE COMMAND SLOOP LDA 1,I GET A COMMAND RAL,CLE,SLA,ERA IF SIGN BIT SET DSK10 CLC 0 SEND COMMAND IS COMMING DSK11 OTA 0,C SEND THE COMMAND ABS CPB-O+A#DMA IF DMA STC 6,C START IT DSK12 STC 0 ALLOW ATTENTION SEZ,INB,RSS IF NOT A COMMAND ABS JMP-O+STDMA DON'T WAIT FOR FLAG * DSK13 SFS 0 WAIT FOR THE FLAG ABS JMP-O+*-1 STDMA STF 6 STOP DMA IF NEEDED ABS CPB-O+A#END END OF LOOP? RSS SKIP IF END ABS JMP-O+SLOOP NOT END AROUND WE GO * DSK14 LIA 0,C GET STATUS 1 DSK15 SFS 0 WAIT FOR FLAG ABS JMP-O+*-1 DSK16 LIB 0,C GET STATUS 2 .ßþúABS AND-O+C174B ISOLATE SZA,RSS IF NO ERRORS ABS JMP-O+OK CONTINUE * SWP SWITCH A AND B REGISTER CONTENTS HLT31 HLT 31B ELSE HALT ABS JMP-O+HLT31 TRY AGAIN * OK ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS ABS JMP-O+SLOAD GO LOAD (A=0=SECTOR ADDRESS) * * DATA AREA C174B OCT 17400 P#WDS DEC -128 N#WDS OCT 77477 HIGH EQU N#WDS WAK OCT 113000 SKCMD OCT 101200 CYLA1 OCT 77600 HDA ABS 76000B-O+DSK10 AD#RC OCT 106000 CYLA3 NOP SC EQU CYLA3 HDA3 ABS 76000B-O+DSK16+1 FILM# OCT 107404 R#CMD OCT 102400 S#TAC OCT 101400 #WDTK DEC 6144 RECNT OCT 77600 CONFIGURED TO BBL ADDRESS D#PRM ABS 76000B-O+WAK TBASE NOP FIRST TRACK# - MUST BE AT START+143B FOR SWTCH!!!!! A#DMA ABS 76000B-O+R#CMD A#END ABS 76000B-O+S#TAC+1 IOG OCT 102000 #HDS DEC 2 # SURFACES BHD# NOP STARTING HEAD # IOMSK OCT 172076 SPCAD ABS 2000B-OO+START B77 OCT 77 T#ACK NOP * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 OF SWICTH REG SET? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THE REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+P#WDS DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+CYLA1+I+I YES GO EXECUTE THE BOOT SKP * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * ôXþú* O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * CPB EQU 056000B CPB CPA EQU 052000B CPA LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED MOVING HEAD PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. SPC 2 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIA 1 READ CONTENTS OF SWITCH REG SSA,RSS RECONFIGURATION REQUIRED? JMP SETDS-ADCON NO, SET SWITCH REG TO OLD DISC SC ELA,CLE,ERA YES, CLEAR SIGN BIT CLB LSR 6 A REG HAS NEW DISC SC SZA,RSS SPECIFIED? JMP SETDS-ADCON NO, SET SWITCH REG TO OLD DISC SC STA DSKSC-ADCON YES, SAVE IT LDB DSKAD-ADCON CONFIGURE ALL DISC I/O INTSTRUCTIONS IOLP LDA B,I FOR NEW DISC SC AND MASK-ADCON CLEAR LOW 6 BITS OF INSTR WORD IOR DSKSC-ADCON STA B,I RESTORE DISC I/O INSTR INB ISZ DATA#-ADCON DONE? JMP IOLP-ADCON NO, CONFIGURE NEXT INSTR JMP CNTNU-ADCON YES, CONTINUE * SETDS LDA DSK1-ADCON ISOLATE CURRENT DSCE SC AND DSKSC-ADCON ALF RAL,RAL MOVE DISC SC TO BITS 6-11 STA DSKSC-ˆþúADCON SAVE IT LIA 1 GET CONTENTS OF SWITCH REGISTER AND CLRDS-ADCON CLEAR BITS 6-11 OF SWITCH REG IOR DSKSC-ADCON INSERT DISC SC INTO BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 LDB P#LST-ADCON N#XT INB STEP ADDRESS N#XT1 LDA B,I GET THE COMMAND RAL,CLE,SLA,ERA IF A CLC IS NEEDED DSK1 CLC DC DO IT DSK2 OTA DC,C SEND THE WORD CPB P#DMA-ADCON DMA NOW? STC 6,C YES DSK3 STC DC ALLOW ATTENTION SEZ,RSS IF NOT A COMMAND JMP DMAST-ADCON DON'T WAIT FOR FLAG * DSK4 SFS DC WAIT FOR FLAG JMP *-1-ADCON * DMAST STF 6 CLEAR DMA CPB P#END-ADCON END OF LOOP RSS YES SKIP OUT JMP N#XT-ADCON NO DO NEXT WORD * DSK5 LIA DC,C GET THE STATUS 1 WORD DSK6 SFS DC WAIT FOR 2 JMP *-1-ADCON * DSK7 LIB DC,C GET STATUS 2 AND B174C-ADCON ISOLATE THE IMPORTANT BITS SZA,RSS IF OK JMP BTEXT-ADCON GET READY TO EXECUTE THE BOOT * RBR,SLB,RBL TEST \READY BIT JMP ATN#-ADCON NOT \READY GO WAIT FOR ATTN. * SWP SWITCH A AND B REGISTER CONTENTS HLT 11B ELSE HALT JMS#A JMP S#ART-ADCON TRY AGAIN * BTEXT CLB CLEAR B REG FOR THE BOOT EXTENSION JMP BADDD-ADCON,I GO EXECUTE THE BOOT * ATN# LDB P#LST-ADCON GET 'END' COMMAND ADDRESS AND JMP N#XT1-ADCON GO SEND IT AND WAIT FOR ATTN. P#LST DEF *+1-ADCON ADDRESS OF COMMAND LIST OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400P#EN OCT 101400 STATUS COMMANDBADD‚þú ABS START-O+I+I THESE DSKDR ABS DC DMA CON WORD DM128 DEC -128 BADDD ABS START-O B174C OCT 17400 P#END ABS P#EN-ADCON P#DMA ABS R#DCM-ADCON MASK OCT 177700 DSKSC OCT 77 CLRDS OCT 170077 I#OTB DEF DSK1-ADCON DEF DSK2-ADCON DEF DSK3-ADCON DEF DSK4-ADCON DEF DSK5-ADCON DEF DSK6-ADCON DEF DSK7-ADCON DEF DSKDR-ADCON I#OTC EQU * DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTRUCTIONS DSKAD DEF I#OTB-ADCON,I ADDRESS OF I/O INSTRUCTION LIST SPC 1 HNDR EQU *-1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION HED GENERATE $TB32 TRACK MAP TABLE \TB32 EQU * **ENTRY POINT FOR DSTBL** DSTBL NOP * GENERATE TB32 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA #SUBC GET NUMBER OF WORDS CMA,INA SET NEGATIVE STA \TBUF+1 SET COUNT LDB $TB32 GET THE LST ENTRY JSB \LSTS FOR $TB32 JSB \ABOR BAD NEWS NO $TB32 ????? LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE LDA \TBUF+1 SEND THE SUBCHANNEL COUNT JSB \ABDO FIRST * DSTB1 LDA \TBUF,I GET WORD FROM TABLE JSB \ABDO SEND TO DISC ISZ \TBUF STEP TABLE ADDRESS LDA \TBUF,I GET THE HEAD/UNIT WORD JSB \ABDO SEND IT ISZ \TBUF STEP TO THE # OF TRACKS WORD LDA \TBUF,I AND JSB \ABDO SEND IT ISZ \TBUF STEP OVER THE SPARE WORD ISZ \TBUF (vþú ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TO CMB,INB WRITE HEADER RECORD CCA,CLE #2 CONTAINING THE TRACK JSB \DSKD MAP TABLE IMAGE JMP \TB32,I EXIT * $TB32 DEF *+1 ASC 3,$TB32 * HED 7905 RTGEN SUBROUTINE SEGMENT * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * \FSC5 NOP LDB ABOOT GET THE CLA,CCE BOOT FROM JSB \DSKD THE DISC LDB LWSLB GET THE HIGHEST SYSTEM ADDRESS STB HIGH AND STORE IN THE BOOT LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB \DSKD BACK TO THE DISC CLE DLD \OBUF FLUSH THE FINAL BUFFER ELA,CLE FROM CORE JSB \DSKD * * WRITE THE GENERATOR'S FIRST HEADER RECORD, STORED IN THE TMT BUFFER. * THE FIRST 6 WORDS MUST CONTAIN THE SYSTEM SUBCHANNEL INFORMATION. * * LDA SYSCH IOR MSIGN SIGNAL AN RTE-IV STA TB30 THE SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 " " EQT # LDA CEQT STA TB30+2 # EQT'S LDA \PIOC STA TB30+3 PRIVILEGED INTERRUPT CHANNEL LDA \TBCH STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET # OF DEFINED DISK SUBCHANNELS BLF,BLF ROTATE TO THE HIGH BYTE IOR B AND MERGE WITH THE TTY CHANNEL STA TB30+5 AND SAVE LDB ATB30 CMB,INB NEGATE IT SO \DSKD WILL KNOW CLA,CLE JSB \DSKD JMP \FSC5,I * MSIGN OCT 100000 * M17 OCT 17 * END EQU * * END BEG05 ¦æ0.**0ÿÿþúASMB,R,L,C HED RT4G8 - DRIVER PARTITION LOADING CONTROL SEGMENT NAM RT4G8,5,90 92067-16009 REV.1926 790427 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G8 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \\LDP * * EXTERNAL REFERENCE NAMES * EXT \DPLD,\PREL,\TBUF EXT \CBPA,\CPL2 EXT \CONV,\ABDO,\DSKA EXT \ADSK,\PTYP,\TMSK EXT \SPAC,\GNER,\MESS,\IRER,\ABOR EXT \ADBP,\NUMP EXT \IDX,\TIDN,\ID1,\ID3,\ID4,\ID5,\ID6,\ID8 EXT \IFIX,\FIX,\FIX1 EXT \CUBP,\UCBP,\ICBP,\CBPA EXT \SYS,\USRS,\USER EXT \LRBP,\URBP,\SRET EXT \DDON * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 vÄþú TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGWKþúMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE ;þúINSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1fÚþú * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF SSGAF BSS 1 SSGA ACCESS FLAG FOR SEGMENTS * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * ç þú * ********************************************************* * SPC 4 SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * SEG8 CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS P7 DEC 7 P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 M37 OCT 37 M177 OCT 177 M1000 OCT 1000 M1777 OCT 1777 M7777 OCT 77777 M3777 OCT 37777 M1776 OCT 177776 * LWSBP OCT 1645 * MES64 DEF *+1 ASC 9,PARTITION DRIVERS MESDP DEF *+1 ASC 2,DP DO NOT REARRANGE MESPD NOP THESE FOUR ASC 1,: LINES SKP * * LOADING CONTROL FOR DRIVER PARTITIONS: * - CHOOSES THE NEXT PARTITION DRIVER TO RELOCATE * - ZERO-FILLS ANY REMAINING DRIVER PARTITION SPACE * - UPDATE DRIVER MAP TABLE ENTRIES WITH CORRECT * PHYSICAL DP PAGE # * * ON ENTRY: * A-REG = -1 IF DRIVER PARTITION #1 IS TO BE RELOCATED * = 0 IF DRIVER PARTITIONS #2 ONWARD ARE TO BE * RELOCATED WITH THE REMAINING PRD'S * \\LDP SSA,RSS JMP DP2ON GO LOAD DRIVER PARTITIONS #2 ... * * RELOCATE DRIVERS INTO DRIVER PARTITION #1 ONLY * ADA \PREL DETERMINE THE LAST WORD OF TA I STA LWTAI AND SAVE FOR COMPUTING SAM#0 IOR M1777 AND ROUND TO THE START OF THE INA NEXT PAGE STA DPADD SAVE LOGICAL STARTING ADDRESS OF DP'S JSB CPAG# CONVERT IT TO A PHYSICAL PAGE # AND STA PAGE# FOR UPDATING DVMAP ENTRIES * ADA DPLN ADD # PAGES PER PARTITION STA FPCOM AND -þúSET FIRST COMMON PAGE ALF,ALF MOVE TO CORRECT FORMAT RAL,RAL AS A MEMORY ADDRESS STA LWDP1 AND SAVE AS LAST WORD OF A DP, +1 * LDA SDID GET IDENT INDEX OF SYSTEM DISK DRIVER AND M3777 TO BE RELOCATED STA CIDNT INTO DP #1 CLA SET PROGRAM TYPE STA \PTYP FOR SCDRV/IDSCN STA DPFLG SIGNAL DP RELOCATION MODE JSB \SPAC JSB \SPAC * JMP LOADD NOW LOAD DP #1 * DP1DN LDA LWDP1 SET THE RELOCATION ADDRESS FOR SSGA STA \PREL STA SSGA. AND SAVE FOR MPFT SETTING CCA TURN OFF DP RELOCATION STA DPFLG MODE JMP \DDON RETURN TO LOADING CONTROL IN RT4G3 SKP * * RELOCATE REMAINING PARTITION-RESIDENT DRIVERS INTO DP 'S #2 ONWARD * DP2ON STA \PTYP SET IDENT SCAN TYPE STA DPFLG SIGNAL DP RELOCATION MODE INA NOW SET THE # OF DP'S ALREADY STA DPNUM RELOCATED * LDA P17 SEND LDB MES64 HEADING: JSB SETHD "PARTITION DRIVERS" * * INITIALIZE FOR PARTITION DRIVER LOADING * CCA SET FOR TOP-DOWN LINK STA BPINC ALLOCATION ADA PBREL SAVE LOWEST LINK TO STA BPLMT ALLOCATE(LESS 1) STA HILNK AND HIGHEST SYSTEM LINK ALLOCATED * INA SET BP SCAN ARE TO LOWEST LINK STA \CUBP ABOVE HIGHEST SYSTEM LINK ADA \ADBP AND SAVE ITS RT4GN STA \ICBP IMAGE AREA * LDA LWSBP SET UPPER BP LINK SCAN AREA STA \UCBP BELOW SCOM * CCA ADA LOLNK SET FIRST LINK ADDRESS TO STA PBREL FOLLOW LAST TA-II LINK * CLA CLEAR SO THE SYSTEM-ONLY LINKS STA \LRBP ON BP WILL NOT STA \URBP BE SHARED * LDA M1000 FIXUP LINKS MUST GO IN STA HIBP HIGH BASE PAGE * * JSB DSKEV FORCE EVEN SECTOR BOUNDARY FOR DP #2P€þú STA DSKDP AND SAVE DISK ADDR OF DP #2 (FOR $SBTB) * LDA LPSLB GET PHYSICAL PAGE # FOLLOWING INA THE SLOW BOOT/SAM #1 STA PAGE# AND SET STARTING PAGE FOR DP #2 * * JMP LOADD NOW LOAD THE DRIVER PARTITIONS * DPDON LDB PAGE# NEXT AVAILABLE PAGE # STB FPMBP IS THE MEMORY RESIDENT BASE PAGE * CMB,INB DETERMINE IF THERE WERE EVEN ADB \NUMP ENOUGH PHYSICAL PAGES SSB FOR THE DRIVER PARTITIONS JMP PGOV NOPE * LDA LPSLB DETERMINE THE # OF PAGES USED CMA BY DP'S #2 ONWARD ADA FPMBP STA DPNUM AND SAVE CCA TURN OFF DP STA DPFLG RELOCATION MODE * JMP \DDON RETURN TO RT4G3 FOR MEMORY RESIDENT LOADING * * PGOV LDA ERR61 SEND ERROR DIAGNOSTIC JSB \IRER NO MORE PHYSICAL PAGES ERR61 ASC 1,61 SKP * * SUBROUTINE LOADD: * LOADS DRIVER PARTITION #1, OR DRIVER PARTITIONS #2 ONWARD * * ON ENTRY THE FOLLOWING HAVE ALREADY BEEN SET UP: * - DPNUM CONTAINS THE # OF DP'S ALREADY BUILT * - BPINC,BPLMT,\CUBP,\ICBP,\UCBP,PBREL,\LRBP,\URBP INITIALIZED * FOR LINK ALLOCATION * - HIBP SET TO ALLOCATE LINKS IN UPPER BASE PAGE * - PAGE# INITIALIZED TO THE PHYSICAL PAGE # OF THE NEXT DP * * LOADD EQU * * * SEARCH FOR A PARTITION-RESIDENT DRIVER * NEWDP JSB SCDRV SCAN IDENTS JMP DPDON NO MORE - DONE WITH DP'S RSS GOT A PRD! JMP NEWDP NO, IT WAS AN SDA DRIVER * * PRINT DP HEADING * SHEAD LDA DPNUM CONVERT CMA PARTITION NUMBER LDB ATBUF TO ASCII JSB \CONV AND LDA \TBUF+2 STORE STA MESPD IN MESSAGE LDA P7 LDB MESDP JSB \MESS PRINT: DP XX: JSB \SPAC * LDA \CBPA RESET THE CP LINK AREA TO "EMPTY" STA \CPL2 LAST CP AREA = LAST BP ARÁ‚þúEA STA CPLS LAST "SAVE" CP AREA = LAST BP AREA LDA DPADD SET STARTING RELOCATION STA \PREL ADDRESS LDB DPNUM DON'T CHANGE SPECIFICATION SZB MAPS YET IF STILL DP #1 JSB \USRS INITIALIZE \ABDO MAP * * LOAD THE DRIVER INTO THE PARTITION * LPRD LDA \ID3,I GET USAGE WORD CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RESTORE * JSB \DPLD LOAD THE PROGRAM VIA \NLOD (RT4G4) JSB INCAD UPDATE PBREL & \PREL LDB LWDP1 GET LAST LOGICAL WORD ADDRESS CMB,INB OF A DP, AND CHECK FOR OVERFLOW ADB A OF THIS DRIVER'S RELOCATION SSB JMP SCDVM IT FIT, NOW GO UPDATE THE DVMAP ENTRIES * LDA ERR59 IRRECOVERABLE ERROR JSB \IRER SEND DIAGNOSTIC, AND THEN TERMINATE ERR59 ASC 1,59 SEND DRIVER IS TOO LARGE FOR A DP * * * SCAN THE DRIVER MAP TABLE FOR ENTRIES MATCHING * THE CURRENT DRIVER IDENT, AND UPDATE THE ENTRIES * TO THE STARTING PAGE OF ITS PARTITION. * SCDVM STB LEFTO SAVE NEGATIVE # WORDS LEFT IN DP JSB \SYS DVMAP IS IN THE SYSTEM MAP LDB DVMAP GET ITS MEMORY ADDRESS LDA CEQT AND THE NUMBER OF ENTRIES CMA SET A NEGATIVE STA TEMP1 LOOP COUNTER * SCDV1 ISZ TEMP1 BUMP ENTRY COUNTER RSS CONTINUE CHECKING FRO MATCHING IDENTS JMP MORE? DONE WITH THIS DRIVER - FIND NEXT JSB DPRW GET THE CONTENTS OF THE NEXT ENTRY RAL CHECK FOR A NON-UPDATED ENTRY SSA,RSS FROM A PRD-DRIVER JMP SCDV1 WAS AN SDA, OR UPDATED PRD AND M7777 CLEAR THE SIGN BIT RAR AND SHIFT BACK TO CORRECT POSITION CPA IMAIN IS THIS FOR THE CURRENT DRIVER? RSS YES, A MATCH JMP SCDV1 NO, CONTINUE THE SCAN * LDA PAGE# ??? GET STARTING PAGE OF THIS PARTITION ADB >þúN1 MOVE BACK TO ENTRY ADDRESS JSB \ABDO AND UPDATE IT JMP SCDV1 LOOK FOR MORE OF THE SAME * * * SEE IF ANOTHER DRIVER WILL FIT INTO THIS PARTITION * MORE? LDA P10 RESET SCAN TO START AT BEGINNING STA CIDNT OF IDENT TABLE MORE1 JSB SCDRV SCAN FOR A PRD JMP ZFIL NO MORE, ZERO-FILL REMAINDER OF DP RSS JMP MORE1 AN SDA - TRY AGAIN * LDA \ID8,I GET THE DRIVER'S MAIN PROGRAM SIZE AND M3777 ADA LEFTO DOES IT FIT INTO DP? SSA,RSS JMP MORE1 NO, TRY FOR ANOTHER * JSB CPL? IF CPL'S IN EFFECT, GET ESTIMATED SIZE JMP MORE1 NOW IT'S TOO BIG, TRY FOR ANOTHER * LDA DPNUM DON'T CHANGE MAPS IF STILL DP #1 SZA JSB \USER RESET CORRECT OUTPUT MAP LDA \ID3,I GET USAGE WORD OF DRIVER CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RE-STORE * LDA \ADSK GET THE CURRENT DISK ADDRESS STA EMDSK AND SAVE IN CASE OF BACKUP *TEMP* JSB \DPLD LOAD THE DRIVER AFTER PREV. ONE IN DP * * DETERMINE IF DP OVERFLOW OCCURRED - IN WHICH CASE BACKUP * MUST BE DONE * LDB LWDP1 GET LAST LOGICAL WORD ADDRESS OF A DP,+1 CMB,INB AND CHECK FOR OVERFLOW OF THIS ADB TPREL DRIVER'S RELOCATION SSB,RSS JMP DPOV TOO BAD! * STB LEFTO SAVE #WORDS STILL LEFT IN THIS DP JSB INCAD UPDATE \PREL & PBREL JMP SCDVM+1 GO FILL IN THIS DRIVER'S DVMAP ENTRIES * * DRIVER PARTITION OVERFLOW * DPOV JSB \SPAC SEND THE WARNING ONLY LDA P26 THAT A DP OVERFLOWED LDB BKUPM NO OPERATOR RECOVERY JSB \MESS * LDA IMAIN MAKE SURE THAT THE STA \TIDN CORRECT IDENT ENTRY JSB \IDX IS IN CORE JSB \ABOR NOT THERE! LDA \ID3,I NOW CLEAR ITS AND M1776 LOAD BITS STA \ID3,I lþú LDA EMDSK RESET THE DISK ADDRESS TO STA \ADSK THE VALUE BEFORE THE DRIVER WAS LOADED JSB CLFIX CLEAR ANY FIXUP ENTRIES CREATED BY IT JMP MORE1 SEE IF ANY OTHER DRIVERS WILL FIT * * * ZERO-FILL THE REMAINDER OF THE DP SINCE NO MORE WILL FIT IN IT * ZFIL LDA DPNUM RESET TO USER'S MAP SZA JSB \USER FOR DP'S #2 ... CCA POSITION TO THE LAST ADA \PREL USED ADDRESS IN THIS DP STA B AND SAVE IOR M1777 ROUND TO LAST WORD ON PAGE CPA B ANY CHANGE? JMP NEXT? NO, SO NO FILL NECESSARY LDB A GET LAST WORD ADDRESS CLA AND ZERO-FILL UP TO AND INCLUDING JSB \ABDO THAT ADDRESS * * INITIALIZE FOR LOADING THE NEXT DRIVER PARTITION * NEXT? LDA DPNUM IF THIS WAS THE FIRST DP SZA,RSS JMP DP1DN THEN WE'RE DONE FOR NOW ISZ DPNUM ELSE BUMP TO THE NEXT DP # * JSB DSKEV FORCE OUTPUT OF LAST SECTOR LDA \PREL GET # WORDS LEFT IN CURRENT CMA,INA DRIVER PARTITION ADA LWDP1 JSB CPAG# AND CONVERT TO THE NUMBER OF AND M37 UNUSED PAGES IN IT CMA,INA AND SUBTRACT FOR DP LENGTH ADA DPLN TO DETERMINE ACTUAL NUMBER ADA PAGE# USED STA PAGE# NOW SET THE STARTING PAGE OF THE NEXT DP * LDA P10 RESET IDENT INDEX FOR STA CIDNT SCAN JMP NEWDP GO START A NEW DRIVER PARTITION * LEFTO NOP BKUPM DEF *+1 ASC 13,DRIVER PARTITION OVERFLOW P26 DEC 26 SPC 4 * * * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SKP * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTSdDþú * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TB³øNLHREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SPC 5 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A Š¶Nÿÿþú JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 N1 DEC -1 SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * IDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * CPL? DETERMINES THE SPACE NEEDED BY A DRIVER WITH CURRENT PAGE LINKS * IN EFFECT - AND CHECKS TO SEE IF IT WILL FIT IN THE REMAINDER OF A * DRIVER PARTITION, WHERE LEFTO CONTAINS THE NEGATIVE NUMBER OF WORDS * LEFT IN THE DP. * * RETURN: (P+1) CPL SIZE IS TOO LARGE FOR LEFTO * (P+2) THIS DRIVER WILL FIT IN THE DP * CPL? NOP LDB \ID5,I DOES THE USET WANT SSB,RSS CURRENT PAGE LINKS? JMP CPLX NO, TAKE SUCCESS RETURN * LDA \PREL GET ADDRESS STA B OF THE LAST WORD IOR M1777 OF THE PAG· þúE CMB,INB COMPUTE THE INB NUMBER OF WORDS ADB A REMAINING ON STB TEMP2 THE PAGE * LDA \ID8,I COMPUTE THE # OF AND M3777 WORDS OF STA TEMP3 CMB,INB THE PROGRAM ADB A THAT FALL STB TEMP1 BEYOND THIS PAGE * SSB WILL THE PROGRAM RSS FIT ON THIS PAGE? SZB,RSS NO - SKIP JMP CPLX YES, SO NEEDN'T WORRY ABOUT CPL'S * LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # OF WORDS OF PROG CMB,INB ON CURRENT PAGE -OR- ADB A # OF WORDS OF PROG ON SSB,RSS NEXT PAGE * LDA TEMP1 DIVIDE THIS CLB MINIMUM DIV P4 BY FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP CPLX OF LOW CURRENT PG LINK AREA * ADA TEMP3 ADD PROGRAM SIZE ADA LEFTO AND NEGATIVE # OF WORDS LEFT SSA,RSS IN DP JMP CPL?,I WON'T FIT * CPLX ISZ CPL? BUMP RETURN ADDRESS TO INDICATE JMP CPL?,I THAT DRIVER WILL FIT - EXCLUDING LIBR RTNS * TEMP3 NOP P4 DEC 4 SKP * * CLFIX CLEARS ANY FIXUP ENTRIES BUILT BY A RELOCATED * DRIVER THAT HAS OVERFLOWED THE DRIVER PARTITION * (AND WILL THEREFORE BE RELOCATED INTO ANOTHER DP). * CLFIX NOP JSB \IFIX INITIALIZE THE FIXUP TABLE CLFX1 JSB \FIX SET ADDRESSES OF NEXT ENTRY JMP CLFIX,I END OF LIST * LDA \FIX1,I IS THIS ENTRY FREE? SSA JMP CLFX1 YES * LDB \PREL SEE IF THE ENTRY WAS BUILT CMB,INB BY AN OVERFLOWD DRIVER -CHECK ADA B ITS INSTR. ADDRESS AGAINST THE LAST SSA VALID DP RELOCATION ADDRESS JMP CLFX1 NO - ENTRY IS OK TO LEAVE * CCA CLEAR ENTRY BUILT BY STA \FIX1,I OVERFLOWED DRIVER JMP CLFX1 CONTINUE UNTIL END OF LIƒ ST * * * END SEG8 ˜=ÿÿ ÿýŽ`ï ÿ92067-18010 1926 S C0822 &4SWH1 SWTCH             H0108 ÌþúASMB,R,L,C HED SWTCH - TRANSFERS FILE CONTAINING RTE-IV SYSTEM GENERATED ONLINE NAM SWTCH,3,10 92067-16010 REV.1926 790425 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWTCH-IV * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * **************************************** SPC 2 * * TURN - ON SEQUENCE: * * RU,SWTCH,FLNAME:SC:LB,CHANNEL,SUBCHANNEL/UNIT,AUTO,FILES,TYPE6,INITS * * WHERE: * * FLNAME:SC:LB IS THE ABSOLUTE FILE NAME OF THE SYSTEM * CHANNEL IS THE OCTAL TARGET CHANNEL, WITH A "B" APPENDED * SUBCHANNEL IS THE TARGET 7900 SUBCHANNEL * OR * UNIT IS THE TARGET 7905/7920 UNIT * AUTO IS Y/N, FOR AUTO BOOT-UP * FILES IS Y/N, FOR SAVING THE TARGET FILE SYSTEM * TYPE6 IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET * INITS IS Y/N, FOR INITIALIZING ANY ADDITIONAL SUBCHANNELS SPC 2 * * * THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CONTAINING * A COMPLETE RTE-IV SYSTEM FOR A SPECIFIC CONFIGURATION. * SWTCH COPIES THE FILE ONTO THAT CHANNEL AND SUBCHANNEL(UNIT), OR * TO A USER-SPECIFIED 'TEMPORARY' CHANNEL AND SUBCHANNEL(UNIT). * AND BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, * THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION, * INCLUDING THE SYSTEM SUBCHANNEL DEFINITION. * * IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW * FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN * INTO THE FMP CARTRIDGE DIRECTORY SÿþúO THAT ON BOOTUP, FMP * WILL REMAIN INTACT (INITIALIZED). SKP * ENTRY POINTS * ENT SWTCH * ENT \SWTM ENT \DFTR,\DSHD,\DNSU,\DNSP,\DNTR,\DSUB ENT \TUNT,\TCH,\TSUB,\DUNT ENT \INIT,\LNTH ENT \BUFA,\XOUT,\SAVE ENT \TRAK,\SECT ENT \CVAS,\CLEN,\DSPL,\BLIN ENT \FFMP,\STRK ENT \BOOT,\TMT,\LU2 * * EXTERNAL ENTRY POINTS * EXT RMPAR,EXEC,$LIBR EXT OPEN,READF,LOCF,CLOSE EXT $LIBR,$LIBX * EXT \DSK0,\DSK5 EXT \INP0,\INP5 EXT \INT0,\INT5 EXT \STD0,\STD5 EXT CNUMD,GETST EXT \FLGT,\SETD,\BADH * IFN EXT DBUG XIF * SPC 2 A EQU 0 B EQU 1 SUP SKP * HEADER RECORD #1 FORMAT * * ------------------------------------ * !1! SYSTEM SUBCHANNEL # ! * ------------------------------------ * ! SYSTEM EQT # ! * ------------------------------------ * ! NUMBER OF EQT'S ! * ------------------------------------ * ! PRIV. INT. CHANNEL ! * ------------------------------------ * ! TBG CHANNEL ! * ------------------------------------ * ! # SUBCHANNELS ! TTY CHANNEL ! * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #1 * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #2 * ------------------------------------ * . . * . . * . . * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #N * ------------------------------------ SPC 2 * Úzþú HEADER RECORD #2 FORMAT * * FOR A 7905/6/20 SYSTEM: * * ------------------------------------ * ! FIRST CYLINDER # ! ONE 4-WORD * ------------------------------------ * ! # SUFACES ! STARTING HEAD ! UNIT ! ENTRY FOR * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNELS * ------------------------------------ * ! NUMBER OF SPARES ! 0 THRU 31 * ------------------------------------ * * FOR A 7900 SYSTEM: * * ------------------------------------ * ! FIRST TRACK # ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 SKP SPC 4 *------------------------------------------------------------------------ * * THE FOLLOWING 6144 WORDS WILL BE OVERLAID * ONCE THE TRANSFER PROCESS BEGINS. BUFR * WILL CONTAIN ONE TRACK'S WORTH OF INFO. * *------------------------------------------------------------------------ SPC 4 BUFR BSS 128 BUFFER FOR 1 FULL TRACK (6144 WORDS) * * MES1 DEF *+1 ASC 22, ****** W A R N I N G ****** MES2 DEF *+1 ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM ASC 9,TRANSFER PROCESS. SPC 2 BSS 384+BUFR-* NEED TO READ IN 3 RECORDS AT VERF1 SPC 2 MES3 DEF *+1 ASC 14,FILE NAME OF NEW RTE SYSTEM? MES4 DEF *+1 ASC 9,ILLEGA> þúL FILE NAME MES5 DEF *+1 ASC 15,NEW SYSTEM I/O CONFIGURATION: MES6 DEF *+1 ASC 18,SELECT CODE XX PRIVILEGED INTERRUPT MES6A DEF MES6+7 MES7 DEF *+1 ASC 9,SELECT CODE XX TBG MES7A DEF MES7+7 MES8 DEF *+1 ASC 11,SELECT CODE XX TYPE=XX MES8A DEF MES8+7 MES8B DEF MES8+11 MES9 DEF *+1 ASC 24,NEW SYSTEM (LU2) SELECT CODE= XX SUBCHANNEL= XX MES9A DEF MES9+16 MES9B DEF MES9+24 MES10 DEF *+1 ASC 12,PLATTER XX FIRST TRACK# MS10A ASC 9,XXXX #TRACKS XXXX MS10C DEF MS10A MS10D DEF MS10A+7 MES11 DEF *+1 ASC 20, HEAD# X #TRACKS XXXX #SURFACES X MS11C DEF *+1 ASC 20, UNIT# X FIRST CYL# XXXX #SPARES X MS11A DEF MES11+12 MS11B DEF MS11C+12 MS11D DEF MS11C+20 MES12 DEF *+1 ASC 25,TARGET SELECT CODE FOR NEW SYSTEM? (XX OR " "CR) MES13 DEF *+1 ASC 14,TARGET PLATTER/UNIT FOR NEW ASC 11,SYSTEM? (X OR " "CR) MES14 DEF *+1 ASC 20,NEW SYSTEM WILL OVERWRITE FILE XXXXXX. MES16 DEF *+1 ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN MES17 DEF *+1 ASC 21,TARGET PLATTER/UNIT. (" "CR TO CONTINUE) MES18 DEF *+1 ASC 16,SAVE FILES AT TARGET? (Y OR N) MES19 DEF *+1 ASC 19,NEW SYSTEM WILL DESTROY SOME FMP FILES MES20 DEF *+1 ASC 12,OK TO PROCEED? (Y OR N) MES22 DEF *+1 ASC 15,PURGE TYPE 6 FILES? (Y OR N) MES23 DEF *+1 ASC 19, INFORMATION STORED ON PLATTER/UNIT XX ASC 14, OF TARGET SELECT CODE XX MS23B DEF *+1 ASC 9, WILL BE DESTROYED MS23A DEF MES23+32 MES24 DEF *+1 ASC 12,AUTO BOOT-UP? (Y OR N) MES25 DEF *+1 ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. MES26 DEF *+1 ASC 22,SYSTEM WILL HALT AFTER TRANSFER COMPLETION. MES32 DEF *+1 ASC 17,READY TO TRANSFER. OK TO PROCEED? MES34 DEF *+1 ASC 18,INITIALIZE SUBCHANNELS ? (Y OR N) MS34A DEF MES34+12 "L" ASC 1,L MES35 DEF *+1 ASC 15,TARGET PLATTER? (XX OR " "CR) MES36 DEêþúF *+1 ASC 16,TARGET UNIT XX FOR SUBCHANNELS MS36A ASC 24, ASC 20, ASC 24, COMBL ASC 1,, MS36B DEF MS36A MES37 DEF *+1 ASC 16,DESTN. UNIT XX FOR SUBCHANNELS MS37A ASC 24, ASC 20, ASC 24, MS37B DEF MS37A MES38 DEF *+1 ASC 14,TARGET UNIT? (XX OR " "CR) * SWAP0 DEF *+1 ASC 3,SWSG1 7900 DISK DRIVER SEGMENT SWAP5 DEF *+1 ASC 3,SWSG2 7905/7920 DISK DRIVER SEGMENT SKP * CONSTANTS * B177 OCT 177 B777 OCT 777 B1774 OCT 177400 B2060 OCT 20060 * N7 DEC -7 N31 DEC -31 N64 DEC -64 N89 DEC -89 * P12 DEC 12 P14 DEC 14 P17 DEC 17 P28 DEC 28 P64 DEC 64 P98 DEC 98 P512 DEC 512 * SKP * * * F$TB SEARCHES THE RESIDENT LIBRARY ENTRY POINT * LIST FOR THE APPROPRIATE TRACK MAP TABLE, * $TB31 OR $TB32 (DEPENDENT UPON THE SOURCE * DISK TYPE), AND RETURNS IT IN BUFR. * * CALLING SEQUENCE: JSB F$TB * DEF .1 OR .2 * F$TB NOP LDA #LEP GET # OF LIBRARY ENTRY POINTS MPY P4 4 WORDS PER ENTRY STA LEPL SAVE SIZE OF L.E.P. LIST * LDA ALEP GET DISK ADDRESS OF LEP LIST LDB A ALF,ALF RAL AND B777 STA LTRK SAVE THE TRACK LDA B AND B177 F$T3 STA LSEC AND SECTOR ADA N89 DETERMINE IF THE SECTOR RESULTS IN SSA LESS THAN 512 WORDS LEFT ON TRACK JMP F$T1 <89 INA SEE HOW MANY SECTORS LESS MPY P64 CMA,INA AND SUBTRACT FROM ADA P512 512 MAX STA LLEN LENGTH OF READ JMP F$T0 F$T1 LDA LEPL JSB GTLEN GET READ LENGTH F$T0 JSB READD READ IT * CLB LDA LLEN DIV P4 GET THE # OF ENTRIES READ IN CMA,INA NEGATE STA LCNT LOOP COUNTER LDB \BUFA F$T2 STB BPTR * LDA $T CPA B,I A "$T"? INB,RSS ªþúJMP NOTIT NO LDA B3 CPA B,I A "B3"? INB,RSS JMP NOTIT NO LDA F$TB,I LDA A,I GET "1" OR "2" XOR B,I AND B1774 SZA,RSS A MATCH? JMP F$T7 YES!! * NOTIT ISZ LCNT DONE WITH CURRENT BUFFER? RSS JMP F$T4 YES LDB BPTR ADB P4 JMP F$T2 * F$T4 LDA LLEN SEE IF ALL WERE SEARCHED CMA ADA LEPL SSA IF WE'VE GONE THRU THE ENTIRE LEP JMP ABF$ THEN ITS NOT THERE, SO ABORT SWTCH INA STA LEPL NEW # LEFT * LDB LSEC DETERMINE IF TRACK CROSSING ADB N89 IF >= 88 THEN THERE WILL BE INB SSB JMP F$T5 NOPE * ISZ LTRK YES, INCREMENT TO NEXT TRACK CLB STB LSEC SET NEXT SECTOR TO 0 JMP F$T1 SET LENGTH OF READ * F$T5 LDA LSEC INCREMENT TO NEXT STARTING ADA P8 SECTOR JMP F$T3 SET LENGTH OF READ * F$T7 STB LCNT TEMPORARY SAVE LDB P17 DETERMINE IF WE'RE TO READ LDA SEQT IN A $TB31 (17 WORDS), OR SLA,RSS A $TB32 (98 WORDS) LDB P98 STB LLEN * LDB LCNT RESTORE ENTRY POINTER LDA B,I DETERMINE IF ENTRY IS AT A INB AND P1 MEMORY ADDRESS, OR A DISK SZA BY CHECKING BIT 0 OF WORD 3 JMP F$T9 DISK ADDR * LDA B,I GET THE MEMORY ADDRESS LDB SEQT DETERMINE IF USER-DEFINED TMT SLB,RSS DIFFERENT CHECKS FOR 7900-7905/7920 JMP F$T10 7905/7920 LDB A,I GET WORD 1 SSB IF NEGATIVE, THERE'S AN EXTRA WORD INA * F$T11 LDB LLEN # WORDS TO GET CMB,INB STB LCNT LOOP COUNTER LDB \BUFA STB BPTR BUFFER POINTER RSS F$T8 ISZ BPTR NEXT LOCATION LDB A,I STB BPTR,I STORE WORD INA INÚWþúCRMENT MEMORY ADDRESS ISZ LCNT DONE? JMP F$T8 NO LDA \BUFA STA BPTR ISZ F$TB JMP F$TB,I * F$T10 LDB A,I CHECK WORD 1 SSB,RSS IF POSITIVE,THERE'S AN EXTRA WORD INA JMP F$T11 * F$T9 LDA B,I TRANSLATE THE DISK ALF,ALF ADDRESS TO RAL AND B377 STA LTRK TRACK AND LDA B,I AND B177 STA LSEC SECTOR * JSB READD READ IT LDA \BUFA INA SKIP EXTRA WORD STA BPTR ISZ F$TB JMP F$TB,I * ABF$ LDA P28 LDB MES30 JSB \DSPL JMP \XOUT TERMINATE SWTCH SPC 3 #LEP EQU 1762B # OF LIBRARY ENTRY POINTS IN LIST ALEP EQU 1761B ADDR " " " LIST LEPL NOP LENGTH " " " " LCNT NOP COUNTER $T ASC 1,$T B3 ASC 1,B3 .1 ASC 1,1 .2 ASC 1,2 MES30 DEF *+1 ASC 28,SOURCE SUBCHANNEL NOT FOUND ON A SYSTEM TRACK MAP TABLE SKP * * GTLEN COMPUTES LLEN FOR READING THE * LIBRARY ENTRY POINTS LIST INTO * BUFR * * CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. * JSB GTLEN * GTLEN NOP LDB P512 THE NORMAL BUFFER SIZE CMA,INA IF MORE THAN THE REMAINING ADA P512 LEP SIZE, THEN USE THE SIZE SSA,RSS IN (A) LDB LEPL STB LLEN JMP GTLEN,I SPC 5 * * READD READS LLEN WORDS AT TRACK LTRK, AND * SECTOR LSEC * READD NOP JSB EXEC DEF *+7 DEF P1 DEF P2 DEF BUFR DEF LLEN DEF LTRK DEF LSEC * JMP READD,I * * LTRK NOP LSEC NOP SKP * * VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH * AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING * CHECKS ARE MADE: * * VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE * LAST SYSTEM TRACK (AS DEFINED BY THEþú NEW * SYSTEM) * VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY * EXISTS ON THIS TRACK * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS * AT THE FIRST PHYSICAL TRACK/CYLINDER OF * DESTINATION SYSTEM * * * RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE * (P+2) CAN SAVE IT * VFYSY NOP CLA STA \INIT CLEAR INIT WORD FOR DISKD * LDA N128 STA \LNTH READ 128 WORDS CCE HOPEFULLY THEY WILL CONTAIN LDB \BUFA THE CARTRIDGE DIRECTORY AT STB BPTR TARGET SUBCHANNEL CCA ADA \DNTR DESTINATION SYSTEM LAST(LOGICAL) STA \TRAK TRACK, LESS 1 CLA STA \SECT JSB DISKD * * * VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY * LDA N31 MAX # CARTRIDGE ENTRIES STA TEMP1 CHCD0 LDA BPTR,I GET WORD 0 OF ENTRY SSA JMP NOTFS LU WORD < 0 LDB N64 ADB A SSB,RSS JMP NOTFS LU > 77(8) * CPA P0 END OF LU'S ? JMP CHCD3 YES CPA P2 LU 2 (SYSTEM) ? RSS YES JMP CHCD1 CHECK WORDS 1-3 IN ENTRY * LDB BPTR GET WORD #1 OF THE (POSSIBLY) INB SYSTEM LU 2 ENTRY LDA B,I SSA JMP NOTFS LAST FMP TRACK WORD < 0 STA D.LT SAVE FOR LATER CHECKS * CHCD1 LDA N3 STA TEMP2 * CHCD2 ISZ BPTR CHECK WORDS 1,2,&3 LDA BPTR,I OF ENTRY FOR VALUES SSA >= 0 JMP NOTFS INVALID ISZ TEMP2 JMP CHCD2 CHECK NEXT WORD ISZ BPTR NEXT ENTRY WORD 0 ISZ TEMP1 LAST ENTRY (31)? JMP CHCD0 NO,CONTINUE * CHCD3 LDA D.LT (WAS INITIALLY -1) SSA JMP NOTFS NEVER SET BY A LU 2 LDA BF124 SZA JMP NOTFS WORD 124 OF CD MUST = 0 * * * LOOKED LIKE A CARTRIDGE DIRECTORY. NOW TRY[Rþú FOR A * FILE DIRECTORY IN THE NEXT BLOCK. * CCA ADA \DNTR DETERMINE DISK ADDRESS OF NEXT STA \TRAK BLOCK CONTAINING THE LDA P14 FILE SPEC ENTRY STA \SECT READ 128 WORDS, HOPEFULLY THE LDB \BUFA SPEC ENTRY STB BPTR CCE JSB DISKD * LDA BPTR,I TESTS FOR A VALID FILE DIRECTORY ENTRY: SSA,RSS JMP NOTFS WORD 0 MUST BE < 0 * LDA N7 WORDS 1-7,9-15 IN SPEC MUST BE >= 0 STA TEMP2 CHFD1 ISZ BPTR LDA BPTR,I SSA JMP NOTFS < 0, THEREFORE INVALID ISZ TEMP2 JMP CHFD1 * ISZ BPTR WORD 8 MUST BE < 0 LDA BPTR,I SSA,RSS JMP NOTFS LDA N6 NOW CHECK WORDS 9-15 STA TEMP2 CHFD2 ISZ BPTR LDA BPTR,I SSA JMP NOTFS ISZ TEMP2 JMP CHFD2 * LDA BF6 WORD 6 (#SECTORS/TRACK) MUST BE LDB BF5 >= WORD 5 (NEXT AVAILABLE SECTOR) CMB,INB ADA B SSA JMP NOTFS INVALID * LDA BF7 LOWEST DIRECTORY TRACK(LOGICAL) LDB BF8 MINUS THE NEGATIVE # DIRECTORY STB D.# TRACKS, CMB MINUS 1 ADA B GIVES LAST FMP TRACK CPA D.LT MUST = LAST FMP TRACK INDICATED RSS IN CD FOR LU 2 JMP NOTFS INVALID * LDB \DNTR DOES THE LOGICAL DIRECTORY TRACK # ADB N1 AT TARGET = LOGICAL DIRECTORY TRACK # CPA B FOR DESTINATION (THE LAST LOGICAL TRACK FOR RSS SYSTEM LU) ? JMP NOTFS NO LDA BF4 SAVE THE FIRST FMP TRACK FOR STA \FFMP FUTURE CHECKS * * * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS AT THE * DESTINATION SYSTEM'S PHYSICAL LOCATION OF LOGICAL TRACK 0 * SECTOR 0 * LDB \BUFA READ(HOPEFULLY) THE TRACK 0,SECTOR 0 STB BPTR BOOTSTRAP CCE CLA Œeþú STA \TRAK STA \SECT JSB DISKD * CCA JSB VT0S0 VERIFY ITS EXISTENCE JMP NOTFS NO GOOD * LDA BF99 TBASE (WORD 100 OF BOOTSTRAP) IS THE CPA \DFTR PHYSICAL LOCATION (TRACK OR CYLINDER) OF RSS TRACK 0 AT THE TARGET - MUST BE EQUAL JMP NOTFS TO THAT OF DESTINATION TRACK 0 * LDA DEQT FURTHER CHECKS FOR A 7905/7920 SYSTEM SLA REPLACEMENT JMP VOUT * LDA BF97 GET NUMBER OF SURFACES CPA \DNSU SAME AS DESTINATION? RSS JMP NOTFS NO LDA BF98 GET STARTING HEAD # CPA \DSHD SAME AS DESTINATION? RSS JMP NOTFS NO * VOUT ISZ VFYSY LOOKS VALID JMP VFYSY,I SPC 2 * * ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE * TARGET FILE STRUCTURE TO BE SAVED * NOTFS LDA \TSUB LDB DEQT SLB,RSS LDA \TUNT ADA B2060 STA MES23+19 LDA P1 SET FO \CVAS STA \CLEN LDA \TCH LDB MS23A JSB \CVAS LDA P33 LDB MES23 "INFORMATION STORED ON PLATTER UNIT XX OF JSB \DSPL TARGET CHANNEL YY WILL BE DESTROYED" LDA P9 LDB MS23B JSB \DSPL * JSB OK? CHECK ANSWER * CLA STA \SAVE DON'T \SAVEFILES STA TYP6 " " PURGE TYPE 6'S JMP VFYSY,I * P33 DEC 33 * BF4 EQU BUFR+4 BF5 EQU BUFR+5 BF6 EQU BUFR+6 BF7 EQU BUFR+7 BF8 EQU BUFR+8 BF97 EQU BUFR+147B # SURFACES IN 7905 BOOT EXTENSION BF98 EQU BUFR+150B STARTING HEAD IN 7905 BOOT EXTENSION BF99 EQU BUFR+143B FIRST TRACK IN BOOT EXTENSION BF124 EQU BUFR+124 SKP * VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP * * CALLING SEQUENCE: (A) = -1 WHERE II/III/IV BOOT EXTENSION IS OKAY * = 0 WHERE RTE-IV BOOT EXTENSION IS REQUIRED * * * RETURN: (P+1) NO¸™þúT A BOOTSTRAP * (P+2) YES, ONE EXISTS * VT0S0 NOP STA STDSK SAVE FLAG IN TEMPORARY * LDB BPTR TRY FOR AN RTE-IV SYSTEM FIRST ADB B155 COMPARE WORDS: LDA B,I CPA WD155 WORD 155 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD156 WORD 156 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD157 WORD 157 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD160 WORD 160 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD161 WORD 161 INB,RSS JMP BE23 NO, TRY A II/III INB SKIP WORD 162 LDA B,I CPA WD163 WORD 163 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD164 WORD 164 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD165 WORD 165 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD166 WORD 166 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD167 WORD 167 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD170 WORD 170 RSS JMP BE23 NO, TRY A II/III ISZ VT0S0 FOUND ONE JMP VT0S0,I SO EXIT * BE23 ISZ STDSK IS A II/III EXTENSION ALLOWED? JMP VT0S0,I NO, SO TAKE FAILURE EXIT * LDB BPTR CHECK MATCH ON WORDS 3,4,5(ALL SAME),6,7 ADB P2 LDA B,I 14,15,16,17,20 CPA WD345 WORD 3 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 4 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 5 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD6 WORD 6 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD7 WORD 7 RSS JMP VT0S0,I NO ADB P5 LDA ›þúB,I CPA WD14 WORD 14 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD15 WORD 15 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD16 WORD 16 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD17 WORD 17 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD20 WORD 20 RSS JMP VT0S0,I NO ISZ VT0S0 JMP VT0S0,I OK!!!!! SPC 2 WD345 OCT 017506 BOOTSTRAP WORDS 3,4,& 5 WD6 OCT 124003 " WORD 6 WD7 OCT 002011 " WORD 7 WD14 OCT 003304 " WORD 14 WD15 OCT 040001 " WORD 15 WD16 OCT 005225 " WORD 16 WD17 OCT 106702 " WORD 17 WD20 OCT 106602 " WORD 20 WD155 OCT 000000 " WORD 155 WD156 OCT 102106 " WORD 156 WD157 OCT 107700 " WORD 157 WD160 OCT 006400 " WORD 160 WD161 OCT 102501 " WORD 161 WD163 OCT 101045 " WORD 163 WD164 OCT 002011 " WORD 164 WD165 OCT 026201 " WORD 165 WD166 OCT 102077 " WORD 166 WD167 OCT 026202 " WORD 167 WD170 OCT 106601 " WORD 170 * B155 OCT 155 SKP * * STDSK CONTROLS THE CALL TO CONFIGURE THE * DISK DRIVER (EITHER \DSK0 FOR 7900 OR \DSK5 * FOR 7905/7920), VIA A CALL TO \STD0 OR \STD5 * STDSK NOP LDA DEQT SLA JMP STDS1 JSB \STD5 CONFIGURE THE 7905/7920 DRIVER JMP STDSK,I * STDS1 JSB \STD0 CONFIGURE THE 7900 DRIVER JMP STDSK,I SKP * OK? QUERIES THE USER WITH: * "OK TO PROCEED? (Y OR N)" * AND TRANSFERS TO \XOUT ON A "N" RESPONSE, * DOING A SIMPLE RETURN ON A "Y" RESPONSE. * OK? NOP LDA P12 LDB MES20 JSB \DSPL JSB YE?NO DECIPHER ANSWER JMP OK?+1 INVALID REPLY JMP OK?+1 INVALID REPLY JMP \XOUT NO,TERMINATE SWTCH JM§“NLHP OK?,I SPC 4 * YE?NO READS THE OPERATOR ANSWER ( Y OR N ) * RETURNS TO (P+1) IF INVALID ANSWER * (P+2) IF /E * (P+3) IF NO * (P+4) IF YES * YE?NO NOP JSB EXEC RETRIEVE ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N2 SZB,RSS JMP YE?NO+1 TRY AGAIN FOR A RESPONSE * CLE CHECK HIGH HALF FIRST LDA BUFR CPA "/E" JMP EOUT YENO ALF,ALF AND B377 CPA "N" JMP NOUT CPA "Y" JMP YOUT * SEZ CHECK THE LOW HALF? JMP YE?NO,I ALREADY DID - NEITHER MATCHES LDA BUFR SWITCH EM ALF,ALF CCE JMP YENO CHECK THE LOW HALF * YOUT ISZ YE?NO NOUT ISZ YE?NO EOUT ISZ YE?NO JMP YE?NO,I * "N" OCT 116 "Y" OCT 131 "/E" ASC 1,/E SPC 4 * * READS TARGET RESPONSES, INCLUDING RE-ISSUING EXEC CALL * IN CASE OF TIME-OUTS. * TARGT NOP JSB EXEC GET REPONSE DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N8 SZB,RSS ANYTHING ENTERED? JMP TARGT+1 NO JMP TARGT,I YES, RETURN SKP * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. (B) IS THE LENGTH OF INPUT IN CHARACTERS ™pNÿÿþú* RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * DFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP DFLT,I NO, SO DON'T BOTHER CHECKING LDA BUFR AND B1774 CPA LBLNK ISZ DFLT GOT ONE JMP DFLT,I * LBLNK OCT 20000 SKP * * PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) * PRODUCES A PARAMETER BUFFER 12 WORDS LONG * * THE TWELVE WORDS ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 8 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR : P1 : P2 , P3 , P4 , P5 , P6 , P7 , P8 * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 14,15 * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH " * WORD 11 = 7TH " * WORD 12 = 8TH " SPC 2 * * WHERE: * DNAME = TWELVE WORD DESTINATION PARAMETER BUFFER ADDRESS * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "PARMP" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE T:þúPASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER. * SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 INBUF NOP INPUT BUFFER ADDRESS PARML NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF * PARMP NOP CCA SET TO NO COMMAS STA FRSTC CLA,INA STA ISTRC SET FIRST CHAR LDB \BUFA STB INBUF INPUT BUFFER ADDRESS LDB DNAME STB BPTR NOW CLEAR OUT DEST BUFFER LDA N12 GET DEST BUFFER LENGTH STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 STA WORD4,I INITIALIZE THE TYPE WORD STA FILEW AND THE FILE FLAG LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB PARML GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DI\DN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - PARML -1 CCA,SEZ TEST E FOR ERROR JMP PARMP,I RETURN A= -1 FOR ERROR LDA BPTR GET DESTINATION BUFFER LDB A ADB P3 SET ADDRESS OF TYPE WORD STB BPTR AND BUFFER POINTER LDB P3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER STA FILEW AND SAVE FILE TYPE(IF ANY) LDB FRSTC WAS A COMMA ENCOUNTERED SZB JMP MORE0 NO RAR,RAR YES, SKIP APPROPRIATE RAR,RAR POSITIONS IN WORD4,I STA WORD4,I FOR P1 AND P2 ISZ BPTR AND UPDATE DESTINATION ISZ BPTR POINTER JMP MORE1 MORE0 LDB N2 SET TO GET THE NEX±þúT 2 PARAMETERS AFTER: STB SUBCT ISZ BPTR LDA BPTR CLB,INB JSB SCAN IOR WORD4,I SET BITS FOR SECURITY CODE (FIRST TIME THRU), RAR,RAR OR LABEL PARAMETER(SECOND TIME THRU) STA WORD4,I ISZ SUBCT RSS JMP MORE1 LDB FRSTC GOT A COMMA AFTER ONLY ONE COLON? SZB JMP MORE0+2 NO, A SECOND COLON ISZ BPTR UPDATE DESTINATION POINTER RAR,RAR AND TYPE BITS FOR NULL PARAMETER P2 STA WORD4,I MORE1 LDB N6 NOW SCAN FOR NEXT 6 SUB-PARAMS STB SUBCT MORE2 ISZ BPTR LDA BPTR GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM IOR WORD4,I MERGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL EIGHT? JMP MORE2 NO, CONTINUE JMP PARMP,I SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+PARML SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+PARML = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU PARML ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *-íëþú ADB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA FSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINUS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR CHARACTER AMORE STB FSTCA SAVE THE 1ST CHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP INCOM CHECK FOR FIRST COMMA CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER !þú ISZ ISTAR ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECK IT SPC 2 INCOM ISZ FRSTC FIRST COMMA? NOP NO SPC 2 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERSION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, RETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER SPC 1 MMORE MPY BASE1 TRY CONVERSION STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA P3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS n4þú CLE,ELB FORM CHARACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 FRSTC DEC -1 FIRST COMMA NOT IN YET O10 OCT 10 D10 DEC 10 SUBCT NOP HOLDS SUB-PARAM. COUNTER N12 DEC -12 SPC 4 WORD4 DEF *+5 ADDRESS FOR TYPE WORD DNAME DEF *+1 NAME BSS 3 FOR FILE NAME BSS 1 TYPE WORD ¾áþúBSS 8 PARAMETERS 1-8 ISECU EQU NAME+4 ICR EQU NAME+5 PARM3 EQU NAME+6 PARM4 EQU NAME+7 PARM5 EQU NAME+8 PARM6 EQU NAME+9 PARM7 EQU NAME+10 PARM8 EQU NAME+11 APARM EQU NAME FILEW NOP SKP * PYN - CHECKS FOR A "Y" OR "N" TURN-ON PARAMTER * A-REG = THE PARAMETER * B-REG = PRESENT STATE OF WORD 4,I * * RETURN:(P+1) NEITHER, OR NOT SPECIFIED * (P+2) GOT ONE, A-REG = 0 FOR NO, =1 FOR YES * PYN NOP STA TEMP1 SAVE THE PARAMETER RBR,RBR NEXT WORD4 POSITION SLB,RSS IS THIS PARAMETER SPECIFIED? JMP PYN,I NO * LDA B AND P3 CPA P3 ASCII? RSS JMP PYN,I NO STB TEMP2 SAVE CCB LDA TEMP1 ALF,ALF SHIFT TO LOW AND B377 CPA "N" CLB CPA "Y" CLB,INB SSB,RSS ISZ PYN MATCH SSB,RSS ISZ BATCH ONE MORE FOUND NOP LDA B RESTORE LDB TEMP2 JMP PYN,I SPC 3 B400 OCT 400 N72 DEC -72 P384 DEC 384 "!!" ASC 1,!! SKP * * * MAINLINE CODE FOR SWTCH * * THE PRECEDING CODE AND THE CODE UP TO BFULL IS OVERLAID * WHEN THE TRANSFER IS BEGUN * SWTCH NOP STB APARM JSB RMPAR DEF *+2 DEF APARM * IFN JSB DBUG DEF *+1 XIF * * SET UP THE OPERATOR'S LU * LDA APARM GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ APARM NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? JMP *+3 NO,ASCII - USE DEFAULT LU 1 LDA APARM STA OPLU SET THE LU * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * LDA SYSTY GET I-O CHANNEL ADA P3 OF SYSTEM CONSOLE LDA A,I AND B77 STA HTTY * JSB \BLIN LDA P22 DISPLAY WARNING MESSAGES. LDB ME+þúS1 JSB \DSPL LDA P32 LDB MES2 JSB \DSPL * * * PARSE THE TURN-ON PARAMETERS * JSB GETST GET THE PARAMETER STRING DEF *+4 DEF BUFR DEF P48 DEF ERR * PARS SZB,RSS ANY THERE? JMP GTNAM NO RBL CONVERT TO CHARACTERS STB PARML SAVE # CHARACTERS JSB PARMP GO PARSE THEM CPA N1 JMP GTNAM COUL\DN'T * * RETRIEVE CHANNEL PARAMETER * LDB WORD4,I GET THE TYPE WORD INTO B SZB,RSS LDB FILEW FILE NAME ONLY SPECIFIED? SZB,RSS JMP GTNAM NO PARAMTERS BLF,BLF SWAP HIGH AND LOW BLF SLB,RSS CHECK BITS 5-4 JMP CP2 NOT SPECIFIED LDA B AND P3 CHECK TYPE CPA P1 RSS JMP CP2 NOT AN INTEGER LDA PARM3 STA \TCH GOT ONE - CHECK IT'S RANGE LATER ISZ BATCH * * RETRIEVE THE SUBCHANNEL/UNIT CP2 RBR,RBR GET BITS 7-6 TO LOW SLB,RSS JMP CP3 NOT SPECIFIED LDA B AND P3 CPA P1 MUST BE AN INTEGER RSS JMP CP3 NOT ONE LDA PARM4 STA \TSUB SAVE IT ISZ BATCH * * RETRIEVE PARAMETERS 5, 6, 7, AND 8 CP3 LDA PARM5 JSB PYN CHECK BITS 9-8 RSS NO GOOD STA AUTO LDA PARM6 JSB PYN CHECK BITS 11-10 RSS NO GOOD STA \SAVE LDA PARM7 JSB PYN CHECK BITS 13-12 RSS NO GOOD STA TYP6 LDA PARM8 JSB PYN CHECK BITS 15-14 RSS NO GOOD STA SUBI * LDA FILEW GET FILE TYPE CPA P3 ASCII FILE NAME? ISZ BATCH YES, NOP * CPA P3 FILE NAME? JMP VERIF YES, GO VERIFY IT GTNAM JSB \BLIN NO. LDA P14 LDB MES3 JSB \DSPL ASK FOR FILE NAME, SECUR, LABEL. * READ ÆþúN JSB EXEC READ INPUT. DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N72 * SZB,RSS JMP READN TRY AGAIN FOR RESPONSE STB PARML POSITIVE # CHARACTERS. * LDA BUFR WANT TO EXIT? CPA "!!" CHECK FOR !! JMP \XOUT YES * JSB PARMP PARSE THE STRING. SSA JMP GTNAM TRY AGAIN * VERIF JSB OPEN OPEN THE FILE. DEF *+7 DEF DCB DEF ERR DEF NAME DEF P0 DEF ISECU DEF ICR * SSA,RSS OPEN ERROR? JMP VERF1 NO. * ERRV LDA P9 YES. DISPLAY MSG AND RE-TRY. LDB MES4 JSB \DSPL JSB CLOSE DEF *+3 DEF DCB DEF ERR JMP GTNAM * VERF1 CPA P1 TYPE 1 FILE? JMP READH JMP ERRV NO * READH JSB READF READ FIRST THREE RECORDS. DEF *+5 DEF DCB DEF ERR DEF BUFR DEF P384 * SSA READ ERROR? JMP ERRV YES. * LDB \BUFA DOES THIRD RECORD LOOK LIKE ADB P256 STB BPTR A TRACK 0, SECTOR 0 BOOTSTRAP? CLA JSB VT0S0 VERIFY IT JMP ERRV NOT ONE * * LDA DCB+5 SAVE FILE SIZE. ARS ADA N2 LESS TWO FOR HEADER RECORDS STA SIZE # 128-WORD SECTORS. CLB DIV P48 GET LENGTH IN TRACKS SZB INA FOR PARTIAL TRACKS ADA P9 SYSTEM AVAILABLE TRACKS STA \STRK SIZE IN TRACKS * LDA DCB+9 SAVE DCB CONTENTS STA TEMP1 JSB CLOSE BEFORE CLOSING THE DEF *+3 ABSOLUTE OUTPUT FILE DEF DCB VIA FMP DEF ERR LDA TEMP1 NOW FUDGE THE DCB IN ORDER STA DCB+9 KEEP IT OPEN CLA CLEAR THE IN-BUFFER FLAGS STA DCB+13 SKP * * PROCESS HEADER RECORD * LDA BUFR GET NEW SYSTEM INFO  þú SSA,RSS CHECK TYPE JMP ERRV NOT AN RTE-IV SYSTEM AND B7777 MASK OFF BIT 15 STA \DSUB DESTINATION SUBCHANNEL LDA BUFR+2 STA #EQTS # EQT'S IN SYSTEM LDA BUFR+3 STA DPI DESTINATION PRIVILEGED INTERRUPT LDA BUFR+4 STA DTBG " TBG CHANNEL LDA BUFR+5 STA B AND SAVE AND B377 ISOLATE STA DTTY " TTY CHANNEL LDA B ALSO GET THE ALF,ALF AND B377 NUMBER OF STA #SUBC DEFINED SUBCHANNELS LDB \BUFA ADB BUFR+1 ADB P5 LDA B,I ALF,ALF AND B377 STA \DCH " SYSTEM DISK CHANNEL LDA B,I AND B377 STA DEQT " DISK TYPE(EQT) * LDA \BUFA MOVE THE TRACK MAP TABLE IMAGE ADA P128 TO THE PERMANENT STORAGE LDB \TMT AREA MVW P128 FROM HEADER RECORD #2 * * ROLLS IN THE CORRECT DISK DRIVER SEGMENT, DEPENDENT * UPON THE DESTINATION DISK TYPE * LDB SWAP5 ADDRESS OF 7905/7920 SEGMENT'S NAME LDA DEQT SLA LDB SWAP0 " 7900 " " STB SWAPA JSB EXEC ROLL IN THE SEGMENT - IT WILL DEF *+3 COME BACK TO \SWTM AFTER DEF P8 EXECUTING THE SEGMENT'S SWAPA NOP FRONT END CODE * * * DISPLAY DESTINATION I/O CONFIGURATION * \SWTM JSB \BLIN LDB MES5 LDA P15 JSB \DSPL "NEW SYSTEM I/O CONFIGURATION" JSB \BLIN * LDB P1 SET FOR \CVAS STB \CLEN LDA DPI SZA,RSS DEFINED? JMP OUT1 NO LDB MES6A JSB \CVAS LDA P18 LDB MES6 JSB \DSPL "SELECT CODE XX PRIVILEGED INTERRUPT" * OUT1 LDA DTBG LDB MES7A JSB \CVAS LDA P9 LDB MES7 JSB \DSPL "SELECT CODE XX TBG" * LDA #EQTS GET REMAININGâiþú EQT'S CMA,INA STA TEMP2 NEG. # EQT'S ST0 LDA #EQTS CMA,INA STA TEMP1 NEG. CURRENT EQT # LDB \BUFA ADB P5 STB TEMP4 POSITION IN EQT'S, LESS 1 * ST1 ISZ TEMP4 LDA TEMP4,I GET ENTRY ALF,ALF AND B377 AND ITS CHANNEL CPA CURCH NEXT CHANNEL? RSS JMP ST2 NOPE LDB MES8A YES,DISPLAY IT JSB \CVAS LDA TEMP4,I AND B377 LDB MES8B JSB \CVAS LDA P11 LDB MES8 JSB \DSPL "SELECT CODE XX TYPE YY" ISZ TEMP2 INCREMENT # FOUND RSS JMP ST4 ALL DONE * ST2 ISZ TEMP1 END OF EQT LIST? JMP ST1 NO ISZ CURCH CHANNEL NOT IN SYSTEM JMP ST0 SEARCH FOR NEXT * * * DISPLAY DESTINATION SYSTEM SUBCHANNEL DEFINITION * ST4 JSB \BLIN LDA \DCH GET DESTINATION SELECT CODE # LDB MES9A JSB \CVAS LDA \DSUB LDB MES9B JSB \CVAS LDA P24 LDB MES9 JSB \DSPL "NEW SYSTEM(LU 2) SELECT CODE=XX SUBCHANNEL=XX" * JSB \BLIN LDA DEQT SLA,RSS JMP D05 7905/7920 DESTINATION DISK * LDA \DSUB ADA B2060 ALF,ALF STA MES10+5 STORE PLATTER # IN MESSAGE LDA \DFTR CMA,INA LDB P2 SET FOR \CVAS STB \CLEN LDB MS10C " FIRST TRACK # " JSB \CVAS LDA \DNTR CMA,INA LDB MS10D " # TRACKS " JSB \CVAS LDA P21 LDB MES10 " LOGICAL SUBCHANNEL XX FIRST TRACK XXX JSB \DSPL # TRACKS XXX" JMP GETEM * D05 LDA \DSHD 7905/7920 SUBCHANNEL DEFINITION ADA B2060 STA MES11+4 STORE HEAD # IN MESSAGE LDA P2 STA \CLEN LDA \DNTR CMA,INA LDB MS11A " # TRACKS " JSB \CVAS LDA \DUNT ADA B2060 STA ëàþúMS11C+4 " UNIT # " LDA \DNSU ADA B2060 STA MES11+20 " # SURFACES " LDA \DFTR CMA,INA LDB MS11B " FIRST TRACK " JSB \CVAS LDA \DNSP CMA,INA CLB,INB STB \CLEN LDB MS11D JSB \CVAS " # SPARES " LDA P20 LDB MES11 " UNIT # XX FIRST CYL # XXX HEAD # X JSB \DSPL # SURFACES X #TRACKS XXX #SPARES XXX" LDA P20 LDB MS11C JSB \DSPL SKP * * CHECK TARGET CHANNEL * GETEM JSB \BLIN LDA \TCH GET TARGET CHANNEL SSA,RSS SPECIFIED? JMP CHCH YES, CHECK FOR VALIDITY ASKCH LDA P25 LDB MES12 JSB \DSPL "TARGET SELECT CODE FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB DFLT CR? JMP ASK1 NO LDA \DCH YES, DEFAULT TARGET CHANNEL STA \TCH TO DESTINATION CHANNEL JMP GTSCH * ASK1 LDA P2 JSB GETOC CONVERT ANSWER JMP ASKCH ERROR-TRY AGAIN STA \TCH * CHCH ADA N8 CHECK FOR CORRECT SSA RANGE (10-77 OCTAL) JMP ASKCH < 10, TRY AGAIN ADA N56 SSA,RSS JMP ASKCH > 77, TRY AGAIN * * CONFIGURE THE DISK DRIVER DISKD TO THE TARGET CHANNEL * GTSCH JSB STDSK * * CHECK TARGET SUBCHANNEL OR UNIT * LDA \TSUB GET THE TARGET SUBCHANNEL SSA,RSS SPECIFIED? JMP CHSB YES, CHECK VALIDITY ASKSB JSB \BLIN LDA P25 LDB MES13 JSB \DSPL "TARGET PLATTER/UNIT FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB DFLT CR? JMP ASK3 NO LDA DEQT SLA,RSS DEFAULT TO EITHER 7900 SUBCHANNEL OR 7905/7920 UNIT JMP ASK2 LDA \DSUB DEFAULT TARGET SUBCHANNEL TO DESTINATION SUBCHANNEL STA \TSUB JMP CHOV * ASK2 LDA \DUNT STA \TUNT DEFAULT TARG¾fNLHET UNIT TO DESTINATION UNIT JMP CHOV * ASK3 LDA P1 JSB GETOC CONVERT ANSWER TO OCTAL JMP ASKSB ERROR, TRY AGAIN STA \TSUB **TEMP** * CHSB ADA N8 SSA,RSS JMP ASKSB > 7, TRY AGAIN LDB \TSUB LDA DEQT FOR THE 7905/7920, SAVE THE ANSWER AS THE UNIT SLA,RSS STB \TUNT SKP * * CHECK FOR OVERWRITE OF ABSOLUTE FILE CONTAINING NEW SYSTEM * CHOV JSB LOCF GET LU OF DISK DEF *+8 CONTAINING THE FILE. DEF DCB DEF ERR DEF IREC DEF IRB DEF IOFF DEF JSEC DEF SLU * JSB EXEC GET SOURCE EQT TYPE DEF *+6 AND CHANNEL # DEF P13 DEF SLU DEF IEQT5 DEF IEQT4 DEF SSBCH * LDA IEQT4 AND B77 STA SCH DISC CHANNEL LDA IEQT5 ALF,ALF AND B77 STA SEQT DISC TYPE * CPA DEQT SAME AS TARGET TYPE? RSS JMP OKAY NO, THEN NO PROBLEM WITH OVERLAYING ABS FILE LDA SCH CPA \TCH SAME DISC CHANNEL? RSS JMP OKAY NO, AGAIN NO PROBLEM * LDA SEQT GET DISC TYPE SLA,RSS JMP OV05 CHECK VIA 7905/7920 t8Nÿÿþú* * * GET 7900 SOURCE SUBCHANNEL DEFINITION VIA $TB31 * JSB F$TB SEARCH THRU SYSTEM ENTRY POINTS FOR IT DEF .1 LDA BPTR GO INTO TABLE AND RETRIEVE: ADA SSBCH LDB A,I STB SFTR SOURCE SUBCHANNEL'S FIRST(PHYSICAL) TRACK * * * 7900 CHECKS FOR OVERWRITE OF ABSOLUTE FILE * LDA SSBCH GET SOURCE SUBCHANNEL(IE, PLATTER) CPA \TSUB COMPARE WITH TARGET SUBCHANNEL RSS JMP OKAY NO PROBLEM, DIFFERENT SUBCHANNELS * LDA \STRK GET NEW SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK # ADA SFTR CONVERT TO ABSOLUTE LAST TRACK OF FILE,+8 ADA N9 LESS THOSE AVAILABLE TRACKS CMA,INA NEGATE ADA \DFTR ADD FIRST TRACK OF NEW SYSTEM SSA,RSS LAST SOURCE TRACK MUST BE < FIRST SYSTEM TRACK JMP OKAY NO PROBLEM LDA \DFTR GET FIRST SYSTEM TRACK CMA ADA DCB+3 ADD FIRST FILE TRACK ADA SFTR CONVERT TO ABSOLUTE FOR FILE SSA,RSS FIRST SOURCE TRACK MUST BE > FIRST SYSTEM TRACK JMP OKAY NO PROBLEM * * * NEW SYSTEM WILL OVERLAY ABSOLUTE FILE CONTAINING IT * OVWR JSB \BLIN LDA NAME STORE ABS, FILE NAME IN MESSAGE STA MES14+17 LDA NAME+1 STA MES14+18 LDA NAME+2 STA MES14+19 LDA P20 LDB MES14 JSB \DSPL TELL USER JMP \XOUT TERMINATE SWTCH SKP *CONSTANTS B37 OCT 37 B77 OCT 77 N56 DEC -56 P11 DEC 11 P18 DEC 18 P15 DEC 15 P21 DEC 21 P19 DEC 19 P23 DEC 23 P24 DEC 24 P25 DEC 25 P31 DEC 31 P256 DEC 256 * IOFF NOP IRB NOP IREC NOP JSEC NOP * * SUBCHANNEL DEFINITION CONTAINING THE ABSOLUTE (SOURCE) FILE * SEQT NOP SOURCE CHANNEL EQT TYPE SCH NOP " " SSBCH NOP " SUBCHANNEL SFTR NOP " " FIRST TRACK SNHD NOP " Vþú " STARTING HEAD SNSU NOP " " # SURFACES SUNIT NOP " " UNIT SLU NOP " LU SPC 2 * HOST => CURRENT SYSTEM UNDER WHICH SWTCH IS OPERATING * HSBCH NOP HOST SYSTEM DISK SUBCHANNEL HCH NOP " " " CHANNEL HEQT NOP " " " TYPE HUNIT NOP " " " UNIT (7905/6/20) HNHD NOP " " SUBCHANNEL STARTING HEAD (7905/6/20) HNSU NOP " " " # SURFACES HFTR NOP " " " STARTING TRACK/CYLINDER HTTY NOP " " TTY CHANNEL SKP * * GET 7905/7920 SOURCE SUBCHANNEL DEFINITION VIA $TB32 * OV05 JSB F$TB DEF .2 LDA SSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA SFTR SOURCE SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA SUNIT " " UNIT # LDA B,I ALF AND B17 STA SNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA SNHD " " STARTING HEAD # * * 7905/7920 CHECKS FOR OVERWRITE OF ABS FILE * LDA SUNIT CPA \TUNT SAME UNIT? RSS JMP OKAY NO, SO OVERWRITE NOT POSSIBLE * CLB LDA \STRK GET SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK ADA N9 LESS THOSE AVAILABLE TRACKS DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER CMA,INA NEGATE ADA \DFTR ADD FIRST NEW SYSTEM CYLINDER SSA,RSS LAST SOURCE CYL MUST BE < FIRST SYSTEM CYL JMP OKAY NO PROBLEM CLB LDA DCB+3 GET FIRST SOURCE TRACK DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER LDB \DFTR GET FIRST NEW SYSTEM CYLINDER £íþú CMB ADB A ADD FIRST SOURCE CYLINDER SSB,RSS FIRST SOURCE CYL MUST BE > FIRST SYSTEM CYL JMP OKAY NO PROBLEM * * POSSIBLE OVERWRITE EXISTS: LAST CYL OF NEW SYSTEM > FIRST CYL OF * ABSOLUTE FILE * LDA SNSU GET # OF SOURCE SUBCH. SURFACES CMA,INA STA TEMP1 AND STORE ITS NEGATIVE CLB,INB LDA SNHD GET STARTING HEAD ADA DSBUF AND ITS ENTRY ADDRESS IN BUFFER SETSS CPA ESBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP INDS YES-GO SET DESTINATION SURFACES STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE(SKIP IF DONE) JMP SETSS GO SET NEXT * INDS LDA \DNSU GET # OF DESTINATION SURFACES CMA,INA STA TEMP1 AND SET NEGATIVE LDA \DSHD GET STARTING HEAD ADA DDBUF AND ITS ENTRY ADDRESS IN BUFFER SETDS CPA EDBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP OVRLP GO CHECK OVERLAPS STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE (SKIP IF DONE) JMP SETDS GO SET NEXT * OVRLP LDB N5 CHECK FOR MATCH ON ANY SURFACE STB TEMP1 LDB DDBUF STB TEMP2 SET DEST. ENTRY ADDRESS LDB DSBUF STB TEMP4 AND SOURCE ENTRY ADDRESS MATCH LDA TEMP2,I GET DEST. SURFACE SZA,RSS OCCUPIED? JMP NEXTS NO,INCREMENT TO NEXT SURFACES CPA TEMP4,I IS THE SOURCE SURFACE ALSO OCCUPIED? JMP OVWR YES,SO OVERWRITE POSSIBLE NEXTS ISZ TEMP2 INCREMENT TO NEXT SURFACE ADDRESSES ISZ TEMP4 ISZ TEMP1 DID 5 SURFACE CHECKS ALREADY? JMP MATCH NO JMP OKAY YES - AND WE MADE IT * DSBUF DEF *+1 BSS 5 SOURCE SURFACES 0-4 ESBUF DEF * DDBUF DEF *+1 BSS 5 DESTINATION SURFACES 0-4 EDBUF DEF * N5 DEC -5 SKP * * WE PASSED THE FIRST TEST!!! * * IF THE HüþúOST AND TARGET SYSTEM'S ARE BOTH 7905/7920'S THEN WE'RE * GOING TO SEARCH $TB32 NOW BEFORE THE USER HAS AN OPPOR\TUNTY * TO INSERT A DIFFERENT SYSTEM DISC. THE HOST SUBCHANNEL DEFINITION * MUST BE DETERMINED IN ORDER TO CHECK FOR AN OVERLAY OF THE HOST * SYSTEM. * OKAY JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+6 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 DEF HSBCH * LDA IEQT4 GET CHANNEL AND B77 STA HCH STA B LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 STA HEQT CPA DEQT SLA SAME DISC TYPE - SEE WHICH JMP OKAYY 7900, NO PROBLEM CUZ CAN USE SUBCHANNEL * CPB \TCH SAME CHANNEL? RSS YES JMP OKAYY NO PROBLEM HERE * * GET 7905/7920 HOST SUBCHANNEL DEFINITION VIA $TB32 * JSB F$TB DEF .2 LDA HSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA HFTR HOST SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA HUNIT " " UNIT # LDA B,I ALF AND B17 STA HNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA HNHD " " STARTING HEAD # SKP * * * OPERATOR GIVEN OPPOR\TUNTY TO INSERT CORRECT CARTRIDGE * OKAYY LDA BATCH CMA,SSA,INA,SZA SKIP IF <= 0 JMP SAVE? NOT SO IN BATCH MODE JSB \BLIN LDA P23 LDB MES16 JSB \DSPL LDA P21 "NOW IS THE TIME TO INSERT CORRECT LDB MES17 CARTRIDGE IN TARGER SUBCHANNEL/UNIT" JSB \DSPL * CRLF JSB EXEC GET ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF P3 SZB,RSS CHECK TRANS. LOG JMP CRLF TRY AGAIN FOR ANSWER * * CHECK IF FILE STRUCTURE AT TARGET IS TO BE SAVED * SAVE? LD)ýþúA \SAVE WAS IT SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SAV?? YES * SAV1 LDA P16 NO, ASK THEM LDB MES18 JSB \DSPL "SAVE FILES AT TARGET? (Y OR N) * JSB YE?NO READ ANSWER JMP SAV1 INVALID REPLY JMP SAV1 INVALID REPLY CLA,RSS NO CLA,INA YES, SAVE IT STA \SAVE * SAV?? CPA P0 DO WE SAVE THE FILES ? JMP SUBI? NOPE * * CHECK THE SYSTEM AT THE TARGET * JSB VFYSY VERIFY THE SYSTEM OUT THERE! JMP SUBI? CAN'T SAVE THE FILES * LDA \STRK SIZE OF NEW SYSTEM (INCLUDING 9 TRACKS LDB \FFMP OF AVAILABLE TRACK SPACE) MUST BE CMA,INA < FIRST FMP TRACK OF TARGET ADA B SUBCHANNEL SSA,RSS JMP SAVE6 NO PROBLEM * LDA P19 WARN USER LDB MES19 JSB \DSPL "NEW SYSTEM WILL DESTROY SOME FMP FILES" JSB OK? "OK TO PROCEED?" * CCA SET TO PROCEED, BUT SAVE AS MANY FILES STA \SAVE AS POSSIBLE * * * CHECK IF TYPE 6 FILES ARE TO BE SAVED * SAVE6 LDA TYP6 SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SUBI? YES * SAV6A LDA P15 NO, ASK THEM LDB MES22 JSB \DSPL "PURGE TYPE 6 FILES? (Y OR N)" * JSB YE?NO DECIPHER ANSWER JMP SAV6A INVALID REPLY * * DETERMINE IF ANY ADDITIONAL SUBCHANNELS ARE TO BE INITIALIZED * JMP SAV6A /E AN INVALID REPLY CLA,RSS NO CLA,INA YES STA TYP6 SKP SUBI? LDA SUBI SPECIFIED AT TURN-ON TIME? SZA,RSS JMP AUTO? ONLY THAT NOT WANTED CCB ADB #SUBC GET NUMBER OF SUBCHANNELS SZB,RSS ASIDE FROM SYSTEM SUBCHANNEL JMP AUTO?-1 NONE, SO SKIP QUERY * SSA,RSS YES, OR NOT-YET-SPECIFIED? JMP SUBBR YES, SO DON'T ASK AGAIN * SUBIA LDA P18 LDB MES34 JSB \DSPL "INITIAL°§þúIZE SUBCHANNELS? (Y OR N)" JSB YE?NO DECIPHER ANSWER JMP SUBIA INVALID REPLY JMP SUBIA INVALID REPLY CLA,RSS NO CLA,INA YES STA SUBI SAVE SZA,RSS IF NO, THEN MOVE ON TO JMP AUTO? AUTO BOOT QUERY * SUBBR LDA "L" CHANGE MESSAGE STA MES34+11 LDA DEQT GET DISC TYPE SLA,RSS BRANCH TO REQUEST JMP SUBI5 7905/6/20 INITIALIZATIONS * * REQUEST INITIALIZATIONS OF ADDITIONAL 7900 SUBCHANNELS * CCB,RSS NXSUB LDB SUBIA GET LAST SUBCHANNEL DISPLAYED INB CPB \DSUB JMP NXSUB+1 CPB #SUBC JMP AUTO? DONE ASKING * STB SUBIA SAVE SUBCHANNEL # LDA \TMT POSITION INTO TRACK MAP TABLE ADA P8 BUFFER TO GET # OF ADA B TRACKS DEFINED FOR THIS SUBCHANNEL LDA A,I SZA,RSS ANY? JMP NXSUB+1 NO,TRY NEXT SUBCH ADB B2060 CONVERT TO ASCII STB MES34+12 AND STORE IN MESSAGE NXA LDA P18 LDB MES34 NOW ASK? JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXA INVALID REPLY JMP AUTO? /E SO EXIT JMP NXSUB NO INIT * ASKTS LDA P15 LDB MES35 ASK 'EM JSB \DSPL "TARGET PLATTER?" JSB TARGT GET RESPONSE JSB DFLT CR? JMP NASK NO LDA SUBIA DEFAULT IMPLIED, SO GO TO TMT JMP CSST GO COMPARE WITH SYS SUBCH TARGET * * GET TARGET PLATTER FOR 7900 SUBCHANNEL * NASK CLA,INA GET TARGET PLATTER JSB GETOC RESPONSE JMP ASKTS INVALID REPLY CSST CPA \TSUB SAME AS SYSTEM SUBCH'S? JMP ASKTS YES - NOT ALLOWED * LDB SUBIA GET THIS SUBCHANNEL # ADB \TMT AND OFFSET INTO THE TMT BUFFER ADB P16 PAST THE DEF'NS (16 WORDS) STA B,I SAVE TARGET PLATTER FOR THIS SUBCHANNEL ˆþú ADB N16 BACK UP TO FIRST TRACK ENTRY LDA B,I AND MARK THE SUBCHANNEL IOR MSIGN TO ENABLE INITIALIZATION STA B,I JMP NXSUB NOW TRY THE NEXT ONE SKP * * REQUEST INITIALIZATIONS OF ADDITIONAL 7905/6/20 SUBCHANNELS * SUBI5 LDB MS36B SET MESSAGE BUFFER ADDRESS STB TEMP2 FOR STORAGE OF SUBCH #'S CLA CLEAR HEADER STA HDFLG FLAG INA SET ASCII CONVERSION LENGTH STA \CLEN TO 1 WORD - FOR \CVAS CLB STB TEMP1 FIRST SUBCHANNEL # * * DISPLAY THOSE SUBCHANNELS ON SAME UNIT AS SYSTEM SUBCHANNEL * SUB0 CPB \DSUB SAME AS SYS SUBCH? JMP SUB1 YES, SO NEEDED ASK RBL,RBL POSITION INTO TMT FOR ADB \TMT THIS SUBCHANNEL'S ENTRY INB LDA B,I AND GET WORD 1 OF ENTRY AND B17 ISOLATE THE UNIT # CPA \DUNT SAME UNIT AS FOR SYS SUBCH? RSS YES JMP SUB1 NO - MOVE ON TO NEXT LDA TEMP1 GET SUB # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER ADDRESS JSB \CVAS CONVERT TO ASCII AND PUT IN MESSAGE LDA COMBL GET A COMMA AND PLACE ISZ TEMP2 AFTER THE # STA TEMP2,I IN THE MESSAGE ISZ TEMP2 NEXT BUFFER POSITION ISZ HDFLG INDICATE ONE 'FOUND' FOR THIS UNIT * SUB1 ISZ TEMP1 BUMP TO NEXT SUBCH # LDB TEMP1 CPB #SUBC LAST SUBCH DONE? RSS YES JMP SUB0 * LDA HDFLG ANY FOUND MATCHING \DUNT? SZA,RSS JMP OTHER NO * LDB \TUNT STORE THE UNIT # IN THE MESSAGE ADB B2060 STB MES36+7 * RAL SET # OF WORDS TO PRINT ADA P16 LDB MES36 GET BUFFER ADDRESS JSB \DSPL AND PRINT IT * LDA HDFLG SET LOOP COUNTER CMA,INA TO CLEAR BUFFER STA HDFLG LDB MS36B GE‚þúT BUFFER ADDRESS LDA BLNK AND 2 ASCII BLANKS STA B,I STORE IN BUFFER ISZ HDFLG BUMP BUFFER COUNTER (0 WHEN DONE) JMP *-2 * * ASK IF SUBCHANNELS ON \TUNT ARE TO BE INITIALIZED * CCA STA TEMP2 ALLOW ALL MATCHES IN INIT? LDA \DUNT GET UNIT FOR TMT MATCHING LDB \TUNT AND PASS TARGET UNIT FOR THOSE SUBCH'S JSB INIT? * * DISPLAY SUBCHANNELS MATCHING EACH DEFINED UNIT * CLA INITIALIZE THE UNIT # STA TEMP5 OTHER LDB MS37B AND THE BUFFER POINTER STB TEMP2 CLB STB TEMP1 CLEAR THE SUBCH # CPA \DUNT SAME UNIT AS SYSTEM SUBCH? JMP NXUNT CAN'T ALLOW (ALREADY DONE) * OT1 RBL,RBL POSITION TO SUBCH'S ENTRY ADB \TMT IN THE TMT BUFFER INB MOVE TO WORD 1 LDA B,I AND GET IT AND B17 CPA TEMP5 IS IT THE UNIT WE WANT? RSS YUP JMP NXTSB NO, TRY THE NEXT * INB POSITION TO WORD 2 LDA B,I AND GET THE # OF TRACKS SZA,RSS JMP NXTSB SKIP IF NO TRACKS ASSIGNED SSA OR IF ALREADY SPECIFIED JMP NXTSB * LDA TEMP1 GET SUBCH # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER POSITION JSB \CVAS STORE IN MESSGE LDA COMBL NOW PLACE A COMMA ISZ TEMP2 AFTER THE NAME STA TEMP2,I ISZ TEMP2 ISZ HDFLG BUMP COUNTER * NXTSB ISZ TEMP1 BUMP TO NEXT SUBCHANNEL LDB TEMP1 RETRIEVE IT CPB #SUBC AND SEE IF DONE RSS YES JMP OT1 NO, CONTINUE SCANNING * LDA HDFLG ANY FOUND? SZA,RSS JMP NXUNT NO, TRY NEXT UNIT LDB TEMP5 STORE UNIT IN MESSAGE ADB B2060 STB MES37+7 RAL DETERMINE LENGTH OF MESSAGE ADA P16 BY # OF SUBCH'S STORED IN 3üþúIT LDB MES37 DISPLAY JSB \DSPL "DESTINATION UNIT XX FOR SUBCHANNELS ..." * LDA HDFLG CLEAR BUFFER CONTAINING CMA,INA SUBCH #'S STA HDFLG LDB MS37B BUFFER ADDR LDA BLNK BLANKS STA B,I CLEAR ISZ HDFLG BUMP JMP *-2 CONTINUE * * ASK FOR TARGET UNIT FOR THIS SET OF SUBCHANNELS * ASKTU LDA P14 ASK FOR TARGET UNIT LDB MES38 JSB \DSPL "TARGET UNIT? (XX OR " "CR, OR /E) JSB YE?NO GET RESPONSE JMP TDFLT CHECK DEFAULT JMP NXUNT /E JMP ASKTU NO, TRY A NUMBER JMP ASKTU YES, NEED A NUMBER TDFLT JSB DFLT CR? JMP GETU NO LDA TEMP5 GET DEFAULTED UNIT JMP CSSTU AND GO CHECK AGAINST TARGET SYS UNIT * GETU CLA,INA RETRIEVE TARGET UNIT # JSB GETOC FROM RESPONSE JMP ASKTU INVALID REPLY - ASK AGAIN CSSTU CPA \TUNT SAME AS SYS SUBCH UNIT? JMP ASKTU YES - CAN'T ALLOW * * REQUEST INITIALIZATION OF EACH SUBCHANNEL OF CURRENT SET * LDB A GET TARGET UNIT # LDA \DUNT SET FOR DISALLOWING STA TEMP2 \DUNIT REPONSES LDA TEMP5 GET DEST UNIT # JSB INIT? AND ASK FOR INITIALIZATIONS * NXUNT ISZ TEMP5 BUMP UNIT COUNTER LDA TEMP5 RETRIEVE IT CPA P8 AND CHECK IF DONE JMP AUTO? YES JMP OTHER NO - START SUBCH SCAN AGAIN SKP * * SCAN TRACK MAP TABLE (IN BUFFER) FOR SUBCHANNELS THAT MAY BE * INITIALIZED, BASED UPON THE 'MATCH' UNIT IN THE A-REG. THE TARGET * UNIT FOR THESE SUBCHANNELS (IF INITIALIZED) IS IN THE B-REG. * INIT? NOP STA TEMP3 SAVE TMT MATCH UNIT STB TEMP4 AND TARGET UNIT CLB INITIALIZE STB TEMP1 NEXT SUBCHANNEL # * INIT1 CPB \DSUB SYSTEM SUBCHANNEL? JMP NXS YES, SO SKIP RBL,RBL CONVERT TO TMT‡þú ENTRY # ADB \TMT AND OFFSET INTO BUFFER INB LDA B INA IF WORD2 IS NEGATIVE LDA A,I THEN THIS SUBCH ALREADY SSA HAS BEEN SPECIFIED JMP NXS SO SKIP THIS ENTRY SZA,RSS JMP NXS ALSO SKIP IF NO TRACKS ASSIGNED TO IT * LDA B,I ISOLATE THE AND B17 UNIT CPA TEMP2 THIS UNIT MATCH DISALLOWED? JMP NXS YES, TRY NEXT SUBCH * CPA TEMP3 ONE WE'RE LOOKING FOR? RSS YES JMP NXS TRY NEXT ONE * STB TEMP6 SAVE BUFFER POSITION LDA TEMP1 GET SUBCH # CMA,INA LDB MS34A AND CONVERT TO ASCII JSB \CVAS AND STORE IN MESSAGE NXI LDA P18 NOW ASK 'EM LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXI INVALID REPLY JMP INIT?,I /E SO EXIT JMP NXS NO REPLY * LDB TEMP6 GET BUFFER POSITION LDA B,I AND WORD 1 OF SUBCH'S ENTRY AND B1777 MASK OFF UNIT IOR TEMP4 AND ADD IN TARGET UNIT STA B,I RE-STORE INB NOW SET THE SIGN BIT LDA B,I FOR WORD 2 TO IOR MSIGN INDICATE A SPECIFIED ENTRY STA B,I * NXS ISZ TEMP1 BUMP SUBCHANNEL # LDB TEMP1 RETRIEVE IT AND CPB #SUBC AND SEE IF DONE JMP INIT?,I YES JMP INIT1 CONTINUE SCAN * SKP * * THE FOLLOWING CONDITIONS FOR AUTO BOOT-UP ARE CHECKED: * DESTINATION CHANNEL = TARGET CHANNEL * DESTINATION SUBCHANNEL/UNIT = TARGET SUBCHANNEL/UNIT * DESTINATION TBG CHANNEL = HOST TBG CHANNEL * DESTINATION TTY CHANNEL = HOST TTY CHANNEL * DESTINATION PI CHANNEL = HOST PI CHANNEL ( IF BOTH EXIST) * STB SUBI CLEAR INIT WORD IF NO SUBCH'S AUTO? LDA AUTO SPECIFIED AT TURN-ON TIME? ëþú SZA,RSS JMP CHPNT YES, ONLY THAT THEY DON'T WANT IT * LDA \DCH COMPARE DISC CHANNELS CPA \TCH RSS JMP CANT NO MATCH LDB DEQT SLB CHECK SUBCHANNELS OR UNITS JMP AUT0 LDA \DUNT CPA \TUNT JMP AUT1 JMP CANT NO MATCH ON 7905/7920 UNIT * AUT0 LDA \DSUB CPA \TSUB RSS JMP CANT NO MATCH ON 7900 SUBCHANNEL # * AUT1 LDA TBG GET HOST TBG CHANNEL CPA DTBG RSS JMP CANT TBG'S DON'T MATCH LDA HTTY CPA DTTY RSS JMP CANT TTY CHANNELS DON'T MATCH LDA PI GET HOST PI CHANNEL CPA P0 IF EITHER THE HOST OR JMP AUT2 LDB DPI CPB P0 DESTINATION PI IS 0, JMP AUT2 THEN DON'T CHECK CPA B RSS JMP CANT PI CHANNELS DON'T MATCH * * * AUTO BOOT-UP IS POSSIBLE * AUT2 LDA AUTO HAS IT BEEN SPECIFIED YET? SSA,RSS -1=NOT SPECIFIED, 1=YES JMP CHPNT YES, AND WANT IT AUT3 LDA P12 LDB MES24 JSB \DSPL "AUTO BOOT-UP? (Y OR N)" JSB YE?NO GET ANSWER JMP AUT3 INVALID REPLY JMP AUT3 INVALID REPLY CLA,RSS NO CLA,INA YES STA AUTO JMP CHPNT * * * WON'T BE BOOTING UP NEW SYSTEM * CANT LDA P25 LDB MES25 JSB \DSPL "PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP" CLA STA AUTO * * * DETERMINE IF WE'RE OVERLAYING PART OF THE HOST SYSTEM. * ALSO, DETERMINE IF WE CAN RETURN TO HOST SYSTEM AFTER * TRANSFER, OTHERWISE HALT * * CHPNT LDA HEQT GET HOST EQT TYPE CPA DEQT SAME AS NEW? RSS JMP GO LDA HCH GET HOST CHANNEL CPA \TCH REPLACING CURRENT? RSS MAYBE JMP GO LDB DEQT SLB,RSS JMP CHPT5 CHECK 7905/7920 SUBCHANNELGþú DEFN LDA HSBCH GET HOST SUBCHANNEL CPA \TSUB SAME 7900 SUBCHANNELS? RSS JMP GO NO,SO NO PROBLEM * * WILL BE REPLACING CURRENT SYSTEM * REPL CLA,INA STA PONRT SET "POINT OF NO RETURN" FLAG FOR THE LDA AUTO SZA JMP GO LDA P22 ERROR MESSAGE PROCESSING LDB MES26 JSB \DSPL "SYSTEM WILL HALT AFTER TRANSFER COMPLETION" JMP GO * * GOT 7905/7920 HOST SUBCHANNEL DEFINITION (VIA $TB32) AT OKAY * * 7905/7920 CHECKS FOR OVERWRITE OF HOST SYSTEM, USING HUNIT ONLY * CHPT5 LDA HUNIT CPA \TUNT SAME UNIT? JMP REPL YES - SO HALT IF NO AUTO-BOOT * * ALLOW OPERATOR ONE MORE OPPOR\TUNTY TO GET OUT * GO LDA BATCH NO MESSAGE IN BATCH MODE CMA,SSA,INA,SZA SKIP IF <= 0 JMP PURGF LDA P17 LDB MES32 JSB \DSPL "READY TO TRANSFER. OK TO PROCEED?" JSB YE?NO JMP GO INVALID REPLY JMP GO INVALID REPLY JMP \XOUT BAIL OUT JMP PURGF YES, GET WITH IT SKP * * PURGE ALL FILES FROM THE FILE DIRECTORY (AND THEIR EXTENTS) * THAT WERE OVERLAID BY THE NEW SYSTEM - LISTING THEM AT THE * SAME TIME. * PURGF JSB EXEC CORE LOCK - TO DEF *+3 PREVENT SWTCH FROM DEF P22 FROM BEING SWAPPED OUT DEF P1 * LDB \SAVE WERE THE FMP FILES TO BE \SAVED? SZB,RSS JMP XFER NO * LDA D.LT CONVERT LAST FMP LOGICAL ADDRESS STA \TRAK CLB STB \SECT LDA D.# STA TEMP4 SAVE FOR LOOP CHECKS * STB \INIT FOR DISKD LDA N6144 STA \LNTH LDA \BUFA STA BPTR * LDA \SAVE SSA,RSS WERE ANY FMP FILES OVERLAID? JMP PUR6 NO,CHECK ON TYPE 6 FILES * LDA LWAM SET THE ADDRES OF THE ADA N3 FIRST FILE NAME ENTRY STA PENT * CLA,INA STA §oNLHREWRT SET RE-WRITE FOR FD LDB \BUFA CCE SET FOR READ JMP BFULL * SPC 3 ****************************************************************************** * * THE FOLLOWING BSS ALLOWS FOR OVERLAY OF THE * PREVIOUS CODE, AND ADDS ADDITIONAL BSS'S FOR * AN AREA TOTALING 6144(DECIMAL) WORDS. * BSS 6144+BUFR-* * ***************************************************************************** SPC 3 BFULL JSB DISKD FIRST FULL TRACK READ JSB \BLIN LDA P10 HEADING: LDB MES27 JSB \DSPL "OVERLAID FMP FILES:" CCA STA CURCH SET FOR PURGT LDA BPTR POSITION TO CARTRIDGE SPECIFICATION ADA P900 ENTRY WORD 4 LDB \STRK AND STORE THE NEW FIRST STB A,I FMP TRACK * LDB BPTR POSITION TO FIRST FILE ADB B200 DIRECTORY ENTRY ON THE LDA N376 TRACK LOOP0 STA TCNT SET # ENTRIES TO SEARCH LOOP1 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRB ALREADY PURGED SZA,RSS JMP INCRB NOT AN ENTRY ADB P4 POSITION TO TRACK ADDRESS ½üNÿÿþú LDA B,I LDB \STRK COMPARE WITH LAST SYSTEM CMB,INB TRACK ADA B SSA WAS THE FILE IN THE NEW SYSTEM AREA? JSB PURGT PURGES,LISTS ENTRY * INCRB JSB UPDAT SET TO SEARCH NEXT ENTRY JMP LOOP1 CONTINUE IN SAME TRACK JMP PUR6 PURGE TYPE 6 FILES JMP LOOP0 CONTINUE IN NEW TRACK * P900 DEC 900 SKP * PURGES ANY TYPE 6 FILES OF THE TARGET FMP FILE SYSTEM * PUR6 LDA TYP6 ARE WE TO PURGE ANY? SZA,RSS JMP XFER NO * CLA CLEAR THE STA REWRT REWRITE & FILES FLAGS STA CURCH FOR PURGT STA \SECT LDA D.# STA TEMP4 SET THE # DIRECTORY TRACKS TO SEARCH LDA D.LT FIRST DIRECTORY TRACK STA \TRAK LDB \BUFA STB BPTR CCE JSB DISKD READ IT * LDB BPTR POSITION TO FIRST ADB B200 FILE DIRECTORY ENTRY LDA N376 LOOP2 STA TCNT # ENTRIES TO SEARCH LOOP3 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRE ALREADY PURGED SZA,RSS JMP INCRE NOT AN ENTRY ADB P3 POSITION TO FILE TYPE LDA B,I CPA P6 A TYPE 6? RSS JMP INCRE NOPE LDA HDRSW SZA JMP LOOP4 ISZ HDRSW JSB \BLIN LDA P10 PRINT HEADING: LDB MES28 JSB \DSPL "TYPE 6 FILES PURGED:" * LOOP4 JSB PURGT PURGE AND LIST ENTRY INCRE JSB UPDAT POSITION TO NEXT DIRECTORY ENTRY JMP LOOP3 CONTINUE IN SAME TRACK JMP XFER DONE WITH DIRECTORY JMP LOOP2 CONTINUE IN NEW TRACK SPC 2 B50 OCT 50 B62 OCT 62 B200 OCT 200 N376 DEC -376 N6144 DEC -6144 HDRSW NOP HEADER SWITCH SKP * BEGIN THE TRANSFER, READING FROM THE ABSOLUTE FILE VIA READF * CALLS, AND WRITING OUT THE NEW SYSTEM VIA DISKD (TURNS OFF * THE INTERRUPT SYSTEáþúM) * XFER CLA STA \TRAK SET DESTINATION TRACK 0 SECTOR 0 STA \SECT * * READ FROM THE NEW SYSTEM FILE * LDA \BUFA STA BPTR RESET TO BEG. OF BUFFER LDA DEQT LDB \INP0 SLA,RSS LDB \INP5 SET TO WRITE PROTECT AND INITIALIZE STB \INIT (FOR DISKD) * CLB LDA SIZE # 128-WORD SECTORS DIV P48 SIZE OF SYSTEM CMA,INA NOW MEANS THE SYSTEM SIZE IN TRACKS STA TEMP1 NEGATIVE STB TEMP2 REMAINING # OF SECTORS LDA P6144 STA \LNTH * JSB READF READ A TRACK STARTING WITH RECORD #2 DEF *+7 DEF DCB DEF ERR DEF BUFR DEF \LNTH DEF LLEN DEF P3 SSA READ ERROR? JMP RDERR YES * LDA PONRT SET TO INDICATE POSSIBLE OVERLAY CMA,INA RESULTING IN 0 OR -1 STA PONRT * * LDA \BUFA COMPUTE ADDRESS OF SYSTEM ADA P1024 COMMUNICATION AREA IN NEW ADA B50 BASE PAGE. LDB A POSITION TO LOCATION 1650. ADB P6 GET TAT ADDRESS AT 1656 WHILE LDB B,I WE'RE THERE. STB TAT * LDB \SAVE ARE WE SAVING THE FILE STRUCTURE SZB,RSS AT THE TARGET? JMP WDISK NO, WRITE OUT THE BUFFER * * * SINCE THE TARGET FILE STRUCTURE IS TO BE SAVED, RECOMPUTE * THE FMP SETUP WORD FOR THE NEW SYSTEM * CLB CLEAR THE SUM WORD STB STUPW LDB N8 ADD LOC'S 1650 THRU 1657 JSB ADDIT ADA B62 POSITION TO LOCATION 1742 LDB N6 JSB ADDIT ADD LOC'S 1742 THRU 1747 ADA P5 POSITION TO LOCATION 1755 LDB N8 JSB ADDIT ADD LOC'S 1755 THRU 1764 JMP WDISK WRITE TRACK TO DISK * * READ FROM ABSOLUTE DISK FILE * RDISK LDA P6144 ISZ TEMP1 LAST FULL TRACK'S WORTH? JMP READ NO, CONTINUE LDA TEMP2 GET †˜þú# OF LEFTOVER SECTORS SZA,RSS JMP DDONE NONE! MPY B200 BY 128 ISZ EOFLG SET EOF FLAG * * CLEAR REMAINDER OF TRACK * STA \LNTH SAVE # WORDS TO BE READ CMA,INA DETERMINE # REMAINING ON TRACK ADA P6144 LDB \BUFA GET STARTING ADDRESS ADB \LNTH WITHIN BUFFER JSB CLRBF AND CLEAR THE AREA TO FOLLOW RSS THE LAST RECORD READ IN * * READ ANOTHER TRACK FROM ABS FILE * READ STA \LNTH # WORDS TO READ JSB READF DEF *+5 DEF DCB DEF ERR DEF BUFR DEF \LNTH SSA READ ERROR? JMP RDERR YES * * WRITE TO THE TARGET * WDISK LDA \TRAK DISPLAY DESTINATION OTA 1 * LDA N6144 STA \LNTH # WORDS TO READ/WRITE LDB \BUFA BUFFER(CORE) ADDRES CLE SET TO WRITE JSB DISKD AND DO IT. * LDA EOFLG DONE WITH TRANSFER? SZA NO JMP DDONE ISZ \TRAK INCREMENT DESTINATION JMP RDISK ADDRESS BY ONE TRACK * * * * TRANSFER COMPLETE. INITIALIZE THE NECESSARY DISK TRACKS * DDONE LDB \INT0 GET WRITE INITIALIZE BITS LDA DEQT SLA,RSS LDB \INT5 STB \INIT SET FOR DISKD * LDA \SAVE SZA,RSS JMP WHOLE INITIALIZE WHOLE REST OF SUBCHANNEL SSA JMP INIT2-1 INITIALIZE ONLY THE 9 AVAILABLE TRACKS * * INITIALIZE ONLY UP TO TARGET(EXISTING) FIRST FMP TRACK * LDA \FFMP COMPUTE NUMBER OF TRACKS UP TO FMGR AREA JMP LESS * * INITIALIZE REST OF SYSTEM SUBCHANNEL * WHOLE LDA \DNTR COMPUTE # TRACKS LEFT ON SUBCHANNEL LESS LDB \STRK ADB N9 CMB,INB ADA B CMA,INA JMP INIT2 * * INITIALIZE THE MINIMUM 9 TRACKS SINCE WE'RE OVERLAYING * SOME FMGR FILES AS IT IS. * N9 DEC -9 * LDA N9 INIT2 STA TEMP1 NEGATIVE # * * CLEAR ¯ŽþúENTIRE BUFFER FIRST * LDB \BUFA STARTING ADDRESS LDA P6144 AND SIZE JSB CLRBF DO IT * * SET FIRST TRACK * LDA \STRK ADA N9 AND B377 STA \TRAK NEXT TRACK TO WRITE IN1 OTA 1 LDB \BUFA CLE JSB DISKD ISZ \TRAK INCREMENT THE TRACK NUMBER LDA \TRAK ISZ TEMP1 DONE? JMP IN1 NO SKP * * STORE THE NEW FMP SETUP WORD IN THE CARTRIDGE DIRECTORY * OF THE SAVED TARGET SYSTEM. FMP WILL THEN REMAIN * INITIALIZED. * CLA STA \INIT RESET FOR DISKD STA \SECT LDA \SAVE HAVE WE PRESERVED THE FMP? SZA,RSS JMP ISUBS NO * LDA D.LT READ THE CARTRIDGE DIRECTORY STA \TRAK LDB N128 STB \LNTH LDB \BUFA STB BPTR SAVE CCE JSB DISKD * * DISMOUNTS ALL CARTRIDGES,EXCEPT LU 2, BY CLEARING THE * CARTRIDGE DIRECTORY. STORE THE NEW FMP SETUP WORD * LDB BPTR SEARCH THRU THE CARTRIDGE DIRECTORY SRCH2 LDA B,I FOR LU 2 ENTRY CPA P2 FOUND? JMP FOUND YES ADB P4 CHECK NEXT ENTRY JMP SRCH2 * FOUND INB LDA B,I SAVE LU 2'S: STA TEMP1 LAST FMP TRACK INB LDA B,I STA TEMP2 LABEL * LDA N126 NOW CLEAR THE CD OUT STA TEMP4 LDB \BUFA CLA STA B,I INB ISZ TEMP4 JMP *-3 INB SKIP THE MASTER SECURITY CODE (WORD 126) STA B,I BUT CLEAR WORD 127 * LDA P2 RESET ENTRY FOR LU 2 STA BUFR LDA TEMP1 STA BUFR+1 LDA TEMP2 STA BUFR+2 * LDA STUPW STORE THE NEW FMP SETUP WORD STA BUFR+125 * CLE LDB \BUFA JSB DISKD AND RE-WRITE IT SKP * * ANY ADDITIONAL SUBCHANNELS TO BE INITIALIZED? * ISUBS LDB N6144 RESET LENGTH TO ONE TRACK j|þú STB \LNTH LDA SUBI SHOULD WE INITIALIZE ANY SZA,RSS ADDITIONAL SUBCHANNELS? JMP UPTAT NO CLA SIGNAL A NON-SYSTEM LU STA \LU2 LDA \DSUB SAVE THE DESTINATION DISK SUBCHANNEL STA TEMP1 * LDB DEQT BRANCH ON THE SLB,RSS DISK TYPE JMP INS5 7905/6/20 * * INITIALIZE SPECIFIED 7900 SUBCHANNELS * LDA \TSUB SAVE THE DESTINATION TARGET SUBCHANNEL STA TEMP2 LDB \INT0 SET THE WRITE INIT STB \INIT FLAG CLB INITIALIZE THE STB \DSUB SUBCHANNEL # TO SCAN INS0 ADB \TMT OFFSET INTO THE TMT FOR ENTRY LDA B,I IS THIS SUBCHANNEL SSA,RSS TO BE INITIALIZED? JMP INS1 NO AND B7777 STA \DFTR SET THE STARTING TRACK TO BE ADB P8 INITIALIZED LDA B,I STA \DNTR AND THE NUMBER OF TRACKS ADB P8 LDA B,I STA \TSUB THE TARGET PLATTER # JSB ILOOP GO INITIALIZE THAT SUBCHANNEL * INS1 ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB SEE IF DONE CPB #SUBC RSS YES JMP INS0 NO, CONTINUE SCAN OF TMT * LDB TEMP1 RESTORE THE SYSTEM SUBCHANNEL'S STB \DSUB SPECIFICATIONS ADB \TMT LDA B,I STA \DFTR THE STARTING TRACK # ADB P8 LDA B,I STA \DNTR THE NUMBER OF TRACKS LDA TEMP2 STA \TSUB AND THE TARGET PLATTER JMP UPTAT EXIT SKP * * INITIALIZE SPECIFIED 7905/6/20 SUBCHANNELS * INS5 LDA \TUNT SAVE THE TARGET UNIT FOR STA TEMP2 THE SYSTEM SUBCHANNEL LDB \INT5 SET THE WRITE INITIALIZE STB \INIT FLAG LDA \DSUB SAVE DESTINATION SYSTEM SUBCHANNEL STA \TSUB FOR USE AT ISPAR(SWSG2) CLB STB \DSUB INITIALIZE SUBCH # FOR SCAN * INS6 JSB \SETD GO SET UP \DSUB'S SPECS þúLDA \DUNT SET THE TARGET UNIT STA \TUNT FROM THE ENTRY CCA RESET THE HEADING FLAG TO STA \BADH DISPLAY SUBCHANNEL # OF BAD/SPARED TRACKS SEZ INITIALIZE IT? JSB ILOOP YES * ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB DONE YET? CPB #SUBC RSS YES JMP INS6 TRY THE NEXT SUBCHANNEL * LDB TEMP1 RE-STORE THE STB \DSUB SYSTEM SUBCHANNEL'S DESTINATION LDB TEMP2 SUBCH , AND THE TARGET STB \TUNT UNIT JSB \SETD RESET SYSTEM SUBCH SPECS JMP UPTAT AND GO UPDATE THE TAT * * * ILOOP NOP LDA \DNTR GET THE # OF TRACKS CMA,INA FOR THIS SUBCHANNEL STA TEMP3 AND SET AS THE LOOP COUNTER CLA SET THE STARTING TRACK # STA \TRAK TO INITIALIZE STA \SECT CLEAR SECTOR # * IL1 LDA \TRAK DISPLAY TRACK # OTA 1 IN SW REG LDB \BUFA GET BUFFER ADDRESS CLE SET TO WRITE JSB DISKD WRITE INIT THE TRACK ISZ \TRAK INCREMENT THE TRACK # ISZ TEMP3 AND THE LOOP COUNTER JMP IL1 CONTINUE JMP ILOOP,I DONE WITH THIS SUBCHANNEL SKP * * UPDATE THE 7900 TAT FOR ANY BAD TRACKS ENCOUNTERED DURING * THE TRANSFER OR INITIALIZATION. * UPTAT CLA CLEAR THE WRITE STA \INIT INITIALIZE FLAG LDA DEQT GET THE TARGET DISK TYPE SLA,RSS JMP BOOT? NO BAD ONES ON A 7905/7920 * LDA \FLGT GET ADDRESS OF BAD TRACK TABLE STA TEMP3 AND SAVE IT FOR RETRIEVAL LDA A,I GET THE FIRST BAD TRACK CPA N1 -1 MEANS END OF LIST JMP BOOT? NO BAD TRACKS * LDA TAT CONVERT THE TAT CORE ADDRESS ADA P128 TO TRACK # AND OFFSET CLB (ALLOW FOR T0S0 BOOTSTRAP) DIV P6144 STB TEMP1 TAT'S OFFSET INTO TRACK BUFFER =îþú STA TEMP2 TRACK CONTAINING THE TAT CMB,INB ADB P6144 SET THE # OF (POSSIBLE) TAT STB TYP6 ENTRIES ON TRACK TEMP2 * CMB,INB DETERMINE IF NEXT BAD TRACK IS ON LDA TEMP3,I THE TAT ENTRIES OF TRACK TEMP2 AND B1776 ALF,ALF ROTATE TRACK TO LOW A RAL ADB A SSB JMP RDTAT IT IS TRAK2 ISZ TEMP2 ADJUST VARIABLES FOR NEXT TRACK LDA TEMP1 CMA,INA ADA P6144 CONVERT NEW OFFSET TO NEG (BECAUSE CMA,INA OF LOGICAL BAD TRACK #'S) STA TEMP1 * RDTAT CLA STA REWRT CLEAR REWRITE FLAG STA \SECT LDA TEMP2 STA \TRAK LDB \BUFA CCE JSB DISKD GO READ IT! * SETBD LDA TEMP3,I GET THE BAD TRACK# AND B1776 INTO LOW A ALF,ALF RAL ADA TEMP1 ADD TAT OFFSET INTO TRACK BUFFER ADA \BUFA LDB MSIGN STB A,I SET THE TAT ENTRY ISZ REWRT SET TO REWRITE THE TRACK ISZ TEMP3 POINT TO NEXT BAD TRACK ENTRY * LDA TEMP3,I GET THE NEXT BAD TRACK CPA N1 END OF LIST? JMP TROUT YES AND B1776 ROTATE IT TO LOW A ALF,ALF RAL ADA TYP6 ADD # ENTRIES ON TEMP2 SSA,RSS TO SET IF ITS ON THIS TAT TRACK JMP SETBD ON TEMP2, SO GO SET IT * TROUT LDA REWRT IS TRACK TEMP2 TO BE RE-WRITTE? SZA,RSS JMP BOOT? NO LDA \INP0 STA \INIT LDB \BUFA GET THE BUFFER ADDRESS CLE CLEAR TO WRITE JSB DISKD AND DO IT * LDA TEMP3,I CPA N1 DONE NOW? RSS YES JMP TRAK2 NO,SET ENTRIES THAT ARE ON NEXT TRACK SKP * BOOT? JSB \BLIN LDA P6 INA LDB MES33 JSB \DSPL "SWTCH FINISHED" JSB \BLIN * LDB PONRT CAN WE REMOVE THE CORE LOCK? SZB JMP BOOTS NO 2\þú* JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * BOOTS LDA AUTO ARE WE TO BOOT UP ? SZA JMP BOOT YES LDB PONRT CAN WE RETURN TO THE SZB,RSS CURRENT SYSTEM? JMP XOUTT YES * JSB $LIBR NOP NO HLT 77B HALT * * * BOOT THE NEW RTE! * BOOT JSB \BLIN LDA N128 STA \LNTH CLA SET FOR TRACK 0, SECTOR 0. STA \INIT STA \TRAK STA \SECT ISZ \BOOT SET SO DISKD WILL BRANCH LDB B2011 TO THE BOOTSTRAP LOADR CCE JSB DISKD LOAD THE SYSTEM LOADER. * B2011 OCT 2011 LWAM EQU 1777B SKP * ABNORMAL TERMINATION EXIT * \XOUT LDA P20 LDB MES15 JSB \DSPL * JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * XOUTT JSB EXEC TERMINATE DEF *+2 DEF P6 SPC 2 RDERR CMA,INA ABSOLUTE FILE READ ERROR STA ERR JSB CNUMD DEF *+3 DEF ERR DEF MS31A * LDA MS31A+2 SAVE ERROR CODE ONLY STA MS31A LDA P6 LDB MES31 JSB \DSPL JMP \XOUT * STUPW NOP FMP SETUP WORD MSIGN OCT 100000 BAD TRACK IN TAT HED SWTCH SUBROUTINES. ******************************** * * CONTROLS CALLS TO THE CORRECT DISK DRIVER, * DEPENDENT UPON THE DESTINATION DISK TYPE * DISKD NOP DST ABREG SAVE 'EM LDA DEQT SLA JMP DISK1 DLD ABREG JSB \DSK5 CALL TO 7905/7920 DRIVER JMP DISKD,I * DISK1 DLD ABREG JSB \DSK0 CALL TO 7900 DRIVER JMP DISKD,I * ABREG BSS 2 A & B REGISTER SAVE AREA SPC 4 * * CLEAR A-REG NUMBER OF WORDS IN A BUFFER STARTING AT B-REG * CLRBF NOP CMA,INA CONVERT TO NEGATIVE WORD COUNT STA TEMP2 AND SAVE CLA CLEAR STA B,I INB BUMP BUFFER ADDRESt¹þúS ISZ TEMP2 AND LOOP COUNTER JMP CLEAR CONTINUE JMP CLRBF,I DONE SKP * * * UPDATES THE DIRECTORY POINTERS ( AND POSSIBLY TRACK # ) * WHEN PURGING FILES * * RETURN: (P+1) CONTINUE IN SAME DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (P+2) DONE WITH THE DIRECTORY * (P+3) CONTINUE IN NEXT DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (A) IS # ENTRIES TO SEARCH ON NEXT PASS * UPDAT NOP LDB BPTR SET TO SEARCH NEXT ENTRY ADB P16 DIRECTORY ENTRY ISZ TCNT DONE WITH TRACK? JMP UPDAT,I NO,CONTINUE ISZ UPDAT * LDA CURCH ARE WE PURGING EXTENTS? SZA,RSS JMP UPDTT NOPE * * SEARCH THE JUST COMPLETED DIRECTORY TRACK FOR THE EXTENTS * OF ANY OVERLAID FILES * LDA #PF ANY SO FAR? SZA,RSS JMP UPDTT NO, CONTINUE CMA,INA STA PCNT SAVE AS A COUNTER LDB LWAM GET ADDRESS OF 1ST ENTRY ADB N3 * PEXT0 LDA \BUFA AND ADDRESS OF BUFFER TO SEARCH STB TEMP3 PEXT1 STA BPTR SAV BOTH ADDRESS POINTERS * STA TEMP2 LDA TEMP2,I GET WORD 0 OF A FILE DIRECTORY ENTRY SSA JMP PEXT2 ALREADY PURGED SZA,RSS JMP PEXT2 NOT A VALID ENTRY CPA B,I CHARACTERS 1&2? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 3&4? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 5&6 RSS JMP PEXT2 NO CCA STA BPTR,I YES, SO PURGE THE EXTENT ISZ REWRT SET TO REWRITE THE DIRECTORY TRACK * PEXT2 LDA BPTR POINT TO NEXT FILE ENTRY ADA P16 LDB TEMP3 CPA BPEND DONE? RSS JMP PEXT1 NO CONTINUE WITH TRACK BUFFER ADB N3 MOVE TO NEXT LIST ENTRY ISZ PC$ÜþúNT DONE WITH FILE LIST? JMP PEXT0 JMP UPDTT YES * UPDTT LDA REWRT DOES THIS ONE NEED TO BE REWRITTEN? SZA,RSS JMP INCRT NO, NO ENTRIES WERE PURGED * LDB \BUFA REWRITE THE THIS DIRECTORY TRACK CLE JSB DISKD * INCRT ISZ TEMP4 DONE WITH THE DIRECTORY? RSS JMP UPDAT,I YES * CCA ADA \TRAK NO, UPDATE THE DISK ADDRESS STA \TRAK BUMP TO PREVIOUS TRACK ( THE CLA NEXT DIRECTORY TRACK) STA \SECT CCE LDB \BUFA JSB DISKD READ NEXT DIRECTORY TRACK CLA STA REWRT CLEAR LDA N384 SET LOOP COUNTER LDB \BUFA AND BUFFER POINTER ISZ UPDAT JMP UPDAT,I * PCNT NOP LOOP COUNTER OF PURGED FILES BPEND DEF BUFR+6144 END OF BUFR N384 DEC -384 SKP * * PURGT PURGES AND DISPLAY FILE FOR ONE OF TWO REASONS: * A FILE OVERLAID BY THE NEW SYSTEM * A TYPE 6 FILE SPECIFIED BY THE USER TO BE PURGED * PURGT NOP LDB BPTR INSERT THE FILE LDA B,I NAME INTO THE STA MS29 OUTPUT MESSAGE INB BUFFER LDA B,I STA MS29+1 INB LDA B,I STA MS29+2 LDA P6 LDB MES29 JSB \DSPL OUTPUT THE FILE NAME * ISZ REWRT FLAG TO REWRITE DIRECTORY TRACK CCA STA BPTR,I SET WORD 0 OF ENTRY TO PURGE IT LDA CURCH SZA,RSS PURGE THE EXTENTS AND CLEAR THE SIZE WORD? JMP PURGT,I NO * * ENTERS THE FILE NAME SO ITS EXTENTS CAN LATER * BE SEARCHED FOR AND PURGED * & CLEAR THE SIZE WORD TO PREVENT RECOVERY OF DISC SPACE * LDB BPTR FIRST CLEAR THE SECTOR SIZE WORD ADB P6 SINCE OVERLAID FILES' SPACE CANNOT CLA BE RECOVERED STA B,I ADB N1 SEE IF THIS IS AN EXTENT FILE ENTRY LDA B,I IF SO, DON'T RE-ENTER THE FILE ALF,ALF $þú NAME IN THE LIST AND B377 SZA JMP PURGT,I IT WAS ISZ #PF INCREMENT # ENTRIES IN FILE LDB PENT LDA MS29 STORE FILE NAME IN LIST STA B,I UPWARDS INB LDA MS29+1 STA B,I LDA MS29+2 INB STA B,I LDA PENT ADA N3 READY FOR NEXT ENTRY STA PENT JMP PURGT,I * PENT NOP ADDRESS OF NEXT ENTRY TO USE #PF NOP # OF PURGED FILE ENTRIES SKP \BLIN NOP OUTPUT A BLANK LINE. LDB DBLNK CLA,INA JSB \DSPL JMP \BLIN,I SPC 4 \DSPL NOP DISPLAY MESSAGE ON OPERATOR CONSOLE STA DSPL STB DSPB JSB EXEC DEF *+5 DEF P2 DEF OPLU DSPB NOP DEF DSPL JSB LOOP WAIT UNTIL DEVICE AVAILABLE JMP \DSPL,I TO RETURN * DSPL NOP SPC 4 LOOP NOP LOOPS ON A STATUS CHECK UNTIL LOOPS JSB EXEC THE DEVICE IS NO LONGER DEF *+5 BUSY DEF P13 DEF OPLU DEF IEQT5 DEF IEQT4 * LDA IEQT5 AND M1400 SZA JMP LOOPS JMP LOOP,I * M1400 OCT 140000 SPC 3 * ADD N WORDS TO FMP SETUP WORD. * ADDIT NOP A=ADDR, B=NEG. # WORDS. STB CNTR LDB STUPW ADB A,I INA ISZ CNTR JMP *-3 STB STUPW JMP ADDIT,I SKP * * CONVERT A TO ASCII AT B * * THE \CVAS SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. * * CALLING SEQUENCE: * \CLEN = MAXIMUM # WORDS IN ANSWER * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB \CVAS * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CVAS NOP STB CURAT SET ¨¡þúMESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA CTEMP PUT NUMBER IN TEMPORARY LDA \CLEN GET # WORDS CPA P1 IF ONLY 1 THEN ADB P2 ADVANCE 2 POWERS STB RANAD SET OWER RANGE ADDRESS LDB N2 ALSO SET LOOP COUNT CPA P1 INB ONCE FOR 2 WORDS STB TCNT LDB CTEMP NUMBER INTO B NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CVAS,I YES - RETURN * OPWRS DEF *+1 OCT 1000 M100 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 1000 DEC 100 P10 DEC 10 P1 DEC 1 * \CLEN NOP MAXIMUM # WORDS IN ANSWER CURAT NOP BUFFER ADDRESS TCNT NOP TEMPORARY LOOP COUNTER CTEMP NOP SPC 6 * * GET DIGIT FOR \CVAS * * GETD PROVIDES THE ASCII CHARACTERS FOR \CVAS. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * RANAD NOìPNLHP SKP * * CONVERT OCT ASCII TO BINARY * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN BUFR FROM * TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCB SET FOR HIGH CHAR STB BUFUL LDA \BUFA STA BPTR CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX LDB BUFUL GET UPPER-LOWER FLAG IGNOR LDA BPTR,I GET CHAR FROM BUFFER SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ BPTR INCR BUFFER ADDRESS STB BUFUL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR YES ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA N8 ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ¹“Nÿÿþú ADA A SET A = OCTNO X 4 ADA A SET A = OCTNO X 8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN * TCHAR NOP TEMP CHAR SAVE AREA. OCTNO NOP OCTAL DIGIT. BLANK OCT 40 BUFUL NOP UPPER/LOWER CHARACTER = -1/0 MAXC NOP MAXIMUM # DIGITS IN CONVERSION L60 OCT -60 HED SWTCH CONSTANTS AND STORAGE. * DESTINATION => GENERATION-DEFINED SYSTEM * \DCH NOP DESTINATION SYSTEM DISC CHANNEL \DSUB NOP " " " SUBCHANNEL DEQT NOP " " " EQT TYPE \DUNT NOP " " " UNIT \DFTR NOP " " " FIRST TRACK/CYLINDER \DNTR NOP " " " NUMBER TRACKS \DSHD NOP " " " STARTING HEAD (7905/7920) \DNSU NOP " " " NUMBER SURFACES " \DNSP NOP " " " " SPARES " DTTY NOP " TTY CHANNEL DPI NOP " PI CHANNEL DTBG NOP " TBG CHANNEL SPC 3 * TARGET => TEMPORARY STORAGE FOR NEW SYSTEM * \TCH DEC -1 TARGET DISC CHANNEL \TSUB DEC -1 " " SUBCHANNEL \TUNT DEC -1 " " UNIT (7905/7920) SKP * MES15 DEF *+1 ASC 20,TRANSFER CANCELLED AND SWTCH TERMINATED. MES27 DEF *+1 ASC 10,OVERLAID FMP FILES: MES28 DEF *+1 ASC 10,TYPE 6 FILES PURGED: MES29 DEF *+1 MS29 ASC 6, MES31 DEF *+1 ASC 5,FILE ERR - MS31A BSS 0 MES33 DEF *+1 ASC 7,SWTCH FINISHED SPC 3 \BOOT NOP "WE'RE BOOTING" FLAG FOR DISKD (0=NOT NOW) AUTO DEC -1 AUTO BOOT-UP FLAG (0=NO, 1=YES) \SAVE DEC -1 SAVE TARGET FILES(0=NO,1=YES,-1=OVERLAYS SOMEjðþú) TYP6 DEC -1 PURGE TYPE 6 FILES FLAG (0=NO, 1=YES) SUBI DEC -1 INITIALIZE SUBCHANNELS FLAG," " BATCH DEC -6 BATCH MODE ( NO<=0, YES>=1 ) #EQTS NOP NUMBER OF DESTINATION EQT'S CURCH DEC 0 CURRENT CHANNEL COUNTER PONRT NOP "POINT-OF-NO-RETURN" FLAG (0=OK,1=WILL,-1=DONE) D.LT DEC -1 LAST DIRECTORY TRACK FROM TARGET'S CD D.# NOP # DIRECTORY TRACKS FROM TARGET'S CD TAT NOP DISK ADDRESS OF TAT IN NEW SYSTEM \FFMP NOP FIRST LOGICAL FMP TRACK AT TARGET #SUBC NOP NUMBER OF DEFINED DISK SUBCHANNELS HDFLG NOP HEADER FLAG \LU2 DEC -1 LU 2 OR 3 FLAG * \LNTH NOP LENGTH OF READ/WRITE \INIT NOP DISKD COMMAND MASK \TRAK NOP DESTINATION DISK ADDRESS \SECT NOP \BUFA DEF BUFR BPTR NOP BUFR POINTER EOFLG NOP REWRT NOP RE-WRITE TRACK FLAG SIZE NOP # BLOCKS IN FILE \STRK NOP # TRACKS IN FILE (PLUS 8) * TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP " TEMP4 NOP " TEMP5 NOP " TEMP6 NOP " * PI EQU 1737B TBG EQU 1674B SYSTY EQU 1675B * IEQT4 NOP IEQT5 NOP SKP P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P8 DEC 8 P9 DEC 9 P13 DEC 13 P16 DEC 16 P22 DEC 22 P20 DEC 20 P32 DEC 32 P48 DEC 48 P128 DEC 128 P1024 DEC 1024 P6144 DEC 6144 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N6 DEC -6 N8 DEC -8 N16 DEC -16 N126 DEC -126 N128 DEC -128 * B17 OCT 17 B60 OCT 60 B377 OCT 377 B1776 OCT 177600 B1777 OCT 177760 B7777 OCT 77777 * OPLU DEC 1 DEFAULT OPER CONSOLE LU (MAY * BE OVERWRITTEN) CNTR NOP DBLNK DEF BLNK BLNK OCT 20040 * * DCB BSS 144 ERR NOP LLEN NOP * \TMT DEF *+1 BSS 128 * END EQU * * * END SWTCH œü ÿÿþúASMB,R,L,C HED SWTCH - SWSG1, 7900 DISK DRIVER SEGMENT NAM SWSG1,5,10 92067-16010 REV.1805 780206 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWSG1 * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * **************************************** * * * ENTRY POINTS * ENT \DSK0,\STD0 ENT \INP0,\INT0 ENT \FLGT * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \TCH,\TSUB,\DFTR,\DNTR EXT \INIT,\LNTH EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \DSUB,\XOUT,\BUFA EXT \BOOT,\TMT,\LU2 EXT \TRAK,\SECT * * A EQU 0 B EQU 1 SUP SKP BEG0 LDB \DSUB SEGMENT'S ENTRY POINT ADB \TMT OFFSET INTO TRACK MAP TABLE BUFFER LDA B,I GET FIRST WORD OF SUCHANNEL'S ENTRY STA \DFTR SET STARTING TRACK ADB P8 POSITION TO SECOND WORD OF SUBCH'S ENTRY LDA B,I AND GET ITS STA \DNTR # OF TRACKS JMP \SWTM RETURN SPC 3 TEMP BSS 3 TEMP FOR INTIALIZATION * M100 OCT 100 B177 OCT 177 M440 OCT 440 M0100 OCT 10000 M1776 OCT 177600 M7700 OCT 177700 * N10 DEC -10 * P10 DEC 10 P2 DEC 2 P4 DEC 4 P8 DEC 8 P9 DEC 9 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 DEC 17 P18 DEC 18 P25 DEC 25 * \INP0 OCT 101000 INITIALIZE, WRITE PROTECT COMMAND BITS \INT0 OCT 100000 " " " SKP * * ó›þú INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD0 NOP LDA \TCH SAVE TARGET DISK CHANNEL STA TEMP1 LDA #DATA GET # WORDS TO BE CONFIGURED LDB HPDSK GET ADDRESS OF INSTR ADDR LIST STDS1 STA TEMP2 SAVE NO. OF INSTRUCTIONS STDS2 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR TEMP1 INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP2 SKIP - DONE WITH SET JMP STDS2 CONFIGURE NEXT INSTRUCTION * LDA TEMP1 DONE WITH COMMAND CHANNEL? CPA \TCH RSS JMP STDS3 YES LDA #CMND GET # COMMAND INSTRUCTIONS ISZ TEMP1 STEP TO COMMAND CHANNEL JMP STDS1 GO CONFIGURE * STDS3 LDA N10 CLEAR THE BAD TRACK STA TEMP TABLE LDB \FLGT GET ADDRESS OF TABLE CCA STA TEMP+2 SET TO NO BAD TRACKS STDS4 STA B,I SET TO -1 FOR NO ENTRY INB STEP TABLE ADDRESS ISZ TEMP DONE? JMP STDS4 NO, DO NEXT ONE STA B,I JMP \STD0,I RETURN * * #DATA ABS I/OTB-I/OTC # DATA INSTRUCTIONS #CMND ABS I/OTC-I/OTD # COMMAND INSTRUCTIONS HPDSK DEF I/OTB,I ADDR OF I/O INSTRUCTION LIST TEMP1 NOP TEMP2 NOP * ADDRESS OF BAD TRACK TABLE \FLGT DEF \STD0+1 WHICH OVERLAYS 10 WORDS OF \STD0 SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. * INIER JSB INTON TURN INTERRUPTS BACK ON LDA STATB GET STATUS AND AND M440 MASK SEEK CHECK CHECK AND END OF CYLINDER SZA,RSS BITS - IF NOT SET CONTINUE JMP INIE0 WITH BAD TRACK ROUTINE * LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P15 ELSE SEND BA¸óþúD SPECIFICATION LDB ERR43 JSB \DSPL "INVALID DISC SPECIFICATIONS" JMP \XOUT TERMINATE SWTCH * INIE0 LDA \INIT SAVE THE \INIT STA TEMP2 FLAG WORD LDA DFCYF SET COMMAND STA \INIT TO FLAG TRACK DEFECTIVE CLE AND LDB \BUFA CALL JMP DISK0+1 DRIVER * INIEH ISZ TEMP+2 BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA P10 LDB \TSUB GET SUBCHANNEL ADB BLK0 ADD ASC BLANK 0 STB EMES1-1 SET IN MESSAGE LDB EMES1 SEND THE JSB \DSPL MESSAGE * INIES LDA \TRAK GET TRACK ADDRESS CMA,INA SET NEGATIVE FOR DECIMAL CONVERSION LDB P2 STB \CLEN FOR \CVAS LDB ALBUF SET BUFFER ADDRESS JSB \CVAS CONVERT THE NUMBER LDA P4 AND LDB ALBUF SEND JSB \DSPL THE TRACK NUMBER * * TRACK IS NOW FLAGGED AND REPORTED IT IS NOW ENTERED IN THE * BAD TRACK TABLE. * LDA \LU2 SHOULD IT BE ENTERED IN TABLE? SZA,RSS JMP DISK0,I NO, RETURN NOW LDA TEMP2 STA \INIT RESTORE IT LDA \TRAK GET THE TRACK ALF,ALF RAR ADA \DSUB STA TEMP1 AND SAVE LDB \FLGT GET THE BAD TRACK TABLE ADDRESS LDA N10 ALLOW 10 ENTRIES STA TEMP+1 SET COUNTER INIE1 LDA B,I GET ENTRY SSA NEGATIVE? JMP INIET YES - USE THIS ONE * INB NO ALREADY USED ISZ TEMP+1 STEP COUNT 10 YET? JMP INIE1 NO - TRY NEXT ONE * LDB ER41A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P17 LDB ERR41 JSB \DSPL "LIMIT OF 10 BAD TRACKS EXDEEDED" JMP \XOUT AND TERMINATE SWTCH * INIET LDA TEMP1 GET SUBCHANNEL/TRACK STA B,I SET IN TABLE JMP DISK0,I GO FINISH INITILIZATION. * DFCYF OCT 100400 ÎÖþúALBUF DEF *+1 BSS 2 EMES2 ASC 10,BAD TRACKS PLATTER EMES1 DEF EMES2 BLK0 ASC 1, 0 * ERR41 DEF *+1 ASC 17,LIMIT OF 10 BAD TRACKS EXCEEDED ER41A DEF ERR41+17 ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 HED DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK51 DATA CHANNEL DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK56 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSKDR I/OTC DEF DSK01 COMMAND CHANNEL DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK71 I/OTD EQU * HED 7900 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO INIER * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 \DSK0 EQU * DISK0 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK ADA \DFTR ADD FIRST TRACK TO RELATIVE TRACK STA T#AC0 SAVE ABSOLUTE TRACK LDB \TSUB GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT STB UN#IT SAVE UNIT NUMBER  Þþú ADB M0100 SET COMMANDS LDA \INIT ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R#DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB \SECT GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB NSEC SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND M100 CHECK READY BIT SZA IF SET JMP NRERR GO TELL THE MAN * LDA T#AC0 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R#DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSKDR GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA \LNTH SET LENGTH STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP ERRCH CHECK ERROR STATUS * LDA \BOOT ARE WE BOOTING UP? SZA,RSS JMP DISKR NO,CONTINUE CLA LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STßþúORE IN BITS RAL 11-6 OF THE OTA 1 SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 NOW DETERMINE IF WE'RE IN CPB P2 AN RTE-II OR RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III JMP A,I GO TO RTE! CLB MUST CLEAR THE MPFT LFB DJP A,I WELL SAID! * M2055 OCT 2055 M2011 OCT 2011 M1742 EQU 1742B * DISKR JSB INTON OK, SO TURN ON INTERRUPTS LDA \INIT CHECK IF MAY HAVE BEEN ALF,ALF FLAGGING A DEFECTIVE SLA TRACK, SO RETURN JMP INIEH TO REPORT IT JMP DISK0,I ELSE RETURN * ERRCH RAL,CLE,ERA CLEAR SIGN BIT CPA P9 WRITE PROTECT ERROR? (BITS 3,0) RSS CPA M2011 DATA PROTECT SWITCH ON? (BITS 10,3,0) JMP WRPTM YES - GO TELL 'EM * CPA P25 DEFECTIVE CYLINDER? (BITS 4,3,0) JMP DISBM * AND M100 ISOLATE READY BIT (BIT 2) SZA READY? JMP NRERR NO - GO TELL USER * CLA YES, TRY TO RECOVER JSB SEEK SEEK TO CYLINDER 0 ISZ EDCNT INCREMENT # TRIES JMP DSK16 NOT TEN YET GO TRY AGAIN * LDA \INIT 10 TIMES IN INIT PHASE? CPA \INT0 JMP INIER YES GO TO INIT ERROR ROUTINE * * JSB INTON TURN THE INTERRUPTS BACK ON LDA \TRAK INSERT THE TRACK IN THE MESSAGE CMA,INA NEGATE FOR \CVAS LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXX" LDA \INIT DETERMINE ACTION TO TAKE ALF,ALF RAR SLA IF WRITE PROTECT BIT SET,THEN JMP \XOUT TRACKS WERE BEING WRITTEN, SO EXIT LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO TO INIT ERRþúOR ROUTINE JMP \XOUT ELSE TERMINATE SWTCH * * DISBM JSB INTON ON INTERRUPTS! LDA \INIT IF DEFECTIVE CYLINDER ALF,ALF IS BEING FLAGGED BY SLA INIER JMP INIEH IGNORE ERROR, GO REPORT TRACK * RAL IF WRITE PROTECT SET, THEN SLA THE SYSTEM IS BEING WRITTEN JMP IRERR AND THAT'S IRRECOVERABLE! * LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO FLAG IT DEFECTIVE * IRERR LDA \TRAK INSERT TRACK # IN MESSAGE CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT AND EXIT * * NRERR JSB INTON INTERRUPTS ON JSB \BLIN DISC NOT READY LDB MS33A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA P14 LDB MES33 TELL 'EM JSB \DSPL "READY DISC AND PRESS RUN" JSB $LIBR TURN OFF NOP CLF 0 DSK56 LIA 0 GET STATUS TO A HLT 33B PAUSE JMP RTRY ON RESTART, RETRY * * WRPTM JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS ON LDB MS32A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB MES32 JSB \DSPL "TURN OFF DISC PROTECT - PRESS RUN" JSB $LIBR OFF AGAIN NOP CLF 0 HLT 32B WAIT FOR IT JMP RTRY AND DO IT AGAIN * SPC 3 * * TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK71 CLF 1 JSB $LIBX DEF INTON SPC 2 * SEEK ROUTINE SEEK NOP DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 ÆÌ0.*SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 * * WAIT AND STATUS ROUTINE STATC NOP DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 5 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP NSEC DEC -24 W#CMD OCT 010000 UN#IT NOP H#AD NOP S#EKC OCT 030000 R#DCM OCT 020000 DSKDR OCT 120000 MUST BE CONFIGURED T#AC0 NOP SKP * ESUB NOP CLA,INA SET FOR 1 WORD STA \CLEN CONVERSION LDA \TSUB GET CURRENT SUBCHANNEL # CMA,INA NEGATIVE FOR DECIMAL CONVERSION JSB \CVAS JMP ESUB,I * SPC 5 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 * MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 * MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 * END EQU * * END BEG0 * * END EQU * END BEG0 ˜ë0ÿÿþúASMB,R,L,C HED SWTCH - SWSG2, 7905 DISK DRIVER SEGMENT NAM SWSG2,5,10 92067-16010 REV.1840 780810 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************************* * * NAME: SWSG2 * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * ******************************************************************* * * * ENTRY POINTS * ENT \DSK5,\STD5,\BADH ENT \INP5,\INT5,\SETD * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \DFTR,\DNTR,\DSHD,\DNSU,\DNSP EXT \TCH,\TUNT,\DSUB,\DUNT,\TSUB EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \LNTH,\XOUT EXT \INIT,\BOOT,\SAVE EXT \TRAK,\SECT EXT \TMT EXT \FFMP,\STRK * * A EQU 0 B EQU 1 SUP SKP BEG5 JSB \SETD SEGMENT'S ENTRY POINT JMP \SWTM RETURN TO MAIN * * \INP5 OCT 041400 INITIALIZE ,WRITE PROTECT COMMAND BITS \INT5 OCT 001400 " " " FLGPT EQU \INP5 FLGDF OCT 021400 FLGSP OCT 101400 * \BADH NOP BAD TRACKS HEADER FLAG * M17 OCT 17 M37 OCT 37 M177 OCT 177 M74C OCT 7400 M7700 OCT 177700 M1776 OCT 177600 * N10 DEC -10 * P1 DEC 1 P2 DEC 2 P4 DEC 4 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P18 DEC 18 SKP * * DETERMINE SUBCHANNEL SPECIFICATIONS, USING INFORMATION * RETRIEVED FROM THE \TMT ENTRY FOR \DSUB. * \SETD NOP LDB \DSUB GET DESTINATION SUBCHANNEL RBL,RBL CONVtKþúERT TO 4 WORD PER ENTRY OFFSET ADB \TMT INTO THE \TMT BUFFER LDA B,I GET WORD 0 OF ENTRY STA \DFTR AND SAVE STARTING TRACK OF SUBCH INB LDA B,I GET WORD 1 OF ENTRY AND M17 ISOLATE THE UNIT # STA \DUNT AND SAVE LDA B,I NOW GET ALF,ALF AND MASK AND M17 THE STA \DSHD STARTING HEAD LDA B,I ALF NOW ISOLATE AND M17 THE STA \DNSU NUMBER OF SURFACES INB LDA B,I GET WORD 2 OF ENTRY CLE SET NO-INIT FLAG SSA CCE INIT WANTED FOR THIS SUBCH AND M7777 REMOVE SIGN BIT STA \DNTR SET THE # OF TRACKS INB LDA B,I AND FINALLY STA \DNSP SET THE # OF SPARES RESERVED CLA BUT CLEAR STA UBADC THE NUMBER USED JMP \SETD,I * M7777 OCT 77777 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE \STD5 SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD5 NOP LDB HPDSK GET ADDR OF INSTRUCTION ADDR LIST LDA #DATA GET # INSTRUCTIONS TO CONFIGURE STA TEMP1 STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR \TCH INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP1 SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION * CCA SET NO HEADER STA \BADH FOR BAD TRACKS JMP \STD5,I RETURN * #DATA ABS I/OTB-I/OTC # DATA I/O INSTRUCTIONS HPDSK DEF I/OTB,I ADDRESS OF INSTRUCTIONS TEMP1 NOP SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO * INITIALIZE A TRACK. * SPC 2 * EOCYL ENTRY CONDITIONS: * STATUS ERRORS 11 AOáþúND 14 * SEEK CHECK ON A STATUS 2 ERROR * OUT OF SPARES * EOCYL JSB INTON LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDB ERR43 ELSE SEND BAD SPECIFICATION LDA P15 JSB \DSPL MESSAGE AND JMP \XOUT TERMINATE SPC 2 * * BAD TRACK ENCOUNTERED - MARK IT DEFECTIVE AND SPARE IT * * INIER ENTRY CONDITIONS: FROM ERRDS, STWRT, & DEFTR * INIER ISZ \BADH BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA \DSUB CONVERT THE SUBCHANNEL TO ASCII CMA,INA LDB P1 STB \CLEN LDB EMES1 JSB \CVAS LDA P12 LDB EMES2 SEND THE JSB \DSPL MESSAGE LDA P16 SEND THE SECOND LINE: LDB EMES3 " LOGICAL CYL HD UNIT" JSB \DSPL AND AWAY IT GOES. INIES LDA \TRAK GET TRACK ADDRESS STA BTRAK AND SAVE IT * INBSP LDB ABTMS ADDRSS OF BAD TRACK JSB TRKMS SEND THE BAD TRACK NUMBERS * * TRACK IS NOW REPORTED TO THE OPERATOR * FLAGD LDA \DNSP GET THE # SPARES CPA UBADC OUT OF SPARES?? JMP EOCYL+1 YES GO SEND ERROR 43 AND TERMINATE * LDA FLGDF SET TO FLAG DEFECTIVE STA \INIT LDA \DNTR GET BASE SPARE TRACK ADDRESS ADA UBADC ADD NUMBER USED SO FAR STA \TRAK SAVE FOR DISK5 JSB DADTR GO TRANSLATE TO DISC ADDRESSES LDA PT#TR PICK UP THE CYL (B= HEAD) DST CYLA2 SET THE SPARE'S ADDR IN DEFECTIVE TRACK LDB MADDR GET BUFFER ADDRESS CLE SET TO WRITE JMP DISK5 FLAG THE TRACK DEFECTIVE * * DO A STATUS-WRITE TO THE NEXT SPARE TRACK TO SEE IF IT IS: * - AVAIABLE FOR USE * - BEING USED AS A FMGR TRACK SPARE * - DEFECTIVE * INISS DLD CYLAD SET THE ADDR OF BAD TRACK IN DST CYLBD TEMPORARY STORAGE OF INIFS CLA báþú RESET THE INIT FLAG STA \INIT FOR THE STATUS WRITE INA AND SET SKFLG TO INDICATE THIS MODE JMP SETSK * * INIFS IS BRANCHED TO WHEN A SPARE TRACK HAS BEEN FOUND * TO BE AVAILABLE FOR USE * INIFS LDA FLGSP SET IOR CHEKS POSSIBLY THE WRITE PROTECT BIT STA \INIT THE SPARING FLAG DLD CYLBD SET THE ADDRESS OF THE BAD TRACK DST CYLA2 IN THE SPARE TRACK CLA CLEAR THE MODE FLAG * SETSK STA SKFLG SET MODE TO 0/1 LDA \DNTR COMPUTE THE TRACK ADDRESS ADA UBADC AGAIN STA \TRAK SAVE FOR DISK5 CLE SET TO WRITE LDB MADDR GET BUFFER ADDRESS JMP DISK5 FLAG THE SPARE * * TRACK NOW SPARED - REPORT WHICH SPARE USED * INIRS LDA UBADC REPORT THE ADA \DNTR LOGICAL TRACK # OF THE LDB ASPMS USED SPARE JSB TRKMS OK LDA CHEKS RESET THE INIT FLAG STA \INIT AND LDA BTRAK GET BAD TRACK # AGAIN STA \TRAK AND RESET AS CURRENT TRACK ISZ UBADC STEP THE SPARE COUNTER JMP \DSK5,I CONTINUE WRITING & INITIALIZING * * UNAVAILABLE SPARE - EITHER DEFECTIVE OR ALREADY A FMGR SPARE * SO REPORT IT AND GO TRY THE NEXT ONE * NIXSP DLD CYLBD RESET THE ORIGINAL BAD TRACK ADDRESS DST CYLAD BECAUSE IT MUST BE REFLAGGED WITH A CCB NEW SPARE ADDRESS STB SKFLG ALSO MUST RE-SEEK TO THAT BAD TRACK LDA UBADC HERE IF SPARE IS BAD ISZ UBADC BUMP SPARE COUNT ADA \DNTR COMPUTE UNIT TRACK# JMP FLAGD DON'T REPORT BAD SPARE * BTRAK NOP ORIGINAL BAD TRACK # CYLBD BSS 2 & ITS CYLINDER, HEAD/SECTOR ADDRESSES SKP * * REPORT BAD TRACK/ SPARE ROUTINE * * A = LOGICAL TRACK * B = ADDRESS OF FIRST 5 WORDS OF MESSAGE * PT#TR = CYL ADDRESS * H#AD = HEAD ADDRESS * UN#INãþúT = UNIT ADDRESS * * JSB TRKMS * RETURN A,B MEANINGLESS * TRKMS NOP STB TRK01 SAVE THE ADDRESS CMA,INA SET UP TO CONVERT THE TRACK LDB P2 STB \CLEN LDB ALBUF TO THE MESSAGE BUFFER JSB \CVAS DO IT LDA PT#TR NOW CONVERT CMA,INA THE CYL. # LDB ACYLM TO THE MESSAGE JSB \CVAS LDA H#AD CONVERT THE HEAD ALF,ALF ADA BL0 STA HEDMS SET IT IN THE MESSAGE LDA UN#IT NOW THE UNIT ADA BL0 STA UNIMS SET IN THE MESSAGE LDA N6 STA MOV6 COUNTER LDA TRK01 GET THE PREAMBLE LDB EMES4 AND STB TEMP2 MOVE LDB A,I MOVE IT TO THE STB TEMP2,I MESSAGE ISZ TEMP2 INA ISZ MOV6 JMP MOVE LDA P15 SEND LDB EMES4 "XXXXXXXXXX LLLLL CCCCCC H U" JSB \DSPL TO THE TTY JMP TRKMS,I AND RETURN * MOV6 NOP N6 DEC -6 TEMP2 NOP TRK01 NOP ASPMS DEF SPMS ABTMS DEF BTMS ALBUF DEF TKMS ACYLM DEF CYLMS EMES4 DEF EMS4 EMES2 DEF *+1 ASC 11,BAD TRACKS SUBCHANNEL XX EMSS2 NOP LOCATION FOR XX EMES1 DEF EMSS2 BL0 ASC 1, 0 EMES3 DEF *+1 ASC 5, ASC 11, LOGICAL CYL HEAD UNIT EMS4 ASC 6,BAD TRACK TKMS ASC 3, CYLMS ASC 3, HEDMS ASC 2, UNIMS ASC 1, BTMS ASC 6,BAD TRACK SPMS ASC 6,SPARED TO ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 UBADC NOP # USED SPARES SPC 7 * SWTCH DISC DRIVER I/O INSTRUCTION ADDRESSES * I/OTB DEF DSKDR DATA CHANNEL DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 DEF DSK28 DEF DSK29 DEF DSK30 I/OTC EQU * HED 7905 I/O DISC DRIVER * THE DISK5 SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WOœMþúRDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER. FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN * THE IRRECOVERABLE ERROR EXIT AT EOCYL IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * THEN: IF THE INIT FLAG IS SET GO TO EOCYL, * ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * * THE \DSK5 ROUTINE INTERCEPTS ALL I/O CALL TO DISK5 AND SETS THE * PROPER VALUES FOR THE FLAG WORD CHEKS AND THE FILE MASK * INSTRUCTION FILMK. THEIR VALUES DEPEND ON WHETHER A READ * OR A NORMAL WRITE VERSUS AN INITIALIZE WRITE IS BEING DONE. * FOR INITIALIZE WRITES, A REGULAR WRITE WITH SPARING DISABLED * IS DONE FIRST IN ORDER TO DETECT THE PRESENT STATUS OF THE * TRACK (IE, POSSIBLY DEFECTIVE) SO THAT THAT STATUS MAY BE * ACKNOWLEDGED. CHEKS CONTAINS THE ORIGINAL VALUE OF \INIT * AS SET BY THE CALL FROM SWTCH'S MAINLINE CODE - UNLESS IT WAS * A READ CALL IN WHICH CASE IT IS SET TO 0. \INIT IS THEREFORE * THE TEMPORARY VALUE PERTAINING TO EACH I/O CALL AND MAY BE * 0 FOR A REGULAR READ/WRITE, OR SET TO THE VALUES FOR FLAGGING * PROTECTED, DEFECTIVE, AND/OR SPARE TRACKS. * \DSK5 NOP SEZ IF A READ CALL CLA,RSS THEN ALWAYS SET TO 0 LDA \INIT ELSE GET THE INTENDED MODE STA CHEKS AND SAVE SZA IF AN INITIALIZE WRITE JMP SET5 THEN GO SET THE \INIT & FILMK VALUES STA SKFLG CLEAR DEF-SEEK/SPARE-STATUS FLAG LDA FLMWS OTHERWISE ENABLE SPARING STA FILMK ON ALL ACCESSES JMP DISK5 AND GO DO IT! * SET5 CLA CLEAR THE INIT MODE RÆþúFLAG STA \INIT TO SIGNAL A WRITE FOR STATUS PURPOSES STA SKFLG CLEAR DEFECTIVE-SEEK/SPARE-STATUS FLAG LDA FLMNS DISABLE SPARING SO DEFECTIVE & STA FILMK AND SPARE TRACKS CAN BE DETECTED JMP DISK5 * CHEKS NOP ORIGINAL TRANSFER MODE OF I/O CALL FLMNS OCT 107400 FILE MASK WITH NO AUTOMATIC SPARING FLMWS OCT 107404 FILE MASK WITH AUTOMATIC SPARING SKFLG NOP DEFECTIVE-SEEK = -1 / SPARE-STATUS = 1 / ELSE 0 SKP * * DISK5 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK GET TRACK ADDRESS JSB DADTR TRANSLATE THE TRACK ADDRESS LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA WRTCM GET THE WRITE COMMAND ADA \INIT ADD THE INIT CODE STA W#CMD AND SET IT LDA \INIT GET THE INIT CODE CPA FLGDF IF FLAGGING A DEFECTIVE TRACK JMP OFF THEN SKIP ADDRESS SETUP FOR SEEK LDA PT#TR GET THE CYLINDER LDB \SECT SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES * LDA \INIT IF FLAGGING A SPARE AND M137 CPA FLGSP JMP OFF THEN SKIP THE SECOND ADDRESS SET UP LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND * OFF JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB +˜þúMADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB WRITE? JMP DSEEK NO, GO DO REGULAR READ SEQUENCE * LDA CHEKS GET INITIAL TRANSFER MODE SZA,RSS JMP WSEEK GO DO A REGULAR WRITE LDA \INIT IS THIS THE FIRST WRITE FOR STATUS? SZA,RSS JMP WSEEK THEN MUST SEEK LDA SKFLG MUST SEEK FOR A SECOND-TIME-AROUND DEFECTIVE SZA FLAGGING, OR STATUS-WRITE TO A SPARE JMP WSEEK GO SEEK * LDA W#CMD SINCE A WRITE WAS JUST DONE JSB XFER WITH NO END COMMAND ISSUED, A SEEK DEF ADRES-1 NEEDN'T BE DONE DEF R/WCM JMP CKSTA CHECK ERROR STATUS * WSEEK LDA W#CMD SET TO WRITE DSEEK JSB XFER STANDARD TRANSFER WITH SEEK DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JMP FAULT 01 ILLEGAL OP - PROGRAM FAULT JMP FAULT 02 UNIT AVAIL. PROGRAM FAULT JMP FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 04 " " " " JMP FAULT 05 " " " " JMP FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JMP FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JMP FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JMP FAULT 15 UNIMPLEMENTED ERROR CODE - FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JMP ISPAR 20 ILLEGAL SPARE JMP DEFTR 21 DEFECTIVE TRACK JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR ††þú JMP ST2ER 23 STATUS 2 GO CHECK JMP FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 25 " " " " JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. SKP * * ERRDS ENTRY CONDITIONS: * STATUS 10,16,17 ERRORS * VERIFY ERROR * INVALID STATUS 2 ERROR * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN * LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP DSKER NO, SO FLAG THE ERROR JSB INTON TURN THE INTERRUPTS BACK ON JSB STWRT IF STATUS WRITE, BRANCH APPROPRIATELY CPA \INT5 INIT ONLY? RSS CPA \INP5 INIT,WRITE PROTECT? JMP INIER YES, GO SPARE IT CPA FLGDF IF TRACK IS BEING SET JMP INISS DEFECTIVE - GO CHECK THE SPARES AND M137 CPA FLGSP IF TRACK IS BEING SPARED JMP NIXSP THEN MUST TRY ANOTHER RSS SKIP INTON CALL * * DSKER JSB INTON LDA \TRAK ERROR MESSAGE CONTAINING THE CMA,INA TRACK # LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXXX" JMP \XOUT SPC 2 * * IF A STATUS-WRITE FOR EITHER A REGULAR TRACK OR * FOR A SPARE TRACK, BRANCH APPROPRIATELY FOR THE ERROR * STWRT NOP LDA \INIT GET THE PRESENT MODE SZA,RSS IF STATUS THEN LDA SKFLG CHECK IF CHECKING A SPARE'S STATUS CPA P1 IN WHICH CASE A NEW JMP NIXSP SPARE MUST BE GOTTEN SZA,RSS OTHERWISE, JMP INIER THIS TRACK MUST BE MARKED DEFECTIVE JMP STWRT,I RETURN TO ERRDS OR DEFTR FOR MORE CHECKS SKP * * STATUS 21 ERROR - CHECK IF INITIALIZING OR NOT * DEFT‹~þúR JSB INTON TURN INTERRUPTS BACK ON LDB CHEKS WAS THIS A WRITE WITH STATUS SZB,RSS CHECKING? JMP FAULT NO - REGULAR READ/WRITE WITH NO RECOVERY * JSB STWRT IF A STATUS-WRITE, BRANCH APPROPRIATELY CPA FLGDF WAS IT JUST MARKED DEFECTIVE? JMP INISS YES, SO GO SPARE IT NOW AND M137 MASK OFF POSSIBLE WP BIT CPA FLGSP WAS IT JUST SPARED? JMP NIXSP YES, GO TRY ANOTHER SPARE JMP INIER OTHERWISE, FLAG DEFECTIVE & SPARE IT SKP * * ILLEGAL SPARE (STATUS 20 ERROR) * - IF NOT INITIALIZING THE SYSTEM * SUBCHANNEL IN FILESAVE MODE, THEN IGNORE * ISPAR LDB CHEKS WAS THIS A WRITE INITIALIZE? SZB,RSS JMP FAULT-1 NO, SO STATUS 20 ERROR IS VALID * LDA SKFLG IF CHECKING THE STATUS OF A SPARE CPA P1 THEN CHECK FURTHER IF RSS IT IS AVAILABLE FOR USE JMP END01 OTHERWISE IGNORE ERROR & CONTINUE * * IF NOT THE SYSTEM SUBCHANNEL OR NOT SAVING FILES, * THEN RE-USE THE TRACK. * LDA \DSUB IS THE SYSTEM SUBCHANNEL CPA \TSUB BEING INITIALIZED? RSS JMP USESP NO - SO SPARE CAN BE REUSED LDB \SAVE ARE FILES BEING SAVED? SZB JMP GETBD YES, SEE IF IT LIES IN THE FMGR SPACE * USESP JSB INTON TURN INTERRUPTS BACK ON JMP INIFS GO REUSE IT * NEXTS JSB INTON TURN INTERRUPTS BACK ON JMP NIXSP AND TRY NEXT SPARE TRACK * * STILL INITIALIZING THE SYSTEM SUBCHANNEL, CHECK IF TRACK * BELONGS TO THE FMGR AREA. * GETBD LDB N3 MUST READ THE ADDRESS OF THE DEFECTIVE STB \LNTH THAT WAS STORED IN THIS SPARE LDB DPBUF GET THE 3-WORD PREAMBLE BUFFER ADDR LDA RFSCM AND THE READ FULL SECTOR COMMAND JSB XFER AND PERFORM THE READ DEF ADRES-1 ADDRESS OF COMMAND TABLE, -1 DEF R/WCM ADDRESS OF LAST COMMAND TO EXECUTE ÿ/þú* LDA N6144 RESET THE LENGTH OF DMA TRANSFER STA \LNTH TO ONE TRACK LDA HDSSP GET THE HEAD/SECTOR ADDR ALF,ALF ROTATE TO LOW BYTE AND M37 AND ISOLATE STA HDSSP SAVE ONLY THE HEAD # * LDB \SAVE LDA \FFMP GET FIRST LOGICAL FMP TRACK SSB IF SOME WERE OVERLAID LDA \STRK THEN GET NEXT TRACK AFTER SYSTEM JSB DADTR CONVERT FIRST FMP TRACK TO CYL & HEAD * * CHECK IF DEFECTIVE TRACK LIES WITHIN CURRENT SUBCHANNEL DEFINITION * LDA N5 CLEAR SURFACE BUFFER STA TEMP1 SET LOOP COUNTER CLA LDB DSBUF GET BUFFER ADDRESS STA B,I INB ISZ TEMP1 DONE? JMP *-3 NO * LDA \DNSU GET # SURFACE OCCUPIED BY SYSTEM CMA,INA SUBCHANNEL, AND SET AS A STA TEMP1 LOOP COUNTER CLB,INB GET 'OCCUPIED' INDICATOR LDA \DSHD GET STARTING HEAD # ADA DSBUF AND OFFSET INTO BUFFER SETDS CPA ESBUF END-OF-BUFFER? JMP CHEKK (ERRONEOUS DEF'N) STB A,I MARK SURFACE AS ONE OCCUPIED BY SYS SUBCH INA BUMP BUFFER ADDRESS ISZ TEMP1 DONE? JMP SETDS NO * CHEKK LDA HDSSP GET HEAD # OF DEFECTIVE TRACK ADA DSBUF AND GET CORRESPONDING ENTRY IN TABLE LDB A,I SZB,RSS POSSIBLY WITHIN THE SYS SUBCH? JMP USESP NO, SO SPARE CAN BE RESUED * * COMPARE WITH FIRST FMP CYLINDER * LDB PT#TR GET STARTING CYLINDER OF FMP CMB,INB AND COMPARE WITH DEF TRACK'S CYLINDER ADB CYLSP SSB JMP USESP DEFECTIVE TRACK CYLINDER IS LESS SZB GREATER? JMP CLAST YES, SO CHECK WITH LAST FMP TRACK * * SEE IF DEFECTIVE HEAD PRECEEDS STARTING HEAD OF FMP * LDA H#AD GET FIRST FMP HEAD# ALF,ALF INTO LOW BYTE AND M37 AND ISOLATE SZA,RSS Ë0þú IF ZERO THEN JMP NEXTS NO HEAD PRECEEDS IT - TRY NEXT SPARE CMA,INA ADA HDSSP GET DEFECTIVE HEAD# AND COMPARE WITH THAT SSA,RSS OF THE FIRST FMP - LESS? JMP NEXTS NO, THIS SPARING MUST BE PRESERVED - TRY NEXT JMP USESP GO AHEAD AND USE THIS SPARE * * SEE IF DEFECTIVE TRACK'S CYLINDER IS > LAST FMP CYLINDER * CLAST CCA CONVERT LAST TRACK ON SUBCHANNEL ADA \DNTR TO PHYSICAL CYLINDER AND HEAD JSB DADTR ADDRESSES LDB CYLSP GET DEFECTIVE TRACK CYL CMB,INB AND COMPARE WITH LAST FMP CYL ADB PT#TR JUST COMPUTED SSB GREATER? JMP USESP YES, REUSE THAT SPARE SZB LESS? JMP NEXTS YES, TRY FOR NEXT SPARE * * SEE IF DEFECTIVE HEAD# IS > LAST FMP CYL HEAD# * LDA H#AD GET LAST FMP HEAD ALF,ALF ISOLATE AND M37 LDB HDSSP COMPARE WITH HEAD# OF DEFECTIVE TRACK CMB,INB ADA B SSA,RSS JMP NEXTS TRY ANOTHER TRACK JMP USESP REUSE THAT SPARE SPC 2 DPBUF DEF *+1,I PREAMBLE BUFFER NOP CYLSP NOP CYLINDER ADDR STORED IN SPARE HDSSP NOP HEAD/SECTOR ADDR STORED IN SPARE N3 DEC -3 N5 DEC -5 N6144 DEC -6144 RFSCM OCT 3000 * DSBUF DEF *+1 BSS 5 SUBCHANNEL SURFACE BUFFER ESBUF DEF * SKP * * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO NRERR TO WAKE 'EM UP * PROTECTED SEND TURN ON THE SWITCH MESSAGE * ST2ER SSB,RSS IF NO STATUS 2 ERROR THEN JMP ST2 TRY FOR A FORMAT PROTECT SWITCH ERROR * LDA B STATUS 2 TO A AND P4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO TERMINATE JMP NRERR OTHERWISE, IT MUST NOT BE READY * ST2 LDA MADDR WAS THIÈNLHS A READ OR A WRITE? SSA JMP ERRDS READ - SO NEEDN'T WORRY ABOUT SWITCHS * LDA B GET THE STATUS WORD AGAIN AND M40 KEEP FORMAT BITS SZA,RSS SET?? JMP WRPTM TURN ON FORMAT SWITCHH LDA B GET STATUS -2 AGAIN AND M100 GET PROTECTED BIT SZA,RSS JMP ERRDS JUST COUNT THE ERROR AND TRY AGAIN * * * FORMAT/PROTECT ERROR - WARN 'EM AND WAIT * WRPTM STA TEMP2 SAVE BITS OF STATUS-2 JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS LDA TEMP2 LDB MS34A SZA LDB MS32A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA TEMP2 RETRIEVE THOSE BITS LDB MES34 "TURN ON FORMAT SWITCH - PRESS RUN" SZA LDB MES32 "TURN OFF DISK PROTECT - PRESS RUN" LDA P18 JSB \DSPL * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 HLT 32B WAIT FOR TURN ON JMP RTRY TRY AGAIN. SPC 1 ÖeNÿÿþú* * NOT READY ERROR - WARN 'EM AND WAIT * NRERR JSB INTON JSB \BLIN DISC IS NOT READY LDB MS33A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P14 LDB MES33 SEND THE WORD TO THE MAN JSB \DSPL "READY DISC AND PRESS RUN" * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 LDA STATB HLT 33B PAUSE JMP RTRY ON RESTART RETRY SPC 5 * * ENTRY CONDITIONS: * STATUS ERRORS 1,2,12 * UNIMPLEMENTED STATUS ERRORS 3,4,5,6,13,15,24,25 * FROM DEFTR ON A STATUS ERROR 21 * FROM ISPAR ON A STATUS ERROR 20 * JSB INTON TURN ON INTERRUPTS FOR MESSAGE FAULT LDA \TRAK CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT TERMINATE SPC 4 ESUB NOP CLA,INA SET FOR A 1-WORD CONVERSION STA \CLEN LDA \DSUB GET CURRENT SUBCHANNEL CMA,INA JSB \CVAS JMP ESUB,I SKP SPC 1 ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 M100 OCT 100 M137 OCT 137777 UN#IT NOP * SPC 3 * * INTON TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK30 CLF 0 CLC 6 JSB $LIBX DEF INTON SPC 3 * UWAIT WAIT FOR UNIT TO BECOME AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * SPC 3 * * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL ISZ EDCNT CHECK COUNT RSS JMP DSKER LDA CALC GEnÛþúT COMMAND JMP UWAT1 GO SEND IT SKP * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * ALSO IF DOING INITIALIZE AND NOT FLAGGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * NOTE: AN 'END' COMMAND IS NOT ISSUED IF A WRITE FOR STATUS PURPOSES * WAS JUST DONE, ALLOWING THE SEEK TO BE SKIPPED WHEN RE-WRITING . * ENDOK LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP ENDSX NO, JUST GO SEND THE END COMMAND * END01 LDA \INIT FIRST TIME THRU FOR THE SZA STATUS ONLY? JMP END02 NO - JUST DID THE REAL THING JSB INTON TURN INTERRUPTS BACK ON FIRST LDA SKFLG IF THE STATUS CHECK WAS TO A CPA P1 POTENTIAL SPARE TRACK JMP INIFS THEN NEEDN'T SEND THE END * STB \INIT YES, NOW THE THE CORRECT INIT FLAG LDB MADDR GET BUFFER ADDRESS CLE CLEAR FOR A WRITE JMP DISK5 NOW DO THE REAL INITIALIZE (NO END WAS DONE) * END02 RAL,SLA IF SPARING JMP STDAD THE SEEK ADDRESS IS ALREADY SET * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB \LNTH EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * SEND THE END COMMAND * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT LDA \BOOT ARE WE BOOTIN UP? SZA,RSS YES, SO GO DO IT! JMP ENDBR NO LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STORE IN BIT|6þúS RAL 11-6 OTA 1 OF THE SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 DETERMINE IF WE'RE IN AN CPB P2 RTE-II OR AN RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III/IV JMP A,I GO TO RTE! CLB MUST CLEAR THE BASE PAGE FENCE SETTING LFB DJP A,I WELL SAID! * M2055 OCT 2055 M1742 EQU 1742B * ENDBR JSB INTON LDA \INIT CPA FLGDF BRANCH APPROPRIATELY, JMP INISS FLAGGING DEFECTIVE - NOW GET A SPARE AND M137 CPA FLGSP JMP INIRS FLAGGING A SPARE - RESET \TRAK & \INIT JMP \DSK5,I AND EXIT SKP * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER. THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE DMA OTA 6 SEND CW1 CLC 2 PREPARE MEM ADDR REG FOR CW2 OTB 2 SEND CW2 STC 2 PREPARE WORD CNT REG FOR CW3 LDA \LNTH OTA 2 SEND CW3 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPA R/WCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC 0 TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA 0,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C ACTIVATE THE DMA DSK22 STC 0 START THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JS{´þúB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT SKP * * * XFER COMMAND TABLE * WAITC OCT 113000 WAKEUP COMMAND SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF SEEKC DEF VERCM DEF CALC DEF ADRES DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF RFSCM #UNST ABS UNITC-*+1 NUMBER IN THE LIST SKP * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * UNIT AT: UN#IT ALSO RETURNED IN A. * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * JSB DADTR CALL * * DADTR NOP CLB DIVIDE # TRACKS BY DIV \DNSU NUMBER OF HEADS/CYL ADA \DFTR ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS ADB \DSHD ADD THE BASE HEAD ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE LDA B PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT FROM LOW B LDA \TUNT STA UN#IT STORE IT AS PROMISED JMP DADTR,I RETURN A= UNIT, B=HEAD * PT#TR NOP H#AD NOP SKP * * STATW — RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA 0,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB 0,C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN SPC 3 * * * OUTCC OUTPUT THE COMMAND WORD IN THE A-REG * OUTCC NOP DSK26 CLC 0 SEND "HERE COME DE WORD" DSK27 OTA 0,C SEND DE WORD DSK28 STC 0 SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN SPC 3 * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS 0 HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN SPC 3 * * STACC OCT 1400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP R#DCM OCT 102400 W#CMD NOP DSKDR ABS 0 DMA CONTROL WORD MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 MES34 DEF *+1 ASC 18,TURN ON FORMAT SWITCH - PRESS RUN MS34A DEF MES34+18 MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * * END EQU * END BEG5 mçÿÿ ÿý–\ó ÿ92067-18011 2013 S C0422 &4ASMB ASSB?????-4??EN             H0104 ‡SþúASMB,R,L,C * * NAME: ASMB * SOURCE: 92067-18011 * RELOC: 92067-16011 * PGMR: C.C.H,S.P.K. * MODIFIED BY EARL STUTES 1976-09-20-1600 * MODIFIED BY EAS TO ADD DEY INSTRUCTION 1977-01-30 * MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD & GEN INSTR. * MODIFIED BY VERN MCGEORGE 13JUL79 TO COUNT CS & FMP ERRORS * MODIFIED BY VERN MCGEORGE 21JAN80 TO ALLOW NEG OPERANDS IN DEF * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB 92067-16011 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB,3,99 92067-16011 REV.2013 800131 * ********************************************* * * ASSEMBLER CONTROL STATEMENT OPTIONS * * * * * * A = ABSOLUTE ASSEMBLY * * * B = IGNORED * * * C = SCHEDULE 'XREF' FOR XREF TABLE * * * F = FLOATING POINT HDWE. INSTRUCTIONS * * * L = LIST OUTPUT W/ ENTIRE OBJECT CODE * * * Q = LIST OUTPUT W/ RELOC ADDR OF * * * OPERAND AS OBJECT CODE * * * N = ASSEMBLE STATEMENTS WITHIN 'IFN' * * * R = RELOCATABLE ASSEMBLY * * * T = LIST SYMBOL TABLE (END OF PASS 1) * * * X = NON-EAU INSTRUCTIONS * * * Z = ASSEMBLE STATEMENTS WITHIN 'IFZ' * * * P = NULL OVERRIDE OPTION * * ********************************************* * ENT ASMB SPC 1 EXT IFBRK EXT SUP.C,RED.C,WRT.C,PRM.C,GMM.C,OLY.„HþúC,SPC.C EXT EOF.C,END.C EXT C.SOR,C.LST,C.BIN,C.BIA,C.TTY SPC 1 EXT ?HA3Z,?LITI,?AREC,?BREC,?ART,?LKLI EXT ?CMQ,?ENP,?EXP,?EMP,?INSR,?INS? ENT ?ASCN,?ASMB,?BNCN,?BPKU,?CHOP,?CHPI,?DCOD ENT ?ENDS,?ERPR,?MSYS,?GETC,?MOVE,?MSYM ENT ?AFLG,?LSTL,?RFLG,?ASM1,?LABE ENT ?ORRP,?SETM,?SUP,?LPER,?PERL,?PLIN ENT ?LOUT,?LTFL,?LTSA,?LTSB,?ORGS,?CNTR ENT ?ASII,?ICSA,?FLGS,?LFLG,?TFLG ENT ?X,?MESX,?ASCI,?LINC,?LINS,?LIST ENT ?OPLK,?OPER,?PKUP,?PLIT,?PNCH,?PRNT,?RSTA ENT ?SEGM,?SYMK,?V,?ARTL,?LST,?LWA ENT ?NEAU,?HA38,?FMPE,?BINF,?ASME ENT ?FPT,?FP,?ENER,?PRPG,?ENFL ENT ?BPSV,?BASF,?GETA ENT ?NDOP,?NDSY,?SYML,?SYMT SUP SUPPRESS EXTENDED LISTING SPC 3 ENT ERRCN ENT ?TEMP,?NAMI,?NAME,?RELC,?SIGN,?SUMP ENT ?TERM,?T,?BYFL,?FLEX,?CNTB,?CODE,?DSIG ENT ?FLAG,?FLAQ,?INST,?LAST,?PASS,?PEEK,?PLCN ENT ?PLEN,?PNTR,?RCNT,?SAVB,?SCN1,?SYMI,?SYMP,?TEST ENT ?ENT.,?ENTC,?ENTV,?IOBF,?BUFF,?PBUF,?SVST ENT FUBP,FUBP2 * ****************************** * * OPCODE AND PSEUDO-OP TABLE * * ****************************** OPT OCT 40502,51421,0, 40504,40416,42001 ABS/ADA OCT 40504,41016,46001, 40514,43060,31700 ADB/ALF OCT 40514,51060,31400, 40514,51460,31000 ALR/ALS OCT 40516,42016,12001, 40522,51460,31100 AND/ARS OCT 40523,41407,0, 41114,43060,25700 ASC/BLF OCT 41114,51060,25400, 41114,51460,25000 BLR/BLS OCT 41122,51460,25100, 41123,51412,0 BRS/BSS OCT 41503,40461,53400, 41503,41061,47400 CCA/CCB OCT 41503,42463,42300, 41514,40461,52400 CCE/CLA OCT 41514,41061,46400, 41514,41450,106700 CLB/CLC OCT 41514,42463,0, 41514,43052,103100 CLE/CLF OCT 41515,40461,53000, 41514,47430,103101 CMA/CLO OCT 41515,41061,47000, 41515,42463,42200 CMB/CME OCT 41517,46403 COM DEF ?CMQ OCáþúT 41520,40416,52001, 41520,41016,56001 CPA/CPB OCT 42105,41410,0, 42105,43020,0 DEC/DEF OCT 42105,54025,0, 41131,52043,0 DEX/BYT ASC 2,DEY$ DEY OCT 0 OCT 42514,40460,131600, 42516,52004 ELA/ENT DEF ?ENP OCT 42514,41060,125600, 42516,42014,0 ELB/END OCT 42522,40460,131500, 42521,52413,0 ERA/EQU OCT 42522,41060,125500, 42530,52005 ERB/EXT DEF ?EXP OCT 42515,40405 EMA DEF ?EMP OCT 44114,52051,102000,46111,40450,102500 HLT/LIA OCT 46111,41050,106500,46511,40450,102400 LIB/MIA SKP * ?FPT EQU * < FLOATING POINT SUBROUTINE/MACRO OPCODES > * OCT 43101,42006 FAD DEF ?HA38 OCT 43104,53006 FDV DEF ?HA38 OCT 43115,50006 FMP DEF ?HA38 OCT 43123,41006 FSB DEF ?HA38 * OCT 44516,40466,52004, 44516,41066,46004 INA/INB OCT 43505,47033,0, 46117,42034,0 GEN/LOD OCT 44517,51016,32001, 44523,55016,36000 IOR/ISZ OCT 45115,50016,26000, 45123,41016,16000 JMP/JSB OCT 46104,40416,62001, 46104,41016,66001 LDA/LDB OCT 46511,41050,106400, 47101,46415,0 MIB/NAM OCT 47117,50030,0, 47503,52011,0 NOP/OCT OCT 47524,40450,102600, 47522,43401 OTA/ORG DEF ORGP OCT 47524,41050,106600, 47522,51002 OTB/ORR DEF ORRP OCT 51101,46060,31200, 51101,51060,31300 RAL/RAR OCT 51102,46060,25200, 51102,51060,25300 RBL/RBR OCT 51120,46032,0 RPL OCT 51123,51470,42001, 51505,55062,42040 RSS/SEZ OCT 51506,41452,102200, 51506,51452,102300 SFC/SFS OCT 51514,40465,10010, 51514,41065,4010 SLA/SLB OCT 51517,41453,102201, 51517,51453,102301 SOC/SOS OCT 51523,40464,52020, 51523,41064,46020 SSA/SSB OCT 51524,40416,72000, 51524,41016,76000 ºMþúSTA/STB OCT 51524,41450,102700, 51524,43052,102100 STC/STF OCT 51524,47430,102101, 51532,40467,52002 STO/SZA OCT 51532,41067,46002, 54117,51016,22001 SZB/XOR OCT 47522,41000 ORB DEF ORBP OCT 46123,52024,0, 51513,50022,0 LST/SKP OCT 51525,50040,1, 44105,42017 SUP/HED DEF HEDSB OCT 52516,46024,1, 51105,50035 UNL/REP DEF REPSB OCT 52516,51440,0, 44506,47031,116 UNS/IFN OCT 54111,43031,0, 44506,55031,132 XIF/IFZ OCT 51520,41423,0, 46511,41500,0 SPC/MIC * SKP * * * * 21MX INSTRUCTION SET * * * * OCT 41501,54030,101741, 41501,54430,101751 CAX/CAY OCT 41502,54030,105741, 41502,54430,105751 CBX/CBY OCT 54101,54030,101747, 54101,54430,101757 XAX/XAY OCT 54102,54030,105747, 54102,54430,105757 XBX/XBY OCT 44523,54030,105760, 44523,54430,105770 ISX/ISY OCT 42123,54030,105761, 42123,54430,105771 DSX/DSY OCT 46104,54110,105745, 46104,54510,105755 LDX/LDY OCT 45114,54511,105762, 45120,54513,105772 JLY/JPY OCT 46101,54111,101742, 46101,54511,101752 LAX/LAY OCT 46102,54111,105742, 46102,54511,105752 LBX/LBY OCT 51501,54111,101740, 51501,54511,101750 SAX/SAY OCT 51502,54111,105740, 51502,54511,105750 SBX/SBY OCT 51524,54111,105743, 51524,54511,105753 STX/STY OCT 40504,54110,105746, 40504,54510,105756 ADX/ADY OCT 41530,40430,101744, 41530,41030,105744 CXA/CXB OCT 41531,40430,101754, 41531,41030,105754 CYA/CYB OCT 46102,52030,105763, 51502,52030,105764 LBT/SBT OCT 51506,41030,105767, 52102,51515,105775 SFB/TBS OCT 51502,51515,105773, 41502,51515,105774 SBS/CBS OCT 41502,52114,105766, 46502,52114,105765 CBT/MBT OCT 46526,53514,105777, 41515,53514,105776 MVW/CMW OCT 42102,46041,0, 42102,51042,1 DBL/DBR * * * * * 21MX - MEU INSTRUCTIONS * * * * OCT 42112,50111,105732, 42112,51511,105733 DJP/DJS OCT 45122,51515,105715 âiþú JRS OCT 46106,40430,101727, 46106,41030,105727 LFA/LFB OCT 46502,43030,105703, 46502,44430,105702 MBF/MBI OCT 46502,53430,105704, 46527,43030,105706 MBW/MWF OCT 46527,44430,105705, 46527,53430,105707 MWI/MWW OCT 50101,40430,101712, 50101,41030,105712 PAA/PAB OCT 50102,40430,101713, 50102,41030,105713 PBA/PBB OCT 51123,40430,101730, 51123,41030,105730 RSA/RSB OCT 51126,40430,101731, 51126,41030,105731 RVA/RVB OCT 51512,50111,105734, 51512,51511,105735 SJP/SJS OCT 51523,46511,105714 SSM OCT 51531,40430,101710, 51531,41030,105710 SYA/SYB OCT 52512,50111,105736, 52512,51511,105737 UJP/UJS OCT 52523,40430,101711, 52523,41030,105711 USA/USB OCT 54103,40511,101726, 54103,41111,105726 XCA/XCB OCT 54114,40511,101724, 54114,41111,105724 XLA/XLB OCT 54115,40430,101722, 54115,41030,105722 XMA/XMB OCT 54115,46430,105720, 54115,51430,105721 XMM/XMS OCT 54123,40511,101725, 54123,41111,105725 XSA/XSB * ?NEAU EQU * * START OF NON-EAU OPTABLE SWAP AREA * * OCT 42111,53026,100400, 42114,42026,104200 DIV/DLD OCT 42123,52026,104400, 46520,54426,100200 DST/MPY OCT 40523,46027,100020, 40523,51027,101020 ASL/ASR OCT 46123,46027,100040, 46123,51027,101040 LSL/LSR OCT 51122,46027,100100, 51122,51027,101100 RRL/RRR OCT 51527,50030,101100,51101,46451,105000 SWP/RAM * ?FP EQU * * OCT 0,54030,105100,43114,52030,105120 FIX/FLT OCT 0 ********* END OF OPCODE TABLE *********** * * SKP * ************************************* * * PUT OUT A MESSAGE TO THE OPERATOR * * ************************************* MESSX NOP STA MESS SET MESSAGE LOCN STB MESS+1 SET MESSAGE LENGTH JSB WRT.C DEF C.TTY CONSOLE FCB - OUTPUT ON SYSTEM TTY DEF MADDR MESSAGE ADDRESS DEF MSGLN MESSAGE LENGTH NOP %þú JMP MESSX,I EXIT SEGNM ASC 3,ASMB ASGNM DEF SEGNM MADDR ASC 7, /ASMB: $END MESS ASC 2, MESSAGE EXTENSION MSGLN DEC 9 * ******************************* * * GO TO LOAD THE NEXT SEGMENT * * ******************************* SEGMT STA DFSG# SET CORRECT DIGIT (0,1,2,3,OR 4) JSB SGNAM DEF DFSG# SEGMENT # JSB OLY.C LOAD OVERLAY SEGMENT DEF SEGNM DLD NOSG SEGMENT NOT FOUND JSB MESSX JMP ABORT DFSG# NOP NOSG ASC 2,NOSG * SGNAM NOP ROUTINE TO DETERMINE NAME OF SEGMENT LDA SGNAM,I GET ADDRESS OF SEG# LDA A,I SEGMENT # ADA B60 CONVERT # TO ASCII DECIMAL ALF,ALF MOVE TO UPPER BYTE STA SEGNM+2 SET UP SEGMENT NAME ISZ SGNAM LDB ASGNM JMP SGNAM,I RETURN * * SPC 1 * *********************** * * EXIT FROM ASSEMBLER * * *********************** ABORT LDA MXEND SET UP END MESSAGE FOR EOF ABORT LDB MXEND+1 JSB MESSX GO PRINT MESSAGE JMP ASMEX GO TO COMPLETION MXEND ASC 2,XEND * ASMBX LDA BINFL GET BINARY FLAG SZA,RSS SET? JMP XRFSC NO, THEN SEE IF XREF TO BE SCHEDULED LDA AFLAG YES SZA ABSOLUTE ASSEMBLY? JMP EOFAB YES, CLOSE ABSOLUTE OUTPUT FILE JSB EOF.C WRITE EOF ON RELOCATABLE OUTPUT FILE DEF C.BIN BINARY RELOC. FILE FCB BINER CLB,INB,RSS ERROR RETURN JMP XRFSC JMP ?FMPE DISPLAY ERROR * EOFAB JSB EOF.C WRITE EOF ON ABSOLUTE OUTPUT FILE DEF C.BIA ABSOLUTE OUTPUT FILE FCB JMP BINER * XRFSC LDA CFLAG CROSS-REFERENCE TABLE REQUESED? SZA,RSS JMP EOFLS NO, THEN WRITE EOF ON LIST FILE CLA,INA SET FLAG FOR SEGMENT D STA ?ENFL TO INDICATE SCHEDULE XREF CLA JMP SEGMT USE SEGMENT D * EOFLS JSB EOF.C .þú WRITE EOF RECORD ON LIST FILE DEF C.LST CLA,RSS JMP ASMEX JMP ?FMPE * ASMEX LDA BLNS LDB BLNS SEND $END MESSAGE JSB MESSX LDA ERRCN ERROR COUNT STA TEMP SEND PARM BACK JSB END.C DEF TEMP BUFFER LOC JMP *-3 IF ERROR RETURN TRY TO END ASMB AGAIN * * .8 DEC 8 B60 OCT 60 ?ENFL NOP * SKP * ********************************************* * * OPLK: OPCODE TABLE LOOKUP - WALDY HACCOU * * * CALLING SEQUENCE: L JSB OPLK,I * * * L+1 ERROR RETURN * * * L+2 NORMAL RETURN * * * OUTPUT VALUES: VALUE IN A REG. AND 'CODE'* * * INSTR.FORMAT IN B AND 'INST'* * ********************************************* DOPL DEF TEMP+5 DEF OPT LOC'N OF OPCODE TABLE OPLK NOP JSB BPKUP GET OPCODE POSN STB SCN1+1 CLA STA TEMP+6 CLEAR TEMP+6 STA MFLAG CLEAR SUPPLEMENTAL TABLE FLAG LDA 1 B REG TO A REG JSB GETA GET OPCODE ADDRESS STB OPLMV LDA .3 LDB DOPL L(TEMP+5) JSB MOVE OPLMV NOP MOVE ORIGIN HERE LDB DOPL+1 L(OPCODE TABLE) OPLGO LDA 1,I GET NEXT ENTRY INB CPA TEMP+5 CHECK 1ST 2 CHARS. JMP K J ADB .2 LDA 1,I SZA END OF TABLE? JMP OPLGO NO-PICK UP NEXT ENTRY LDA MFLAG YES- SZA REACHED END OF SUPPL. TABLE? JMP OPMIC YES-CHECK FOR 'MIC' LDB ?NDOP NO-SET POINTER TO TABLE STB MFLAG SET SUPPLEMENTAL TABLE FLAG CPB ?LWA ANY ENTRIES IN SUPPLEMENTAL TABLE? JMP OPMIC NO--INVALID OPCODE; CHECK 'MIC'. JMP OPLGO GO TO CHECK NEXT ENTRY OPMIC LDA CODE GET OPCODE I.D. NO. CPA B100 CODE =100B (MIC)? JMP OPLK,I YES--ÐþúO.K., RETURN. * * * ERROR EXIT HERE * * LDA .OP 'OP' OPCODE ERROR JSB ERPR CLA FORCE A 'NOP' FOR STA INST INVALID OPCODE'S INSTRUCTION. JMP OPLK,I EXIT HERE ON 'OP' ERROR K LDA 1,I CHECK LAST CHAR OF OPCODE AND UMSK CPA TEMP+6 COMPARE IT JMP *+2 OPCODE FOUND ,SKIP JMP J NOT FOUND, TRY NEXT ENTRY LDA 1,I AND LMASK SET 'A' = OPCODE TYPE INB LDB 1,I STB INST = INSTRUCTION FORMAT STA CODE = VALUE OF CODE ISZ OPLK JMP OPLK,I EXIT ALPHA+2 * MFLAG NOP SUPPLEMENTAL-OPCODE-TABLE FLAG B100 OCT 100 * SKP * ****************************************************** * * EVALUATE OPERAND; TEST/PROCESS 'C' OR 'I' MODIFIER * * ****************************************************** * CLER DEF RELC START OF 5 WORD CLEAR AREA CHOP NOP * * * ON ENTRY A = MODIF.PARAMETER (I,C,0=NONE,2=ASC) * * * B= MASK NECESSARY FOR I OR C MODIFIER * * STA FLAG STB FLAQ SPC 1 * * CLEAR CHOP PARAMS IN T, RELC, SIGN, SUMP & TERM.. * LDA .5 LDB CLER START OF CLEAR AREA JSB SETM ZERO NOP TO SET MEMORY TO ZERO STA XORD INITIALIZE XORD =0. STA EMASY CLEAR FLAG FOR EMA SYMBL LOOKED UP IN SYMBL TBL ISZ SIGN SET SIGN = + (+1=+,-1=-) LDA SCN1+2 OPER.POSN. STA PNTR SZA,RSS JMP HD22 ERROR**NO OPERAND * * * GET THE 1ST CHARACTER * JSB GETC CPA L+3 PLUS? JMP HD34 YES CPA L+5 MINUS? JMP HD32 YES JMP HD35 NO * * * PROCESS AN ASTERISK '*' * HD26 CLA,INA SET A=1 CPA SYMP IS THE '*' ALONE? RSS YES - GOOD JMP HD22 NO - IT'S AN ERROR ADA ?BASF SET A -íþú= CURRENT RELOCATION TYPE. LDB AFLAG GET ABS. ASSMBL. FLAG SZB IS THIS AN ABS. ASSEMBLY? CLA YES, CLEAR A(WILL BE RELOC. BIT) LDB PLCN PROG LOCN CNTR TO B REG STB SAVB SAVE PLCN VALUE-TEMPORARILY. JMP HD50A * * * CHOP LOOP PROCESSING HERE * HD30 LDA PEEK CPA L+4 TEST PEEK FOR A JMP HD36 COMMA, GO TO TEST MODIFIERS CPA BLNK JMP HD40 =BLNK CLB,INB SET 'SIGN' FOR + CPA L+3 PLUS? RSS YES * * * PROCESS SIGNS HERE * HD32 CCB SET 'SIGN' FOR - STB SIGN (HD32+1) HD34 ISZ PNTR * * * PICK UP NEXT SET OF CHARS.IN BUFFER * HD35 JSB BPKUP GET POSN OF NXT NON-BLNK CHAR.HD32+3 STA PEEK STB PASCN SAVE PNTR FOR ASCN RTN JSB MSYMS MEAS.SYMBOL, SET SYMP/SYMN ADA PNTR STA PNTR * * * TEST FOR NUMERIC OR SYMBOLIC SET * LDA PEEK FIRST CHAR OF SET TO A FOR TESTING LDB TEST STB PEEK SAVE CHAR.FOR LATER TEST CPA L+2 ASTERISK? JMP HD26 TO '*' PROC ADA .M58 -58 SSA,RSS TEST FOR SYMBOLIC TERM JMP HD50 PROCESS THE SYMBOL ADA .10 (10) SSA JMP HD50 PROCESS THE SYMBOL * * * PROCESS NUMERIC SET HERE * LDB SYMP ADB .M1 LDA LAST IS B LAST - CPA .B CHARACTER? JMP *+2 * * SET B REG FOR ASCN ROUTINE ADB .401B LDA PASCN JSB ASCN TO AXCII CONVERSION TO BINARY JMP CHOP,I ERROR EXIT FROM ASCII CONV. JMP HD61+1 A REG CONTAINS THE VALUE * * * TEST INFORMATION FOLLOWING COMMA, IF LEGAL * * -USES FLAG AND FLAQ * * -IF C OR I, SET CORRECT BIT IN INSTRUC. USING FLAQ AS MASK * HD36 LDB FLAG SZB,RSS IS COMMA LEGAL JMP HD37 -NO- ERROR CP$ÙþúB .2 'ASC'? JMP HD40 -YES- ISZ PNTR POINT TO CHAR.FOLLOWING COMMA JSB BPKUP SEARCH FOR NON-BLANK JSB MSYM MEASURE SYMBOL CPA .1 1 CHAR SYMBOL? JMP HD43 YES * * NO - ERROR HD37 JSB OPERR OPERAND ERROR JMP HD40 HD43 LDA TEST CPA BLNK BLANK TERMINATOR? JMP *+2 -YES- JMP HD37 -NO- ERROR LDA LAST CHAR TO A CPA FLAG =I/C? RSS YES, O.K. JMP HD37 ERROR: NOT 'I' OR 'C' MODIFIER! LDA INST IOR FLAQ SET I OR C BIT STA INST LDA CODE CPA L+2 STF OR CLF? (52) JMP HD37 -YES- ERROR * * * CHOP TERMINATION PROCESSOR * * HD40 CLA INITIALIZE THE STA SIGN OFFSET FLAG TO ZERO. LDA RELC A=RELOCATION CODE LDB CODE B=INSTRUCTION I.D. SZA ABSOLUTE OPERAND? JMP RELOC NO, CHECK RELOCATABLE. HD40A LDA SUMP YES, GET OPERAND VALUE. SSA NEGATIVE? CPB .17 YES. IS IT ABS (21B)? JMP HD42 YES-OK- CPB .32B NO. IS IT RPL (32B)? JMP HD42 YES-OK- JMP HD22 NO. *ERROR* * * * VALUE IS RELOCATABLE, TEST FOR VALIDITY * * RELOC LDA T IS RELOC. NUMBER SZA CANCELLED? JMP HD40B NO. CHECK FOR LEGAL RELOC. STA RELC YES, SET RELOCATION CODE =0. JMP HD40A GO TO CHECK FOR NEGATIVE OPERAND. HD40B CPA .1 LEGAL RELOC? (+1) RSS -YES- SKIP JMP HD22 NO,ERROR. CPB .1 ORG? JMP E -YES * * * CHECK: EQU,END,ORG,DEF,HED,& I/O EXT * * ADB .M11 -11 SSB CODE <13B? JMP HD22 YES, ERROR ADB .M6 SSB CODE > 20B ? JMP E NO. CHECK FOR EXTERNAL. ADB .M27B YES.Ôíþú CODE LESS THAN SSB 50B ? JMP HD22 YES. ERROR: NOT I/O! ADB .M3 CODE GREATER THAN SSB,RSS 52B ? JMP HD22 YES. ERROR: NOT I/O! CLB FORCE ERROR IF NON-EXT I/O. E LDA RELC GET RELOC. CODE. CPA .4 EXTERNAL ? JMP HD41 YES. CHECK VALIDITY. * LDA CODE CHECK FOR DEF / ALLOW NEG OPERAND CPA .16 JMP HD42 * LDA SUMP GET VALUE OF OPERAND. SSA,RSS ERROR, IF NEGATIVE. SZB,RSS RELOC. VALID FOR THIS OPCODE? JMP HD22 NO. * 'M' ERROR * JMP HD42 VALID RELOC. GO TO FINISH. * * * TEST FOR EXT W/OFFSET; SET SIGN & OFFSET VALUE * * HD41 LDA TERM GET NUMBER OF OPERAND TERMS. CPA .1 SINGLE EXTERNAL REFERENCE ? JMP HD42 YES, NO MORE CHECKING NEEDED. ADB .6 (6) TEST FOR EQU. SZB,RSS EQU TO EXTERNAL, WITH OFFSET ? JMP HD22 YES, *ERROR* LDA SUMP GET COMBINED OPERAND VALUE. LDB XORD GET EXTERNAL ORDINAL NUMBER. STB SIGN SET OFFSET FLAG = EXT ORDINAL #. CMB,INB NEGATE ORDINAL VALUE. ADA B SUBTRACT EXTERNAL ORDINAL VALUE. STA SUMP SAVE OFFSET VALUE. * * * NORMAL EXIT FROM CHOP, HERE * * HD42 LDA RELC RELOCATION CODE IN (A) AND LDB SUMP SUM IN (B) ON EXIT. ISZ CHOP JMP CHOP,I EXIT ALPHA+2 * * *CHOP ERROR EXIT* * HD22 LDA .MBLN 'M' FOR M TERM ERROR JSB ERPR ERROR PRINT CLA CLEAR THE STA SIGN OFFSET FLAG. JMP CHOP,I EXIT ALPHA+1 * * * PROCESS SYMBOLIC TERM HERE * * HD50 JSB SYMK GO TO SYMBOL TABLE LOOKUP JMP HD6 ERR0R STB SAVB SAVE VALUE FOUND IN B. LDB FLEX GET FIRST WORD OF SYMBOL ENTRY. SSB,RSS IS THE UNDEFINED BIT SET? JMP HD50A NOVHFB BLF YES, THEN IS 'E' BIT SET? SSB JMP HD6 YES, THEN THIS IS AN UNDEFINED 'ENT' CCB SET FLAG TO INDICATE SYMBOL STB EMASY JUST LOOKED UP WAS AN EMA HD50A AND .7 TYPE MASK SZA,RSS RELOCATABLE TYPE? JMP HD61 NO, ABSOLUTE. * óHÿÿþú SKP * * * TEST FOR EXTERNAL EQU (RELC=5) * CPA .5 RELOC=5? LDA .4 YES, SET FOR 4 * * * TEST FOR REPLACEMENT CODE SYMBOL (RELC=6) * * LDB CODE GET OPCODE I.D. CPA .6 REPLACEMENT CODE SYMBOL? CPB .32B YES, IS CODE RPL? RSS YES, CONTINUE. JMP HD22 NO, ERROR LDB RELC GET OPERAND RELOC. CODE SZB,RSS FIRST SYMBOL ENCOUNTERED? STA RELC YES, SET OPERAND RELOC. CODE CPA RELC NO,TEST FOR SAME RELOC.TYPE CPB .4 SAME. ANOTHER EXTERNAL ? JMP HD22 *ERROR* DIFFERENT OR 2 EXT'S. LDB SAVB GET SYMBOL'S VALUE. CPA .4 IF SYMBOL IS AN EXTERNAL, STB XORD SAVE THE ORDINAL NUMBER. * * *UPDATE SIGN SAVER * LDB SIGN COMPUTE ALGEBRAIC RUNNING SUM ADB T OF SYMBOLIC TERM'S SIGNS. STB T END RESULT=0/+1,ELSE 'M' ERROR. HD61 LDA SAVB VALUETO A ISZ TERM UPDATE NO OF TERMS LDB SIGN SSB IS SIGN NEGATIVE? CMA,INA -YES- COMPLEMENT ADA SUMP -UPDATE RUNNING SUM STA SUMP JMP HD30 * * * UNDEFINED SYMBOL EXIT * * HD6 LDA .UN 'UN' UNDEFINED SYMBOL JMP HD22+1 TO ERPR .M11 DEC -11 .M27B OCT -27 .401B OCT 401 .32B OCT 32 .50 DEC 50 .M58 DEC -58 XORD NOP TEMP. STORAGE: EXTERNAL ORDN'L NO. EMASY NOP FLAG FOR EMA SYMBOL FOUND IN SYMBL TABLE .40 DEC 40 * SKP * ******************** * * READ A STATEMENT * * ******************** RSTA NOP JSB IFBRK DEF *+1 SSA,RSS BREAK FLAG SET? JMP CNTRD CONTINUE TO READD CLA YES, CLEAR CROSS-REFERENCE FLAG STA CFLAG JMP ASMBX TERMINATE ASSEMBLER CNTRD LDA REP SZA,RSS ARE WE REPEATING A STA¢ÝþúTE? JMP RXT NO - ISZ REP YES, ARE WE DONE? JMP RZP NO RXT LDB FBOI LDA .50 FOR 50 WORDS JSB SETM SET I/O BUFF TO BLANKS BLNS ASC 1, RXC JSB RED.C GO READ A STATEMENT DEF C.SOR SOURCE FILE FCB FFUB DEF BUFF READ BUFFER DEF .40 40 WORDS INPUT JMP REDER READ ERROR CPB .M1 EOF RETURN? JMP ABORT EOF RETURN - NOT POSSIBLE BLS CONVERT # OF WORDS TRANSMISSION LOG TO STB SCN1 # OF CHARS - SAVE COUNT CMB,INB STB PNTR SAVE NEG. CHAR COUNT LDB SCN1 SZB,RSS END OF TAPE? (B=0?) JMP TAPN YES - GO SET PARAMETERS ISZ SEQN BUMP SEQ.NO. CLB,INB 1 TO B STB PNTR SET PNTR = 1 ADB SCN1 GET TOATL LENGTH * * SET CHARS FOLLOWING STATE.TO BLANKS * BRS ADB FFUB LDA BLNS STA 1,I RXL CLA (ENTER FOR REP PROCESSOR) STA BYFLG CLR PUNCH BYTE FLAG STA SCN1+3 STA TEST STA SIGN CLR EXT W/OFFSET FLAG. ISZ ASM1 CONTROL STATE.? JMP CHKLB NO.. LDA .5 YES, SET LIST CODE JSB LIST CLA,INA SET A = 1 STA TAPE SET TAPE COUNT = 1, IN CASE OF ? JMP RSTA,I EXIT * REDER CCB JMP ?FMPE DISPLAY FMP ERROR * * * CHECK LABEL AREA * CHKLB JSB PKUP PICK UP NEXT CHAR; BUMP PNTR CPA L+2 *? JMP HI24 -YES- * * * IS LABEL PRESENT? * CPA BLNK LABEL PRESENT ? JMP HS50 NO. GO TO PROCESS OPCODE. CLB =0: SYMTS LABEL CHECK. JSB SYMTS GO TO CHECK FOR VALID LABEL. NOP ERRORS ALREADY NOTED; CONTINUE SCANNING. JMP HS49 GO TO LABEL POST-PROCESSOR. * * SYMTS - TEST FOR VALID CHARACTERS IN A LABEL/SYMBOL * * ENTER: CHAR. IN LOW & 'TEST';=0:LABEL OR NEG. CHAR. CNT.:OPERAND. * EXIT: P+1 INVALID (SY ERROR PRINTED); P+2 VALID; & MEANINGLESS. * SYMTS NOP STB SCNT SAVE NEGATIVE CHARACTER COUNT. JSB LBL GO TO TEST FOR ILLEGAL CHARACTER, LDA TEST GET CHAR.; TEST FOR NUMERIC 1RST CHAR. ADA .M48 SUBTRACT 60B (ASCII '0'). SSA FIRST CHARACTER <60B ? JMP HS20 YES - O.K. - GO GET NEXT CHARACTER. ADA .M15 NO. SUBTRACT 17B. SSA FIRST CHARACTER >= 77B (ASCII '?') ? JMP LBLER NO--ILLEGAL FIRST CHARACTER! HS20 JSB PKUP GET NEXT CHARACTER. CPA BLNK END OF LABEL (SYMBOL TERMINATOR) ? JMP SYMEX YES, GO TO COMPLETION. JSB LBL NO. GO TO TEST VALIDITY OF THIS CHAR. JMP HS20 GO TO GET THE NEXT CHARACTER. * SYMEX LDA SERR GET INVALID CHARACTER FLAG. SZA,RSS ANY INVALID CHARACTERS ? ISZ SYMTS NO. SET RETURN TO P+2. CLA CLEAR INVALID CHARACTER FLAG. STA SERR FOR NEXT USER. JMP SYMTS,I RETURN: P+1-ERROR; P+2-VALID SYMBOL. * * * TEST FOR ILLEGAL CHAR. IN SYMBOL * * * THEY ARE ' ( ) * + , - * * LBL NOP ADA .M46 SUBTRACT 56B (ASCII '.') SSA,RSS GREATER THAN 55B ? JMP LBLEX YES-O.K. ADA .7 NO. ADD BACK 7B. SSA LESS THAN 47B (ASCII ' ) ? JMP LBLEX YES-O.K. LBLER LDA SERR GET ERROR FLAG. SZA ANY PREVIOUS ERRORS, THIS SYMBOL ? JMP LBLEX YES, AVOID ADDITIONAL ERROR MESSAGES. LDA .SY NO. GET 'SY' - ILLEGAL SYMBOL INDICATOR. JSB ERPR GO TO PRINT THE ERROR MESSAGE. ISZ SERR SET ILLEGAL CHARACTER FLAG. LBLEX ISZ SCNT DECREMENT COUNT. ALL CHARACTERS CHECKED? JMP LBL,I NO. GO BACK FOR MORE. JMP SYMEX YES, GO TO COMPLETION. * SCNT NOP NEGATIVE CHARACTER COUÔþúNT FOR 'SYMTS'. SERR NOP ILLEGAL CHAR. FLAG (0=OK;1=INVALID CHAR.) * * * 'REP' PROCESSING * RZP ISZ REQ 1ST REP PASS? JMP RXT YES,READ STATEMENT CCA STA REQ SET REQ = -1 CLA,INA STA PNTR SET PNTR=1 JMP RXL * * * LABEL POST-PROCESSOR * * HS49 LDA PNTR ADA .M2 (-2) SET LABEL LENGTH STA SCN1+3 * * * PROCESS OPCODE * * HS50 JSB OPLK SEARCH FOR OPCODE JMP HSERR ERROR EXIT HS51 JSB PKUP GET NEXT CHAR (_*+5) CPA BLNK BLANK? JMP HS52 YES? CPA L+4 COMMA? JSB BPKUP YES-GET NEXT NON-BLANK JMP HS51 GET NEXT CHAR. * * * TEST FOR OPCODE LENGTH LEGAL * HS52 LDB PNTR CMB,INB (POINTS TO BLNK FOLLOWING OPCODE) ADB SCN1+1 CPB .M4 (-4) JMP HS54 LENGTH OK (=3) LDA CODE ADA .M48 CODE-60B SSA,RSS MICRO-OP ? JMP HS54 YES * * * ERROR PROCESSOR FOR OPCODE * LDA .OP 'OP'= OPCODE HAS TOO MANY CHARS. JSB ERPR HSERR LDA ASM1 LDB IFUSE CPB .1 SKIP CODE BECAUSE OF IFZ/IFN? JMP IFPRN YES - GO PRINT THE STATEMENT. SSA IS THIS AN INITIAL READ REQUEST? JMP HI24 -IT'S FROM INIT, SKIP OUTPUT BELOW. LDA PASS SZA,RSS JSB ?LABE INSERT LABEL FOR OPCODE ERROR JSB LOUT TO BREC JSB LIST ISZ PLCN BUMP LOCN.CNTR JMP RXT READ NEXT STATE. HI24 LDA .3 (3) REMARK PROC. JSB LIST JMP RXT READ NEXT STATEMENT * * * PICK UP OPERAND LOCN, THEN EXIT * * HS54 LDB CODE CPB .31B IS THIS IFZ/IFN/XIF? JMP IFZN YES LDA IFUSE GET 'IF' USE FLAG CPA .1 SKIP ASSEMBLING? CPB .12 IS IT AN 'END'? RSS YES - DON'T SKIP IT ’4þúJMP HI24+1 GO ON AND PRINT THE STATEMENT JSB BPKUP GO SKIP BLANKS IF NECESSARY. ADB .M81 (-81) TEST FOR PNTR< 81 CLA SET A=0 STA LTFLG CLEAR LITERAL FLAG SSB SKIP IF FIELD OUT OF RANGE LDA PNTR PNTR TO A STA SCN1+2 OPERND POSN SZA OPERAND PRESENT? * * * TEST FOR LITERAL * JSB PKUP YES - GET 1ST CHAR. LDB AFLAG GET FLAG FOR 'ABS' TEST CPA EQ IS THE OPERAND A LITERAL? SZB YES, BUT EXIT IF ABSOLUTE ASS'Y. JMP RSTA,I NO EXIT FROM READER HERE. JSB PKUP GET THE LITERAL TYPE, NOW. LDB SCN1+2 GET OPERAND PNTR ADB .2 ADD 2 STA LTFLG SET LIT.FLAG(=LITERAL TYPE) LDA CODE * NOW CHECK FOR LEGAL LITERAL * CPA .6 ARITHMETIC MACRO? STB SCN1+2 YES, SET OPERAND POINTER. CPA .14 MEMORY REFERENCE? STB SCN1+2 YES, SET OPERAND POINTER. CPA .26B MPY/DIV/DLD/DST ? STB SCN1+2 YES, SET OPERAND POINTER. CMA,INA NEGATE OPCODE I.D. NO. ADA .A (101B) SSA OPCODE >100B ? STB SCN1+2 RESET POINTER TO LITERAL VAALUE. JMP RSTA,I EXIT FROM RSTA HERE .26B OCT 26 * SPC 2 * * PROCESS 'IFZ', 'IFN', OR 'XIF' CODES..* SPC 1 IFZN LDA INST GET INSTR.FORMAT(HAS IF CHAR IN) CLB SZA,RSS IS INST = 0? (IS IT XIF) ? JMP IFZN3 YES CPB IFUSE IFUSE = 0? JMP IFZN2 YES - GO ON WITH PROCESSING IFZNR LDA IF NO, ERROR, WE'RE IN IF OR REP JSB ERPR PRINT 'IF' ERROR JMP IFZN3+1 YES, GO ON WITH PROGRAM IFZN2 CLB,INB SET B = 1 CPA IFTST IS 'IF' CHARACTER MATCHED? CMB,INB YES - SET B = -1 IFZN3 STB IFUSE SET 'IFUSE' FLAG CLB CPB REP IN RANGE OF A REPEAT? JMP IFPRN NO - OK ST3iþúB REP YES - CLEAR 'REP' FLAG JMP IFZNR GO PRINT ERROR DIAG. IFPRN CLA,INA SET UP FOR NO INST, NO LOC'N PRNT JMP HI24+1 GO TO LIST AND CONTINUE SPC 1 IF ASC 1,IF ERROR IN IFZ OR IFN EQ OCT 75 EQUAL SIGN(=) .31B OCT 31 =IFZ,IFN,XIF TYPE .M80 DEC -80 .M46 DEC -46 .M81 DEC -81 ASM1 OCT -1 CONTROL STATE.FLAG .SY ASC 1,SY HEDR DEF HEADP UMSK OCT 177400 MASK FOR UPPER CHARACTER LMASK OCT 377 MASK FOR LOWER CHARACTER TAPE OCT 1 COUNT SOURCE TAPES SPC 1 * * SET SEQN TO ZERO, BUMP AND CONVERT SEQN. NO. * SPC 1 TAPN STB SEQN SET SEQ. NO. TO ZERO ISZ TAPE ADD 1 TO TAPE # LDA TAPE CCE CONVERT TO ASCII JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+2 STA ASCI+4 STORE IT INTO THE HEADER JMP RXC * SKP * * * TEST FOR LABEL PRESENT AND INSERT IN SYMBOL TABLE * * SET CORRECT RELOC.CODE BEFORE INSERTION. * ?LABE NOP LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP ?LABE,I NO, DONE, EXIT.. STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. LDB LTFLG STB FLAQ SAVE LTFLG CLA STA LTFLG LTFLG_0 LDA AFLAG SZA IS THIS AN ABSOLUTE ASSEMBLY? JMP LABEX YES CLA,INA SET A = 1 LDB ?BASF SZB IN BASE PAGE ? INA YES, SET A = 2 LDB PLCN JSB ?INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT LDB FLAQ STB LTFLG RESTORE LTFLG JMP ?LABE,I EXIT LABEX JSB ?INS? GO TO INSERT RTN IN ASMB3 NOP ERROR EXIT JMP ?LABE,I EXIT * SKP * ************************************** * * MOVE: MOVES A STRING OF CHARACTERS * * * LINKAGE: A = NO.OF CHARSûKþú TO MOVE * * * B = DESTINATION ADDRESS * * * L JSB MOVE,I * * * L+1 SOURCE ADDRESS * * * L+2 RETURN * * * ADDR.TRUE IF STARTS ON LEFT * * * 2'S COMPL.IF STARTS ON RIGHT * * ************************************** MOVE NOP SZA IS CHAR.COUNT = 0? JMP MOVE1 NO JSB OPERR YES JMP MOVX MOVE1 CMA,INA STA GTEM+3 =-A * * SET UP DESTINATION CLE,SSB CMB,CCE,INB ELB STB GTEM+1 LDB MOVE,I GET SOURCE ADDRESS * * SET UP SOURCE CLE,SSB CMB,CCE,INB ELB STB GTEM+2 * * NOW MOVE THE CHARACTERS * $ LDB GTEM+2 CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE . AND LMASK MASK OUT UPPER 8 BITS * * LOWER 8 BITS OF A CONTAINS CHAR.TO BE MOVED.* STA GTEM LDB GTEM+1 DEST TO B CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE AND UMSK IOR GTEM * * CHAR.NOW IN A, WITH OTHER HALF OF DEST.WORD.* * * SINCE IT'S ON RIGHT WE MAY HAVE TO ROTATE * SEZ,RSS E=0? ALF,ALF ROTATE STA 1,I A TO B,I * * NOW IT'S IN OK, BUMP COUNTERS AND PROCEED * ISZ GTEM+2 ISZ GTEM+1 ISZ GTEM+3 JMP $ MOVX ISZ MOVE JMP MOVE,I RETURN TO L+2 OF LINKAGE * * * ********************************************* * * SYMK: LOOKUP SYMBOL TABLE ENTRY; W HACCOU * * * LINKAGE: INPUT; SYMP=NO CHARS;SYMN=FWA * * * OF NAME..OUTPUT;A=TYPE,B=VALUE* * * L JSB SYMK,I * * * L+1 UNDEF.SYMBOL EXIT * * CÆþú * L+2 NORMAL RETN * * ********************************************* SYMK NOP CLA INITIALIZE NAME(4), STA NAME 0 TO 1ST, BLANKS TO LDA BLNS OTHER WORDS STA NAME+1 STA NAME+2 LDA SYMP NO.OF CHARS ADA .M6 (-6) SSA JMP SYMK1 * * * SYMBOL TOO LONG, PRINT DIAG.; SET LENGTH = 5 * * LDA .SY 'SY' TOO MANY CHARS IN SYMBOL JSB ERPR LDA .5 STA SYMP SYMK1 LDA SYMP (FROM *-5) LDB SYMP+1 ADDR.OF 1ST CHAR. STB FCHMV LDB NAMI CMB,INB JSB MOVE FCHMV NOP (SET AT *-4) LDA SYMP NO.OF CHARS. ARS STORE NUMBER OF INA WORDS IN ENTRY-1 STA TEMP+2 INTO TEMP+2 INA STA TEMP+3 AND TEMP+3 ALF,ALF ALF ADA NAME SET NUMBER OF WORDS STA NAME TO COMPARE FIRST WORDS LDB X IN THE LP2 LDA B,I CONTENTS OF START OF NEXT ENTRY IN SYMB. TBL SZA,RSS JMP SYMK5 UNDEFINED EXIT FROM HERE AND SMASK 70377B CPA NAME COMPARE 1ST WORDS JMP LP5 ALF AND .15 (17B)MASK NO.WRDS IN ENTRY ADB A LP3 JMP LP2 LP5 STB SYMI STB TEMP+4 LDA B,I STA FLEX LDA NAMI STA SALU LDA TEMP+2 (FROM *-6) ADA SYMI SET LIMIT=LWA-1 STA VAL0 OF SYMTAB ENTRY LP6 ISZ SYMI BUMP ADDR CNTR (FROM *+7) LDA SYMI CPA VAL0 END OF ENTRY? JMP LP7 YES ISZ SALU NO LDA SYMI,I COMPARE NEXT 2 CHARS. CPA SALU,I JMP LP6 EQUAL; COMPARE NEXT TWO. LP4 LDB TEMP+3 ADB TEMP+4 SET FWA OF NEXT ENTRY JMP LP3 CHK NXT SYMTAB ENTRY LP7 LDA FLEX GET 1ST ENTRY WRD (FROM *-8) ALF,ALF AND .15 (17B) LDB LTFLG SZB,RSS LIhaþúTERAL IN OPERAND? JMP LP8 NO CPB .1 ARITH MACRO WITH LITERAL? JMP LP8 YES CPA .7 RELC=7? JMP LP9 YES, DONE. JMP LP4 NO, GO BACK LP8 CPA .7 LITERAL? JMP LP4 YES, GO BACK(OPERAND IS'NT LITERAL) LP9 LDB SYMI,I B=VALUE ISZ SYMK JMP SYMK,I EXIT ALPHA+2 HERE * SYMK5 STB SYMI UNDEFINED SYMBOL STB TEMP+4 LDA B,I STA FLEX LDA NAMI STA SALU JMP SYMK,I RETURN TO L+1 * SMASK OCT 70377 .400B OCT 400 .M16 DEC -16 .M48 DEC -48 SALU NOP TEMPORARY FOR NAME ADDR. COUNTER * SKP * ************************* * * PUNCH A BINARY RECORD * * ************************* * * NOTE: THE CONTENTS OF FUBP AND FUBP2 CAN BE MODIFIED SO THAT * OTHER BUFFERS CAN BE USED FOR OUTPUT MLK 790215 PNCH NOP LDB BINFL BINARY OUTPUT FILE EXISTS? SZB,RSS JMP PNCHX NO - EXIT * * * COMPUTE CHECKSUM * * LDB FUBP = ADDRESS OF PUNCH BUFFER. LDA FUBP,I GET RECORD LENGTH FROM BUFFER ALF,ALF POSITION TO LOWER BYTE. STA CNTB SAVE FOR 'EXEC' CALL. CMA,INA NEGATE WORD COUNT AND INA -1 (LENGTH NOT IN CK.SUM). STA GTEM STORE CHKSUM CNTR CLA CLEAR STA FUBP2,I CHECKSUM BUFFER-WORD. PNCH1 INB BUMP REC.ADDR. ADA 1,I ADD TO CHK SUM ISZ GTEM DONE? JMP PNCH1 -NO STA FUBP2,I -YES- STORE SUM * * * GO TO SYS PUNCH * * JSB WRT.C GO WRITE BIN RECORD DEF C.BIN BINARY OUTPUT FCB NAME FUBP DEF PBUF BUFFER NAME DEF CNTB WORD COUNT JMP *+2 ERROR JMP PNCHX NO ERROR CLB,INB INDICATE OUTPUT FILE JMP ?FMPE DISPLAY ERROR AND EXIT PNCHX CLA STA FUBP,I * * |³þú * EXIT HERE * * JMP PNCH,I * BINFL NOP FUBP2 DEF PBUF+2 SKP * ******************************************** * * ASCN - CONVERT AN ASCII NUMBER TO BINARY * * * -ENTRY: A CONTAINS POSITION OF 1ST CHAR. * * * B(LOWER) CONTAINS NO. OF CHARS. * * * B(UPPER): MODE(BELOW) * * * 0 = OCTAL * * * 1 = FIXED DECIMAL * * * 2 = FLOATING DECIMAL * * * 3 = 3 WORD FLOATING DECIMAL * * * 4 = 4 WORD FLOATING DECIMAL * * * -EXIT : L+1 = ERROR RETURN ON ILLEGAL * * * CHARACTER OR OVERFLOW. * * * L+2 = NORMAL RETURN * * * MODE=0 OR 1, VALUE IN A * * * MODE=2, VALUE IN A AND B * * * MODE=3, VALUE IN A, B AND VALU * * * MODE=4, VALUE IN A,B,VAL0 &VAL1 * * * NOTE: FOR MODES 2 AND 3 VALUES IN A AND * * * B ARE ALSO IN VAL0 AND VAL1 RESP. * * ******************************************** * * PROC ASCN(STRING,LENGTH,MODE); * VALUE STRING,LENGTH,MODE;INTEGER LENGTH,MODE;CHAR ARRAY STRING; * BEGIN * INITIALIZE_TEMPS; * IF MODE = 0 OR MODE = 1 THEN CONVERT_TO_INTEGER * ELSE CONVERT_TO_4_WORD_REAL; * CASE MODE *2: PACK_INTO_2_WORD_NUMBER; *3: PACK_INTO_3_WORD_NUMBER; *4: PACK_INTO_4_WORD_NUMBER; * ESAC; *END OF ASCN; * * PROC CONVERT_TO_4_WORD_REAL(STRING,LENGTH); * VALUE STRING,LENGTH;CHAR ARRAY STRING;INTEGER LENGTH; * BEGIN * INTEGER I. * INTEGER ARRAY ACC,VAL[0:3]; * FOR I := 0 TO 3 DO VAL[I] := 0 * FOR I := 0 TO LENGTH-1 DO * BEGIN * CNVT := CONVT(STRING,I); * MPY10(VAL,ACC); * IF NOT OVERFLOW THEN ADD4(ACC,CNVT); * END; ASCNP NOP ASCN EQU ASCNP STA SYMI CHAR POS. IN SYMI LDA LMSK AND 1 CMA,IN¡ˆþúA STA DCNT CHAR COUNT IN DCNT LDA 1 ALF,CLE,ALF POSITION THE MODE AND LMSK STA MODE SET MODE IN MODE ADA .M2 INTEGER CONVERSION? SSA,RSS JMP ASCN2 NO - GO TO FLOATING PT ROUTINE JSB INTEG GO TO INTEGER CONVERSION XNORM ISZ ASCNP SET UP FOR NORMAL RETURN JMP ASCNP,I EXIT * ***************************************** * * FLOATING POINT PROCESSING STARTS HERE * * ***************************************** ASCN2 CLA STA VAL0 CLEAR NUMBER SLOTS STA VAL1 STA VAL2 STA VAL3 STA DEXP CLEAR DEC. OVERFLOW SLOT CCA STA DSIG SET SIGN(-1) FIR + STA CNVT SET FLAG FOR SIGN IN 1ST POSN. LDA BIT15 STA DFCNT SET DFCNT = 100000B FDCN1 JSB CNVRT CONVERT A CHARACTER JMP FDCN3 NON DIGIT RETURN ISZ DFCNT BUMP FRAC. COUNT LDA DEXP SZA IF OVERFLOW THEN JMP DCOV GO TO DCOV JSB LODAC PROCESS DIGIT JSB SHFTL ACC := ACC * 2; SSA IF OVERFLOW THEN GO TO DCOV; JMP DCOV JSB SHFTL ACC := ACC * 4; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV JSB ADD4 ACC := ACC * 5; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV SPC 2 JSB SHFTL ACC := ACC * 10; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV LDA ACC3 ACC := ACC + NEWDIGIT; ADA CNVT FINALLY ADD LATEST DIGIT TO NUM STA ACC3 SEZ,RSS IF NOT CARRY THEN GO TO FDCN6 JMP FDCN6 ISZ ACC2 ELSE PORPAGATE CARRY JMP FDCN6 ISZ ACC1 JMP FDCN6 LDA ACC0 CLE,INA STA ACC0 SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV FDCN6 JSB STACC CURRENT_VALUE := NEW_VALUE; FDCN7 ISZ DCNT IF(CHARS:=CHARS-1) # 0 THEN JMP FDCN1 GO TO Œ„þúFDCN1 JMP FDHOP ELSE GO TO FDHOP; FDCN3 CPA L+6 DEC PNT? (NON DIG.FROM CNVRT) JMP FDCN5 YES CPA .E 'E'? JMP *+3 YES ILEX LDA .IL NO, GO GET 'IL' JMP OVEX+1 GO TO ERROR DIAG EXIT ISZ DCNT LAST CHARACTER? JMP FDHOP NO - GO TO PROCESS EXPONENT FDCN5 LDA DFCNT SSA,RSS IS THIS A SECOND DEC.PNT? JMP ILEX YES CLA STA DFCNT CLEAR COUNTER FOR DIGITS AFTER . JMP FDCN7 DCOV ISZ DEXP OVERFLOWDIGITS := OVERFLOWDIGITS +1; JMP FDCN7 SPC 3 * ************************************* * * PROCESS EXPONENT, IF PRESENT, AND * * * FINISH THE NUMBER(NORMALIZE, ETC)* * ************************************* FDHOP LDB DFCNT CMB,SSB,INB,RSS WAS A DEC POINT PRESENT? CLB NO, CLEAR B ADB DEXP STB DEXP SET CURRENT COUNT FOR DEC EXPONENT LDA DSIG STA SDSIG SAVE SIGN OF MANTISSA CLA NO - CONTINUE PROCESSING LDB TEST CPB .E IS EXPONENT THERE? JSB INTEG YES - EVALUATE IT ADA DEXP A+OVERFLOW CHARS STA DEXP SET VALUE OF DECIMAL EXPONENT LDA VAL0 CHECK FOR A VALUE OF ZERO IOR VAL1 IOR VAL2 IOR VAL3 SZA,RSS IS THE VALUE=0? JMP UNDTF YES, NORMAL EXIT FROM ASCN RTN. LDA .63 BINARY_EXP := 63; STA FEXP FDHP2 JSB NRMLZ GO NORMALIZE THAT TURKEY JSB STACC LDA DEXP CLE,SZA,RSS JMP FDHPX DONE IF EXPONENT=0 SSA IS EXPONENT POSITIVE? JMP FDHP6 NO - GO TO DIVIDE BY 10 ADA .M1 YES - MULTIPLY NUMBER BY 10 HERE STA DEXP DEXP=DEXP-1 LDA .3 ADA FEXP STA FEXP FEXP=FEXP+3 JSB SHFTR SHIFT THE 4 WORD ACCUMULATOR JSB SHFTR -RIGHT 2 PLACES JSB ADD4 JMP FDHP2 GO BACK \ NLHTO RE-NORMALIZE * * DIVIDE NUMBER IN VAL0,VAL1,VAL2 BY 10 * FDHP6 INA STA DEXP DEXP=DEXP+1 LDA .M2 ADA FEXP STA FEXP FEXP := FEXP + EXP(.1) +1; & -2 IF U CARE LDA PVAL STA WPVAL WPVAL := @VAL0; LDA UVAL STA CNVT FDHP7 CPA VSTOP LAST SECTION PROCESSED? JMP FDHP9 YES, GO FINISH UP * * DIVIDE 'A' BY 10 (MPY BY .1) * * RESULT IN A AND B LDA WPVAL,I CLB,CLE SLA,ERA A := VAL[I]/2 LDB TENTH IF ODD(VAL[I]) THEN STB CRYOT CRYOT := TENTH ELSE CRYOT := O MPY TENTH CLE,ELA ELB,CLE BA := VAL[I]*TENTH ADA CRYOT A := A+CRYOT THE REAL PRODUCT SEZ IF CARRY THEN CLE,INB B := B+1 STB CNVT,I SAVE MSB VALUE ISZ CNVT BUMP ADDRESS STA CNVT,I SAVE LSB VALUE ISZ WPVAL @VALUE := @VALUE+1; LDA CNVT ISZ CNVT JMP FDHP7 åNÿÿþúFDHP9 LDB .M7 SUM_AND_CARRY(DATASTACK,7,CARRYOUT,ANSWER); CLA JSB SUMCY STA VAL3 LDB .M5 VAL2 := SUM_AND_CARRY(DATASTACK,5,CARRYOUT,ANSWER); LDA CRYOT JSB SUMCY STA VAL2 LDB .M3 VAL1 := SUM_AND_CARRY(DATASTACK,3,CARRYOUT,ANSWER); LDA CRYOT JSB SUMCY STA VAL1 LDA CRYOT VAL0 := CARRYOUT + DATASTACK[0]; ADA V320 STA VAL0 JSB LODAC ACC := CURRENT_VALUE. JMP FDHP2 GO RENORMALIZE AND CONTINUE * ****************************** * * SET UP FLTG DECIMAL RESULT * * * FOR EXIT FROM CONVERSION * * ****************************** FDHPX LDB MODE ADB PVAM1 STB WPVAL LDA B,I CLE ADA .200B ROUND THE LEAST SIGNIF. WORD AND UMSK MASK OF THE EXPONENT AREA RNDLP STA B,I SEZ,RSS IF NO CARRY THEN GO PACKITUP * SINCE THE NUMBER IS A POSITIVE NORMALIZED STRUCTURE * THE MSB'S WILL NEVER CARRY OUT THUS GARRENTEEING * TERMINATION OF THIS LOOP JMP PAKIT ADB .M1 LDA B,I PROPAGATE THE CARRY CLE,INA JMP RNDLP PAKIT JSB LODAC NORMALIZE IT ONE MORE TIME JSB NRMLZ JSB STACC ISZ SDSIG IS SIGN OF MANTISSA=+ JMP FDHR4 NO, GO PROCESS NEG. MANTISSA FDHRT LDA FEXP GET FRACTIONAL EXPONENT IN A/B LDB FEXP AND .1776 CLEAR LOWER 7 BITS SZA POSITIVE OVERFLOW? CPA .1776 MAYBE, NEG. OVERFLOW? CPB .1776 MAYBE, IS EXPON,=-200B? JMP FDHR3 YES, ALSO OTHER OVERFLOWS.. LDA FEXP GET THE EXPONENET AGAIN RAL POSITION IT AND LMSK CLEAR BITS 15-8 IOR WPVAL,I ADD IN THE LEAST SIG.PART STA WPVAL,I UNDTF LDA VAL0 GET WORD 1 LDB VAL1 GET WORD 2 JMP XNORM GO OUT THE NORMAL EXIT FDHR3 SSB,RSS IS IT REALLY AN UNDERFLOW? JMP OVEX NO CLåþúA YES, SET NO. = ZERO STA VAL0 CLEAR VAL0 JMP UNDTF FDHR4 LDB WPVAL START GETTING COMPLEMENT LDA B,I CMA,CLE,INA COMLP STA B,I CMB,INB SUBTRACT 1 FROM B REG CMB WITHOUT DESTROYING THE E REG CPB PVAM1 IF DONE THEN GO CHECK FOR A POWER OF 2 JMP PWR2 LDA B,I CMA,SEZ CLE,INA JMP COMLP PWR2 CLE,ELA WAS N0. A POWER OF 2? SSA,RSS JMP FDHRT NO BUG OUT STA VAL0 PUT AWAY THE CORRECT FRACTION PART LDA FEXP ADA .M1 STA FEXP SUBTRACT 1 FROM EXPONENT. JMP FDHRT * ************************* SPC 3 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC LODAC(VALUE) THE 4 WORD ACCUMULATOR IS LOADED WITH * THE CURRENT VALUE OF THE OPERAND * CALL JSB LOCAC * * IT IS ASSUMED THAT THE CURRENT VALUE IS * IN THE 4 WORD DATA STRUCTURE VAL0,VAL1,VAL2,VAL3 * * * ON EXIT THE LSB'S OF THE 4 WORD OBJECT ARE IN THE REGISTERS * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * LODAC BSS 1 LDA VAL0 STA ACC0 LDA VAL1 STA ACC1 LDB VAL2 STB ACC2 LDA VAL3 STA ACC3 JMP LODAC,I SPC 2 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC STACC(VALUE) THE 4 WORD ACCUMULATOR IS STORED IN THE * 4 WORD DATA STRUCTURE VAL0,VAL1,VAL2,VAL3 * * CALL: JSB STACC * * ON EXIT THE REGISTERS CONTAIN THE MSB'S OF THE DATA STRUCTURE * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * STACC BSS 1 LDA ACC3 STA VAL3 LDA ACC2 STA VAL2 LDA ACC1 STA VAL1 LDB ACC0 STB VAL0 JMP STACC,I SPC 3 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC ADD4(ACC,VALUE); * ADD THE 2 4 WORD DATA STRUCTURES AND STORE THE ANSWER * IN THE 4 WORD ACCUMULATOR ACC * FOR I := 3 SPEP -1 UNTIL 0 Dê«þúO * BEGIN * ACC[I] := ACC[I] + VALUE[I]; * IF CARRY THEN ACC[I-1] := ACC[I-1] + 1; * END; END OF ADD4; SPC 2 ADD4 BSS 1 LDA ACC3 CLE ADA VAL3 STA ACC3 LDA ACC2 SEZ CLE,INA ADA VAL2 STA ACC2 LDA ACC1 SEZ CLE,INA ADA VAL1 STA ACC1 LDA ACC0 SEZ CLE,INA ADA VAL0 STA ACC0 JMP ADD4,I * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC SUM_AND_CARRY(DATASTACK,N,CARRYOUT,ANSWER); * VALUE N; INTEGER ANSWER,CARRYOUT;INTEGER ARRAY DATASTACK; * BEGIN * INTEGER I; * CARRYOUT := 0; * FOR I := 1 TO N DO * BEGIN * ANSWER := ANSWER + DATASTACK[I]; * IF CARRY THEN CARRYOUT := CARRYOUT + 1; * END; * END OF SUM_AND_CARRY; SPC 2 SUMCY BSS 1 * ON ENTRY A = ANSWER * B CONTAINS -N FOR THE FOR LOOP COUNTER * ALL OTHER REGISTERS ARE MEANINGLESS STB SCNTR CLB,CLE STB CRYOT LDB PV320 SUMLP ADA B,I SEZ,CLE ISZ CRYOT ISZ SCNTR JMP SUMGO JMP SUMCY,I SUMGO INB JMP SUMLP * ON EXIT A = ANSWER; CRYOT = CARRYOUT; ALL OTHER REGS MEANINGLESS SPC 3 SHFTR BSS 1 LDA ACC0 CLE,ERA STA ACC0 LDA ACC1 ERA STA ACC1 LDA ACC2 ERA STA ACC2 LDA ACC3 ERA,CLE STA ACC3 JMP SHFTR,I * DATA STRUCTURE: * ACC ::= A FOUR WORD ACCUMULATOR * THE ROUTINE ASSUMES THAT THAT THE ACCUMULATOR HAS BEEN * LOADED * * CALLING SEQUENCE: * JSB SHFTL * * ON EXIT THE FOUR WORD VALUE HAS BEEN SHIFTED LEFT ONE * BIT AND E & O ARE SET PROPERLY FOR THE FOUR WORD SHIFT * A & B CONTAIN THE MOST SIGNIFICANT TWO WORDS * SHFTL BSS 1 LDA ACC3 CLE,ELA STA ACC3 LDA ACC2 ELA STA ACC2 LDA ACC1 ELA STA ACC1 LDA ACC0 ELA STA AC5èþúC0 JMP SHFTL,I * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC NORMALIZE(ACC); * BEGIN THE 4 WORD ACCUMULATOR IS SHIFTED LEFT UNTIL THE * LEADING 1 REACHES THE SIGN BIT AND THEN THE ACC IS SHIFTED * ONE BIT BACK TO THE RIGHT, THUS LEAVING A NORMALIZE NUMBER * IN THE ACC. THE EXPONENT COUNT IS DECREMENTED FOR EACH * LEFT SHIFT AND INCREMENTED FOR EACH RIGHT SHIFT * ON EXIT BOTH THE ACC AND EXPONENT COUNT ARE CORRECT SPC 2 * WHILE NOT OVERFLOW DO SHIFT_LEFT; * SHIFT_RIGHT; * END OF NORMALIZE; SPC 2 NRMLZ BSS 1 LDA ACC0 SSA JMP RSHFT JSB SHFTL CCA ADA FEXP STA FEXP JMP NRMLZ+1 GO AROUND AGAIN RSHFT JSB SHFTR ISZ FEXP JMP NRMLZ,I JMP NRMLZ,I JUST IN CASE SPC 2 * ********************************** * * CNVRT - CONVERT AN ASCII CHAR. * * * TO BINARY. * * * - MODE = 0,OCTAL; ELSE DECIMAL * * * - L+1 RETURN IF NON-NUMBERIC * * ********************************** * CNVRT NOP LDA SYMI GET POS'N.OF CHARACTER JSB GETC GET CHARACTER ISZ SYMI BUMP POS'N LDB MODE SZB OCTAL CONVERSION? LDB .M2 NO - SET FOR DEC.CONV ADB .M8 B=-8 HERE, IF OCTAL CONVERSION ADA .M48 -60B + A SSA IS VALUE LESS THAN ZERO? JMP CNVR2 YES ADB 0 NO - ADD IN MAX DIGIT VALUE. SSB IS IT A VALID NUMBER? JMP CNVRX YES- GO TO EXIT WITH NO. IN A. CNVR2 LDA TEST NO - TEST FOR + OR - CPA L+3 PLUS? JMP CNVR4 YES CPA L+5 NO - IS IT MINUS ? CLA,RSS YES JMP CNVRT,I NO - TAKE L+1 EXIT STA DSIG CNVR4 CLA ISZ CNVT HAS SIGN BEEN ENCOUNTERED BEFOR? JMP ILEX YES- 'IL' EXIT FROM ASCN CNVRX STA CNVT ISZ CNVRT JMP ißþúCNVRT,I * SKP * ************************************** * * INTEG - CONVERT A STRING OF ASCII * * * CHARS TO AN OCTAL(MODE=0) * * * OR DECIMAL INTEGER. * * *-IF OTHER THAN A LEADING SIGN OR * * * NUMBER IS FOUND 'IL' EXIT IS TAKEN * * *-'OV' EXIT IF OVERFLOW. * * ************************************** INTEG NOP CCB STB DSIG SET SIGN FLAG FOR PLUS STB CNVT SET 1ST CHAR FLAG(FOR SIGN CHK) CLA INTG2 STA VALUS SAVE CURRENT VALUE JSB CNVRT CONVERT A CHARACTER JMP ILEX ERROR - NON NUMERIC LDA VALUS CLE,ELA JSB OVTST TEST 4 TIMES A FOR OVERFLOW LDB MODE NO OVERFLOW SZB MODE = OCTAL ADA VALUS NO - 5 TIMES A(IT'S DECIMAL) JSB OVTST TEST 8(OR 10) TIMES A FOR OV ADA CNVT NO - ADD IN NEW DIGIT SEZ OVERFLOW? JMP OVEX YES ISZ DCNT LAST CHAR IN STRING? JMP INTG2 NO - GET ANOTHER SZB,RSS MODE = OCTAL? JMP INTG6 YES - OK CPA BIT15 IS NO. + OR - 32768? JMP INTG6 YES - OK SSA IS SIGN NEG? JMP OVEX YES - OVERFLOW INTG6 ISZ DSIG IS SIGN NEGATIVE? CMA,INA YES - COMPLEMENT A. JMP INTEG,I EXIT * ****************************************** * * TEST ZERO BIT AND 'E' BIT FOR OVERFLOW * * ****************************************** OVTST NOP ELA 2 TIMES ENTRY VALUE OF 'A' SEZ,SLA,RSS OVERFLOW? JMP OVTST,I NO - RETURN OVEX LDA .OV GET 'OV' FOR ERROR DIAGNOSTIC. JSB ERPR JMP ASCNP,I LEAVE VIA RERROR EXIT * UVAL DEF V320 VSTOP DEF V320+7 ASCN HI ORDER BITS 8 WORD STOPPER FOR DIV BY 10 .M7 DEC -7 .63 DEC 63 SCNTR BSS 1 CRYOT BSS 1 ACC BSS 8 ACÞÂþúC0 EQU ACC ACC1 EQU ACC+1 ACC2 EQU ACC+2 ACC3 EQU ACC+3 V320 EQU ACC VALUS EQU ACC+4 PVAL DEF VAL0 PVAM1 DEF VAL0-1 PV320 EQU UVAL DVSOR EQU ACC+1 THE NUMBER BASE IN THE BNCN ROUTINE .1776 OCT 177600 177600 TENTH OCT 63146 THE CONSTANT FOR DIVIDING BY 10 ITS IRRATIONAL HONEY .200B OCT 200 THE FLOATING POINT ROUNDING CONSTANT SWEETY LMSK EQU LMASK .10 DEC 10 HERES TEN WHEN U NEED IT * ICSAP DBR ASCI+2 * ************************************** * * BINARY TO ASCII CONVERSION ROUTINE * * * A = NUMBER TO BE CONVERTED * * * E = 0 CONVERT TO OCTAL * * * E = 1 CONVERT TO DECIMAL * * ************************************** OCT 30060 PACKED ASCII '00'. BNCN BSS 1 LDB ICSAP GET LOC'N OF ACSI BUFFER STB SYMI LDB BNCN-1 SET BUFFER=ASCII ZERO'S STB ASCI STB ASCI+1 STB ASCI+2 LDB .8 SEZ TEST E BIT (=0,OCTAL =1,DECIMAL) ADB .2 STB DVSOR SET UP THE PROPER BASE FOR THE ALGORITHM BNCLP CLB DIV DVSOR A:= QUOTIENT. B:= REMAINDER STA ACC SAVE QUOTIENT LDA B REMAINDER TO A LDB SYMI B:= BYTE POINTER CLE,SLB,ERB B := WORD POINTER ODD BYTE TEST JMP *+2 NOT ODD BYTE ALF,ALF ROTATE IF ODD BYTE IOR B,I STA B,I LDB SYMI ADB .M1 STB SYMI LDA ACC SZA JMP BNCLP JMP BNCN,I * * ***************** * * ORR PROCESSOR * * ***************** ORRP NOP CLA (OR$ PARAMETER) STA OFLAG TO INDICATE COMING FROM ORRP ROUTINE JSB OR$ TO PRE-PROC STA ORRSV 0 TO ORRSV LDA ORRS GET THE SAVED MAIN PLCN STA PLCN SET PLCN TO MAIN LOC CNT. JMP ORRP,I EXIT(PICKED UP AT *-5) OFLAG NOP * * * ORG/ORR PRE-PROCESSOR * þú* OR$ NOP LDA ?BASF LDB PLCN SZA ARE WE IN BASE PAGE ? STB ?BPSV YES, SAVE B.P. LOCATION COUNTER. LDA ORRSV GET ORRSV SZA WERE WE IN MAIN PROG? JMP OR$1 NO ISZ OFLAG COMING FROM ORRP OR ORGP? JMP ORRP,I FROM ORRP, RETURN STB ORRS FROM ORGP OR$1 SSA WAS THIS SECTION SET BY AN ORG ? JSB ORGST GO SET HIGH PLCN VALUE IN PROG. CLA STA ?BASF CLEAR BASE PAGE FLAG. JMP OR$,I * ***************** * * ORG PROCESSOR * * ***************** STBI STB ORRS THIS IS A PARAMETER ORGP NOP CCA SET OFLAG TO INDICATE COMING FORM ORGP STA OFLAG JSB OR$ CCA STA ORRSV SET ORRSV = -1 * * * GO TO EVALUATE OPERAND * * JSB CHOPI JMP ORGP,I ERROR EXIT STB PLCN LDB AFLAG SZB,RSS SKIP OUT, IF ABSOLUTE ASSEMBLY CPA .1 RELOC? JMP ORGP,I YES,OK JSB OPERR NO, 'M' ERROR JMP ORGP,I EXIT * SKP * ******************************* * * LIST ROUTINE: PARAMETERS; * * * IF A=0,4,6,7 B=RELOC CODE * * * A=0 FULL LINE * * * A=1 NO INST OR LOCN * * * A=2 NO INST * * * A=3 COMMENT * * * A=4 NO SEQ.NO., NO STATE.* * * A=5 PRINT 'ASMB' STATEMENT* * * A=6 INST ONLY(EXT OFFSET)* * * A=7 NO LOCN (RPL CODE) * * ******************************* LISTD DEC 60,-61 LISTK DEF IOBF+6 INSTRUCTION LOC'N DEF IOBF+3 LOCATION LOC'N DEF IOBF+2 LIST COMMENT LOC'N LIST NOP STB SAVB SAVE ASCII RELOC CODE STA SAVB+1 SAVE LIST PARAM. CPA .5 CONTROL STATE.? JMP HI82 YES LDB LFLAG GET LIST FLAG SZB,RSS PUNCH ONLY²þú? JMP LIST,I YES, EXIT LDB PASS SZB,RSS PASS 1 ? JMP LIST,I YES, EXIT LDA LST SZA LIST FLAG=0 ? JMP LIST,I NO, EXIT LDA .10 LDB FBOI JSB SETM SET BUFFER TO ASC 1, BLANKS LDA SAVB+1 CPA .1 A=1? JMP HI82 YES CPA .2 A=2? JMP HI80 YES * * * CONVERT INSTRUCTION * LDB SAVB STB IOBF+9 SET RELOC INDIC LDA INST CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK L(IOBF+6) JSB V MOVE NO.TO BUFFER LDA SAVB+1 GET LIST PARAMETER. CPA .7 (7) NO LOCATION ? JMP HI82 YES, GO CONVERT SEQ. NUMBER. CPA .6 (6) INSTRUCTION ONLY ? JMP HX8 YES, CHECK FOR SUPPRESS. * SKP * * CONVERT LOCATION CNTR * * HI80 LDA PLCN CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK+1 L(IOBF+3) LDA .5 (5) JSB MOVE LISTL NOP -ASCI GOES IN HERE LDA SAVB+1 CPA .4 A=4? JMP HX8 YES * * * CONVERT SEQ.NO. * HI82 LDA SEQN CCE E=1 JSB BNCN CONVERT IT TO ASCII DECIMAL LDA ASCI+1 STA IOBF LDA ASCI+2 STA IOBF+1 * * * SET UP BUFFER LENGTH, ADJUST IF >80 CHARS * LDB SAVB+1 CPB .5 CONTROL STATE.? STA ASCI+4 SET TAPE # =1 LDA SCN1 STATE.LENGTH CPB .3 REMARK? JMP HI19 YES HI17 STA 1 H TO B ADA LISTD+1 -61 SSA,RSS LENGTH>60 ? LDB LISTD YES, SET B=60 ADB .4 ADD 4 STB 0 NEW LENGTH TO A HI18 ADA .16 LENGTH+16 LDB FBOI JSB PRNT *PRINT THE LINE OF OUTPUT * JMP LIST,I EXIT * * * SET UP FOR LIST COMMENT * HI19 LDB LISTK+2 $rþú L(IOBF+2) JSB MOVE DEF BUFF LDA SCN1 ADA .M16 LENGTH-16 JMP HI17 * * * TEST FOR EXTENDED SUP * HX8 LDB SUP SZB SUPPRESS THE LISTING ? JMP LIST,I YES, EXIT LDA .4 INITIALIZE STATEMENT LENGTH =4. JMP HI18 GO TO PRINT THE LINE. FBOI DEF IOBF * SKP * ****************** * * SKIP 'A' LINES * * ****************** LINS NOP SZA,RSS DON'T GO TO DRIVER, JMP LINS,I IF COUNT =0 (IT'S NOT NECESSARY). STA DSIG SET LINES TO SKIP INTO CNTR. JSB SPC.C SKIP LINES DEF C.LST LIST FILE FCB DEF DSIG LINE COUNT JMP *+2 ERROR JMP LINS,I RETURN. CLB INDICATE LIST FILE JMP ?FMPE DISPLAY ERROR AND ABORT * ********************************************************************** * * * * FIND NUM.OF CHARS IN A TERM * * * * * ENTER:=DON'T CARE; =RELATIVE POS'N IN 'BUFF' OF 1RST CHAR. * * EXIT: =NO. CHARS. IN TERM; B=STARTING MEMORY ADDRESS OF TERM * * 'TEST'=CONTINUATOR CHAR., FOLLOWING TERM * * 'LAST'=LAST CHARACTER IN TERM * ********************************************************************** * MSYM NOP STB SAVB STB PNTR CLA START WITH STA DSIG ZERO FOR CNTR STA TEST HI42 STA LAST LAST LDA SAVB JSB GETC CPA L+2 * ? JMP HI43 YES CPA BLNK END OF SYMBOL? JMP HI45 -YES- ADA .M46 -46 = -56B SSA,RSS >55B ? JMP HI44 -YES, NOT A TERMINATOR. ADA .7 (7) NO. SSA >47B [TERMINATOR: ' ( ) * + , - ] ? JMP HI44«§þú NO * * SET UP FOR EXIT * HI45 LDA PNTR JSB GETA LDA DSIG NO.OF SYMBOLS TO A JMP MSYM,I EXIT HI43 LDA DSIG CPA .1 IS '*' ALONE? JSB OPERR NO, ERROR HI44 ISZ DSIG BUMP CNTR. ISZ SAVB LDA TEST JMP HI42 * * ******************************** * * PRINT OUTPUT AND COUNT LINES * * ******************************** PRNT NOP STB PRLOC SAVE THE BUFFER ORIGIN CLE,SLA,ERA DIVIDE #CHARS BY 2 & SKIP IF EVEN JMP ODDCN STWCN STA SAVB SAVE THE WORD COUNT ISZ LINC END OF PAGE ? JMP I - NO LDB PLINE STB LINC RESET THE LINE COUNTER LDA .7 SKIP SEVEN LINES ON TTY, CMA,INA OR GO TO TOP OF FORM JSB LINS ON LINEPRINTER. ISZ LINC+1 BUMP PAGE NO. CCE SET FOR DECIMAL NO.CONVERSION. LDA LINC+1 GET PAGE NO. JSB BNCN CONVERT TO ASCII OCTAL * * * SET UP PAGE HEADER * LDA RC 'E' STA ASCI JSB WRT.C GO TO PRINT THE HEADER DEF C.LST LIST FILE FCB NAME DEF HEADP HEADER LOC'N DEF .35 WORD COUNT JMP PRNER LDB PASS SZB,RSS LIST PASS JMP PRNT1 NO LDA HED HEADING PRESENT? SZA,RSS JMP PRNT1 NO JSB WRT.C PRINT THE HEADING IF GIVEN DEF C.LST LIST FILE FCB .HEAD DEF HEAD2 START OF HEADER BUFFER DEF HED HEADER BUFFER LENGTH JMP PRNER ERROR RETURN LDA .2 RSS PRNT1 LDA .3 PREPARE TO JSB LINS SKIP 2 LINES. I JSB WRT.C GO OUTPUT A LINE DEF C.LST PRLOC NOP BUFFER ORIGIN DEF SAVB WORD COUNT JMP *+2 JMP PRNT,I PRINT EXIT PRNER CLB INDICATE LIST FILE ERROR JMP ?FMPE DISPLAY AND ABORT ODDCN STA SAVB SAVE WORD COUNT ¾þú ADB A POINT TO LAST WORD IN BUFFER LDA B,I GET CONTENTS AND B1774 MASK UPPER BYTE IOR BLNK INSERT BLANK IN LOW BYTE STA B,I RESTORE WORD LDA SAVB GET WORD COUNT INA INCREMENT IT JMP STWCN SET WORD COUNT * LINC OCT -1,0 LINE CNTR/PAGE CNTR .35 DEC 35 B1774 OCT 177400 * SKP * ******************* * * SET UP A HEADER * * ******************** HEDSB NOP LDA SCN1+2 SZA,RSS HEADER PRESENT? JMP HXD NO-RETURN ADA .M1 CMA,INA ADA SCN1 STA HED HEADER LENGTH IN 'HED' LDB .72 ADA .M73 -73 SSA,RSS IS HEADER TOO LONG (MORE THAN 58 CHARS) STB HED SET HEADER LENGTH TO 58 LDA SCN1+2 JSB GETA GET ADDRESS OF HEADER LDA HED STB HEDMV LDB HXD. GET L(HEDR+9) JSB MOVE HEDMV NOP ADDR OF HEADER LDA HED ADA .4 SLA,ARS CONVERT TO WORD COUNT JMP ODD# ODD # OF CHARACTERS HXD STA HED WORD COUNT JMP HEDSB,I ODD# STA HED SAVE FOR NOW LDB .HEAD ADDRESS OF HEAD BUFFER ADB A POINT TO THE LAST WORD IN HEADER LDA B,I AND B1774 MASK UPPER BYTE IOR BLNK INSERT BLANK IN LOW BYTE STA B,I RESTORE LAST WORD OF HEADER ISZ HED INCREMENT WORD COUNT FOR HEADER JMP HEDSB,I RETURN * .72 DEC 72 .M73 DEC -73 HXD. DEF HXBUF LOCATION OF HEADER HED NOP HEADER FLAG(LENGTH) ICSA DEF ASCI LOC'N OF ASCI BUFFER * ************************** * * PRINT ERROR DIAGNOSTIC * * ************************** DEF IOBF+5 ERPR NOP ISZ ERRCN BUMP ERROR COUNTER LDB BLNS STA IOBF+5 ERROR DIAG. STB IOBF+6 BLANKS STB IOBF+9 BLANK OUT RELOC INDIC. LDA SEQN Q9HFBCCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 FOR USE IN STA IOBF+7 THE LDA ASCI+2 DIAGNOSTIC STA IOBF+8 JSB PRPAG GO PRINT PREVIOUS PAGE NO. LDA SCN1 GET STATEMENT LENGTH ADA .10 (+10) LDB ERPR-1 GET STATE,ORIGIN (IOBF+5) JSB PRNT PRINT THE MESSAGE. JMP ERPR,I EXIT >Hÿÿþú SKP * *PRINT PREVIOUS PAGE CONTAINING ERROR ** * PRPAG NOP USED IN 'ERPR' AND 'ENDSB' PRPG1 LDA .2 SET UP TO EMIT A BLANK LINE LDB ABLNS JSB PRNT GO TO PRINT ROUTINE LDA LINC GET CURRENT LINE VALUE CPA .M1 IS IT SET FOR A PAGE EJECT? JMP PRPG1 YES, GO OUTPUT ANOTHER BLANK LIN LDB PASS LDA TAPE GET SOURCE TAPE NO. SZB FIRST PASS? LDA PRERR GET PREVIOUS PAGE(=0 IF 1ST ERR) CCE JSB BNCN CONVERT PAGE OR TAPE TO DECIMAL LDA .TNO GET ' #' LDB PASS SZB FIRST PASS? LDA .PG GET "PG" FOR PAGE POINTER STA ASCI SET IN '**' LDA ASCI+1 AND .2077 MAKE 1ST DIGIT BLANK STA ASCI+1 LDA .6 GET PARAM FOR 6 CHARS LDB ICSA BUFFER ORG JSB PRNT GO PRINT "**PAGE" OR " #TAPE" LDA LINC+1 GET CURRENT PAGE NUMBER. STA PRERR SET PREV. PAGE = CURRENT PAGE. JMP PRPAG,I EXIT .PG ASC 1,PG ABLNS DEF BLNS .2077 OCT 20077 * ************************************** * * PRINT ERROR COUNT AT END OF A PASS * * * SPACE TO BOTTOM OF PAGE * * * INIT.LINE,ERROR AND SEQUENCE CNTRS* * * SET CONTROL STATEMENT FLAG = -1 * * ************************************** ENDSB NOP LDB PASS SZB,RSS FIRST PASS? JMP GETER YES, BYPASS MESSAGE CHANGE. DLD TOTAL NO. CHANGE MESSAGE DST PAU+7 FROM: LDA TOTAL+2 "PASS#1" STA PAU+9 TO: "*TOTAL". GETER LDA ERRCN GET CURRENT ERROR COUNT. ADA ?ENER INCLUDE ENTRY POINT ERRORS, IF ANY. STA ERRCN UPDATE TOTAL ERROR COUNT. SZA,RSS ANY ERRORS? JMP ENDSR NO ERRORS.. LDB PASS SZB FIRST PASS? JSB PRPAG NO, PUT OUT THE PAGE POINTER LD]ûþúA ERRCN GET THE TOTAL ERROR COUNT CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 LDB ASCI+2 JMP ENDS1 ENDSR LDA BLNS * * * 'NO'ERROR SETUP * * LDB .NO FOR 'NO' ERRORS ENDS1 STA PAU+1 STA EMESG+4 STB PAU+2 STB EMESG+5 LDA PASS SZA,RSS PASS 2? JMP ENDS2 NO JSB WRT.C YES, SEND ERROR COUNT TO CONSOLE DEF C.TTY DEF EMESG DEF .13 NOP ENDS2 LDA DOT (46) NO OF CHARS IN MESSG. LDB PAU-1 BUFF ADDR JSB PRNT PRINT DIAG. CCA STA LINC NEXT TIME SKIP PAGE STA ASM1 SET CONT.STATE.FLG CLA,INA SET A=1 STA TAPE SET TAPE COUNTER = 1 JMP ENDSB,I EXIT END SUBROUTINE * DEF PAU LOC OF PASSOVER STATE. * PAU EQU * ESTABLISH START OF MESSAGE. * ASC 23,**0000 ERRORS PASS#1 **RTE ASMB 92067-16011** TOTAL ASC 3,*TOTAL EMESG ASC 13, /ASMB: 0000 ERRORS TOTAL * .20 DEC 20 ?PERL DEF *+1 ?BASF NOP BASE PAGE FLAG. ?BPSV NOP HIGHEST BASE PAGE VALUE. REP NOP REPEAT COUNTER REQ NOP FLAG FOR 1ST STATE AFTER REP LST NOP LST/UNL FLAG LTFLG NOP LITERAL FLAG(0=NO LIT.) ORRSV NOP =0 IN REG. PROG;=-1 IN ORG SECTN ORRS NOP SAVE LAST PLCN VAL FOR ORR SET ORGSV NOP HIGHEST PLCN VAL IN AN ORG SECTN PRERR NOP PREV. PAGE # CONTAINING ERROR. SUP NOP SUP/UNS FLAG IFUSE NOP =1, SKIP ASSMBL.; =-1, IN 'IF' RANGE SEQN NOP SEQUENCE COUNTER ?LPER ABS *-?PERL-1 LENGTH OF AREA TO BE CLEARED * ?ENER NOP 'ENT' ERROR COUNT STORAGE ERRCN NOP ERROR COUNTER. * SKP * * * PICK UP NEXT CHAR, ADD 1 TO PNTR * * PKUP NOP LDA PNTR JSB GETC ISZ PNTR JMP PKUP,I * * * SEARCH FOR NON-BLANK CHAR, SET PNTR AT I)ˆþúT * * BPKUP NOP JSB PKUP CPA BLNK BLANK? JMP *-2 YES - GET NEXT CHAR. LDB PNTR NO - SET PNTR TO LAST NON-BLANK ADB .M1 STB PNTR JMP BPKUP,I * ***************************** * * PUNCH AND SET UP FOR LIST * * ***************************** LOUT NOP CLA 0 TO A CLB,INB 1 TO B CPB PASS SKIP PUNCH IF IN PASS 1 RSS PASS 2, SO PUNCH. JMP PLST PASS 1 SO PREPARE FOR LIST. CPA AFLAG ABSOLUTE ASSEMBLY ? JMP RLREC NO, GO PROCESS RELOC. RECORD. JSB ?AREC YES,GO TO ABS REC. PROCESSOR. RSS SKIP TO PREPARE FOR LIST. RLREC JSB ?BREC GO TO RELOC. REC PROCESSOR. PLST CLA 0 TO A LDB BLNS BLANKS TO B JMP LOUT,I EXIT * SKP * * GET HIGHEST CURRENT LOCATION VALUE FOR 'ORG' PROCESSING. * ORGST NOP LDA ORGSV LAST ADDR. GENERATED DURING ORG CMA,INA ADA 1 "A" REGISTER _ LAST 'PLCN' VALUE SSA,RSS GREATER ? STB ORGSV NO. USE 'PLCN' VALUE FOR HI ORG CLA,INA "A" = 1 JMP ORGST,I RETURN. * * ***************** * * ORB PROCESSOR * * ***************** ORBP NOP LDA AFLAG SZA,RSS RELOCATABLE ASSEMBLY ? JMP XYZ YES. LDA .IL NO - 'IL ERROR ! JSB ERPR JMP ORBP,I RETURN. * XYZ LDB PLCN LDA ?BASF SZA ARE WE IN BASE PAGE ? JMP ORBP,I YES, EXIT. LDA ?BPSV NO, SET PLCN TO STA PLCN LATEST B.P. VALUE ISZ ?BASF SET B.P. FLAG. LDA ORRSV ARE WE IN SZA MAIN PROGRAM ? JSB ORGST NO, SET HIGH PLCN VALUE. SZA,RSS STB ORRS SAVE PLCN. CLA,INA STA ORRSV SET ORRSV = 1 JMP ORBP,I RETURN. * 'þúSKP * **************************** * * PROCESS ARITHMETIC MACRO * * **************************** DEF TEMP+4 HA38 JSB ARTLT GO TO LITERAL PROCESSOR LDA L+6 (PERIOD) STA TEMP+4 LDB HA38-1 =L(TEMP+4) LOWER CMB,INB STB SYMP+1 LOC.OF SYMBOL LDA .4 (4) EXT RELOC CODE STA SYMP NO.OF CHARS. LDB PASS SZB JMP ?ART GO TO ARITH('ART') ROUTINE LDB CNTR EXT.NUMBER JSB ?INSR INSERT INTO SYMBOL TABLE RSS ERROR- SKIP NEXT ISZ CNTR BUMP EXT CNTR LDA .2 2 JMP ?HA3Z CNTR OCT 1 EXT COUNTER,FOR PASS 1. * ************************** * * MEASURE LITERAL LENGTH * * ************************** MSYML NOP LDA SCN1+2 GET OPERAND POSITION STA SAVB SPC 1 * * SET UP AND TEST NEXR CHARACTER NXTCH ISZ SAVB SAVB = OPDRND POS'N+1 LDA SAVB GET CURRENT POSITION JSB GETC GET THE CHATACTER CPA BLNK IS IT A SPACE? RSS YES, END OF LITERAL JMP NXTCH NO, GO EXAMEINE THE NEXT CHARACT. LDB SCN1+2 GET STARTING POSITION CMB,INB COMPLEMENT IT. ADB SAVB RESULTS IN THE LITERAL LENGTH JMP MSYML,I EXIT * SKP * ******************** * * PROCESS LITERALS * * ******************** PLITS NOP LDA LTFLG LITERAL FLAG CPA .F =F ? JMP PER CPA .A =A ? JMP P.A CPA .L =L? JMP P.L JSB MSYML =B OR D; GET SYMB LNG. LDA LTFLG CPA .B =B? JMP P.0 YES CPA .D =D? JMP P.M1 YES PER JSB OPERR 'M' ERROR JMP PLITS,I EXIT P.M1 ADB .400B P.0 LDA SCN1+2 JSB ASCN CONVERT TO BINARY JMP PLITS,I ERROR RETURN P.1 STA ASCI P.2 LDA .2 8þúSTA SYMP LDA PASS SZA PASS 1 ? JMP P.LK NO JSB ?LITI YES, INSERT LIT.INTO SYMBOL TABL JMP PLITS,I ERROR RETURN RSS P.LK JSB ?LKLI LOOKUP LITERAL IN SYMBOL TABLE ISZ PLITS JMP PLITS,I NORMAL RETURN P.L CLA EXPRESSION PROCESSOR STA LTFLG JSB CHOPI EVALUATE OPERAND JMP PLITS,I ERROR EXIT SZA ABSOL.VALUE? JMP PER NO-ERROR LDA 1 VALUE TO A REG JMP P.1 P.A LDA SCN1+2 JSB GETA STB P.MV ADDR OF OPERAND LDA .2 2 CHARS LDB ICSA GET LOC'N OF ACSI BUFFER JSB MOVE P.MV NOP OPERAND ADDR. JMP P.2 .A OCT 101 ASCII 'A' .D OCT 104 'D' .F OCT 106 'F' .L OCT 114 'L' SKP * ************************* * * ARITH MACRO PROCESSOR * * ************************* ARTLT NOP LDA LTFLG GET LITERAL FLATG SZA,RSS LITERAL PRESENT? JMP ARTLT,I NO LITERAL, EXIT LDB TEMP+6 STB ARTSV+1 LDB TEMP+5 1ST 2 OPCODE CHARS FOR TEST STB ARTSV CPB .MP MPY? JMP LTAR YES CPB .DI DIV? JMP LTAR YES CPB .DS DST? JMP LERR1 YES, ERROR CPA .F =F? FLTG PT LIT PROC JMP LERR+3 LERR1 JSB OPERR NO,'M'ERROR LERR CLB B=0 CLA,INA A=1 JMP LTAR+2 JSB MSYML PROC.LIT.LNG. ADB B1000 2 TO 'B' UPPER LDA SCN1+2 OPERND PNTR JSB ASCN CONVRT ASCII TO FLTG.PT. JMP LERR ERROR RETURN STA ASCI STB ASCI+1 LDA .4 (4) STA SYMP SET SYMK/INSR PARAMS. LDA PASS SZA,RSS PASS 1 ? JMP LTINS YES JSB ?LKLI NO, LOOKUP LIT. IN SYMBL TABLE JMP LTAR+2 EXIT LTINS JSB ?LITI INSERT LIT‡þúERAL INTO SYMBOL TABLE JMP LTARZ ERROR EXIT(OK) ISZ PLEN JMP LTARZ LTAR JSB PLITS JMP LERR ERROR RETURN STA LTSVA SAVE A STB LTSVB SAVE B LTARZ CLA,INA STA LTFLG SET LTFLG=1 FOR LIT.IN ARITH MACRO. LDA ARTSV SET OPCODE CHARS BACK STA TEMP+5 FOR FURTHER PROCESSING LDA ARTSV+1 STA TEMP+6 JMP ARTLT,I EXIT FROM LIT. PROC. HERE SPC 1 .MP ASC 1,MP .DI ASC 1,DI .DS ASC 1,DS ARTSV OCT 0,0 LTSVA NOP FOR ART USE LTSVB NOP * ******************** * * SETUP FOR REPEAT * * ******************** REPSB NOP LDA REP SZA IN 'REP' RANGE? JMP RXP YES, ERROR JSB CHOPI EVAL NO.OF REP'S JMP RXP+2 ERROR EXIT SZA VAL RELOC? JMP RXR YES, ERROR SZB,RSS VAL=0? JMP RXP+2 YES INB NO. CMB,INB -B TO B LDA .M2 STA REQ SET REQ=-2(FOR SEQNO PROC) RXX STB REP B TO REP (NO.OF REPEATS) JMP REPSB,I RXP LDA .OP 'OP' ERROR(IN RANGE OF 'REP') JSB ERPR CLB 0 TO B (FOR NO REP) JMP RXX RXR JSB OPERR RELC.VAL(ERROR) 'M' JMP RXP+2 * * * SET UP FOR EVALUATION OF OPERAND IN WHICH A COMMA * * IS ILLEGAL. * CHOPI NOP CLA JSB CHOP JMP CHOPI,I ISZ CHOPI JMP CHOPI,I * ************************************* * * GET BREC CODE AND LIST RELOC CHAR * * BREC CODE IN A, LIST CHAR IN B. * ************************************* DCOD NOP LDB BLNS SZA,RSS ABSOLUTE REL.? JMP DCOD,I YES,DONE STA SAVB SAVE RELC CODE CPA .5 IS IT EQU EXT ? ADA .M1 YES, SET = 4. LDB ?TFLG PRINTING THE SYMBL TBL? SSB JMP DCOD1 YES LDB EMASY ؇þú OPERAND SYMBOL IS AN EMA? SSB,RSS BIT 15 SET? JMP DCOD1 NO CLA YES, THEN EMA GET 'E' STA EMASY CLEAR EMASY FLAG DCOD1 ADA RC-1 POINT TO CORR.RELC.CHAR. LDB 0,I PICK IT UP LDA BYFLG SZA,RSS LDA SAVB PICK UP RELC CODE IF NECESSARY. JMP DCOD,I RETURN * * * MOVE CHARS.TO A BUFFER FROM ASCI * * * BUFFER ADDR.IN B REG. * * V NOP LDA .6 JSB MOVE DEF ASCI JMP V,I * * * SET UP AND PRINT 'M' DIAG. FOR OPERAND ERROR * * OPERR NOP LDA .MBLN 'M'= OPERAND ERROR JSB ERPR JMP OPERR,I * ********************************************************************** * * * * GET BUFFER ADDRESS OF ITEM * * * * * ENTER: =CHARACTER POS'N. RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =+-CHAR. MEMORY ADDR.; NEG-IN LOWER BYTE,POS-UPPER * * * ********************************************************************** * GETA NOP ADA .M1 A-1 TO A CLE,ERA ADA FFUB SEZ UPPER ADDR? CMA,INA NO - COMPLEMENT IT. STA 1 A TO B JMP GETA,I * ********************************************************************** * * * * GET AN OPERAND CHAR. * * * * * ENTER: =CHAR. POS'N RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =CHAR.(LOWER BYTE); =WORD ADDRESS OF 'TEST' * * 'TEST' = CHARACTER (LOWER BYTE) * * þú * ********************************************************************** * GETC NOP JSB GETA STB GETMV LDB TS ADDR OF 'TEST' TO B REG CMB,INB CLA,INA SET =1 JSB MOVE GETMV NOP (FROM *-5) LDA TEST JMP GETC,I TS DEF TEST * * ************************************ * * MEASURE SYMBOL AND SET * * * SYMP = SYMBOL CHAR COUNT * * * SYMP+1 = SYMBOL POSITION * * ************************************ MSYMS NOP JSB MSYM STA SYMP STB SYMP+1 JMP MSYMS,I * * ***************************** * * SET MEMORY TO GIVEN VALUE * * ***************************** * SETM NOP CMA,INA SET VALUE FOR COUNTER STA DSIG LDA SETM,I GET PARAMETER TO BE STORED IN AREA SETLP STA 1,I - PLACE PARAMETER IN MEMORY INB ISZ DSIG JMP SETLP ISZ SETM JMP SETM,I SKP * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR AND ABORT ASMB * CALLING SEQUENCE: A REG = - ERROR # * B REG = -1 IF ERROR IN INPUT FILE * 0 IF ERROR IN LIST FILE * 1 IF ERROR IN OUTPUT FILE * JMP ?FMPE * ?FMPE ISZ ERRCN COUNT THE ERROR STB FMPMV SAVE B REG CMA,INA CONVERT ERROR # TO +VE CCE CONVERT TO ASCII JSB BNCN DLD ASCI+1 SET UP MESSAGE DST FMPER+10 LDB FMPMV GET FILE # LDA .INPT SSB IF -1 THEN INPUT FILE JMP STMVA ADA .3 SZB 0 THEN LIST FILE ADA .3 STMVA STA FMPMV LDA .6 MOVE FILE NAME INTO MESSAGE LDB FMPAD ADB .13 JSB MOVE FMPMV NOP JSB WRT.C DISPLAY MESSAGE ON CONSOLE DEF C.TTY CONSOLE FCB DEF FMPER MESSAGE ADDRESS DEF .16 …fþú NOP JMP ASMEX ABORT ASSEMBLER * .13 DEC 13 FMPER ASC 16, /ASMB: FMP ERROR - FMPAD DEF FMPER .INPT DEF *+1 ASC 3,SOURCE ASC 3,LIST ASC 3,BINARY SKP * * ASSEMBLY OPTION FLAGS * * EXIT NOP FLAGS DEF *+1 POINTS AT BFLAG LFLAG NOP LIST RFLAG NOP RELOCATABLE ASMBLY(OPTIONAL FLG) TFLAG NOP SYMBOL TABLE PRINT REQ. IFTST NOP CONTAINS 'IF' FLAG(N,Z, OR 0) AFLAG NOP ABSOLUTE ASMBLY. CFLAG NOP CROSS REFERENCE TABLE FLAG PLINE NOP STANDARD LINE COUNT ?LWA NOP LAST WORD ADDR. OF AVAIL. MEMORY X NOP ?NDOP NOP POINTS TO SUPPLEMENTARY OPCODES ?NDSY NOP POINTS TO END OF SYMBOL TABLE SKP * HEADP ASC 2, PAG ASCI BSS 3 DEST. OF CONVERTED DEC. NOS. ASCI1 EQU ASCI+1 .TNO ASC 3, # PART OF HEADER ASC 11, TIME ASC 16, HEAD2 ASC 2, HXBUF BSS 36 HEADER BUFFER. GTEM BSS 4 TEMP STORAGE: 'MOVE' & 'PNCH'. * A EQU 0 B EQU 1 SPC 1 * ASMB JSB SUP.C SUPERVISOR CALL FOR SET UP OF COMPILER LIB DEF TIME 16 WORD TIME STRING NOP NO ERRORS SHOULD OCCUR JSB PRM.C GET 4TH PARAMETER DEF .4 # OF LINES/ PAGE ON LIST OUTPUT STA PLINE SZA,RSS 0? JMP DFLT TAKE DEFAULT # OF LINES/PAGE LDA PLINE NO CMA,INA SAVE -VE COUNT FOR # OF LINES/PAGE JMP *+2 DFLT LDA .M55 DEFAULT IS 55 LINES/PAGE STA PLINE JSB GMM.C FIND FWA AND LWA FOR FREE MEM DEF .5 TO BE USED FOR SYMBOL TABLE DEF SGNAM ROUTINE CONVERT SEG# TO SEG NAME STA ?X FWA STB ?LWA LWA STB ?NDOP SET START OF SUPPLEMENTAL OPCODE TABLE CLA STA ?NDOP,I CLEAR START OF SUPPLEMENTAL TBL * CLA LOAD SEGMENT 0 ( ASMBD) JMP SEGMT CALL SEGMENT OVERLAY ROUTINE * .M55•Yþú DEC -55 SPC 2 ?AFLG EQU AFLAG ?ARTL EQU ARTLT ?ASCI EQU ASCI ?ASCN EQU ASCN ?ASII EQU ASCI1 ?ASM1 EQU ASM1 ?ASMB EQU ASMBX ?ASME EQU ASMEX ?BINF EQU BINFL ?BNCN EQU BNCN ?BPKU EQU BPKUP ?CHOP EQU CHOP ?CHPI EQU CHOPI ?CNTR EQU CNTR ?DCOD EQU DCOD ?ENDS EQU ENDSB ?ERPR EQU ERPR ?FLGS EQU FLAGS ?GETA EQU GETA ?GETC EQU GETC ?HA38 EQU HA38 ?ICSA EQU ICSA ?LFLG EQU LFLAG ?LINC EQU LINC ?LINS EQU LINS ?LIST EQU LIST ?LOUT EQU LOUT ?LST EQU LST ?LSTL EQU LISTL ?LTFL EQU LTFLG ?LTSA EQU LTSVA ?LTSB EQU LTSVB ?MESX EQU MESSX ?MOVE EQU MOVE ?MSYM EQU MSYM ?MSYS EQU MSYMS ?OPER EQU OPERR ?OPLK EQU OPLK ?ORGS EQU ORGSV ?ORRP EQU ORRP ?PKUP EQU PKUP ?PLIN EQU PLINE ?PLIT EQU PLITS ?PNCH EQU PNCH ?PRNT EQU PRNT ?PRPG EQU PRPAG ?RFLG EQU RFLAG ?RSTA EQU RSTA ?SEGM EQU SEGMT ?SETM EQU SETM ?SUP EQU SUP ?SYMK EQU SYMK ?SYML EQU MSYML ?SYMT EQU SYMTS ?TFLG EQU TFLAG ?V EQU V ?X EQU X FWA AVAIL. FOR RELOCAT. ASS'YS. SKP * **************************** * * TEMPORARY AND FLAG REGION* * **************************** TEMP BSS 7 TEMP AT START OF OVERLAY AREA VAL0 EQU TEMP+1 ASCN - MOST SIGNIFICANT BITS VAL1 EQU TEMP+2 ASCN VAL2 EQU TEMP+3 ASCN - MIDDLE BITS VAL3 EQU TEMP+4 ASCN - LEAST SIGNIFICANT BITS DCNT EQU TEMP+5 WPVAL EQU DCNT PASCN EQU TEMP+2 NUMBER PNTR SAVE(CHOP) .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 L OCT 50 ( OCT 51 ) OCT 52 * OCT 53 + OCT 54 , OCT 55 - DOT OCT 56 . .9 DEC 9 .M8 DEC -8 .M15 DEC -15 BLNK OCT 40 LOWER BLANK .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO .OP ASC 1,OP .OV ASC ¿+þú1,OV .UN ASC 1,UN B1000 OCT 1000 BIT15 OCT 100000 .E OCT 105 .B OCT 102 DEF *+1 ADDRESS OF RC RC ASC 5,E R B C X NAMI DEF NAME LOC'N FOR TEMP SYMBOL STORAGE NAME OCT 0,0,0,0 FOR USE BY 'OPLK' * * FOLLOWING 5 LOC'S ARE CLEARED IN CHOP ROUTINES * RELC NOP RELOCATION FLAG SIGN NOP SUMP NOP RUNNING SUM FOR 'CHOP' TERM NOP NO. OF TERMS IN AN OPERAND T BSS 2 BYFLG NOP BYTE FLAG FOR 'BREC' FLEX NOP 'ASCN' MODE EQU FLEX CNTB NOP CODE NOP OPCODE TYPE(FROM OPTABLE) DSIG NOP 'ASCN' FLAG NOP FLAQ NOP INST NOP OPCODE FORMAT LAST NOP PASS NOP PASS FLAG(0=PASS 1 AND 1=PASS2) PEEK NOP LAST CHAR PICKED UP PLCN NOP PROGRAM LOCATION COUNTER PLEN NOP LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR NOP POINTS AT LAST OR CURRENT CHAR. RCNT NOP SAVB BSS 2 SCN1 BSS 4 STATE LNG/OPCODE/OPERAND/LABEL(4) SVST NOP SYMI NOP ADDR CNTR FOR SYMBOL TBL (SYMK) FEXP EQU SYMI SYMP BSS 2 SYMBOL LNG/ AND LOC'N TEST BSS 2 TEST CHARACTER ENT. NOP ENTC NOP ENTV NOP DEXP EQU ENT. CNVT EQU ENTC ASCN SDSIG EQU ENTV ASCN - SAVE SIGN OF MANTISSA DFCNT EQU ENTV * * I/O STATEMENT BUFFER * IOBF BSS 63B 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU IOBF+12B PBUF OCT 10400,20000,0 START OF PUNCH BUFFER ASC 3, OCT 0,0,0,0,143,0,0,0,0,0,0 BSS 43 REST OF PUNCH BUFFER OCT 0 EXTRA WORD FOR BUFFER OVERFLOW OCT 5757 FOR ASMB CHECK SPC 1 * SET UP EQU'S FOR ABOVE VALUES TO DECLARE ENT'S ?TEMP EQU TEMP ?NAMI EQU NAMI ?NAME EQU NAME ?RELC EQU RELC ?SIGN EQU SIGN ?SUMP EQU SUMP ?TERM EQU TERM ?T EQU T ?BYFL EQU BYFLG ?FLEX EQU FLEX ?CNTB EQU CNTB ?CODE EQU CODE ?DSIG EQU DSIG ?FLAG EQU FLAG ?FLAQ EQU FLAQ ?INST EQU INST‰ŠHFB ?LAST EQU LAST ?PASS EQU PASS ?PEEK EQU PEEK ?PLCN EQU PLCN ?PLEN EQU PLEN ?PNTR EQU PNTR ?RCNT EQU RCNT ?SAVB EQU SAVB ?SCN1 EQU SCN1 ?SVST EQU SVST ?SYMI EQU SYMI ?SYMP EQU SYMP ?TEST EQU TEST ?ENT. EQU ENT. ?ENTC EQU ENTC ?ENTV EQU ENTV ?IOBF EQU IOBF ?BUFF EQU BUFF ?PBUF EQU PBUF SPC 2 END ASMB ­ãHÿÿ ÿýš8Ó ÿ92067-18012 2001 S C0322 &4XRF1 CROSS REF GENERATOR             H0103 N~þúASMB,R,L,C RTE 'XREF' CROSS-REFERENCE TABLE GENERATOR HED * RTE 'XREF' CROSS-REFERENCE TABLE GENERATOR 92067-16012 * * NAME: XREF * SOURCE: 92067-18012 * RELOC: 92067-16012 * PGMR: C.C.H.,S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XREF,3,99 92067-16012 REV.2001 791031 SUP EXT IFBRK EXT C.SOR,C.LST,C.TTY,OPN.C,WRT.C,RED.C,END.C EXT SPC.C,PRM.C,SUP.C,GMM.C,RWN.C,EOF.C * * THIS PROGRAM PRODUCES A CROSS REFERENCE TABLE FOR AN PROGRAM * WRITTEN IN HP-21XX ASSEMBLY LANGUAGE (HPAP). THE TABLE CON- * SISTS OF A LIST OF SYMBOLS, IN ALPHABETIC ORDER, EACH FOLLOWED * BY ITS LOCATION IN THE PROGRAM, AND A LIST OF REFERENCES TO * THAT SYMBOL. EACH LOCATION IS A 5-DIGIT SEQUENCE NUMBER, FOL- * LOWED BY THE NUMBER OF THE TAPE ON WHICH IT APPEARS. THESE TWO * ARE SEPARATED BY A SLASH. THE TAPE NUMBER IS NOT PRINTED WHEN * ONE TAPE ONLY EXISTS. * * THE METHOD USED IS TO READ IN THE HPAP SOURCE PROGRAM AND * BUILD A TABLE OF REFERENCES. THERE ARE TWO INTERNAL TABLES, THE * LABEL TABLE (LTAB) AND THE CROSS REFERENCE TABLE (XTAB). THESE * TABLES ARE ORGANIZED AS FOLLOWS: * * LTAB: EACH ENTRY CONTAINS THE LABEL NAME AS FOLLOWS: * WORD COUNT CHAR.1 * CHAR.2 CHAR.3 (OPTIONAL) * CHAR.4 CHAR.5 (OPTIONAL) * CHAR.6 CHAR.7 (OPTIONAL) * * THE WORD COUNT MAY BE 1,2,3, OR 4 * * XTAB: EACH ENTRY CONTAINS THE FOLLOWING: * -NUMBER OF WORDS IN ENTRY (-N-2) * LABEL SEQUENCE NUMBER * REF.1 " " D(þú LABELS ARE ADDED AS ENCOUNTERED; * ... * REF.N " " REST OF TABLE IS PUSHED DOWN. * * NO LINKAGE BETWEEN THE 2 TABLES IS REQUIRED BECAUSE THE ENTRIES * ARE IN THE SAME ORDER AND CORRESPOND 1 FOR 1. * NOTE THAT LTAB BEGINS IN LOW CORE AND XTAB IN HIGH CORE, SO THAT * BOTH ARE OPEN-ENDED. * * A LABEL WHICH HAS BEEN DEFINED BUT NEVER REFERENCED IS SIGNIFIED BY * A "@" IN COLUMN #1 PRECEEDING THE LABEL. * * A LABEL WHICH HAS BEEN DEFINED MORE THAN ONCE WILL HAVE A DEFINITION * FIELD OF HASH MARKS: "#####". * * A LABEL WHICH HAS BEEN REFERENCED BUT NEVER DEFINED WILL HAVE A * DEFINITION FIELD OF QUESTION MARKS "?????". * * ANY INSTRUCTION THAT WILL HAVE AN EFFECT UPON THE PROGRAM LISTING * AS ORG, ORB, ORR, IFN, IFZ, XIF, ECT. WILL BE DEFINED AS FOLLOWS: * " **XXX ***** NNNNN NNNNN " WHERE XXX IS THE TYPE OF INSTR. * AND NNNNN IS THE SEQUENCE NUMBER OF THE INSTRUCTION. * * A LITERAL INSTRUCTION WILL BE DEFINED AS A LABEL WITH ITS DEFINITION * FILLED WITH DOTS, OTHER SEQUENCE NUMBERS DEFINE WHERE THEY WERE USED. * * PARAMETERS: * *ON,XREF,SOURCE,LIST[,A[,B[,C]]] * NAMR NAMR * WHERE: * SOURCE AND LIST NAMR'S ARE FMGR NAMR OR LU#'S * A = 0 WILL ASK FOR NO ALPHA LIMITS. * A # 0 WILL ASK "ENTER LIMITS OR /E" * THE OPERATOR SHOULD ENTER TWO ALPHA CHARACTERS * REPRESENTING THE BEGINNING AND LAST SYMBOLS * OF THIS PASS. THE MESSAGE WILL CONTINUE AFTER * EACH PASS UNTIL A /E IS ENTERED. * * B = 0 WILL GIVE TAPE NUMBERS WITH SEQUENCE NUMBERS * B = N WILL GIVE NO TAPE NUMBERS THUS ALLOWING * LARGER SEQUENCE NUMBERS * B = -N XREF WILL NUMBER PAGES CONSECUTIVELY * FROM THE LAST RTE-ASMB PAGE NUMBER. * (TAPE NUMBER©ùþúS WILL BE PRINTED.) * [ MORE THAN 16 TAPES: PROCESSING TERMINATES ! ] * * * C = 0 WILL GIVE 55 LINES PER PAGE. * C = N WILL GIVE N LINES PER PAGE. [0nþúNORE PSUEDO OPCODE; CHECK PARAMETERS. CCB SET B TO POINT AT LABEL SEQUENCE JSB PUTSQ NUMBER AND PUT IN ETAB. MICPR LDA NEXT IS NEXT CHAR CPA COMMA EQUAL TO A COMMA? RSS YES - GO GET NEXT PARAM JMP RAC NO - GO GET NEXT STATEMENT. GSEC JSB ID GO GET NEXT SYMBOL JMP *+1 SKIP SECOND PARAMETER LDA NEXT IS NEXT CHAR CPA BLANK EQUAL TO SPACE JMP RAC YES - GO GET NEXT STATEMENT CPA FEED IS IT A LINE FEED JMP RAC YES - GO GET NEXT STATEMENT CPA COMMA IS IT A COMMA RSS YES - GO GET NEXT CHAR JMP GSEC NO - GO GET NEXT SYMBOL GTLEN JSB CHAR GET # OF OPERANDS PARAMETER CPA BLANK SKIP JMP GTLEN BLANKS. CPA FEED END OF CARD? JMP FLEN YES - CONTINUE. JSB DIGIT GO CHECK SEE IF IT IS A DIGIT RSS YES - IT IS A DIGIT CONTINUE FLEN CLA,INA,RSS SYMBOLIC - SET # OF OPERANDS TO 1. AND .7 CONVERT ASCII DIGIT TO OCTAL. ALF ALF,ALF STA NEXT LDB ETAB LDA B,I GET FIRST CHAR OF CURRENT OP-CODE IOR NEXT "OR" IN NUMBER OF OPERANDS STA B,I RESTORE ENTRY IN TABLE ALF,ALF UPDATE POINTER AND .15 TO NEXT ADB A ENTRY IN OP-CODE STB ETAB TABLE. JMP RAC GO GET NEXT STATEMENT SPC 1 * EXT PROCESSOR SPC 1 DOEXT JSB ID GET SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOEXX JSB LLKUP PUT IN LABEL TABLE. JSB ORDLK GET ADDRESS OF LABEL SEQUENCE ADA MIN1 LDB 0,I NUMBER AND SEE IF IT'S ZERO. SZB,RSS IF IT IS, PLACE THE CURRENT JSB MKSEQ SEQNO THERE. DOEXX LDA NEXT IF NEXT CHARACTER IS A CPA COMM'þúA COMMA, JMP DOEXT GO GET THE NEXT SYMBOL, JMP RAC ELSE GO TO READ NEXT LINE. SPC 1 * ENT PROCESSOR * SPC 1 DOENT JSB SOP PROCESS SYMBOL. CPA COMMA IF NEXT CHARACTER IS A COMMA, RSS SKIP FOR REFRESH JMP RAC ELSE GO TO READ NEXT CARD. CCA REFRESH NUMBER-OF-OPERANDS STA TEMP2 COUNTER, AND JMP DOENT GO TO GET THE NEXT SYMBOL. SPC 1 * COM PROCESSOR * SPC 1 DOCOM JSB ID GET A SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOCM1 JSB LLKUP PUT IN LABEL TABLE. CCB JSB PUTSQ PUT SEQUENCE NUMBER IN XTAB. DOCM1 LDA NEXT IF NEXT CHARACTER IS A CPA LPREN LEFT PARENTHESIS, JMP COMRG GO TO PROCESS ARGUMENT. COM1 CPA COMMA IF A COMMA, JMP DOCOM GO GET NEXT COMMON ENTRY. JMP RAC ELSE GET NEXT RECORD. COMRG JSB CHAR PROCESS ARGUMENT. CPA RPREN IF NEXT CHAR. IS A RIGHT PAREN, JMP *+4 GO GET NEXT COM ENTRY. CPA FEED IF A LINE FEED, THEN JMP RAC END OF CARD. JMP COMRG ELSE GET NEXT CHARACTER. JSB CHAR JMP COM1 SPC 1 * NAM PROCESSOR * SPC 1 DONAM LDA CCNT GET CURRENT CHARACTER COUNT. STA NAMLN SAVE FOR EXTENSION PROCESSING. JSB ID GET THE NAME JMP RAC NOT THERE LDA LABEL GET FIRST CHARACTER OF NAME AND MASK8 IOR UPBLN AND PRECEDE IT BY A BLANK. STA NAME MOVE TO NAME LOCATION. LDA LABEL+1 STA NAME+1 LDA LABEL+2 STA NAME+2 LDA CCNT GET CURRENT CHARACTER COUNT. CMA,INA,SZA,RSS MAKE POSITIVE. ZERO ? JMP RAC YES, GO GET NEXT RECORD. ADA NAMLN ANY MORE TO PROCESS ? SSA,RSS JMP RAC NO. GO TO READ NEXT RECORD. LDA .NMEX ADA Ezþú.NMEX STA NAMLN LDA NEXT GET LAST CHARACTER READ. RSS GO TO CHECK FOR FIRST BLANK. FBLNK JSB CHAR YES, EXAMINE NEXT CHARACTER. CPA FEED IF CHAR. IS A LINE FEED, THIS IS JMP RAC END OF STRING. GO READ NEW REC CPA BLANK IS THIS BEGINNING OF NAM EXTENT? RSS YES, GO TO PROCESS. JMP FBLNK NO. GO SEARCH FOR 1RST BLANK. LDB DM40 (B) = MAX CHAR. COUNT. LDA CCNT GET CURRENT CHAR. COUNT. ADA DEC40 IS NAM EXTENT >40 CHARS.? SSA STB CCNT YES, SET = 40 MAX CHARS. LDA BLANK (A)= ASCII BLANK. MVEXT LDB NAMLN JSB A2BUF ISZ NAMLN JSB CHAR GET THE NEXT CHARACTER. LDB CCNT GET NUMBER OF CHARS. ALREADY MOVED. SZB EXTENSION BUFFER FULL ? CPA FEED NO. IF THIS CHARACTER IS A LINE FEED, JMP RAC THAT'S ALL. JMP MVEXT GO BACK FOR MORE. SPC 1 * END PROCESSOR * SPC 1 DOEND JSB SOP PROCESS ELEMENT FOLLOWING END. LDA TAPNO SET TAPE NUMBER STA TPCNT TO TAPE COUNT * SPC 1 * OUTPUT SECTION * SPC 1 LDA RUN GET RUN FLAG SZA NEW PASS: OPERATOR SPEC'D LIMITS? JMP *+3 YES, DON'T FORCE NEW HEADER. CCA SET LINE COUNT TO -1 TO FORCE PAGE EJECT STA LINES TITLE AT THE BEGINNING. LDA LABCT COMPLEMENT LABCT TO FACILITATE STA LBLCT CMA ITS USE AS A COUNTER. STA LABCT SPC 1 * SECTION TO PROCESS A SINGLE LABEL * SPC 1 DUMP ISZ LABCT ANY MORE LABELS ? JMP DOLAB YES. LDA LETOP GET LIMIT PARAMETER. SZA,RSS LIMITS SUPPLIED FROM KEYBOARD ? JMP STOP NO, TERMINATE XREF ISZ RUN SET RUN NOT EQUAL TO ZERO JMP RSTAR RETURN FOR NEXT LIMITS * DOLAB LDA MAXCC SET CCNT SO AS TO FORCE A STA CCNT àþú BLANK LINE. JSB LINE * * SEARCH LABEL TABLE TO FIND THE FIRST LABEL, ALPHABETICALLY * * LDA MASK8 INITIALIZE TO A STA LABEL MAXIMUM. LDA FWA INITIALIZE LPNTR TO POINT AT STA PNTR1 FIRST ENTRY. LDA LTAB. SET LTAB. AS END OF TABLE CMA,INA POINTER. STA PNTR2 CLA INTIALIZE ORDNL TO STA ORDNL ZERO. DOLB1 ISZ ORDNL ADVANCE ORDNL. LDB PNTR1 TEST FOR END OF LTAB. ADB PNTR2 SSB,RSS SKIP IF NOT END OF LABEL TABLE. JMP GOTLB GO TO PRINT SECTION. * * MOVE CURRENT LABEL TO TEST ARRAY. * * LDA BLBL FIRST INITIALIZE TO BLANKS. STA TEST+1 STA TEST+2 STA TEST+3 STORE BLANKS IN TEST BUFFER LDA PNTR1 SET TEMP TO POINT AT CURRENT STA TEMP LABEL. LDB .TEST SET B TO POINT AT TEST ARRAY. LDA TEMP,I GET FIRST WORD OF LABEL IN A. AND MASK8 GET FIRST CHARACTER IN STA TEST TEST. XOR TEMP,I GET WORD COUNT IN HI-PART OF A. ALF,ALF ROTATE TO LO-PART. CMA,INA STORE AS NEGATIVE IN COUNT. STA COUNT DOLB2 ISZ TEMP ADVANCE LABEL POINTER. ISZ COUNT TEST FOR ANY MORE WORDS IN LABEL INB,RSS ADVANCE TEST POINTER, SKIP JMP COMPR GO TO COMPARISON SECTION. LDA TEMP,I GET NEXT WORD OF LABEL. STA 1,I AND MOVE IT TO TEST ARRAY. JMP DOLB2 SPC 1 * COMPARISON SECTION * SPC 1 COMPR LDA .LAB SET TEMP1 TO POINT STA TEMP1 AT LABEL LDB .TEST AND B TO POINT AT TEST LDA MIN4 SET COUNT TO -4 STA COUNT DOLB3 LDA TEMP1,I GET LABEL WORD IN A AND CMA,INA SUBTRACT IT FROM ADA 1,I TEST WORD. SSA IF TEST WORD IS SMALLER, GO TO JMP MOVE MOVE SECTION; SZA IF BIGGER GO TO JMP KEEP KEEP SECTION. oáNLH ISZ COUNT TEST FOR ANY MORE WORDS. RSS YES. JMP KEEP NO--SHOULDN'T COME HERE ISZ TEMP1 ADVANCE LABEL POINTER INB AND TEST POINTER JMP DOLB3 MOVE LDA 1,I MOVE TEST WORD TO LABEL STA TEMP1,I ISZ TEMP1 ADVANCE INB POINTERS. ISZ COUNT ANY MORE WORDS IN TEST ? JMP MOVE YES. LDA PNTR1 SET UP ADDRESS OF BEST LABEL STA BESTL SO FAR. LDA ORDNL SET ORDINAL OF THAT STA BESTO LABEL ALSO. KEEP LDA TEMP SET PNTR1 TO NEXT LABEL, AND STA PNTR1 GO TO TEST THE JMP DOLB1 NEXT ONE. * sNÿÿþú SKP * SECTION TO PRINT FOR THE OPTIMUM LABEL * SPC 1 GOTLB LDA BESTL,I STORE A MAXIMUM CHARACTER IOR MASK8 IN THIS LABEL SO THAT WE STA BESTL,I DON'T PICK IT UP AGAIN. LDA LABEL+3 SAVE LAST WORD OF LABEL STA TEMPZ SAVE LAST WORD IN TEMPZ LDA BESTO GET ADDRESS OF XTAB ENTRY JSB ORDLK IN A AND SAVE IN STA PNTR1 PNTR1. LDA PNTR1,I GET LENGTH OF ENTRY AND SAVE STA COUNT IN COUNT. LDB LABEL LOAD B WITH FIRST WORD OF LABEL ADB UPBLN ADD ENTRIES CPA MIN2 SEE IF ONLY ONE ENTRY ADB UPBLN YES. FORCE "@" FOR FIRST CHAR. STB LABEL OF LABEL GOTL1 ISZ COUNT TEST COUNT FOR ANY MORE. JMP *+3 GO TO DO NEXT SEQUENCE NUMBER. JSB LINE JMP DUMP GO TO DO NEXT LABEL. CCA SUBTRACT 1 FROM PNTR1 SO AS ADA PNTR1 TO HAVE IT POINT AT NEXT STA PNTR1 SEQUENCE NUMBER. LDB MIN4 SET MINUS 4 INTO STB PCOUN POWERS OF TEN COUNTER. LDA PNTR1,I LOAD A WITH THE SEQUENCE NUMBER. SSA NEGATIVE SEQUENCE NUMBER? JMP DEFDD YES, PROCESS DOUBLY-DEFINED LABEL. AND MSK12 OBTAIN THE STA SEQNO SEQNO AND XOR PNTR1,I TAPE NO. ROTAT NOP ROTATE TAPE # TO LOW BITS INA INCREMENT A BY ONE STA TAPNO LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA .P10 SET SQ1 TO POINT AT POWERS OF STA SQ1 TEN TABLE LDB SEQNO LOAD A WITH SEQUENCE NUMBER SZB,RSS SKIP IF NOT ZERO JMP UNDEF GO MODIFY DEFINITION AREA DGLUP LDA SIXTY INITIALIZE A TO ASCII 0 ADB SQ1,I TRY & SUBTRACT A POWER OF TEN. SSB SKIP IF O.K. JMP *+3 INA BUMP OUTPUT DIGIT JMP *-4 & LOOP. CMB ADD BACK THE ADB SQ1,I POWER OF ðÆþú CMB TEN, AND SAVE STB SEQNO REMAINDER IN SEQNO JSB OUTCR OUTPUT THE DIGI ISZ SQ1 ADVANCE POWER OF 10 POINTER. LDB SEQNO LOAD B WITH SEQUENCE NUMBER ISZ PCOUN ANY MORE DIGITS? JMP DGLUP YES. LDA .TAPE LOAD A WITH TAPE # PARAMETER SZA SKIP IF PARAMETER IS ZERO JMP EASYT IF NOT ZERO SKIP OUTPUT TAPE NO. ROUT. SPC 2 * NOW OUTPUT THE TAPE NUMBER.* SPC 1 CPA TPCNT IS THE TAPE COUNT ZERO JMP EASYT YES; GO OUTPUT BLANKS LDA SLASH OUTPUT A SLASH. JSB OUTCR LDB TAPNO GET TAPE NUMBER IN B LDA SIXTY SET A TO ASC 0 ADB MTEN IF B IS GREATER OR EQUAL TO 10 SSB JMP *+3 INA THEN THE FIRST DIGIT IS A 1 JMP *-4 ADB FEED STB TAPNO AND THE SECOND IS TAPNO-10 JSB OUTCR FIRST DIGIT. LDA TAPNO ADA SIXTY JSB OUTCR SECOND DIGIT JMP GOTL1 SPC 1 DEFDD LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA HASH GET ASCII '#'. RSS SKIP UNDEF INITIALIZATION. UNDEF LDA QUEST LOAD A WITH "?" LDB LABEL LOAD B WITH FIRST WORD OF LABEL CPB BL.AS COMPARE FIRST WORD WITH AN ASTERISK LDA STAR LOAD A WITH A "*" CPB BL.EQ COMPARE FIRST WORD WITH AN "=" LDA DOT LOAD A WITH A "." FIELD JSB OUTCR GO TO OUTPUT CHARACTER ROUTINE ISZ PCOUN INCREMENT POINTER JMP FIELD RETURN FOR NEXT CHAR LDB TPCNT LOAD B WITH TAPE COUNT SZB,RSS SKIP IF COUNT NOT ZERO EASYT LDA BLANK OUTPUT JSB OUTCR THREE BLANKS JSB OUTCR WHEN JSB OUTCR TAPNO=1. JMP GOTL1 SPC 1 * ROUTINE TO MOVE A CHARACTER TO THE OUTPUT BUFFER * SPC 1 OUTCR NOP STA CR1 SAVE CHARACTER IN CR1. ISZ CCNT TEST FOR END OF :HþúLINE. JMP *+3 NOT END OF LINE. JSB LINE OUTPUT THE LINE. JMP *-3 TRY AGAIN. LDA CR1 PUT THE LDB CPNTR CHARACTER IN THE JSB A2BUF OUTPUT BUFFER. ISZ CPNTR ADVANCE CHARACTER POINTER. LDA CR1 RETURN WITH CHARACTER JMP OUTCR,I STILL IN A. SPC 2 * ROUTINE TO PRINT THE OUTPUT LINE * SPC 1 LNE NOP ISZ LINES ADVANCE THE LINE COUNT. JMP LNE,I IF NOT END OF PAGE SKIP OUT JSB SPC.C DEF C.LST LIST FILE FCB DEF LNSKP # OF LINES TO SKIP CLB,RSS ERROR JMP NOPAG JMP ?FMPE DISPLAY FMGR ERROR NOPAG LDA MIN6 LOAD A WITH -6 FOR NEXT SKIP PAGE END STA LNSKP STORE IN END PAGE SKIP EXEC CALL ISZ PAGNO INCREMENT PAGE NUMBER BINARY LDA PAGNO CONVERT JSB CNDEC BINARY STA PGNUM+1 PAGE INB NUMBER LDA B,I TO ASCII STA PGNUM IN HEDDING LDA DEC40 PRINT THE PAGE LDB .NAME HEADING. JSB WRITE LDA TCNT LDB .TITL JSB WRITE CLA JSB WRITE LDA NLINZ SET LINE COUNT TO -55. STA LINES JMP LNE,I RETURN * SPC 2 LINE NOP JSB LNE GO TEST AND PROCESS EOT LDA TEMPZ RECALL LAST WORD OF LABEL STA LABEL+3 INSTAL INTO LAST POSITION OF LABEL AND MASK8 SAVE LAST CHARACTER CPA BLANK SEE IF LAST CHARACTER IS BLANK JMP *+4 NO; SKIP NEXT FOUR INSTRS, LDA DOT LOAD A WITH A LOW CHAR DOT IOR UPBLN ADD A UPPER BLANK STA LABEL+4 STORE ONLY ONE DOT INSTED OF TWO LDA CCNT GET CHARACTER COUNT IN A SZA,RSS IF 0 THEN IT SHOULD BE -1. CMA ADA DEC73 GET + NUMBER OF CHARS. FOR PRINT. CLE,SLA,ERA IF ODD # CHAR CLEAR JMP ODDCN LOW BY0êþúTE OF LAST WORD LINE1 LDB ..LAB GET ADDRESS OF PRINT BUFFER. JSB WRITE LDA BLBL BLANK OUT THE STA LABEL LABEL STA LABEL+1 FIELD. STA LABEL+2 STA LABEL+3 BLANK OUT FIELD STA TEMPZ SET LAST LABEL WORD TO BLANKS LDA OUTBF RESET CPNTR TO POINT ADA MIN1 STA CPNTR BEYOND THE LABEL. LDA SETCC INITIALIZE CCNT STA CCNT & JMP LINE,I RETURN * ODDCN STA WRCNT SAVE WORD COUNT LDB ..LAB BUFFER ADDRESS ADB A POINT TO LAST WORD LDA B,I GET CONTENTS AND MSKUP CLEAR LOW BYTE IOR BLANK INSERT BLANK IN LOW BYTE STA B,I RESTORE WORD LDA WRCNT INCREMENT WORD COUNT INA BY 1 JMP LINE1 * MSKUP OCT 177400 SPC 1 * ROUTINE TO FETCH A CHARACTER FROM A STRING * SPC 1 BUF2A NOP CLE,ERB ROTATE TO GET ADDRESS IN B LDA 1,I GET WORD IN A SEZ,RSS IF E=0, ROTATE TO GET CHARACTER ALF,ALF IN LOW END. AND MASK7 MASK THE CHARACTER JMP BUF2A,I SPC 1 * ROUTINE TO STORE A CHARACTER INTO A STRING * SPC 1 A2BUF NOP STA TEMP SAVE CHARACTER IN TEMP ERB COMPLEMENT LOW ORDER BIT OF B. CME ELB JSB BUF2A OBTAIN MATE TO THIS CHARACTER ALF,ALF IN HIGH END. IOR TEMP INSERT THE OTHER CHARACTER SEZ AND ALF,ALF ROTATE IF NECESSARY. STA 1,I STORE THE WORD & JMP A2BUF,I RETURN. SPC 1 * CHAR GETS THE NEXT CHARACTER FROM THE INPUT STRING * SPC 1 CHAR NOP LDB CPNTR GET CHARACTER POINTER. LDA FEED IN CASE OF END OF RECORD. ISZ CPNTR BUMP CHARACTER POINTER. ISZ CCNT TEST FOR END OF RECORD. JSB BUF2A NOT END OF RECORD. JMP CHAR,I * * LOOK FINDS THE ID IN" þú LABEL IN THE TABLE SPECIFIED * SPC 1 LOOK NOP LDA LOOK,I GET TABLE STARTING ADDRESS. STA .LOOK ISZ LOOK LDA LOOK,I GET TABLE ENDING ADDRESS CMA,INA STORE AS NEGATIVE STA LOOK. CLA INITIALIZE LOOKC STA LOOKC TO ZERO. ISZ LOOK SET LOOK TO POINT TO RETURN ADRS LOOK1 ISZ LOOKC BUMP COUNTER. LDB .LOOK TEST FOR END OF LIST ADB LOOK. B POSITIVE IF THE END. CLA SSB,RSS SKIP IF NOT END OF LIST. JMP LOOK,I RETURN WITH A=0, IF END OF LIST. * * NEXT 4 INSTRUCTIONS FOR MULTI-OPERAND OP-CODES (E.G. 'MIC') * * LDA .LOOK,I GET FIRST WORD OF TABLE ALF POSITION OPERAND COUNT AND .15 ISOLATE NUMBER OF OPERANDS STA OPCNT SAVE NUMBER OF OPERANDS. LDA .LOOK,I GET FIRST WORD OF LIST ELEMENT ALF,ALF GET NUMBER OF WORDS IN A. AND .15 ISOLATE NUMBER OF WORDS IN ENTRY. LDB .LOOK GET ADDRESS OF LIST ELEMENT IN B ADA 1 AND ADD WORD COUNT TO IT SO IT STA .LOOK POINTS AT NEXT ELEMENT. LDA .LAB SET TEMP TO POINT AT THE STA TEMP LABEL. LDA B,I GET FIRST WORD OF LABEL. AND MASK9 STRIP NUMBER OF OPERANDS. RSS GO TO COMPARE WITH LABEL. LOOK2 LDA 1,I LOAD A WORD FROM THE ELEMENT IN- CPA TEMP,I TO A AND COMPARE WITH LABEL. INB,RSS BUMP LIST ELEMENT POINTER. JMP LOOK1 IF NOT EQUAL GO GET NEXT ELEMENT LDA LOOKC COMPARE TO NEW VALUE OF .LOOK CPB .LOOK RETURN WITH A=LOOKC IF EQUAL. JMP LOOK,I ISZ TEMP BUMP LABEL POINTER ALSO AND JMP LOOK2 CONTINUE CHECKING THIS ELEMENT SPC 1 * LLKUP RETURNS THE ORDINAL OF LABEL IN THE LABEL TABLE * SPC 1 LLKUP NOP JSB LOOK LOOK UP LABEL IN LABEL TABLE FWA DEF * LTAB. BSS 1 END OF LABEL TABLE. ãFþú SZA IF ORDINAL NOT 0, LABEL IS IN JMP LLKUP,I TABLE, SO RETURN. LDA LABEL GET FIRST WORD OF LABEL AND FIND ALF,ALF ITS WORD COUNT. AND .15 CMA,INA STORE AS NEGATIVE IN STA PCOUN PCOUN. ADA .XTAB COMPUTE .XTAB-LTAB.+PCOUN-1 CMA,INA AND TEST FOR POSITIVE. ADA LTAB. CMA,SSA JMP OVERR OTHERWISE, TABLE OVERFLOW. LDB .LAB MOVE LABEL TO LABEL TABLE. LDA 1,I A_LABEL WORD STA LTAB.,I PUT IN LTAB ISZ LTAB. BUMP THE INB POINTERS. ISZ PCOUN ANY MORE? JMP *-5 YES LDA MIN2 NO. SET -2 IN XTAB AS NUMBER OF STA .XTAB,I WORDS IN ENTRY. ADA .XTAB SUBTRACT 2 FROM XTAB TO POINT IT STA .XTAB AT NEW BEGINNING OF TABLE. INA STORE A ZERO IN XTAB ENTRY TO CLB SAY THAT LABEL IS UNDEFINED SO STB 0,I FAR. LDA LOOKC RETURN LOOKC AS ORDINAL OF THIS ISZ LABCT LABEL. JMP LLKUP,I SPC 1 * ORDLK GETS THE ADDRESS OF THE NTH ENTRY IN XTAB * SPC 1 ORDLK NOP CMA,INA GET N IN PUTS1 AS STA PUTS1 NEGATIVE. LDA LWA STB MKSEQ TEMPORARILY SAVE CONTENTS OF B ISZ PUTS1 TEST FOR A LINK RSS JMP ORDLK,I ADA 0,I LINK THROUGH XTAB JMP *-4 SPC 1 * MKSEQ STORES THE CURRENT SEQUENCE NUMBER IN 0,I * SPC 1 MKSEQ NOP STA 1 ADDRESS TO LDA DDFLG GET DOUBLY-DEFINED FLAG. SZA PROCESSING DOUBLE-DEF.? JMP *+3 YES, USE ORIG. SEQ. NO. FOR NEW ENTRY. LDA SEQNO GET CURRENT SEQUENCE NUMBER. IOR TAPNO ADD IN THE CURRENT TAPE NUMBER. STA 1,I STORE IT INTO XTAB. JMP MKSEQ,I * DDFLG NOP DOUBLE-DEF FLAG (SEQUENCE/TAPE NO.) * PUTSQ INSERTS THE CURRENT SEQUENCE NUMBER INfÆþú XTAB. A CONTAINS THE * ORDINAL, AND B=-1 IF THIS IS ONLY TO BE STORED AS THE LABEL SE- * QUENCE NUMBER, OR B=0 IF THE TABLE MUST BE EXPANDED TO ADD A NEW * ELEMENT TO THE SPECIFIED ENTRY. SPC 1 PUTSQ NOP JSB ORDLK GET ADDRESS OF ENTRY STA TEMP SAVE ADDRESS FOR DOUBLE-DEF PROCESSING. SZB,RSS IF B IS ZERO, GO TO TABLE MOVE JMP PUTS2 SECTION. ADA 1 SET A TO POINT AT LABEL SEQ.NO. LDB 0,I TEST TO SEE IF A SEQUENCE NUMBER SZB IS ALREADY THERE. JMP DDERR DOUBLY DEFINED SYMBOL. PUTS3 JSB MKSEQ NOW COMPUTE THE SEQUENCE NUMBER LDA TEMP GET ENTRY ADDRESS. CLB PREPARE TO CLEAR DOUBLE-DEF FLAG. CPB DDFLG IS THE DOUBLE-DEF FLAG SET? JMP PUTSQ,I NO, RETURN. STB DDFLG YES, CLEAR IT, AND ADD NEW ENTRY. PUTS2 CCB ADD ONE TO THE ADB 0,I NUMBER OF ELEMENTS IN THE STB 0,I ENTRY. ADA 0,I ADD THIS TO A (AND ADD THE 1 INA BACK IN) TO GET THE ADDRESS STA PUTS1 OF THE NEW ELEMENT. LDA .XTAB MOVE ELEMENTS IN [.XTAB+1,PUTS1] STA PUTS5 DOWN 1 LOCATION. CMA -.XTAB-1 ADA LTAB. +LTAB. SSA,RSS IF POSITIVE, THEN JMP OVERR TABLE OVERFLOW. LDB .XTAB SET B TO BEGINNING OF BLOCK. CPB PUTS1 JMP PUTS6 BLOCK MOVED. INB LDA 1,I MOVE A STA PUTS5,I WORD. ISZ PUTS5 ADVANCE DESTINATION POINTER. JMP *-6 PUTS6 CCA DECREMENT .XTAB ADA .XTAB STA .XTAB LDA PUTS1 JMP PUTS3 * DDERR SSB,RSS ALREADY DOUBLY-DEFINED? JMP NEWDD NO, GO PROCESS DOUBLE DEFINITION. LDA TEMP YES, GET XTAB ENTRY-ADDRESS. JMP PUTS2 GO TO ADD NEW ENTRY. NEWDD SWP ADDRESS TO , SEQUENCE NUMBER TO . STA DDFLG SAVE SEQUENCE NUMBôªþúER AS DOUBLE-DEF FLAG. IOR RM2 SET SIGN FOR DOUBLE DEFINITION INDICATOR. STA B,I PLACE IN XTAB'S LABEL SEQUENCE NO. LDA TEMP GET ENTRY ADDRESS. JMP PUTS2 GO TO ADD FIRST SEQUENCE NO.TO ENTRIES. SPC 1 * ID SCANS THE INPUT STRING & BUILDS THE NEXT IDENTIFIER. IF THERE * IS ONE, IT SKIP RETURNS. SPC 1 ID NOP CLA INITIALIZE ASCII LITERAL FLAG TO 0 STA ALTRL LDA BLBL INITIALIZE LABEL TO BLANKS. STA LABEL+1 STA LABEL+2 STA LABEL+3 BLANK OUT FIELD LDA ONEBL STA LABEL STA L.DLM LDA MIN6 INITIALIZE CHARACTER COUNTER. STA ID1 LDA LABCH SET LABEL CHARACTER POINTER IN STA TEMP1 TEMP1 LDA NEXT IF LAST CHARACTER WAS A CPA FEED FEED , THIS IS THE END OF JMP ID,I CARD ID2 JSB CHAR GET NEXT CHARACTER STA NEXT PUT INTO NEXT. CPA EQUAL IS THE CHAR AN #="? JMP LITRL YES, GO PROCESS THE LITERAL CPA BLANK SKIP BLANKS JMP ID2 JSB LETTR IS IT A LETTER JMP NONID ...NO-GO TO SCAN FOR END OF FIELD SPC 1 * ADD THIS LETTER TO THE LABEL SO FAR * SPC 1 ID4 LDB ID1 LABEL CHARACTER COUNT. INB,SZB,RSS MORE THAN 5 CHARACTERS ? JMP ID3 YES STB ID1 BUMP CHARACTER COUNT ISZ TEMP1 BUMP CHARACTER POINTER LDB TEMP1 INSERT CHARACTER IN JSB A2BUF LABEL STRING LDA LABEL LDB ID1 ADD ONE TO LABEL WORD COUNT SLB,RSS IF ID1 IS EVEN. ADA HIGH1 STA LABEL LDA NEXT LOAD THE LAST CHARACTER READ. CPA TEMP IS THE LAST CHARACTER PROCESSED? ID3 JSB CHAR GET NEXT CHARACTER AND MASK7 ISOLATE THE LOWER 7 BITS STA NEXT SAVE THE NEW CHARACTER ISZ L.DLM CHARACTER #3 OF A LITERAL JMP ID0 NO, CONTINUE ID5 LDB ALTRL ASCII ŒþúLITERAL? SSB JMP ID7 YES CPA BLANK NO, BLANK? JMP ID6 YES, RETURN ID7 CPA FEED END OF ERCORD? JMP ID6 YES, GO ISSUE A SKIP RETURN. JMP ID4 NO, GO INSERT CHARACTER IN LABEL ID0 CLB,INB ENTER: B=1 CPB L.DLM CHARACTER #4 OF A LITERAL? JMP ID5 YES GO BACK FOR EOR CHECK JSB LETTR IS IT A LETTER RSS NO JMP ID4 YES JSB DIGIT IS IT A DIGIT JMP ID4 YES STA NEXT ID6 ISZ ID JMP ID,I SPC 1 NOTID STA NEXT SCAN FOR END OF FIELD. CPA BLANK JMP ID,I NONID CPA COMMA JMP ID,I CPA PLUS JMP ID,I CPA MINUS JMP ID,I CPA FEED JMP ID,I JSB CHAR JMP NOTID SPC 1 * LETTER DETERMINES WHETHER THE CHAR IN A IS A LEGAL HPAP LETTER * * LETTR NOP CPA BLANK BLANKS JMP LETTR,I & CPA FEED LINE FEEDS ARE JMP LETTR,I NOT LETTERS. JSB DIGIT IS IT A DIGIT ? JMP LETTR,I YES--NOT A LETTER. LDB 0 GET CHARACTER IN B & CMB,INB SUBTRACT FROM ADB LETMX LETMX SSB IF NOT SMALLER THEN JMP ISLET IT IS A LETTER. ADB LETMN OTHERWISE TEST AGAINST SSB,RSS LETMN. ISLET ISZ LETTR JMP LETTR,I LITRL JSB CHAR GO GET NEXT CHARACTER STA NEXT SAVE THE NEW CHARACTER CPA FEED END OF RECORD? JMP ID,I YES, RETURN CPA BLANK JUMP IF BLANK JMP ID6 YES, RETURN CPA EQ.L COMPARE TO OCTAL 114 "L" JMP ID2 YES, GO PROCESS SYMBOLS LDB MIN2 LOAD: B=-2 STB L.DLM SET THE LITERAL COUNT FLAG. ADB ID1 DECREMENT SYMBOL LIMIT BY 2 STB ID1 ALLOW SYMBOL TO BE 7 CHARS. CLB CPA EQ.A IS IT AN ASCII? CCB YES, THEN SET FLAG TO INDICATE SO STB ALTRL R!þú LDB .EQ. NO, LOAD THE SPECIAL "=". LDA EQUAL LOAD AN "=" CHAR. CPA NEXT IS THE NEW CHAR. AN "=" STB NEXT YES, STORE THE SPECIAL "=". JMP ID4 GO ENTER "=" INTO LABEL STRING. SPC 1 LETMX OCT 55 LETMN OCT -6 ALTRL NOP EQ.A OCT 101 SPC 2 * DIGIT DETERMINES WHETHER THE CHARACTER IN A IS A DIGIT * SPC 1 DIGIT NOP LDB 0 GET CHAR IN B CMB,INB AS NEGATIVE ADB DIGMX COMPARE TO MAXIMUM DIGIT (ASC9) SSB JMP NODIG ADB DIGMN AND TO MINIMUM DIGIT (ASC0) SSB,RSS NODIG ISZ DIGIT SKIP RETURN IF NOT A DIGIT JMP DIGIT,I SPC 1 DIGMX OCT 71 * SKP * CONSTANTS & VARIABLES * SPC 1 SEQNO NOP LABCT NOP .XTAB NOP TAPE1 OCT 004000 TAPE NUMBER --- INCREMENT CONSTANT. TAPNO NOP NEXT NOP DM40 DEC -40 DEC73 DEC 73 DEC80 DEC 80 CCNT NOP CHAR1 NOP STAR OCT 52 BLANK OCT 40 PLUS OCT 53 MINUS OCT 55 SLASH OCT 57 COMMA OCT 54 LPREN OCT 50 RPREN OCT 51 BL.AS ASC 1, * BL.EQ ASC 1, = DOT OCT 56 QUEST OCT 77 EQUAL OCT 75 EQ.L OCT 114 .EQ. OCT 275 L.DLM OCT 440 SSTAR OCT 24000 SPCLB OCT 1452 UPBLN OCT 20000 LINES NOP DEC40 EQU LPREN MAXCC DEC -72 PNTR1 NOP PNTR2 NOP ORDNL NOP TEMP NOP .TEST DEF TEST COUNT NOP ..LAB DEF LABEL-1 .LAB DEF LABEL TEMP1 NOP HIBND BSS 1 LOBND BSS 1 TWO DEC 2 BESTL NOP BESTO NOP MSK12 OCT 003777 11 BIT SEQUENCE NUMBER MASK = 2048. .P10 DEF *+1 DEC -10000,-1000,-100,-10,-1 MIN1 EQU *-1 MTEN EQU *-2 DIGMN EQU MTEN SQ1 NOP MIN4 DEC -5 PCOUN NOP SIXTY OCT 60 CR1 NOP LBLCT OCT 000000 .NAME DEF HEDR .TITL DEF BLBL .NMEX DEF NAMXT NAMLN NOP NLINZ DEC -55 LNSKP DEC -55 OUTBF NOP SETCC DEC -64 MASK7 OCT 177 MASK8 OCT 377 MASK9 OCT 7777 CPNTR NOP FEED OCT 12 .LOOK NOP LOOKC NOP LOOK. NOP MIN2 DEC -2 PUTS1 NOP PUTS5 NOP ONEBL OCT 440 MIN6 DEC -6 INDIR NOP q½þú SET FOR COMMA IN MULTI-OP INSTR. TEMP2 NOP OPCNT NOP NO. OPERANDS IN CURRENT STATEMENT. FXEND DEF OPEND "CODED" END OF OP-CODE TABLE. MICOP DEF EJMP POINTER TO START OF MICRO-OPS. LABCH NOP HIGH1 OCT 400 HASH OCT 43 ASCII '#' ASC 1, LABEL BSS 4 CBUF BSS 40 SUP HEDR ASC 4, PAGE PGNUM ASC 4,0000 ASC 8, NAME ASC 4, NAMXT ASC 20, BLBL ASC 20, CROSS-REFERENCE SYMBOL TABLE TIME ASC 16, TCNT DEC 36 RUN BSS 1 PAGNO NOP .TAPE BSS 1 TPCNT BSS 1 SKP OVERR JSB WRT.C DEF C.TTY CONSOLE FCB DEF OVDEF DEF .11 NOP CLA JMP STOP * OVDEF ASC 11, /XREF: TABLE OVERFLOW .11 DEC 11 TEST BSS 4 ID1 BSS 1 * * WRITE ROUTINE OUTPUTS ONE LINE TO OUTPUT DEVICE * * CALLING SEQUENCE: * LDA # OF CHARS(+) OR 0 IF SINGLE SPACE * LDB BUFFER ADDRESS * JSB WRITE * WRITE NOP SZA,RSS CHECK IF TO SPACE 1 LINE JMP WSPAC YES STA WRCNT SAVE WORD COUNT STB WRI10 STORE BUFFER ADDRESS JSB IFBRK BREAK FLAG SET? DEF *+1 SSA JMP STOP YES, TERMINATE XREF JSB WRT.C OUTPUT ONE LINE DEF C.LST WRI10 NOP DEF WRCNT WRTER CLB,RSS ERROR RETURN JMP WRITE,I RETURN JMP ?FMPE DISPLAY ERROR MESSAGE * WSPAC JSB SPC.C OUTPUT SINGLE SPACE DEF C.LST LIST FILE FCB DEF .1 JMP WRTER ERROR RETURN JMP WRITE,I RETURN * STOP JSB EOF.C WRITE EOF RECORD IN LIST FILE DEF C.LST JMP WRTER ERROR RETURN STOPX LDA NAME GET FIRST NAME CHARACTER. CPA BLBL NAME PRESENT ? JMP STOP1 NO, USE ASTERISKS FOR TERM. MESSG. AND MASK8 STRIP OFF UPPER BLANK IOR CARET ADD LEFT CARET, TO CONFIGURE STA BMESS+7 $END MESSAGE LDA NAME+1 TO INCLUDE STA BMESS+8 THE PROGRAM éþú LDA NAME+2 NAME STA BMESS+9 IF, ANY. STOP1 JSB WRT.C DEF C.TTY DEF BMESS DEF .11 NOP TERM JSB END.C COMPLETION REQUEST DEF CMLST JMP TERM ERROR IN CLOSING FILES, TRY AGAIN DEC10 EQU FEED BMESS ASC 11, /XREF: $END <*****> CMLST NOP * CNDEC NOP BINARY TO DECIMAL ASCII LDB MTEN STB CNDIV LDB A00 STB ASCI STB ASCI+1 STB ASCI+2 LDB CNMBR STB CNMLC CNORG JSB DVUKN DIVIDE BY 10 ADB CNMLC,I STB CNMLC,I SZA,RSS JMP CNOUT JSB DVUKN BLF,BLF ADB CNMLC,I STB CNMLC,I ISZ CNMLC SZA JMP CNORG CNOUT LDB CNMBR+3 LDA CNMBR+1 STA CNMBR+3 STB CNMBR+1 LDB CNMBR JMP CNDEC,I SPC 1 DVUKN NOP CLB CLEAR LOOP COUNTER = QUOTIENT + STB DVTMP DVU00 STA B FLAG ALLOW BIT 15 OF # TO BE SET DVU01 ADA CNDIV DIDIDE BY SUCCESSIVE SUBTRACTION ISZ DVTMP SSA,RSS DONE IF A IS NEG AND B IS POS JMP DVU00 CLEAR B TO ALLOW EXIT SSB EXIT IF POS JMP DVU01 ORIGINAL # TO CONVERT WAS NEG LDB CNDIV DONE CMB,INB ADB A REMAINDER TO B LDA DVTMP ADA MIN1 QUOTIENT TO A JMP DVUKN,I * DVTMP BSS 1 CNDIV NOP CNMLC NOP A00 ASC 1,00 CNMBR DEF *+1 ASCI ASC 3, SPC 1 * * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR AND ABORT XREF * CALLING SEQUENCE: A REG = - ERROR # * B REG = -1 IF ERROR IN SOURCE FILE * = 0 IF ERROR IN LIST FILE * JMP ?FMPE * ?FMPE STB FMPMV SAVE B REG CMA,INA CONVERT ERROR # INTO +VE JSB CNDEC CONVERT ERROR # TO ASCII INB DLD B,I GET LAST 4 DIGITS DST FMPER+10 LDB FMPMV GET FILE # LDA .INPT SSB,RSS IF -1 THE SOUR“!NLHCE FILE ADA .3 OTHERWISE LIST FILE STA FMPMV DLD A,I GET FIRST 2 WORDS OF FILE NAME DST FMPER+13 LDA FMPMV ADA .2 LDA A,I THIRD WORD OF FILE NAME STA FMPER+15 JSB WRT.C DISPLAY MESSAGE ON CONSOLE DEF C.TTY CONSOLE FCB DEF FMPER MESSAGE ADDRESS DEF .16 NOP JMP STOPX TERMINATE XREF * FMPMV NOP FMPER ASC 16, /XREF: FMP ERROR - .INPT DEF INPUT INPUT ASC 3,SOURCE ASC 3,LIST * * MORE CONSTANTS,ETC. * WRCNT NOP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .15 DEC 15 .16 DEC 16 .18 DEC 18 .23 DEC 23 .55 DEC 55 MAXIMUM ALLOWABLE LINES/PAGE OCTCL OCT 1100 CARET OCT 036000 .M16 DEC -16 N19 DEC -19 DEF1 DEF .1 DEFS OCT 124 DEFC OCT 125 TDEFS NOP TDEFC NOP RM1 OCT 077777 RM2 OCT 100000 RM3 RAL RM4 OCT 003777 RM5 OCT 004000 RM6 ALF,RAL DEFCB DEF CBUF DEFLB DEF LABEL LETOP NOP TEMPZ NOP EMESG ASC 18, /XREF: ENTER LIMITS OR ?_ SLSHE ASC 1,/E TPMSG ASC 10, /XREF: >16 TAPES !! * Nÿÿþú SKP ************************************************************************* * * * * OPERATOR BRANCH TABLE * * * * * EACH SINGLE ENTRY CORRESPONDS 1 FOR 1 WITH A 3-WORD OP-TABLE ENTRY. * * * * ENTRIES ARE ADDRESSES OF OPCODE/OPERAND PROCESSORS. * * * * EXAMPLES: * * * * << STANDARD OPCODES >> * * DEF DOSOP ABS : OPCODE WITH SINGLE OPERAND. * * * * << SPECIAL OPERANDS >> * * DEF DONAM NAM : PROCESS 'NAM' STATEMENT. * * * * << SPECIAL OPCODES >> * * DEF DOSPC IFN : OPCODE MODIFIES ASSEMBLED RESULTS, * * HAS NO DEFINING LABEL, AND * * DOES NOT HAVE AN OPERAND. * * * * DEF DOSP1 ORG : (SAME AS DOSPC) BUT, HAS OPERAND. * * * ************************************************************************* SPC 3 SWICH DEF *+1,I * SJMP EQU * START OF BRANCH TABLE * DEF RAC 0 NO OP-TABLE ENTRY FOUND DEF DOSOP ABS DEF DOSOP ADA DE©vþúF DOSOP ADB DEF DOSOP ADX DEF DOSOP ADY DEF DOSOP AND DEF DOSOP ASC DEF DOSOP ASL DEF DOSOP ASR DEF DOSOP ATD DEF DOSOP BAD DEF DOSOP BDV DEF DOSOP BMY DEF DOSOP BSS DEF DOSOP BTD DEF DOSOP CBS DEF DOSOP CBT DEF DOSOP CLC DEF DOSOP CLF DEF DOSOP CMW DEF DOCOM COM DEF DOSOP CPA DEF DOSOP CPB DEF DOSOP DAD DEF DOSOP DBL DEF DOSOP DBR DEF DOSOP DCP DEF DOSOP DCS DEF DOSOP DEF DEF DOSOP DIV DEF DOSOP DJP DEF DOSOP DJS DEF DOSOP DLD DEF DOSOP DSB DEF DOSOP DSF DEF DOSOP DSN DEF DOSOP DST DEF DOSOP DTA DEF DOSOP DTB DEF DOSOP EMA DEF DOEND END DEF DOENT ENT DEF DOSOP EQU DEF DOEXT EXT DEF DOSOP FAD DEF DOSOP FDV DEF DOSOP FMP DEF DOSOP FSB DEF DOSOP HLT DEF DOSPC IFN DEF DOSPC IFZ DEF DOSOP IOR DEF DOSOP ISZ DEF DOSOP JLY DEF DOSOP JMP DEF DOSOP JPY DEF DOSOP JRS DEF DOSOP JSB DEF DOSOP LAX DEF DOSOP LAY DEF DOSOP LBX DEF DOSOP LBY DEF DOSOP LDA DEF DOSOP LDB DEF DOSOP LDX DEF DOSOP LDY DEF DOSOP LIA DEF DOSOP LIB DEF DOSOP LSL DEF DOSOP LSR DEF DOSOP MBT DEF DOSOP MIA DEF DOSOP MIB DEF DOMIC MIC DEF DOSOP MPY DEF DOSOP MVW DEF DONAM NAM DEF DOSPC ORB DEF DOSP1 ORG DEF DOSPC ORR DEF DOSOP OT†þúA DEF DOSOP OTB DEF DOSOP RAM DEF DOSOP REP DEF DOSOP RRL DEF DOSOP RRR DEF DOSOP RPL DEF DOSOP SSM DEF DOSOP SAX DEF DOSOP SAY DEF DOSOP SBS DEF DOSOP SBX DEF DOSOP SBY DEF DOSOP SFC DEF DOSOP SFS DEF DOSOP SJP DEF DOSOP SJS DEF DOSOP SPC DEF DOSOP STA DEF DOSOP STB DEF DOSOP STC DEF DOSOP STF DEF DOSOP STX DEF DOSOP STY DEF DOSOP TBS DEF DOSOP UJP DEF DOSOP XCA DEF DOSOP XCB DEF DOSOP UJS DEF DOSPC XIF DEF DOSOP XLA DEF DOSOP XLB DEF DOSOP XOR DEF DOSOP XSA DEF DOSOP XSB * EJMP EQU *-SJMP NO. OF BRANCH TABLE ENTRIES * DEF DOSP1 OP-CODES DEFINED BY MIC INSTR. * * * END OF BRANCH TABLE * * SKP *************************************************************************** * * * * OPERATOR TABLE * * * * * EACH 3-WORD ENTRY CORRESPONDS 1 FOR 1 WITH ONE BRANCH TABLE ENTRY. * * * * FORMAT: O*OOO*WWW*WAA*AAA*AAA, A*AAA*AAA*AAA*AAA*AAA * * * * WHERE: OOOO (WORD#1 BITS 15-12) = NO. OPERANDS THIS OP-CODE. * * [ 0 FOR ONE OPERAND; ACTUAL NO. FOR >1 OPERAND. ] * * WWWW (WORD#1 BITS 11-08) = NO. WORDS THIS ENTRY. * * AAAAAAAA (WORD#1 BITS 07-00) = 1RST ASCII CHAR. OF OP-CODE. * * AAAAAAAAAAAAAA³«þúAA (WORD#2)= PACKED ASCII CHARS.2/3 OF OPCODE. * * * *************************************************************************** SPC 3 OPBEG EQU * START OF OPERATOR TABLE * OCT 1101,41123,1101,42101,1101,42102 ABS ADA ADB OCT 1101,42130,1101,42131,1101,47104 ADX ADY AND OCT 1101,51503,1101,51514,1101,51522 ASC ASL ASR OCT 21101,52104,21102,40504,31102,42126 ATD BAD BDV OCT 31102,46531,1102,51523,21102,52104 BMY BSS BTD OCT 21103,41123,1103,41124,1103,46103 CBS CBT CLC OCT 1103,46106,1103,46527,1103,47515 CLF CMW COM OCT 1103,50101,1103,50102,21104,40504 CPA CPB DAD OCT 1104,41114,1104,41122,21104,41520 DBL DBR DCP OCT 1104,41523,1104,42506,1104,44526 DCS DEF DIV OCT 1104,45120,1104,45123,1104,46104 DJP DJS DLD OCT 21104,51502,31104,51506,1104,51516 DSB DSF DSN OCT 1104,51524,21104,52101,21104,52102 DST DTA DTB OCT 1105,46501 EMA OCT 1105,47104,1105,47124,1105,50525 END ENT EQU OCT 1105,54124,1106,40504,1106,42126 EXT FAD FDV OCT 1106,46520 FMP OCT 1106,51502,1110,46124,1111,43116 FSB HLT IFN OCT 1111,43132,1111,47522,1111,51532 IFZ IOR ISZ OCT 1112,46131,1112,46520,1112,50131 JLY JMP JPY OCT 21112,51123 JRS OCT 1112,51502,1114,40530,1114,40531 JSB LAX LAY OCT 1114,41130,1114,41131,1114,42101 LBX LBY LDA OCT 1114,42102,1114,42130,1114,42131 LDB LDX LDY OCT 1114,44501,1114,44502,1114,51514 LIA LIB LSL OCT 1114,51522,1115,41124,1115,44501 LSR MBT MIA OCT 1115,44502,1115,44503,1115,50131 MIB MIC MPY OCT 1115,53127,1116,40515 MVW NAM OCT 1117,51102,1117,51107,1117,51122 ORB ORG ORR OCT 1117,52101,1117,52102,1122,40515 OTA OTB RAM OCT 1122,42520,1122,51114,1122,51122 REP RRL RRR OCT 1122,50114,1123,51515 RPL SSM OCT 1123,40530,1123,40531,21123,41123 SAX SAY SBS OCT 1123,41130,1123Óo,41131,1123,43103 SBX SBY SFC OCT 1123,43123,1123,45120,1123,45123 SFS SJP SJS OCT 1123,50103,1123,52101,1123,52102 SPC STA STB OCT 1123,52103,1123,52106,1123,52130 STC STF STX OCT 1123,52131,21124,41123,1125,45120 STY TBS UJP OCT 1125,45123,1130,41501,1130,41502 UJS XCA XCB OCT 1130,44506,1130,46101,1130,46102 XIF XLA XLB OCT 1130,47522,1130,51501,1130,51502 XOR XSA XSB * OPEND EQU * END OF BASIC INSTRUCTION SET * * THE EXPANSION TABLE ** MUST ** IMMEDIATELY FOLLOW THE OPERATOR TABLE! * * BSS 1024 EXPANSION AREA FOR 'MIC'-DEFINED OP-CODES * A EQU 0 B EQU 1 SPC 1 UNS SPC 1 END XREF Ë-ÿÿ ÿý%à ÿ92067-18013 1805 S C0222 &#EMA1 RTE-IV EMA FIRMWARE VERIFIER             H0102 “KþúASMB,R,L,C HED EMA FIRMAWARE ON-LINE DIAGNOSTIC NAM #EMA,3,99 92067-16013 REV.1805 780323 EXT EXEC,.DIO.,.IOI.,.DTA.,MMAP,.EMAP,.EMIO EXT $LIBR,$LIBX,IFBRK ENT #EMA EMAA EMA 0,0 * * DATE: 03/23/78 * NAME: #EMA * SOURCE: 92067-18013 * RELOC: 92067-16013 * PGMR: DJV * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * EMA FIRMWARE ON-LINE DIAGNOSTIC * * THIS IS A DIAGNOSTIC FOR THE 21MX E-SERIES EMA FIRMWARE. * IT OPERATES UNDER CONTROL OF AN RTE-IV SYSTEM. * * TO EXECUTE: * * RU,#EMA,LU,#TIMES * * PRINT MESSAGES ON LU. IF LU NEGATIVE, PRINT ONLY ERROR * MESSAGES. DEFAULT IS LU 1. #TIME IS NUMBER OF TIMES TO] * RUN THE DIAGNOSTIC. IF NEGATIVE, RUN CONTINUOUSLY. DEFAULT * IS ONCE. SET BREAK FLAG TO STOP. * A EQU 0 B EQU 1 XID EQU 1717B POINTS TO ID SEGMENT XIDEX EQU 1645B POINTS TO ID SEGMENT EXTENSION BPA2 EQU 1743B BASE PAGE FENCE SWAP EQU 1736B THE SWAP WORD * * FOLLOWING LOCATIONS ARE USED THROUGHOUT THE PROGRAM * ASV NOP PLACES TO SAVE A BIG OCT 77777 A BIG NUMBER BSV NOP AND B CNTR NOP COUNTS NUMBER OF TIMES THROUGH THE PROGRAM EMASZ NOP WILL HOLD THE NUMBER OF PAGES OF EMA ERCNT NOP COUNTS NUMBER OF ERRORS FLAG NOP IF = 1, DON'T PRINT INFO MESSAGES LSMSG NOP THE LAST MSEG REG +1 LU NOP PUT THE OUTPUT LU HERE M1 DEC -1 MSEG NOP STORES MSEG SIZE IN PAGES NAME NOP POINTS TO NAME OF ROUTINE BEING TESTED (FOR ERRORS) NPAGE NOP HOLDS îÏþúNUMBER OF PAGES ONE DEC 1 PAGE NOP STORES STARTING PHYSICAL PAGE OF THIS PROG PART NOP HOLDS THE PARTITION NUMBER SAMSG NOP HOLDS START ADDRESS OF MSEG SOFT NOP SET TO ONE IF USING SOFTWARE SPMSG NOP LOGICAL START PAGE MSEG STEMA NOP PHYSICAL START PAGE EMA SWPSV NOP TO SAVE THE SWAP WORD PGSTR NOP HOLDS STARTING LOGICAL PAGE OF THIS PROG TEMP NOP TMPDX NOP HOLDS ID EXT. WORD ZERO TSTNO NOP HOLDS THE CURRENT TEST NUMBER TWO DEC 2 ZERO NOP .1 DEC 1 .2 DEC 2 .6 DEC 6 .19 DEC 19 .22 DEC 22 .24 DEC 24 .25 DEC 25 .29 DEC 29 .30 DEC 30 .35 DEC 35 .1024 DEC 1024 * .EMAA DEF EMAA .NMAP DEF NMAP NMAP ASC 2,MMAP .NMMP DEF NMMP NMMP ASC 2,EMAP .NMMI DEF NMMI NMMI ASC 2,EMIO .MAPS DEF MAPS,I MAPS BSS 32 MAP REGISTERS WILL BE STORED HERE .#EMA DEF #EMA * #EMA CLE CLEAR A FLAG XLA B,I GET FIRST PARAM (LU) SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 SSA SKIP IF POSITIVE CMA,CCE,INA IF NEG, MAKE POS, SET FLAG STA LU STORE THE LU CLA THE EXTEND BIT FLAGS THAT LU WAS NEG. ERA STA FLAG INB GET #TIMES XLA B,I SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 CMA,INA MAKE NEGATIVE STA CNTR LDA XID GET EMASZ ADA =D28 GO TO WORD 28 IN THE ID SEGMENT XLA A,I GET IT AND =B1777 STA EMASZ XLA XIDEX,I GET MSEG SIZE AND =B37 STA MSEG LDA .#EMA GET THE STARTING LOGICAL PAGE OF THIS PROG CLB ASR 10 STA PGSTR LDA XIDEX GET LOGICAL START PAGE MSEG INA XLA A,I ASL 5 STB A AND =B37 STA SPMSG FORM START PSAGE MSEG ADA MSEG FORM LAST PAGE OF MSEG+1 INA «¯þúSTA LSMSG SAVE IT LDA SPMSG ASL 10 MAKE LOGICAL START ADDRESS OF MSEG STA SAMSG LDA EMASZ COMPUTE MSEG-EMASZ CMA,INA ADA MSEG SSA IF MSEG>=EMASZ, CAN'T RUN JMP CANRN JUMP IF CAN RUN JSB EXEC PRINT MESSAGE DEF *+5 DEF .2 DEF LU DEF CNTRN DEF .35 JSB EXEC PRINT TERMINTED MESSAGE DEF *+5 DEF .2 DEF LU DEF TERM DEF .19 JSB EXEC NOW QUIT DEF *+2 DEF .6 CANRN LDA EMASZ SEE IF EMA BIG ENOUGH FOR A FULL TEST ADA =D-33 SSA,RSS IF NEGATIVE, TOO SMALL JMP ISFRM NEED EMASZ > 32 PAGES JSB EXEC TELL OPERATOR PARTITION TOO SMALL DEF *+5 DEF .2 DEF LU DEF TOSML DEF .24 ISFRM LDA CLMMP CHECK TO SEE IF THE EMA CALLS AND =B74000 HAVE BEEN RP'ED TO THE CPA =B14000 FIRMWARE OPCODES JMP SFTWR JUMP IF STILL JSB LDA CLEMP MUST CHECK ALL THREE AND =B74000 POSSIBLE CALLS CPA =B14000 COMPARE TO A JSB JMP SFTWR JMP IF STILL A JSB LDA CLEMI CHECK EMIO AND =B74000 CPA =B14000 JMP SFTWR JMP START USING FIRMWARE, GO DO TESTS SFTWR CLA,INA SET A TO 1 STA SOFT SET SOFTWARE FLAG JSB EXEC TELL OPERATOR, USING SOFTWARE DEF START DEF .2 DEF LU DEF NOTFW DEF .30 START LDA SWAP SAVE THE SWAP WORD STA SWPSV JSB $LIBR NOW KLUDGE THE SWAP WORD NOP TO ALLOW SWAPPING LDA =B17 STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW LOCK INTO MEMORY DEF *+3 DEF .22 DEF .1 SKP TST00 LDA .NMAP PUT ADDRESS OF "MMAP" IN NAME FOR ERROR OUTPUT STA NAME CLA INITIALIZE THE TEST COUNTER OTA 1 SET THE S REÓRþúG STA TSTNO CLMMP JSB MMAP CALL MMAP WITH OFFSET NEGATIVE DEF *+3 DEF M1 A -1 FOR THE OFFSET DEF ONE CPA M1 A SHOULD BE -1 JMP TST01 IF SO, THEN DO NEXT TEST JSB NOER IF NOT, PRINT ERROR MESSAGE DEF TST01 * TST01 JSB INTST INCREMENT THE TEST NUMBER JSB MMAP DEF *+3 ASK FOR A NEGATIVE NUMBER OF PAGES DEF ONE DEF M1 CPA M1 A SHOULD BE -1 JMP TST02 IF IT IS, GO TO NEXT TEST JSB NOER PRINT ERROR MESSAGE DEF TST02 * TST02 JSB INTST INCREMENT THE TEST NUMBER LDA MSEG NOW BUILD A CALL TO ASK FOR MORE PAGES INA THAN ARE IN AN MSEG STA TEMP JSB MMAP DEF *+3 DEF ZERO A ZERO OFFSET DEF TEMP CPA M1 A SHOULD BE -1 JMP TST03 JUMP IF SO JSB NOER PRINT ERROR IF NOT DEF TST03 * TST03 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ NOW BUILD A REQUEST FOR PAGES BEYOND ADA M1 THE EMA STA TEMP JSB MMAP DEF *+3 DEF TEMP OFFSET IS EMASZ-1 DEF TWO ASK FOR 2 PAGES CPA M1 A SHOULD BE -1 JMP TST04 JUMP IF SO JSB NOER OTHERWISE PRINT ERROR MESSAGE DEF TST04 * TST04 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY JSB MMAP DO A STANDARD MSEG AND A STANDARD DEF *+3 NUMBER OF PAGES DEF ZERO NO OFFSET DEF MSEG SZA,RSS A SHOULD BE ZERO.(SKIP IF IT IS NOT) JMP A4 JSB INCER PRINT ERROR MESSAGE DEF TST05 A4 JSB ICMPS CHECK MAPS. SHOULD BE INCREMENTAL DEF TST05 * TST05 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ ASK FOR 1 PAGE AT END OF EMA TO ADA M1 CHECK READ/WRITE PROTECT BITS. STA TEMP JSB MMAP DEF *+3 DEF TEMP =hþú DEF ONE WANT ONE PAGE SZA,RSS IF NOT ZERO, THEN ERROR JMP A5 JSB INCER PRINT ERROR DEF TST06 A5 JSB LSTMP LAST PAGE OF EMA SHOULD BE MAPPED IN DEF TST06 * TST06 LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB INTST INCREMENT THE TEST NUMBER CLEMP JSB .EMAP CALL .EMAPFROM AN EMA PROGRAM AND DEF *+4 GIVE A NON-EMA ARRAY DEF NEMA START OF ARRAY DEF TNEM6 TABLE DEF ONE ASK FOR FIRST WORD JMP A6 INCORRECT ERROR RETURN CPB .NEMA SEE IF ADDRESS RIGHT JMP TST07 JUMP IF SO JSB EMAPR ADDRESS WRONG, ERROR DEF TST07 A6 JSB INCER INCORRECT ERROR RETURN DEF TST07 TNEM6 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT NEMA NOP .NEMA DEF NEMA * TST07 JSB INTST INCREMENT AND DISPLAY THE TEST NUMBER JSB .EMAP TRY A ZERO DIMENSION ARRAY DEF *+4 DEF EMAA THE EMA ARRAY DEF TEMA7 DEF ONE THIS IS IGNORED JMP A7 INCORRECT ERROR RETURN CPB SAMSG SHOULD BE START OF EMA AREA JMP B7 JUMP IF SO LDA SAMSG A HAS WHAT WAS EXPECTED JSB EMAPR PRINT REAL B, EXPECTED B DEF TST08 A7 JSB INCER BAD ERROR RETURN DEF TST08 B7 JSB TOMPS CHECK THE MAP REGISTERS DEF TST08 TEMA7 NOP ZERO DIMENSIONS DEC 0,0 NO OFFSET * TST08 JSB INTST INCREMENT TEST NUMBER JSB .EMAP TRY NEGATIVE NUMBER OF DIMENSIONS DEF *+4 DEF EMAA DEF TEMA8 THE TABLE DEF ONE JMP A8 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST09 A8 JSB EEMAP SEE IF A AND B ARE RIGHT DEF TST09 TEMA8 DEC -32768 NEGATIVE NUMBER OF DIMS DEC -1 DEC 1,0,0 * TST09 JSB INTST JSB .EMAP TRY SUBS¢±þúCRIPT BELOW LOWER BOUND DEF *+4 DEF EMAA DEF TEMA9 DEF M1 JMP A9 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST10 A9 JSB EEMAP CHECK A AND B DEF TST10 TEMA9 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT DEC 0,0 OFFSET WORDS * TST10 JSB INTST JSB .EMAP TRY NEGATIVE DIMENSION SIZE DEF *+4 DEF EMAA DEF TEM10 DEF ONE JMP A10 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST11 A10 JSB EEMAP CHECK A AND B DEF TST11 TEM10 DEC 1 DEC 0 DEC -1 DEC 0,0 * TST11 JSB INTST JSB .EMAP TRY OFFSET TOO LARGE DEF *+4 DEF EMAA DEF TEM11 DEF ONE JMP A11 SHOULD BE ERROR JSB NOER ERROR IF RETURN HERE DEF TST12 A11 JSB EEMAP SEE IF A AND B RIGHT DEF TST12 TEM11 DEC 1 ONE DIMENSION DEC 0 LOWER BOUND ZERO DEC 1 ONE WORD PER ELEMENT OCT 0,77777 LARGE OFFSET * TST12 JSB INTST JSB .EMAP TRY ARRAY TO LARGE (>1000000) DEF *+5 DEF EMAA DEF TEM12 DEF .2000 ASK FOR ELEMENT 2,000,001 DEF ONE JMP A12 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST13 A12 JSB EEMAP CHECK A AND B DEF TST13 TEM12 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 1000 DIMENSION SIZE DEC 0 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET .2000 DEC 2000 * TST13 JSB INTST JSB .EMAP TRY DOUBLE PRECISION CALCULATION OVERFLOW DEF *+6 DEF EMAA DEF TEM13 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 JMP A13 SOULD BE ERROR RETURN JSB NOER DEF |ºþúTST14 A13 JSB EEMAP CHECK A AND B DEF TST14 TEM13 DEC 3 A 3D ARRAY DEC -1 FIRST LOWER BOUND 1 DEC 32767 FIRST DIM DEC -1 SAME FOR THE REST DEC 32767 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET * TST14 JSB INTST JSB .EMAP TRY DISPLACEMENT TO LARGE DEF *+5 DEF EMAA DEF TEM14 DEF BIG DEF BIG THIS IS 32767 JMP A14 SHOULD BE ERROR RETURN JSB NOER DEF TST15 A14 JSB EEMAP CHECK A AND B DEF TST15 TEM14 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 32767 DEC -1 DEC 1 DEC 32767,32767 BIG OFFSET * TST15 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF EMAA DEF TEM15 DEF ONE DEF ONE JMP A15 SHOULD NOT ERROR RETURN ADB =D-1 B SHOULD BE START MSEG+1 CPB SAMSG SHOULD BE FIRST ELEMENT JMP B15 LDA SAMSG NOT RIGHT, PRINT MESSAGE INA EXPECTED SAMSG+1 INB B WAS DECREMENTED ABOVE JSB EMAPR DEF TST16 A15 JMP INCER IMPROPER ERROR RETURN DEF TST16 B15 JSB TOMPS CHECK MAPS DEF TST16 TEM15 DEC 2 DEC -1 DEC 1024 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 1,0 ONE WORD OFFSET * TST16 JSB INTST JSB .EMAP FOLLWING 6 TESTS ARE FOR DEF *+3 NON EMA ARRAYS DEF NEMA THIS IS NEG. DIM TEST DEF TNE16 JMP A16 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST17 A16 JSB EEMAP CHECK A AND B DEF TST17 TNE16 DEC -1 * TST17 JSB INTST JSB .EMAP SUBSCRIPT BELOW LOWER BOUND DEF *+4 DEF NEMA DEF TNE17 DEF M1 JMP A17 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST18 Ë@þúA17 JSB EEMAP CHECK A AND B DEF TST18 TNE17 DEC 1 ONE DIM DEC -1 LOWER BOUND 1 DEC 1 * TST18 JSB INTST JSB .EMAP DIM SIZE NEGATIVE DEF *+4 DEF NEMA DEF TNE18 DEF ONE JMP A18 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST19 A18 JSB EEMAP CHECK A AND B DEF TST19 TNE18 DEC 1,-1,-1 * TST19 JSB INTST JSB .EMAP 15 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE19 DEF BIG THIS IS 32767 JMP A19 SHOULD ERROR RETURN JSB NOER DEF TST20 A19 JSB EEMAP CHECK A AND B DEF TST20 TNE19 DEC 1 ONE DIMENSIONAL DEC 0 LOWER BOUND 0 DEC 2 TWO WORDS PER ELEMENT * TST20 JSB INTST JSB .EMAP 16 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE20 DEF B4000 JMP A20 SHOULD ERROR RETURN JSB NOER DEF TST21 A20 JSB EEMAP CHECK A AND B DEF TST21 TNE20 DEC 1 DEC 0 DEC 4 4B*40000B SETS THE B REG B4000 OCT 40000 * TST21 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF NEMA DEF TNE21 DEF *+1,I TRY AN INDIRECT DEF ONE ASK FOR THE ELEVENTH WORD JMP A21 SHOULD NOT ERROR RETURN ADB =D-11 SHOULD NOW BE .NEMA CPB .NEMA SEE IF IT IS JMP TST22 JUMP IF OK LDA .NEMA ADA =D11 ADB =D11 SET B BACK, A HAS EXPECTED VALUE JSB EMAPR PRINT ERROR MESSAGE DEF TST22 A21 JSB INCER INCORRECT ERROR RETURN TNE21 DEC 2 DEC 0 DEC 10 ARRAY IS (X , 10 ) DEC 0 LOWER BOUNDS BOTH 0 DEC 1 ONE WORD PER ELEMENT * TST22 JSB INTST JSB .EMAP TRY A(N)-L(N)>32767 DEF *+4 DEF NEMA DEF TNE22 DEF M1 JMP A22 SHOULD ERROR RETURN DLþúJSB NOER ERROR IF NO ERROR RETURN DEF TST23 A22 JSB EEMAP CHECK A AND B DEF TST23 TNE22 DEC 1 ONE DIMENSION DEC -32768 LOWER BOUND IS 32768 DEC 1 * TST23 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME CLEMI JSB .EMIO NEGATIVE BUFFER LENGTH DEF *+4 DEF M1 NOP NOP JMP A23 SHOULD ERROR RETURN JMP NOER IF NOT, IS AN ERROR DEF TST24 A23 JSB EEMIO CHECK A AND B DEF TST24 * TST24 JSB INTST LDA EMASZ BUFFER OVERFLOWS END STA TEMP OF EMA JSB .EMIO DEF *+5 DEF .2 A 2 WORD BUFFER DEF TEM24 DEF TEMP BUFFER STARTS AT THE LAST DEF .1024 WORD OF EMA JMP A24 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST25 A24 JSB EEMIO CHECK A AND B DEF TST25 TEM24 DEC 2 TWO DIMENSIONS DEC -1 LOWER BOUND 1 DEC 1024 RANGE DEC -1 LOWER BOUND FOR SECOND SUBSCRIPT DEC 1,0,0 ONE WORD PER ELEMENT AND NO OFFSET * TST25 JSB INTST LDA MSEG BUFFER ONE PAGE BIGGER INA THAN AN MSEG MPY =D1024 STA TEMP JSB .EMIO BUFFER BIGGER THAN AN MSEG DEF *+4 DEF TEMP DEF TEM25 DEF ONE JMP A25 SHOULD RETURN HERE JSB NOER IF NOT, TEHN ERROR DEF TST26 A25 JSB EEMIO CHECK A AND B DEF TST26 TEM25 DEC 1 DEC 0 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST26 JSB INTST JSB .EMIO TRY A STANDARD MSEG DEF *+4 DEF ONE DEF TEM26 DEF ZERO JMP A26 INCORRECT ERROR RETURN CPB SAMSG SEE IF ADDRESS RIGHT JMP B26 JMP IF OK LDA SAMSG A HAS WHAT B SHOULD BE JSB EMIOR PRINT ERROR MESSAGE DEF TST27 A26 JSB INCER INCORRECT ERROR RETURN ¼þú DEF TST27 B26 JSB ICMPS CHECK THE MAPS DEF TST27 TEM26 DEC 1 DEC 0 DEC 1,0,0 * TST27 JSB INTST JSB .EMIO NON-STANDARD MSEG DEF *+5 DEF .1024 OVERLAPS STANDARD MSEG DEF TEM27 DEF MSEG STARTING ELEMENT AT LAST PAGE DEF .1024 JMP A27 SHOULD NOT ERROR RETURN ADB =D-1023 B SHOULD BE LAST WORD OF CPB SAMSG THE FIRST PAGE OF MSEG JMP B27 ADB =D1023 PUT B BACK THE WAY IT WAS LDA SAMSG IF WRONG, PRINT ERROR JSB EMIOR DEF TST28 A27 JSB INCER WRONG ERROR RETURN DEF TST28 B27 JSB OFMPS GO CHECK MAPS DEF TST28 .3000 DEC 3000 TEM27 DEC 2 2 DIMENSION DEC -1 LOWER BOUND 1 DEC 1024 DEC -1 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST28 JSB INTST LDA .NMMP STA NAME LDA XIDEX SAVE THIS LOCATION STA TEMP JSB $LIBR NOW GO PRIVLEDGED NOP CLA CLEAR THE ID EXT. ADDRESS SO STA XIDEX FIRMWARE THINKS THIS IS NON EMA PROG JSB .EMAP GIVE 1D ARRAY DEF *+4 DEF NEMA MUST REMAIN PRIVLEDGED SO THE DEF TNEM6 XIDEX IS NOT RESTORED IN A SWAP DEF ONE JMP A28 SHOULD NOT ERROR RETURN JSB $LIBX DEF *+1 DEF *+1 CPB .NEMA CHECK ADDRESS JMP TST29 JMP IF OK LDA .NEMA THIS IS EXPECTED ANSWER JSB EMAPR EMAP ERROR DEF TST29 A28 JSB $LIBX DEF *+1 DEF *+1 JSB INCER INCORRECT ERROR RETURN DEF TST29 * TST29 JSB INTST LDA .NMAP CHANGE NAME TO MMAP STA NAME JSB $LIBR INTERRUPTS OFF AGAIN NOP CLA CLEAR XIDEX INCASE IT HAS STA XIDEX BEEN RESTORED JSB MMAP MMAP CALL FROM NON EMA PROG DEF *+3 DEF ZERO DEF ONE JSB $LIBX _œþú DEF *+1 DEF *+1 CPA =D-1 SHOULD ERRO RETURN JMP TST30 JSB NOER INCORRECT RETURN DEF TST30 * TST30 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME JSB $LIBR GO PRIVLEDGE TO CLEAR XIDEX NOP CLA CLEAR XIDEX STA XIDEX JSB .EMIO THIS IS ILLEGAL DEF *+4 DEF ONE DEF TEM26 DEF ONE JMP A30 SHOULD RETURN HERE LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX SYSTEM BACK ON DEF *+1 DEF *+1 JSB NOER ERROR NOT DETECTED DEF TST31 A30 CAX SAVE A LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX DEF *+1 DEF *+1 CXA PUT A BACK JSB EEMIO CHECK A AND B DEF TST31 * TST31 LDA SOFT USING SOFTWARE? SZA SKIP IF NOT JMP TST32 THIS TEST WONT WORK WITH SOFTWARE JSB INTST INCREMENT THE TEST NUMBER LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB MMAP FORCE A STANDARD MSEG DEF *+3 DEF ZERO DEF .1 JSB .EMAP CALL EMAP AND ASK FOR DEF *+5 AN ELEMENT IN THE LAST PAGE DEF EMAA DEF TEM31 DEF EMASZ DEF ONE JMP A31 CPB SAMSG B SHOULD BE AT START OF MSEG JMP B31 JMP IF SO LDA SAMSG PRINT ERROR IF NOT JMP EMAPR DEF TST32 A31 JMP INCER INCORRECT ERROR RETURN DEF TST32 B31 JSB GTMPS MUST CHECK MAP REGS LDB SPMSG LOG. START PAGE MSEG LDX .MAPS ADDRESS OF MAPS LAX B,I GET THE FIRST MAP CONTENTS STA TEMP SAVE IT LDA STEMA COMPUTE PHYSICAL PAGE NUMBER OF LAST PAGE ADA EMASZ ADA =D-1 CPA TEMP SEE IF RIGHT JMP C31 JUMP IF OK JSB TOERR PRINT ERROR MESSAGE JMP TST32 C31 INµ‡þúB SECOND MAP REG SHOULD BE PROTECTED LAX B,I AND =B140000 CPA =B140000 JMP *+2 ALL OK JSB TOERR PRINT THE FIRST TO MAP REGS XLA XIDEX,I CHECK NONSTAN MSEG BIT SSA SKIP IF NOT SET JMP TST32 JMP IF OK LDA MSEG BUILD AN APPROXIMATION TO ID EXT 0 IOR =B10000 JMP IDXER GO PRINT ERROR MESSAGE TEM31 DEC 2 2 DIMS DEC -1 DEC 1024 DEC -1 DEC 1 DEC 0,0 NO OFFSET * TST32 EQU * JSB EXEC NOW UNLOCK MEMORY DEF *+3 DEF .22 DEF ZERO JSB $LIBR SET SWAP WORD BACK NOP LDA SWPSV STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB IFBRK SEE IF BREAK FLAG SET DEF *+1 SSA JMP QUIT LDA CNTR IF CNTR >0, RUN CONTINUOUSLY SSA,RSS SKIP IF NEGATIVE JMP START START OVER ISZ CNTR INCREMENT THE COUNTER JMP START GO AGAIN IF NOT ZERO QUIT LDA ERCNT SEE IF ANY ERRORS SZA SKIP IF NONE JMP EREND JSB EXEC WRITE TERMINATION MESSAGE DEF *+5 DEF TWO DEF LU DEF GDEND DEF .24 JMP FINE EREND LDA LU CLB SEND FAILED TO PASS MESSAGE JSB .DIO. DEF BDEND DEF FINE LDA ERCNT JSB .IOI. JSB .DTA. FINE JSB EXEC TERMINATE DEF *+2 DEF .6 HLT * * EEMAP - CHECK A AND B ON ERROR RETURN FROM EMAP * SHOULD BE A = "15" AND B = "EM" * EEMAP NOP CPA =A15 RSS JMP WGMP CPB =AEM JMP OKMP JMP IF ALL OK WGMP JSB INCER PRINT ERROR IF NOT RIGHT DEF *+1 RETURN HERE OKMP LDA EEMAP,I GET RETURN ADDRESS JMP A,I RETURN * * EEMIO - CHECK A AND B ON ERROR RETURN FROM EMIO. * SHOULD BE A= "16" AND B= "EM" . * EEMIO NOP CPA =A16 RSS pëNLH JMP WGIO JUMP IF WRONG CPB =AEM JMP OKIO WGIO JSB INCER WRITE ERROR MESSAGE DEF *+1 OKIO LDA EEMIO,I RETURN JMP A,I * * EMAPR WRITES EMAP ERROR MESSAGE * EMAPR NOP STA ASV THIS IS WHAT B SHOULD BE STB BSV THIS IS WHAT IT IS JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FREMP DEF ENMPR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENMPR ISZ ERCNT BUMP THE ERROR COUNT NOP IN CASE ERCNT OVER FLOWS LDA EMAPR,I GET RETURN ADDRESS JMP A,I RETURN * * EMIOR - WRITES EMIO ERROR MESSAGE * EMIOR NOP STA ASV STB BSV JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRIOR THE FORMAT DEF ENIOR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENIOR ISZ ERCNT INCREMENT THE ERROR COUNTER NOP IN CASE ERCNT OVERFLOWS LDA EMIOR,I RETURN JMP A,I * * THE FOLLOWING SUBROUTINE GETS THE USER MAP REGISTERS, THE PHYSICAL * START PAGE OF THE USER AREA, AND THE PHYSICAL START PAGE OF EMA. * A SECTION IS PRIVLEGED SO THAT IT WILL NOT BE SWAPPED BETWEEN * ACCESSES. MEMORY LOCK WAS NOT USED BECAUSE IT MAY BE INHIBITED. çNÿÿþú* GTMPS NOP LDA XIDEX GET THE PHYSICAL START PAGE OF EMA INA IT IS THE SECOND WORD IN THE ID EXT. XLA A,I AND =B1777 STRIP OFF UNWANTED STUFF STA STEMA LDA XID GET THE PARTITION NUMBER ADA =D21 WHICH IS IN WORD 21 OF XLA A,I THE ID SEGMENT AND =B77 MASK OUT JUST PARTITION NUMBER INA STA PART LDA .MAPS PUT ADDRESS OF MAPS BUFFER IN A JSB $LIBR THIS IS REQUIRED BECAUSE USA MAY NOP CAUSE A DM WHEN IT SHOULDN'T USA COPY USER MAPS OUT JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW GET PHYSICAL START PAGE OF THIS PARTITION DEF *+6 DEF .25 DEF PART DEF PAGE DEF NPAGE DEF TEMP ISZ PAGE SKIP BASE PAGE JMP GTMPS,I RETURN * * ICMPS CHECKS THE MAP REGISTERS STARTING IN THE USER AREA. * IT ASSUMES THE MAP REG CONTENTS ARE SEQUENTIAL. * ICMPS NOP JSB GTMPS GET THE MAP REGS AND START PHYS. PAGE * * GTMPS GETS THE MAPS (INTO BUFFER MAPS) AND SETS PAGE AND STEMA. * IN THE FOLLOWING, B IS A MAP NUMBER AND X IS THE START OF * THE ARRAY HOLDING THE MAPS. * LDB PGSTR LDX .MAPS START COMPARISON AT MAP FOR BEGINING OF USER AREA ICLP LAX B,I GET MAP REGISTER CONTENTS CPA PAGE SHOULD BE INCREMENTAL PAGES JMP ICEQ JMP IF EQUAL JSB MAPER PRINT ERROR IF NOT DEF ICIDX ICEQ ISZ PAGE INB POINT TO NEXT MAP REG CPB LSMSG SEE IF AT END OF MAP REGS RSS JMP ICLP LOOP BACK IF MORE ICIDX LDA MSEG SHOULD BE MSEG # 0. XCA XIDEX,I CHECK WORD ZERO OF ID EXT. JMP ICEND JUMP IF OK JMP IDXER GO PRINT ERROR MESSAGE ICEND LDA ICMPS,I GET ADDRESS TO RETURN JMP A,I * IDXER STA ASV SAVE THE EXPECTED VALUE IF IDEX0 JSB PTEST PRINT THE TEST NUMBER LDeLþúA LU NOW PRINT IDEX CLOBBERED MESSAGE CLB JSB .DIO. DEF FRIDX DEF NDIDX LDA ASV PRINT EXPECTED VALUE JSB .IOI. XLA XIDEX,I PRINT REAL VALUE JSB .IOI. JSB .DTA. NDIDX ISZ ERCNT NOP JMP EREND ID EXT. WORD 0 IS GONE, SO TERMINATE * INCER NOP SUBROUTINE TO PRINT ERROR IF INCORRECT ERROR RETURN STA ASV SAVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE FAILING ROUTINE DST FRMT2+2 STORE IT IN THE FORMAT LDA LU NOW CALL THE FORMATTER TO OUTPUT THE MESSAGE CLB JSB .DIO. DEF FRMT2 DEF ENDL2 LDA ASV JSB .IOI. PRINT CONTENTS OF A LDA BSV JSB .IOI. PRINT CONTENTS OF B JSB .DTA. ENDL2 ISZ ERCNT INC THE ERROR COUNTER LDA INCER,I GET THE RETURN ADDRESS JMP A,I * INTST NOP INCREMENT THE TEST NUMBER AND PUT ON S ISZ TSTNO LDA TSTNO OTA 1 ADA =D-32 IF > 32, IN A LOOP SSA,RSS IF < 0, OK JMP EREND TERMINATE THE PROGRAM JMP INTST,I * * LSTMP CHECKS THE MAP REGISTERS ASSUMING THE LAST PAGE OF * EMA IS THE ONLY ONE MAPPED IN. THE REST OF THE MSEG * IS PROTECTED. * LSTMP NOP JSB GTMPS GET THE MAPS AND PHYS START PAGE OF THIS PARTITION LDB PGSTR GET LOGICAL START ADDRESS OF THIS PROG LDX .MAPS B POINTS TO MAP REG FOR START OF THIS PROG LSLP LAX B,I GET THE MAP REG CONTENTS CPA PAGE SHOULD MATCH PHYSICAL PAGE JMP LSEQ JSB MAPER PRINT ERROR IF NO MATCH DEF LSEND LSEQ ISZ PAGE INCREMENT PHYSICAL PAGE COUNTER INB INCREMENT POINTER TO MAPS CPB SPMSG SEE IF IN MSEG YET RSS SKIP IF SO JMP LSLP JUMP IF MORE TO CHECK LDA STEMA BUILD THE PHYSICAL PAGE NUMBER FOR ADA EM?ßþúASZ THE LAST PAGE OF EMA ADA M1 STA PAGE LAX B,I GET NEXT MAP CPA PAGE AND CHECK IT RSS JMP LSER JMP IF BAD INB LSLP2 LAX B,I GET THE MAP REG CONTENTS AND =B140000 REST OF PAGES SHOULD BE READ/WRITE PROTECTED CPA =B140000 SEE IF RIGHT JMP LSEQ2 JUMP IF OK LAX B,I GET MAP REG CONTENTS LSER JSB MAPER PRINT THE ERROR MESSAGE DEF LSIDX LSEQ2 INB CPB =D32 SEE IF AT END OF MAPS RSS IF SO, DO NEXT TEST JMP LSLP2 IF NOT, GO BACK AND DO SOME MORE LSIDX CLB CHECK ID EXT. WORD 0 LDA EMASZ MUST SEE IF LAST PAGE ADA =D-1 ONLY MAPPED IN STANDARD MSEG DIV MSEG SZB IF NO REMAINDER, STAN MSEG JMP NNSTN JUMP IF NON STAN MSEG ASL 5 SHIFT UP MSEG NUMBER IOR MSEG A IS NOW WHAT IDEX0 SHOULD BE XCA XIDEX,I COMPARE TO REAL IDE0 JMP LSEND JUMP IF OK JMP IDXER OTHERWISE PRINT ERROR NNSTN XLA XIDEX,I GET WORD ZERO AND AND =B100037 MASK OUT MSEG # STA TEMP SAVE IT LDA MSEG IDEX0 SHOULD BE MSEG SIZE WITH IOR =B100000 THE SIGN BIT SET CPA TEMP SEE IF RIGHT JMP LSEND JUMP IF OK JMP IDXER PRINT ERROR IF WRONG LSEND LDA LSTMP,I GET RETURN ADDRESS JMP A,I RETURN * MAPER NOP PRINT MMAP ERROR MESSAGE STA ASV WILL HAVE MAP REG CONTENTS ON ENTRY STB BSV WILL HAVE MAP REG NUMBER JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRMAP DEF ENMAP LDA BSV JSB .IOI. LDA ASV JSB .IOI. JSB .DTA. ENMAP ISZ ERCNT INCREMENT THE ERROR COUNTER LDA MAPER,I RETURN JMP A,I * * NOER - PRINTS THE MESSAGE THAT AN ERROR CONDITION * WAS NOT DETECTED * NOER NOP STA ASV SA¼þúVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE ROUTINE DST FRNER+2 AND STORE IN THE FORMAT LDA LU NOW CALL THE FORMATTER CLB JSB .DIO. DEF FRNER DEF NDNER LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. NDNER ISZ ERCNT INCREMENT THE ERROR COUNTER NOP NOP IN CAES IT OVERFLOWS LDA NOER,I GET THE RETURN ADDRES JMP A,I AND RETURN * * OFMPS - CHECK THE MAP REGISTERS ASSUMING A NON STANDARD MSEG. * THE FIRST PAGE OF THE MSEG IS THE LAST PAGE OF THE * FIRST STANDARD MSEG. ONLY TWO PAGES ARE CHECKED * IN CASE WE ARE IN A SMALL PARTITION. * OFMPS NOP JSB GTMPS GET THE MAP REGS LDA MSEG GET MSEG SIZE ADA =D-1 MINUS 1 ADA STEMA PLUS PHYSICAL START EMA STA PAGE = PHYS. START THIS MSEG LDA =D-2 CHECK ONLY TWO PAGES STA TEMP LDX .MAPS THE ADDRESS OF THE MAPS LDB SPMSG START CHECKING AT THE MSEG OFLP LAX B,I GET MAP CONTENTS CPA PAGE SEE IF RIGHT RSS SKIP IF SO JMP OFER JMP IF ERROR ISZ PAGE GO TO NEXT LOCATION INB ISZ TEMP JMP OFLP OFEND LDA OFMPS,I RETURN JMP A,I OFER JSB MAPER A MAPPING ERROR DEF OFEND * PTEST NOP PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRTST THE FORMAT DEF ENDPT LDA TSTNO GET THE TEST NUMBER JSB .IOI. JSB .DTA. ENDPT JMP PTEST,I * * TOMPS - CHECKS THE MAP REGISTERS SET UP BY EMAP. * IT CHECKS ONLY THE FIRST TWO BECAUSE THAT IS * ALL THAT THE FIRMWARE VERSION OF EMAP SETS UP. * THE CHECK FOR THE NON-STANDARD MSEG BIT SET * IS NOT DONE IF SOFTWARE IS USED. TOMPS NOP JSB GTMPS GET THE MAP REGS [þúLDB SPMSG GET LOG START PAGE MSEG LDX .MAPS STARTING ADDRESS OF MAPS LAX B,I GET FIRST PHYS. PAGE NUMBER CPA STEMA SEE IF RIGHT JMP *+3 JUMP IF SO JSB TOERR PRINT ERROR MESG. JMP TOEND INB POINT TO NEXT MAP REG CONTENTS LAX B,I ADA =D-1 BACK IT UP ONE CPA STEMA SEE IF THIS ONE RIGHT JMP *+3 JUMP IF SO JSB TOERR GO PRINT ERROR MESG. JMP TOEND LDA SOFT USING SOFTWARE? SZA JMP TOEND YES, END XLA XIDEX,I NONSTAN MSEG BIT SHOULD BE SET SSA,RSS SKIP IF ITS SET JMP *+3 DO ERROR MESSAGE TOEND LDA TOMPS,I GET RETURN ADDRESS JMP A,I RETURN LDA MSEG BUILD AN APROXIMATION OF IOR =B100000 THE ID.EXT. WE EXPECTED JMP IDXER GO DO ID.EXT. ERROR TOERR NOP PRINT THE FIRST TWO MSEG MAP REGS JSB PTEST PRINT THE TEST NUMBER LDA LU NOW PRINT MESSAGE THAT CLB EMAP SET UP MAP REGS WRONG JSB .DIO. DEF FRTWO DEF NDTWO LDA SPMSG GET FIRST MAP REG ADDRESS JSB .IOI. LDA .MAPS AND =B77777 GET ADDRESS OF MAPS ADA SPMSG STA TEMP SAVE IT LDA A,I GET THE MAP REG CONTENTS JSB .IOI. LDA SPMSG INA JSB .IOI. THIS IS THE NEXT MAP REG LDA TEMP INA LDA A,I THIS IS THE CONTENTS JSB .IOI. JSB .DTA. NDTWO ISZ ERCNT BUMP THE ERROR COUNTER NOP JMP TOERR,I RETURN * * FOLLOWING ARE FORMATS AND MESSAGES * SUP TOSML ASC 20, WARNING - PARTITION TOO SMALL FOR COMPL ASC 4,ETE TEST CNTRN ASC 20, *** THIS PARTITION IS TOO SMALL TO EXEC ASC 15,UTE THE ON-LINE DIAGNOSTIC TERM ASC 19, *** EMA ON-LINE DIAGNOSTIC TERMINATED GDEND ASC 24, EMA ON-LINE DIAGNOSTIC SUCCESSFUL COMPLETION BDEND ASC 21,(/," ***EMA F«J$"IRMWARE FAILED TO PASS DIAGNO ASC 12,STIC*** ",I6," ERRORS") FRMT2 ASC 21,( " NAME INCORRECT ERROR RETURN A =",K7,"B ASC 7, B =",K7,"B") FRMAP ASC 20,(" MMAP ERROR. FIRST MAP REGISTER TO MIS ASC 17,COMPARE = ",I2,", CONTENTS = ",I6) FRIOR ASC 22,(" EMIO ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRTST ASC 9,(/," TEST",I2,":") FREMP ASC 22,(" EMAP ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRNER ASC 20,( " NAME DID NOT DETECT ERROR CONDITION ASC 14, A =",K7,"B B =",K7,"B") FRIDX ASC 21,(" ID EXT. WORD ZERO WRONG. EXPECTED =",K7 ASC 12,,"B. ACTUAL =",K7,"B") NOTFW ASC 20, WARNING - EMA DIAGNOSTIC USING SOFTWARE ASC 10, INSTEAD OF FIRMWARE FRTWO ASC 12,(" EMAP MAPPING ERROR.", ASC 15,2(/" MAP REG.",I5," =",I8)) END #EMA Õt$ÿÿ ÿýŸ¸ ÿ92067-18014 2001 S C0122 &$CSY4 HEADER FOR RTE 4A O.S.             H0101 Ö¦ASMB,L * * NAME: $CSY4 * SOURCE: 92067-18014 * RELOC: 92067-16014 * PGMR: E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $CSY4,0 92067-16014 REV.2001 791102 END $ÿÿ ÿý ¦ ÿ92067-18015 1926 S 0622 RTE-IV DISPATCHER              H0106 kKþúASMB,R,Q,C ** DISP4 -- RTE-IV DISPATCHER MODULE ** HED DISP4 -- RTE-IV DISPATCHER * DATE: 2/16/77 * NAME: DISP4 * SOURCE: 92067-18015 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,L.W.A.,D.L.S.,E.J.W.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DISP4,0 92067-16014 REV.1926 790221 * ***** AMD ***** JUL,73 GAA ***** GSD ***** FEB,77 EJW * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$BRED,$ZZZZ,$XCQ ENT $ALDM,$DMAL,$SMAP,$PRCN ENT $XDM,$MAXP,$UNPE ENT $LOW,$HIGH * ENT $BG1,$BG2,$BG3,$BG4,$BG5 ENT $RT1,$RT2,$RT3,$RT4,$RT5 ENT $MM1,$MM2,$MM3,$MM4,$MM5 * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $MRMP,$MATA,$MPFT,$BGFR,$RTFR EXT $EMRP,$RSRE,$ABRT,$XSIO,$DREQ EXT $WATR,$TIME,$DREL,$TRRN,$SZIT EXT $ABRE,$LIST,$RTST,$SGAF,$ERMG EXT $MCHN,$MBGP,$MRTP,$CFR,$WORK EXT $IOCL,$IRT,$IDLE,$DVPT,$IDEX,$CMST EXT $SDA,$SDT2,$MNP,$XDMP EXT $ABRE,$LIST,$RTST,$SGAF,$SCXX * * SKP * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PO•þúARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *********** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * * ACTIVITY PART'N STATUS ID STATUS *................................................................ * PROGRAM BEING LOADED 0 2 * PROGRAM IS IN PARTITION 1 1-6 * SWAPPING OUT 2 1-6 * SEGMENT BEING LOADED 2 2 * PROGRAM IS SWAPPED OUT 3 1-6 * i­þú SUBPARTITIONS BEING SWAPPED OUT 4 1-6 * SUBPARTITIONS ALL SWAPPED OUT 5 1 * SKP * ******************************************************************** * * THE DISP MODULE OF THE REAL TIME EXECUTIVE PERFORMS: * * 1. IDLE LOOP IF NO PROGRAMS ARE SCHEDULED OR CAN'T BE EXECUTED * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * SPC 2 ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS * CPB BPOWN DOES THIS GUY OWN THE CPU ? STA BPOWN YES, BUT NOT ANY MORE. * STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES ADA D14 CHECK IF DISC RES. LDA A,I PROGRAM AND D15 STA ATMP SAVE TYPE FOR LATER CHECK CPA D1 IS IT DISC RES. PROG? RSS NO, SKIP. JSB DREL RELEASE ANY SWAP TRACKS * LDA ATMP GET PROGRAM TYPE CPA D1 IF MEM RES A <> 0 RSS CLA IF DISC RES A = 0 * LDB TMP RELEASE ANY RE-ENTRENT JSB $ABRE MEMORY PROGRAM OWNS. LDB TMP RELEASE ANY STRING STORAGE JSB $RTST MEMORY THAT THE PROGRAM OWNS. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP LDA B ADA D20 STA TEMP SAVE ADDR OF FLAG WORD LDA A,I ALF,ALF GET FLAG WORD SLA ANY RESOURCES HELD? JSB $TRRN YES, RELEASE THEM * CLA IF CURRENTLY LDB TEMP,I STA TEMP,I (CLEAR FLAG WORD) SLB IS!ßþú HE SERIALLY REUSABLE JMP $XCQ YES,LEAVE IN MEMORY * LDA ATMP GET TYPE CPA D1 IS IT MEM RES? JMP $XCQ YES,DONT FOOL WITH PARTITION * LDA TMP GET ID SEG ADR JSB MATEN GO SET UP POINTERS LDB MID,I GET PARTITION OCCUPANT WORD CPB TMP IS PROG STILL RESIDENT? RSS YES JMP $XCQ NO, DONT BOTHER WITH IT * LDA MLNK,I DID PTTN GET UNDEFINED INA,SZA,RSS BY A PARITY ERROR? JMP X0154 YES. KILL POSSIBLE I/O TRANSFER * LDA MADR,I SSA IS IT A MOTHER PTTN? JMP XN353 YES, MOVE PTTN FROM ALLOC TO FREE * LDB MFLGS SSB IS IT A REAL TIME PARTITION? JMP XN253 YES, RT. MOVE PTTN FROM ALLOC TO FREE JMP XN153 NO, BG. MOVE PTTN FROM ALLOC TO FREE SPC 2 DM8 DEC -8 D17 DEC 17 SPC 2 $MAXP NOP RE-ESTABLISH MAXIMUM PTTN LIST SIZE WORDS CLA INIT ALL MAX SIZE WORD TO ZERO STA $MCHN STA $MRTP STA $MBGP STA NUMCH INIT ALL PTTN COUNTS BY TYPE TO ZERO STA NUMBG STA NUMRT LDA $MNP CMA,INA,SZA,RSS JMP MXPDN IN CASE 0, EXIT DONE * STA CNT SAVE NEG NUMBER OF PTTN ENTRIES LDA $MATA START AT FIRST PTTN * MXPSL JSB MATAD SET UP PTRS TO MAT ENTRY LDA MLNK,I INA,SZA,RSS IS THIS ENTRY UNDEFINED? JMP MXPNX YES, CHECK NEXT PTTN * LDA MADR,I SSA IS THIS A MOTHER PTTN? JMP MXPCH YES, INCRE COUNT * LDA MFLGS SSA IS THIS A RT PTTN? JMP MXPRT YES, INCRE COUNT * LDB DMBGP SET ADDR OF BG POINTER ISZ NUMBG INCRE COUNT OF BG PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX * MXPCH LDB DMCHN SET ADDR OF MOTHER PTTN PTR ISZ NUMCH INCRE COUNT OF CH PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX Viþú * MXPRT LDB DMRTP SET ADDR OF RT POINTER ISZ NUMRT INCRE COUNT OF RT PTTNS * MXPSZ LDA MLTH,I RAL,CLE,ERA SEZ IS THIS PTTN RESERVED? JMP MXPNX YES, SKIP MAX SIZE CHECK * AND B1777 CHECK LENGTH OF THIS PTTN STA TEMP AGAINST MAX SIZE SO FAR CMA,INA ADA B,I SSA,RSS IS THIS ONE LARGER? JMP MXPNX NO, TRY NEXT PTTN * LDA TEMP YES, SET UP NEW MAX STA B,I * MXPNX LDA MLNK ADA MATSZ INCRE TO NEXT PTTN MAT ENTRY ISZ CNT DONE YET? JMP MXPSL NO, DO NEXT PTTN * MXPDN LDA NUMCH YES, DONE SZA,RSS SET THE PROPER FREE LIST PTR STA $CFR TO ZERO IF THE LIST IS EMPTY LDA NUMRT FOR THE LSTIN SUBROUTINE SZA,RSS STA $RTFR LDA NUMBG SZA,RSS STA $BGFR JSB LSTIN RE-INIT MAT LIST PTRS JMP $MAXP,I RETURN * * NUMCH NOP 0 AT BOOT UP NUMBG NOP 0 AT BOOT UP NUMRT NOP 0 AT BOOT UP DMCHN DEF $MCHN+0 DMBGP DEF $MBGP+0 DMRTP DEF $MRTP+0 * * * INITIALIZE PARTITION MEMORY ALLOCATION TABLE ENTRY LIST POINTERS * CALLED BY BOTH DISPATCHER'S STARTUP CODE AND $MAXP * LSTIN NOP LDA $RTFR IS THERE A RT LIST OR CPA NUMRT WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI1 YES, CHECK BG LIST * LDA ABGFR NO, SET UP RT TO SAME AS BG STA ARTFR LDA ABGPR STA ARTPR LDA ABGDM STA ARTDM LDA $MBGP STA $MRTP JMP LSTI2 * LSTI1 LDA $BGFR IS THERE A BG LIST OR CPA NUMBG WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI2 YES, CHECK MOTHER PTTN LIST * LDA ARTFR NO, SET BG LIST POINTERS TO RT STA ABGFR LDA ARTPR STA ABGPR LDA ARTDM STA ABGDM ƒþú LDA $MRTP STA $MBGP * LSTI2 LDA $CFR IS THERE A MOTHER PTTN LIST OR CPA NUMCH WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTIN,I YES, RETURN * LDA ABGFR NO, SET MOTHER LIST SAME AS BG STA ACHFR LDA ABGPR STA ACHPR LDA ABGDM STA ACHDM LDA $MBGP STA $MCHN JMP LSTIN,I RETURN. AT LEAST ONE LIST REQUIRED * * SKP * CALLING SEQUENCE * JMP $XCQ DIRECT ENTRY IN SYSTEM MAP * OR * JMP $XEQ ENTRY VIA TABLE AREA I IN EITHER MAP * $XCQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUE CURRENT PGM * X0005 LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME X0035 LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA,RSS ANY MORE IN SKEDD LIST? JMP ILOOP NO, GO TO IDLE LOOP * CPA SGSUP IS THIS PROG SEGMENT SUSPENDED? LDA A,I YES, SKIP TO NEXT PROG SZA IF ZERO,THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * _¿þú * ILOOP STA FENCE SET THE FENCE TO ZERO OTA 5 STA XEQT CLEAR XEQT ADDRESS VALUE LDB DIDLE RSS LDB B,I GET DIRECT ADDR RBL,CLE,SLB,ERB FOR IDLE LOOP JMP *-2 STB XSUSP SET BASE PAGE POINTERS INB TO POINT TO DUMMY STB XA LOCATIONS. STB XB STB XEO STB XI JMP $IRT GO TO IDLE LOOP (JMP *) * DIDLE DEF $IDLE+0 DIRECT ADDR TO IDLE LOOP SKP * * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS ADA D7 STA ZEMA EMA WORD (ID WORD 28) LDA A,I JSB IDXAD GET ID EXT ADDR JMP X0012 NOT EMA, CLEAR ZIDEX X0012 STA ZIDEX SAVE ADDR OF ID EXT OR 0 * * CHECK IF CURRENT PGM IS STILL TOP. * LDA XEQT SEE IF PROGRAM CURRENTLY EXECUTING SZA,RSS YES SKIP JMP X0030 NO, SO GO XECUTE IT * ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPÇþúA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH * LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP $RENT PROGRAM OF HIGHER PRIORITY * * CHECK PROGRAM TYPE * X0030 LDA ZTYPE,I PROGRAM TYPE AND D15 CPA D1 CHECK IF MEMORY RESIDENT JMP X0F40 YES, SET UP TO RUN NOW * LDB ZMPID,I SSB ASSIGNED TO A PARTITION? JMP PCHK YES, GO SEE WHAT TYPE * LDB ZIDEX SZB IS THIS AN EMA PROG? JMP X0300 YES * CPA D2 REAL TIME DISC RESIDENT? JMP X0200 YES * CPA D3 BACKGROUND DISC RESIDENT? JMP X0100 YES, TREAT AS BG * CPA D4 LARGE BACKGROUND DISC RESIDENT? JMP X0100 YES * JMP X0035 NOT LEGAL TYPE, IGNORE * PCHK LDA B ASSIGNED TO PTTN AT LOAD TIME? AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR ADA D3 LDB A,I SSB IS IT MOTHER PTTN? JMP X0300 YES * ADA D2 GET FLAG WORD LDA A,I SSA IS IT RT? JMP X0200 YES JMP X0100 NO,BACKGROUND * ATMP NOP MPN NOP INDEX TO MPFT, BP FLAG LTH NOP LSTHD NOP NPGN NOP SPRIO NOP BPOWN NOP BPOWN IS CURRENT OWNER OF BP & THUS CPU HED DISP4 -- SET UP PROGRAM ID SEG ADR IN XEQT AREA * * ******************************************************************** * * OK, WE HAVE ARRIVED AT THE POINT THAT WE KNOW WHICH * PROGRAM WE INTEND TO EXECUTE. SO LETS SET UP THE * BASE PAGE POINTERS ON BEHALF OF THE NEW XEQT PROGRAM. * * REMEMBER XEQT OWNS ALL OF BASE PAGE FOR AS LONG AS HE * EXECUTES. ON SIMPLE INTERUPTS WE DON'T NEED TO RESET * UP BASE PAGE BEC¬†þúAUSE IT IHAS ALREADY BEEN SET UP TO * BELONG TO XEQT. * ******************************************************************** * * * * * ****************************************** * * * * * INITIAL (RE)DISPATCH OF MEM RES PROG * * * * * ****************************************** * * X0F40 LDA ZWORK GET THE ID OF PROG WE WANT TO DISPATCH LDB ZMPID CPA BPOWN DOES HE ALREADY OWN CPU ? JMP XRENT YES, SO SKIP THE BASE PAGE SET UP * CLA STA XMATA STA XIDEX * LDA $EMRP LDB A GET THE MEM RES BP LIMITS. JMP RTSET NOW SET EM UP. * * * ****************************************** * * * * * INITIAL (RE)DISPATCH DISC RES PROG * * * * * ****************************************** * * X0040 LDA ZWORK GET THE ID OF PROG WE WANT TO DISPATCH LDB ZMPID CPA BPOWN DOES HE OWN THE CPU ? JMP XRENT YES, SO SKIP THE BASE PAGE SET UP. * LDA MLNK GET THE MATA LINK ADDRESS STA XMATA SET INTO BASE PAGE LDA ZIDEX SAME WITH EMA PROG FLAG STA XIDEX * LDB ZWORK ADB D21 LDA B,I GET LENGTH OF PROG AND B76K ADA DM1 STA LTH ADB DM7 LDA B,I GET TYPE ADB D8 INDEX TO LOW MAIN LDB B,I B = LOW MAIN, A = TYPE WORD * ERA,RAR NOW SET E= 0 FOR RT PROGRAM SEZ,CCE,SLA,RSS AND E= 1 FOR BG PROGRAM CLE * LDA B A = B = LOW MAIN ADA LTH A = XX777 IE HIGHEST ADDRESS OF PROGRAM SEZ,RSS THIS A RT PROGRAM ? JMP RTSET YES. * STB BGDRA NO, BG. SET UP THE BASE PAGE ¿»þú ADB DM1 B = LOW MAIN - 1 STB AVMEM JMP R.SET * RTSET STA BGDRA SET UP THE RT BP WORDS STA AVMEM R.SET STA BGLWA STB RTDRA * LDB ZWORK GET THE ID SEG ADDRESS AND ADB D21 INDEX TO MEMORY PROTECT FENCE SETTING LDA B,I RAL,ALF ALF SET UP THE VALUE FOR LATER AND D7 STA MPN MPN = INDEX INTO MEMORY PROTECT FENCE * XRENT INB LDA B,I STA XI SET AS X REGISTER SAVE AREA * LDB ZWORK !!!!!!!!!!!!!! COMMIT !!!!!!!!!!!!!!!! STB XEQT !!!!!!!!!!!!!! RTE IV !!!!!!!!!!!!!!!! * STB BPOWN BPOWN IS THE CURRENT OWNER OF BASE PAGE LDA DM12 LOAD PROGRAM TO BE EXECUTED STA TMP INTO XEQT AREA LDA XQDEF X0041 STB A,I INA INB ISZ TMP JMP X0041 * LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * SKP * ******************************************* * * * * * CONTINUE WITH XEQT * * * * * ******************************************* * * * CHECK IF POINT OF SUSPENSION IS LIBRARY AREA * * * $RENT LDA XEQT (RETURN FROM EXEC) INDEX TO TYPE ADA D14 WORD STA ZTYPE AND SAVE FOR A MOMENT LDA A,I LDB $MRMP & ADDRESS OF MEM RES MAP AND D7 KEEP ONLY TYPE BITS CPA D1 THIS A MEM RES PROG ? USB YES, SO SET UP USER MAP * LDB XEQT GET THE RENT BIT ADB D20 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 ’9þú GO SET FENCE * SLB IF MEMORY MOVED JSB $RSRE GO RESTORE IT LDA ZTYPE,I ERA,RAR CMA,SSA,SLA,RSS IS THE PROG MEM RESIDENT ? JMP X0028 NO, DISC RES CAN'T BE USING MEM RES LIB * LDA LBREG MEMORY RESIDENT AND REENTRANT LDB LB#PG CBX CLEAR WRITE-PROTECT BITS FROM LDB LBPG# RESIDENT LIBRARY PAGES XMS LDA MPN CHECK MRP'S MPFTI ARS SZA MPN > 1 ? JMP X0028 YES, USE THAT MP FENCE SETTING * LDA LBORG NO, LOWER MP FENCE FOR M.R.L. JMP X0029 FROM MRP WITH NO COMMON * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * ID SEG WORD 21 !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !RP/ #PAGES / MPFTI /**/ PARTITION # ! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * * MPFTI (MPN) = 0 DISC RESIDENT(TYPE 4), NO COMMON * 1 MEMORY RESIDENT, NO COMMON * 2 ANY PROGRAM, RT COMMON * 3 ANY PROGRAM, BG COMMON * 4 ANY PROGRAM, SSGA * 5 DISC RESIDENT(TYPE 2 & 3), NO COMMON * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM * XQDEF DEF XLINK * LBREG NOP RES. LIB. REGISTER # IN USER MAP LBPG# NOP RES. LIB. PHYSICAL PAGE # LB#PG NOP RES. LIB. SIZE IN # OF PAGES HED DISP4 -- BUFFERS, CONSTANTS, POINTERS, ETC * ZIDEX NOP ZEMA NOP ZMPID NOP * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE LDB SKEDD SCHED LIST PRIORITY ADDRESS SPC 1 TEMP ADB D6 TEMPORARY WORKING STORAGE AREA TEMP1 STB Ø_þúZPRIO TEMP2 INA TEMP3 LDB B,I TEMP4 STB A,I TEMP5 CLB TEMP6 STB ZPRIO,I ZEXIT JMP $ZZZZ,I TMP NOP TEMPORARY WORKING STORAGE TMP1 NOP TMP2 NOP CN#SC NOP CURRENT # SECTORS/TRACK (-) * DM12 DEC -12 DM3 DEC -3 * D1 DEC 1 D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 D20 DEC 20 D21 DEC 21 D22 DEC 22 D27 DEC 27 D32 DEC 32 D33 DEC 33 * C77 OCT 177700 * B7 EQU D7 B17 EQU D15 B37 OCT 37 B77 OCT 77 B100 OCT 100 B177 OCT 177 B377 OCT 377 B1777 OCT 1777 B76K OCT 76000 * HED DISP4 -- USER MAP BUILDING ROUTINES ******************************************** *ROUTINE TO SET USER MAP CALLED BY DISP4 AND RTIO4 *CALL: * (B) =ADDR MAT ENTRY * (E) = 0 REBUILD USER MAP, SAVE IN BP COPY * (E) = 1 USE CURRENT BP COPY OF USER MAP, IF ANY * JSB $SMAP * REGISTERS MEANINGLESS ******************************************** * * $SMAP NOP STB XMAT SAVE MAT ENTRY ADDR ADB D2 LDA B,I GET ID SEG ADDR STA XIDA ADA D8 LDA A,I SEZ,SZA PT SUSP=0? OR (E)=0? JMP REMAP NO, USE BP COPY OF USER MAP * INB YES, HAVE TO REBUILD USER MAP LDA B,I AND B1777 STA XSTP SAVE PTTN START PAGE # * LDB XIDA ADB D21 LDA B,I AND B76K GET BITS 10-14 ALF RAL,RAL STA XNUM SAVE # OF PROG PAGES * LDA B,I ALF,ALF RAL AND B7 GET MPFT INDEX VALUE SZA,RSS JMP NOCOM =0, DISC RES(TYPE 4), NO COMMON * LDA XIDA =2,3,4 TYPE BG/RT USING COMMON ADA D14 OR TYPE 2 OR 3 WITHOUT COMMON LDA A,I AND B7 GET ID SEG TYPE CCB SET UP FOR TYPES 2,3, OR 4 WITH COMMON ADB $SDA CLE CPA D2 IS÷#NLH IT TYPE 2? RSS YES, RT NEEDS TAII + SDA CPA D3 IS IT TYPE 3? CCE YES, SET E=1 MAP COMMON + TAII + SDA JMP SYSRG NO, LEAVE E=0 MAP ONLY COMMON * NOCOM CCB NO COMMON, TYPE 4 ADB $CMST CLE (E)=0 FOR NOT PRIVILEGED * SYSRG CBX (X)= # PAGES IN TABLES, ETC. LDA D33 (A)= START REG # 33 FOR USER MAP CLB,INB (B)= 1 XMS SEZ,RSS PRIVILEGED PROG? JMP USERG NO * LDB $SDT2 YES, SET WRITE PROTECT BIT CBX (X)= # PAGES IN SDA + $$TB2 LDB $SDA ADB WRPRT (B)= PAGE # OF SDA WITH WRITE PROTECT XMS * USERG LDB XNUM NOW MAP USER CODE PAGES CBX LDB XSTP INB XMS MAP USER PROGRAM * LDB A CMB,INB ADB B100 CBX (X)= # REGISTERS LEFT LDB RWPMP (B)= READ-WRITE PROTECT FLAGS SET XMS * CLB,INB CBX (X)= 1 REGISTER LDB XSTP (B)= 1ST PAGE OF PTTN FOR BASE PAGE ¢Nÿÿþú LDA D32 (A)= USER BASE PAGE REGISTER # XMS * LDB XMAT JSB PHYBP MAP IN USER BP TO SAVE USER MAP IOR BIT15 (A) = SIGN SET FOR SAVE MAP IN MEMORY USA JMP $SMAP,I RETURN * REMAP LDB XMAT JSB PHYBP MAP IN USER BP TO LOAD USER MAP USA RESTORE USER MAP FROM BP COPY JMP $SMAP,I RETURN * * * PHYBP MAP IN THE PHYSICAL BASE PAGE COPY OF USER MAP * CALL SEQUENCE: (B) = MAT ADDR * JSB PHYBP * (A) = ADDR OF PHYSICAL BP COPY * PHYBP NOP MAP PHYSICAL BP FOR USER PROG ADB D3 FOR SAVE & RESTORE MAP REGS LDA B,I GET PTTN'S FIRST PAGE # AND B1777 WHICH IS THE PHYSICAL BP STA B (B) = PAGE # OF BP CLA,INA CAX (X) = 1 TO SET ONE REGISTER LDA $DVPT WHERE DRIVER PTTN REG NORMALLY IS XMS MAP IN THE PHYSICAL BP LDA ADBPC GET LOGICAL ADDR FOR BP COPY JMP PHYBP,I RETURN WITH ADDR IN (A) * * ADBPC NOP LOGICAL ADDR IN DRIVER PTTN FOR USER BP COPY RDWRP OCT 140000 READ & WRITE PROTECT RWPMP OCT 141740 READ & WRITE PROTECT END OF MEMORY WRPRT OCT 040000 WRITE PROTECT ONLY XSTP NOP XIDA NOP XNUM NOP XDMST NOP D3 DEC 3 XMAT NOP DFDMR DEF DVMPR ADDR OF STORAGE FOR DRIVER MAP REG DVMPR NOP DRIVER MAP REGISTER CONTENTS * * *************EXTERNAL ROUTINE TO SET USER MAP******** ***************************************************** **********CALL: LDA IDADR (A) HAS ID SEG ADDR ********** JSB $XDMP ********** ********** (A) =0 IF ERROR-- PROGRAM NOT IN PARTITION * $XDM RBL,RBL CALLED VIA $XDMP ($$TB1) BY JMP STB XDMST SAVE DMS STATUS STA XIDA TEMP SAVE OF ID ADR LDB A ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV §þúYES,GO SET MEM RES MAP * ADB D7 GET MPID WORD LDA B,I AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR STA XMAT SAVE MAT ENTRY ADDR ADA D2 LDA A,I CPA XIDA IS PROG STILL IN PARTITION? JMP XDMOK YES ,CONTINUE * CLA NO, ERROR JMP XDMEX RETURN (A)=0 * XDMOK CCA CAX (X)=1 READ 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DFDMR (B)=ADDR OF SAVE AREA XMM SAVE REG USED FOR MAPPING USER BP CCE (E)=1 TO REUSE BP COPY OF MAP LDB XMAT (B)=MATA ENTRY ADDR JSB $SMAP GO SET MAP CLA,INA CAX (X)=1 WRITE 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DVMPR (B)=SAVED DRIVER PTTN REG VALUE XMS RESTORE REG USED FOR MAPPING USER BP XDMEX JRS XDMST $XDMP,I RETURN (A)#0 * MRPV LDA $MRMP USA SET MEM RES MAP JMP XDMEX RETURN (A)=0 * HED DISP4 -- FIND PARTITION FOR SCHEDULED PROGRAM * ***************************************** * * ROUTINE TO SEARCH FOR A PARTITION * * ***************************************** SPC 2 * FNDSG NOP LDA ZWORK SET UP PTRS TO PTTN JSB MATEN FNDAG LDA ZMPID,I FNDSH CLE,ELA GET ASSIGNED FLAG IN (E) * *AT THIS POINT THE FOLLOWING WORD ARE IN USE * CNT--PARTITION NUMBER PROG LAST IN * MID--MAT ENTRY ADDR FOR PARTITION ID SEG * EREG--RESERVED FLAG,E=1,CNT IS PTTN SPECIFIED * AT LOAD,E=0,CNT IS PTTN LAST IN * LDA MLTH,I RAL (A) HAS "C" BIT IN SIGN LDB MID,I CPB ZWORK PROG STILL IN PARTITION? JMP FDNSW YES * SEZ,CLE NO,IS ASSIGNED FLAG SET? JMP FDSWP YES, TRY TO SWAP OUT OCCUPANT * * SPC 2 * AT THIS POINT WE KNOW THAT THE PROGRAM IS NOT ASSIGNED TO * A PARTITION ½þúAND THAT THE PROGRAM IS NOT CURRENTLY IN THE * PARTITION. THAT IS, THE PROGRAM DOES NOT OWN THE PARTITION. * SINCE THE PROGRAM DOESN'T OWN THE PARTITION AN $XSIO CALL * WILL BE REQUIRED TO BRING HIM OFF THE DISC & INTO MEMORY. * THIS MEANS THAT IN ORDER TO DO ANYTHING USEFUL WITH THE * PROGRAM WE NEED AN $XSIO CALL. IF THE CALL IS NOT AVAILABLE * THEN NOTHING CAN BE DONE FOR THIS TYPE PROGRAM (BG) AND WE SHOULD * GO TO THE NEXT GUY IN THE SCHED LIST IF HE IS RT OR EMA SOMETHING * USEFUL IS POSSIBLE. SPC 2 * LDB FNDSG,I GET THE CONTENTS OF THE LDB B,I $XSIO BUSY WORD SZB CALL BUSY ? JMP X0035 YES, GO GET THE NEXT GUY IN SCHED LIST  * ISZ FNDSG NO, SO FIX RETURN & HOP TO IT !!! * * * ********************************** * * SEARCH FOR PARTITION * * ********************************** * * LDA ZMPID,I AND B76K GET #PAGES OF CODE - BP ALF (PLUS MSEG, IF ANY) RAL,RAL CMA,INA STA NPGN LDA ZEMA,I SZA,RSS EMA PROG? JMP FNDS3 NO * AND B1777 YES, EMA CMA,INA GET EMA SIZE ADA NPGN ADD TO PROG SIZE STA B LDA ZIDEX,I AND B37 GET #PAGES IN MSEG ADA B SUBTRACT FROM PROG SIZE FOR STA NPGN SIZE PTTN NEEDED EVEN THOUGH EMA * FNDS3 LDB FLIST GET POINTER TO FREE LIST HEADER * * * SEARCH FOR A FREE PARTITION * (B) = POINTER TO LIST HEADER * NPGN= NEGATIVE CURRENT LENGTH * GOES TO NOFRP IF NONE FOUND * * FREE LIST IS IN ORDER OF INCREASING SIZE * SCHFR LDA B,I GET ADR ENTRY(HAS LINK WORD) SZA,RSS END OF LIST JMP NOFRP YES,NO FREE PTTN * STA LSTHD STORE CURRENT ENTRY ADDR * CAX SET UP THE INDEX REGISTER * LAX D4,I GET LENGTH PARTITION SSA þüþú PTTN RESERVED JMP FR2 YES, CAN'T USE * RAL,CLE,ELA RAR,RAR SEZ,RSS IS IT IN CHAIN MODE? JMP FR1 NO, SEE IF LARGE ENOUGH * LAX D3,I YES, CHAIN MODE SSA,RSS BUT WAS IT MOTHER PTTN? JMP FR2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * LAX D4,I MOTHER IN CHAIN MODE, OK TO USE * FR1 AND B1777 SCREEN OUT FLAGS ADA NPGN SEE IF GRTR,EQUAL TO CURRENT PRG SSA,RSS IS S=0 PTTN BIG ENOUGH JMP FNDFR FOUND ONE * FR2 LDA LSTHD STA B JMP SCHFR * * UNLINK PTTN FROM FREE LIST * LINK PTTN INTO ALLOCATED LIST * FNDFR LAX D3,I WE SEARCHING THE MOTHER LIST ? SSA WELL ? JMP SUBCH YES, SO GO LOOK AT THE SUB PART'N AVAIL * LDA LSTHD,I GET ADR NEXT ENTRY STA B,I UNLINK CURRENT ENTRY JSB SCHND GO SET MAP ID WORD LDA ZWORK JSB MATEN GO SET UP MAT POINTERS * FNDF1 LDA ZPRIO,I GET NEW PRIORITY STA MPRIO,I PUT IN PARTITION JSB ALINK LINK INTO ALLOCATED LIST CLB SET TO CLEAR RESIDENT FLAG STB MID,I CLEAR PTTN ID WORD JMP FNDSG,I RETURN TO CALLER * * * FOUND A PARTITION AND DON'T NEED TO SWAP * PROGRAM IS STILL IN PARTITION (ALLOCATED) BUT IS DORMANT * OR PROGRAM WAS JUST SWAPPED OUT AND IS STILL IN THERE. * IF IT IS A MOTHER PARTITION, CHAIN IS STILL ACTIVE * FDNSW LDB MADR,I SSA,RSS TEST C-BIT JMP FDNS2 C=0 IT'S OK. * SSB,RSS TEST M-BIT JMP FNDS5 C=1, M=0 SUBPTTN BUSY IN CHAIN! * FDNS2 ISZ FNDSG SET UP RETURN ADDRESS JSB FND C=1 M=1 SET UP FLAGS AND USE IT LDA ZPRIO,I GET PARTITION PRIORITY CPA MPRIO,I IS IT THE SAME AS CURRENT? JMP FNDSG,I YES, CONTINUE * STA MPRIO,I NO, RELINK IN ALLOCATED LIST JSB RLNK džþú CAUSE PROG WAS DORMANT JMP FNDSG,I CONTINUE * FNDS5 LDA MRDFL,I SUBPTTN BUSY, AND D7 GET PTTN STATUS CPA D3 IS HE ALL SWAPPED OUT ?TTN RSS YES, SO RELEASE THIS PART'N & GET ANOTHER JMP X0035 NO, LETS WAIT ON THIS GUY FOR A WHILE * LDA DLIST GET DORM LIST POINTER LDB MLNK AND MAT POINTER JSB UNLNK MOVE OUT OF ADORM OR ALLOC LIST AND LDB FLIST INTO FREE LIST . STB TEMPS (SAVE & RESTORE FLIST CAUSE JSB FLINK FLINK CHANGES IT) * LDB TEMPS NOW GO TO TOP OF PART'N SCAN ROUTINE & TRY AGAIN. STB FLIST RESET FREE LIST POINTER FIRST. CLA RELEASE OWNERSHIP WORD STA MID,I JMP FNDAG NOW GO GET HIM ANOTHER PARTITION. * * * * * ***************************************** * * PROGRAM WAS ASSIGNED TO A PARTITION * * ***************************************** * FDSWP LDB MLNK,I INB,SZB,RSS PTTN UNDEFINED BY P.E.? JMP FDOOH OH-OH, YES * ISZ FNDSG FIX RETURN ADDRESS LDB MADR,I SSA,RSS TEST C-BIT JMP FDSW2 C=0 C-BIT NOT SET, IT'S OK. * SSB,RSS TEST M-BIT JMP FDSUB C=1 M=0 SUBPTTN IN CHAIN, MAYBE SWAP. * FDSW2 LDA MID,I C=1 M=1 OR C=0 OK TO TRY SWAP CLE,SZA IS PTTN EMPTY? JMP FDSW1 NO * SSB,RSS THIS A MOTHER ? JMP USEIT NOT A MOM & NOT IN CHAIN. * LDA MLTH,I IS A MOM, BUT IS CHAIN IN EFFECT ? RAL C BIT IN SIGN SSA,RSS IN CHAIN MODE ? JMP SUBAS IS A MOM BUT NOT IN CHAIN JMP FDSW1 IS A MOM IS ALSO IN CHAIN * * USEIT LDA FLIST YES, AN EMPTY PARTITION LDB MLNK UNLINK FROM FREE LIST JSB UNLNK AND USE THIS PARTITION JMP FNDF1 NOW GO LINK IT INTO ALLOCATED LIST * FDSW1 JSB FND GO SET UP AND SWAP LATER Jþú JMP FNDSG,I CONTINUE * FDOOH LDA ZMPID,I UNASSIGNED PROG SINCE RAL,CLE,ERA THE PARTITION WENT AWAY STA ZMPID,I BECAUSE OF PARITY ERROR THERE JMP FNDSH TRY TO FIND A PARTITION * * * PROGRAM IS ASSIGNED TO A SUBPARTITION, HOWEVER THAT SUB IS * IN THE CHAIN MODE. SO LETS SEE WHO OWNS THE MOTHER PARTITION * AND SEE IF THAT GUY IS SWAPABLE. * * FDSUB LDB MLNK SAVE MAT ADDR OF PTTN STB LSTHD THAT WE NEED LDB MSUBL,I GIVEN SUBPTTN WITH "C" SET FDSMO LDA D3 FIND THE MOTHER PTTN ADA B LDA A,I SSA IS THIS THE MOTHER PTTN? JMP FDSMD YES, SEE IF MOTHER IS DORMANT * ADB D6 NO, TRY NEXT LINK LDB B,I JMP FDSMO * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION BUT THE MOTHER PARTITION * IS STILL OCCUPIED. SEE IF WE CAN STILL QUALIFY TO FORCE A SWAP * OUT FROM THE MOTHER PARTITION. THE USER SHOULD NOT ASSIGN PROGRAMS * TO A SUBPARTITION IF THAT PROGRAM IS CONTINUOUSLY COMING IN AND * OUT OF THE SCHEDULE LIST. EMA PROGRAM PERFORMANCE WILL BE SEVERELY * DEGRADED. * * FNDSM IS ENTERED WHEN A PROGRAM IS NOT ASSIGNED TO ANY PARTITION * AND NO PARTITION OF THE PROPER TYPE WAS FOUND BUT A SUITABLE * SUBPARTITION WAS FOUND IN A DORMANT MOTHER PROGRAM. * FDSMD STB MOTHR SAVE SUBPTTN'S MOTHER ADDR ADB D5 LDA B,I AND D6 CPA D4 CLEARING OR CLEARED SUBPTTNS? JMP X0035 YES, SKIP IT FOR NOW * FNDSM LDA MOTHR YES, SET MAT ADDRS OF MOTHER PTTN JSB MATAD CCE (E) = 1 FOR SPECIAL SWAP CHECK LDB MID,I (B) = ID FOR SWPCK JSB SWPCK JMP SMABT ABORT - ONLY IF ASSIGNED TO SUBPTTN JMP SWMOM SWAP IS OK, PROG SAVE RES. OR SUSPENDED JMP SMLOD LOAD - PROG TERM. SERIAL REUSE. JMP X0035 CAN'T SWAP, TRY NEXT SCHED PROG * SMLOD CLA LOAD - PROG TERM. SERIAL REUSE. STA MID,I CLEAÉêþúR MOTHER OCCUPANT, BEFORE USE SUBPTTN LDA FLIST SAVE CURR FREE LIST HEADER STA TEMPS CAUSE UNMOM+FLINK MESSES IT UP LDB MLNK GET MOTHER MAT ADDR JSB UNMOM RELEASE SUBPTTNS LDA TEMPS RESTORE FREE LIST HEADER STA FLIST LDB LSTHD GET MAT ADDR OF SUBPTTN WE NEED JSB UNLNK UNLINK FROM FREE LIST LDA LSTHD JSB MATAD SET UP MAT ADDR JMP FNDF1 SET INTO ALLOC LIST, RETURN * SWMOM LDA CHSWP MOTHER PTTN I/O CALL BUSY? SZA JMP X0035 YES, TRY SCHED NEXT PROG JMP X0325 NO, DO SWAP OUT OF MOTHER PTTN * SMABT LDA ZIDEX CAN WE ABORT MOM FOR LOAD IN SUBPTTN? SZA IS THIS EMA PROG? JMP XM352 YES, ABORT LOAD IN MOM CAUSE CHSWP WILL BE FREE * LDB BGSWP LDA MFLGS SSA IS THIS PROG FOR BG TYPE PTTN? LDB RTSWP NO, RT PTTN HAS TO BE USED FOR LOAD SZB IF WE DO ABORT, CAN WE LOAD? JMP X0035 NO, WAIT TILL I/O CALL IF FREE. JMP XM352 YES, ABORT MOM LOAD, WE CAN LOAD. TEMPS NOP SKP * * REACHED END OF FREE LIST AND COULD NOT FIND A PARTITION. * SO NOW WHAT WE WANT TO DO IS SEE IF THIS PROGRAM HAS IN THE * PAST FORCED A SWAP. IF WE HAVE GONE THROUGH FNDSG BEFORE * ON BEHALF OF THIS PROGRAM AND FORCED A SWAP, THEN THAT PART'N * NUMBER WILL BE IN THE PROGRAMS ID SEGMENT. LETS LOOK AND * AND SEE IF THAT PROGRAM IS SWAPPED OUT. IF SO WE WILL USE THAT * PARTITION. THIS SAVES US NEEDLESS SWAP OUTS ON BEHALF OF * A SINGLE PROGRAM. ALSO WE WON'T RETURN A PARTITION BEING * SWAPPED BECAUSE DURING THE SWAP THE $XSIO CALL WILL BE BUSY * AND WE DON'T EVEN GET HERE. * NOTE THAT EVEN IF THIS PROGRAM DIDN'T FORCE THE SWAP, WE CAN * CUT DOWN ON SEARCH TIME. * ONE WORD OF CAUTION. FRESHLY LOADED PROGRAMS HAVE A ZERO * (1ST PARTITION) IN THEIR ID SEGMENT. WE CAN'T TRUST * è¦þúPARTITION ZERO TO BE THE CORRECT TYPE OF PARTITION. * * NOFRP LDA ZPRIO,I COME HERE IF NO FREE PTTN CMA,INA STA SPRIO SEARCH ALLOC LIST FOR PTTN LDA MRDFL,I GET THE PART'N STATUS WORD AND B7 KEEP ONLY STATUS BITS CPA D3 THE RESIDENT PROG SWAPPED OUT ? CLA,RSS YES ! JMP MMSWP NO, SEE IF WE CAN STEAL IT. * CPA CNT THIS PARTITION = ZERO ? JSB PTNOK YES, SO GO SEE IF PART'N IS A LEGAL ONE. SZA IS ALL OK ? JMP SRCNT NO. GO SEARCH ALLOC LIST. * LDA MADR,I MOTHER BIT IN SIGN OF A-REG LDB MLTH,I GET CHAIN BIT IN E-REG ELB,ELB * SEZ,SSA M=1,C=1/ IE MOTHER & IN CHAIN MODE. JMP FNDSG,I REUSE THE PARTITION. * SEZ,SSA,RSS M=0,C=0 /IE NOT A MOM & NOT IN CHAIN JMP FNDSG,I REUSE THIS PARTITION JMP SRCNT M=1 & C=0 / OR M=0 & C=1 (CAN'T USE PART'N) * * * * OK, SO SOMEBODY ELSE OWNS THE PARTITION. IF ITS A MOTHER PARTITION * AND THIS THE RESIDENT IS HAVING SUBPARTITIONS CLEARED, THEN IT'S * POSSIBLE TO STEAL THIS PARTITION FROM THE OLD OWNER. LETS SEE. * MMSWP CPA D4 PARTITIONS BEING CLEARED ? CLA,RSS YES CPA D5 PARTITIONS ALL CLEARED CLA,RSS YES JMP SRCNT NO, JUST FORGET THE WHOLE THING. * CPA CNT PART'N # = ZERO JSB PTNOK YES, SEE IF THE PARTITION IS RIGHT TYPE SZA ALL OK ? JMP SRCNT NO. SO GO SEARCH ALLOC LIST. * LDA MPRIO,I GET THE RESIDENTS PRIORITY CMA,INA ADA ZPRIO SEE HOW THIS COMPARES TO THE CONTENDERS PRIORITY SSA,RSS WHO WINS ? JMP SRCNT THE RESIDENT. * LDA ZPRIO THE CONTENDER STA MPRIO,I SET NEW PRIORITY IN MAT TABLE LDA ZWORK AND NEW OWNER TOO * STA MID,I ******* COMMIT PARTITION ******** * JSB RLNK RELINK IN ALLOCATED LIST SINCE T,tþúHE PRIORITY IS JMP FNDSG,I DIFFERENT. NOW RETURN SKP * * * THE PTNOK ROUTINE LOOKS AT A PARTITION AND DETERMINES IF * IT IS THE TYPE OF PARTITION WE ARE LOOKING FOR. IT IS * USED BY THE FNGDG ROUTINE TO DETERMINE IF IT IS OK TO * LOAD THE CURRENT ZWORK PROGRAM INTO THIS PARTITION. IN THE * FUTURE THE ROUTINE COULD BE USED TO LOOK AT THE ZWORK * PROGRAMS FATHER AND IF THE SCHEDULE WAS WITH WAIT FORCE A * SWAP OF THE FATHER PROVIDING THE PARTITION THE FATHER * WAS IN IS THE SAME TYPE AS THE SON COULD USE. THIS FEATURE * PREVENT HIGH PRIORITY PROGRAMS FROM HOGGING PARTITIONS * WHEN THEY DON'T NEED THEM. THE ROUTINE SHOULD BE USED * AFTER SCANNING THE FREE LIST AND NOT FINDING AND EMPTY * PARTITION. * * * CALLING SEQUENCE JSB PTNOK * ALL MAT POINTERS (IE MLNK ETC) SET UP * * * * ON RETURN: A REG = 0 ALLS WELL USE THE PARTITION * A REG = -1 PARTITION OF WRONG TYPE OR * PROGRAM TO BIG FOR PARTITION. * * * PTNOK NOP LDB ACHPR FIRST SEE WHAT TYPE PARTITION LDA MADR,I WE ARE SET UP FOR SSA MOTHER ? JMP MOMIT YES. * LDB ABGPR NO. LDA MRDFL,I SSA BG PARTITION ? LDB ARTPR NO, A RT PARTITION. * MOMIT CPB ALIST IS THIS THE TYPE OF PART'N FNDSG CALLED FOR? RSS YES JMP NOPTN NO, MAKE THE NO GO RETURN. * LDA MLTH,I RIGHT TYPE OF PARTITION BUT IS SSA THE PART'N RESERVED ? JMP NOPTN YES, SO WE CAN'T USE IT. * AND B1777 NO, SO GET THE SIZE OF THE PARTITION. ADA NPGN AND CHECK AGAINST THE SIZE OF THE PROG SSA,RSS DOES IT FIT CLA,RSS YES, MAKE THE OK RETURN. NOPTN CCA NO, MAKE THE NO GO RETURN. JMP PTNOK,I RETURN TO CALLER. * SKP * * SRCNT LDB DLIST,I LESS OR EQÒÇþúUAL PRIORITY * * SEARCH FOR SUITABLE ALLOCATED PARTITION. * ALLOCATED LIST IS IN ORDER * OF INCREASING PRIORITIES(I.E. DECREASING * NUMBERS)--EXCEPTION:DORMANT PROGS WITH * SAVED RESOURCES AT FRONT OF LIST * (OF,SS,COMPLET)*********** * NPGN--NEG LENGTH CURRENT * SPRIO--NEG PRIO CURRENT * GOES TO X0035 IF NO PTTN * * SCHAL CPB ALIST END OF DORM LIST? LDB B,I YES, BUMP TO ALLOC LIST CCE,SZB,RSS LIST EMPTY? JMP SCHMO YES, SEARCH DORMANT MOTHER PTTNS * STB LSTHD STORE CURRENT LIST HEAD CBX SET THE INDEX REGISTER * LAX D4,I SSA PARTITION RESERVED JMP SCHL2 YES, CAN'T USE IT * RAL,CLE,ELA RAR,RAR SEZ,RSS IS PTTN IN CHAIN MODE? JMP SCHL4 NO, TEST SIZE * LBX D3,I SSB,RSS MOTHER IN CHAIN MODE? JMP SCHL2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * SCHL4 AND B1777 GET PARTITION LENGTH ADA NPGN SSA,RSS IF S=0, PTTN IF .GE. IN LENGTH JMP SCHL3 LONG ENOUGH * SCHL2 LDB LSTHD,I CCE,SZB,RSS END OF LIST JMP SCHMO NO PTTNS, TRY DORMANT MOTHER PTTNS JMP SCHAL GO TRY NEXT ONE * * * SCHL3 LBX D2,I GET PART ID ADDR SZB,RSS ANYBODY STILL THERE? JMP FNDAL NO, SO USE IT * ADB D14 LDA B,I AND B100 SZA IS CORE LOCK BIT SET? JMP SCHL2 YES, KEEP LOOKING * LAX D1,I NO GET PARTITION PRIORITY ADA SPRIO SUBTRACT CURRENT PRIORITY CMA,SSA,INA,SZA JMP FNDAL CURRENT IS .GT., GO DO IT * INB CURRENT IS .LE. PTTN PRIORITY LDA B,I GET STATUS AND D15 CPA D1 IS PTTN SCHEDULED? JMP SCHL2 YES, GO TRY SOMEONE ELSE * FNDAL JSB SCHND GO SET MAP ID WORD JSB FND GO SET UP RES FLAGS AND MAT JMP FNDSG,I * * * ï0þú NO RT OR BG ALLOC PTTNS CAN BE FOUND FOR PROGRAM * SO SEARCH THROUGH THE DORMANT MOTHER PARTITION LIST * TO SEE IF ANY SUBPARTITIONS CAN BE RELEASED WHICH * CAN BE USED FOR THIS PROGRAM * SCHMO LDA ACHDM (B=0 & E=1) SEARCH DORM MOM LIST CPA DLIST ALREADY LOOKED BECAUSE EMA? JMP NOMOR YES, NOTHING CAN BE DONE * STA MOTHR LDA FLIST WERE WE SCANNING FOR CPA ARTFR A RT PTTN? ERB YES SET TEMP = 100000 FOR RT PART'N STB TEMP NO SET TEMP = 000000 FOR BG PART'N * SCHMN LDB MOTHR,I GET NEXT ENTRY SZB ACCIDENTLY END OF LIST? CPB ACHPR OR END OF DORMANT LIST? JMP NOMOR YES, CAN'T USE BUSY MOTHER PTTNS * STB MOTHR ADB D4 LDA B,I SSA IS MOTHER PTTN RESERVED? JMP SCHMN YES, TRY NEXT DORMANT MOTHER PTTN * LDA ABGFR GET THE BG FREE LIST HEAD CPA ARTFR IF SAME AS RT, THEN SKIP TYPE CHECK, ONLY ONE LIST. JMP SCHSB * INB LDA B,I AND BIT15 JUST KEEP RT BIT CPA TEMP PTTN TYPE MATCH WHAT WE NEED? JMP SCHSB YES, TRY SUBPTTN SIZE CHECK JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * SCHSB LDA MOTHR JSB MATAD LDA MID,I GET ID OF MOTHER PTTN OCCUPANT ADA D14 LDA A,I AND B100 SZA IS CORE LOCK SET? JMP SCHMN YES, TRY NEXT MOTHER PTTN * SCHSN LDA MSUBL,I GET NEXT SUBPTTN PTR SCHNX CPA MOTHR ANY MORE SUBPTTNS? JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * JSB MATAD SET UP MAT PTRS LDA MLTH,I SSA SUBPTTN RESERVED? JMP SCHSN YES, SKIP TO NEXT SUBPTTN * AND B1777 GET SUBPTTN LENGTH ADA NPGN ADD NEG LENGTH NEEDED SSA IS SUBPTTN LONG ENOUGH? JMP SCHSN NO, TRY NEXT SUBPTTN * LDB MLNK YES, SAVE MAT ADDR OF SUBPTTN ê%þú STB LSTHD FOR FNDSM JSB SCHND SET UP ID SEG FOR SUBPTTN JMP FNDSM MOVE SUBPTTN FROM FREE LIST INTO ALLOC LIST * SPC 1 * SO NOW WE KNOW THAT THERE IS NO PARTITION THAT THE PROGRAM * CAN USE. THAT IS, THE PARTITIONS HE COULD USE ARE LOCKED * UP OR THERE HAS BEEN A PARITY ERROR IN WHAT WAS FORMERLY * THE LARGEST PARTITION OF THAT TYPE (IE BG, RT, OR MOM). * NOW IF THERE HAS BEEN A PARITY ERROR, THEN IF THIS PROGRAM * IS TOO LARGE FOR THE SYSTEM WE SHOULD ABORT IT. IF THERE * HAS NOT BEEN A PARITY ERROR, THEN JUST GO GET THE NEXT * GUY IN THE SCHED LIST. SPC 1 * NOMOR LDA $UNPE HAS THERE EVER BEEN A SZA,RSS PARITY ERROR ? JMP X0035 NO, SO GET THE NEXT GUY IN THE SCHED LIST * LDA ZWORK YES, I WONDER IF THIS GUY STILL FITS STA $WORK SET UP TO CALL $SZIT & FIND OUT JSB $SZIT GO SEE IT HE STILL FITS SZA,RSS DOES HE STILL FIT ? JMP X0035 YES, GO GET NEXT GUY IN SCHED LIST * LDA ZWORK NO, FLUSH HIM !!! STA XEQT MAKE HIM THE CURRENTLY EXECUTING PROG LDA DP GET THE ERROR CODE LDB BLANK JSB $ERMG ABORT THE MOTHER JMP $XCQ FINISH UP THE ABORTION. * DP ASC 1,DP BLANK ASC 1, * * SUBROUTINE TO SET UP PROGRAM ID SEG TO USE A PARTITION * WHICH WAS FOUND IN A SEARCH OF A LIST. * CALL: * (LSTHD) = ADDR OF PARTITION WHICH WAS FOUND * (ZMPID) = ADDR OF PTTN WORD IN ID SEG * JSB SCHND * * SCHND NOP LDA $MATA GET ADR OF MAT CMA,INA ADA LSTHD CLB DIV MATSZ CALCULATE PTTN # LDB A LDA ZMPID,I GET MAP ID WORD AND C77 IOR B STA ZMPID,I PUT NEW PTTN # IN JMP SCHND,I * * ************************************** * FOUND A PARTITION, SET UP MAT POINTERS AND BP POINTERS * CALL: WORK = ID SEG ADDR OF PROG * JSB FND * ±"NLH ************************************** * FND NOP LDA ZWORK JSB MATEN GO SET UP MAT POINTERS JMP FND,I NOW RETURN. * DM1 DEC -1 MOM NOP TEMPORARY STORE OF MOTHER MATA ENTRY MOTHR NOP MOTHER MATA ENTRY ADDR OF CURRENT SUBPTTN MOMFL NOP SUBFL NOP SUBFR NOP SUBDM NOP * * * ******************************************** * * FOUND A FREE MOTHER OR WE HAVE * * * A PROGRAM THAT WAS ASSIGNED TO * * * A SUBPARTITION AND THAT MOTHER * * * PARTITION WAS EMPTY NOW GO SEE * * * IF SUBS ARE OVERLAYABLE OR * * * SWAPABLE * * ******************************************** * * SUBCH JSB SCHND SET PART'N # INTO ID SEG LDA ZWORK SET UP THE MATA POINTERS JSB MATEN * LDA MLTH,I RAL SSA IS "C" SET ALREADY? JMP FNDSG,I YES, USE THIS PTTN YƒNÿÿþú* SUBAS LDA MOMFL THIS SECTION OF CODE IN USE ? SZA WELL ? JMP X0035 YES, CAN'T DO THIS, TRY ANOTHER PROGRAM. * LDA MFLGS SSA,RSS SET UP PROPER LIST HEADERS JMP BGSUB * LDA ARTFR RT MOTHER PTTN STA SUBFR LDA ARTDM STA SUBDM JMP SUBC2 * BGSUB LDA ABGFR BG MOTHER PTTN STA SUBFR LDA ABGDM STA SUBDM * * SUBC2 LDB MLNK STB MOMFL SET UP SUBPTTN SWAPOUT FLAGS STB SUBFL WITH THE MOTHER PTTN ADDR * SUBN1 LDA MSUBL,I CHECK NEXT SUBPTTN CPA MOMFL DONE YET? JMP SUBRS YES, SET "C" START SWAPS * JSB MATAD SET UP MAT PTRS LDB MID,I CCE,SZB,RSS IS SUBPTTN EMPTY? JMP SUBN1 YES, SKIP SWAP CHECK * * FIRST SCAN THROUGH SUBPTTNS FOR SWAPPABILITY * JSB SWPCK (E)=1 FOR SUBPTTN SWAP CHECK NOP STOP LOAD NOP SWAP OUT JMP SUBN1 LOAD OK, TEST NEXT SUBPTTN CLA CAN'T SWAP, SUBPTTN NOT AVAILABLE STA MOMFL CLEAR THE CHECK IN PROGRESS FLAGS STA SUBFL LDA ZMPID,I GET THE PARTITION WORD SSA,RSS THIS PROG ASSIGNED ? JMP FR2 NO, SO GO LOOK FOR ANOTHER PART'N JMP X0035 YES, SO FORGET IT * * SUBRS LDA MOMFL ALL SUBPTTNS SWAPPABLE SUBR1 JSB MATAD SO SET "C" FLAG ON ALL * LDA MLTH,I IOR B40K STA MLTH,I LDA MSUBL,I CPA MOMFL DONE YET? JMP SUBS0 YES, INITIATE SWAPOUTS JMP SUBR1 NO, KEEP GOING * * SUBS0 LDA MOMFL SEE IF MOTHER PTTN JSB MATAD HAS ANY SUBPTTNS * LDA FLIST *** UNLINK FROM FREE LIST *** LDB MLNK JSB UNLNK * LDA ZPRIO,I GET THE PRIORITY STA MPRIO,I INTO THE PARTITION JSB ALINK *** MOVE INTO ALLOC LIST * LDA ZWORK ***** COMMIT THE PARTITION ***** STA MID,I wþú***** COMMIT THE PARTITION ***** * LDA MSUBL,I CPA MOMFL ANY SUBPTTNS? JMP SUBDN NO, SO DONE SET PTTN STATUS=5 * LDA MFLGS SET MOTHER PTTN STATUS=4 IOR D4 FOR SUBPTTNS SWAPPING OUT STA MRDFL,I * SUBNX LDA SUBFL GET NEXT SUBPTTN ADA D6 LDA A,I CPA MOMFL ARE WE DONE YET? JMP SUBDN YES, DONE. STA SUBFL SET NEW SUBPTTN ADDR * * * TRY TO SWAP SUBPARTITION. GET HERE FROM I/O CALL COMPLETE CODE SUBSS LDA CHSWP CHECK IN CASE WE CAME FROM RT OR BG CODE SZA IS MOTHER PTTN/EMA CALL BUSY? JMP X0005 YES, SKIP IT FOR A WHILE * SUBS2 LDA SUBFL SET UP MAT PTRS TO SUBPTTN JSB MATAD LDB MID,I CCE,SZB,RSS IS IT EMPTY? (E=1) FOR SWPCK JMP SUBNX YES, DO NEXT SUBPTTN * * SECOND SCAN THROUGH SUBPTTNS AND ACTUAL DO SWAPS * SUBSC JSB SWPCK (E=1) FOR SUBPTTN SWAP CHECK JMP SUBAB ABORT CURRENT LOAD JMP X0325 SWAP CURRENT OCCUPANT OUT JMP SUBNX LOAD OK, CHECK NEXT SUBPTTN LDB MOMFL CAN'T SWAP, SUBPTTN NOT AVAILABLE SUBNL ADB D4 LDA B,I AND C40K CLEAR "C" BIT STA B,I PUT IT BACK ADB D2 LDB B,I GET NEXT SUBPTTN CPB MOMFL DONE YET? JMP SUBDE YES, DEALLOCATE MOTHER PTTN JMP SUBNL NO, CLEAR CHAIN BIT * SUBDE LDA MOMFL UNLINK MOTHER PTTN FROM JSB MATAD ALLOCATED LIST SINCE WE LDA MFLGS STA MRDFL,I SET PTTN STATUS = 0 LDA ACHDM FOUND AN UNSWAPPABLE SUBPTTN LDB MOMFL JSB UNLNK LDA ACHFR STA FLIST LINK IT INTO THE FREE LIST JSB FLINK CLA CLEAR SUBPTTN CLEARING FLAGS STA MID,I UNCOMMIT THE PARTITION STA MOMFL STA SUBFL JMP X0005 GO TO TOP OF SCHED LIST * * SUBAB LDB MID,I ABORT LOAD IN SUBPTTN JSB $LIST RESCHED™£þúULE PROG BEING ABORTED OCT 401 LDA SUBDM TO EXECUTE LATER LDB MLNK UNLINK IT FROM ALLOCATED LIST JSB UNLNK LDA SUBFR AND LINK IT INTO THE FREE LIST STA FLIST JSB FLINK JMP X0154 GO CANCEL LOAD (EXITS VIA $IOCL) * * SUBDN LDA MOMFL SET UP MOTHER PTTN PTRS JSB MATAD SUBDX LDA MSUBL,I NOW UNLINK ALL SUBPTTNS FROM LISTS CPA MOMFL DONE YET? JMP SUBCL YES, SUBPTTNS ALL CLEARED * JSB MATAD SET UP SUBPTTN PTRS LDA SUBFR GET FREE LIST HEADER LDB MID,I SZB IS SUBPTTN EMPTY? LDA SUBDM NO, UNLINK FROM ALLOC LIST LDB MLNK JSB UNLNK UNLINK ENTRY FROM LIST CLA STA MID,I CLEAR OUT OCCUPANT WORD LDA MFLGS STA MRDFL,I CLEAR STATUS FIELD TOO LDA MADR,I ALSO CLEAR THE DORM BIT IOR B20K XOR B20K STA MADR,I JMP SUBDX GO DO NEXT SUBPTTN * SUBCL LDA MOMFL JSB MATAD SET UP PTRS TO MOTHER PTTN LDA MFLGS SUBPTTNS ALL CLEARED NOW IOR D5 SET UP MOTHER PTTN STATUS = 5 STA MRDFL,I CLA CLEAR OUT SUBPTTN STA MOMFL SWAPOUT FLAGS STA SUBFL JMP X0005 HAVE TO GO TO TOP OF SCHED LIST * * * * UNLINK SUBPARTITIONS FROM MOTHER PARTITION AND * RETURN SUBPARTITIONS TO THE BG OR RT FREE LIST * CALL: * MAT ADDRESSES SET UP BY MATAD (MLNK, ETC.) * (B) = MOTHER'S MAT ADDR * JSB UNMOM CALL * (A) = MOTHER'S MAT ADDR * UNMOM NOP CPB MOMFL IS MOTHER TRYING TO CLEAN HOUSE? JMP X0035 YES, LEAVE HER ALONE. * STB MOM SAVE MOTHER MAT ADDR TEMP LDA ACHDM UNLINK MOTHER PTTN FROM ALLOC LIST JSB UNLNK UNLINK FROM ALLOCATED LIST LDA ACHFR STA FLIST LINK PTTN INTO FREE LIST JSB FLINK LDA MLTH,I CLEAR "C" BIT TOO AND C40K Ì‚þú STA MLTH,I LDA MRDFL,I GET PTTN STATUS AND D7 IF MOTHER PTTN STILL IN PROCESS CPA D4 OF CLEANING OUT SUBPTTNS JMP UNMOM,I FORGET RELINKING SUBPTTNS * UNMOL LDA MSUBL,I ANY SUBPARTITIONS? CPA MOM END OF LIST? JMP UNMOM,I YES. RETURN * JSB MATAD SET UP PTRS TO CURRENT MAT LDB ABGFR LDA MFLGS SSA RT PTTN? LDB ARTFR YES, CHANGE TO RT FREE LIST STB FLIST SET PROPER FREE LIST PTR JSB FLINK TO LINK SUBPTTN INTO LDA MLTH,I CLEAR "C" BIT TOO AND C40K STA MLTH,I JMP UNMOL LINK NEXT SUBPTTN SOMEWHERE * C40K OCT 137777 ULFRE NOP HED DISP4 -- MEMORY ALLOCATION TABLE LIST LINKAGE ROUTINES * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ödþú ! ! ! ! ! * MLTH 4 ! R! C *********** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * * PARTITION STATUS = * 0 PROGRAM BEING LOADED * 1 PROGRAM IS IN PARTITION * 2 SWAPPING OUT OR SEGMENT BEING LOADED * 3 PROGRAM IS SWAPPED OUT * 4 SUBPARTITIONS ARE BEING SWAPPED OUT * 5 SUBPARTITIONS ALL SWAPPED OUT * ************************************** * SET UP POINTERS TO ENTRY IN MAT * CALL: (A) = ID SEG ADDR OF PROG * JSB MATEN * ************************************** * MATEN NOP ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PARTITION # STA CNT MPY MATSZ MULTIPLY BY MAT ENTRY LENGTH ADA $MATA JSB MATAD JMP MATEN,I RETURN * * * SET UP THE MAT POINTERS FROM THE MAT ADDR * MATAD NOP STA MLNK SET MAT ENTRY POINTER INA STA MPRIO ID SET PRIORTY INA STA MID ID SEG ADR INA STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LõîþúINK WORD LDA MRDFL,I AND C7 STA MFLGS FLAGS IN PTTN STATUS WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MPRIO NOP PRIORITY RESIDENT MID NOP ID SET ADR MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP CNT NOP PARTITION # MFLGS NOP UPPER BITS * * * CALCULATE ID SEGMENT EXTENSION ADDRESS * CALL: * (A) = ID SEG WORD 29 * JSB IDXAD * * * IDXAD NOP SZA,RSS ANY EMA? JMP IDXAD,I NO, RETURN P+1 * ALF YES, GET ID EXT# RAL,RAL AND B77 ADA $IDEX INDEX THRU KEYWORD TABLE LDA A,I GET THE ID EXT ADDR ISZ IDXAD JMP IDXAD,I RETURN AT P+2 SKP * ****************************************** *RELINK PART BY NEW PRIORITY ***************************************** * RLNK NOP RELINK BY NEW PRIORITY LDA MADR,I AND DMFLG SEE IF IN DORMANT PTTN ALLOC LIST SZA,RSS JMP RLN1 NO * XOR MADR,I YES STA MADR,I CLEAR FLAG LDA DLIST RLN2 LDB MLNK GET ADR CURRENT ENTRY JSB UNLNK GO UNLINK JSB ALINK GO RELINK IN ALLOC BY NEW PRIO JMP RLNK,I * RLN1 LDA ALIST GO UNLINK ALLOC LIST JMP RLN2 * * ******UNLINK ROUTINE******************** ****CALL: (A) = POINTER TO LIST HEAD * (B) = ADDR MAT ENTRY LOOKING FOR * JSB UNLNK * AFTER UNLINKING ***************************************** * UNLNK NOP UNLN1 SZA,RSS SHOULD NEVER GET CAUGHT HERE! BUT IF WE DO... HLT06 HLT 6 AT LEAST WE HAVE A CHANCE TO FIND IT STA ULST RIGHT, JIM? LDA ULST,I GET ADR CURRENT ENTRY CPB A SAME AS ONE SEARCHING FOR RSS YEÈKþúS,GO UNLINK JMP UNLN1 GO TRY NEXT ENTRY LDB B,I GET THIS ENTRY'S LINK STB ULST,I STORE IN PREVIOUS ENTRY LINK JMP UNLNK,I * ULST NOP * * ****LINK INTO FREE LIST******* * CALL: MLNK IS THE PTTN ENTRY TO BE ENTERED IN FREE LIST * FLIST IS SET TO THE PROPER FREE LIST (SMALLEST PTTN FIRST) * JSB FLINK * PTTN IS LINKED BY SIZE (SMALLEST PTTN FIRST) ****************************** * FLINK NOP LDA MADR,I IOR DMFLG XOR DMFLG CLEAR DORMANT FLAG STA MADR,I LDA MLTH,I GET CURRENT LENGTH AND B1777 SCREEN OUT FLAGS LDB A CMB,INB FLN1 LDA FLIST,I GET FIRST ENTRY IN LIST SZA,RSS JMP FLN2 * ADA D4 BUMP TO LENGTH WORD LDA A,I AND B1777 SCREEN OUT FLAGS ADA B SSA,RSS S=1 NEXT PARTITION SMALLER JMP FLN2 S=0, GO LINK * LDA FLIST,I STA FLIST GO CHECK NEXT ENTRY IN LIST JMP FLN1 * FLN2 LDA FLIST,I GET PREVIOUS POINTER STA MLNK,I PUT IN THIS ENTRY LINK WORD LDA MLNK GET ADR THIS ENTRY STA FLIST,I PUT IN LINK WORD PREVIOUS ENTRY JMP FLINK,I * *******LINK IN ALLOCATED LIST********** * ALINK NOP LDA MLNK SET PTTN LINK ADR STA XLNK LDA MLTH SET PTTN LENGTH ADR STA XLTH LDB MPRIO,I GET CURRENT PRIORITY CLA STA XEND SET END LIST LDA ALIST STA XLST SET UP LINK LIST JSB XXLNK GO LINK JMP ALINK,I * XLTH NOP XLNK NOP XEND NOP XLST NOP C7 EQU DM8 SKP * * ****SETUP FOR DORMANT LINK******* ******CALL: (A) = ID SEG ADDR * JSB DSET * WITH ULST-ALLOC LIST * XLST-DORM LIST ******************************** * DSET NOP STA XLTH SAVE IN TEMP CELL ADA D14 LDA A,I GET TYPE WORD = þú AND D15 CPA D1 JMP DSET,I MEM RES,DONT LINK * LDA XLTH ADA D21 LDA A,I GET MAPID WORK AND B77 GET PTTN # MPY MATSZ CALCULATE ADR ADA $MATA STA XLNK STORE ADR JPARTITIONS LIND ADA D2 LDB A,I GET PTTN RES CPB XLTH SAME AS THE PROGRAM RSS YES JMP DSET,I NO, DON'T LINK * INA INCRE TO WORD 3 LDB A,I SSB IS THIS A MOTHER PTTN? JMP DLMOM YES, SET UP FOR LINKING MOTHER * INA SET UP TO PUT TOP ALLOC STA XLTH SAVE ADDR OF PTTN LENGTH WORD INA LDA A,I GET FLAG WORD SSA IS THIS A BG PTTN? JMP DLRT NO, IT IS RT * LDA ABGDM ADD TO BG DORMANT LIST STA XLST LDA ABGPR GET BG ALLOC LIST ADDR DLN1 STA ULST SET UNLINK HEADER STA XEND SET END LIST ISZ DSET JMP DSET,I * DLRT LDA ARTDM STA XLST SET RT DORM LIST ADDR LDA ARTPR GET RT ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DLMOM LDA ACHDM STA XLST SET MOTHER DORMANT LIST ADDR LDA ACHPR GET MOTHER ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DMFLG OCT 20000 BIT 13 OF MAT WORK 3 INDICATED DMLIST *** * *********LINK DORMANT PROGAM IN ALLC LIST**** * * DLINK NOP JSB DSET GO SETUP JMP DLINK,I NO LINK RETURN,NOT STILL IN PART * LDB XLNK ADB D3 LDA B,I GET WORK 3 MAT ENTRY AND DMFLG SZA IS IT ALREADY IN DORMANT LIST JMP DLINK,I YES, DON'T LINK AGAIN * LDA DMFLG NO IOR B,I SO SET FLAG AND LINK STA B,I LDB XLNK LDA ULST JSB UNLNK GO UNLINK ALLOCATED LIST LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK ‰wþúJMP DLINK,I SKP ****PERFORM LINK INTO ALLOCATED LIST**** ******ROUTINE WILL INSERT IN ALLOCATED * LIST IN ORDER OF INCREASING * PRIORITY(DECREASING NUMBER). PTTN * OF SAME PRIORITY WILL BE IN ORDER * OF INCREASING LENGTH.*************** *CALL:XLNK ADDR OF CURRENT MAT LINK WORD * XLTH ADDR OF CURRENT MAT LENGTH WORD * XLST ADDR OF ALLOCATED LIST TO BE ADDED INTO * JSB XLINK * *************************************** * * XXLNK NOP ALN1 LDA XLST,I GET FIRST ENTRY IN LIST CPA XEND END OF LIST JMP ALN3 YES * INA BUMP TO PRIORITY WORK LDA A,I CMA,INA SCREEN OUT FLAGS ADA B ADD TO CUTTENT PRIORITY SSA,RSS S=1,NEXT PARTITION LOWER PRIORITY JMP ALN2 S=0,GO LINK * ALNXT LDA XLST,I GO CHECK NEXT ENTRY STA XLST JMP ALN1 * ALN2 SZA,RSS ARE PRIORITIES THE SAME JMP ALN4 GO ARRANGE BY LENGTH * ALN3 LDA XLST,I GET PREVIOUS POINTER STA XLNK,I PUT IN THIS ENTRY LINK WORD LDA XLNK GET ADR THIS ENTRY STA XLST,I PUT IN LINK WORK PREVIOUS JMP XXLNK,I * ALN4 LDA XLTH,I GET LENGTH CURRENT ENTRY AND B1777 SCREEN OUT FLAGS CMA,INA STA CLTH LDA XLST,I ADA D4 LDA A,I GET LENGTH NEXT ENTRY IN LIST AND B1777 SCREEN OUT FLAGS ADA CLTH SSA S=1,CURRENT LENGTH GREATER JMP ALNXT GO SEE IF NEXT ENTRY BIGGER JMP ALN3 CURRENT SMALLER,GO LINK * CLTH NOP SKP *******UNLINK ALLOCATED,LINK DORMANT**** * CALL: (A) = ID SEG ADDR * JSB $ALDM * *************************************** * $ALDM NOP JSB DLINK JMP $ALDM,I NOT STILL IN PTTN OR ALREADY IN DM * * ************************************* ****UNLINK DORMANT,LINK ALLOCATED**** * CALL: (A) = ID SEG ADDRÏþú * JSB DMAL * **NOTE--MUST MAKE SURE IN DORMANT LIST ** BEFORE GET HERE**** ************************************* * $DMAL NOP JSB DSET GO SET UP JMP $DMAL,I NOT IN PTTN,DONT CHANGE * LDB XLNK ADB D3 LDA B,I XOR DMFLG CLEAR DM LIST FLAG STA B,I LDA XLST GO UNLINK DORM LIST LDB ULST STB XLST SET TO INSERT ALLOC LIST LDB XLNK JSB UNLNK CLA STA XEND LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK IN ALLOC LIST JMP $DMAL,I SKP *****RELINK FOR PR COMMAND********* **RELINKS IN ALLOC LIST BY NEW PRIORITY** * * $PRCN NOP STB NEWPR JSB DSET GO SET UP JMP $PRCN,I NOT STILL IN PTTN,DONT RELINK * LDB XLNK ADB D3 LDA B,I AND DMFLG IS IT IN DORM LIST SZA,RSS JMP PRCG2 NO, MUST BE IN ALLOC * LDA XLST YES, IN DORM PRCG1 LDB XLNK JSB UNLNK GO UNLINK LDA XLNK INA LDB NEWPR PUT NEW PRIO IN PTTN STB A,I JSB XXLNK GO LINK BY NEW PRIO JMP $PRCN,I * PRCG2 CLA SET UP FOR ALLOC LIST STA XEND LDA ULST STA XLST JMP PRCG1 * NEWPR NOP ABGFR DEF $BGFR+0 ADR BG FREE LIST ABGPR DEF BGPR ADR BG ALC LIST HD ABGDM DEF BGDM ADDR BG DORMANT SUBLIST HEADER BGDM DEF BGPR INIT BG DORMANT SUBLIST HEAD BGPR NOP BG ALLOCATED LIST HEADER * * EXTERNAL DEFINITIONS FOR CMM4 & CDA4 * $BG1 EQU ABGFR $BG2 EQU ABGPR $BG3 EQU ABGDM $BG4 EQU BGDM $BG5 EQU BGPR * ARTFR DEF $RTFR+0 ADDR RT FREE LIST HEADER ARTPR DEF RTPR ADDR RT ALLOCATED LIST HEADER ARTDM DEF RTDM ADDR RT DORMANT SUBLIST HEADER RTDM DEF RTPR INIT RT DORMANT SUBLIST HEAD RTPR NOP RT ALLOCATED LIST HEADER * * EXTERNAL DEFINITIONS FOR CMM4 & CDA4 * $RT1 EQqyþúU ARTFR $RT2 EQU ARTPR $RT3 EQU ARTDM $RT4 EQU RTDM $RT5 EQU RTPR * ACHFR DEF $CFR+0 ACHPR DEF CHPR ACHDM DEF CHDM CHDM DEF CHPR CHPR NOP * * EXTERNAL DEFINTIONS FOR CMM4 & CDA4 * $MM1 EQU ACHFR $MM2 EQU ACHPR $MM3 EQU ACHDM $MM4 EQU CHDM $MM5 EQU CHPR * FLIST NOP CURRENT FREE LIST POINTER ALIST NOP CURRENT ALLOCATED LIST POINTER DLIST NOP CURRENT DORMANT SUBLIST POINTER SKP * $UNPE - UNLINK PARTITION AND UNDEFINE IT FOR PARITY ERROR MODULE * CALLED BY PERR4 * CALL: * (B) = MAT ADDR OF PARTITION * JSB $UNPE * REGISTERS MEANINGLESS * * $UNPE NOP STB NEWPR SAVE MAT ADDR ADB D3 LDA B,I SSA IS IT A MOTHER PTTN? JMP ULMOM YES, UNLINK AND UNDEFINE MOM * ADB D2 LDA B,I ADB DM3 LDB B,I (B) = ID ADDR SSA IS IT RT PARTITION? JMP ULRT YES * LDA ABGFR BG PARTITION SZB IS PTTN EMPTY? LDA ABGDM NO, USE BG ALLOC LIST JMP ULPTN YES, USE BG FREE LIST * ULRT LDA ARTFR USE RT FREE LIST IF EMPTY SZB IS PTTN EMPTY? LDA ARTDM NO, USE RT ALLOC LIST ULPTN LDB NEWPR JSB UNLNK UNLINK THE ENTRY CCA STA NEWPR,I UNDEFINE THE MAT ENTRY * CLA NOW SET THE MAT FREE LDB NEWPR ADB D2 STA B,I ZAP THE ID ADDRESS ADB D3 LDA B,I GET THE STATUS WORD AND BIT15 SAVE ONLY TYPE STA B,I ZAP THE STATUS JMP $UNPE,I RETURN * ULMOM LDA NEWPR CPA MOMFL SAME AS ONE WE'RE TRYING TO CLEAN OUT CLB,RSS YES, SKIP JMP ULM2 NO, UNLINK FROM LISTS * STB MOMFL YES, CLEAR SWAP OUT FLAGS STB SUBFL ULM2 ADA D4 LDA A,I RAL SSA,RSS IS MOTHER IN CHAIN MODE? JMP ULM3 NO, SKIP UNFÌþúMOM * LDA NEWPR JSB MATAD SET UP MAT ADDRS LDB NEWPR JSB UNMOM UNLINK SUBPTTNS FROM MOM LDA ACHFR UNLINK MOM FROM CH FREE LIST JMP ULPTN * ULM3 LDB NEWPR (UNMOM CHECKS PTTN STATUS = 4) ADB D2 LDA B,I GET PTTN STATUS AND D7 LDB A LDA ACHFR EITHER IT IS IN FREE LIST CPB D4 JMP ULMSP OR IN ALLOC LIST (SWAPPING SUBPTTNS) * LDB NEWPR ADB D2 LDB B,I SZB OR ULMSP LDA ACHDM IN ALLOC LIST (OCCUPIED) JMP ULPTN GO UNLINK AND UNDEFINE HED DISP4 -- BACKGROUND DISK PROGRAM LOADING * BACKGROUND DISK RESIDENT PROGRAM SCHEDULED * * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0100 LDA ABGFR SET UP LIST HEADERS STA FLIST LDA ABGPR STA ALIST LDA ABGDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO BG PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF BGSWP & SUPPLY THE $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLG SSA IS PROG IN RT PTTN JMP XB200 YES,GO THERE * XR100 LDjÔNLHB MID,I PROGRAM RESIDENT IN PTTN? SZB,RSS YES, SKIP JMP XN120 NO, SO GO READ IT IN * CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * * SET UP TO CALL SWPCK * LDA BGSWP IS BG SWP OR LOAD IN PROGRESS SZA NO,SO GO TO IT CPA B YES, IS IT SAME PTTN (B)=MID,I CLE,RSS OK,GO TO SWPCK (E=0) JMP X0035 * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0152 (P+1) GO CLEAR CURRENT LOAD JMP X101 (P+2) GO SWP OUT CURRENT PRGM * * LOAD RETURN FROM SWPCK * XN120 LDA BGSWP (P+3) GO LOAD OVER CURRENT OCCUPANT SZA JMP X0B35 YES, CALL BUSY, RELEASE PTTN IF FREE * JSB COMIT COMMIT THE PARTITION * HED DISP4 -- BACKGROUND DISK RESIDENT PROGRAM SWAP OUT * SETUP TO SWAP OUT BACKGROUND DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * Nÿÿþú* COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * SEZ,RSS E = 1 IS LOAD IN OR SWAP BACK IN X101 JSB SWOUT E = 0 IS SWAP OUT (GO SAVE MAP REG FIRST) CLB,SEZ,INB,RSS INB STB BGRQ SET UP REQUEST CODE LDB MID,I LDA BTRPA JSB PREST EXITS VIA X0035 IF NO DISC SPACE FOR SWAP STB BGLU SET UP REQUEST LU STA BTRP SET UP TRIPLETS ADDR LDA MID,I SET CALL BUSY AFTER PREST RETURNS STA BGSWP LDA MRDFL STA BRDFL SAVE FLAGS ADDR LDA MFLGS STA BFLGS SAVE HIGH ORDER BITS LDA ZPRIO,I STA BSPR SET UP PRIORITY * JSB $XSIO MAKE DISC I/O CALL BGLU NOP LOGICAL UNIT DEF X0122 COMPLETION ADDR X0155 NOP LINK WORD BGRQ OCT 1 REQUEST CODE BTRP DEF BTRIP TRIPLETS ARRAY ADDR BSPR NOP BG SWAPPING PRIORITY BGSWP NOP ID ADDR OF PROG ISZ BRDFL,I SWAPPING OUT? JMP X0035 YES, FLAG = 2 * LDA BFLGS NO, LOAD. FLAG = 0 IOR BRDFL,I SET UP HIGH BITS STA BRDFL,I JMP X0005 * * BRDFL NOP BFLGS NOP SKP * * BACKGROUND READ IN COMPLETION PROCESSOR * þú * * THE BACKGROUND DISC RESIDENT READ COMPLETION PROCESSOR, * * IF NO READ ERROR, IT CLEARS THE READ IN WAIT FLAG, * * ENTERS PROGRAM INTO SCHEDULE LIST VIA LIST * * SUCH THAT EXECUTION CAN BEGIN AT THE NEXT * * OPPORTUNITY THE PROGRAM BECOME THE TOP OF LIST.* * IF READ ERRORS OCCURRED, CALL $ABRT PROCESSOR . * X0122 STB TEMP SAVE READ IN STATUS OF DISC ISZ BRDFL,I STEP BG RD FLAG (1 LOADED, 3 SEG LOADED) LDA BFLGS IOR BRDFL,I STA BRDFL,I SET READ FLAG=1 IF READ (A=1) * LDB BGSWP CLA STA BGSWP CLEAR BG I/O FLAG LDA BGRQ * X0125 ISZ $LIST SET LIST FLAG TO FORCE SCAN SLA,RSS A=1 IF READ,0 IF WRITE JMP X0127 IT IS WRITE, GO SCAN LIST * STB TEMP1 SAVE ID-SEG. ADDRESS JSB $LIST CALL $LIST TO SCHEDULE PROG OCT 401 LDB TEMP CHECK READ IN STATUS FLAG SZA,RSS IF LIST ERROR OR SSB,RSS DISC ERROR JMP X0127 * LDA TEMP1 GO ABORT, A CONTAINS ID SEG ADDR JSB $ABRT GO TO ABORT ROUTINE * X0127 LDA MOMFL SZA ANY SUBPTTNS TO SWAP OUT? JMP SUBSS YES, GO DO IT JMP $XCQ NO, DO NEXT SCHEDULE/ABORT * * CLEAR OUT CURRENT LOAD * X0152 LDB MID,I RESCHEDULE THE JSB $LIST PROGRAM OCT 401 XN153 LDA ABGDM LDB MLNK JSB UNLNK REMOVE LDA ABGFR STA FLIST STRING BY LENGTH JSB FLINK INSERT INTO FREE LIST X0154 CLB LDA MRDFL,I AND D7 CPA D5 DID WE JUST CLEAR MOTHER PTTN LOAD? JMP XABIO YES, ABORT I/O * SLA IS I/O GOING ON IN THIS PTTN? JMP XX154 NO, GO TO $XCQ * XABIO LDA MID,I GET RESIDENT PTTN STB MID,I CLEAR RESIDENT CPA BGSWP WAS I/O BUSY IN BG? zðþú JMP XB154 YES * CPA RTSWP RT CALL BUSY? JMP XR154 YES, CLEAR IT * CPA SGSWP JMP XS154 * CPA CHSW2 CHUNK I/O CALL BUSY? JMP XC154 YES, CLEAR IT * CPA CHSWP MOTHER PTTN I/O BUSY? JMP XM154 YES, CLEAR IT * XX154 STB MID,I NONE OF ABOVE, JMP $XCQ JUST CLEAR RESIDENCY WORD * XM154 STB CHSWP CLEAR MOTHER PTTN FLAG LDA DX355 BECAUSE IT WAS NONE OF ABOVE JMP $IOCL GO CANCEL LOAD * XC154 STB CHSW2 STB CHSWP LDA DX366 CHUNK I/O BUSY. JMP $IOCL GO CANCEL LOAD * XR154 LDA DX255 STB RTSWP CLEAR RT FLAG JMP $IOCL GO CANCEL LOAD * XB154 STB BGSWP CLEAR BG FLAG LDA DX155 JMP $IOCL GO CANCEL LOAD * XS154 STB SGSWP CLEAR SG FLAG LDA DX455 JMP $IOCL GO CANCEL LOAD * SPC 1 DX155 DEF X0155 ADDR OF LINK WORD IN BG $XSIO CALL DX255 DEF X0255 ADDR OF LINK WORD IN RT $XSIO CALL DX355 DEF X0355 ADDR OF LINK WORD IN MOTHER $XSIO CALL DX366 DEF X0366 ADDR OF LINK WORD IN CHUNK $XSIO CALL DX455 DEF X0455 ADDR OF LINK WORD IN SEGMENT $XSIO CALL EMAOF NOP MSGSZ NOP MSGPG NOP ZIDX0 NOP ZIDX1 NOP * B40 OCT 40 B176K OCT 176000 DM7 DEC -7 * X0B35 LDA MID,I GET PTTN RESIDENT SZA IF EMPTY PUT BACK IN FREE LIST JMP X0035 OTHERWISE ,DONT BOTHER * LDA ALIST GO REMOVE ALLOCATD LIST LDB MLNK JSB UNLNK JSB FLINK JMP X0035 * * * SKP * * THE COMMIT ROUTINE INSURES THE THE PARTITION IS COMMITTED TO * THE PROGRAM BEFORE THE PROGRAM IS LOADED INTO THE PARTITION. * IF THE PARTITION USED TO BE IN THE DORM LIST IT IS MOVED TO * THE ALLOC LIST. WHAT WE SHOULD PROBABLY DO HERE LATER * IS ALSO TO MOVE THE PARTITION OUT OF THE FREE LIST INTO THE * ALLOC LIST. CURRENTLY THIS IS DONE IN THE FNDSG ROUTINE. OH * WELL MAYBE NEÏôþúXT PASS WE'LL GET THE TIME. * * * COMIT NOP * LDA MID,I ANYBODY ALREADY OWN THE PARTITION ? SZA,RSS WELL ? JMP ALLOK NO, SO PARTITION IN CORRECT LIST ( VIA FNDSG ) * LDA MADR,I GET THE DORM BIT WORD AND B20K FETCH DORM BIT SZA,RSS THIS PART'N IN DORM LIST ? JMP ALLOK NO. * XOR MADR,I YES, SO STA MADR,I CLEAR DORM BIT & LDA DLIST MOVE OUT OF DORM LIST INTO LDB MLNK THE ALLOC LIST. JSB UNLNK JSB ALINK * ALLOK LDA ZPRIO,I ASSIGN NEW PRIORITY TO PTTN CPA MPRIO,I IS IT SAME AS PARTITION PRIORITY? JMP XW120 YES, CAN'T RELINK * STA MPRIO,I ASSIGN NEW PRIORITY JSB RLNK GO RELINK IN ALLOCATED LIST XW120 LDB ZWORK STB MID,I *** COMMIT THE PARTITION *** !!!!!! JSB $LIST SUSPEND PROG UNTIL READ COMPLETE OCT 402 CCA,CCE (E)=1 FOR PREST ON LOAD STA MRDFL,I * JMP COMIT,I RETURN * B20K OCT 20000 HED DISP4 -- RT DISK RESIDENT LOAD TESTS * * REAL TIME DISC RESIDENT * * REAL TIME DISC RESIDENT PROGRAM EXECUTION * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0200 LDA ARTFR SE¢‡þúT POINTERS TO LIST HEADERS STA FLIST LDA ARTPR STA ALIST LDA ARTDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO RT PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF RTSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLAG SSA,RSS IS PROG IN BG PTTN? JMP XR100 YES,GO DO IT * XB200 LDB MID,I IS PROGRAM RESIDENT? SZB,RSS JMP XN220 NO, SO GO READ IT IN * CPB ZWORK YES, DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * SET UP TO CALL SWPCK * LDA RTSWP IS RT I/O CALL BUSY? SZA NO, GO TO IT CPA B YES, IS IT SAME PTTN? (B)=MID,I CLE,RSS YES, GO TO SWPCK (E=0) JMP X0035 NO, I/O CALL BUSY, TRY NEXT PROG * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0252 GO CLEAR CURRENT LOAD JMP X201 GO SWAP OUT CURRENT PGM. JMP XN220 * SPC 1 X0230 AND B7 PROG IN MEMORY, SCHED IF DONE LOAD CCE,SLA,RSS READ IN COMPLETE? JMP X0035 NO, GO TRY THE NEXT PGM * CPA D3 STILL IN MEMORY AFTER SWAP? JMP X02IN YES, USE IT AGAIN * LDA ZWORK ADA D27 LDA A,I SWAP BACK IN? CCE,SZA JSB SWPIN YES, SO SET UP THE MAPS FOR DISPATCH CCE NO, REDISPATCH, USE MAP ON USER B.P. XW230 LDB MLNK JSB $SMAP SET UP USER MAP LDB ZWORK GET THE ID-SEG. ADDRESS JSB DREL RELEASE SWAP TRACKS IF ANY JMP X0040 GO EXECUTE THE PGM. * X02IN LDB MFLGS CCE,INB STB MRDFL,I FORCE PTTN STATUS=1 JSB SWOUT RESET THE MAP BACK TO WH¢ÓþúAT IT WAS. JMP XW230 RE-USE BP COPY OF USER MAP (E=1) HED DISP4 -- RT DISK RESIDENT READ IN * * SETUP TO READ IN RT DISK PROGRAM * * READ IN OF REAL TIME DISC RESIDENT PROGRAM * * IF ID SEGMENT SWAP ADDRESS IS ZERO, THE SYSTEM * * GENERATED DISC ADDRESS IS USED TO COMPUTE THE * * PARAMETERS FOR DISC I/O CALL. * * IF THERE IS SWAP ADDRESS, THEN THIS DISC ADDRESS * * IS USED. * * * XN220 LDA RTSWP TRANSFER IN ANOTHER AREA? SZA NO, OKAY TO LOAD JMP X0B35 YES, FREE UP PTTN AGAIN * JSB COMIT COMMIT THE PARTITION HED DISP4 -- RT DISK RESIDENT PROGRAM SWAP OUT * * SETUP TO SWAP OUT RT DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * (E)=0 SWAP OUT (E)=1 LOAD IN SEZ,RSS E = 1 IS A LOAD IN OR SWAP BACK IN X201 JSB SWOUT E = 0 IS A SWAP OUT SO SAVE THE MAP INFO CLB,SEZ,INB,RSS SET UPVþú THE REQUEST INB AND SET STB RTRQ LDB MID,I ID SEGMENT ADDRESS LDA RTRPA GET THE QUE ADDRESS JSB PREST GO SET UP THE SWAP STB RTLU SET THE LU STA RTRP SET THE TRIPLET QUE ADDRESS LDA MID,I STA RTSWP LDA MRDFL STA RRDFL LDA MFLGS SAVE FLAGS STA RFLGS LDA ZPRIO,I SET THE REQUEST PRIORITY STA RTSPR IN THE CALL JSB $XSIO CALL FOR DISK I/O RTLU NOP LOGICAL UNIT DEF X0251 COMPLETION ADDRESS X0255 OCT 0 RTRQ NOP REQUEST CODE READ/WRITE RTRP DEF RTRIP ARRAY ADDRESS RTSPR NOP RT SWAP PRIORITY RTSWP NOP EXTENDED XSIO CALL--ID ADR ISZ RRDFL,I SWAPPING OUT? JMP X0035 YES, CONTINUE SEARCH (FLAG = 2) * LDA RFLGS NO, IT'S LOAD IOR RRDFL,I PUT FLAGS BACK IN MAT WORD STA RRDFL,I NOW=0 IF LOADING OR SWAPPING IN JMP X0005 RESCAN LIST, NEW PROG MAY BE READY. * RFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD RRDFL NOP ADDR OF MAT PTTN STATUS WORD SPC 2 * * * READ IN COMPLETION PROCESSOR * * THE REAL TIME DISC RESIDENT READ COMPLETION PROCESSOR, * * * IF NO ERRORS, IT CLEARS READ IN WAIT FLAG, AND * * SCHEDULES PROGRAM SUCH THAT PROGRAM EXECUTION * * CAN BEGIN AT THE NEXT OPPORTUNITY. * * IF READ ERRORS, CALL $ABRT PROCESSOR * * * X0251 STB TEMP SAVE READ IN STATUS OF DISK ISZ RRDFL,I SET FLAG =1 LOAD DONE, =3 SWAP DONE LDA RFLGS IOR RRDFL,I STA RRDFL,I * LDB RTSWP GET ID SEG ADR CLA STA RTSWP CLEAR SWAP IN PROGRESS LDA RTRQ GET REQUEST CODE JMP X0125 GO FINISH CHECKS SPC 2 X0252 LDB MID,I ABORT ²ÖþúLOAD IN PTTN WHICH WE NEED JSB $LIST AND RESCHEDULE THE ABORTED PROG OCT 401 TO BE LOADED AGAIN LATER XN253 LDA ARTDM LDB MLNK JSB UNLNK REMOVE PTTN FROM ALLOCATED LIST LDA ARTFR STA FLIST JSB FLINK INSERT PTTN INTO FREE LIST JMP X0154 GO CANCEL LOAD SPC 1 RTRPA DEF RTRIP SPC 1 HED DISP4 -- MOTHER PARTITION RESIDENT PROGRAM PROCESSING * DISPATCHING EMA PROGRAM * OR A BG OR RT PROGRAM ASSIGNED TO A MOTHER PARTITION X0300 LDA ACHFR SET UP LIST HEADERS STA FLIST LDA ACHPR STA ALIST LDA ACHDM STA DLIST * LDA ZIDEX SZA,RSS IS IT AN EMA PROG? JMP X0310 NO * XE300 LDB ZWORK YES, IT IS EMA PROG ADB D8 LDB B,I GET POINT OF SUSPENSION FROM ID SEG SZB INITIAL DISPATCH? JMP X0310 NO, LEAVE EMA SIZE OR EMA START PAGE ALONE * LDA ZIDEX YES, INITIAL DISPATCH CCE,INA STA ZIDX1 SAVE ADDR OF WORD 1 IN ID EXT LDA ZIDEX,I AND B37 GET #PAGES IN MSEG STA B SAVE # PAGES IN MSEG RAL,ERA SET SIGN AND CLEAR MSEG # STA ZIDEX,I SO MSEG PAGES GET PROTECTED LDA ZMPID,I AND B76K ALF RAL,RAL GET SIZE OF PROG LESS BP CMB,INB SUBTRACT MSEG FOR ACTUAL CODE SIZE ADB A KEEP PROG SIZE IN (B) * LDA ZIDX1,I GET ID EXT WORD 1 ALF,RAL SSA,RSS WAS DEFAULT BIT SET? JMP X0310 NO, JUST USE SPECIFIED EMA SIZE * LDA ZEMA,I AND B1777 CPA D1 IS IT DEFAULTED TO 1? RSS YES, SET UP NEW EMA SIZE JMP X0310 NO, USE GIVEN SIZE * CMB,INB SUBTRACT ACTUAL CODE SIZE FROM PTTN SIZE LDA ZMPID,I SSA,RSS ASSIGNED TO A PTTN? JMP X0308 NO, USE $MCHN SIZE * STB NPGN SAVE NEG PROG SIZE‡þú LDA ZWORK YES, FIND THE PTTN'S SIZE JSB MATEN LDA MLTH,I AND B1777 LDB NPGN SUBTRACT PROG SIZE ADB A FROM PTTN SIZE TO CALCULATE RSS EMA SIZE X0308 ADB $MCHN USE MOTHER PTTN SIZE TO CALCULATE LDA ZEMA,I GET EMA WORD FROM ID SEG AND B176K IOR B AND FILL IN NEW EMA SIZE STA ZEMA,I SAVE NEW EMA SIZE WORD * X0310 JSB FNDSG GO FIND A PTTN LARGE ENOUGH DEF CHSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDB MID,I PROG ASSIGNED TO MOTHER PTTN SZB,RSS IS ANY PROG IN PTTN? JMP XS320 NO, READ PROG IN IF REALLY FREE * CPB ZWORK YES, BUT IS IT THE CORRECT ONE? JMP X0330 YES, CHECK FOR READ COMPLETE * SWEMA LDA CHSWP NO, TRY SWAP IT OUT SZA IS I/O CALL BUSY? CPA B YES, CALL BUSY. IN THIS PTTN? (B)=MID,I CLE,RSS CALL NOT BUSY OR ONLY BUSY IN THIS PTTN JMP X0035 CALL IS BUSY, SO DO SOMETHING ELSE. * JSB SWPCK CHECK SWAP CONDITION (E=0) JMP X0352 THIS PROG PR > CURR PROG READ IN, STOP IT JMP X0325 WE CAN SWAP OUT OLD OCCUPANT JMP XN320 OCCUPANT NOT EXECUTED SINCE LOAD, OVERLAY IT * * * WE CAN SWAP OUT OLD PROGRAM IN PARTITION * X0325 LDB MID,I GET OLD OCCUPANT ID ADDR ADB D28 INDEX TO EMA WORD LDA B,I STB ZEMA SET UP FOR SWAP OUT CODE JSB IDXAD GET ID EXT ADDR STA ZIDEX NOT EMA, GO SWAP STA ZIDEX IS EMA, SAVE THE ID EXT ADDRESS * CLE JSB SWOUT SAVE THE USER MAP REGISTERS JMP X301 GO SWAP * SPC 3 * SWAPPED EMA PROGRAM BACK IN * SINCE IT MAY COME BACK IN DIFFERENT PARTITION, WE MUST * REBUILD THE MSEG PAGE REGISTERS AND SAVE A NEW COPY OF * THE MAP IN THE USER'S PHYSICAL BASE PAGE. * * EMA START OFFSET = PG# CURR EMA PAGE - OLD EMA 8uþúSTART PAGE * NEW EMA START PG = 1ST PG NEW PTTN + #PAGES IN ID + 1 - MSEG SIZE * #PG TO MAP IN MSEG= MSEG SIZE + 1 * * IF MSEG IS NOT COMPLETELY FILLED BY EMA PAGES BECAUSE * END OF THE EMA WAS REACHED OR IF THERE WAS NO MSEG MAPPED * AT THE TIME OF THE SWAP-OUT, THEN THOSE PAGES WILL BE * SET UP WITH READ-WRITE PROTECT. * * X0330 LDA MRDFL,I AND D7 GET PTTN STATUS CPA D4 STILL TRY TO SWAP OUT SUBPTTNS? JMP XS322 YES, DO SOME MORE * CPA D5 ALL DONE WITH SUBPTTNS? JMP XN320 YES, LOAD INTO IT * LDB ZIDEX NONE OF ABOVE, SO READ STARTED ALREADY SZB,RSS IS IT AN EMA PROG? JMP X0230 NO, JUST SET UP BP MAP * CCE,SLA,RSS IS EMA LOAD ALL DONE? JMP X0035 NO, GO DISPATCH NEXT PROG * CPA D3 STILL IN MEMORY AFTER SWAP OUT? JMP X03IN YES, CHANGE PTTN STATUS TO 1 * LDA ZWORK PROGRAM IS IN MEMORY ADA D27 LDA A,I GET SWAP TRACKS WORD CCE,SZA,RSS IS THIS A LOAD BACK IN FROM A SWAP OUT ? JMP X0333 NO, EITHOR A REDISPATCH OR INITIAL RUN. * JSB SWPIN YES, SO SET UP THE USERS MAP REGS CCE LDB MLNK GET THE MATA LINK WORD & JSB $SMAP NOW GO ENABLE THE USER MAP * XW330 LDB ZWORK GET THE ID ADDRESS JSB DREL RELEASE SWAP TRACKS, IF ANY JMP X0040 GO EXECUTE PROG * X03IN LDB MFLGS CCE,INB STB MRDFL,I SET STATUS = 1 FOR PROG IN MEMORY JSB SWOUT RESTORE SAVED MAP TO WHAT IT USED TO BE LDB MLNK GET THE MAT ADDRESS & JSB $SMAP RE-USE USER MAP (E=1) JMP XW330 AFTER SWAP, SO GET RID OF SWAP TRACKS * SKP * * THIS IS EITHOR A REDISPATCH OR THE INITIAL RUN OF THE PROGRAM * X0333 LDB MLNK LDA ZWORK GET THE ID ADDRESS ADA D8 LDA A,I GET PT OF SUSP CCE,SZA,RSS INITIAL EXECUTION? JMP X0335 YESwaþú,SO SET UP THE START PAGE OF EMA * JSB $SMAP NO,A REDISPATCH SO JUST USE MAP ALREADY SET UP JMP X0040 SO GO EXECUTE THE GUY. * * THIS IS THE FIRST DISPATCH OF THE EMA PROGRAM * X0335 CLE (E=0) TO FORCE NEW MAP JSB $SMAP SET UP USER MAP LDA ZIDEX,I EMA PROG JUST LOADED AND B37 NEEDS MAP REGS SET UP FOR MSEG LDB A NEGATE #PGS IN MSEG CMB,INB LDA ZMPID,I GET #PAGES IN USER ALF (WITHOUT BASE PAGE) RAL,RAL AND B37 TO GET ACTUAL CODE SIZE INA ADB A IN (B) * LDA MADR,I GET PHYSICAL START PAGE OF PTTN AND B1777 FROM MATA ENTRY ADB A ADD TO GET NEW START PAGE EMA LDA ZIDX1,I AND B176K IOR B ADD OLD BITS IN HIGH PART LDB ZIDEX GET THE ID EXT ADDRESS INB THE START PHYSICAL PAGE OF EMA WORD STA B,I AND SET UP THE EMA PHYSICAL PAGE WORD. JMP X0040 OK, SO GO EXECUTE THE PROGRAM. * * * B40K OCT 40000 D19 DEC 19 * * X0352 LDB MADR,I NEED TO ABORT LOAD IN PROGRESS SSB MOTHER PTTN? JMP XM352 YES, MOTHER PTTN * LDB MFLGS NO, MUST BE EMA ASSIGNED TO RT/BG SSB JMP X0252 ASSIGNED TO RT (UNLINK RT PTTN) JMP X0152 ASSIGNED TO BG (UNLINK BG PTTN) * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION AND THE SWPCK ROUTINE * DETERMINED THAT IT IS HIGHER PRIORITY THAN THE PROGRAM BEING * LOADED INTO THE MOTHER PARTITION SO STOP THE LOAD. * XM352 LDB MID,I JSB $LIST RESCHEDULE PROG IN MOTHER PTTN OCT 401 * XN353 LDB MLNK PROG ABORTED BY OPERATOR OR SYSTEM JSB UNMOM OR PROGRAM COMPLETED NORMALLY XW354 JSB MATAD RESET UP PTRS FOR MOTHER PTTN JMP X0154 THEN CANCEL LOAD IF NEED TO * * * DO THE LOAD OF PROGRAM INTO MOTHER PTTN * XN321 LDA MADR,I YwþúMOTHER/EMA CALL IS BUSY SSA NEED TO LOAD INTO MOTHER PTTN? JMP X0035 YES, HAVE TO WAIT. TRY NEXT SCHED JMP X0B35 NO, EMA ASSIGNED TO RT/BG. RELEASE PTTN * * XS320 LDA MRDFL,I AND B7 STILL TRYING TO CLEAR SUBPTTNS? CPA D4 RSS YES, DO SOME MORE OR GO TO NEXT PROG JMP XN320 NO, DO LOAD IF CALL IS FREE * XS322 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA (NEED THIS, IN CASE OF ABORT IN SUBPTTN) JMP X0035 YES, BUSY SO SKIP IT FOR A WHILE JMP SUBS2 NO, DO NEXT SUBPTTN. * * XN320 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA JMP XN321 YES, BUSY. TRY NEXT PROG IF MOTHER PTTN * JSB COMIT COMIT THE PARTITION * SKP * * SWAP-OUT OR LOAD * X301 CLB,SEZ,INB,RSS SET UP REQ CODE INB AND SET UP STB CHRQ IN MOTHER PTTN CALL STB CHRQ2 LDA MLNK STA CHMAT SAVE MAT ADDR LDB MID,I (B) = ID SEG ADDR LDA CTRPA (A)=BOTTOM OF TRIPLETS JSB PREST SET UP FOR SWAP OR LOAD OF PROG STB CHLU1 SAVE LU STB CHLU2 STA CTRP SET TRIPLET QUEUE ADDR LDA TEMP1 STA CHTRK SAVE NEXT TRACK # LDA TEMP2 STA CHSCT SAVE NEXT SECTOR # LDA MID,I STA CHSWP SET EMA/MOTHER PTTN I/O CALL BUSY LDA MRDFL STA CRDFL SET ADDR OF READ-IN FLAG LDA MFLGS STA CFLGS SET HIGH BITS OF READ-IN FLAG LDA ZPRIO,I STA CHSPR SET REQUEST PRIORITY STA CHSP2 LDA ZEMA,I STA CHEMA SAVE CONTENT OF EMA WORD LDA ZIDEX AND ID EXT ADDR STA CHIDX FOR COMPLETION CODE * JSB $XSIO DO LOAD OR SWAP I/O CALL CHLU1 NOP DISC LU DEF X0351 COMPLETION ADDR X0355 NOP LINK WORD CHRQ NOP READ/WRITE CTRP DEF CTRIP TRIPLET ADDR CHSP +NLHR NOP PRIORITY CHSWP NOP ID ADDR OF PROG, CODE BUSY FLAG * ISZ CRDFL,I JMP X0035 SWAP OUT FLAG = 2, CONTINUE * LDA CFLGS LOAD IN OR SWAP IN IOR CRDFL,I STA CRDFL,I JMP X0005 CONTINUE * * CHEMA NOP CONTENTS OF EMA WORD CHIDX NOP ID EXT ADDRESS * * * * EMA/MOTHER PTTN I/O COMPLETE * X0351 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERRORS JMP X03AB ERROR, ABORT! * LDA CHEMA DONE LOAD/SWAP OF PROG, SZA,RSS EMA? JMP X0380 NO, DONE NOW * LDB CHSWP ADB D8 LDB B,I GET POINT OF SUSPENSION WORD CCE,SZB,RSS INITIAL LOAD? JMP X0380 YES, SKIP EMA CHUNK MOVES * LDB CHSWP STB CHSW2 SET CHUNK I/O CALL BUSY RBL,ERB SET SIGN BIT FOR $XSIO CALL STB CHSW3 * LDA CHIDX,I GET THE MSEG SIZE WñNÿÿþú AND B37 CMA,INA MAKE IT NEGATINVE INA ADD 1 FOR BP STA B SAVE -MSEGSIZE+1 LDA CHMAT GET THE PHYS. START ADA D3 PAGE OF THIS PARTITION LDA A,I AND B1777 ADB A B HAS S.P.PART-MSEGSIZE+1 LDA CHSWP GET THE PROGS ID ADRS ADA D21 GET #PAGES FROM ID LDA A,I ALF,RAL SHIFT DOWN TO BOTTOM BITS RAL AND B37 ADB A B HAS S.P.PART+#PGS+1-MSEGSIZE STB CHKPG SET STARTPAGE EMA TO START SWAP LDA CHEMA GET EMASIZE TO FIND END OF AND B1777 SWAPPED AREA ADA B STA EMAEN * X0360 LDA SVCUR SAVE CURRENT USER MAP USA BEFORE MAPPING CHUNK CLA,INA CAX (X) = 1 REGISTER CLB (B) = 0 FOR PAGE# LDA D32 (A) = USER BASE PAGE REGISTER XMS ZAP B.P. SO RTIOC WON'T GET CONFUSED * LDA CHKPG ADA CHKSZ ADD CHUNK SIZE STA CHKNX TO GET START OF NEXT CHUNK CMA,INA ADA EMAEN SSA IS CHUNK PAST END OF EMA? JMP CHKSM YES, ADJUST # PAGES * LDA CHKSZ MAP IN THE CHUNK CHKMP CAX (X) = # PAGES IN CHUNK ALF,ALF RAL,RAL STA TEMP SAVE # WORDS IN CHUNK LDB CHKPG (B) = CHUNK PAGE START LDA CHKRG (A) = REGISTER # XMS * LDB CHMAT JSB PHYBP MAP IN USER'S BP ADA DM32 SAVE CHUNK MAP IN SECOND BP COPY IOR BIT15 USA * LDA CHKAD STA TEMP3 SET UP BEGINNING LOGICAL ADDR OF CHUNK LDA CHTRK STA TEMP1 SET TRACK # FOR SETUP LDA CHSCT STA TEMP2 SET SECTOR # FOR SETUP LDA CTRPA JSB SETUP BUILD TRIPLETS FOR CHUNK STA CTRP2 SET TOP ADDR OF TRIPLETS LDB TEMP1 STB CHTRK SAVE TRACK # FOR NEXT CHUNK, IF ANY LDB TEMP2 {þúSTB CHSCT SAVE SECTOR # FOR NEXT CHUNK, IF ANY * JSB $XSIO CHLU2 NOP DEF X0370 COMPLETION ADDR X0366 NOP LINK WORD CHRQ2 NOP READ/WRITE CTRP2 DEF CTRIP TRIPLET ADDR CHSP2 NOP PRIORITY CHSW3 NOP USE CURR USER MAP (ID ADDR + SIGN) * LDA RSCUR RESTORE USER MAP USA JMP X0005 SCHED NEXT PROG OR GO IDLE * * CHSW2 NOP CHUNK I/O BUSY FLAG CFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD CRDFL NOP ADDR OF MAT PTTN STATUS WORD CHKPG NOP PAGE NUMBER OF CURRENT EMA CHUNK CHKNX NOP NEXT CHUNK PAGE NUMBER EMAEN NOP END OF EMA CHTRK NOP TRACK CHSCT NOP SECTOR EMAS NOP EMAL NOP CHMAT NOP MAT ADDR OF PROG D28 DEC 28 DM32 DEC -32 BIT15 OCT 100000 SVCUR DEF CURMP,I RSCUR DEF CURMP CURMP BSS 32 * * AN EMA CHUNK IS FROM LOGICAL PAGE 1 THRU PAGE 31 IN USER MAP * SO THAT LOGICAL PAGE 0 IS NOT USED. THE REASON IS THAT WE * WILL NOT HAVE TO RELOAD THE BASE PAGE FENCE TO PREVENT THE * SYSTEM COMMUNICATION AREA FROM SHOWING THROUGH THE TOP PART * OF THE USER BASE PAGE. IT IS NO BIG LOSS TO MAP JUST ONE * PAGE LESS! CHKSZ NOP CHUNK SIZE CHKRG NOP REGISTER NUMBER OF CHUNK IN USER MAP CHKAD NOP LOGICAL ADDR OF CHUNK * * CHKSM LDA CHKPG GET SIZE OF CHUNK FROM HERE CMA,INA TO END OF EMA ADA EMAEN LDB EMAEN STB CHKNX THERE IS NO NEXT CHUNK JMP CHKMP * * X0370 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERROR JMP X03AB ERROR, ABORT! * LDA CHKNX STA CHKPG CMA,INA INSTEAD OF COMPARE, ADA EMAEN SUBTRACT TO SEE IF DONE SZA IF CHKNX = EMAEN THEN DONE JMP X0360 NO, NOT DONE YET * X0380 ISZ CRDFL,I FLAG =1 LOAD DONE, =3 SWAP DONE HŠþú LDA CFLGS IOR CRDFL,I STA CRDFL,I * LDB CHSWP CLA STA CHSWP STA CHSW2 LDA CHRQ ISZ $LIST SLA,RSS WAS IT SWAP OUT? JMP X0385 YES, CHECK IF NEED TO START SUBPTTN SWAPOUT * JSB $LIST NO, IT WAS LOAD OCT 401 SCHEDULE THE PROG SZA SCHEDULE ERROR? JMP X03AB YES, SO JUST ABORT THE WHOLE THING * * X0385 LDA SUBFL ANY SUBPTTNS NEED TO SWAP OUT? SZA JMP SUBSS YES, START/CONTINUE SUBPTTN SWAP OUT JMP $XCQ NO, GO CHECK SCHEDULE/ABORT LISTS * X03AB LDA CHSWP GET ID SEG ADDR OF PROG JSB $ABRT GO ABORT IT JMP X0385 NOW GO SCAN THE LISTS * SKP DREL NOP ROUTINE TO RELEASE DISC SWAP TRK STB TEMP3 ADB D27 COMPUTE ID SEGMENT SWAP ADDRESS LDA B,I CCE,SZA,RSS SWAPPED, SO GO TO RELEASE JMP DREL,I NOT, SWAPPED, SO RETURN STA TEMP SAVE LU/TRK/#TRK AND B177 STA TEMP2 ISOLATE # TRACKS TO RELEASE CLA CLEAR ID SEGMENT STA B,I SWAP VALUE LDA TEMP ALF,ALF RAL AND B377 LDB TEMP SSB ADA TATSD L. U. 3 SO ADD # SYS TRACKS STA TEMP1 LDB TEMP2 (B) TO # OF TRACKS TO REL JSB $DREL CALL DISC TRACK RELEASE PROCESOR LDB TEMP3 ADB D28 LDA B,I JSB IDXAD GET ID EXT ADDR JMP DREL,I NOT EMA, EXIT ADA D2 LDA A,I GET # EMA SWAP TRACKS AND B1777 FROM WORD 2 SZA,RSS IF NO TRACKS JMP DREL,I DON'T RELEASE * STA B (B)=#TRACKS TO RELEASE LDA TEMP1 TRACK ADDR OF PROG + #TRACKS ADA TEMP2 = BEGIN TRACK OF EMA JSB $DREL RELEASE THE TRACKS JMP DREL,I RETURN HED DISP4 -- SWAP CHECK ROUTINE. CAN AND SHOULD WE SWAP? * •þú SWPCK CHECKS TO SEE IF AN AREA SHOULD BE SWAPPED, * IT CHECKS: * 1. IF A SWAP OUT IS UNDER WAY (IF SO FORGET IT) * 2. IF THE BASE PAGE SWAP FLAG FOR THE AREA ALLOWS SWAPPING. * 3. IF THE RESIDENT PROGRAM HAS INHIBITED SWAPPING. * 4. IF THE RESIDENT PROGRAM IS SCHEDULED AND HAS HIGHER * OR EQUAL PRIORITY. * 5. IF THE RESIDENT IS DORMANT BUT HAS PRIORITY AND IS IN * THE TIME LIST AND ITS TIME IS "NEAR". * 6. IF THE RESIDENT IS I/O SUSPENDED * WITH THE BUFFER IN HIS AREA. * * ALL OF THE ABOVE CONDITIONS INHIBIT A SWAP. ( JMP X0035 ). * THE FOLLOWING CONDITIONS CAUSE THE INDICATED ACTIONS. * * 7. THE RESIDENT IS BEING READ IN BUT DOES NOT HAVE PRIORITY * CAUSES AN ABORT (I.E. STOP THE READ) RETURN. * 8. THE RESIDENT HAS NOT BEEN EXECUTED SINCE IT WAS LAST * LOADED FROM THE DISC CAUSES A READ RETURN (I.E. ASSUME * THE RESIDENT CAN BE RELOADED WHEN NEEDED) * * CALLING SEQUENCE: * * ALL THE MAT PTRS ARE SET UP BY EITHER MATEN OR MATAD * MRDFL,I = THE READ IN FLAG 0=READING, 1 = INCORE, 2 =SWAPPING OUT OR * SEGMENT LOAD, 3 = INCORE AND SWAPPED OUT. * (B)= THE RESIDENTS ID-SEGMENT ADDRESS * (E)= 0 NORMAL SWAP CHECK CALL * 1 SUBPARTITION SWAP CHECK CALL * JSB SWPCK * JMP ABORT ABORT (I.E. STOP LOAD) RETURN (A=B=E=0). * JMP SWP SWAP OUT RETURN * JMP LOAD LOAD RETURN * JMP NOSWP CAN'T SWAP RETURN, ONLY SUBPTTN CHECK (E=1) * * THE FOLLOW TEMP AREAS ARE USED IN SWPCK: * RINF EQU TEMP READ IN FLAG SAVE LOCATION RBUFA EQU TEMP1 ADDRESS OF CONWRD THEN BUFFER ADDRESS RPRIO EQU TEMP2 ADDRESS OF RESIDENTS PRIORITY RSUSP EQU TEMP3 ADDRESS OF RESIDENTS SUSP RTIML EQU TEMP4 ADDRESS OF RESIDENTS T BIT. RTIME EQU TEMP5 ADDRESS OF RESIDENTS TIME. RSWTR EQU TEMP6 ADDRESS OF RESIDENTS SMAN. SKP ´ãþúSWPCK NOP LDA MRDFL,I GET CURRENT PTTN STATUS AND B7 CPA D3 IF CURRENT IS SWAPPED OUT JMP SWPC4 GO MAKE LOAD RETURN * RAL,ERA PUT (E) INTO SIGN OF RINF STA RINF SAVE THE READ IN FLAG ELA,CLE,ERA IF SWAPPING OR LOADING A SEGMENT CPA D2 OR IF CLEARING SUBPARTITIONS RSS CPA D4 THEN RETURN CAN'T SWAP . JMP X0N35 * * INB INDEX TO THE I/O CONWRD ADDRESS STB RBUFA SAVE IT ADB D5 INDEX TO THE PRIORITY ADDRESS STB RPRIO SAVE IT ADB D2 INDEX TO THE SUSPENSION ADDRESS STB RSUSP SAVE IT ADB D6 INDEX TO THE TYPE/CORE LOCK BIT ADDRESS LDA B,I GET THE WORD AND B100 ISOLATE THE CORE LOCK BIT SZA IF SET JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * INB INDEX TO THE STATUS LDA B,I GET STATUS TO A AND D15 ISOLATE THE STATUS ADB D2 INDEX TO THE TIME LIST ADDRESS STB RTIML SAVE IT INB INDEX TO THE TIME ADDRESS STB RTIME SAVE IT ADB D9 INDEX TO THE SWAP TRACK ADDRESS STB RSWTR AND SAVE IT * LDB RPRIO,I GET THE PRIORITY CMB,CLE,INB SUBTRACT ADB ZPRIO,I SET E IF RES. WINS PRIORITY TEST LDB RINF GET THE READ FLAG BLR,BRS CLEAR BITS 14,15 DON'T CHANGE (E) CPA D2 IF I/O SUSPENDED JMP SWPC3 GO DO I/O SUSP. CHECKS * SEZ,RSS IF THE CONTENDER HAS PRIORITY JMP SWPC1 GO CHECK IF SWAP IS NEEDED * CPA D1 IF RESIDENT IS SCHEDULED JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * LDB RTIML,I GET THE TIME LIST BIT BLF,SLB IF IN TIME LIST CLE,SZA AND DORMANT JMP SWPC1 NO SO GO CHECK IF SWAP IS NEEDED * DLD $TIME GET THE SYSTEM TIME µþúDIV BTRIP !! DIVIDE BY ZERO TO SET POS. !! BTRPA EQU *-1 DEF TO BTRIP ADA RTIME,I SUBTRACT THE ID-SEG TIME VALUE SEZ,CLE IF OVERFLOW INB STEP B ISZ RTIME STEP TO NEXT TIME WORD ADB RTIME,I ADD THE HIGH WORD ADA SWPTM ADD THE NEG. OF # OF TICKS SYS WILL WAIT. SEZ,SZB,RSS IF HIGH VALUE IS ZERO AND SSA,RSS THE DIFF < LIMIT JMP SWPC1 * CPB SWPTM & LIMIT NOT = 0 RSS JMP X0N35 FORGET THE SWAP, TRY NEXT PTTN * SWPC1 LDA RSUSP,I SWAP IN ORDER TEST IF THE RESIDENT LDB RSWTR,I WAS RUN SINCE LAST LOAD CLE,SZB,RSS IF SWAP TRACKS STILL ASSIGNED OR SZA,RSS POINT OF SUSP IS ZERO SWPC4 ISZ SWPCK THEN JUST READ SWPC2 ISZ SWPCK ELSE SET SWAP RETURN (E=0) JMP SWPCK,I EASY ISN'T IT? SPC 1 SWPC3 CLA E = 0 IF HE HAS PRIORITY SEZ,SZB,RSS IF READING IN AND PRIORITY JMP SWPCK,I RETURN P+1 WITH A = 0 (ABORT) * SZB,RSS IF READING IN BUT NOT PRIORITY JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * * THE FOLLOWING CODE WILL ALLOW THE SWAPPING OF * PROGRAMS SUSPENDED FOR UNBUFFERED I/O REQUESTS. * * LDA RBUFA,I GET CONWRD. * RAR IF IT IS A * SSA,SLA CONTROL REQUEST * JMP SWPC2 THEN ALLOW SWAP. * * IF UNBUFFERED CONTROL DONT SWAP * LDA RBUFA,I GET COMMAND AND D3 IF CONTROL CPA D3 JMP X0N35 DONT SWAP * ISZ RBUFA ELSE INCREMENT TO THE BUFFER ADDRESS. LDA RBUFA,I GET BUFFER ADR CLE,SSA IS IT A RE-ENT BUFFER JMP SWPC2 YES CAN SWAP * LDA RBUFA ADA D20 INDEX TO LOW MAIN LDA A,I CMA,CLE,INA SUBTRACT FROM BUFF ADDR ADA RBUFA,I IF BUFF ADDR IS BELOW LOW MAIN SEZ,RSS THEN IT IS IN COMMON, SWAP OK. JMP SWPC2 (E=0) SWAP RETURN * ¹þú* X0N35 - GET HERE IF SWPCK TRIED TO DISPATCH A PROGRAM * IN A PARTITION BUT FOUND THAT IT WAS NO SWAPPABLE * AT THE TIME (IF EVER). IF THE PROGRAM TO BE * DISPATCHED DOES NOT REQUIRE A SPECIFIC PARTITION * NUMBER, THEN A SWAP WILL BE TRIED ON THE NEXT * PARTITION IN THE ALLOCATED LIST. * X0N35 LDA RINF SSA,RSS DOING SPECIAL SUBPTTN CHECK? JMP X0N36 NO * ISZ SWPCK YES, RETURN NOSWP CONDITION JMP SWPC4 * X0N36 LDA ZMPID,I WAS SPECIFIC PTTN ASSIGNED FOR SSA PROGRAM TRYING TO DISPATCH? JMP X0035 YES, CAN'T USE ANOTHER PTTN. JMP SCHL2 NO, TRY NEXT PTTN IN LIST, IF ANY LEFT * SPC 1 SWPTM DEC -15 MAX WAIT IS 150 MS. D9 DEC 9 HED SWOUT & SWPIN THE MAP SAVE & RESTORE SWAPPING ROUTINES * * * THE SWOUT ROUTINE IS CALLED FOR ALL PROGRAMS TO BE SWAPPED OUT TO THE * DISC. IT'S PURPOSE IS TO SAVE THE USER MAPS IN THE USER AREA SO * THAT ON SWAP IN THE MAP REGISTERS WILL BE RESTORED TO THE SAME * CONDITION, RELATIVE TO THE START OF THE PARTITION, THAT THEY WERE WHEN * THE SWAP OUT OCCURED. THIS IS DONE BY MAPPING IN THE FIRST TWO PAGES * OF THE USERS PARTITION AND THEN SAVING THE MAP AS IT EXISTS IN THE * UNUSED PORTION OF THE USERS BASE PAGE INTO WORDS 2 - 34 OF THE * SECOND PAGE OF THE PARTITION. THIS IS THE AREA RIGHT BEHIND THE * THE X & Y REGISTER SAVE AREA. ON SWAP IN THIS INFO WILL BE USED * TO REBUILD THE MAP REGISTERS. * * * CALLING SEQUENCE : JSB SWOUT * * MADR = ADDRESS OF MAT START PAGE WORD * (IE MATAD HAS BEEN CALLED) * * E-REG = 0 SWAP OUT * E-REG = 1 ALREADY SWAPPED OUT BUT * BUT WE INTEND TO RESCHEDULE * THE PROGRAM. * * Qþú E-REGISTER IS PRESERVED. * * SWOUT NOP LDA MADR,I GET THE START PHYS PAGE OF PART'N AND B1777 KEEP ONLY THE START PAGE # STA B B = START PAGE LDA D2 CAX X = # OF PAGES TO MAP LDA $DVPT A = START REGISTER # XMS MOVE 1ST TWO PAGES OF PART'N INTO DVR MAP * LDA ADBPC GET THE ADDRESS OF THE REGISTERS (A=SOURCE) LDB A NOW GET THE DESTINATION ADB D34 ADDRESS TO B. SEZ ARE WE SAVING OR RESTORING ? SWP RESTORING. MVW D32 *** SAVE OR RESTORE THE USER MAP AS IT EXISTS *** JMP SWOUT,I RETURN * SKP * * * THE SWPIN ROUTINE IS CALLED FOR ALL PROGRAMS THAT HAVE BEEN * SWAPPED BACK INTO MEMORY. IT GETS THE 32 WORDS OF MAP INFO * SAVED BY SWOUT AND CONFIGURES THESE WORDS TO MAKE SENSE FOR * THE CURRENT PARTITION. IT USES $LOW & $HIGH AS THE LIMITS * OF THE PARTITION AREA. $HIGH WILL PROBABLY BE USED LATER * FOR SHAREABLE EMA. * * * CALLING SEQUENCE JSB SWPIN * MLNK = ADDR OF MAT ENTRY OF * INTEREST. * * SWPIN NOP LDB MLNK GET MAT ADDR OF INTEREST ADB D3 SAVE THE START PG OF THIS PART'N LDA B,I AND B1777 STA STPG# STPG# = START PG # OF THIS PART'N * STA B B = START PG # LDA D2 CAX X = # OF PAGES TO MAP LDA $DVPT A = START REGISTER # XMS MAP 1ST TWO PAGES OF PART'N INTO SYS MAP * LDB ADBPC GET THE DEST BUFFER ADDRESS OF NEW MAP INFO STB NEW AND SAVE FOR OFFSET TESTS. ADB D34 GET THE READ BUFFER ADDRESS OF OLD MAP INFO LDA STPG# NOW IF THE CURRENT START PAGE # EQUAL OLD CPA B,I THEN WE MUST HAVE SWAPPED THIS GUY BACK INTO THE JMP NOMAP SAME PARTITION & NO OFFSET TESTS ARE NEEDED. * !àþú STB OLD OLD = ADDRESS OF BUFFER OF OLD MAP INFO LDB B,I GET THE OLD START PAGE CMB,INB & MAKE NEG FOR TESTS STB OBASE OBASE = OLD BASE ( START PG OF LAST PART'N) * LDB DM32 GET THE MAP REG COUNT & STB KNTR SET IT UP SPC 1 * WHEN SHAREABLE EMA COMES KNTR = #PGS PROG ONLY * THAT WAY THE EMA PAGE #'S WON'T BE EFFECTED. SPC 1 JMP SETIT OK, SO SET UP THE NEW MAPS. * * NXPG# LDA OLD,I GET THE NEXT OLD PAGE # LDB $LOW GET THE LOWEST PAGE # FOR PART'NS CMB,CLE,INB MAKE NEG ADB A NOW IF THE OLD PAGE WE ARE LOOKING LDB A AT IS BELOW THE LOWEST PARTITION PAGE CMB,SEZ,CLE,INB OR IS ABOVE THE LARGEST ADB $HIGH PAGE KNOWN BY THE SYSTEM, SEZ,RSS JMP SETIT THEN JUST LEAVE IT AS IS. * ADA OBASE HERE IF $LOW <= (OLD PG #) <= $HIGH ADA STPG# ADD START PAGE OF THIS PART'N * SETIT STA NEW,I THIS IS NOW THE NEW PAGE # ISZ OLD BUMP A FEW POINTERS ISZ NEW ISZ KNTR DONE ? JMP NXPG# NO, SO AROUND WE GO. * LDB ZIDEX ONE LAST THING TO DO. SZB,RSS THIS AN EMA PROG ? JMP SWPIN,I NO, SO WE'RE DONE. * INB YES, SO WE NEED TO SET UP THE NEW START LDA B,I PAGE OF EMA. SO GET THE OLD AND B1777 EMA START PAGE. ADA OBASE AND CALCULATE THE NEW START PAGE ADA STPG# * XOR B,I NOW PLACE IT BACK AND B1777 INTO THE ID EXTENSION UNDER THE XOR B,I RULES OF STA B,I WOO. JMP SWPIN,I SO NOW WE'RE DONE. RETURN TO CALLER. * * NOMAP LDA B PROG SWAPPED BACK INTO SAME PART'N LDB ADBPC MVW D32 RESTORE MAP TO BASE PAGE JMP SWPIN,I RETURN * * $LOW NOP STARTI§þúNG PAGE # OF THE PROG PART'N AREA $HIGH NOP LAST PAGE # OF THE PROGRAM PART'N AREA OLD NOP BUFFER ADDRESS OF OLD MAP INFO NEW NOP BUFFER ADDRESS OF NEW MAP INFO KNTR NOP LOOP COUNTER SET TO -32 OBASE NOP NEG START PAGE # OF LAST PART(N PROG WAS IN STPG# NOP STARTING PAGE # OF THIS PARTITION D34 DEC 34 * HED DISP4 -- PRELIMINARY SETUP FOR DISK CALL * PREST SETS UP FOR A DISC LOAD OR SWAP AS FOLLOWS: * * 1. SETS MEMORY BOUNDS FOR THE PROGRAM * TEMP = #WORDS IN MAIN * TEMP3 = FIRST WORD OF MAIN * TMP = #WORDS IN BASE PAGE * TMP1 = FIRST WORD OF BASE PAGE * * 2. IF SWAP, GET SWAP TRACKS IF REQUIRED * AND SETS SMAN IN THE ID-SEGMENT. * * 3. SETS THE INITIAL DISC ADDRESS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * B = LU OF DISC * * 4. SETS THE NUMBER OF SECTORS: * CN#SC = -NUMBER OF SECTORS/TRACK * * 5. CALLS SETUP TO BUILD THE TRIPLET FOR THE LOAD * * PREST CHECKS THE FOLLOWING OPTIONS: * * 1. SHORT ID-SEGMENT (BG-SEGMENT LOAD) * 2. THE "ALL OF CORE" BIT CAUSES THE WHOLE AREA * TO BE SWAPPED ALONG WITH ALL OF THE AREA * BASE PAGE. * 3. IF SWAP THEN THE FIRST WORD IS ALWAYS THE AREA * BOUNDRY. * 4. IF SWAP AND NO TRACK ASSIGNED THEN SWAP TRACKS * ARE ALLOCATED. * * CALLING SEQUENCE: * * PREST ASSUMES -BGLWA- AND -AVMEM- ARE SET UP FOR PROG TO BE SWAPPED * B = ID-SEGMENT ADDRESS * E = 1 FOR LOAD * E = 0 FOR SWAP OUT * A = BOTTOM OF TRIPLET TABLE * JSB PREST * * ON RETURN: * B = DISC LU * A = DEF OF TRIPLET TABLE FOR XSIO CALL * * ABNORMAL EXIT * A JMP IS MADE TO X0035 IF NO DISC TRACKS ARE AVAILABLE * FOR SWAPPING. * [>þú* INTERNAL TEMP AREA USAGE: * TEMP4 - TRIPLET QUE ADDRESS * TEMP5 - PROGRAM TYPE WORD * TEMP6 - MEMORY ADDRESS POINTER TO ID-SEGMENT. * TMP2 - DISC ADDRESS POINTER TO ID-SEGMENT. SKP PREST NOP STA TEMP4 SAVE THE TRIPLET QUE ADDRESS CLA SET THE START SECTOR STA TEMP2 ADDRESS FOR SWAP OPTION CPB XEQT IF CURRENT EXECUTING STA XEQT PROGRAM CLEAR THE FLAG ADB D14 INDEX TO TYPE WORD LDA B,I GET PROGRAM TYPE TO A STA TEMP5 SAVE IT ALF,ALF ROTATE THE SHORT ID-SEG. BIT ALF,SLA,RAR TO ZERO AND TEST INB,RSS ADB D8 INDEX TO MEMORY ADDRESSES STB TEMP6 SAVE THE MEMORY ADDRESS ADB D4 INDEX TO THE DISC ADDRESS STB TMP2 AND SAVE IT SSA IF SHORT ID-SEG. JMP SEGCK GO CHECK SEGMENT LIMITS ALF,RAL AND D15 CPA D5 IF TYPE 5 JMP SEGCK GO CHECK SEGMENT LIMITS * ******************************************* **E=0IF SWAP,B=0 IF FIRST LOAD******* ******************************************* * SEZ,INB STEP TO SWAP DISC ADDRESS LDB B,I GET SWAP ADDRESS (SKIPPED IF SWAP) CMB,CLE,INB,SZB IF SWAP TRACK OR SWAPPING ISZ TMP2 STEP THE DISC ADDRESS TO SMAN. PRES1 LDB TEMP6,I GET THE ID-SEG LOW MAIN ADD. ISZ TEMP6 STEP THE MEMORY ADDRESS TO HIGH MAIN STB TEMP3 CMB,INB NEGATE SEZ IF FIRST LOAD JMP PRES2 GO SET UP TRUE TO ID-SEG. * LDA TMP2 INA LDA A,I STA ZIDX0 JSB IDXAD GET ID EXT ADDR JMP PRES6 NOT EMA, ZIDX0=0 STA ZIDX0 SAVE ID EXT ADDR INA LDA A,I RAR AND B76K ADB A JMP PRES5 MAKE SURE (A)#0 * PRES6 LDA TEMP6 INDEX TO # OF PAGES WORD. ADA DM2 LDA A,I –ˆþúAND B76K GET # OF WORDS LDB A TO B REG * CCA (A) = -1 SWAP ALL OF PTTN PRES5 STB TEMP SET #WORDS IN MAIN ISZ TEMP6 STEP TO LOW BASE PAGE LDB TEMP6,I GET LOW BP STB TMP1 AND SET IT ISZ TEMP6 STEP TO HIGH BASE PAGE CMB,INB SZA INITIAL LOAD? JMP PRES9 NO, USE ALL OF POSSIBLE BP (A#0) * ADB TEMP6,I YES, USE ACTUAL HIGH BP BOUND (A=0) RSS PRES9 ADB BPA2 STB TMP SET BASE PAGE SIZE CMA,CLE,INA SET E IF FIRST LOAD LDA TMP2,I GET THE DISC ADDRESS SZA IF NONE SKIP JMP PRES7 DISC DEFINED GO SET UP * * GET SWAP TRACKS * LDA B GET BASE PAGE SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TMP SAVE LDA TEMP WHILE CHECK MAIN SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TEMP SAVE MAIN SIZE FOR SETUP ADA TMP ADD IF ANY ROUNDED UP FROM BP ALF,ALF DIVIDE BY 128 WORDS RAL TO GET #SECTORS STA PRSCT CLB DIV #SCT DIVIDE BY MIN #SECTORS/TRACK SZB IF REMAINDER INA BUMP STA SETUP SET #TRACKS IN SMAN * LDB TMP2 INB INCRE TO EMA WORD LDA B,I SZA EMA PROG? JMP PRESA YES, ADD EMA TRACK NEEDS * STA EMTRK NO, JUST SWAP PROG LDA SETUP JMP PRESB * PRESA AND B1777 GET EMA SIZE (IN PAGES) ALF,RAR MULT BY 8 TO GET #SECTORS ADA PRSCT ADD #SECTORS NEEDED FOR PROG CLB DIV #SCT DIVIDE BY #SECTORS/TRACK SZB TO GET # OF TRACKS INA BUMP #TRACKS IF ANY OVERFLOWED LDB SETUP CMB,INB SUBTRACT #TRACKS FOR PROG ADB A FROM TOTAL g¹NLH#TRACKS STB EMTRK FOR #TRACKS IN EMA * PRESB CLB GO TO SYS TO GET TRACKS JSB $DREQ ERB,SLB SET LEAST LU BIT IN E SKIP IF NONE ALF,SLA,ALF ROTATE TRACK SKIP ALWAYS JMP X0035 NO TRACKS EXIT TO SWITCHER * ERA,CLE SET LU BIT IN TRACK WORD IOR SETUP ADD THE # TRACKS STA TMP2,I AND SET BACK IN ID-SEG * LDB ZIDX0 (A)=SWAP WORD, (E)=0 SZB,RSS EMA PROG? JMP PRES7 NO * STA SETUP SAVE (A) TEMPORARILY ADB D2 INDEX TO EMA SWAP TRACKS WORD LDA EMTRK STA B,I SET #EMA SWAP TRACKS LDA SETUP RESTORE (A) * * DECODE TRACK/SECTOR ADDRESS IN A * PRES7 AND B177 MASK OUT THE SECTOR/#TRACKS CLB,SEZ,INB SET B TO 1,SKIP IF SWAP STA TEMP2 SET SECTOR ADDRESS XOR TMP2,I GET THE TRACK/LU ASL 1 SET LU IN B/TRACK IN HIGH A ²˜Nÿÿþú ALF,ALF BRING DOWN THE TRACK STA TEMP1 SET THE TRACK ADDRESS LDA SECT2 GET THE SECTOR SIZE FOR LU 2 SLB IF LU IS 3 LDA SECT3 USE 3'S NUMBER CMA,INA SET NEGATIVE STA CN#SC NUMBER OF SECTORS/TRACK * * NOW CALL SETUP TO BUILD THE TRIPLETS * STB TEMP6 SET LU IN A SAFE PLACE LDA TEMP4 GET THE TRIPLET ADDRESS JSB SETUP SET UP THE MAIN LDB TMP STB TEMP SET UP FOR THE LDB TMP1 BASE PAGE STB TEMP3 AND JSB SETUP GO BUILD IT'S TRIPLETS LDB TEMP6 RESTORE THE LU TO B JMP PREST,I NOW THAT WASN'T HARD WAS IT? SPC 2 * PRES2 CLA (A) = 0 TO USE REAL BOUNDS ADB TEMP6,I JMP PRES5 SPC 2 SEGCK LDB FENCE IS IT BELOW THE FENCE CMB,INB ADB TEMP6,I LOW MAIN(SEGMENT) SSB JMP SEGER YES GO ABORT * LDB TEMP6 INB LDB B,I GET HIGH MAIN(SEGMENT) CMB,INB ADB BGLWA DOES IT FIT IN PART'N INB CCE,SSB,RSS SET E FOR OK COND'N JMP PRES1 IT WILL FIT * SEGER LDB D8 IT WONT FIT JMP $SCXX GO PRINT SC08 AND ABORT * C177 OCT 177600 DM2 DEC -2 #SCT NOP EMTRK NOP PRSCT NOP HED DISP4 -- DISK CALLING SEQUENCE GENERATOR * * DISK READ/WRITE CALLING SEQUENCE GENERATOR ROUTINE * ON ENTRY * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * A = PARAMETER TABLE ADDRESS * * THE DISC PARAMETER GENERATOR FUNCTION IS TO GENERATE * * PARAMETERS FOR DISC CALL GUARANTEEING THAT ALL * * TRACK CROSSING CALLS ARE BROKEN DOWN INTO SUB-CALLS * * SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * * THE CALLS ARE BROKEN UP IN TRIP…ÍþúLETS OF * * STARTING CORE MEMORY ADDRESS * * NUMBER OF WORDS TO TRANSFER * * STARTING TRACK/SECTOR ADDRESS. * * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING * * THE LAST TRIPLET. * * * SETUP NOP ENTRY/EXIT LDB TEMP COMPUTE NUMBER OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA DM3 SET UP TRIPLET STA DSTAD ADDRESS ADB B177 ROUND UP NUMBER ASR 7 OF SECTORS BLS STB TEMP5 SAVE NUMBER OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B ADA CN#SC SUB CURRENT # SECTORS/TRACK LDB TEMP3 STB DSTAD,I STORE STARTING MEMORY ADDRESS ISZ DSTAD INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES, USE REST OF TRACK IF OVER. ASL 6 UPSET LDB TEMP1 FORM BLF,RBL TRACK RBL,RBL ADDRESS ADB TEMP2 AND SECTOR ADDRESS DST DSTAD,I STORE LAST TWO WORDS OF TRIPLET DSTAD EQU *-1 ADA TEMP3 UPDATE STARTING STA TEMP3 MEMORY ADDRESS LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB DSTAD,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUB 1 FOR CORRECT NEXT TRIPLET ADA DSTAD ADDRESS CALC. JMP SETU1 GO TO NEXT LOOP SPC 1 SETI0 LDA TEMP SET FOR LAST JMP UPSET iþú TRIPLET HED DISP4 -- READ SETUP * * SETUP TO READ IN BACKGROUND DISK RESIDENT PROGRAM * OR BACKGROUND DISK RESIDENT SEGMENTS * $BRED EQU * $SGLD NOP ENTRY/EXIT CLA CPA SGSWP SEGMENT LOAD CALL BUSY? JMP SGLD1 NO, SO DO SEGMENT LOAD * LDB XEQT YES, SEGMENT LOAD CALL BUSY STA XEQT CLEAR CURRENT EXECUTING PROG STB SGSUP AND SET IT SEGMENT SUSPENDED JMP X0035 TRY NEXT SCHEDULED PROG * SGLD1 STB SGTMP SAVE THE SHORT ID SEG ADDRESS LDA XEQT GET THE MAINS ID SEG ADDRESS JSB MATEN NOW SET UP THE MAT POINTERS LDB SGTMP GET THE SHORT ID ADDRESS * LDA D2 IOR MFLGS SET READ IN WAIT FLAG STA MRDFL,I PTTN STATUS =2 LOAD SEG CLA,CCE,INA (E=1) FOR PREST TO LOAD STA SGRQ SET READ REQUEST LDA MPRIO,I STA SGPR SET PRIORITY LDA STRPA JSB PREST ADB MSIGN SET SEGMENT LOAD FLAG INTO $XSIO CALL STB SGLU SET LU STA STRP SET TRIPLETS ADDR LDA MID,I AFTER PREST CALL RETURNS STA SGSWP SET SEGMENT I/O CALL BUSY LDA MRDFL STA SRDFL SAVE FLAG WORD ADDR LDA MFLGS STA SFLGS SAVE HIGH BITS * JSB $XSIO SGLU NOP LOGICAL UNIT DEF X0422 COMPLETION ADDR X0455 NOP LINK WORD SGRQ OCT 1 REQUEST CODE STRP DEF STRIP TRIPLETS ARRAY ADDR SGPR NOP PRIORITY SGSWP NOP ID SEGMENT ADDR LDB MID,I JSB $LIST SUSPEND SEGMENT UNTIL DONE OCT 402 JMP $SGLD,I RETURN, SEGMENT LOAD INITIATED * * SRDFL NOP SGTMP NOP SFLGS NOP MSIGN OCT 100000 STRPA DEF STRIP SGSUP NOP * * * SEGMENT LOAD COMPLETION SECTION * X0422 STB TEMP SAVE COMPLETION STATUS LDB SFLGS INB STB SRDFL,I FORCE PTTN STATUS=1 LDB SGSWP CLA STA SGSW“ÈþúP CLEAR BUSY FLAG STA SGSUP CLEAR SEGMENT SUSPEND FLAG LDA SGRQ JMP X0125 DO OTHER COMPLETION STUFF * HED DISP4 -- SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * SETS FENCE REGISTER TO 0 * * CLEARS XEQT * * SCHEDULES 'FMGR' IF PRESENT * STARTS THE CLOCK BY CALLING $SCLK IN RTIME MODULE * THIS SECTION IS EXECUTED ONCE - IT IS OVERLAYED ******************************************************************** * $ZZZZ NOP * STB DFMG SET THE NAME ADDRESS CLC 0 CLEAR INTERRUPT SYSTEM JSB MPINT GO DO MAP STUFF * * * LDA $MNP GET THE MAX # OF PART'NS CMA,INA AND SET NEG FOR LOOP N#PTN LDB $MATA GET THE MATA TABLE ADDRESS * MADD STA *-1 LOOKS STRANGE DOESN'T IT ? NXPTN STB *-1 * ADB D3 INDEX TO THE START PAGE WORD LDA B,I AND B1777 KEEP ONLY PAGE BITS STA STPG# INB LDA B,I GET THE # OF PAGES IN THE PART'N AND B1777 KEEP ONLY PAGE BITS ADA STPG# A = START PG# + # OF PAGES LDB $HIGH GET THE HIGHEST PAGE # SO FAR CMB,INB NOW IF THE CURRENT SUM IS LARGER ADB A THAN THE PAST SUM SSB,RSS THEN USE THE CURRENT SUM AS LAST PAGE STA $HIGH IN THE SYSTEM (USED BE SWAPPING ROUTINES) * LDB MADD GET THE CURRENT PART'N MATA ADDRESS ADB D7 INDEX TO THE NEXT ONE ISZ N#PTN WE DONE ? JMP NXPTN NO, SO DO NEXT PARTITION. * LDB $MATA YES, SO NOW FIGURE ADB D3 OUT THE START OF THE PARTITION AREA LDA B,I GET THE PAGE # AND B1777 KEEP ONLY PAGE BI“þúTS STA $LOW SET AS START OF THE PARTITION AREA * * LDA SWAP SET UP THE SWAP DELAY ALF,ALF AND B377 CMA,INA SET NEGATIVE STA SWPTM SET THE VALUE * LDA SECT2 FIND MINIMUM # SECTORS/TRACK LDB SECT3 SUBTRACT # FOR LU 3 CMB,INB,SZB FROM # FOR LU 2. ADB SECT2 IF POSITIVE RESULT, CMB,SSB,INB,SZB LU 3 IS SMALLER. LDA SECT3 OTHERWISE, USE LU 3 ARS CONVERT 64 WORD SECTORS STA #SCT TO 128 WORD SECTORS LDA SKEDD SAVE THE CURRENT STA ZWORK SCHEDULE POINTER SPC 1 JSB $LIST SCHEDULE 'FMGR' PROGRAM OCT 201 IF IT IS IN THE SYSTEM. DFMG DEF * SZA JMP ZEXIT NO - BTRIP NOP END OF BG TRIPLETS CHKBG EQU BTRIP-$ZZZZ-21 INSURE AT LEAST 7 TRIPLETS LDA SKEDD LDB A,I INSURE 'FMGR' IS CPB ZWORK FIRST IN THE SWP SCHEDULED LIST. STB SKEDD STA B,I CLB STB A,I LDA SKEDD GET THE FMGR ID-SEG ADDRESS INA AND LDB TATLG INHIBIT ALL TRACK STB A,I ALLOCATIONS UNTIL CCB 'FMGR' EXECUTES. STB TATLG 'FMGR' UNDOES THIS SPC 1 JMP ZTYPE * FNMP OCT 2000 B1740 OCT 1740 * ********MAP INITIALIZATION************** ******* MPINT NOP LDA $MPFT ADA D4 LDA A,I GET START OF SSGA ADA DM1 STA $SGAF RTRIP NOP END OF RT TRIPLETS CHKRT EQU RTRIP-BTRIP-21 INSURE AT LEAST 7 TRIPLETS * LDA $DVPT SET UP LOGICAL ADDR ALF,ALF IN DRIVER PARTITION FOR RAL,RAL ACCESSING USER'S BP COPY IOR B1740 OF USER MAP STA ADBPC * LDA $MPFT INA LDA A,I GET START OF MEM RES LIB AND B76K ALF RAL,RAL STA B LDA LBORG AND B76K ALF RAL,ÞäþúRAL STA LBREG LIB PAGE REGISTER START CMA,INA ADA B STA LB#PG NUMBER OF PAGES IN LIB LDA $MRMP ADA LBREG LDA A,I STRIP NOP END OF SEGMENT TRIPLETS CHKSG EQU STRIP-RTRIP-21 INSURE AT LEAST 7 TRIPLETS AND B1777 STA LBPG# LDA LBREG ADA B40 STA LBREG * LDA $CMST USE AREA FROM START OF COMMON CMA,INA TO THE END OF USER MAP ADA D32 FOR DOING I/O ON CHUNKS OF STA CHKSZ EMA TO BE SWAPPED LDA $CMST ADA D32 STA CHKRG STARTING REG# IN USER MAP LDA $CMST ALF,ALF RAL,RAL STA CHKAD SAVE LOGICAL ADDR * LDA $MRMP GET ADDRESS MEM RES MAP USA LOAD USER MAP CLA XMA SET DMA1 FROM SYS MAP INA XMA SET DMA2 FROM SYS MAP LDA BPA2 GET LAST USER LINK INA INCREASE TO FIRST SYSTEM LINK IOR FNMP SET BIT 10 TO SHOW LOWER MAPPED LFA SET FENCE FOR BP JSB LSTIN INITIALIZE PTTN LIST PTRS JMP MPINT,I * CTRIP NOP END OF MOTHER PTTN TRIPLETS CHKCH EQU CTRIP-STRIP-21 INSURE AT LEAST 7 TRIPLETS CTRPA DEF CTRIP HED DISP4 -- ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XIDEX EQU 1645B ADDR OF CURR ID SEG EXT XMATA EQU 1646B ADDR OF CURR MAT ENTRY XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * INTBA EQU 1654B SKEDD EQU 1711B * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OV_Œ*($ERFLOW SWAP EQU 1736B * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BGDRA EQU .+68 FWA OF BGG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BGLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH ORIGINALLY 2716 (8) ? EQU *-2716B END $ZZZZ **ÿÿ ÿý¦Qø ÿ92067-18016 1805 S C0122 &RTIM4 RTE-IV TIME PROCESSOR             H0101 @ þúASMB,R,L,C ** RT TIME MODULE ** HED REAL TIME TIME MODULE * NAME: RTIME * SOURCE: 92067-18016 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,C.M.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RTIME,0 92067-16014 REV.1805 780104 * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * RTIME ENTRY POINT NAMES * ENT $TADD,$CLCK,$TREM,$TIMV ENT $ETTM,$TIMR,$ONTM,$TMRQ,$SCLK * * RTIME EXTERNAL REFERENCE NAMES * EXT $INER,$DEVT,$LIST,$XEQ EXT $ERMG,$MSEX,$SYMG,$IDSM EXT $WORK,$BATM,$TIME * ******************************************************************** * * THE RTIME MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * * 1. TIME PROCESSOR ROUTINES * * 2. CLOCK START UP ROUTINE. * * ******************************************************************** HED REAL TIME CLOCK-TIME LIST PROCESSING ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP-2100 REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMENT REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. SCHEDULE PROGRAMS AT THE REQUESTED TIME AND COMPUTE ITS* * NEXT START TIME. * * 3. ADD PROGRAMS TO THE TIME LIST. * * 4. REMOVE PROGRAMS FROM8Óþú THE TIME LIST. * * 5. OUTPUT CURRENT SYSTEM TIME TO USER ARRAY. * * 6. SET ID SEGMENT VALUES AS REQUESTED BY USER. * ******************************************************************** SPC 1 * THE $CLCK ROUTINE FUNCTIONS AS FOLLOWS: * * THE ROUTINE IS ENTERED EVERY 10 MILLISECOND DUE * * TO TIME BASE GENERATOR INTERRUPTS. * * THE TIME VALUE IS INCREMENTED BY 10 MILLISECONDS. * * THE TIME VALUES OF EACH PROGRAM IN TIME LIST IS * * COMPARED TO THE CURRENT TIME. IF THE TIMES * * COMPARE AND THE PROGRAM IS DORMANT, A SCHEDULE * * REQUEST IS MADE VIA LIST PROCESSOR. REGARDLESS * * OF PROGRAM STATUS, THE NEXT START TIME IS * * COMPUTED UNLESS THE MULTIPLE VALUE IS ZERO- * * WHICH MEANS THAT THE PROGRAM IS TO BE REMOVED * * FROM TIME LIST. * * THE TIME-OUT CLOCKS FOR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * $CLCK ISZ $TIME STEP THE LOW ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS ISZ $TIME+1 STEP THE HIGH ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL STA $TIME DAYS WORTH OF STB $TIME+1 OF TENS OF MS. ISZ $TIME+2 STEP THE DAYS/YEARS COUNTER * * CHECK IF TIME TO SCHEDULE PROGRAM * CL010 LDB TLIST TIME LIST CL011 CLE,SZB,RSS IF THRU PROCESSING IT, GO JMP TOBAT PROCESS BATCH TIME-OUT STB POINT SAVE TIME LINK ADB D2 B NOW PTS TO IDSEG TIME VAULE DLD B,I GET THE SCHEDULEÉþú TIME CPA $TIME IF BOTH WORDS MATCH CCE THEN CPB $TIME+1 THE SEZ,RSS TIME IS JMP CH010 JSB TMSCH NOW SO SCHEDULE THE PROG. * * INCREMENT TO NEXT PROGRAM IN LIST * CH010 LDB POINT,I GET ADDR OF NEXT PROG IN LIST JMP CL011 GO TO COMPARE NEXT PROG IN LIST * * IF CURRENT PGM IS BATCH THEN STEP THE TIMER * TOBAT LDB XEQT GET THE BATCH BIT SZB IF NO CURRENT PGM SKIP CPB DD.RT IF CURRENT PGM IS D.RTR DO NO TIME JMP IOTOP BUT GO DO DEVICE TIME OUTS * CPB $IDSM IF SMP JMP IOTOP ADB D20 TO LDA B,I GET THE BATCH FLAG SSA,RSS IF NOT BATCH JMP IOTOP SKIP TEST * ISZ $BATM STEP BATCH TIMER JMP IOTOP IF NO ROLL OVER EXIT * ISZ $BATM+1 ELSE STEP NEXT WORD JMP IOTOP IF NO ROLL OVER SKIP * RAL PUT FATHER BIT IN 15. SSA IF THIS IS A SON JMP ABOR THEN ABORT HIM * RAR RESTORE A IOR B10K SET THE BREAK FLAG STA B,I AND RESET THE WORD JMP IOTOP CONTINUE WITH TIME OUTS * ABOR LDA ATI GET THE TI ABORT MESSAGE LDB BLANK JSB $ERMG GO ABORT HIM * * PROCESS DEVICE TIME-OUT CLOCKS * IOTOP LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA $TIMV ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA D14 OF FIRST EQT ENTRY LDB A,I LOAD WORKING CLOCK- SZB IS IT ACTIVE? ISZ A,I YES: INCREMENT IT INA,RSS IT HAS NOT TIMED-OUT JMP $DEVT GO TO TIME-OUT PROCESSOR ISZ $TIMV THRU? JMP IOTO2 NO: GO DO NEXT ONE JMP $XEQ YES; NO TIME-OUTS-RETURN SPC 1 D20 DEC 20 M7777 OCT 7777 RS1 OCT 25000 RS2 OCT 177574 PRS1 OCT 153000 PRS2 OCT 203 BLANK ASC 1, HED REAL T¸þúIME CLOCK SCHEDULE ON TIME ROUTINE * * PROGRAM TO BE SCHEDULED * * THE TMSCH ROUTINE SCHEDULES THE PROGRAM IF DORMANT * THEN COMPUTES ITS NEXT SCHEDULE TIME FROM ITS * RES CODE AND MULT FACTOR IN ITS ID-SEGMENT. * IF THE RES CODE IS ZERO THE PROGRAM IS REMOVED FROM * THE TIME LIST. * * THE CALLING SEQUENCE IS: * SET POINT TO THE ADDRESS OF THE TIME LINK WORD * JSB TMSCH * TMSCH NOP CCB COMPUTE THE STATUS ADDRESS ADB POINT LDA B,I GET THE STATUS AND D15 GET THE LOW BITS SZA IF NOT DORMANT JMP CH026 FORGIT IT ADB DM15 ELSE SET B TO THE ID-SEG ADDRESS JSB $LIST CALL LIST PROCESSOR TO SCHED PROG OCT 401 THE PROGRAM * * CHECK IF NEXT SCHEDULE TIME TO BE COMPUTED * CH026 LDB POINT INB LDA B,I RES CODE/MULT FACTOR AND M7777 SZA,RSS IF ZERO, THEN NO NEW START TIME JMP CH040 GO REMOVE PROG FROM LIST STA TEMP SAVE MULTIPLICATION FACTOR JSB TUDAT GO UPDATE THE SCHEDULE TIME JMP TMSCH,I RETURN * * REMOVE PROGRAM FROM TIME LIST * CH040 LDA B10K CLEAR THE RESOLUTION TOO. STA B,I AND RESET IN THE ID-SEGMENT. LDB POINT VALUE OF TLINK JSB $TREM GO TO REMOVE PROGRAM JMP TMSCH,I GO TO PROCESS NEXT PROGRAM HED REAL TIME CLOCK PROCESSING ID-TIME UPDATE * TUDAT USES THE RES AND MULT FROM THE ID-SEGMENT TO * UPDATE THE EXECUTE TIME OF THE PROGRAM WHOES ID- * SEGMENT RESOLUTION CODE ADDRESS IS IN B. * * CALLING SEQUENCE: * * SET TEMP TO THE MULT FACTOR * SET B TO THE RES CODE ADDRESS * JSB TUDAT * TUDAT DEF SETMS ENTRY POINT LDA B,I GET THE RES CODE TO A INB SET STB TEMP1 TEMPS TO THE TIME INB ADDRESSES STB TEMP2 IN THE ID-SEGMENT RAL,CLE,SLA,RAL IF HOURS qþúJMP HR GO DO SPECIAL HOURS UPDATE RAL,CLE ELSE SET UP AND D7 FOR THE APPROPIATE ADA TTAB BASE LDA A,I AND MULTIPLY BY THE MULT. CH030 MPY TEMP CH031 ADA TEMP1,I ADD THE CURRENT VALUE SEZ IF OVERFLOW INB STEP B ADB TEMP2,I ADD THE HIGH BITS. STA TEMP1,I RESTORE THE NEW TIME STB TEMP2,I TO THE ID-SEG. CLE,SSB IF NEGATIVE RESULT THEN JMP TUDAT,I EXIT * LDA RS1 POSITIVE RESULT SO ADD NEG. OF LDB RS2 DAY TO MAKE NEGATIVE JMP CH031 * HR LDA TEMP FOR HOURS FIRST CLB INSURE LESS THAN DIV D24 ONE DAY LDA B RESULT IS MODULO 24 MPY D15 NOW SET UP TO MULTIPLY BY 60,000 STA TEMP IN TWO STEPS TO PREVENT OVERFLOW LDA D24K FIRST BY 15, JMP CH030 AND NEXT BY 24,000 * NOP TLIST NOP TOP OF TIME SCHEDULE LIST DAYS OCT 4552 RELEASE DATE. TTAB DEF * TTAB1 DEC 1 TTAB2 DEC 100 TTAB3 DEC 6000 D24K DEC 24000 D2 DEC 2 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D24 DEC 24 DM15 DEC -15 SPC 4 * * SYSTEM START TBG ROUTINE * * THE $SCLK ROUTINE STARTS THE CLOCK PROVIDES * AN ENTRY POINT TO AID THE POWERFAIL ROUTINE. * * ON FIRST ENTRY THIS ROUTINE: * * 1. CONFIGURES IT SELF * 2. STARTS THE TBG. * 3. PRINTS "SET TIME" * 4. EXITS TO THE DISPATCHER. * * ON SUBSEQUENT ENTRIES IT IS A SUBROUTINE TO RESTART * TIME BASE GENERATOR. * $SCLK JMP CONFI GO CONFIGURE ON FIRST ENTRY LDA D2 PROGRAM THE TBG FOR 10'S OF MS. OTATB OTA 0 STCTB OCT 1100 CONFIGURED TO A STC TBG,C STFTB OCT 1600 CONFIGURED TO A STF TBG JMP $SCLK,I RETURN SPC 2 CONFI LDA TBG CONFIGURE THE TBG TEMP IOR OTATB MAKE AN OTA TBG TEMP1 STA OTATB SET IT TEMP2 IOR STCTB FORM AN STC TBG,÷­þúC TCC STA STCTB SET THE STC XOR STFTB SET UP THE STF STA STFTB TLINC JSB $SCLK START THE TBG POINT LDA TUDAT SEND THE DD.RT STB DD.RT SAVE D.RTR ID-SEG. ADDRESS JSB $SYMG SET TIME JMP $XEQ MESSAGE AND GO TO THE DISPATCHER SPC 2 SETMS DEC -10 LENGTH OF SET TIME MESSAGE OCT 6412 PUT CR/LF OUT FIRST ASC 2,SET TIME ATI ASC 1,TI TI USED BY BATCH TIMER HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * RQP3 (OPTIONAL) CONTAINS ADDRESS OF YEAR BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * ARRAY(5) = DAYS * RQP3,I = YEAR (197X) * * E IS SET * A IS THE YEAR * $TIMV ASC 1,ME ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS ×ûþú STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS ADA D1970 ADD THE BASE YEAR TO YEAR STA RQP3,I SET YEAR JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR DM197 DEC -1970 NEG OF BASE YEAR HED REAL TIME ON REQUEST FOR TIME SCHED PROGRAM * ON REQUEST CONTINUATOR * * IF CURRENT TIME VALUES ARE ZERO OR NOW IS CODED THEN * THE CURRENT TIME IS PUT IN THE ID-SEG. AND R/M USED * TO COMPUTE THE NEXT TIME. * * IF CURRENT TIME VALUES ARE NOT ZERO THE PROGRAM IS * JUST PUT IN THE TIME LIST. * * CALLING SEQUENCE * * A=-1 IF NOW OPTION * A#-1 IF NOT NOW BUT PUT IN TIME LIST * B=ID-SEGMENT TIME ADDRESS. * * JMP $ONTM * $ONTM STB DLDAD SET LOAD ADDRESS STA TCC SET NOW FLAG FOR LATER INA,SZA,RSS IF NOW SKIP LOAD JMP NOW DLD DLDAD,I GET THE CURRENT TIME VALUES DLDAD EQU *-1 SZA,RSS IF TIME NOT ZERO SZB THEN JMP TIMIN THEN GO PUT IN TIME LIST NOW DLD $TIME GET CURRENT TIME DST DLDAD,I AND SET IN THE ID-SEG TIMIN LDB DM2 COMPUTE TIME LIST ADDRESS ADB DLDAD AND STB POINT AND SET FOR LIST ROUTINE JSB $TADD ADD PROG TO TIME LIST. ISZ TCC SKIP IF NOW RSS JSB TMSCH SCHEDULE THE PROG. AND UPDATE MESEX CLA SET A FOR NO ERROR JMP $MSEX HED $TIMR ROUTINE SETS UP ID SEGMENT TIME VALUES * THE $TIMR ROUTINE WHICH ALLOWS USER TO ENTER TIME VALUES * * INTO AN ID SEGMENT FUNCTIONS AS FOLLOWS: * * IF PROG VALUE IS ZERO, THEN CURRENT EXECUTING PROG. * * AND IF NON-ZERO, THEN SEARCH FOR ID SEGMENT * Öþú* ADDRESS. * * IF RESOLUTION CODE IS NON-ZERO, THEN RES/MULT WORD * * STORED. THE NEXT VALUE IS CHECKED FOR + OR -. * * IF PLUS, THEN NEXT START TIME VALUES GIVEN AND * * ARE STORED AND PROGRAM ENTERED INTO TIME LIST. * * IF MINUS, THEN THE COMPLEMENT OF VALUE IS ADDED* * TO THE CURRENT TIME AND ENTERED INTO THE ID * * SEGMENT. IF PROG VALUE IS ZERO, THIS IS TO BE A* * TIME DELAY OF CURRENT PROGRAM AND THUS PROGRAM * * IS SET DORMANT VIA LINK PROCESSOR BUT POINT OF * * SUSPENSION IS NOT CLEARED. IF PROG VALUE IS NON* * ZERO, THEN PROGRAM IS ENTERED INTO TIME LIST. * * THIS IS METHOD FOR SPECIFYING AN INITIAL OFFSET* * TIME. * * * ROUTINE TO SET ID SEGMENT TIME VALUES * CALLING SEQUENCE * JSB EXEC * DEF *+6 OR DEF *+9 * DEF REQUEST CODE ADDRESS RQP1 * DEF PROG RQP2 * DEF RES RQP3 * DEF MULT RQP4 * DEF OFFSET OR DEF HRS RQP5 * DEF MINS RQP6 * DEF SECS RQP7 * DEF TENS OF MSEC RQP8 * WHERE * PROG = 0 IF CURRENTLY EXECUTING * = ADDRESS OF PROGRAM NAME * RES = 1 FOR 10 MILLISECOND RESOLUTION * = 2 FOR SECONDS RESOLUTION LIST * = 3 FOR MINUTES RESOLUTION LIST * = 4 FOR HOURS RESOLUTION LIST * MULT = 0 FOR N0 MULTIPLE VALUE * $êþú = N A POSITIVE INTEGER FOR COMPUTING * NEXT SCHEDULE TIME * OFFSET= M A NEGATIVE INTEGER FOR COMPUTING INITIAL * OFFSET TIME * HRS= START TIME HOURS * MINS= START TIME MINUTES * SECS= START TIME SECONDS * TENS= START TIME TENS OF MILLISECONDS * * EXEC PRE-PROCESSOR CHECKS FOR RESOLUTION CODE * ERRORS AND FINDS THE ID-SEGMENT ADDRESS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JMP $TIMR SKP $TIMR ADB D16 GET ADDRESS OF TIME LINK STB TCC AND SAVE IT INB STEP TO RESOLUTION ADDRESS STB TEMP1 AND SAVE LDA B,I GET RESOLUTION CODE/T/MULT INB STEP TO TIME LOCATION STB DSTAD SAVE THE ADDRESS * ALF,ERA SAVE BIT 12 SINCE PROGRAM MAY XLA RQP4,I ALREADY BE IN THE TIME LIST ALF,ERA COMBINE MULT AND SAVED T-BIT XLB RQP3,I RESOLUTION TO B LSR 3 SHIFT RESULT TO A STA TEMP1,I SET IT IN THE ID-SEG. XLA RQP5,I NEGATIVE IF OFFSET SSA,RSS POSITIVE IF START TIME JMP TI100 CMA,INA SET POSITIVE AND STA TEMP SAVE IN TEMP XLA RQP2,I CHECK IF CURRENT XEQ PROGRAM SZA JMP TI012 NO * LDB XEQT YES, SET THE SAVE- STB $WORK RESOURCES BIT IN STA XEQT THE PROGRAM'S STATUS ADB D15 WORD. LDA B,I (CLEAR XEQT SO THAT $LIST WILL IOR B200 SET THE NP BIT IF THE USER IS STA B,I MODIFING ITS ON TIME VALUES). JSB $LIST MAKE PROGRAM DORMANT OCT 300 TI012 LDA $TIME GET THE CURRENT TIME LDB $TIME+1 AND SET DST DSTAD,I IT IN THE ID-SEG DSTAD EQU *-1 LDB TEMP1 GET THE RES. CODE ADDRESS TO B JSB TUDAT UPDATE THE TIME * TI015 LDB TCC JSB PPþú$TADD ENTER PROG INTO TIME LIST JMP $XEQ DONE - EXIT TO DISPATCHER * * GIVEN START TIME * TI100 XLA RQP5,I BRING PARAMETERS 5 - 8 STA LOCL1 LOCALLY. XLA RQP6,I STA LOCL2 XLA RQP7,I STA LOCL3 XLA RQP8,I STA LOCL4 * LDA DEFLC NOW SET UP LOCALL ADDRESSES STA RQP5 FOR THE $ETTM ROUTINE INA STA RQP6 INA STA RQP7 INA STA RQP8 * LDB DSTAD SET B TO THE TIME ADDRESS AND JSB $ETTM GO TO STORE VALUES IN ID SEGMENT JMP TI015 GO PUT PROG IN TIME LIST * DM2 DEC -2 B200 OCT 200 DEFLC DEF LOCL1 LOCL1 NOP LOCL2 NOP LOCL3 NOP LOCL4 NOP HED REAL TIME CLOCK PROCESSOR SET TIME IN ID-SEG * $ETTM SETS A TIME IN THE REFERENCED ID-SEGMENT. * * CALLING SEQUENCE * * RQP5,I=HOURS * RQP6,I=MINUTES * RQP7,I=SECONDS * RQP8,I=TENS OF MS. * * B=TIME ADDRESS IN THE ID-SEG. * $ETTM NOP ENTRY POINT STB DSTA2 SAVE THE ID-SEG. ADDRESS LDA RQP7,I GET SECONDS MPY TTAB2 CONVERT TO MS (MPY D100) ADA RQP8,I ADD THE MS VALUE AND STA RQP8 AND SAVE LDA RQP5,I GET HOURS MPY D60 CONVERT TO MINUTES ADA RQP6,I ADD MINUTES MPY TTAB3 CONVERT MINUTES TO MS (MPY D6000) CLE PREPARE FOR ADD ADA RQP8 ADD MS VALUE SEZ IF OVERFLOW INB STEP HIGH PART SET01 CLE,SSB IF POSITIVE JMP SET02 ADA RS1 SUBTRACT 24 HRS SEZ,CLE UNTIL INB ADB RS2 IT IS JMP SET01 NEGATIVE SET02 DST DSTA2,I SET THE VALUE IN THE ID-SEG. DSTA2 EQU *-1 JMP $ETTM,I RETURN HED ADDITION OF PROGRAM TO TIME RESOLUTION CODE LIST * THE $TADD ROUTINE FUNCTIONS AS FOLLOWS: * * IF RESOLUTION CODE IS ZERO, THEN EXIT * * ™/þú IF NON-ZERO RESOLUTION, AND PROGRAM NOT IN TIME LIST* * (BIT 12 OF RES/T/MULT 0), THEN SET BIT 12 OF * * MULT WORD TO SIGNIFY THAT IT IS IN TIME LIST. * * IF TIME LIST IS NULL, THEN SET IT TO POINT TO * * PROGRAM TIME LINK AND SET TLINK TO ZERO. * * IF PROGRAM NOT IN LIST, THEN IT IS ADDED TO * * TOP OF TIME LIST AND ITS TLINK VALUE MADE * * TO POINT TO THE PREVIOUS TOP OF LIST * * PROGRAM. * * * * * ADDING A PROGRAM TO A TIME RESOLUTION CODE LIST * CALLING SEQUENCE * LDB ADDRESS OF ID SEGMENT TLINK VALUE * JSB $TADD * $TADD NOP STB TLINC SAVE TLINK ADDRESS INB INCR TO RES CODE/MULT FACTOR ADD LDA B,I ALF,CLE,ERA AND D7 SZA,RSS JMP $TADD,I EXIT SEZ PROG IN TIME LIST? JMP $TADD,I YES, SO EXIT * LDA B,I IOR B10K SET T BIT STA B,I LDB TLIST LOAD VALUE OF TOP OF LIST LDA TLINC SET LINK OF NEW PROG TO PREVIOUS STB A,I OF TIME LIST STA TLIST SET TOP OF TIME LIST TO NEW PROG TLINK ADDRESS JMP $TADD,I RETURN HED REMOVE A PROGRAM FROM TIME LIST * * * THE $TREM ROUTINE FUNCTIONS AS FOLLOWS: * * IF PROGRAM NOT IN TIME LIST, THEN EXIT * * IF PROGRAM IN TIME LIST, THEN CLEAR BIT 12 OF * * RES/T/MULT TO INDICATE NOT IN TIME LIST. * * A SEARCH IS MADE OF THE TIME LIST PROGRAMS * * UNTIL PROGRAM FOUND OR END OF LIST. THE * * TLINK VALUES ARE CHANGED AS NECESSARY. * CÒþú* * * * CALLING SEQUENCE * LDB TLINK ADDRESS OF ID SEGMENT * JSB $TREM * $TREM NOP ENTRY/EXIT STB TLINC COMPUTE LIST ADDRESS INB LDA B,I CHECK IF PROGRAM IS IN TIME LIST AND B10K SZA,RSS JMP $TREM,I NO, SO EXIT XOR B,I CLEAR T-BIT STA B,I LDA DTLST GET ADDR OF TOP OF LIST PNTR * TR010 LDB A,I GET CURRENT TOP OF LIST CPB TLINC IS THIS THE PROG? JMP TR030 YES SZB,RSS END OF LIST? JMP $TREM,I YES, RETURN STB A SAVE ADDR OF CURRENT LINKWORD JMP TR010 GO CHECK NEXT PROG * TR030 LDB B,I LINK NEXT PROG STB A,I TO PREV PROG TO REMOVE JMP $TREM,I RETURN SPC 1 DTLST DEF TLIST B10K OCT 10000 HED MESSAGE PROCESSOR TM REQUEST COMPLETION * THIS ROUTINE COMPLETES THE SET TIME REQUEST * * CALLING SEQUENCE: * * LDB DEFP1 SET B TO ADDRESS OF PRAM LIST * JMP $TMRQ * $TMRQ LDA DM6 SET UP PRAM ADDRESSES ON STA TEMP THE BASE PAGE LDA DRQP3 TM1 STB A,I ADB D4 PRAMS SEPERATED BY FOUR WORDS INA ISZ TEMP DONE? JMP TM1 NO * LDA RQP3,I GET YEAR ADA DM197 SUBTRACT THE BASE MPY D365 MULTIPLY BY DAYS PER YEAR ADA RQP4,I ADD THE DAY CMB SET B TO -1 IF LEGAL RESULT ADA B SUBRTACT ONE FROM DAY INB,SZB IF B WAS NOT ZERO AFTER MULT. THEN JMP $INER INPUT ERROR STA $TIME+2 SET DAY COUNTER * LDB DTIME GET TIME ADDRESS TO B JSB $ETTM SET THE TIME JMP MESEX EXIT TO MESSAGE PROCESSOR SPC 2 DM6 DEC -6 DRQP3 DEF RQP3 D4 DEC 4 DTIME DEF $TIME HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE CO&œþúMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 Ïfþú 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $SCLK ÝYZXTTZÿÿ ÿý§» ÿ92067-18017 1805 S C0122 &ASCM4 RTE-IV MESSAGES             H0101 º‚ASMB,R,L ** RT MESSAGE MODULE ** HED RT MESSAGE MODULE * NAME: $ASC4 * SOURCE: 92067-18017 * RELOC: 92067-16014 * PGMR: G.A.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ASC4,0 92067-16014 REV.1805 780125 * SUP * ENTRY REFERENCE NAMES * ENT $OPER,$ERIN,$NOPG,$ILST,$NOLG,$LGBS,$NMEM * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $NOLG DEF *+1 DM12 DEC -12 ASC 6,NO LGO SPACE * $LGBS DEF *+1 DM10 DEC -10 ASC 5,LGO IN USE * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * $NMEM DEF *+1 DEC -18 ASC 9,CMD IGNORED-NO MEM * END $ERIN ’hÿÿ ÿý¨® ÿ92067-18018 2001 S C0822 &RTIO4              H0108 “wþúASMB,Q,C ** RTE-IV INPUT/OUTPUT CONTROL MODULE ** HED ** RTE-IV INPUT/OUTPUT CONTROL MODULE ** * DATE: 1/07/77 * NAME: RTIO4 * SOURCE: 92067-18018 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,L.W.A.,D.L.S.,E.J.W.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RTIO4,0 92067-16014 REV.2001 791102 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** ***** AMD-DAS ***** AUG,72 ***** REV.GAA ***** ***** AMD-DAS ***** APR,75 ***** REV.LWA ***** ***** DSD ***** FEB,77 ***** REV.EJW ***** * * ENT $CIC0,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$DEVT,$CXC,$CYC ENT $GTIO,$UP,$CVEQ,$DMS,$BLLO,$BLUP ENT $BITB,$UNLK,$XXUP,$DLAY,$DMEQ,$CKLO ENT $CON1,$CON2,$CON3,$DRVM,$RSM * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN EXT $LUSW,$SCD3,$RNTB,$CNV3,$ERMG EXT $CNV1,$CLAS,$REIO,$ABRT,$INER,$ZZZZ EXT $PDSK,$UCON,$UIN,$CIC,$PERR EXT $ERAB,$IDNO,$SMAP,$MATA EXT $MRMP,$MVBF EXT $DVPT,$DLTH,$DVMP,$SDA * ENT $DVC,$CJMP,$LIA4 * * * * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E N T R A L I N T E R R U P T C O N T R O L *** * * THE PROCESSING OF SYSTEMO^þú INTERRUPTS IS CONTROLLED * BY DIRECTING ALL SOURCES TO THE ENTRY POINT < $CIC0>. * < $CIC0> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC0. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * MEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM DRIVER) OR IS SCHEDULED IN T€cþúHE NORMAL * PRIORITY ORDER IF IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC0>. * SKP * <$CIC0> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * 6 - TIME BASE GENERATOR(TBG)INTERRUPT * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE MANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS OF THE ENTRY ISB«þú * ASSUMED TO BE THE FWA OF AN EQT ENTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC0 TRANS- * FERS DIRECTLY TO THE * IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC0>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC0 RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * C. RETURN AT (P+3): CONTINUATION REQUESTING A DMA * CHANNEL. IF ASSIGNED NOW OR * LATER, THEN ENTRY WILL BE MADE * INTO INTIATION SECTION OF DRIVER * ¯rþú FROM SUBROUTINE *DRIVR*. RETURN * FROM THIS INITIATION WILL ACT AS * A CONTINUATION RETURN. THE DRIVER * IS RESPONSIBLE FOR KEEPING A FLAG * INDICATING WHETHER THE NEXT ENTRY * INTO THE INITIATOR FOR THIS CHANNEL * IS A RESULT OF A NORMAL INITIATION * OR A CONTINUATION REQUEST FOR DMA. * THIS FEATURE IS AN UNADVERTISED * ABILITY FOR THE USE OF DVR07 (MULTIPOINT) * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * * - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PROGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY !þúA JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC0 IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENABLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAN THE INDICATORS. * THIS FACILITY IS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE INTERRUPT * OCCURRED AND THAT MEMORY * PRO¼ÏþúTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE INTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - SKP $CIC0 EQU * OCT 103300 INTERRUPT SYSTEM ALREADY OFF? ISZ $INT YES, FLAG IT FOR $PERR4 * TURN IT OFF IN ANY CASE !! * * PRESERVE CURRENT STATUS OF MACHINE * SSM $DMS SAVE DMS STATUS AT INTERRUPT FOR P.E. STA TEMPA SAVE A-REG IN CASE OF PARITY ERROR LIA 4 GET INTERRUPT SOURCE STA INTCD AND SAVE IT CPA .5 IS IT MP, DMS, OR PE? JMP PE? MAYBE. * IOR CLF NO, CONSTRUCT CLF XX INSTRUCTION STA *+1 * $DVC NOP CLEAR DEVICE FLAG * CIC1 STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I LDA TEMPA STA XA,I CIC2 ISZ MPTFL SET 'MPTFL' = 1 TO MEAN MP IS OFF. * SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * * PROVIDE FOR SPECIAL (PRIVILEGED) INTERRUPTS * * CLC 6 CLEAR DMA CHANNELS CLC 7 CONTROL FF. * STF 0 RE-ENABLE INTERRUPTS * * CIC.0 EQU * LDA XI SAVE INDEX REGISTERS CXB XSB A,I STORE X THROUGH USER MAP INA CYB XSB A,I STORE Y THROUGH USER MAP LDA INTCD RESTORE THE INT CODE LDB $CIC SAVE P-REGISTER SOON AS POSSIBLE STB XSUSP,I POINT OF SUSPENSION. * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPA .5 IF MEMORY PROTECT VIOLATION, JMP $RQST GO TO EXAMINE MP VIOLATION. * CPA TBG IF }´þúTIME BASE GENERATOR, $CJMP JMP $CLCK GO TO TBG PROCESSOR ROUTINE. * * CHECK LEGALITY OF INTERRUPT * ADA N6 CODE - 6. STA B (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM DRIVER IS TO BE CALLED RTE03820 JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B ADDRESS, SET IN B TO <$LIST>. * ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 CLF CLF 0 N6 DEC -6 TEMPA NOP $DMS NOP DMS STATUS AT INTERRUPT $INT NOP ($DMS+1)INTERRUPT SYSTEM: 0 ON, 1 OFF * * PE? LIA 5 GET VIOLATION REGISTER SSA,RSS IS IT PARITY ERROR? JMP CIC1 NO, SAVE REGISTERS FOR REAL * LDA TEMPA RESTORE A-REG JMP $PERR CALL PARITY ERROR ROUTINE * * $CXC LIA 4 *** SPECIAL ENTRY TO SKIP CLF *** $CYC STA INTCD SAVE INTERRUPT SOURCE CODE SSM $DMS SAVE DMS STATUS JMP CIC2 SKP * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE ENTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRl/þúESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. * CIC.6 JSB $DRVM GO SET RIGHT MAP * LDA INTCD (A) = INTERRUPT SOURCE CODE * LDB EQT14,I SET DEVICE SZB TIME-OUT CLOCK DLS 780217 STB EQT15,I IF USER SPECIFIED A TIMEOUT. * * CALL I/O PROCESSOR, COMPLETION SECTION * LDB EQT3,I CALL DRIVER SEZ BUT NEED TO ENTER IN CORRECT MAP JMP $UCON USER MAP ENTRY TO CONTINUATOR * JSB B,I SYSTEM MAP ENTRY TO CONTINUATOR JMP $CON1 (P+1): *COMPLETION RETURN* JMP $CON2 (P+2): *CONTINUATION RETURN* $CON3 JSB $RSM (P+3): *NEED DMA RETURN* RESTORE USER MAP ISZ CONFL FAKE *DRIVR* CALL, FLAG=1 IN CASE WE GET LDA DIOCR TO *REXIT* VIA SUBROUTINE *DRIVR* STA DRIVR DUMMY UP RETURN ADDR IN *DRIVR* JMP DVR0 JUMP INTO MIDDLE OF *DRIVR* IOCRT JMP IOCO1 (P+1) TO ALLOC DMA CHAN, REENTER INITIATOR JMP NOTRD (P+2) * $CON2 JSB $RSM (P+2): *CONTINUATION RETURN* IOCO1 CLA RESTORE USER MAP FIRST LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP $TYPE ACKNOWLEDGE. * LDA $LIST IF $LIST ENTERED SZA,RSS SKIP TO ENTER $XEQ JMP $IRT RETURN TO POINT OF INTERRUPT * JMP $XEQ GO DISPATCH POSSIBLE NEW PROGRAM * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CNV1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7 STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT LDA MpþúCICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT LDA XSUSP,I GET THE EXECUTE ADDRESS * STA RTN SAVE THE RETURN ADDRESS LDB XI RESTORE INDEX REGISTERS XLA B,I INB XLB B,I CAX CBY LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN CLA CLEAR 'MPTFL' TO MEAN CLF 0 TURN OFF THE INTERRUPT SYSTEM STA MPTFL MEMORY PROTECT IS ON. * SW2 JMP IRT2 RETURN IF NOT PRIV. (ELSE CLC) * STF1 STF 12B BUFFER ON DUMMY I/O CARD * DLD INTBA,I CHECK CONDITION OF DMA CHANNELS SSA IF BIT = 1 FOR DMA #1 (ACTIVE) STC 6 THEN SET CONTROL TO ENABLE SSB INTERRUPTS. SAME FOR STC 7 DMA CHANNEL #2. * IRT2 LDA XA,I RESTORE THE A AND B REGS LDB XB,I STF 0 TURN ON THE INTERRUPT SYSTEM STC 5 AND MEMORY PROTECT UJP * ENABLE USER MAP AND RETURN RTN EQU *-1 SPC 4 CICM1 DEF *+1 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 DEC -15 ASC 8,SC03 INT XXXXX * INTCD NOP HOLDS INTERRUPT SOURCE CODE $LIA4 EQU INTCD D$LUT DEF $LUSW+0 DIRECT ADDRESS OF BATCH LU TABLE DIOCR DEF IOCRT * $BLLO DEC -100 LOW BUFFER LIMITS *1926DLS* $BLUP DEC -300 UPPER BUFFER LIMITS *1926DLS* HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > *** I N P U T / O U T P U T C O N T R O L *** * * Tì þúHE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC0> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETION*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC0> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDLE POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDLE TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BEðõþúFORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: LAST SUBCHANNEL REFERENCED ON THIS EQT. * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT STATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL DEVICE ADDRESSING OF PHYSICAL I-O * SLOTS DEFINED IN THE *EQT*. THE *DRT* CONSISTS * OF TWO SEQUENTIAL TABLES EACH TABLE CONSISTING * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * EACH LOGICAL UNIT'S WORD ONE IS AS FOLLOWS: * BITS 5-0 DEVICE'S EQT NUMBER * BITS 6-10 THE LOCKING RESOURCE NUMBER * BITS 11-15 THE DEVICE'S SUBCHANNEL ON THE EQT. * THE CONTENTS OF EACH LOGICAL UNIT'S DEVICE * REFERENCE TABLE WORD TWO CONTAINS A * POINTER TO THE I/O QUEUE OF THE I/O REQUESTS * FOR THIS DEVICE WHEN THE DEVICE IS DOWN: * BIT 15=0 FOR AN UP LU. * =1 FOR A DOWN LU. * BITS 14-0=0 FOR AN UP LU. * #0 FOR A DOWN LU WHERE * = ADDRESS OF THE I/O QUEUE IF THIS * IS THE FIRST LU(MAJOR LU)POINTING * TO THE DEVICE. * = 1 TO 1777(8). THE LU NUMBER OF * DEVICE(MAJOR LU)ON WHICH THE I/O * IS QUEUED. * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 0 - BIT BUCKET(DUMMY LU)(NO ENTRY IN DRT) * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' ¦{NLHINPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - ÃNÿÿþú SKP * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINED BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * DEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONW‡þúD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE * * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP * C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * DEF STAT3 (DEFINE STATUS WORD 3 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP s¥þúWORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * STAT3 NOP IF PRESENT, THEN BIT 15 INDICATES * THE LU IS UP(0) OR DOWN(1) AND BITS * 0-4 GIVE THE LU'S SUBCHANNEL. * * * IV. GENERAL OPERATION * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY(SAM) * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER * OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND * NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * * A. READ/WRITE AND WRITE-READ REQUEST FORMAT * * çþú EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINE READ (17) WRITE (18) WRITE-READ (20) * DEF CONWD (SAME AS STANDARD READ/WRITE) * DEF IBUFR (SAME AS STANDARD (NOT USED ON READ) * DEF BUFFL (SAME AS STANDARD) * DEF OPT1 (SAME AS STANDARD (TRACK)) * DEF OPT2 (SAME AS STANDARD (SECTOR)) * DEF CLASS (CLASS TO QUEUE REQUEST ON ) * EXIT --- * . * . * RCODE DEC 17 OR 18 OR 20 (SEE NOTE BELOW) * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * OPT1 DEC N (SEE GET CALL BELOW) * OPT2 DEC N (SEE GET CALL BELOW) * CLASS DEC N DEFINES CLASS TO BE USED IN GET CALL. * IBUFR BSS N DATA BUFFER * * * NOTES: * THE WRITE-READ CALL IS FOR DEVICES WHICH EXPECT DATA IN * THE READ BUFFER. THIS CAUSES THE SYSTEM TO MOVE THE BUFFER * TO SYSTEM MEMORY AND ALSO TO SAVE AND PASS TO THE USER * THE BUFFER ON THE GET CALL. THE REQUEST CODES RECEIVED * BY THE DRIVER ARE: * 1 FOR REQUEST 17 OR 20 * 2 FOR REQUEST 18 * 3 FOR REQUEST 19 * * THE CLASS WORD HAS THE FOLLOWING FORMAT * BITS 0-7 DEFINE THE CLASS. IF ZERO OR NOT SUPPLIED * THE SYSTEM WILL ASSIGN A CLASS FOR THE REQUEST. * BITS 8-12 CONTAIN THE SECURITY CODE ASSIGNED BY THE * SYSTEM UPON CLASS ALLOCATION. * BITS 13-14 ARE NOT USED BY READ/WRITE OR WRITE-READ * BUT WILL BE RETURNED TO CALLER IF A CLASS * IS ALLOCATED. * BIT 15 SHOULD BE SET TO INDICATE THAT THE PROGRAM IS TO * BE CONTINUED WITHOUT MAKING THE REQUEST IF THERE * IS NOT ENOUGH SYSTEM MEMORY AT THE CURRENT TIME. * * ON RETURN TO THE PROGRAM THE A REGISTER WILL BE SET AS * FOLLOWS (IF BIT 15 WAS SET): * * ÛcþúA = -1 DYNAMIC CLASS ASSIGNMENT FAILED (NO FREE CLASS NOW) * -2 NO MEMORY AVAILABLE FOR BUFFERING. * = >0 THE NEWLY ALLOCATED CLASS NUMBER AND SECURITY CODE. * * B. CLASS CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINES REQUEST CODE) * DEF CONWD (DEFINES CONTROL WORD) * DEF PRAMD (DEFINES PRAMETER WORD) * DEF CLASS (CLASS TO QUEUE REQUEST ON) * EXIT --- * . * . * RCODE DEC 19 CLASS CONTROL REQUEST CODE * CONWD OCT NNNN CONTROL INFO/LOGICAL UNIT # * PRAM DEC N PRAMETER AS REQUIRED BY TYPE OF CODE * CLASS DEC N DEFINES CLASS TO USED IN GET CALL. * * THE CLASS CONTROL IS THE SAME AS THE STANDARD CONTROL EXCEPT * COMPLETION INFORMATION IS QUEUED ON THE DESIGNATED CLASS QUEUE. * * C. CLASS GET REQUEST FORMAT. * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE RETURN ADDRESS) * DEF RCODE (DEFINE REQUEST CODE ADDRESS) * DEF CLASS (DEFINE CLASS ADDRESS) * DEF IBUFR (DEFINE BUFFER ADDRESS) * DEF IBUFL (DEFINE BUFFER LENGTH) * DEF IRP1 ((RETURN PRAMETER 1 (OPTIONAL)) * DEF IRP2 ((RETURN PRAMETER 2 (OPTIONAL)) * DEF RCLAS (RETURN CLASS WORD ADDRESS)(OPTIONAL) * EXIT --- * . * . * RCODE DEC 21 REQUEST CODE FOR GET REQUEST * CLASS OCT NNN CLASS THE GET IS TO GET FROM. * IBUFR BSS N BUFFER TO HOLD THE READ DATA * IBUFL DEC N OR -N WORD OR CHARACTER LENGTH OF BUFFER * IRP1 BSS 1 OPTIONAL PRAMETER ONE RETURNED HERE * IRP2 BSS 1 OPTIONAL PRAMETER TWO RETURNED HERE * RCLAS BSS 1 CLASS RETURN WORD. * * NOTES: * THE CLASS WORD HAS THE FOLLOWING OPTIONS: * BITS 0 - 7 CLASS TO BE USED * BITS 8 -12 CLASS SECURITY CODE * BIT 13 DO NOT DEALLOCATE THE CLASS. IF THIS BIT * IS NOT SET AND THE CLASS IS EMPTY Ù7þú(NO * COMPLETED OR PENDING REQUESTS) IT IS * DEALLOCATED. * BIT 14 RETURN THE INFORMATION BUT DO NOT DEQUEUE * THE REQUEST (MUST MAKE ANOTHER REQUEST TO * DEQUEUE THE REQUEST). * BIT 15 IF NO ENTRIES IN QUEUE RETURN TO PROGRAM * (NORMAL ACTION IS TO SUSPEND UNTIL A * REQUEST IS PUT ON THE QUEUE). * * THE RETURNED CLASS WORD (RCLAS) IS AS FOLLOWS: * BITS 0 - 7 SET TO THE REQUEST CODE SENT TO THE DRIVER I.E. * 17 IS SET TO 1 * 18 IS SET TO 2 * 19 IS SET TO 3 * 20 IS SET TO 1 * * THE PARAMETERS IRP1/IRP2 ARE SET TO THE ORIGINAL REQUEST * PARAMETERS OPT1/OPT2. THEY ARE PROTECTED FROM DRIVER * MODIFICATION AND SO SHOULD BE AS SUPPLIED, EXCEPT IF * BIT 12 IN THE CONWORD IS SET "IRP1" POINTS TO * THE BUFFER AREA THE SYSTEM USED (I.E. IT IS NONSENSE). * * THE A REGISTER ON RETURN IS SET AS FOLLOWS: * A = -N N IS THE NUMBER OF REQUESTS PENDING ON THE CLASS * IN ONE'S COMPLEMENT [-(N+1)] = [-N-1] * (NO REQUEST HAS COMPLETED YET) * A = 10XXXX (WHERE 1 IS BIT 15, 0 IS BIT 14, * AND XXXX IS THE REST OF EQT5 WHEN THE * REQUEST EITHER WAS REJECTED BY THE DRIVER * OR WAS IMMEDIATELY COMPLETED BY THE DRIVER. * ON REJECT B = -1,ON IMMEDIATE COMPLETION * B = TLOG. * A = > 0 A IS THE STATUS (EQT5) OF THE DEVICE AT * COMPLETION OF THE REQUEST. (IF BIT 14 IS SET * THE REQUEST CAUSED THE DEVICE TO GO DOWN). * B = TLOG IN THIS CASE. * * ON COMPLETION OF AN 18 REQUEST THE DATA BUFFER IS RETURNED * TO SYSTEM MEMORY. * THE GET REQUEST WILL ALWAYS GET A BUFFER 5þúWHICH IS THE * MINIMUM OF THE ALLOTTED SIZE ON THE GET AND THE BUFFER * IN THE QUEUE. THE CONTROL BUFFER (BIT 12 OPTION) IS AT THE * END OF THE ALLOTED BUFFER AND MAY BE RETURNED ON A GET IF * THE BUFFER SUPPLIED WILL HOLD IT AND THE REQUEST WAS NOT A * CLASS WRITE (18) REQUEST. SKP * CLASS I/O QUEUE FORMAT AND ITS USE * * THE CLASS QUEUE CAN BE IN FOUR DIFFERENT STATES. * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0! * ------------------------------------------------------ * STATE 1: CLASS DEALLOCATED, AVAILABLE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------- * ! 0 ! A D D R E S S O F F I R S T E N T R Y ! * ------------------------------------------------------- * STATE 2: POINTER TO FIRST ENTRY IN CLASS QUEUE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 0 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 3: CLASS ALLOCATED, NO ONE WAITING ON CLASS * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 1 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 4: CLASS ALLOCATED, SOMEONE WAITING (SUSPENDED) * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * ACTIONS TO BE TAKEN WHEN HANDLING A CLASS I/O OR GET REQUEST * DEPEND ON THE CURRENT STATE OF THE CLASS QUEUE HEAD * GET REQUESTS: * STATE 1. ABORT THE PROGRAM IO00, NO CLASS. * STATE 2. RETURN THE DATA FROM CLASS BUFFER * STATE 3. SET THE SOMEONE WAITINˆþúG BIT(BIT14), SUSPEND PROGRAM * STATE 4. ABORT THE PROGRAM IO00, ONLY ONE PROGRAM MAY BE * SUSPENDED PER CLASS. * CLASS I/O REQUESTS: * STATE 1. STATE 3 IS SET UP, SECURITY CODE IS LOW 5 BITS OF * PROGRAM ID NUMBER, COUNTER IS SET TO 1. * STATE 2. THE COUNTER AT END OF QUEUE IS INCREMENTED BY 1 * STATE 3. THE COUNTER IS INCREMENTED BY 1. * STATE 4. THE COUNTER IS INCREMENTED BY 1. * ON COMPLETION OF CLASS I/O REQUESTS: * STATE 1. ILLEGAL--SHOULD NEVER HAPPEN--BUFFER IS RETURNED * AND THE COMPLETION IS IGNORED. * STATE 2. THE NEW DATA IS ADDED AT THE END OF THE LIST (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 3. THE NEW DATA IS ADDED AT THE END OF THE LIST (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 4. THE WAITING PROGRAM IS SCHEDULED AND THE COUNTER * IS DECREMENTED BY 1 AND THE SOMEONE WAITING BIT(BIT14) * IS CLEARED. SKP $IORQ EQU * CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMPL AND 'DISC R/W USER REQ' FLAG STA CLASS CLEAR THE CLASS WORD STA TEMP5 CLEAR LU FLAG FOR LU 0 * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * LDA DRQ2I GET ADDR OF EXEC'S PRAMS STA TEMP1 LDA DPARM GET ADDR OF DIRECT PARMS STA TEMP2 LDB N8 GET 8 PARMS DIRECT GTPAR CLA CLEAR (A) IN CASE XLA TEMP1,I NO PARM WAS PASSED STA TEMP2,I ISZ TEMP1 ISZ TEMP2 INB,SZB DONE YET? JMP GTPAR NO * * * LOGICAL UNIT REFERENCE VALIDITY CHECK * CCA,CCE TRANSLATE BY -1 ADA PARM2 EXTRACT LOGICAL UNIT # FROM AND B77 PARAMETER 1 STA TEMP1 SAVE LOGICAL UNIT #-1 FOR DISC TEST LDB XSUSP GET PROGRAM'S BATCH FLAG ADB .12 AND LDB B,I IFžõþú BATCH SSB,RSS FLAG JMP L.0 IS SET * LDB $LUSW CHECK FOR LU SWTCH CMB,INB NEGATE COUNT FOR LOOP. * STB TMP8 ELSE SET UP TO SCAN THE TABLE LDB D$LUT GET DEF TO TABLE L.00 INB STEP TABLE ADDRESS LDA B,I GET ENTRY AND B77 IF SAME CPA TEMP1 AS CURRENT LU JMP L.001 GO SWITCH * ISZ TMP8 STEP COUNT JMP L.00 AND LOOP * L.0 LDA TEMP1 NO SWITCH USE SUPPLIED LU L.0.1 LDB A CPB B77 IF 0 SPECIFIED JMP L.00X GO DO IMMEDIATE COMPLETION THING * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. ADB DRT INDEX INTO THE DRT. LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 CCE,SZA,RSS IF ZERO JMP L.00X THEN DO IMMEADIATE COMPLETION THING * JSB $CVEQ CONVERT TO ABS.EQT ADD(WILL MASK SUBCH.). * LDA EQT4,I AND B77 GET I/O SELECT CODE SZA,RSS IF SELECT CODE = 0 JMP ERR03 GIVE IO03 ERROR SKP * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDA TEMP1 GET LU-1 AND DETERMINE JSB STADV IF THE LU OR EQT ARE DOWN. JMP L.014 IF DOWN, SUSPEND THE PROGRAM. * LDA RQPX UP, SO CONTINUE. LDB XPRIO,I SET THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.02 SKIP FURTHER ANALYSIS. * LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. Ùqþú LDA RQP1 GET THE RQ CODE *1926DLS* * * BUFFER LEGALITY CHECK FOR INPUT. * BFCK LDB PARM4 GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE BFCK1 STB TMP8 AND SAVE. CPA B21 IF CLASS READ, THEN *1926DLS* JMP L.01 SKIP BUFFER CHECK. *1926DLS* * SPC 1 ADB N1 CALCULATE ADDR OF LAST WORD CLO IN BUFFER ADB RQP3 AND IN CASE IT'S PAST 32K SOC ADDRESS SPACE, JMP ERR04 GIVE ERROR MESSAGE * STB LWABF SAVE THE LAST WORD BUFFER ADDR. LDA RQP3 GET THE 1ST WORD ADDRESS. LDB XEQT AND ID SEG ADDRESS JSB COMN IS THE 1ST WORD OF BUFFER IN COMMON ? JMP CHKWR NO, SO JUST GO DO THE WRITE PROTECT CHECK. * LDA LWABF YES, IF 1ST WORD IN COMMON, THEN THE LAST LDB XEQT WORD BETTER BE IN COMMON ALSO. JSB COMN IS IT ?? JMP ERR04 NO !!! WHEW ! THAT WAS A CLOSE ONE ! JMP ALCOM YES, THE WHOLE BUFFER IS IN COMMON. * CHKWR LDB LWABF BUFFER NOT IN COMMON SO MAKE SURE CLA THAT THE LAST WORD IS IN RRL 6 MAPPED MEMORY. SO SHIFT PAGE # TO A-REG ADA B40 ADD IN OFFSET FOR USER MAP. *1940DLS* CCB CBX SET X=-1 FOR READ 1 REG TO MEMORY LDB DCURU READ IT INTO 'CURUS' XMM LDA CURUS RAL TEST BIT 14 SSA WRITE PROTECTED? JMP ERR04 YES, ERROR * ALCOM LDA RQPX NO ERROR CLE,SZA,RSS IF GET REQUEST JMP G.01 GO FINISH GET OPERATION * L.01 LDB RQCNT GET REQUEST COUNT ADB N5 AND SET 'E' FOR FIVE PRAM TEST LDA EQT5,I CHECK REFERENCED DEVICE AND B36K FOR BEING A CPA B14K DISC FILE (DVR30,31,32,33) RSS JMP ŠB@ FIELD TO 3 IOR B40K SET = 1 FOR BUFFERING. LDB TEMPW ST¢ŠþúA B,I AND SET IN WORD 2 OF BLOCK. INB LDA TEMP6 SET REQUESTING PROGRAM PRIORITY STA B,I IN WORD 3. INB LDA L.04 SET BLOCK LENGTH IN STA B,I WORD 4. INB LDA TEMPW,I GET THE CONWORD SSA,RSS IF STANDARD REQUEST JMP L.061 SKIP * LDA CLASS ELSE SET THE CLASS STA B,I WORD IN INB THE BUFFER L.061 LDA .3 IF REQUEST CPA RQP1 IS STANDARD CONTROL, SKIP JMP L.08 BUFFER MOVE * LDA PARM4 SET USER BUFFER LENGTH STA B,I IN WORD 5. CMA,CLE,INA SET E IF ZERO LENGTH BUFFER (SAVE A CYCLE IF SO) LDA PARM5 GET FIRST OPTIONAL WORD INB STEP TO STORE LOCATION STB TEMPW SAVE THE ADDRESS OF THE LOCATION STA B,I SET IT INB SET FOR NEXT WORD LDA PARM6 GET SECOND OPTIONAL WORD STA B,I SET IT IN THE BUFFER LDA RQP1 IF CLASS READ OR CPA B23 IF CLASS CONTROL, JMP L.078 GO FINISH ITS SET UP * CPA B21 IF CLASS READ ADB TMP8 ADJUST BUFFER ADDRESS FOR DOUBLE BUF. SEZ,CLE,INB,RSS IF LENGTH = 0, CPA B21 OR CLASS READ JMP L.075 SKIP BUFFER MOVE. * * MOVE USER BUFFER TO TEMPORARY BLOCK. * LDA RQP3 SET USER BUFFER L.065 EQU * ADDRESS FOR MOVE. LDX TEMP3 GET # WORDS TO MOVE MWF MOVE INTO SYSTEM MAP FROM USER MAP * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA PARM2 GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * STB TEMPW,I SET BUFFER ADDRESS IN REQUEST LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.078 ADB N2 CORRECT (B) FOR CLASS CONTROL L.08 LDA PARM3 F/þúOR CONTROL REQUEST, SET WORD 3 STA B,I (PARAM) IN PLACE OF RECORD JMP L.13 LENGTH. SPC 2 B21 OCT 21 B23 OCT 23 D$RN DEF $RNTB+0 DIRECT ADDRESS OF RN TABLE SKP SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * * L.10 CLE CLEAR (E) FOR WORD2 CALL LATER LDB PARM3 GET CONTROL WORD LDA RQP1 (A) = REQUEST CODE. CPA .3 IF CONTROL GO JMP L.101 SET IT UP * LDB XTEMP+4 GET THE ADDRESS OF THE RENT ADB .15 BIT IN THE ID-SEG. LDA B,I GET THE WORD TO A ALF,RAL PUT THE BIT IN SIGN OF A LDB RQP3 BUFFER ADDRESS TO B CLE,SSA IF BIT SET JSB $REIO GO MOVE THE TDB (IF NEEDED) SETS E-REG ! * CLA,SEZ DID WE CALL $REIO ? CPA $MVBF YES,BUT DID $REIO MOVE THE BUFFER ?? CLE,RSS NO. $REIO NOT CALLED OR BUFFER NOT MOVED. ADB MSIGN E-REG IS SET. REIO CALLED & BUFFER MOVED. STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA PARM4 BUFFER STA XTEMP+2,I LENGTH AND LDA PARM2 GET THE CON WORD CMA,CME SET COMPLEMENT IOR TEMPL MIRGE WITH DISC FLAG LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS IF NONE USE JMP L.102 ZERO XLB B,I GET THE OPTION WORD L.102 SEZ,SLA,RSS IF RENT AND DOUBLE BUFFER JSB $REIO GO CHECK OUT THE BUFFER ADDRESS STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * LDA PARM6 SET THE FINAL OPTIONAL WORD STA XTEMP+4,I IN THE ID-SEGMENT * * CLNôþúE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD JSB WORD2 ASSEMBLE CONTROL WORD (E)=0 ALREADY STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 LDA RQP1 IF STANDARD I/O CPA RQPX THEN JMP L.131 GO UP DATE AND EXIT * * CLASS I/O SO SET THE CLASS QUEUE TO SHOW * ANOTHER REQUEST IS PENDING. * LDA SECCD,I INA INCREMENT CLASS QUEUE COUNT BY 1 STA SECCD,I JMP L.132 SKIP XSUSP SET UP * * L.131 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB $DMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB PARM4 GET THE REQUEST LENGTH L.136 SSB AND SET UP CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION JMP R00 AND GO TO COMPLETION SECTION * SKP * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY XSB RQP3,I IN 'STAT1'. LDA EQT4,I STORE WORD 4 OF EQT ENTRY XSA RQP4,I IN 'STAT2'. * LDB TEMP1 GE™ºþúT SUBCHANNEL ADB DRT FROM DRT LDA B,I WORD 1. AND B174K ALF,RAL PUT SUBCHANNEL IN ADB LUMAX LOWER 5 BITS. LDB B,I GET UP/DOWN BIT FROM CLE,ELB DRT WORD 2 AND OR RAL,ERA WITH SUBCHANNEL. XSA RQP5,I STORE IN 'STAT3'. L.16 LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP CLASS NOP DCLAS DEF $CLAS+0 DIRECT ADDR OF CLASS TABLE MCLAS NOP CONFIGURED TO BE NEGATIVE OF ABOVE. B174C OCT 17400 BITS 8-12 B37 OCT 37 N2 DEC -2 SKP * $GTIO IS THE ENTRY POINT THE EXEC CALLS FOR A 'GET' EXEC * CALL. * $GTIO XLA RQP2,I GET REAL PARAM STA PARM2 XLA RQP4,I FOR BFCK STA PARM4 LDA PARM2 GET THE CLASS AND B377 MASK STA B SAVE AND CMA,CLE,INA,SZA,RSS IF CLASS=0 CLE,RSS SEND "IO00" * ADA $CLAS IF GREATER THAN MAX THEN CLA,SEZ,RSS SEND JMP ERR00 'IO00' ERROR * STA RQPX CLEAR REQ CODE ADB DCLAS SET THE STB CLASS CLASS TABLE ADDRESS JMP BFCK GO CHECK THE BUFFER ADDRESS. * * BFCK RETURNS TO G.01 * G.01 LDA PARM2 GET SECURITY CODE AND B174C BITS FROM CLASS WORD STA SECCD LDB CLASS,I GET QUEUE HEAD SSB IF A COUNTER JMP G.06 GO SUSPEND THE PROGRAM * SZB,RSS IF QUEUE-HEAD = 0 JMP ERR00 ERROR "IO00" * STB PTR SAVE THE ADDRESS INB GET THE CON WORD LDA B,I AND AND .3 ISOLATE THE REQUEST CODE XSA RQP7,I RETURN IT TO USER'S IRCLS INB STEP TO STATUS WORD LDA B,I GET COMPLETION STATUS. STA XA,I AND SET IT IN THE A REG. INB GET THE BUFFER LENGTH LDA B,I AND SET IT STA ¯ þúCLTMP FOR RETURN INB STEP TO USER CLASS WORD LDA B,I GET IT AND B174C KEEP SECURITY CODE CPA SECCD MATCHES CALLER'S? RSS JMP ERR00 NO, ERROR IO00 * INB INDEX TO THE LDA B,I TLOG AND STA XB,I SET IT IN THE 'B' REG INB INDEX TO THE LDA B,I FIRST OPTIONAL WORD AND XSA RQP5,I SET IT IN THE USERS BUFFER INB NOW DO THE SECOND OPTIONAL WORD LDA B,I XSA RQP6,I * STB TEMP4 SAVE THE BUFFER ADDRESS LDA .8 GET THE BUFFER LENGTH CMA,INA SET NEGATIVE ADA CLTMP LOP OFF THE HEAD WORDS STA TEMP3 SET THE MOVE COUNT LDB TMP8 GET THE SUPPLIED LENGTH CMA,INA SET MOVE COUNT NEG ADA TMP8 SUBTRACT FROM USER BUFFER SIZE SSA,RSS IF QUEUE COUNT IS SMALLER, LDB TEMP3 USE QUEUE SIZE, MAYBE 1 BIGGER!! SSB IF COUNT LESS THAN ZERO THEN JMP G.05 THEN SKIP MOVE * LDA TEMP4 GET THE BUFFER ADDRESS. INA STEP TO THE PROPER WORD CBX GET MOVE COUNT LDB RQP3 GET DESTINATION MWI MOVE FROM SYSTEM TO USER G.05 LDA PARM2 IF SAVE RAL,RAL QUEUE OPTION SLA,ELA THEN JMP L.16 EXIT * LDA PTR,I ELSE STA CLASS,I UPDATE THE LIST SSA IF POINTER, SKIP COUNT CHECK AND B37 GET # PENDING REQUESTS LEFT SEZ,SZA,RSS NO REQUESTS LEFT STA CLASS,I AND IF DEALLOCATE WANTED, DO IT. JSB $RTN RETURN THE MEMORY PTR NOP AND CLTMP NOP THEN JMP G.08 SCHEDULE WAITERS AND EXIT * G.06 LDA B174C GET SECURITY CODE AND B FROM QUEUE CPA SECCD MATCH? RSS JMP ERR00 NO, ERROR IO00 * RBL,CLE,ELB MOVE BIT14 (SOMEONE WAITIN$lNLHG) TO E G.065 LDA CLASS,I GET CLASS WORD AND B377 CMA,SEZ ANYONE WAITING? (SET ONES COMP) JMP SCEDT YES,SORRY SOMEBODY BEAT YOU TO IT * STA XA,I SET A FOR POSSIBLE RETURN INA GET CORRECT 2'S COMPLEMENT STA B LDA PARM2 GET THE OPTION FLAG ELA,RAL SET E=BIT15 NO-WAIT OPT. SZB,RSS IF QUEUE-HEAD = 0 SSA AND BIT14 SET, JMP G.07 DON'T DEQUEUE * STB CLASS,I IF Q-H=0 AND BIT14=0 DEQUEUE! G.08 LDA DCLAS NOW SCHEDULE ALL THOSE WAITING JSB $SCD3 FOR AN AVAILABLE CLASS NUMBER. JMP L.16 RETURN * G.07 SEZ,CCE JMP L.16 BIT15=1 FOR NO-WAIT. RETURN. * LDB CLASS GET CLASS ADDR IN B FOR L.013 LDA B,I SET "SOMEONE IS WAITING" FLAG RAL,RAL ERA,RAR STA B,I AND JMP L.013 PUT IT BACK INTO WAIT LIST SPC 1 C377 OCT 177400 COMPLEMENT OF 377 *@Nÿÿþú SKP * * * * THE COMN ROUTINE IS USED TO DETERMINE IF THE BUFFER * SPECIFIED IS IN COMMON. TO BE IN COMMON THE BUFFER * MUST BE BELOW THE LOAD POINT OF THE PROGRAM SPECIFIED. * AND ALSO BE BELOW $SDA, THE START OF THE SYSTEM DRIVER * AREA. IT IS NOT ENOUGH TO JUST SEE IF THE BUFFER IS BELOW * THE LOAD POINT AS THE BUFFER COULD BE IN THE MEMORY RESIDENT * LIBRARY. WE ALSO DON'T HAVE TO CHECK IF THE ADDRESS IS BELOW * $CMST AS EXEC DOES THIS FOR ALL I/O REQUESTS IN THE * MEMORY PROTECT CHECK PROCESSOR. * * * * CALLING SEQUENCE: LDA BUFFER ADDRESS * LDB ID SEG ADDRESS * JSB COMN * - HERE IF BUFFER NOT IN COMMON * - HERE IF BUFFER IS IN COMMON * * * COMN NOP CMA MAKE BUF ADDR NEG +1 & STA BUFAD SAVE FOR NEXT CHECK. * ADB .22 INDEX TO LOAD POINT ADA B,I OF PROGRAM. SSA BUFFER BELOW LOAD POINT ? JMP COMN,I NO, SO IT CAN'T BE IN COMMON. * LDA $SDA GET PAGE # OF SDA & CONVERT ALF,ALF TO RAL,RAL AN ADDRESS ADA BUFAD NOW IS THE BUFER ALSO SSA,RSS WELL ? ISZ COMN YES, BUFFER MUST BE IN COMMON. JMP COMN,I NO, SO RETURN. * * BUFAD NOP SKP **************************************************************** * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILT AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 * ******************************************************** * * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR BUFFERED RQ. ¡þú = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * ***************************************************************** WORD2 NOP LDB RQPX IF CLASS WRITE-READ CPB .4 THEN CHANGE CLB,CLE,INB CHANGE TO READ REQUEST LDA PARM2 COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD LDB TEMPL IF NOT DISC CCE,SZB,RSS REQUEST, JMP WORD2,I EXIT - * AND C114C OTHERWISE, SWP SET BITS (9,8) AND .3 TO INDICATE ALF,ALF SYSTEM, AUXILIARY, IOR B OR PERIPHERAL TYPE JMP WORD2,I EXIT - * B137C OCT 13700 B3700 OCT 3700 C114C OCT 166377 * * SCEDT ERB,RBR CLEAR THE BIT AND STB CLASS,I RESET THE CLASS HEAD LDB $LIST SAVE STATUS OF STB STADV $LIST ENTRY POINT. LDA CLASS GET HEAD ADDRESS TO A AND JSB $SCD3 RESCHEDULE THE WAITER IF ANY CLE E=0 FOR G.065. IF $LIST ENTRY POINT LDA $LIST IS UNCHANGED, THEN THERE WAS CPA STADV NO WAITER. JMP G.065 NO, SO MUST HAVE BEEN ABORTED. CONTINUE. JMP ERR10 šóþú YES. ERROR, SO GO ABORT. * * **************************************************************** * * SUBROUTINE STADV: * * STADV WILL RETURN AT THE UP EXIT IF LU=0. IT NEXT * CHECKS TO DETERMINE IF THE CURRENT EQT IS DOWN(BIT * 14 EQT WORD 5)OR IF THE LU IS DOWN(BIT 15 DRT WORD 2). IF * DOWN, RETURN IS MADE AT P+1. IF UP, RETURN IS MADE AT P+2. * * CALLING SEQUENCE: * :=ADDRESS OF STATUS WORD FOR THIS EQT. * :=LU#-1. * JSB STADV * * RETURN: * (P+1) EQT OR LU DOWN. * (P+2) EQT AND LU UP. * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * STADV NOP CPA B77 IF LU=0(IE, 77B), THEN JMP STAD9 GOTO UP EXIT. * ADA DRT GET DRT WORD ADA LUMAX 2 AND CHECK LDA A,I IF THE LU IS SSA UP OR DOWN. JMP STADV,I LU IS DOWN. * LDB EQT5,I LU IS UP, SO RBL,SLB CHECK IF THE JMP STAD9 EQT IS UP OR SSB DOWN. JMP STADV,I EQT IS DOWN. * STAD9 ISZ STADV LU AND EQT JMP STADV,I ARE UP. SKP * THE QUEUE CHECK ROUTINE CHECKS TO SEE IF THE QUEUE ON * THE CURRENT EQT HAS MORE THEN THE 'LIMIT' NUMBER OF WORDS * OF BUFFER MEMORY ON IT AT THE CURRENT TIME. * THE LIMIT IS PASSED IN THE B REG. SO THE ROUTINE CAN * CAN BE USED FOR BOTH UPPER AND LOWER LIMIT CHECKS. * * CALLING SEQUENCE: * * LDB NEGATIVE OF LIMIT * JSB QCHK * --- MORE THAN LIMIT WORDS ON QUEUE * --- LESS THAN LIMIT WORDS ON QUEUE * EQT1 ADDRESS IS IN B ON EXIT * QCHK NOP STB TEMP1 SET LIMIT LDA EQT1,I START AT EQT HEAD RAL,CLE,ERA CLEAR POSSIBLE SIGN AND E CLE,SZB SET E FOR NOT EXCEEDED QCHK1 SZA,RSS END OF QUEUE? JMP QCHK3 YES GO EXIT * STA TEMPW SET CURRENT ¹þúELEMEMT INA GET THE CON WORD LDB A,I TO B RBL CHECK IF A BUFFERED SSB,RSS REQUEST? JMP QCHK2 NO TRY NEXT ONE * ADA .2 YES STEP TO THE COUNT LDB A,I GET COUNT TO B ADB TEMP1 ADD TO LIMIT STB TEMP1 AND RESET QCHK2 LDA TEMPW,I GET NEXT ELEMENT JMP QCHK1 GO CHECK THIS ELEMENT * QCHK3 LDB EQT1 GET SUSPEND POINTER SEZ,RSS OVERFLOW? ISZ QCHK NO STEP RETURN JMP QCHK,I RETURN * SKP * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE * NEW ONE IN THE PRIORITY CHAIN. * THE NEW ENTRY IS LINKED ACCORDING * TO ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKED INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * zWþú TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW * REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LINK NOP LDB EQT1 GET THE HEAD OF THE LIST CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * ************************************************* **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LINK WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * LDA TEMPL SYSTEM IS IT A DISC SZA,RSS REQUEST ? JMP LINK2 NO USE ZERO PRIORITY * INB,RSS YES USE THE PROVIDED WORD LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIGN Üyþú(SAVES E) SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST JMP LINK,I RETURN * SPC 1 .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 .22 DEC 22 SKP ***************************************************** * JSB DRVMP SET UP DRIVER MAP FROM ORIGINAL CALL * * (E)=0 ENTER DRIVER IN SYSTEM MAP * (E)=1 ENTER DRIVER IN USER MAP * (B)=0 SET PORT MAP WITH SYSTEM MAP * (B)=100000 SET PORT MAP WITH USER MAP ***************************************************** DRVMP NOP CLA STA DVMPS INIT USER MAP SAVE FLAG TO 0 STA MATAD INIT USER MAT ADDR TO 0 STA FLAG INIT DEFAULT MAP AS SYS MAP STA MAP? INIT DEFAULT REBUILD USER MAP JSB CPEQT GET EQT # INTO (A) CCB ADB A CALCULATE INDEX TO ADB $DVMP THE DRIVER MAP TABLE STB DVMP1 ADB EQT# INDEX TO SECOND WORD STB DVMP2 LDB EQT1,I GET DRIVER LINK WORD STB TID SAVE IT AWAY MIGHT BE AN ID SEG ADDRESS CLE,SSB,RSS BIT15=1 FOR TIME-OUT ON CLEAR REQUEST CLE,SZB,RSS CLEAR (E) FOR SYSTEM MAP JMP DVUSY MAP DRIVER IF IN PTTN * LDA B INA LDA A,I CHECK T FIELD IN CONTROL WORD STA TWORD (SAVE FOR LATER TOO) RAL CLE,SSA T=1 0R 3 IF S=1 JMP DVUSY (E) CLEARED FOR SYSTEM MAP * SLA,RSS JMP DVUSE T=0,GO SET USER MAP * ADB .4 a2þúT=2,GET ID WORD IN SYS CALL LDB B,I STB TID SAVE IT AWAY IT IS AN ID SEG ADDRESS. CLE,SZB,RSS IS IT 0 ? JMP DVUSY YES,USE SYSTEM MAP (E)=0 * SSB IS IT SPECIAL $XSIO CALL? JMP DVCUR YES, USE CURRENT USER MAP * * THIS IS AN $XSIO CALL IF IT IS A LOAD * IN, SWAP IN, OR SWAP OUT THEN THE MAP * TO SET UP IS THE ORGINAL VIRGIN MAP. IF * THIS IS A SEGMENT LOAD, THEN WE WANT TO * USE THE MAP AS IS. * * LDA EQT1,I GET THE ADDRESS OF THE $XSIO LINK WORD ADA N2 INDEX TO THE LU WORD. IF THE SIGN BIT LDA A,I IS SET , THEN IT IS A SEGMENT LOAD CALL RAL (LSB = 1 MEANS USE CURRENT MAP) ELSE IT STA MAP? IS A LOAD OR SWAP(LSB = 0 MEANS VIRGIN MAP) JMP DVUSR NOW GO SEE IF HE IS STILL MAPPED IN. * DVUSE CCA STA FLAG SET FLAG FOR USER MAP NEEDED STA MAP? SET USER MAP NEW/OLD FLAG * LDA EQT1,I NO, OK GET THE BUFFER ADDRESS ADA .2 LDA A,I GET USER BUFFER ADR FROM ID TMP WORDS CLE,SSA WAS BUFFER MOVED TO SAM? JMP DVUSY YES,NEED SYSTEM MAP (E)=0 * LDB TWORD GET THE T FIELD WORD RBR GET THE REQUEST CODE TO MSB & LSB SSB,SLB IF THIS IS A CONTROL RQ THEN GO JMP DVUSR UNBUFFERED & IN USER MAP (THIS STINKS !) * * LDB TID GET BACK THE ID SEG ADDR JSB COMN IS THE BUFFER IN COMMON ? RSS NO. JMP DVUSY YES, ENTER THE DRIVER UNDER THE SYS MAP * DVUSR LDA D32 (A) = REG# OF USER BASE PAGE CCB CBX (X) = READ 1 REGISTER LDB DCURU (B) = ADDR OF CURR USER BP SAVE XMM READ REGISTER * LDB TID ADB .14 IS CURRENT USER LDA B,I CORE RESIDENT? AND .15 STA TYP CPA V¾þú.1 WELL? JMP MEMRS YES GO SET MEM RES MAP * ADB .7 STEP TO THE MAP ADDRESS LDA B,I GET MAPID WORD AND B77 GET PARTITION NUMBER MPY .7 MULTIPLY BY 7 ADA $MATA GET MAT ENTRY ADDR STA MATAD SAVE ADDR FOR $SMAP CALL LATER * ADA .3 IT IS DISC RESIDENT USER LDA A,I GET PAGE# FROM MATA ENTRY AND B1777 STA DVMP2,I SAVE SECOND WORD * LDB MAP? DO WE NEED TO FORCE BUILD MAP? ERB (E)=0 FORCE BUILD (E)=1 REUSE CPA CURUS IS USER ALREADY MAPPED? JMP SAMUS YES, SEE IF WE CAN JUST REUSE IT * ISZ DVMPS NEED TO SET UP USER MAP LDA ASVUI FIRST, SAVE CURRENT USER MAP USA NEWUS LDB MATAD SET UP NEW USER MAP JSB $SMAP SET UP USER MAP (B)=MATA ADDR * DVUDV LDA FLAG USER MAP IS NOW SET UP SLA,RSS WAS IT NEEDED BY $XSIO CALL? JMP DVSYS YES, ENTER IN SYSTEM MAP * LDA DVMP1,I SDA? SSA,RSS JMP MAPDV NO, MAP DRIVER INTO DRIVER PTTN * CLE,SLA SDA DRIVER DOES OWN MAPPING? JMP DVDON YES, OK (E)=0 * CCE (E) = 1 MAY BE JUST BIG DRIVER FOR USER LDA TYP SDA + USER MAP CPA .4 BIG BG TYPE? JMP ERR11 YES, NO SDA IN USER MAP JMP DVDON NO, OK FOR SDA IN USER MAP * SAMUS SEZ SAME USER BP, BUT NEED TO REBUILD MAP? JMP DVUDV NO, REUSE MAP JMP NEWUS YES, DON'T SAVE OLD COPY, REBUILD * * * DRIVER SET UP NEEDING MEMORY RESIDENT MAP * MEMRS LDA $MRMP CPA CURUS MEM.RES.MAP ALREADY SET UP? JMP MEMR2 YES * ISZ DVMPS NO, SO SAVE CURRENT USER MAP LDB ASVUI BEFORE SET UP MEM.RES.MAP USB USA SET UP MEM.RES. IN USER MAP MEMR2 LDA FLAG SLA,RSS WAS IT $XSIO CALL? JMP DVSYS YES, ENTER IN SYS MAP ·Ñþú* LDB MSIGN STB DVMP2,I SET WORD 2 = 100000 LDA DVMP1,I SSA,RSS SDA? JMP MAPDV NO, MAP DRIVER INTO DRIVER PTTN * CLE,SLA SDA + SELF-MAPPING? JMP DVDON YES, (E)=0 FOR SDA IN SYS * CCE (E) = 1 BIG DRIVER NEED USER MAP LDA $MRMP MEM.RES. MAP INCLUDE ADA $SDA SDA AND TABLE AREA II? LDA A,I AND B1777 MASK OUT PROTECT BITS CPA $SDA JMP DVDON YES, (E)=1 FOR SDA IN USER MAP * ERR11 JSB $RSM RESTORE USER MAP LDA .11 NEED USER MAP AND SDA DRIVER DOESN'T MAP JMP ILLCD SO GIVE ERROR IO11 * * * * DRIVER SET UP NEEDING SYSTEM MAP * DVCUR CLA,INA $XSIO CALL IN SYS MAP STA MAP? NEEDS USER IN PORT MAP RBL,CLE,ERB (B)= ID SEG ADDR SZB,RSS $CNFG CALLING? JMP DVSYS YES, THERE IS NO ID SEG * ADB .21 LDA B,I GET MAP WORD AND B77 MPY .7 GET MAT ADDR ADA $MATA ADA .3 LDA A,I AND B1777 STA B (B)= PAGE # OF USER BASE PAGE JSB MPUBP MAP IN USER BASE PAGE ADA N32 SET ADDR TO SECOND COPY IN BP ISZ DVMPS LDB ASVUI USB SAVE CURRENT USER MAP USA SET UP MAP FROM SECOND COPY IN BP JMP DVSYS ENTER UNDER SYS MAP * DVUSY CLA USER SWITCHING TO SYS MAP STA FLAG STA MAP? * DVSYS CLA,CLE STA DVMP2,I SET WORD 2 = 0 LDA DVMP1,I SSA SDA? JMP DVDON YES, ENTER IN SYS (E)=0 * MAPDV LDA FLAG MAP DRIVER INTO DRIVER PTTN ERA OF THE APPROPRIATE MAP JSB MPDRV LDB DVMP2,I SEZ ENTER IN SYS MAP? SSB OR USING MEM.RES MAP? JMP DVDON YES, DON'T SAVE USER MAP IN BP * JSB MPUBP MAP IN USER BP IOR MSIGN NO, NEED TO SAVE USER MAP ëþú USA IN DISC RES MAP COPY IN BP * DVDON LDB MAP? SZB ANY USER MAP SET UP? LDB MSIGN SET PORT MAP WORD UP JMP DRVMP,I RETURN (E)=0 SYS (E)=1 USER * * * MAP DRIVER INTO THE DRIVER PARTITION AREA * USING CURRENT DRIVER MAP TABLE ENTRY @DVMP1 * CALLING SEQUENCE: * (E) = 0 USE SYSTEM MAP * (E) = 1 USE USER MAP * JSB MPDRV * * (E) = PRESERVED * ALL OTHER REGISTERS MEANINGLESS * MPDRV NOP LDA DVMP1,I GET PAGE # OF DRIVER AND B1777 STA B LDA $DLTH CAX (X) = # PAGES TO MAP LDA $DVPT (A) = PAGE # OF DRIVER PTTN SEZ ARE WE MAPPING FOR USER ? ADA D32 YES, ADD 32 FOR USER REGISTERS XMS MAP IT JMP MPDRV,I RETURN * * * MAP USER'S PHYSICAL BASE PAGE * CALLING SEQUENCE: * (B) = USER BASE PAGE # * JSB MPUBP * * (A) = LOGICAL ADDR OF SAVE AREA IN USER BP IN SYS MAP * (E) = PRESERVED * ALL OTHER REGISTERS MEANINGLESS * MPUBP NOP CLA,INA (B) = PAGE# OF USER BP CAX (X) = 1 REGISTER TO SET UP LDA $DVPT (A) = PAGE # OF DRIVER PTTN XMS MAP USER BP AT DRIVER PTTN AREA LDA DVPTA (A) = LOG ADDR OF USER MAP COPY JMP MPUBP,I RETURN * * * TWORD NOP TFIELD WORD .14 DEC 14 .21 DEC 21 N32 DEC -32 D32 DEC 32 DVPTA NOP LOG ADDR OF USER MAP COPY (INIT SET UP) DVMP1 NOP DVMP2 NOP MATAD NOP FLAG NOP DCURU DEF CURUS CURUS NOP B1777 OCT 1777 *** * TID NOP TYP NOP ASVUI DEF SVUSR,I ADDRESS WITH SIGN SET FOR SAVE ASVUS DEF SVUSR SVUSR BSS 32 DVMPS BSS 1 DRIVER MAP FLAG * ********RESTORE USER MAP TO PRE-****** ********DRIVER STATE****************** * * $RSM NOP CLA CPA DVMPS WAS USER MAP CHANGED JMP RSEX NO,RETURN * STA DVMPS YES,CL8ÊþúEAR CHANGE MAP FLAG LDA ASVUS USA RESTORE ORIGINAL USER MAP RSEX JMP $RSM,I ENABLE SYSTEM MAP * * * ************************************** * $DRVM DRIVER MAP SET-UP FOR CONTINUATION * CALLING SEQUENCE: * * SET UP EQT ADDRESSES * JSB $DRVM * --- RETURN WITH (E) INDICATING WHICH MAP * (E)=0 NEEDS SYSTEM MAP * (E)=1 NEEDS USER MAP * ALL OTHER REGISTERS MEANINGLESS * ************************************************ ***********NO EXTERNAL ROUTINE SHOULD CALL ***********$DRVM OR $RSM EXCEPT SPOOL AND POWER-FAIL ************************************************** * * $DRVM NOP JSB CPEQT GET EQT # INTO (A) CCB ADB A ADB $DVMP STB DVMP1 SAVE ADDR DRIVER MAP TABLE WORD 1 ADB EQT# LDA B,I CLE,SZA,RSS IS SECOND WORD = 0? JMP SDDRV YES, SYSTEM MAP NEEDED * STB DVMP2 SAVE ADDR DRIVER MAP TABLE WORD 2 LDA D32 (A) = REG# OF USER BASE PAGE CCB CBX (X) = READ 1 REGISTER LDB DCURU READ INTO 'CURUS' XMM READ MAP REGISTER LDB DVMP2,I GET SECOND WORD CCE,SSB MEM RES PROG? (E)=1 JMP MRPUS YES * CPB CURUS SAME USER ALREADY MAPPED? JMP SDUSE YES, RETURN (E)=1 * ISZ DVMPS NO, DIFFERENT USER LDA ASVUI SAVE CURRENT USER MAP USA JSB MPUBP AND MAP IN USER BASE PAGE USA TO MAP USER WITH COPY OF MAP SDUSE LDA DVMP1,I SSA,RSS SDA? JMP $DRVM,I NO, RETURN * SDADV SLA YES, BUT IS IT SDA+MAPPING? CLE YES, ENTER IN SYS MAP (E)=0 JMP $DRVM,I RETURN (E)=0 SYS (E)=1 USER * * MRPUS LDA CURUS CPA $MRMP,I WAS MEM RES MAP IN USER MAP? JMP SDDRV YES, JUST MAP IN DRIVER *1926DLS* * ISZ DVMPS NO, DIFFERENT USER LDB ASVUI SAVE CURRENT USE¾ÎHFBR MAP USB * MRDRV LDA $MRMP SET UP MEM.RES. MAP USA * SDDRV LDA DVMP1,I (E)=0 SYS (E)=1 USER SSA IS DRIVER IN SDA? JMP SDADV YES, SEE IF SELF-MAPPING * JSB MPDRV NO, NEED TO MAP DRIVER IN CORRECT MAP JMP $DRVM,I RETURN (E IS STILL SAME) * Ç6Hÿÿþú SKP * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED OR COMPLETED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * RETURNED TO THE CALLER FOR * FURTHER ACTION. * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 ¬Çþú THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL # 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE RAL SSA,SLA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * RAR IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * STB A SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING RAL SSA,SLA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. RAR ALR,RAR CLEAR STA EQT5,I FIELD. * JSB DRVMP GO SET MAP INITIALLY ADB CHAN (B) HAS MAP INDICATOR FOR PORT XMB JMP DV02C CONTINUE * * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * JSB DRVMP GO SET MAP INITIALLY DV02C ELA SAVE (E) STA MAP? LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. ÁþúLDA B,I GET REQUEST CONTROL WORD, AND NTSUB SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT,CLEAR LOW. STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. * AND .6 CPA .6 CCA,RSS THIS IS A CONTROL CALL LDA C100K NOT CONTROL SET TO MASK OUT SIGN * AND B,I * DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. * * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND B77 # OF I/O DEVICE. LDB MAP? ERB LDB EQT2,I CALL DRIVER *INITIATION* ELB,CLE,ERB CLEAR SIGN BIT WITHOUT CHANGING E *1926DLS* SEZ ENTER DRIVER IN USER MAP? JMP INUS YES * JSB B,I NO, ENTER IN SYSTEM MAP JMP DRVRT * MAP? NOP * INUS JSB $UIN ENTER IN USER MAP, RETURN TO DRVRT SKP * * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJECT. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY!!þú * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * DRVRT STA TEMP6 SAVE DRIVER CODE. JSB $RSM GO RESOTRE USER MAP LDA TEMP6 RESOTRE DRIVER CODE CCE,SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I IF NO QUE SZA SKIP BUSY SET STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED * DRV06 STB TLOG SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE SPC 1 C7700 OCT 170077 NTSUB OCT 153703 B174K OCT 174000 B20K OCT 20000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR > * SYSTEM I/O REQUEST PROCESSOR - $XSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A PRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * Ãþú SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * 8 OCT <0> OR * OR <100000 IF USE USER MAP UNCHANGED> * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. RBL,CLE,ERB STRIP SIGN BIT IF SPECIAL SEG LOAD CALL STB $CKLO SAVE FOR *STADV*. ADB DRT INDEX INTO THE DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * LDB $XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 ï~þú REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE THE SUB CHANNEL CLE,INB SET ADDRESS OF HIS CON WORD ELA,ALF MOST BIT TO 'E', REST AROUND ELA,SLA,RAL TO BITS 2-5, SKIP IF MOST IS ZERO ADA B20K SET MOST IN BIT 13 IF REQUIRED ADA MSIGN ADD THE 'SYSTEM REQUEST' BIT XOR B,I ADD HIS INFORMATION AND SUBCH =B120074 THROW OUT THE EXCESS XOR B,I SET HIS BITS AGAIN STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). STA TEMPL SET DISC FLAG TO ZERO (NON-DISC) LDA EQT5,I GET THE DRIVER TYPE AND B36K MASK TO TEST FOR DISC ADB .4 SET B TO THE RETURN ADDRESS STB $XSIO AND SAVE IT ADB N2 SET B TO DISC PRIORITY WORD LDB B,I GET PRIORITY WORD CPA B14K IF DISC STB TEMP2 SET PRIORITY CPA B14K AND STA TEMPL THE DISC FLAG FOR * JSB LINK CALL TO LINK REQUEST IN I/O LIST. SEZ IF DEVICE IS BUSY JMP $XSIO,I THEN EXIT. * LDA $CKLO ELSE, IF DEVICE IS JSB STADV DOWN, THEN RETURN RSS TO CALLER. * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. SPC 1 XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK, (PLUS SYSTEM RQ CODE) HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCA®…þúTION * OF THE TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * <$CON1> IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) * * THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * * 2) USER (AUTOMATIC OUTPUT BUFFERING) * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . * N+8 * SKP * * 4) SYSTEM REQUEST * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * 11 CLASS I/O * * SKP $CON1 RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION LOG STB XLOG SAVE TRANSMISSION LOG º±þúFOR RETURN. * JSB $RSM GO RESTORE USER MAP IF NECESSARY * CLA CLEAR STA EQT15,I TIME-OUT CLOCK. * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. * L.49 LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB REQUEST BLOCK TO JMP L.502 IF CLEAR COMPLETION GO CLEAN IT UP. STB IOE11 SAVE CONWD FOR *IOERR* USE. * LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. LDB EQT1,I LDA TEMP3 IF ERROR, CPA .1 GO PROCESS. JMP NOTRD * LDA B,I UNLINK STA EQT1,I CURRENT I/O LDA TEMP0 REQUEST. RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. * SEZ,RSS IF = 0, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 IF MALFUNCTION OCCURRED, SZA THEN UNDO THE RELINKING STB EQT1,I AND BY PASS RELEASE OF SZA BUFFER. JMP L.70 STB L.50 * ADB .3 GET TOTAL LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 JSB $CKLO CHECK IF BELOW THE LIMIT. IF SO, JMP L.54 SCHED ANY WAITERS. START NEXT REQUEST. * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. SKP * * NORMAL USER OPERATION COMPLETION * L.51 STB L.52 SET CURRENT ADDR. FOR SCHEDULER. ADB .9 SE^ÑþúT (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 STB PTR SAVE THE QUEUE ADDRESS SEZ IF CLASS REQUEST JMP C.01 GO REQUEUE THE REQUEST * ADB N1 GET WORD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. SKP * * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * BACK INTO THE LIST, OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 BY PASS INITIATING THE NEXT CMA,SSA,INA,SZA OPERATION IF A MALFUNCTION HAS JMP L.70 OCCURRED ON THIS DEVICE. * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JSB CLDVM CLEAR DRVR MAP TABLE WORD 2 JMP L.68 GO START THE NEXT REQUEST * .11 DEC 11 N8 DEC -8 * * CHECK IF BELOW THE BUFFER LIMIT ON TÀÕB@ * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT# SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IF A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABO3PþúRTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. JSB $ETEQ SET EQT ADDRESSES. * LDA EQT1,I IF NO I/O QUEUED ON THIS SZA,RSS DEVICE, THEN GO CLEAN OUT JMP L.60 ITS 'WAITING ON DMA ALLOC.' FLAG. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1 GO CLEAN OUT ANY CPA $DMEQ I-O REQUESTS IF THIS JMP IOCX7 IS THE BIT BUCKET. * LDB EQT1,I IF NO REQUEST SZB,RSS IS WAITING, THEN JMP IOCX GO EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. SKP * **************************************************************** * * I/O COMPLETION - EXIT SECTION. * * THIS ROUTINE FIRST CHECKS FOR A DMA QUEUE AND IF ANY AND IF A * CHANNEL IS AVAILABLE, THEN THE CHANNEL ASSIGNMENT ROUTINE * IS ENTERED. IF THIS CONDITION DOES NOT EXIST, THEN * IF THE "BIT BUCKET FLAG" IS SET, THEN THE BIT BUCKET * I/O REQUEST ARE CLEANED OUT. IF THE FLAG IS NOT SET, THEN * IF THE REQUEST IS A SYSTEM REQUEST WITH A COMPLETION ADDRESS, * THEN CONTROL IS TRANSFERED TO THE COMPLETION ADDRESS. IF * NEITHER OF THESE CONDITIONS EXITS, THEN THE OPERATOR ATTENTION * FLAG IS CHECKED. IF SET, THEN THE OPERATOR ACKNOWLEDGEMENT * ROUTINE IS ENTERED.€þú IF NOT SET, THEN CONTROL IS RETURNED * TO THE SYSTEM. * ***************************************************************** * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDB $BITB CHECK THE "BIT BUCKET FLAG" TO SEE SZB TO SEE IF THE BIT BUCKET MUST BE JMP IOCX0 CLEANED OUT. * LDA COMPL IF SYSTEM REQUEST STB COMPL CLEAR COMPLETION SPECIFICATION. LDB XLOG SZA COMPLETION ROUTINE SPECIFIED, JMP A,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ OTHERWIZE, RETURN TO THE DISPATCHER. * XLOG NOP SKP * * * CLEAN OUT BIT BUCKET REQUESTS. * * IOCX0 LDA $DMEQ SET UP THE BIT JSB $ETEQ BUCKET EQT ADDRESSES. IOCX7 LDB EQT1,I CHECK IF THERE IS ANY SZB,RSS I/O REQUEST TO BE JMP IOCX9 INITIATED ON THE BIT BUCKET. * LDB EQT1,I YES, SO GET THE REQUEST'S ADB .3 SIZE AND DO AN IMMEDIATE LDB B,I COMPLETION. JMP L.136 * IOCX9 STB $BITB NO, SO CLEAR BIT BUCKET FLAG AND JSB $CKLO CHECK BUFFER LIMITS AND SCHED.WAITERS. JMP IOCX1 * $BITB NOP BIT BUCKET FLAG. DO NOT TOUCH. SKP * * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ‚þúON JMP IOERR OTHER DEVICE, PRINT DIAG. * * DISC ERROR PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CNV3 CONVERT TO DECIMAL ASCII. INA DLD A,I SET DECIMAL TRACK DST DMSG+1 IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). JSB $CNV1 STA DMSG+5 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII AND B37 JSB $CNV1 STA DMSG+7 * LDB TEMP0 (B)= REQUEST TYPE LDA BLS (A)= " S" SSB,RSS IF USER TYPE REQUEST, LDA BLU (A)= " U" STA DMSG+8 SET "S" OR "U" IN MESSAGE * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS LDA DMSGA PRINT DIAGNOSTIC: JSB $SYMG "TRNNNN EQTXX,UYY S(OR U)" * CCB LDA TEMP0 IF DISC ERROR SSA FROM SYSTEM REQUEST, JMP L.71 CONTINUE. * STB TEMP9,I SET TLOG IN ID-SEGMENT FOR ABORT ALF,ALF IF LU # 2 OR 3, AND .3 SET TRACK DOWN SZA,RSS IN TAT- JMP L.71 OTHERWISE, CONTINUE * SLA,RSS CLB,RSS LDB TATSD ADB TLOG INDEX TO ADB TAT TAT, SET ERROR LDA MSIGN TRACK STA B,I "DOWN" (ASSIGNED TO SYSTEM). * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * L.71 STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * DMSGA DEF *+1 DEC -18 DMSG ASC 9,TRNNNN EQTXX UYY S BLS ASC 1, Sñ4þú BLU ASC 1, U HED < I/O CONTROL MODULE - ERROR SECTION > * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR00 CLB,RSS ILLEGAL CLASS NUMBER OR SECURITY CODE ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR03 LDB .3 ILLEGAL EQT REFERENCE. SELECT CODE = 0 RSS ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM RSS OR OTHER BOUNDARIES. ERR05 LDB .5 ILLEGAL DISC TRACK OR SECTOR RSS ADDRESS IN DISC REQUEST. ERR06 LDB .6 REFERENCE TO PROTECTED DISC TRACK RSS ERR08 LDB .8 DISC TRANSFER EXCEEDS TRACK BOUND RSS ERR09 LDB .9 LOAD-N-GO AREA OVERFLOW RSS ERR10 LDB B400 DOUBLE REQUEST ON SAME CLASS * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * ERIO ASC 1,IO B400 OCT 400 SKP * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJECT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORYuþú. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETION ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TLOG ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. CPA .2 SET ERROR FLAG FOR CLA CLASS COMPLETION. CMA,INA NEGATE TO AVOID STA TEMP3 REPORT AT L.54. LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * CCE,SLA IF CLASS REQUEST JMP L.49 GO DO CLASS COMPLETION. ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01B SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01A IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01A NOP - FWA - R01B NOP - # WORDS - JMP REXIT * R02 SLA,RSS CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL AD…ÚþúDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE CCE,INA SET XSUSP(SET E FOR $CNV1 STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA TEMP4 CPA .1 CHANGE ANY NOT READY REJECT LDA .7 CODE TO 7. JSB $CNV1 CONVERT TO ASCII AND IOR AS00 FILL LEADING ZEROES LDB A STORE IN B REG. LDA ERIO (A) = ASCII * IO * JSB $ERMG PRINT DIAGNOSTIC AND ABORT PROG CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05A ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TLOG STORE INA TRANSMISSION LOG STB A,I IN XB. JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK R05A NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD CLB CLEAR ERROR STB TEMP3 FLAG. CPB CONFL IF $XSIO CALL SSA,RSS THEN SKIP, JMP L.501 ELSE DO NEXT REQUEST. JMP $XSIO,I $XSIO ERROR RETURN (REQUEST SKIPPED) * * AS00 ASC 1,00 SKP * ****************************************$ þú****************************** * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE IS UNAVAILABLE FOR * INITIATION OF AN OPERATION OR WHEN AN ERROR IS DETECTED AT THE * END OF AN OPERATION. A DIAGNOSTIC MESSAGE IS PRINTED ON THE * SYSTEM CONSOLE IN THE FOLLOWING FORMAT: * * I/O MN LXX EYY SZZ * * WHERE: XX = THE LOGICAL UNIT NUMBER OF THE DEVICE * YY = THE EQT NUMBER OF THE DEVICE * ZZ = THE SUBCHANNEL NUMBER OF THE DEVICE * MN = A MNEMONIC DESCRIBING ONE OF THE FOLLOWING CONDITIONS * 1. NR - DEVICE IS NOT READY * 2. ET - END-OF-TAPE OR TAPE SUPPLY LOW ON THE DEVICE * 3. PE - TRANSMISSION PARITY ERROR TO/FROM THE DEVICE * 4. TO - THE DEVICE TIMED OUT * -- NEW CODES MAY BE ADDED HERE -- * * GIVEN A BAD I/O REQUEST, IOERR WILL DOWN ALL LU'S ASSOCIATED WITH * THE DEVICE(DEFINED BY THE EQT AND SUBCHANNEL). ALL I/O CHANNELS * ASSOCIATED WITH THE EQT ARE CLEARED. ALL I/O REQUESTS ASSOCIATED * WITH THE DEVICE ARE UNSTACKED FROM THE EQT'S I/O REQUEST QUEUE AND * RELINKED IN THE LOWEST LU'S(MAJOR LU) I-O REQUEST QUEUE(DRT ENTRY * WORD 2)BY THE SUBROUTINE UNLNK. DRT ENTRY WORD 2 OF OTHER DOWNED * LU'S ARE SET TO THE LU NUMBER OF THE MAJOR LU. THE LU DOWN BIT(BI * 15 OF DRT ENTRY WORD 2)FOR EACH DOWNED LU IS SET. THE EQT ENTRY I * NOT SET DOWN. I/O ERROR MESSAGES ARE ISSUED FOR ALL LU'S SET DOWN * * ON ENTRY, CONTAINS A NUMBER CORRESPONDING TO THE ASSOCIATED * MNEMONIC AND EQT1 CONTAINS THE ADDRESS OF WORD ONE OF THE ASSOCIAT * DEVICE'S EQT ENTRY. * * THE FOLLOWING TEMPORARY LOCATIONS ARE USED FOR TEMPORARY STORAGE B * IOERR: * :=SUBCHANNEL-EQT WORD FOR THE BAD I-O REQUEST GIVING THE * SUBCHANNEL IN BITS 11-15 AND THE EQT IN BITS 0-5(USED BY * LUERR). * :úþú=WORD 2 OF THE BAD I-O REQUEST. * ********************************************************************** * SKP NOTRD LDB EQT1,I LU NOT READY ENTRY. INB GET BAD I-O REQUEST CONWD STB IOE11 AND SAVE FOR LATER. CLA,INA SET A=1 FOR NOT READY. * IOERR LDB EQT1 REMOVE ALL ENTRIES IN THE QUEUE STB HEAD RELATED TO THE BAD I-O REQUEST. ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND SET STA IOMSG+2 IN DIAGNOSTIC MESSAGE. JSB CLDVM CLEAR DRIVER MAP TABLE WORD 2 * LDA BLL SET UP STA IOMSG+3 "L" AND LDA BLS "S" IN THE STA IOMSG+7 DIAGNOSTIC MESSAGE. * JSB CPEQT GET EQT NUMBER(SETS E=1). STA TEMP8 SAVE EQT NUMBER. JSB $CNV1 CONVERT TO ASCII STA IOMSG+6 AND SAVE(E MUST = 1). * LDA EQT4,I GET LAST USED SUBCHANNEL ALF,RAL FORM EQT4 AND POSITION AND B174K TO HIGH 5 BITS. IOR TEMP8 ADD IN EQT NUMBER STA TEMP8 AND SAVE AS SUBCHANNEL-EQT WORD. * ALF,RAL GET SUBCHANNEL AND B37 NUMBER. JSB $CNV1 CONVERT TO ASCII(ON ENTRY,E MUST=1) STA IOMSG+8 AND SAVE. * JSB LUERR DOWN THE LOGICAL UNITS(ENTRY A#0).WAIT UNTIL LDA EQT5,I AFTER LUERR CALL TO SET AVAIL FIELD TO 0 SO ALR,RAR WE WON'T ENTER DRIVER(VIA $XSIO)TO PRINT STA EQT5,I ERROR MESSAGE ON SAME EQT WE'RE DOWNING. * SEZ CHECK IF WE TRIED TO JMP IOER9 DOWN LU 1. IGNORE ATTEMPT. * LDA EQT1 LDB A,I CHECK IF WE MUST SZB INITIATE AN JSB $DLAY I/O REQUEST OF THIS EQT. * LDB IOE11,I GET SAVED WORD 2(CONWORD) LDA CONFL FOR THE BAD I/O REQUEST. SZA IF COMPLETION SECTION IS IN JMP IOCX CONTROL, THEN EXIT IOC. * RBL,SLB IF REQUEST SEC£þúTION IN CONTROL, SSB CHECK IF USER OR SYSTEM I/O REQUEST. JMP IOCX IF USER, GO TO EXECUTION SECTION. JMP XSIOE,I IF SYSTEM, RETURN TO SYSTEM CALLER. * IOER9 LDA CONFL SAVE CONTROL STA SCONF FLAG. CLA,INA SET JSB $CNV1 ASC11 1 STA IOMSG+4 INTO MESSAGE. LDA IOMSA JSB $SYMG ISSUE MESSAGE. LDA SCONF RESTORE FLAG. STA CONFL JMP L.60 * HEAD NOP IOE11 NOP * * IOMSA DEF *+1 DEC -18 IOMSG ASC 9,I/O MN LXX EYY SZZ * * * * I/O DEVICE ERROR MNEMONIC TABLE--ORDERED BY * ERROR CODE DESCRIBING CONDITION. * ERTBL DEF * ASC 1,NR - NOT READY - ASC 1,ET - END OF TAPE (INFORMATION) - ASC 1,PE - TRANSMISSION PARITY ERROR - ASC 1,TO - TIMED-OUT - * * NEW CODES MAY BE ADDED AT THIS POINT * SBMSK OCT 20074 BLL ASC 1, L * SKP * ***************************************************************** * * SUBROUTINE LUERR * * THIS SUBROUTINE IS USED TO DOWN ALL LU'S CORRESPONDING TO A * SPECIFIC EQT AND SUBCHANNEL. IT WILL OPTIONALLY PRINT AN * ERROR MESSAGE FOR EACH DOWNED LU. * * CALLING SEQUENCE: * :=0 DO NOT PRINT I/O ERROR MESSAGES * :#0 PRINT I/O ERROR MESSAGES(ASSUMES ASCII EQT AND * SUBCHANNEL ALREADY SET) * := POINTER TO I-O REQUEST LIST TO SCAN. * :=SUBCHANNEL-EQT WORD FROM THE BAD I-O REQUEST. * JSB LUERR * * RETURN: * :=1 TRIED TO DOWN LU 1 * :=0 DID NOT TRY TO DOWN LU 1 * NO REGISTERS ARE SAVED. * SUBROUTINE UNLNK USES TEMP0 AND OTHERS. * USES THE FOLLOWING REGISTERS: * :=FLAG AS TO WHETHER TO PRINT(#0) OR NOT PRINT(=0) * I/O ERROR MESSAGES. * :=USED TO STORE THE MAJOR LU. * :=COUNTER FOR SCAN THROUGH DRT. * :=USED TO SAVE POINTER INTO DRT. * :=USED TO SAVE EQT1. * :=USED TO STORE LU TEMPORARILY. * ****************************************************************** * LUERR NOP STA TMP1 * LDA CONFL SAVE CURRENT STA SCONF CONTROL FLAG. * CLA SET MAJOR LU STA TMP2 TO ZERO. * LDA LUMAX SET CMA,INA UP STA TMP3 COUNTER. LDB DRT GET FIRST DRT ENTRY. * SKP D.00 LDA B,I GET DRT WORD 1 STB TMP4 SAVE POINTER IN DRT. AND C3700 COMPARE DRT WORD 1 TO THE SUBCHANNEL- CPA TEMP8 EQT WORD(LESS THE LOCK FLAG). RSS IF EQUAL,FOUND A LU,SO GO PROCESS. JMP D.04 OTHERWIZE,GO CONTINUE SCAN OF DRT. * LDA LUMAX FOUND A LU MATCH SO PROCESS IT. CCE,INA COMPUTE THE(SET E=1 FOR POSSIBLE LU=1) ADA TMP3 LU NUMBER. STA TMP8 SAVE LU NUMBER FOR LATER. CPA .1 CHECK TO SEE IF SYSTEM CONSOLE. IF SO, JMP D.06 DO NOT SET THE DEVICE DOWN. ADB LUMAX POSITION POINTER TO DRT WORD 2. LDA TMP2 CHECK TO SEE IF A MAJOR SZA LU HAS BEEN FOUND JMP D.02 IF SO,THEN STORE THE MAJOR LU # IN WORD * 2,SET THIS LU BUZY,ISSUE MESSAGE. * STB A SAVE DRT WORD 2 ADDRESS. LDB EQT1 SAVE EQT1 ADDRESS STB TMP6 FOR RESTORATION. LDB HEAD GO UNLINK ANY I-O REQUESTS FROM JSB $UNLK THE GIVEN I-O QUEUE. DEF TEMP8 LDA TMP8 SAVE THIS LU STA TMP2 AS MAJOR LU. LDB TMP4 RESTORE POINTER TO DRT WORD 2. ADB LUMAX LDA B,I D.02 CCE RAL,ERA SET THE(E MUST=1) STA B,I LU DOWN. LDB TMP1 CHECK IF WE ARE TO PRINT ERROR CCE,SZB,RSS MESSAGES(SET E=1 ’bNLHFOR $CNV1). JMP D.025 NO, SO SKIP. LDA TMP8 JSB $CNV1 CONVERT LU TO STA IOMSG+4 ASCII AND SAVE. LDA IOMSA GET LU I/O ERROR MESSAGE JSB $SYMG AND ISSUE TO USER. LDA TMP6 RESTORE JSB $ETEQ EQT POINTERS. D.025 LDB TMP4 * D.04 INB INCREMENT POINTER TO NEXT DRT ENTRY. ISZ TMP3 JMP D.00 GO SCAN NEXT ENTRY. * JSB $CKLO CHECK BUFFER LIMITS AND SCHED WAITERS. CLE D.06 LDA SCONF RESTORE CONTROL STA CONFL FLAG. JMP LUERR,I IF NO MORE LU ENTRIES, RETURN. –“Nÿÿþú SKP * *********************************************************************** * * SUBROUTINE $UNLK * * THIS SUBROUTINE IS USED TO UNLINK I/O REQUESTS FROM THE EQT I/O * REQUEST QUEUE POINTED TO BY EQT1. IT MAY BE USED IN ONE OF TWO * MODES: * MODE I. IF ON ENTRY THE A REGISTER EQUALS ZERO, NORMAL USER * (UNBUFFERED)I-O REQUESTS ARE UNLINKED WITH THE CALLING * PROGRAMS SUSPENDED IN THE GENERAL WAIT LIST. IT IS * ASSUMED THAT THE EQT WILL BE SET DOWN BY THE CALLER. * MODE II. IF ON ENTRY THE A REGISTER IS NONZERO, THEN ONLY I/O * REQUESTS MATCHING THE SUBCHANNEL GIVEN IN SUEQT ARE * UNLINKED. UNBUFFERED I/O REQUESTS ON THIS SUBCHANNEL AR * HANDLED AS IN MODE I. BUFFERED, CLASS AND SYSTEM * I/O REQUESTS ARE STACKED UPON AN LU I/O REQUEST QUEUE AF * THE I/O REQUEST POINTED TO BY THE A REGISTER IN THE ORDE * THAT THEY APPEARED IN THE EQT QUEUE. * * CALLING SEQUENCE: * :=THE SUBCHANNEL-EQT WORD DEFINING THE DEVICE(MODE II * ONLY, UNUSED WITH MODE I). * :=EQT1(HEAD OF THE I-O REQUEST QUEUE)OF THE DEVICE'S * EQT(USED WITH MODE I AND II). * :=0 INDICATES MODE I PROCESSING. * :#0 INDICATES MODE II PROCESSING. POSITION IN LU I/O REQ * QUEUE AFTER WHICH ALL UNLINKED I-O REQUESTS ARE * TO BE RELINKED. * JSB $UNLK * DEF SUEQT * * RETURN: * NO REGISTERS ARE SAVED. * USES UNLK3,UNLK8,TEMPX,TEMP0 * ************************************************************************ SKP $UNLK NOP STB TMP5 SAVE EQT ADDR FOR A WHILE STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. LDA $UNLK,I LDA A,I AND B174K GET SUBCHANNEL CLE,ELA AND SHIFT RAL,RAL UPPER BIT þú ALF TO BIT 13 SEZ ADD IN LOWER 4 BITS ADA B20K AT BITS 2-5 STA TEMP0 AND SAVE. RSS * UNLK0 LDB TEMPX,I GET NEXT ENTRY. UNLK1 STB TEMPX SAVE POINTER TO PREVIOUS REQUEST. UNLK2 LDB TEMPX,I GET POINTER TO THIS REQUEST. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. SZB,RSS IF END, JMP UNLK6 THEN GO EXIT. * STB UNLK3 SAVE POINTER TO THIS REQUEST. INB STEP TO CONTROL WORD OF THIS REQUEST. LDA UNLK8 CHECK IF MODE I OR II PROCESSING. SZA,RSS JMP UNL25 MODE I SO SKIP SUBCHANNEL CHECK. LDA B,I GET CONTROL WORD OF THIS REQUEST. AND SBMSK PICK OFF SUBCHANNEL INFORMATION AND CPA TEMP0 COMPARE TO THE SUBCHANNEL INFO OF RSS THE BAD I/O REQUEST. IF NOT EQUAL, JMP UNLK0 GO CHECK THE NEXT I/O REQUEST. * UNL25 LDA B,I GET CONTROL WORD OF THIS I/O RAL REQUEST AND ROTATE IT. CMA,SSA,SLA,RSS IF NOT STANDARD USER REQUEST, JMP UNLK4 GO PROCESS AS OTHER TYPES. * LDA .4 STANDARD USER, SO SUSPEND PROGRAM STA B,I IN GENERAL WAIT LIST AND LDA TMP5 SET ID TEMP WORD #1 TO 4. CMA,INA NEGATE EQT ADDR INB TO SAVE IN TEMP WORD #2 STA B,I BECAUSE WE DON'T KNOW LU# ADB .7 LDA B,I STEP TO SAVED A-REG., GET SAVED ADB N1 POINT OF SUSPENSION, AND STORE STA B,I IT IN XSUSP FOR THIS PROGAM. LDA UNLK3,I UNLINK THIS STA TEMPX,I I/O REQUEST. JSB $LIST LINK THIS PROGRAM INTO THE OCT 103 GENERAL WAIT LIST. UNLK3 NOP JMP UNLK2 GO TRY NEXT ENTRY. * UNLK4 LDA UNLK8 CHECK IF MODE I OR II. SZA,RSS IF MODE I, DO NOT UNLINK JMP UNLK0 THIS REQUEST. GO TRY NEXT ONE. LDB UNLK8,I IF MODE II, CLEAR RBL,CLE,ERB ¤Óþú POSSIBLE SIGN BIT LDA UNLK3,I AND LINK THIS I-O STA TEMPX,I STB UNLK3,I REQUEST TO THE LDB UNLK3 END OF THE DOWN STB UNLK8,I I/O REQUEST QUEUE. STB UNLK8 SET UNLK8 TO POINT TO THE LAST REQUEST. JMP UNLK2 GO TRY NEXT ENTRY. * UNLK6 ISZ $UNLK JMP $UNLK,I RETURN * * UNLK8 NOP TEMPX NOP * TMP1 NOP TMP2 NOP TMP3 NOP TMP4 NOP TMP5 NOP TMP6 NOP * TMP8 NOP SKP * ****************************************************************** * * SUBROUTINE $DLAY: * * $DLAY IS USED TO SET UP A SHORT TIMEOUT(10 MSEC)WHICH, WHEN IT * OCCURS, SIGNALS THAT AN I/O OPERATION MUST BE INITIATED ON THE * TIMED-OUT EQT(SEE $DEVT). * * CALLING SEQUENCE: * LDA * JSB $DLAY * * RETURN: * ALL REGISTERS ARE MODIFIED. * ***************************************************************** * $DLAY NOP CCE,INA SET THE SIGN BIT LDB A,I ON TO INDICATE RBL,ERB WE MUST INITIATE AN STB A,I OPERATION. ADA .3 CCE LDB A,I SET THE RBL,ERB EQT STB A,I BUZY. ADA .10 LDB N1 SET A STB A,I TIMEOUT JMP $DLAY,I OF 10 MSEC. HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * $CON1 IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * IF THE TIMEOUT WAS DUE TO THE NEED TO INITIATE AN * I/O OPERATION(BIT 15 EQT2 SET)THEN THIS BIT * IS CLEARED AND $CON1 IS ENTERED(AT L.60) TO * INITIATE THE I/O OPERATION. * * * ENTER FROM SCHEDULER MODULE: * * (A)
* * èØþú$DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I GET THE CLEAR BIT SSA IF CLEAR TIME OUT JMP CLTIM JUST CLEAR * LDA EQT2,I CHECK IF THE TIMEOUT SSA IS FOR INITIATING I/O JMP INTDL ON THIS EQT. * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A STA INTCD BLF,SLB IF DRIVER TO HANDLE TIME JMP CIC.6 OUT GO CALL THE DRIVER. * CLTIM JSB CLCHS CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP $CON1 RETURN FROM DRIVER * INTDL RAL,CLE,ERA CLEAR INITIATION STA EQT2,I BIT. ISZ CONFL SET CONTROL FLAG TO NONZERO. JMP L.60 GO INITIATE. * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * ***************************************************************** * * CONSTANT AND VARIABLE STORAGE AREA * ******************************************************************* * A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .3 DEC 3 .5 DEC 5 .8 DEC 8 .9 DEC 9 .10 DEC 10 N1 DEC -1 * B77 OCT 77 B377 OCT 377 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 MSIGN OCT 100000 * TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP7 NOP TEMP8 NOP TEMP9 NOP TEMP0 NOP TEMPL NOP TEMPW NOP * CONFL NOP SCONF NOP TLOG NOP COMPL NOP DO NOT USE FOR INIT CODE(MUST=0 BEGIN). DMACF NOP FLAGS USED IN ALLOCATING HED ** I/O CONTROL - OPERATOR COMMUNICATION ** * ***************************************************************** * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM USES COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OôIþúF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR STATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWO OF THE I-O CONTROL STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE * AND ARE INCLUDED IN RTIOC. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-OUT, AND EQT STATUS) * ARE OPTIONAL AND ARE CONTAINED IN THE USER PROGRAM * $$$CMD WHICH IS SCHEDULED BY SCHED. THESE COMMANDS * MAY BE REMOVED BY DELETING $$CMD. * ****************************************************************** * SKP * **************************************************************** * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,N1 OR DN,,N2 * WHERE N1 IS THE EQT # OF THE I/O SLOT TO BE SET DOWN * OR N2 IS THE LU # OF THE I/O DEVICE TO BE SET DOWN. * * ACTION: WHEN SETTING THE EQT DOWN, THE AVAILABILITY FIELD OF THE * REFERENCED SLOT IS SET = 1(SLOT DISABLED). * WHEN SETTING THE LU DOWN, BIT 15 OF DRT WORD 2 IS SET AND * ANY I/O FOR THIS DEVICE IS REMOVED FROM THE EQT I/O * QUEUE AND ADDED TO THE LU I/O QUEUE HEADED AT DRT * WORD 2. * * CALL (FROM MESSAGE PROCESSOR): * * := N1 (EQT #) IN BINARY OR 0 * :=-1 OR N2 (LU #) IN BINARY * JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR TO -MESS.I- TO PRINT * * INPUT ERROR * IF N1 OR N2 ARE ILLEGAL OR IF BOTH ARE PRESENT. * ëþú **************************************************************** * $IODN SZA,RSS CHECK IF DOWN LU OR JMP DNLU DOWN EQT COMMAND. * INB,SZB DOWN EQT COMMAND. IF BOTH LU AND EQT ARE JMP $INER GIVEN, ISSUE INPUT ERROR MESSAGE. * JSB IODNS CHECK LEGALITY OF EQT & SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO DOWN EQT OF SYSTEM CPA SYSTY CONSOLE, ISSUE INPUT ERROR MESSAGE. JMP $INER LDA EQT5,I SET AVAILABITY FIELD ALR,RAR TO 1 IOR B40K TO SET STA EQT5,I DOWN. * JSB XUPIO SET ANY DOWNED LU'S UP. * LDB EQT1,I GO PUT ALL WAITERS(UNBUFFERED RBL,CLE,ERB I/O)INTO THE BENERAL WAIT SZB,RSS LDB EQT1 CLA LIST. SKIP FIRST REQUEST. JSB $UNLK DEF A (DUMMY DEF FOR THIS MODE). JMP $XEQ RETURN. * DNLU STB A SAVE LU NUMBER. CMB,CLE,INB,SZB,RSS ISSUE AN ERROR MESAGE JMP $INER IF THE LU IS LESS THEN ADB LUMAX 1 OR IS GREATER THEN CCB,SEZ,RSS LUMAX. JMP $INER * ADB A USE LU NUMBER ADB DRT TO POSITION TO LDA B,I WORD 1 OF THE AND C3700 DRT ENTRY. STA TEMP8 SET UP SUBCHANNEL-EQT WORD. AND B77 INPUT SZA,RSS ERROR IF JMP $INER DOWNING BIT BUCKET DEVICE. * STB TEMP9 SAVE ADDRESS OF DRT WORD 1. JSB $CVEQ SET EQT ENTRY ADD(WILL MASK SUBCH.). * LDB EQT5,I CHECK IF RBL,SLB EQT IS JMP DNLU5 UP OR IS SSB DOWN. JMP DNLU9 EQT IS DOWN. * DNLU5 LDB EQT1,I SKIP FIRST EQT I-O REQUEST QUEUE SZB,RSS ENTRY UNLESS THE QUEUE IS EMPTY. LDB EQT1 STB HEAD SAVE THIS POINTER. CLA SET FOR NO ERROR MESSAGES. JSB LUERR GO DOWN ALL LU'S POINTING TO DEVICE. ˆ÷þú SEZ ERROR IF ATTEMPT JMP $INER TO DOWN LU 1. JMP $XEQ NO, RETURN TO SYSTEM. * DNLU9 LDB TEMP9 IF EQT IS DOWN, THEN ADB LUMAX GET DRT WORD 2 LDA B,I AND SET THE LU IOR MSIGN DOWN. STA B,I JMP $XEQ RETURN. * C3700 OCT 174077 * * *IODNS* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * IODNS HLT 2 HLT FOR INIT CODE STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $INER GO TO $MESS ERROR EXIT. JSB $CVEQ SET EQT ENTRY ADDRESSES. STB CONFL SET ALL THE FLAGS TO ZERO. JMP IODNS,I SKP * **************************************************************** * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE REFERENCED SLOT(EQT ENTRY * #)IS SET = 0 (UNIT AVAILABLE). THE AVAILABILITY FIELD OF * ANY DEVICES(BIT 15 DRT WORD 2) REFERENCING THIS EQT ARE * SET = 0 AND THE LU'S' I/O QUEUES ARE ADDED TO THE EQT'S * I/O QUEUE. IF THE EQT WAS AVAILABLE OR DOWN, THEN THE * *$CON1* SECTION(AT *L.68*)IS ENTERED TO INITIATE ANY * WAITING I/O REQUESTS. * * CALL (FROM MESSAGE PROCESSOR): * * := NN (EQT #) IN BINARY * JMP $IOUP * * RETURN IS MADE TO *$CON1* OR TO *$XEQ* IF ANY ACTION * IS TAKEN. IF NN IS ILLEGAL, THEN RETURN IS MADE TO * *MESS,I* TO PRINT 'INPUT ERROR'. * ****************************************************************** * $IOUP JSB IODNS CHECK 'NN' AND SET EQT ADDRESSES. $UP EQU * JSB $RSM GO RESTORE USER MAP IN CASE DRIV þúER CALL JSB CPEQT GET EQT # STA TMP1 FROM EQT1. LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 (RETURN B=0). * LDA EQT5,I IF EQT IS BUSY OR WAITING FOR *1926DLS* SSA,RSS DMA, THEN SKIP DMA RELEASE. *1926DLS* JSB CLDMA OTHERWIZE,IF AV OR DOWN,RELEASE DMA. * JSB XUPIO SET ANY ASSOCIATED LU'S UP. * LDA EQT5,I GET AVAILABILITY ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. SKP * ************************************************************************ * * SUBROUTINE XUPIO: * * XUPIO IS USED TO UP ANY LU'S ASSOCIATED WITH THIS EQT. * * CALLING SEQUENCE: * :=THE ADDRESS OF THE FIRST WORD OF THIS EQT. * :=THE EQT NUMBER. * JSB XUPIO * * RETURN: * ALL REGISTERS ARE DISTROYED. * USES TMP2,TMP4,TMP6. * CALLS SUBROUTINE XXUP. * ************************************************************************ * XUPIO NOP LDA LUMAX SET CMA,INA UP STA TMP2 COUNTER. LDB DRT POSITION TO FIRST STB TMP6 DRT ENTRY. * UPIO1 LDA TMP6,I CHECK IF THIS AND B77 DRT ENTRY POINTS CPA TMP1 TO THE EQT. JMP UPIO5 YES. UPIO3 ISZ TMP6 NO. SO ISZ TMP2 GO CHECK JMP UPIO1 NEXT DRT ENTRY. JMP XUPIO,I RETURN. * UPIO5 LDB TMP6 POSITION TO DRT ADB LUMAX WORD2. STB TMP4 GO PLACE LDB B,I ENTRIES LDA EQT1 INTO EQT JSB $XXUP I/O QUEUE(RETURN B=0). STB TMP4,I SET THE LU 'UP'. JMP UPIO3 GO CHECK NEXT DRT ENTRY. SKP **************************************************************** * * SUBROUTINE $XXUP: * * $XXUP TAKES AN I/O QUEUE A°ZþúND(USING LINK)POSITIONS THE I/O * REQUESTS IN THE CURRENT EQT QUEUE ACCORDING TO THEIR PRIORITY. * IT RETURNS A FLAG IF AN I/O OPERATION SHOULD BE INITIATED. * * CALLING SEQUENCE: * := EQT1 OF OLD DEVICE. * :=ADDRESS OF FIRST STACKED I/O REQUESTS TO BE LINKED ON * THE CURRENT EQT(SIGN BIT WILL BE STRIPPED). * JSB $XXUP * * RETURN: * :=0 * :#0 A NEW I/O OPERATION IS AT THE HEAD OF THE CURRENT * EQT I/O QUEUE SO IT MUST BE INITIATED. = * THE ADDRESS OF THE FIRST WORD OF THE EQT. * USES TEMP1,TEMP2,UNLK8,TEMP4,XXUP7 * ***************************************************************** * $XXUP NOP STA TEMP4 SAVE OLD DEVICE EQT1. CLA CLEAR STA XXUP7 INITIATION FLAG. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. XXUP9 SZB,RSS RETURN WHEN END OF I/O JMP XXUP2 REQUEST QUEUE IS FOUND. * STB TEMP1 SET UP POINTER FOR LINK. ADB B176K IF POINTER IS < 2000, SSB THEN NO I-O STACKED ON JMP XXUP2 THIS LU SO EXIT B=0. * LDB TEMP1 OTHERWIZE, GET I-O REQUEST ADDRESS. LDA B,I UNLINK THIS STA UNLK8 I/O REQUEST. INB LDA B,I GET INB PRIORITY RAL OF THE SSA I-O REQUEST JMP XXUP8 SLA,RSS BUFFERED AND CLASS I-O REQUESTS. JMP XXUP5 NORMAL USER REQUEST. LDA TEMP4 SYSTEM REQUEST. ADA .4 LDA A,I AND B36K CHECK IF THE OLD DEVICE CPA B14K IS A DISK OR NOT. JMP XXUP1 CLA IF OLD DEVICE IS NOT A DISK, STA TEMPL SET TEMPL=0 AND USE JMP XXUP3 ZERO PRIORITY. XXUP1 STA TEMPL IF OLD DEVICE IS A DISK, THEN INB,RSS SET TEMPL#0 AND USE PRIORITY. XXUP5 ADB .4 XXUP8 LDA B,I ÷!þú XXUP3 STA TEMP2 SAVE PRIORITY FOR LINK. JSB LINK LINK THIS REQUEST ONTO THE EQT. LDA EQT1 SEZ,RSS IF ONLY REQUEST ON THE EQT, THEN STA XXUP7 STORE INTO THE INITIATION FLAG. LDB UNLK8 LOOP FOR NEXT JMP XXUP9 I/O REQUEST. * XXUP2 CLB SET B=0. LDA XXUP7 GET INITIATION FLAG JMP $XXUP,I RETURN * XXUP7 NOP B176K OCT 176000 HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 15 11-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 20 * CHARACTERS (10-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $SYMG * (P+1) -RETURN- * * ON RETURN: * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $SYMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY * LDB SY# IF BUFFER CPB .15 IS FILLED (15 MESSAGES), JMP $SYMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 ENTRY ADDRESS FOR MOVE MVW .11 MOVE THE WORDS. * ISZ SY# INCREMENT COUNT ENTRY. LDB SYC (B) = CURRENT ENTRY ADDRESS. LDA SYT1 ADA .11 (A) = NEXT ENTRY ADDRESS. CP.ÇþúA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * CLA,CLE (A) = 0 FOR EXIT WITH JMP $SYMG,I MESSAGE ACCEPTED. * * CALL <$XSIO> TO INITIATE OUTPUT * SYSCL NOP LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH NOP SAYS DO NOT NEED USER MAP JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .10 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 NOP SYC DEF SBUF SBF DEF SBUF SKP * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # IN LOWER 6 BITS. * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * OF THE ENTRY DESCRIBED BY -EQT1-. * * CALLING SEQUE׊HFBNCE: (P) JSB CPEQT * (P+1) - RETURN - * ON RETURN, (A) = EQT # * (E) = 1 * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. JMP CPEQT,I SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP STA EQT1 INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * * ‚Hÿÿþú SKP * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPERATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF- * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S DRIVER IS * CALLED WITH A CLEAR REQUEST (CONTROL * WITH ZERO SUBFUNCTION. IF THE DRIVER * ACCEPTS THE REQUEST (A=0 ON RETURN) THEN * EQT1 SIGN BIT IS SET AND A 1 SEC. TIME OUT * IS SET UP. (THIS TIME OUT IS TRAPED BY THE * SYSTEM AND IS NEVER GIVEN TO THE DRIVER). * $ABRT IS CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "$CON1" TO INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE DMA CANNEL) * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FºþúOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. * LDA A,I GET LINK ADDR RAL,CLE,ERA CLEAR SIGN ,SET E IF SIGN WAS SET CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL TO SCAN NEXT ENTRY LIST. * * SCAN ALL DRT WORD 2 I/O QUEUES * LDA LUMAX SET TEMP2 = NEGATIVE CMA,INA NUMBER OF DRT STA TEMP2 ENTRIES. LDA DRT INITIALIZE ADA LUMAX FOR FIRST STA IOC50 DRT WORD IOC41 STA IOC51 TWO. LDA A,I GET LINK RAL,CLE,ERA CLEAR SIGN, SET E IF SIGN SET. CPA TEMP1 JUMP IF A MATCH JMP IOC62 TO A PROGRAM. * SZA IF NOT END OF LIST, JMP IOC41 CONTINUE SCAN. * ISZ IOC50 SET = NEXT LDA IOC50 ADDRESS OF NEXT ISZ TEMP2 DRT WORD 2. JMP IOC41 IF NOT END OF DRT, CONTINUE SCAN. JMP IOC63 IF END,NOT FOUND.MUST BE PROGRAM SO ABORT. SKP * * PROGRAM REQUEST FOUND IN DRT, UNLINK REQUEST. * IOC62 LDB A,I GET NEXT LINK, PROPOGATE RBL,ERB SIGN IF SIGN WAS SET AND STB IOC51,I STORE IN PREVIOUS LINK. * IOC63 LDA TEMP1 CHECK IF THIS ISZ TEMP1 IS A SYSTEM LDB TEMP1,I REQUEST. SSB,RSS IF SO SKIP ABORT. JSB $ABRT 'ABORT PROGRAM' JMP $XEQ RETURN. * * PROGRAM REQUEST ENTRY FOUND IN EQT, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET RBL,ERB PROPOGATE SIGN IF SIGN SET STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT iDþú JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING SKIP TO CLEAR DEVICE. JMP $XEQ -EXIT TO $XEQ. SKP JSB $ETEQ JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT LDA EQT5,I GET CURRENT STATUS RAL,CLE IF DOWN OR IN DMA SSA WAIT JMP $XEQ JUST LEAVE IT ALONE * ERA ELSE SET NOT BUSY STA EQT5,I AND PLANT JSB $DRVM SET UP FOR MAPPING LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND SEZ ENTER DRIVER IN USER MAP? JMP IOCUS YES * JSB B,I ENTER DRIVER IN SYSTEM MAP JMP IOCWT * IOCUS JSB $UIN ENTER DRIVER IN USER MAP, RETURN TO IOCWT * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO $CON1 TO GET THE NEXT REQUEST * IOCWT CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR $CON1 (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP $CON1 NO SO JUST GO TO $CON1 * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 NOP IOCL6 NOP IOC50 NOP IOC51 NOP SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,<æþúCLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * CLCHS NOP JSB CLDMA CLEAR DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA CLCSC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? CLCSC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP CLCHS,I YES-EXIT * ISZ CLCSC JMP CLRNX * CLR10 CLC 10B B3.I DEF 3,I N100 DEC -100 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 165 15 * 11 SBL DEF * * ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT * ADA CLCP CONFIGURE THE DUMMY ADDRESSES STA CLC2,I USE INDIRECTS TO AVOID LINKS XOR STCP MAKE STC STA STC2,I STC STA STCP SET IN LINE TOO XOR STFP STF STÐ1þúA STF2,I AND STF STA STFP NEED THIS IN LINE ALSO STCP OCT 4000 SET UP THE PRIV. CARD STFP OCT 600 NOW FOR DISC DRIVERS ETC. NOPRV LDA CLE REPLACE CALL TO HERE STA $SYMG+1 WITH A CLE LDB DL.12 GET DEF TO L.012 FOR LDA PDSK DISC PROTECT OPTION SZA PROTECT?? STB DPOPI,I YES, SET IT UP LDB HLT2 PUT HALT 2 IN LOCATION 2 STB 2 AND HALT 3 IN LOCATION 3 CCE,INB OF SYSTEM MAP FOR TRAPPING STB 3 ERRORS LDA $DVPT GET PAGE OF DRIVER PTTN ALF,ALF CONVERT TO LOGICAL ADDR RAL,RAL IOR B1740 FORM ADDR OF USER MAP COPY AREA STA DDVPT,I SAVE LOG ADDR LDA ACLAS CMA,INA STA DDMCL,I SBUF3 LDA SBUF RESTORE A JMP $SYMG+1 EXIT INITIALIZATION CODE * * CLE CLE PDSK DEF $PDSK DL.12 DEF L.012 CLCP CLC 0 DPOPI DEF DPOPT STC2 DEF SW1 STF2 DEF STF1 CLC2 DEF SW2 LOCAL DEFS TO AVOID LINKS DDVPT DEF DVPTA DDMCL DEF MCLAS ACLAS DEF $CLAS+0 HLT2 HLT 2 B1740 OCT 1740 * L EQU 165+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU E’$".+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 RQP9 EQU .+32 9 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) * ORG * LENGTH OF RTIOC END $CIC0 ©™$ÿÿ ÿý°f ÿ92067-18019 1926 S C0422 &4EXC1 RTE-IV EXECUTIVE             H0104 ¼³þúASMB,R,L,C ** RT EXEC CENTRAL CONTROL MODULE ** HED ** REAL-TIME EXECUTIVE CENTRAL CONTROL MODULE ** * NAME: EXEC * SOURCE: 92067-18019 * RELOC: PART OF 92067-16014 * PGMR: G.A.A., L.W.A., C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EXEC4,0 92067-16014 REV.1926 790506 * SUP PRESS EXTRANIOUS LISTING ****************************************************************** * HISTORY * * * ***G.A.A. RTE 2 VERSION JULY 1973 ***L.W.A. RTE 3 VERSION APRIL 1975 ***C.M.M. RTE 4 VERSION JANUARY 1978 * ***************************************************************** * * * ENT $ERMG,$RQST,$OTRL,$USER ENT $DREQ,$DREL,$SDRL,$SDSK ENT $ERRA,$REIO,$CREL,$RSRE,$ABRE ENT $PDSK,$ABXY ENT $PWR5,$MVBF,$SGAF ENT $LEND,$DHED,$LBR,$LBX,$XEX * EXT $CNV3,$SYMG,$LIST,$XEQ,$PVCN EXT EXEC,$LIBR,$LIBX,$IDLE,$PVST EXT $RENT,$CVEQ,$ABRT,$DMS,$IDLE EXT $TRRN,$SCLK,$ALC,$RTN EXT $MATA,$IDNO,$IDEX EXT $MRMP,$PBUF EXT $MNP,$MPFT,$PERR,$CNV1 * * $PDSK EQU 0 DEFINE DEFAULT FOR DISC PROTECT * ***** < EXEC > PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECUTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE &sþúA * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- * QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PRO“[þúGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * SKP ************MEU INSTRUCTIONS***************** *EXEC NOP * HLT 0 PROTECTION AGAINST DIRECT CALL. * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! (ADDRESS OF INTERUPT) CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STB $LIBR SAVE (P+1) OF ISZ $LIBR CALL. (JUST LIKE A REAL SUBROUTINE CALL) * STB XSUSP,I SAVE AS POINT OF SUSP IN ID SEG XLA B,I GET WORD. STA INSTR SAVE THE OFFENDING INSTRUCTION. AND B074K ISOLATE INSTR. CODE. CPA JSBI IF INSTRUCTION IS JSB JMP *+2 (RSS) CHECK OPERAND ADDRESS. JMP MPERR -MEMORY PROTECT ERROR- LDA INSTR CHECK FOR EFFECTIVE AND B2000 ADDRESS SZA LINK THRU CURRENT PAGE? LDA B YES, USE CURRENT PAGE BITS XOR INSTR MIRGE THE PAGE OFFSET AND G76 UNDER THE RULES OF WOO. XOR INSTR NOW HAVE THE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT INDR XLA A,I GET NEXT LEVEL RAL,CLE,SLA,ERA CHECK FOR MULTI LEVEL JMP INDR FOUND ONE SO LOOP (MUST END) * SFC 5 IS THE VIOLATION MP OR DM ? JMP CHKDM A DM VIOLATION * CPA EXECA MP VIOLATION. SEE IF ITS A JSB EXEC JMP R0 YES, REQUEST TO BE ANALYSED. CPA LIBRA -LIBRARY ROUTINE CALLING FOR JMP LIBRC RE-ENTRANT OR PRIVILEGED RUN. CPA LIBXA -LIBRARY ROUTINE RETURNING JMP LIBXC TO CALLER. JMP MPERR A MP ERROR ! FLUSH HIM ! * * CHECK FOR USER CALL TO LIBRARY PROGRAM * CHKDM LDB XMATA GET THE CURRENT MATA ENTRY SZB IS THIS A MEMORY RES PROGRAM ? JMP MPERR NO, SO FLUSH HIM ! * STA B SAVE OPERAND ADDRESS. LDA LBORG SUBTRACT LIBRARY Ö‚þú CMA,CLE,INA AREA ORIGIN FROM ADA B OPERAND ADDRESS. LDA B (E = 0 IF SYSTEM VIOLATION ) CMA,SEZ,CLE,INA SKIP IF VIOLATION ALREADY ELSE ADA $LEND TEST FOR ABOVE LIB. SEZ,RSS IF NOT CALL TO LIBRARY RESIDENT, JMP MPERR THEN VALID DMS ERROR. LDA $LIBR -CALL TO LIBRARY. XSA B,I SET (P+1) ADDRESS OF JSB INTO THE ADB D2 1ST WORD OF SUB.(JUST LIKE NORMAL CALL) STB $LIBR PUT P+1 OF JSB $LIBR INTO $LIBR ALSO JMP LIBRC - TRANSFER TO $LIBR SECTION $LEND NOP END OF MEMORY RES LIB $SGAF NOP SPC 1 JSBI JSB 0 B074K OCT 074000 G76 OCT 76000 EXECA DEF EXEC+0 A DIRECT ADDRESS RQP1A DEF RQP1 INSTR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 * * ANALYZE SYSTEM REQUEST (A VALID JSB EXEC) * R0 XLA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 IS GREATER CLA,SEZ THAN JMP RQERR 8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 STA RQP7 AREA STA RQP8 STA RQP9 * LDA RQP1A SET TEMP2 = STA TEMP2 ADDRESS OF RQP1 IN BASE PAGE STA TEMP3 SAVE FOR CALL BY NAME TEST R1 LDA $LIBR GET EFFECTIVE OPERAND ADDRESS. R1D1 XLA A,I FIRST LEVEL TO A SZA IF THROUGH A CPA D1 OR B JMP RQERR BAD NEWS FELLOW! * RAL,CLE,SLA,ERA REMOVE INDIRECT BIT,SKIP IF DIRECT JMP R1D1 STILL INDIRECT GO TRY AGAIN. * STA TEMP2,I SêþúET IN BASE PAGE. ISZ TEMP2 INDEX ISZ $LIBR ADDRESSES AND INB,SZB PARAMETER COUNT. JMP R1 - CONTINUE - SKP * CHECK LEGALITY OF REQUEST CODE * XLA RQP1,I GET REQUEST CODE LDB XEQT COMPUTE ADB D15 THE STATUS WORD STB TEMP1 ADDRESS AND SAVE LDB B,I GET STATUS RAL,CLE,ERA PUT ABORT OPTION BIT RBL,ERB IN SIGN OF STATUS STB TEMP1,I AND RESET IN ID-SEG. SSB IF OPTION SELECTED ISZ RQRTN STEP RETURN ADDRESS. STA RQP1 SAVE THE REQUEST CODE. SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED SSA,RSS -THEN JMP RQERR TOUGH LUCK, YOUR A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS * STA INSTR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD LDB RQCNT GET THE NUMBER OF PRAMS TO CMB,SEZ,RSS TEST SET COUNT ALF,ALF ROTATE IF ODD REQUEST CODE STB TEMP1 SET PRAMETER COUNT * R3 ISZ TEMP3 STEP THE PRAMETER ADDRESS LDB TEMP3,I GET THE ADDRESS ISZ TEMP1 SKIP IF END OF LIST CMB,CLE,RSS SET UP FOR TEST AND SKIP JMP INSTR,I GO EXERCISE THE REQUEST SLA,RAR IF FLAG NOT SET THEN ADB FENCE SKIP THE ADD CLB,SEZ,RSS SET B FOR ERROR SKIP IF ERROR JMP R3 NO ERROR GO TEST NEXT PRAM * LDA RQ1 SET A FOR ERROR JMP $ERRA GO SEND 'RQ00' ERROR * * P22 DEC 22 P12 DEC 12 P14 DEC 14 P11 DEC 11 P24 DEC 24 P23 DEC 23 P10 DEC 10 P9 DEC 9 P8 DEC 8 P7 DEC 7 P6 DEC 6 * D1 N÷þú DEC 1 D2 DEC 2 D5 DEC 5 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D25 DEC 25 D26 DEC 26 D29 DEC 29 D32 DEC 32 DM1 DEC -1 DM32 DEC -32 B377 OCT 377 CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION PROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PROGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * LIBRA DE·ôþúF $LIBR+0 A DIRECT ADDRESS * *$LIBR NOP * SJP $LBR $LBR STA XA,I DIRECT ENTRY MUST BE PRIV & GOING DEEPER XLA $LIBR,I MAKE SURE SZA AND IF GOING REENTRANT JMP MPERR SEND SOUTH INSTEAD.(FLUSH HIM !!) * LDA $PVST GET THE STATUS HE CAME IN WITH RAL,RAL AND SET IT UP FOR THE RETURN STA $PVST * LIBRX LDA XA,I RESTORE THE A REGISTER & RETURN ISZ $LIBR SET RIGHT ADDRESS ISZ $PVCN AND STEP THE DEPTH COUNTER JRS $PVST $LIBR,I SET UP CORRECT MAP AND RETURN TO CALLER. * LIBRC XLB $LIBR,I GET (P+2) OF -$LIBR- CALL. SZB,RSS IF (P+2) = 0, THEN CALLED PROGRAM JMP PVEXC IS IN 'PRIVILEGED' FORMAT. * STB TEMP1 SAVE -TDB- ADDRESS. XLA B,I GET WORD 1 OF DATA BLOCK. LDA A,I GET ID SEG ADDRESS OR ZERO RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT SZA,RSS IS THE TDB FREE ? JMP LIBR1 YES GO SET IT UP. CPA XEQT DOES SAME PROG ALREADY OWN IT ? JMP ERE01 RECURSIVE ENTRY !! FLUSH HIM !!! INB ALREADY OWNED, SO GET THE TDB LENGTH XLA B,I TO THE A REG LIBR1 ADA D4 USE JUST FOUR WORDS (OR ADD 4 WORDS) STA TEMP4 SAVE LENGTH FOR ALLOCATE CALL LDB $DHED GET POINTER TO HEAD OF RENT LDA XEQT LIST ADA D20 CHECK IF ALREADY IN LIST STA TEMP3 SAVE ID-SEG POINTER LDA A,I GET THE STATUS WORD ALF,RAL BIT 10 IS RENT BIT SSA,RSS IF CLEAR THEN THIS IS FIRST ENTRY JMP RE2 SO GO SET UP * LDB XEQT NOT FIRST ENTRY SO FIND OTHERS JSB FINDL USING FINDL ROUTINE JMP ERE01 LIST ERROR ABORT THE PGM ADB D3 STEP TO SUB QUE HED RE2 STB TEMP2 SET POINTER TO LIST HEAD * JSB $ALC ALLOCATE THE MEMORY TEMP4 NOP NUMBER OF WORDS REQUIRED JMP NVRM IF NEVER ANY MEMORY, TRY 4 ONLY Ïþú JMP LB05 NO MEMORY NOW, SUSPEND. CCE ALLOC DONE. * CPB TEMP4 DID WE GET THE REQUESTED NUMBER? B40 CLE YES CLEAR E AS A FLAG * LDB TEMP2,I GET OLD POINTER STA TEMP2,I SET NEW BLOCK ADDRESS STB A,I LINK OLD BLOCKS INTO THE LIST LDB XEQT GET THE ID-SEG ADDRESS SEZ,INA STEP A AND SKIP IF EXACT ALLOCATION ADB SIGN ELSE ADD SIGN BIT TO ID-ADDRESS STB A,I SET IN WORD 2 STA TEMP4 SET TDB ADDRESS POINTER INA SET TO WORD 3 ADDRESS LDB TEMP1 SET TDB ADDRESS IN WORD THREE STB A,I INA CLEAR CLB WORD STB A,I FOUR * XLB TEMP1,I IF BLOCK AVAILABLE THEN SZB,RSS SKIP THE JMP RE4 MOVE * SEZ,INA SET A TO SAVE BLOCK ADDRESS INA (EXTRA WORD USED IN ID-EXTENSION) LDB TEMP1 DIG THE TDB SIZE OUT CLE,INB OF THE TDB XLB B,I AND SET IN B JSB MTDB MOVE OUT THE TDB RE4 LDA TEMP4 GET THE ADDRESS OF THE ID-SEG. ADDRESS XSA TEMP1,I AND SET IN THE TDB LDA TEMP3,I GET THE ID-STATUS WORD IOR B2000 SET THE RENT BIT STA TEMP3,I RESTORE THE WORD LDB TEMP1 (B) = ADDR. OF TDB. ADB D2 SET LDA $LIBR (P+1) ADA DM2 OF ORIGINAL XLA A,I CALL IN XSA B,I WORD 3 OF TDB IN PROGRAM. ISZ $LIBR SET TO FIRST INSTR IN LIB. PROG. * LDB $LIBR SET RETURN ADDRESS STB XSUSP,I IN THE ID-SEG. JMP $RENT RETURN TO THE DISPATCHER * SKP * * REJECT SECTION CAUSED BY NO MEMORY * AVAILABLE FOR -TDB-. CALLING USER PROGRAM * IS SUSPENDED BACK TO POINT OF CALL AND * LINKED INTO MEMORY SUSPENSION LIST. * NVRM LDA D4 NEVER ENOUGH MEMORY, REQUEST 4 NEXT TIME STA XTEMP,I LB5 JSB $LIST SUSPEND OCT 504 PROGRAŠþúM JMP $XEQ TRANSFER TO EXECUTE SECTION. * LB05 LDA $LIBR BACK UP TO ADA DM2 THE ENTRY POINT. XLB A,I SUBTRACT ONE FROM THE RETURN ADB DM1 ADDR TO GET ADDR OF THE CALL. STB XSUSP,I POST THIS ADDR AS SUSP.POINT. JMP LB5 SUSPEND PROGRAM FOR MEMORY. * * * INITIATE PRIVILEGED EXECUTION OF USER PROGRAM * PVEXC EQU * RESTORE REGISTERS. LDB XI GET X,Y TO A,B XLA B,I CAX INB XLA B,I CAY NOTMX LDA XEO,I CLO SLA,ELA STF 1 LDB XB,I * LDA $DMS GET THE DMS STATUS @ INTERUPT STA $PVST AND SET FOR RETURN * JMP LIBRX GO GET A AND EXIT * HED RENT SUBROUTINES * MTDB MOVES A TDB TO SYSTEM MEMORY AND UPDATES THE LINKAGES * AS REQUIRED. * * CALLING SEQUENCE: * * TEMP6 = NUMBER OF WORDS REQUIRED (IF ALLOCATION) * TEMP1 = ADDRESS OF TDB TO BE MOVED * A = CORE ADDRESS (FROM $ALC ) * B = NUMBER OF WORDS ALLOCATED (FROM $ALC ) * E = 0 IF MEMORY IS ALREADY ALLOCATED * = 1 IF TEMP6 IS SET AND A AND B ARE NOT. * * THE SECOND WORD OF THE SAVE AREA IS SET TO THE CONTENTS * OF B WHILE THE SECOND WORD OF THE TDB DETERMINS HOW * MANY WORDS TO MOVE. * * TEMP USAGE IN THIS ROUTINE IS: * * AHLD DESTINATION ADDRESS * TEMP7 ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,I) * MTDB NOP SEZ,RSS IF NO ALLOCATE OPTION JMP MTDB2 SKIP ALLOCATE CALL * JSB $ALC GET THE MEMORY TEMP6 NOP JMP MTDB0 NEVER ANY MEMORY JMP LB5 NO MEMORY NOW, SUSPEND PROG * MTDB2 STA AHLD SET UP DESTINATION POINTER XLA TEMP1,I SAVE THE ID-EXTENSION ADDRESS STA TEMP7 LDA TEMP1 GET THE TDB ADDRESS STA AHLD,I AND SET IT IN THE SAVE AREA. ISZ AHLD STEP TO WORD TWO STB AHLD,I AND SET ACTUAL COUNT ¾þú ADB DM2 ADJUST COUNT FOR MOVE CBX AND SET FOR MWW ADA D2 ADJUST THE FROM ADDRESS LDB AHLD GET THE TO ADRESS INB ADJUST TO ADDRESS MWF MOVE BLOCK FROM USER TO SYS MAP. * CLA XSA TEMP1,I SET THE TDB "FREE" LDB TEMP7,I GET THE ID-SEGMENT ADDRESS FOR RBL,CLE,ERB THE OWNING PROGRAM ADB D20 INDEX TO THE STATUS WORD LDA B,I FETCH IT AND SET IOR B4000 THE RENT MEMORY MOVED STA B,I BIT ISZ TEMP7 STEP TO THE TDB POINTER ADDRESS LDA AHLD GET THE NEW LOCATION ADA C100K SUBTRACT ONE AND ADD SIGN STA TEMP7,I AND SET IN THE EXTENSION. MTDBX JMP MTDB,I NOW RETURN AHLD NOP 1 * MTDB0 CLA NEVER ANY MEMORY CLB RETURN (A)=0, (B)=0 JMP MTDBX SPC 2 * FINDL FINDS A ID-EXTENSION GIVEN THE ID-SEGMENT ADDRESS * * CALLING SEQUENCE: * * LDB ID-SEG ADDRESS * JSB FINDL * NOT FOUND RETURN * FOUND RETURN B = ADDRESS OF EXTENSION,TEMP5 = ADDRESS OF * PREVIOUS BLOCK IN THE LIST (FOR UNLINKING). * E = 0. * * TEMP USAGE: * * TEMP5 = LAST POINTER * TEMP6 = ID-SEGMENT ADDRESS * FINDL NOP STB TEMP6 SAVE THE ID-SEGMENT ADDRESS LDB $DHED GET THE HED OF THE LIST ADDRESS FIND1 STB TEMP5 SET LAST POINTER LDB B,I GET THE ADDRESS OF THE EXTENSION SZB,RSS END OF LIST? JMP FINDL,I YES- MAKE NOT FOUND RETURN LDA B ADDRESS TO A INA STEP TO THE ID-ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT CPA TEMP6 THIS IT? CLE,RSS YES RETURN E = 0 JMP FIND1 NO TRY NEXT ENTRY ISZ FINDL STEP TO TRUE RETURN JMP FINDL,I RETURN SKP * RTN4 RETURNS THE FOUR WORD ID-EXTENSION AND CAN CLEAR * THE PROGRA'þúMS RENT BIT * * CALLING SEQUENCE: * * TEMP2 = ADDRESS OF THE FOUR WORD BLOCK * E = 0 IF THE RENT BIT IS TO BE CLEARED. * TEMP1 = ADDRESS OF THE TDB (TO SET FIRST WORD TO ZERO) * JSB RTN4 * * TEMP USAGE: * TEMP2 AS ABOVE * TEMP3 NUMBER OF WORDS TO RETURN * TEMP1 AS ABOVE * RTN4 NOP LDA TEMP2 GET BLOCK ADDRESS INA INDEX TO ID SEG ADDRESS LDB A,I GET ID-SEG ADDRESS LDA D4 SET A TO THE REQUEST LENGTH RBL,SLB,ERB IF WE GOT 4 SKIP INA ELSE SET TO 5. STA TEMP3 SET RETURN LENGTH SSB IS RENT BIT CLEAR REQUESTED? JMP RTNA NO SKIP ADB D20 YES INDEX TO THE BIT LDA B,I GET THE WORD XOR B2000 ZAP THE BIT STA B,I RESET THE WORD RTNA CLA CLEAR THE TDB FLAG XSA TEMP1,I JSB $RTN RETURN THE MEMORY TEMP2 NOP TEMP3 NOP JMP RTN4,I RETURN SPC 2 $DHED DEF *+1 NOP HED OF ID-EXTENSION LIST DM3 DEC -3 D20 DEC 20 B4000 OCT 4000 B2000 OCT 2000 SIGN DEF 0,I HED $REIO RENT I/O PROCESSOR ROUTINE * $REIO MOVES TO SYSTEM MEMORY THE TDB CONTAINING THE * REFERENCED ADDRESS - IF ANY. THIS ROUTINE IS CALLED * BY RTIOC TO ALLOW I/O FROM A RE-ENTRENT ROUTINE. * * CALLING SEQUENCE * * LDB BUFAD BUFFER ADDRESS IN B. * JSB $REIO * ON RETURN B IS THE NEW BUFFER ADDRESS, E IS SET. * * TEMP USAGE: * * TEMP1 = TDB ADDRESS * TEMP3 = NEG. OF PASSED BUFFER ADDRESS * TEMP4 = NEXT ENTRY POINTER. * TEMP5 = TDB PTR ADDRESS IN ID-EXTENSION * $REIO NOP CMB,INB SET BUFFER ADDRESS NEGATIVE FOR TESTS. STB TEMP3 TEST AND SAVE IT CLB STB $MVBF CLEAR MOVE TO REENT MEM FLAG LDB XEQT GET THE ID-ADDRESS JSB FINDL AND SO THE ID-EXTENSION JMP REIO2 NOT FOUND - EXIT * REIO1 LDA B ˆêþú SET ADDRESS IN A TOO SZB,RSS IF END OF LIST JMP REIO2 EXIT WITH SAME ADDRESS * SEZ,RSS FIRST POINTER IS ADA D3 + 3 STA TEMP4 REST ARE STANDARD LINK ADB D2 INDEX TO THE TDB ADDRESS STB TEMP5 SAVE THE TDB ADDRESS LDA B,I TDB ADDRESS TO A RAL,CLE,SLA,ERA CLEAR MOVED FLAG, SKIP IF NOT LDA A,I IF MOVED,GET TRUE TDB ADDRSS STA TEMP1 SAVE FOR MTDB ROUTINE * LDB A PUT IN A TOO SO CLE,INA WE CAN INDEX TO LENGTH XLA A,I NOW GET THE LENGTH OF THE TDB ADB TEMP3 ADD IN NEG OF PASSED BUFFER ADDRESS SEZ,CLE,RSS E SET =>BELOW TDB SO SKIP ADB A ADD TDB LENGTH LDB TEMP4,I GET THE NEXT ENTRY TO B SEZ,CCE,RSS E=0 IF NOT IN THE TDB. JMP REIO1 TRY NEXT TDB HE OWNS.(PERHAPS WRONG TDB) * STA TEMP6 FOR MTDB LDA TEMP5,I IF ALREADY MOVED XLB TEMP1,I THEN SKIP SZB MOVE AND USE CURRENT POINTER JSB MTDB GO MOVE THE TDB RAL,CLE,ERA CLEAR THE SIGN BIT (A = ADDR OF MOVED TDB) LDB A,I OLD TDB ADDRESS TO B CMA,INA NEG. OF NEW ADDRESS TO A STA $MVBF SET MOVED TDB TO SAM FOR RTIOC ADB A NEG. OF OFFSET TO B REIO2 ADB TEMP3 NEG OF NEW BUFFER ADDRESS TO B CMB,CCE,INB SET POSITIVE AND SET E. JMP $REIO,I RETURN TO CALLER $MVBF NOP MOVED TDB TO SAM FLAG FOR RTIOC HED RESTORE MOVED TDB'S FOR CURRENT PROGRAM * $RSRE MOVES BACK ANY TDB MOVED OUT BY CONTENDING PROGRAMS * THIS ROUTINE IS CALLED BY THE DISPATCHER WHEN IT IS * ABOUT TO DISPATCH A PROGRAM AND THE RENT MEMORY * MOVED BIT IS SET IN THE PROGRAMS ID-SEGMENT. * * CALLING SEQUENCE: * * SET UP BASE PAGE (XEQT ETC.) * JSB $RSRE * * ON RETURN THE PROGRAM IS READY TO RUN * * IF MEMORY IS NEEDED BUT NOT AVAILABLE THE PROGRAM 3ŸNLHIS * MEMORY SUSPENDED AND RETURN IS TO $XEQ. * * TEMP USAGE: * * TEMP1 = TDB POINTER * TEMP3 = THE FROM ADDRESS * TEMP6 = # WORDS FOR ALLOCATION * TEMP4 = MOVE COUNTER * TEMP5 = RETURN MEMORY ADDRESS * TEMP9 = RETURN # WORDS * $RSRE NOP RSRE1 LDB XEQT GET THE ID-SEGMENT EXTENSION JSB FINDL JMP RSRE3 NOT FOUND GO EXIT * RSRE2 ADB D2 INDEX TO THE TDB ADDRESS LDA B,I GET THE TDB ADDRESS TO A SSA IF NOT MOVED OUT THEN SKIP JMP RSRE4 ELSE GO MOVE BACK * SEZ,CCE,INB GET ADDRESS OF NEXT BLOCK ADB DM3 TO B LDB B,I SZB IF ZERO THEN DONE JMP RSRE2 ELSE GO TEST NEXT ONE * RSRE3 LDB XEQT GET THE ID-ADDRESS ADB D20 AND REMOVE LDA B,I THE MEMORY XOR B4000 MOVE REQUIRED BIT STA B,I RESET THE WORD JMP $RSRE,I RETURN AND RESTORE MEU STATUS * RSRE4 RAL,CLE,ERA CLEAR THE SIGN BIT AND &Nÿÿþú STA TEMP5 SAVE THE ADDRESS STB TEMP3 SET THE FORM ADDRESS LDB A,I GET THE TDB ADDRESS STB TEMP1 SET THE TDB ADDRESS INA STEP TO THE ALLOCATED COUNT LDA A,I GET AND STA TEMP9 SET FOR RETURN CALL XLA B,I GET THE OWNER INB AND THE XLB B,I COUNT. STB TEMP6 SET COUNT FOR ALLOCATION ADB DM2 SET UP THE MOVE COUNT STB TEMP4 SAVE IT CCE,SZA SKIP IF SUBROUTINE IS FREE JSB MTDB MOVE THE OTHER USER TO SYS. MEM. * LDB TEMP4 PUT MOVE COUNT IN CBX X CCB ADB TEMP3 BACK UP TO THE ID ADDRESS IN THE EXTENSION XSB TEMP1,I SET IN THE TDB TO SHOW OWNER LDB TEMP1 SET UP ID-EXTENSION STB TEMP3,I LDA TEMP5 GET ADDRESS OF MEMORY ADA D2 ADJUST FOR MOVE ADB D2 ADJUST TO ADDRESS ALSO * MWI MOVE FROM SYS TO USER * JSB $RTN RETURN THE MEMORY TEMP5 NOP TEMP9 NOP JMP RSRE1 GO TRY AGAIN HED ABORT PROCESSOR FOR PROGRAM ABORTED IN A RENT SUBROUTINE * $ABRE CLEANS UP MEMORY ALLOCATION AND OWNERSHIP FLAGS * FOR A PROGRAM ABORTED (OR TERMINATED) WHILE IN A REENTRENT * SUBROUTINE. * * CALLING SEQUENCE: * * A=0 IF DISC RESIDENT * A#0 IF CORE RESIDENT * * LDB ID-SEG ADDRESS * JSB $ABRE * * TEMP USAGE: * * TEMP2 = ADDRESS OF 4 WORD ID EXTENSION * TEMP4 = NEXT ID-SEG EXTENSION * TEMP6 = ID ADDRESS (FROM FINDL) * TEMP1 = TDB ADDRESS * TEMP7 = MEMORY ADDRESS * TEMP8 = # WORDS TO RETURN * TEMP9 = CORE RESIDENT FLAG (PASSED IN A) * SAVER = ID-SEGMENT ADDRESS SAVE WHILE RN RELEASE CALLED * $ABRE NOP STA TEMP9 SAVE THE RESIDENCY FLAG LDA B ADA D20 ADVANCE TO FATHER PTR LDA A,I ALF,RAL TEST REENTRANT BIT SSA ®1þú SEARCH ONLY IF NEED TO. JSB FINDL DOES HE HAVE ANY? JMP ABRX NO EXIT * LDA B,I YES UNLINK FROM LIST STA TEMP5,I ABRE1 STB TEMP2 SET ID-EXTENTION ADDRESS CLA,SEZ,RSS COMPUTE ADDRESS LDA D3 OF NEXT ENTRY ADA B IN THE PROGRAMS LIST LDA A,I AND SAVE STA TEMP4 IT * ADB D2 INDEX TO THE TDB ADDRESS LDA B,I FETCH IT RAL,CLE,SLA,ERA CLEAR MOVED BIT, SKIP IF NOT JMP ABRE2 NOT MOVED CONTINUE * STA TEMP1 SET THE TDB ADDRESS FOR CLEAR LDB TEMP9 GET THE RESIDENCY FLAG CMA,CLE IF THE TDB IS NOT IN THE LIB. AREA ADA RTORG AND THE PROG IS DISC RESIDENT SEZ,CCE,RSS THEN DO NOT CLEAR THE TDB SZB JMP ABRE4 EITHER RESIDENT OR TRUE LIB. JMP ABRE3 IN DISC RESIDENT PGM. * ABRE2 STA TEMP7 SET UP TO RETURN IT INA STEP TO THE LENGTH LDA A,I GET IT STA TEMP8 SET FOR RETURN CALL JSB $RTN RETURN THE SAVE AREA TEMP7 NOP TEMP8 NOP * ABRE3 CLA,CCE CLEAR TEMP1 TO AVOID PROBLEMS STA TEMP1 JSB RTN4 RETURN THE 4 WORD EXTENSION ABRE6 LDB TEMP4 GET ADDRESS OF NEXT CCE,SZB EXTENSION JMP ABRE1 GO DO IT IF IT EXISTS ABRX JMP $ABRE,I RETURN * ABRE7 LDA $PBUF GET THE ADDRESS OF OUR 32 WORD MAP BUFFER ADA SIGN ADD SIGN BIT TO INSURE WRITE TO MEMORY USA PERFORM THE WRITE LDA $MRMP NOW GET ADDRESS OF MEM RES MAP USA SET IT UP JSB RTN4 RETURN THE 4 WORDS AND RELEASE THE TDB LDA $PBUF GET THE SAVED MAP USA PUT IT BACK JMP ABRE6 GO GET THE NEXT BLOCK * * ABRE4 SZB DISC RES PROGRAM ? JMP ABRE7 NO, MEM RES. * LDA TEMP6 GET THE ID ADDRESS ADA D21 AND INDEX TO THE SSGA WORD LDA A,I ÉþúALF,ALF GET IT TO LOW END RAL AND D7 KEEP ONLY MPFT INDEX CPA D4 WAS SSGA ALLOWED ? STB TEMP1,I YES, ZAP THE TDB CAUSE IT'S IN SSGA(SET FREE) JMP ABRE3 NO, DON'T ZAP IT. IT WAS IN PROG AREA. * D21 DEC 21 HED $LIBX EXIT PROCESSOR FOR RENT/PRIV LIB ROUTINES SKP * < $LIBX> IS ENTERED WHEN A LIBRARY * PROGRAM TERMINATES ITS EXECUTION. A * TEMPORARY DATA BLOCK IS MOVED BACK * INTO THE LIBRARY PROGRAM, IF REQUIRED, * BEFORE RETURN TO THE ORIGINAL CALLER. * * LIBXA DEF $LIBX+0 A DIRECT ADDRESS * *$LIBX NOP * SJP $LBX $LBX STA XA,I NON MP ENTRY MUST BE PRIV SUB RETURN. LDA $PVCN SUBTRACT ONE FORM THE COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LB10 IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK XLA $LIBX,I TRACK DOWN THE RETURN XLA A,I ADDRESS STA $LIBX AND SET IT * LDA $PVST GET DMS STATUS RAL,RAL ROTATE & SET FOR RETURN TRIP STA $PVST * LDA XA,I RESTORE A AND JRS $PVST $LIBX,I RETURN * LB10 STA $PVCN RETURN NON PRIV. SET COUNTER STB XB,I TO ZERO AND FINISH THE REG. SAVE ERA,ALS E SOC O INA STA XEO,I XLA $LIBX,I GET THE XLA A,I RETURN ADDRESS STA XSUSP,I AND SAVE IT LDB XI GET THE X & Y REGISTER SAVE AREA CXA GET X TO A XSA B,I SAVE X INB BUMP POINTER CYA XSA B,I SAVE Y JMP $RENT NOW GO SET THE FENCE * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LIBXC XLB $LIBR,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. XLA B,I AND GET CONTENTS (TEMP4 = ADDRESS OF STA TEMP4 WORD 2 OF ID EXT TO BE RETURNED) ISZ $LIBR SET TO (P+2) OF CALL TO -$LIBX-.(RETRN ADJ)  þúADB D2 GET XLA B,I ORIGINAL RETURN ADDRESS XLB $LIBR,I ADD IN THE RETURN ADJUSTMENT ADA B STA XSUSP,I AND SET FOR RETURN TO USER. * LDB XEQT GET ID EXTENSION JSB FINDL ADDRESS JMP MPERR NOT FOUND??? JMP LB14 START SEARCH * LB15 SEZ,CCE,RSS FIND NEXT ENTRY ADDRESS ADB D3 GO TO 4TH WORD (ONLY DONE ONCE) STB TEMP5 SAVE POINTER LDB B,I GET ADDRESS LB14 STB A OF INA ID WORD CPA TEMP4 THIS ONE?? RSS YES GO DO IT JMP LB15 NO TRY NEXT ONE * STB TEMP2 SAVE BLOCK ADDRESS LDB B,I RELINK THE BLOCKS STB TEMP5,I JSB RTN4 RETURN THE ID-EXTENSION JMP $RENT TDB = 0, GO TO CHECK RETURN. * HED ** SYSTEM DISC ALLOCATION/RELEASE PROCESSOR ** * SYSTEM DISC ALLOCATION/RELEASE REQUESTS * * THESE REQUESTS CONFORM TO THE GENERAL * SYSTEM REQUEST FORMAT. * * A. DISC TRACK ALLOCATION * * THE ALLOCATION REQUEST INCLUDES THE * NUMBER OF CONTIGUOUS TRACKS DESIRED, A * PARAMETER TO INDICATE SUSPENSION OR * NO SUSPENSION IF THE REQUESTED SPACE IS * NOT AVAILABLE AND VARIABLE STORAGE FOR * RETURNING THE STARTING TRACK NUMBER, THE * DISC LOGICAL UNIT NUMBER AND THE NUMBER * OF SECTORS PER TRACK FOR THE ASSIGNED * DISC. * * (P) JSB EXEC * (P+1) DEF *+6 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS DESIRED) * (P+4) DEF STRAK ( " WORD FOR TRACK #) * (P+5) DEF DISC ( " " FOR DISC LU #) * (P+6) DEF SECT# ( " " FOR # SECTORS) * (P+7) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * SECT# NOP * * M = 4 ALLOCATE TRACK TO PROGRAM * = 15 ALLOCATE TRACK GLOBALLY * * #TRAK (BIT 15):= 0 TO MEAN×þú SUSPENSION IF * TRACKS NOT AVAILABLE * = 1 TO MEAN NO SUSPENSION AND * SET (STRAK) = -1 IF NO * TRACKS AVAILABLE. * * STRAK : THE STARTING TRACK NUMBER OF THE * CONTIGUOUS GROUP ALLOCATED IS * STORED IN THIS WORD ( OR = -1 AS * DESCRIBED FOR 'NO SUSPENSION' ABOVE). * * DISC : THE LOGICAL UNIT NUMBER OF THE DISC * ON WHICH THE TRACK(S) WERE ALLOCATED * IS STORED IN THIS WORD. * * SECT#: THE NUMBER OF SECTORS PER TRACK FOR * THIS DISC ALLOCATION IS STORED IN * THIS WORD. SKP * * B. DISC TRACK RELEASE * * THE RELEASE REQUEST PROVIDES FOR RELEASING * A SINGLE TRACK, A CONTIGUOUS GROUP OF TRACKS * OR ALL TRACKS ASSIGNED. THE TRACKS TO BE * RELEASED MUST BE EITHER ASSIGNED TO THE * REQUESTING PROGRAM (REQUEST CODE 5) OR * ASSIGNED GLOBALLY (REQUEST CODE 16). * * (P) JSB EXEC * (P+1) DEF *+5 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS TO RELEASE) * (P+4) DEF STRAK ( " STARTING TRACK #) * (P+5) DEF DISC ( " DISC LU # ) * (P+6) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * * M = 5 RELEASE PROGRAM TRACK * = 16 RELEASE GLOBAL TRACK * * #TRAK: = N, TO INDICATE THE NUMBER OF CONTIG- * UOUS TRACKS TO RELEASE BEGINNING * AT THE TRACK NUMBER IN 'STRAK'. * * = -1, TO MEAN RELEASE ALL TRACKS ASSIGNED * TO THE USER PROGRAM - * VALID ONLY FOR PROGRAM ASSIGNED TRACKS * IN THIS CASE, THE 'STRAK' ANDNk * 'DISC' PARAMETERS NEED NOT * BE INCLUDED. * * STRAK: THE STARTING TRACK OF THE GROUP TO * BE RELEASED IS STORED IN THIS WORD. Äþú * * DISC: THE LOGICAL UNIT NUMBER OF THE DISC * CONTAINING THE TRACKS IS STORED * IN THIS WORD. SKP * * ** TRACK ASSIGNMENT TABLE ** * * THE *TAT* IS A VARIABLE LENGTH TABLE DESCRIBING * THE AVAILABILITY OF EACH DISC TRACK ON THE * SYSTEM DISC AND, IF INCLUDED, THE AUXILIARY DISC. * THE *TAT* IS CONSTRUCTED BY BASED ON * USER PARAMETERS DECLARING THE SIZE OF THE SYSTEM * DISC AND THE AVAILABILITY AND SIZE OF AN AUXILIARY * DISC. EACH TRACK IS REPRESENTED BY A 1-WORD ENTRY. * THE FIRST WORDS OF THE TABLE CORRESPOND TO THE * N TRACKS OF THE SYSTEM DISC, USUALLY 32, 64 OR * 128. THE WORD "TATSD" IN THE BASE PAGE COMMUNI- * CATION AREA CONTAINS THE SIZE OF THE SYSTEM DISC * AS A POSITIVE INTEGER. IF AN AUXILIARLY DISC IS * INCLUDED, THE REST OF THE *TAT* CONTAINS 1-WORD * ENTRIES TO DESCRIBE THE TRACKS ON THAT DISC. * RTGEN INITIALIZES THE PROTECTED TRACKS OF THE * SYSTEM DISC TO BE ASSIGNED TO THE SYSTEM (PERM- * ANENTLY UNAVAILABLE). * THE CONTENTS OF A TRACK ASSIGNMENT ENTRY WORD * MAY BE ONE OF THE FOUR VALUES: * * 0 - AVAILABLE FOR ASSIGNMENT * 100000 - ASSIGNED TO THE SYSTEM (OR PROTECTED) * 077777 - ASSIGNED GLOBALLY * NNNNN - USER PROGRAM ASSIGNMENT. NNNNN IS THE * ID SEGMENT ADDRESS OF THE PROGRAM. * * THE WORD "TATLG" IN THE BP COMMUNICATION AREA * CONTAINS THE NEGATIVE LENGTH OF THE TAT. * THE WORD "TAT" CONTAINS THE FWA OF THE TABLE. * * ** VARIABLE NUMBER OF SECTORS PER TRACK ON FIXED-HEAD SYSTEMS ** * * ONE RTE CAN ACCOMODATE TWO FIXED-HEAD * DISC UNITS TERMED THE SYSTEM DISC (LU #2) * AND THE AUXILIARY DISC (LU#3). THESE DISCS * MAY BE DIFFERENT MODELS OF A FIXED-HEAD * DISC AND WITH DIFFERING NUMBER OF SECTORS * PER TRACK. FOR THIS REASON THE WORDS * 'SECT2' AND 'SECT3' IN THE BASE PAGE * COMMUNICATION AREA CONTAIN THE NUMBER OF * SECTORS PER TRACK FOR LOGICAL UNITS 2 AND 3. * * Dâþú SKP * TRACK ALLOCATION (USER CALL) * DISCA CCB,RSS SET DISC1 LDB XEQT ENTRY LDA RQCNT INSURE ADA DM4 THAT SSA 4 PARAMETERS ARE SUPPLIED. JMP DERR1 -NO, ERROR 'DR01' * XLA RQP2,I GET '#TRAK' PARAMETER TO CHECK AND C100K 'N'. REMOVE BIT 15, SZA,RSS -ERROR IF JMP DERR2 #TRAK = 0. * ELB,CLE,ERB JSB $DREQ CALL FOR CONTIGUOUS ALLOCATION * SZB IF TRACKS ALLOCATED, JMP DSC3 CONTINUE. * * NO TRACKS ARE AVAILABLE * CCA CHECK SUSPENSION XLB RQP2,I PARAMETER. SSB IF BIT 15 = 1, GO TO SET STRAK JMP DSC3 = -1 AND RETURN TO CALLER. * * SUSPEND PROGRAM - LINK INTO DISC SUSPENSION LIST * JSB $LIST SUSPEND OCT 505 PROGRAM JMP $XEQ - EXIT - * * AVAILABLE TRACK FOUND * DSC3 XSA RQP3,I SAVE STARTING TRACK #. LDA SECT2 SET TO STORE CPB D3 # SECTORS PER TRACK IN LDA SECT3 'SECT#' DEPENDING ON LU # IN B. XSA RQP5,I SET # SECTORS. * XSB RQP4,I SET DISC LOGICAL UNIT #. * DSC4 LDA RQRTN SET *XSUSP* TO STA XSUSP,I BE EXIT ADDRESS JMP $XEQ - EXIT -. * D3 DEC 3 DM2 DEC -2 DM4 DEC -4 C100K OCT 77777 * * * TRACK RELEASE (USER CALL) * DISC2 CLA,CLE,RSS SET DISCB CLA,CCE,INA ENTRY STA TEMP7 SWITCH LDA RQCNT INSURE SZA,RSS THAT AT LEAST 1 PARAMETER GIVEN. JMP DERR1 - NO, ERROR LDA XEQT (A)= ID SEGMENT ADDRESS XLB RQP2,I GET PARAMETER: CPB DM1 IF = -1, JMP DSC7 GO TO RELEASE ALL FOR THIS PROG * LDA RQCNT INSURE THAT THE ADA DM3 STRAK AND DISC PARAMETERS SSA ARE PROVIDED. JMP DERR1 -NO, ERROR * XLA RQP4,I GET DISC LU #. XLB RQP3,I AND THE # OF TRACKüµþúS CLE,ERA CHECK VALIDITY. CPA D1 IF NOT 2 OR 3 RSS THEN GO SEND HIM JMP DERR2 DOWN THE TUBES. * SEZ IF LU 3 USE ADB TATSD AUXILIARY DISC * XLA RQP2,I GET #TRAK. CMA,INA SET NEGATIVE FOR SSA,RSS COUNTER. ERROR IF 0 OR JMP DERR2 ORIGINALLY NEGATIVE. STA TEMP1 SET COUNTER. * LDA TEMP7 RELEASE CCE,SZA NON-GLOBAL JMP DSC8 GLOBAL * ADB TAT ADD THE TAT ADDRESS DSC5 LDA B,I GET CURRENT TRACK ASSIGNMENT CPA XEQT COMPARE TO PROGRAM ID SEG ADDRESS CLA,RSS JMP DERR3 OTHERWISE, REQUEST ERROR. STA B,I = 0 TO BE AVAILABLE. INB ADD 1 TO TAT ADDRESS. ISZ TEMP1 -INDEX COUNTER. JMP DSC5 -MORE * DSC6 JSB $SDSK FINISHED-SCHEDULE DISC SUSP PROGS * JMP DSC4 GO ADVANCE RETURN ADDRESS AND EXIT * DSC8 LDA TEMP1 SET A TO NUMBER OF TRACKS(-) JSB $CREL TRY CONDITIONAL RELEASE STB XA,I SET RESULT IN USER A REG. JMP DSC4 AND GO EXIT * DSC7 SEZ IF GLOBAL RELEASE JMP DERR1 SHOT DOWN THE CLOD. JSB $SDRL RELEASE ALL TRACKS JMP DSC6 GO SCHEDULE ALL WAITING PGMS. * * * $CREL CONDITIONALLY RELEASES SYSTEM OR GLOBAL TRACKS * THE CONDITION BEING: * A) THAT THEY ARE ASSIGNED AS EXPECTED AND * B) THAT THEY ARE NOT IN A DISC I/O QUEUE. * * CALLING SEQUENCE: * * E = 1 IF GLOBAL TRACK RELEASE * E = 0 IF SYSTEM TRACK RELEASE * A = THE NEGATIVE OF THE NUMBER OF TRACKS TO RELEASE. * B = THE FIRST TRACK'S OFFSET IN THE TAT. * * JSB $CREL * * RETURN CONDITIONS ARE: * * B = -1 ONE OR MORE OF THE TRACKS IS IN USE * = -2 ONE OR MORE OF THE TRACKS IS NOT ASSIGNED AS SPECIFIED. * = 0 TRACKS WERE RELEASED. * $CREL NOP ADB TAT “ þú GET THE TAT ADDRESS TO B STB TEMP4 STB TEMP7 ENTRY IN TAT SPC 1 STA TEMP1 SET THE COUNTERS STA TEMP6 LDA C100K SET UP THE SEZ,RSS ASSIGNMENT FLAG INA STEP GLOBAL TO SYSTEM STA TEMP2 SAVE IT LDA TATSD COMPUTE THE DISC LU ADA TAT A IS THE TAT POSITION CMA,INA (-) OF THE FIRST WORD OF LU 3. ADA B SUBTRACT FROM TAT POSITON OF FIRST TRACK CLE,SSA IF NEG. THEN ADJUST ADA TATSD FOR LU 2 (SETS E) STA TEMP8 SET THE TRACK NUMBER CLB,SEZ,INB,RSS SET B TO INB THE DISC LU LESS ONE. STB $OTRL SAVE THE LU ISZ $OTRL ADD THE MISSING ONE. ADB DRT GET THE EQT ADDRESS LDA B,I INTO JSB $CVEQ EQT1 * SPC 1 DSC9 LDA TEMP7,I GLOBAL CPA TEMP2 TRACK? RSS YES-GO SEE IF IN USE JMP DSC15 NO-RETURN TO PROG WITH A=-2 LDB EQT1,I GET REQUESTS QUEUED ON DISC ELB,CLE,ERB STRIP POSSIBLE SIGN BIT DSC10 STB TEMP9 DISC QUEUE EXHAUSTED? SZB,RSS JMP DSC12 YES-GO TO NEXT TRACK INB NO-SEE IF REQUEST LDA B,I IS FOR THIS TRACK ALF,ALF AND D3 CPA $OTRL SAME LU? I.E. DISC? RSS YES-CHECK IF SAME TRACK JMP DSC11 NO ADB D3 LDA B,I CPA TEMP8 SAME TRACK? JMP DSC14 YES-RETURN WITH A=-1 SPC 1 DSC11 LDB TEMP9,I GO TO NEXT REQUEST JMP DSC10 IN QUEUE SPC 1 DSC12 ISZ TEMP7 SET UP FOR NEXT TRACK ISZ TEMP8 CHECK NEXT TRACK ISZ TEMP1 ALL TRACKS CHECKED? JMP DSC9 NO TRY AGAIN SPC 1 DSC13 STB TEMP4,I CLEAR ALL ISZ TEMP4 TRACKS ISZ TEMP6 JMP DSC13 SETUP TO RETURN JSB $SDSK SCHEDULE ANY WAITING PGMS. JMP $CREL,I AND REÉaþúTURN SPC 1 DSC14 CCB,RSS STORE B REGISTER DSC15 LDB DM2 TO INDICATE WHY NO TRACKS JMP $CREL,I RELEASED AND RETURN * * * * * DISC REQUEST ERROR SECTION * DERR1 CLB,INB,RSS -ILLEGAL DISC REQUEST - DR01 - DERR2 LDB D2 -ILLEGAL TRACK # - DR02 - JMP DERR DERR3 LDB D3 -TRACK NOT ASSIGNED TO PROG- DR03 DERR LDA DRA (A) = DR IN ASCII. $ERRA ADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG. AND ABORT PROG JMP $XEQ -EXIT- * DRA ASC 1,DR AS00 ASC 1,00 * * * SUBROUTINE: <$OTRL> * * PURPOSE: THIS SUBROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * ADDRESS IS IN THE A REGISTER. * * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * WHOSE TRACKS ARE TO BE RELEASED * (P) JSB $OTRL * (P+1) -RETURN- * * $OTRL NOP STA TEMP3 SAVE ID SEGMENT ADDRESS LDA $OTRL AND RETURN ADDRESS FOR STA $SDRL $SDRL ROUTINE AND JUMP JMP SDSC1 TO IT SKP * * SUBROUTINE: < $SDRL > * * PURPOSE: THIS ROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * IS DEFINED IN *XEQT* OR ANY TRACKS ASSIGNED * GLOBALLY DEPENDING ON A REG CONTENTS ON ENTRY. * * * EXCEPTION: IF THE NAME OF THE SUBJECT PROGRAM IS * "EDIT",OR "D.RTR" AN IMMEDIATE EXIT IS MADE TO * AVOID RELEASING SAVED SOURCE FILES AND * DIRECTORY TRACKS IN THE NAME OF THESE * PROGRAMS. * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * OR 077777B (GLOBAL FLAG) * (P) JSB $SDRL * (P+1) -RETURN- * * $SDRL NOP STA TEMP3 DLD IDADD,I GET THE ID ADDRESSES OF D.RTR IDADD EQU *-1 AND EDIT (NOT EDIT6ÊþúR DUMMY) CPA TEMP3 IF D.RTR RSS CPB TEMP3 OR EDIT JMP $SDRL,I DON'T RELEASE THEIR TRACKS * SDSC1 LDA TAT SET *TAT* STA TEMP1 ADDRESS LDA TATLG AND TAT LENGTH STA TEMP2 AS INDEX. CLB (B) = 0 FOR RELEASE * SDSC2 LDA TEMP1,I GET CURRENT TRACK ASSIGNMENT. CPA TEMP3 IF ASSIGNED TO THIS PROGRAM, STB TEMP1,I RELEASE IT. ISZ TEMP1 SET ISZ TEMP2 FOR JMP SDSC2 NEXT TRACK. JSB $SDSK SCHEDULE DISC SUSPENDED PROGRAMS JMP $SDRL,I -FINISHED- * SKP * * SYSTEM SUBROUTINE: < $DREQ> * * PURPOSE: THIS SUBROUTINE PROVIDES FOR THE * ALLOCATION OF 'N' CONTIGUOUS TRACKS * FOR BOTH SYSTEM ROUTINES AND NORMAL * USER PROGRAMS. THE 'N' CONTIGUOUS * TRACKS ALLOCATED WILL BE ON THE SAME * DISC UNIT, NO SPANNING OF DISCS WITH * ONE ALLOCATION IS ALLOWED. * * CALL: (A) = NUMBER OF CONTIGUOUS TRACKS * (B) = : 0 FOR CALL FROM SYSTEM ROUTINE * : (XEQT) FOR AN ACTUAL USER * REQUEST. THE ID SEGMENT * ADDRESS (XEQT) IS STORED IN * THE ASSIGNED TRACK WORDS IN * THE -TAT-. * : (077777B) FOR A GLOBAL ASSIGNMENT REQUEST. * THIS OCTAL NUMBER IS STORED IN THE * ASSIGNED TRACK WORDS IN THE -TAT-. * * (P) JSB $DREQ * (P+1) -RETURN- * * ON RETURN: 1) B = 0 IF N TRACKS WERE * NOT AVAILABLE * * 2) A = STARTING TRACK ADDRESS * OF N TRACKS. * B = LOGICAL UNIT # OF DISC * * $DREQ NOP CMA,INA SET COUNT NEGATIVE FOR LOOPS STA TEMP1 SAVE '-N' * CLA,INA ALLOCATION IS TOP DOWN FOR SYS CLE,SZB REQUEST AND BO$ªþúTTOM UP JMP DREQ0 FOR USER REQUEST - USER JMP. * CCA,CCE SET INCREMENT VALUE AND SYSTEM FLAG LDB SIGN B= SYS TAT FLAG WORD DREQ0 STB TEMP6 SAVE ASSIGNMENT VALUE. STA $DREL SET TABLE INCREMENT VALUE (+1 OR -1) * LDB TAT SET *TAT* LDA B COMPUTE ADDRESS OF LU 3'S ADA TATSD TAT POSITION SEZ IF SYSTEM RQ. ADA $DREL SUBTRACT ONE STA TEMP7 SET ADDRESS OF FIRST WORD ON OTHER DISC LDA TATLG AND TAT LENGTH STA TEMP4 AS INDEX. CMA,SEZ IF SYSTEM RQ. ADB A SET TO START AT THE TOP * DREQ1 LDA B,I GET CURRENT TRACK ASSIGNMENT. SZA,RSS IF NOT ASSIGNED, JMP DREQ3 CHECK FOR N CONTIGUOUS. * DREQ8 ADB $DREL SET FOR DREQ5 ISZ TEMP4 NEXT JMP DREQ1 TRACK. * DREQ2 CLB NOT AVAILABLE, EXIT JMP $DREQ,I WITH (B) = 0. * * AVAILABLE TRACK FOUND - CHECK NEXT 'N-1' TRACKS * DREQ3 STB TEMP3 (B) = FIRST TRACK TAT INDEX. LDA TEMP1 SET STA TEMP2 'N' AS INDEX. DREQ4 LDA B,I CHECK CURRENT SZA TRACK ASSIGNMENT. JMP DREQ8 -ASSIGNED, CONTINUE OTHER SCAN. * ISZ TEMP2 INDEX -'N' RSS NOT ZERO, CHECK NEXT TRACK. JMP DREQ6 - FOUND N TRACKS - * ADB $DREL INDEX TO NEXT TRACK CPB TEMP7 DISC (LU 2)? JMP DREQ5 YES - DO NOT SPAN * ISZ TEMP4 INDEX AND TRACK INDEX. JMP DREQ4 -NOT FINISHED WITH TAT SIZE. * JMP DREQ2 NOT N AVAILABLE. * * N CONTIGUOUS TRACKS FOUND * DREQ6 SEZ IF SYSTEM REQUEST STB TEMP3 SET START ALLOCATION ADDRESS LDB TEMP3 SET THE FIRST TRACK TAT ADDRESS. LDA TEMP6 SET TRACK WORD DREQ7 STA B,I = 100000 FOR SYSTEM USE INB OR TO THE ID SEGMENT ADDRESS ISZ TEMP1 OF THE USER PROGRAM OR TO JMí,NLHP DREQ7 077777B FOR GLOBAL ASSIGNMENT. * LDA TEMP7 GET ADDRESS OF LU 3 TR 0 IN TAT CMA,SEZ,RSS AND SUBTRACT FROM INA ADA TEMP3 ALLOCATED POSITION CLE,SSA IF ON LU 3 THEN WE HAVE THE TRACK ADA TATSD ELSE NOW WE HAVE IT (E SET TOO) CLB,CME,INB TURN E AROUND TO LEAST LU BIT ELB SET DISC LU IN B JMP $DREQ,I -EXIT-. SPC 1 TEMP1 NOP SKP * * SYSTEM SUBROUTINE: < $DREL> * * PURPOSE: THIS ROUTINE RELEASES 'N' CONTIGUOUS * TRACKS (ASSIGNED TO THE SYSTEM) * BEGINNING AT TRACK 'M'. * * CALL: (A) = 'M' - STARTING TRACK # (+ SIZE OF * SYSTEM DISC IF LU #3) * (B) = 'N' - # OF CONTIGUOUS TRACKS * (P) ) JSB DREL * (P+1) -RETURN- A = 0. * * $DREL CXA CXA FOR X,Y CONFIGURATION ADA TAT COMPUTE *TAT* ADDRESS STA TEMP1 OF STARTING ADDRESS. LDA A,I GLOBAL TRACKS SSA,RSS ARE NOT TO ˆ8Nÿÿþú JMP $DREL,I BE RELEASED * CMB,INB SET 'N' AS INDEX. CLA SET CURRENT DREL0 STA TEMP1,I TRACK ISZ TEMP1 RELEASED INB,SZB JMP DREL0 JSB $SDSK SCHEDULE ANY SUSPENDED PROGRAMS. JMP $DREL,I -EXIT- * SKP * SUBROUTINE: < $SDSK > * * PRUPOSE: THIS ROUTINE CALLS FOR THE * SCHEDULING OF ALL USER PROGRAMS * SUSPENDED BECAUSE OF DISC TRACK * AVAILABILITY. * * CALL: (P) JSB $SDSK * (P+1) - RETURN - A = 0 * * $SDSK DEF IDADD LINK FOR START UP CODE ISZ $LIST FORCE ENTRY INTO DISPATCHER. DSKD1 LDB SUSP4 GET DISC SUSPENSION LIST POINTER. CCE,SZB,RSS IF EMPTY LIST, JMP $SDSK,I EXIT. * JSB $LIST CALL *SCHEDULER* TO OCT 401 LINK INTO SCHEDULE LIST. * JMP DSKD1 SCHEDULE NEXT PROGRAM SKP HED - EXEC - PARTITION STATUS REQUEST PROCESSOR * EXEC CALL FOR PARTITION STATUS * * CALLING SEQUENCE : JSB EXEC * DEF *+6 RETURN * DEF D25 CODE=25 * DEF PART# PARTITION NUMBER * DEF PAGE# RETURNED STARTING PAGE # * DEF #PGS RETURNED NUMBER OF PAGES * DEF PSTAT RETURNED PARTITION STATUS * BIT15 = BG/RT 0/1 * BIT14 = FREE FOR ALL/RESERVED 0/1 * BIT13 = NORMAL/MOTHER PART'N 0/1 * BIT12 = ISN'T/IS A SUB PART'N 0/1 * BIT11 = CHAIN ISN'T/IS IN EFFECT * 0/1 * * * TEMP USAGE : TEMP1 = INPUT PARTITION # * * FORMAT OF PSTAT * 15 14 13 12 11 7 *----------------------------------------------------------- *I RS I RT I M I S I C I ---- 4þú0 ---- I ID SEGMENT NUMBER I *----------------------------------------------------------- * * #PGS = -1 ON RETURN IF PARTITION NUMBER IS ERRONEOUS * $PTST LDA RQCNT GET THE REQUEST COUNT ADA DM4 SUBTRACT THE PRAMETER COUNT SSA ARE THERE ENOUGH PARAMETERS ? JMP RQERR NO, SO TAKE GAS ! * XLA RQP2,I GET THE PART'N # STA TEMP1 AND SAVE CMA,INA IF NEG OR 0 SSA,RSS FORGET IT . JMP PT.ER * ADA $MNP ADD IN THE MAX # OF PARTITIONS SSA IF PARTITION REQUESTED IS TOO JMP PT.ER LARGE, FLUSH HIM ! * CCA NOW INDEX TO ADA TEMP1 THE REFERENCED MPY D7 PARTITION ADA $MATA CAX PUT ADDRESS IN X FOR FUTURE INDEXING LDA A,I GET THE CONTENTS OF 1ST WORD SSA IS THE PARTITION DEFINED ? JMP PT.ER NO, FLUSH HIM !!! * LBX D2,I GET THE USERS ID SEG # SZB IF NOBODY HOME, FORGET IT JSB $IDNO RETURNS IS SEG # IN B-REG * LAX D4,I GET THE RESERVED WORD RAL,CLE,SLA,ELA R =LSB C = E-REG ADB SIGN IF RESERVED,SET B-REG SIGN BIT RAR,RAR MOVE RESERVED WORD BACK AND B1777 KEEP ONLY #PGS SEZ,INA ADD BASE PAGE, SKIP IF CHAIN IN EFFECT ADB B4000 SET C BIT TO INDICATE CHAIN XSA RQP4,I GIVE # OF PAGES TO USER * LAX D5,I GET RT WORD SSA IF RT BIT SET THEN ADB B40K SET THE RT BIT IN PSTAT * RBL,RBL PLACE M&S BITS INTO BIT 15 & 14 * LAX D3,I GET THE START PAGE WORD SSA IS THE M BIT SET ? ADB SIGN YES, SO SET THE PSTAT M BIT AND B1777 KEEP ONLY START PG # XSA RQP3,I GIVE IT TO THE USER * SSB IS THIS A MOTHER PARTITION JMP PT.MB YES, SO CAN'T BE A SUB PARTITION * LAX D6,I NO, ÜÿþúGET THE SUBPARTITION LINK WORD SZA IS THERE A SUB PARTITION ? ADB B40K YES, SO SET THE PSTAT S BIT PT.MB RBR,RBR FIX B- REG XSB RQP5,I AND GIVE THE PSTAT TO THE USER * PT.RT LDA RQRTN GET THE RETURN ADDRESS STA XSUSP,I DET AS THE POINT OF SUSPENSION JMP $XEQ AND SEE WHAT TO DO NEXT. * * PT.ER CLA XSA RQP3,I RETURN 0 AS START PG # CMA XSA RQP4,I RETURN -1 AS # OF PAGES JMP PT.RT * D6 DEC 6 B1777 OCT 1777 B40K OCT 40000 B37 OCT 37 B77 OCT 77 * HED - EXEC - PARTITION SIZE REQUEST PROCESSOR * * * EXEC 26 CALLING SEQUENCE * * JSB EXEC * DEF RETURN * DEF CODE# = 26 * DEF FWMEM = ADDRESS OF PROGRAM'S HIGHEST WORD + 1 * DEF NWLM = # OF WORDS AFTER PROG END & END OF ADDRESS SPACE * DEF PTS12 = LENGTH OF CURRENT PARTITION IN PAGES * DEF MAP = OPTIONAL 32 WORD BUFFER FOR COPY OF USER MAP * * * TEMP USAGE: TEMP1 = - [ HIGH MAIN + LARGEST SEGMENT + 1 ] * * * * PTSIZ LDA RQCNT GET THE REQUEST COUNT ADA DM3 SUBTRACT ACTUAL PRAMETER COUNT SSA AT LEAST 3 PARAMETERS SUPPLIED ? JMP RQERR NO, FLUSH HIM !!! SZA,RSS DID HE SUPPLY THE OPTIONAL PARAMETER ? JMP NMOVE NO. * LDA $PBUF GET THE DESTINATION ADDRESS ADA SIGN SPECIFY READ NOT WRITE USA GET THE MAP * LDA $PBUF NOW THAT WE HAVE THE MAP LDB RQP5 LET'S GIVE IT TO THE USER LDX D32 X = # OF WORDS TO MOVE MWI MOVE THE WORDS. * NMOVE LDA XMATA GET ADDR OF CURRENT $MATA ENTRY SZA,RSS IS THIS A MEMORY RESIDENT PROG ? JMP MEMER YES, FORGET THE REST OF THE CALL ADA D4 INDEX TO THE SIZE WORD LDA A,I GET IT. INA ACCOUNT FOR BASE PAGE. AND B1777 KEEP ONLY THE SIZE BITS XSA RQP4,I AND GIVE IT TO THEd0þú USER * LDB XEQT NOW GET THIS PROS'S ID SEG ADDRESS ADB D29 INDEX TO THE HIGH MAIN + SEGMENT +1 LDA B,I GET THE SIZE ADB DM6 NOW INDEX TO HIGH MAIN + 1 SZA,RSS IS THE PROGRAM SEGMENTED ? LDA B,I NO, SO USE HIGH MAIN + 1 XSA RQP2,I NOW GIVE IT TO THE USER. CMA,INA * ADB DM1 NOW INDEX TO LOW MAIN WORD IN ID SEG ADA B,I GET THE WORD STA TEMP1 AND SAVE * ADB DM1 NOW INDEX TO # OF PAGES WORD LDA B,I GET THE WORD AND G76 & KEEP SIZE IN PAGES ADA TEMP1 ADD LOAD POINT. A = # OF WORDS LEFT XSA RQP3,I GIVE IT TO THE USER. ADB D7 *E INDEX TO EMA WORD LDA B,I *E SZA,RSS *E IS THIS AN EMA PROG? JMP MYEND *E NO, DONE * ALF *E YES, EMA PROG RAL,RAL *E GET INDEX VALUE AND B77 *E ADA $IDEX *E LDA A,I *E LDA A,I *E (A) = 1ST WORD ID EXT AND B37 *E KEEP ONLY MSEG SIZE ALF,ALF *E RAL,RAL *E CONVERT TO # OF WORDS CMA,INA *E XLB RQP3,I *E SUBTRACT FROM # OF WORDS ADA B *E THAT USER COULD HAVE XSA RQP3,I *E (A) = DYNAMIC BUFFER AREA SIZE IN #WORDS * MYEND LDA RQRTN GET RETURN POINT STA XSUSP,I SAVE OIN ID SEG AS POINT OF SUSPENSION. JMP $XEQ NOW GO SEE WHAYT TO DO NEXT. * MEMER STA RQP2,I MEMORY RESIDENT PROGRAM STA RQP3,I SO DONT RETURN STA RQP4,I PARTITION SIZE OR FREE MEMORY JMP MYEND HED * EXEC - ERROR MESSAGE SECTION * * * MEMORY PROTECT * * IN RTE 4 THE OPERATING SYSTEM IS PROTECTED BY A HARDWARE * MEMORY PROTECT. THIS MEANS THAT ANY PROGRAM THAT ILLEGALLY * TRIES TO MODIFY OR JUMP TO THE OPERATING SYSTEM WILL CAUSE * A MEMORY PROTECT INTERUPT. THE OPERATING SYSTEM INTERCEPTS * THE INçþúTERUPT AND DETERMINES IT'S LEGALITY. IF THE MEMORY * PROTECT IS ILLEGAL, THEN THE PROGRAM IS ABORTED AND THE FOLLOWING * MESSAGE IS REPORTED TO THE SYSTEM CONSOLE : * * MP INST = XXXXXX XXXXX = OFFENDING OCTAL INSTRUCTION CODE * ABE PPPPPP QQQQQQ R CONTENTS OF A,B & E REGISTERS AT ABORT * XYO PPPPPP QQQQQQ R CONTENST OF X,Y & O REGISTERS AT ABORT * MP YYYYY ZZZZZ YYYYY = PROGRAM NAME, ZZZZZ = VIOLATION ADDRESS * YYYYY ABORTED * * * DYNAMIC MAPPING VIOLATION * * A DYNAMIC MAPPING VIOLATION OCCURS WHEN AN ILLEGAL READ OR * WRITE OCCURS TO A PROTECTED PAGE OF MEMORY. THIS MAY HAPPEN * WHEN ONE USER TRIES TO WRITE BEYOND HIS OWN ADDRESS SPACE TO * NON EXISTANT MEMORY OR SOMEONE ELSES MEMORY. IN THIS CASE THE * PROGRAM IS ABORTED AND THE FOLLOWING MESSAGE IS PRINTED: * * * DM VIOL = WWWWW WWWWW = CONTENTS OF DMS VIOLATION REGISTER * DM INST = XXXXXX * ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R * DM YYYYY ZZZZZ * YYYYY ABORTED * * * EX ERRORS * * IT IS POSSIBLE TO EXECUTE IN THE PRIVLEDGED MODE (IE INTERUPT * SYSTEM OFF) IN THIS CASE THE USER MAY NOT MAKE EXEC REQUESTS * BECAUSE MEMORY PROTECT, WHICH IS THE ACCESS VEHICLE TO EXEC IS OFF. * AN ATTEMPT TO MAKE AN EXEC CALL WITH THE INTERUPT SYSTEM OFF * WILL CAUSE THE CALLING PROGRAM TO BE ABORTED AND THE FOLLOWING * MESSAGE PRINTED : * *EX YYYYY ZZZZZ *EX ABORTED * * * * UNEXPECTED DM AND MP ERRORS * * THE OPERATING SYSTEM HANDLES ALL MP AND DM VIOLATIONS. * CERTAIN OF THESE VIOLATIONS ARE LEGAL AND OTHERS ARE NOT. * IN ANY CASE THE OPERATING SYSTEM ASSOCIATES THESE VIOLATIONS * WITH PROGRAM ACTIVITY. IF A DM OR MP ERROR OCCURS AND NO PROGRAM * WAS ACTIVE THEN, THIS IS AN UNEXPECTED MP OR DM VILATION. * SINCE NO PROGRAM IS PRESENT, THERE IS NO PROGRAM TO ABORT * IN THIS CASE THE FOLLOWING MESSAGE WILL BE PRINTED : * * * DM VIefþúOL = WWWWW * DM INST = XXXXX OR MP INST = XXXXX * ABE PPPPPP QQQQQQ R ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R XYO PPPPPP QQQQQQ R * DM 0 MP = 0 * * * WARNING WARNING WARNING WARNING WARNING WARNING * ------------------------------------------------- * * THE ABOVE MESSAGE WHICH SPECIFIES AS THE PROGRAM * NAME IS A SIGNAL TO THE USER THAT AN UNEXPECTED MEMORY PROTECT * OR DYNAMIC MAPPING VIOLATION ERROR HAS OCCURED. THIS IS A * SERIOUS VIOLATION OF OP SYSTEM INTEGRITY. MOST TIMES IT MEANS * USER WRITTEN SOFTWARE (DRIVER, PRIVLEDGED SUBROUTINE) HAS DAMAGED * THE OPERATING SYSTEM INTEGRETY OR INADAQUATELY PERFORMED REQUIRED * (DRIVER) SYSTEM HOUSEKEEPING. IT MAY ALSO MEAN THAT THE CPU * HAS FAILED AND THAT THE OPERATING SYSTEM CAUGHT THE FAILURE * IN TIME TO AVOID A SYSTEM CRASH. * * IF THIS ERROR OCCURS IT IS SUGGESTED THAT USERS SAVE WHATEVER * THEY WERE DOING (IE FINISH UP EDITING, ETC) AND REBOOT THE SYSTEM. * IF ONLY H-P SYSTEM MODULES ARE PRESENT IN THE OPERATING SYSTEM, * CPU FAILURE IS HIGHLY SUSPECTED AND CPU DIAGNOSTICS SHOULD BE RUN. * * * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * MPERR LDA MP ASSUME A MP ERROR SFS 5 IS IT A MEMORY PROTECT OR DM ERROR ? JMP MPER MEMORY PROTECT RVA GET THE VIOLATION REGISTER CLE SPECIFY OCTAL CONVERSION JSB $CNV3 CONVERT TO OCTAL LDB A,I GET THE 1ST WORD STB VBUFR+7 INA BUMP POINTER DLD A,I PULL IN LAST TWO DST VBUFR+8 AND SET IN OUTPUT BUFFER * LDA VBUFR GET ADDRESS JSB $SYMG AND REPORT ERROR * LDA DM (A) = 'DM' * MPER STA IBPBF+2 (SAVE THER ERROR CODE ) CLE OCTAL CONVERSION LDA INSTR GET THE INSTRUCTION JSB $CNV3 CONVERT TO OCTAL LDB A,çòþúI GET THE 1ST WORD STB IBPBF+7 & SAVE INA DLD A,I AND THE LAST TWO DST IBPBF+8 LDA IBPBF GET THE ADDRESS & JSB $SYMG TELL THE FOLKS THEY BLEW IT JSB $ABXY REPORT THE AB,XY, & EO REGISTERS LDA IBPBF+2 GET THE CODE JMP DOABT AND DO THE ABORTION * RQERR LDA RQ1 (A) 'RQ' JMP DOABT * ERE01 LDA RE (A) 'RE' JMP DOABT * * SYSTEM MAY BE RESTARTED AFTER * A CRASH BY SETTING P = EXEC * $XEX LDB EXECA,I GET THE CONTENTS OF EXEC SZB,RSS WAS IT A JSB ? JMP XEX1 NO ADB DM1 YES, SO USE THIS AS STB XSUSP,I A POINT OF SUSPENSION * XEX1 LDA IDLE BUT, REGARDLESS RESTORE THE STA $IDLE IDLE LOOP ADDRESS. * CLA SET EXEC BACK TO A NOP AGAIN STA EXECA,I JSB $ABXY REPORT X & Y REGISTERS * LDA EX GET THE ERROR CODE * DOABT LDB BLANK (B) = BLANKS JSB $ERMG GO ABORT THE PROGRAM & REPORT ABORTION * CLE SPECIFY OCTAL CONVERSION JMP $XEQ GO SEE WHAT TO DO NEXT * MP ASC 1,MP RQ1 ASC 1,RQ RE ASC 1,RE PE ASC 1,PE EX ASC 1,EX * VBUFR DEF *+1 DEC -16 DM ASC 8,DM VIOL = XXXXX IBPBF DEF *+1 DEC -16 ASC 8,XX INST = XXXXX * SKP * * * $ABXY PRINTS OUT THE A, B, X, Y, E, & O REGISTERS ON THE * SYSTEM CONSOLE. * IT IS CALLED FOR MP, DM, & PE ERRORS. * * * SET UP TO SEND A & B / X & Y REGISTERS TO SYS CONSOLE * $ABXY NOP DLD AB GET THE ASCII 'AB' DST ABBUF+2 AND PUT INTO MESSAGE * LDA XEO,I GET THE E & O REGISTERS LDB ASC.0 GET AN ASCII ' 0' CLE,SSA WAS E REG SET ? INB YES * LDA XA GET A REG @ SUSPENSION ADDRESS GETXY STA TEMP8 AND SAVE STB ABBUF+11 SAVE E & O REG ALSO LD’±þúA A,I GET THE VALUE TO REPORT JSB $CNV3 CONVERT TO ASCII LDB A,I GET 1ST WORD STB ABBUF+4 CLE,INA BUMP POINTER (CLEAR E FOR NEXT CONVERSION) DLD A,I GET LAST TWO WORDS DST ABBUF+5 & PUT INTO BUFFER * ISZ TEMP8 BUMP TO NEXT WORD (B REG OR Y REG) LDA TEMP8,I GET IT JSB $CNV3 AND DO IT AGAIN LDB A,I STB ABBUF+8 CLE,INA DLD A,I DST ABBUF+9 * LDA ABBUF GET THE ADDRESS JSB $SYMG REPORT THE REGISTER CONTENTS * DLD XY GET X & Y REGISTER MESSAGE CPA ABBUF+2 DONE THIS BEFORE ? JMP $ABXY,I YES, SO RETURN TO CALLER * DST ABBUF+2 NO, SO REPORT X&Y REGISTERS LDB XI GET ADDRESS OF X REGISTER XLA B,I GET IT STA X &SAVE INB XLA B,I STA Y * LDA XEO,I GET THE E&O REGISTER LDB ASC.0 AND THE ' 0' CLE,SLA O REGISTER SET ? INB YES * LDA X.Y PUT ADDRESS IN TEMP8 JMP GETXY * * X.Y DEF *+1 LOCAL X & Y REGISTER SAVE AREA X NOP Y NOP AB ASC 2,ABE XY ASC 2,XYO ABBUF DEF *+1 DEC -20 ASC 10,ABE XXXXXX XXXXXX X ASC.0 ASC 1, 0 SKP * * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * THE ROUTINE ALSO ATTEMPTS TO RECOVER FROM * PROCESSOR FAILURE. IT SEEMS THAT WHEN THE * CPU HICCUPS CONTROL IS TRANSFERED HERE. * THAT IS, THE HICCUP IS DECODED AS A MP, DM, * OR OTHER TYPE ERROR. IF THERE IS A PROGRAM * CURRENTLY EXECUTING, THEN THAT PROGRAM IS ABORTED * \ªþú AND ALL THE ASSOCIATED PROGRAM CLEAN UP IS DONE * VIA THE CALL TO $ABRT. IF HOWEVER, XEQT = 0, THEN * THERE IS NO ONE TO ABORT & WE'RE IN TROUBLE. * IN THIS CASE THE MESSAGE * * DM VIOL = XXXXX * DM INST = XXXXX OR MP INST = XXXXXX * DM 0 MP 0 * * IS PRINTED AND NO CALL TO $ABRT IS MADE. WHAT THIS * DOES IS TO ALLOW THE SYSTEM TO RECOVER FROM A * CPU FAILURE. * * HINT ! SAVE WHAT YOUR DOING BECAUSE THE SYSTEM * (CPU) IS IN TROUBLE !!! * * NOTE THE FRIENDLINESS, THE OP SYSTEM IS ACTUALLY * PROTECTING THE USER FROM HIS OWN CPU !!!!! * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) * $ERMG JMP EXINT FIRST ENTRY BY JMP GOES TO INIT STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * $USER NOP RESERVE SPACE FOR USER HANDLING OF ERRORS NOP RESERVE SPACE FOR USER HANDLING OF ERRORS * LDB XEQT GET ID ADDR OF PROGRAM TO ABORT SZB IS THERE ANYBODY TO ABORT ? ADB D8 YES, SO GET POINT OF SUSPENSION ADDRESS STB $SDSK AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME CPB D4 BUT IF THERE'S NOBODY TO ABORT LDB .INT. GET THE ADDRESS ERAB1 LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT JMP NOABT GO SET IT UP. * ERM CLA POINT OF SUSP = 0 IF $SDSK “Úþú = 0 LDA $SDSK,I GET ERROR LOCATION (DON'T USE XSUSP) JSB $CNV3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. CLE,INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * * * DOAB LDA XEQT NOW GO DO ABORT PROCESSING. SZA BUT BE CAREFUL THAT THERE IS JSB $ABRT REALY SOMEONE TO ABORT. * LDA IDLE WHEW ! THAT WAS A CLOSE ONE WE STA $IDLE ALMOST CRASHED !!!!!!!!! JMP $ERMG,I * IDLE DEF $IDLE-1 THIS IS THE ADDRESS OF THE ' JMP * ' D4 DEC 4 D8 DEC 8 C377 OCT 177400 * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * LDA XEQT IS THERE REALY SOMEONE TO ABORT ? SZA,RSS WELL ? JMP ERM NO !!!!! WOW, THAT WAS A CLOSE ONE !!!!!! CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ","DM","RE", JMP ERM "DP", OR "PE" ABORT ANYWAY) ADA RQRTN STA $SDSK,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * * DM6 DEC -6 * .INT. DEF *+1 PROCESSOR FAILURE ERROR CODE ASC 3, * * MSGA DEF *+1 * MSG DEC -18 EXINT STB $SDSK,I SET THE TWO SPECIAL ID-SEG. ADDS ASC 1, XOR 40 WHEN EXECUTED BLANK ASC 1, JMP $TRRN GO SET UP RN CODE IF ANY LDB B,I GET THE ADDR OF D.RTR'S ID-SEG. JMP $SCLK GO START THE CLOCK SPC 1 BSS 7+BLANK-* * A EQU 0 B EQU 1 HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRòfþúESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ+0 CODE 1 I/O READ DEF $IORQ+0 CODE 2 I/O WRITE DEF $IORQ+0 CODE 3 I/O CONTROL * DEF DISC1+0 CODE 4 DISC TRACK ALLOCATION DEF DISC2+0 CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1+0 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2+0 CODE 7 OPERATOR SUSPENSION * EXT $MPT3 DEF $MPT3+0 CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4+0 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5+0 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6+0 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7+0 CODE 12 TIME SELECTION * DEF $IORQ+0 CODE 13 I/O DEVICE STATUS * EXT $MPT9 DEF $MPT9+0 CODE 14 GET-PUT STRING * DEF DISCA+0 CODE 15 GLOBAL TRACK ASSIGNMENT DEF DISCB+0 CODE 16 GLOBAL TRACK RELEASE * DEF $IORQ+0 CODE 17 READ CLASS I/O DEF $IORQ+0 CODE 18 WRITE CLASS I/O DEF $IORQ+0 CODE 19 CONTROL CLASS I/O DEF $IORQ+0 CODE 20 WRITE-READ CLASS I/O * EXT $GTIO DEF $GTIO+0 CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8+0 CODE 22 SWAP/CORE USAGE REQUEST * DEF $MPT4+0 CODE 23 SCHEDULE WITH WAIT/WAIT * DEF $MPT5+0 CODE 24 SCHEDULE NO WAIT/WAIT DEF $PTST+0 CODE 25 PARTITION STATUS DEF PTSIZ+0 CODE 26 PARTITION SIZE * * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * Ë2þú AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS H3 2/3 (WRITE BUFFER) ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS L8 8/9 (SCHEDULE) ABS L2+L3+H8 10/11 (SCHED WWAIT),(TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5+H3 14/15 (G/S PRM.ST),(GL.ALC.PRM) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS L8 22/23 (SCHEDULE W WAIT/WAIT) ABS L3+L4+L5+H8 24/25 (SCHEDULE NO WAIT/WAIT),(PART.STATUS) ABS H5+H4+H3+H2 26/- (PARTITION SIZE INFO/---) SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * XIDEX EQU .-3 ADDRESS OF CURRENT ID EXTENSION XMATA EQU .-2 $MATA ADDRESS FOR CURRENT PROGRAM XI EQU .-1 X,Y SAVE ADDRESS EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 ¤ôNLH FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15 - WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS •˜NÿÿþúRQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BABKGSMUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # ¹¼  OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * PROGRAM LENGTH P END $RQST áB ÿÿ ÿý´0å ÿ92067-18020 1805 S C0122 &$TRN4 RTE-IV TRRN             H0101 c5þúASMB,R,L,C ** $TRRN RN-LU SYSTEM ROUTINES ** HED ** REAL-TIME EXECUTIVE $TRRN RN-LU SYSTEM ROUTINES ** * NAME: $TRRN * SOURCE: 92067-18020 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $TRN4,0 92067-16014 REV.1805 780104 * EXT $RNTB,$IDNO,$SCD3,$SCLK,$ULLU,$CGRN ENT $TRRN,$CRN#,$ULU * SUP A EQU 0 B EQU 1 * * * $TRRN IS THE RN/LU LOCK CLEAN UP ROUTINE. * IT IS CALLED BY THE DISPATCHER WHEN EVER A PROGRAM COMPLETES * (THE CALL IS BY WAY OF THE REENTRENT CLEAN UP ROUTINE. * * ITS FUNCTION IS TO RELEASE ANY LOCAL LOCKS AND ANY LOCAL * ALLOCATIONS THE PROGRAM HAS. IT ALSO RELEASES ANY LU * LOCKS THE PROGRAM HAS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JSB $TRRN * NORMAL RETURN REGISTERS MEANING LESS * * $TRRN JMP TEMP1 INITIALIZATION ON FIRST JMP HERE JSB $ULLU RELEASE ANY LU LOCKS / SET UP TEMPS LDA D$RN SET THE TABLE ADDRESS FOR STA TEMP1 BOTH LOOPS STA TEMP2 LDA A,I GET THE TABLE SIZE CMA,INA,SZA,RSS SET NEGATIVE / IF ZERO EXIT JMP $TRRN,I * STA TEMP3 SET LOOP COUNTERS STA RQP8 FOR BOTH LOOPS * TRRN1 ISZ TEMP2 DALLOCATE LOOP LDA TEMP2,I GET THE RN ALF,ALF PUT OWNER FLAG IN LOW A AND B377 MASK CPA RQP5 IF OWNED BY COMPLETING STA TEMP2,I PROGRAM FLAG FOR NEXT LOOP ISZ RQP8 STEP COUNTER JMP TRRN1 LOOP IF NOT DONE * TRRN3 ISZ TEMP1 ²uþúLOCAL LOCK LOOP LDA TEMP1,I GET THE RN AND B377 IF LOCAL LOCK CPA RQP5 TO COMPLETING PROGRAM JMP TRRN6 GO RELEASE THE LOCK * TRRN4 ISZ TEMP3 STEP COUNT JMP TRRN3 IF NOT DONE LOOP * LDB TEMP2 GET THE DEALLOCATE FLAG LDA D$RN AND THE ALLOCATE SUSPEND FLAG SZB,RSS IF ANY DEALLOCATED JSB $SCD3 SCHEDULE ANY WAITING PROGRAMS JMP $TRRN,I RETURN * TRRN6 XOR TEMP1,I CLEAR THE LOCK STA TEMP1,I FLAG AND RESET SZA,RSS IF DEALLOCATED STA TEMP2 SET FLAG FOR END OF LOOP JSB SRNW SCHEDULE ANY WAITERS FOR THIS RN JMP TRRN4 RETURN TO LOOP SKP * $CGRN IS THE CLEAR GLOBAL RN ROUTINE FOR USE BY DRIVERS * AND OTHER SUCH USER WRITTEN SYSTEM PROGRAMS * * CALLING SEQUENCE: * * LDA RN SET A TO USER RN WORD * JSB $CGRN CALL THIS ROUTINE * RETURN REGISTERS MEANING LESS. * $CRN# RBL,RBL SET DMS STATUS FOR OUR STB DMRTN RETURN STA B SAVE THE RN NUMBER AND B377 CACULATE THE TABLE ADA D$RN ADDRESS STA TEMP1 AND SET IT LDA B GET RN WORD AGAIN IOR B377 SET THE GLOBAL FLAG CPA TEMP1,I IS THIS A LEGAL RN? RSS YES SKIP JMP DONE NO RETURN NO ACTION AND C377 CLEAR THE RN STA TEMP1,I AND RESET IT JSB SRNW SCHEDULE ANY WAITING PROGRAMS DONE JRS DMRTN $CGRN,I RETURN TO CALLER SPC 3 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (TEMP1) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA TEMP1 GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN SKP * * THIS SUBROUTINE RELEASES ALL LU'S LOCKED BY A PROGRAM * AND SCHEDULES ANY PROGRAMS WAITING FOR AN * LU OR AN RN. * * CALLING SEQUENCE: * Ý«þú * LDB ID ADDRESS * JSB $ULLU * RETURN - REGISTERS MEANNINGLESS * $ULU RAL,RAL FIX STATUS FOR RETURN STA DMRTN AND SAVE JSB $IDNO GET THE ID NUMBER STB RQP5 SET FOR $TRRN BLF,BLF PUT THE FLAG WORD STB RQP6 IN HIGH END ADB RQP5 AND IN BOTH ENDS STB RQP7 SET IN RQP7 LDA LUMAX SET UP TO SCAN THE CMA,CLE,INA DRT STA TEMP2 * LDA DRT GET THE DRT ADDRESS STA TEMP3 AND SET FOR LOOP ULLU1 LDA TEMP3,I SEARCH FOR ALL AND B3700 LOCKED LU'S SZA THIS ONE LOCKED? JMP ULLU4 YES - GO TEST * ULLU2 ISZ TEMP3 NO / YES STEP TO NEXT ENTRY ISZ TEMP2 IF NOT DONE JMP ULLU1 TRY NEXT ONE * CLB,SEZ,RSS IF NONE RELEASED JMP RTNDM JUST EXIT * STB TEMP1,I CLEAR THE RN JSB SRNW SCHEDULE RN WAITERS LDA D$RN AND ALLOCATION JSB $SCD3 WAITERS RTNDM JRS DMRTN $ULLU,I RETURN * DMRTN NOP DMS STATUS WORD * ULLU4 CLB LSL 10 SHIFT LOCK FLAG TO LOW B ADB D$RN AND INDEX INTO THE RN TABLE LDA B,I GET THE RN FLAG CPA RQP7 CURRENT PROGRAM? CCE,RSS YES SKIP JMP ULLU2 NO CONTINUE SEARCH * STB TEMP1 YES SET ADDRESS FOR SCHEDULE LDA TEMP3,I GET THE DRT ENTRY AND C3700 CLEAR THE FLAG STA TEMP3,I RESET IT AND JMP ULLU2 CONTINUE SEARCH * D$RN DEF $RNTB B377 OCT 377 C377 OCT 177400 B3700 OCT 3700 C3700 OCT 174077 SPC 2 TEMP1 STA D$RN INITIALIZE CODE TEMP2 LDB B,I GET ADDRESS OF TEMP3 JMP $SCLK D.RTR AND GO START CLOCK * DRT EQU 1652B LUMAX EQU 1653B RQP5 EQU 1704B RQP6 EQU 1705B RQP7 EQU 1706B RQP8 EQU 1707B * ORG * PROGRAM LENGTH END $TRRN K¡ÿÿ ÿýµ¾ ÿ92067-18021 1926 S 0722 RTE-IV SCHEDULAR              H0107 jþúASMB,R,Q,C ** RT SCHEDULER MODULE ** HED RTE SCHEDULER/MESSAGE PROCESSOR * NAME: SCHED * SOURCE: 92067-18021 * RELOC: 92067-16021 * PGMR: G.A.A.,L.W.A.,D.L.S.,C.M.M. * DATA: 1/1/78 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SCHD4,0 92067-16014 REV.1926 790506 * SUP PRESS EXTRANIOUS LISTING ******************************************************************* * HISTORY * * *G.A.A. RTE 2 VERSION JULY 1973 *L.W.A. RTE 3 VERSION APRIL 1975 *D.L.S. ENHANCEMENTS MAY 1977 *C.M.M. RTE 4 VERSION JAN 1978 * ******************************************************************* * * SCHED ENTRY POINT NAMES * ENT $ABRT,$TYPE,$PRSE,$CNV1,$CNV3,$OP ENT $MPT1,$MPT2,$MPT3,$MPT4,$MPT5,$MPT6 ENT $STRT,$INER,$MPT7,$ASTM,$WATR,$SZIT ENT $MPT8,$IDSM,$PBUF ENT $MPT9,$RTST,$CVWD,$STRG ENT $MSEX,$LSTM ENT $LST,$SCD,$ID#,$MSG,$SCXX * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG,$DREQ EXT $DLP,$PLP,$MPFT,$MEU EXT $CMST,$COML,$SDA,$SDT2,$RLB,$RLN EXT $MPSA,$MPS2,$IDEX EXT $IOCL,$OTRL,$DREL,$CHTO,$LUPR,$EQST EXT $MESS,$LIST,$IDNO,$SCD3,$CNFG EXT $ERAB,$ZZZZ,$TIME,$PVCN,$MNP EXT $ERIN,$NOPG,$OPER,$ILST,$NOLG,$LGBS,$NMEM EXT $XEQ,$TMRQ,$ONTM,$ALC,$RTN,$WORK EXT $BRED,$TIMR,$ETTM,$TIMV,$TREM EXT $RNTB,$CREL,$SYMG,$SDRL EXT $ALDM,$DMAL,$MATA,$PRCN EXT $MBGP,$MRTP,$MCHN,$MAXP ALDM EQU $ALDM DMAL EQU $DMAL PRCNG EQU $PRCN * * ******************pþú*MEU INSTRUCTIONS*********** ********************************************** EXT $BLLO,$BLUP * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* HED --BUFFERS, CONSTANTS, POINTERS, ETC * TEMP LDA EQT11 ***TEMPORARY WORKING STORAGE AREA TEMP1 STA TEMP5 * TEMP2 LDB EQT12 * TEMP3 STB TEMP6 * TEMP4 JSB $RTN * THESE TEMPS ARE USED TO INITIALIZE TEMP5 NOP *** SYSTEM AVAILABLE MEMORY. TEMP6 NOP * AND ALSO TMP JMP $ALC * USED BY $PARS AS CONTIGUOUS BUFFER SPACE NOP ?? WORK EQU $WORK WPRIO NOP * ASCI BSS 1 * ASCI1 BSS 1 *** ASCI2 BSS 1 DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D14 DEC 14 D15 DEC 15 D17 DEC 17 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B177 OCT 177 B377 OCT 377 * ZERO REP 5 NOP DEF0 DEF ZERO * * RETRN NOP DMST NOP DMM5 DEC -5 D22 DEC 22 NWCNT NOP HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ‚Òþú ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ¹þú ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 29 ID EXTENSION # (15-10) EMA SIZE (9-0) * ! ! ! ! ! ! * 30 HIGH MAIN + LARGEST SEGMENT + 1 ( = 0 IF NO SEGMENT) * ! ! ! ! ! ! * 31 SESSION MONITOR WORD 1 * ! ! ! ! ! ! * 32 SESSION MONITOR WORD 2 * ! ! ! ! ! ! * 33 SESSION MONITOR WORD 3 * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SPC 5 * <<<<<<<<<>>>>>>>> SPC 5 * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * 1 NS / CURRENT MSEG # / # PAGES MSEG * ! ! ! ! ! ! * 2 MSEG STRT PAGE #/DE/ EMA START PAGE PHYSICAL * ! ! ! ! ! ! * 3 /# OF TRACKS FOR EMA SWAP * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 SKP * WHERE THE FLAG BITS MEAN: * * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A =Îþú ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * NS = 0/1 MSEG POINTING TO STD SEGMENT(SET BY .EMAP) / * MSEG POINTING TO NON STD SEG (SET BY .EMIO)/ * DE = SET IF EMA SIZE WAS DEFAULTED * * * $LIST STATE TRANSITION TABLE: * * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * * 0- OP SUSPEND BIT IS A DEFERRED ACTION BIT. SUSPEND ON NEXT SCHEDULE * ATTEMPT. CAN'T DO IT NOW BECAUSE PROGRAM IS OP SUSPENDED OR * IN THE TIME LIST. * * W- WAIT BIT (EXEC 9 & 23) THIS PROGRAM SCHEDULED ANOTHER WITH WAIT. * ID ADDRESS OF PERSON HE SCHEDULED IS IN 2ND OF WORD OF ID. * * R- SAVE RESOURCES WHEN SETTING DORMANT. NOT LEFT IN ID SEG AFTER * PROG IS SET DORMANT. * * D- DORMANT BIT IS A DEFERRED ACTION BIT. IT MEANS TO SET THE * PROGRAM DORMANT ON THE NEXT SCHEDULE ATTEMPT. WE CAN'T DO IT * NOW BECAUSE HE IS I/O SUSPENDED. * * * * *  þú THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. * * ONE FINAL NOTE TO THE UNWARY. THE CODE OF THE LIST PROCESSOR * IN NO WAY FOLLOW THE CHART BELOW. THE CHART IS TO GIVE THE * READER AN IDEA OF WHAT THE FOREST LOOKS LIKE NOT THE TREES. * DON'T MAKE THE MISTAKE OF THINKING THAT THE CHART SHOWS HOW * ANYTHING IS DONE. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X DŠþú 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O 16.0 X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *-------°"þú--!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE & B = PROG ID ADDRESS * IF A NOT= 0, THE A = ASCII ERROR CODE ADDRESS * & B CONTAINS DECIMAL ERROR CODE * * * ADDRESS CODES OF 0, 6, & 7 ARE RESERVED FOR * DRIVERS. THE ONLY FUNCTION CODE ALLOWED WITH * THESE ADDRESS CODES IS 1 (SCHEDULE) * IF SUCCESSFUL A = 0 ELSE * B = 3 ILLEGAL STATUS * B = 5 NO SUCH PROG * * FOR A DRIVER THAT WANTS TO CONVERT A PROG NAME * TO AN ID ADDRESS : JSB $LIST * OCT 217 * DEF PNAME (PROG NAME) * * THIS PERFORMS A SIMPLE LIST MOVE LIKE CHANGES TO PRIORITY. * (IF THE PROGRAM IS DORMANT ITS A BIG NOP ). UPON * A SUCCESSFUL RETURN (A = 0) B WILL BE THE ID ADDRESS * OF THE PROGRAM. IF THE PROGRAM IS SCHEDULED MANY TIMES * DOING THIS REMOVES THE SEARCH TIME FOR THE ID SEG OF * THE PROGRAM. * * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMO²JþúRY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * ADDRESS CODE * 0 = ID SEGMENT ADDRESS(5 PARAMETERS PASSED) * 1 = ID SEGMENT ADDRESS(AS NEXT OCT VALUE) * 2 = ASCII PROGRAM NAME ADDRESS(A DEF) * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEGMENT ADDRESS (NEXT PRAM IS VALUE TO * PUT INTO B REG @ SUSP) * 7 = ASCII PROG NAME (PASSES 5 PARAMETERS) * * * * FOR EXAMPLE * * ---0,7,& 6 (FOR DRIVERS)------- ---1---- ---2---- ----3----- * - - - - - - - - * * JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST * OCT 001 OCT 701 OCT 601 OCT 1XX OCT 2XX OCT 3XX * DEF RETRN DEF RETRN OCT IDADR OCT IDADR DEF PNAME ID ADR IN $WORK * OCT IDADR DEF PNAME OCT BVAL * DEF PRAM1 DEF PRAM1 * DEF PRAM2 DEF PRAM2 * DEF PRAM3 DEF PRAM3 (NO INDIRECT DEFS !!) * DEF PRAM4 DEF PRAM4 * DEF PRAM5 DEF PRAM5 * * * * ---4----- ------5-------- * - - - - * * JSB $LIST JSB $LIST * OCT 4XX OCT 5XX * ID ADR IN B REG ID ADR IN XEQT * * * * * SKP * * ************** WATCH THE E REGISTER ****************** * * * ENTRY MADE BY $LIST NOP * RSA * SJP $LIST * * $LST RAL,RAL ROTATE THE DMS STATUS AND SAVE STA DMST NOW PUT DMS STATUS IN E-REGISTER RAL,ELA E = 0/1 CALLŸ/þú CAME FROM SYS/USER MAP * LDA $LIST GET ADDRESS OF CALL STA $LSTM SAVE FOR CRASH DUMP ANALIZER ( HOPE WE * NEVER USE IT !!!!!!) SEZ (E= 0/1 CAME FROM SYS/USER MAP) JMP UMAP1 CALL CAME FROM THE USER MAP ! * LDA $LIST,I CALL FROM SAME MAP (SYSTEM MAP) AND D15 PUT FUTURE STATUS INTO L0091 STA L0091 STORE AWAY FUNCTION CODE XOR $LIST,I FORM ADDR CODE * LIST1 ALF,ALF AND PUT INTO LOW END RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD * SEZ WHICH MAP ? JMP UMAP2 USER MAP (ALTERNATE MAP) * LDB $LIST,I THIS MAP SO GET IT TO B LIST2 CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP * CPA D2 DOES B POINT TO AN ASCII NAME ? JMP DL02 YES SO SEE IF THE PROGRAM EXISTS CPA D6 JMP DL06 * STB RETRN B MUST BE A RETURN ADDRESS ISZ $LIST BUMP TO THE PROGRAM ADDRESS OR NAME LDB $LIST AND SAVE AS A POINTER STB TEMP1 FOR PARAMETER PASSING LDB RETRN GET THE RETURN ADDRESS CMB,INB DECREMENT WITHOUT AFFECTING E-REG CMB STB $LIST THIS THEN SETS UP RETURN ADDRESS * SEZ WHICH MAP JMP UMAP3 STILL THE USER MAP LDB TEMP1,I GET THE ID ADDRESS OR PROG NAME ADDR * LIST3 CPA D7 ASCII PROGRAM NAME ? JMP DL07 YES SZA,RSS ID ADDRESS JMP DL00 YES * * * L0075 LDA $ILST ILLEGAL STATUS MESSAGE LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 * SPC 6 * * * * UMAP1 XLA $LIST,I GET 7tþúTHE REQUEST CODE AND D15 SAVE LOWER BITS STA L0091 SOCK IT AWAY AS FUTURE STATE OF PROGRAM XLA $LIST,I GET IT AGAIN XOR L0091 NOW GET THE UPPER BITS JMP LIST1 NOW GO SEE WHAT TYPE CALL * * UMAP2 XLB $LIST,I GET POSSIBLE ID ADDRESS JMP LIST2 AND CONTINUE * * UMAP3 XLB TEMP1,I GET ID ADDRESS OF PROGRAM NAME ADDRESS & JMP LIST3 CONTINUE HED LIST PROCESSOR--REQUEST CODE DETERMINATION * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * DL02 SEZ IS NAME IN THIS MAP JSB PLNAM NO, SO PULL IT IN LOCALLY JSB TNAME NOW ID ADDR IN B REG SEZ,RSS SKIP IF NOT FOUND OR SHORT ID JMP L0021 GO SET UP WORK ADDRESSES * NPRG LDA $NOPG GET THE NO SUCH PROG ADDRESS LDB D5 AND THE NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * L0060 LDB WORK GET ID SEGMENT ADDRESS L0021 JSB DORM? GO SET UP WORK ADDRESSES * LDB L0091 GET THE REQUEST CODE SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE SPC 3 HED LIST PROCESSOR--DRIVER SERVICING SECTION. * * THIS PROCESSES LIST CALLS OF 0, 6, & 7. THESE ARE RESERVED * FOR DRIVERS. THE OPERATING SYSTEM MAKES THE ASSUMPTION * THAT IF YOU KNOW HOW TO CALL $LIST YOU KNOW WHAT YOUR * DOING. IN ADDITION, IF A DRIVER WANTS A PROGRAM IT WANTS * IT IN A HURRY. THUS $LIST DOES MINIMAL ERROR CHECKING FOR * DRIVERS (AND NONE FOR THE OP SYSTEM). HERE A CHECK IS MADE * ONLY TO SEE IF THE PROGRAM IS DORMANT (ALSO IF THE PROGRAM * EXISTS IF THE CALL WAS BY NAME RATHER THAN BY ID ADDRESS). * NO SIZE yþúCHECKS OR EMPTY ID CHECKS ARE MADE. IF YOUR KNOW * ENOUGH TO CALL $LIST, YOU KNOW ENOUGH TO MAKE SURE THE * PROGRAM EXISTS AND THAT THERE IS A PARTITION TO RUN IT IN. * THE REAL ADVANTAGE TO THIS PHILOSOPHY IS THAT DRIVERS ARE * GIVEN OP SYSTEM STATUS AND THEREFOR OP SYSTEM SPEED IN * PROGRAM SCHEDULING. THE SYSTEM WILL SCHEDULE THE PROGRAM AS * FAST AS IT POSSIBLY CAN. * HINT. IF YOUR SCHEDULING DISC RESIDENT PROGRAMS, HAVE THEM * TERMINATE SAVING RESOURCES OR SERIALLY REUSABLE. IT WILL * SAVE LOTS OF DISC TIME. * * * * DL07 SEZ WELL WHICH MAP IS IT IN ? JSB PLNAM ALTERNATE MAP, SO PULL IN LOCALLY JSB TNAME GET THE ID ADDRESS SEZ DID THE PROGRAM EXIST ? JMP NPRG NO, SO TELL THE FOLKES * DL00 JSB DORM? SET UP THE $LIST PRAMS & SEE IF DORMANT SZA PROG DORMANT ? JMP L0075 NO, TELL THE DRIVER TO FORGET IT JSB PRAMX GO PICK UP THE PARAMETERS JMP L0275 GO SCHEDULE THE PROGRAM * DL06 ISZ $LIST BUMP TO FUTURE B-REG @ SUSP(SETS RETURN ADDR) SEZ WHICH MAP ? JMP DL061 THE OTHER ONE. * LDA $LIST,I GEY THE B REG @ SUSP DL062 STA TEMPX AND SAVE TEMPORARIALLY JSB DORM? SET UP LIST PARAMETERS & CHK FOR DORMANT SZA PROG DORMANT ? JMP L0075 TELL DRIVER TO FORGET IT. LDB WORK GET THE ID ADDRESS ADB D10 AND INDEX TO THE B REG @ SUSP WORD LDA TEMPX GET THE VALUE STA B,I AND PUT IT IN THE ID SEG JMP L0275 NOW GO SCHEDULE THE PROGRAM * DL061 XLA $LIST,I GET THE B REG AT SUSP VALUE JMP DL062 CONTINUE * * SKP * HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * 4tNLH IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT _‹Nÿÿþú CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * IOR WSTAT,I MERGE THE CURRENT STATUS AND CL.NP CLEAR NO PARMS BIT L0105 STA WSTAT,I RESET THE NEW STATUS JMP L0014 GO TO EXIT * L0115 LDA WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 (CLEAR 5 TEMP WORDS TO 0) JSB PRAM LDB WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED ADB D6 INDEX TO TYPE WORD LDA B,I AND CLEAR AND NCLAM THE CORE LOCK AND ALL OF MEMORY STA B,I BITS CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN LDB WORK RETURN THE ID ADDRESS L0015 ISZ $LIST STEP TO RETURN ADDRESS JRS DMST $LIST,I LOOK MA ! NO LABEL !! SPC 1 SPC 1 L0350 SLB,RSS IF RESOURCE BIT NOT SET JMP L0115 GO MAKE DORMANT CPA D6 IF OPERATOR SUSPENDED JMP L0103 GO SET DORMANT BIT TOO. * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR THE "R" AND "D" BITS LDB WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 $LSTM NOP DON'T MOVE OR REARRANGE THESE THREE L0090 NOP WORDS. CRASH DUMP ANALIZER USES THEM. L0091 NOP SPC 1 NCLAM OCT 177637 CL.NP OCT 157777 HED LIST PROCESSOR--SCHEDULE REQUEST * * SCHEDULE REQUEST * * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT LÔþúADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND * REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD * SZA IF DORMANT OR CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 RBL DORM BIT TO 15 L0271 CLA,INA SET A FOR SCHEDULE SSB IF DORM BIT SET JMP L0100 GO SET DORMANT * * CHECK FOR SERIALLY REUSABLE OR SAVE RESOURCES * OR OP SUSPEND TERMINATION LAST TIME THROUGH . * * LDB L0090 GET THE CURRENT STATUS SZB IF 0 CPB D6 OR 6 RSS THEN CHECK ON THE PROGS LAST PARTITION JMP L0130 ELSE GO SCHEDULE THE PROGRAM * L0275 LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I GET THE TYPE AND D15 ONLY CPA D1 NOW IF ITS MEMORY RES, THEN NO PARTITION JMP L0130 SO, WE JUST SCHEDULE * ADB D7 MUST BE 1ST DISPATCH & DISC RES LDA B,I GET THE PARTITION WORD AND B77 AND USE IT TO INDEX INTO THE MPY D7 $MATA TABLE ADA $MATA ADA D3 GET TO THE D BIT WORD LDA A,I AND PULL IT IN AND B20K MASK IT SZA,RSS IS IT SET ? JMP L0290 NO, SO GO SCHEDULE * LDA WORK GET THE ID ADDRESS TP 1 JSB DMAL AND SEE IF HE IS STILL IN THE PARTITION. * L0ónþú290 CLA,INA SET FOR SCHEDULE JMP L0130 AND DO IT TO IT !!! * * * * * L0220 RBL,SLB CHECK RESOURCE BIT JMP L0230 IF SET GO CLEAR OP-SUSP SSB IF DORM BIT SET JMP L0271 GO MAKE DORMANT * L0230 XOR B1006 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, GO SCHEDULE. * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT, THEN ENTER INTO OPERATOR SUSPEND LIST * IF ALREADY OPERATOR SUSPEND, THEN STATUS ERROR EXIT * IF SCHEDULED, THEN ENTER INTO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, THEN OPERATOR-SUSPEND BIT SET * L0300 CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * CCE,SZA IF DORM WITH RESOURCES SKIP JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * ELA,ELA IF DORM BUT IN TIME LIST ADA WSTAT LDA A,I AND B10K THEN SET O BIT SZA IN TIME LIST ? JMP L0310 YES * LDB WSTAT,I GET FULL STATUS WORD SZB,RSS ENTIRE STATUS WORD = 0 ? JMP L0075 YES, ITS AN ERROR * LDA B306 ELSE SET "R" AND "D" BITS AND IOR B PUT IN OP-SUSP LIST JMP L0130 * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS IOR WSTAT,I JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SyþúUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B306 OCT 306 B1006 OCT 1006 CLD.R OCT 57460 D21 DEC 21 SKP * * THE PLNAM SUBROUTINE PULLS THREE WORDS OUT OF THE ALTERNATE * MAP (ASCII PROGRAM NAME). THE ROUTINE IS TYPICALLY CALLED * DIRECTLY BEFORE TNAME SO THAT THE PROGRAM NAME IS LOCAL AND * THE ID SEGMENTS CAN BE SEARCHED. * * * CALLING SEQUENCE LDB ADDRESS OF THREE WORD ARRAY * JSB PLNAM * * ON RETURN B = LOCAL ADDRESS OF ARRAY * A = DESTROYED * * PLNAM NOP XLA B,I GET THE 1ST ONE STA PNAME AND SAVE IT INB DO THIS TWO MORE TIMES XLA B,I STA PNAME+1 INB XLA B,I STA PNAME+2 LDB DPNAM JMP PLNAM,I * DPNAM DEF PNAME PNAME BSS 3 DON'T REARRANGE THESE WORDS OR MOVE THEM TEMPX NOP I NEED THEM LATER FOR CONTIGIOUS SPACE TEMPY NOP IN THE PRAMX ROUTINE TEMPZ NOP * * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR FOR * ALL CALLS IT'S PRIMARY FUNCTION IN LIFE IS TO SET UP * WORK, WPRIO, WSTAT, AND L0090. IN ADDITION IT RETURNS * L0090, THE PROGRAMS CURRENT STATUS IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6, AND 7 (THE DRIVER $LIST * CALLS) USE THIS TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE LDB ID ADDRESS * JSB DORM? * ON RETURN A-REG = CURRENT STATUS 0-6 * * DORM? NOP STB iþú$WORK SET UP THE ID ADDRESS FOR LATER ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD LDA B,I GET THE OLD STATUS AND D15 KEEP ONLY STATUS STA L0090 SET UP THE STATUS WORDTATUS JMP DORM?,I RETURN TO THE CALLER HED SET UP ID SEGMENT TEMP PARAMETERS * * * THE PRAMX SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ADDRESS CODES OF 0 & 7. THESE ADDRESS CODES * HAVE BEEN RESERVED FOR DRIVERS WHO WISH TO SCHEDULE * PROGRAMS. THE SUBROUTINE CALLS EITHOR THE PRAM OR * XPRAM SUBROUTINE TO STUFF THE PARAMETERS INTO THE PROGRAMS * ID SEGMENT TEMP AREA. PRAM IS CALLED IF THE DRIVER CALLED * $LIST FROM THE SYSTEM MAP, XPRAM IS CALLED IF THE DRIVER * IS IN THE SYSTEM MAP. * ACTUALLY PRAMX IS ONLY CALLED ONCE & THUS NEED NOT BE A * SUBROUTINE. HOWEVER, FOR THOSE WHO MUST READ THIS CODE * IT HELPS SEPERATE THE LIST MOVE PROBLEM FROM THE PARAMETER * MOVE PROBLEM AND MAKES THE CODE MUCH EASIER TO READ & * UNDERSTAND. * * * CALLING SEQUENCE JSB PRAMX * * $WORK HAS PROG ID ADDRESS * DMST HAS THE DMS STATUS IN IT * TEMP1 POINTS TO THE WORD BEFORE THE PARAMETER LIST * RETRN HAS RETURN ADDRESS OF THE LIST CALL * * RESTRICTIONS - ASSUMPTIONS * 1) DEFS IN THE $LIST CALL MUST BE DIRECT * (NEED NOT APPLY IF DRIVER IN SYSTEM MAP) * 2) AT LEAST ONE PARAMETER MUST BE SUPPLIED (IE 1 DEF) * 3) RETURN ADDRESS MUST DELIMIT PARAMETER LIST. * 4) 5 PARAMETERS MAX * * PRAMX NOP ISZ TEMP1 BUMP $LIST TO POINT TO 1ST PRAM LDB RETRN GET RETURN ADDRESS CMB,INB AND USE THIS TO ADB TEMP1 SEE HOW MANY PARAMETERS TO PASS STB DM5 SAVE TO FAKE OUT PRAM OR XPRAM * LDA DMST NOW GET THE DMS STATUS RAL,ELA E = 1 MEANS CALL FROM USER MAP SEZ,RSS WELL, WHICH MAP ? JMP PRMEX SYS MAP , SO GO STUFF THE PRAMETERS * øJþú CMB,INB USER, SO PULL ADDRESSES IN LOCALLY CBX PUT # IN X LDA TEMP1 GET SOURCE LDB DPNAM AND DESTINATION MWF AND BRING EM IN. * LDA WORK NOW GET THE PROGRAMS ID ADDRESS LDB DPNAM AND THE LOCAL ADDRESS ADB SIGN MAKE IT ADDRESS INDIRECT JSB XPRAM AND GO STUFF THE ID SEGMENT JMP PRMX3 NOW GO RETURN * PRMEX LDA WORK ID ADDRESS TO A LDB TEMP1 ADDRESS OF PARAMETERS TO B ADB SIGN SET THE SIGN BIT TOO JSB PRAM GO STUFF THE ID SEGMENT * PRMX3 LDA DMM5 GET A -5 BACK TO STA DM5 LOCATIOM DM5 SO THAT THE OTHER PROCESSORS JMP PRAMX,I ARE HAPPY. - RETURN TO CALLER - * * * * SES#3 IS A SUBROUTINE WHICH RETURNS THE ADDRESS OF * SESSION WORD # 3 IN THE REFERENCED PROGRAM'S ID * SEGMENT. * * CALLING SEQUENCE : LDB ID ADDRESS * JSB SES#3 * * ON RETURN B = SESSION WORD #3 ADDRESS * A = PROGRAM TYPE * * SES#3 NOP ADB D14 INDEX TO TYPE LDA B,I PULL IT IN AND D7 KEEP ONLY TYPE CPA D1 IS IT MEMOR RESIDENT ? ADB DM4 YES, RESET SESSION WORD POINTER ADB D18 SET TO SESSION WORD # 3 JMP SES#3,I RETURN * D18 DEC 18 * * HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR SECTION OF THE HP-21XX REAL TIME * EXECUTIVE * 1. REMOVES A PROGRAM FROM A LIST * AND * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGî5þúRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LINK,I FORGET IT ????????????????????????????? CPB WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION.Xlþú * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA WORK,I LINK THIS TO FOLLOW WORK LDA WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS WSTAT NOP WORK STATUS ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * * 1. TURN ON A PROGRAM * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,ítþúMN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A SLOT OR DEVICE DOWN. * DN,N1 * DN,,N2 * 11. SET A SLOT AND DEVICES UP * UP,NN * 12. LOGICAL UNIT SWITCH AND STATUS * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 * 23. SIZE REQUEST/CHANGE * SZ,XXXXX * SZ,XXXXX,P1 * SZ,XXXXX,P1,P2 * 24. ASSIGN PROGRAM TO PARTITION * AS,XXXXX,N * 25 UNRESERVE A PARTITION * UN, N * * * * SPC 3 * IN GENERAL THERE ARE TWO CLASSES OF COMMANDS. THOSE THAT PERFORM * A SERVICE IN WHICH SPEED IS OF IMPORTANCE (RU, ON, OF ETC) AND * AND THOSE COMMANDS WHICH GIVE STATUS INFORMATION OR WHICH MUST * BE ENTERED BEFORE A PROGRAM IS RUN. IN THE FORMER CASE A CONSIDERABLE * AMOUNT OF EFFORT IS SPENT EXECUTING THE COMMAND AS FAST AS POSSIBLE. * IN THE LATER CASE EFFORT IS SPENT IN MAKING THE CODE AS SMALL AS * POSSIBLE SO AS TO SAVE ROOM. * * HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIέþúS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * MESS MUST KEEP TRACK OF WHICH MAP THE CALLER CAME IN FROM * IF THE ENTRY TO $MESS IS FROM THE SYSTEM MAP THEN THE CALL * WAS FROM THE $TYPE ROUTINE. IF FROM THE USER MAP THEN THE * CALL IS FROM THE SYSTEM LIBRARY ROUTINE MESSS. (PRMPT & * R$PN$ THING) * IF FROM $TYPE, THEN INPUT BUFFER = INBUF * OUTPUT BUFFER = INBUF * IF FROM MESSS, THEN INPUT BUFFER PULLED IN LOCALLY TO * IBUFX * OUTPUT BUFFER = THE PROCESSOR'S BUFFER * GENERALLY SHARED W/PARSE * BUFFER. * * * ENTRY MADE BY $MESS NOP * SSM $MEU * SJP $MSG * * $MSG STA BFADD SAVE INPUT BUF ADDRESS FOR STRING ROUTINE STB BFCNT SAVE COUNT FOR STRING ROUTINE TOO. STB NWCNT ONE MORE TIME. * LDA $MEU GET THE DMS STATUS RAL,RAL ROTATE THE STATUS FOR STA $MEU OUR RETURN TRIP * SSB IF NEG ITS AN ERROR JMP $INER SZB,RSS IF THE CHAR COUNT = 0 JMP M0150 JUST RETURN * RAL,ELA PUT DMS STATUS IN E REG (0/1 SYS USER) LDA BFADD GET THE BUFFER ADDRESS BACK AGAIN SEZ,RSS WELL, WHICH MAP ? JMP NMESS SYSTEM (SYSTEM CONSOLE) * INB CONVERT CHAR COUNT TO BRS WORD COUNT (DIVIDE BY 2) CBX SAVE WORD COUNT FOR MOVE * ADB DM41 NO×.þúW CHECK OUT WORD COUNT SSB GREATER THAN 22 WORDS ? JMP GTMES NO,SO PULL IT IN LOCALLY LDB D40 YES, SO ONLY PULL IN 22 WORDS ANYWAY CBX SAVE FOR MOVE RBL NOW CONVERT TO CHARACTERS FOR $PARS ROUTINE STB NWCNT * GTMES LDB IBUFX GET THE DESTINATION MWF AND MOVE THE WORDS * LDA IBUFX GET THE BUFFER ADDRESS LDB NWCNT AND THE LENGTH NMESS JSB $PRSE AND GO PARSE THE INPUT STRING BUFAD DEF PRAMS * * * HED MESSAGE PROCESSOR--OP REQUEST SEARCH * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. UNL IFN LST CPB DBUG **********DEBUG********** CLB,RSS **********DEBUG********** JMP M0030 **********DEBUG********** STB FLG **********DEBUG********** ENT $DDDT **********DEBUG********** $DDDT JSB $DDT **********DEBUG********** DEF $TYPE+2 **********DEBUG********** DBUG ASC 1,DB **********DEBUG********** EXT $DDT **********DEBUG********** UNL XIF LST M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT J|JþúUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX JRS $MEU $MESS,I RETURN AND RESTORE MEU STATUS MSEX EQU $MSEX D40 DEC 40 DM41 DEC -41 UNL IFZ BSS 7 MAKE RELEASED LISTING ALLIGN W/DBUG XIF LST * * * SKP * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 8,RTONOFSSGOSTPRIT $ASTM ASC 9,TMDNUPLUEQLSLGTOTI ASC 7,BRABRUBLSZASUR OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0070 RELEASE PROGRAM'S TRACKS DEF M0100 TURN ON DEF M0200 TURN OFF DEF M0300 OPERATOR SUSPEND DEF M0400 REMOVE OPERATOR SUSPEND DEF M0500 STATUS DEF M0650 PRIORITY CHANGE DEF M0600 INTERVAL TIME CHANGE DEF M0700 REAL TIME CLOCK INITIALIZATION DEF M0800 DN REQUEST DEF $IOUP UP REQUEST DEF M0850 LU REQUEST DEF M0900 EQ REQUEST DEF M0960 LS REQUEST DEF M0970 LG REQUEST DEF M0990 TO REQUEST DEF M0750 TI REQUEST DEF M0725 BR REQUEST DEF M0950 AB REQUEST DEF M0408 RU REQUEST DEF BLIM BL REQUEST DEF SIZE SZ REQUEST DEF ASIGN AS REQUEST DEF URESV UR REQUEST DEF OPER OPERATOR ERROR * ON EQU LDOPC+2 RU EQU LDOPC+20 OF EQU LDOPC+3 ST EQU LDOPC+6 * * HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PRSE * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * ÄNLH1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PRSE NOP CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. M’NÿÿþúCP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 CP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER * $OP EQU OP ENDT EQU * ********************************************************************** * HED SYSTEM START UP ROUTINE * * WHEN THE SYSTEM IS BOOTED UP A JMP 3,I IS MADE. * THE DESTINATION OF THE JUMP IS $STRT. THE CODE FROM HERE TO * OVCHK IS EXECUTED ONCE AT START UP AND LATER OVERLAYED FOR I/O * BUFFERS AND OTHER TEMPS NEEDEDBY THE SYSTEM. * * ORG IBUFY PUT INIT CODE IN BUFFER * * $STRT LIA 1 GET THE SWITCH REGISTER LIB 1 AND B70K KEEP TOP OCTAL DIGIT SZA,RSS = 0 ? JMP TOIT YES, NO HALT &NO DBUG XOR B GET RID OF THE BITS OTA 1 AND RESET THE SWTCH REGISTER XOR B GET THE BIT BACK ALF ROTATATE TO LOW END UNL * IFN LST CPA D7 IF = 7 & DDT IN SYS, THEN HALT RSS TO LET THEM SET SWITCH REGISTER JMP DOHLT AND THEN CALL $DDT ON THEIR BEHALF HLT 75B JSB $DDT DEF TOIT XIF UNL IFZ BSS 6 XIF LST * DOHLT CPA D6 HLT 76B TOIT JSB $SYMP SET UP THE SYSTEM MAP JSB $CNFG NOW GO DO RECONFIGURATION * LDA DM5 GET THE LOOP VARIABLE STA TEMP5 PREPARE TO CALL $ALC LDA DEQT1 TO RETURN BLOCKS OF MEMORY STA TEMP6 TO INITIALIZE SYSTEM AVAILABLE MEMORY MRTNL LDA TEMP6,I BLOCK ADDRESSES ARE IN PAIRS STA MADR1 EQT1 THRU EQT12 ISZ TEMP6 LDA TEMP6,iþúI STA NWDS1 ISZ TEMP6 JSB $RTN RETURN A BLOCK MADR1 NOP NWDS1 NOP ISZ TEMP5 DONE WITH EQT1 THRU EQT10? JMP MRTNL NO, RELEASE NEXT BLOCK JMP $ALC NEXT GO TO $ALC FOR CONFIGURATION * DEQT1 DEF EQT1 GOES TO GTFMG FROM $ALC VIA $WORK * GTFMG LDB TEMPH GET FMGR'S NAME ADDRESS JSB $ZZZZ GO TO DISPATCHER TO SET UP LDB TERM GET ADDRESS JSB TNAME OF D.RTR TO B SEZ,RSS IF NONE SKIP STB ID.RT SET FOR LATER. LDB P1OR2 LOOK UP EDIT'S ADDRESS JSB TNAME ALSO SEZ,RSS IF NONE SKIP STB ID.RT+1 SET IN LIST LDB TEMPH NOW FIND JSB TNAME FMGR'S ID-SEGMENT ADDRESS SEZ,RSS IF NONE SKIP STB IDFMG SET ADDRESS LDB DSMP JSB TNAME SEZ,RSS STB $IDSM * LDA IDFMG GET FMGR'S ID ADDRESS SZA,RSS ANY FMGR ? JMP NOFMG NO, SO FORGET ABOUT ANY CHECKS * STA WORK SET UP HIS ADDRESS IN $WORK JSB $SZIT SEE IF THERE'S A PART'N LARGE ENOUGH SZA WELL IS THERE ? JMP NGFMG NO, YOU BLEW THE RECONFIGURATION TURKEY !!!! * LDA ID.RT OK, SO YOU DID THAT RIGHT. BUT DID YOU SZA,RSS YOU GIVE D.RTR ENOUGH ROOM ? JMP NOFMG NO D.RTR HUH . * STA WORK SET UP FOR THE TEST JSB $SZIT SEE IF THERE IS ENOUGH ROOM SZA OK ? JMP NGFMG NO. * NOFMG LDA D$RN TRACK DOWN RN TABLE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT LDA A,I USE NEXT LEVEL * LDB IDADS GET ADDRESS OF ID ADDRESSES JMP $ERMG GO TO EXEC TO SET UP NO RETURN * NGFMG HLT 10B NO ROOM FOR FMGR, SO YOU LOSE !!!!!!! JMP *-1 YOU LOSE AGAIN ! * * * IDADS DEF ID.RT FMGR ASC 3,FMGR D.RTR ASC 3,D.RTR DSMP DEF *+1 ASC 3,SMP D$RN DEF $RNTB * $SYMP NOP LDA $DLP GET þúTHE LOAD POINT ALF AND GET THE # OF PAGES RAL,RAL STA $CMST * LDA $DLP GET IT AGAIN CMA,INA MAKE IT NEG ADA BKCOM ADD LENGTH & START OF COMMON LDB $MPFT ADB D3 ADA B,I * SZA,RSS ANY COMMON AT ALL ? JMP NCOMN NO AND B76K YES. SO GET PAGE BITS ALF TO LOW END RAL,RAL AND SAVE IT NCOMN STA $COML THIS IS THE LENGTH(IN PAGES) OF COMMON * ADA $CMST ADD IN START PAGE OF COMMON & STA $SDA WE HAVE THE START OF THE SYS DVR AREA * LDB $PLP GET THE PRIV LOAD POINT BLF GET PAGE # TO LOW END RBL,RBL CMA,INA SUBTRACT FROM START OF SYS DVR AREA ADA B TO GET LENGTH OF TB 1 & SYS DVR AREA STA $SDT2 * LDA LBORG NOW GET THE LIBRARY ORGIN ALF CONVERT TO PG # RAL,RAL STA $RLB AND SET AS START OF RES LIB * LDB $MPFT NOW INB GET START OF MEM RES AREA LDB B,I TO LOW END BLF RBL,RBL CMA,INA ADD IN START OF LIBRARY ADA B AND WE GET THE LENGTH STA $RLN OF THE RES LIBRARY * * SPC 1 * SET UP THE SYSTEM MAP AND RETURN SPC 1 * CLA START REGISTER 0 CLB START VALUE = 0 LDX $SDA SET EM UP TO START OF SYS DVR AREA XMS DO IT ! * ADB WRTPR NOW GET THE WRITE PROTECT STA TBL SAVE START REGISTER LDA $SDA GET START VALUE CMA,INA MAKE NEG TO GET # OF REGS ADA D32 LEFT TO SET UP CAX PUT IN X-REG LDA TBL RESTORE START REG XMS AND PLAY IT AGAIN SAM. * LDA $MPSA GET START PAGE SYS AV AND B1777 STA TBL B HAS START VALUE LDA EQT1 AND B1777 XOR EQT1 KEEP ONLY PAGE ºþú ALF RAL,RAL GET IN LOW 5 BITS STA NWDS1 START PAGE OF SAM LDA TBL XOR $MPSA GET LENGTH ALF RAL,RAL A HAS LENGTH CAX PUT IN XREG LDB TBL START PAGE NUMBER ADB WRTPR AND WRITE PROTECT LDA NWDS1 START REGISTER XMS LOAD MAP * * STA NWDS1 SAVE REGISTER # LDA $MPS2 GET THE 2ND CHUNK OF SAM AND B1777 SAVE THE PHY PG # LDB A PUT IN B ADB WRTPR AND SET UP WRITE PROTECT XOR $MPS2 NOW GET # OF PAGES ALF RAL,RAL TO LOW END CAX AND PUT INTO X AS # OF REGISTERS LDA NWDS1 GET START REG BACK AGAIN XMS AND DO IT SJP $SYMP,I SET UP SYSTEM MAP & RETURN TBL NOP *$MPSA-$MPS2 0-9 START PG SAM * 10 - 15 NUMBER PGS SAM WRTPR OCT 40000 B70K OCT 70000 B76K OCT 76000 * OVCHK EQU *-ENDT OVERLAY CHECK * HED MESSAGE PROCESSOR--IT,XXXXX COMMAND * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR LDA WORK SET ADA D17 UP THE TIME PRAMETER STA TEMPP STARTING ADDRESS. LDB P2 GET THE RESOLUTION ADB DM5 CODE AND TEST SSB,RSS FOR MORE THAN 4. JMP $INER GREATER THAN 4-ILLEGAL CODE LDA P3 GET THE MULT. FACTOR. LDB TEMPP,I GET THE OLD TIME PRAM. BLF,ERB Á°þú IF IN TIME LIST ALF,ERA SET BIT IN NEW WORD. LDB P2 GET RESOLUTION TO B SZB,RSS IF ZERO RESOLUTION JMP M0605 GO REMOVE FROM TIME LIST LSR 3 SHIFT THE WHOLE MESS TO A M0604 STA TEMPP,I SET NEW RESOLUTION MULT. ISZ TEMPP INCR TO TMS ADDRESS LDA P7 GET TENS OF MS. ADA DM100 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P6 GET SECONDS VALUE ADA DM60 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P5 GET MINUTES. ADA DM60 SSA,RSS YES, SO CONVERT TO DECIMAL JMP $INER INPUT ERROR LDA P4 GET HOURS ADA DM24 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA DP4 SET DEFS TO THE PRAMS STA RQP5 ON THE BASE LDA DP5 PAGE FOR STA RQP6 $ETTM LDA DP6 THE SET TIME STA RQP7 SUBROUTINE LDA DP7 IN THE STA RQP8 RTIME MODULE LDB TEMPP GET ID-SEG ADDRESS AND JSB $ETTM GO SET VALUES IN ID-SEG JMP M0150 EXIT $MESS SPC 2 M0605 CCB REMOVE PGM FROM TIME ADB TEMPP LIST JSB $TREM CLA AND CONTINUE JMP M0604 SETTING UP THE ID-SEG SPC 1 DM100 DEC -100 SPC 2 BLIM CLB,CCE,INB CHECK TO SEE IF EXAMINE CPB PARAM ONE PRAM? JMP BLIMP YES GO PRINT LIMITS * LDB P2 GET THE SECOND PRAMETER CMB,INB,SZB GET NEW UPPER LIMIT STB $BLUP IF ZERO SKIP THE STORE CMA,INA SET UP THE LOWER LIMIT STA $BLLO JMP M0150 GO EXIT DONE SPC 1 BLIMP LDA $BLLO GET THE LOWER LIMIT CMA,INA SET POSITIVE JSB $CNV1 CONVERT TO ASCII OCTAL STA BUFF3 SET LOW DIGITS DLD ASCI GET THE HIGH 4 DIGITS DST BUFF1 AND SET INÊèþú BUFFER LDA $BLUP GET THE UPPER LIMIT CMA,CCE,INA SET POSITIVE JSB $CNV1 CONVERT STA BUFF7 SET THE LOW DIGITS DLD ASCI GET THE HIGH DIGITS DST BUFF5 SET IN THE BUFFER LDA AASCI GET A DOUBLE BLANK STA BUFF4 SET BETWEEN THE NUMBERS LDA DM14 GET RECORD LENGTH STA BUFFR SET IN THE BUFFER AND JMP M0520 GO SEND THE MESSAGE SPC 1 HED MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR LDA P2 GET PRIORITY SSA,RSS SZA,RSS CHECK IF ZERO PRIORITY REQ JMP $INER ERROR-ILLEGAL VALUE LDB WORK ADB D6 STA B,I STORE NEW PRIORITY VALUE STA NPCNG SAVE NEW PRIORITY JSB $LIST RELINK THE PROGRAM OCT 317 BY NEW PRIORITY LDB NPCNG GET NEW PRIO LDA WORK GET ID ADR JSB PRCNG GO RELINK IN ALLOCATED LIST CLA JMP MSEX RETURN NPCNG BSS 1 SPC 5 * MESSAGE PROCESSOR -- TM COMMAND * M0700 LDB DEFP1 PASS PRAM. ADDRESS TO JMP $TMRQ RTIME PROCESSOR SPC 2 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM M0730 ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT HED MESSAGE PROCESSOR--TI COMMAND * * TI COMMAND * * THE REQUEST TO GET CURRENT SYSTEM TIME OUTPUTS CURRENT * YEAR, DAY NUMBER, HOUR, MINUTES, AND SECONDS IN THE * FOLLOWING FORMA§þúT: * YEAR.DAY..HR..MN..SC * WHERE THE .'S ARE BLANKS * M0750 LDA DM20 STA BUFFR SET OUTPUT CHARACTER COUNT LDA DTEMP SET UP TO GET THE TIME STA RQP2 TO TEMP AREA ADA D5 STA RQP3 DLD $TIME JSB $TIMV GO GET TIME JSB $CNV1 CONVERT YEARS STA BUFF2 SET LEAST TWO DIGITS LDA ASCI1 GET THE NEXT TWO DIGITS STA BUFF1 AND SET THEM LDA TEMP4 GET DAYS JSB $CNV1 CONVERT AND STORE DAYS STA BUFF4 SET LEAST TWO DIGITS LDA ASCI1 GET NEXT DIGIT STA BUFF3 SET IN BUFFER LDA AASCI STUFF NECESSARY WORDS WITH STA BUFF5 BLANKS STA BUFF7 STA BUFF9 LDA TEMP3 GET HOURS JSB $CNV1 CONVERT AND STORE HOURS STA BUFF6 LDA TEMP2 JSB $CNV1 CONVERT AND STORE MINUTES STA BUFF8 LDA TEMP1 JSB $CNV1 CONVERT AND STORE SECONDS STA BUF10 JMP M0520 GO SET A AND EXIT SPC 1 DM20 DEC -20 * * DN,N1 OR DN,,N2 * * THE REQUEST TO DOWN AN EQT OR LU WORKS AS FOLLOWS: * IF N1 IS GIVEN, DOWN THE EQT POINTED TO BY N1. * IF N2 IS GIVEN, DOWN THE LU POINTED TO BY N2. * M0800 CCE NO THIRD PARAMETER. JSB P1OR2 SET A=PARAMETER 1, B=PARAMETER 2. JMP $IODN GO TO 'DOWN' ROUTINE. HED MESSAGE PROCESOR--LU,EQ AND TO COMMANDS * * MESSAGE PROCESSOR --LU,N1,N2 COMMAND * * REQUEST OF LOGICAL UNIT ASSIGNMENT (N1 VALUE ONLY) OR * REQUEST LOGICAL UNIT REASSIGNMENT(N1 & N2 - OR * N1, N2 ,& N3 PRESENT) * M0850 CLE SET THE N3 POSSIBLE SWITCH JSB P1OR2 SET UP PARAMETERS JMP $LUPR * * SPC 1 SPC 1 * * MESSAGE PROCESSOR ---- EQ,N1,N2 COMMAND * * * REQUEST EQUIPMENT STATUS (N1 PARAMETER ONLY) * REQUEST EQUIPMENT BUFFERING OR NON BUFFERING (N1 & N2) * N2 = 0 FOR NO BUFFERING ˜ðþú * N2 = 1 FOR BUFFERING * M0900 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $EQST * * D29 DEC 29 D28 DEC 28 DM12 DEC -12 DM6 DEC -6 SPC 1 SPC 1 * MESSAGE PROCESSOR TO,N1,N2 COMMAND * * * REQUEST DEVICE TIME OUT PARAMETERS (N1 ONLY) * REQUEST TO ASSIGN DEVICE TIMEOUT (N1 & N2) * N1 = DEVICE EQT # * N2 = TIME OUT PARAMETER TO BE ASSIGNED * M0990 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $CHTO * * * * SKP P1OR2 DEF ABM ENTRY/EXIT LDA CP2 CHECK IF JUST SZA,RSS ONE PARAMETER JMP P1OR5 YES - GO EXIT LDA P2 GET SECOND PRAM. SEZ,RSS IS A THIRD PARAMETER POSSIBLE? JMP P1OR7 YES P1OR3 LDB A LOAD B WITH 'N2' OR 'N3:N2' P1OR4 LDA P1 LOAD A WITH N1 JMP P1OR2,I P1OR5 CCB SET B REG TO -1 FOR 1 PARAMETER JMP P1OR4 P1OR7 AND B377 SAVE BITS 7-0 STA P2 OF 'N2' LDA P3 GET 'N3' AND B37 KEEP BITS 4-0 AND LSL 11 MOVE THEM TO POSITIONS 15-11 ADA P2 ADD IN THE 'N2' PRAM JMP P1OR3 GO EXIT * B37 OCT 37 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP MSEX RETURN HED MESSAGE PROCESSOR -- AB COMMAND * * MESSAGE PROCESSOR -- AB COMMAND * * THE AB COMMAND ABORTS THE BATCH PROGRAM CURRENTLY * BEING EXECUTED * * IT TRACKS DOWN THE LOWEST LEVEL USING FMGR AS THE * FIRST LEVEL. IF FMGR IS NOT WAITING THEN IT'S BREAK * FLAG IS SET. IF FMGR IS DORMANT THE REQUEST IS ILLEGAL * IF D.RTR IS AT THE END OF THE LIST THEN THE * INVOLKING PROGRAM IS ABORTED OR, IF FMGR, THE BREAK FLAG * IS SET. * M0950 ALR,ALF KILL BIT 3 (NEVER =8) STA P2 SET THE OPTION FLAG LDB IDFMG GET FMGR'S ID-SEG.ãþú ADDRESS M0951 STB WORK AND SET UP WORK SZB IF NO FMGR SKIP ADB D15 INDEX TO STATUS LDA B,I GET STATUS AND D15 IF FMGR IS DORMANT SZA,RSS THEN JMP M0405 ILLEGAL STATUS EXIT * LDA B,I GET STATUS ALF,CLE,SLA IF WAITING JMP M0958 GO TRACK DOWN * M0955 LDB IDFMG GET FMGR'S ID-SEG ADDRESS CPB WORK IF SAME AS CURRENT JMP M0730 GO SET BREAK FLAG * JMP M0202 ABORT * M0958 LDB WORK GET CURRENT ID INB STEP TO WAIT PROGRAM LDB B,I GET ADDRESS CPB ID.RT IF D.RTR JMP M0955 GO DO PREVIOUS PGM. * CPB $IDSM IF SMP JMP M0955 GO TO PREV. JMP M0951 AND CONTINUE HED MESSAGE PROCESSOR - LS N1,N2 PROCESSOR * * SET "SOURCE FILE" IDENTIFICATION * * THE OPERATOR REQUEST IS: * "LS,LUN,1ST TRACK # " * THIS STATEMENT SETS THE SOURCE FILE CONTROL WORD * IN THE COMMUNICATION AREA IN THE FOLLOWING * FORMAT( THE WORD IS LABELED "SFCUN" ): * ******************************* * *LU* ST. TRACK #* ZERO * * ******************************* * 15,14 - 7,6 - 0 (BITS) * * THE LOGICAL UNIT # AND STARTING TRACK # ARE * RECORDED BY THE 'EDITOR' WHEN THE SOURCE FILE * IS CREATED. * * VALIDITY CHECKS ARE FOR LOGICAL UNIT = 2 OR 3, * HOWEVER, A LU = 0 WILL SET "SFCUN" = 0. * M0960 CLB IF PARAM 1 = 0, GO TO SZA,RSS JMP M0961 CLEAR "SFCUN" CLE,ERA SET E IF LU 3. CPA D1 IF NOT LU 2 OR THREE CPB CP2 OR P2 NOT SUPPLIED THEN TAKE JMP $INER ERROR EXIT. ERB SET SIGN OF B TO 1 IF LU 3. ADB P2 ADD THE TRACK AND ASL 7 NORMALIZE (I.E. PUT IN 14-07) * M0961 STB SFCUN SET "SFCUN" JMP M0150 GO EXIT * ID.RT NOP ID.ED NOP IDFMG NOP $IDSM JMP GTFMG START UP C1°þúODE HED MESSAGE PROCESSOR - LG,N COMMAND * * SET "LOAD-AND-GO" PARAMETERS * * THE OPERATOR STATEMENT IS: * "LG,# OF TRACKS" * * THIS STATEMENT ALLOWS THE OPERATOR TO: * 1. ALLOCATE A NUMBER OF CONTIGUOUS DISC * TRACKS FOR 'LOAD-AND-GO' USAGE. * 2. RELEASE TRACK(S) CURRENTLY ASSIGNED TO LGO. * * THIS REQUEST HAS NO EFFECT IF LGO CURRENTLY IN USE * * THE BASE PAGE COMMUNICATION AREA WORDS DESCRIBED * BELOW CONTAIN THE LGO TRACK ASSIGNMENTS: * * ******************************** * 'LGOTK' *LU* ST. TRACK # * # OF TRACKS * * ******************************** * 15,14---------07,06---------00 * * ******************************** * 'LGOC' *LU* TRACK # * SECTOR # * * ******************************** * 15,14---------07,06---------00 * * LGOTK DEFINES THE LU #, THE STARTING TRACK # * AND THE NUMBER OF CONTIGUOUS TRACKS. THIS * WORD IS ZERO IF NO TRACKS ARE ALLOCATED. * * LGOC DEFINES THE CURRENT AVAILABLE SECTOR. * THIS IS UPDATED BY 'RTIOC' AND RESET TO * THE BEGINNING OF THE AREA BY THE LOADER * AFTER LOADING FROM THE LGO AREA; ALSO BY * THIS ROUTINE WHEN THE TRACKS ARE ALLOCATED. * * M0970 AND B177 MAX. VALUE OF 127. STA P1 -SAVE P- SZA,RSS IF P = 0, GO TO JMP M0971 RELEASE LGO TRACK(S). CLA CHECK FOR CPA LGOTK CURRENT ASSIGNMENT. M0975 CLB,RSS -NONE JMP M0971 -RELEASE CURRENT * LDA P1 (A) = # OF TRACKS JSB $DREQ ALLOCATE TRACKS * SZB,RSS IF P TRACKS NOT JMP M0972 AVAILABLE, GO FOR DIAG. RETURN. * RBR SET SIGN OF B IF LU 3. ASL 16 MOVE THE TRACK UP ASL 7 TO BITS 14-07 OF B. STB LGOC SET LGOC. ADB P1 SET # OF TRACKS IN 06-00 STB LGOTK AND SET LGOTK. * JMP MSEX -RETURN- * M097Ô6þú1 CPA LGOTK JMP MSEX LDB LGOTK GET ASSIGNMENT WORD TO RELEASE. CLE,ELB SET E IF LU = 3 LSR 8 SET FIRST TRACK IN B ALF,ALF PUT # OF RAR TRACKS IN A CMA,SEZ,CLE,INA SET NEGATIVE,SKIP IF LU 2. ADB TATSD ADD SYSTEM DISC SIZE JSB $CREL GO RELEASE IF POSSIBLE SZB RELEASE OK? JMP M1973 NO SEND THE NASTY MESSAGE. STB LGOTK CLEAR 'LOAD-AND-GO' STB LGOC CONTROL WORDS. CPB P1 IF P = 0, JMP M0150 -RETURN- JMP M0975 GO TO ALLOCATE NEW TRACKS. * M0972 LDA $NOLG PRINT: NO LGO SPACE RSS M1973 LDA $LGBS PRINT: LGO IN USE JMP MSEX * HED MESSAGE PROCESSOR SIZE COMMAND * * * THE SIZE COMMAND COMES IN THREE FLAVORS * * 1) SZ,XXXXX PRINTS SIZE INFORMATION ON PROGRAM XXXXX * 2) SZ,XXXXX,P2 FOR NON EMA PROGRAMS, CHANGES MAX LOGICAL * ADDRESS SPACE OF XXXXX TO P2 PAGES. * FOR EMA PROGRAMS P2 BECOMES THE NEW * SIZE OF PROGRAM + EMA SIZE, IE, THE * NEW MINIMUM PARTITION SIZE OF THE PROG. * 3) SZ,XXXXX,P2,P3 THIS FORM IS FOR EMA PROGRAMS ONLY. P2 * IS AS DESCRIBED ABOVE. P3 IS THE NEW * MSEG SIZE. * * * TEMPS: TEMPY = # OF PAGES IN PROG (NO MSEG) + DYNAMIC BUFFER AREA * IF THE PROGRAM IS AN EMA PROGRAM * = NEG LOW MAIN ADDRESS IF PROG NOT EMA * * * SIZE LDA PARAM GET THE PARAMETER COUNT CPA D2 IS IT JUST 2 ? JMP SZRPT YES,SO REPORT THE SIZE INFO * JSB SZCHK NO, SO GO SEE IF MODS OK JSB $SZIT NOW GO GET ALL THE PARAMETERS LDB TEMPB,I *E SZB *E IS IT AN EMA PROG? JMP ESIZX YES * LDB WORK GET THE LOW MAIN ADDRESS ADB D22 LDA B,I ST#9þúA TEMPI SAVE IT FOR LATER CMA,INA MAKE NEG STA TEMPY AND SAVE ADB D7 NOW CALCULATE THE # OF WORDS IN ADA B,I IN THE PROGRAM CODE ADB DM6 CPA TEMPY PROG SEGMENTED ? ADA B,I NO. ADA B1777 ALLIGN TO PAGE ALF NOW, CONVERT TO # OF PAGES OF CODE. RAL,RAL AND B37 CMA MAKE NEG & ADD IN BASE PAGE ADA P2 NOW ADD NEW SIZE SPECIFIED SSA IS LOWER LIMIT CHECK OK ? JMP SZERR NO, SO ITS A SIZE ERROR * * WE ALREADY HAVE MAX PARTITION SIZE, BUT MIGHT BE GREATER * THAN MAX PROGRAM ADDRESS SPACE. LETS SEE. * LDA TEMPI GET THE LOW MAIN ADDRESS ALF GET PAGE # RAL,RAL ADA DM32 NOW SEE WHICH IS SMALLER LDB A SAVE IT CMB,INB BUT MAKE POSITIVE ADA TEMPA ADD IN LARGEST PARTITION SIZE SSA,RSS OF THE TWO KEEP THE SMALLEST STB TEMPA USE LOGICAL ADDRESS SPACE * * LDB P2 GET THE INPUT SIZE CMB,INB MAKE NEG ADB TEMPA ADD IN MAX SIZE INB SSB OK ? JMP SZERR NO ! SEND SIZE ERROR. * CCB NOW GO ADB P2 GET THE REQUESTED SIZE ESIZW BLF,BLF AND SHIFT UP RBL,RBL LDA TEMPC,I GET THE # OF PAGES WORD AND BPG# OUT GOES THE OLD ADA B IN GOES THE NEW * SSA,RSS IF PART'N ISN'T RESERVED, ZAP PART'N # AND B177K BECAUSE PROG MIGHT NOT RUN THERE ANTMORE STA TEMPC,I SOCK IT AWAY JMP M0150 AND RETURN * * B177K OCT 177700 SPC 2 * EMA PROGRAM CHECK SPC 2 * ESIZX LDA TEMPF GET THE MSEG SIZE CMA,INA SUBTRACT FROM PROG SIZE ADA TEMPI STA TEMPY TEMPY = PROG SIZE (NO MSEG) * LDB CP3 GET THE LAST PARAMETER SZB,RSS ANY SUPPLIED ? JMP ESFX1 ]6NLH NO, SO DON'T CHECK IT OUT CCB NOW CHECK MSEG SIZE ADB P3 SSB,INB MUST NOT BE LESS THAN 1 JMP $INER IT IS, SO FORGET IT * CLA,INA *E ADA TEMPE *E INDEX TO 2ND ID EXT WORD LDA A,I *E AND GET MSEG START PAGE ALF,RAL *E AND B37 *E GET VALUE FROM LOW 5 BITS CMA,INA *E SUBTRACT FROM 32 TO GET ADA D32 A = MAX MSEG SIZE CMB,INB B = - INPUT SIZE ADA B SSA WELL,IS IT OK OR NOT ? JMP SZERR NOT ! FLUSH HIM JMP ESFX3 IS. * ESFX1 LDA TEMPF USE OLD MSEG SIZE AS NEW. STA P3 * ESFX3 LDA CP2 WAS THIS PARAMETER SUPPLIED ? SZA,RSS WELL ? JMP ESFX2 NO LDA TEMPE GET ADDRESS OF ID EXTENSION INA LDA A,I INDEX TO DE BIT WORD ALF,RAL NOW IF THE DE BIT IS CLEAR SSA,RSS THEN CHANGE IS ILLEGAL JMP SZERR SO YOU LOSE ! * LDA P2 GET THE INPUT EMA SIZE SZA IF = 0 SSA OR IF < 0 fÕNÿÿþú JMP $INER ITS AN ERROR. * ADA TEMPY ADD # OF PAGES OF PROG (NO MSEG) CMA,INA NOW SEE IF PROGRAM WILL FIT INTO ADA TEMPA PROPER PARTITION SSA WELL ? JMP SZERR NO, YOU LOSE. * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD ADA P2 IN GOES THE NEW STA TEMPB,I * ESFX2 LDA TEMPE,I GET THE 1ST ID EXTENSION WORD XOR TEMPF OUT GOES THE OLD ADA P3 IN GOES THE NEW IOR SIGN ANS THE NON STANDARD BIT STA TEMPE,I * LDB TEMPY GET THE # OF PAGES IN PROG ADB P3 ADD IN THE NEW MSEG SIZE JMP ESIZW NOW GO PUT IT IN THE ID SEG * D32 DEC 32 SKP * * SZRPT JSB TTNAM GET THE ID INFO JSB SES#3 GET THE PROGRAM TYPE CPA D1 MEMORY RESIDENT ? JMP $INER YES, INPUT ERROR. JSB $SZIT PICK UP THE SIZE WORDS LDB WORK NOW GET THE ID ADDRESS ADB D29 INDEX TO HIGH MAIN OF LARGEST SEG LDA B,I PULL IT IN ADB DM6 NOW INDEX TO HIGH MAIN OF PROG CLE,SZA,RSS IF ZERO THEN NO SEGMENT SO USE LDA B,I PROGRAM SIZE JSB $CNV3 NOW CONVERT TO ASCII (OCTAL) * LDA ASCI GET THE 1ST WORD STA BUFF1 AND PUT IT IN THE BUFFER DLD ASCI1 AND GET THE LAST 2 WORDS DST BUFF2 AND SAVE THEM TOO * * LDA TEMPI GET SIZE OF PROG (+ MSEG IF EMA ) LDB TEMPB,I IS THE PROGRAM EMA ? SZB,RSS JMP LSIZE NO JUST GO LIST SIZE LDB TEMPF YES GET MSEG SIZE CMB,INB AND SUBTRACT IT ADB TEMPG FROM THE EMA SIZE ADA B AND ADD (A = PROG + EMA SIZE) LSIZE CCE,INA ACCOUNT FOR BASE PG & DO DECIMAL CONVERSION JSB $CNV3 DO THE CONVERSION * DLD ASCI1 GET THE LOWER 2 WORDS (MAX = 1024) DST BUFF5 AND SET INTO BUFFER LDA ASCI GET A BLAN~þúK STA BUFF4 AND PUT IT OUT AS A DELIMITER STA BUFF7 ON BOTH SIDES STA BUF10 AND FOR THE NEXT ONE STA BUF11 AND FOR THE NEXT ONE * LDA TEMPB,I GET THE EMA WORD AND B1777 KEEP ONLY EMA SIZE LDB DM12 GET A CHAR COUNT CCE,SZA,RSS (DECIMAL CONVERSION) IF NO EMA THEN, JMP SZEXT WE'RE DONE * JSB $CNV3 NOW THEN,CONVERT TO ASCII * DLD ASCI1 GET THE RESULT (MAX = 1024) DST BUFF8 * LDA TEMPF AS LONG AS WE'RE HERE LETS JSB $CNV3 GIVE THEM THE MSEG SIZE TOO. DLD ASCI1 DST BUF12 * * LDB DM26 GET THE CHAR COUNT SZEXT STB BUFFR AND PUT IT IN THE BUFFER LDA BUFAD THE BUFFER ADDRESS TO A JMP MSEX NOW , GO TELL THE FOLKES. * DM26 DEC -26 SKP * THE SZCHK SUBROUTINE IS CALLED BY THE SZ & AS PROCESSORS * IT MAKES SURE THAT THE PROGRAM EXISTS, IS NOT A SEGMENT, * IS DORMANT, IS NOT MEMORY RESIDENT, AND DOES NOT CURRENTLY * OWN ANY PARTITION. * * SZCHK NOP JSB TTNAM GO LOOK FOR THE PROGRAM SZA IF NOT DORMANT, TAKE GAS ! JMP M0405 SEND ILLEGAL STATUS ERROR. * LDB WORK NOW GO SEE WHAT TYPE ADB D14 PROGRAM THIS IS LDA B,I AND D7 KEEP ONLY LOWER 3 BITS CPA D1 IS IT MEMORY RESIDENT ? JMP M0405 THEN SEND ILLEGAL STATUS ERROR * ADB D7 NOW GET TO THE PARTITION WORD LDA B,I PULL IT IN AND KEEP ONLY AND B77 THE PARTITION BITS MPY D7 USE THIS AS AND INDEX INTO ADA $MATA THE $MATA TABLE ADA D2 SO WE CAN SEE WHO OWNS THAT PARTITION LDA A,I PULL IN THE OWNERS ID ADDRESS CPA WORK AND COMPARE IT TO THIS GUY JMP M0405 IF SAME THEN SEND ILLEGAL STATUS ERROR JMP SZCHK,I IF YOU GOT HERE, YOUR A WINNER !!! * * SZERR LDA $SERR JMP MSEX * xþú* $SERR DEF *+1 DEC -10 ASC 5,SIZE ERROR * BPG# OCT 101777 B1777 OCT 1777 * * HED MESSAGE PROCESSOR --- UR COMMAND * * * WHY, YOU ASK YOURSELF, IS THERE A UNRESERVE COMMAND. * IT SEEMS INTUITIVELY OBVIOUS TO THE MOST CASUAL OBSERVER * THAT A RESERVE COMMAND WOULD BE MORE USEFUL. BUT WHAT * HAPPENS TO THE POOR PROGRAM THAT IS SWAPPED OUT, AND THEN * THE ONLY PARTITION HE WILL RUN IN IS RESERVED. WHERE IS * HE TO GO ? REMEMBER ! PARANOIA IS THE WATCH WORD OF * A GOOD OPERATING SYSTEM. * UR, N N = NUMBER OF PARTITION TO BE UNRESERVED * URESV ADA DM1 SUBTRACT 1 FROM PART'N # SSA IF NEG, SEND ILLEGEL PART'N MESSAGE JMP IPRTN CMA MAKE NEG & CHECK AGAINST ADA $MNP MAX # OF PARTITIONS SSA IS IT OK ? JMP IPRTN NO SEND ILLEGAL PARTITION MESSAGE * CCA ADA P1 INDEX INTO MPY D7 PROPER MATA TABLE ENTRY ADA $MATA LDB A,I GET THE LINK WORD SSB IF PARTITION UNDEFINED JMP IPRTN SEND ERROR MESSAGE * ADA D4 NOW GET THE ENTRY LDB A,I STB TEMPX SAVE THE SIZE FOR A LATER CHECK RBL,CLE,ERB STRIP SIGN BIT STB A,I AND PUT IT BACK * INA BUMP TO TYPE WORD LDB A,I GET IT SSB IS IT RT ? JMP URRT YES CHECK SIZE ADA DM2 NOW GO CHECK MOTHER BIT LDB A,I PULL IT IN SSB IS IT SET ? JMP URMT YES * LDB $MBGP GET MAX BG PART'N SIZE MCHEK LDA TEMPX GET PARTITION SIZE AND B1777 KEEP ONLY SIZE CMB AND COMPARE AGAINST THAT TYPE PTN SIZE ADA B NOW IS THE UNRESERVED SSA PARTITION BIGGER THAN LAST OLD PARTITION ? JMP M0150 NO SO WERE FINISHED * JSB $MAXP YES, SO SET UP THE LARGER PARTITION JMP M0150 * _>þú * * URRT LDB $MRTP GET CURRENT RT MAX SIZE JMP MCHEK * URMT LDB $MCHN JMP MCHEK * * IPRTN LDA $ILPN JMP MSEX * B777K OCT 77700 * $ILPN DEF *+1 DEC -14 ASC 7,ILLEGAL PART'N * HED MESSAGE PROCESSOR --- AS COMMAND * * AS,XXXXX, Y * * * THE AS COMMAND WILL ASSIGN PROGRAM XXXXX TO PARTITION # Y * XXXXX MUST BE DORMANT AND NOT RESIDENT IN ANY PARTITION. * (IE HE MAY NOT HAVE PREVIOUSLY TERMINATED SERIALLY * REUSABLE. DO AN OF,XXXXX,1 IF HE DID) * ASIGN JSB SZCHK 1ST GO SEE IF CMND LEGAL JSB $SZIT GET THE NEEDED ADDRESSES. LDA P2 GET THE PARTITION CLE,SZA,RSS IF = 0 WE UNASSIGN JMP ASTUF GO UNASSIGN * SSA IF NEG IT'S AN JMP IPRTN ERROR CMA,INA IF GREATER THAT MAX # PART'NS ITS ADA $MNP AN ERROR SSA JMP IPRTN ALSO. * CCA NOW GO LOOK AT THE PARTITION ADA P2 ACCOUNT FOR BASE PAGE STA P2 AND SAVE MPY D7 INDEX TO THE ADA $MATA PROPPER $MATA ENTRY LDB A,I GET THE LENGTH WORD SSB IF ENTRY UNDEFINED ITS AN ERROR JMP IPRTN * ADA D4 NOW INDEX TO THE # PAGES LDA A,I WORD. AND B1777 KEEP ONLY THE PAGES STA TEMPX AND SAVE FOR LATER * LDB TEMPB,I GET THE EMA WORD SZB IS THIS AN EMA PROG ? JMP EMASS YES, SO DO THE EMA THING * GTPGS LDA TEMPI GET THE # OF PAGES WORD CMA,INA MAKE IT NEG ADA TEMPX AND CHECK IT. CCE,SSA IF NEG ITS AN ERROR JMP IPRTN * ASTUF LDA TEMPC,I GET THE SIZE WORD BACK AND B777K THROW AWAY OLD PARTITION IOR P2 PUT IN NEW PARTITION RAL,ERA FIX THE RESERVED BIT STA TEMPC,I AND PUT THE WORD BACK JMP M0150 AND RETURN * * EMASS LDA TEMPE GE WþúT THE ID EXTENSION ADDRESS INA LDA A,I GET THE DE BIT WORD ALF,RAL PUT IN SIGN BIT SSA,RSS WAS DEFAULT TAKEN ? JMP EMESS NO. * LDA TEMPB,I GET THE EMA SIZE WORD XOR TEMPG GET RID OF OLD SIZE INA SET DISPATCHER FLAG FOR MAX SIZE STA TEMPB,I CLA,INA,RSS * EMESS LDA TEMPG GET THE EMA SIZE CMA,INA ADA TEMPF REDUCE BY MSEG SIZE EMES1 ADA TEMPX OFSET THE PARTITION SIZE STA TEMPX AND RESET IT JMP GTPGS NOW GET # OF PAGES IN PROGRAM HED MESSAGE PROCESSOR CONSTANTS ETC. LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER MASKU OCT 177400 UPPER CHARACTER MASK (AND) TEMPP NOP TEMPORARY STORAGE KEY NOP TEMPORARY STORAGE * DEFP2 DEF DP2,I DP0 DEF OP DP1 DEF P1 DP2 DEF P2 DP3 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT * * * THE PLOAD SUBROUTINE IS CALLED BY THE RU, ON, & GO PROCESSORS * IT DECIDES WHETHER THE USER WANTED TO DO STRING PASSING AND/OR * SET UP THE 5 TEMP WORDS IN THE PROGRAMS ID SEGMENT. * * PLOAD NOP ENTRY/EXIT LDA WSTAT,I IF NO PRAM BIT IS RAL,RAL SET THEN DO NOT PASS CLE,SSA THE SCHEDULING STRING JMP PLOAD,I (SET E=0 FOR ALCST BELOW). LDB PARAM IF NO PARAMETERS, CPB D2 THEN DO NOT PASS JMP PLOD5 THE SCHEDULING STRING. LDB OP+1 CHECK FOR "IH" IN CPB ASCIH COMMAND TO INHIBIT JMP PLOD5 PASSAGE OF STRINGS. * LDA $MEU GET THE DMS STATUS RAL,ELA E = 0/1 CAME FROM SYS/USER MAP CCA,SEZ,CLE,RSS DID INPUT COME FROM THE SYS CONSOLE ? STA MVFLG YES SET A FLAG FOR THE ALCST SUBROUTINE * LDB WORK NO "IH",SO GET ID-SEG ADDRESS JSB ALCST AND GO STORE THE STRING. JMP NOMEM MEMORY ALLOCÆâþúATION ERROR? JMP NOMEM YES, GO SEND MESSAGE. * PLOD5 LDB DEFP2 GET INDIRECT DEF TO PRAMS. LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA WORK GET ID-SEGMENT ADRESS JSB PRAM GO SET PRAMS. JMP PLOAD,I RETURN. * NOMEM LDA $NMEM GO ISSUE NO MEMORY JMP $MSEX MESSAGE AND RETURN. * ASCIH ASC 1,IH NO ASC 1,NO SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP PRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP PRAM1 NO- CONTINUE JMP PRAM,I YES , SO EXIT HED CROSS MAP PARAMETER CONTROL STORE SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. XPRAM SETS ·þúFIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * NOTE THAT THE PARAMETERS THAT ARE BROUGHT IN ARE * FROM THE USER MAP, THAT IS, THE ALTERNATE MAP. THIS * MEANS THAT THE PARAMETERS TRUE ADDRESS MUST BE IN THE * CURRENT MAP BECAUSE THE CROSS LOAD INSTRUCTION CHASES * DOWN INDIRECTS IN THE CURRENT MAP BEFORE GOING ACROSS * MAPS TO PICK UP THE VALUE. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB XPRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * XPRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP XPRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER XRAM1 CLA ZERO ADDRESS GETS A ZERO XLA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP XRAM1 NO- CONTINUE JMP XPRAM,I YES-EXIT * HED MESSAGE PROCESSOR NAME SEARCH * * CALL BY NAME SEARCH ROUTINE * * CALLING SEQUENCE: * * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * * WORK = ID ADDRESS * B = ID ADDRESS IF A PROGRAM, IF SEGMENT B = 5 (IE TYPE) * A = LEAST 4 STATUS BITS * E = 0 STANDARD ID SEGMENT * E = 1 SHORT ID SEGMENT * * TTNAM NOP ENTRY/EXIT LDB DEFP1 ¨‘þú ADDRESS OF ASCII PROG NAME JSB TNAME CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! * LDA WORK SEE WHAT TYPE PROGRAM IS ADA D14 WITHOUT EFFECTING E REG LDA A,I AND D7 CPA D5 IS IT A SEGMENT ? JMP OPOK? YES, SEE WHO WANTS TO KNOW SPC 2 OPOK! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND JMP TTNAM,I RETURN SPC 2 OPOK? STA B A SEGMENT SET B = 5, B NOT = ID ADDR. LDA OP GET THE INPUT COMMAND CPA OF OFF COMMAND ? JMP OPOK! YES. CPA ST ST COMMAND ? JMP OPOK! YES. SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR (YOU LOSE !) JMP MSEX EXIT HED SEARCH KEYWORD LIST FOR PROGRAM NAME * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B AND WORK ARE THE ID SEGMENT ADDRESS OF REQUESTED PROGRAM * WSTAT = THE STATUS WORD ADDRESS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT OR NOT FOUND * TNAME NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS ‰Kþú3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP TNAME,I EXIT HED CVT3 (BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CNV3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CNV3 NOP STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * !-þúCCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CNV3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 HED $CNV1 (BINARY TO ASCII CONVERSION) * CALLING SEQUENCE: SAME AS $CNV3 * * RETURN RESULTS LEAST TWO DIGITS IN A. * OTHERS AS PER $CNV3 * $CNV1 NOP JSB $CNV3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CNV1,I RETURN HED PROGRAM SIZE .VS. PART'N SIZE CHECK * * * THE $SZIT SUBROUTINE IS CALLED BY THE EXEC 9,10,23 & 24 * PROCESSORS AND IS CALLED FOR THE ON, RU, & SZ COMMANDS. * IT IS ALSO CALLED BY THE DISPATCHER IF A PARITY ERROR * HAS OCCURED AT ANY TIME IN THE PAST AND A SEARCH WAS MADE * FOR A PARTITION & NONE OF THE PROPER SIZE WAS FOUND. * THE SUBROUTINE MAKES SURE THAT THE PROGRAM TO BE SCHEDULED * WILL FIND A PARTITION LARGE ENOUGH TO RUN IN. THAT IS * IT MAKES SURE THAT NO PROGRAM IS FOREVER SCHEDULED BUT * BUT NEVER DISPATCHED. THIS CASE WILL OCCUR IF A PROGRAM * IS LOADED, THEN SP 'D , THE SYSTEM THEN REDEFINED, AND THEN * THE PROGRAM RP 'D AND PROGRAM EXECUTION ATTEMPTED. * * * CALLING SEQUENCE JSB $SZIT * ID ADDRESS IN WORK * * ON RETURN A = 0 ALL IS WELL * A = ASCII ERROR CODE ADDRESS. (PROG TOO LARGE) * B = 8 IF PROG ASSIGNED TO A PARTITION * = 9 IF PROGRAM IS NOT ASSIGNED TO ANY PARTITION. * * TEMPS : TEMPA = $MBGP, $MRTP, $MCHN, OR PARTITION SIZE * TEMPB = ADDR OF ID SEG WORD # 29, THE EMA SIZE WORD * TEMPC = ADDR OF ID SEG WORD # 22, SIZE - PARTITION WORD * TEMPD = ERROR COSE 8 OR 9 (AS IN B-REG ABOVE) * TEMPE = ADDRESS OF ID EXTENSION * TEMPF = MSEG SIZE * TEMPG = EMA SIZE * TEMPI = #OF PAGES OF PROG (INCLUDES 1 €IþúMSEG) * * * $SZIT NOP LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I PULL IT IN AND D7 KEEP ONLY TYPE BITS CPA D1 IF MEM RES JMP SIZOK THE MAKE SUCCESSFUL RETURN * LDB $MBGP ASSUME PROG IS BG CPA D2 IS IT ? LDB $MRTP NO, BETTER LUCK NEXT TIME. STB TEMPA SAVE THE PROPER SIZE WORD * LDB WORK GET THE ID ADDRESS AGAIN ADB D28 NOW GET TO THE EMA WORD STB TEMPB (SAVE THE ADDRESS TOO ) LDA B,I AND PULL IT IN LDB $MCHN GET THE MAX EMA SIZE SZA IS PROG EMA ? STB TEMPA YES SO SIZE IS EMA * LDB WORK GET THE ID ADRESS AGAIN ADB D21 INDEX TO THE PARTITION WORD STB TEMPC (SAVE THE ADDRESS TOO ) LDA B,I PULL IT IN NOTAS LDB D9 GET THE PROPPER ERROR CODE SSA,RSS IS PROG ASSIGNED ? JMP GOSIZ NO * AND B77 GET THE PARTITION MPY D7 AND USE AS INDEX ADA $MATA INTO THE LDB A,I GET THE 1ST WORD SSB IF UNASSIGNED, JMP UNASN THEN UNASSIGN THE PROGRAM & TRY AGAIN ADA D4 $MATA TABLE LDA A,I GET THE SIZE OF THE AND B1777 PARTITION STA TEMPA AND SAVE LDB D8 GET THE ERROR CODE * * GOSIZ STB TEMPD AND SAVE IT IF WE NEED IT LDA TEMPC,I ALF GET # OF PAGES IN PROG (+ MSEG IF EMA) RAL,RAL AND B37 STA TEMPI SAVE FOR LATER * LDB TEMPB,I GET THE EMA FLAG SZB IS PROGRAM EMA ? JMP EMACK YES SO CHECK IT OUT * CMA,INA NOW SEE IF ADA TEMPA IF IT IS DISPATCHABLE SZBAD LDB TEMPD GET THE ERROR CODE READY * SSA,RSS WELL ? SIZOK CLA,RSS YES ALL IS WELL, SO CLEAR A LDA $SERR NO, SEND ERROR CODE TO CALLER diþúJMP $SZIT,I RETURN * UNASN LDA TEMPC,I GET THE PART'N WORD AND B777K UNASSIGN THE PROGRAM STA TEMPC,I AND JMP NOTAS TRY AGAIN. * TEMPA NOP TEMPB NOP TEMPC NOP TEMPD NOP TEMPE NOP TEMPF NOP TEMPG NOP TEMPI NOP * * EMACK LDA B ALF GET ID EXTENSION TO LOW END RAL,RAL AND B77 NOW USE THIS AS AN INDEX TO THE ADA $IDEX PROG'S ID EXTENSION LDA A,I PULL IT IN STA TEMPE SAVE THE ADDRESS LDA A,I NOW GET THE AND B37 MSEG SIZE STA TEMPF SAVE THIS TOO * LDA TEMPB,I NOW GET THE EMA SIZE FXEMA AND B1777 LDB A PUT IN IN B=REG TOO STB TEMPG AND SAVE AGAIN ADA TEMPI A= [ #PGS + EMA SIZE ] CMA,INA A= -[ #PGS + EMA SIZE ] ADA TEMPA A = $MCHN - [#PGS + EMA SIZE] ADA TEMPF A = $MCHN -[#PGS - MSEG + EMA SIZE ] SPC 1 * A = $MCHN - [#PGS - MSEG + EMA SIZE ] OR SPC 1 SSA,RSS IS IT OK ? JMP SIZOK YES * CPB D1 IF EMA SIZE = 1, THEN IT'S AN JMP SZBAD ERROR * CLB,INB WELL, PAL YOU GET ONE LAST CHANCE ADB TEMPE INDEX TO THE DE BIT IN THE LDB B,I ID EXTENSION BLF,RBL NOW SEE IF THE EMA SIZE WAS DEFAULTED SSB,RSS WELL ? JMP SZBAD NO, SO YOU'RE A LOSER ! * LDB WORK OK, BUT HAS THE PROGRAM EXECUTED ? ADB D8 LDB B,I GET POINT OF SUSPENSION SZB HAS IT EVER EXECUTED ? JMP SZBAD YES, CAN ONLY HAVE BEEN A PARITY ERROR * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD SIZE INA IN GOES THE DEFAULT (A FLAG TO THE STA TEMPB,I DISPATCHED TO GIVE LARGEST SIZE) JMP FXEMA PLAY IT AGAIN SAM HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * TMÕNLHHE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLED. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP Nÿÿþú JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLAG JMP $XEQ GO TO $XEQ * TYP10 CLA CLEAR THE COM FLAG STA FLG LDA IBUF GET BUFFER ADDRESS TO A JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP27 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT  CMB,INB TO POSITIVE WORD COUNT. STB TYPCO SAVE WORD COUNT. LDB IBUF GET BUFFER INA ADDRESSES. MVW TYPCO GO MOVE WORDS. * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ * TYP27 LDA OP GET THE OP CODE CPA RU WAS IT A RUN ? RSS YES CPA ON NO, WAS IT AN ON ? RSS YES JMP TYP30 NO, DO COMPLETION STUFF * LDB WORK GET THE ID ADDRESS JSB SES#3 GET SESSION WORD # 3 ADDRESS CCA A = -1 (NEG LU # OF SYS CONSOLE) STA B,I SET THE LU IN THE ID SEGMENT TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT ´þú * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR SABRT CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB SABRT THE SOFT ABORT ROUTINE LDA TEMPH GET THE ADDRESS AND JSB $SDRL GO RELEASE THE DISC TRACKS LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I EXIT * * ABMA DEF *+1 DM14 DEC -14 ABM ASC 7,PROGX ABORTED AASCI ASC 1, HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT9 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND (OPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) * SET/CLEAR ALL-OR-MEMORY AND CÝþúORE-LOCK FLAGS * GET/PUT A COMMAND STRING ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A FATHER CHECKS * ADB D20 STEP TO FATHER POINTER ADDRESS CCA GET ADA B,I TO A AND B377 AND MASK ADA KEYWD ADDRESS OF ID OF FATHER IN A LDA A,I NOW CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * LDB WORK RESTORE THE ID-SEGMENT ADDRESS TO B * MPT1A LDA RQRTN UPDATE THE RETURN STA XSUSP,I ADDRESS CLA SET A TO ZERO IN CASE XLA RQP3,I PRAMETER NOT SUPPLIED CMA,SZA,RSS IS THIS GUY SERIALLY REUSABLE JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B STANDARD TERMINATION CALL. * INA,SZA,RSS IS IT JMP MPT1C A SAVE RESOURCES TERMINATION * INA,SZA,RSS MAY BE A SOFT ABORT JMP M0240 YES GO TO ABORT ROUTINE * INA,SZA,RSS HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CLOSE! * ESC02 LDB D2 YOU LOSE - UNRECOGNIZED PRAMETER. JMP ESCXX GO ABORT HIM * MPT1C LDA WORK GET ID ADR JSB ALDM GO PUT IN DORMANT LIST & SET FLG LDB WORK RESTORE B LDA WSTAT,I SET THE IOR B200 RESOURCE BIT IN THE STATUS STA WSTAT,I AND THEN CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIç6þúAL REUSE LDA IDCKK JSB ALDM GO PUT IN DORMANT LIST & SET FLAG JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB XPRAM TRANSFER THE PRAMETERS JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 SKP * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF NOT IN SESSION, CLEAR OUT NEG LU WORD. * 3. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 4. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB TREM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM DEF D.RTR JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST * STB IDCKK SAVE THE ID-ADDRESS ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR RESTORE A AND SET E TO FATHER WAITING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 #Ëþú IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D20 DEC 20 SIGN OCT 100000 B200 OCT 200 B7400 OCT 7400 DEFR4 DEF RQP4,I SPC 2 $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN * SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 LDA XEQT GET ADDR OF ID SEG ADA D20 LDA A,I GET FATHER POINTER CLB SSA IF BATCH FLAG IS SET JMP ESCXX ABORT SC00 LDA XEQT GET CURRENT ID ADR JSB ALDM GO PUT IN DORMANT LST & SET DM FLAG JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST JMP MEM15 GO UPDATE XSUSP SPC 3 * * READ IN BACKGROUND PROGRAM SEGMENT * $MPT3 CCA CHECK PARAMETER COUNT ADA RQCNT SSA JMP ESC01 ERROR, SO RETURN LDB RQP2 ADDR OF ASCII PROG SEGMENT JSB PLNAM PULL IT IN LOCALLY JSB TNAME GO FIND THE ID SEG. SZA,RSS IF NOT FOUND JMP ESC05 TAKE GAS! ADB D7 STEP TO PRIMARY ENT PT. SEZ IF SHORT ID-SEG. STEP ADB D4 TO THE SHORT ID-SEG PRI ENT PT. ADD LDA B,I FETCH AND STA $WATR SET AS RETURN ADDRESS ADB D7 STEP TO TYPE ADDRESS LDA B,I BET TYPE AND D7 MASK IT SEZ,RSS IF SHORT IT MUST BE A SEG. CPA D5 SEGMENT?? CCE,RSS YES SKIP. JMP ESC03 NO TAKE GAS! LDA $WATR SET UP RETURN ADDRESS STA RQRTN LDB WORK GET THE ID-SEG ADDRESS STB XA,I JSB $BRED GO SET UP TO LOAD CCB %Iþú SET THE ALL OF CORE ADB WSTAT BIT LDA B,I FOR THE IOR LASCI DISPATCHER STA B,I JSB PRAMO PASS PRAMETERS IF ANY JMP MEM15 ADVANCE THE RETURN ADDRESS AND EXIT SPC 3 * PRAMO PASSES PRAMETERS FROM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * * CALLING SEQUENCE: * * SET UP WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRAMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB XPRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. SKP * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * * * ENTRY MADE BY $SCD3 NOP * RSB * SJP $SCD * * * $SCD RBL,RBL STB TEMPD STA $IDNO SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB IF END OF LIST JMP SCDMR JRS TEMPD $SCD3,I RETURN * SCDMR LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA $IDNO THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA PRAMO AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOES ID-SGEMENT ADDRESS IS IN B LDB PRAMO GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST * SKP * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT LDB XEQT GET THE ADDRESS lÂþú ADB D20 OF THE BATCH FLAG XOR B,I AND SET IT AND C120K INTO THE XOR B,I THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STATUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM RSS * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT * LDB XEQT GET THE FATHER'S SESSION OR NEG LU WORD JSB SES#3 GET THE SESSION WORD LDA B,I STA TEMP1 AND SAVE IT FOR A MOMENT LDB XTEMP,I NOW GET THE SON'S JSB SES#3 SESSION WORD ADDRESS LDA TEMP1 GET FATHERS SESSION WORD STA B,I AND PASS IT TO THE SON * MEM15 LDA RQRTN SET UP SUSPENSION STA XSUSP,I POINT JMP $XEQ * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESC03 LDB D3 RSS ESC04 LDB D4 RSS ESC05 LDB D5 NO SUCH PROGRAM ERROR CODE. RSS ESC07 LDB D7 RSS ESC10 LDB B400 (SC10) NO MEM EVER FOR STRING PASSAGE. ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE $SCXX EQU ESCXX * B40K OCT 40000 B400 OCT 400 C120K OCT 57777 SKP * * CALL TO GET SYSTEM REAL TIME * $MPT6 LDA RQP2 SAVE THE BUFFER STA TEMP1 ADDRESSES LDA RQP3 STA TEMP2 * LDA DPNAM GET THE ADDRESS OF OUR LOCAL BUFFER STA RQP2 AND USE IT ADA D5 INSTEAD STA RQP3 * DLD $TIME GET THE TIME JSB $TIMV AND CONVERT IT * LDA D5 GET THE # OF CAX TO X LDA DPNAM THE SOURCE LDB TEMP1 THE DESTINATION MWI GIVE THE DATA TO THE USER * LDA DPNAM+6 GET THE YEAR XSA TEMP2,I GIVE TO USER(IWþúF TEMP2 = 0 ITS A NOP) JMP MEM15 GO TO STORE RETURN ADDRESS * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"IS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS * GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME XLA RQP2,I GET THE PRAMETER SZA,RSS ANY SUPPLIED ? JMP GTID# NO LDB RQP2 GET ADDRESS OF NAME JSB PLNAM PULL IT IN LOCALLY GTID# JSB TNAME GO SEARCH FOR IT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $ID# RAL,RAL STA TEMPD STB GETID SAVE THE REQUESTED ID-ADDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JRS TEMPD $IDNO,I RETURN * SKP * * CALL TO SET ID SEGMENT TIME VALUES * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 4 OR 7 ADA RQCNT SZA,RSS IF SEVEN THEN JMP MPT7A CONTINUE, ELSE ADA D3 CHECK FOR 4 SZA JMP ESC01 YOU LOSE, WRONG # OF PRAMS XLA RQP5,I NO CHECK PRAM 5 SZA,RSS IF = 0 JMP ESC02 YOU LOSE * MPT7A XLA RQP3,I +Vþú IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET THE ID-SEGMENT ADDRESS TO B LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE * DM7 DEC -7 * SKP * * THE IDCKK SUBROUTINE CHECKS THE STATUS OF POTENTIAL * SON PROGRAMS & DETERMINES WHETHER TO HONOR THE FATHER- * SON SCHEDULE REQUEST. * * * SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE IDCKK NOP LDB RQP2 GET PROG NAME ADDRESS JSB PLNAM PULL IT IN LOCALLY JSB TNAME NOW SEE IF THE PROGRAM EXISTS SEZ JMP ESC05 NO SUCH PROGRAM ERROR ADB D14 MAKE SURE IT IS NOT LDA B,I A SEGMENT AND D7 CPA D5 IF SEGMENT JMP ESC03 TAKE GAS! JSB $SZIT SEE IF IT WILL FIT SZA WELL ? JMP ESCXX NO,SO TAKE GAS ! * LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA WORK ALSO COMPUTE THE ADA D20 FATHER POINTER WORD ADDRESS STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * XLB RQP9,I (A MUST=0)CHECK IF THE OPTIONAL SZB,RSS PARAMETER STRING IS INCLUDED. JMP IDCK4 IF NOT,SKIP STRING STORAGE. JSB $CVWD CONVERT BUFFER LENGTH TO STB BFCNT POSITIVE CHARS AND SAVE. LDA RQP8 SET UP BUFFER ADDRESS. STA BFADD CLE LDB WORK GET ID-SEGMENT ADDRESS JSB ALCST AND STORE PARM.STRING. JMP ESC10 ABORT PROGRAM(SC10)IF NO MEM EVER. JMP NMNOW SUSPEND FATHER IF vºþúNO MEM NOW. * IDCK4 JSB PRAMO PASS THE PARAMETERS,IF ANY,TO IDCK5 JSB $LIST THE ID-SEG.AND THEN SCHEDULE. OCT 301 STA XA,I SHOW THAT IT WAS DONE STB XTEMP,I SON'S ID ADDR TO FATHER'S 1ST TEMP WORD LDA $IDNO,I (MIGHT BE EXEC 9). GET THE CURRENT FLAG BITS AND C377 MASK OUT ANY OLD FATHER NUMBER. IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK5 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I AND RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * DM8 DEC -8 C377 OCT 177400 SKP * *SCHEDULE WITH WAIT WITH WAIT REQUEST * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 SKP * * $MPT8 SE¦4þúT/CLEAR ALL OF MEMORY AND CORE LOCK FLAGS * * EXEC 22 REQUEST WITH ONE PRAMETER * PRAMETER MEANING * 0 CLEAR CORE LOCK * 1 SET CORE LOCK * 2 CLEAR ALL OF MEMORY FLAG * 3 SET ALL OF MEMORY FLAG. * $MPT8 LDB XEQT GET THE ADDRESS ADB D14 OF THE BITS IN THE ID-SEGMENT STB $LIST SAVE ADDRESS LDA B,I GET CURRENT STATUS XLB RQP2,I GET THE REQUEST WORD CMB,INB,SZB,RSS IF ZERO JMP CLCL CLEAR THE CORE LOCK * INB,SZB,RSS IF ONE JMP STCL SET THE CORE LOCK * INB,SZB,RSS IF TWO JMP MEM15 CLEAR ALL OF MEMORY FLAG * INB,SZB IF NOT THREE THEN JMP ESC02 GO ABORT HIM. JMP MEM15 * STCL LDB SWAP CHECK IF LEGAL REQUEST RBR,RBR GET LEGAL FLAG SLA TO LEAST B RBR,CLE CLE,SLB,RSS IF ILLEGAL JMP ESC07 GO DO HIM IN * CLCL LDB B100 GET THE CORE LOCK FLAG TO B MPT81 IOR B SET THE FLAG SEZ AND IF A CLEAR REQUEST XOR B CLEAR THE FLAG STA $LIST,I RESET THE WORD JMP MEM15 GO EXIT. SKP ********************************************************************** * * EXEC 14--GET/PUT A COMMAND STRING. * * FOUR PARAMETERS USED: * . * . * . * JSB EXEC * DEF RTN * DEF ICODE * DEF GPCOD * DEF IBUFR * DEF IBUFL * RTN . * . * . * ICODE DEC 14 * GPCOD DEC 1 OR 2 1 = GET(RETRIEVE)PARAMETER STRING * 2 = PUT(WRITE)PARAMETER STRING TO FATHER * IBUFR BSS N BUFFER OF N WORDS * IBUFL DEC N(OR -2N) BUFFER LENGTH WORDS(+) OR CHARACTERS(-) * ****************************************************************** * $MPT9 LDA RQCNT CHECK TO SEE ADA DM3 ×þú IF THERE ARE SSA FOUR PARAMETERS. JMP ESC01 SORRY BUDDY, YOU BLEW IT! LDA RQP3 SAVE ADDRESS STA BFADD OF BUFFER. XLB RQP4,I GET BUFFER LENGTH, SAVE STB $IDNO FOR TRANS.LOG CHECK, JSB $CVWD CONVERT TO POSITIVE STB BFCNT CHAR COUNT AND SAVE. XLA RQP2,I GET TYPE OF REQUEST. ADA DM2 SZA,RSS JMP MPT9W 2=WRITE. INA,SZA 1=READ. JMP ESC02 ILLEGAL REQUEST. * LDB XEQT READ A STRING BLOCK FOR AN ID-SEG. JSB $STSH TO THE BUFFER(E=1,EXTRA WORD). SZA,RSS GET THE STRING BLOCK ADDRESS JMP NOPAW FOR THIS PROG. IF NO STRING, ADA D2 THEN SET A=1, CLEAR B, AND RETURN. LDB A,I GET ACTUAL SIZE OF STORED CMB,CLE,INB STRING AND COMPARE TO ADB BFCNT TO THE REQUESTED LDB A STRING SIZE. SEZ,INA,RSS SET A REG. TO SOURCE ADDRESS. LDB BFCTA USE WHICHEVER SIZE IS LDB B,I SMALLER AND CONVERT STB BFCNT INB TO WORDS AND USE BRS AS MOVE WORDS STB XB,I COUNT. LDB BFADD SET B REG. TO DESTINATION ADD. LDX XB,I MWI GO MOVE WORDS. LDB XEQT WHEN COMPLETE, RETURN THE JSB $RTST STRING BLOCK TO MEMORY. LDB XB,I GET MOVE WORDS COUNT. LDA $IDNO IF ORIGINAL REQUEST WAS SSA FOR CHARS, THEN DOUBLE LDB BFCNT WORD COUNT FOR TRANS.LOG. JMP MPT91 GO SETUP REGS. AND RETURN. * MPT9W LDA XEQT WRITE A STRING BLOCK TO THE FATHER. ADA D20 GET CURRENT PROGRAM LDA A,I AND DETERMINE IF THERE AND B377 IS A FATHER. SZA,RSS JMP NOPAW ERROR, NO FATHER. CCB,CCE GET ID(SET E=1 FOR ALCST) ADB KEYWD SEGMENT ADB A ADDRESS OF LDB B,I )ÔNLH FATHER. JSB ALCST DEALLOCATE AND THEN ALLOC.BLOCK FOR PAW. JMP ESC10 IF SUCCESS ALLOC.,THEN SET A=0.IF NO JMP NMNOW MEM EVER,ABORT SON(SC10).IF NO MEM MPT91 CLA NOW, SUSPEND THE SON. * MPT95 STB XB,I SET UP B REGISTER. STA XA,I SET UP A REGISTER. JMP MEM15 RETURN. * NMNOW JSB $LIST NOT ENOUGH MEMORY NOW SO OCT 504 LINK PROGRAM INTO MEMORY JMP $XEQ SUSPENSION LIST. * NOPAW INA IF NO STRING ON 'GET' OR CLB NO FATHER ON 'PUT', THEN JMP MPT95 SET A=1 OR B=0. * DM2 DEC -2 SKP ************************************************************** * * SUBROUTINE TO STORE A STRING IN SYSTEM AVAILABLE MEMORY. * ALCST DEALLOCATES ANY STRING MEMORY, ALLOCATES A BLOCK OF * MEMORY, TRANSFERS THE STRING INTO THE BLOCK, AND LINKS THE * BLOCK INTO THE HEAD OF THE STACK LOCATED AT $STRG. THE LINKED * BLOCKS LOOK AS FOLLOWS: * * * *********** ********************* * $STRG * ---------* 0 OR LINK-------------- RvNÿÿþú* *********** *-------------------* * EXTRA WORD BIT------* ID SEG ADDRESS * * *-------------------* * * # CHARS IN STRING * * *-------------------* * * CHAR 1 CHAR 2 * * *-------------------* * * * * *-------------------* * * CHAR M * * ********************* * * EXTRA WORD * * *-------------------* * * * WORD 1 = LINK TO NEXT BLOCK OR 0 FOR LAST BLOCK * WORD 2 = BITS 0-14 = ID-SEGMENT ADDRESS * BIT 15 = EXTRA WORD IN BLOCK BIT(SEE $ALC) * WORD 3 = ACTUAL NUMBER OF CHARS (M) IN STRING * * CALLING SEQUENCE: * BFADD:= BUFFER ADDRESS * BFCNT:= POSITIVE BUFFER CHAR COUNT * MVFLG:= -1/0 STRING IN SYS/USER MAP * CLE/CCE (SEE BELOW) * LDB ID-SEGMENT ADDRESS * JSB ALCST * * RETURN: * (P+1) =-1, =XTEMP UNSUCCESSFUL,NO MEM EVER * (P+2) =0 , =XTEMP UNSUCCESSFUL,NO MEM NOW * (P+3) =+ , =XTEMP SUCCESSFUL ALLOCATION EVER * * AND ARE MODIFIED * TEMP1, TEMP4 AND TEMP6 ARE USED. * CALLS $RTST WHICH USES TEMP2, TEMP3 AND TEMP5. * * ON ENTRY, IF E REG=0, THE BASE PAGE WORD XTEMP(1721B)IS * SET TO THE ID SEGMENT WORD 2 ADDRESS INDICATED BY THE B REG * AND THEN RESTORED ON EXIT. IF THE E REG = 1, THEN XTEMP IS * NOT MODIFIED. SINCE ON "NOT ENOUGH MEMORY", $ALC WILL STORE * THE AMOUNT OF MEMORY REQUIRED IN 'XTEMP,I', THIS WILL RESULT: * 1)E=0,SAVE MEMORY SIZE IN XTEMP OF B REG PROGRAM, OR * 2)E=1,SAVE MEMORY SIZE IN XTEMP OF CURRENT PROGRAM(USED * ONLY IN EXEC 14 CALL FROM SON TO FATHER). * **************************ƒ'þú************************************* * ALCST NOP STB TEMP1 SAVE ID ADDRESS. LDA XTEMP SAVE CURRENT PROGRAM'S ID STA TEMP4 WORD 4. * INB IF E=0, THE SET UP OUR PROGRAM'S ID SEZ,INB,RSS WORD 2 FOR USE BY $ALC. STB XTEMP OTHERWIZE, USE CURRENT PROGRAM. LDB TEMP1 GET ID ADDRESS AND JSB $RTST RETURN ANY STRING MEMORY. LDA BFCNT GET CHAR COUNT. INA CHANGE TO ARS WORD COUNT STA RTSTW AND SAVE. ADA D3 INCREMENT WORD COUNT BY STA WORDS 3 FOR LINKAGE WORDS AND JSB $ALC GO GET MEMORY. WORDS NOP JMP ALST9 NO MEMORY EVER RETURN. JMP ALST8 NO MEMORY NOW RETURN. CCE OK RETURN. SET E REG TO CPB WORDS 1 IF AN EXTRA WORD WAS CLE RETURNED. LDB $STRG LINK THE BLOCK INTO STB A,I THE HEAD OF THE STA $STRG STACK HEADED AT $STRG. LDB TEMP1 GET ID-SEG ADDRESS, ADD IN RBL,ERB EXTRA BLOCK WORD BIT, INA AND STORE IN SECOND STB A,I BLOCK WORD. LDB BFCNT STORE BUFFER CHAR INA COUNT IN THIRD STB A,I WORD OF BLOCK. INA LDB A GET ADD.OF DESTINATION BUFFER. LDA BFADD GET ADDRESS OF SOURCE BUFFER. * ISZ MVFLG WHERE IS THE STRING RIGHT NOW ? JMP ALST5 USER MAP * MVW RTSTW SYS MAP, SO GO MOVE THE WORDS JMP ALST6 * ALST5 LDX RTSTW MWF GO MOVE WORDS FROM USER MAP. ALST6 ISZ ALCST SUCCESSFUL RETURN. ALST8 ISZ ALCST NO MEMORY NOW RETURN. ALST9 CLB CLEAR OUT SYS/USER MAP FLG STB MVFLG LDB TEMP4 RESTORE CURRENT PROGRAM'S STB XTEMP ID WORD 2 ADDRESS. JMP ALCST,I NO MEMORY EVER RETURN--A=STATUS. * STRGA DEF $STRG $STRG OCT 0 HEAD OF STRING STOÑ·þúRAGE STACK. BFCTA DEF BFCNT BFCNT BSS 1 BFADD BSS 1 MVFLG NOP -1/0 STRING CURRENTLY IN SYS/USER MAP SKP ************************************************************** * * SUBROUTINE TO RETURN SYSTEM AVAILABLE MEMORY ALLOCATED * FOR A STRING. GIVEN A PROGRAM'S ID-SEGMENT ADDRESS, $RTST * LOCATES THE STRING IN THE BLOCK HEADED AT $STRG, UNLINKS * IT AND RETURNS IT TO SAVMEM. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $RTST * * RETURN: * NO REGISTERS ARE SAVED. * USES TEMP2 AND TEMP5 FOR TEMPOARAY STROAGE. * CALLS $STSH WHICH USES TEMP3. * ************************************************************** * $RTST NOP STB TEMP2 SAVE ID-SEGMENT ADDRESS. RTST1 JSB $STSH GET STRING BLOCK ADD.(E=1,EXTRA WD). SZA,RSS CHECK IF STRING JMP $RTST,I BLOCK FOUND. STA RTSTA STORE STARTING BLOCK ADDRESS. LDA A,I UNLINK BLOCK STA B,I FROM STACK. LDA RTSTA ADA D2 GET SIZE OF LDB A,I BLOCK, CONVERT INB TO WORDS BRS AND ADB D3 ADD 3. SEZ IF EXTRA WORD BIT SET, INB ADD 1 TO SIZE. STB RTSTW STORE TOTAL SIZE OF BLOCK. JSB $RTN RETURN MEMORY BLOCK. RTSTA NOP RTSTW NOP * LDB TEMP2 GET ID SEGMENT ADDRESS. STB WORK SET UP $WORK IN CASE ANY PROG SCHEDULED JMP RTST1 CHECK FOR ANY MORE BLOCKS. * SKP ********************************************************************** * * SUBROUTINE $STSH CHASES DOWN A STRING BLOCK IN THE STACK * HEADED AT $STRG GIVEN THE ID-SEGMENT ADDRESS. ASSUMES ENTRY * IN THE SYSTEM MAP. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $STSH * * RETURN: * =0 = COULD NOT FIND NAMED BLOCK * =+ = ADDRESS OF BLOCK, E=1 = EpyþúXTRA WORD IN BLOCK * B= ADDRESS OF PREVIOUS BLOCK * USES TEMPORARY LOCATION TEMP3. * ********************************************************************** * $STSH NOP STB TEMP3 SAVE ID-SEGMENT ADDRESS LDB STRGA GET POINTER TO HEAD OF STACK. STSH1 LDA B,I GET BLOCK ADDRESS AND CLE,SZA,RSS IF ZERO, THEN END JMP STSH9 OF STACK. INA OTHERWIZE,INCREMENT IT,AND GET LDA A,I GET ID-SEGMENT ADDRESS. ELA,RAR SAVE EXTRA WORD BIT IN E REG. CPA TEMP3 IF THIS IS CORRECT JMP STSH2 BLOCK, THEN RETURN. LDB B,I OTHERWIZE, GO CHECK JMP STSH1 NEXT BLOCK. * STSH2 LDA B,I SET A=BLOCK ADDRESS AND STSH9 JMP $STSH,I RETURN. * ********************************************************************** * * $CVWD CONVERTS NEGATIVE CHARACTER COUNT OR POSITIVE WORD COUNT * TO POSITIVE CHARACTER COUNT. * * CALLING SEQUENCE: * LDB COUNT(+ = WORDS, - = CHARACTERS) * JSB $CVWD * * RETURN: * B = +CHARACTERS * ********************************************************************** * $CVWD NOP SSB CONVERT NEGATIVE CMB,INB,RSS CHARACTERS AND BLS POSITIVE WORDS TO JMP $CVWD,I POSITIVE CHARACTERS. HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MO‚?þúDULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 Jb$"EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $LST ™H$ÿÿ ÿý»P ÿ92067-18022 1805 S C0122 &$ALC4 RTE-IV MEMORY ALLOCATION             H0101 H(þúASMB,R HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * NAME: $ALC * SOURCE: 92067-18022 * RELOC: PART OF 92067-16014 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALC,0 92067-16014 REV.1805 741120 * ENT $ALC,$RTN,$PNTR EXT $LIST,$WORK * * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * * IF, WHEN BUFFER REQUESTED, - (AVMEM) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * * JSB $ALC * DEC 32767 * * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH C¼þú* THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * * * REGISTERS ARE NOT PRESERVED * SKP $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA AVMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX ywþú SET BUFFER LENGTH STB A BUFFER ADDRESS TO A CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB AVMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS JMP $ALC,I AND RETURN * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA AVMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN LDA $RTN,I # OF WORDS RETURNED (X) ADA DM2 SSA <2? JMP RETNR BUFFER TO SMALL - IGNORE LDA PNTRA GET THE STARTING POINTER .R11 STA BAD BAD _ AAD INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS CPB PNTRA IF LOCAT POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT THE NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER ¯ÆLENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA AVMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB AVMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP $RTN,I RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA AVMEM COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP $RTN,I NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * * * PNTRA DEF AVMEM DUMMY BLOCK ADDRESS(DON'T MESS!) AVMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) $PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA AVMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * BSS 0 LENGTH OF PROGRAM * END $ALC 6Pÿÿ ÿý¼Å ÿ92067-18022 1805 S C0122 &$ALC4 RTE-IV MEMORY ALLOCATION             H0101 H(þúASMB,R HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * NAME: $ALC * SOURCE: 92067-18022 * RELOC: PART OF 92067-16014 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALC,0 92067-16014 REV.1805 741120 * ENT $ALC,$RTN,$PNTR EXT $LIST,$WORK * * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * * IF, WHEN BUFFER REQUESTED, - (AVMEM) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * * JSB $ALC * DEC 32767 * * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH C¼þú* THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * * * REGISTERS ARE NOT PRESERVED * SKP $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA AVMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX ywþú SET BUFFER LENGTH STB A BUFFER ADDRESS TO A CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB AVMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS JMP $ALC,I AND RETURN * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA AVMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN LDA $RTN,I # OF WORDS RETURNED (X) ADA DM2 SSA <2? JMP RETNR BUFFER TO SMALL - IGNORE LDA PNTRA GET THE STARTING POINTER .R11 STA BAD BAD _ AAD INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS CPB PNTRA IF LOCAT POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT THE NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER ¯ÆLENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA AVMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB AVMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP $RTN,I RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA AVMEM COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP $RTN,I NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * * * PNTRA DEF AVMEM DUMMY BLOCK ADDRESS(DON'T MESS!) AVMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) $PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA AVMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * BSS 0 LENGTH OF PROGRAM * END $ALC 6Pÿÿ ÿý½Æ ÿ92067-18023 1805 S C0222 &4OCM1 RTE-IV COMMANDS             H0102 ¾cþúASMB,L,C HED RTE-IV SYSTEM COMMAND MODULE * * NAME: OCMD4 * SOURCE: 92067-18023 * RELOC: PART OF 92067-16014 * PGMR: D.L.S.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OCMD4,0 92067-16014 REV.1805 771102 ENT $LUPR,$EQST,$CHTO EXT $CVEQ,$CNV1 EXT $CNV3,$UNLK,$XXUP,$DLAY,$DMEQ,$SCD3,$ETEQ EXT $CKLO,$BITB,$INER,$XCQ,$MSEX A EQU 0 B EQU 1 SUP * ***************************************************************** * * RTE SYSTEM PROGRAM OCMD4: * * OCMD4 PROVIDES EXECUTION OF THE FOLLOWING SYSTEM COMMANDS: * * LU,P1[,P2[,P3]] LU STATUS AND LU CHANGE. * EQ,P1[,P2] EQT STATUS AND BUFFERING CHANGE. * TO,P1[,P2] SHOW TIMEOUT OR CHANGE TIMEOUT. * * ******************************************************************* * $EQST STA P1 STB P2 JSB IODNS CHECK P2 AND SET EQT ADDRESSES. LDB P2 CHECK PARAMETER #2. LDA EQT4,I GET EQT CHANNEL WORD. CLE,SSB,RSS IF P2=-1, OUTPUT EQT STATUS JMP EQST1 OTHERWIZE, SET BUFFERING BIT IN EQT. * JSB $CNV1 OUTPUT THE EQT STATUS. STA EQMS1 CONVERT THE CHANNEL NUMBER. * LDA EQT4,I CONVERT ASR 6 UNIT #. AND B37 JSB $CNV1 STA EQMS5 LDA EQT4,I SET LDB EQBLK D (FOR DMA CHANNEL) RAL,SLA OR LDB EQBD 0 STB EQMS3 LDB EQBLK SET SSA B (FOR AUTOMATIC BUFFERING) LDB EQBB OR STB EQMS4 0 LDA EQT5,I SET ºˆþú RAL,RAL AVAILABILITY AND .3 STATUS ADA EQBLK (0,1,2,OR3) STA EQMS6 LDA EQT5,I CONVERT ALF,CLE,ALF EQUIPMENT ADA B3000 TYPE (SET HIGH BITS TO JSB $CNV1 FOOL LEADING BLANK GENERATOR) STA EQMS2 DV.NN. LDA EQMSA (A) = ADDRESS OF REPLY JMP $MSEX RETURN. * EQST1 ERB ROTATE BIT 1 TO E RAL,RAL AND PUT IN ERA,RAR 14 OF EQT4 STA EQT4,I AND RESTORE JMP $XCQ ALL DONE * EQMSA DEF *+1 DEC -20 ASC 1, EQMS1 NOP I/O CHANNEL # EQBD ASC 2, DV. EQMS2 NOP EQUIP TYPE CODE EQMS3 NOP D OR 0 EQMS4 NOP B OR 0 ASC 1, U EQMS5 NOP UNIT # EQMS6 NOP AVAILABILITY * EQBLK ASC 1, 0 EQBB ASC 1, B * .2 DEC 2 .3 DEC 3 B37 OCT 37 * SKP * **************************************************************** * * 'LOGICAL UNIT' STATEMENT * * FORMAT: LU,P1(,P2(,P3)) WHERE: * * P1 = LOGICAL UNIT # * P2 = 0, EQT ENTRY #, OR NOT PRESENT * P3 = SUBCHANNEL # OR NOT PRESENT IN WHICH * CASE IT DEFAULTS TO ZERO * * ACTION: 1) P2 AND P3 NOT INPUT; THE ASSIGNMENT OF * LOGICAL UNIT P1 IS PRINTED AS: * ' LU #P1 = EXX SYY D ' * WHERE: * P1=LOGICAL UNIT NUMBER * XX=EQT NUMBER * YY=SUBCHANNEL NUMBER * D=IF PRESENT, THE LU IS DOWN. * 2) P2 = 0; THE ASSIGNMENT IS RELEASED, * I.E, THE CORRESPONDING * WORD IN THE DEVICE * REFERENCE TABLE (DRT) * IS SET = 0. * 3) N2 # 0 THE LU'S ASSIGNMENT IS CHANGED TO POINT * TO THE NEW EQT AND SUBCHANNEL. ANY I/O * ASSOCIATED Wr þúITH THE OLD EQT AND SUBCHANNEL * (DEVICE)IS TRANSFERRED TO THE NEW DEVICE. * * THE FOLLOWING LOCATIONS ARE USED AS TEMPORARIES BY LUPR: * := LU NUMBER := P3,P2 NEW SUBCH-EQT WORD * :=DRT WORD 1 ADDRESS :=DRT WORD 2 ADDRESS * :=EQT1 ADDRESS OF OLD :=NEW DEVICE'S EQT NUMBER * DEVICE * :="NEW DEVICE'S EQT IS :=NEW DEVICE SPLIT SUB. * DOWN" FLAG. * :=NEW DEVICE'S MAJOR LU * :#0 INITIATE REQUEST :#0 MORE THAN ONE LU FOR * ON NEW DEVICE UP OLD DEVICE * :=SEE SUB. SDRT2 * :=OLD SUBCH-EQT WORD :=OLD DEVICE MAJOR-LU * :=OLD DEVICE MAJOR-LU :=OLD DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * :=NEW DEVICE MAJOR-LU :=NEW DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * **************************************************************** * SKP $LUPR STA P1 STB P2 CPB M1 IF P2= -1, PRINT CURRENT ASSIGNMENT. JMP LUPR0 * CPA .2 PREVENT REASSIGNMENT JMP $INER OF LU 2 AND LU 3 CPA .3 JMP $INER * LUPR0 CMA,CLE,INA,SZA,RSS ILLEGAL LU NUMBER JMP $INER IF THE LU IS LESS ADA LUMAX THEN 1 OR GREATER CCA,SEZ,RSS THEN LUMAX. JMP $INER * ADA P1 SAVE ADA DRT DRT WORD STA DRT1A 1 AND ADA LUMAX WORD 2 STA DRT2A ADDRESSES. * CCE,INB,SZB,RSS IF P2=-1, THEN GO(SET E=1 FOR LUPR3) JMP LUPR3 PRINT CURRENT ASSIGNMENT. * LDB DRT PREVENT CLE,INB ASSIGNMENT(CLEAR E) DLD B,I OF ANY OTHER CPB P2 DEVICE SZB,RSS TO CPA P2 LU 2 JMP $INER › þú OR 3. SKP * LDA P2 CONSTRUCT I/O AND B174K SUBCHANNEL WORD ELA,RAL FOR NEW DEVICE(E WAS ALF,RAL CLEARED)WITH LOWER CLB,SEZ BITS IN BITS 2-5 ADA B20K AND UPPER BIT IN STA WORD2 BIT 13(CLEAR B REG). * STB NINTF CLEAR "NEW DEVICE I/O INITIATE" FLAG. STB TTEMP CLEAR "NEW DEVICE EQT IS DOWN" FLAG. * LDA DRT1A,I SAVE AND C3700 OLD SUBCH-EQT STA OSBEQ WORD AND AND B77 EQT1 SZA,RSS JMP LUP25 ADA M1 OF MPY .15 OLD(CLEAR B REG.) ADA EQTA DEVICE'S LUP05 STA OEQT1 EQT. * LDA P2 CHECK LEGALITY OF AND B77 N2(NEW EQT)AND STA NEQT# SZA,RSS SET THE EQT JMP LUPR2 * JSB IODNS ADDRESSES. * * SPECIAL TEST TO SEE IF MOVING I-O TO A DISK.IF SO, ERROR. * LDA EQT1 IS NEW ADA .4 DEVICE A LDA A,I AND B36K DISK? CPA B14K JMP LU100 YES, SO GO DO CHECK. * **************************************************************** * DETERMINE IF THE OLD DEVICE IS UP OR DOWN. **************************************************************** * LUPR1 LDA DRT2A,I CHECK IF OLD SSA DEVICE IS JMP DNXX UP OR DOWN. SKP **************************************************************** * OLD DEVICE IS UP. IS THERE MORE THAN ONE LU FOR IT? **************************************************************** UPXX LDA LUMAX SET UP TO SCAN THE LUS CMA,INA STA XLUS IF COUNT GOES TO ZERO THERE IS BUT ONE. LDB DRT GET ADDRESS OF THE FIRST ONE LUCO LDA B,I GET AN ENTRY AND C3700 DROP POSSIBLE LOCK BITS CPA OSBEQ IF NOT THE SAME CPB DRT1A OR IF SAME ENTRY INB,RSS SKIP TO GO ROUND AGAIN zÄþú JMP MLUS ELSE THERE ARE MORE THAN ONE * ISZ XLUS COUNT DOWN THE ENTRIES JMP LUCO AROUND WE GO *************************************************************** * IF THE DEVICE IS UP AND HAS MORE THAN ONE LU THEN ITS * QUEUE IS NOT MOVED. THIS PREVENTS UNWANTED LOSS OF DATA * CAUSED BY UNRELATED LU CHANGES. *************************************************************** * * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. **************************************************************** MLUS LDA NEQT# CHECK IF NEW SZA,RSS DEVICE IS THE JMP UPBIT BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP UPDN NEW DEVICE IS DOWN. ISZ TTEMP NEW DEVICE'S EQT IS DOWN. SKP **************************************************************** * THE OLD AND NEW DEVICE ARE UP OR THE OLD DEVICE IS UP * AND THE NEW DEVICE'S EQT IS DOWN. ******************************************************************* UPUP LDA P1 NEW DEVICE IS UP. CPA .1 CHECK IF OLD JMP UPLU1 DEVICE IS LU 1. * UPUP5 LDA XLUS IF ANOTHER LU EXISTS SZA THEN JMP UPMU DON'T MOVE THE QUEUE * LDB OEQT1,I UNLINK I/O REQUESTS FROM THE RBL,CLE,ERB OLD DEVICE. SKIP THE SZB,RSS LDB OEQT1 LDA DRT2A FIRST I-O REQUEST. JSB $UNLK DEF OSBEQ * LDB DRT2A,I RESET WORD 2 OF THE I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. LDA OEQT1 LDB DRT2A,I LINK THE I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STB DRT2A,I CLEAR UP THE CURRENT LU STA NINTF SET THE MUST START NEW I/O FLAG UPMU LDA TTEMP IS THE NEW DEVICE'S SZA,RSS EQT DOWN? JMP LUP50 NO, SO CONTINUE. * LDB EQT1,I YES, SO RBL,CLE,ERB UNSTACK SZB,RSS NORMAL USER LDB EQT1 J—þú I/O(SKIP FIRST JMP DNDE5 ENTRY)AND CONTINUE. * XLUS NOP SKP UPLU1 LDA EQT5,I GET DEVICE AND B374C TYPE OF THE SZA,RSS NEW DEVICE AND SEE JMP UPLU2 IF IT IS LEGAL CPA B2400 (00 OR 05 SUB 0) RSS FOR A SYSTEM JMP $INER CONSOLE. LDA WORD2 SZA JMP $INER * UPLU2 LDA TTEMP MAKE SURE NEW DEVICE'S SZA EQT IS NOT DOWN. JMP $INER LDA EQT1 SET NEW SYSTEM CONSOLE STA SYSTY ADDRESS IN BASE PAGE. JMP UPUP5 GO TRANSFER I/O. * * UPBIT LDA P1 CHANGING AN UP DEVICE TO CPA .1 THE BIT BUCKET. ERROR JMP $INER IF THE OLD DEVICE IS JMP UPUP5 THE SYSTEM CONSOLE. SKP ****************************************************************** * THE OLD DEVICE IS UP AND THE NEW DEVICE IS DOWN. ********************************************************************* UPDN STB TTEMP SAVE LU# OF FIRST LU(MAJOR LU)OF NEW DEVICE. STA NDML2 SAVE DRT WORD 2 ADDRESS OF NEW-MAJOR-LU. ADB M1 COMPUTE NEW- ADB DRT MAJOR-LU STB NDML1 DRT WORD 1. * LDB P1 CHECK IF THIS CPB .1 WILL SET LU JMP $INER 1 DOWN. * LDB TTEMP CHECK IF LU IS CMB,INB LOWER THEN THE ADB P1 MAJOR LU FOR SSB,RSS THE NEW DOWNED JMP UPDN5 DEVICE. * LDB A,I LU IS BELOW NEW DEVICE'S MAJOR LU. STB DRT2A,I MOVE I/O FROM MAJOR LU TO LU. LDB XLUS IF CURRENT DEVICE STILL HAS AN LU SZB THEN JMP DNDN6 SKIP THE MOVE * LDB DRT2A CHASE DOWN THIS DOWN I/O JSB CHASE QUEUE TO ITS END. LDA B * LDB OEQT1,I UNLINK I/O REQUESTS FOR THE RBL,CLE,ERB OLD DEVICE AND ADD TO SZB,RSS LDB OEQT1 JSB $UNLK !™þú THE I-O QUEUE. SKIP FIRST ENTRY. DEF OSBEQ JMP DNDN6 GO MODIFY LU'S FOR THE NEW DEVICE. SKP UPDN5 LDB XLUS IF WE STILL HAVE A LU FOR THIS DEVICE SZB THEN JMP UPDN6 SKIP THE MOVE * LDB NDML2 NEW DEVICE'S MAJOR LU IS BELOW LU. JSB CHASE CHASE DOWN THIS I-O QUEUE LDA B TO ITS END. * LDB OEQT1,I UNLINK I/O REQUESTS RBL,CLE,ERB FOR THE OLD DEVICE SZB,RSS (SKIP FIRST REQUEST)AND LDB OEQT1 ADD TO DOWNED LU I/O JSB $UNLK QUEUE. DEF OSBEQ * UPDN6 LDA TTEMP SET ADA MSIGN THE LU STA DRT2A,I DOWN. JMP LUP50 GO FINISH. SKP **************************************************************** * THE OLD DEVICE IS DOWN. ******************************************************************* * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. * DNXX LDA NEQT# CHECK IF SZA,RSS NEW DEVICE JMP DNUP IS BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP DNDN NEW DEVICE IS DOWN. JMP DNDNE NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE IS UP(OR BIT BUCKET) ********************************************************************** DNUP JSB DETOL DETERMINE THE OLD-MAJOR-LU. LDB ODML2,I RESET WORD 2 OF I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. * LDA OEQT1 LDB ODML2,I LINK OLD DEVICE'S I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STA NINTF * JSB FOLDD FIX ALL OLD DOWNED LU'S THAT NEED IT. JMP LUP52 ****************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE'S EQT IS DOWN. ********************************************************************* DNDNE JSB DETOL DETERMINùÔþúE OLD DEVICE'S MAJOR-LU LDA OEQT1 LINK OLD DEVICE'S I/O REQUESTS ON THE LDB ODML2,I NEW DEVICE'S EQT. JSB $XXUP STA NINTF * JSB FOLDD FIX OLD DOWNED DEVICE'S LU'S THAT NEED IT. * LDB EQT1 UNLINK ANY NORMAL USER DNDE5 CLA I/O FROM THE NEW DEVICE'S EQT. JSB $UNLK DEF P2 JMP LUP50 SKP **************************************************************** * THE OLD AND NEW DEVICES ARE DOWN. ********************************************************************* DNDN STB TTEMP SAVE NEW DEVICE MAJOR-LU AND STA NDML2 ITS DRT WORD 2 ADDRESS. ADB M1 SAVE ITS ADB DRT DRT WORD STB NDML1 2 ADDRESS. * JSB DETOM DETERMINE THE OLD DEVICE'S MAJOR-LU. * LDB TTEMP CHECK IF NEW CMB,INB NEW DEVICE'S MAJOR ADB P1 LU IS < LU. SSB,RSS LU < NEW DEVICE'S MAJOR LU. JMP DNDN5 * DNDN9 LDB DRT2A LU IS BELOW NEW DEVICE'S MAJOR LU. JSB CHASE CHASE DOWN THE LU'S I/O LDA NDML2,I QUEUE TO ITS END AND RAL,CLE,ERA ADD THERE THE NEW DEVICE'S STA B,I MAJOR-LU I/O QUEUE. * LDA OMJLU IF OLD MAJOR LU EQUALS TO CPA P1 LU, THEN FIX UP OLD DEVICE'S RSS LU'S TO INCLUDE THE NEW OLD- JMP DNDN6 MAJOR-LU. OTHERWIZE, CONTINUE. * LDA OSBEQ A=OLD SUBCHANNEL-EQT WORD. LDB DRT1A INB B=LU WORD 1 ADDRESS + 1. JSB FXOLD GO FIX OLD DEVICE'S LU'S. * DNDN6 LDA P2 MODIFY ALL LU'S STA SSBEQ FOR NEW DEVICE LDA P1 TO POINT TO IOR MSIGN LU. LDB NDML1 CLE JSB SDRT2 JMP LUP50 SKP DNDN5 SZB,RSS CASE WHERE OLD AND NEW DEVICES ARE JMP $XCQ BOTH DOWN AND EQUAL. * LDB NDML2 LU > NEW DEVICE MAJOR-LU. JSB CHASE CHASE DOWN THE N2YþúEW MAJOR-LU'S. CCA I/O QUEUE TO ITS END. * ADA DRT CALCULATE DRT ADA OMJLU WORD 2 OF STA ODML1 OLD MAJOR-LU. * ADA LUMAX LINK OLD MAJOR LU I/O LDA A,I RAL,CLE,ERA QUEUE TO END OF NEW STA B,I MAJOR I/O QUEUE. * LDA TTEMP MAKE LU POINT TO IOR MSIGN NEW DEVICE MAJOR-LU. STA DRT2A,I * LDA OMJLU IF LU = OLD CPA P1 MAJOR-LU, RSS THEN CONTINUE, JMP LUP50 ELSE DONE. * LDA OSBEQ FIX OLD LDB ODML1 DEVICE'S INB LU'S. JSB FXOLD SKP ****************************************************************** * FINISH SWITCHING LU ******************************************************************* LUP50 LDA DRT1A,I SET UP DRT AND B3700 WORD 1 WITH ADA P2 NEW DEVICE AND STA DRT1A,I OLD LOCK FLAG. * LUP52 LDA NINTF CHECK IF AN I/O SZA,RSS OPERATION MUST BE JMP LUP55 INITIATED ON THE NEW EQT. CPA $DMEQ YES, IF THE NEW DEVICE IS THE BIT BUCKET, JMP LUP80 THEN SET A FLAG FOR IOCX. JSB $DLAY IF NOT,SET A TIMEOUT FOR INITIATION. * LUP55 LDA .4 SCHEDULE ANY WAITERS ON JSB $SCD3 DOWNED DEVICES. LDA OEQT1 SET UP THE OLD DEVICE'S JSB $ETEQ EQT ADDRESSES, CHECK BUFFER JSB $CKLO LIMITS AND SCHED WAITERS. * LDA P1 IF LU CHANGED WAS CPA .1 SYSTEM CONSOLE THEN JMP LUP70 ISSUE A MESSAGE. JMP $XCQ * LUP70 LDA NSYSM ISSUE '**' MESSAGE TO JMP $MSEX CONSOLE. * LUP80 ISZ $BITB SET A FLAG FOR IOCX SO THAT JMP LUP55 IT WILL CLEAN OUT THE BIT BUCKET. * LUPR2 LDA $DMEQ SET UP DUMMY JSB $ETEQ EQT ADDRESES FOR JMP LUPR1 THE BIT BUCKET. * LUP25 LDA $DMEQ JMP LUP05 * SKP * ¾·þú SPECIAL TEST TO DISALLOW SWTCHING AN LU TO A DISK IF THE * LU HAS I/O STACKED ON IT(OR IT'S EQT). * LU100 LDA DRT2A,I DOES THE LU RAL,CLE,ERA HAVE ANY I/O SZA HUNG ON IT? JMP $INER YES, ISSUE ERROR MESSAGE. * SEZ IF NO I/O AND LU IS DOWN, JMP LUPR1 THEN ALLOW SWTCH. LDA OEQT1,I OTHERWIZE, IF UP AND NO I/O IS SZA,RSS HUNG ON THE OLD EQT, THEN JMP LUPR1 ALLOW SWTCH. * JMP $INER IF I-O HUNG ON OLD EQT,ISSUE ERROR MESS. * ****************************************************************** * DISPLAY LU AND IT'S STATUS ****************************************************************** * LUPR3 LDA P1 GET AND JSB $CNV1 SAVE THE STA LUMSG+2 ASCII LU #. LDA DRT1A,I GET AND AND B77 SAVE JSB $CNV1 THE ASCII STA LUMSG+5 EQT #. LDA DRT1A,I CHECK IF AND B174K A SUBCHANNEL CCE,SZA IS SPECIFIED. JMP LUP14 LDA DBLBK IF SUBCHANNEL=0, STA LUMSG+6 THEN DO NOT DISPLAY JMP LUP15 THE SUBCHANNEL. * LUP14 LDB BLS IF SUBCHANNEL#0, STB LUMSG+6 THEN DISPLAY ALF,RAL THE ASCII JSB $CNV1 SUBCHANNEL. LUP15 STA LUMSG+7 LDB DBLBK CHECK IF LDA DRT2A,I THE DEVICE SSA IS UP OR LDB EQBD DOWN. IF STB LUMSG+8 DOWN, LDA LUMGA PRINT A "D". JMP $MSEX RETURN. SKP * * VARIABLES, CONSTANTS AND BUFFERS FOR LUPR * NSYSM DEF *+1 DEC -2 ASC 1,** * LUMGA DEF *+1 DEC -18 LUMSG ASC 9,LU #N1 = EXX SYY * B174K OCT 174000 B176K OCT 176000 B20K OCT 20000 B14K OCT 14000 B36K OCT 36000 B77 OCT 77 B3700 OCT 3700 C3700 OCT 174077 MSIGN OCT 100000 .1 DEC 1 .4 DEC 4 .15 DEC 15 M1 DEC -1 * DBLBK ASC 1, BLS ASC 1, S * P1#sþú NOP P2 NOP DRT1A NOP DRT2A NOP NINTF NOP TTEMP NOP OEQT1 NOP NEQT# NOP WORD2 NOP OSBEQ NOP OMJLU NOP OLD DEVICE MAJOR LU. ODML1 NOP OLD DEVICE MAJOR-LU DRT WORD 1 ADDRESS. ODML2 NOP OLD DEVICE MAJOR-LU DRT WORD 2 ADDRESS. NDML1 NOP NEW DEVICE MAJOR-LU DRT WORD 1 ADDRESS. NDML2 NOP NEW DEVICE MAJOR-LU DRT WORD 2 ADDRESS. SKP ***************************************************************** * * SUBROUTINE CKNLU: * * CKNLU DETERMINES IF THE DEVICE(LU) OR THE EQT POINTED TO BY * THE SUBCHANNEL-EQT WORD IS UP OR DOWN. * * CALLING SEQUENCE: * := SUBCHANNEL IN BITS 11-15, EQT IN BITS 0-5. * :=ADDRESS OF FIFTH EQT WORD. * JSB CKNLU * * RETURN: * (P+1) DEVICE IS DOWN. * (P+2) EQT IS DOWN. * (P+3) DEVICE IS UP OR NO DEVICE FOUND. * ALL REGISTERS ARE VIOLATED. * AT (P+1): :=MAJOR LU # OF DOWNED DEVICE. * :=MAJOR LU DRT WORD 2 ADDRESS. * USES SDRT2 AS A TEMPORARY. * **************************************************************** * CKNLU NOP LDA EQT5,I CHECK IF RAL,SLA THE EQT JMP CKNL0 IS UP OR SSB DOWN. JMP CKNL2 THE EQT IS DOWN. * CKNL0 LDB LUMAX CMB,INB STB SDRT2 LDB DRT CKNL1 LDA B,I DETERMINE AND C3700 IF THE CPA P2 NEW JMP CKNL7 DEVICE INB EXISTS. ISZ SDRT2 JMP CKNL1 JMP CKNL9 THE DEVICE DOES NOT EXIST. * CKNL7 ADB LUMAX DETERMINE IF THE DEVICE LDA B,I IS UP OR DOWN. SSA JMP CKNL8 CKNL9 ISZ CKNLU THE DEVICE IS UP, RETURN TO P+3. CKNL2 ISZ CKNLU THE EQT IS DOWN, RETURN TO P+2. JMP CKNLU,I RETURN. * CKNL8 STB A THE DEVICE IS DOWN. LDB LUMAX SET =DRT WORD 2 ADDumþúRESS. ADB SDRT2 SET =LU #. INB JMP CKNLU,I RETURN TO P+1. SKP **************************************************************** * SUBROUTINE SDRT2: * * SDRT2 WILL STORE THE A REG IN DRT WORD 2 FOR ANY DRT ENTRIES * WHICH CORRESPOND TO THE SUBCHANNEL AND EQT GIVEN IN P2. IF * ON ENTRY E=1, THEN SDRT2 WILL SCAN ONLY TO THE FIRST ENTRY * CORRESPONDING TO P2. IF E=0, THEN SDRT2 WILL SCAN THE ENTIRE * DRT FROM THE GIVEN ENTRY TO ITS END. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD FOR THE LU'S TO SCAN FOR: * BITS 5-0=EQT * BITS 15-11=SUBCHANNEL * :=DRT WORD 1 ADDRESS FROM WHICH TO BEGIN SCAN. * :=CONTENTS TO STORE INTO DRT WORD 2. * :=0 SCAN TO END OF DRT. * :=1 SCAN ONLY FOR FIRST ENTRY. * JSB SDRT2 * USES TEMPORARY LOCATIONS CKNLU,SDRT8,SDRT9 * RETURN: * NO REGISTERS ARE SAVED ON EXIT. * ON EXIT: * :=NEXT DRT WORD 1 ADDRESS TO BE SCANNED. * := LUMAX - LAST LU# SCANNED. ***************************************************************** * SDRT2 NOP STA CKNLU SAVE CONTENTS TO STORE INTO DRT WORD 2. LDA LUMAX SET ADA DRT CMA,INA UP ADA B STA SDRT9 COUNTER. STB SDRT8 SAVE ADDRESS OF FIRST DRT ENTRY TO SCAN. SZA,RSS JMP SDRT2,I * SDR29 LDA SDRT8,I SET CONTENTS AND C3700 OF DRT WORD 2 CPA SSBEQ AND COMPARE TO JMP SDR22 SUBCHANNEL-EQT WORD. SDR25 ISZ SDRT8 INCREMENT DRT ADDRESS. ISZ SDRT9 INCREMENT COUNT. JMP SDR29 CLA JMP SDRT2,I NO MORE ENTRIES, SO RETURN. * SDR22 LDB CKNLU FOUND AN ENTRY, LDA SDRT8 POSITION TO ADA LUMAX WORD 2 AND STB A,I STORE NEW CONTENTS. SEZ,RSS IF E=1, ;\NLH JMP SDR25 THEN CONTINUE SCAN. ISZ SDRT8 OTHERWIZE, INCREMENT DRT LDA SDRT9 ADDRESSES AND RETURN. INA JMP SDRT2,I * SDRT8 NOP SDRT9 NOP SSBEQ NOP * ********************************************************************* * * SUBROUTINE CHASE: * * CHASE WILL FIND THE END OF AN I/O QUEUE GIVEN IT'S HEAD. * * CALLING SEQUENCE: * :=ADDRESS OF HEAD OF I/O QUEUE. * JSB CHASE * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=ADDRESS OF LINK WORD OF LAST I/O REQUEST. * :=0 * ******************************************************************** * CHASE NOP CHASE CHAS1 LDA B,I DOWN RAL,CLE,ERA THE LU'S SZA,RSS I/O QUEUE JMP CHASE,I TO ITS LDB A END. JMP CHAS1 SKP * ***************************************************************** * * SUBROUTINE FXWD2: * * FXWD2 CHANGES THE SUBCHANNEL IN WORD 2 OF EACH I/O REQUEST ³lNÿÿþú* IN THE GIVEN I/O QUEUE. * * CALLING SEQUENCE: * :=NEW SUBCHANNEL: BITS 2-5=LOWER 4 BITS * BIT 13 =UPPER BIT. * :=POINTER TO FIRST I-O REQUEST =0 IF NO REQUESTS. * JSB FXWD2 * * RETURN: * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * FXWD2 NOP RBL,CLE,ERB STRIP POSSIBLE SIGN BIT. FWD21 SZB,RSS IF END OF I/O QUEUE, JMP FXWD2,I THEN EXIT. STB SDRT2 INB POSITION TO I/O LDA B,I CONTROL WORD. AND WD2SB STRIP OFF OLD SUBCHANNEL IOR WORD2 AND ADD IN NEW SUBCHANNEL. STA B,I LDB SDRT2,I FIX NEXT I/O REQUEST. JMP FWD21 * WD2SB OCT 157703 SKP * **************************************************************** * * SUBROUTINE DETOL * * DETOL DETERMINES WHAT THE OLD DEVICE'S MAJOR-LU IS AND SETS * UP LOCATIONS OMJLU, ODML1 AND ODML2. * * CALLING SEQUENCE: * JSB DETOL * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=OLD DEVICE'S MAJOR-LU. * :=OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * :=OLD DEVICE'S MAJOR-LU DRT WORD 2 ADDRESS. **************************************************************** * DETOL NOP JSB DETOM DETERMINE THE OLD MAJOR-LU. ADA M1 COMPUTE THE ADA DRT OLD DEVICE'S STA ODML1 MAJOR-LU'S ADA LUMAX DRT WORD 1 STA ODML2 AND 2 ADDRESSES. JMP DETOL,I RETURN. * * ************************************************************************ * * SUBROUTINE DETOM: * * DETOM RETURNS THE OLD DEVICE'S MAJOR-LU. * * CALLING SEQUENCE: * JSB DETOM * * RETURN: * :=OLD DEVICE'S MAJOR-LU. * *********************************************************************** Mpþú* DETOM NOP LDA DRT2A,I DETERMINE IF LU IS RAL,CLE,ERA THE OLD MAJOR-LU. CLE,SZA,RSS IF NO QUEUE, THEN LU CCE IS THE OLD MAJOR-LU. STA B IF QUEUE ELEMENT IS < 2000, ADB B176K THEN QUEUE ELEMENT IS SEZ OLD MAJOR-LU. LDA P1 IF 2000 >= QUEUE ELEMENT, THEN ELEMENT STA OMJLU IS ADDRESS AND LU IS OLD MAJOR-LU. JMP DETOM,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FOLDD: * * FOLDD WILL FIX THE DRT WORD 2'S OF THE OLD DEVICE'S LU'S. * * CALLING SEQUENCE: * :=THE OLD DEVICE'S MAJOR-LU. * :=THE OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * JSB FOLDD * * RETURN: * ALL REGISTERS ARE MODIFIED. ***************************************************************** * FOLDD NOP LDA DRT1A,I SET UP DRT WORD 1 AND B3700 OF LU WITH THE NEW ADA P2 DEVICE AND OLD STA DRT1A,I LOCK FLAG. * CLA SET DRT WORD 2 OF STA DRT2A,I LU TO UP STATE. * LDA OMJLU IF LU=OLD DEVICE MAJOR-LU CPA P1 THEN FIX LU'S FOR THE RSS OLD DEVICE. JMP FOLDD,I OTHERWIZE, RETURN. LDA OSBEQ OLD MAJOR LU. LDB ODML1 INB JSB FXOLD FIX LU'S FOR THE OLD DEVICE. JMP FOLDD,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FXOLD: * * FXOLD WILL CREATE A NEW MAJOR-LU FOR THE OLD DEVICE, POINT * ANY OTHER LU'S FOR THIS DEVICE TO THE MAJOR-LU, AND SET ALL * THESE LU'S DOWN. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD OF THE LU TO SCAN FOR. * :=DRT WORD 1 ADDRESS TO BEGIN SCAN. * JSB FXOLD * CALLS SUBROUTINE SDRT2 * * REUTRN: * NO REGISTERSKEþú ARE SAVED. * ***************************************************************** * FXOLD NOP STA SSBEQ LDA MSIGN CREATE A NEW CCE OLD-MAJOR- JSB SDRT2 LU. SZA,RSS IF A=0, THEN NO OTHER JMP FXOLD,I LU'S ON OLD DEVICE. * ADA LUMAX OTHERWIZE, POINT IOR MSIGN ALL OTHER LU'S LDB SDRT8 FOR OLD DEVICE CLE TO THE NEW JSB SDRT2 OLD-MAJOR-LU. JMP FXOLD,I RETURN. SKP * **************************************************************** * * ' DEVICE TIME-OUT PARAMETER ' STATEMENT * * FORMAT: TO,P1,P2 WHERE * * P1 = EQT # * P2 = TIME-OUT PARAMETER OR -1 * * ACTION: IF P2 = -1, A SECOND PARAMETER WAS NOT * RECEIVED FROM THE MESSAGE PROCESSOR; * THEREFORE, PRINT THE CURRENT TIME-OUT * PARAMETER OF DEVICE P1. * * BOTH P1 AND P2 PRESENT, ASSIGN P2 AS THE * NEW TIME-OUT PARAMETER FOR DEVICE P1. * ***************************************************************** * $CHTO STA P1 STB P2 JSB IODNS CHECK VALIDITY OF EQT # LDB P2 LOOK AT P2 SZB,RSS IF N2 ZERO, DISABLE JMP CHTO2 TIME-OUT FOR DEVICE * INB,SZB IF N2 = -1, OUTPUT T-O PARAMETER JMP CHTO1 OTHERWISE, ENTER NEW T-O VALUE * LDA EQT14,I CONVERT T-O PARAMETER CCE,SZA TO DECIMAL ASCII B3000 CMA JSB $CNV3 LDB A,I GET THE HIGH WORD ADB B164C ADD '=' - 'BLANK' STB TOMS+3 CCE,INA DLD A,I STORE IN MESSAGE DST TOMS+4 * LDA P1 CONVERT EQT # JSB $CNV1 TO DECIMAL ASCII STA TOMS+2 STORE INTO MESSAGE LDA TOMSA JMP $MSEX RETURN. SKP CHTO1 CMB,INB ERROR IF ATTEMPT LDA EQT5,I TO SET TYPE 0 OR 5 AND B374C DEVICE TÁIME-OUT SZA VALUE TO LESS THAN CPA B2400 FIVE SECONDS. RSS JMP CHTO2 OTHERWISE, STORE * LDA .500 NEW TIME-OUT ADA B VALUE. SSA,RSS JMP $INER * CHTO2 STB EQT14,I JMP $XCQ RETURN WITHOUT MESSAGE. * TOMSA DEF *+1 DEC -12 TOMS ASC 2,TO# NOP ASC 1, = NOP NOP * .500 DEC 500 B164C OCT 16400 B2400 OCT 2400 B374C OCT 37400 SKP IODNS NOP STA B IF CMB,INB,SZB EQT SSA NUMBER CCB,RSS IS ZERO ADB EQT# SSB THEN TAKEE, JMP $INER ERROR EXIT. JSB $CVEQ OTHERWIZE, SET EQT ENTRY ADDRESSES. JMP IODNS,I RETURN. * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT14 EQU .+83 * SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * ORG * LENGTH OF SYSTEM COMMAND MODULE. END $EQST ~hÿÿ ÿý¿Ö ÿ92067-18024 1840 S 0122 RTE-IV PERR              H0101 ÖâþúASMB,R,L,C *** RTE-IV PARITY ERROR MODULE *** * DATE: 7/26/77 * NAME: PERR4 * SOURCE: 92067-18024 * RELOC: PART OF 92067-16014 * PGMR: E.WONG,M.MANLEY * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM PERR4,0 92067-16014 REV.1840 780731 ENT $PERR,$PETB EXT $CNV1,$CNV3,$SYMG,$ERMG,$XCQ,$UNPE,$MAXP EXT $MATA,$DMS,$ABXY,$CIC A EQU 0 B EQU 1 * * THIS MODULE OF RTE-IV HANDLES PARITY ERRORS. * CALL SEQUENCE FROM RTIO4: * JMP $PERR * <$PERR EXITS VIA $CIC,I> * * IF THE PARITY ERROR IS IN THE OPERATING SYSTEM OR CONFIGURATOR PROGRAM, * $PERR HALTS: HLT 5 * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS DETECTED IN A DCPC TRANSFER * WHILE THE OPERATING SYSTEM IS EXECUTING IN THE SYSTEM MAP, * $PERR HALTS: HLT 5,C * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS A SOFT ERROR (UNREPRODUCABLE), * $PERR PRINTS THE MESSAGES: * "PE @ #####" * "DMS STAT = ######" * * IF THE PARITY ERROR IS IN A PARTITION, * $PERR UNLINKS THE PARTITION FROM THE SYSTEM (UNTIL * NEXT BOOT UP). IT THEN RETURNS WITH : * "PART'N ## DOWN" * "PART'N ## DOWN" (IF THERE IS A MOTHER PTTN) * * IF THE PARITY ERROR WAS IN A MEMORY RESIDENT PROGRAM, * $PERR WILL ONLY PRINT THE FOLLOWING MESSAGES * (THESE WILL FOLLOW THE PARTITION DOWN MESSAGES * IN THE CASE OF A PARTITION RESIDENT PROGRAM): * "PE PG# ##### BAD" * "ABE ###¼gþú### ###### #" * "XYO ###### ###### #" * "PE XXXXX #####" * "XXXXX ABORTED" * * * NOTE THAT THE PROGRAM THAT ENCOUNTERED THE PARITY ERROR * IS NOT NECESSARIALLY THE CURRENTLY EXECUTING PROGRAM. * IE, THE PE ERROR MAY HAVE OCCURED DURING A DMA TRANSFER. SKP $PERR STA SAVA INTERRUPT SYSTEM IS TURNED OFF BY RTIO4 STB SAVB SAVE ALL USER REGISTERS LDA $CIC IN CASE OF POWER FAIL STA SAVAD ERA,ALS (DMS STATUS SAVED IN $DMS BY RTIO4) SOC INA STA SAVEO CXB STB SAVX CYB STB SAVY * LIB 5 RBL,CLE,ERB STB LOGPE SAVE LOGICAL PARITY ERROR ADDR LDA 5 PE ALREADY TURNED OFF PE INTERRUPTS STA SAV5 SAVE TRAP CELL 5 LDA JMPPE STA 5 SWITCH TRAP CELL TO LOCAL CLB STB PTNPE INITIALIZE PTTN# TO ZERO STB PEID INITIALIZE ID SEG ADDR TO ZERO STB PHYPG INITIALIZE PHYSICAL PAGE # TO ZERO JSB TRYPE TRY FOR P.E. IN SYSTEM MAP (B)=0 * * NOT IN SYSTEM MAP , TRY DCPC MAPS * DCPC? LDA SAVEU SAVE CURRENT USER MAP USA LDA INTBA,I SZA,RSS IS PORT A BUSY? JMP DCPCB NO, TRY PORT B * LDA SAVEP GET A COPY OF PORT A MAP PAA LDA RSTRP TO PUT INTO USER MAP USA LDB D6 JSB TRYPE TRY FOR P.E. IN PORT A (B)=6 * DCPCB LDA INTBA TRY IT IN PORT B INA LDA A,I SZA,RSS PORT B BUSY? JMP USEPE NO, WE'LL TRY USER MAP FINALLY. * LDA SAVEP GET A COPY OF PORT B MAP PBA LDA RSTRP TO PUT INTO USER MAP USA LDB D7 JSB TRYPE TRY FOR P.E. IN PORT B (B)=7 * * TRY USER MAP * USEPE LDA RSTRU RESTORE USER MAP USA CCB JSB TRYPE TRY FOR P.E. IN USER MAP (B)=-1 * * NOT IN SYSTEM, USER, PORT A, NOR PORT B. ‰‹þúSOFT PARITY ERROR. * SOFPE LDA SAV5 STA 5 RESTORE LOCATION 5 FOR $CIC CLE SET UP FOR OCTAL ASCII CONVERSION LDA $DMS GET THE DMS STATUS VALUE JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT2+8 CLE,INA DLD A,I AND THE SECOND DST SOFT2+9 * LDA LOGPE GET LOGICAL PARITY ERROR ADDR JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT1+4 AND PUT INTO BUFFER INA DLD A,I AND NOW THE LAST TWO DST SOFT1+5 * LDA SOFT1 GET THE 1ST MESSAGE JSB $SYMG AND REPORT TO USER LDA SOFT2 GET THE SECOND MESSAGE JSB $SYMG AND REPORT IT TOO * PEDON LDB SAVY RESTORE REGISTERS BEFORE RETURNING CBY LDB SAVX CBX LDA SAVEO CLO SLA,ELA STF 1 LDB SAVB CLA CPA $INT,I IS INT SYS ON? $INT=0? JMP INTON YES * STA $INT,I NO, CLEAR $INT LDA SAVA RESTORE A-REG JMP EXIT REENABLE PARITY ERROR AND RETURN * INTON LDA SAVA RESTORE A-REG STF 0 TURN ON INTERRUPT SYSTEM EXIT STF 5 REENABLE PARITY ERROR JRS $DMS * RETURN SAVAD EQU *-1 * * SOFT1 DEF *+1 DEC -10 ASC 5,PE @ XXXXX SOFT2 DEF *+1 DEC -18 ASC 9,DMS STAT = XXXXXX D6 DEC 6 D7 DEC 7 SAVA NOP SAVE A-REGISTER SAVB NOP SAVE B-REGISTER SAVEO NOP SAVE E AND O REGISTERS SAVX NOP SAVE X-REGISTER SAVY NOP SAVE Y-REGISTER $INT DEF $DMS+1 SAV5 NOP SAVE LOCATION 5 CONTENTS SAVEU DEF UMAP,I SAVE USER MAP IN MEMORY RSTRU DEF UMAP STORE MEMORY IN USER MAP SAVEP DEF PMAP,I SAVE PORT MAP IN MEMORY RSTRP DEF PMAP STORE MEMORY IN PORT MAP UMAP BSS 32 PMAP BSS 32 * * JMPPE JMP PELNK,I TRAP CELL INSTRUCTION FOR P.E. ôKþúORB PELNK DEF GOTPE BASE PAGE LINK TO PARITY ERROR CODE ORR * * * SUBROUTINE TO TRY TO GET PARITY ERROR AGAIN * CALL SEQUENCE: * (LOGPE) = LOGICAL ADDRESS * (B) = 0 TRY IT IN SYSTEM MAP * (B) # 0 TRY IT IN CURRENT USER MAP * JSB TRYPE CALL * NO PARITY ERROR OCCURRED * TRYPE NOP TRY TO VERIFY PARITY ERROR STB PORT SAVE MAP INDICATOR RETRY STF 5 ENABLE PARITY INTERRUPTS SZB DO IT IN SYSTEM MAP? JMP TRYUS NO, TRY IT IN USER MAP * LDA LOGPE,I DO READ OF SUSPECTED LOCATION JMP NOPE NO P.E. RETURN * TRYUS XLA LOGPE,I TRY READ OF SUSPECTED LOCATION NOP WAIT FOR MX HARDWARE TO COOL OFF! NOPE CLF 5 TURN OFF PE INT SO WE DON'T GET CONFUSED JMP TRYPE,I NO P.E. IN USER MAP, RETURN * * * GOT A PARITY ERROR FROM TRYPE SUBROUTINE * GOTPE LIA 5 GOT A PARITY ERROR RAL,CLE,ERA BUT IS IT A SECOND PE ERROR CPA LOGPE OR IS IT A VERIFICATION OF SAME ONE? RSS SAME, SKIP JMP RETRY SECOND ONE, TRY AGAIN TO VERIFY FIRST * LDA SAV5 WE CAN NOW SAFELY RESTORE STA 5 TRAP CELL FOR MP/DMS/PE INTERRUPTS * LDA LOGPE GET PE ADDR AND B76K GET LOGICAL PAGE # ALF RAL,RAL (A) = LOGICAL PAGE # SZB USING SYSTEM MAP? ADA B40 NO, USE USER MAP REG# CCB CBX (X) = -1 FOR READ 1 REGISTER LDB DPHYP READ IT INTO 'PHYPG' XMM READ MAP REGISTER LDA PHYPG AND B1777 KEEP LOWER 10 BITS STA PHYPG AS PHYSICAL PAGE NUMBER * LDB PORT SSB WAS THE PE IN USER MAP? JMP INPRG - YES, FIND PROGRAM * SZB WAS THE PE IN SYSTEM MAP? JMP DMAPE + NO, FIND THE CURRENT DMA REQUESTOR * * PARITY ERROR WAS V yþúERIFIED TO BE IN THE SYSTEM MAP * OR IT WAS IN A USER PAGE CONTAINING SYSTEM TABLES. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INSYS LDA PHYPG PE IN SYS OR SYS TABLES LDB LOGPE HLT05 HLT 5 102005 HALT FOR SYS PE ERROR JMP *-1 DON'T ALLOW TO PROCEED * * * PARITY ERROR WAS VERIFIED TO BE IN A DCPC TRANSFER * WHILE THE SYSTEM MAP WAS ENABLED. SINCE RTE IS NOT * REENTRANT, WE CANNOT PROCESS ERROR MESSAGES OR ABORT * ANY PROGRAMS BECAUSE WE MAY HAVE INTERRUPTED FROM * THAT CODE. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INDMA LDA PHYPG PE IN DCPC TRANSFER DURING SYS MAP LDB LOGPE HLTC5 HLT 5,C 103005 HALT FOR DCPC DURING SYS JMP *-1 DON'T ALLOW TO PROCEED * * * $PETB EQU * ENTRY POINT FOR ANALYSER PHYPG NOP $PETB+0 PHYSICAL PAGE NUMBER LOGPE NOP $PETB+1 LOGICAL PARITY ERROR ADDRESS PORT NOP $PETB+2 MAP CONTAINING PARITY ERROR PEID NOP $PETB+3 ID SEGMENT ADDRESS IF PROGRAM PE PTNPE NOP $PETB+4 PARTITION NUMBER(S) IF PROGRAM PE B1777 OCT 1777 B76K OCT 76000 B40 OCT 40 HED PARITY ERROR IN A PORT MAP DMAPE LDA $DMS GET DMS STATUS AT PE INTERRUPT RAL SSA,RSS DID WE INTERRUPT FROM SYSTEM MAP? JMP INDMA YES, HLT 5,C * LDA RSTRU RESTORE ORIGINAL USER MAP USA LDA PORT AND D1 ADA INTBA LDA A,I GET EQT ADDR OF DMA USER RAL,CLE,ERA CLEAR SIGN BIT FIRST LDB A,I GET EQT LINK WORD SSB,RSS DOING SYSTEM CLEAR? SZB,RSS OR EQT ALREADY UNLINKED? JMP INSYS YES, JUST GIVE SYS PE, DON'T KNOW PROG * LDA B INA LDA A,I GET CONTROL WORD TO CHECK T RAL SSA T=1 OR T=3? JMP INSYS YES, SYSTEM IS DOING I/O * SLA,RSS T=0? JMP PRGPE YES, USER DOING I/OVãþú * ADB D4 T=2. LDB B,I GET TYPE OF $XSIO CALL RBL,CLE,ERB CLEAR SIGN, KEEP IT IN (E) SZB,RSS IS IT A SYSTEM REQUEST? JMP INSYS YES, =0 OR 100000 JMP PRGPE NO, USER REQ (B)=ID SEG ADDR * * B77 OCT 77 D1 DEC 1 D4 DEC 4 D14 DEC 14 D15 DEC 15 D21 DEC 21 DPHYP DEF PHYPG HED PARITY ERROR IN A USER PROGRAM INPRG LDB XEQT IN CURRENT USER MAP SZB IS PROG = 0? JMP PRGPE NO, PROG. GET MAT INFO * LDB EQT1,I YES, MAYBE INTERRUPT DRIVER. RBL,CLE,ERB SZB,RSS I/O IN PROGRESS? JMP INSYS NO, DO SYS PE HALT * LDA B LEAVE POSSIBLE ID ADDR IN (B) INA LDA A,I CHECK T-FIELD IN CONTROL WORD RAL,RAL AND D3 SZA T=00? (UNBUFFERED USER) JMP INSYS NO, DO SYS PE HALT * PRGPE STB PEID (B)=ID SEG ADDR OF USER ADB D14 LDA B,I AND D15 GET PROG TYPE CPA D1 IS IT MEMORY RESIDENT PROG? JMP ABPRG YES, JUST ABORT PROG * LDA PEID ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PTTN # MPY MATSZ MULT BY MAT ENTRY SIZE ADA $MATA JSB MATAD SET UP MAT PTRS * LDA MLNK,I GET THE LINK WORD INA,SZA,RSS DID WE ALREADY UNDEFINE THIS GUY ? JMP PEDON YES, SO DON'T DO IT AGAIN. * LDA MADR,I IS PE IN MOTHER PTTN? SSA JMP MOMPE YES, HAVE TO FIND SUBPTTN * * PE IS IN A SUBPARTITION, FIND THE MOTHER PARTITION * JSB INPT? IS LOCATION IN PTTN? JMP INSYS NO, PE IN SYS PORTION OF USER MAP! LDB MLNK SUBPTTN OR REGULAR PTTN STB SUB HAS THE PE JSB $UNPE UNLINK FROM ALLOC LIST AND UNDEFINE NXSPE LDA MSUBL,I STA MOM SAVE POSSIBLE MOTHER PTTN ADDR SZA,RSS IS THIS A SUBPTTN? JMP BLDPT käþú NO, GO BUILD PTTN PE WORD * JSB MATAD YES, SEARCH FOR MOTHER PTTN LDA MADR,I SSA,RSS IS THIS THE MOTHER? JMP NXSPE NO, TRY NEXT SUBPTTN LINK * LDB MLNK YES, FOUND THE MOTHER LINK JSB $UNPE UNLINK MOTHER PTTN FROM FREE LIST JMP BLDPT FOUND IT ALL NOW * * * PE IS MOTHER PARTITION, FIND THE AFFECTED SUBPARTITION * MOMPE JSB INPT? IS PE ACTUALLY IN MOTHER PTTN? JMP INSYS NO, SAY IT IS IN SYS. LDB MLNK YES, PE OCCURRED IN MOTHER PTTN STB MOM SAVE FOR PTTN PE WORD JSB $UNPE UNLINK MOTHER PTTN FROM ALLOC LIST * NXSP2 LDA MSUBL,I CPA MOM DONE YET? JMP BLDP2 YES, PE JUST IN MOTHER PTTN * STA SUB NO, NEED TO FIND SUBPTTN WITH PE JSB MATAD JSB INPT? IS PE IN THIS SUBPTTN? JMP NXSP2 NO, TRY NEXT * SBPPE LDB MLNK UNLINK AND UNDEFINE JSB $UNPE THIS SUBPARTITION. * BLDPT LDB SUB GET PTTN/SUBPTTN OF PE JSB PTTNO CONVERT IT TO PTTN# STA PTNPE SET INTO BITS 0-7 OF PTTN PE WORD BLDP2 LDB MOM GET POSSIBLY MOTHER PTTN ADDR STB A CPB SUB BUT IF SAME AS SUBPTTN CLA THEN USE 0 IN PTTN PE WORD SZA THEN USE 0 IN PTTN PE WORD BITS 8-15 JSB PTTNO CONVERT TO PTTN# ALF,ALF IOR PTNPE STA PTNPE PUT INTO BITS 8-15 * UNCHN LDA MOM NOW UNCHAIN SUBPTTNS SZA,RSS ANY MOTHER PTTN AFFECTED? JMP UPEDN NO, USER PE. DONE. * UNCH2 JSB MATAD YES, MOTHER PTTN INVOLVED LDA MLTH,I AND C40K CLEAR "C" BITS IF SET STA MLTH,I LDA MSUBL,I GET NEXT SUBPTTN ADDR CLB STB MSUBL,I CLEAR LINK WORD CPA MOM DONE YET? JMP UPEDN YES, RETURN PE TO EXEC JMP UNCH2 NO, DO NEXT SUBPTTN * UPEDN JSB $MAXP RE-ESTABLISH MAX PTTN SIZES * * ¿0þú LDA PTNPE GET PTTN NUMBERS AND B377 SAVE LOWER BYTE SZA,RSS ANY SUBPTTN? JMP P1TRY NO, JUST MOTHER PTTN? * P1MOR CCE COUNT FROM 1 & DO DECIMAL CONVERSION. JSB $CNV1 CONVERT TO ASCII STA PEMSG+6 PUT INTO THE ERROR MESSAGE LDA PEMSG GET THE LOCATION OF THE ERROR MESSAGE JSB $SYMG TELL THE USER ABOUT THE DOWN PARTITION P1TRY LDA PTNPE GET THE PARTITION NUMBER(S) AGAIN ALF,ALF GET NEXT PARTITION TO LOWER BYTE AND B377 SAVE THE LOWER BYTE SZA,RSS IS THERE A MOTHER PARTITION ? JMP ABPRG NO,TELL BAD PAGE # STA PTNPE SAVE PARTITION # JMP P1MOR DO IT ONCE MORE * * ABPRG LDA PHYPG GET THE BAD PG# CCE DO DECIMAL CONVERSION FROM 0 JSB $CNV3 AND CONVERT TO DECIMAL ASCII LDB A,I GET THE 1ST WORD STB BDPG#+5 AND SAVE INA DLD A,I NOW GET THE LAST TWO DST BDPG#+6 LDA BDPG# GET THE ADDRESS OF THE MESSAGE JSB $SYMG AND SEND IT TO THE USER * LDB PEID GET ID SEG ADDR OF PROG SZB,RSS JMP PEDON STB XEQT FAKE OUT ABORT PROCESSORS CBX * LDA LOGPE GET LOGICAL PARITY ERROR ADDR SAX D8,I AND PUT IT INTO THE POINT OF SUSP WORD JSB $ABXY DUMP A,B,E,X,Y,O REGS LDA PE NOW GO ABORT THE PROGRAM LDB BLANK JSB $ERMG STF 5 REENABLE PARITY ERROR JMP $XCQ * * * B377 OCT 377 D8 DEC 8 * BLANK ASC 1, PEMSG DEF *+1 DEC -16 ASC 8,PART'N XX DOWN BDPG# DEF *+1 DEC -16 PE ASC 8,PE PG# XXXXX BAD * * * INPT? - VERIFY IF PE PAGE IN IS A PARTITION * * CALL SEQUENCE: * MATA ADDR SET UP BY MATAD * JSB INPT? * * * REGISTERS ARE MEANINGLESS * INPT? NOP IS PE IN PTTN PAGES? LDA MAè þúDR,I TRY TO FIND IF PE OCCURRED IN PAGES AND B1777 WITHIN THE SUBPTTN OR STA B IT WAS IN THE SYSTEM PAGES CMA,INA OF THE USER MAP ADA PHYPG SSA PE PAGE# < FIRST PAGE PTTN? JMP INPT?,I YES, PE BELOW PTTN PAGES. RETURN P+1 * LDA MLTH,I AND B1777 ADA B ADD #PAGES IN PTTN FOR LAST PAGE CMA,INA ADA PHYPG SZA SSA PE PAGE# > LAST PAGE PTTN? ISZ INPT? NO, PE IN PTTN PAGES. RETURN P+2 JMP INPT?,I YES, PE ABOVE PTTN PAGES. RETURN P+1 * * * PTTNO - CONVERT PTTN MAT ADDR TO PTTN NUMBER * * CALL SEQUENCE: * (B) = MAT ADDR * JSB PTTNO * * (A) = PTTN # * PTTNO NOP (B) = MAT ADDR LDA $MATA CMA,INA SUBTRACT BEGINNING OF MAT ADA B TABLE FROM MAT ADDR CLB DIV MATSZ DIVIDE BY #WORDS PER ENTRY INA JMP PTTNO,I RETURN PTTN # IN (A) * * C40K OCT 137777 D3 DEC 3 SUB NOP MAT ADDR OF SUBPTTN MOM NOP MAT ADDR OF MOTHER PTTN * * * SKP * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT !€ðþú * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *****!***** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * ************************************** * SET UP POINTERS TO ENTRY IN MAT * CALL: (A) = MAT ADDR * JSB MATAD * ************************************** * MATAD NOP STA MLNK SET MAT ENTRY POINTER ADA D3 STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LINK WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP * * * XMATA EQU 16“…B@<46B ADDR OF CURR MAT ENTRY INTBA EQU 1654B INTERRUPT TABLE ADDR EQT1 EQU 1660B WORD 1 ADDR OF CURRENT EQT XEQT EQU 1717B ADDR OF CURRENT PROG ID SEG * BSS 0 SIZE OF MODULE END $PERR «Bÿÿ ÿýÀÐ ÿ92067-18025 1926 S C0422 &4CNF1 RTE-IV CONFIGURATION             H0104 þúASMB,R,Q,C HED RTE IV CONFIGURATOR PART OF 92067-16014 NAM $CNFG,16 92067-16014 REV.1926 790610 * NAME: $CNFG * SOURCE: 92067-18025 * RELOC: PART OF 92067-16014 * PGMR: S.K.,D.J.V.,J.M.N * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * SUP ENT $CNFG,$EXIT,$PCHN,$WRRD,$USRS,$ABDP,$SMTB ENT $TRTB,$TREN,$NPGQ,$GDPG,$SAVE * EXT $SBTB,$SSCT EXT $XSIO,$CMST,$ENDS,$MRMP,$XCQ,$LIST EXT $CNV3,$PRSE,$PLP,$MATA,$MNP * * A EQU 0 B EQU 1 JSBCI EQU 5 EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B INTBA EQU 1654B INTLG EQU 1655B KEYWD EQU 1657B EQT1 EQU 1660B EQT3 EQU 1662B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B TBG EQU 1674B SYSTY EQU 1675B SKEDD EQU 1711B DUMMY EQU 1737B BPA2 EQU 1743B LBORG EQU 1745B SECT2 EQU 1757B * * $SAVE BSS 9 NOP NOP BSS 3 TBGSV NOP PRVSV NOP ACN1 DEF CN1 MRSET OCT 150077 * .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .31 DEC 31 .32 DEC 32 .40 DEC 40 .64 DEC 64 .168 DEC 168 * N1 DEC -1 N3 DEC -3 N4 DEC -4 N6 DEC -6 * B10 EQU .8 B37 EQU .31 B40 EQU .32 B41 OCT 41 B74 OCT 74 B75 OCT 75 B177 OCT 177 B1777 OCT 177700 B377 OCT 377 B1774 OCT 177400 B1776 OCT 1776 HLT4 OCT 102004 * YE ASC 1,YE NO ASC 1,NO SPACE ASC 1, * MSG4 AS†óþúC 13,CURRENT I/O CONFIGURATION: MSG5 ASC 8,SELECT CODE = MSG6 ASC 6,EQT ,TYPE MSG8 ASC 4,PRIV I/O MSG10 ASC 25,CURRENT SELECT CODE#,NEW SELECT CODE#?(/E TO END) MSG12 ASC 20,NEW I/O CONFIGURATION PERMANENT?(YES/NO) MSG21 ASC 13,PHYSICAL MEM SIZE?(#PAGES) AMSG5 DEF MSG5 AMSG6 DEF MSG6 AMSG8 DEF MSG8 ACNFX DEF *+1 SWREG ASC 3,$CNFX TEMP EQU ACNFX CTRCL EQU SWREG+1 CINTB EQU SWREG+2 OLSTB BSS 56 * * * * $CNFG NOP SVTBL CLC 0 CLEAR ALL INTERRUPTS LDA SYSTY GET CONSOLE EQT ADDRESS ADA .3 POINT TO WORD 4 OF CONSOLE EQT STA $SAVE SAVE IT LDA .4,I TRAP CELL CONTENTS FOR POWER FAIL STA $SAVE+11 SLOT LDA HLT4 INSERT HALT 4 IN TRAP CELL SO THAT THE SYSTEM STA .4,I HALTS ON POWER FAIL DURING CONFIGURATION LDA DUMMY SAVE PRIV INT CARD LOC STA $SAVE+5 FROM BASE PAGE STA PRVSV LDA TBG STA TBGSV LDA SKEDD SAVE CONTENTS STA $SAVE+6 CLB CLEARSYSTY TO PREVENT USER FROM RSTBL STB SYSTY GETTING OPERATOR ATTENTION STB DUMMY & DUMMY TO LET INTERRUPTS COME THRU STB SKEDD PREVENT PROG FROM BEING SCHEDULED LDA $LIST SAVE CONTENTS STA $SAVE+7 ISZ $LIST DLD EQT1 SAVE EQT WORDS 1-6 ON DST $SAVE+1 BASE PAGE COMMUNICATION AREA DLD EQT3 DST $SAVE+3 DLD EQT5 DST $SAVE+12 * LDB ACNFX GET $CNFX'S ID SEGMENT ADDRESS JSB TNAME SEZ,SZA,RSS PRESENT? CLB NO STB CNXID ID SEGMENT ADDRESS * LIA 1 READ THE SWITCH REGISTER CONTENTS STA SWREG AND SAVE IT CLB CLEAR THE SWITCH REGISTER OTB 1 SSA,RSS BIT 15 SET? JMP MEMLD NO,LOAD MEM RES & DRIVER PARTNS CCA YES,INITIALIZE SVTBL TO -1 LDB .40 SVTBL IS 16 WORDS LONG TEMP6 JSB SETM AND RSTBL IS 20 WORDS LONG WFLAâþúG DEF SVTBL STARTING FROM LOC SVTBL TEMP1 LDA SWREG TEMP2 ALF,ALF GET NEW DISC SC IN BITS 0-5 TEMP3 RAL,RAL TEMP4 AND B77 MASK DISC SC TEMP5 SZA,RSS 0? OLDSC JMP MEMLD YES, DISC SC DOES NOT CHANGE NEWSC STA NEWSC LDA ASVTB START OF SVTBL JSB SVENT MAKE NEW DISC ENTRY IN SVTBL CLA LDB NEWSC CPB TBG USED TO BE TBG? STA TBG YES, THEN CLEAR TBG CPB $SAVE+5 USED TO BE PRIV I/O CARD? STA $SAVE+5 YES, THEN CLEAR PRIV I/O CARD * TRPCL LDA DRT POINT TO DRT ENTRY FOR LU2 INA LDA A,I GET CONTENTS OF SYS LU ENTRY IN DRT AND B77 MASK EQT # FOR DISC ADA N1 SUBTRACT 1 TO START EQT#'S AT 0 MPY .15 FIND SYS DISC EQT ADDR ADA EQTA ADA .3 POINT TO WORD 4 OF SYS DISC EQT STA B SAVE ADDRESS IN THE B REG STA RSTBL+5 SAVE FOR NOW JSB EQTCN SET EQT WORD 4 FOR NEW SELECT CODE LDA INTBA INTERRUPT TABLE ADDRESS ADA OLDSC ADD OLD SELECT CODE # ADA N6 ADJUST ADDRESS LDB A,I GET CONTENTS OF INTRPT TBL ENTRY INA POINT TO NEXT SC IN INTRPT TBL CPB A,I BOTH SELECT CODES THE SAME? CCA,RSS YES CLA STA TEMP -1 IF 2 SC'S FOR DISC, 0 OTHERWISE JSB INTRP SET TRAP CELL AND INTRPT TBL FOR NEW SC LDA TEMP SSA,RSS 2 DISC SC'S? JMP MEMLD NO, THEN LOAD MEMORY ISZ NEWSC YES,SECOND SELECT CODE# FOR DISC ISZ OLDSC SECOND SELECT CODE FOR DISC LDA ASVTB ADA .4 ENTER SECOND SC ENTRIES IN SVTBL JSB SVENT JSB INTRP SET UP TRAP CELL & INTRPT TBL FOR 2ND SC CCA GET OLD SC BACK TO ORIGINAL VALUE ADA OLDSC OLD SC - 1 CCB ADB NEWSC NEW SC - 1 PRMTB DST OLDSC RESTORE THEM * * * LOAD MEMORY RESIDENT PROGRAMS AND RESIDENT LIBRARY * AND ThþúHE DRIVER PARTITIONS INTO MEMORY * * MEMLD LDA $SBTB+1 GET # OF PAGES IN DRIVER PARTITIONS SZA,RSS ANY GENERATED INTO SYSTEM? DRPGS JMP MEMRS NO, LOAD MEMORY RESIDENT PROGRAMS STA DRPGS USE THIS AS COUNTER LDA B41 BUILD DISC RESIDENT PROGRAM LDB $CMST MAP TO LOAD DRIVER PARTITIONS ADB N1 MWOCM CBX # OF PAGES TO BE LOADED NPGS CLB,INB START LOADING FROM PAGE 1 XMS TRANSFER SEQUENTIAL MEMORY STA MEMLD A REG POINTS TO NEXT MAP REG# LDB $ENDS START PAGE OF DRIVER PARTITIONS STB MEMLD+1 LDB $CMST # OF PAGES IN THE MAX.ADDRESSABLE CMB,INB SPACE WITHOUT COMMON ADB .31 STB MWOCM SAVE IT LDA $SBTB DISC ADDRESS OF DRIVER PARTNS JSB DSCAD SEPARATE TRACK AND SECTOR #'S * LDA $CMST START PAGE OF COMMON LSL 10 MULTIPLY BY 2000B STA TEMP3 LOAD FOR DRIVER PARTN DRVLD LDA DRPGS LDB DRPGS # OF PAGES IN DRIVER PARTITIONS CMB,INB # OF PAGES LEFT TO BE LOADED ADB MWOCM > MAX ADDRESS SPACE IN MAP? SSB LDA MWOCM YES,#PGS TO LOAD AT ONE TIME=MWOCM STA NPGS # OF PAGES OF DRVR PARTN TO BE LOADED CAX BUILD THE REST OF THE DISK RES MAP DLD MEMLD XMS LOAD MAP DST MEMLD SAVE NEW VALUES OF A&B REG LDA NPGS BUILD TRIPLETS TO READ DATA LSL 10 FROM DISC W/OUT CROSSING TRACK BOUNDARY STA TEMP SAVE # OF WORDS IN BUFFER JSB LOAD LOAD NPGS OF DRIVER PARTITION LDA NPGS # PAGES LOADED CMA,INA ADA DRPGS #PAGES THAT HAD TO BE LOADED SZA,RSS ANY LEFT? JMP MEMRS NO, DONE LOADING DRIVER PARTNS * STA DRPGS #PAGES LEFT TO BE LOADED ISZ PRMAR ADDRESS OF PARAMETER ARRAY LDB PRMAR,I GET # OF WORDS IN LAST TRIPLET LSR 6 DIVIDE IT BY 62/þú4 CBX SAVE B REG VALUE ISZ PRMAR GET TRACK / SECTOR # FOR LAST TRIPLET LDA PRMAR,I JSB DSCAD SEPARATE DISC ADDRESS CXB GET X REG IN B ADB TEMP2 B REG HAS NEW SECTOR # CMB -(NEW SECTOR# + 1) ADB SECT2 # OF SECTORS/TRACK ON SYS DISC SSB,RSS NEW SECT#># SECTORS/TRACK ON SYS DISC? JMP DRVLD NO ISZ TEMP1 YES, INCREMENT TRACK# BY 1 CLA SECTOR# IS 0 STA TEMP2 SECTOR# FOR SETUP JMP DRVLD LOAD THE NEXT PAGES * * * INTRP - THIS PROCEDURE IS PERFORMED TO ENTER * INTERRUPT TABLE AND TRAP CELL VALUES FOR DISC * SELECT CODES * * CALLING SEQUENCE: JSB INTRP * INTRP NOP LDB OLDSC,I TRAP CELL VALUE FOR OLD SELECT CODE STB NEWSC,I STORE VALUE IN NEWSC'S TRAP CELL * LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 STA TEMP2 SAVE THIS ADDRESS LDB OLDSC OLD SELECT CODE ADB A POINT INTO INTERRUPT TABLE LDA B,I OLD SC'S INTERRUPT TABLE VALUE LDB NEWSC ADB TEMP2 STA B,I SAVE OLDSC VALUE IN NEWSC ENTRY JMP INTRP,I IN INTERRUPT TABLE - RETURN * * * TNAME - SEARCH KEYWORD LIST FOR PROGRAM NAME * CALLING SEQUENCE: B REG = ADDRESS OF ASCII PROGRAM NAME * JSB TNAME * RETURNS: A REG = 0 IF PROGRAM NOT FOUND (E=1) * B REG = ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E REG = 0 IF STANDARD ID SEGMENT * E REG = 1 IF SHORT ID SEGMENT OR NOT FOUND * * TNAME NOP TNTM3 STB TNTM3 ADDRESS OF NAME 1 AND 2 TNTM4 INB INCREMENT TO CHAR 3 AND 4 ADDR TNTM5 STB TNTM4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND B1774 MASK OFF X STA TNTM5 SZA IF NULL CHAR. FORCE ERROR RETURN LDA KEYWD STA TEMP TN005 LDA TEMP,I CHECK IF AT ¢öþúEND OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST RETURN ADA .12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TNTM3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 5,X CPB TNTM4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND B1774 MASK OFF X CPA TNTM5 COMPARE CHAR 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ TEMP INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB TEMP,I LOAD B WITH ID SEG ADDRESS JMP TNAME,I EXIT * * * LOAD THE MEMORY RESIDENT PROGRAMS * AND THE MEMORY RESIDENT LIBRARY * * MEMRS LDA $SBTB+3 # OF PAGES IN MEM RESIDENT BASE PAGE SZA,RSS MEM RES PROGRAMS EXIST? JMP IOCNF NO, THEN CONFIGURE I/O LDA B40 YES LDB .32 32 REGISTERS CBX LDB $MRMP MEM RES MAP XMM TRANSFER MEM TO MAPS * LDA B1776 1776B WORDS TO LOAD FOR STA TEMP MEM RESIDENT BASE PAGE LDA $SBTB+2 DISC ADDRESS FOR MEM RES BASE PAGE JSB DSCAD LDA .2 START ADDRESS IS 2 STA TEMP3 JSB LOAD LOAD MEM RES BASE PAGE LDA $SBTB+5 #PAGES FOR MEM RES LIB & PROGS LSL 10 MULTIPLY BY 2000B STA TEMP # OF WORDS IN BUFFER LDA $SBTB+4 DISC ADDRESS FOR MEM RES LIB & PROGS JSB DSCAD LDA LBORG STARTING MEM ADDRESS STA TEMP3 FOR RESIDENT LIBRARY JSB LOAD LOAD THE MEM RES PROGS & LIB * * **** I/O RE-CONFIGURATION ****** * * IOCNF LDA SWREG RE-CONFIGURATION REQUESTED? a+þú SSA,RSS BIT 15 IN SWITCH REGISTER SET? JMP $EXIT NO, THEN DONE * CCA YES,INITIALIZE TRPCL,INTBL,EQTBL TO -1 LDB .168 168 ENTRIES POSSIBLE JSB SETM DEF TRPCL START AT LOC TRPCL CCA INITIALIZE OLD SC TABLE TO -1 LDB B70 JSB SETM DEF OLSTB LDA SVTBL DISC I/O SELECT CODE CHANGED? SSA JMP CONSL NO, THEN CONFIGURE CONSOLE SC JSB JNENT ENTER DISC SC IN INTBL AND TRPCL NOP ERROR RETURN NOT POSSIBLE LDA AEQTB ADDRESS OF EQTBL ADA NEWSC POINT TO NEW DISC SC ENTRY ADA NB10 IN EQTBL LDB RSTBL+5 EQT WORD 4 ADDRESS FOR DISC EQT STB A,I SET UP ENTRY IN EQTBL FOR DISC JSB CLRSC CLEAR SC IN INTERRUPT TABLE &TRAP CELL LDA ARSTB ADDRESS OF RSTBL JSB RSENT MAKE ENTRIES IN RESTORE TABLE LDA SVTBL+4 DISC HAS TWO SELECT CODES? CPA N1 ENTRY MADE IN SVTBL? JMP CONSL NO, THEN CONFIGURE CONSOLE SC ISZ NEWSC YES ISZ OLDSC JSB JNENT ENTER 2ND DISC SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN JSB CLRSC CLEAR SC IN INTERRUPT TABLE & TRAP CELL LDA ARSTB POINTER INTO RSTBL FOR ADA .6 SECOND DISC SC ENTRIES JSB RSENT MAKE ENTRIES IN RSTBL * CONSL LDA SWREG GET BITS 0-5 OF SWITCH REGISTER AND B77 GET CONSOLE SELECT CODE SZA,RSS 0? JMP UNBCN YES, CONSOLE SC NOT CHANGED STA NEWSC NO, NEW SELECT CODE FOR CONSOLE LDA $SAVE DETERMINE DRIVER TYPE FOR CURRENT INA SYSTEM CONSOLE - POINT TO WORD 5 LDA A,I OF CURRENT SYSTEM CONSOLE EQT ALF,ALF GET EQUIPMENT TYPE CODE AND B77 INTO BITS 0-7 STA TEMP1 SAVE IT LDA N3 CONFIGURE I/O INSTR TO FIND OUT TYPE CONLP LDB ACN1,I OF CONSOLE ATTACHED TO NEW SC åpþú ADB NEWSC STB ACN1,I RESTORE INSTR ISZ ACN1 POINT TO NEXT INSTR INA,SZA ALL INSTR CONFIGURED? JMP CONLP NO LDB .5 LDA MRSET MASTER RESET WORD CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 CLB DVR00 DRIVER CLA CPB TEMP1 IS THIS CONSOLE SAME TYPE AS CURRENT ONE CCA,RSS YES, INDICATE SO IN TEMP2 STB TEMP1 NO, THEN SAVE NEW CONSOLE TYPE STA TEMP2 0 IF DRIVER TYPES NOT SAME, -1 IF SAME * * FIND AN EQT WITH EQUIPMENT TYPE CODE MATCHING * THE NEW SELECT CODE * LDA NEWSC JSB EQTFN FIND AN EQT # WITH NEW SC SSB,RSS FOUND? JMP FNCNE YES CNEQT LDA TEMP2 NO, THEN DRIVER TYPES WERE SAME? SSA JMP CONTY YES CLA,INA NO FIND EQT WITH RIGHT DRIVER TYPE STA TEMP TEMP KEEPS COUNT OF EQT'S LOOKED AT LDB EQTA EQUIPMENT TABLE START ADB .4 POINT TO WORD 5 OF THE FIRST EQT EQTLP LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF EQUIPMENT TYPE CODE IN LOW 6 BITS AND B77 CPA TEMP1 IS IT SAME AS THAT OF NEWSC? JMP FNDEQ YES,THE RIGHT EQT HAS BEEN FOUND LDA TEMP CPA EQT# ALL EQT'S DONE? JMP EQERR YES, THEN ERROR ISZ TEMP NO, POINT TO NEXT EQT'S WORD 5 ADB .15 JMP EQTLP * FNCNE LDA TEMP5 EQT#-1 RETURNED BY EQTFN INA EQT# STA TEMP SAVE IT INB POINT TO WORD 5 OF EQT LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF AND B77 GET EQUIPMENT TYPE CODE CPA TEMP1 IS IT SAME AS THAT OF NEW CONSOLE? JMP FNDEQ YES, THEN FOUND THE RIGHT EQT JMP CNEQT NO, THEN FIND EQT * EQERR HLT 55B HALT SYSTEM JMP *-1 * CONTY LDB $SAVE DRIVER TYPE SAME FOR JMP EQTTY OLD AND NEW SYSTEM CONSOLE * UNBCN LDB $SAVE UNBUFFER CONcÁþúSOLE EQT JSB EQUNB LDA TEMP2 STA $SAVE+9 LDA $SAVE,I GET WORD 4 OF CONSOLE EQT AND B77 GET THE SELECT CODE LDB A,I GET THE TRAP CELL CONTENTS FOR SYS CONSOLE STB CTRCL SAVE TRAP CELL CONTENTS ADA INTBA INDEX INTO THE INTERRUPT TABLE ADA N6 LDA A,I STA CINTB INTERRUPT TABLE ENTRY FOR SYS CONSOLE JMP STRCN * * * * CLRSC - ROUTINE TO CLEAR INTERRUPT TABLE ENTRY FOR OLDSC * AND TO INSERT A JSB $CIC,I INSTR IN CORRESPONDING * TRAP CELL ENTRY * CALLING SEQUENCE: JSB CLRSC * * CLRSC NOP LDA OLDSC CPA SVTBL IS OLDSC SAME AS NEW DISC SC #1? JMP CLRSC,I YES, THEN RETURN CPA SVTBL+4 IS OLDSC SAME AS NEW DISC SC #2? JMP CLRSC,I YES, RETURN LDA JSBCI JSB $CIC,I INSTR STA OLDSC,I IN TRAP CELL ENTRY FOR OLD SC LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 ADA OLDSC POINTER INTO THE INTERRUPT TABLE CLB CLEAR ENTRY FOR OLD SC IN INTERRUPT TABLE STB A,I JMP CLRSC,I RETURN * * * EQT HAS BEEN FOUND, CHANGE EQT# IN DRT ENTRY FOR * LU1 - THE SYSTEM CONSOLE AND IN BASE PAGE LOC SYSTY * FNDEQ ADB N1 POINT TO WORD 4 OF NEW EQT ADDRESS STB $SAVE SAVE IS WHERE SYSTY+4 IS SAVED CPA .5 IN THIS DVR05 TYPE CONSOLE? JMP NOSUB YES, THEN SUBCHANNEL IS 0 * LDA LUMAX # OF LOGICAL UNITS DEFINED CMA,INA STA TEMP3 SAVE AS NEGATIVE COUNTER LDB DRT START OF DEVICE REFERENCE TABLE DRTLP LDA B,I GET AN ENTRY FROM DRT AND B77 MASK EQT # CPA TEMP SAVE AS NEW SYS CONSOLE'S EQT JMP DRTEN YES, FOUND NEW SYS CONSOLE'S ENTRY IN DRT * INB POINT TO NEXT ENTRY IN DRT ISZ TEMP3 INCREMENT COUNTER JMP DRTLP CHECK NEXT DRT ENTRY * NOSUB LDA TEMP EQT # OF NEW SYS CONSOLE RSS DRš—þúTEN LDA B,I SET UP DRT ENTRY FOR LU 1 STA DRT,I * EQTTY LDB $SAVE NEW CONSOLE'S EQT WORD 4 ADDRESS LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 STA OLDSC OLD SC # FOR CONSOLE JSB EQUNB UNBUFFER EQT LDB TEMP2 SAVE BUFFERED/UNBUFFERED STATUS STB $SAVE+9 LDA ASVTB POINT TO ENTRY IN ADA .8 SVTBL FOR SYSTEM CONSOLE JSB SVENT ENTER NEW SC IN SVTBL JSB JNENT ENTER NEW & OLD SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR CURRENT EQT'S FOR NEW SC LDA OLDSC GET OLD SELECT CODE # JSB IPROC CONFIGURE INTRPT TBL & TRAP CELL LDA NEWSC NEW SELECT CODE JSB IPROC CONFIGURE NEW SELECT CODE LDA ARSTB POINTER INTO RSTBL FOR CONSOLE SC ADA .12 JSB RSENT MAKE ENTRIES IN RSTBL FOR CONSOLE SC CLA CLEAR FLAG STA NOCLR LDB RSTBL+17 EQT WORD 4 ADDRESS OF CONSOLE ADB N3 POINT TO FIRST WORD OF CONSOLE EQT STA B,I CLEAR THIS WORD * STRCN LDB .11 JSB WRTTY DEF MSG0 START RECONFIGURATION * CONFIGURE LIST DEVICE SELECT CODE * LSTDV LDB .8 JSB QUERY ASK FOR DEF MSG1 LIST DEVICE LU? LSTLU LDA PRSBF GET FIRST WORD OF PARSE BUFFER TRTMP SZA,RSS NULL? JMP LUDFL YES, THEN DEFAULT LU# SAVPG LDB APRSB ADDRESS OF PARSE BUFFER SVPG1 LDA LUMAX UPPER LIMIT FOR LU# STA MXLU# CLA,INA LOWER LIMIT FOR LU# JSB TST# TEST LU# MXLU# NOP JMP LUERR RSS LUDFL INA YES, THEN DEFAULT LU IS 1 STA LSTLU LIST DEVICE LU# * * LIST DEVICE SELECT CODE # * CCB LDA LSTLU CPA .1 SAME AS CONSOLE LU? JMP ECHO2 YES, DO NOT ASK FOR SELECT CODE# LDA LSTLU GET EQT# FOR LIST DEVICE LU Üþú ADA N1 ADA DRT ADDRESS OF DRT TABLE LDA A,I GET CONTENTS AND B77 LIST DEVICE EQT# IN A REG SZA,RSS BIT BUCKET? JMP LUERR YES ADA N1 MPY .15 GET EQT ADDRESS ADA EQTA ADA .3 POINT TO WORD 4 OF LIST DEV EQT STA $SAVE+8 SAVE ADDR OF WORD 4 OF LIST DEV EQT LULST LDB .13 JSB QUERY DEF MSG2 LIST DEVICE SELECT CODE #? LDA PRSBF FIRST WORD OF PARSE BUFFER SZA,RSS 0? JMP ECHOQ YES,NO CHANGE IN LIST DEV CHNL LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST VALIDITY OF LIST DEVICE SELECT CODE# JMP LULST SELECT CODE # NOT VALID STA NEWSC NEW SELECT CODE # FOR LIST DEVICE LDB $SAVE+8 ADDR OF WORD 4 OF LIST DEV EQT LDA B,I GET CONTENTS OF LIST DEV EQT WORD 4 AND B77 MASK SC # STA OLDSC OLD SC # FOR LIST DEVICE JSB EQUNB UNBUFFER LIST DEVICE EQT LDA TEMP2 STA $SAVE+10 LDA ASVTB ADDRESS OF SVTBL ADA .12 POINT TO LIST DEVICE ENTRIES JSB SVENT MAKE NEWSC ENTRY IN SVTBL JSB JNENT INTBL AND TRPCL ENTRIES NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR SC # FROM CURRENT NEWSC EQT'S LDA OLDSC ENTRY IN INTERRPT TABLE AND JSB IPROC AND TRAP CELL FOR OLD SELECT CODE LDA NEWSC AND NEW SELECT CODE FOR LIST DEVICE JSB IPROC LDA ARSTB POINTER INTO RSTBL FOR ADA .18 LIST DEVICE JSB RSENT MAKE ENTRIES IN RSTBL FOR LIST DEVICE CLA STA NOCLR RESET FLAG LDB RSTBL+23 GET EQT WORD 4 ADDR FOR LIST DEV ADB N3 POINT TO FIRST WORD OF LIST DEV EQT STA B,I CLEAR THE WORD * * ECHOQ LDB .7 JSB QUERY ECHO?(YES/NO) DEF MSG3 LDA PRSBF PARSE BUFFER CPA .1 ØJþú NUMERIC VALUE? JMP ECHOQ YES, THEN ASK AGAIN CCB LDA PRSBF+1 FIRST TWO CHARACTERS CPA NO NO? JMP ECHO2 ECHO NOT REQUIRED? CPA YE YES? RSS JMP ECHOQ ERRONEOUS REPLY, ASK AGAIN ECHO CLB ECHO2 STB ECHO ECHO=0 ECHO WANTED,-1 ECHO NOT WANTED * * * PRINT A LIST OF CURRENT I/O CONFIGURATION * STIO DLD .ENT SET UP MESSAGE DST MSG4+2 LDB .13 JSB WRLST DEF MSG4 CURRENT I/O CONFIGURATION: JSB PRNIO * * WANT I/O CONFIGURATION? * WNTIO LDB .14 JSB QUERY DEF MSG9 I/O RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO CNTRP JMP MEMCN I/O CONFIG NOT REQIURED CNINT CPA YE LSTRP RSS LSINT JMP WNTIO ASK QUES AGAIN * * I/O RECONFIGURATION IS DESIRED * IOCN2 LDB .25 JSB WRTTY DEF MSG10 CURRENT SELECT CODE#,NEW SELECT CODE#?(/E TO END) IOCN3 CLB,INB JSB QUERY DEF HYPHN HYPHEN (-) PROMPT LDA PRSBF CPA .2 ASCII? JMP ENDIO CHECK IF END OF LIST LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STA OLDSC OLD SELECT CODE LDA PRSBF+4 SECOND PARAMETER ASCII? CPA .2 RSS YES, CHECK IF IT IS PR JMP NEWCH NO, TEST NEW CHANNEL # LDA PRSBF+5 CPA PI PRIVILEGED I/O CARD TO BE ADDED? RSS YES JMP IOERR NO, THEN ERROR LDA OLDSC OLD SELECT CODE VALUE JSB CHKSC NEW SC VALUE FOR DISC,CONSOLE OR LIST? JMP ERR3 YES, THEN CONFIG ERR 3 LDA OLDSC NO, GET OLDSC # STA $SAVE+5 SET UP DUMMY WORD ON BASE PAGE ADA NB10 ADA AINTB POINT INTO INTBL CLB STB A,I CLEAR THE INTBL ENTRY FOR OLDSC LDA OLDSC CPA TBG TBG CHANNEL? STB TBG YES, CLEAR TBG WORD ON BAS¿6NLHE PAGE ADA NB10 ADA ATRPC POINT INTO TRPCL TABLE LDB JSBCI INSERT JSB $CIC,I INSTR IN STB A,I TRPCL ENTRY FOR OLDSC LDA OLDSC ADA NB10 CAX SAVE A REG VALUE ADA AOLSC POINT TO OLD SC TABLE JSB PRVOL RESTORE PREV OLDSC IF NECESSARY CXA GET OLDSC - 10B ADA AOLSC POINT TO OLDSC ENTRY IN OLSTB CCB STB A,I NO OLDSC ASSIGNED CXA GET OLDSC -10B ADA AEQTB EQT TBL STB A,I ENTRY TO -1 JMP IOCN3 ASK FOR MORE * NEWCH LDB APRSB ADB .4 POINT TO VALUES FOR NEW SC LDA B IF THE NEW SELECT CODE # IS 0 INA DO NOT GO THRU TSTCH ROUTINE LDA A,I SZA JMP TSTNS NOT 0 THEN TEST NEW SELEC CODE LDB OLDSC GET OLD SELECT CODE # CPB PRVSV IS IT A PRIV I/O CARD? JMP STNWS YES, THEN 0 FOR NEWSC IS VALID JMP IOERR NO, THEN ERROR ÄNÿÿþúTSTNS JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STNWS STA NEWSC NEW SELECT CODE JSB INENT ENTER IN INTBL AND TRPCL JMP ERR3 GIVE CONFIG ERR 3 JMP IOCN3 ASK FOR MORE * ENDIO LDA PRSBF+1 /E ? CPA /E JMP IOCN7 CPA /R RESTART? JMP RSTRT * IOERR LDA A2 INVALID SELECT CODE # RSS ERR3 LDA A3 JSB ERROR JMP IOCN3 * LUERR LDA A1 JSB ERROR INVALID LIST DEVICE LU # JMP LSTDV * MSG0 ASC 11,START RECONFIGURATION MSG1 ASC 8,LIST DEVICE LU#? MSG2 ASC 13,LIST DEVICE SELECT CODE#? MSG3 ASC 7,ECHO?(YES/NO) * NOCLR NOP INTBL EQU TRPCL+56 EQTBL EQU INTBL+56 RDBUF EQU EQTBL+56 PRSBF EQU RDBUF+80 AINTB DEF INTBL $ABDP DEF INTBL ARSTB DEF RSTBL .11 DEC 11 .18 DEC 18 .ENT ASC 2,ENT .25 DEC 25 A1 ASC 1,1 A2 ASC 1,2 A3 ASC 1,3 AEQTB DEF EQTBL PI ASC 1,PI * RSTRT CCA INITIALIZE TABLES FOR I/O LDB .168 RE-CONFIGURATION TO -1 JSB SETM ATRPC DEF TRPCL CCA LDB B70 SET OLDSC TABLE TO -1 JSB SETM AOLSC DEF OLSTB * LDA TBGSV CHANGE TBG VALUE TO THE NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES, THEN CLEAR TBG LDA TBGSV NO STA TBG LDA PRVSV CHANGE PRIV I/O VALUE TO NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES LDA PRVSV NO STA $SAVE+5 CLB STB TEMP2 LDA ARSTB ADDRESS OF RESTORE TABLE STA TEMP USE TEMP AS POINTER RSLP LDB TEMP,I OLD SELECT CODE # SSB ENTRY MADE? JMP SKPRS NO, THEN NOTHING TO RESTORE STB OLDSC ADB NB10 RESTORE OLD SC VALUES IN INTBL AND TRPCL JSB RESTR LDB ASVTB ADDRESS OF SAVE TABLE ADB TEMP2 INDEX INTO IT LDB B,I GET NEW SC # Š¢þúADB NB10 CBX SAVE FOR NOW ADB AOLSC POINT INTO OLDSC TABLE LDA OLDSC STA B,I RESTORE OLDSC VALUE CXB RESTORE B REG VALUE CAX JSB RESTR RESTORE NEW SC VALUES IN TRPCL &INTBL ISZ TEMP CXA ADA AEQTB RESTORE EQT WORD 4 ADDRESS ADA NB10 LDB TEMP,I STB A,I ISZ TEMP RSLPE LDA TEMP2 ALL ENTRIES IN SVTBL RESTORED? CPA .12 JMP IOCN2 YES RESTART I/O CONFIGURATION ADA .4 NO, POINT TO NEXT SET OF ENTRIES STA TEMP2 JMP RSLP SKPRS LDA TEMP * ADA .6 POINT TO NEXT SET OF ENTRIES IN RSTBL STA TEMP JMP RSLPE * MSG9 ASC 14,I/O RECONFIGURATION?(YES/NO) MEM ASC 2,MEM NEW ASC 2,NEW HYPHN ASC 1,- /R ASC 1,/R /E ASC 1,/E N2 DEC -2 B70 OCT 70 #WRDS ABS EQTBL+56-SVTBL LENGTH OF ALL IO TABLES .20 DEC 20 CONSC EQU SVTBL+8 LSTSC EQU SVTBL+12 * IOCN7 LDA INTLG GET LENGTH OF INTERRPUT TABLE ADA N2 CMA,INA STA TEMP2 USE AS -VE COUNTER LDA B10 FIRST SELECT CODE VALUE STA TEMP3 IOLP1 CPA CONSC NEW CONSOLE SELECT CODE? JMP ENIOL YES,DO NOT CHANGE CONSOLE SELECT CODE VALUE CPA LSTSC NEW LIST DEVICE SELECT CODE? JMP ENIOL YES, DO NOT CHANGE IT JSB IPROC TRANSFER INTBL AND TRPCL VALUES RSS ENIOL JSB JPROC CLEAR NEWSC'S PREV EQT'S IF NOT ASSIGNED ISZ TEMP3 TO INTRPT TABLE AND TRAP CELL LDA TEMP3 ISZ TEMP2 INCREMENT COUNTER JMP IOLP1 LDA EQT# # OF EQT'S DEFINED CMA,INA USE AS COUNTER STA TEMP5 LDA EQTA ADDRESS OF START OF EQT TABLES CLB CLREQ STB A,I CLEAR FIRST WORD OF ALL EQT'S ADA .15 ISZ TEMP5 JMP CLREQ * DLD NEW SET UP MESSAGE DST MSG4+2 LDB .11 PRTMP JSB WRLST NEW I/O CONFIGURATION DEF MSG4+2 æÆþúPRTM2 JSB PRNIO PRINT NEW I/O CONFIGURATION * * PERMQ LDB .20 JSB QUERY NEW I/O CONFIGURATION PERMANENT?(YES/NO) DEF MSG12 LDA PRSBF+1 CPA NO RESPONSE IS NO? JMP MEMCN YES, THEN MEMORY CONFIGURATION CPA YE JMP PRMIO MAKE I/O CONFIG PERMANENT CPA /R RESTART I/O CONFIGURATION? RSS YES JMP PERMQ ERROR IN RESPONSE CCA INITIALIZE ALL I/O RE-CONFIGURATION LDB #WRDS TABLES TO -1 JSB SETM ASVTB DEF SVTBL CCA LDB B70 JSB SETM SET OLD SC TABLE TO -1 DEF OLSTB LDA TBG TBG CHANNEL STA TBGSV LDA $SAVE+5 STA PRVSV JMP STIO START I/O RE-CONFIGURATION * * PRMIO LDA CONSC NEW SELECT CODE FOR CONSOLE SSA DEFINED? JMP CHKLS NO ADA INTBA YES, THEN SAVE ITS CURRENT INTERRUPT TABLE ADA N6 CONTENTS LDB A,I TO BE DONE BECAUSE A DRIVER CAN CHANGE STB CNINT CAN CHANGE INTERRUPT TABLE ENTRIES LDB RSTBL+15 GET CONTENTS OF ORIGINAL VALUE IN INTERRUPT STB A,I TABLE FOR THE CONSOLE SELECT CODE LDB CONSC,I GET CONTENTS OF CURRENT VALUE OF TRAP CELL STB CNTRP SAVE THIS VALUE LDB RSTBL+16 ORIGINAL TRAP CELL VALUE FOR STB CONSC,I THE CONSOLE SELECT CODE CHKLS LDA LSTSC LIST DEVICE SELECT CODE SSA DEFINED? JMP PRCNT NO,CONTINUE TO MAKE I/O CONFIG PERM ADA INTBA GET INTERRUPT TABLE VALUE CURRENTLY ADA N6 ASSIGNED TO LIST DEVICE SELECT CODE LDB A,I STB LSINT SAVE THIS VALUE LDB RSTBL+21 GET ORIGINAL INTERRUPT TABLE STB A,I VALUE FOR LIST DEVICE LDB LSTSC,I GET CURRENT TRAP CELL VALUE FOR STB LSTRP LIST DEVICE --- SAVE IT LDB RSTBL+22 GET ORIGINAL TRAP CELL VALUE FOR STB LSTSC,I FOR LIST DEVICE * PRCNT LDA INàqþúTBA ADDRESS OF INTERRUPT TABLE LDB INTLG LENGTH OF INTERRUPT TABLE JSB $TRTB WRITE INTERRUPT TABLE ON DISC LDA B10 WRITE TRAP CELLS ON DISC - SET UP FOR LDB B70 ENTERING $TRTB AT TRPTB ENTRY POINT DST TRTMP SAVE START ADDR AND LENGTH OF TRAP CELLS LDA .2 STA TEMP2 SECTOR # CLA STA TEMP1 TRACK# LDA B10 # OF WORDS OFFSET INTO THE SECTOR STA #OFST JSB TRPTB TRANSFER TRAP CELLS TO DISC LDA CONSC NEW SELECT CODE FOR CONSOLE SSA DEFINED? JMP RSTLS NO LDB CNTRP GET SAVED VALUE OF TRAP CELLS FOR STB CONSC,I CONSOLE SELECT CODE ADA INTBA ADA N6 LDB CNINT RESTORE CURRENT VALUE OF INTERRUPT TABLE STB A,I RSTLS LDA LSTSC SSA NEW LIST DEVICE SELECT CODE EFINED? JMP PREQT NO,MAKE EQT WORD 4'S PERMANENT LDB LSTRP RESTORE CONTENTS OF LIST DEVICE STB LSTSC,I TRAP CELL ADA INTBA ADA N6 LDB LSINT RESTORE CONTENTS OF LIST DEVICE STB A,I INTERRUPT TABLE ENTRY * PREQT JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S CLA STA PRTM2 USE AS COUNTER LDA EQTA START ADDRESS OF EQT TABLES ADA .3 POINT TO WORD 4 OF FIRST EQT STA TEMP3 PREQL CLB JSB $TREN TRANSFER EQT WORD 4 TO DISC ISZ PRTM2 LDA PRTM2 CPA EQT# JMP UNBFR DONE LDA TEMP3 ADA .15 STA TEMP3 POINT TO WORD 4 OF NEXT EQT JMP PREQL UNBFR LDA $SAVE+9 CONSOLE EQT WAS BUFFERED? SZA,RSS JMP LSUNB NO LDA PRTMP YES, RESTORE UNBUFFERED WORD STA $SAVE,I LSUNB LDA $SAVE+10 LIST DEVICE EQT WAS BUFFERED? SZA,RSS JMP PRDRT NO LDA PRTMP+1 RESTORE UNBUFFER STATUS STA $SAVE+8,I * PRDRT LDA DRT ADDRESS OF DRT ENTRY FOR SYSTEM CONSOLE SC žþúCLB MAKE IT PERMANENT JSB $TREN * * LDA ATBG MAKE TBG WORD ON BASE PAGE PERMANENT LDB TBG GET CONTENTS OF TBG WORD FROM BASE PAGE JSB LOCTR TRANSFER IT TO DISC LDA ASYST SYSTY WORD ON BASE PAGE TO BE TRANSFERRED LDB $SAVE CONTENTS OF SYSTY (+3) ARE IN $SAVE ADB N3 POINT TO START OF CONSOLE EQT JSB LOCTR TRANSFER WORD TO DISC LDA ADUMY TRANSFER PRIVILEGED I/O CARD ADDRESS LDB $SAVE+5 CONTENTS OF WORD ON BASE PAGE JSB LOCTR * * I/O CONFIGURATION COMPLETED * * MEMORY RE-CONFIGURATION * MEMCN LDB $MNP MAX # OF PARTITIONS ALLOWED BDTMP CMB,INB STB TEMP USE AS COUNTER LDB $MATA GET STARTITNG ADDRESS OF MAT ENTRIES MATLP LDA B,I GET CONTENTS OF FIRST WORD OF THIS ENTRY SSA -1? JMP BCKUP YES, BACKUP TO FIND # PAGES IN MEM ADB .7 NO ISZ TEMP ALL PARTITIONS CHECKED? JMP MATLP NO, IS NEXT ENTRY THE LAST ONE? BCKUP ADB N1 GET CONTENTS OF LAST WORD LDA B,I OF PREVIOUS MAT ENTRY SZA,RSS 0? JMP FOUND YES, THEN NOT A SUBPARTITION ADB N3 POINT TO WORD 3 OF PREVIOUS MAT ENTRY LDA B,I SSA IS IT A MOTHER PARTITION? JMP MFND YES ADB N4 POINT TO LAST ENTRY OF PREV PARTN JMP BCKUP+1 * FOUND ADB N3 POINT TO WORD 3 OF THIS MAT ENTRY MFND LDA B,I GET VALUE AND BIT09 MASK # OF PAGES IN PART'N CAX SVE THIS VALUE INB LDA B,I GET WORD 4 OF THE MAT ENTRY AND BIT09 MASK # PAGES IN PARTITION CXB ADA B CCE,INA CONVERT #PAGES IN PHYSICAL MEM TO ASCII JSB $CNV3 INA DLD A,I GET ASCII VALUE FOR LEAST 4 DIGITS DST MSG23+14 SET UP MESSAGE LDB .19 JSB WRLST CURRENT PHYSICAL MEM SIZE: XXXX PAGES DEF *þúMSG23 * DLD MEM SET UP MESSAGE DST MSG9 MEMC0 LDB .14 MESSAGE LENGTH JSB QUERY DEF MSG9 MEM RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO NO? JMP $EXIT RETURN CONTROL TO SYSTEM CPA YE RSS MEM RECONFIGURATION WANTED JMP MEMC0 ERROR IN RESPONSE * $NPGQ LDB .13 JSB QUERY DEF MSG21 PHSICAL MEM SIZE?(#PAGES) LDA .48 LOWER BOUNDS IS 48 PAGES LDB APRSB ADDRESS OF PARSE BUFFER JSB TST# TEST VALIDITY OF RESPONSE .1024 DEC 1024 UPPER LIMIT JMP NPGSE ERROR IN RESPONSE STA MEMSZ SAVE MEM SIZE ADA N1 GET LAST PAGE # IN MEMORY STA LASTP LDA $SBTB+1 # PAGES IN DRIVER PARTITION ADA $SBTB+5 # OF PAGES IN MEM RES PART'N INA # PAGES IN MEM RES BASE PAGE ADA $ENDS # PAGES IN SYSTEM UPTO SAM DEFAULT STA $USRS START OF SAM EXTENSION CCE CONVERT PAGE# TO ASCII DECIMAL JSB $CNV3 INA DLD A,I GET LAST 4 DIGITS DST MSG22+17 BDPAG LDB .25 JSB WRTTY DEFINE BAD PAGES BEGINING AT PAGE XXXX ( E TO END) DEF MSG22 LDA N100 MAX # OF BAD PAGES ALLOWED STA BDTMP USE AS COUNTER LDA $ABDP START OF BAD PAGE LIST ADA N1 MINUS ONE STA TEMP1 TEMP1 WILL BE THE POINTER LDB $USRS INITIALIZE LIST OF BAD PAGES TO ADB N1 LAST PAGE OF MEMORY RESIDENT PROGRAMS STB TEMP1,I BDPGQ CLB,INB WORD COUNT JSB QUERY SEND HYPHEN PROMPT DEF HYPHN LDA PRSBF+1 RESPONSE IS /E? CPA /E JMP ENBDP YES, THEN END BAD PAGE LIST CPA /R RESTART ENTRIES FOR BAD PAGES? JMP BDPAG YES LDA TEMP1,I LOWER LIMIT FOR A BAD PAGE # INA IS PREVIOUS BAD PG# + 1 LDB APRSB POINTER TO BAD PAGE # IN PARSE BUF JSB TST# 7_þú TEST VALIDITY OF BADE PAGE # LASTP NOP LAST PAGE # IN MEMORY JMP BDPGE BAD PAGE ERROR ISZ TEMP1 INCREMENT POINTER STA TEMP1,I SAVE THE BAD PAGE # IN LIST ISZ BDTMP INCREMENT COUNTER JMP BDPGQ PROMPT FOR NEXT BAD PG # JMP ENBDP 100 PAGES ENTERED DONE * BDPGE LDA A11 BAD PAGE ERROR JSB ERROR JMP BDPGQ * NPGSE LDA A10 # OF PAGES IN MEM ERROR JSB ERROR JMP $NPGQ * ATBG DEF TBG ASYST DEF SYSTY ADUMY DEF DUMMY * MEMSZ NOP MSG22 ASC 25,DEFINE BAD PAGES BEGINNING AT PAGEXXXX (/E TO END) MSG23 ASC 19,CURRENT PHYSICAL MEM SIZE: XXXX PAGES .48 DEC 48 N100 DEC -100 .17 DEC 17 .19 DEC 19 BIT09 OCT 1777 A10 ASC 1,10 A11 ASC 1,11 * ENBDP CCA -1 TO INDICATE END OF BAD PAGE LIST #PGS ISZ TEMP1 INCREMENT POINTER #NPGS STA TEMP1,I * * LDA CNXID GET ID SEGMENT ADDRESS FOR $CNFX ADA .21 LDA A,I GET # PAGES WORD ALF,RAL MOVE # PAGES (NO BP) TO LOW BITS RAL AND B37 MASK # PAGES USED FOR $CNFX STA #PGS SAVE CMA,INA SAVE NEGATIVE # OF PAGES TOO STA #NPGS LDA $USRS SAVE START OF SAM EXT PAGE LDB $ABDP SAVE POINTER TO BAD PAGE LIST DST SAVPG POINTER INTO BAD PAGE LIST CHNKL CLA A REG = 0 TO INDICATE CALL FROM SYSTEM MAP JSB $PCHN GET THE NEXT CHUNK OF GOOD PAGES SZA,RSS 0? JMP ABORT YES,THEN NO SPACE TO LOAD $CNFGX ADA #NPGS SPACE LARGE ENOUGH FOR $CNFX? SSA,RSS JMP FCHNK YES * LDA $ABDP,I GET CURRENT BAD PAGE SSA ALL BAD PAGES USED UP? JMP ABORT YES, THEN HLT 22 * INA STA $USRS TRY WITH THIS USER START PAGE JMP CHNKL FIND ANOTHER CHUNK OF MEMORY * FCHNK LDA $PLP LOAD POINT FOR PRIVILEGED PROGRAMS ALF RAL,RAL AND B37 # OF PAG¥8þúES BEFORE LOAD POINT ADA N1 CAX USE AS COUNTER TO LOAD PAGES LDA B41 START LOGICAL PAGE FOR TABLE AREA I THRU SDA CLB,INB PHYSICAL PAGE # TO BE LOADED XMS LDB #PGS # OF PAGES FOR USER AREA CBX USE AS COUNTER LDB $USRS INB B REG HAS PHYSICAL PAGE XMS TO LOAD USER AREA CLA,INA CAX COUNTER TO LOAD BASE PAGE LDA B40 LOGICAL START PAGE LDB $USRS XMS LDB CNXID GET ID SEG ADDRESS FOR $CNFX SZB,RSS PRESENT? JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .14 POINT TO TYPE WORD IN ID SEG LDA B,I GET CONTENTS AND B37 MASK TYPE OF PROGRAM CPA .3 IS IT A BACKGROUND DISC RESIDENT PROG? RSS YES JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .8 GET WORD 23 OF ID SEGMENT LDA B,I GET CONTENTS STA TEMP3 LOW MAIN ADDRESS CMA,INA INB POINT TO WORD 24 OF ID SEG ADA B,I HIGH MAIN +1 - LOW MAIN STA TEMP SAVE # OF WORDS TO BE LOADED FOR MAIN ADB .3 POINT TO WORD 27 OF ID SEGMENT LDA B,I DISC ADDRESS OF MAIN PROGRAM JSB DSCAD SET UP TRACK & SECTOR #'S FOR SETUP JSB LOAD LDB CNXID ADDRESS OF THE ID SEGMENT ADB .24 POINT TO LOW BASE PAGE ADDR LDA B,I STA TEMP3 CMA,INA INB POINT TO HIGH BASE PAGE ADDR + 1 ADA B,I # OF WORDS IN BASE PAGE STA TEMP SAVE FOR SETUP ROUTINE LDA PRMAR ADDRESS OF LAST TRIPLET JSB NXTAD FIND NEXT DISC ADDRESS LDA TEMP2 GET NEW SECTOR # SLA EVEN #? INA NO, THEN MAKE IT EVEN CPA SECT2 ALL SECTORS ON TRACK TRANSFERRED? RSS YES JMP SETSC NO ISZ TEMP1 INCREMENT TRACK ADDRESS  Èþú CLA SET SECTOR ADDRESS TO 0 SETSC STA TEMP2 NEW SECTOR ADDRESS JSB LOAD DLD SAVPG RESTORE SAVED VALUES STA $USRS FOR USER PART'N START PAGE STB $ABDP AND BAD PAGE POINTER LDA MEMSZ PASS MEMORY SIZE TO $CNFX STA $PCHN LDA LSTLU PASS LIST DEVICE LU$# TO $CNFX STA $WRRD LDA ECHO STA $TRTB PASS ECHO FLAG TO $CNFX CLA,INA SET THE BASE PAGE FENCE ADA BPA2 LWA OF USER BASE PAGE LINKS IOR BIT10 LFA LDB CNXID GET PRIMARY ENTRY POINT FOR $CNFX ADB .7 LDB B,I UJP B,I ENABLE USER MAP AND JUMP TO $CNFX * * CNXID NOP .24 DEC 24 .21 DEC 21 BIT10 OCT 2000 B63 OCT 63 $SMTB NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP E$SMT DEF *-1 A$SMT DEF $SMTB AEQT4 DEF EQT4 * ABORT HLT 22B HALT SYSTEM JMP *-1 * $EXIT LDA $GDPG MEMORY RE-CONFIGURATION WAS SSA,RSS MADE PERMANENT? JMP EXIT2 NO, RESET SYTEM MAP FOR SAM EXT LDA AEQT4 YES, MAKE EQT4 WORD ON BASE PAGE LDB $SAVE+4 CONTENTS JSB LOCTR JMP EXIT5 * EXIT2 LDA $SMTB+2 SYSTEM MAP NEEDS TO BE SZA,RSS RESET FOR SAM EXTENSION? JMP EXIT5 NO LDB A$SMT YES, POINTER TO $SMTB STB TEMP LDA $ENDS LOGICAL START PAGE OF SAM EXTENSION SMELP LDB TEMP,I PHYSICAL START PG OF A CHUNK OF SAM EXT SZB,RSS DEFINED? JMP EXIT5 NO, THEN DONE ADB BIT14 WRITE PROTECT SAM EXTENSION ISZ TEMP YES,POINT TO #PGS IN THIS CHUNK OF SAM EXT LDX TEMP,I COUNTER IN X REG XMS TRANSFER SEQUENTIALLY TO DMS REGISTERS LDB E$SMT POINTER TO END OF $SMTB CPB TEMP AT THE END OF THE TABLE? JMP EXIT5 YES, THEN DONE ISZ TEMP NO, THEN SET UP NEXT CHUNK OF SAM EXT JMP SMõNþúELP * EXIT5 LDB CNXID ID SEG ADDR OF $CNFX SZB,RSS PRESENT? JMP EXIT1 NO LDA COMMA YES, CHANGE NAME TO ,,,,, ADB .12 STA B,I INB STA B,I INB LDA B,I GET CONTENTS OF NAME 5 WORD AND B377 MASK LOWER BYTE STA B,I SAVE IT LDA COMMA AND B1774 MASK UPPER BYTE ADA B,I STA B,I RESTORE 5TH CHAR OF NAME * EXIT1 LDA SWREG GET THE SWITCH REGISTER SSA,RSS RECONFIGURATION WAS REQUESTED? JMP EXIT4 NO * LDA $SAVE,I GET THE EQT WORD 4 OF SYS CONSOLE EQT STA $SMTB SAVE THE WORD IN A TEMP LOCATION LDA $SAVE ADDRESS OF EQT WORD 4 OF SYS CONSOLE ADA N3 POINT TO EQT WORD 1 LDB .15 # OF WORDS IN EQT JSB DSKRD READ THE EQT FROM DISC * LDA $SMTB GET THE CONTENTS OF EQT 4 SAVED STA $SAVE,I RESTORE IN EQT 4 WORD AND B77 GET SC FOR SYS CONSOLE STA $SMTB SAVE SELECT CODE FOR SYS CONSOLE ADA INTBA INDEX INTO THE INTERRUPT TABLE ADA N6 STA $SMTB+1 SAVE POINTER INTO INTERRUPT TABLE FOR SYS CONSOLE LDA $SAVE ADDRESS OF EQT WORD 4 ADA .8 POINT TO EQT EXTENSION SIZE WORD LDB A,I GET THE EQT EXTENSION SIZE WORD SZB,RSS EQT EXTENSION DEFINED? JMP EXIT8 NO * INA YES, POINT TO EQT EXTENSION ADDRESS LDA A,I JSB DSKRD READ EQT EXTENSION FROM THE DISC * EXIT8 LDA RSTBL+16 GET SYSTEM CONSOLE TRAP CELL CONTENTS CPA N1 SAVED? JMP EXIT6 NO * LDB RSTBL+15 YES, THEN GET INTERRUPT TABLE ENTRY JMP EXIT7 * EXIT6 LDA CTRCL GET SAVED CONTENTS OF TRAP CELL LDB CINTB AND INTERRUPT TABLE FOR SYS CONSOLE EXIT7 STA $SMTB,I RESTORE TRAP CELL AND INTERRUPT TABLE STB $SMTB+1 ENTRIES WITH ORIGINAL CONTENTS * EXIT4 LDA $SAVE RESTORE THÓ¿þúE SAVED BASE PAGE ADA N3 POINT TO START OF CONSOLE EQT STA SYSTY DLD $SAVE+1 EQT1 AND EQT2 DST EQT1 DLD $SAVE+3 EQT3 & EQT4 DST EQT3 DLD $SAVE+12 EQT5 & EQT6 DST EQT5 CLA STA EQT7 STA EQT8 STA EQT9 STA EQT10 STA EQT11 STA EQT12 LDA $SAVE+5 DUMMY STA DUMMY LDA $SAVE+6 SKEDD STA SKEDD LDA $SAVE+7 STA $LIST LDA $SAVE+11 TRAP CELL CONTENTS FOR POWER FAIL STA .4,I RESTORE TRAP CELL 4 JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S * * JMP $CNFG,I RETURN CONTROL TO THE OP SYSTEM * BIT14 OCT 40000 COMMA ASC 1,,, DEQT1 DEF EQT1 * * * INENT - THIS PROCEDURE IS PERFORMED FOR EVERY OLD AND * NEW SELECT CODEL PAIRS. APPROPRIATE INTERRUPT TABLE * AND TRAP CELL VALUES ARE INSERTED INTO INTBL AND TRPCL * OLDSC AND EQT WORD 4 ADDRESS ARE INSERTED INTO ENTRIES * IN OLSCT AND EQTBL * * JNENT - ENTRY POINT IS USED FOR DISC , CONSOLE AND LIST * DEVICE SC CONFIGURATION * * CALLING SEQUENCE: JSB INENT * OLD AND NEW SELECT CODE VALUES ARE ASSUMED * TO BE IN OLDSC AND NEWSC RESP. * RETURN: P FOR ERROR RETURN IF OLDSC WAS ASSIGNED TO * OR NEWSC IS SC NEWSC FOR DISC,CONSOLE OR LIST DEV * SAME AS DISC , CONSOLE OR LIST DEVICE SC * * INENT NOP LDA B10 START SC # STA TEMP3 SAVE IT LDB AOLSC ADDRESS OF OLD SC TABLE OLDSL LDA B,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPA OLDSC OLDSC ALREADY ASSIGNED? RSS YES JMP ENSCL NO LDA TEMP3 SC # TO WHICH OLDSC WAS ASSIGNED JSB CHKSC NEWSC FOR DISC,CONSOLE OR LIST DEV? JMP INENT,I YES, ERROR RETURN LDA NEWSC NEW SC # IS DISC ,CONSOLE OR LIST DEV? JSB CHKSC JMP INENT,I YES, ERROR RETURN LDA TEMP3 þú TEMP3 IS SC TO WHICH OLDSC WAS ASSIGNED ADA NB10 LDB AINTB ADB A POINT INTO INTBL FOR TEMP3 ENTRY STB TEMP1 SAVE THIS ADDRESS LDB ATRPC ADB A POINT INTO TRPCL TABLE FOR TEMP3 ENTRY STB TEMP2 SAVE IT LDA .N56 COUNTER FOR OLD SC TABLE STA TEMP4 LDB AOLSC START OF OLDSC TABLE OLDS2 LDA B,I INB CPA TEMP3 HAS SC TO WHICH OLD SC WAS ASSIGNED JMP ASGND BEEN ASSIGNED TO ANOTHER SC ISZ TEMP4 NO JMP OLDS2 CCA CCB JMP INEN2 ASGND CLA YES, THEN CLEAR INTBL ENTRY LDB JSBCI AND JSB CIC,I IN THIS SC'S ENTRIES INEN2 STA TEMP1,I SET UP INTBL AND TRPCL ENTRIES FOR PREV SC STB TEMP2,I LDA TEMP3 POINT INTO OLD SC TABLE FOR ADA NB10 PREV ENTRY STA TEMP2 SAVE IT ADA AOLSC CCB STB A,I ERASE IT LDA AEQTB ERASE ENTRY IN EQTBL ADA TEMP2 STB A,I LDA TBGSV CPA TEMP3 WAS IT A TBG? STA TBG YES, RESET TBG LDA PRVSV PRIV I/O? CPA TEMP3 WAS IT A PRIV I/O? STA $SAVE+5 YES, RESET PRIV I/O CARD JMP INEN5 CONTINUE I/O CONFIGURATION * ENSCL ISZ TEMP3 LDA TEMP3 CPA B77 ALL OLDSC TABLE ENTRIES LOOKED AT? JMP INEN3 YES INB NO JMP OLDSL * INEN3 LDA NEWSC JSB CHKSC NEW SC # THAT OF DISC,CONSOLE OR LISTDEV? JMP INENT,I ERROR JMP INEN5 * JNENT NOP ENTRY POINT FOR DISC,CONSOLE AND LIST DEVICE LDA JNENT STA INENT INEN5 CLB LDA NEWSC NEW SELECT CODE # CPA TBG IS NEW SELECT CODE TBG CHANNEL? STB TBG YES CPA $SAVE+5 IS NEW SELECT CODE PRV CHANNEL? STB $SAVE+5 YES, CLEAR IT LDB OLDSC OLD SELECT CODE # CPB TBGSV IS THE OLD SELECT CODE TBG CHANNEL? STA TBG Ÿ NLH YES, THEN RESET TBG CHANNEL CPB PRVSV IS THE OLD SELECT CODE PRIV I/O CHANNEL? RSS YES JMP INEN7 NO SZA,RSS IS NEW SELECT CODE 0? STB NEWSC YES, SET NEW SELECT CODE TO OLDSC STA $SAVE+5 * INEN7 LDB NEWSC GET NEW SELECT CODE VALUE ADB NB10 PREPARE TO INDEX INTO INTBL AND TRPCL STB TEMP1 LDA AINTB ADDRESS OF INTBL PGSRM ADA B POINT TO NEWSC ENTRY IN INTBL STA TEMP2 SAVE IT LDA ATRPC ADA B POINT TO NEWSC ENTRY IN TRPCL STA TEMP3 SAVE POINTER $USRS LDA N4 IS OLDSC ENTRY MADE IN SVTBL? ENDSM STA TEMP TEMP IS COUNTER LDA ASVTB ADDRESS OF SVTBL SVLP LDB A,I GET VALUE CPB OLDSC OLD SELECT CODE? JMP SVTBE YES ADA .4 NO, LOOK AT NEXT ENTRY ISZ TEMP JMP SVLP * OLD SELECT CODE ENTRY IS NOT IN SVTBL NEWEN LDA OLDSC,I GET TRAP CELL ENTRY FOR OLDSC STA TEMP3,I STORE OLDSC VALUE IN NEWSC ENTRY IN TRPCL nfNÿÿþú LDA INTBA INTERRUPT TABLE ENTRY FOR OLDSC ADA N6 ADA OLDSC LDA A,I STA TEMP2,I STORE OLDSC VALUE IN NEWSC ENTRY IN INTBL LDA OLDSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR OLDSC STEQT LDA AEQTB ADA TEMP1 POINTER INTO EQTBL FOR NEWSC ENTRY STB A,I STORE EQT ADDRESS IN EQTBL ENTOL LDA AOLSC ADA TEMP1 POINT TO OLDSC TABLE ENTRY FOR NEWSC CAX SAVE THIS ADDRESS JSB PRVOL RESTORE PREV OLD SC IF NECESSARY CXA RESTORE ADDRESS INTO AOLSC LDB OLDSC GET OLDSC VALUE STB A,I STORE IT * OLDEN LDB OLDSC OLD SELECT CODE ENTRY ADB NB10 LDA AINTB GET VALUE OF OLDSC IN INTBL ADA B STA TEMP2 SAVE ADDRESS LDA A,I CPA N1 HAS IT BEEN ASSIGNED A VALUE SO FAR? RSS NO JMP RINEN YES,RETURN CLA CLEAR INTBL ENTRY FOR OLDSC STA TEMP2,I LDA ATRPC ADDRESS OF TRPCL ADA B POINT TO OLDSC ENTRY IN TRPCL LDB JSBCI ENTER JSB CIC,I FOR OLD SC STB A,I IN TRPCL JMP RINEN RETURN * OLD SC ENTRY IS IN SVTBL SVTBE INA LDB A,I STB TEMP3,I NEWSC ENTRY IN TRPCL INA LDB A,I STB TEMP2,I NEWSC ENTRY IN INTBL INA LDB A,I EQT PRESENT FOR THIS SC? SSB JMP ENTOL NO JMP STEQT YES, THEN SET EQT ADDRESS * RINEN ISZ INENT GOOD RETURN JMP INENT,I * NB10 OCT -10 .N56 DEC -56 * * * CHKSC - ROUTINE TO CHECK IF GIVEN SC IS SAME AS NEWSC * FOR DISC, CONSOLE OR LIST DEVICE * CALLING SEQUENCE: A REG = SC# * JSB CHKSC * RETURN: P IF SC# MATCHES NEW SC FOR ABOVE * P+1 OTHERWISE * * CHKSC NOP STA TEMP1 SAVE CLA CHKLP LDB ASVTB ADDRESS OF SVTBL ADB A LDB B,I CPB TEMP1 MATCHES? JMP CHKSC,QþúI YES ADA .4 CPA .16 ALL DONE? RSS YES, NO MATCH JMP CHKLP ISZ CHKSC JMP CHKSC,I RETURN TO P+1 * * * EQTFN - THIS ROUTINE FINDS ADDRESS OF WORD 4 OF * EQT BELONGING TO SELECT CODE VALUE IN OLDSC * EQT # - 1 IS ALSO RETURNED * * CALLING SEQUENCE: A REG = SC # * JSB EQTFN * RETURNS: B REG = ADDR OF EQT WORD 4 IF EQT PRESENT * = -1 IF EQT NOT FOUND * TEMP5 = EQT # - 1 (VALID ONLY IF EQT FOUND) * * EQTFN NOP STA TEMP6 CLA STA TEMP5 COUNTER TO FIND THE RIGHT EQT LDB EQTA ADDRESS OF EQT ADB .3 POINT TO WORD 4 OF EQT LPEQT LDA B,I GET CONTENTS OF WORD 4 AND B77 MASK SELECT CODE # CPA TEMP6 IS IT SAME AS OLDSC JMP EQTFN,I YES, THEN RETURN ISZ TEMP5 NO LDA TEMP5 CPA EQT# ALL EQT'S LOOKED AT? JMP EXEQT YES ADB .15 NO,POINT TO WORD 4 OF NEXT EQT JMP LPEQT * EXEQT CCB EQT NOT FOUND JMP EQTFN,I RETURN * * * PRVOL - ROUTINE CHECKS IF THIS NEWSC WAS ASSIGNED * A SELECT CODE PREVIOUSLY. IF SO, CHECK IF THIS * PREVIOUS SELECT CODE WAS ASSIGNED A NEW VALUE * IF NO VALUE WAS ASSIGNED DO NOT DESTROY ITS ORIGINAL * VALUE * FOR EG. 12,10 * 13,10 * THEN 12 SHOULD NOT BE DESTROYED * * CALLING SEQUENCE: A REG = POINTER INTO OLSCT FOR NEWSC ENTRY * JSB PRVOL * * PRVOL NOP LDB A,I WAS NEWSC PREVIOUSLY ASSIGNED ANOTHER SC? CPB N1 JMP PRVOL,I NO, THEN RETURN ADB NB10 YES CBY ADB AOLSC LDA B,I CPA N1 DOES IT HAVE AN ASSIGNMENT MADE? RSS NO JMP PRVOL,I YES CYB NO, THEN CHANGE ITS TRPCL AND INTBL ADB ATRPC ENTRIES TO -1 STA B,I Íþú CYB ADB AINTB STA B,I CYB ADB AOLSC -1 IN OLDSC ENTRY STA B,I CYB ADB AEQTB -1 IN EQTBL ENTRY STA B,I JMP PRVOL,I RETURN * * * RSENT - ROUTINE TO MAKE ENTRIES IN RSTBL, * THE RESTORE TABLE USED TO SAVE TRPCL,INTBL,EQTBL VALUES * FOR OLD SC AND NEW SC OF DISC, CONSOLE AND LIST DEVICE * FORMAT OF RSTBL IS : ENTRIES FOR DISC SC # 1 * " " " " # 2 * " " CONSOLE * " " LIST DEVICE * * EACH SET OF ENTRIES IS 6 WORDS LONG AS FOLLOWS: * WORD 1 - OLD SC# * WORD 2 - INTBL VALUE FOR OLDSC * WORD 3 - TRPCL VALUE FOR OLDSC * WORD 4 - INTBL VALUE FOR NEWSC * WORD 5 - TRPCL VALUE FOR NEWSC * WORD 6 - EQT WORD 4 ADDRESS FOR NEWSC * * CALLING SEQUENCE: A REG = POINTER INTO RSTBL FOR ENTRIES * JSB RSENT * NOTE: RSENT ASSUMES OLDSC AND NEWSC CONTAIN VALUES * FOR OLD AND NEW SELECT CODES RESPECTIVELY * * RSENT NOP STA TEMP SAVE POINTER INTO RSTBL LDA OLDSC OLD SELECT CODE VALUE STA TEMP,I STORE IT IN RSTBL JSB SVRST STORE OLD SC'S INTBL & TRPCL ENTRIES LDA NEWSC NEW SELECT CODE VALUE JSB SVRST STORE NEW SC'S INTBL & TRPCL ENTRIES ISZ TEMP POINT TO WORD 6 LDA AEQTB ADDRESS OF EQTBL ADA NB10 POINT TO ENTRY FOR NEWSC ADA NEWSC LDA A,I GET EQT WORD 4 ADDRESS STA TEMP,I MAKE ENTRY IN RSTBL JMP RSENT,I RETURN * * * SVRST - ROUTINE TO STORE INTBL AND TRPCL VALUES * OF A GIVEN SELECT CODE INTO RSTBL * CALLING SEQUENCE: A REG = SELECT CODE VALUE * JSB SVRST * NOTE: TEMP IS ASSUMED TO BE POINTING AT ENTRY * PREVIOUS TO THE ONE TO BE MADE BY SVRST * * SVRST NOP ISZ TEMP POINT TO RSTBL ADA NB10 INDEX INTO INTBL STA B ADA AINTB %@þú LDA A,I GET VALUE FOR INTBL ENTRY STA TEMP,I STORE IT IN RSTBL ISZ TEMP ADB ATRPC INDEX INTO TRPCL LDA B,I GET VALUE STA TEMP,I STORE VALUE IN RSTBL JMP SVRST,I RETURN * * * RESTR - ROUTINE TO RESTORE INTBL AND TRPCL VALUES * FOR A GIVEN SELECT CODE THAT WERE SAVED IN RSTBL * CALLING SEQUENCE: B REG = SELECT CODE# - 10B (INDEX * VALUE TO BE USED IN INTBL & TRPCL) * JSB RESTR * * RESTR NOP STB TEMP1 SAVE INDEX VALUE ADB AINTB POINTER INTO INTBL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL LDA TEMP,I VALUE OF INTBL ENTRY STA B,I RESTORE IT IN INTBL LDB TEMP1 ADB ATRPC POINTER INTO TRPCL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL LDA TEMP,I VALUE OF TRPCL ENTRY STA B,I RESTORE IT IN TRPCL JMP RESTR,I RETURN * * * IPROC - THIS ROUTINE TRANSFERS A SELECT CODE'S VALUES * FROM INTBL AND TRPCL INTO INTERRUPT TABLE AND TRAP CELL * AND CHANGES SELECT CODE # IN EQT IF NECESSARY * * CALLING SEQUENCE: JSB IPROC * A REG = SELECT CODE # * * IPROC NOP STA TEMP ADA NB10 STA TEMP1 SAVE VALUE ADA AINTB POINT TO SC ENTRY IN INTBL LDB A,I CPB N1 GIVEN A VALUE? JMP IPROC,I NO, THEN RETURN * LDA INTBA ADDRESS OF INTERRUPT TABLE ADA N6 ADA TEMP POINT TO SC ENTRY IN INTERRUPT TABLE STB A,I STORE INTBL VALUE IN INTERRUPT TABLE LDA ATRPC ADDRESS OF TRPCL ADA TEMP1 POINT TO SC ENTRY IN TRPCL LDA A,I STA TEMP,I STORE IT IN TRAP CELL LDA AEQTB ADA TEMP1 LDB A,I GET EQTBL ENTRY FOR THIS SC SSB DEFINED? JMP IPRC5 NO,CLEAR EXISTING EQT ENTRIES FOR NEWSC LDA B,I YES, GET CONTENTS OF EQT WORD 4 AND B77 MASK OLD¡8þú SELECT CODE # CPA TEMP OLDSC = NEWSC? JMP IPROC,I YES, NO NEED TO CHANGE SC'S STA OLDSC NO, SAVE THIS OLDSC VALUE LDA EQT# # OF EQT'S DEFINED CMA,INA STA TEMP5 USE AS COUNTER LDB EQTA ADDRESS OF START OF EQT TABLES ADB .3 POINT TO WORD 4 LEQT# CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENEQL YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENEQL CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENEQL YES LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET OLD SC# CPA OLDSC MATCHES ONE WE ARE LOOKING FOR? RSS YES JMP ENEQL NO, LOOK AT NEXT EQT LDA N3 POINT TO FIRST WORD OF THIS EQT ADA B STA TEMP4 SAVE ADDRESS OF THIS EQT LDA A,I GET CONTENTS OF THE FIRST WORD CPA N1 PREVIOUSLY CHANGED ? JMP ENEQL YES CCA NO,CHANGE TO NEWSC AND SET FLAG STA TEMP4,I TO INDICATE THIS LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B1777 CLEAR BITS FOR SC IOR TEMP INSERT NEW SC STA B,I RESTORE EQT WORD 4 ENEQL ADB .15 POINT TO NEXT EQT'S WORD 4 ISZ TEMP5 INCREMENT COUNTER JMP LEQT# DO NEXT ONE * IPRC5 LDA NOCLR FLAG SET TO SKIP THIS? SSA JMP IPROC,I YES, THEN RETURN JMP IPRC7 JPROC NOP ENTRY POINT FOR CONSOLE AND LIST SC STA TEMP LDA JPROC SET UP RETURN ADDRESS STA IPROC IPRC7 LDA AOLSC START OF OLDSC TABLE LDB .N56 USE AS COUNTER STB TEMP5 OLSLP LDB A,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPB TEMP SAME AS NEW SELECT CODE? JMP IPROC,I YES, RETURN INA NO, LOOK FURTHER ISZ TEMP5 JMP OLSLP LDA EQT# NEW SC IS NOT ASSIGNED TO ANY OTHER SC# CMA,INA ~þú THEN CLEAR OUT NEW SC # FROM OLD EQT'S STA TEMP5 LDB EQTA IPRLP LDA B,I GET FIRST WORD OF EQT SSA -1? JMP ENIPR YES, THEN NEW SC IN IT ADB .3 NO CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENIPR YES, LOOK FOR NEXT EQT LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET SC # CPA TEMP IS THIS SAME AS NEW SC#? RSS YES JMP ENIPR NO, LOOK AT NEXT EQT LDA B,I YES AND B1777 THEN CLEAR SC# STA B,I RESTORE EQT WORD 4 ENIPR ADB .12 POINT TO NEXT EQT ISZ TEMP5 MORE EQT'S LEFT? JMP IPRLP YES JMP IPROC,I NO, RETURN * * * TSTCH - ROUTINE TO TEST THE VALIDITY OF A SELECT CODE# * CALLING SEQUENCE: JSB TSTCH * B REG = POINTER TO PARSE BUFFER * CONTAINING THE 4 WORD SET FOR SELECT CODE# * TO BE TESTED * * RETURN : LOC P IF AN ERROR RETURN * LOC P+1 IF NORMAL RETURN * * TSTCH NOP STB TEMP4 POINTER TO PARSE BUFFER INB STB TEMP5 LDA B,I GET VALUE CLB DIV .10 CONVERT VALUE TO OCTAL ALS CMA,INA ADA TEMP5,I STA TEMP5,I RESTORE VALUE LDB TEMP4 GET POINTER TO PARSE BUFFER LDA B10 10 OCTAL IS LOWER LIMIT JSB TST# TEST THE SELECT CODE # B77 OCT 77 UPPER LIMIT FOR SELECT CODE # JMP CHNLE ERROR ISZ TSTCH VALID SELECT CODE # JMP TSTCH,I NORMAL RETURN TO P+1 LOC * CHNLE LDA A2 JSB ERROR DISPLAY ERROR MESSAGE JMP TSTCH,I * .10 DEC 10 * * * * TST# - ROUTINE TO TEST VALIDITY OF A GIVEN # * CALLING SEQUENCE: A REG=LOWER Lã¢þúIMIT OF RANGE FOR # * B REG=POINTER TO 4 SET OF WORDS * FOR # IN PARSE BUFFER * JSB TST# * DEC(OR OCT) UPRLM UPPER LIMIT * RETURN: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * NUMBER IS IN THE A REG * * TST# NOP CBX SAVE CONTENTS OF B REG LDB B,I TYPE OF VALUE CPB .1 NUMERIC? RSS YES JMP TSTE NO THEN ERROR RETURN CXB RETRIEVE VALUE OF B REG INB LDB B,I GET VALUE CMA,INA -VE OF LOWER LIMIT ADA B VALUE-LOWER LIMIT SSA LOW LIMIT > VALUE? JMP TSTE YES, ERROR RETURN LDA B CMA,INA ADA TST#,I UPPER LIMIT-VALUE SSA VALUE > UPPER LIMIT? JMP TSTE YES, ERROR LDA B ISZ TST# NORMAL RETURN TSTE ISZ TST# JMP TST#,I RETURN * * * SVENT - ROUTINE TO MAKE ENTRY IN SVTBL * SVTBL HAS ENTRIES FOR TWO DISC SELECT CODES, * CONSOLE AND LIST DEVICE SELECT CODES IN THAT ORDER * EACH ENTRY IN SVTBL IS 4 WORDS LONG AND * CONTAINS THE FOLLOWING: * WORD 1 - NEW SC # * WORD 2 - ORIGINAL TRAP CELL CONTENTS OF NEW SC * WORD 3 - ORIGINAL INTERRUPT TABLE CONTENTS OF NEW SC * WORD 4 - EQT WORD 4 ADDRESS OF NEW SC * * CALLING SEQUENCE: A REG = POINTER TO ENTRY IN SVTBL * JSB SVTBL * ASSUME: NEWSC HAS VALUE OF SC FOR SVTBL ENTRY * * SVENT NOP LDB NEWSC NEW SELECT CODE # STB A,I ENTER IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB NEWSC,I VALUE OF NEWSC'S TRAP CELL STB A,I SAVE IT IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB INTBA ADDRESS OF INTERRUPT TABLE ADB N6 ADB NEWSC POINTER TO NEWSC ENTRY IN LDB B,I ùVþú INTERRUPT TABLE STB A,I STORE INTRPT TABLE VALUE IN SVTBL INA POINT TO NEXT ENTRY STA TEMP SAVE IT LDA NEWSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR THIS SC STB TEMP,I STORE IT IN SVTBL JMP SVENT,I RETURN * * * EQTCN - INSERT NEW SC IN EQT, FIND OLD SC # AND * UNBUFFER DEVICE IF BUFFERED * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQTCN * RETURN: TEMP2=0 IF DEVICE NOT BUFFERED * 1 OTHERWISE * EQTCN NOP JSB EQUNB UNBUFFER EQT IF BUFFERED BIT SET LDA B,I VALUE OF EQT WORD 4 AND B77 MASK SELECT CODE STA OLDSC SAVE IT LDA B,I AND B1777 CLEAR LOW 6 BITS ADA NEWSC ADD NEW SELECT CODE STA B,I RESTORE WORD 5 JMP EQTCN,I RETURN * * * EQUNB - ROUTINE TO UNBUFFER EQT WORD 4 IF THE B BIT WAS SET * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQUNB * RETURNS: TEMP2 = 0 IF EQT BUFFER STATUS WAS NOT CHANGED * = 1 IF EQT BUFFER STATUS WAS CHANGED * NOTE: B REG IS UNCHANGED * * EQUNB NOP CLA STA TEMP2 LDA B,I CONTENTS OF WORD 4 OF EQT RAL,RAL CLE,SLA BUFFERED? - BIT 14 SET? ISZ TEMP2 YES, THEN TEMP2 IS SET ERA,RAR CLEAR BIT 14 IF SET STA B,I RESTORE EQT WORD 4 JMP EQUNB,I RETURN * * * BUFFR - ROUTINE RESTORES THE STATUS OF CONSOLE * AND LIST DEVICE EQT'S TO BUFFERED IF THEY WERE ORIGINALLY * BUFFERED * CALLING SEQUENCE: JSB BUFFR * * BUFFR NOP LDA $SAVE+9 WAS CONSOLE EQT BUFFERED? SZA,RSS JMP LSBUF NO LDA $SAVE,I YES, GET CONTENS OF WORD 4 OF CONSOLE EQT STA PRTMP SAVE IT TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE,I RESTORE EQT WORD 4 LSBUF LDA $SAVE+10 LIST DEVICE EQT WAäqþúS BUFFERED? SZA,RSS JMP BUFFR,I NO, THEN RETURN LDA $SAVE+8,I YES, GET CONTENTS OF WORD 4 OF LIST DEV EQT STA PRTMP+1 SAVE EQT WORD 4 CONTENTS TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE+8,I RESTORE EQT WORD 4 CONTENTS JMP BUFFR,I RETURN * * * SETM - ROUTINE SETS MEMORY LOCATIONS TO GIVEN VALUE * CALLING SEQUENCE: A REG= VALUE * B REG = # OF LOCATIONS TO BE CHANGED * JSB SETM * DEF LOC STARTING LOCATION * SETM NOP CAX SAVE VALUE OF A REG IN X LDA SETM,I STARTING LOCATION STA TEMP ADDRESS OF LOC ISZ SETM CMB,INB -VE COUNT CXA VALUE IN A SETLP STA TEMP,I STORE VALUE INB,SZB,RSS INCREMENT COUNTER JMP SETM,I RETURN ISZ TEMP POINT TO NEXT MEM LOC JMP SETLP * * * DSCAD - ROUTINE TO SEPARATE DISC ADDRESS INTO * TRACK AND SECTOR # * CALLING SEQUENCE: A REG = DISC ADDR BITS 0-6 SECTOR * 7-15 TRACK * JSB DSCAD * RETURNS: TEMP1 IS TRACK #, TEMP2 IS SECTOR # * * DSCAD NOP CLB LSL 9 TRACK # IN B REG STB TEMP1 SAVE IT ALF,ALF SECTOR# RAR STA TEMP2 SAVE IT JMP DSCAD,I RETURN * * * LOAD - ROUTINE TO LOAD DATA FROM DISC INTO MEMORY * CALLING SEQUENCE : JSB LOAD * * LOAD NOP JSB SETUP SET UP TRIPLETS STA PRMAR ADDRESS OF START OF TRIPLETS JSB $XSIO MAKE SYSTEM I/O REQUEST .2 OCT 2 LU# DEF CLOAD COMPLETION ROUTINE ADDRESS NOP FOR SYSTEM USE OCT 1 PRMAR NOP ARRAY ADDRESS DEC 0 BIT15 OCT 100000 LEAVE USER MAP AS IS JMP $XCQ WAIT FOR I/O TO COMPLETE CLOAD JMP LOAD,I RETURN * * * SETUP - THIS ROUTINE IS TAKEN FROM THE DISPATCHER * IT GENEuÄþúRATES PARAMETERS FOR DISC CALL GUARANTEEING * THAT ALL TRACK CROSSING CALLS ARE BROKEN DOWN INTO * SUB-CALLS SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * THE CALLS ARE BROKEN UP IN TRIPLETS OF * STARTING MEMORY ADDRESS * NUMBER OF WORDS TO TRANSFER * TRACK/SECTOR ADDRESS * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING LAST TRIPLET * CALLING SEQUENCE: * NOTE: THE TABLE OF TRIPLETS IS BUILT BOTTOM-UP. * THE CONTENTS OF LAST WORD OF TABLE MUST BE 0 - THIS WORD'S * ADDRESS IS ASSUMED TO BE APRMT * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * RETURNS : ADDRESS OF START OF TRIPLETS IN PRMAR * * SETUP NOP CLA END OF PRMTBL MARKED BY 0 STA PRMTB LDA APRMT ADDRESS OF END OF PARM TABLE LDB TEMP COMPUTE # OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA N3 SET UP TRIPLET STA PRMAR ADDRESS ADB B177 ROUND UP NUMBER OF SECTORS ASR 7 BLS STB TEMP5 SAVE # OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B LDB SECT2 # OF SECOTRS ON SYSTEM DISC CMB,INB ADA B SUBTRACT # OF SECTORS/TRACK LDB TEMP3 STARTING MEMORY ADDRESS STB PRMAR,I STORE IT IN MEMORY ISZ PRMAR INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES,USE REST OF TRACK IF OVER ASL 6 UPSET LDB TEMP1 FORM TRACK BLF,RBL AND RBL,RBL SECTOR ADDRESS ADB TEMP2 DST PRMAR,I STORE LAST 2 WORDS OF TRIPLET ADA TEMP3 UPDATE STARTING ADDRESS STA TEMP3 LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT ÓþúNEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB PRMAR,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUBTRACT 1 FOR CORRECT NEXT TRIPLET ADA PRMAR ADDRESS CALCULATION JMP SETU1 GO TO NEXT LOOP * SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET * * * ERROR - ROUTINE PRINTS ERROR MESSAGE * CALLING SEQUENCE: A REG = ERROR# IN ASCII * JSB ERROR * ERROR NOP STA ERR00+6 LDB .7 LENGTH OF BUFFER JSB WRTTY DISPLAY ON CONSOLE DEF ERR00 JMP ERROR,I RETURN * ERR00 ASC 7,CONFIG ERR * * * $WRRD- ROUTINE TO PERFORM I/O USING THE SYSTEM * I/O ROUTINE $XSIO * CALLING SEQUENCE: A REG = REQUEST CODE * B REG = BUF LNGTH OR * PRIORITY CODE IF DISC I/O * BIT 15 OF BREG SET IF CALLING FROM USER MAP * Y REG = LU # * 1 IF BUFFER IN USER MAP * JSB $WRRD * DEF BUFAD ADDRESS OF BUFFER * NOTE: SEE WRITE-UP ON $XSIO ROUTINE FOR FURTHER INFO * * $WRRD NOP STA REQCD REQUEST CODE STB TEMP SSB,RSS BIT 15 SET? JMP WRRD5 NO ELB,CLE,ERB CALLING FROM SUER MAP - CLEAR SIGN BIT STB BUFLN SET UP BUFFER LENGTH XLA $WRRD,I GET ADDRESS OF BUFFER IN USER AREA STA TEMP5 SAVE ADDRESS OF BUFFER IN USER MAP LDA ARDBF USE RDBUF TO MOVE USER BUFFER INTO STA BUFAD IT IS ALSO THE BUFFER ADDRESS LDA REQCD GET REQEST CODE SLA IS IT FOR WRITE? JMP WRRD7 NO, IT IS A READ REQUEST CBX BUFFER LENGTH IN X REG FOR MOVE LDB ARDBF DESTINATION BUFFER ADDRESS LDA TEMP5 SOURCE ADDRESS MWF MOVE WORDS FROù=þúM USER MAP INTO SYSTEM MAP JMP WRRD7 CONTINUE WITH I/O REQUEST WRRD5 LDA $WRRD,I GET VALUE OF BUFFER LNGTH DST BUFAD STORE BUFFER ADDRESS & LENGTH WRRD7 CYA RETRIVE Y REG STA LU# JSB $XSIO LU# NOP DEVICE LU# DEF CWRRD COMPLETION ROUTINE ADDRESS NOP FOR SYS USE REQCD NOP REQUEST CODE BUFAD NOP BUFFER ADDRESS BUFLN NOP BUFFER LENGTH DEC 0 MAP WORD=0 SINCE BUFFER ALWAYS IN SYS MAP JMP $XCQ WAIT FOR I/O COMPLETION CWRRD ISZ $WRRD COMPLETION RETRUN LDA TEMP SSA,RSS CALLING FROM SYSTEM MAP? JMP $WRRD,I YES, RETURN LDA REQCD GET REQUEST CODE SLA,RSS READ REQUEST? JMP RWRRD NO, THEN RETURN STB TEMP YES, THEN SAVE TRANSMISSION LOG CBX #OF WORDS READ LDA ARDBF ADDRESS OF READ BUFFER LDB TEMP5 ADDRESS OF DEST BUFFER IN USER MAP MWI MOVE WORDS INTO USER MAP LDB TEMP TRANSMISSION LOG RESTORED IN B REG RWRRD UJP $WRRD,I ENABLE USER MAP AND RETURN * * * QUERY - ROUTINE TO DISPLAY QUESTION ON CONSOLE AND * READ RESPONSE ANDS PARSE IT * * WRTTY - EMBEDDED IN QUERY, DISPLAYS MESSAGE ON CONSOLE * * CALLING SEQUENCE: B REG = # OF WORDS IN BUFFER TO DISPLAY * JSB QUERY(WRTTY) * DEF BUFR MESSAGE TO BE DISPLAYED * QUERY NOP CCA SET FLAG TO INDICATE QUERY ROUTINE JMP CONTQ CONTINUE WRTTY NOP LDA WRTTY STA QUERY CLA CLEAR FLAG TO INDICATE CONSOLE WRITE ROUTINE CONTQ STA WFLAG SET FLAG TO -1 LDA QUERY,I STA QBUFR CLA,INA LU # 1 CAY IN Y REG INA REQ CODE IS 2 FOR WRITE JSB $WRRD QBUFR NOP ISZ WFLAG WRTTY ROUTINE? JMP RQUER YES, RETURN * * READ RESPONSE JSB $XSIO ò:NLH .1 OCT 1 CONSOLE LU DEF CREAD COMPLETION ROUTINE ADDRESS NOP OCT 401 REQUEST CODE ARDBF DEF RDBUF READ BUFFER .80 DEC 80 80 WORDS NOP SYSTEM MAP JMP $XCQ WAIT FOR I/O COMPLETION CREAD LDA ARDBF ADDRESS OF READ BUFFER BLS CONVERT WORD COUNT TO CHAR. COUNT JSB $PRSE SYSTEM ROUTINE TO PARSE APRSB DEF PRSBF PARSE BUFFER RQUER ISZ QUERY JMP QUERY,I RETURN * * * WRLST - ROUTINE TO WRITE BUFFER ON LIST DEVICE AND * THE SYS CONSOLE IF ECHO IS REQUESTED * * CALLING SEQUENCE: B REG = BUFFER LENGTH * BIT 15 OF B REG SET IF CALLING FROM USER MAP * JSB WRLST * DEF BUFR BUFFER ADDRESS * * NOTE: IT IS ASSUMED THAT IF CALLING FROM USER MAP, * THE BUFFER IS ALSO IN THE USER MAP * WRLST NOP STB TEMP4 LDA WRLST,I BUFFER ADDRESS FROM SYSTEM MAP STA CNBF STA LSBF LDA ECHO ECHO REQUIRED?  Nÿÿþú SZA JMP NECHO NO ECHO JSB WRTTY WRITE ON CONSOLE CNBF NOP * NECHO LDA LSTLU LIST LU CAY LU # IN Y REG LDB TEMP4 BUFFER ADDRESS LDA B202 REQUEST CODE,CONTROL INFO JSB $WRRD LSBF NOP ISZ WRLST POINT TO RETURN ADDRESS JMP WRLST,I RETURN * B202 OCT 202 * * * PRNIO - THIS ROUTINE PRINTS I/O CONFIGURATION OF THE SYSTEM * THE FORMAT IS: * CALLING SEQUENCE : JSB PRNIO * * PRNIO NOP LDA AMSG5 SOURCE BUFFER ADDRESS LDB ARDBF DEST BUFFER ADDRESS MVW .8 LDA INTBA ADDRESS OF THE INTERRUPT TABLE ADA .2 POINT TO ENTRY FOR SC 10 OCTAL STA TEMP1 SAVE IT LDB INTLG LENGTH OF THE INTERRUPT TABLE ADB N2 ADJUST TO SKIP I/O SELECT CODES 6 AND 7 CMB,INB USE AS COUNTER STB TEMP2 LDA B10 STA TEMP3 COUNTER FOR SELECT CODE # PRNLP LDA TEMP3 CLE CONVERT SC # TO ASCII JSB $CNV3 SYSTEM ROUTINE TO CONVERT ADA .2 POINT TO LAST DIGITS LDA A,I STA RDBUF+6 SELECT CODE# IN MESSAGE LDA TEMP3 GET SELECT CODE # CPA TBG IS IT THE TBG SELECT CODE? JMP TBGPR YES CPA $SAVE+5 IS IT THE PRIV I/O CARD? JMP PRIV YES * LDA TEMP1,I INTERRUPT TABLE ENTRY SZA,RSS 0? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT SSA PROGRAM ID SEGMENT? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT ADA .4 EQT ADDRESS SPECIFIED STA TEMP4 SAVE ADDRESS OF WORD 5 OF EQT LDA EQTA START OF EQT TABLE CMA,INA ADA TEMP1,I # WORDS OFFSET TO THE BEGINING OF THIS EQT CLB DIV .15 GET EQT # STA TEMP5 SAVE EQT#-1 JMP CNVE# CONVERT IT TO ASCII * SRCHE LDA TEMP3 GET SC # JSB EQTFN FIND EQT WORD 4 ADDRESS AND EQT DBþú# INB POINT TO WORD 5 STB TEMP4 SAVE EQT WORD 5 ADDRESS SZB,RSS FOUND AN EQT? JMP NOEQT NO EQT FOR THIS SC CNVE# LDA AMSG6 SOURCE BUFFER ADDRESS LDB ADEST DEST BUFFER ADDRESS MVW .6 LDA TEMP5 EQT # - 1 FOR THIS DEVICE CCE,INA CONVERT IT TO DECIMAL ASCII JSB $CNV3 ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE FOR EQT STA RDBUF+10 STORE IT IN RDBUF LDA TEMP4 GET WORD 5 OF EQT LDA A,I ALF,CLE,ALF EQUIPMENT TYPE CODE IN BITS 0-6 AND B77 JSB $CNV3 CONVERT EQ TYPE CODE TO OCTAL ASCII ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE STA RDBUF+14 STORE IT IN BUFFER LDA SPACE CLEAR REMAINING WORD STA RDBUF+15 * PRENT LDA TEMP1,I GET INTERRUPT TABLE ENTRY SZA,RSS IS IT AN ENTRY POINT? JMP ENINS YES SSA IS IT A PROG ID SEGMENT JMP PROGN YES JMP PRNT * NOEQT LDA SPACE LDB .8 JSB SETM SET FIRST PART OF MESSAGE TO BLANKS ADEST DEF RDBUF+8 JMP PRENT * ENINS LDA TEMP3,I GET TRAP CELL VALE FOR SC CPA JSBCI IS IT JSB CIC,I? JMP NOENT YES CLE CONVERT TRAP CELL CONTENTS TO ASCII OCTAL JSB $CNV3 LDB ARDBF ADDRESS OF RDBUF ADB .16 MVW .3 MOVE ASCII VALUE LDB .19 # OF WORDS TO LIST JMP PRNT+1 * NOENT LDA TEMP4 EQT WAS FOUND? SZA JMP PRNT YES, PRINT LINE JMP ENDLP NO, SKIP PRINTING * PROGN CMA,INA MAKE THE ID SEG ADDR +VE ADA .12 POINT TO WORD 13 OF ID SEG STA TEMP5 SAVE ADDRESS DLD A,I GET PROGRAM NAME DST RDBUF+16 LDA TEMP5 ADA .2 GET LAST CHAR OF PROG NAME LDA A,I AND B1774 BLANK THE LOWER BYTE IOR B40 ADD A ©þúSPACE STA RDBUF+18 STORE IT IN READ BUFFER LDB .19 JMP PRNT+1 PRINT * TBGPR DLD .TBG TBG SELECT CODE DST ADEST,I LDB .10 JMP PRNT+1 * PRIV LDA AMSG8 PRIVILEGED I/O CARD LDB ADEST MVW .4 LDB .12 RSS * PRNT LDB .15 JSB WRLST DEF RDBUF ENDLP ISZ TEMP3 POINT TO NEXT SELECT CODE # ISZ TEMP1 INCREMENT POINTER TO THE INTERRUPT TBL ISZ TEMP2 INCREMENT COUNTER JMP PRNLP PRINT NEXT SC ENTRY JMP PRNIO,I RETURN * .TBG ASC 2,TBG * * * TRWRD - ROUTINE TRANSFER A WORD FROM SYSTEM IN MEMORY * TO A CORRESPONDING LOCATION ON DISC * CALLING SEQUENCE: A REG = DISC ADDRESS * B REG = CONTENTS OF WORD IN MEMORY * #OFST = # OF WORDS OFFSET IN THE SECTOR * * TRWRD NOP STB TEMP4 SAVE CONTENTS OF MEM LOC STA PRMTB-1 BUILD TRIPLETS FOR $XSIO ROUTINE LDB APRMT ADDRESS OF PARAMETER TABLE ADB N3 STB WRAD1 ADDRESS OF START OF TRIPLET STB WRAD2 LDA ASCBF START MEM ADDRESS STA PRMTB-3 LDB .64 # OF WORDS TO BE READ STB PRMTB-2 LDA .2 CAY LU# CLA,INA REQUEST CODE TO READ CLB READ BUFFER INTO THE SYTEM MAP JSB $WRRD WRAD1 NOP LDA ASCBF ADDRESS OF START OF BUFFER ADA #OFST ADD OFFSET TO IT LDB TEMP4 CONTENTS OF WORD TO BE TRANSFERRED STB A,I CHANGE CORRESP WORD IN BUFFER LDA .2 REQ CODE IS 2 TO WRITE CAY LU# IS ALSO 2 FOR DISC CLB WRITE BUFFER FROM SYSTEM MAP JSB $WRRD WRAD2 NOP JMP TRWRD,I RETURN * APRMT DEF PRMTB * * * MEMDS - ROUTIEN TO CONVERT GIVEN MEMORY LOCATION * (MUST BE 2000B OR GREATER) IN SYSTEM CODE INTO A * CORRESPONDING DISC LOCATION * CALLING SEQUENCE: A REG = MEMORY LOCATION * JSB ÂYþúMEMDS * RETURNS: TEMP1 = TRACK# * TEMP2 = SECTOR# * #OFST = # OF WORDS OFFSET INTO SECTOR * * MEMDS NOP LDB SECT2 # OF SECTORS/TRACK ON SYS DISC BLF MULTIPLY BY 100B TO GET RBL,RBL STB NWRDS # OF WORDS / TRACK CLB DIV NWRDS DIVIDE MEM LOC BY # OF WORDS/TRACK STA TEMP1 TRACK # CLA RRR 6 DIVIDE REMAINING WORDS BY 100B ADB $SSCT ADD SECTORS TO ACCOUNT FOR BOOT EXT STB TEMP2 QUOTIENT IS SECTOR# LDB SECT2 # OF SECTORS PER TRACK ON SYS DISC CMB,INB ADB TEMP2 SECTOR# - # SECTORS/TRACK SSB SECTOR # >= # OF SECTORS/TRACK? JMP CALOF NO, CALCULATE OFFSET STB TEMP2 YES,SECTOR# = SECTOR#-#SECTORS/TRACK ISZ TEMP1 INCREMENT TRACK # * CALOF ALF A REG HAS REMAINDER RAL,RAL STA #OFST # OF WORDS OFFSET INTO SECTOR JMP MEMDS,I RETURN * NWRDS NOP #OFST NOP * * * $TREN - ROUTINE TO TRANSFER A SYSTEM ENTRY POINT VALUE * FROM MEMORY TO A CORRESPONDING LOC ON DISC * CALLING SEQUENCE: A REG = ADDRESS OF ENTRY POINT * B REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * JSB $TREN * $TREN NOP RSS LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS FROM ADDRESS JMP *-2 STB TRTMP SAVE VALUE OF B REG LDB A,I GET CONTENTS OF MEM LOC JSB LOCTR TRANSFER WORD TO DISC LDA TRTMP CALLING FROM SYSTEM MAP? SSA,RSS JMP $TREN,I YES,RETURN UJP $TREN,I NO, RETURN TO USER MAP * * * LOCTR - ROUTINE FINDS DISC ADDRESS FOR A GIVEN MEMORY LOCATION * AND TRANSFERS THE CONTENTS OF THIS LOCATION TO A CORRESPONDING * LOCATION IN MEMORY * * CALLING SEQUENCE: A REG = ADDRESS OF LOC IN MEMORY * B REG = CONTENTS OF LOCATION * £þú JSB LOCTR * * LOCTR NOP STB TRTMP+1 SAVE IT JSB MEMDS FIND DISC ADDRESS FOR THIS LOC LDA TEMP1 GET TRACK# ALF,RAL RAL,RAL TRACK # IN BITS 7-15 ADA TEMP2 SECTOR # IN BITS 0-6 LDB TRTMP+1 JSB TRWRD TRANSFER WORD TO DISC JMP LOCTR,I RETURN * * * $TRTB - PROCEDURE USED TO TRANSFER A TABLE FROM * THE SYSTEM AREA IN MEMORY TO A CORRESPONDING LOCATION * ON THE SYSTEM DISC * CALLING SEQUENCE: JSB $TRTB * A REG = START ADDRESS OF TABLE * B REG = LENGTH OF TABLE (BIT 15 SET IF * CALLING FROM USER MAP) * $TRTB HAS TWO ENTRY POINTS - $TRTB FOR TABLES WITH STARTING * ADDRESS 2000B OR GREATER AND TRPTB WITH MEM LOC LESS THAN 2000B * CALLING SEQUENCE FOR TRPTB IS : JSB TRPTB * TRTMP, TRTMP+1, #OFST WORDS MUST BE SET UP BEFORE CALLING * TRPTB ROUTINE * * $TRTB NOP RSS LDA A,I REMOVE INDIRECTS FROM ADDRESS RAL,CLE,SLA,ERA JMP *-2 STA TRTMP SAVE THE ADDRESS OF TABLE SSB,RSS CALLING FROM USER MAP? JMP TRTB1 NO ELB,CLE,ERB YES LDA $TRTB SET BIT 15 OF THE RETURN ADDRESS ADA BIT15 STA $TRTB LDA TRTMP START ADDRESS OF TABLE TRTB1 STB TRTMP+1 JSB MEMDS CONVERT START ADDRESS INTO DISC LOC JMP TRCNT CONTINUE BY SKIPPING FOLL. INSTRUCTIONS TRPTB NOP SECOND ENTRY POINT LDA TRPTB SET UP RETURN LOC STA $TRTB TRCNT LDA ASCBF ADDRESS OF SECOTR BUFFER STA TEMP3 LDA .64 # OF WORDS TO BE READ STA TEMP JSB SETUP SET UP A TRIPLET TO READ STA TRBFA THE FIRST SECTOR THE TABLE OCCUPIES STA TRBFB ADDRESS OF TRIPLET LDA .2 LU # CAY CLA,INA REQ CODE TO READ CLB BUFFER IN SYS MAP JSB $WRRD READ THE FIRST SECTOR TRBFA €uþúNOP OF THE TABLE LDB #OFST # OF WORDS OFFSET INTO FIRST CMB,INB SECTOR FOR START OF TABLE ADB .64 #WORDS FROM START OF TABLE TO END OF SECTOR LDA TRTMP+1 CMA,INA - ( # OF WORDS IN THE TABLE ) ADA B + (# WORDS TILL END OF SECTOR) SSA,RSS #WORDS IN TABLE <= #WORDS LEFT IN SECTOR? LDB TRTMP+1 YES,#WORDS TO MOVE=# WORDS IN TABLE STB TEMP1 INTO THE FIRST SECTOR LDA TRTMP ADDRESS OF TABLE ADB TRTMP STB TRTMP NEW START LOC OF TABLE STB TEMP3 LDB ASCBF ADDRESS OF SECTOR BUFFER ADB #OFST ADDRESS TO WHICH FIRST PART OF MVW TEMP1 TABLE MUST BE MOVED LDA .2 WRITE BUFFER BACK ON DISC CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFB NOP * LDA TEMP1 CMA,INA ADA TRTMP+1 LENGTH OF TABLE-# OF WORDS TRANSFERRED STA TRTMP+1 # OF WORDS REMAINING TO BE TRANSFERED CLB RRR 6 DIVIDE BY 100B TO GET BLF # OF WORDS IN LAST SECTOR OCCUPIED BY TABLE RBL,RBL STB #OFST SAVE THIS VALUE CMB,INB - ( # OF WORDS IN LAST SECOTR) ADB TRTMP+1 ADD # OF WORDS REMAINING TO BE TRANSFERRED STB TEMP # OF WORDS TO TRANSFER TO DISC IN ONE CHUNK STB TRTMP+1 RESET TO USE LATER LDA TRBFB ADDRESS OF LAST TRIPLET USED JSB NXTAD GET THE NEXT DISC ADDRESS JSB SETUP BUILD TRIPLETS FOR THIS CHUNK OF MEMORY STA TRBFC ADDRESS OF TRIPLETS LDA .2 REQ CODE IS 2 CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFC NOP * LAST SECTOR OF TABLE TO BE TRANSFERRED LDA TRTMP START MEM ADDRESS FOR LAST CHUNK ADA TRTMP+1 # OF WORDS JUST WRITTEN STA TRTMP START ADDRESS FOR LAST PART OF THE TABLE LDA .64 # OF WORDS TO BE READ FROM DISC STA TEMP LDB TRBFC,_ þúI CONTENTS OF FIRST WORD OF LAST TRIPLET LDA TRBFC ADDRESS OF THE LAST TRIPLET USED SZB,RSS WAS LAST TRIPLET EMPTY? LDA TRBFB YES,USE TRIPLET ADDR FROM PREVIOUS TRANSFER JSB NXTAD CALCULATE NEXT DISC ADDRESS LDA ASCBF STA TEMP3 JSB SETUP BUILD THE LAST TRIPLET STA TRBFD ADDRESS OF TRIPLET STA TRBFE LDA .2 CAY CLA,INA REQ CODE IS TO READ SECTOR CLB BUFFER IS IN SYSTEM MAP JSB $WRRD READ SECTOR CONTAINING LAST PART OF THE TABLE TRBFD NOP LDA TRTMP START ADDRESS OF LAST PART OF TABLE LDB ASCBF ADDRESS OF SECTOR BUFFER MVW #OFST # OF WORDS LEFT IN THE TABLE LDA .2 REQ CODE IS 2 TO WRITE CAY CLB BUFFER IS IN SYSTEM MAP JSB $WRRD WRITE LAST PART OF THE TABLE TRBFE NOP LDA $TRTB CALLING FROM USER MAP? SSA,RSS JMP A,I NO, RETURN ELA,CLE,ERA CLEAR SIGN BIT UJP A,I RETURN TO USER MAP * ASCBF EQU ARDBF * * * NXTAD - ROUTINE TO FIND TRACK AND SECTOR # TO BE * USED FOR NEXT SEQUENTIAL DISC ACCESS * CALLING SEQUENCE: A REG = ADDRESS OF LAST TRIPLET USED * JSB NXTAD * RETURNS: TEMP1=NEW TRACK # * TEMP2=NEW SECTOR # * * NXTAD NOP INA POINT TO # OF WORDS IN LAST TRIPLET CAY LDA A,I CLB RRR 6 DIVIDE #OF WORDS BY 100B TO GET # OF SECTORS SZB REMAINDER? INA YES, THEN INCREMENT # OF SECTORS STA TEMP4 SAVE THIS VALUE CYA GET POINTER TO TRIPLET INA POINT TO DISC ADDRESS LDA A,I JSB DSCAD BREAK UP DISC ADDRESS INTO TRACK & SECTOR# LDA TEMP2 GET SECTOR # ADA TEMP4 ADD # OF SECTORS TRANSFERRED CPA SECT2 ALL SECTORS IN TRACK DONE? RSS JMP SECTR NO, SET SECTOR # ;cþú ISZ TEMP1 INCREMENT TRACK # CLA SECTR STA TEMP2 CLEAR SECTOR # JMP NXTAD,I RETURN * * * DSKRD - ROUTINE TO READ TWO 64 WORD SECTORS FROM DISC AND * MOVE THE REQUIRED PORTION OF THE BUFFER INTO ADDRESS IN MEMORY * * CALLING SEQUENCE: A REG = ADDRESS IN SYTEM AREA * B REG = NUMBER OF WORDS TO TRANSFER * JSB DSKRD * * DSKRD NOP STA PRTMP SAVE ADDRESS IN SYSTEM AREA CMB,INB NEGATIVE # OF WORDS STB PRTMP+1 USE AS COUNTER TO MOVE WORDS JSB MEMDS GET DISC ADDRESS LDA ARDBF BUFFER TO READ DATA FROM DISC STA TEMP3 LDA .128 # OF WORDS TO READ STA TEMP JSB SETUP SET UP TRIPLETS FOR DISC READ STA TRPAD SAVE ADDRESS OF TRIPLETS LDA .2 DISC LU# CAY IN Y REG CLA,INA READ OPERATION CLB PRIORITY CODE JSB $WRRD READ THE 2 SECTORS FROM DISC TRPAD NOP ADDRESS OF TRIPLETS * LDA ARDBF ADDRESS IN READ BUFFER AT WHICH ADA #OFST TO START TRANSFER OF WORDS MVWLP LDB A,I GET THE WORD STB PRTMP,I RESTORE IT IN SYSTEM INA POINT TO NEXT WORD ISZ PRTMP NEXT ADDRESS IN SYSTEM ISZ PRTMP+1 INCREMENT NEGATIVE COUNTER JMP MVWLP * JMP DSKRD,I RETURN * .128 DEC 128 * * * * $GDPG - ROUTINE FINDS THE FIRST POSSIBLE GOOD PAGE * STARTING FROM THE PAGE # PASSED AS PARAMETER * * CALLING SEQUENCE : A REG = STARTING PAGE# * BIT 15 SET IF CALLING FROM USER MAP * JSB $GDPG * RETURNS: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * A REG = NEXT GOOD PAGE# * * $GDPG NOP STA PRTMP SAVE A REG SSA CALLING FROM SYSTEM MAP? ELA,CLE,ERA NO, CLEAR SIGN BIT BDPGL CPA MEMSZ PAGE IS EQUAL TO MEMORY SIZE? JMP EXGDP YE”þúS, THEN ERROR RETURN LDB A PAGE# IN B REG CMB,INB STB TEMP LDB $ABDP,I GET BAD PAGE# CPB N1 -1? JMP GDPGR YES, END OF BAD PAGE LIST CPB A EQUAL TO START PAGE # PASSED? JMP FNDBD YES, THEN BAD PAGE FOUND ADB TEMP BAD PAGE # > START PAGE? SSB JMP INCBD NO, THEN INCREMENT THE BAD PAGE# GDPGR ISZ $GDPG YES, RETURN EXGDP LDB PRTMP SSB,RSS JMP $GDPG,I RETURN IN SYSTEM MAP UJP $GDPG,I RETURN IN USER MAP FNDBD INA INCREMENT START PAGE # INCBD ISZ $ABDP INCREMENT BAD PAGE POINTER JMP BDPGL TRY AGAIN * * * $PCHN - ROUTINE TO FIND A CHUNK OF MEMORY LARGER THAN * ONE PAGE BETWEEN BAD PAGES * CALLING SEQUENCE : JSB $PCHN * A REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * RETURNS: A REG = SIZE OF CHUNK OF MEMORY * * $PCHN NOP STA TEMP1 LDA $USRS GET START OF USER PART'N JSB $GDPG GET THE NEXT GOOD PAGE JMP ZEROP NO, MORE GOOD PAGES STA $USRS NEW GOOD PAGE PCHLP LDA $ABDP,I GET BAD PAGE VALUE CPA N1 END OF BAD PAGE LIST? JMP NBDPG YES LDB $USRS START OF USER PART'N AREA CMB,INB ADA B BAD PAGE# - START OF USER PART'N CPA .1 SIZE OF THIS CHUNK IS 1? JMP ONEPG YES JMP RPCHN * ONEPG LDA $ABDP,I INCREMENT USER PART'N START PG INA JSB $GDPG FIND GOOD PAGE STARTING AT THE NEW JMP ZEROP NO MORE PAGES LEFT STA $USRS NEW USER PART'N START PAGE JMP PCHLP * ZEROP CLA JMP RPCHN RETURN * NBDPG LDA $USRS START OF USER PART'N CMA,INA ADA MEMSZ MEM SIZE - START USER PART'N PAGE CPA .1 ONLY ONE PAGE? JMP ZEROP YES, THEN RETURN WITH 0 PAGES RPCHN LDB TEMP1 SSB,RSS CALLING FROM SYSTE«“<:6M MAP? JMP $PCHN,I YES, RETURN UJP $PCHN,I NO, ENABLE USER MAP AND RETURN * END $CNFG |<ÿÿ ÿýÄ8ý ÿ92067-18026 1926 S C0122 &$TB14 RTE-IV TABLE AREA I             H0101 ·‚þúASMB,R,L,C * * DATE: 9/21/77 * NAME: $$TB1 * SOURCE: 92067-18026 * RELOC: PART OF 92067-16014 * PGMR: E.WONG * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB1,15 92067-16014 REV.1926 790506 * * EXEC4: ENT $ERAB,$PVCN,EXEC,$LIBR,$LIBX,$PVST * RTIO4: ENT $UPIO,$CIC,$XCIC,$YCIC ENT $UIN,$UCON * DISP4: ENT $XEQ,$XDMP,$IDLE * SCHD4: ENT $SCD3,$IDNO,$MEU,$LIST,$MESS,$WORK,$$OP * TRRN4: ENT $ULLU,$CGRN * MTM: ENT $MTM * ENT $OPSY,$DATC * * EXEC4: EXT $ERRA,$LBR,$LBX,$XEX * RTIO4: EXT $UP,$CIC0,$CXC,$CYC EXT $CON1,$CON2,$CON3 * DISP4: EXT $XCQ,$XDM * SCHD4: EXT $SCD,$ID#,$LST,$MSG,$IDSM,$OP * TRRN4: EXT $ULU,$CRN# * A EQU 0 B EQU 1 * * EXEC4 * HLT 0 TRAP IN CASE OF FALL THROUGH. JMP *-1 DON'T ALLOW RE-RUN EXEC NOP JMP EXEC OR JSB EXEC WITHOUT MP SJP $XEX WILL BE CAUGHT IN EXEC CODE * $ERAB SJP $ERRA * $PVCN NOP LEVEL COUNT FOR PRIVILEGED CALL $PVST NOP DMS STATUS FOR PRIVILEGED CALL * $LIBR NOP SSM $PVST SJP $LBR * $LIBX NOP SSM $PVST SJP $LBX * * * RTIO4 * $UPIO SJP $UP * $CIC NOP JMP $CIC0 *1926DLS* * $XCIC SJP $CXC * $YCIC SJP $CYC * $UIN NOP UJS B,I ENTER DRIVER IN USER MAP SJP $UIN,I RETURN IN SYSTEM MAP * $UCON UJS B,I ENTER DRIVER IN USER MAP JMP UCON1 P+1 RETURN JMP UCON2 …D   P+2 RETURN SJP $CON3 P+3 RETURN UCON1 SJP $CON1 UCON2 SJP $CON2 * * * DISP4 * $XEQ SJP $XCQ * $XDMP NOP RSB SJP $XDM * IDLE JMP * $IDLE DEF IDLE ADDR OF IDLE LOOP NOP DUMMY A,B,EO,X NOP DUMMY Y * * * SCHD4 * $LIST NOP RSA SJP $LST * $SCD3 NOP RSB SJP $SCD * $IDNO NOP RSA SJP $ID# * $MESS NOP SSM $MEU SJP $MSG $MEU NOP SAVES MEU STATUS FOR $MESS * $WORK JMP $IDSM * $$OP DEF $OP+0 DIRECT ADDRESS OF LAST PARSED OP CODE * * * TRRN4 * $ULLU NOP RSA SJP $ULU * $CGRN NOP RSB SJP $CRN# * * * MTM * $MTM NOP * * $OPSY DEC -9 RTE-IV IDENTIFICATION $DATC DEC 1926 DATE CODE OF OPERATING SYSTEM MODULE.*1926DLS* * * END $OPSY ×ä ÿÿ ÿýÅÌ ÿ92067-18027 1926 S C0122 &$TB24 RTE-IV TABLE AREA II             H0101 ¹«ASMB,R,L,C * DATE: 7/26/77 * NAME: $$TB2 * SOURCE: 92067-18027 * RELOC: PART OF 92067-16014 * PGMR: E.J.WONG * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB2,13 92067-16014 REV.1926 790510 * ENT $MATA,$MCHN,$MBGP,$MRTP ENT $DLTH,$DVPT,$TIME,$BATM ENT $DLP,$PLP ENT $ENDS,$MPFT,$BGFR,$RTFR,$IDEX ENT $MRMP,$MPS2,$EMRP,$MPSA ENT $SDA,$SDT2,$CMST,$COML ENT $CFR,$MNP,$DVMP $STRG ENT $RLB,$RLN,$SBTB,$STRK,$SSCT * * $MATA NOP $MCHN NOP $MBGP DEC 14 $MRTP DEC 5 $DLTH DEC 1 $DVPT NOP $TIME OCT 16000 JAN 5, 1978 8:00 AM OCT 177650 OCT 5554 $BATM NOP 1. NOP 2. $DLP NOP $PLP NOP $ENDS NOP $MPFT NOP $BGFR NOP $RTFR NOP $IDEX NOP $MRMP NOP $MPSA NOP $MPS2 NOP $SDA NOP $SDT2 NOP $CMST NOP $STRK DEC 0 STARTING RELATIVE TRACK OF OP SYSTEM $SSCT DEC 2 STARTING RELATIVE SECTOR OF OP SYSTEM $COML NOP $CFR NOP $MNP NOP $DVMP NOP $EMRP NOP $RLB NOP $RLN NOP $SBTB NOP 1. NOP 2. NOP 3. NOP 4. NOP 5. NOP 6. * END $MATA ˆÛÿÿ ÿýÆÌ ÿ92067-18028 1805 S C1622 &GP01 RTE-IV GASP             H0116 Aþú SPL,L,O,M,C ! NAME: GASP ! SOURCE: 92067-18028 ! RELOC: 92067-16028 ! PGMR: A.M.G. ! MOD FOR RTE 4 : C.M.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME GASP(19,80) "92067-16028 REV.1805 780323" ! ! LET G1ERP,G1OMS,G1ZAP,G1WFI BE SUBROUTINE LET G1IMS BE SUBROUTINE ! LET KCVT BE FUNCTION,EXTERNAL LET POST,CREAT,OPEN,CLOSE,POSNT,EXEC BE SUBROUTINE,EXTERNAL LET READF,WRITF,PARSE,G1ROT,G1CEX BE SUBROUTINE,EXTERNAL LET G1CIN,RNRQ,REIO BE SUBROUTINE,EXTERNAL LET ST.LU BE SUBROUTINE,DIRECT,EXTERNAL LET G1RD,G1WFI,G1OPN BE SUBROUTINE LET ERTS BE SUBROUTINE,DIRECT ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET G0INT BE INTEGER,EXTERNAL LET CS43,SP.OK,G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER(3),GLOBAL LET PRMPT BE INTEGER(2) LET JODCB,SPDCB BE INTEGER(16) !DO NOT REARRANGE THESE TWO LET G0DCB BE INTEGER(144),GLOBAL !LINES LET SIZE,SIZE1 BE INTEGER LET ERRS BE INTEGER(3) LET SIGN,ERRNO,SSPOL BE INTEGER LET NSPL,IERR,SAVE,SAVE1,SAVE2 BE INTEGER LET WRN,IRN,ICNWD,CHARS,FFILE,ADDR BE INTEGER LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,GLOBAL LET G0WD4 BE INTEGER(3),GLOBAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,GLOBAL LET G0W12 BE INTEGER(2) LET G0W14 BE INTEGER LET G0W15 BE INTEGER,GLOBAL LET G0W16(110) BE INTEGER LET PBFN2,PBFN1 BE INTEGER LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4 BE INŠQþúTEGER LET BUFX5 BE INTEGER(9) LET BUX14 BE INTEGER LET BUX15 BE INTEGER(17) LET G0PBF BE INTEGER,GLOBAL LET G0P1V BE INTEGER,GLOBAL LET PARS1 BE INTEGER(3) LET G0P2V BE INTEGER,GLOBAL LET PARS2 BE INTEGER(26) LET G0NOP BE INTEGER,GLOBAL LET G0SDN,G0JDN BE INTEGER,GLOBAL LET G0TTY,G0RDS,G0ERH BE INTEGER,GLOBAL ! INITIALIZE PRMPT TO 1,57137K INITIALIZE G0RDS TO 0 INITIALIZE G0EXN TO "EXTND" INITIALIZE G0JBF TO "JOBFIL" INITIALIZE G0SPF TO "SPLCON" INITIALIZE ERRS,SIGN TO 4,"GASP " ! LET CNWD BE CONSTANT(400K) LET E BE CONSTANT(42440K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! GASP: CALL EXEC(22,2);SAVE1 _ $$1 IFNOT [G0TTY _ (SAVE1 AND 77K)] THEN G0TTY _ 1 G0TTY _ G0TTY + CNWD !SAVEG0TTY. IF [X_CS43] THEN GOTO FCHEK CALL ST.LU !SET UP $LUAV AND CS43. CALL EXEC(9,G0EXN,0) !EXTND SETS UP $MPID. FCHEK: CALL OPEN(JODCB,IERR,G0JBF,IOPTN,SEC)!TRY TO OPEN JOBFIL. CALL ERTS !TEST FOR ERRORS CALL G1ZAP(SPDCB) CALL OPEN(SPDCB,IERR,G0SPF,IOPTN,SEC) !NOW TRY SPLCON CALL ERTS !TEST FOR ERRORS CALL G1OPN(G0DCB,IERR,G0JBF) !MOVE THE OPEN DATA CALL G1RD(G0BUF,17) !READ RECORD 17 IF X THEN GOTO RSTRT CALL G1RD(PBUFX,1) !REALLOCATE RN S RNRQ(20K,PBUFX,SAVE) !FOR SPLCON/JOBFIL G0BUF _ PBUFX !TIME THROUGH AFTER RNRQ(20K,G0W14,SAVE) !ALLOCATE HOLD BEM RN. CALL G1WFI(PBUFX,1) !BOOT-UP. CALL G1WFI(G0BUF,17) RSTRT: CALL G1OPN(G0DCB,IERR,G0SPF) !SET TO ACCESS SPLCON IF X THEN GO TO RSTR2 CALL G1RD(PBUFX,1) RNRQ(20K,PBUFX,SAVE) ÅFþú CALL G1WFI(PBUFX,1) RSTR2: CALL G1RD(PBUFX,3) G0SDN_PBUFX;G0JDN_G0W15 !SET THE DOWN FLAGS IF X THEN GO TO GETCD BUFX1 _ G0W14 CALL G1WFI(PBUFX,3) CALL G1CEX(-1) !TERMINATE GO TO GETCD !GET COMMAND ON RESTART ! TERM: CALL CLOSE(JODCB,IERR) !CLOSE THE FILE AND CALL CLOSE(SPDCB) EX: CALL EXEC(6) !EXIT ! GETCD: IFNOT G0RDS THEN [ \READ NEXT COMMAND AND CALL G1IMS(PRMPT)] !PARSE, IF NECESSARY. IERR,G0RDS _ 0 CALL G1ROT(G0PBF,G0NOP,IERR) !GO TO PROPER ROUTINE. ERCHK: IFNOT IERR THEN GOTO GETCD !COME BACK. CHECK FOR CALL G1ERP(IERR) !ELSE REPORT THE ERROR GO TO GETCD !GO GET THE NEXT COMAND ! ! INIT: IF SAVE1 < 0 THEN GO TO EX !IF NO INPUT UNIT, EXIT. IF SP.OK > 0 THEN[\ !CHECK WHAT ST.LU RETURNED CALL G1OMS(G0INT);GO TO INIT1] !IF 0 OR NEG SEND ERROR G0P1V_60K !SET CODE TO GET TO INIT CALL G1ROT(G0PBF,G0NOP,IERR) !CALL INNITILIZE INIT1: CALL G1OMS(G0END) !SEND END MESSAGE GO TO EX ! ! THE FOLLOWING ROUTINE ZEROES A 16-WORD BUFFER AREA. ! G1ZAP: SUBROUTINE(LOCAT) GLOBAL LET LOCAT BE INTEGER SAVE2 _ @LOCAT - 1 REPEAT 16 TIMES DO [ \ $[SAVE2 _ SAVE2+1] _ 0] RETURN END ! ! THE FOLLOWING ROUTINE GETS THE RESPONSE TO QUESTIONS ! AT INITIALIZATION. ! G1IMS: SUBROUTINE(MESS) GLOBAL LET MESS BE INTEGER CALL G1OMS(MESS) CALL REIO(1,G0TTY,G0BUF,-32) CHARS _ $1 CALL PARSE(G0BUF,CHARS,G0PBF) RETURN END ! ! WRITE OUT A MESSAGE ! G1OMS: SUBROUTINE(STRNG) GLOBAL LET STRNG BE INTEGER SAVE2 _ üþú @STRNG + 1 CALL EXEC(2,G0TTY,$SAVE2,STRNG) RETURN END ! ! READ RECORD NUMR TO RDBF ! G1RD: SUBROUTINE(RDBF,NUMR)GLOBAL CALL READF(G0DCB,IERR,RDBF,16,LOC,NUMR) !READ THE RECORD IF IERR<0 THEN GO TO ERMS RETURN END ! ! ERROR ROUTINE FOR FIRST OPENS ! ERTS: SUBROUTINE DIRECT IFNOT IERR+6 THEN GO TO INIT IF IERR<0 THEN[\ ERMS: CALL G1ERP(IERR);GO TO TERM] RETURN END ! ! THIS OPEN ROUTINE REALLY JUST MOVES IN A SAVED DCB HEADER ! G1OPN: SUBROUTINE(NWDCB,RREI,NAMF) GLOBAL DPT_@NWDCB RREI_2 !ERROR IS ALWAYS TWO IF NAMF = "SP" THEN GO TO SPOPN !IF SPOOL GO DO IT SPT_@JODCB !SET SOURCE POINTER GO TO MVOPN !GO DO THE MOVE ! SPOPN: SPT_@SPDCB ! SET UP FOR SPOOL CON MVOPN: CALL POST(NWDCB,IERR) !POST ANY DATA FOR K_0 TO 15 DO[$(DPT+K)_$(SPT+K)] !MOVE DCB RETURN END ! ! WRITE A RECORD TO A FILE. ! G1WFI: SUBROUTINE(RECD,RNUM) GLOBAL,FEXIT LET RECD,RNUM BE INTEGER CALL WRITF(G0DCB,IERR,RECD,16,RNUM) IF IERR THEN FRETURN RETURN END ! ! PRINT CURRENT ERROR ROUTINE ! G1ERP: SUBROUTINE(BOMNO) GLOBAL SAVE_BOMNO IF BOMNO < 0 THEN [SAVE_ -BOMNO; \IF NEGATIVE SET SIGN SIGN_ 20055K] !TO "-" ERRNO_ KCVT(SAVE) !CONVERT TO ASCII CALL G1OMS(ERRS) !SEND THE MESSAGE SIGN _ " " !BLANK THE SIGN AGAIN G0ERH _ BOMNO !KEEP THE HISTORY RETURN !EXIT END ! ! END GASP END$ 7;ÿÿ SPL,L,O ! NAME: G1CEX ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CEX(8) "92002-16001 760615" ! LET CLOSE,POST,G1OPN,EXEC,G1OMS BE SUBROUTINE,EXTERNAL LET G1SUB,G0JDN,G0SDN,G0DCB,G0TTY,G0END BE INTEGER,EXTERNAL ! G1CEX: SUBROUTINE(N) GLOBAL IF N # -1 THEN CALL G1OMS(G0END) CALL POST(G0DCB) !POST DCB IF NEEDED IFNOT G0JDN THEN GO TO EX !IF BOTH IFNOT G0SDN THEN GO TO EX !JOB AND SPOOL SHUT CALL G1OPN(G0DCB,I,"JO") !DOWN CLOSE BOTH FILES CALL CLOSE(G0DCB) !AND CALL G1OPN(G0DCB,I,"SP") !DO NORMAL TERM CALL CLOSE(G0DCB) CALL EXEC(6) ! ! SPOOL OR JOB OR BOTH STILL ACTIVE ! SO SAVE RESOURCES AND TERMINATE ! EX: CALL EXEC(22,2) !DON'T SWAP ALL OF MEM G1SUB_0 !CLEAR SEGMENT FLAG CALL EXEC(6,0,1,0) I_$$1 !GET THE LU IFNOT [G0TTY_(I AND 77K)] THEN G0TTY_1 G0TTY_G0TTY+400K !SET THE ECHO BIT RETURN END END END$ ¢ÿÿþúASMB,R,L HED ST.LU * NAME: ST.LU * SOURCE: 92002-18001 * RELOC: 92001-16001 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ST.LU,8 92067-16028 780317 ENT ST.LU * EXT N.SEQ,$LIBR,$LIBX,$DVMP,SP.OK EXT $LUAV,.DRCT,EXEC,IS43,CS43 * * THE FOLLOWING ROUTINE INITIALIZES THE SPOOL * AVAILABILITY TABLE, $LUAV, AND SETS CS43 # 0 * AS A DONE FLAG. * ST.LU NOP LDA XEQT GET MY ID ADDRESS ADA D14 INDEX TO TYPE WORD LDA A,I PULL IT IN AND M7 KEEP ONLY TYPE CPA D3 IS THIS PROG BG ? RSS YES ISZ INOGO SET AN ERROR FLAG * JSB .DRCT DEF $LUAV GET ADDRESS OF $LUAV. STA ADDR INA STA PTR2 CLA SET COUNTERS AND POINTERS. STA CNTR2 LDA EQTA GET ADDRESS OF WORD 2 OF 1ST EQT. INA STA PTR1 LDA EQTNO SET COUNTER FOR # OF EQT'S CMA,INA TO SEARCH. STA CNTR1 CLB,INB STB NEQT JSB .DRCT GET DIRECT ADDRESS OF DEF IS43 IS43 ENTRY POINT TO SMD. STA SMDAD JSB $LIBR NOP LOOP1 LDA CNTR2 CPA ADDR,I JMP DONE LDA PTR1,I PICK UP EQT2 - DRIVER CPA SMDAD ENTRY POINT. MATCH IS43? JMP SEEK YES. INCR1 ISZ NEQT KEEP LOOKING AT EQT'S. LDA PTR1 ADA D15 INCREMENT TO NEXT EQT. STA PTR1 ISZ CNTR1 JMP LOOP1 * DONE LDA INOGO GET THE ERROR FLAG STA SP.OK AND SAVE IN SSGA SZA WERE THEREŠ§þú ANY ERRORS ? JMP OUT YES, DRIVER NOT IN OUR MAP * LDA CNTR2 STA N.SEQ DONE - SAVE # OF SPOOL EQT'S. CMA,INA,SZA DON'T SAVE IF THERE ARE NONE STA ADDR,I CCA SET CS43 TO STA CS43 -1 TO SHOW DONE OUT JSB $LIBX DEF ST.LU * SEEK CCB GET THE APPROPRIATE DRIVER MAP ENTRY ADB NEQT ADB $DVMP LDA B,I PULL IT IN SSA,RSS IS THE SYS DVR MAP BIT SET ? JMP NOWAY NO. LDA M1K1 GET CORRECT VALUE ? STA B,I AND PUT IT AWAY * CCA NOW SEE IF EQT HAS EXTENTS ADA NEQT MPY D15 ADA EQTA ADA D11 INDEX TO 12 WORD OF THE EXTENT LDA A,I PULL IT IN ADA DM18 SSA OK ? NOWAY ISZ INOGO NO ! * LDA DRT FOUND A SPOOL EQT. STA PTR3 MUST SEARCH DRT TO LDA LUMAX FIND THE CORRESPONDING CMA,INA LU #. STA CNTR3 CLB,INB LOOP2 LDA PTR3,I PICK UP DRT ENTRY. AND B77 GET EQT #. CPA NEQT MATCH THIS ONE? JMP ENTER YES. INB NO - KEEP LOOKING. ISZ PTR3 ISZ CNTR3 JMP LOOP2 JMP INCR1 ENTER STB PTR2,I MAKE AN ENTRY IN $LUAV. ISZ PTR2 CLA STA PTR2,I ISZ PTR2 ISZ CNTR2 JMP INCR1 * SMDAD BSS 1 M1K1 OCT 100001 DM18 DEC -18 INOGO NOP B77 OCT 77 D3 DEC 3 D11 DEC 11 D14 DEC 14 D15 DEC 15 M7 OCT 7 NEQT BSS 1 CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 PTR1 BSS 1 PTR2 BSS 1 PTR3 BSS 1 ADDR BSS 1 EQTA EQU 1650B EQTNO EQU 1651B DRT EQU 1652B LUMAX EQU 1653B XEQT EQU 1717B A EQU 0 B EQU 1 * END Í ÿÿþúASMB,R,L HED G1ROT * NAME: G1ROT * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1ROT,8 92002-16001 760615 ENT G1ROT ENT G1SUB ENT G1SEG * * EXT .ENTR EXT EXEC EXT G1CEX * PBUFR NOP PLEN NOP IERR NOP * G1ROT NOP JSB .ENTR DEF PBUFR LDA G1SUB IF TABLE ADDRESS IS ZERO SZA,RSS THEN STA CSEG ZERO THE SEGMENT PRESENT FLAG LDB PBUFR INB B POINTS TO COMMAND ENTERED LDB B,I GET THE NUMONIC STB G1KLG SAVE IT * LDB BUFAD GET COMMAND TABLE ADDRESS CLA SET SEGMENT FLAG TO MAIN SEGST STA SEGID CLA SET SEGMENT OFFSET TO STA SEGOF ZERO NXTCM INB STEP TABLE ADDRESS LDA B,I GET ENTRY SSA NEGATIVE MEANS NEW SEGMENT JMP SEGST GO SET IT * SZA,RSS ZERO IS END OF LIST JMP G1RT1 ERROR EXIT * CPA G1KLG THIS IT? JMP ITSIT YES GO PROCESS * ISZ SEGOF STEP THE OFFSET JMP NXTCM TRY THE NEXT ONE * ITSIT LDA SEGID GET THE SEGID LDB RTAD SET ADDRESS IN CASE MAIN CMA,INA,SZA,RSS IF ZERO THEN ITS IN THE MAIN JMP MAIN * ADA "0" MAKE IT ASCII ALF,ALF AND ROTATE TO HIGH CPA CSEG CURRENT SEGMENT? JMP G1SEG YES GO DO IT * STA CSEG SET NEW SEG NAME JSB EXEC CALL SYSTEM TO LOAD THE SEGMENT DEF G1SEG мþú DEF D8 DEF GASP * G1SEG LDB G1SUB GET RETURNED ADDRESS MAIN ADB SEGOF ADD THE OFFSET LDB B,I GET ENTRY POINT OF SUB. JSB B,I DEF *+4 DEF PBUFR,I DEF PLEN,I DEF IERR,I JMP G1ROT,I * G1RT1 LDA D5 ILLEGAL COMMAND STA IERR,I SET ERROR CODE JMP G1ROT,I AND RETURN * GASP ASC 2,GASP CSEG NOP CURRENT SEGMENT G1SUB NOP CURRENT SEGMENTS ENTRY POINT TABLE ADDRESS D5 DEC 5 D8 DEC 8 SEGID NOP SEGOF NOP * BUFAD DEF * ASC 1,EX OCT -1 FOLLOWING ARE IN SEGMENT 1 ASC 1,DJ ASC 1,CJ ASC 1,DS ASC 1,CS ASC 1,KS ASC 1,RS ASC 1,AB OCT -2 FOLLOWING ARE IN SEGMENT 2 ASC 1,DA ASC 1,?? "0" OCT 60 SPECIAL CODE TO GET TO IN ROUTINE ASC 1,SD ASC 1,SU NOP END OF TABLE RTAD DEF *+1 DEF G1CEX MAIN TRANSFER TABLE * ENT G1KLG * EXT $LUAV,.DRCT,G0WD1 * * THIS ROUTINE COUNTS THE NUMBER OF ACTIVE LU'S FOR THE * SPOLCON RECORD NUMBER PASSED BY SCANNING THE LU AVAILABLITY * TABLE ($LUAV) AND RETURNS THIS NUMBER IN THE A REGISTER * * CALLING SEQUENCE: * * JSB G1KLG * DEF RNUM NUMBER OF THE RECORD TO BE FOUND * --- RETURN A SET AS ABOVE * G1KLG NOP LDA $LUAV GET THE COUNT OF ENTRIES STA COUNT JSB .DRCT GET A DIRECT ADDRESS DEF $LUAV OF THE TABLE STA PTR AND SAVE IT CLA CLEAR THE RETURN COUNT STA RTN LDA G1KLG,I GET THE RECORD NUMBER LDA A,I TO LOCAL STA RNUM STORAGE ISZ G1KLG STEP TO THE RETURN ADDRESS * NEXT ISZ PTR STEP TO THE ENTRY LDA PTR,I GET THE CURRENT LU ISZ PTR STEP TO THE RECORD NUMBER SSA,RSS IF NOT AN ACTIVE ENTRY JMP CONT JUST CONTINUE * LDB PTR,I GET THE pœ ENTRY'S RECORD NUMBER CPB RNUM THIS IT? ISZ RTN YES STEP THE COUNT * CONT ISZ COUNT END OF THE LIST?? JMP NEXT NO TRY NEXT ONE * LDA RTN YES SEND BACK THE COUNT JMP G1KLG,I RETURN SPC 2 PTR NOP RTN NOP RNUM NOP COUNT NOP A EQU 0 B EQU 1 END ±6ÿÿASMB,R,L HED G0QIP * NAME: G0QIP * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G0QIP,8 92002-16001 760621 ENT G0NJB,G0NLO,G0SZF,G0NSP ENT G0KIL,G0END,G0JHD,G0MXP,G0SLU,G0INT * SUP G0NJB DEC -35 ASC 18,MAX NUMBER OF JOBS,JOB FILE DISC? _ GUARD G0NLO DEC -33 ASC 17,NUMBER,LOCATION OF SPOOL FILES? _ GUARD G0MXP DEC -48 ASC 20,MAXIMUM NUMBER ACTIVE AND PENDING SPOOL ASC 4,FILES? _ GUARD G0NSP DEC -34 ASC 17,NUMBER OF SPOOL FILES (5 TO 80)? _ GUARD G0SZF DEC -34 ASC 17,SIZE OF SPOOL FILES (IN BLOCKS)? _GUARD G0SLU DEC -31 ASC 16,ENTER OUTSPOOL DESTINATION LU _ GUARD G0JHD DEC 19 ASC 19,## NAME STATUS SPOOLS G0END DEC 4 ASC 4,END GASP G0KIL DEC -39 ASC 20,MAY ABORT PROGRAM OR JOB, OK TO KILL? _ GUARD G0INT DEC -40 ASC 20,/GASP: IRRECOVERABLE INITIALIZE ERROR ! * END 80ÿÿASMB,R,L HED GASP1 * NAME: GASP1 * SOURCE: 92067-18028 * RELOC: 92067-16028 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP1,5 92067-16028 REV.1805 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP1 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDJ DEF G1CDJ EXT G1CCJ DEF G1CCJ EXT G1CDS DEF G1CDS EXT G1CCS DEF G1CCS EXT G1CKS DEF G1CKS EXT G1CRS DEF G1CRS EXT G1CAB DEF G1CAB END GASP1 dqÿÿþú SPL,L,O ! NAME: G1CDJ ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: A.M.G. ! DATE: 741015 ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDJ(8) LET G1SCH,G1RDF BE SUBROUTINE LET G1OMS BE SUBROUTINE,EXTERNAL LET G1STM BE SUBROUTINE,EXTERNAL,DIRECT LET EXEC,G1OPN,READF BE SUBROUTINE,EXTERNAL ! LET G0W15,G0BUF,G0WD1,G0WD7,G0WD8,G0WD9 BE \ INTEGER,EXTERNAL LET CNTR,BEGIN,TYP,SKEY BE INTEGER LET G0JHD,G0TTY,G0DCB,G0JBF BE INTEGER,EXTERNAL LET DOWN(6) BE INTEGER INITIALIZE DOWN TO 5," SHUT DOWN" LET SPACE BE REAL INITIALIZE SPACE TO 2," " ! LET CNWD BE CONSTANT(1100K) ! ! ! G1CDJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER BEGIN _ 19; TYP _ $(@PBUFR+4) SKEY _ @PBUFR+5 ICNWD _ CNWD + G0TTY !SET UP I/O DEVICE. CALL EXEC(3,ICNWD,-1) CALL G1OMS(G0JHD) CALL G1OMS(SPACE) CALL EXEC(3,ICNWD,1) CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN CALL G1RDF(17,ERR)?[RETURN] !GET SPEC RECORD ENDR_G0WD1 !SAVE THE END RECORD ! IFNOT (PCNT-1) THEN GOTO WHOLE FL_0 !SET NONE FOUND YET FLAG SEEK: G1SCH(SKEY,TYP,BEGIN,ENDR,ERR) \ ? [IF FL THEN GO TO RETN;IFNOT ERR THEN ERR_6;RETURN] CALL G1STM !PRINT OUT STATUS IF [FL_TYP] = 2 THEN [ \IF NAME KEY, THEN BEGIN _ BEGIN + 1; GOTO¤i   SEEK] !LOOK FOR MORE JOBS GOTO RETN !OF SAME NAME. WHOLE: CALL G1RDF(17,ERR) ? [RETURN] CNTR _ G0WD1 FOR STRT _ 19 TO CNTR DO [ \ CALL G1RDF(STRT,ERR) ? \ [RETURN]; IF G0BUF >= 0 THEN \ CALL G1STM] RETN: IF ERR THEN RETURN CALL G1RDF(17,ERR)?[RETURN] IF G0W15 = "D" THEN CALL G1OMS(DOWN) RETURN END ! ! SEARCH THE JOBFIL FOR A JOB (NAME OR NUMBER KEY). ! G1SCH: SUBROUTINE(KEY,TYPE,STR,ENDF,ERRS) GLOBAL,FEXIT LET KEY,TYPE,STR,ENDF,ERRS BE INTEGER FOR STR _ STR TO ENDF DO [ \ CALL G1RDF(STR,ERRS) ? [FRETURN]; \ IF G0BUF >= 0 THEN [ \ IF TYPE = 1 THEN [ \ IF $KEY = G0WD1 THEN RETURN], \ ELSE [IF $KEY = G0WD7 THEN [IF \ $(KEY+1) = G0WD8 THEN [IF \ $(KEY+2) = G0WD9 THEN\ RETURN]]]]] FRETURN END ! G1RDF: SUBROUTINE(NUM,ERROR) GLOBAL,FEXIT LET NUM,ERROR BE INTEGER CALL READF(G0DCB,ERROR,G0BUF,16,LEN,NUM) IF ERROR THEN FRETURN RETURN END END END$ © ÿÿþú SPL,L,O ! NAME: G1CCJ ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CCJ(8) "92002-16001 760615" ! ! LET G1SCH,G1WFI,G1OPN BE SUBROUTINE,EXTERNAL LET EXEC,POST,RNRQ,G1RDF BE SUBROUTINE,EXTERNAL ! LET G0DCB,G0JBF,G0BUF,G0WD1,G0WD2,G0WD7 BE INTEGER,EXTERNAL ! LET FMGR(3),PAR1,PARS2,PAR2,RSTAT BE INTEGER ! LET IOPTN BE CONSTANT(3) LET SEC BE CONSTANT(123456K) ! INITIALIZE RSTAT TO 0 INITIALIZE FMGR TO "FMGR " LET CHHI BE CONSTANT (44400K) ! ! G1CCJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER PAR2 _ [PARS2 _ [PAR1 _ @PBUFR + 5] \ + 3] + 1 IFNOT $(@PBUFR+4) = 1 THEN [ \ RET1: ERR _ 3; GOTO RETN] CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN G1RDF(17,ERR) ? [GOTO RETN] IF [REC_$PAR1+18] > G0WD1 THEN[\IF BAD JOB NUM EXIT ER3: ERR_3;RETURN] JRN _ G0BUF POST(G0DCB) RNRQ(1,JRN,RSTAT) CALL G1RDF(REC,ERR)?[GO TO RETN] IF [NP_G0BUF]<0 THEN [ERR_3;GO TO RETN]!IF NO JOB HERE EXIT IF (G0WD2 = "CS") OR (G0WD2 = "A") THEN [ \ RET2: ERR _ 4; GOTO RETN] IF PCNT < 0 THEN[ \ABORT REQUEST NP_0; \SET FOR INPUT ABORT IF G0WD2 = "I" THEN GO TO IAB; \IF INPUT OR IF (G0WD2 AND 177400K) = CHHI THEN[ \INPUT A OR H IAB: G0WD2_ "IA";GO TO WRT]; \SET TO IA G0WD2_ "A";NP_ -G0BUF;GO TO WRT] !ELS¼Ã  E SET TO A ! IFNOT $PARS2 = 1 THEN GOTO CHR IF $PAR2 < 1 THEN GOTO RET1 NP,G0BUF _ $PAR2; GOTO WRT ! ! CHANGE STATUS ! CHR: PAR2_$PAR2 AND 177400K IF PAR2 = 44000K THEN[ \HOLD REQUEST IFNOT [HI_G0WD2 AND 177400K] THEN \IF NO HIGH STATUS HI_G0WD2*400K; \USE THE LOW STATUS G0WD2_HI+"H";NP_0;GO TO WRT] !SET UP AND EXIT IF PAR2 = 51000K THEN[ \RELEASE REQUEST IF G0WD2 AND 177400K THEN \IF A HIGH STATUS G0WD2_G0WD2/400K; \JUST PUT IT LOW ELSE NOP IF G0WD2 # "R" THEN NP_0; \IF NOT READY DON'T Q IT GO TO WRT] ERR_56 !BAD PRAM SO SEND ERROR CJERR: IF ERR THEN GOTO RETN GOTO RET2 WRT: CALL G1WFI(G0BUF,REC) ? [GOTO RETN] REC_(REC-1)/16 !GET FLAG ADDRESS OFF_$1 CALL G1RDF(REC,ERR)?[GO TO RETN] $(@G0BUF+OFF)_NP !SET THE NEW PRIORTY CALL G1WFI(G0BUF,REC) RETN: IF RSTAT = 2 THEN [POST(G0DCB); \ RNRQ(4,JRN,RSTAT)] IF PCNT<0 THEN GO TO ABT IF PAR2 = 51000K THEN[\ IF GOING ACTIVE OR ABORT THEN ABT: IFNOT ERR THEN CALL EXEC(10,FMGR,-1)]!CALL FMGR TO FINISH RETURN END ! ! ABORT SETS THE JOB ACTIVE AND COUNTS ON FMGR TO CLEAN UP ! G1CAB: SUBROUTINE(P1,P2,P3) GLOBAL CALL G1CCJ(P1,-1,P3) !CALL CHANGE JOB TO DO IT RETURN END END END$ —æ ÿÿþú SPL,L,O ! NAME: G1CKS (G1CRS) ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CKS(8) "92002-16001 760627" ! ! ! THIS ROUTINE KILLS OUT SPOOL FILES WHICH ARE PENDING ! ON SOME LU OR IN ONE OF THE HOLD STATES. ! ! IT IS INVOKED WITH THE: ! ! KS,PRAM COMMAND ! ! WHERE PRAM IS: ! NUMERIC MEANING KILL THE SPOOL ACTIVE ON LU PRAM ! ASCII MEANING KILL THE SPOOL BY NAME PRAM ! LET G1IMS, \ G1WFI,POST,G1OPN,G1RDF,EXEC,RNRQ BE SUBROUTINE,EXTERNAL LET G1KLG BE FUNCTION,EXTERNAL,DIRECT ! LET G0DCB,G0SPF,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4,\ G0W10,G0W15,G0P1V,G0KIL BE INTEGER,EXTERNAL ! LET RD,RECV,WRIF BE SUBROUTINE,DIRECT ! LET SMP(3) BE INTEGER LET JOB(3) BE INTEGER INITIALIZE SMP TO "SMP " INITIALIZE JOB TO "JOB " ! G1CKS: SUBROUTINE(PRAM,N,ER) GLOBAL ! LU_[PV3_[PV2_[PV_[PF_@PRAM+4]+1]+1]+1]+2 !SET UP PRAM ADDRESSES IFNOT $PF THEN [ER_55;RETURN] !IF NO PRAM SEND ERROR CALL G1OPN(G0DCB,ER,G0SPF) !OPEN THE SPOOL FILE IF ER<0 THEN RETURN !IF ERROR EXIT ER_0 !SET TO ZERO SO NO ERROR IS REPORTED IF N= -1 THEN CALL EXEC(9,JOB,-1) !IF KILL CHECK JOB FIRST ! CALL G1RDF(1,ER)?[RETURN] !READ THE RN RECORD JRN_G0BUF !SAVE THE RN CALL POST(G0DCB) ®˜þú CALL RNRQ(1,JRN,RNST) !LOCK THE FILE LREC_[FREC_G0WD3]+G0WD1-1 !GET RECORD NUMBERS NLUS_G0WD2 !AND NUMBER OF LUS IF N= -1 THEN GO TO LUCK !IF RS CALL GO TO CHECK LU IF $PF=2 THEN GO TO NAM !IF NAME, DO NAME SEARCH FOR I_1 TO NLUS DO[ \START LU SCAN CALL RD((I*8)+1); \READ THE LU BLOCK IF (G0BUF AND 77K)=$PV THEN GO TO FLU]!JUMP IF FOUND ! ! END OF SCAN AND NOT FOUND ! BADPM: ER_56 !SEND BAD PRAM ERROR EX: CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN AND RETURN !EXIT ! ! THE LU WAS FOUND ! FLU: IFNOT G0WD1 THEN [ \IF NO QUE EXIT ER4: ER_4;GOTO EX] !WITH ERROR 4 RNUM_G0WD2 !GET THE FIRST FILE CALL RD(RNUM) !READ THE SPOOL CON RECORD IF G0W10="A" THEN GO TO KL1 !MAKE SURE IT IS ACTIVE IF G0W10="AH" THEN GO TO KL1 !ELSE GO TO ER4 !GO SEND ILLEGAL STATUS ! KL1: FLAG_1 !SET LEGAL COUNT IF ACTIVE IF G0W10="A" THEN GO TO KL2 !SPOOL FILE MUST BE IF G0W10="AH" THEN GO TO KL2 !IN A DEFINED STATE FLAG_0 IF G0W10="W" THEN GO TO KL2 !IN A DEFINED STATE IF G0W10="H" THEN GO TO KL2 !IN A DEFINED STATE KL0: CALL G1IMS(G0KIL) !ELSE MAKE SURE FIRST IF G0P1V = "YE" THEN GO TO KL4 !IF YES ANSWER DO IT GO TO EX !ELSE RETURN NO ACTION ! KL2: IF G1KLG(RNUM) > FLAG THEN GO TO KL0 !IF STILL WRITING, ASK FIRST KL4: CALL RNRQ(4,JRN,RNST) !UNLOCK THE FILE FOR SMP CALL EXEC(23,SMP,13,RNUM,G0WD1,0,G0W10) !CALL SMP TO KILL KL3: RETURN õbþú !AND EXIT ! ! LUCK: IFNOT $LU THEN GO TO NAM !IF NO LU THEN OK RNUM_@G0WD4+2 !SET UP TO SEARCH THE LU TABLE FOR RLHD_1 TO G0WD2 DO[ \SCAN FOR THE LU IF $RNUM = ($LU AND 77K) THEN GO TO NAM;\IF THIS IS IT JUMP RNUM_RNUM+1] !ELSE STEP TO NEXT ENTRY GO TO BADPM !NOT FOUND SEND BAD PRAM MESSAGE ! ! NAM: FOR RNUM_FREC TO LREC DO[ \SCAN THE SPOOL RECS CALL RD(RNUM); \TO FIND THE NAME IF G0BUF >= 0 THEN [ \IF AN ACTIVE ENTRY IF $PV=G0WD2 THEN[ \CHECK THE NAME IF $PV2=G0WD3 THEN[ \ IF $PV3=G0WD4 THEN GO TO FNAM]]]] GO TO BADPM !IF NOT FOUND THEN BAD PRAM ! ! NAME FOUND SO CHECK IF KS OR RS COMMAND ! FNAM: IF N# -1 THEN GO TO KL1 !KS SO GO CHECK STATUS ! OLU _ G0W15 RLHD_G0W10 !SET CURRENT STATUS IF RLHD = "A" THEN GO TO AH !IF ACTIVE GO HOLD/ACTIVE IF RLHD = "AH"THEN GO TO W !IF HOLD/ACTIVE GO RELEASE TO WAIT IF RLHD = "W" THEN GO TO H !IF WAITING GO HOLD IF RLHD = "H" THEN GO TO HH !IF IN HOLD GO CHANGE LU ! GO TO ER4 !NOT IN A LEGAL STATUS SO EXIT ! ! SPOOL IS ACTIVE SO FIRST PUT A HOLD ON IT ! AH: G0W10_"AH" !SET STATUS CALL WRIF !WRITE TO THE FILE AND UNLOCK CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD)!TELL SMP WHAT TO DO ! ! SET UP TO NOW SET THE FILE ACTIVE ! RLHD_"AH" !SET CURRENT STATUS CALL RECV !RECOVER THE LOCK AND RECORD ! ! FILE IS IN ACTIVE HOLD SO SET THE NEW LU AND ! PUT IN WAIT STATUS ! W: G0W10_"W" vþú !SET STATUS LUX_0 IF $LU THEN[IF $LU#G0W15 THEN LUX_$LU] !SET LU CALL WRIF !WRITE OUT AND UNLOCK CALL EXEC(23,SMP,15,RNUM,OLU,LUX,RLHD) !TELL SMP GO TO KL3 !GO EXIT DONE ! ! ! FILE IS IN A WAIT QUEUE SO PUT IN HOLD THEN CHANGE LU ! AND PUT BACK IN WAIT QUEUE FOR THE NEW LU ! H: G0W10_"H" !SET NEW STATUS CALL WRIF !WRITE IT OUT AND UNLOCK CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD) !TELL SMP ! ! NOW SET UP FOR THE WAIT QUEUE TRANSITION ! CALL RECV !RESET THE RN LOCK AND READ IF $LU THEN G0W15_$LU OLU_G0W15 !SET LU FOR CALL GO TO W !GO SET TO WAIT ! ! ! FILE IS IN HOLD SO JUST CHANGE LU AND EXIT ! HH: IF $LU THEN G0W15_$LU CALL WRIF !WRITE IT OUT AND UNLOCK RETURN !NOW RETURN ! END ! ! SUBROUTINE TO WRITE CURRENT RECORD AND UNLOCK THE DISC ! WRIF: SUBROUTINE DIRECT CALL G1WFI(G0BUF,RNUM)?[GO TO EX] !WRITE THE RECORD CALL POST(G0DCB) !MAKE SURE IT GOES TO THE DISC CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN RETURN !AND RETURN END ! ! SUBROUTINE TO LOCK THE RN AND REREAD THE RECORD ! RECV: SUBROUTINE DIRECT CALL RNRQ(1,JRN,RNST) !LOCK THE RN CALL RD(RNUM) !READ THE RECORD TO THE BUFFER RETURN !AND RETURN END ! ! ! RD: SUBROUTINE (R) DIRECT CALL G1RDF(R,ER)?[GO TO EX] RETURN END ! ! THE RESTART SUBROUTINE JUST CALLS THE KS ROUTINE WITH N=-1. ! G1CRS: SUBROUTINE(P,PN,EW) GLOBAL CALL G1CKS(P,-1,EW) RETURNð END END END$ áÿÿþúASMB,R,L,C G1CDS DISPLAY SPOOL STATUS HED G1CDS * NAME: G1CDS G1CCS * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CDS,8 92002-16001 760621 * ENT G1CDS,G1CCS * EXT .ENTR,G1OMS,KCVT EXT G0DCB,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4 EXT G0WD9,G0W10,G0W11,G0W15 EXT G1OPN,READF,WRITF,POST,RNRQ EXT EXEC,G1KLG * A EQU 0 B EQU 1 SUP * PBUF1 NOP PLEN1 NOP IERR NOP * G1CDS NOP JSB .ENTR FETCH PARAMETERS DEF PBUF1 CLA STA SPLU INITIALIZE SPOOL LU# STA PBUF2 SET NONE PRINTED FLAG LDA DBLNK STA SPSTM+2 FILL LU# WITH BLANKS CLA,INA CPA PLEN1,I SEE IF MORE THAN 1 PARAM JMP NOPR1 NO, DEFAULT TO ALL LUS LDB PBUF1 GET ADDR OF PARAM LIST ADB D4 SKIP "DS" COMMAND LDA B,I GET LU IF ANY GIVEN SZA IF NULL OR NUMERIC CPA D1 THEN OK INB,RSS JMP ILPM1 ILLEGAL PARAMETER LDA B,I SET REQUESTED LU # STA SPLU * NOPR1 JSB G1OPN OPEN SPLCON DEF *+4 NO NEED TO LOCK RN DEF G0DCB SO SPOOL SYSTEM CAN DEF IERR,I RUN FASTER DEF SPCON SSA JMP EXIT1 EXIT IF ERROR CLA,INA READ 1ST REC JSB RD LDA G0BUF GET THE RN NUMBER STA RNWD AND SAVE IT * LDA G0WD1 GET #SPOOL CONTROL RECS CMA,INA,SZA,RSS JMP DSNOS NO SPOOLS * STA RCONT SAVE THEøVþú COUNT LDA G0WD3 GET RECORD NUMBER OF STA RCNO FIRST CONTROL RECORD JSB G1OMS SEND HEAD DEF *+2 DEF SPSH2 * JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE * * GTSLU LDA RCNO SET TO READ THE RECORD JSB RD READ IT CHCKN LDA G0BUF GET USAGE FLAG SSA IF NOT IN USE JMP GTNRC GO GET THE NEXT ONE * * LDA G0W15 GET THE LU AND B77 MASK OUT ANY CONTROL BITS SZA,RSS IF NO LU JMP PURG? GO CHECK IF WE SHOULD PURGE * NOPU LDB SPLU GET THE REQUEST LU SZB IF NO REQUEST LU CPB A OR THIS IS IT RSS THEN DISPLAY STATUS JMP GTNRC ELSE SKIP TO NEXT RC * STA TEMP JSB KCVT PREPARE HEADING DEF *+2 BY CONVERTING LU # DEF TEMP CPA AB0 IF RESULT IS ZERO LDA ADM REPLACE WITH "--" LDB DBLNK MOVE THE LU RRR 8 OVER ONE CHAR. AND PAD DST SPSTM+1 SET IN THE MESSAGE * LDA G0WD9 GET SPOOL PRIORITY JSB DEC4C CONVERT 4 DEC ASCII DIGITS DEF SPSTM+7 PUT INTO STATUS MESSAGE * LDA G0WD2 MOVE NAM1,NAM2 STA SPSTM+3 LDA G0WD3 MOVE NAM3,NAM4 STA SPSTM+4 LDA G0WD4 MOVE NAM5,NAM6 STA SPSTM+5 LDA G0W10 PICK UP SPOOL STATUS AND B377 FROM WORD 10 CPA G0W10 IF SAME IOR B20K MERGE IN BLANK IOR G0W10 IF NOT MIRGE IN HIGH CHAR TOO CPA B20K IF UPPER BLANK ONLY LDA ADM USE "--" STA SPSTM+12 LDA G0W11 GET JOB NUMBER ADA MD18 STA SPBUF+11 JSB KCVT CONVERT JOB# DEF *+2 AND STUFF INTO MESSAGE DEF SPBUF+11 STA SPSTM+10 JSB G1OMS PRINT SPOOL STATUS MESSAGE DEF *+2 DEF SPSTM * ISZ PBUF2 COUNT THE PRINTED SPOOLS ƒ`þú* GTNRC ISZ RCNO STEP THE RECORD NUMBER ISZ RCONT BUMP RC COUNT JMP GTSLU * LDA PBUF2 IF NONE PRINTED SZA,RSS THEN SO JSB NOSP STATE LDA D3 READ SPLCON REC #3 JSB RD LDA G0BUF CHECK IF SHUT DOWN CPA "D" IS IN EFFECT RSS JMP DSDN NO, NOT DOWN JSB G1OMS YES, PRINT "SHUT DOWN" DEF *+2 DEF DOWN * DSDN CLA LDB SPLU IF NO LU SPECIFIED SZB,RSS THEN NO ERROR JMP EXIT1 IF CAN'T FIND ANY LDB SPSTM+2 GET LU# CPB DBLNK STILL BLANKS? LDA D6 IF NO LU FOUND, ERR 6 EXIT1 STA IERR,I JMP G1CDS,I RETURN * * ILPM1 LDA D56 ILLEGAL PARAMETER JMP EXIT1 * DSNOS JSB NOSP PRINT "NO SPOOLS" JMP DSDN DONE * NOSP NOP JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE FIRST JSB G1OMS PRINT NO SPOOLS MESSAGE DEF *+2 DEF NOSPM JMP NOSP,I * * ADM ASC 1,-- AB0 ASC 1, 0 * RD NOP READ A RECORD FROM THE CURRENT FILE STA NORC SET THE RECORD NUMBER JSB READF GO READ IT DEF *+7 DEF G0DCB DEF IERR,I DEF G0BUF DEF D16 DEF TEMP DEF NORC JMP RD,I RETURN * NORC NOP RCNO NOP RCONT NOP B77 OCT 77 * * PURG? JSB G1KLG GO SCAN THE $LUAV FOR DEF RCNO THIS RECORD SZA IF SOME ENTRIES OK SO JMP NOPU0 JUST CONTINUE * JSB CKPU CHECK FURTHER JMP CHCKN LOOK OK NOW * JSB EXEC CALL JOB TO SEE IF IT OWNS IT DEF *+4 DEF D9 DON'T WAIT(IF BUSY THEN NOT HIS) DEF JOB DEF MD1 SEND -1 TO JUST CLEAN UP * JSB CKPU OK NOW?? JMP CHCKN YES GO PROCESS * JSB EXEC NO CALL SMP TO KILL IT DEF *+5 DEF D23 WAITŽöþú FOR IT DEF SMP DEF D13 KILL CODE DEF RCNO THIS IS THE BAD GUY * JMP GTNRC IF NOT CLEAR NOW IT NEVER WILL BE * CKPU NOP RETURN P+2 IF SHOULD PURGE JSB POST POST THE BUFFER DEF *+2 THE DCB DEF G0DCB JSB RNRQ AND LOCK THE RN DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT LDA RCNO NOW JSB RD AND READ THE RECORD AGAIN LDA G0BUF NOW MAKE SURE NOTHING SSA HAS CHANGED JMP FG ALREADY CLEARED SO FORGET IT * LDA G0W15 GET THE LU AND B77 AND IF STILL SZA CONTINUE JMP FG ELSE FORGET IT * JSB G1KLG GO GET THE COUNT DEF RCNO IF STILL ZERO SZA CONTINUE JMP FG ELSE FORGET IT * ISZ CKPU SET TO TAKE THE PU EXIT FG JSB ULOKP UNLOCK THE RN NOP IGNOR ERROR JMP CKPU,I RETURN * * NOPU0 CLA JMP NOPU HED G1CCS CHANGE SPOOL STATUS PBUF2 NOP PLEN2 NOP IERR2 NOP * G1CCS NOP CHANGE SPOOL STATUS ROUTINE JSB .ENTR FETCH PARAMETERS DEF PBUF2 LDA PLEN2,I GET NUMBER OF PARAMS ADA MD3 MAKE SURE NO LESS THAN 3 SSA JMP CSMPR * LDB PBUF2 INCRE TO PARAM 2 ADB D4 SINCE FIRST IS "CS" LDA B,I CPA D2 CHECK PARAM 2 FOR RSS ASCII NAME JMP CSBPR IF NOT, THEN ERROR 56 INB STB SPNM SAVE ADDR OF SPOOL NAME ADB D3 INCRE TO PARAM 3 STB PBUF2 * JSB OPLOK OPEN SPLCON, LOCK RN DEF SPCON JMP EXIT2 EXIT IF ERRORS * LDA G0WD1 GET # SPOOL CONTROL RECS CMA,INA,SZA,RSS IF NONE, JMP NOSP2 THEN ERROR 6 STA SPCNT LDA G0WD3 GET SPOOL REC # OFFSET STA SPOFS STA SPREC * CSRDS JSB ¯pþúREADF READ A SPOOL RECORD DEF *+7 DEF G0DCB DEF IERR2,I DEF G0BUF DEF D16 DEF TEMP DEF SPREC SSA JMP EXIT2 EXITS IF ERROR * CCA CPA G0BUF IS THIS SPOOL REC UNUSED? JMP CSNXS YES, SO LOOK SOME MORE * LDA SPNM GET SPOOL NAME TO UPDATE STA TEMP LDA G0WD2 CPA TEMP,I COMPARE NAM1,NAM2 RSS JMP CSNXS ISZ TEMP LDA G0WD3 CPA TEMP,I COMPARE NAM3,NAM4 RSS JMP CSNXS ISZ TEMP LDA G0WD4 CPA TEMP,I COMPARE NAM5,NAM6 JMP CSFDS NAME MATCHES * CSNXS ISZ SPREC BUMP SPOOL REC # ISZ SPCNT BUMP COUNT, DONE? JMP CSRDS NO, READ NEXT SPOOL REC NOSP2 LDA D6 CANT FIND SPOOL REQ. JMP EXIT2 * CSFDS LDA PBUF2,I YEH, WE FOUND IT. ISZ PBUF2 CPA D1 CHECK IF PARAM 3 IS # JMP CSPRI YES, PRIORITY CHANGE CPA D2 CHECK IF PARAM 3 IS ASCII JMP CSSTA YES, STATUS CHANGE CSBPR LDA D56 BAD PARAMETER EXIT2 STA IERR2,I JSB ULOKP UNLOCK RN, POST FILE NOP IGNORE ERROR LDA IERR2,I JMP G1CCS,I RETURN * CSILS LDA D4 ILLEGAL STATUS JMP EXIT2 * CSMPR LDA D55 MISSING PARAMETER JMP EXIT2 * * * CSSTA LDB G0W10 GET OLD SPOOL STATUS STB OSTAT LDA PBUF2,I GET NEW STATUS IN A ALF,ALF MOVE CHAR TO LOW BITS AND B377 KEEP ONLY 1 CHAR CPA "H" MUST EITHER BE "H" JMP CSH OR CPA "R" "R" JMP CSR JMP CSBPR ELSE BAD PARAM * CSH CPB "W" IF SPOOL WAITING JMP SMSET JUST SET HOLD CPB "H" IF ALREADY HELD JMP ALSET NO ERROR TO DO AGAIN CPB "AH" JMP ALSET LDA "AH" CPB "A" IF ACTIVE JMP SMSET THEN SET "AH" JMP CSBP¹7þúR ANYTHING ELSE IS BAD * CSR LDA "W" RELEASE SPOOL CPB "W" IF IN WAIT JMP ALSET ALREADY DONE CPB "H" IF IN HOLD JMP CSSET RELEASE TO WAIT LDA "A" CPB "AH" IF IN ACTIVE-HOLD JMP CSSET THEN MAKE ACTIVE JMP CSBPR ANYTHING ELSE IS BAD * CSSET LDB D15 SET FOR A RELEASE CALL AND RSS SKIP TO THE CALL SMSET LDB D14 SET FOR A HOLD CALL JSB WRSMP WRITE THE RECORD AND CALL SMP ALSET CLA JMP EXIT2 * WRSMP NOP STB SMPR SAVE THE SMP CALL WORD STA G0W10 SET NEW STATUS JSB WR WRITE UPDATED RECORD BACK LDB SMPR RESET SMP CALL PRAM JSB SMPR GO TELL SMP JMP WRSMP,I EXIT * * * SMPR NOP STB TEMP SET CALL PRAM JSB EXEC CALL SMP TO PUT SPOOL DEF *+8 INTO ANY QUEUE IT DEF D23 SHOULD BE IN DEF SMP DEF TEMP DEF SPREC DEF G0W15 DEF MD1 DEF OSTAT JMP SMPR,I EXIT * * * CSPRI LDA G0W10 GET CURRENT STATUS STA OSTAT OF SPOOL FILE CPA "W" IS IT WAITING OR RSS CPA "H" IN HOLD? RSS YES SO OK JMP CSILS ELSE ILLEGAL STATUS * LDB PBUF2,I GET THE NEW PRIORITY STB G0WD9 AND SET IT CPA "H" IF IN HOLD GO JMP CSPRH GO WRITE THE RECORD * LDA G0W10 ELSE PICK UP THE STATUS LDB D14 AND GO PUT IN HOLD JSB WRSMP LDB D15 NOW RELEASE TO NEW QUEUE JSB SMPR JMP ALSET DONE GO EXIT * * CSPRH JSB WR WRITE THE NEW PRIORITY JMP ALSET AND EXIT * * WR NOP JSB WRITF WRITE UPDATED RECORD BACK DEF *+6 DEF G0DCB DEF IERR2,I DEF G0BUF DEF D16 DEF SPREC SSA JMP EXIT2 JSB ULOKP UNLOCK RN AND POST FLòþúILE NOP JMP WR,I EXIT HED COMMON ROUTINES AND CONSTANTS TO DS,CS * * JSB OPLOK * DEF FILENAME * * * OPLOK NOP OPEN FILE AND LOCK RN LDA OPLOK,I GET ADDR OF FILE NAME STA FNAME ISZ OPLOK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF ULOKP FNAME DEF * SSA ANY ERRORS? JMP OPLKE YES, BUG OUT * JSB READF READ FIRST RECORD DEF *+4 FROM FILE DEF G0DCB INTO GLOBAL BUFFER DEF ULOKP DEF G0BUF SSA ANY ERRORS? JMP OPLKE YES LDA G0BUF GET FIRST WORD OF RECORD STA RNWD WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT * ISZ OPLOK INCRE ADDR FOR GOOD RETURN OPLKE JMP OPLOK,I RETURN * * * * * JSB ULOKP * * * ULOKP NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF RNWD DEF RNSTT ULOK1 ISZ ULOKP JMP ULOKP,I RETURN * * * * LDA NUMBER * JSB DEC4C * DEF BUFFER * * * DEC4C NOP 4 CHAR DEC ASCII CONVERT LDB DEC4C,I GET BUFFER ADDR STB ADDR TO STORE RESULT ISZ DEC4C CLB DIV D100 STA OS<‡0.*TAT SAVE 2 HI DIGITS STB CNTR SAVE 2 LOW DIGITS JSB KCVT CONVERT TWO HI DIGITS DEF *+2 DEF OSTAT STA ADDR,I ISZ ADDR JSB KCVT CONVERT TWO LOW DIGITS DEF *+2 DEF CNTR STA ADDR,I JMP DEC4C,I RETURN * * B20K OCT 20000 B377 OCT 377 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D9 DEC 9 D13 DEC 13 D14 DEC 14 D15 DEC 15 D16 DEC 16 D23 DEC 23 D55 DEC 55 D56 DEC 56 D100 DEC 100 MD1 DEC -1 MD3 DEC -3 MD18 DEC -18 * RNSTT DEC 1 ADDR NOP CNTR NOP SPLU NOP SPCNT NOP SPNM NOP SPREC NOP SPOFS NOP RNWD NOP TEMP NOP OSTAT NOP RNLOK OCT 1 RNULK OCT 4 "A" OCT 101 "AH" ASC 1,AH "D" OCT 104 "H" OCT 110 "R" OCT 122 "W" OCT 127 SPBUF BSS 16 SMP ASC 3,SMP JOB ASC 3,JOB SPCON ASC 3,SPLCON SPSH2 DEC 15 ASC 15, LU NAME PRIORITY JOB# STATUS SPSTM DEC 12 ASC 12, LU NAMESP PPPP JJ AA NOSPM DEC 6 ASC 6, NO SPOOLS DOWN DEC 5 ASC 5, SHUT DOWN SPACE DEC 1 DBLNK ASC 1, * BSS 0 SIZE END $0ÿÿþúASMB,R,L,C HED G1STM * NAME: G1STM * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1STM,8 92002-16001 740807 ENT G1STM * EXT G1OMS,CNUMD,KCVT,.DFER EXT G0WD1,G0WD2,G0WD3,G0WD7,G0W11,G0BUF * G1STM NOP JSB CNUMD CONVERT DEF *+3 DEF G0WD1 THE JOB NUMBER DSTAT DEF STAT TO THE STATUS BUFFER JSB .DFER MOVE NAME TO BUFFER. DEF NAME DEF G0WD7 LDA G0WD3 AND MASKL LDB DIR SZA LDB SRC STB STUS JSB CNUMD CONVERT THE DEF *+3 DEF G0BUF PRIORITY DEF STUS+1 TO THE BUFFER LDA G0WD2 AND B377 KEEP LOW PART CPA G0WD2 IF SAME IOR HBLK PAD WITH A BLANK IOR G0WD2 AND SET STA STUS+4 STATUS IN BUFFER CLA,INA STA FNUM LDA M8 SET MAX REPORT LIMIT FOR STA LIM NUMBER OF SPOOL FILES LDA W11AD RAL,CLE,SLA,ERA REMOVE INDIRECT BIT LDA A,I GET DIRECT ADDRESS STA ADDR1 LDA M5 STA CNTR LDA SPAD STA ADDR LOOP LDA M16 STA CNTR1 LDA ADDR1,I STA SAVE ILOP SLA JMP GOTON BACK RAR STA SAVE ISZ FNUM ISZ CNTR1 JMP ILOP * ISZ ADDR1 ISZ CNTR JMP LOOP * OUT LDA DSTAT CALCULATE THE RECORD SIZE CMA ADA ADDR STA STAT JSB G1OMS DEF *+2 DEF STAT JMP G1STM,I GOTON JSB KCVT CONVERT |'   DEF *+2 DEF FNUM THE FILE NUMBER STA ADDR,I ISZ ADDR LDB BLANK STB ADDR,I ISZ ADDR LDA SAVE ISZ LIM MORE THAN MAX NUM OF FILES? JMP BACK NO CONTINUE * JMP OUT YES JUST SEND WHAT WE HAVE * SUP STAT ASC 6 NAME ASC 5 STUS ASC 8 NUMS BSS 16 * DIR ASC 1, D SRC ASC 1, S LIM NOP FNUM BSS 1 ADDR1 BSS 1 CNTR BSS 1 ADDR BSS 1 SPAD DEF NUMS W11AD DEF G0W11 CNTR1 BSS 1 B377 OCT 377 MASKL OCT 177400 M8 DEC -8 M5 DEC -5 M16 DEC -16 BLANK OCT 20040 HBLK OCT 20000 SAVE BSS 1 A EQU 0 B EQU 1 END -1 ÿÿASMB,R,L HED GASP2 * NAME: GASP2 * SOURCE: 92067-18028 * RELOC: 92067-16028 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP2,5 92067-16028 REV.1805 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP2 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDA DEF G1CDA EXT G1CQQ DEF G1CQQ EXT G1CIN DEF G1CIN EXT G1CSD DEF G1CSD EXT G1CSU DEF G1CSU END GASP2 îûÿÿþúASMB,R,L,C G1CSD SHUT DOWN/START UP HED G1CDS * NAME: G1CSD,G1CSU * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CSD,8 92002-16001 760622 * ENT G1CSD,G1CSU * EXT G0SDN,G0JDN,.ENTR EXT G0DCB,G0BUF EXT G0W15 EXT G1OPN,READF,WRITF,POST,RNRQ EXT EXEC * A EQU 0 B EQU 1 SUP * PBUF3 NOP PLEN3 NOP IERR3 NOP * G1CSD NOP JSB .ENTR FETCH PARAMETERS DEF PBUF3 LDB PBUF3 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SD" LDA B,I INB STB PBUF3 CLB SZA,RSS IF NO PARAM 2 JMP BOTH THEN SHUT DOWN SPOOL AND JOBS CPA D2 JMP SDASC SDBPR LDA D56 BAD PARAMETER JMP EXIT3 * BOTH STA PBUF3,I SET PARAM 2 TO 0 JMP SDSP IF NOT SPECIFIED * SDASC LDA PBUF3,I GET PARAM 2 CPA "S" SHUT DOWN SPOOLS? JMP SDSP YES CPA "B" SHUT DOWN BATCH JOBS? JMP SDBA YES JMP SDBPR ELSE BAD PARAM * SDSP JSB OPLOK TO SHUT DOWN SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN JMP EXIT3 JSB READF THEN READ REC 3 DEF *+7 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF TEMP DEF D3 SSA JMP EXIT3 RETURN IF ERRORS * LDA "D" SET "D" INTO 1ST WORD STA G0BUF OF REC 3 FOR SHUT DOWN STA G0SDN SET FLAG FOR TERM JSB WRITF TO LET SMP KNOW. D‰”þúEF *+6 WRITE REC BACK TO SPLCON FILE DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF D3 SSA JMP EXIT3 * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 SHUTDOWN PROCEDURE DEF D23 DEF SMP DEF D16 * LDA PBUF3,I SZA SHUTDOWN BOTH? JMP SDDN NO, DONE. * SDBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI JMP EXIT3 JSB READF READ REC # 17 DEF *+7 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF TEMP DEF D17 SSA JMP EXIT3 LDA "D" SET "D" INTO 15TH WORD STA G0W15 AS FLAG FOR BM STA G0JDN SET FLAG FOR TERM JSB WRITF WRITE THE RECORD BACK DEF *+6 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF D17 SSA SDDN CLA SHUT DOWN DONE * EXIT3 STA IERR3,I JSB ULOKP NOW UNLOCK RN, POST FILE NOP LDA IERR3,I JMP G1CSD,I RETURN * * HED G1CSU START UP SPOOL AND/OR BATCH SYSTEM PBUF4 NOP PLEN4 NOP IERR4 NOP * G1CSU NOP JSB .ENTR FETCH PARAMETERS DEF PBUF4 JSB EXEC TELL JOB TO CLEAN UP DEF *+4 IN ANY CASE DEF D9 IF BUSY DON'T WAIT DEF JOB DEF MD1 -1 CLEAN UP ONLY LDB PBUF4 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SU" LDA B,I INB STB PBUF4 CLB SZA,RSS IF NO PARAM 2 JMP BOTHU THEN START UP SPOOL AND JOBS CPA D2 JMP SUASC * SUBPR LDA D56 JMP EXIT4 * BOTHU STA PBUF4,I SET PARAM 2 TO 0 JMP SUSP IF NOT SPECIFIED * SUASC LDA PBUF4,I GET PARAM 2 CPA "S" START UP SPOOLS? JMP SUSP YES CPA "B" START UP BATCH JOBS? ¿—þú JMP SUBA YES JMP SUBPR ELSE BAD PARAM * SUSP JSB OPLOK TO START UP SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN JMP EXIT4 JSB READF THEN READ REC 3 DEF *+7 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF TEMP DEF D3 SSA JMP EXIT4 RETURN IF ERRORS * CLA CLEAR 1ST WORD STA G0BUF OF REC 3 FOR START UP STA G0SDN SET GLOBAL FLAG TOO JSB WRITF TO LET SMP KNOW. DEF *+6 WRITE REC BACK TO SPLCON FILE DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF D3 SSA JMP EXIT4 * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 START UP PROCEDURE DEF D23 DEF SMP DEF D17 * LDA PBUF4,I SZA START UP BOTH? JMP SUDN NO, DONE. * SUBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI JMP EXIT4 JSB READF READ REC # 17 DEF *+7 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF TEMP DEF D17 SSA JMP EXIT4 CLA CLEAR 15TH WORD STA G0W15 AS FLAG FOR BM STA G0JDN SET LOCAL GLOBAL TOO JSB WRITF WRITE RECORD BACK DEF *+6 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF D17 SSA JMP EXIT4 EXIT IF ERROR JSB EXEC SCHEDULE FMGR DEF *+4 TO UPDATE JOBS DEF D10 DEF FMGR DEF MD1 -1 MEANS JOB UPDATE ONLY * SUDN CLA START UP DONE EXIT4 STA IERR4,I JSB ULOKP NOW UNLOCK RN, POST FILE NOP LDA IERR4,I JMP G1CSU,I RETURN * * HED COMMON ROUTINES AND CONSTANTS TO DS,CS,SD,SU * * JSB OPLOK * DEF F4ÙþúILENAME * * * OPLOK NOP OPEN FILE AND LOCK RN LDA OPLOK,I GET ADDR OF FILE NAME STA FNAME ISZ OPLOK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF ULOKP FNAME DEF * SSA ANY ERRORS? JMP OPLKE YES, BUG OUT * JSB READF READ FIRST RECORD DEF *+4 FROM FILE DEF G0DCB INTO GLOBAL BUFFER DEF ULOKP DEF G0BUF SSA ANY ERRORS? JMP OPLKE YES LDA G0BUF GET FIRST WORD OF RECORD STA RNWD WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT * ISZ OPLOK INCRE ADDR FOR GOOD RETURN OPLKE JMP OPLOK,I RETURN * * * * * JSB ULOKP * * * ULOKP NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF RNWD DEF RNSTT ULOK1 ISZ ULOKP JMP ULOKP,I RETURN * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D9 DEC 9 D16 DEC 16 D17 DEC 17 D23 DEC 23 D10 DEC 10 D56 DEC 56 MD1 DEC -1 * RNSTT DEC 1 RNWD NOP TEMP NOP RNLOK OCT 1 RNULK OCT 4 "B" ASC 1,B "B " "D" OCT 104 "S" ASC 1,S "S " SMP ASC 3,SMP FMGR ASC 3,FMGR JOBFI ASC 3,JOBFIL JOB ASC 3,JOB SPCON ASC 3,SPLCON * BSS 0 SIZE END ôÿÿþúASMB,R,L,C HED G1C?? - GASP ERROR EXPANDER MODULE * NAME: G1C?? * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1C??,8 92002-16001 741027 ENT G1CQQ EXT .DFER,G1OMS,G0BUF,G0ERH,G0TTY,.ENTR EXT EXEC SUP N NOP LST NOP SPC 1 G1CQQ NOP ENTRY POINT JSB .ENTR GEN PRAMS DEF LST SPC 1 LDA LST ADVANCE PRAM TO ADA .4 THE FIRST PRAM STA LST AND RESTORE LDB G0ERH GET ERROR PRAM ASR 16 EXTEND THE SIGN BIT DIV .1000 DIVID LDA B ERROR CODE TO A LDB LST,I GET FLAG ISZ LST STEP TO SZB IF NOT SUPPLIED USE .E.R. LDA LST,I ELSE USE FIRST PRAM CPA .99 IF PRAM=99 JMP ALL THEN PRINT ALL CODES ON LIST STA N SAVE CODE ADA MOSNG TEST FOR SSA DEFINED CODE JMP UDF TOO NEGATIVE LDA N ADA NHLP1 SSA JMP PRINT OK - PRINT IT ADA NHLG SSA JMP UDF IN MID CODE GAP - UNDEFINED ADA NHH SSA,RSS JMP UDF TO HIGH - UNDEFINED LDA N ADJUST N ADA NHLG FOR HIGH GROUP STA N TABLE PRINT LDA N GET N ADA TBAD ADD TABLE ADDRESS PR LDB A,I GET MESSAGE ADDRESS STB MSAD SET AS POINTER LDB B,I MESSAGE STB A LENGTH CMA,INA SET FOR STA û þúN MOVE ADB .2 AND STB LNMES OUTPUT JSB .DFER MOVE THE FIRST THREE WORDS DEF G0BUF TO THE BUFFER DEF LNMES INCLUDES THE LENGTH AND NAME LDA BUF.D HEAD RSS LDA A,I OF RAL,CLE,SLA,ERA MESSAGE JMP *-2 GET ADA .3 BUFFER ADDRESS AND MOVE ISZ MSAD LDB MSAD,I MOVE STB A,I MESSAGE INA TO ISZ N BUFFER JMP MOVE JSB G1OMS PRINT DEF FMRTN ON BUF.D DEF G0BUF DEVICE FMRTN CLA STA G0ERH JMP G1CQQ,I ELSE, RETURN SPC 3 UDF LDA DFUDF PICK UN DEFINED JMP PR AND SEND IT. SPC 3 ALL LDA G0TTY SAVE THE TTYLU STA TTY LOCALLY LDA LST IF ADA .4 A LU SUPPLIED LDA A,I THEN USE SZA IT STA G0TTY LDA G0TTY GET THE LU AND B77 KEEP ONLY THE LU IOR B1100 ADD THE PAGE BITS STA LUX SET FOR EJECT LDA PTRS SET THE STA CPTRS POINTER FOR THE MESSAGES WRIT JSB G1OMS WRITE DEF WRRTN THE CPTRS NOP THE WRRTN ISZ CPTRS LDA CPTRS ELIMINATE THE RAL,CLE,ERA NOT DEFINED LDA A,I MESSAGES CPA NDEF UNDEFINED MESSAGE? JMP WRRTN YES SKIP IT * LDA CPTRS,I IF LENGTH NEGATIVE SSA,RSS SKIP JMP WRIT ELSE GO WRITE NEXT MESSAGE SPC 3 LDA TTY RESTORE THE TTY LU STA G0TTY JSB EXEC SEND THE TOP OF FORM DEF EX DEF .3 DEF LUX DEF N2 EX JMP G1CQQ,I GO EXIT SPC 2 .1000 DEC 1000 .99 DEC 99 N2 DEC -2 .2 DEC 2 .3 DEC 3 .4 DEC 4 B77 OCT 77 B1100 OCT 1100 TTY NOP LUX NOP SPC 1 MSAD NOP DFUDF DEF *+1 NDEF DEF UDN-1 LNMES NOP GASP ASC Pûþú2,GASP TBAD DEF MS00 PTRS DEF LSHED,I ABS LUDN UDN ASC 6, NOT DEFINED LUDN EQU *-UDN LSHED DEF HEAD-1 THIS LIST DEF BLNK-1 IS IN DEF HD2-1 THE DEF BLNK-1 ORDER DEF ERM14-1 OF DEF ERM13-1 PRINTING DEF ERM12-1 AND DEF UDN-1 ALSO DEF UDN-1 NUMERICAL DEF UDN-1 ORDER DEF ERM8-1 DEF ERM7-1 DEF ERM6-1 DEF UDN-1 DEF ERM4-1 DEF UDN-1 DEF ERM2-1 DEF ERM1-1 MS00 DEF ER0-1 DEF ER1-1 DEF ER2-1 DEF ER3-1 DEF ER4-1 DEF ER5-1 DEF ER6-1 HLOW EQU *-MS00-1 MOST POSITIVE OF LOW GROUP DEF ER55-1 DEF ER56-1 NHIG EQU *-MS00-HLOW-2 NUMBER OF HIGH ERRORS DEF N2 * A EQU 0 B EQU 1 MSTN EQU 14 MOST NEGATIVE ERROR CODE LHIG EQU 55 LOWEST OF HIGH GROUP HHIG EQU LHIG+NHIG HIGHEST OF HIGH GROUP SPC 1 MOSNG ABS MSTN MOST NEG. CODE NHLP1 ABS -HLOW-1 NEG. OF LOW HIGH BOUND NHLG ABS HLOW+1-LHIG NEG. OF LOW HIGH GAP NHH ABS LHIG-HHIG-1 NEG. OF HIGH SIZE. * * ERROR TABLE -CODES ARE ENTERED IN ANY ORDER. * ABS L0 ER0 ASC 6, 0 NO ERROR L0 EQU *-ER0 ABS LM1 ERM1 ASC 7, -1 DISC ERROR LM1 EQU *-ERM1 ABS LM2 ERM2 ASC 12, -2 DUPLICATE FILE NAME LM2 EQU *-ERM2 ABS LM4 ERM4 ASC 19, -4 MORE THAN 32767 RECORDS IN A TYPE ASC 4, 2 FILE LM4 EQU *-ERM4 ABS LM6 ERM6 ASC 18, -6 CR OR FILE NOT FOUND OR NO ROOM LM6 EQU *-ERM6 ABS LM7 ERM7 ASC 13, -7 BAD FILE SECURITY CODE LM7 EQU *-ERM7 ABS LM8 ERM8 ASC 15, -8 FILE OPEN OR LOCK REJECTED LM8 EQU *-ERM8 ABS LM12 ERM12 ASC 11, -12 EOF OR SOF ERROR LM12 EQU *-ERM12 ABS LM13 ERM13 ASC 8, -13 DISC LOCKED LM13 EQU *-ERM13 ABS LM14 ERM14 ASC 10, -14 DIRECTORY FULL LM14 EQU *-ERM14 SPC 1 ABS L1 ERÐ1 ASC 7, 1 DISC ERROR L1 EQU *-ER1 ABS L2 ER2 ASC 11, 2 NUMBER OUT OF RANGE L2 EQU *-ER2 ABS L3 ER3 ASC 9, 3 BAD JOB NUMBER! L3 EQU *-ER3 ABS L4 ER4 ASC 9, 4 ILLEGAL STATUS L4 EQU *-ER4 ABS L5 ER5 ASC 9, 5 ILLEGAL COMMAND L5 EQU *-ER5 ABS L6 ER6 ASC 6, 6 NOT FOUND L6 EQU *-ER6 SPC 2 ABS L55 ER55 ASC 11, 55 MISSING PARAMETER L55 EQU *-ER55 ABS L56 ER56 ASC 9, 56 BAD PARAMETER L56 EQU *-ER56 SPC 2 ABS LHEAD HEAD ASC 9, GASP ERROR CODES LHEAD EQU *-HEAD ABS LHD2 HD2 ASC 9, ERROR MEANING LHD2 EQU *-HD2 ABS LBLNK BLNK ASC 1, LBLNK EQU *-BLNK ORG * PROGRAM LENGTH END Ä´ÿÿþú SPL,L,O ! NAME: G1CIN ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CIN(8) "92002-16001 760630" ! LET G1CDA,G1OMS,G1ZAP,G1WFI BE SUBROUTINE,EXTERNAL LET G1CQQ,EXEC,G1IMS BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT BE FUNCTION,EXTERNAL LET POST,CREAT,OPEN,CLOSE BE SUBROUTINE,EXTERNAL LET RNRQ BE SUBROUTINE,EXTERNAL LET ST.LU BE SUBROUTINE,DIRECT,EXTERNAL LET CNUMD,G1RD,G1OPN BE SUBROUTINE,EXTERNAL LET CRERR BE SUBROUTINE LET GERR BE SUBROUTINE,DIRECT ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET CS43,N.SEQ,G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER,EXTERNAL LET G0DCB BE INTEGER,EXTERNAL !LINES LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,EXTERNAL LET G0WD4 BE INTEGER,EXTERNAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,EXTERNAL LET G0W15 BE INTEGER,EXTERNAL LET G0PBF BE INTEGER,EXTERNAL LET G0P1V BE INTEGER,EXTERNAL LET G0P2V BE INTEGER,EXTERNAL LET G0NOP BE INTEGER,EXTERNAL LET G0SDN,G0JDN BE INTEGER,EXTERNAL LET G0TTY,G0RDS,G0ERH BE INTEGER,EXTERNAL LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4,BUFX5(9),BUX14, \ BUX15(17) BE INTEGER ! LET DUPNM(8),MESS(4),DINIT(8) BE INTEGER INITIALIZE DUPNM,MESS TO 11,"DUP FILE NAME XXXXXX. " INITIALIZE DINIT TO 7,"DEINITIALIZE?_" LET NOROM(3),DNO(12),MS,MSS(11) B°†þúE INTEGER INITIALIZE NOROM,DNO,MS,MSS TO 27,\ DISC FULL MESSAGE "DISC XXXXX FULL OR MISSING, XX SPOOL FILES CREATED. " LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IERR BE INTEGER !TWO LINES INITIALIZE SPOL TO "SPOL" INITIALIZE SPLNO TO 1 INITIALIZE SIZE1 TO 16 LET E BE CONSTANT(42440K) LET EXIT BE CONSTANT(42530K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! G1CIN: SUBROUTINE GLOBAL INIT: CALL ST.LU CALL G1IMS(G0NJB) !INITIALIZE THE BATCH IFNOT [SAVE1 _ G0P1V] > 0 THEN [ \SYSTEM. GET # OF JOBS. INIT1: CALL GERR; GOTO INIT] ! SIZE _ 3 IF G0P1V > 254 THEN GOTO INIT1 IF [SAVE _ G0P1V - 6] <= 0 THEN \FIGURE OUT THE SIZE OF GOTO CRJOB !JOBFIL, AND CREATE IT. IF (SAVE AND 7K) THEN \ SIZE _ SIZE + 1 SIZE _ (SAVE >-3) + SIZE CRJOB: SPDIS_G0P2V !SET THE DISC FOR JOBFIL CALL CREAT(G0DCB,IERR,G0JBF,SIZE,2,SEC,SPDIS) CALL CRERR(G0JBF) !CHECK FOR ERRORS CALL G1ZAP(PBUFX) CALL RNRQ(20K,IRN,SAVE) !ALLOCATE JOBFIL RN. PBUFX _ IRN !PUT IT IN JOBFIL. CALL G1WFI(PBUFX,0) ? [GOTO EXIN] PBUFX _ 0 !INITIALIZE FIRST 2 REPEAT 15 TIMES DO [ \JOBFIL SECTORS. CALL G1WFI(PBUFX,0) ? \ [GOTO EXIN]] NSP: CALL G1IMS(G0NSP) !GET # OF SPOOL FILES. IF [NSPL,BUFX2 _ G0P1V] > 80 THEN [ \MAKE SURE IT IS NOT NSP1: CALL GERR; GOTO NSP] !MORE THAN 80. IFNOT NSPL > 4 THEN GOTO NSP1 SZS: CALL G1IMS(G0SZF) !GET SIZE OF SPOOL FILES. IFNOT G0PBF = 1 THEN GOTO SZS1 !MAKE SURE NUMERIC. IFNOT [SSPOL,BUFX3 _ G0P1V] > 0 THEN [\MAKEÜïþú SURE IT IS NON-ZERO. SZS1: CALL GERR; GOTO SZS] BUFX1 _ [SIZE _ SAVE1 + 18] PBUFX _ IRN !PUT IN RN NUMBER. RNRQ(20K,WRN,SAVE) !ALLOCATE HOLD BEM RN. BUX14 _ WRN WRT1: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 17. NOL: CALL G1ZAP(PBUFX) ADDR _ @PBUFX-1; FFILE _ 1 REPEAT 8 TIMES DO [ \GET # OF SPOOL FILES CALL G1IMS(G0NLO); \AT EACH LOCATION AND IF G0P1V = E THEN GOTO ADDUP; \MAKE UP JOBFIL $[ADDR _ ADDR+1] _ (G0P1V <-8) \RECORD 18. XOR FFILE; \ FFILE _ FFILE + G0P1V; \ $[ADDR _ ADDR+1] _ G0P2V] ADDUP: ADDR _ @PBUFX-2 ;SAVE1 _ 0 !CHECK IF THE # OF FILES REPEAT 8 TIMES DO [ \AT EACH LOCATION AGREES SAVE1 _ (($[ADDR _ ADDR+2] -<8) \WITH THE TOTAL # OF AND 377K) + SAVE1] !FILES. IFNOT SAVE1 = NSPL THEN [ \IF DISAGREE, DO OVER. CALL GERR; GOTO NOL] WRT2: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 18. CALL G1ZAP(G0BUF) G0BUF _ -1 FOR SAVE _ 19 TO SIZE DO [ \INITIALIZE REST OF CALL G1WFI(G0BUF,0) ? \JOBFIL. [GOTO EXIN]] ! ! MNS: CALL G1IMS(G0MXP) !GET SPLCON INFORMATION. IFNOT G0PBF = 1 THEN GOTO MNS1 IFNOT [BUFX1 _ G0P1V + N.SEQ] >= NSPL\GET MAXIMUM # THEN [ \ MNS1: CALL GERR; GOTO MNS] !OF SPOOL FILES. IFNOT [BUFX4 _ G0P1V] > 0 \ THEN GOTO MNS1 BUFX2 _ 0; ADDR _ @BUFX5 REPEAT 11 TIMES DO THRU LUSET LUN: CALL G1IMS(G0SLU) !GET LOGICAL UNIT IF G0P1V = E THEN GOTO ALLDN !NUMBERS FOR IF [G0P1V_G0P1V AND 77K] < 3 THEN GO TO LUNER !LU 1,2 ILL CALL EXEC(100015¸ÁþúK,G0P1V,EQT5) !GET DRIVER TYPE GO TO LUNER !BAD LU ERROR IF (EQT5 AND 36000K)=14000K THEN[ \DISC ILLGAL LUNER: GERR;GO TO LUN] !REPORT ERROR AND TRY IFNOT [G0P2V_G0P2V AND 17K] THEN G0P2V_4 !DEFAULT DEPTH $[ADDR _ ADDR+1] _ G0P1V+G0P2V*400K !LEVEL IN HIGH HALF LUSET: BUFX2 _ BUFX2 + 1 ALLDN: IF (BUFX1 AND 7K) THEN SIZE _ 1, \ ELSE SIZE _ 0 SIZE _ (BUFX1 >-3) + SIZE + BUFX2 + 1 CCR: CREAT(G0DCB,IERR,G0SPF,SIZE,2,SEC,SPDIS)!CREATE SPLCON. CALL CRERR(G0SPF) BUFX3 _ ((BUFX2+1) <-3) + 1 RNRQ(20K,PBUFX,SAVE) !ALLOCATE SPLCON RN. ADDR _ @BUFX5 CALL G1ZAP(G0BUF) G1WFI(G2BUF,2) ? [GOTO EXIN] !WRITE 2ND SPLCON REC. G0WD1 _ WRN REPEAT 6 TIMES DO [G1WFI(G0BUF,0) \ ? [GOTO EXIN]] G0WD1 _ 0 REPEAT BUFX2 TIMES DO [ \SET UP LOGICAL UNIT G0BUF _ $[ADDR _ ADDR+1]; \SECTORS IN SPLCON. $ADDR_$ADDR AND 77K; \ISOLATE THE LU G1WFI(G0BUF,0) ? [GOTO EXIN]; \ G0BUF _ 0; \ REPEAT 7 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? \ [GOTO EXIN]]] CALL G1ZAP(G0BUF); G0BUF _ -1 REPEAT BUFX1 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? [GOTO EXIN]] ! CALL G1WFI(PBUFX,1)?[GOTO EXIN] !WRITE 1ST SPLCON REC. ! CALL OPEN(G0DCB,IERR,G0JBF,3,SEC,SPDIS) !REOPEN JOB FILE CALL CRERR(G0JBF) CALL G1RD(PBUFX,18) !GET BACK RECORD 18 ADDR _ @PBUFX-1 REPEAT 8 TIMES DO THRU LAST !CREATE ALL THE SPOOL FFILE _ $[ADDR _ ADDR+1] AND 377K !FILES. SAVE1 _ (($ADDR -<8) AND 377K)+FFILE-1 ICR _ $[ADDR _ ADDR+1] FOR FFILE _ FFILE TO SAVE1 DO [ \ IF [SPLNO _ KCVT(FFILE)] \ •Î < 30000K THEN SPLNO _ \ SPLNO OR 30000K ; \ CALL CREAT(G0BUF,IERR,SPOL, \ SSPOL,3,SEC,ICR); \ IF IERR= -6 THEN GO TO TRUN; \ CALL CRERR(SPOL)] LAST: ! CALL CLOSE(G0BUF) EXINT: CALL CLOSE(G0DCB) !CLOSE THE FILE AND RETURN ! ! TRUN: CALL G1RD(G0BUF,17) !SET UP JOB FILE FOR G0WD2_FFILE -1 !THE ACTUAL NUMBER OF FILES CALL G1WFI(G0BUF,17) !WRITE IT OUT CALL CLOSE(G0DCB) !CLOSE THE FILE MS_KCVT(FFILE-1) !SET UP THE MESSAGE CALL CNUMD(ICR,DNO) CALL G1OMS(NOROM) !SEND NO ROOM MESSAGE GO TO AGAIN END ! ! CRERR: SUBROUTINE(FIN) IF IERR > 0 THEN RETURN !IF NO ERRORS RETURN IF IERR = -2 THEN [CALL .DFER(MESS,FIN); \IF DUP NAME CALL G1OMS(DUPNM); \SEND MESSAGE AND GET ANS. AGAIN: CALL G1IMS(DINIT); \SEND MESSAGE AND GET ANS. IF G0P1V = "YE" THEN[CALL G1CDA(-1); GO TO INIT]] EXIN: CALL G1CQQ(SIZE) !SEND ERROR MESSAGE CALL G1OMS(G0END) !SEND END MESSAGE CALL EXEC(6) !TERMINATE END ! ! ERROR REPORT SUBROUTINE ! GERR: SUBROUTINE DIRECT IERR_2 !SET THE ERROR CODE CALL G1CQQ(SIZE) !PRINT THE MESSAGE RETURN END END END$ œéÿÿþú SPL,L,O ! NAME: G1CDA ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDA(8)"92002-16001 760627" ! LET G1OMS,G1ZAP,G1WFI BE SUBROUTINE,EXTERNAL LET G1CQQ,EXEC,G1IMS BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT BE FUNCTION,EXTERNAL LET POST,PURGE,OPEN,CLOSE BE SUBROUTINE,EXTERNAL LET RNRQ BE SUBROUTINE,EXTERNAL LET G1CEX,G1CSD,G1RD,G1OPN BE SUBROUTINE,EXTERNAL LET FERR BE SUBROUTINE ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER,EXTERNAL LET G0DCB BE INTEGER,EXTERNAL !LINES LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,EXTERNAL LET G0WD4 BE INTEGER,EXTERNAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,EXTERNAL LET G0W15 BE INTEGER,EXTERNAL LET G0PBF BE INTEGER,EXTERNAL LET G0P1V BE INTEGER,EXTERNAL LET G0P2V BE INTEGER,EXTERNAL LET G0NOP BE INTEGER,EXTERNAL LET G0SDN,G0JDN BE INTEGER,EXTERNAL LET G0TTY,G0RDS,G0ERH BE INTEGER,EXTERNAL ! LET RESON(8),MES(3) BE INTEGER INITIALIZE RESON TO 10,"ERROR ON FILE " LET CLEAN(8) BE INTEGER INITIALIZE CLEAN TO 7,"SPOOL IS DEAD!" LET REALY(9) BE INTEGER INITIALIZE REALY TO 8,"KILL SPOOLING? _" LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IER,I BE INTEGER !TWO LINES INITIALIZE SPOL þú TO "SPOL" INITIALIZE SPLNO,IER TO 1,0 LET SEC BE CONSTANT(123456K) LET RLF BE CONSTANT(40040K) !RN RELEASE CODE WORD ! G1CDA: SUBROUTINE(F) GLOBAL IF F # -1 THEN[CALL G1IMS(REALY); \IF NOT FROM INIT IF G0P1V # "YE" THEN RETURN] !THEN MAKE SURE. ! ! FIRST CALL SHUT DOWN ! IF G0JDN THEN[IF G0SDN THEN GO TO DOWN] IER _ 0 CALL G1CSD(SIZE1) ! ! FIRST GET THE NUMBER OF SPOOL POOL FILES TO PURGE ! DOWN: CALL OPEN(G0DCB,IER,G0JBF,0,SEC) !OPEN JOB FILE IF IER = 2 THEN GO TO RD17 !IF NO ERROR JUMP IF IER = -6 THEN[SPNO_80;GO TO GOTNO] !IF NO FILE PURGE 80 ! CALL FERR(G0JBF) !REPORT ANY OTHER ERROR GO TO EX !AND GET OUT ! ! RD17: CALL G1RD(G0BUF,17) !GET RECORD 17 SPNO_G0WD2 !SET THE COUNT ! GOTNO: FOR I_1 TO SPNO DO THRU X SPLNO_KCVT(I) IF SPLNO < 30000K THEN SPLNO_SPLNO OR 30000K !FIX IF 01-09 CALL PURGE(G0DCB,IER,SPOL,SEC) !PURGE THE FILE IF IER > -1 THEN GO TO X IF IER = -6 THEN GO TO X !IF NO FILE OR NO ERROR CALL FERR(SPOL) !DON'T WORRY, ELSE REPORT GO TO EX !AND STOP X: !END OF LOOP CALL OPEN(G0DCB,IER,G0JBF,0,SEC) !REOPEN THE JOB FILE IF IER # 2 THEN GO TO PUSP !IF ERROR SKIP ! CALL G1RD(G0BUF,17) !GET THE RN'S TO CORE CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE TWO RN'S GO TO NEX1 NEX1: CALL RNRQ(RLF,G0W14,IS) GO TO NEX2 NEX2: CALL PURGE(G0DCB,IER,G0JBF,SEC) !PURGE JOB FILE IF IER < 0 THEN CALL FERR(G0JBF) !REPORT ERRORS ! PUSP: CALL OPEN(G0DCB,IER,G0SPF,0,SEC) !NOW GET SPLCON IF IER #2 THEN[ \IF ERROR REPORT IT Z: CALL FERR(G0SPF);GO TO m EX] !AND EXIT ! CALL G1RD(G0BUF,1) !GET THE FIRST RECORD CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE RN. GO TO NEX3 NEX3: CALL PURGE(G0DCB,IER,G0SPF,SEC) !PURGE THE FILE IF IER < 0 THEN GO TO Z !IF ERROR REPORT IT CALL G1OMS(CLEAN) !ELSE REPORT DONE EX: CALL G1OMS(G0END) !AND EXIT CALL EXEC(6) END ! ! FERR: SUBROUTINE(N) CALL .DFER(MES,N) !SET UP THE FILE NAME CALL G1OMS(RESON) !SENT IT CALL G1CQQ(SIZE) !CALL ?? TO SEND THE FULL MESSAGE RETURN END END END$ J"ÿÿ ÿýÖF ÿ92067-18029 1940 S C0122 &JOB4 RTE IV JOB PROG             H0101 ykþúASMB,R,L,C HED JOB ROUTINE * NAME: JOB * SOURCE: 92067-18029 * RELOC: 92067-16028 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM JOB,2,30 92067-16028 REV.1940 790802 SUP * EXT EXEC SYSTEM CALLS EXT RMPAR PARAMETER RETRIEVAL EXT $PARS SYSTEM PARSE ROUTINE EXT OPEN FILE MANAGER OPEN EXT READF FILE MANAGER READ EXT WRITF FILE MANAGER WRITE EXT $LIBR CALL FOR PRIVILEGED OPERATION EXT $LIBX LEAVE PRIVILEGED OPERATION EXT CLOSE FILE MANAGER CLOSE FILE EXT REIO REENTRANT I/O ROUTINE EXT .DRCT PICK UP DIRECT ADDRESS EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFER EXT .DFER MOVE THREE WORDS ROUTINE EXT LURQ LOCK LU ROUTINE EXT SPOPN SPOOL OPEN ROUTINE EXT $LUAV SPOOL LU TABLE * IDCB BSS 144 ONBF BSS 4 DO NOT REARRANGE THESE BUFFERS COMND BSS 16 BUFR2 BSS 17 BUFR BSS 41 SAVE BSS 1 SAVE1 BSS 1 RECNO BSS 1 RECNT BSS 1 FILNO BSS 1 SPLU BSS 1 IBUFL BSS 1 BUFL1 BSS 1 OLU OCT 401 * ORG IDCB PUT INIT CODE IN BUFFERS * BEM JSB RMPAR RETRIEVE PARAMETERS. DEF *+2 DEF COMND+5 LDA COMND+5 IS FIRST PARAMETER ASCII? SSA OR NEGATIVE JMP BEM2 FORGET INTERACTIVE SET UP * ADA CCOMP SSA,RSS JMP BEM2 YES. * LDA COMND+5 GET INPUT DEVICE LU. SZA,RSS MAKE DEVICE 5 THE DEFAULT. LDA D5 IOR CNWD STA CONWD §þú ADA B200 FORM DYNAMIC STATUS COMMAND WORD STA DYSTA SAVE IT JSB EXEC CHECK IF INTERACTIVE DEF INTYS DEVICE DEF D13 DEF CONWD DEF EQT5 DEF CLRN DEF LKRN INTYS LDA EQT5 GET THE TYPE AND TYPW ISOLATE LDB CONWD PRESET B FOR INTERACTIVE INTY0 SZA,RSS IF ZERO THEN INTERACTIVE JMP INT SO GO SET UP * CPA TYP05 05 RSS COULD BE MUST CHECK SUBCHANNEL CPA TYP07 07 RSS AGAIN CHECK SUBCHANNEL JMP BEM1 NOT INTERACTIVE CONTINUE * LDA LKRN GET THE SUBCHANNEL AND D7 ISOLATE THE LOW BITS JMP INTY0 GO TEST FOR ZERO * INT STB OLU SET AS OUTPUT LU TOO CLA STA RDREC SET TO PROMPT JMP BEM2 SKIP THE LU LOCK IF INTERACTIVE * BEM1 JSB LURQ LOCK THE LU IF NOT INTERACTIVE DEF BEM2 DEF D1 LOCK WITH WAIT DEF CONWD THIS LU DEF D1 ONLY ONE OF THEM BEM2 CLA STA EOJSW CLEAR EOJ SWITCH. JMP OPFL3 GET OUT OF DCB FOR OPEN * TST0 EQU COMND+10-* ERROR MEANS WE ARE ABOUT TO OVERLAY * ORG BUFR SKIP OVER THE RU PRAMS * OPFL3 JSB OPEN OPEN JOBFIL DEF *+6 DEF IDCB DEF IERR DEF JOBFL DEF IOPTN DEF ISECU CPA M8 DID WE SUCCEED? JMP OPFL3 KEEP TRYING. * SSA JSB JERR OPEN ERROR. RING BELLS. * LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA BUFR2 SAVE JOBFIL RN. STA JRN LDA BUFR2+14 SAVE RN FOR HOLDING INSPOOLING. STA WRN LDA BUFR2+1 STA RECNT SAVE RECORD COUNT. JMP CLEAN SKIP OUT OF BUFFERS ORR BACK TO STD. CORE * * THE FOLLOWING CODE CLEANS UP AFTER THIS PROGRAM IF IT WAS * ABORTED WHILE DOING AN INSPOOL. * * TO CLEAN UP WE MUST: * * 1. CALL ’ŽþúSMP TO KILL THE SPOOL POOL FILE (CLEANS UP SMP'S RECORDS) * 2. OPEN AND CLOSE THE POOL FILE PURGING EXTENTS (GET BACK DISC) * 3. CLEAR THE BIT MAP BIT THAT SAYS THE FILE IS ASSIGNED * 4. CLEAR THE JOBFILE RECORD(RETURN IT TO POOL) * 5. CLEAR THE FLAGS IN JOBFIL RECORD 17 THAT SAY THESE THINGS * MUST BE DONE * * THIS CODE IS DONE IN SUCH AN ORDER THAT NO MORE HARM IS DONE * IF IT IS ABORTED AT ANY TIME SO WATCH OUT DON'T REARRANGE IT. * * YES I KNOW IT WOULD BE FASTER AND TAKE LESS CODE BUT WE NEED * FAIL SAFE OPERATION HERE. * * FLAGS KEPT IN REC 17 TO HELP: * * WORD 10 SPLCON REC # OF SPOOL CON ENTRY (SAFE EVEN AFTER REBOOT) * WORD 11 WORD ADDRESS OF BIT MAP BIT TO CLEAR * WORD 12 BIT TO CLEAR IN SPOOL POOL BIT MAP * WORD 13 JOBFIL RECORD NUMBER OF RECORD TO CLEAR * CLEAN JSB LKRNP POST AND LOCK THE RN LDA D17 GET A CLEAN JSB GTREC RECORD 17 LDB BUFR2+10 GET THE SPLCON RECORD NUMBER IF ONE SZB,RSS IS THEIR? JMP NOSP NO SKIP SMP CALL * JSB CLRN CLEAR RN FOR SMP JSB EXEC CALL SMP TO CLEAN UP ITS RECORDS DEF *+5 DEF D23 DEF SMPA DEF D13 KILL CODE DEF BUFR2+10 RECORD NUMBER JSB LKRNP POST AND LOCK THE RN LDA D17 GET THE RECORD AGAIN JSB GTREC CLB CLEAR FLAG TO SHOW STB BUFR2+10 WE HAVE CALLED JSB WRTRC WRITE IT AND JSB POST1 MAKE SURE IT GETS TO THE DISC NOSP LDA BUFR2+13 NOW GO GET THE SZA,RSS JOB RECORD IF ONE JMP NJREC NO JOB RECORD SKIP RELEASE * JSB GTREC GET THE RECORD JSB OPEN OPEN THE SPOOL FILE (CLOSES JOBFIL) DEF *+7 DEF IDCB DEF IERR DEF BUFR2+3 NAM FROM JOBREC DEF ZERO EXCLUSIVE OPEN DEF ISECU SAME SECURITY CODE DEF BUFR2+6 CARTRIDGE JSB CLOSE CLOSE IT AND TRUNCATE tþúEXTENTS DEF *+4 DEF IDCB DEF IERR DEF M8 NEGATIVE NO TO PURGE EXTENTS OPN2 JSB OPEN RE OPEN JOBFILE DEF *+6 DEF IDCB DEF IERR DEF JOBFL DEF IOPTN DEF ISECU CPA M8 OK? JMP OPN2 NO LOCKED TO ANOTHER * SSA ERROR? JSB JERR REPORT AND EXIT * CCA STILL HAVE JOB RECORD AND RN LOCK STA BUFR2 CLEAR USAGE FLAG JSB WRTRC WRITE IT OUT LDA D17 NOW RETRIEVE JSB GTREC RECORD 17 CLA CLEAR THE RECORD FLAG STA BUFR2+13 NJREC LDB BUFR2+11 GET THE OFFSET TO SZB,RSS THE BIT MAP JMP NBITS NONE * ADB DBUF INDEX TO THE WORD LDA BUFR2+12 GET THE BIT TO BE CLEARED CMA CHANGE TO AND MASK AND B,I CLEAR THE BIT STA B,I SET IT BACK CLA STA BUFR2+11 CLEAR THE PRESENTS FLAG NBITS JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN * * END OF CLEAN UP CODE * LDA COMND+5 IS THE FIRST PARAMETER SSA NEGATIVE?? JMP TERM YES CALL WAS TO CLEAN UP ONLY * ADA CCOMP AN ASCII PARAMETER? SSA IF SO, TREAT AS A JMP RDREC SIMULATED XEQ. * * JSB EXEC READ THE STRING DEF STRTN DEF D14 DEF D1 DBUFX DEF BUFR DEF BUFLN STRTN SZB,RSS IF NO STRING JMP TERM JUST EXIT * LDA DBUFX GET THE BUFFER ADDRESS JSB $LIBR PARSE THE RECORD NOP JSB $PARS USE SYSTEM ROUTINE DEF ONBF JSB $LIBX DEF *+1 DEF *+1 GO DO THE XEQ THING JSB XEQQ DO XEQ THING JMP TERM GO EXIT * EQT5 NOP TYP05 OCT 2400 TYP07 OCT 3400 TYPW OCT 37400 DYSTA NOP * * RDREC JMP NACT IF NOT INTERACTIVE JUMP * JSB EXEC ELSE SEND A DEF NA+äþúCT ";" DEF NWWC WRITE REQUEST DEF OLU AS A PROMPT DEF SCOL DEF M2 NACT NOP IGNORE ERRORS. JSB REIO READ A CARD (OR TAPE LINE). DEF *+5 DEF RCODE DEF CONWD DBUFR DEF BUFR DEF BUFLN STB IBUFL CMB,INB STB BUFL1 STA STAT SAVE STATUS WORD. STA LASTH CLEAR LAST HOLD FLAG RAL,CLE,ELA MOVE DOWN BIT TO E REG. ALF,RAL MOVE EOF BIT TO SIGN RAL POSITION. SSA JMP EOF EOF CONDITION. * SZB ZERO LENGTH? JMP PRS NO - NORMAL RECORD. * AND B70 IF DEVICE TYPE < 10 OR SEZ,CCE,SZA DEVICE NOT DOWN, THEN EOF. JMP NACT ELSE RETRY THE READ. * JMP EOF * WRIT NOP WRITE A RECORD ROUTINE JSB REIO WRITE THE CARD TO CURRENT SPOOL FILE. DEF *+5 DEF NWWC DEF ICNWD DEF BUFR DEF BUFL1 JSB JERR ERROR CONDITION - FLUSH THE JOB. * JSB TSTEX TEST EXTENT OVERFLOW JMP WRIT,I OK EXIT * JMP WRIT+1 TRY AGAIN IF NEEDED * PRS LDA BUFR AND MASKL CPA COLON IS THIS A BM COMMAND CARD? JMP PRCOM YES. PARSE IT. * OTHER CLA CPA EOJSW ARE WE READING IN A JOB? JMP RDREC NO. IGNORE THE CARD. * WRREC JSB WRIT WRITE THE CARD TO CURRENT SPOOL FILE. * LDA STAT HAVE WE AN EOF ALF,ALF CONDITION? SSA,RSS JMP RDREC NO - GO READ NEXT CARD. * AND B77 YES - IS THIS A PT READER? CPA RCODE RSS YES - DO AN EOF. JMP RDREC * JSB WAITM WRITE OUT A MESSAGE ASC 3,PT D7 DEC 7 MESSAGE LENGTH JSB EXEC NOW PAUSE UNTIL DEF CONT THE OPERATOR PUTS DEF D7 THE NEXT TAPE IN THE DEF ZERO AND SETS JOB GOING DEF RCODE AGAIN. CONT ×WþúJMP RDREC LOOK FOR MORE INPUT. * TSTEX NOP TEST FOR EXTENT OVERFLOW ALF,ALF GET EOF BIT TO SIGN SSA,RSS EOF SET? JMP TSTEX,I NO RETURN OK * JSB EXEC CAN USE EXEC CALL BECAUSE DEF *+3 THIS CALL JUST REMOVES THE EOF STATUS DEF D3 DEF BSCWD BACK SPACE TO BE READY TO RETRY * LDA LASTH HAVE WE ALREADY SENT THE MESSAGE? SZA,RSS JMP WEXT YES JUST WAIT * CLA SET FLAG TO SHOW ALREADY SENDT STA LASTH JSB WAITM SEND THE EXTENT WAIT MESSAGE ASC 3,EXTENT B11 OCT 11 9 WORDS * WEXT JSB WAIT WAIT FOR THE RN ISZ TSTEX TRY AGAIN JMP TSTEX,I EXIT IS P+2 * EOF LDA EOJSW HOPPER EMPTY OR EOT. SZA,RSS JMP TERM TERMINATE IF NOT READING A JOB. * CLA * STA BUFL1 WRITE 0 LENGTH RECORD. JMP WRREC * TERM JSB CLOSE DEF *+4 DEF IDCB DEF IERR DEF ZERO CLA,INA CLEAR JOBFIL RN IF NECESSARY. CPA JSTAT RSS JSB CLRN JSB EXEC TERMINATE THE BEM. DEF *+2 DEF D6 * * PRCOM LDA DBUFR JSB $LIBR PARSE A BM COMMAND. NOP LDB IBUFL JSB $PARS DEF COMND JSB $LIBX DEF *+1 DEF *+1 LDA BUFR XOR BUFR+1 GET SECOND TWO CHARS AND B377 XOR BUFR+1 ALF,ALF NOW HAVE TWO AFTER THE ':' CPA "EO" JMP EOJCD :EOJ * CPA "XE" JMP XEQ :XEQ * CPA "JO" RSS JMP OTHER * CLA :JOB CPA EOJSW JMP OPFIL * JSB EOJ CLOSE LAST SPOOLFILE. OPFIL JSB LKRNP JSB JSRCH FIND A JOB RECORD LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA M5 STA BUFR2+9 TRY TO FIND AN AVAILABLE LDA WD4AD STA CLRN CLA,INA SPOOL FILE Ï þú STA FILNO CLB,INB CCA STA CLEAR OLOOP LDA M16 STA BUFR2+11 ILOOP LDA CLRN,I AND B SZA,RSS JMP HAVIT * NOT1 RBL ISZ FILNO ISZ BUFR2+11 JMP ILOOP * ISZ CLRN ISZ BUFR2+9 JMP OLOOP * JSB POST1 NOHAV JSB CLRN WAIT UNTIL THERE IS AN JSB HLDIN AVAILABLE SPOOL FILE. JMP OPFIL * D10 DEC 10 "00" ASC 1,00 D3 DEC 3 SVBIT NOP * HAVIT ISZ CLEAR TEST IF FIRST AVAILABLE FILE RSS IF SECOND SKIP TO USE IT JMP NOT1 DO NOT USE FIRST ONE (LEAVE FOR OUT SPOOL) * LDA FILNO SET UP THE SPOOL USAGE FLAG CMA,INA DIVISION OF FILE # BY 16. ADA BUFR2+2 IS FILNO > # OF SPOOL SSA POOL FILES? JMP NOHAV YES - NO GOOD. * LDA CLRN,I NO - OK. XOR B FIX AVAILABILITY BITS. STB SVBIT SAVE BIT FOR REC 17 STA SAVFL SAVE THE NEW WORD LDA D18 HAVE AN AVAILABLE SPOOL FILE. JSB GTREC GET JOBFIL RECORD 18. CLB SET UP FOR DIVIDE LDA FILNO CONVERT THE FILE NUMBER TO ASCII DIV D10 ALF,ALF A HAS HIGH ORDER, B LOW ADA B ADA "00" ADD THE ASC '00' STA SAVE1 LDA BUFAD FIND THE LOCATION INFORMATION STA SAVE FOR THE FILE. RANGE LDA SAVE,I ALF,ALF ADA SAVE,I AND B377 CMA,INA ADA FILNO ISZ SAVE SSA JMP *+3 * ISZ SAVE JMP RANGE * LDA SAVE,I STA SAVE LDA DBUF2 JSB CLEAR LDA SAVE STA BUFR2+6 SAVE DISC LABEL. LDA SAVE1 STA BUFR2+5 LDA SPOL STA BUFR2+3 SAVE FIRST PART OF FILE NAME. LDA SPOL+1 STA BUFR2+4 LDB "I" FINISH SETTING UP THE JOBFIL JSB FJOBF ENTRY. JSB .DRCT DEF COMND JSB CLEAR JSB .DFER FORM Ùþú THE BUFFER TO PASS DEF COMND+2 TO THE SMP. DEF BUFR2+3 MOVE JOB LOCATION. LDA BUFR2+6 STA COMND+6 CARTRIDGE ID. LDA ISECU STA COMND+5 SECURITY CODE. LDA DFLAG STA COMND+8 DISPOSITION FLAGS. LDA RECNO JOBFIL RECD. # OF JOB. STA COMND+11 STA NUM WRITE THE JOB RECORD AND JSB WRTRC SET UP TO UPDATE LDA D17 RECORD 17 JSB GTREC AND LDA RECNO SET THE IN STA BUFR2+13 PROCESS FLAG LDA SAVFL SET THE SPOOL FILE STA CLRN,I IN USE FLAG LDA SVBIT GET THE BIT POSITION STA BUFR2+12 SET IT LDA DBUF COMPUTE THE BUFFER OFFSET CMA,INA TO THE BIT ADA CLRN AND STA BUFR2+11 SET THAT JSB WRTRC AND WRITE THE RECORD JSB CLRNP POST AND UNLOCK THE FILE * STUP2 CLA STA COMND+7 DRIVER TYPE. JSB SPOPN CALL TO OPEN THE SPOOL FILE DEF *+3 RETURN DEF COMND SET UP BUFFER DEF SPLU THE LU LDA SPLU GET THE LU THAT IS PASSED BACK SSA,RSS WAS SETUP SUCCESSFUL? JMP STUP1 YES, GO DO IT * JSB HLDIN NO WAIT UNTIL AN LU OR SUCH JMP STUP2 FREES UP. SMP WILL CALL BACK. * STUP1 STA EOJSW STA ICNWD SET CONTROL WORD FOR WRITES. ADA B200 SET UP A BACKSPACE STA BSCWD FOR EXTENT PROBLEMS JSB LKRNP LOCK UP THE JOB FILE LDA D17 AND GET THE JOB RECORD JSB GTREC AGAIN JSB .DRCT GET THE LU FROM DEF $LUAV THE LU TABLE LDB A,I GET LENGTH STB CLRN SET FOR COUNT NXTLU INA STEP TO LU LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER RBL,CLE,ERB CLEAR SIGN IF SET CPB SPLU THIS THE LU? JMP FSPLU YES GO SET UP * ISZ CLRN STEP COUNT JMP NXTLU TRY NEXT ONE * "õþú JSB JERR REPORT NOT FOUND ERROR * FSPLU LDA A,I GET THE RECORD NUMBER STA BUFR2+10 SET IN THE JOB FILE REC 17 JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN JMP WRREC GO WRITE OUT THE JOB CARD. * SAVFL NOP BSCWD NOP B200 OCT 200 * WAIT NOP JSB RNRQ LOCK THE WAIT RN GLOBALLY. DEF *+4 WHEN A CONDITION IN SMP DEF D2 FREES AN LU OR A FILE OR DEF WRN A FULL OUTSPOOL QUEUE, SMP DEF SAVE CLEARS THIS RN SO THAT OTHER JSB RNRQ PROGRAMS CAN CONTINUE. DEF *+4 DEF D6 DEF WRN LOCK THE RN. DEF SAVE JMP WAIT,I * HLDIN NOP LDA HLDIN GET ADDRESS OF LAST CALL CPA LASTH SAME?? JMP HLD1 YES DON'T RESEND THE MESSAGE * STA LASTH NO SET NEW ADDRESS AND SEND THE MESSAGE JSB WAITM SEND WAIT ON SPOOL RESOURCE MESSAGE ASC 3,SPOOL D13 DEC 13 HLD1 JSB WAIT WAIT FOR IT JMP HLDIN,I RETURN * WAITM NOP MESSAGE FIXER AND SENDER JSB .DFER FIX UP THE MESSAGE DEF MES MOVE IN THE 3 WORDS DEF WAITM,I STA WAITM SET THE ADDRESS OF THE LENGTH JSB EXEC DEF *+5 DEF D2 DEF OLU DEF RESWT DEF WAITM,I ISZ WAITM ADVANCE THE RETURN ADDRESS AND JMP WAITM,I RETURN * LASTH NOP ADDRESS OF LAST HOLD * XEQ CLA CPA EOJSW IF THERE IS A JOB SPOOL RSS NOT COMPLETED, THEN END IT. JSB EOJ JSB XEQQ DO XEQ THING JMP RDREC GO GET NEXT RECORD * * XEQQ NOP XEQ SUBROUTINE JSB JSRCH SEARCH FOR A PLACE TO PUT THIS. LDA DBUF2 JSB CLEAR LDB "R" JSB FJOBF SET UP THE JOBFIL RECORD. LDB JNAMA GET JOB NAME ADDRESS LDA COMND+4 IF LU CPA D1 SUPPLIED LDB DCOM5 USE IT STB MVNAM þúSET ADDRESS JSB .DFER DEF BUFR2+3 MVNAM NOP USE CLEANED UP NAME LDA COMND+13 GET THE CR INFO STA BUFR2+6 AND SET IT JSB QUEUE WRITE IT OUT. JMP XEQQ,I RETURN * EOJCD CLA CPA EOJSW JMP RDREC * JSB WRIT WRITE THE EOJ RECORD JSB EOJP PROCESS THE EOJ JSB EXEC DO DYNAMIC STATUS DEF RTNST DEF D3I NO ABORT RETURN DEF DYSTA JMP RDREC IGNORE REJECT FOR MULTIPOINT * RTNST ALF,ALF RAL,RAL HOPPER EMPTY? SSA,RSS JMP RDREC NO CONTINUE * RAR,RAR ISOLATE DRIVER TYPE AND B73 CPA B11 CARD READER? (CHECKS 11 OR 15) JMP TERM YES - TERMINATE. * JMP RDREC NO CONTINUE * B73 OCT 73 D3I OCT 100003 * EOJ NOP JSB REIO PUT AN ":EOJ" IN THE BUFFER TO BE DEF *+5 DEF WCODE DEF ICNWD DEF EOJC DEF D2 JSB TSTEX TEST FOR EXTENT OVERFLOW RSS NO CONTINUE JMP EOJ+1 YES TRY AGAIN * JSB EOJP PROCESS THE EOJ JMP EOJ,I RETURN * EOJP NOP EOJ COMMON PROCESSOR JSB EXEC SCHEDULE THE SMP TO CLOSE THE DEF *+5 SPOOL FILE. PASS IT THE CLOSE DEF D23 CODE AND THE LU# OF THE SPOOL DEF SMPA DEF D4 DEF SPLU JSB LKRNP MAKE SURE BUFFER IS CLEAR LDA RECNO JSB GTREC GET APPROPRIATE JOBFIL RECORD. LDA BUFR2+2 GET THE STATUS AND B377 IN CASE GASP HAS BEEN HERE CPA "H" NOW IN HOLD? LDA "RH" YES MAKE "RH" CPA "I" WHAT IT SHOULD BE? LDA "R" YES SET "R" STA BUFR2+2 JSB QUEUE WRITE OUT AND Q THE JOBFIL RECORD. JSB LKRNP POST AND LOCK LDA D17 CLEAR THE INPUT IN PROGRESS JSB GTREC FLAG IN CLA RECORD STA BUFR2+10 STà£þúA BUFR2+11 STA BUFR2+12 17. STA BUFR2+13 JSB WRTRC SEND IT BACK TO THE DISC. JSB CLRNP UNLOCK THE FILE JMP EOJP,I RETURN * QUEUE NOP WRITE OUT JOB RECORD AND QUEUE IT JSB WRTRC WRITE IT OUT LDA BUFR2+2 GET STATUS CPA "RH" IF HELD JMP QUEX JUST RETURN * LDA BUFR2 STA SAVE SAVE JOB PRIORITY. CLB CCA COMPUTE THE ADDRESS OF ADA RECNO THE QUEUE FLAG DIV D16 ADB DBUF CALCULATE THE BUFFER ADDRESS STB SAVE1 SAVE IT JSB GTREC GET THE RECORD LDA SAVE SET THE PRIORITY STA SAVE1,I IN THE QUEUE JSB WRTRC WRITE THE RECORD BACK OUT QUEX JSB POST1 POST THE FILE BUFFER. JSB CLRN CLA STA EOJSW JSB EXEC DEF *+4 SCHEDULE THE FILE MANAGER. DEF NWAIT DEF FLMAN DEF M5 JMP QUEUE,I * JMP QUEUE,I * "RH" ASC 1,RH "H" OCT 110 "I" OCT 111 "R" OCT 122 * WRTRC NOP JSB WRITF DEF *+6 DEF IDCB DEF IERR DBUF2 DEF BUFR2 DEF D16 DEF NUM LDA IERR SSA JSB JERR * JMP WRTRC,I * GTREC NOP STA NUM JSB READF DEF *+7 DEF IDCB DEF IERR DBUF DEF BUFR2 DEF D16 DEF LEN DEF NUM LDA IERR SSA JSB JERR * JMP GTREC,I * LEN BSS 1 NUM BSS 1 * POST1 NOP JSB POST DEF *+2 DEF IDCB JMP POST1,I * CLRNP NOP JSB POST1 JSB CLRN JMP CLRNP,I * LKRNP NOP JSB POST1 JSB LKRN JMP LKRNP,I * CLRN NOP JSB RNRQ DEF *+4 DEF D4 DEF JRN DEF JSTAT JMP CLRN,I * LKRN NOP JSB RNRQ DEF *+4 DEF RCODE DEF JRN DEF JSTAT JMP LKRN,I * JSRCH NOP JSR1 JSB POST1 Vþú JSB LKRN LDA D18 SEARCH FOR FREE JOBFIL RECORD. JSR2 INA JSB GTREC LDA BUFR2 SSA,RSS JMP *+4 * LDA NUM STA RECNO JMP JSRCH,I * LDA NUM CPA RECNT RSS JMP JSR2 * JSB POST1 JSB CLRN NONE AVAILABLE. WAIT UNTIL JSB HLDIN THERE IS. JMP JSR1 * CLEAR NOP LDB M16 STB FJOBF CLB STB A,I INA ISZ FJOBF JMP *-3 * JMP CLEAR,I * FJOBF NOP STB BUFR2+2 LDB COMND+8 IF PRIOITY IS ASCII CPB D2 THEN USE DEFAULT CLA,RSS LDA COMND+9 STORE PRIORITY, STATUS, JOB NAME, SZA,RSS LDA DEFPR DEFAULT PRIORITY, IF NECESSARY. CPA NSPRM LDA DEFPR STA BUFR2 LDA M18 ADA RECNO STA BUFR2+1 STORE JOB #. LDA M6 STA CNTR LDB DCOM5 CLE,ELB STB UPTR LDB JNAMA CLE,ELB STB PPTR FXNM1 LDA BLANK LDB UPTR SZB JSB UNPAK CPA RCOLN JMP BLFIL * SZA,RSS JMP BLFIL * JSB PAK ISZ CNTR JMP FXNM1 * JMP FJOBF,I * BLFIL CLB STB UPTR JMP FXNM1 * JNAMA DEF BUFR2+7 CNTR BSS 1 M6 DEC -6 * UPTR NOP UNPAK NOP LDB UPTR ISZ UPTR CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND B377 JMP UNPAK,I * PCHAR NOP PPTR NOP PAK NOP STA PCHAR LDB PPTR ISZ PPTR CLE,ERB LDA B,I SEZ ALF,ALF AND B377 ALF,ALF IOR PCHAR SEZ,RSS ALF,ALF STA B,I JMP PAK,I * JERR NOP JSB EXEC SEND ERROR MESSAGE DEF EXMS DEF D2 DEF OLU DEF TERMM DEF D7 EXMS JMP TERM * A EQU 0 B EQU 1 DEFPR DEC 9999 NSPRM ASC 1,NS NWAIT OCT 100012 FLMAN ASC 3,FMGR iNLHD5 DEC 5 SPOL ASC 2,SPOL TERMM ASC 7,END JOB ABNORM DCOM5 DEF COMND+5 CCOMP OCT -20000 BLANK OCT 40 RCOLN OCT 72 M2 DEC -2 SCOL ASC 1,;_ PROMPT RCODE DEC 1 IOPTN OCT 3 WCODE DEC 2 D2 EQU WCODE DFLAG OCT 40021 B70 OCT 70 B77 OCT 77 B377 OCT 377 M5 DEC -5 BUFAD DEF BUFR2 BUFLN DEC -80 EOJSW BSS 1 JRN BSS 1 WRN BSS 1 JSTAT BSS 1 NWWC OCT 100002 MASKL OCT 177400 COLON OCT 35000 CNWD OCT 400 CONWD BSS 1 ICNWD BSS 1 STAT BSS 1 D6 DEC 6 D23 DEC 23 D4 DEC 4 ZERO DEC 0 D16 DEC 16 D17 DEC 17 D18 DEC 18 M18 DEC -18 WD4AD DEF BUFR2+4 IERR BSS 1 SMPA ASC 3,SMP JOBFL ASC 3,JOBFIL ISECU OCT 123456 M8 DEC -8 M16 DEC -16 "JO" ASC 1,JO "EO" ASC 1,EO EOJC ASC 1,:E ASC 1,OJ "XE" ASC 1,XE D1 DEC 1 D14 DEC 14 RESWT ASC 6,JOB WAIT ON SPOOL RESOURCE MES ASC 3,SPOOL ASC 4,RESOURCE. * ORG * END BEM UONÿÿ ÿý×é ÿ92067-18030 2013 S C0222 &4DV43 RTE-IVA SPOOL DRIVER             H0102 ýÓþúASMB,R,Q,C ASSEMBLE STATEMENT FOR RTE IV * HED SPOOL MONITOR DRIVER FOR RTE IV * NAME: DVS43 * SOURCE: 92067-18030 (RTE IV) * RELOC: 92067-16028 (RTE IV) * PGMR: A.M.G.,G.A.A.,C.M.M.,J.M.N. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVS43 92067-16028 REV.2013 800125 * ENT IS43,CS43,N.SEQ SUP * * * *** SPOOL EQT ENTRIES *** * * EQT1 SAME AS STANDARD * . * . * . * EQT7 SAME AS STANDARD (READ WRITE), BUFFER MASK (POST) * EQT8 TRANSFER AMOUNT IN WORDS * EQT9 USED TO SAVE TLOG WHILE WAKING SPOUT. * EQT10 RECORD LENGTH * EQT11 FLAGS: BIT 15 - 1 IF WRITE CALL TO INCOR * BIT 14 - BATCH CHECK FAILED ONCE * BIT 13 - EOF SENT BACK ONCE (OR BATCH * CHECK FAILED) * BIT 12 - HOLDING I/O ON THIS LU. * BIT 9,10,11- TRANSFER VECTOR FOR EXTND/TO * RETURNS: * 0= POST WAIT FOR XSIO CALL * 1= WAIT FOR EXTND TO START SPOUT * 2= WAIT FOR BUFFER ECT. IN INCOR * 3= WAIT FOR READ/WRITE EXTND * 4= WAIT FOR BACKSPACE EXTENT * 5= WAIT IN RWIND FOR EXTND * 6= NOT USED * 7= NOT USED * BIT 7,8- 00 READ AND WRITE * 01 READ ONLY * 10 WRITE ONLY * BIT 6 - NOT USED * BIT 5 - NOT USED * BIT 4 - ORD™BþúINARY FILE * BIT 3 - SPOOL POOL FILE * BIT 2 - REQUEST LENGTH IN CHARACTERS * BIT 1 - NOT USED * BIT 0 - TEMP EOF FLAG * EQT12 # OF EXTENSION WORDS - BSREC OR PUSH/GETRD RETURN POINT SAVE * EQT13 POINTER TO EXTENSION * EQT14 SAME AS STANDARD * EQT15 SAME AS STANDARD * * *** EQT EXTENSION *** * * EQT16 EQT18 SAVE * EQT17 EQT19/EQT21 SAVE * EQT18 CURRENT TRACK * EQT19 CURRENT OFFSET * EQT20 FILE EXTENSION # * EQT21 CURRENT SECTOR # * EQT22 TRANSFER COUNTER * EQT23 CURRENT PACKING BUFFER ADDRESS * EQT24 BEGINNING TRACK IN THIS EXTENT * EQT25 BEGINNING SECTOR IN THIS EXTENT * EQT26 # OF SECTORS IN THE FILE (AND EACH EXTENT) * EQT27 TR/LU DIRECTORY ADDRESS OF * EQT28 OFFSET/SECTOR MASTER ENTRY. * EQT29 ID SEGMENT ADDRESS OF PGM REQUESTING INPUT CHECK * FILE COUNTER FOR SPOUT (ALWAYS NEGATIVE) * EQT30 # OF SECTORS PER TRACK * EQT31 RECORD COUNT * EQT32 SPOUT CLASS PARAMETER 1 * EQT33 SPOUT CLASS PARAMETER 2 * * * EXT $LIST RTE PROGRAM SCHEDULING EXT $XSIO RTE SYSTEM I/O EXT $XEQ SYSTEM IDLE LOOP EXT $ETEQ RTE - SETUP UP EQT ON BASE PAGE EXT $DRVM IN RTE IV TO SETUP USER MAP EXT $RSM IN RTE IV TO RESTORE PREVIOUS MAP EXT $UPIO IN RTE IV FOR CLEAR IO RETURN ******************** * ERROR EXITS * ******************** * * REJECT REQUEST ERROR CODES (CAUSE IOXX ERROR REPORTS) * * XX = 20 ATTEMPT TO READ A WRITE ONLY FILE * = 21 ATTEMPT TO READ PAST EOF * = 22 SECOND ATTEMPT TO READ A JCL RECORD (FIRST RETURNS EOF) * = 23 ATTEMPT TO WRITE ON A READ ONLY FILE * = 24 ATTEMPT TO WRITE PAST EOF (OR SPOOL FILE OVERFLOW) * = 25 REQUEST ON A EQT THAT HAS NOT BEEN SET UP WITH A FILE. * * EOF EXITS MADE ON READ OR WRITE REQUESTS (SEE BELOW) * * TLOG = 0 STANDARD EOF ALL OK IF RE{·þúAD, IF WRITE OF # 0 RECORD * IMPLIES FILE IS FULL. NEXT ATTEMPT TO WRITE WILL * CAUSE IO24 (SEE ABOVE) * = -1 EOF WAS A -2, MEANS FILE WAS TERMINATED FOR OVERFLOW * = -5 SAME AS FMGR -5 ERROR I.E. NO EXTENT ON READ OR LENGTHS * AT THE ENDS OF THE RECORD DON'T MATCH. HED SPOOL MONITOR DRIVER REQUEST DECODE SECTION N.SEQ NOP IS43 NOP LDA IS43 SRTNI STA RTNI SAVE FIRST RETURN ADDRESS CLA STA SRTNI * LDB EQT6,I TEST FOR CLEAR IO RQ CPB BSN3 BSN3=100003B JMP IS43,I SYSTEM CLEAR ACCEPT IT. * JSB EXEQT LDA EQT27,I IS THIS SPOOL SZA,RSS EQT INITIALIZED? JMP ABORT NO - REJECT THE CALL. * LDA EQT8,I STA EQT10,I CLB SSA,RSS JMP WDS * CMA,INA SLA,ARS INA STA EQT8,I LDB D4 WDS CMA SAVE NEG. OF # OF WORDS TO STA EQT22,I WORDS TO TRANSFER LDA EQT5,I CLEAR EOF BIT. IOR D128 XOR D128 STA EQT5,I LDA EQT11,I AND DISPM IOR B LDB A IF LAST EXIT WAS WITH BATCH CHECK RBL,ELB SEZ,RSS WELL WAS IT? JMP ST11 NO PROCEED * LDB EQT1,I YES IS THIS THE KEEPER OF THE CPB EQT29,I KEYS?? AND CLEOF YES CLEAR THE EOF FLAGS ST11 STA EQT11,I INITIALIZE EQT11 ALF,SLA HOLDING I/O TO THIS LU. JMP ABORT YES. AN ABORTING ERROR (SPOUT KNOWS) * LDA EQT18,I SAVE CURRENT FILE LOCATION STA EQT16,I IN CASE AN EXTENT IS NEEDED LDA EQT19,I AND NOT AVAILABLE AND B377 KEEP LOW BITS OF LENGTH (ITS <0) ALF,ALF IOR EQT21,I STA EQT17,I * LDA EQT6,I AND B77 LDB D20 SET UP THE ERROR CODE RBR,ELB 20 NORMAL, 21 IF POSSIBLE BATCH CHECK CPA D1 JMP RR READ REQUEST * LDB D23 SET FOR WRk¡þúITE ERRORS CPA D2 JMP WR WRITE REQUEST * * COME HERE FOR CONTROL REQUEST * LDA EQT11,I ALF,ALF READ ONLY FILE? SSA JMP CR1 YES. * AND TFLAG DOES FILE HAVE HEADERS? SZA JMP CR1 NO. INTERPRET REQUEST. * STA EQT8,I SET UP TO PUT THE CONTROL CMA INFORMATION IN THE BUFFER STA EQT22,I TO BE WRITTEN OUT. JMP WR * CR1 LDA EQT6,I GET THE CONWD. RRR 6 AND B77 ISOLATE CONTROL FUNCTION CMA,INA,SZA,RSS DECODE THE REQUEST JMP ILL ZERO IS A BAD GUY. * LDB D23 INA,SZA,RSS 1 IS EOF JMP WREOF SO OFF TO THE EOF WRITER * INA,SZA,RSS 2 IS BACK SPACE RECORD JMP BSREC SO OFF THE THE BACK SPACE ROUTINE * INA,SZA,RSS 3 IS FORWARD SPACE RECORD JMP FSREC SO GO DO THAT * INA,SZA,RSS 4 IS REWIND JMP RWIND SO OFF TO DO IT * INA,SZA 5 IS ALSO REWIND CPA N7 14 IS BACKSPACE FILE BUT ONLY ONE SO REWIND RWIND CCA,RSS OFF TO IT. * JMP ILL NONE OF THE ABOVE CAN NOT DO IT * STA EQT20,I REWIND SPOOL FILE BY CALLING THE LDA B5000 EXTND PROGRAM TO GET JMP GTEXT EXTENT 0 (MASTER ENTRY). * * * RETURN TO RW2 AFTER EXTND CALL OR FROM BACKSPACE. * RW2 LDA DM128 MAKE SURE ALL POINTERS STA EQT19,I ARE CONSISTENT WITH * CLA CLEAR THE RECORD COUNT RW3 STA EQT31,I LDA EQT11,I CLEAR EOF BIT IF SET. AND CLEOF STA EQT11,I CLB RETURN A CLEAR TLOG JMP POST1 * ILL LDA D2 NONE OF THE ABOVE JMP RTRN REJECT REQUEST * ABORT LDA D25 SEND ABORT ERROR IO25 * * COMMON RETURN POINT * RTRN STA XA SAVE A REG LDA EQT1,I IS CLEAR IO IN PROGRESS RAL,CLE,SLA,ERA CLEAR SIGN BIT IN CASE CLB,RSS YEÔþúS SET B TO CLEAR TIME OUT JMP RTRN2 NO GO EXIT * STA EQT1,I SET EQT1 WITH CLEARED FLAG BIT STB EQT15,I CLEAR THE TIME OUT WORD LDA EQT5,I CLEAR THE BUSY BIT ALR,RAL AND STA EQT5,I SET IT BACK JMP $UPIO NOW GO TO UPIO * RTRN2 LDA XA NO RESTORE A AND RETURN JMP RTNI,I * XA BSS 1 RTNI BSS 1 DISPM OCT 70630 D23 DEC 23 D25 DEC 25 D20 DEC 20 TFLAG OCT 10000 N7 DEC -7 B4000 OCT 4000 CLEOF OCT 117777 B5000 OCT 5000 B77 OCT 77 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 B3701 OCT 3701 BSN3 OCT 100003 * * * * BSREC LDA EQT11,I IF AT A REAL EOF RAL,RAL THEN SSA JMP BSR0 JUST SET UP THE POINTERS * CCA BACKSPACE ROUTINE JSB BSPTO BACK UP THE POINTER LDA SAVE,I GET THE TRAILING LENGTH WORD CMA SET TO BACK OVER THE RECORD JSB BSPTO DO IT BSR0 CCA BACK UP THE RECORD POINTER ADA EQT31,I BY ONE JMP RW3 GO SET AND EXIT HED SPOOL MONITOR DRIVER BACKSPACE POINTER ROUTINE BSPTO NOP BACKSPACE 'A' WORDS IN THE FILE LDB BSPTO SAVE ENTRY POINT IN CASE STB EQT12,I WE ARE INTERRUPTED. ADA EQT19,I DECREMENT THE BUFFER OFFSET CMA SET FOR DIVIDE CLB SET FOR DIVIDE DIV D128 A IS BLOCK OFFSET, B NEW BUFFER OFFSET CMB SET BUFFER OFFSET NEGATIVE STB EQT19,I SET THE BUFFER OFFSET CMA,INA,SZA,RSS SET BLOCKS NEGATIVE JMP BSP1 IF ZERO THEN IN SAME BUFFER * STA SAVE SAVE THE BLOCK OFFSET JSB SUBT GET CURRENT SECTOR POSITION ADA SAVE ADJUST TO NEW ADA SAVE (IT WAS BLOCKS REMEMBER) CLB SET FOR DIVIDE CMA,SSA,INA SET POS. NUMBER TO GO BACK JMP BSP2 SAME EXTENT GO SET UP * DIV EQT26,I A= # EXTENTS BACK, B= SECTOR®þú OFFSET IN THAT EXTENT SZB ADJUST IF ZERO REMAINDER INA SET UP TO GO CMA ADA EQT20,I BACK AND GET STA EQT20,I THE EXTENT. INA IF LESS THAN SSA -1 THEN JMP RWIND JUST REWIND * CMB,INB,SZB ADB EQT26,I SAVE INDEX INTO STB EQT17,I THE EXTENT. BS13 LDA B4000 GET THE RETURN VECTOR JMP GTEXT GO GET THE EXTENT * BSP2 CMA,INA,RSS SET POSITIVE OFFSET BS10 LDA EQT17,I RETURN FROM EXTENT TO HERE B40 CLE CLEAR E FOR OVERFLOW TEST ADA EQT25,I TAKE INDEX FROM BEGINNING CLB,SEZ,CLE OF TRACK WHERE THE INB STEP B IF OVERFLOW DIV EQT30,I CURRENT EXTENT BEGINS. ADA EQT24,I FIND OUT HOW MANY STA EQT18,I TRACKS TO ADVANCE. STB EQT21,I SAVE CURRENT TRACK AND SECTOR. BSP1 CLE SET FOR READ ACCESS JMP BSCOR MAKE PRESENT AND RETURN HED SPOOL MONITOR DRIVER READ ROUTINE FSREC CLA FAKE OUT THE READ STA EQT8,I ROUTINES SO THAT INA THEY WILL FORWARD STA EQT6,I SPACE ONE RECORD. CMA,INA STA EQT22,I * RR LDA EQT6,I CPA B3701 IS THIS REALLY A POST REQUEST? JMP POST YES. * LDA EQT11,I CHECK IF FILE IS WRITE ONLY. ALF,ALF SLA JMP EOFRT SEND BACK IO20. * AND B40 ALREADY DONE AN EOF ON INB SET FOR EOF # 2 ERROR SZA THIS FILE? JMP EOFRT * JSB GETRD GET READY TO ACCESS THE BUFFER * LDA SAVE,I NO,GET AND SAVE LENGTH OF STA EQT10,I DISK RECORD. STA B SET IN B IN CASE EOF SSA EOF I.E. LESS THAN 0 JMP EORET YES EOF RETURN. * ADA EQT22,I # OF WORDS LEFT IN RECORD SSA,RSS IF BUFFER PROVIDED IS TOO SHORT JMP STFLG THEN JUST USE IT * STB EQT8,I ELSE SAVE TO ²þúTAL # WORDS TO BE CMB TRANSFERRED. STB EQT22,I SET TRANSFER COUNTER. STFLG JSB PUSH PUSH THE BUFFER ADDRESSES LDB EQT29,I GET THE BATCH CHECK FLAG SZB IF ZERO OR CPB EQT1,I CURRENT USER RSS SSB OR NEGATIVE JMP EORT ALL OK GOT TEST FOR END OF RECORD * LDA SAVE,I IF THIS IS A ":" HE IS AND MASKL IN DEEP CPA COLON JMP BINF SHIT, HE BLEW IT * EORT ISZ EQT22,I ALL WORDS MOVED?? JMP TRWD NO GO MOVE A WORD * LDA EQT10,I SET UP TO SKIP ANY RESIDUE CMA AND TO GET THE LAST WORD ADA EQT8,I STA EQT22,I SET COUNT RCONT LDA SAVE,I HANG ONTO THIS WORD. AT END STA EQT7,I OF RECORD, IT WILL CONTAIN LENGTH. JSB PUSH ADVANCE TO END OF RECORD. ISZ EQT22,I FINISHED? JMP RCONT NO GET THE NEXT ONE * LDA EQT7,I YES DO LINE LENGTHS SURROUNDING CPA EQT10,I THIS RECORD MATCH? JMP NORML YES - EVERYTHING NORMAL. * ERN5 LDB N6 SET UP FOR EOF WITH PREJUDICE (-5) JMP EORET NO MATCH - SEND EOF STATUS. * * N6 DEC -6 * TRWD LDB EQT7,I GET THE WORD ADDRESS LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WHICH MAP ? JMP SMAP1 SYSTEM MAP * LDA SAVE,I GET THE WORD XSA B,I SEND IT INTO THE USER MAP JMP IDON * SMAP1 LDA SAVE,I GET THE WORD STA B,I PUT IT INTO BUFFER OF BUFFERED REQUEST IDON ISZ EQT7,I STEP THE USER BUFFER ADDRESS JSB PUSH PUSH MY ADDRESSES JMP EORT GO TEST FOR END HED SPOOL MONITOR DRIVER POSITION TO NEXT WORD ROUTINES PUSH NOP ROUTINE TO PUSH THE BUFFER ADDRESS ISZ SAVE PUSH THE BUFFER ADDRESS ISZ EQT19,I CHECK THE BUFFER COUNT JMP PUSH,I ALL OK SO CONTINUE * LDA PUSH NEED A NEW SECTOR SO SAVE STA EQT12,I THyþúE RETURN ADDRESS LDA D2 ADD 2 TO THE ADA EQT21,I SECTOR ADDRESS CPA EQT30,I END OF TRACK?? CLA YES SET TO ZERO STA EQT21,I RESET THE SECTOR SZA,RSS IF FIRST SECTOR ISZ EQT18,I BUMP THE TRACK LDA DM128 SET THE BUFFER POINTER BACK STA EQT19,I TO THE FIRST WORD JSB SUBT CHECK IF END OF EXTENT CPA EQT26,I WELL JMP RDEXT YES GET NEXT EXTENT * JMP XCOR STILL IN FILE GO GET THE BUFFER * RDEXT LDA B3000 NOT IN FILE, SO GET AND EXTENT GTEXT CLB,INB SET UP THE TEMP WORDS FOR EXTND STB PRM1 LDB EQT1 STB PRM2 LDB A SAVE A LDA EQT6,I CHECK IF WRITE AND D2 ISOLATE READ BIT (0 IF READ) ADA D6 USE 8 FOR WRITE 6 FOR READ STA PRM3 PUT IN THIRD EXTND PRAM LDA B RESTORE A & CALL FOR EXTND JSB LIST JMP WTOUT GO AWAY FOR A WHILE. * GETRD NOP THIS ROUTINE MAKES SURE THE BUFFER IS LDB GETRD IN CORE AND ADDRESSABLE STB EQT12,I SET RETURN ADDRESS XCOR LDB EQT6,I WSET E FOR THE INCOR CALL RBR,ERB 0= READ, 1= WRITE,CONTROL BSCOR JSB INCOR GO GET THE SECTOR * LDA EQT19,I SET UP THE BUFFER POINTER ADA D132 EQT19 STARTS AT -128 AND ADA EQT23,I BUFFER IS 4 WORDS BEYOND EQT23 STA SAVE SET THE POINTER LDA EQT1,I GET THE CLEAR IN PROGRESS FLAG SSA THEN JMP ERN5 GO EXIT * LDB EQT12,I GET THE RETURN ADDRESS JMP B,I AND CONTINUE HED SPOOL MONITOR DRIVER TIME DELAY EXIT / CONSTANTS B3000 OCT 3000 DM128 DEC -128 * NTRDY LDA N4 SET TIME OUT SO THAT WE STA EQT15,I CAN GET BACK IN HERE. LDA EQT4,I IOR TFLAG SET THE HANDLE-OWN-TO FLAG STA EQT4,I * WTOUT CCE LDA EQT5,I SET AVAIL=2 IN RAL,ERA THE EQT STA EQT5,I íþú* JSB $RSM IN RTE IV, RESTORE PREVIOUS JMP $XEQ MAP AND GO TO SYSTEM IDLE LOOP. * MASKL OCT 177400 COLON OCT 35000 N4 DEC -4 B20K OCT 20000 D6 DEC 6 * EQT1 EQU 1660B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B EQT13 EQU 1772B EQT15 EQU 1774B EQT16 NOP EQT17 NOP EQT18 NOP EQT19 NOP EQT20 NOP EQT21 NOP EQT22 NOP EQT23 NOP EQT24 NOP EQT25 NOP EQT26 NOP EQT27 NOP EQT28 NOP EQT29 NOP EQT30 NOP EQT31 NOP EQT32 NOP EQT33 NOP * * * EOFLG NOP LDA EQT5,I SET EOF FLAG IN EQT5. IOR D128 STA EQT5,I LDA EQT11,I SET FLAG TO INDICATE IOR B20K EOF ALREADY SENT ONCE. STA EQT11,I JMP EOFLG,I * EOFRT LDA EQT5,I SET THE IOR D128 EOF FLAG STA EQT5,I * LDA B GET THE RETURN CODE JMP RTRN * * THE FOLLOWING ROUTINE FINDS OUT THE DIFFERENCE * IN SECTORS BETWEEN THE CURRENT POSITION AND * THE BEGINNING OF THIS EXTENT. * RETURNS THE RLEATIVE SECTOR OF CURRENT ADDRESS SECTOR * SUBT NOP LDA EQT24,I HOW MANY TRACKS READ WRITTEN? CMA,INA ADA EQT18,I GET RESULT IN SECTORS. MPY EQT30,I LDB EQT25,I ADD NUMBER OF SECTORS TO CMB,INB GET TOTAL. ADA B ACCUMULATE ADA EQT21,I JMP SUBT,I HED SPOOL MONITOR DRIVER POST ROUTINES * COME HERE TO POST BUFFERS BEFORE SPOOL CLOSE. * POST6 LDB EQT23,I SHOW BUFFER EMPTY AS IT MAY NOT CLA BE THE SAME AS THE INB DISC ANY MORE STA B,I SET LU TO ZERO TO CLEAR POST4 LDB EQT7,I ADVANCE TO THE NEXT BUFFER RBL FIRST THE BIT MAP LDA EQT23,I NOW THE ADDRESS ADA D132 JMP POST2 CONTINUE THE FLUSH * D132 DEC 132 * POST LDA PKBUF MUST FIND ALL BUFFERS CLB,INB TH«jþúAT NEED TO BE WRITTEN. POST2 STB EQT7,I LDB A,I MAKE SURE WE DON'T STA EQT23,I CPB D5 POST A BUFFER THAT IS JMP POST4 BEING READ OR WRITTEN. * SSB JMP POST1 ALL FINISHED. * LDA WRBUF DOES THIS NEED TO AND EQT7,I BE WRITTEN OUT. CCE,SZA JMP POST6 NO. GO CLEAR THE INCORE FLAG IN CASE * JSB SXSIO YES - DO IT. JMP NTRDY * LDB EQT23,I INDICATE THAT THE BUFFER LDA D5 IS UNAVAILABLE BY SETTING STA B,I THE AGE WORD. JSB IOCAL,I LDB EQT23,I FREE UP THE BUFFER CLA,INA FOR USE. STA B,I LDA EQT7,I INDICATE BUFFER NEED NOT IOR WRBUF BE WRITTEN. STA WRBUF JMP POST6 CLEAR THE LU SO WON'T BE FAKED OUT HED SPOOL MONITOR DRIVER CLEAN UP AND EXIT CODE BINF CCA BATCH CHECK ':' FOUND SO JSB BSPTO BACK SPACE TO LENGTH WORD FOR NEXT TIME LDA EQT11,I AND SET THE IOR B40K BATCH CHECK FAILED BIT STA EQT11,I IN THE EQT CCB SET TLOG FOR A 0 RETURN EORET JSB EOFLG SET EOF FLAGS INB SET B FOR TLOG POST1 STB EQT9,I SAVE B REGISTER. LDA EQT32,I NEED WE CALL BACK SPOUT? ALF,SLA RSS JMP POST5 * CSPT CCA SET UP ENTND TEMP WORDS STA PRM1 LDA EQT32,I STA PRM2 LDA EQT33,I STA PRM3 LDA B1000 GET THE RETURN VECTOR JSB LIST CALL FOR EXTND * LDA EQT32,I SUCCESS, SO XOR TFLAG CLEAR BIT WHICH INDICATES NEED STA EQT32,I TO CALL SPOUT. LDB EQT9,I RESTORE THE TLOG. POST5 LDA D4 NO - DO IMMEDIATE COMPLETION. JMP RTRN * B1000 OCT 1000 B40K OCT 40000 PKBUF DEF BUFS B377 OCT 377 D5 DEC 5 IOCAL NOP N1 DEC -1 SAVE NOP SAVE1 NOP TRSEC NOP FLU NOP WRBUF DEC -1 HED SPOOL MONITOR DRIVER GET CURRENT B=«þúLOCK ROUTINES * THE FOLLOWING CHECKS AND MAKES SURE THE DESIRED * SECTOR IS IN CORE. THIS ROUTINE MAY CAUSE ONE OR MORE * EXITS TO WAIT FOR RESOURCES. * * ON ENTRY E = 1 INDICATES A WRITE, E = 0 A READ * ON EXIT THE REQUESTED SECTOR IS IN CORE * * THE RETURN ADDRESS MAY BE SAVED IN EQT9 IF INCOR IS EVER CALLED * FROM MORE THAN ONE LOCATION. * * THE RETURN VECTOR IS 2000. * * INCOR NOP LDA EQT11,I SAVE THE DIRECTION BIT RAL,ERA IN EQT11 BIT 15 STA EQT11,I INC0 LDA EQT27,I GET THE LU AND AND B77 ISOLATE IT STA FLU CLA,INA SET BEGINING BUFFER READ/WRITE FLAG LDB PKBUF GET BEGINNING ADDRESS OF BUFFERS. INC1 STB EQT23,I STB TRSEC LDB B,I LOOK AT 1ST WORD OF BUFFER. INB,SZB,RSS FINISHED? JMP INC4 YES. * ISZ TRSEC LOOK AT BUFFER PTR. TO LU. LDB TRSEC,I DOES IT MATCH THIS ONE? CPB FLU RSS YES TRY THE NEXT ONE JMP INC3 NO. * ISZ TRSEC LOOK AT TRACK #. LDB TRSEC,I CPB EQT18,I IS IT EQUAL TO THE JMP INC2 TRACK DESIRED? * INC3 RAL MOVE THE WRITE FLAG TO NEXT BUFFER LDB EQT23,I INDEX THE ADDRESS ADB D132 ALSO JMP INC1 TRY THE NEXT BUFFER * INC2 ISZ TRSEC LOOK ALSO AT LDB EQT21,I SECTOR POINTER. CPB TRSEC,I MATCH THE ONE DESIRED? RSS YES. JMP INC3 NO. * LDB EQT23,I GET THE AGE FLAG LDB B,I TO B CPB D5 BUFFER - IS BUFFER AVAILABLE? JMP INC5 NO - MUST WAIT UNTIL IT'S POSTED. * LDB EQT11,I BUFFER IS IN CORE CMA IF TO BE WRITTEN ON AND WRBUF SET THE PROPER FLAG SSB SKIP IF READ ACCESS STA WRBUF JMP OKRET GO EXIT WE ARE READY NOW * * * * THE FOLLOWING GRABS UP AN AVAILABLE BUFFER AND * CHECKS IF IT NEEDS TO BE WRITTEi•þúN OUT. * INC4 STB SAVE1 LDB PKBUF CLA,INA OK4 STA SAVE FIND LEAST RECENTLY USED BUFFR. LDA B,I ARE WE AT THE END OF SSA THE BUFFERS? JMP OK2 YES. PICK LEAST RECENTLY USED. * CPA D5 IS THE BUFFER AVAILABLE? JMP OK1 NO. * CMA,INA YES. KEEP LOOKING THROUGH. ADA SAVE1,I CHECK AGE AGAINST CURRENT SSA,RSS IS THIS BUFFER A POSSIBLE? JMP OK3 NO. AGE IT. * STB SAVE1 YES. SAVE THIS BUFFER'S ADDRESS. LDA SAVE SAVE BUFFER POSITION. STA FLU AND WRITE FLAG LOCATION JMP OK3 * OK2 LDB SAVE1 DID WE FIND A BUFFER? SZB,RSS JMP INC5 NO - WAIT FOR TIME OUT * LDA D5 YES - MARK BUFFER AS UNAVAILABLE. STA B,I STB EQT23,I SAVE CURRENT SMD BUFFER ADDRESS. LDA FLU GET THE BUFFER # BIT AND WRBUF ISOLATE MUST BE WRITTEN FLAG CMA,CLE,INA SET E IF MUST BE WRITTEN LDA WRBUF GET THE MUST WRITE FLAG WORD IOR FLU SET THE NO WRITE FLAG LDB EQT11,I READ OR WRITE? SSB SKIP IF READ ELSE XOR FLU CLEAR TO INDICATE MUST WRITE STA WRBUF PUT THE FLAG WORD BACK SEZ,RSS MUST WE WRITE THIS ONE OUT FIRST? JMP OKOUT NO. BYPASS THIS STUFF. * JSB SXSIO WRITE OUT THE BUFFER. JMP NOK NO AVAILABLE $XSIO CALL. * OKOUT LDB EQT23,I MARK BUFFER WITH NEW INFO. INB LDA EQT27,I PUT AND B77 LU STA B,I INB TRACK LDA EQT18,I STA B,I INB LDA EQT21,I AND SECTOR STA B,I IN BUFFER HEAD SEZ IF MUST WRITE THEN JSB IOCAL,I DO IT NOW LDA EQT11,I READ OR WRITE REQUEST? LDB EQT19,I IF READ OR WRITE FROM CPB DM128 OTHER THAN BEGINING OFBLOCK SSA,RSS THEN MUST READ CLùNLHE,RSS MUST READ JMP OKRET NEED NOT READ GO EXIT * JSB SXSIO READ IN THE DESIRED SECTOR. JMP OK5 * JSB IOCAL,I DO THE READ OKRET CLA,INA SET AGE BACK ON BUFFER LDB EQT23,I THAT IS BEING USED. STA B,I JMP INCOR,I * NOK LDA FLU COULD NOT WRITE OUT A SELECTED BUFFER CMA SET AND WRBUF THE MUST BE WRITTEN FLAG JMP OK8 GO FREE THE BUFFER AND WAIT * OK3 LDA B,I IF AGE # 4 CPA D4 RSS ISZ B,I BUMP IT THEN OK1 ADB D132 INDEX TO THE NEXT BUFFER LDA B,I IS THER ONE?? SSA WELL? JMP OK2 NO GO SEE IF ONE WAS FOUND * LDA SAVE YES MOVE RAL THE FLAG AROUND JMP OK4 AND GO TEST THIS ONE * OK5 LDB EQT23,I NO XSIO CALL AVAILABLE INB FOR READ CLA CLEAR THE LU STA B,I AND MUST WRITE FLAGS LDA FLU AND IOR WRBUF OK8 STA WRBUF LDA D4 SET THE FREE FLAG LDB EQT23,I IN THE BUFFER €cNÿÿþú STA B,I AND THEN INC5 LDA EQT11,I SET UP TO TIME OUT IOR B2000 SET RETURN VECTOR STA EQT11,I (RETURNS TO INC0) JMP NTRDY GO TAKE WAIT EXIT * B2000 OCT 2000 HED SPOOL MONITOR DRIVER XSIO CALLS AND SETUP ROUTINES * * THE FOLLOWING SUBROUTINE SETS UP ONE OF THE * CALLS TO $XSIO. SXSIO USES INFORMATION FROM THE * CURRENT PACKING BUFFER. * * CALLING SEQUENCE: * E=0 FOR READ, E=1 FOR WRITE * JSB SXSIO * RETURN NO AVAILABLE CALL * RETURN+1 CALL READY AND SET UP - E=1. * * SXSIO NOP CLA,SEZ,INA INA STA DFUNC SET UP FUNCTION BITS. LDA AVXSI IS THERE AN AVAILABLE $XSIO CALL? SZA,RSS JMP SXSIO,I NO - GO AWAY. * LDB XSI1 CLE,SLA,RSS GET AN AVAILABLE CALLING SEQUENCE. LDB XSI2 STB IOCAL CLE,SLA,RSS BIT 0= CALL ONE, BIT 1= CALL TWO CLA,RSS IF USING CALL TWO THEN BOTH IN USE RAR,ELA USING CALL ONE CLEAR BIT 0 STA AVXSI RESET AVAILABLE-CALL SWITCH. ADB DOFF ADD THE OFFSET TO CALL PRAMS AREA LDA EQT23,I INA STA BUFR LDA A,I STA B,I PUT LU # IN CALLING SEQUENCE. ADB D3 LDA DFUNC STA B,I CCE,INB LDA B,I GET ADDRESS OF DISK CONTROL WDS. LDB BUFR ADB D3 STB A,I STORE BUFFER ADDRESS. ADA D2 STA BUFR ADB N1 LDA B,I GET SECTOR # AND STA BUFR,I PUT IT INTO QUADRUPLET. ADB N1 LDA B,I GET TRACK #. AND B377 IS IT LARGER THAN CPA B,I 256? ALF,SLA,ALF NO ROTATE AND SKIP JMP SXSI1 YES. * RAR FINISH THE ROTATE XOR BUFR,I NO - PUT TRACK AND STA BUFR,I #'S TOGETHER IN ONE CLA,RSS WORD. SXSI2 LDA B,I ISZ BUFR STA BUFR,I PUT IT INTO QUADRUPLET. ISZ SXSIO CCE SET E ~þúFOR RETURN JMP SXSIO,I * SXSI1 LDA BUFR,I MAKE A QUADRUPLE INSTEAD OF A TRIPLE. ELA,RAR SEPARATE TRACK AND STA BUFR,I SECTOR. JMP SXSI2 * DOFF ABS XSI12-XSIO1 OFFSET TO LU WORD OF XSIO CALL BUFR NOP DFUNC NOP XSI1 DEF XSIO1 XSI2 DEF XSIO2 AVXSI OCT 3 EQSV1 NOP EQSV2 NOP * COMP1 LDA EQSV1 HERE ON COMPLETION OF CALL 1 ISZ AVXSI SET CALL AVAILABLE AGAIN JSB SIOEX GO TO COMMON EXIT * XSIO1 NOP MUST FOLLOW (PASSES THE RETURN ADDRESS) LDA EQT1 SAVE THE CURRENT STA EQSV1 EQT ADDRESSBE CHANGED TO COMPENSATE. JSB $RSM IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI12 NOP LOGICAL UNIT #. DEF COMP1 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO.,REQUEST CODE. DEF DSCC1 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV1 RESTORE THE EQT ADDRESSES EXSIO JSB $ETEQ AND THEN JMP WTOUT GO AWAY FOR A WHILE. * SIOEX NOP COMMON XSIO COMPLETION ROUTINE JSB $ETEQ RESTOR THE EQT ADDRESSES CPB D128 TRANMISSION ERROR?? RSS NO ALL OK JSB EOFLG YES SET EOF FLAGS JSB EXEQT SET THE REST OF THE EQT UP(GET WTMAP TO A) CMA,SSA,SLA,RSS USER REQUEST ? RSS NO JSB $DRVM IN RTE IV, SET UP USER MAP. LDB SIOEX,I GET THE RETURN ADDRESS JMP B,I AND RETURN * DSCC1 NOP BUFFER ADDRESS. D128 DEC 128 LENGTH OF BUFFER. NOP SECTOR. NOP TRACK. DEC 0 TERMINATES THE QUADRUPLET. * COMP2 LDA EQSV2 GET THE EQT ADDRESS ISZ AVXSI SET CALL 2 ISZ AVXSI AVAILABLE JSB SIOEX CALL THE COMMON EXIT * XSIO2 NOP LDA EQT1 SAVE THE STA EQSV2 EQT ADDRESS JSB $RSM þú IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI22 NOP LOGICAL UNIT #. DEF COMP2 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO., REQUEST CODE. DEF DSCC2 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV2 JMP EXSIO GO SET EQT AND EXIT * TST1 EQU XSI12-XSIO1-XSI22+XSIO2 MUST BE EXACTLY ZERO TST2 EQU -TST1 OR CALL OFFSETS ARE NOT EQUAL * DSCC2 NOP BUFFER ADDRESS DEC 128 LENGTH NOP SECTOR. NOP TRACK. DEC 0 TERMINATES QUADRUPLET. * * THE FOLLOWING ROUTINE SETS UP POINTERS TO THE EQT EXTENSION. * IN ADDITION, IT DETERMINES WHETHER THE I/O REQUEST IS SET UP * VIA THE USER MAP OR IF IT WAS BUFFERED AND THUS SET UP VIA * THE SYSTEM MAP. IT SETS UP THE MSB AND LSB BITS OF 'WTMAP' * AS A FLAG. LATER READ AND WRITE ROUTINES CHECK THIS TO SEE * WHETHER TO DO CROSS MAP OR SAME MAP READS AND WRITES. * * ON RETURN A = WTMAP * EXEQT NOP LDA EQT13,I LDB N18 STB SAVE LDB ADR16 STA B,I INA INB ISZ SAVE JMP *-4 * LDB EQT1,I GET OUR LINK WORD RBL,CLE,SLB,ERB CLEAR SIGN BIT TO BE SAFE JMP EXEXE EXIT IF A CLEAR REQUEST * INB GET TO THE T-FIELD LDA B,I AND PULL IT IN RAL SET T-FIELD INTO MSB & LSB INB SEE IF BUFFER HAS BEEN MOVED (VIA REIO ?) LDB B,I PULL IN MOVED TO SAM WORD SSB HAS IT BEEN MOVED ? EXEXE CCA YES, SO SET A FLAG STMAP STA WTMAP FOR ALL DATA MOVES JMP EXEQT,I RETURN TO THE CALLER * WTMAP NOP * * *THE LIST SUBROUTINE CALL $LIST IN THE RTE OPERATING SYSTEM *TO SCHEDULE EXTND. THE VERY FIRST SCHEDULE IS BY PROGRAM *NAME, THERE AFTER ALL SCHEDULES ARE BY ID ADDRESS. * * LIST NOP U_þú IOR EQT11,I SAVE THE RETURN VECTOR STA EQT11,I JSB $LIST CALL LIST PROCESSOR CALL OCT 701 BY NAME 1ST TIME DEF *+5 NAME DEF PNAME DEF PRM1 DEF PRM2 DEF PRM3 * SZA WAS IT SUCCESSFUL ? JMP NTRDY NO, SO TRY LATER CLA,INA YES, SO SET UP CALL BY ID ADDR STA CALL STB NAME B = ID ADDR FROM $LIST JMP LIST,I * * PNAME ASC 3,EXTND PRM1 NOP PRM2 NOP PRM3 NOP * * * * HED SPOOL MONITOR DRIVER WRITE ROUTINES ADR16 DEF EQT16 N18 DEC -18 * * COME HERE FOR WRITE EOF REQUEST * WREOF ISZ EQT11,I SET EOF TO BE DONE FLAG * * HERE FOR WRITE REQUEST * WR LDA EQT11,I IF FILE IS READ-ONLY, ALF,ALF REJECT CALL. SSA JMP EOFRT * AND B40 ALREADY SENT AN EOF INB SET B FOR POSSIBLE ERROR SZA ON THIS FILE? JMP EOFRT * JSB GETRD GET READY TO WRITE THE RECORD LDA EQT11,I ARE LENGTHS TO BE WRITTEN? SLA IF JUST A WRITE EOF JMP WR1 GO WRITE IT * AND B20 ISOLATE THE STD. FILE BIT LDB EQT8,I GET LENGTH SZA IF STANDARD JMP STDFL SKIP THIS NONSENSE * ADB D2 BUMP BY TWO STB EQT8,I SAVE FOR THE SOUTH END OF STB SAVE,I THE RECORD AND SET IN FILE JSB PUSH PUSH THE RECORD POINTERS LDA EQT6,I GET THE CON WORD STA SAVE,I AND SET IT JSB PUSH PUSH THE RECORD POINTERS LDB EQT10,I GET THE LENGTH LDA EQT6,I IS CONTROL REQUEST? SLA NO SKIP LDB EQT7,I YES SET CONTROL EXTRA WORD STDFL STB SAVE,I IN TO THE BUFFER IT GOES JSB PUSH PUSH THE BUFFER POINTERS ISZ EQT22,I DONE?? JMP WR0 NO GO GET NEXT WORD * LDA EQT8,I END OF RECORD - WRITE LENGTH. STA SAVE,I JSB PUSH WR1 CCA ‘Rþú WRITE AN EOF AFTER STA SAVE,I LAST LINE. LDA EQT11,I IF THIS WAS A EOF ONLY SLA THEN WR2 JSB EOFLG SET THE EOF FLAGS * NORML ISZ EQT31,I INCREMENT RECORD COUNT. LDB EQT8,I LDA EQT11,I RAR,RAR SLA MAKE SURE LENGTH IS CORRECTLY BLS RETURNED. JMP POST1 * WR0 LDB EQT7,I MOVE USER'S WORD TO SMD BUFFER. ISZ EQT7,I LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WELL, WHICH MAP ? JMP SMAP2 SYS MAP * XLB B,I GET THE DATA JMP STDFL AND GO WRITE IT * SMAP2 LDB B,I JMP STDFL GO WRITE IT * B20 OCT 20 B7000 OCT 7000 HED SPOOL MONITOR DRIVER COMPLETION SECTION CS43 NOP JSB EXEQT LDA EQT11,I AND B7000 ISOLATE THE RETURN VECTOR STA B STASH IT IN B XOR EQT11,I CLEAR IT IN EQT 11 STA EQT11,I AND RESET IT ASR 9 PUT VECTOR IN LOW B LDA EQT4,I WHERE DID WE COME FROM? ALF RAL,CLE,SLA,ERA JMP TMOUT TIME OUT INTERRUPT. * LDA EQT1,I CHECK IF PROCESSING A SYSTEM CLEAR SSA IF SO THEN CLB SET UP TO FOURCE A COMPLETION RETURN LDA EQT21,I RETURN FROM EXTND. ADB XTAB INDEX INTO TRANSFER TABLE JMP B,I RETURN TO CALLING FUNCTION * * XTAB DEF *+1,I EXTEND RETURN TRANSFER TABLE DEF CS43,I 0 INITIALIZE DEF CS43,I 1 SHOULD NEVER HAPPEN DEF CS43,I 2 SHOULD NEVER HAPPEN DEF RLP1 3 CHECK AND RETURN TO READ DEF BS10 4 CONTINUE BACKSPACE DEF RW2 5 CONTINUE RWIND. * RLP1 CPA N1 EXTEND ERROR? CCB,RSS YES - FAKE EOF. JMP XCOR NO - NORMAL CONTINUE. * LDA EQT17,I RESTORE THE ORGIONAL ASL 8 FILE POSITION STB EQT19,I ALF,ALF STA EQT21,I LDA EQT16,I STA EQSÖþúT18,I LDB EQT6,I GET THE REQUEST CODE RBR,SLB IF WRITE OR CONTROL CLB,RSS SKIP JMP ERN5 READ SEND ERROR -5 * STB EQT8,I SET LENGTH TO ZERO JSB GETRD SET TO WRITE LDA N2 SET A -2 EOF MARK STA SAVE,I IN THE FILE JMP WR2 GO COMPLETE IT * * N2 DEC -2 * * TMOUT ALF,ALF ALF STA EQT4,I RESTORE EQT4 WITH TIME OUT BIT CLEARED ADB XTTAB INDEX INTO TIME OUT TRANSFER TABLE JMP B,I AND DISPATCH THE TIME OUT * * XTTAB DEF *+1,I TIME OUT VECTOR TABLE DEF POST 0 POST WAIT FOR XSIO CALL DEF CSPT 1 WAKE UP SPOUT RETURN DEF INC0 2 INCOR ROUTINE WAIT DEF RDEXT 3 READ EXTENT DEF BS13 4 BACKSPACE PROCESSOR DEF RWIND 5 REWIND * * * * BUFFERS FOR PACKING. * * NOTE: THE BUFFER PUSHING ALGORITHMS WILL * HANDLE A LARGER NUMBER OF BUFFERS. * BUFS OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT # OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTR #. BSS 128 BUFFER AREA DEC -1 MARKS END OF BUFFERS. A EQU 0 B EQU 1 END IS43 cì*($$*ÿÿ ÿýÙó ÿ92067-18031 1805 S C0122 &EXTD4 RTE-IV EXTND             H0101 dpþúASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE IV *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II HED EXTND ROUTINE * NAME: EXTND * SOURCE: 92067-18031 * RELOC: 92067-16028 * PGMR: A.M.G. * RTE 4: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EXTND,17,10 92067-16028 REV.1805 771115 * SUP EXT SP.CL * EXT EXEC,RMPAR,$LIBR,$LIBX EXT $PVCN,$CIC,$YCIC * FUNC BSS 1 EQTAD BSS 1 ETYPE BSS 5 * EXTND JSB RMPAR DEF *+2 DEF FUNC LDA FUNC SZA INITIALIZE CALL FROM GASP? JMP EXTN2 NO. * TERM JSB EXEC TERMINATE EXECUTION. DEF *+2 DEF D6 * EXTN2 SSA JMP EXTN3 MUST CALL UP SPOUT. * * GET A FILE EXTENSION * LDA EQTAD GET EQT ADDRESS AND ADA D12 INDEX TO EQT EXTENSION. LDA 0,I ADA D4 GET CURRENT EXTENSION # (EQT20) LDB 0,I AND INCREMENT IT. INB STB TEMP6 ADA D7 PICK UP DIRECTORY ADDRESS STA DIRCT OF MASTER ENTRY. INA (EQT27 AND EQT28) STA DIRCT+1 CCA IS NEW EXTENT NUMBER CPB D256 GREATER THAN 256? JMP EXTN4 YES - TAKE ERROR PATH. JSB EXEC CALL D.RTR TO GET DEF *+8 AN EXTENSION. DEF D23 DEF FMDR DEF 1717B DEF TEMP6 DIRCT BSS 2 DEF ETYPE JSB RMPAR GET PARAMETERS BACK DEF *+2 FROM D.RTR. DEF TEMP1 LDA TEMP1 EXTN4 JSB $LIBR NOP LDB DIRCT ADB M6 SSA,RSS ER  RORS? JMP OK NO. CCA YES - PUT NEGATIVE # IN EQT21. STA 1,I JMP EXTNO GET OUT OF HERE. OK LDA TEMP5 PUT BEGINNING SECTOR AND B377 IN EQT21. STA 1,I ADB D4 ALSO IN EQT25. STA 1,I ADB M1 PUT BEGINNING TRACK # LDA TEMP4 IN EQT24. STA 1,I ADB M6 ALSO IN EQT18. STA 1,I INB INB LDA TEMP6 SAVE NEW STA 1,I EXTENSION # (EQT20). * * SET UP TO INTERRUPT DVS43. * EXTNO LDA RETPT SAVE RETURN POINT. STA $CIC CLA STA $PVCN CLEAR PRIVILEGED COUNTER. LDB EQTAD INDEX THROUGH EQT TO THE ADB D3 SELECT CODE AND LOAD IT. LDA 1,I AND B77 FAKE THE INTERRUPT TO THE SJP $YCIC DRIVER TO TELL IT WE ARE RETPT DEF TERM DONE. * EXTN3 JSB EXEC HAVE A REQUEST FROM SMD DEF *+8 TO CALL SPOUT BACK AND DEF D18 PASS IT THE SAVE CLASS DEF ZERO PARAMETERS. DEF ZERO DEF ZERO DEF EQTAD CLASS PARAMETERS PASSED DEF ETYPE FROM SPOUT TO SMD EQT. DEF SP.CL SPOUT CLASS ID. JMP TERM RETURN. * * STORAGE * XEQT EQU 1720B D6 DEC 6 TEMP1 EQU ETYPE TEMP2 EQU ETYPE+1 TEMP3 EQU ETYPE+2 TEMP4 EQU ETYPE+3 TEMP5 EQU ETYPE+4 TEMP6 EQU FUNC ZERO DEC 0 B77 OCT 77 B377 OCT 377 D3 DEC 3 D4 DEC 4 D7 DEC 7 D12 DEC 12 D18 DEC 18 D23 DEC 23 D256 DEC 256 M1 DEC -1 M4 DEC -4 M5 DEC -5 M6 DEC -6 FMDR ASC 3,D.RTR * END EXTND n ÿÿ ÿýÚá ÿ92067-18032 1805 S C0122 &SPCL4 RTE-IV SP. CL             H0101 [TASMB,R,L HED SUB-SYSTEM GLOBAL FOR SPOOL * NAME: SP.CL * SOURCE: 92067-18032 * RELOC: 92067-16028 * PGMR: A.M.G * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SP.CL,30 92067-16028 REV.1805 780317 * ENT SP.CL ENT SP.OK ENT .IS43 EXT IS43 * SP.CL DEC 0 SP.OK NOP .IS43 DEF IS43+0 FIX FOR RTE4(ALLOWS SMP TO BE RT PROG) * END SP.CL nµÿÿ ÿýÛá ÿ92067-18033 1940 S C0122 &AN4F0 RTE-IV 7900 GRANDFATHER ANSWER FILE             H0101 ÉÁþú&LISTF::-10 *LIST FILE ** ANSWER FILE &AN4F0 92067-18033 1940 RTE4/7900 790919 YES *ECHO ON 45 *EST. # TRKS IN OUTPUT FILE !SYSTM::-10 *SYSTEM FILE - STORED ON THE FIXED DISC 7900 *SYSTEM DISC TYPE 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 203,0 *SUBCHANNEL 0 203,0 *SUBCHANNEL 1 /E *TERMINATE SUBCHANNEL DEFINITION 1 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 48 *MEMORY SIZE !BOOT::-10 *BOOT FILE STORED ON THE FIXED DISC MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IV OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * REL,%DVR00::32767 *TTY PUNCH PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH C/U) REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DV’þúR REL,%DVR31::32767 *7900 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *RELOCATING LOADER REL,%4WHZT::32767 *WHZAT REL,%BMPG1::32767 *BATCH MONITOR REL,%BMPG2::32767 *BATCH MONITOR REL,%BMPG3::32767 *BATCH MONITOR REL,%RT4G1::32767 *GENERATOR REL,%RT4G2::32767 *GENERATOR REL,%4SWTH::32767 *SWITCH PROGRAM REL,%SAVE::32767 *SAVE PROGRAM REL,%RESTR::32767 *RESTORE PROGRAM REL,%COPY::32767 *DISC COPY PROGRAM REL,%VERFY::32767 *VERIFY PROGRAM * ********************** LIBRARIES * REL,%DBKLB::32767 *DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%RLIB1::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB2::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB3::32767 *RTE LIB3 RELOC. LIBRARY REL,%BMLIB::32767 *BATCH LIBRARY REL,%FF4.N::32767 *FORTRAN FORMATTER * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * D.RTR,1,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * ×2þú* ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 Z$DBL,RP,3 * 3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 * EMA MICROCODE - APPLICABLE * .EMIO,RP,105240 * ON 21MX E-SERIES ONLY * MMAP,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR31,D *EQT # 1 - 7900 M.H. DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,1 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,0 *LU # 10 - 7900 SUBCHANNEL 0 0 *LU # 11 - UNASSIGNED 0 *LU # 12 - UNASSIGNED 0 *LU # 13 - UNASSIGNED 0 *lpþúLU # 14 - UNASSIGNED 0 *LU # 15 - UNASSIGNED 0 *LU # 16 - UNASSIGNED 0 *LU # 17 - UNASSIGNED 0 *LU # 18 - UNASSIGNED 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 12,EQT,1 13,EQT,2 14,EQT,6 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOSURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,16 RT4GN,20 SAVE,16 RSTOR,16 COPY,16 VERFY,16 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENÒRT aBÿÿ ÿýÜ æ ÿ92067-18034 1940 S C0122 &AN4F5 RTE-IV 7905/6/20 GRANDFATHER ANSWER FILE             H0101 øóþú&LISTF::32767 *LIST FILE NAME ** ANSWER FILE &AN4F5 92067-18034 1940 RTE4/7905 790919 YES *ECHO ON 45 *EST. # TRKS IN OUTPUT FILE !SYSTM::32767 *SYSTEM FILE NAME 7905 *SYSTEM DISC TYPE: 7905/06/20 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 256,0,0,2,0,8 *SUBCHANNEL 0 203,132,0,2,0,5 *SUBCHANNEL 1 203,236,0,2,0,5 *SUBCHANNEL 2 138,340,0,2,0,4 *SUBCHANNEL 3 203,0,2,1,0,5 *SUBCHANNEL 4 198,208,2,1,0,5 *SUBCHANNEL 5 400,0,3,1,0,11 *SUBCHANNEL 6 400,0,4,1,0,11 *SUBCHANNEL 7 1024,411,0,5,0,26 *SUBCHANNEL 8 985,621,0,5,0,25 *SUBCHANNEL 9 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 48 *MEMORY SIZE !BOOT::32767 *BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IV OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * íþú *********************** DRIVERS * REL,%DVR00::32767 *TTY PUNCH PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH C/U) REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR32::32767 *7905/06/20 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *RELOCATING LOADER REL,%4WHZT::32767 *WHZAT REL,%BMPG1::32767 *BATCH MONITOR REL,%BMPG2::32767 *BATCH MONITOR REL,%BMPG3::32767 *BATCH MONITOR REL,%RT4G1::32767 *GENERATOR REL,%RT4G2::32767 *GENERATOR REL,%4SWTH::32767 *SWITCH PROGRAM REL,%SAVE::32767 *SAVE PROGRAM REL,%RESTR::32767 *RESTORE PROGRAM REL,%COPY::32767 *DISC COPY PROGRAM REL,%VERFY::32767 *VERIFY PROGRAM * ********************** LIBRARIES * REL,%DBKLB::32767 *DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%RLIB1::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB2::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB3::32767 *RTE LIB3 RELOC. LIBRARY REL,%BMLIB::32767 *BATCH LIBRARY REL,%FF4.N::32767 *FORTRAN FORMATTER * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CON#¤þúSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * D.RTR,1,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 Z$DBL,RP,3 *3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 * ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR32,D *EQT # 1 - 7905/06/20 M.H. DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 Bþú *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7905/06/20 SUBCHANNEL 1 1,2 *LU # 11 - 7905/06/20 SUBCHANNEL 2 1,3 *LU # 12 - 7905/06/20 SUBCHANNEL 3 1,4 *LU # 13 - 7905/06/20 SUBCHANNEL 4 1,5 *LU # 14 - 7905/05/20 SUBCHANNEL 5 1,6 *LU # 15 - 7906/20 SUBCHANNEL 6 1,7 *LU # 16 - 7920 SUBCHANNEL 7 1,8 *LU # 17 - 7920 SUBCHANNEL 8 1,9 *LU # 18 - 7920 SUBCHANNEL 9 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,EQT,6 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOSURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTIaÝTIONS * 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,16 RT4GN,20 SAVE,16 RSTOR,16 COPY,16 VERFY,16 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT êÿÿ ÿýÝ ç ÿ92067-18035 2013 S C0122 &$YSLB              H0101 Œ^ASMB,L * NAME: $YSLB * SOURCE: 92067-18035 * RELOC: 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $YSLB 92067-16035 REV.2013 800211 END 6Iÿÿ ÿýÞä ÿ92067-18036 1805 S C0122 &ALRN4 RTE-IV $ALRN              H0101 VIþúASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: $ALRN * SOURCE: 92067-18036 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALRN,6 92067-16035 REV.1805 770715 * EXT $RNTB,$ERAB,$LIST,$XEQ ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD SUP A EQU 0 B EQU 1 * * $ALRN THIS ROUTINE ALLOCATES AN RN IF POSSIBLE * TO THE USER WHOSE ID SEGMENT ADDRESS IS * AT XEQT. * * OPTIONS/CALLING SEQUENCE: * * < IDNO MUST BE USER ID SEG # OR 377 IF GLOBAL * LDB =B1 TO ALLOCATE FROM BOTTOM OF THE RN TABLE * LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE * * JSB $ALRN * * < RETURN A=RN WORD (USER FORMAT) IF SUCESSFUL * A=0 IF NO RN'S AVAILABLE NOW * RQP6 IS SET TO RN ADDRESS IN RN TABLE * * * * $ALRN NOP STB TEMP4 SAVE THE INCREMENT XLA $RNTB GET THE LENGTH OF THE RN TABLE STA TEMP1 SAVE LENGTH OF THE RN TABLE CMA,INA SET NEGATIVE. * STA TEMP2 SET THE COUNT LDA D$RN GET THE RN TABLE ADDRESS SSB,RSS IF BOTTOM UP INA,RSS SET TO FIRST WORD ADA TEMP1 ELSE SET TO LAST WORD * ALRN1 XLB A,I SEARCH FOR SZB,RSS AN AVAILABLE JMP ALRN2 SLOT. FOUND * ADA TEMP4 STEP THE ADDRESS ISZ TEMP2 SKIP IF END JMP ALRN1 ELSE TRY NEXT ONE * CLA NO RN'S AVAILABLE NOW &—þú JMP $ALRN,I SO EXIT WITH A=0 * ALRN2 STA RNADR SAVE LOCATION CMA,INA SET TO CACULATE RN NUMBER * LDB IDNO GET THE USER ID NUMBER BLF,BLF ROTATE TO HIGH HALF XSB RNADR,I SET THE ASSIGNMENT IN THE TABLE ADA D$RN COMPUTE RN NUMBER CMA,INA SET POSTIVE ADA B ADD THE USER ID FLAG JMP $ALRN,I RETURN * * $RNSU LDB RQOP GET NO-WAIT OPTION FLAG SSB IF NO WAIT JMP EXRNW THEN EXIT * $LUSU XSA XTEMP,I SET THE SUSPEND FLAG JSB $LIST AND PUT THE PROG IN LIST OCT 503 NUMBER 3. JMP $XEQ GO THE THE DISPATCHER * EXRNW LDB D5 ENTRY FOR 6/7 RETURN $RNEX LDA RNADR TEST THE RN LOCATION ADDRESS CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP LDB D4 NO RN STATUS XLA RNADR,I GET THE RN SEZ,SZA,RSS SKIP IF ALLOCATE PROBLEMS CLB ELSE SET DEALLOCATED FLAG IF RN IS ZERO AND B377 MASK TO LOCK BITS SZA IF LOCKED INB STEP B TO SO INDICATE CPA B377 IF GLOBAL INB STEP AGAIN STB RQST,I SET THE STATUS WORD $LUEX LDB XEQT SET THE RN BIT IN HIS ADB D20 ID-SEGMENT XLA B,I IOR B400 XSA B,I LDA RQRTN PUSH UP HIS XSA XSUSP,I RETURN ADDRESS JMP $XEQ ** GO TO THE DISPATCHER ** * * * $DRAD NOP ADDR IS GIVEN IN A RSS GET DIRECT ADDRESS LDA A,I IF NOT ALREADY RAL,CLE,SLA,ERA JMP *-2 JMP $DRAD,I RETURN DIRECT ADDR IN A D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR * * D5 DEC 5 D4 DEC 4 D20 DEC 20 B377 OCT 377 B400 OCT 400 TEMP1 NOP TEMP2 NOP TEMP4 NOP * RQOP EQU 1701B RQP2 IS RN/LU REQUEST CODE RQNO EQU 1702B RQP3 IS ADDR OF RN/LU NUMBER RQST EQU 1703B RQP4 IS ADDR OF RN/LU STATUS—' IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS ADDR OF RN IN RN TABLE RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B * ORG * PROGRAM LENGTH END Bùÿÿ ÿýßç ÿ92067-18037 1805 S C0122 &RNRQ4 RTE-IV RNRQ              H0101 bfþúASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: RNRQ * SOURCE: 92067-18037 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RNRQ,6 92067-16035 REV.1805 780222 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$DRAD EXT $ALRN,$LIBR,$PVCN,$RNSU,$RNEX ENT RNRQ * SUP A EQU 0 B EQU 1 * * * * RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER * CALLS THAT CAN ALLOCATE, DEALLOCATE * SET AND CLEAR THE RN. IF A RN REQUEST CAN NOT * BE GRANTED BECAUSE OF NONE AVAILABLE OR * CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS * SUSPENDED UNTIL THE RN BECOMES AVAILABLE * * THE EXEC CALL IS: * * EXT RNRQ * * JSB RNRQ * DEF *+4 * DEF OPTION OPTION ADDRESS * DEF RN RN NUMBER ADDRESS/RETURN * DEF STAT RN STATUS RETURN ADDRESS * * * WHERE: * OPTIN BSS 1 OPTION WORD * RN BSS 1 RN WORD * STAT BSS 1 RN STATUS * * THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE * REQUEST AS FOLLOWS: * * BIT MEANING IF SET * BIT 0 SET THE RN LOCALLY * BIT 1 SET THE RN GLOBALLY * BIT 2 CLEAR THE RN * BIT 3 ALLOCATE AN RN LOCALLY * BIT 4 ALLOCATE AN RN GLOBALLY * BIT 5 DEALLOCATE THE RN * BIT 14 DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B * BIT 15 RETURN EVEN IF REQUEST NOT GRANTED * * A LOCALLY ALËþúLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR * A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER * GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY * ANY PROGRAM. * * IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING * PRESEDENCE IS FOLLOWED: * * 1) LOCAL ALLOCATE (SKIP 2 IF DONE) * 2) GLOBAL ALLOCATE * 3) DEALLOCATE * 4) LOCAL SET (SKIP 5 IF DONE) * 5) GLOBAL SET * 6) CLEAR * * THIS IMPLIES THAT RN MAY BE ALLOCATED,SET,AND CLEARED IN * THE SAME REQUEST. * A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. * THERE ARE TWO RN CODE WORDS: * A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER * REQUESTS). * B) THE RN TABLE CODE WORD. * * THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) * AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS * * THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER * IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF * THE WORD. * * GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 * AVAILABLE/UNLOCKED IS CODED AS 0. * * RN STATUS IS AS FOLLOWS: * * VALUE MEANING * 0 NORMAL DEALLOCATE RETURN * 1 RN IS CLEAR (UNLOCKED) * 2 RN IS LOCKED LOCALLY TO CALLER * 3 RN IS LOCKED GLOBALLY * 4 NO RN AVAILABLE NOW * 5 NOT DEFINED * 6 RN IS LOCKED LOCALLY TO OTHER PROGRAM * 7 RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE. * * STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED * AND THE NO WAIT BIT WAS SET * * POSSIBLE ERRORS FROM THIS CODE ARE: * * ERROR MEANING * * RN00 NO BITS SET IN THE OPTION WORD. * RN01 NO RN'S IN THE SYSTEM (EVER). * RN02 ILLEGAL RN NUMBER. * RN03 RELEASE OR UNLOCK OF UNOWNED RN. * RN REQUEST PROCESSOR * œõþú SKP RNRQ NOP ENTRY JSB $LIBR PRIVILEGED NOP CLA SINCE WE DON'T PLAN TO RETURN STA $PVCN VIA $LIBR, CLEAR CNTR * CCA ADA RNRQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA RNRQ,I SET RETURN ADDR JSB $DRAD WORRY ABOUT FTN CALLS STA RQRTN IN CASE OF ABORT * ISZ RNRQ LDB RNRQ,I LDA B,I GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E IN BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES,BUMP RETRN ADDR, NO-ABORT BIT SET * ABCAL ISZ RNRQ NO LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQNO ADDR OF RN NUMBER ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQST GET ADDR OF RETURN STATUS LDB RQRTN IF RETURN ADDR CMB,INB IS LESS THAN ADB RNRQ THIS NOW, SSB,RSS THEN JMP ERN02 ABORT WITH RN02 * LDB XEQT GET THE ID SEGMENT NUMBER JSB $IDNO TO B STB IDNO SAVE FOR EVERYBODY STB TEMP6 SAVE FOR ME LDA RQOP GET THE OPTION WORD AND B77 IF NO BITS SET THEN CLB SET B FOR ERROR EXIT SZA,RSS TAKE JMP ERN00 ERROR EXIT * AND B30 MASK TO THE ALLOCATE BITS SZA,RSS IF NO ALLOCATION REQUESTED JMP DAL GO TEST FOR DEALLOCATE * AND B10 LDB B377 SZA,RSS GLOBAL ALLOCATE? (BIT 4) STB IDNO YES, SET IDNO TO 377B CCB SET TO SCAN FROM TOP JSB $ALRN ALLOC AN RN AND SET RNADR STA RQNO,I SET IN THE USER AREA SZA SKIP IF ALLOCATION FAILED JMP DALX ELSE GO TEST DALLOCATION * rMþú LDA D$RN GET SUSPEND FLAG JMP $RNSU CHECK IF NEED TO SUSPEND * DAL LDA RQNO,I GET THE RN USER SUPLIED WORD AND B377 ISOLATE THE RN#. XLB $RNTB TEST THE RN CMB TO SEE IF IT IS IN THE ADB A TABLE. CLE,SZA IF ZERO OR SSB,RSS BIGGER THAN LEGAL JMP ERN02 GO BOOM! * ADA D$RN INDEX INTO THE RN TABLE STA RNADR SET THE RN ADDRESS XLA A,I GET THE RN ENTRY LDB RQNO,I IS IT OWNED XOR B AND C377 BY THE SAME USER HE THINKS? CLE,SZA JMP ERN03 NO TOO BAD ABOUT THAT! * DALX LDA RQOP TEST FOR AND B40 DEALLOCATE SZA,RSS BIT SET? JMP SET NO GO DO THE SET THING * LDA RQNO,I GET THE RN AND ALF,CLE,ALF MAKE SURE HE OWNS IT AND B377 OWNER ID# TO A CPA B377 IF GLOBAL RSS OR CPA TEMP6 HE IS OWNER CLA,RSS THEN SKIP THE JMP ERN03 BAD NEWS SEND 'RN03' (WATCH E) * XSA RNADR,I CLEAR THE RN ASSIGNMENT LDA D$RN RESCHEDULE JSB $SCD3 ALLOCATION WAITERS JMP CLRN2 GO DO CLEAR SCHEDULING * SET XLA RNADR,I GET THE RN AND B377 MASK TO CURRENT LOCK LDB RQOP GET THE FLAG WORD CCE,SLB,RSS IF LOCK ERB,SLB THEN JMP LOKRN GO DO LOCK * CLRN LDB RQOP CHECK FOR CLEAR RBR,RBR FLAG. IF NOT CLE,SLB,RSS SET JUST JMP EXRN EXIT * SZA IF NEVER LOCKED, THEN OK. CPA B377 IF GLOBALLY LOCKED RSS CPA TEMP6 OR LOCKED BY CALLER RSS THEN OK, ELSE JMP ERN03 SEND 'RN03' (WATCH E) * XLB RNADR,I CLEAR THE RN. XOR B XSA RNADR,I RESTORE THE WORD * CLRN2 JSB SRNW SCHEDULE THE WAITERS EXRN CLB,INB SET THE CLEAR FLAG JMP $RNEX ”kþúEXIT TO DISPATCHER PROPERLY * * LOCK RN ROUTINE * LOKRN LDB B377 GET GLOBAL FLAG SEZ IF LOCAL LDB TEMP6 REPLACE WITH LOCAL SZA IF NOT LOCKED CPA TEMP6 OR LOCKED TO CALLER CMA,INA,RSS THEN OK CONTINUE JMP LKSUS ELSE SUSPEND THIS GUY. * LOKIT ADA B SET LOCK FLAG LESS CURRENT ENTRY STB TEMP1 SAVE THE B REG XLB RNADR,I SET THE LOCK FLAG ADA B XSA RNADR,I IN THE RN TABLE LDA TEMP1 SET A=ID OF NEW LOCKER JMP CLRN GO TEST FOR CLEAR OPTION * LKSUS LDA RNADR GET THE SUSPEND FLAG JMP $RNSU AND GO SUSPEND SPC 2 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (RNADR) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA RNADR GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN * * ERN02 LDB D2 RN02 ERROR RSS ERN03 LDB D3 RN03 ERROR ERN00 LDA ASRN USE RN JMP $ERAB GO BOOM!#$#$%&'" * ASRN ASC 1,RN SKP * LU UNLOCK REQUEST * * D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR D2 DEC 2 D3 DEC 3 D7 DEC 7 B377 OCT 377 C377 OCT 177400 B77 OCT 77 B10 OCT 10 B30 OCT 30 B40 OCT 40 * TEMP1 NOP TEMP6 NOP * RQRTN EQU 1677B RETURN POINT ADDRESS IDNO EQU 1704B USERS ID SEG # RNADR EQU 1705B RN ADDR IN RN TABLE XEQT EQU 1717B ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU 1730B 'POINT OF SUSPENSION' * RQOP EQU 1701B RQP2 USED FOR RN OPTION NUMBER RQNO EQU 1702B RQP3 USED FOR ADDR OF RN NUMBER RQST EQU 1703B RQP4 USED FOR ADDR OF RN STATUS ORG * PROGRAM LENGTH END ï>$"$ÿÿ ÿýà ë ÿ92067-18038 1805 S C0122 &LURQ4 RTE-IV LURQ              H0101 dgþúASMB,R,L,C ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: LURQ * SOURCE: 92067-18038 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LURQ,6 92067-16035 REV.1805 771013 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$LUSU,$DRAD EXT $LUSW,$LIBR,$PVCN,$ALRN,$LUEX,$ULLU * ENT LURQ * SUP A EQU 0 B EQU 1 * * * * THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU * TO HIS PROGRAM EXCULSIVELY. ANY OTHER PROGRAM IS * PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER * A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O * ON A LOCKED LU (ASSUMING IT IS NOT LOCKED TO HIM) * * THE WAITING PROGRAM WILL BE RESTARTED WHEN THE * LU IS UNLOCKED. ALL LU'S LOCKED TO A PROGRAM WILL BE * UNLOCKED WHEN THE PROGRAM TERMINATES. LU'S MAY * ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING * CALL. * * CALL TO LOCK/UNLOCK AN LU * * EXT LURQ * * JSB LURQ * DEF *+4 * DEF IOPT ADDRESS OF OPTION FLAG WORD * DEF LUARY ADDRESS OF ARRAY OF LU'S * DEF NOLU ADDRESS OF NUMBER OF LU'S TO LOCK/UNLOCK * RETURN - - * . * . * . *LUARY DEC N1 ARRAY OF LU'S TO BE LOCKED * DEC N2 ONLY THE LEAST 6 BITS ARE USED. * . * . * . *IOPT DEC OPTION OPTIONS FOR THIS CALL SEE BELOW *NOLU DEC NO NUMBER OF LU'S IN THE ARRAY * * OPTIONS ARE: * IOPT MEANING * 0 UNLOCK SPECIFIED LU'S * 1000:þú00B UNLOCK ALL OWNED LOCKS * 1 LOCK WITH WAIT THE SPECIFIED LU'S * 100001B LOCK WITHOUT WAIT THE SPECIFIED LU'S. * * TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED * IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. * IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY * HAS ONE OR MORE LU'S LOCKED HE WILL BE ABORTED 'LU01' * * ON A NO WAIT RETURN THE A REGISTER INDICATES THE * STATUS AS FOLLOWS: * * A REGISTER MEANING * -1 NO RN AVAILABLE AT THIS TIME * 0 REQUEST SUCESSFUL * 1 ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO * ANOTHER PROGRAM * * POSSIBLE ABORT ERRORS ON THIS REQUEST ARE: * ERROR MEANING * LU01 HE HAS OTHERS LOCKED AND WAIT OPTION * LU02 ILLEGAL LU * LU03 NOT ENOUGH PRAMETERS * RN01 SYSTEM HAS NO RN'S * RN03 HE DOESN'T OWN THE LOCK HE IS TRYING TO RELEASE * * INTERNAL FUNCTION: * * THE USER IS ASSIGNED AN RN WHICH IS LOCKED TO HIM. * THE DRT ENTRY FOR EACH LOCKED LU CONTAINS A POINTER * TO THE RN USED TO DO THE LOCK. * * ALL A PROGRAMS LU LOCKS ARE CONNECTED WITH THE SAME RN * AND THE DRT FIELD IS 5 BITS WIDE, THUS A TOTAL * OF 31 (0 IS RESERVED FOR NO LOCK) PROGRAMS * MAY HAVE LU'S LOCKED AT THE SAME TIME. * THE DRT ENTRY IS IN BITS 6-10 OF THE DRT ENTRY. * SKP LURQ NOP JSB $LIBR PRIVILEGED ENTRY NOP CLA CLEAR CNTR SINCE WE DON'T STA $PVCN PLAN TO RETURN VIA $LIBX * CCA ADA LURQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA LURQ,I SET RETURN ADDR JSB $DRAD (WORRY ABOUT FTN CALLS.) STA RQRTN IN CASE OF ABORT * ISZ LURQ LDB LURQ,I LDA B,I GET OPTION WORD RAL,CLE,ELA BIT14 TO E RAR,RAR þú RESTORE OPTION, LESS NO-ABORT BIT. STA RQOP SAVE CALLER'S OPTIONS. * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E INTO BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES, BUMP RTRN ADDR, NO ABORT BIT SET * ABCAL ISZ LURQ NO LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQTB ADDR OF LU ARRAY STA RQP7 SAVE FOR FIRST LOOPS ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQSZ ADDR OF NUMBER OF LU'S LDA BIT15 CPA RQOP IF REQ IS RELEASE ALL JMP LUUL3 SKIP PARAMS CHECK * LDB RQRTN MAKE SURE THERE ARE CMB,INB ENOUGH PARAMETERS ADB LURQ ELSE SSB,RSS REJECT JMP ELU03 WITH LU03 ERROR * LDB XEQT HERE ON LU LOCK CALL JSB $IDNO GET THE USERS ID NUMBER STB IDNO SET FOR ALLOCATE, ECT BLF,BLF PUT USER OWN/LOCK ADB IDNO FLAG IN STB TEMP6 TEMP6 LDA RQSZ,I GET THE # OF LU'S CMA,INA,SZA IF NEG OR ZERO, SSA,RSS JMP ELU03 'LU03' ERROR * STA TEMP5 SET COUNTERS STA TEMP4 FOR THE TWO LOOPS LDA LUMAX GET THE DRT SIZE CMA SET NEG OF MAX LU STA TEMP3 STA TEMP9 SET FOR BOTH LOOPS LDA RQOP GET THE OPTION FLAG SLA,RSS IF THIS IS NOT LOCK REQ, JMP LUUL1 GO TO RELEASE CODE * * CHECK IF AN RN HAS ALREADY BEEN ASSIGNED * FOR THIS PROGRAMS LU LOCKS. * ISZ TEMP3 STEP LU COUNTER LDB DRT GET THE DRT ADDRESS LULK1 LDA B,I GET LU ENTRY AND B3700 MASK TO LU LOCK FLAG STA RQP8 SAVE THE LOCK FLAG ALF,ALF ROTATE TO RAL,CLE,RAL LOW AND USE TO ADA D$RN INDEX INTO THE RN TABLE XLA A,I GET RN CZþúODE CPA TEMP6 IF OWNED AND LOCKED BY CALLER JMP LULK8 BY CALLER, JUMP * CCE,INB ELSE STEP DRT ISZ TEMP3 ADDRESS IF NOT END JMP LULK1 CONTINUE SEARCH * CLA CLEAR ALLOCATED FLAG STA RQP8 * LULK2 JSB SWITH SWITCH BATCH LU GET DRT ENTRY SZA IF AVAILABLE CONTINUE CPA RQP8 OR HIS ALREADY RSS ALL OK JMP LULK5 ELSE GO SUSPEND * ISZ TEMP4 STEP THE COUNT DONE?? JMP LULK2 NO TRY NEXT LU. * LDA RQP8 GET THE ALLOCATED FLAG SZA IF AN RN ALREADY ALLOCATED JMP LULK3 GO SET UP * * NO RN ASSIGNED SO ALLOCATE ONE * CLB,INB ASSIGN FROM LOW END OF TABLE JSB $ALRN AND B377 SET RN NUMBER IN A STA B AND B AND B37 IF RN>37B CPA B OR ZERO SZA,RSS THEN GO JMP LULK7 HANG HIM UP. * BLF,BLF MOVE NUMBER TO RBR,RBR BITS 6-10 STB RQP8 AND SET FOR LOCK LOOP LDB TEMP6 GET THE LOCAL LOCK FLAG XSB RNADR,I AND SET IN RN TABLE * LULK3 LDA RQTB RESET THE ARRAY ADDRESS STA RQP7 FOR SWITH LULK4 JSB SWITH GET THE DRT ADDRESS LDA B,I GET DRT ENTRY IOR RQP8 SET LOCK FLAG STA B,I RESET IN THE DRT ISZ TEMP5 IF NOT DONE JMP LULK4 DO THE NEXT ONE * LULKS CLA SET A TO SHOW LULKF XSA XA,I SUCESSFUL COMPLETION JMP $LUEX EXIT VIA LU-RN EXIT CODE * * * LOCKED TO SOME OTHER PROGRAM * LULK5 ALF,ALF IF LOCK IS TO CALLER RAL,RAL THEN ADA D$RN THE LOCK STA RNADR IS TO BE IGNORED CLA,INA SET FAILURE FLAG LULK6 LDB RQOP IF SUSPEND OPTION SSB SUSPEND OPTION? JMP LULKF YES, EXIT LDA RNADR NO, SUSPEND PROGRAM JMP $LUSU * * * rnþú ALLOCATION FAILED - * LULK7 CLB IF BECAUSE >32B SZA,RSS THEN JMP LULK9 XSB RNADR,I RELEASE THE RN LULK9 LDB D$RN SET SUSP FLAG STB RNADR IN RNADR AND CCA SET THE COMPLETION FLAG JMP LULK6 GO EXIT * * HE HAS AT LEAST ONE LU LOCKED ALREADY * TO PREVENT DEAD LOCK HE MUST NOT CODE * WAIT ON SUBSEQUENT CALLS * LULK8 LDA RQOP GET THE OPTION FLAG ERN01 CME,SSA AND THIS CALL WITH JMP LULK2 WAIT THEN * CLB,INB,RSS SEND 'LU01' ELU02 LDB D2 LU ERROR RSS ELU03 LDB D3 LU ERROR LDA ASLU LU ERROR JMP $ERAB GO BOOM!#$#$%&'" * ASLU ASC 1,LU * * * LUUL1 JSB SWITH DO BATCH SWITCH GET LOCK ECT. STA TEMP3 SAVE IN CASE FOUND ALF,ALF ROTATE TO RAL,RAL LOW A AND ADA D$RN USE TO INDEX THE RN TABLE STA RNADR SAVE THE ADDRESS XLA A,I GET THE FLAG CPA TEMP6 HIS? RSS YES SKIP ERROR EXIT JMP ELU03 NO- TOO BAD, YOU LOSE. * XLA B,I UNLOCK THE XOR TEMP3 LU XSA B,I ISZ TEMP4 DONE? JMP LUUL1 NO TRY NEXT ONE * LDA RNADR SCHEDULE ANY WAITING PROGRAMS JSB $SCD3 * ISZ TEMP9 TEST IF ANY LU'S LDB DRT STILL LOCKED LUUL2 LDA B,I BY CALLER AND B3700 IF SO CPA TEMP3 JUST JMP LULKS EXIT * INB STEP DRT ADDRESS ISZ TEMP9 AN COUNT / DONE? JMP LUUL2 NO TRY NEXT * CLA NO LU'S LOCKED XSA RNADR,I DEALLOCATE THE RN LDA D$RN SCHEDULE ANY ALLOCATION JSB $SCD3 WAITERS AND JMP LULKS EXIT * LUUL3 LDB XEQT RELEASE ALL JSB $ULLU LU'S LOCKED BY JMP LULKS CALLER AND RETURN * SWITH NOP DO BATCH SWITCH IF REQUIRED CCA GET THE ÅþúLU-1 ADA RQP7,I GET THE LU AND B77 ISOLATE IT STA RQP9 SAVE IN TEMP ISZ RQP7 STEP ADDRESS FOR NEXT TIME LDB XEQT GET THE BATCH FLAG ADB D20 XLB B,I TO B SSB,RSS IF NOT IN BATCH MODE JMP SWEX GO GET THE WORD FROM DRT. * LDB DLUSW GET ADDR OF THE LU SWITCH TABLE XLA B,I GET THE LENGTH CMA,INA SET NEGATIVE FOR COUNTER STA COUNT SET COUNTER * SWNXT INB START THE LOOP XLA B,I GET THE ENTRY AND B77 ISOLATE THIS ENTRY CPA RQP9 THIS IT?? JMP SWIT YES GO GET THE SWITCH * ISZ COUNT NO , END OF TABLE? JMP SWNXT NO TRY NEXT ONE * JMP SWEX YES USE THE GIVEN LU * SWIT XLA B,I GET THE SWITCH LU ALF,ALF TO LOW A AND B77 ISOLATE STA RQP9 SET IN THE TEMP * SWEX LDA RQP9 GET THE LU ADA TEMP9 TEST FOR LEGALITY INA ADJUST FOR -1 CONVENTION CCE,SSA,RSS SKIP IF OK JMP ELU02 ELSE BAIL OUT WITH DIAGNOSTIC * LDB RQP9 GET THE DRT ENTRY ADB DRT LDA B,I TO A AND B3700 ISOLATE IT JMP SWITH,I RETURN B= ADDRESS, A= ISOLATED LOCK FLAG * COUNT NOP D$RN DEF $RNTB+0 FORCE A DIRECT ADDRESS D2 DEC 2 D3 DEC 3 D7 DEC 7 D20 DEC 20 DLUSW DEF $LUSW+0 FORCE A DIRECT ADDRESS BIT15 OCT 100000 B377 OCT 377 B3700 OCT 3700 B77 OCT 77 B37 OCT 37 * TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP9 NOP * DRT EQU 1652B LUMAX EQU 1653B * RQOP EQU 1701B RQTB EQU 1702B RQSZ EQU 1703B IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS RN ADDR IN RN TABLE * RQRTN EQU 1677B RQP7 EQU 1706B RQP8 EQU 1707B RQP9 EQU 1710B XEQT EQU 1717B XSUSP EQU 1730B XA EQU 1731B ORG * PROGRAM LENGTH END È3*($$*ÿÿ ÿýá í ÿ92067-18039 1805 S C0122 &PRTN RTE-IV PRTN              H0101 jNþúASMB,L,C ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: PRTN * SOURCE: 92067-18039 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRTN,6 92067-16035 REV.1805 771005 ENT PRTM ENT PRTN EXT $LIBR,$LIBX SPC 2 * THIS ROUTINE IS USED TO PASS FIVE PARAMETERS TO THE PROGRAM * THAT SCHEDULED THE CALLER WITH WAIT. IT DOES NOT HONOR THE * NO PARAMETERS BIT. * * THE SCHEDULING PROGRAM MAY RECOVER THESE PARAMETERS WITH RMPAR. * * THE WAIT FLAG IS CLEARED SO THE CALLER SHOULD HAVE HIGHER * PRIORITY THAN THE SCHEDULER TO PREVENT A SWAP. * * CALLING SEQUENCE: * * JSB PRTN * DEF *+2 STANDARD FORTRAN SEQUENCE * DEF PRAM ADDRESS OF THE FIVE RETURN PRAMATERS * JSB EXEC PROGRAM SHOULD COMPLETE * DEF *+2 * DEF SIX SPC 3 PRTN NOP ENTRY POINT JSB $LIBR GO DO PRIVLEDGE THING COUNT NOP LDA PRTN GET THE ADDRESS OF THE CALL PRAMS LDB A,I GET RETURN ADDRESS STB RTN SAVE IT INA STEP TO PRAM ADDRESS LDA A,I GET PRAM ADDRESS RAL,CLE,SLA,ERA REMOVE POSSIBLE INDIRECT JMP *-2 IF INDIRECT TRY AGAIN STA PRTN SAVE THE PRAM ADDRESS LDA KEYWD GET HEAD OF THE KEY WORD LIST STA PRTM SAVE IT LOCALLY JMP NEXT1+1 GO SCAN THE LIST SPC 1 NEXT CLB,INB ADD ONE ADB A TO IT TO GET THE WAIT ID ADDRESS STB ID ALSO THEÄSþú PRAM SAVE ADDRESS SAVE IT XLB B,I GET THE WORD CPB XEQT THIS THE SCHEDULING PROGRAM? JMP FOUND LOOKS GOOD GO CHECK THE STATUS NEXT1 ISZ PRTM STEP KEYWORD ADDRESS XLA PRTM,I GET NEXT ENTRY SZA IF END OF LIST EXIT JMP NEXT NOT END TRY NEXT ID SPC 1 EXIT LDA OP1 RESET THE OPTION FOR PRTN ENTRY STA OPTIN JSB $LIBX EXIT TO THE SYSTEM EXIT ROUTINE DEF RTN RETURN ADDRESS SPC 1 RTN NOP ID NOP STAT NOP SPC 2 FOUND LDB D5 CACULATE LAST PRAM ADDRESS ADB A TO B STB LAST SAVE IT FOR TESTING ADB D10 CALCULATE THE STATUS ADDRESS STB STAT SAVE IT XLB B,I GET STATUS OF SCHEDULER BLF,SLB IS HE WAITING? OPTIN CCE,RSS (OR CLE,INA,RSS FOR PRTM) JMP NEXT1 NO TRY NEXT PGM ERB,CLE,ELB CLEAR WAIT BIT(SAVE E-REG.) BLF,BLF ROTATE B THE REST BLF OF THE WAY AROUND OVER SEZ,CLE,INA,RSS ADVANCE POINTER. JMP PRSPR XSB STAT,I SAVE STATUS WITHOUT WAIT BIT IF PRTN. PRSPR LDB PRTN,I GET FIRST PRAM XSB A,I SET PRAM ISZ PRTN STEP ADDRESS CPA LAST LAST PRAMETER? CLB,INB,RSS YES B_1 AND SKIP JMP OVER NO GO DO NEXT ONE ADA D5 YES SET TO B REG ADDRESS LDB ID GET ADDRESS OF PRAM AREA XSB A,I SET BREG SAVE TO POINT TO PRAMS JMP EXIT DONE RETURN TO PGM SPC 3 OP1 CCE,RSS INARS CLE,INA,RSS PRTM ENTRY A OPTION LAST NOP D5 OCT 5 D10 DEC 10 SPC 2 PRTM NOP OPTIONAL ENTRY FOR FOUR JSB $LIBR PRAMETER PASS WITH OUT CLEARING NOP THE WAIT BIT LDA INARS GET THE OPTIONAL INSTRUCTION STA OPTIN SET IT IN THE CODE LDA PRTM GET THE RETURN ADDRESS STA PRTN SET IT IN THE MAIN ENTRY POINT JMP COUNŒ1 T+1 GO TO MAIN LINE AND DO THE JOB SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END Áèÿÿ ÿýâê ÿ92067-18040 1805 S C0122 &EQLU RTE-IV EQLU              H0101 m)þúASMB,R,L,C ** EQLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -EQLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: EQLU * SOURCE: 92067-18040 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EQLU,6 92067-16035 REV.1805 770718 ENT EQLU EXT .ZPRV * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB EQLU -OR- JSB EQLU -OR- CALL EQLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP EQLU NOP ENTRY JSB .ZPRV DEF LIBX STB EQT4 SAVE B-REG FOR LATER TEST LDA EQLU,I GET ADRS OF RETURN ADDRESS ISZ EQLU BUMP TO POSSIBLE PRAM. LDB EQLU,I GET POSS. ADDRS OF PRAM. CPA EQLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STA EQLU SET RETURN POINT FOR $LIBX STB LUADR SET PASSED PRAM. ADDRESS CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCH¶  ANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER LIBX JMP EQLU,I RETURN A=BIN. VALUE, B= ASCII VALUE DEF EQLU SPC 1 EQT4 NOP LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END ? ÿÿ ÿýãê ÿ92067-18042 1926 S C0122 &REIO4 RTE-IV REIO             H0101 MSþúASMB,L,C,Q ** REIO ** * NAME: REIO * SOURCE: 92067-18042 * RELOC: PART OF 92067-16035 * PGMR: G.A.A.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM REIO,7 92067-16035 REV.1926 790506 EXT .DFER,$LIBR,$LIBX,EXEC,.ENTR ENT REIO SUP SPC 1 * THIS ROUTINE DOES REENTRENT I/O IF THE USERS BUFFER * IS 37 OR MORE WORDS ABOVE THE PROG LOAD POINT. * THIS RESTRICTION IS ENFORCED BECAUSE THE USERS BUFFER * IS USED AS A TDB FOR THE REENTRANT PROCESSOR AND THUS * THREE WORDS(PLUS 2 FOR SAVE X AND Y REG WORDS AND 32 FOR * THE USER MAP SAVE AREA) ARE REQUIRED ABOVE IT. * * NOTE: FOR MEMORY RESIDENT PROGRAMS, THE BUFFER MUST BE 5 * OR MORE WORDS ABOVE THE PROGRAM LOAD POINT. * * * THESE THREE WORDS ARE SAVED LOCALLY AND THE TDB IS SET UP. * AFTER THE I/O HAS COMPLETED THE WORDS ARE RESTORED. * * IF THE BUFFER IS TOO CLOSE TO THE LOAD POINT THE I/O IS * PERFORMED IN THE STANDARD MANNER. THIS IS ALSO TRUE IF THE * BUFFER IS MORE THAN 129 WORDS LONG (TO CONSERVE SYSTEM MEMORY). * * CALLING SEQUENCE: * * THE SAME AS THE EXEC I/O CALL WITH OUT THE TRACK/SECTOR WORDS. * RQ BSS 4 PRAMETER ADDRESS AREA REIO NOP ENTRY POINT JSB .ENTR FETCH THE PRAMETERS DEF RQ LDA RQ+3,I PULL PRAMETERS IN LOCALLY STA RQ+3 INCASE THEY ARE LDA RQ,I ARE IN THE THREE WORD STA RQ AREA AHEAD OF LDA RQ+1,I THE BUFFER STA RQ+1 * LDA XEQT GET THE PROGRAM LOAD ADA D22 POINT ÑåþúXLA A,I LDB RQ+2 AND THE BUFFER ADDRESS CMB,INB NOW MAKE SURE THAT THE BUFFER ADB A IS ABOVE THE LOAD POINT OF CLE,SSB,RSS PROGRAM. JMP DIRIO BUFFER BELOW PROG MUST BE IN COMMON ADB D4 BUFFER ABOVE LOAD POINT, BUT IS IT CLE,SSB,RSS WITHIN 5 WORDS ? JMP DIRIO YES, SO FORGET IT * * *1926DLS* FROM GLM FOR RTE-IVB * LDA XMATA FETCH ADDRESS OF CURRENT MAT ENTRY SZA,RSS IF THIS IS A MEMORY RESIDENT JMP OK PROGRAM IT'S OK TO DO REIO. * ADB D32 DISC RESIDENT, CHECK FOR MAP SAVE AREA CLE,SSB,RSS BUFFER MUST BE 37 WORDS ABOVE LOAD POINT. JMP DIRIO TOO BAD, THE BUFFER IS TOO CLOSE * * *1926DLS* END GLM CHANGES * * OK LDA RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE & SET STA TDBA UP THE $LIBR & STA TDBA2 $LIBX CALLS. * JSB .DFER ELSE SAVE THE THREE WORDS DEF S1 IN LOCAL SAVE AREA DEF TDBA,I LDB RQ+3 GET THE REQUEST LENGTH SSB,RSS IF POSITIVE SKIP CONVERSION JMP RE1 * BRS CONVERT CHARACTERS TO CMB,INB WORDS AND SET POSITIVE RE1 ADB D3 ADD THREE WORDS FOR TDB LENGTH STB A AND PUT IN A FOR LENGTH TEST ADA N133 SUBTRACT 133 (129 + 3 + 1) CLE,SSA,RSS IF POSITIVE OF ZERO JMP DIRIO DO IT DIRECT * CLA,CCE SET ZERO IN WORD ONE AND DST TDBA,I LENGTH IN WORD TWO OF THE TDB JSB DOIO GO DO THE I/O S1 OCT 0,0,0 RETURN SKIPS THREE WORDS DST RQ SAVE THE REGISTERS JSB .DFER RESTORE THE THREE WORDS DEF TDBA,I DEF S1 DLD RQ RESTORE THE A AND B REGS. JMP REIO,I AND EXIT TO USER. * DOIO NOP JSB $LIBR TELL THE SYSTEM WE ARE TDBA DEF * RENT DIRIO JSB EXEC DO THE I/O CALL Ûl DEF EX RETURN ADDRESS DEF RQ DEF RQ+1 DEF RQ+2,I DEF RQ+3 EX RSS SKIP IF ERROR EXIT ISZ REIO ELSE STEP RETURN ADDRESS SEZ,RSS IF DIRECT JMP REIO,I EXIT * JSB $LIBX ELSE EXIT RENT TDBA2 DEF * SECTION D3 DEC 3 +3 WORDS * D32 DEC 32 *1926DLS* FROM GLM N133 DEC -133 N3 DEC -3 N2 DEC -2 D22 DEC 22 D4 DEC 4 XMATA EQU 1646B XEQT EQU 1717B A EQU 0 ORG * END {Fÿÿ ÿýäì ÿ92067-18043 2013 S C0122 &IFBRK              H0101 }|þúASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: IFBRK * SOURCE: 92067-18043 * RELOC: 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFBRK,7 92067-16035 REV.2013 800211 * ENT IFBRK EXT $LIBR,$LIBX SPC 2 * CALLING SEQUENCE: * * IF(IFBRK(IDMY)) 10,20 * * WHERE: 10 BRANCH WILL BE TAKEN IF SET & WILL CLEAR IT. * 20 BRANCH WILL BE TAKEN IF NOT SET * * JSB IFBRK * DEF *+1 * A-REG. = -1 IF SET, ELSE A-REG = 0 * BREAK BIT WILL ALWAYS BE CLEARED IF SET! SPC 1 IFBRK NOP ENTRY FROM FTN LDA IFBRK,I GET P+1 ADDRESS STA IFBRK SET RETURN ADDRESS LDB XEQT GET IDSEG ADDRESS OF THIS PROG ADB D20 GET ID(21) ADDRESS XLA B,I GET CONTENTS AND BIT12 MASK DOWN TO BIT 12 SZA,RSS SET? JMP IFBRK,I NO, RETURN A=0 *2013 DLS* JSB $LIBR YES, THEN TURN *2013 DLS* NOP OFF INTERRUPTS *2013 DLS* XLA B,I AND THEN CLEAR *2013 DLS* XOR BIT12 BIT 12 OF *2013 DLS* XSA B,I WORD 21. *2013 DLS* CCA RETURN A-REG. = -1 JSB $LIBX DEF IFBRK * D20 DEC 20 BIT12 OCT 10000 XEQT EQU 1717B B EQU 1 END Ø  ÿÿ ÿýåì ÿ92067-18044 1805 S C0122 &CORA4 RTE-IV COR.A              H0101 b6ASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: COR.A * SOURCE: 92067-18044 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.A,6 92067-16035 REV.1805 770621 ENT COR.A EXT .ZPRV * * ROUTINE TO FIND THE ADDRESS OF THE FIRST WORD OF AVAIL MEM. * FOR A GIVEN ID SEGMENT * * CALLING SEQUENCE: * * LDA IDSEG GET ID SEGMENT ADDRESS TO A * JSB COR.A CALL THIS ROUTINE * RETURN A= FIRST WORD OF AVAIL MEM (MEM2 FROM ID) * COR.A NOP JSB .ZPRV DEF LIBX ADA .14 INDEX TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF ROTATE THE BLF,SLB SHORT ID FLAG TO LOW B AND TEST INA,RSS SHORT SO INDEX TO MEM ADA .8 LONG SO INDEX TO MEM INA INDEX TO MEM2 XLA A,I SET IT IN A LIBX JMP COR.A,I RETURN DEF COR.A * .14 DEC 14 .8 DEC 8 A EQU 0 END "ÿÿ ÿýæì ÿ92067-18045 1805 S C0122 &CORB4 RTE-IV COR.B              H0101 e6þúASMB,R,L,C ** COR.B ** HED COR.B ROUTINE * SOURCE: 92067-18045 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.B,6 92067-16035 REV.1805 770816 ENT COR.B EXT .ZPRV * * * THIS ROUTINE RETURNS THE FWA OF FREE MEMORY FOR * A MAIN PROGRAM, THIS ADDRESS IS HIGH MAIN + 1 * FOR A NON-SEGMENTED PROGRAM, AND HIGH LARGEST SEGMENT * SEGMENT + 1 FOR A SEGMENTED PROGRAM * * CALLING SEQUENCE: * A REG = ID SEGMENT ADDRESS OF MAIN PROGRAM * JSB COR.B * RETURNS: * A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN, B REG IS MEANINGLESS * B REG = FWA OF FREE MEM FOR MAIN PROGRAM * * COR.B MAKES AN ERROR RETURN IF THE ID SEGMENT ADDRESS * PASSED IS THAT OF A SHORT ID SEGMENT * * COR.B NOP JSB .ZPRV DEF LIBX ADA .14 POINT TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF BLF,SLB SHORT ID SEG FLAG SET? JMP ERROR YES, THEN ERROR RETURN ADA .9 NO, POINT TO HIGH MAIN + 1 WORD XLB A,I GET CONTENTS ADA .6 POINT TO HIGH LARGEST SEG + 1 WORD XLA A,I GET CONTENTS SZA SEGMENTED PROGRAM? LDB A YES, RETURN WITH HIGH LARGEST SEG+1 ADDR CLA,RSS NORMAL RETURN * ERROR CCA ERROR RETURN LIBX JMP COR.B,I RETURN DEF COR.B * * .6 DEC 6 .9 DEC 9 .14 DEC 14 * A EQU 0 B EQU 1 END ôi  ÿÿ ÿýçî ÿ92067-18046 1805 S C0122 &CV134 RTE-IV $CV13              H0101 4 þúASMB,R,L,C HED $CVT1 AND $CVT3 ROUTINES * SOURCE: 92067-18046 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $CVT3,6 92067-16035 REV.1805 770621 ENT $CVT3 ENT $CVT1 EXT .ZPRV HED $CVT3(BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT JSB .ZPRV DEF LIBX STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE ç   * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B LDX ASCI2 LOAD X WITH LEAST TWO DIGITS LIBX JMP $CVT3,I RETURN DEF $CVT3 * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 ASCI NOP ASCI1 NOP ASCI2 NOP AASCI ASC 1, TEMP6 NOP TMP NOP * * $CVT1 NOP ENTRY FOR ONE WORD JSB .ZPRV DEF CLIBX JSB $CVT3 CONVERT IT LDA ASCI2 GET THE LEAST SIG WORD CLIBX JMP $CVT1,I DEF $CVT1 END ò` ÿÿ ÿýèï ÿ92067-18047 1805 S C0122 &KCVT4 RTE-IV KCVT              H0101 W\ASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: KCVT * SOURCE: 92067-18047 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM KCVT,6 92001-16035 REV.1805 770621 ENT KCVT * * EXT .ENTP,$CVT3,.ZPRV * NUMBR BSS 1 * KCVT NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF NUMBR LDA NUMBR,I CCE JSB $CVT3 CXA GET LEAST TWO DIGITS LIBX JMP KCVT,I RETURN DEF KCVT END r ÿÿ ÿýéï ÿ92067-18048 1840 S 0122 RTE-IV MESSS              H0101 ÜþúASMB,R,Q,C HED MESSS * NAME: MESSS * SOURCE: 92067-18048 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MESSS,7 92067-16035 REV.1840 780724 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN,$$OP SPC 2 SPC 2 BUFFR NOP LNGTH NOP P1 NOP MESSS NOP JSB $LIBR GO PRIVILEGED. CNTR NOP JSB .ENTP GET PARAMETERS. DEF BUFFR LDA MESSS LDB HERE SZB JMP EXIT2 THERE STA RTN STA HERE LDA DEFEF STA MESSS CLA STA $PVCN LDA BUFFR LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM. ISZ $PVCN SZA,RSS JMP CHECK IF NO RETURNED MESSAGE, THEN CHECK XLB A,I FOR SPECIAL PATCHING OF 'RU' OR 'ON' STB LNGTH OTHERWIZE PROCESS MESSAGE. BRS STB CNTR LOOP INA XLB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH EXIT CLB STB HERE STB P1 EXIT1 JSB $LIBX DEF DEF RTN RTN NOP HERE NOP DEFEF DEF DEF SPC 2 26 CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. INB LDA BUFFR,I TEST FOR ON,RUN CPA .ON COMMANDS JMP DP1 TEST 1ST PRAM CPA .RU JMP DP1 JMP DP2 SPC 2 DP1 XLA B,I LU# IF GIVEN SZA,RSS IN FIRST LDA P1,I PARAMETER. XSA B,I * DP2 XLA $$OP,I GET THE OP CODE THE SYS PARSED CPA .ON ON ? JMP DP3 CPáö  A .RU RU ? JMP DP3 JMP EXIT2 * DP3 LDB XEQT GET MY ID ADDRESS JSB SES#3 NOW GET THE SESSION WORD XLA B,I STA HERE & SAVE IT * LDB $WORK GET THE SON'S ID ADDRESS JSB SES#3 AND GET IT'S SESSION WORD ADDRESS LDA HERE GET THE FATHERS WORD XSA B,I AND PROPIGATE TO THE SON. * * EXIT2 CLA ZERO OUT 'A' REG FOR RETURN JMP EXIT SPC 2 * SES#3 NOP ADB D14 INDEX TO TYPE WORD XLA B,I GET THE TYPE AND D7 KEEP ONLY TYPE CPA D1 IS IT MEM RES ? ADB DM4 ADB D18 B = SESSION WORD # 3 ADDRESS JMP SES#3,I RETURN * * .ON ASC 1,ON .RU ASC 1,RU D1 DEC 1 D5 DEC 5 D7 DEC 7 D14 DEC 14 D18 DEC 18 D29 DEC 29 DM4 DEC -4 A EQU 0 B EQU 1 XEQT EQU 1717B * END Ó ÿÿ ÿýêñ ÿ92067-18049 1840 S 0122 RTE-IV $PARS              H0101 æÚþúASMB,R,L,C HED $PARS - PARSE SUBROUTINE FOR OPERATOR MESSAGES * SOURCE: 92067-18049 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $PARS,6 92067-16035 REV.1840 780811 ENT $PARS EXT .ZPRV * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PARS NOP JSB .ZPRV DEF LIBX CLE,ELA MAKE CHARACTER ADD. STA !6þúTEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMPŸ€þú2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XO£¹R VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS LIBX JMP $PARS,I RETURN DEF $PARS SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP * * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TMP NOP NOP WPRIO NOP ASCI NOP ASCI1 NOP ASCI2 NOP * TEMPP NOP DM32 DEC -32 WSTAT NOP TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 COM OCT 54 SABRT NOP D10 DEC 10 D8 DEC 8 AASCI ASC 1, B377 OCT 377 LASCI OCT 40 A EQU 0 B EQU 1 END öjÿÿ ÿýëô ÿ92067-18050 1805 S C0122 &PRSE4 RTE-IV PARSE              H0101 v\ASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: PARSE * SOURCE: 92067-18050 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PARSE,6 92067-16035 REV.1805 770714 ENT PARSE * EXT $PARS,.ENTP,.ZPRV * CMBUF BSS 1 BFLEN BSS 1 BUFR BSS 1 * PARSE NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF CMBUF LDA BUFR STA BUFR1 LDA CMBUF LDB BFLEN,I JSB $PARS BUFR1 BSS 1 LIBX JMP PARSE,I RETURN DEF PARSE END ôˆÿÿ ÿýìò ÿ92067-18051 1913 S C0122 &TMVL4 RTE-IV TMVAL             H0101 J›þúASMB,L,C ROUTINE TO CONVERT TIME HED TMVAL * NAME: TMVAL * SOURCE: 92067-18051 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TMVAL,6 92067-16035 REV.1913 790124 ENT TMVAL EXT .ENTP,$TIME,.ZPRV * * * CALLING SEQUENCE (FORTRAN) * * CALL TMVAL(ITM,ITMAR) * * WHERE ITM IS THE TWO WORD NEGATIVE TIME IN TENS OF * MS. AND ITMAR IS A 5 WORD ARRAY TO RECIEVE THE * TIME. THE ARRAY WILL BE SET UP AS: * * 1. TENS OF MS. * 2. SECONDS * 3. MINUTES * 4. HOURS * 5. CURRENT SYSTEM DAY OF YEAR (NOT RELATED TO CALL VALUES) * ITM NOP ITM1 NOP * TMVAL NOP JSB .ZPRV GO PRIVILEGED IF IN MEM RES LIB DEF LIBX JSB .ENTP GET PRAMS DEF ITM * LDA ITM1 SET ADDRESS STA RQP2 FOR SYSTEM ROUTINE DLD ITM,I GET THE TIME JSB $TIMV CONVERT IT LIBX JMP TMVAL,I DEF TMVAL * HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ÁË   ARRAY(4) = HOURS * ARRAY(5) = DAYS * * E IS SET * A IS THE YEAR * $TIMV NOP ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE OCT 101724 XLA $TIME+2 *******XLA + OFFSET IS NOT DEF $TIME+2 HANDLED CORRECTLY BY ASSEMBLER************ DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 PRS1 OCT 153000 PRS2 OCT 203 TTAB3 DEC 6000 TTAB2 DEC 100 RQP2 NOP RQP4 NOP END Ìû ÿÿ ÿýíô ÿ92067-18052 1805 S C0122 &CNMD4 RTE-IV CNUMD              H0101 hPASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMD * SOURCE: 92067-18052 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMD,6 92001-16035 REV.1805 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMD * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMD SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMD NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CCE SET FOR BINARY TO DEC. CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I WHERE TO PUT IT FROM NOP LIBX JMP CNUMD,I AND RETURN DEF CNUMD END ÄTÿÿ ÿýîô ÿ92067-18053 1805 S C0122 &CNMO4 RTE-IV CNUMO              H0101 PASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMO * SOURCE: 92067-18053 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMO,6 92067-16035 REV.1805 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMO * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMO SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMO NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CLE SET FOR BINARY TO OCTAL CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I FROM NOP LIBX JMP CNUMO,I AND RETURN DEF CNUMO END ô€ÿÿ ÿýïõ ÿ92067-18054 1805 S C0122 &IPRS4 RTE-IV INPRS              H0101 ‹`þúASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: INPRS * SOURCE: 92067-18054 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM INPRS,6 92067-16035 REV.1805 770621 SUP PRESS EXTRANEOUS LISTING ENT INPRS EXT .ENTP,$CVT3,.ZPRV SPC 1 A EQU 0 B EQU 1 HED INPRS : DESCRIPTION * CALLING EXAMPLE : * FTN,L * PROGRAM R$PN$(2,10) * INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),IC), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS) * CALL PARSE(BUFFER,IB,PARBUF) * <"ON" REQUEST - PARBUF(2)="ON" ?> * * * CALL INPRS(PARBUF,PARBUF(33)) * IC = MESSS(BUFFER,IB) * * * GO TO 1 * END SPC 2 * THE BUFFER 'PARBUF' LOOKS LIKE : SPC 2 * PARBUF(1) * PRAM(1) TYPE * (2) * VALUE(1) * (3) * (2) * (4) * (3) * (5) * PRAM(2) TYPE * (6) * VALUE(1) * (7) * (2) * (8) * (3) SPC 1 * ET CETERA SPC 1 * PARBUF(33)* NUMBER OF PARAMETERS PARSED SPC 2 * WHERE : TYPE = 0 => NULL PARAMETER * 1 => NUMERIC PARAMETER IN VALUE(1) * æ€þú 2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) HED INPRS : MAIN BUF NOP #P NOP INPRS NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF BUF SPC 2 LDA #P,I SET PRAM CMA,INA,SZA,RSS COUNTER JMP EXIT NO PRAMS EXIT STA #P INIT COUNTER LDB BLANK USE LEADING BLANK SPC 2 LOOP EQU * LDA BUF GET VALUE FOR INA THIS ENTRY LDA A,I AND IF SSA NEGATIVE ADB B21 CONVERT BLANK TO 1. LDA BUF,I GET PRAM SPEC STB BUF,I STORE ", " OR " " BACK ISZ BUF STEP TO VALUE CMA,INA,SZA,RSS IF ZERO JMP NULL THEN NULL PRAM SPC 2 INA,SZA,RSS IF ONE JMP NUMBR THEN NUMERIC SPC 2 ISZ BUF MUST BE ASCII,SO LOOP2 EQU * IT'S OK ISZ BUF AS ISZ BUF IS. LDB COMMA GET ", " ISZ #P DONE ? JMP LOOP NO-GET NEXT PRAM. SPC 2 EXIT EQU * LIBX JMP INPRS,I YES-EXIT TO CALLER DEF INPRS SPC 2 NULL EQU * LDB BLANK FOR NULL STB BUF,I PRAM , REPLACE LDA B WITH STO EQU * ISZ BUF SIX DST BUF,I BLANKS JMP LOOP2 & GET NEXT PRAM. SPC 2 NUMBR EQU * NUMERIC PRAM PROC. LDA BUF,I GET NUMBER CCE,SSA VALUE IF CLE NEG,SET FOR OCTAL CONVERSION JSB $CVT3 CONVERT TO ASCII ERB SET E IF NEG. LDB A,I GET HIGH DIGIT SEZ,INA STEP & IF OCTAL ADB B104C CONVERT '1' TO 'B' STA T SAVE ADDRESS LDA A,I GET NEXT DIGIT RRL 8 ROTATE 1ST 2 DIGITS TO 'B'REG STB BUF,I STORE 1ST 2 DIGITS ISZ T STEP TO LAST 2 DIGITS ALF,ALF LDB T,I GET LAST 2 DIGITS RRL 8 ‚Ð ROTATE TO RIGHT ORDER JMP STO GO STORE IT HED INPRS : CONSTANTS B21 OCT 21 B104C OCT 10400 COMMA ASC 1,, BLANK ASC 1, T NOP HED INPRS - END END Xÿÿ ÿýðø ÿ92067-18055 1805 S C0122 &.MVW4 RTE-IV .MVW              H0101 EMASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92067-18055 * RELOC: PART OF 92067-16035 * PGMR: G.A.A * HED MOVE WORD ROUTINE TO SIMULATE 105777B MICROCODE INSTR * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .MVW,7 92067-16035 REV.1805 751021 ENT .MVW .MVW EQU * *** MOVE NOP STA FROM MICRO CODE MOVE REPLACEMENT SUB LDA MOVE,I GET THE COUNT LDA A,I TO A ISZ MOVE STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA FROM,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ FROM FROM ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA FROM PUT NEXT LOCATION IN A FOR PURISTS JMP MOVE,I AND RETURN * * A EQU 0 B EQU 1 FROM NOP COUNT NOP END /Pÿÿ ÿýñ÷ ÿ92067-18056 1805 S C0122 >ST4 RTE-IV GETST              H0101 •WþúASMB,R,L,C HED SUBROUTINE GETST * * * NAME: GETST * SOURCE: 92067-18056 * RELOC: PART OF 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GETST,7 92067-16035 REV.1805 771005 ENT GETST EXT EXEC,.ENTP,.ZPRV SUP * ***************************************************************** * * SUBROUTINE GETST: * * GETST IS A FORTRAN CALLABLE SUBROUTINE WHICH MAY BE USED TO * RETRIEVE ANY PARAMETER STRING FROM A COMMAND STRING WHICH * FOLLOWS THE SECOND COMMA(THIRD IF THE SECOND PARAMETER IS * 'NO' AND 'NOW'). ONLY THE FIRST 80 CHARACTERS OF THE * COMMAND STRING ARE CHECKED. * * CALLING SEQUENCE: * * EXT GETST * JSB GETST * DEF RTN * DEF IBUFR * DEF IBUFL * DEF ILOG * RTN ... * IBUFR BSS N BUFFER TO STORE STRING IN. * IBUFL DEC N(-2N) WORD(+) OR CHARS(-) TO TRANSFER. * ILOG BSS 1 TRANSMISSION LOG. * * RETURN: * =:=POSITIVE NUMBER OR WORDS(CHARS)TRANSFERRED. * :=0 IMPLIES NO BUFFER FOUND. * ***************************************************************** * IBUFR NOP IBUFL NOP ILOG NOP * GETST NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF IBUFR * JSB EXEC GO GET ANY PARAMETER STRING. DEF *+5 DEF D14 DEF D1 DIBR DEF IBR DEF DM80 * SZB,RSS IF TRANSMISSION LOG JMP L2 IS ZERO, THEN EXIT. INB CMB,INB SET UP CHARACTER STB CNæñþúT CHARACTER COUNTER. * LDB IBUFR CONVERT DESTINATION BUFFER CLE,ELB ADDRESS TO CHARACTER STB DBADD AND SAVE. LDB DIBR CONVERT SOURCE CLE,ELB BUFFER ADDRESS ADB DM1 TO CHARACTER STB ADD ADDRESS AND SAVE. LDB DM2 SET COMMA COUNT STB TEMP TO -2. * L1 JSB GETCH GO GET A CHARACTER. CPA ASCCM IF NOT A COMMA OR THE FIRST COMMA, ISZ TEMP THEN CONTINUE SCANNING FOR JMP L1 COMMAS. * LDB ADD OTHERWIZE, SAVE STB TEMP ADDRESS. LDB CNT SAVE CHAR STB TCNT COUNT. * L31 JSB GETCH NOW SCAN FOR 'NO' OR 'NOW'. CPA ASCBK STRIP LEADING BLANKS. JMP L31 CPA ASC.N IF CHARACTER EQUALS 'N' JMP L5 THEN CHECK FOR A 'O'. * L6 LDA TEMP IF CHARACTER IS NOT 'N', THEN LDB TCNT GET SAVED ADDRESS AND CHARACTER JMP L91 COUNT AND GO MOVE BUFFER. SKP L5 JSB GETCH GET NEXT CHARACTER. CPA ASC.O CHECK IF CHARACTER RSS IS A 'O'. JMP L6 IF NOT, GO MOVE BUFFER. * JSB GETCH FOUND 'NO'. CPA ASCBK CHECK IF NEXT CHARACTER JMP L81 IS A BLANK OR CPA ASCCM A COMMA. JMP L9 * CPA ASC.W FOUND 'NO'. CHECK IF RSS NEXT CHARACTER IS A 'W'. JMP L6 IF NOT THEN MOVE BUFFER. * JSB GETCH FOUND 'NOW' SO GET NEXT CHARACTER. CPA ASCCM CHECK IF NEXT JMP L9 CHARACTER IS A CPA ASCBK BLANK OR A COMMA. RSS JMP L6 IF NOT THEN MOVE BUFFER. * L81 JSB GETCH GET NEXT CHARACTER. CPA ASCCM SKIP TO THIRD COMMA IN STRING. RSS JMP L81 * L9 LDA ADD SAVE STARTING CHAR ADDRESS LDB CNT AND CHARACTER COUNT L91 INA OF SOURCE BUFFER. Š2þú INB STA SBADD LDA IBUFL,I GET REQUEST LENGTH SSA AND CONVERT TO CHARACTERS. JMP L92 RAL CMA,INA L92 STA CNT SAVE NEGATIVE CHARACTER COUNT. CMA,INA ADA B USE LESSER OF ACTUAL TRANSMISSION LOG SSA AND THE ACTUAL REQUEST LENGTH. LDB CNT STB CNT COMPUTE NUMBER OF CMB,INB CHARACTERS IN STB ILOG,I SOURCE BUFFER. SKP LL3 LDB SBADD GET CLE,ERB SOURCE LDA B,I CHARACTER. SEZ,RSS ALF,ALF AND B377 * LDB DBADD STORE CLE,ERB INTO SEZ,RSS DESTINATION JMP LL5 BUFFER. XOR B,I LL4 STA B,I ISZ SBADD INCREMENT SOURCE CHAR. ADD ISZ DBADD DESTINATION BUFFER ADD AND ISZ CNT CHARACTER COUNT. JMP LL3 * SEZ IF LAST BYTE WAS A RIGHT CHARACTER, JMP LL43 THEN JUST CONTINUE. CPA ASCB0 IF LAST BYTE WAS A LEFT BLANK, JMP LL55 THEN GO REMOVE IT. XOR ASCBK OTHERWIZE, GO PLACE A BLANK IN STA B,I LOWER BYTE. * LL43 LDB ILOG,I GET MODIFIED TRANSMISSION LOG. LDA IBUFL,I IF CHARACTERS WERE SSA SPECIFIED, THEN JMP L2 RETURN. INB IF WORDS WERE SPECIFIED, THEN BRS CHANGE TO WORDS AND RETURN. * L2 STB ILOG,I SAVE TRANSMISSION LOG LIBX JMP GETST,I AND RETURN. DEF GETST * LL5 ALF,ALF JMP LL4 * LL55 LDB ILOG,I DECREMENT ADB DM1 CHARACTER STB ILOG,I COUNT. JMP LL43 SKP * ****************************************************************** * * SUBROUTINE GETCH: * * GETCH WILL GET THE NEXT CHARACTER IN A BUFFER. * IF THE BUFFER BECOMES EMPTY, GETCH WILL * FORCE AN EXIT FROM GETST. * * CALLING SEQUENCE: * ¿' :=PREVIOUS CHARACTER ADDRESS * :=PREVIOUS CHARACTER COUNT(NEGATIVE) * JSB GETCH * * RETURN: * :=CHARACTER IN LOWER BYTE. * :=CURRENT CHARACTER ADDRESS. * :=CURRENT CHARACTER COUNT. * ALL REGISTERS ARE MODIFIED EXCEPT B. * ******************************************************************** * GETCH NOP CLB SET POSSIBLE TRANSMISSION LOG TO 0. ISZ ADD INCREMENT CHARACTER ADDRESS. ISZ CNT INCREMENT CHARACTER COUNT. RSS IF COUNT GOES JMP L2 TO ZERO, LEAVE GETST. * LDA ADD GET CHARACTER ADDRESS AND CLE,ERA AND CONVERT TO WORD ADDRESS. LDA A,I E=1 MEANS LOWER BYTE. SEZ,RSS GET WORD AND ALF,ALF PLACE PROPER AND B377 CHARACTER IN JMP GETCH,I LOWER BYTE. * B377 OCT 377 SKP * * CONSTANTS * A EQU 0 B EQU 1 * CNT NOP TEMP NOP TCNT NOP ADD NOP SBADD NOP DBADD NOP * IBR BSS 40 * D1 DEC 1 D14 DEC 14 DM1 DEC -1 DM2 DEC -2 DM80 DEC -80 * ASCCM OCT 54 COMMA ASCBK OCT 40 BLANK ASC.N OCT 116 'N' ASC.O OCT 117 'O' ASC.W OCT 127 'W' ASCB0 OCT 20000 * END ’þÿÿ ÿýòû ÿ92067-18057 1805 S C0122 &EMAP RTE-IV .EMAP              H0101 K9þúASMB,R,L,C ** .EMAP ** HED .EMAP ROUTINE TO RESOLVE ELEMENT ADDRESS OF AN ARRAY * SOURCE: 92067-18057 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .EMAP,7 92067-16035 REV.1805 771031 SUP ENT .EMAP EXT .EMAS,.EMAT * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR EMA AND NON-EMA * ARRAYS. IF THE ARRAY IS NON-EMA 16 BIT ARITHMETIC IS * PERFORMED. IF THE ARRAY IS AN EMA 32 BIT ARITHMETIC IS * PERFORMED AND THE APPROPIATE MAPPING SEGMENT CONTAINING * THE ELEMENT IS MAPPED IN THE MSEG LOG ADDRESS SPACE * * CALLING SEQUENCE: * JSB .EMAP * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF ARRAY START ADDRESS OF ARRAY * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) USED ONLY * OFFSET WORD 2 (HIGH 16 BITS) FOR EMA * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=15(ASCII), BREG=EM(ASCII) * NORMAL RETURN: AT LOC RTN+1 * AREG = MEANINGLESS * BREG = ELEMc þúENT ADDRESS * * .EMAP NOP ROUTINE TO RESOLVE ARRAY ADDRESS LDA .EMAP,I GET RETURN ADDRESS STA RETRN SAVE IT ISZ .EMAP POINT TO ARRAY ADDRESS LDB .EMAP,I GET ARRAY ADDRESS JMP *+2 REMOVE INDIRECTS LDB B,I RBL,CLE,SLB,ERB JMP *-2 * ISZ .EMAP POINT TO THE TABLE ADDRESS LDA XIDEX DETERMINE WHETHER ARRAY ADDRESS SZA,RSS GIVEN IS THAT OF AN EMA OR NON-EMA ARRAY JMP NOEMA CALLING PROG DOES NOT HAVE EMA DECLARED INA POINT 2ND WORD OF ID SEG EXT XLA A,I GET CONTENTS OF 2ND WORD OF ID SEG EXT OF PROG CLE,ERA MOVE BITS 15-11 INTO 14-10 POSITION AND B76K GET LOGICAL START ADDR OF MSEG CMA,INA ADA B ARRAY ADDRESS SPECIFIED < START MSEG? SSA JMP NOEMA NO THEN A NON-EMA ARRAY LDA .EMAP POINTER TO TABLE ADDRESS JSB .EMAS RESOLVE ELEMENT ADDRESS FOR EMA ARRAY SSA,RSS ERROR ENCOUNTERED? JSB .EMAT MAP NECESSARY MSEG TO GET ELEM IN LOG ADDR SPACE SSA ERROR ENCOUNTERED? JMP ERROR ISZ RETRN NO, ELEMENT ADDRESS IS IN B REG JMP RETRN,I NORMAL RETURN TO RTN+1 LOCATION * * NON - EMA ARRAY - RESOLVE ELEMENT ADDRESS USING * 16 BIT ARITHMETIC * NOEMA STB ARRAY SAVE ARRAY ADDRESS LDA .EMAP,I GET TABLE ADDRESS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL ADDRESS OF PARAMETER TABLE LDA A,I # OF DIMENSIONS SSA -VE? JMP ERROR YES, ERROR SZA,RSS 0 DIMENSIONS? JMP NODIM YES CMA,INA STA NDIM -VE # OF DIMENSIONS TO USE AS COUNTER CLA STA SUM1 INITIALIZE VARIABLE TO HOLD DISPLACEMENT LOOP ISZ PTABL POINT TO -(LOWER BOUND) OF ITH DIMENSION ISZ .EMAP POINT TO SUBSCRIPT VALUE OF I ITH DIMENSION LDA .EMAP,I GET SUBSCRIPT VALUE --- A(I) LDA A,I CLO CLEAR OVERFLOW REGISTER ADA PTABL,I A(I)-L(I) SUBSCRIPT VALUE-LOWER BOUND SSA,RSS LOWER BOUND > SUBSCRIPT VALUE? SOC C OVERFLOW REG SET? JMP ERROR YES, ERROR ADA SUM1 ACCUMULATE DISPLACEMENT - IF OVERFLOW ISZ PTABL IT WILL BE DETECTED AFTER MULTIPLY LDB PTABL,I DIMENSION SIZE OF (I-1)ST DIMENSION D(I-1) SSB -VE? JMP ERROR YES, THEN ERROR MPY B (A(I) - L(I))*D(I-1) SZB,RSS OVERFLOW INTO B REG? SSA NO, OVERFLOW INTO BIT 15 OF A REG? JMP ERROR YES STA SUM1 NEW VALUE FOR DISPLACEMENT ISZ NDIM INCREMENT # DIMENSIONS COUNTER JMP LOOP ALL DIMENSIONS NOT DONE YET * NODIM LDB ARRAY ARRAY ADDRESS ADB A ADD DISPLACEMENT ISZ RETRN NORMAL RETURN AT LOC RTN+1 JMP RETRN,I * * ERROR DLD ERRCD ERROR ENCOUNTERED JMP RETRN,I RETURN AT LOC RTN * * ERRCD ASC 2,15EM ERROR CODE PTABL NOP SUM1 NOP NDIM NOP ARRAY NOP RETRN NOP * B76K OCT 76000 * XIDEX EQU 1645B A EQU 0 B EQU 1 * END * * …ÿÿ ÿýóû ÿ92067-18058 1805 S C0122 &EMIO4 RTE-IV .EMIO              H0101 fAþúASMB,R,L,C ** .EMIO ** HED .EMIO I/O BVUFFER ROUTINE FOR EXTENDED MEMORY AREAS * SOURCE: 92067-18058 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMIO,7 92067-16035 REV.1805 771006 SUP ENT .EMIO EXT .EMAS,.EMAT,..MP,.NPGS,.IPGS,.MSG#,.MSGS,.ARRY EXT .SUM2,.EMSZ * * * ROUTINE TO RESOLVE AN ELEMENT ADDRESS FOR AN EMA ARRAY * AND TO MAP THE APPROPRIATE MAPPING SEGMENT TO CONTAIN * THE ENTIRE BUFFER STARTING AT THE ELEMENT AND HAS * LENGTH SPECIFIED IN THE CALLING SEQUENCE * A SPECIAL NON-STANDARD MAPPING SEGMENT IS MAPPED IF THE * BUFFER DOES NOT FIT INTO A STANDARD MAPPING SEGMENT * * CALLING SEQUENCE: * JSB .EMIO * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF BUFL LENGTH OF BUFFER IN # WORDS * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) * OFFSET WORD 2 (HIGH 16 BITS) * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=16(ASCII), BREG=EM(ASCII) * NORMAL REDHþúTURN: AT LOC RTN+1 * AREG = MEANINGLESS * BREG = ELEMENT ADDRESS * * .EMIO NOP LDA .EMIO RETURN ADDRESS INA POINT TO THE BUFFER LENGTH LDB .EMIO,I SAVE RETURN ADDRESS STB .EMIO LDB XIDEX EMA ROUTINE DECLARED IN CALLING PROG? SZB,RSS JMP ERROR NO, THEN ERROR LDB A,I LDB B,I BUFFER LENGTH IN B REG STB BUFL SAVE IT SSB -VE? JMP ERROR YES, ERROR INA POINT TO 'DEF TABLE' PARAMETER JSB .EMAS RESOLVE ADDRESS OF ELEMENT SSA ERROR ENCOUNTERED? JMP ERROR YES * * TEST IF SPECIAL MAPPING REQUIRED * ADB BUFL ADD BUFFER LNGTH TO DISP IN MSEG CLA RRL 6 #PAGES IN DISP + BUFL IN A REG SZB REMAINDER=0? INA NO STA TEMP SAVE THIS VALUE CMA,INA NEGATE # PAGES ADA .MSGS ADD MAPPING SEGMENT SIZE SSA MSEG SIZE > DISP + BUFL? JMP SPMAP NO THEN SPECIAL MAPPING REQUIRED LDA TEMP GET #PAGES IN DISP FROM START OF EMA UPTO MSEG ADA .IPGS ADD #PGS FROM START OF EMA UPTO ELEMENT CMA,INA NEGATE IT ADA .EMSZ EMA SZ - #PGS FROM START OF EMA TO END OF MSEG SSA EMA SIZE SMALLER? JMP ERROR YES JSB .EMAT NO, THEN MAP STANDARD MSEG SSA ERROR? JMP ERROR YES * ISZ .EMIO NORMAL RETURN TO LOC RTN + 1 JMP .EMIO,I * * SPECIAL MAPPING REQUIRED * SPMAP LDA .SUM1 DISP INTO PAGE CONTAINING ELEMENT STA TEMP SAVE IT ADA BUFL ADD #WRDS IN BUFFER SSA OVERFLOW? JMP ERROR YES, THEN ERROR CLB NO RRR 10 #PGS NEEDED TO MAP TO ACCESS ENTIRE BUFFER SZB REMAINDER=0? INA NO STA .SUM1 # PAGES TO BE MAPPED LDA .SUM2 ·Y STA .IPGS CCA SPECIAL MAPPING SEGMENT STA .MSG# JSB ..MP MAP THE SPECIAL MAPPING SEGMENT SSA ERROR RETURN? JMP ERROR YES, THEN MAKE ERROR RETURN LDB .ARRY BASE ADDRESS OF ARRAY ADB TEMP # WORDS LEFT IN DISP ISZ .EMIO NORMAL RETURN JMP .EMIO,I * * ERROR DLD ERRCD JMP .EMIO,I ERROR RETURN * * ERRCD ASC 2,16EM BUFL NOP TEMP NOP .SUM1 EQU .NPGS N1 DEC -1 B1777 OCT 1777 XIDEX EQU 1645B A EQU 0 B EQU 1 END òÿÿ ÿýôü ÿ92067-18059 1805 S C0122 &MMAP4 RTE-IV MMAP              H0101 LPþúASMB,R,L,C ** MMAP ** HED MMAP ROUTINE TO MAP EMA PAGES IN MSEG * SOURCE: 92067-18059 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM MMAP,7 92067-16035 REV.1805 771020 SUP ENT MMAP,..MP,.MMAP,.EMSZ,.MSG#,.MSGS,.NPGS,.IPGS EXT $DVPT,$LIBR,$LIBX * * * ROUTINE TO MAP THE REQUESTED SEQUENCE OF PHYSICAL * PAGES IN THE MAPPING SEGMENT ADDRESS SPACE * IF THE # OF PAGES SPECIFIED TO BE MAPPED IS LESS * THAN THE STANDARD MAPPING SEGMENT SIZE, MMAP WILL MAP * UPTO THE STANDARD MSEG SIZE PAGES IF THEY FIT * * CALLING SEQUENCE: JSB MMAP * DEF RTN RETURN ADDRESS * DEF IPGS # OF PAGES DISP FROM START OF EMA * UPTO THE FIRST PAGE TO MAP * DEF NPGS # OF PAGES TO BE MAPPED * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN * * * MMAP HAS TWO OTHER ENTRY POINTS .MAP. AND .MMAP * .MAP. IS ENTERED BY .EMIO WHILE DOING SPECIAL MAPPING * CALLING SEQUENCE FOR .MAP. IS: JSB .MAP. * * .MMAP IS ENTERED BY .EMAS WHILE MAPPING A STANDARD MSEG * CALLING SEQUENCE FOR .MMAP IS: JSB .MMAP * * * MMAP NOP LDA MMAP,I GET THE RETURN ADDRESS STA RETRN AND SAVE IT ISZ MMAP GET THE NEXT PARAMETER LDA MMAP,I LDA A,I A REG HAS # OF PAGES DISPLACEMENT FROM START STA .IPGS OF EMA TO START OF SEGMENT TO BE MAPPED SSA -VE? JMP ERROR YES, THEN ERROR ISZ MMAP LDB MMAP,I GET THE NEXT PšîþúARM LDB B,I # OF PAGES TO BE MAPPED SSB -VE? JMP ERROR YES, THEN ERROR STB .NPGS LDA XIDEX ADDRESS OF ID SEG EXT SZA,RSS IS IT 0? JMP ERROR YES THEN NOT AN EMA PROG LDA XEQT GET ID SEG ADDRESS ADA .28 XLA A,I GET WORD 28 OF THE ID SEGMENT AND B1777 MASK OUT THE EMA SIZE STA .EMSZ SAVE IT XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK STANDARD MSEG SIZE STA .MSGS SAVE IT * LDA .IPGS FIND MSEG # IF STANDARD MSEG CLB DIV .MSGS RELATIVE START PAGE OF MSEG/.MSGS SZB REMAINDER=0? CCA NO, NON-STANDARD MSEG STA .MSG# SAVE MAPPING SEGMENT # JMP .MAP1 SKIP OVER FOLLOWING ENTRY POINT * ..MP NOP ENTRY POINT FOR .EMIO TO ENTER LDA ..MP GET RETURN ADDRESS STA RETRN SET UP MAIN RETURN ADDRESS .MAP1 LDA .NPGS # OF PAGES TO BE MAPPED ADA .IPGS # OF PAGES DISP FROM START OF EMA CMA,INA ADA .EMSZ EMA SIZE-(#PGS DISP+#PGS TO BE MAPPED) SSA EMA SIZE < NPGS+.IPGS? JMP ERROR YES, THEN ERROR LDB .NPGS # OF PAGES TO BE MAPPED CMB,INB ADB .MSGS MSGSZ - NPGS SSB .NPGS> MSGSZ? JMP ERROR YES, ERROR ISZ .MSGS INCREMENT MSEG SIZE TO ACCOUNT LDB .MSGS FOR OVERFLOW PAGE LDA .EMSZ EMA SIZE CMA,INA ADA .IPGS #PGS DISP FROM START EMA - EMA SIZE ADB A + MSEG SIZE + 1 CMA,INA EMA SIZE - # PGS DISP SSB .IPGS+.MSGS+1<=EMA SIZE? LDA .MSGS YES, #PAGES TO MAP IS MSEG SIZE + 1 STA .NPGS SET # OF PAGES TO BE MAPPED SZA,RSS 0? JMP ERROR YES, THEN IPGS = EMASZ JMP NOADJ SKIP OVER FOLLOWING ENTRY POINT * * CHANGE USER MAP ON BASE PAGE * .MMAP NOP “Þþú LDA .MMAP SET UP MAIN RETURN ADDRESS STA RETRN ISZ .MSGS ACCOUNT FOR OVERFLOW PAGE NOADJ JSB $LIBR TURN OFF INTERRUPTS AND NOP MEMORY PROTECT FENCE LDA XIDEX INA XLA A,I GET 2ND WORD OF ID SEG EXT CAY SAVE IT AND B1777 MASK PHYSICAL START PAGE OF EMA ADA .IPGS A REG = PHYSICAL START PAGE OF MAPPING SEG STA .IPGS SAVE IT LDA B40 READ THE USER BASE PAGE # FROM DMS REG 40B CCB CBX -1 IN XREG TO READ 1 REG LDB AEMSZ ADDRESS OF LOC CONTAINING MEM ADDRESS XMM READ DMS REG CLB,INB X REG = 1 TO CHANGE CONTENTS OF 1 DMS REG CBX B TO X XLA $DVPT DMS REG# POINTING TO START OF DRIVER PARTN STA MLOC ADA B40 LDB AEMSZ POINT THIS REG TO USER BASE PAGE XMM LDB MLOC START PAGE OF DRIVER PARTN BLF,BLF MULTIPLY BY 2000B RBL,RBL ADB B1740 LOC ON USER BASE PAGE AT WHICH MSEG STARTS CYA SECOND WORD ID SEG EXT FROM Y TO A ALF,RAL MOVE BITS 11-15 TO POSITION 10-14 AND B37 MASK OUT START LOGICAL PAGE OF MSEG STA MSTRT SAVE IT ADB A BREG HAS MEM LOC ON BASE PAGE STB MLOC AT WHICH USER MAP MUST BE CHANGED LDA .NPGS # OF PAGES CMA,INA COUNTER STA .EMSZ LDA .IPGS START PHYSICAL PAGE OF MSEG LOOP STA B,I STORE IT ON USER BASE PAGE INA INCREMENT PAGE # INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP STORE NEXT PAGE# * USER MAP ON BASE PAGE IS CHANGED TO SHOW THE NEW MSEG * REST OF THE LOCATIONS MUST BE MADE READ&WRITE PROTECTED * LDA .MSGS FIND # OF LOCATIONS LEFT TO BE CMA,INA READ AND WRITE PROTECTED ADA .NPGS #PAGES - (MSEG SIZE+1) SZA,RSS EQUAL? °Ó JMP STDMS YES THEN SET DMS REGISTERS STA .EMSZ #PGS TO READ-WRITE PROTECT LDA B140K LOOP1 STA B,I STORE 140000B IN LOC ON USER BASE PAGE INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP1 * STDMS LDA B40 40 OCTAL ADA MSTRT FIRST MAP REGISTER TO BE CHANGED IN A REG LDB .MSGS #DMS REG TO CHANGE IS MSEG SIZE + 1 CBX TO BE LOADED FROM LDB MLOC USER BASE PAGE XMM TRANSFER MEM INTO DMS REG * XLA XIDEX,I GET FIRST WORD OF ID SEG EXT LDB .MSG# SSB,RSS -1? JMP MMAP1 NO IOR BIT15 YES, THEN SET BIT 15 JMP MMAP2 * MMAP1 AND B37 MASK OUT BITS 0-4 BLF,RBL MOVE MSEG # TO BITS 5-14 ADA B MMAP2 XSA XIDEX,I STORE BACK WORD 0 OF THE ID SEG EXT CLA RETURN WITH A REG=0 JSB $LIBX TURN ON MEMORY PROTECT & INTERRUPTS DEF RETRN * ERROR CCA ERROR RETURN WITH A REG=-1 JMP RETRN,I * * RETRN NOP .IPGS NOP .NPGS NOP .MSGS NOP .MSG# NOP .EMSZ NOP AEMSZ DEF .EMSZ MSTRT NOP MLOC NOP B37 OCT 37 B40 OCT 40 B1777 OCT 1777 B1740 OCT 1740 B140K OCT 140000 BIT15 OCT 100000 .28 DEC 28 N1 DEC -1 A EQU 0 B EQU 1 XIDEX EQU 1645B XEQT EQU 1717B END ˜ÿÿ ÿýõþ ÿ92067-18060 1805 S C0122 &EMAS4 RTE-IV .EMAS              H0101 f2þúASMB,R,L,C ** .EMAS ** HED .EMAS INTERNAL ROUTINE TO RESOLVE ELEMENT ADDRESS IN EMA * SOURCE: 92067-18060 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMAS,7 92067-16035 REV.1805 771031 SUP ENT .EMAS,.EMAT,.ARRY,.SUM2 EXT .MMAP,.MSGS,.EMSZ,.MSG#,.NPGS,.IPGS * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR AN EMA ARRAY * * CALLING SEQUENCE: JSB .EMAS * A REG = POINTER TO TABLE ADDRESS IN * THE LIST OF PARAMETERS * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF AN ERROR WAS ENCOUNTERED * B REG = TOTAL # OF WORDS DISPLACEMENT FROM * THE START OF MSEG TO THE ELEMENT * * .EMAS NOP ROUTINE TO RESOLVE ARRAY ADDRESS STA TEMP SAVE ADDRESS CLA CLEAR VARIABLES TO KEEP RUNNING SUM STA .SUM1 OF THE ELEMENT ADDRESS STA .SUM2 LDA TEMP,I ADDRESS OF THE TABLE OF PARAMETERS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL PTABL IS THE POINTER TO THE PARM TABLE LDA A,I # OF DIMENSIONS IN THE A REG SSA -VE? JMP ERROR YES, THEN ERROR ISZ PTABL INCREMENT POINTER INTO THE TABLE SZA,RSS 0? JMP NODIM YES, NO DIMENSIONS SPECIFIED CMA,INA NEGATE IT TO KEEP COUNT STA NDIM -VE # OF DIMENSIONS * LOOP ISZ TEMP GET THE NEXT SUBSCRIPT VALUE LDA TEMP,I LDA A,I CLO CLEAR ŒrþúOVERFLOW REGISTER ADA PTABL,I ADD -LI TO AI SSA,RSS IS THIS VALUE -VE? SOC C OVERFLOW REG SET? JMP ERROR YES,SUBSCRIPT VALUE < LOWER BOUND ERROR ADA .SUM1 ADD LOWER 14 BITS OF SUM ELEMENT ADDRESS SSA IS BIT 15 SET? ISZ .SUM2 YES,ADD 1 TO THE MOST SIGNIFICANT BITS OF SUM ELA,CLE,ERA CLEAR SIGN BIT IN THE A REGISTER ISZ PTABL POINT TO UPPER BOUNDS OF (I-1)TH DIMENSION LDB PTABL,I DIMENSION SIZE D(I-1) IN B REG STB DIMLN SSB -VE? JMP ERROR YES MPY B MULTIPLY .SUM1 BY DIMENSION SIZE RAL,CLE,ERA CLEAR BIT 15 IN A REG AND SAVE IN E REG ELB SHIFT BIT 15 OF AREG INTO BIT 0 POSITION OF BREG STA .SUM1 NEW VALUE OF BITS 0-14 OF ELEMENT ADDRESS STB .SUM3 LDA .SUM2 BITS 15-31 OF ELEMENT ADDRESS MPY DIMLN NO, THEN MULTIPLY BY DIMENSION SIZE .EMA3 ADA .SUM3 ADD BITS 15-31 FROM PREVIOUS MULTIPLICATION STA .SUM2 .SUM2 HAS BITS 15-31 OF ELEMENT ADDRESS SO FAR SZB,RSS OVERFLOW INTO B REG? SSA SIGN BIT SET ? JMP ERROR YES, ERROR ISZ PTABL POINT TO NEXT SET OF ARRAY PARAMETERS ISZ NDIM ALL DIMENSIONS DONE? JMP LOOP NO, THEN EVALUATE NEXT DIMENSION * NODIM XLA XIDEX,I GET FIRST WORD OF ID SEG EXT CAY SAVE IT IN Y REG AND B37 MASK MSEG SIZE STA .MSGS SAVE IT LDA XIDEX INA GET 2ND WORD OF ID SEG EXT XLA A,I CLE,ERA AND B76K GET LOGICAL START EMA ADDRESS STA .ARRY SAVE IT * DLD PTABL,I GET TWO OFFSET WORDS RAL,CLE,ERA IF BIT 15 OF AREG SET, CLEAR IT AND SAVE ELB SHIFT IT IN BIT 0 POSITION OF HIGH ORDER BITS SEZ,SSB,RSS OFFSET HAS SIGN BIT SET OR TOO LARGE? RSS JMP ERROR YES, THEN ERROR ADA .SUM1 OFFSET WORD 1 óÕþú RAL,CLE,SLA,ERA CLEAR SIGN BIT IF SET INB INCREMENT HIGH ORDER BITS TO ACCOUNT ADB .SUM2 FOR SIGN BIT OF LOW ORDER BITS SSB OVERFLOW? JMP ERROR YES RAL MOVE BITS 0-14 IN 1-15 POSITION ASL 5 B REG HAS TOTAL # OF PAGES IN DISPLACEMENT SOC C WERE SOME SIGNIFICANT BITS LOST? JMP ERROR YES STB .SUM2 FROM BEGINNING OF EMA UPTO PAGE CONTAINING ELEMENT ALF,ALF MOVE REMAINING WORDS INTO LOW BITS RAL,RAL STA .SUM1 SAVE # OF WORDS OFFSET IN THE LAST PAGE CMB - (#PAGES DISP + 1) LDA XEQT ADA .28 WORD 29 OF ID SEGMENT XLA A,I AND B1777 MASK EMA SIZE STA .EMSZ ADB A TOTAL #PGS DISP+1(IF OFFSET INTO LAST PAGE) SSB > EMA SIZE? JMP ERROR YES, THEN ERROR LDA .SUM2 # OF PAGES DISP FROM START OF EMA CLB DIV .MSGS DIVIDE DISP BY MSEG SIZE STA .MSG# QUOTIENT IS THE MSEG # TO MAP LDA B SAVE B REG CMA,INA # PAGES DISP - # PAGES OFFSET INTO MSEG ADA .SUM2 STA .IPGS BLF,BLF CONVERT REMAINDER # PAGES INTO WORDS RBL,RBL ADB .SUM1 TOTAL # OF WORDS DISP INTO MSEG STB TEMP SAVE THIS VALUE CLA JMP .EMAS,I RETURN * * MAP THE STANDARD MAPPING SEGMENT * .EMAT NOP CYA GET THE FIRST WORD OF THE ID SEG EXT SSA BIT 15 SET? JMP MSGMP YES, THEN MSEG NEEDS TO BE MAPPED CLB LSR 5 GET MSEG# CURRENTLY MAPPED CPA .MSG# IS IT THE SAME AS THE ONE WE WANT JMP RETRN YES,NO NEED TO MAP MSEG RETURN * * MAPPING SEGMENT TO BE MAPPED * MSGMP LDA .EMSZ SIZE OF EMA CLB DIV .MSGS DIVIDE BY MSEG SIZE TO GET THE SZB,RSS HIGHEST MSEG # - REMAINDER = 0? ADA N1 YES, THEN SUBT:&RACT 1 FROM QOUTIENT CPA .MSG# IS THE HIGHEST MSEG# = MSEG# WE WANT? JMP MSGM1 YES LDB .MSGS NO, ADJUST# PAGES TO BE MAPPED INB FOR OVERFLOW JMP MSGM2 MSGM1 SZB,RSS REMAINDER=0? LDB .MSGS YES,#PAGES TO BE MAPPED IS MSEG SIZE MSGM2 STB .SUM1 # OF PAGES TO BE MAPPED JSB .MMAP MAP THE MAPPING SEGMENT * RETRN LDB .ARRY LOGICAL START ADDRESS OF MSEG ADB TEMP # OF WORDS DISP INTO MSEG CLA JMP .EMAT,I RETURN * ERROR CCA ERROR RETURN JMP .EMAS,I * .SUM1 EQU .NPGS LOWER SIGNIFICANT BITS 0-14 OF DISPLACEMENT .SUM2 NOP UPPER SIGNIFICANT BITS 15-31 OF DISPLACEMENT .SUM3 NOP PTABL NOP POINTER INTO TABLE NDIM NOP DIMLN NOP TEMP NOP .ARRY EQU NDIM XIDEX EQU 1645B XEQT EQU 1717B .28 DEC 28 N1 DEC -1 B37 OCT 37 B76K OCT 76000 B1777 OCT 1777 A EQU 0 B EQU 1 END €†ÿÿ ÿýöÿ ÿ92067-18061 1805 S C0122 &EMST4 RTE-IV EMAST              H0101 t^þúASMB,R,L,C ** EMAST ** HED EMAST ROUTINE RETURNS INFORMATION OF AN EMA * SOURCE: 92067-18061 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM EMAST,7 92067-16035 REV.1805 770913 ENT EMAST * * * ROUTINE TO GIVE INFORMATION FOR AN EMA PROGRAM * CALLING SEQUENCE: JSB EMAST * DEF *+4 RETURN ADDRESS * DEF NEMA SIZE OF EMA * DEF NMSEG SIZE OF MSEG * DEF IMSEG START LOGICAL PAGE MSEG * RETURNS: * A REG = 0 IF NORMAL RETURN * =-1 IF ERROR RETURN * ERROR RETURN IS MADE IF CALLING PROGRAM DOES NOT * HAVE AN EMA DEFINED * * * EMAST NOP LDA EMAST,I STA RETRN SAVE RETURN ADDRESS LDA XIDEX EMA PROGRAM? SZA,RSS JMP ERROR NO THEN ERROR * LDA XEQT YES ADA .28 GET WORD 28 OF THE ID SEG XLA A,I AND B1777 MASK OUT EMA SIZE JSB PRMST STORE EMA SIZEL IN RETURN PARAMETER XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK MSEG SIZE JSB PRMST STORE IT IN RETURN PARAMETERS LDA XIDEX ID SEG EXT ADDRESS INA XLA A,I GET SECOND WORD OF ID SEG EXT ALF,RAL MOVE START LG PAGE OF MSEG TO LOW BITS AND B37 MASK IT JSB PRMST STORE IT IFN RETURN PARAMETER CLA,RSS NORMAL RETURN ERROR CCA ERROR RETURN A REG=-1 JMP RETRN,I RETURN * PRMST NOP ROUTINE TO STORE VALUE±K  S INTO PARAMETERS ISZ EMAST LDB EMAST,I STA B,I JMP PRMST,I RETURN * RETRN NOP .28 DEC 28 B1777 OCT 1777 B37 OCT 37 A EQU 0 B EQU 1 XEQT EQU 1717B XIDEX EQU 1645B END ã ÿÿ ÿý÷þ ÿ92067-18062 1805 S C0122 &TRLU4 RTE-IV TRMLU              H0101 —dþúASMB,R,L,C ** TRMLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -TRMLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: TRMLU * SOURCE: 92067-18062 * RELOC: 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TRMLU,7 92067-16035 REV.1805 771117 ENT TRMLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB TRMLU -OR- JSB TRMLU -OR- CALL TRMLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP TRMLU NOP ENTRY STB EQT4 SAVE B-REG FOR LATER TEST LDA TRMLU,I GET ADRS OF RETURN ADDRESS ISZ TRMLU BUMP TO POSSIBLE PRAM. LDB TRMLU,I GET POSS. ADDRS OF PRAM. CPA TRMLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STB LUADR SET ADDRESS FOR PASSED PRAM STA TRMLU SET UP RETURN ADDRESS CLA SET START LU = 0 STA LUNUM * NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCHANNEL BITS MPY D15 CAL/à  CULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOND1 LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER JMP TRMLU,I SPC 1 FOUND LDA EQT4 GET THE SPECIFIED LU INA AND NOW EQT 5 LDA A,I AND MEQT GET THE TYPE SZA,RSS DVR00 ? JMP FOND1 YES, WERE DONE LDA DRT MUST BE DVR05, SO GET DRT ADA LUNUM ADD LU # ADA DM1 DO OFFSET LDA A,I GET THE DRT VALUE AND MSUB GET THE SUB CHANNEL # SZA,RSS WAS IT THE CRT ? JMP FOND1 YES, SO DO IT. JMP NEXT SPC 1 EQT4 NOP MSUB OCT 174000 MEQT OCT 37400 DM1 DEC -1 LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B A EQU 0 B EQU 1 END åì ÿÿ ÿýøÿ ÿ92067-18063 2013 S C0122 &IFTTY              H0101 žþúASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED -IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92067-18063 * RELOC: PART OF 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFTTY,7 92067-16035 REV.2013 800211 ENT IFTTY,.TTY EXT EXEC * * ROUTINE TO DETERMINE IF THE SPECIFIED LU IS INTERACTIVE * CALLED AS FOLLOWS: * * IFLAG = IFTTY(LU) JSB IFTTY * DEF *+2 * DEF LU * * * IFLAG = A REG = -1 IF THE LU IS INTERACTIVE * = 0 IF THE LU IS NON-INTERACTIVE * B REG = UPPER BYTE = DEVICE TYPE * LOWER BYTE = SUBCHANNEL NUMBER * * * .TTY EQU * IFTTY NOP ENTRY DLD IFTTY,I GET RETURN ADDRESS & LU# LDB B,I GET THE LU # STA IFTTY SAVE RETURN ADDRESS STB ANLU# AND LU # SZB,RSS IF LU 0, THEN *2013 DLS* JMP UNDEF RETURN NON-INTERACTIVE.*2013 DLS* * JSB EXEC SEE IF THE LU IS INTERACTIVE DEF *+6 DEF D13I STATUS REQUEST DEF ANLU# THE LU WE WANT THE INFO ABOUT DEF YTEMP EQT WORD 5 PLACED HERE DEF DTYPE EQT WORD 4 PLACED HERE(NOT NEEDED) DEF ZTEMP SUB CHANNEL IN LOWER 5 BIT HERE JMP UNDEF IT AIN'T EVEN AN LU !!!! *2013 DLS* * LDA DTYPE GET EQT WORD 4 AND *2013 DLS* AND B77 ISOLATE I-O SELECT CODE. *2013 DLS* SZA,RSS IF LU ASSIGNED TO ZERO, *2013 DLS5u  * JMP UNDEF RETURN AS NON-INTERACTIVE.*2013 DLS* * LDA YTEMP GET EQT WORD 5 AND MEQT KEEP ONLY THE EQT TYPE FIELD LDB A AND SAVE IT LDA ZTEMP GET THE SUBCHANNEL BITS AND M37 STA ZTEMP ADA B CONFIGURE B REGISTER RETURN WORD STA DTYPE SZB,RSS IF DVR 00 THEN JMP ITSIN ITS INTERACTIVE CPB M2400 IF DVR 05 THEN JMP DVR05 DO ONE MORE CHECK FOR SUB CHANNEL CPB M3400 IS IT DVR07 ? JMP DVR05 THEN DO DVR05 CHECK JMP ITSNT ELSE ITS NOT INTERACTIVE * UNDEF CLB CLEAR INDICATOR OF DEVICE *2013 DLS* STB DTYPE TYPE AND SUBCHANNEL. *2013 DLS* JMP ITSNT RETURN AS NON-INTERACTIVE. *2013 DLS* * DVR05 LDA ZTEMP GET THE SUB CHANNEL # SZA,RSS IF = 0 THEN ITS ITSIN CCA,RSS SET INTERACTIVE FLAG ITSNT CLA SET NON INTERACTIVE FLAG LDB DTYPE JMP IFTTY,I RETURN TO CALLER * * D13I OCT 100015 M2400 OCT 2400 M37 OCT 37 B77 OCT 77 M3400 OCT 3400 MEQT OCT 37400 ANLU# NOP DTYPE NOP YTEMP NOP ZTEMP NOP A EQU 0 B EQU 1 END ²z ÿÿ ÿýù ÿ92067-18064 1826 S C0122 &LGLU4 RTE-IV LOGLU              H0101 ‚ZþúASMB,R,L,C ** LOGLU - RETURNS LU FROM PROGRAM ID SEGMENT HED -LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92067-18064 * RELOC: 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOGLU,7 92067-16035 REV.1826 780502 ENT LOGLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * CALLED AS FOLLOWS: * * LU = LOGLU(IDUMY) JSB LOGLU * DEF *+2 * DEF IDUMY * * * LU = A REG = LU # OF LU AT WHICH 'RU' OR 'ON' WAS ENTERED. * OR IF SCHEDULED BY A FATHER, THE LU AT WHICH * THE FATHER WAS SCHEDULED. * = 1 IF PROGRAM SCHEDULED BY INTERUPT OR TIME LIST * B REG = ASCII LU # * IDUMY = 0 IF IN SESSION * = -1 IF NOT IN SESSION * * LOGLU NOP ENTRY DLD LOGLU,I GET RETURN ADDRESS & DUMMY ADDRESS STB DUMMY SAVE DUMMY ADDRESS STA LOGLU &RETURN ADDRESS LDB XEQT GET MY ID ADDRESS ADB D14 INDEX TO TYPE WORD XLA B,I GET THE TYPE AND D7 CPA D1 ADB DM4 ADB D18 CALCULATE SESSION WORD ADDRESS XLA B,I GET THE SESSION WORD SZA,RSS IF = 0 WE ARE NOT IN SESSION CCA SO SET LU = -1 SSA ARE WE IN SESSION ? CCB,RSS NO CLB YES STB DUMMY,I GIVE ANSWER TO CALLER * SPC 1 ******************************uP  ********************************* * SESSION MONITOR LU RETRIEVAL CODE TO BE INSERTED HERE * *************************************************************** SPC 1 * CMA,INA MAKE LU POS STA LU# * CLB NOW CONVERT TO ASCII DIV D10 ALF,ALF ADB A ADB ASC00 B = ASCII LU # LDA LU# A = BINARY LU # JMP LOGLU,I RETURN * * * D1 DEC 1 D7 DEC 7 D14 DEC 14 D18 DEC 18 D10 DEC 10 D30 DEC 30 DM4 DEC -4 DUMMY NOP LU# NOP ASC00 ASC 1,00 XEQT EQU 1717B A EQU 0 B EQU 1 END Mç ÿÿ ÿýú ÿ92067-18065 1805 S C0122 &.IAE4 RTE-IV .IAE.              H0101 (#ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18065 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .IAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .IAY.,.ZAE. ENT .IAE. * DEC 1024 THIS IS THE ONE WORD .IAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 1024 DEF .IAY. * END í³ÿÿ ÿýû ÿ92067-18066 1805 S C0122 &.RAE4 RTE-IV .RAE.              H0101 2,ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18066 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .RAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .RAY.,.ZAE. ENT .RAE. * * DEC 1024 THIS IT THE TWO WORD/ELEMENT .RAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 512 DEF .RAY. * END Q#ÿÿ ÿýü ÿ92067-18067 1805 S C0122 &.XAE4 RTE-IV .XAE.              H0101 92ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18067 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .XAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .XAY.,.ZAE. ENT .XAE. * DEC 1023 THIS IS THE THREE WORD/ELEMENT .XAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 341 DEF .XAY. * END _Oÿÿ ÿýý ÿ92067-18068 1901 S C0122 &.TAE4 RTE-IV .TAE.             H0101 [ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18068 * RELOC: PART OF 92067-16035 * PGMR: G.A.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .TAE.,7 92067-16035 REV.1901 781128 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .TAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .TAY.,.ZAE. ENT .TAE. * DEC 1024 THIS IS THE FOUR WORD/ELEMENT .TAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 256 DEF .TAY. * END å[ÿÿ ÿýþ ÿ92067-18069 1901 S C0122 &.ZAE4 RTE-IV .ZAE.             H0101 hþúASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18069 * RELOC: PART OF 92067-16035 * PGMR: G.A.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .ZAE.,7 92067-16035 REV.1901 781128 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .TAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * * CALLING SEQUENCE TO THIS ROUTINE IS: * * DEC #WORDS/PAGE (MUST BE WHOLE ELEMENTS) * DEF TO DEFS TO OFFSET IN EMA AND -# ELEMENTS TO XFER * JSB .ZAE. RETURN IS TO ABOVE ADDRESS POINTED TO +2 * DEC #ELEMENTS/PAGE * DEF .IAY. OR .RAY. OR .XAY. OR .TAY. AS REQUIRED * EXT .EMAP,ERR0 ENT .ZAE. * #WDS NOP RTN NOP N3 DEC -3 A EQU 0 B EQU 1 FMTR NOP HOLD FORMATER ENTRY ADDRESS XIDEX EQU 1645B ADDRESS OF THE ID EXTENSION B174K OCT 1740”#þú00 SKP .ZAE. NOP THIS IS WHERE IT HAPPENS CLB SET TO DEFAULT TO ZERO IF NOT AN EMA PGM. LDA XIDEX FIRST GET INA THE XLA A,I EMA LOGICAL ADDRESS AND B174K ISOLATE THE PAGE RAR PUT IN RIGHT SPOT IN WORD STA EMAAD PUT IN THE .EMAP CALL LDA .ZAE. GET THE RETURN ADDRESS AND ADA N3 USE IT TO INDEX INTO THE DLD A,I THE DATA DST #WDS SAVE THE #WORDS AND THE RETURN ADDRESS DLD B,I GET THE DEF'S FOLLOWING THE CALL ISZ RTN SET UP THE PROPER RETURN ADDRESS ISZ RTN SET UP THE PROPER RETURN ADDRESS STB T1 SAVE THE ADDRESS OF THE COUNT DLD A,I GET THE OFFSET DST EMOF AND SET IN THE .EMAP CALL DLD .ZAE.,I GET THE #WORDS/X AND THE FMTR ENTRY PT. STB FMTR SAVE IN THE FORMATER CALL STA NELM ALSO SAVE THE DEFAULT COUNT DLD T1,I GET THE TOTAL NUMBER OF WORDS IN THE ARRAY T1 EQU *-1 AGAIN DST COUNT SAVE IT ASL 1 TEST IF INB,SZB LESS THAN 32K LEFT (SETS E IF SKIP) JMP OK NO GO DO THE DEFAULT XFER * ERA YES RESTORE THE COUNT ADA NELM TEST IF LESS THAN THE DEFAULT SSA WELL? JMP OK NO GO DO THE DEFAULT * LDB COUNT YES COMPUTE HOW MANY CMB,INB AND STB NELM SET FOR THE CALL * OK JSB .EMAP CALL .EMAP TO RESOLVE THE ADDRESS DEF BOOM EMAAD NOP ADDRESS OF EMA FROM THE IDEX DEF TABLE USE DUMMY TABLE BOOM JSB ERR0 TOO BAD YOU LOSE STB CALL SET ADDRESS FOR FMTR CALL JSB FMTR,I CALL THE FORMATER CALL NOP ADDRESS NELM NOP NUMBER OF ELEMENTS * CLE COMPUTE WHAT IS LEFT LDA EMOF FIRST THE ADA #WDS THE EMA OFFSET SEZ,CLE MOST IS A CARRY v ISZ EMOF+1 IF CHANGE STEP IT STA EMOF RESTORE THE OFFSET * DLD COUNT ADA NELM SUBTRACT FROM NUMBER LEFT SEZ,CLE MOST IS A CARRY OF 1 INB,SZB INDEX COUNT JMP AGAIN IF NO ROLL OVER THEN DO IT AGAIN * JMP RTN,I ELSE RETURN * * TABLE NOP NO DIMENSIONS EMOF NOP DOUBLE WORD EMA OFFSET NOP COUNT NOP DOUBLE WORD COUNT (NEGATIVE) NOP END ¢¬ÿÿ ÿýÿ ÿ92067-18070 1940 S C0122 &4ASB0 - ASSEMBLER SEGMENT 0             H0101 •þúASMB,R,L,C * * NAME: ASMB0 * SOURCE: 92067-18070 * RELOC: 92067-16070 * PGMR: C.C.H.,S.P.K. * * MODIFIED BY VERN MCGEORGE 13JUL79 TO COUNT CS & FMP ERRORS * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED * RTE ASMB0 92067-16070 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB0,5,99 92067-16070 REV.1940 790713 ENT ASMB0 SPC 1 EXT OPN.C,PRM.C,C.BIN,C.BIA,C.LST,C.SOR EXT WRT.C,C.TTY,RUN.C EXT ?BPKU,?PKUP,?RSTA,?SETM,?SEGM,?ASM1 EXT ?MESX,?FLGS,?AFLG EXT ?X,?LWA,?RFLG,?ICSA,?LSTL,?LINC,?PLIN,?ENFL EXT ?NEAU,?HA38,?ASME EXT ?FP,?FPT,?NDSY,?MOVE EXT ERRCN EXT ?PASS,?PLCN,?PLEN,?PNTR,?IOBF,?BUFF,?PBUF EXT ?TEMP,?BINF,?FMPE * * **************************** * * TEMPORARY AND FLAG REGION* * **************************** * A EQU 0 B EQU 1 SUP SUPPRESS EXTENDED LISTING .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .14 DEC 14 .54B OCT 54 , BLNK OCT 40 LOWER BLANK,UPPER 0 (=40B) TW10 OCT 176000 ADDRESS MASK .B OCT 102 .M201 DEC -201 .M202 DEC -202 NPRG ASC 2,NPRG ASMBN OCT 5757 SPC 2 LINC EQU ?LINC PLINE EQU ?PLIN PASS EQU ?PASS PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. * * I/O STATEMENT BUFFER * * *(INPUXFFER(BUFF) STARTS IN 11TH WORD)* IOBF EQU ?IOBF 50 WRDS+EOS BUFF. BUFF EQU ?BUFF PBUF EQU ?PBUF STASÅþúRT OF PUNCH BUFR(NAM FMT) * .BUFF DEF BUFF ADDRESS OF BUFFER PRMST ASC 1,]_ PROMPT CHARACTER SPC 1 ASMB0 LDA ?ENFL FLAG SET? SZA,RSS JMP OPNFL NO, THEN OPEN FILES JMP XRFSC YES,SCHEDULE XREF OPNFL LDA PRMST PROMPT CHARACTER JSB OPN.C NO, OPEN SOURCE FILE DEF C.SOR WITH REWIND OPTION JMP SRCER ERROR SEND OUT THE ERROR MESSAGE JSB OPN.C OPEN LIST FILE DEF C.LST LIST FILE FCB JMP LSTER SEND OUT ERROR MESSAGE JMP ASMD6 * SRCER CCB INDICATE SOURCE FILE CPA .M202 SOURCE NAMR NOT FOUND? RSS YES JMP ?FMPE NO, THEN DISPLAY FMP ERROR DLD NPRG YES, DISPLAY: JSB ?MESX /ASMB: NPRG JMP ?ASME EXIT * LSTER CLB JMP ?FMPE DISPLAY FMP ERROR * ASMD6 LDA ?ICSA CMA,INA STA ?LSTL CLA STA PASS SET PASS FLAG=0 (PASS 1) JSB ?RSTA READ AND PRINT CONTROL STATEMENT * * * TEST FOR 'ASMB' IN FIRST 4 POSITIONS * * LDA BUFF CMA,INA ADA BUFF+1 CPA ASMBN =5757B (I.E. =ASMB?) JMP COPS YES * * * CONTROL STATEMENT ERROR ROUTINE * * CSER ISZ ERRCN COUNT THE ERROR LDA .CS 'CONTROL' STATEMENT'ERROR LDB .CS+1 JSB ?MESX PRINT MESSAGE JMP ?ASME ASSEMBLER EXIT * * * TEST FOR CONTROL OPTIONS (A,B,C,F,L,N,R,T,X,Z) * * COPS CLA INITIALIZE STA XFOPT X OR F OPTION JSB PRM.C GET DEF .5 PARAMETER # 5 SZA,RSS OVER RIDE OPTIONS SPECIFIED? JMP COPST NO PROCESS STANDARD ASMB STMT * CLE,ERB DIVIDE BYTE ADDR BY 2 TO GET WORD ADDR SEZ WAS IT AN ODD BYTE ADDRESS? CMB,INB INDICATE STRING STARTS ON RIGHT BYTE STB MVSTR SOURCE ADDRESS OF WORDS LDA .5 CHECK FOR A OR R OPTION IN C+ÇþúS STRING STA PNTR IN THE SOURCE STATEMENT CLOOP JSB ?PKUP PICKUP A CHAR CPA BLNK DONE? JMP GETOP YES, GET OVER RIDE OPTIONS SZA,RSS 0? JMP GETOP YES, GET OVERRIDE OPTIONS CPA .54B COMMA? RSS YES JMP CSER NO, ERROR JSB ?BPKU SKIP BLANKS ISZ PNTR SET POINTER TO CHECK NEXT CONTROL OPTION CPA .R R OPTION? JMP RLOC YES CPA .A A OPTION? RSS YES JMP CLOOP NO, CHECK NEXT CONTROL OPTION STA ?AFLG RSS RLOC STA ?RFLG SET RELOCATABLE ASSEMBLY FLAG GETOP LDA .6 # OF CHARS IN STRING TO MOVE LDB .BUFF DESTINATION ADDRESS RSS LDB B,I REMOVE INDIRECTS RBL,CLE,SLB,ERB JMP *-2 JSB ?MOVE MVSTR NOP CLA,INA SET UP CHAR POINTER TO STRING STA PNTR RELATIVE CHAR POSITION W.R.T. BUFF OPLP JSB ?PKUP PICKUP NEXT CHAR CPA BLNK BLANK? JMP G YES, THEN TERMINATE CHECK JSB CHKOP NO, THEN CHECK OPTION LDB PNTR CMB,INB ADB .6 GREATER THAN 6? SSB JMP G YES, TERMINATE CHECK JMP OPLP NO, TEST FOR MORE SPC 2 COPST LDA .5 (5) STA PNTR SET PNTR = 5 COPUP JSB ?PKUP GET NEXT CHARACTER CPA BLNK DONE ? JMP G YES SZA,RSS CHAR=0? JMP G YES, 0K CPA .54B COMMA? RSS -YES- JMP CSER -NO- ERROR JSB ?BPKU SKIP BLANKS JSB CHKOP CHECK FOR OPTION ISZ PNTR JMP COPUP TEST FOR MORE CONTROL OPTIONS SPC 1 * TEST FOR VALIDITY OF CONTROL OPTION CHKOP NOP LDB ?FLGS LOC'N OF CONTROL CHAR SET CPA .B =B? (PUNCH) JMP CHKOP,I YES,IGNORE CPA .L =L? (LIST) JMP BCON YES CPA .R =R? (RELOC.-ñ_þúNOT NECESSARY) ADB .1 YES CPA .T =T? (SYMBOL TABLE PRINT) ADB .2 YES CPA .N IS IT FOR IFN? ADB .3 YES CPA .Z IS IT FOR IFZ? ADB .3 YES CPA .A =A? (ABSOLUTE ASSEMBLY?) ADB .4 YES CPA .C =C? (CROSS REF. TABLE?) ADB .5 YES CPA .Q =Q? JMP BCON YES,PRINT ONLY ADDRESS NOT INSTRUCTION CODE CPA .P =P (OVERRIDE OPTION?) JMP CHKOP,I YES, IGNORE IT CPB ?FLGS SKIP IF ANY OPTION FOUND JMP XTST NO NICE MATCH SO FAR BCON STA 1,I SET OPTION FLAG JMP CHKOP,I RETURN .L OCT 114 ASCII 'L' .N OCT 116 'N' .R OCT 122 'R' .T OCT 124 'T' .Z OCT 132 'Z' .A OCT 101 'A' .C OCT 103 'C' .X OCT 130 'X' .Q OCT 121 'Q' .P OCT 120 'P' .F OCT 106 'F' XFOPT DEC 0 'X' OR 'F' OPTION COUNT CNTX DEC -12 LENGTH OF FLOATING POINT OPCODE ENTRIES DESTN DEF ?FP LOC'N OF HDWE. 'FIX/FLT' OPCODES AS.FI OCT 43111 ASCII 'FI' TO ENABLE 'FIX/FLT' OPCODES DESLO DEF ?FPT LOC'N OF FLOATING POINT OPCODE ENTRIES * MVLC DEF *+1 FLOATING POINT OPCODE TBL. VALUES * * ****** FAD ******* ****** FDV ******* OCT 43101,42026,105000,43104,53026,105060 * * ****** FMP ******* ****** FSB ******* OCT 43115,50026,105040,43123,41026,105020 * * * END OF FLOATING POINT ENTRIES * * SKP CS.CK NOP LDA XFOPT LOAD A WITH OPTION FLAG SZA SKIP IF FLAG 0 JMP CSER IF 1 PRINT CS ERROR INA INCREMENT VALUE OF FLAG STA XFOPT SAVE IN FLAG POSITION JMP CS.CK,I RETURN * FMOVE JSB CS.CK GO CHECK LEGAL OPTION LDB DESTN ¿þú LOAD B WITH TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDR. IN B LDA AS.FI LOAD A WITH ASCII "FI" STA B,I STORE IN FIX PART OF TABLE LDB DESLO LOAD B WITH SECOND TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDR. IN B TMOV2 LDA MVLC,I LOAD FIRST WORD STA B,I STORE IN TABLE ISZ MVLC INCREMENT TO NEXT WORD INB INCREMENT POINTER ISZ CNTX INCREMENT COUNT, SKIP IF 0 JMP TMOV2 RETURN FOR NEXT WORD JMP BCON+1 RETURN * XTST CPA .F IS OPTION =F JMP FMOVE YES, GO CHANGE TABLE CPA .X IS OPTION =X JMP TMOVE YES, GO CHANGE TABLE JMP CSER NO, PRINT CONTROL STATEMENT ERROR! TMOVE JSB CS.CK CHECK IF F BEFORE LDB DESLC MOVE N-EAU OPCODE VALUES RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDRESS IN B TMOV1 LDA MOVLC,I OPCODE TABLE IN ASMB.. RAL,CLE,SLA,ERA CLEAR INDIRECT BIT, IF ANY. LDA A,I GET DIRECT ADDRESS. STA B,I STORE NEW VALUE INTO OPCODE TBL. ISZ MOVLC INB BUMP TABLE POINTER ISZ COUNX IS TABLE ALL MOVED? JMP TMOV1 NO, GO MOVE ANOTHER WORD. JMP BCON+1 COUNX DEC -13 LENGTH OF NEW TABLE DESLC DEF ?NEAU LOCATION OF OPCODE VALUE DESTIN. * MOVLC DEF *+1 NON-EAU OPCODE VALUES FOR TABLE. OCT 42111,53006 DIV DEF ?HA38 OCT 42114,42006 DLD DEF ?HA38 OCT 42123,52006 DST DEF ?HA38 OCT 46520,54406 MPY DEF ?HA38 OCT 0 END OF NEW TABLE * * TEST FOR COMPATABILITY AMONG THE OPTIONS * * G LDB ?AFLG LDA ?RFLG SZB,RSS IS 'A' SET? JMP *+3 SZA YES - IS 'R' SET? JMP CSER YES - CONTROL CONFLICT LDA ?X GET FWâ€þúA OF AVAILABLE CORE CMA,INA ADA ?LWA LWA-FWA AVAIL MEM. IN A INA A NOW = SYMBOL TBL LENGTH * * * CLEAR SYMBOL TABLE * * LDB ?X FWA OF SYM TBL TO 'B' STB ?NDSY SET ADDRESS OF END OF SYMBOL TABLE JSB ?SETM NOP SET SYMBOL TABLE TO ZERO * ********************* * * START PASS 1 HERE * * ********************* LDB ?AFLG GET ABSOLUTE ASSEMBLU FLAG SZB,RSS ABSOLUTE ASSEMBLY? JMP RELOC NO JSB OPN.C YES DEF C.BIA ABSOLUTE BINASY FILE FCB OUTER CLB,INB,RSS ERROR JMP ASMD5 CPA .M201 IS THE ERROR BINARY FILE NOT SPECIFIED? JMP ASMD7 YES, THEN DO, NOT OUTPUT BINARY JMP ?FMPE NO, THEN PRINT ERROR MESSAGE RELOC JSB OPN.C RELOC. ASSEMBLY DEF C.BIN BINARY RELOCATABLE FCB JMP OUTER ERROR ASMD5 CLA,INA SET FLAG TO INDICATE STA ?BINF BINARY OUTPUT IS PRESENT ASMD7 LDA TW10 STA ?ASM1 SET FLAG FOR 'INIT' PROCESSING CLA STA PASS SET PASS FLAG FOR PASS 1 STA PLCN INITIALIZE PROG LOC'N COUNTER STA PLEN CLEAR LITERAL LENGTH FLAG LDA EXTLN GET LENGTH OF NAM EXTENSION AREA. LDB EXTAD GET FWA OF NAM EXTENSION. JSB ?SETM GO SET BLANKS INTO THE AREA. ASC 1, DUAL ASCII BLANKS. LDA .3 SEG. CALL FOR ABSOLUTE LDB ?AFLG GET ABSOLUTE-ASSEMBLY FLAG. SZB,RSS ABS. ASSY? - SKIP IF TRUE. CLA,INA PICK UP CODE FOR ASMB1 JMP ?SEGM GO TO LOAD THE NEXT SEGMENT .CS ASC 2,CS ASCII 'CS' FOR CONTROL STMT. ERROR MSG. EXTAD DEF PBUF+17 FWA OF NAM EXTENSION AREA. EXTLN EQU .54B (54B) LENGTH OF NAM EXTENSION AREA. * * THIS SECTION IS ENTERED TO SCHEDULE XREF ANDEOR * TERMINATE THE ASSEMBLER * * XRFSC LDA LINC+1 GET CURRENT PAGE # CMA,INA NEGATE FOR SØB*($IGNAL TO XREF STA PRMLS+3 SAVE IN PARAMETER LIST LDA PLINE GET THE NEGATED # LINES/PAGE CMA,INA MAKE THE VALUE POSITIVE STA PRMLS+4 SET IT IN PARAMETER LIST * JSB WRT.C INFORM THE OPERATOR DEF C.TTY THAT THE CROSS-REFERENCE GENERATOR DEF TELOP HAS BEEN SCHEDULED DEF .12 NOP * JSB RUN.C SCHEDULE THE XREF PROGRAM DEF C.SOR SOURCE FILE FCB DEF C.LST DEF XREF NAME OF PROGRAM DEF PRMLS PARAMETER LIST JMP ?ASME TERMINATE ASSEMBLER * PRMLS NOP BSS 4 TELOP ASC 4, /ASMB: XREF ASC 3,XREF ASC 5,SCHEDULED .12 DEC 12 * END ASMB0 ¿*ÿÿ ÿý  ÿ92067-18071 1940 S C0222 &4AS11 - ASSEMBLER SEGMENT 1             H0102 ø˜þúASMB,R,L,C * * NAME: ASMB1 * SOURCE: 92067-18071 * RELOC: 92067-16071 * PGMR: C.C.H.,S.P.K. * MOD 77-01-30 ADDED DEY INST EAS * MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD & GEN INSTR. * MODIFIED BY VERN MCGEORGE 13JUL79 TO REPORT "SY" ERROR IN NAM * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB1 92067-16071 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB1,5,99 92067-16071 REV.1940 790713 ENT ASMB1 SPC 1 EXT RWN.C,C.SOR SPC 1 ENT ?LITI,?CMQ,?INSR,?HA3Z,?ENP,?EXP,?EMP EXT ?RSTA,?ERPR,?MOVE,?CHPI,?OPER,?PLIT,?ORGS EXT ?ASCN,?BPKU,?MSYM,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?SEGM,?PNCH,?V,?X,?T EXT ?ICSA,?TFLG,?LTFL,?CNTR EXT ?ARTL,?ASM1,?ORRP,?BNCN,?DCOD,?MESX,?PRNT EXT ?LABE EXT ?OPLK,?NDOP,?NDSY,?ENER,?PRPG EXT ?BPSV,?GETA,?GETC,?SYMT,?FMPE SPC 2 EXT ?NAMI,?NAME,?SUMP,?FLEX,?CNTB,?CODE,?INST EXT ?LAST,?PEEK,?PLCN,?PLEN,?PNTR,?SCN1,?SYMI EXT ?SYMP,?TEST,?ENT.,?ENTC,?ENTV,?IOBF,?BUFF EXT ?PBUF,?TEMP,FUBP,FUBP2 SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .29 DEC 29 .M8 DEC -8 .M15 DEC -15 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO BLNS ASC 1, BIT15 OCT 100000 .E OCT 105 .B OCT 102 RC ASC 5,E R B C X TEMP EQU ?TEMP NAMI EQU ?NAM!KþúI LOC'N FOR TEMP SYMBOL STORAGE NAME EQU ?NAME FOR USE BY 'OPLK' SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' FLEX EQU ?FLEX 'ASCN' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PEEK EQU ?PEEK LAST CHAR PICKED UP PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU ?SYMI ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N TEST EQU ?TEST TEST CHARACTER ENT. EQU ?ENT. ENTC EQU ?ENTC ENTV EQU ?ENTV * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF * *(INPUT BUFFER 'BUFF' STARTS IN 11TH WORD)* BUFF EQU ?BUFF PBUF EQU ?PBUF SAVES THE 'NAM' RECORD INFO. OCT 0 EXTRA WORD FOR BUFFER OVERFLOW. WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. SPC 1 ASCN EQU ?ASCN BPKUP EQU ?BPKU CHOP EQU ?CHOP CHOPI EQU ?CHPI CNTR EQU ?CNTR ERPR EQU ?ERPR GETA EQU ?GETA GETC EQU ?GETC LTFLG EQU ?LTFL MOVE EQU ?MOVE MSYM EQU ?MSYM MSYMS EQU ?MSYS OPERR EQU ?OPER ORGSV EQU ?ORGS PKUP EQU ?PKUP PNCH EQU ?PNCH RSTA EQU ?RSTA SYMTS EQU ?SYMT T EQU ?T X EQU ?X * ICNTR DEC -6 ATBL DEF *+1 PBF9 DEF PBUF+9 CSAD DEF PBUF+3 POINTS AT PUNCH BUFFER DSTAD DEF PBUF+17 ADDR: NAM EXTENSION BUFFER PBF8 DEF PBUF+8 ADDRESS: NAM-RECORD COMMON DECLARATION SNOB DEF IOBF+5 BUFFER ORIGIN FFUB DEF BUFF SPC 1 * ASMB1 LDA ATBL,I GET AN INDIRECT ADDRESS RSS LDA A,I REMOVE ONE LEVEL OF INDIRECT RAL,CLE,SLA,ERA BIT 15 SET? JMP *-2 YES STA ATBL,I RESTORE DIRECT ADDRESS ISZ ATBL ISZ ICNTR ALL ADDRESSES DONE? JMP ASMB1 NO * ASMBA JSB RSTA LDA CODE CPA .15 'HED' STATE? JMP ñ,þúIXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS CPA .13 (13) NAM ? JMP HI12 * * * NO NAM OR ORG * * LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMBA * * * * PROCESS NAME FOR BINARY RECORD * * .SY ASC 1,SY PNSAV OCT 0,0 FOR USE IN 'NAM' SETUP HI12 LDB SCN1+2 JSB MSYM MEASURE THE NAME STB HI14 STA PNSAV SAVE # OF CHARS IN THE PARAMETER * LDB A CHECK FOR NAM TOO LONG CMB,INB ADB .5 SSB,RSS ERR < 0 / OK >= 0 JMP HI13 OK NAM <= 5 CHARACTERS LDA .SY NOT OK NAM > 5 CHARACTERS JSB ERPR REPORT ERROR LDA PNSAV RESTORE A REG (NESSESSARY ?) * HI13 LDB TEST GET CONTINUATOR STB PNSAV+1 AND SAVE IT LDB CSAD JSB MOVE MOVE IT TO THE 'NAM' RECORD HI14 NOP LDA PNSAV+1 GET THE CONTINUATOR CPA L+4 COMMA?(ANOTHER PARAMETER?) RSS YES JMP HI16 NO - GO TEST FOR END LDA PNSAV GET # OF CHARS IN CURRENT PARAME ADA PNTR INA STA PNTR SET POINTER TO NEXT PARAMETER JSB BPKUP SCAN TO NEXT PARAM. JSB MSYM MEASURE IT STA PNSAV SAVE # OF CHARS IN THE PARAMETER ALF,ALF INA FOR DECIMAL CONV ALF,ALF POSITION IT STA 1 PARAM. FOR 'ASCN' TO 'B' REG. LDA TEST GET CONTINUATOR STA PNSAV+1 AND SAVE IT LDA PNTR GET POSITION OF NUMBER JSB ASCN GO CONVERT THE NUMBER CLA ERROR RETURN, SET 'A' =0 STA PBF9,I ISZ PBF9 JMP HI14+1 HI16 CPA BLNK LEGAL? RSS YES JSB OPERR NO - PRINT 'M' ERROR LDA PBUF+9 SZA,RSS IS TYPE=0(SYSTEM)? STA PBUF+10 YES, SET PRIORITY = 0. SPC 1 * 0œþú * EXTENDED NAM RECORD PROCESSOR * SPC 1 LDA PNSAV GET # OF CHARS. IN CURRENT PARAM. ADA PNTR INA SET POINTER TO NEXT PARAMETER. STA PNTR SAVE FOR BUFFER MOVE. CMA,INA COMPUTE THE NUMBER OF ADA SCN1 ADDITIONAL CHARACTERS, IF ANY. SSA,INA MORE ? JMP HA32 NO. STA PNSAV YES. SAVE CHARACTER COUNT. LDA PNTR RELATIVE POINTER TO START JSB GETA OF NAM RECORD EXTENSION STB SRCAD SOURCE BUFFER. LDA PNSAV GET NUMBER OF CHARACTERS, LDB DSTAD AND DESTINATION ADDRESS JSB MOVE FOR DATA MOVE. SRCAD NOP LDA PNSAV CONVERT NUMBER OF INA CHARACTERS TO ARS NUMBER OF WORDS. ALF,ALF POSITION TO UPPER BYTE. ADA WCNT COMPUTE TOTAL NAM-REC WORD COUNT STA WCNT SAVE FOR PUNCH ROUTINE. * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO 'END' PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA71 YES, GO TO RPL PROCESSOR. CPA .100B USER MICROCODE (MIC)? JMP MIC YES, GO PROCESS. ADA .M3 (-3) SSA ORR/ORB/ORG ? JMP HA64 YES, ROUTE TO PROCESSOR. CPA .12B NAM? JMP HA63 YES, ERROR ADA .M3 (-3) SSA 'COM','ENT','EXT' OR 'EMA' ? JMP INST,I JUMP TO ROUTINE DESIGNATED IN INST CPA .5 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .13 (15B) SPC? JMP HA32 IGNORE-PASS #1. CPA .14 (16B) LST/UNL? JMP HA32 ‰Îþú IGNORE-PASS #1. * * * TEST FOR LABEL FIELD * JSB LABEL LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA DEY IF INST = DEY THEN JMP HA40 GO PROCESS IT CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA .7 (7) JMP HA54 TO ASC CPA .33B (33 OCTAL) GEN INFORMATION RECORD JMP GENR YES, USE GEN PROCESSOR CPA .34B (34 OCTAL) LOADER INFO RECORD JMP LODR YES, USE LOD PROCESSOR CPA .26B INTEGER ARITH(HARDWARE)? JMP HA70 YES.... CPA .6 (6) ARITH MACRO? JMP INST,I YESM JUMP TO PROCESS IT.. ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROCESSOR. CPA .4 (4) MEM REF? JMP HA3L YES,TEST FOR LITERAL LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL. SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * * HA3Z ADA PLCN ADD CURRENT LOC'N. STA PLCN SAVE NEW PROG. LOC'N COUNT. JMP HA32 GO TO GET NEXT STATEMENT. .26B OCT 26 FOR HARDWARE ARITHMETIC SPC 1 * * PROCESS BSS * * HA3M JSB CHOPI EVALUATE OPERAND. JMP HA32 * ERROR * LDA 1 B TO A JMP HA3Z GO UPDATE PROG. LOC'N COUNT. HA3L LDA LTFLG SZA,RSS LITERAL PRESENT ? JMP HA3B NO LDA INST SLA IS LITERAL LEGAL WITH INST? JMP *+3 YES JSB OPERR NO 'M' ERROR JMP HA3B JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR JMP HA3B * .M3 DEC -3 .12B OCT 12 .32B OCT 32 .33B OCôþúT 33 .34B OCT 34 .100B OCT 100 M100B OCT -100 .M10 DEC -10 BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' DEX OCT 25 OP TYPE FOR 'DEX' DEY OCT 44 OP TYPE FOR 'DEY' ENFLG NOP FLAG FOR PROCESSING ENTRY POINTS S BSS 1 * SKP * * PROCESS 'COMMON' DECLARATION * * CMQ LDA SCN1+2 STA PNTR SET POINTER STA TEST SET TEST (U) = 0. CMQA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR ! GO TO GET NEXT STATEMENT. LDB PBF8,I SAVE CURRENT COM. LOC'N STB S FOR SYMBOL TABLE VALUE. LDB TEST GET CHARACTER FOLLOWING THE SYMBOL. CPB L+4 COMMA? JMP HM2 YES CPB BLNK END OF OPERAND ? JMP HM2 YES, IT'S = BLANK CPB L LEFT PAREN? RSS YES, = ( JMP HA55+1 NO. ERROR: 1ST PASS JSB BPKUP SKIP BLANKS STB TEMP+1 SAVE POINTER JSB MSYM MEASURE COM LENGTH STA TEMP SAVE NUMBER OF CHARACTERS JSB SPNTR ALIGN POINTER LDA TEST CPA L+1 RT PAREN? RSS YES, = ) JMP HA55+1 NO. 1RST PASS ERROR! STA PEEK LDB TEMP LDA LAST ADB .M1 LENGTH-1 TO B REG CPA .B =B? (OCTAL VALUE) RSS YES-SKIP ADB .401B NO, SET FOR DECIMAL LDA TEMP+1 JSB ASCN GO TO ASCII CONVERSION ROUTINE JMP HA32 ERROR EXIT ADA PBF8,I BUMP LENGTH OF OOMMON STA PBF8,I * * * INSERT 'COMMON' SYMBOL INTO TABLE * HM3 LDA .3 SET RELOC=COMMON LDB S VALUE TO B JSB INSR INSERT SYMBOL NOP ERROR EXIT LDA PEEK CPA BLNK BLANK? JMP HA32 YES, EXIT TO HA32 CPA L+4 COMMA? RSS YES JSB PKUP GET NEXT CHAR JSB ENDTS TEST FOR TERMINATION JMw½þúP CMQA HM2 ISZ PBF8,I STB PEEK SAVE TEST JMP HM3 * * PROCESS 'EXT' DECLARATION * EXP LDA SCN1+2 STA PNTR SET POINTER EXPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDB CNTR VALUE TO B LDA .4 (4) EXT INDIC. JSB INSR GO TO INSERTION ROUTINE JMP *+2 ERROR EXIT ISZ CNTR BUMP EXT CNTR LDA TEST JSB ENDTS TEST FOR TERMINATION JMP EXPA GO BACK, THERE'S ANOTHER 'EXT'!! * * * PROCESS 'ENT' DECLARATION * ENP LDA .10B SET ENFLG = 10B STA ENFLG LDA SCN1+2 STA PNTR SET POINTER ENPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDA .210B SET 'U' & 'E' FIELDS = 1 CLB JSB INSR INSERT INTO THE SYMBOL TABLE NOP LDA TEST JSB ENDTS TEST FOR TERMINATION JMP ENPA ENDTS NOP TEST FOR TERMINATION CPA BLNK OF COM,ENT OR EXT JMP HA55E CPA L+4 COMMA? RSS YES JMP HA55+1 NOT AN ERROR EXIT JSB BPKUP SCAN TO NEXT CHAR. JMP ENDTS,I * * PROCESS 'EMA' DECLARATION EMP CLA,INA SET EMA FLAG STA EMFLG LDA EMCNT COUNTER FOR # OF EMA INSTR. SZA AN EMA INSTR ALREADY ENCOUNTERED? JMP EMAIL YES, THEN ERROR LDA SCN1+2 SET POINTER TO FIRST OPCODE'S STA PNTR RELATIVE CHARACTER POSITION LDA .2 PRETEND IT IS AN ASC INSTRUCTION JSB CHOP GET VALUE OF FIRST OPERAND JMP HA32 ERROR RETURN SZA IS VALUE ABSOLUTE? JMP EMAOP NO THEN OPERAND ERROR LDA SUMP SAVE VALUE OF FIRST OPERAND STA EMASZ WHICH IS EMA SIZE * JSB PKUP PICKUP NEXT CHAR CPA L+4 IS IT A COMMA? RSS ïñþú YES JMP EMAOP NO, THEN ERROR JSB BPKUP SKIP OVER ANY BLANKS STB SCN1+2 SET OPERAND POINTER AT 2ND PARAMETER CLA SET A=0 FOR NO COMMA JSB CHOP GET VALUE OF THE MSEG SIZE JMP HA32 ERROR RETURN SZA ABSOLUTE VALUE? JMP EMAOP NO, THEN ERROR-BAD OPERAND LDA SUMP YES, GET VALUE STA MSGSZ SAVE THE MAPPING SEGMENT SIZE * TEST FOR VALIDITY OF EMA SIZE AND MSEG SIZE LDA EMASZ GET EMA SIZE SSA -VE? JSB EMAOP YES, THEN OPERAND ERROR CMA,INA NEGATE EMA SIZE ADA .1023 MUST BE LESS THAN 1024 SSA EMA SIZE LESS THAN 1024? JMP EMAOP NO THEN OPERALND ERROR LDA MSGSZ NO, GET MSEG SIZE SSA -VE? JMP EMAOP YES, THEN OPERAND ERROR CMA,INA NEGATE MSEG SIZE ADA .31 SSA IS IT LESS THAN 32? JMP EMAOP NO, THEN ERROR * BOTH OPERANDS ARE VALID , TEST FOR LABEL JSB LBCK LABEL PRESENT? STA SYMP YES, SET CHARACTER COUNT LDB FFUB GET BUFFER ADDRESS STB SYMP+1 SET LABEL ADDRESS LDA .4 EXT INDICATOR LDB CNTR ORDINAL # - VALUE JSB INSR INSERT EMA LABEL INTO SYMBOL TABLE JMP HA32 ERROR EXIT ISZ CNTR INCREAMENT ORDINAL# CLA STA EMFLG CLEAR EM FLAG INA SET EMA COUNT TO INDICATE AN EMA STA EMCNT INSTRUCTION HAS ALREADY BEEN ENCOUNTERED JMP HA32 READ NEXT STATEMENT * PRINT EMA ERRORS EMAOP JSB OPERR OPERAND ERROR JMP HA32 READ NEXT STATEMENT EMAIL LDA .IL 'IL' ILLEGAL INSTR ERROR JSB ERPR PRINT ERROR MESSAGE JMP HA32 READ NEXT STATEMENT * EMASZ NOP MSGSZ NOP EMFLG NOP EMCNT NOP .31 DEC 31 .1023 DEC 1023 * HA55E CLA STA ENFLG CLEAR 'ENT'FLAG JMP HA32 EXIT ON A BL5þúANK SPC 1 * * PNTR+1+'A' TO PNTR * SPNTR NOP ADA PNTR INA STA PNTR JMP SPNTR,I * .10B OCT 10 .210B OCT 210 SPC 1 HA63 LDA .IL NAM IS ILLEGAL AFTER START JMP HA55+2 TO ERPR * ************************************************* * * INSR: ADD ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: A = TYPE B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * ************************************************* .EN ASC 3,ENDDSO INSR NOP STA FLX1 SAVE TYPE STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP JMP INS1 NOT FOUND; GO TO INSERT. LDB ENFLG ALREADY THERE. SZB,RSS IN ENTRY PROC? JMP INSY NO ADA .M4 (-4) CHECK SYMBOL TYPE: SSA IS IT ABS,REL,B.P.,OR COM ? JMP INSC YES ENERR LDA .EN 'EN' ERROR: WRONG TYPE, DUPLICATE OR JMP INSX REFERENCE TO EXT-DEFINED SYMBOL. INSY AND .7 ISOLATE SYMBOL TYPE. LDB FLEX GET CURRENT FW OF ENTRY. SSB,RSS UNDEFINED ENTRY POINT? JMP INSG NO BLF IS THE 'E' BIT SET? SSB,RSS JMP INSG NO, THEN AN EMA LABEL LDB FLX1 YES, GET CURRENT SYMBOL TYPE CPB .4 EQUATING EXT TO ENT-DEFINED SYMBOL? JMP INSX-1 YES: 'DD' ERROR! ADA .M4 NO, CHECK TYPE: SSA,RSS ABS,REL,B.P. REL,OR COM? JMP ENERR INVALID TYPE FOR ENT! LDA FLX1 GET SYMBOL TYPE. ALF,ALF POSITION TO BITS #8-11 IOR FLEX INCLUDE ORIGINAL DATA, ELA,CLE,ERA CLEAR UNDEFINED BIT. LDB NAME+3 SET VALUE INTO STB TEMP+1,I SYMBOL TABLE ENTRY. oþú JMP INSEX-1 FINISH PROCESSING. INSG CPA .7 LITERAL? JMP INSR,I YES, EXIT CPA .4 EXT? JMP INSZ YES, TEST INSE LDA .EN+1 NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR JMP INSR,I GET OUT HERE INSZ LDB FLEX EMA? SSB IS THE 'U' BIT SET? JMP INSE YES, ERROR LDB EMFLG IN EMA PROCESS? SZB JMP INSE YES, ERROR CPA FLX1 ARE BOTH EXT'S? JMP INSR,I YES, FAKE 'DD'EXIT (FOR ARITH. MACRO'S). JMP INSE GO TO ERROR PRNT INS1 LDA FLX1 ALF,ALF ADA NAME TYPE IN FIRST WORD LDB EMFLG IN EMA PROCESS? SZB IOR BIT15 YES, SET 'U' BIT TO INIDICATE EMA LABEL STA NAME OF ENTRY LDB NAMI ADB TEMP+2 STB TEMP+1 SET LIMIT LDA ?NDOP LWA-1 FOR SYMBOL TABLE CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .EN+2 'SO' SYMBOL TABLE OVERFLOW JMP INSX 'SO' ERROR LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA TEMP+1 JMP INS5 GO SET NEW END OF SYMBOL TABLE. INA ISZ SYMI JMP *-6 INS5 LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. JMP INSEX EXIT. INSC LDA .4000 IOR TEMP+4,I STA TEMP+4,I SET ENTRY POINT TYPE INSEX ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE .M4 DEC -4 * * ************************************ * * INSERT LITERAL INTO SYMBOL TABLE * * ************************************ LITIN NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 LDA .7 (7) STA LTFLG LDB PLEN JSB INSR INSERT SYMBOL JMP LITIN,I ERROR RETN. ISZ PLEN BUMP L þúITERAL LOC'N CNTR ISZ LITIN JMP LITIN,I EXIT(NORMAL) * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .2 B=3 IF CODE IS 'DEX' CPA DEY IF CODE = DEY THEN LDB .4 SET WORD COUNT = 4 STB TEMP+5 SET LOCN COUNT BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * * HA41 JSB PKUP LDB TEMP+5 GET COUNT BUMPER CPA L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. ADB .M2 IF (TYPE=DEX) OR (TYPE=DEY) THEN SSB,RSS JMP HA42 GO CONTINUE SCAN LDB TEMP+5 CPA L+6 PERIOD? JMP HA48 YES, GO TEST FLT. POINT. CPA .E 'E' ? JMP HA48 YES, GO SEE IF DECIMAL PT., ALSO HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB TEMP+5 GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA TEMP+5 ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NO. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT * * ******************************** * * PROCESS ASC (GET VALUE OF N)°þú * * ******************************** HA54 LDA .2 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 ERROR-NOT ABS.VAL. SZB,RSS ZERO WORDS? JMP HA55 YES - * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * INFER LDA .MBLN 'M' ERROR(BAD OPERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * * ******************************************************** * * * * * SYMCK: CHECK FOR A VALID SYMBOL * * * ENTER: = DON'T CARE. * * * = 'PNTR' (RELATIVE POS'N 1RST CHAR.) * * * RETURN: P+1 - INVALID SYMBOL ('SY' ERROR PRINTED) * * * P+2 - VALID SYMBOL. * * * * * * * * ******************************************************** SYMCK NOP STB PNTSV SAVE 'PNTR' FOR LATER RESTORATION. JSB MSYMS GO TO MEASURE THE SYMBOL. STA SYMSZ SAVE CHARACTER COUNT. CMA,INA NEGATE THE COUNT, STA SMCNT AND SAVE FOR 'SYMTS' LOOP COUNT. LDA TEST GET CONTINUATOR CHARACTER AND STA SYTST SAVE FOR LATER RESTORATION. LDA PNTSV GET POINTER TO FIRST CHARACTER. JSB GETC GO TO GET THE CHARACTER. LDB SMCNT GET NEGATIVE SYMBOL SIZE. JSB SYMTS GO TO CHECK FOR LEGAL SYMBOL. RSS ** ERROR: SET RETURN TO P+1. ISZ SYMCK VALID: SET RETURN TO P+2. LDA PNTSV RESTORE FORMER CONTENTS STA PNTR OF CHARACTER POINTER. LDA SYMSZ GET SYMBOL MEASUREMENT. JSB SPNTR GO TO ALIGN 'PNTR' FOR NEXT USE. LDA SYTST REpþþúSTORE THE STA TEST ORIGINAL CONTINUATOR. JMP SYMCK,I RETURN: P+1=ERROR; P+2=O.K. * PNTSV NOP TEMP. STORAGE: 'PNTR'. SYMSZ NOP TEMP. STORAGE: SYMBOL SIZE. SMCNT NOP TEMP. STORAGE: -SYMSZ. SYTST NOP TEMP. STORAGE: 'TEST'. * * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND JMP HA32 * ERROR * STB TEMP+1 CPA .4 (4) EXT ? RSS JMP HA57 LDA .5 (5) SET FOR NON-PNCH EXT LDB FLEX IS THIS AN EMA? SSB,RSS JMP HA57 NO CLB,INB YES,THEN SET EMA FLAG STB EMFLG HA57 STA TEMP NO CLB,INB JSB MSYMS GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP CLA CLEAR EMA FLAG STA EMFLG JMP HA32 * ******************************* * * ORB ORG ORR PROCESSOR JUMPS * * ******************************* HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDB LTFLG GET LITERAL FLAG SZB IS A LITERAL IN THE OPERAND? JSB ?ARTL GO PROCESS THE LITERAL LDA .2 A=2 JMP HA3Z * ********************************** * * PROCESS REPLACEMENT CODE (ENT) * * ********************************** HA71 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND. JMP HA32 *ERROR* GET NEXT STATEMENT. STB TEMP+1 SAVE OPERAND. CLB,INB POINT TO 1RST CHAR. OF LABEL. JSB MSYMS MEASURE SYMBOL,SET SYMP/SYMN LDA .14 (16B)CODE-REPLACEMENT ENT RECORD. LDB TEMP+1 GET REPLACEMENT CODE VALUE. JSB INSR INSE/fTRNRT SYMBOL & VALUE IN TABLE. NOP (ERRORS ARE ALREADY NOTED) JMP HA32 GO GET NEXT STATEMENT. ¾KTÿÿþú* * * LABEL PRESENCE DETECTOR * * LBCK NOP LDA SCN1+3 GET LABEL LENGTH. SZA LABEL PRESENT ? JMP LBCK,I YES, RETURN. * LDA .LB NO. GET ASCII ERROR CODE. JMP HA55+2 GO TO NOTE THE ERROR. .LB ASC 1,LB * SKP * ************************************* * * * * * PROCESS THE GENERATOR AND LOADER * * * INFORMATION RECORDS. OUTPUT THE * * * RECORDS THIS PASS PRIOR TO THE NAM* * * * * ************************************* * INFO NOP INFORMATION RECORD FLAG B160K OCT 160000 IDENT 7 SUBIDENT 0 B162K OCT 162400 IDENT 7 SUBIDENT 5 IPTR NOP DATA POINTER INTO PUNCH BUFFER CNTC NOP LOOP COUNTER BFAD DEF IOBUF BFAD3 DEF IOBUF+3 DPBUF DEF PBUF+0 IOBUF BSS 35 * GENR LDA B160K SET A FOR GEN INFO RECORD JMP LODR1 GO DO COMMON PROCESSING * LODR LDA B162K SET A FOR LOD INFO RECORD LODR1 STA IOBUF+1 SAVE IN PUNCH BUFFER LDA .4 GET RECORD LENGTH STA IOBUF SAVE IN WORD COUNT LDA BFAD3 GET DATA DESTINATION ADDRESS STA IPTR SAVE AS POINTER * LDA SCN1+2 INITIALIZE AS FOR ASC PROCESSING STA PNTR LDA .M1 STA T+1 LDA .2 (2) INDICATES ASC JSB CHOP GO EVALUATE WORD LENGTH JMP INFER * ERROR EXIT * SZA VALUE ABSOLUTE? JMP INFER NO, * ERROR * SZB,RSS ASKING FOR ZERO WORDS? JMP INFER YES, * ERROR * ADB .M29 (-29) (VALUE IS IN SUMP TOO) SSB,RSS VALUE > 28? JMP INFER YES, * ERROR * LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE (COMPLEMENT) TO LOOP COUNT * INFLP ISZ T POINT TO NEXT CHARACTER IN STRING LDA T GET CHARACTER ADDRESS JSB GETC GET CHARACTER ALF,ALF ˜‘þú SHIFT TO UPPER HALF STA TEST SAVE IN TEST FOR LOWER HALF ISZ T POINT TO NEXT CHARACTER IN STRING LDA T GET CHARACTER ADDRESS JSB GETC GET NEXT CHARACTER STA IPTR,I STORE INTO PUNCH BUFFER CLA STA TEST ISZ T+1 ISZ IOBUF INCREMENT WORD COUNT ISZ IPTR INCREMENT OUTPUT BUFFER ADDRESS ISZ CNTC INCREMENT LOOP COUNTER JMP INFLP LOOP IF NOT DONE * LDA IOBUF GET WORD COUNT ALF,ALF SHIFT TO UPPER HALF STA IOBUF AND SAVE LDA BFAD SET UP OUTPUT BUFFER ADDRESS STA FUBP FOR THE PUNCH ROUTINE ADA .2 SET UP CHECKSUM ADDRESS STA FUBP2 FOR THE PUNCH ROUTINE JSB ?PNCH FORCE A WRITE LDA DPBUF RESTORE PBUF ADDRESS STA FUBP FOR THE PUNCH ROUTINE ADA .2 RESET THE CHECKSUM STA FUBP2 FOR THE PUNCH ROUTINE JMP HA32 GO DO NEXT LINE * ************************ * * PASS 1 END PROCESSOR * * ************************ NOP HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS CCA SET ?TFLG TO -1 TO INDICATE IN STA ?TFLG THE PROCESS OF PRINTING THE SYMBL TBL LDA FFUB ADA .4 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA COMPLETED? JMP HBW NO CLA YES, CLEAR ?TFLG STA ?TFLG JMP HB08 GO TO FINISH PASS 1 HBW JSB MBLNK SET UP BLANKS IN SYMBOL OUT AREA * * * GET RELOCATION INDIC. CHAR. LDA ENTV,I ALF,ALF AND .7 (7) CPA .7 LITERAL ENTRY? JMP HBY YES. CLB CPA .6 (6) REPLACEMENT CODE ENTRY ? LDB ¦þúSBLN YES, GET ASCII S-BLNK. SZB,RSS SKIP IF INDICATOR PRESENT. JSB ?DCOD CPB RC+4 RSS JMP HBZ LDA ENTV,I SSA LDB RC HBZ STB BUFF+3 * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB .M1 ADB ENTV STB ENTV LDA 1,I ISZ ENTV CLE SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .14 (14) JSB ?PRNT GO TO PRINT JMP HBX ENTRY DONE. HBY LDA SUMP NO.WDS IN ENTRY ADA ENTV + ADDR OF ENTRY STA ENTV = ADDR OF NEXT ENTRY JMP HBX SBLN ASC 1,S .PASS ASC 2,PASS * SKP * * * ERRORS PRINTED * * HB08 JSB ?ENDS CLOSE OUT THE PASS SPC 1 * *********************** * * * START PASS 2 HERE * * * *********************** SPC 1 * TEST FOR PUNCH OUTPUT JMP NMP GO - PUT OUT START OF BIN DK HB11 JSB RWN.C REWIND SOURCE FILE DEF C.SOR SOURCE FILE FCB JMP HBERR LDA .2 PICK UP ENT CODE TO GET ASMB2 JMP ?SEGM GO TO GET NEXT SEGMENT * HBERR CCB INDICATE ERROR IN INPUT FILE JMP ?FMPE DISPLAY ERROR AND ABORT ASSEMBLER * SKP * * MOVE ENT NAMES/ADDRESS TO PUNCH BUFFER. * * IF UNDEFINED, PRINT DIAGNOSTIC. HNP NOP LDA .10B FOR "ENT" TYPE = 10B STA ENFLG LDB .2000 FOR WORDS PER ENTRY = 4 LDA .M15 FOR 15 ENTRIES/RECORD JSB ENEXT CLA STA ENFLG JMP HNP,I * * * PUNCH BINARY OUTPUT FOR RELOCATABLE PROGRAMS * * * (NAM,ENT, AND EXT RECORDS ONLY) * * * OUTPUT 'NAM' RECORD * OCVsþúT 1400,4400 NMP JSB GNMP GO SET UP SOME PARAMETERS JSB PNCH GO TO PUNCH 'NAM' RECORD * * * OUTPUT 'ENT' RECORD * JSB HNP GO TO 'ENT' MOVE/TEST RTN. * * PROCESS 'EXT' RECORD HERE LDA CNTR CPA .1 JMP HB11 EXIT ON CNTR=1 LDA .M20 -20 LDB NMP-2 1400B FOR EXT WCNT = 3/ENTRY JSB ENEXT * PROCESS 'EMA' RECORD HERE LDA EMCNT WAS AN EMA INSTR ENCOUNTERED? SZA,RSS JMP HB11 NO, THEN EXIT LDA .M2 -2 FOR ONE ENTRY CLB,INB SET EMA FLAG STB EMFLG LDB .2000 FOR WORDS PER ENTRY=4 JSB ENEXT OUTPUT EMA RECORD JMP HB11 EXIT BLUP OCT 20000 BLANK UPPER .M20 DEC -20 SPC 1 ENEXT NOP STA ENT. SAVE SYMBOL COUNT STB ORBS+1 SAVE WORD COUNT PER ENTRY LDA X FWA OF AVAILABLE MEMORY STA ENTV ENTV=ORG ADDR OF ENTRY * * * INITIALIZE FOR NEXT BINARY OUTPUT IMAGE * * HX1 LDA CSAD STA ORBS ORBS=DEST ADDR IN BIN REC. LDA BIT15 100000B LDB ENFLG SZB ENT PROC? RAR YES, SET RIC = 2 LDB EMFLG OUTPUTING AN EMA RECORD? SZB,RSS JMP HX8 NO LDA B140K RELOC INDICATOR=6 ADA EMASZ EMA SIZE IN BITS 0-9 OF WORD 1 HX8 STA PBUF+1 NO, EXT. SET RIC = 4. LDA NMP-2 1400B (FOR STARTING WORD COUNT) STA WCNT SET BLK CNT = 3 LDA ENT. STA ENTC ENTC = RECRD COUNTER HX2 LDA ENTV,I SZA,RSS END OF TABLE? JMP HX9 YES ALF,ALF NO-PICK UP SYMBOL TYPE CLB STB ORBS+2 CLR FLG FOR B.P.; SET IN ENT REC LDB ENFLG RAR,RAR SZB,RSS ARE WE PROCESSING ENT'S? JMP HX3 NO... RAR,SLA,RAL CHECK FOR ENT-'E' BIT SET? JMP HX12 ENT; GO PROCESS. HXN RAR,RAR NO AND .7 ¤üþú (7) ADD ENTRY ADA ENTV -LENGTH STA ENTV -TO ENTV JMP HX2 GO TO NEXT SYMBOL TABLE ENTRY * * * PROCESS END OF TABLE * * HX9 LDA ENTC CPA ENT. ANY SYMBOLS LEFT? RSS NO JSB PNCH GO TO PUNCH CLA STA WCNT CLEAR WORD COUNT IF NO SYMBOL OUT JMP ENEXT,I EXIT HERE HX3 SLA,RSS IS THIS AN EXT ENTRY? JMP HXN NO.. RAL,SLA,RAL TYPE 6 (RPL) OR 7 (LITERAL) ? JMP HX7 YES, BYPASS THE SYMBOL. SLA TYPE 5 (EXT EQU) ? JMP HX7 YES, BYPASS THE SYMBOL LDB EMFLG PROCESSING EMA RECORD? SZB JMP HX10 YES LDB ENTV,I GET FIRST WORD OF SYMBOL TABLE ENTRY SSB 'U' BIT SET? JMP HX7 YES, SET JMP HX5 NO HX10 LDB ENTV,I EMA PROCESS SSB 'U' BIT SET? JMP HX5 YES, THEN AN EMA LABEL, PROCESS IT HX7 RAR,RAR PREPARE TO GET WORD COUNT. JMP HXN GO ADVANCE TO NEXT TABLE ENTRY. HX5 ISZ ENTC END OF BIN RECORD? JMP *+3 NO JSB PNCH GO TO PUNCH JMP HX1 * * * PLACE CURRENT EXT OR ENT SYMBOL INTO BINARY RECORD * * LDA ENTV CMA,INA STA HMOV5 ORG.ADDR.TO MOVE LINK LDB ORBS LDA BLNS STA ORBS,I SET DEST.AREA TO BLANKS ISZ ORBS STA ORBS,I LDA BLUP GET UPPER BLANK. LOWER HALF OF ISZ ORBS -DEST WORD = 0 ADA ORBS+2 STA ORBS,I LDA ENTV,I JSB MTABL MOVE CHARS TO BIN REC LDA EMFLG EMA PROCESS? SZA,RSS ISZ PBUF+1 BUMP NO. OF ENTRIES IN REC. LDA SUMP NO.WORDS IN SYMBOLIC ENTRY ADA ENTV STA ENTV UPDATE ENTV(SYMBOL PNTR) ADA .M1 LDB 0,I ENTRY VALUE TO B LDA ENFLG SZA,RSS ENTRY POINT? ADB ORBS,I NO, SET EXT ORDINAL SZA ü…þúISZ ORBS STB ORBS,I STORE INTO RECORD ISZ ORBS UPDATE ORBS (RECRD PNTR) LDA EMFLG EMA PROCESS? SZA,RSS JMP HX6 NO LDA MSGSZ SET WORD 7=MSEG SIZE STA ORBS,I STORE IN OUTPUT BUFFER ISZ ORBS INCREMENT BUFFER COUNT HX6 LDA WCNT ADA ORBS+1 STA WCNT UPDATE WORD COUNT JMP HX2 HX12 RAL,RAL RIGHT JUSTIFY AND AND .7 ISOLATE SYMBOL TYPE. CPA .6 TYPE 6 ? (CODE REPLACEMENT) ADA .M1 YES,FORCE TO 5 (YIELDS TYPE 4) SZA,RSS CONVERT FROM INTERNAL REP- LDA .4 RESENTATION OF TYPE TO ADA .M1 PROPER TYPE CODE IN OBJECT. STA ORBS+2 SET IN TYPE FIELD. LDA ENTV,I GET THE FIRST WORD AGAIN SSA,RSS HAS THE ENTRY PT. BEEN DEFINED? JMP HX5 YES, GO PUT INTO THE PUNCH BUFFER * * * ENT ERROR DIAGNOSTIC ROUTINE * JSB MBLNK MOVE A SYMBOL TO BUFF THRU BUFF+2 LDA .EN 'EN' STA IOBF+5 SAVE 'EN' IN PRINT BUFFER LDB BLNS GET BLANKS FOR BUFFER STB IOBF+9 LDB ENUN SET UP ' UNDEF' STB IOBF+6 LDB ENUN+1 STB IOBF+7 LDB ENUN+2 STB IOBF+8 JSB ?PRPG GO PRINT PREVIOUS 'ERROR-PAGE' LDA .15 15 WORD OUTPUT LDB SNOB GET BUFFER ORIGIN JSB ?PRNT GO PRINT THE 'EN' ERROR ISZ ?ENER BUMP 'EN' ERROR COUNTER. LDA ENTV,I GET WORD #1 OF CURRENT ENTRY. ALF POSITION WORD COUNT TO BITS 0-2 JMP HXN+1 GO TO GET NEXT ENTRY. ENUN ASC 3, UNDEF .4000 OCT 4000 .2000 OCT 2000 B140K OCT 140000 FLX1 BSS 1 (ASCN) .401B OCT 401 ORBS BSS 3 * *********************************** * * PICK UP A SYMBOL TO BE PRINTED * * * 'A' HAS DESTINATION ADDRESS * * *********************************** MBLNK NOP LDB ENTV GET TBL ENTRY LOCATION CMï.þúB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 LDB FFUB ADDR. OF BUFF TO B JSB MTABL MOVE SYMBL TO PRINT BUFF JMP MBLNK,I EXIT HERE SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * * -A CONTAINS 1ST WORD OF SYMBOL ENTRY * -B CONTAINS DESTINATION ADDR. * -HMOV5 CONTAINS ORIGIN ADDR. MTABL NOP ALF AND .7 (7) FOR NO.OF WRDS. STA SUMP CPA .2 (2) CLA IOR .1 JSB MOVE HMOV5 NOP JMP MTABL,I * *************************************************** * * GNMP - SET UP BASE PAGE AND PROGRAM LENGTHS. * * * SET UP 'PLEN' FOR LITERALS(IF PRESENT). * * *************************************************** GNMP NOP JSB ?ORRP RESET PROG LOC'N COUNTERS LDA PLCN LDB ?BPSV STA PBUF+6 SET MAIN PROG. LENGTH STB PBUF+7 SET BASE PAGE LENGTH. * * * TEST FOR 'ORG' EXTENT BEYOND MAIN PROGRAM * LDB ORGSV GET ORG SECTION LWA CMA,INA ADA ORGSV SSA,RSS IS ORG VALUE GRTR? STB PBUF+6 YES, CHANGE MAIN PROG. LENGTH * * * TEST FOR LITERALS * LDA PBUF+6 LDB PLEN SZB LITERALS PRESENT? STA PLEN YES, SET START OF AREA ADA 1 ADD LENGTH OF REGION STA PBUF+6 TO PROG LENGTH. JMP GNMP,I EXIT FROM THE GNMP ROUTINE * * ***************************************** * * PROCESS EXTENDED INSTRUCTION SET AND * * * USER MICROCODES * * ***************************************** XMIC STA SCODE SAVE CODE - 100B LDB LTFLG GET LITERAL FLAG SZB,RSS IS IT ON? JMP XMIC2 NO - OK CPA .10B TYPE 110B? JMP XMIC1 YES - OK CPA .12 5aþú TYPE 114B? JMP XMIC1 YES - OK CPA .13 TYPE 115B? JMP XMIC1 YES - OK JSB OPERR ILLEGAL FOR ALL OTHERS JMP XMIC2 XMIC1 JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR * XMIC2 LDB SCODE PICK UP CODE-100B LDA .2 A = 2 CPB .12 TYPE 114B? INA YES, A = 3 CPB .13 TYPE 115B? INA YES, A = 3 ADB .M8 (-8) SSB,RSS TYPE 101B TO 107B(USER CODES)? JMP HA3Z NO - USE VALUE NOW IN A ADB .7 ADA B A NOW CONTAINS MACRO INST. COUNT JMP HA3Z * * **************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION(USER MICROCODE) * * * FORMAT: MIC MMM,CCCC,N * * * WHERE * * * MMM = USER DESIGNATED MNEMONIC * * * CCCC = USER DESIGNATED FUNCTION CODE * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * **************************************************** MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE OPCODE MNEM. JMP MIC01 NOT DUPLICATE MICOP JSB OPERR 'M' TERM(OPERAND) ERROR STA CODE SET CODE NOT EQUAL 100B JMP HA32 * MIC01 LDA TEMP+5 SAVE USER MNEMONIC STA SCODE SAVE 1ST 2 CHARACTERS LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST MNEMONIC FOR ALPHA ONLY * * * BY CHECKING NEXT 3 CHARACTERS * LDA .M3 (-3) STA TEMP MIC04 JSB PKUP CMA,INA ADA .100B SSA,RSS VALUE LESS THAN A? JMP MICOP YES - ERROR, NOT ALPHA ADA .32B SSA VALUE GRTR THAN Z? JMP MICOP YES - ERROR, NOT ALPHA ISZ TEMP DONE WITH MNEMONIC? JMP MIC04 NO - GO GET NEëGþúXT CHARACTER LDA .17 STA CODE CODE='ABS' FOR CHOP PROCESSING LDA .2 SET A FOR COMMA STOP JSB VMIC GO PICK UP MICRO CODE/TEST PART STA INST * CLA SET A FOR NO COMMA STOP JSB VMIC SSB VALUE PLUS? JMP MICOP NO, WE HAVE AN ERROR ADB .M8 VALUE IN A AND B SSB,RSS B LESS THAN 8? JMP MICOP NO - ERROR ADA .100B YES - SET UP CODE CPA .100B CODE = 100B? LDA .30B YES - NO PARAMS SO TYPE 30B STA CODE * ******************************************************** * * NOW ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * ******************************************************** LDA ?NDOP ADA .M3 SET NEW SUPPL. OPCODE ORIGIN STA B CMB,INB ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .EN+2 YES 'SO' OPTABLE OVERFLOW JSB ERPR JMP HA32 MIC10 STA ?NDOP LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP PICK UP 3RD CHAR. ADB CODE INSERT CODE (101-107) STB A,I STORE INA LDB INST STORE MICROCODE STB A,I INTO TABLE JMP HA32 COMPLETE OPCODE ENTRY IN TABLE. * * ******************************************************* * * VMIC CHECKS FOR COMMAS, NUMERICS AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR(MICROCODE AND PARAMETER #. * * ******************************************************* VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP CPA L+4 COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER ANY BLANKS STB SCN1+2 SET OPERAND AT NEW PARAMETER LDA CTM JSB CHOP GO EVALUATE PARAMETER JMP HA32 ERROR RETURN SZA IS VALUE ABSOLUT]Ÿ<:6E? JMP MICOP NO - ERROR LDA SUMP A AND B = VALUE JMP VMIC,I EXIT CTM NOP SAVE A FOR CHOP INITIATION .30B OCT 30 A EQU 0 B EQU 1 SCODE NOP SAVE CODE TYPE/SAVE 1ST 2 OPCODE CHARS. MTEMP NOP SAVE 3RD OPCODE CHARACTER SPC 1 ******************************************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2310B ****** ******************************************************************** SPC 1 ?CMQ EQU CMQ ?ENP EQU ENP ?EXP EQU EXP ?EMP EQU EMP ?HA3Z EQU HA3Z ?INSR EQU INSR LABEL EQU ?LABE ?LITI EQU LITIN SPC 1 END ASMB1 öÀ<ÿÿ ÿý ÿ92067-18072 1940 S C0222 &4AS21 - ASSEMBLER SEGMENT 2             H0102 ú™þúASMB,R,L,C * * NAME: ASMB2 * SOURCE: 92067-18072 * RELOC: 92067-16072 * PGMR: C.C.H.,S.P.K. * * MODIFIED BY EARL STUTES 1976-09-20-1600 * MOD 77-01-30 ADDED DEY INST EAS * MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD AND GEN INSTR. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB2 92067-16072 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB2,5,99 92067-16072 REV.1940 790531 ENT ASMB2 ENT ?ART,?BREC,?LKLI EXT ?DCOD,?GETC,?LINC,?LIST,?LOUT,?OPLK EXT ?SUP,?BPKU,?PKUP,?PNCH,?SYMK EXT ?LFLG,?LTFL,?LTSA,?LTSB,?RSTA,?ERPR,?CHOP EXT ?CHPI,?OPER,?PLIT,?ASCN,?MSYM,?ASM1,?ICSA EXT ?LINS,?ARTL,?LST,?LPER,?PERL,?SETM EXT ?BASF,?SYML EXT ?X,?MOVE,?PLIN EXT ?ASCI,?ASII,?ENDS,?ASMB SPC 2 EXT ?RELC,?SIGN,?SUMP,?TERM,?T,?BYFL,?CNTB EXT ?CODE,?DSIG,?FLAG,?FLAQ,?INST,?LAST,?PASS EXT ?PLCN,?PLEN,?PNTR,?RCNT,?SAVB,?SCN1,?SVST EXT ?SYMP,?TEST,?IOBF,?PBUF,?TEMP,?FLEX SUP TEMP EQU ?TEMP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 .M7 DEC -7 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL ILLEGAL OPERAND MSG CONSTANT 1976-09-20-1500 .NO ASC 1,NO .OP ASC 1,OP .OV ASC 1,OV .UN ASC 1,UN BLNS ASC 1, TW10 OCT 176000 ADDRESS MASK B1000 OCT 1000 BIT15 ÑþúOCT 100000 .E OCT 105 RC ASC 5,E R B C X RELC EQU ?RELC RELOCATION FLAG SIGN EQU ?SIGN SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' TERM EQU ?TERM NO. OF TERMS IN AN OPERAND T EQU ?T BYFLG EQU ?BYFL BYTE FLAG FOR 'BREC' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) DSIG EQU ?DSIG 'ASCN' FLAG EQU ?FLAG FLAQ EQU ?FLAQ INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PASS EQU ?PASS PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. RCNT EQU ?RCNT SAVB EQU ?SAVB SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SVST EQU ?SVST SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N TEST EQU ?TEST TEST CHARACTER FLEX EQU ?FLEX * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF PBUF EQU ?PBUF WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 ASMBX EQU ?ASMB CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST LTFLG EQU ?LTFL MSYML EQU ?SYML OPERR EQU ?OPER RSTA EQU ?RSTA SYMK EQU ?SYMK A EQU 0 B EQU 1 * SKP * ******************* * * CONTINUE PASS 2 * * ******************* ASMB2 LDA .VAL0 REMOVE INDIRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA .VAL0 DIRECT ADDRESS LDA ?LPER LENGTH OF 'CLEAR'AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA STA PLCN INITIALIZE PROG LOC'N COUNTER CLB DST PBUF DST PBUF+2 CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA REµþúAD A SOURCE STATEMENT(NAM?) LDA CODE CPA .15 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .13 (13) NAM ? JMP HC02 YES, GO TO LIST IT. LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 YES, EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 YES, EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA .M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO SKIP TO BOTTOM. STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT CCA SKIP TO BOTTOM OF PAGE. STA LINC JMP HC04 EXIT TO GET NEXT STATEMENT * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M54 DEC -54 OCT 60100 RIC=5, CURRENT PAGE BREC NOP STA EXTFL SAVE FOR EXTERNAL CHECKS. CPA .10B TWO WORD EXTERNAL ? LDA .5 YES, SET RELOC. INDICATOR TO 5 STA SAVB+1 SAVE RELOC'N BYTE LDA WCNT SZB RECORD OUT ? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. * * Îáþú * OUTPUT A RECORD * HI60 LDA WCNT ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF LDA SVST,I POSITION REMAIN RELOCATION BYTES ALF,RAR ISZ RCNT JMP *-2 RAL STA SVST,I STORE RELOC.BYTES * * * SET REC.ID CODE (WORD 2) * LDB BREC-1 GET RIC/PAGE INDICATOR CLA,INA CPA ?BASF IF BASE PAGE RELOCATABLE, LDB MICRD+2 SET RIC = 060000 . ADB PBUF+1 SET REMAINDER STB PBUF+1 JSB ?PNCH GO TO 'PUNCH' JMP BREC,I AND EXIT * * * PROCESS A BINARY OUTPUT WORD * * DEF PBUF+4 HI66 LDA WCNT SZA FIRST WORD OF RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+3 SET DBL ADDR. STA PBUF+1 SET PBUF+1=0 LDB .4 (4) STB WCNT SET WCNT = 4 LDB HI66-1 STB STOR SET STOR=L(PBUF+4) LDB .M5 (-5) STB RCNT SET RCNT=-5 LDB .M54 -54 STB CNTB SET CNTB FOR WORD COUNT HI70 LDB RCNT CPB .M5 RCNT= -5? JMP HI74 -YES-SET UP ADDRESSES * * * STORE RELOC.BYTE / UPDATE * * HI71 ISZ PBUF+1 UPDATE # OF DATA WRDS LDA SVST,I GET RELOC. BYTE WORD ALF,RAR POSITION FOR NEXT WORD IOR SAVB+1 GET THE NEW BYTE STA SVST,I STORE BACK IN BYTE WORD ISZ RCNT BYTE WORD FULL? JMP HI76 -NO- LDB .M5 -YES- =-5 STB RCNT RESET RCNT TO -5 RAL STA SVST,I LDA CNTB CPA .M1 RSS ISZ CNTB HI76 LDB INST ISZ WCNT ADVANCE WORD COUNT LDA EXTFL GET TWO-WORD EXT. FLAG. CPA .10B TWO-WORD EXTERNAL ? JMP EXT2 YES, GO TO PROCESS. STB STOR,I NO, STORE INSTRUCTION. ISZ STOR CCE PREPARE FOR BYTE ADDRESS WORD, IF ANY. CPA .5 (5) 2 WORD INS.¤þúERT? JMP HI77 YES, GO TO PROCESS. CPA .6 (6) BYTE ADDRESS ? JMP BYTAD YES, GO PROCESS. JMP HI78 TO EXIT TEST * * * PROCESS 2-WORD EXTERNAL (R = 5) OR BYTE ADDRESS (R = 6) * * EXT2 LDA SIGN GET OFFSET FLAG (EXT ORDN'L) CLE,SZA IS THIS AN EXT W/OFFSET? [E_0] CCE,RSS YES, SET =1 AND SKIP. LDA SUMP NO: I/O EXT. USE ORDN'L IN SUMP. ALS,ALS POSITION ORDINAL TO BITS 9-2. SEZ MEM. REF. EXTERNAL WITH OFFSET ? IOR INST YES, INCLUDE INSTRUCTION CODE. IOR .3 ADD ABSOLUTE 'MR' INDICATOR (3). STA STOR,I STORE FIRST WORD OF PAIR. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. BYTAD LDA SUMP GET OFFSET VALUE, OR BYTE ADDRESS IF ANY. SEZ,RSS MEM. REF. EXT. W/OFFSET OR BYTE ? LDA INST NO,I/O. USE INSTRUCTION. STA STOR,I STORE SECOND WORD OF PAIR. JMP HI77A GO TO COMPLETE THE PROCESS. * HI77 LDA SUMP GET RELOCATABLE VALUE. STA STOR,I AND BRMSK CLEAR UPPER 6 BITS OF 'SUMP' BRS,BRS CLEAR LOWER 2 BITS OF INST BLS,BLS IOR 1 'OR' B TO A STA INST HI77A ISZ WCNT ADVANCE WORD COUNT. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. ISZ CNTB BUMP CNTB RSS JMP HI60 HI78 ISZ CNTB IS THIS THE LAST WORD? JMP BREC,I NO- EXIT JMP HI60 YES- GO TO PUNCH HI74 LDB STOR STB SVST CLA STA SVST,I CLEAR RELOC BYTE WORD ISZ STOR ISZ WCNT JMP HI71 STOR BSS 1 BRMSK OCT 1777 .10B OCT 10 .8 EQU .10B EXTFL NOP TWO-WORD EXTERNAL FLAG. SKP HC02 LDA .2 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * HC05 LDA CODE LDB INST SZA,RSS (0) ORB ? §þúJMP HC42 YES. CPA .100B CODE = 'MIC' ? JMP X39 YES, GO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, ITS A MICROCODE MACRO. LDA CODE GET OPCODE I.D. NO. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .3 60/70(MICRO-OP?) JMP MICR YES LDA CODE GET JUMP TABLE ADDRESS ADA CODLC ADD OPCODE INCREMENT JMP A,I JUMP TO PROCESSOR .100B OCT 100 M100B OCT -100 * * * PROCESS MEMORY REFERENCE INSTRUCTIONS * MEMRY LDA INST LDB LTFLG SZB LITERAL PRESENT? JMP HCY YES AND .M2 NO, CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDB SUM. GET THE OPERAND VALUE * * * RELOC.CODE IS IN RELC * SZA ABS? JMP HC11 NO ADB TW10 YES, SUBTRACT 2000B. SSB,RSS IS THE OPERAND LESS THAN 2000B? JSB OPERR NO, IT'S AN "M" TERM ERROR HC11 LDA SUM. LDB CODE CPB .16 (16) DEF? JMP HC14A YES, GO CHECK FOR EXT W/OFFSET. LDA RELC CPA .2 (2) B.P. RELOCATABLE ? JMP *+3 YES. SZA ABSOLUTE? JMP HC15 NO SPC 1 * * TEST FOR OPERAND >1023 * SPC 1 LDA SUM. ADA TW10 (176000) SSA,RSS JMP OI.SP LDA INST CLEAR AND CBIT CURRENT-PAGE BIT [MASK=175777] STA INST JMP HC14 SPC 1 * * TEST FOR OPERAND & I¼%þúNSTR IN SAME PAGE * SPC 1 OI.SP LDA RELC CPA .2 (2) B.P. RELOCATABLE ? JMP HC13 YES, ERROR. LDA PLCN AND TW10 CMA,INA ADA SUM. AND TW10 SZA,RSS JMP *+3 HC13 LDA .OV 'OV' ERROR. JSB ERPR LDA BRMSK STRIP UPPER SIX BITS. AND SUM. STA SUM. HC14 LDA RELC CPA .2 (2) B.P. RELOCATABLE ? JMP HC15+2 HC14A LDA SIGN GET OFFSET FLAG (EXT ORDINAL). SZA IS OPERAND EXT W/OFFSET ? JMP HC17A YES, IGNORE ORDN'L FOR NOW. LDA SUM. NO, GET OPERAND VALUE. LDB CODE GET OPCODE ID NUMBER. CPB .16 ARE WE PROCESSING A 'DEF'(16B) ? JMP HC17 YES, SET UP ADDRESS FOR 'BREC'. HC14B LDA SUM. NO, GET OPERAND VALUE; AND BRMSK MASK TO FORM ADDRESS, AND JMP HC17 INSERT INTO INST. HC15 CPA .4 EXTERNAL ? (4) JMP HC14A YES, GO CHECK FOR OFFSET. LDB .5 (5) STB BYFLG ADA .M1 FORM 'MR' INDICATOR FOR OPERAND HC17 IOR INST STA INST SET LOADER FLAG LDA SIGN GET OFFSET FLAG. HC17A LDB .10B GET TWO-WORD EXT INDICATOR. SZA EXTERNAL W/OFFSET IN PROCESS ? STB BYFLG YES, SET FLAG FOR BREC. * * * SET UP FOR DCOD* LDA RELC HC19 JSB ?DCOD * * * OUTPUT A BINARY WORD * HC22 STB SAVB CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * LDA INST GET INSTRUCTION PATTERN. LDB SIGN GET OFFSET FLAG. SZB PROCESSING MEM. REF. W/OFFSET? IOR B YES, INCLUDE EXT ORDN'L NO. LDB ?LFLG TEST FOR ADDRESS ONLY MODE CPB .Q JMP *+2 JMP ARUND LDB CODE CPB .14 LDA SUM. ARUND STA INST SAVE INSTRUCTION FOR LISTING. LDB SAVB GET RELOC. CHARACTER. LDA TERM GET THE LIST PARAMETER 2Øþú JSB LIST GO TO LIST THE LINE. LDA SIGN GET OFFSET FLAG. SZA,RSS PROCESSING MEM. REF. EXT W/OFFSET ? JMP HC20 NO, GO TO ADVANCE LOC'N COUNTER. LDA SUM. YES, GET OFFSET VALUE. STA INST SAVE IN INST FOR LISTING. LDB PLUS SET = ASCII: +BLANK. LDA .6 6=LIST CODE FOR INSTRUCTION ONLY. JSB LIST GO TO LIST OFFSET VALUE. HC20 ISZ PLCN ADVANCE LOCATION COUNTER. JMP HC04 GO TO READ NEXT STATEMENT. PLUS ASC 1,+ OFFSET LIST INDICATOR. * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF X39 *COM 3 DEF X39 *ENT 4 DEF X39 *EXT,EMA 5 DEF INST,I *ARITH 6 DEF ASCP ASC 7 DEF DCNUM DEC 10 DEF OCNUM OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF X39 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF DXNUM DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO ETC 30 .I OCT 111 ASCII 'I' 31 DEF RPLP RPL 32 DEF 5OþúLODR GEN 33 DEF LODR LOD 34 DEF X52 REP 35 .JSB OCT 16000 36 .C OCT 103 ASCII 'C' 37 DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 DEF DYNUM DEY 44 SUM. BSS 1 DEX OCT 25 'DEX' OPCODE TYPE DEY OCT 44 'DEY' OPCODE TYPE .Q OCT 121 AN ASCII Q DUMMY CBIT OCT 175777 M17 DEC -17 SKP * ****************************** * * ARITHMETIC MACRO PROCESSOR * * ****************************** ART JSB SYMK GO TO SYMBOL TABLE LOOKUP RSS ERROR RETN(UNDEF) JMP *+4 NORMAL RET'N LDA .UN 'UN'= UNDEFINED SYMBOL JSB ERPR CLB SET B = 0 ADB .JSB 'JSB' INSTRUCTION MASK STB INST LDA .4 (4) A=EXT JSB BREC PUNCH LDB RC+4 ' X' CLA * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** ARTX JSB LIST GO TO LIST FIRST WORD LDA .16 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA LTFLG SZA LITERAL PRESENT? JMP ALTR YES LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ALTZ ISZ PLCN BUMP LOCATION COUNT STB SUM. SAVE OPERAND VALUE LDB .4 LIST PARAMETER=4 JMP HCXL ALTR LDA ?LTSA PICK UP LDB ?LTSB LITERAL PARAMS. JMP ALTZ FROM LKLIT * * * LITERAL PROCESSING * * HCY SLA,RSS LSB OF INST INDIC LITERAL POSSIBLE JMP HCZ NO, ERROR AND .M2 CLEAR LSB OF INST STA INST JSB ?PLIT JMP HCZ+1 ERÇþúROR EXIT JMP HCX HCZ JSB OPERR 'M' ERROR HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * SKP * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * X39 CLA,INA 1 TO A JMP HC03 * * * ORG,ORB,ORR PRE-PROCESSOR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE CCB LDA LST SZA,RSS IS LIST FLAG ON? STB LINC YES, SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 BYPASS LISTING FOR 'LST/UNL' X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA .2 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC70 LDA LTFLG GET LITERAL FLAG SZA ARE LITERALS PRESENT? JSB ?ARTL YES, GO TO LITERAL PROCESSOR JSB LOUT OUTPUT THE ARITH INSTRUCTION JMP ARTX GO PROCEESS THE 'DEF' PORTION.. HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0?)þú JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .15 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 SPC 1 * ************************ * * PASS 2 RPL PROCESSOR * * ************************ RPLP LDA SCN1+3 CHECK FOR LABEL. SZA PRESENT ? JMP *+4 YES, GO EVALUATE THE OPERAND. LDA .LB NO, GET ERROR MNEMONIC 'LB'. JSB ERPR GO TO INDICATE THE ERROR. RSS CLEAR THE INSTR. FIELD FOR LIST. JSB CHOPI GO TO EVALUATE THE OPERAND. CLB * ERROR * SET OPERAND =0. STB INST SAVE OPERAND VALUE FOR LIST. LDA .7 (7) LIST WITHOUT LOCATION. LDB SBLN ASCII:S-BLANK (SUBSTITUTION) JMP HC03 GO TO LIST THE STATEMENT. .LB ASC 1,LB ASCII 'LB' NO-LABEL ERROR CODE. SBLN ASC 1,S REPLACEMENT CODE INDICATOR: 'S'. * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* SPC 1 OCNUM CLA JMP NUMPX DCNUM LDA .1 JMP NUMPX DXNUM LDA .3 JMP NUMPX DYNUM LDA .4 NUMPX STA WHAT NUMP LDA SCN1+2 STA PNTR SET POINTER LDA .M1 STA T+1 SET FPAS=-1 HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC LDB WHAT STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .8 IF CODE # DEC THEN GO COUNTEMUP JMP *+2 JMP CNTUP LDB .†þú.2 TEST FOR REAL OR INTEGER CPA L+6 DECIMAL POINT? JMP *+2 CPA .E 'E'? STB RELC YES, SET RELC = 2 CNTUP ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDB RELC BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION JMP ASCER THIS IS THE ERROR RETURN STA TEMP+1 SAVE THE FIRST WORD LDA .VAL0 STA WPNTR SET UP THE WORKING POINTER LDA RELC CMA,INA,SZA,RSS WORKING COUNTER FOR THE LOOP CCA OOPS IT WAS ZERO STA RELC NUMLP LDA WPNTR,I OUTPUT A WORD INTO THE DATA STREAM JSB NOUT ISZ WPNTR ISZ RELC IF U DUN DEN BUG OUT JMP NUMLP HE18 LDA TERM CPA BLNK JMP HC04 EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1500 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SABE CLA MAKE A NOP JSB NOUT DUMP IT JMP HC04 BUG OUT, U DONE ASCER CLA JSB NOUT JMP HE18 * .VAL0 DEF TEMP+1 WPNTR BSS 1 WHAT BSS 1 LOCAL OPCODE FLAG FOR NUMP * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP STA INST CLA SET A=0 FOR 1ST LINE OUTPUT ISZ T+1 SKIP FOR 1ST LINE OF OUTPUT. LDA .4 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** INFO NOP INFORMATION RECORD FLAG * LODR CLüqNLHA,INA SET A FOR A LOADER INFO RECORD JMP ASCP1 * ASCP CLA SET A FOR A ASC RECORD ASCP1 STA INFO SAVE RECORD TYPE IN INFO LDA SCN1+2 INITIALIZE FOR ASC PROCESSING STA PNTR LDA .M1 ÖNÿÿþú STA T+1 LDA .2 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 * ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; * ERROR * SZB,RSS ASKING FOR ZERO WORDS ? JMP HP2D-1 YES, * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; * ERROR * LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC LDA INFO GET INFO/ASC RECORD FLAG SZA ASC RECORD? JMP PINFO NO, PROCESS INFOR RECORD * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * PINFO CLA,INA SET PRINT TYPE (NO LOCC, NO INSTR) LDB BLNS JSB LIST JMP HC04 GO DO NEXT LINE * * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 I/O MASKS OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND. CPA L+1 'HLT'? JMP HP2D * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB B1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT SZA,RSS ABSOLUTE? JMP ABSL YES, GO PROCESS. CPA .4 EXTERNAL I/O OPERAND? ALS,SLA YES, SET TO 10 FOR BYFLAG. JMP R NO. ERROR! STA BYFLG SET BYFLG. LDA INST GET UNCONFIGURÎBþúED INSTRUCTION. LDB SIGN GET THE OFFSET FLAG. SZB,RSS EXTERNAL I/O WITH OFFSET ? JMP IOEX NO, SINGLE EXTERNAL TERM. ADA SUMP YES. ADD OFFSET TO INSTRUCTION. STA INST SAVE THE MODIFIED INSTRUCTION. STB SUMP PUT EXT ORDN'L IN SUMP FOR BREC. IOEX CLB CLEAR LIST PARAMETER STB TERM TO LIST WHOLE LINE. STB SIGN SET EXT I/O FLAG FOR BREC. JMP HC19-1 OUTPUT BINARY; LIST LINE. ABSL LDA SUMP GET I/O OPERAND. LDB INST LOAD B WITH INSTRUCTION FORMAT ADA IOPR-2 MASK WITH 177300 CPB RAM IS IT A RAM INSTR RSS SKIP IF YES ADA IOPR-1 FINISH MASK IF NOT RAM LDB SUMP RESTORE B CONTENTS * * * TEST FOR VALUE>63 * SSA JMP *+4 VAL>64 LDA .OV 'OV' ADDRESS OVERFOLW JSB ERPR Q CLB ADB INST STB INST JMP HP2D R JSB OPERR 'M' ERROR - RELOC.I/O ADDR. JMP Q * * * PROCESS SOC OR SOS HC28 LDA SCN1+2 PNTR TO OPERAND SZA,RSS OPERAND PRESENT? JMP HP2D NO LDB 0 A TO B JSB ?MSYM ADA .M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * LDA INST IOR B1000 MASK IN CURRENT BIT STA INST JMP HP2D * ********************** * * MICRO-OP PROCESSOR * * ********************** CNTC BSS 1 INSV EQU SUM. MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG VÔþú STA TEST CLEAR CHAR TESTER * * START HERE FOR EACH NEW CODE * * F LDA INST UNPACK THE MICRO-OP CODE * *THE FORMAT IS: BITS 14-13=1 IF SRG,2 IF ASG, 0 IF EITHER. * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE'IT'S BIGGER THAN THE LAST ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE TO BITS O AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3 TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSVnÚþú STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA .3 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 IF SO, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR INVALID CHAR.-'M' ERROR ! * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * ******************************** * * SEARCH SYMBL TBL FOR LITERAL * * ******************************** LKLIT NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 STA LTFLG SET LTFLG#0 JSB SYMK SYMBOL TABLE LOOKUP ROUTINE CLB ERROR RETURN ADB PLEN ADDR OF LITERAL CLA,INA A=1 STB SUMP STA RELC JMP LKLIT,I LKLIT EXIT * * .13B OCT 13 SCODE NOP SAVE CODE-100B FOR XMIC PROCESS ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 UMASK EQU RAM+1 177400B * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE LDA .M1 STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC ˜NþúSTA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNY LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RT FLAG IOR INST NO - SET UP TO GENERATE A WORD BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * SKP BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ********************************************************** * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************** * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START ON PARAMETER COUNT ADA .7 (7) SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM OK LDB .M1 B = -1 CPA .M6 (-6) CODE = 115B? (BITS INSTRUCTION) ADB .M1 B = -2 STB OPNUM PRz€þúOCX JSB LOUT OUTPUT MICROCODE TO BINARY JSB LIST LIST MICRO SOURCE STATEMENT LDA PLCN SAVE LOCN CNTR AT INSTRUCTION STA STAR PSEUDO LOCN CNTR STA STARX ORIGINAL LOCATION ISZ STAR BUMP PSEUDO COUNTER ISZ PLCN BUMP PROGRAM LOCATION COUNTER PROC1 LDA .16 STA CODE SET CODE = 20B (DEF) LDA STARX RESET PLCN TO INSTRUC LOCN STA PLCN CLA STA INST CLEAR INSTRUCTION STA BYFLG AND BYFLG LDA SCODE A=ORIGINAL CODE(-100B) LDB LTFLG SZB LITERAL? JMP PROC7 YES CPA .13B NO - IS CODE = 113?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE OPERAND JMP PRERR+1 ERROR JMP *+3 PROC2 JSB CHOPI EVALUATE OPERAND WITH NO',I' JMP PRERR+1 ERROR SZA ABSOLUTE VALUE? JMP *+4 NO ADB TW10 YES (VAL-2000B) SSB,RSS GRTR THAN 1777B? JMP PRERR YES,ERROR CPA .4 (4) EXTERNAL SYMBOL? RSS YES JMP PROC4 NO LDB SCODE CPB .13B CODE = 113B? (JPY) JMP PRERR YES - ERROR * PROC4 LDA PNTR STA SCN1+2 RESET POINTER LDA SIGN SZA,RSS TEST FOR EXT WITH OFFSET JMP NOTSO LDB .10B SET UP BYFLG STB BYFLG CLA,RSS SKIP ONE BECAUSE OF EXT WITH OFFSET NOTSO LDA SUMP IOR INST 'OR' INST TO EXT ORDINAL AND SAVE STA INST SET VALUE INTO INSTRUCTION SSA WAS ADDR INDIRECT? ISZ SCN1+2 YESM , BUMP OPERAND LOCATION LDA RELC JSB ?DCOD STB SAVB SAVE ASCII RELOC. CHARS. LDB STAR SET PLCN TO ACTUAL LOCN STB PLCN CLB,INB SET B=1 JSB BREC GO PUNCH THE WORD LDA INST IF EXT WITH OFFSET, IOR SIGN INSERT THE I.D. INTO THE ’]þúSTA INST INSTRUCTION WORD FOR LISTING. LDB SAVB B = ASCII RELOC CHARS. LDA .4 A = 4 JSB LIST LDA SIGN TEST FOR EXT WITH OFFSET SZA,RSS JMP NOOFF DON'T GOT ANY LDA SUMP STA INST LDB PLUS LDA .6 JSB LIST LIST THE OFFSET NOOFF ISZ PLCN BUMP PROG.LOCATION COUNTER ISZ STAR BUMP PSEUDO CNTR CLA STA INST CLEAR INST FOR FINAL NOP(IF ANY) STA LTFLG CLEAR LITERAL FLAG. LDB SCODE CPB .12 CODE = 114B(NOP IN 3RD WORD?) JMP PROCA YES, EMIT A 'NOP' ISZ OPNUM NO - LAST PARAMETER? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - DONE * PROC7 CPA .10B =110B CODE? JMP PROC8 YES CPA .12 =114B CODE? JMP PROC8 YES CPA .13 =113B CODE? JMP PROC8 YES PRERR JSB OPERR NO - ERROR CLA STA SUMP INA STA RELC LDB LTFLG SZB,RSS LITERAL? JMP PROC4 NO JMP *+3 YES PROC8 JSB ?PLIT JMP PRERR+1 ERROR JSB MSYML LDA SAVB STA PNTR JMP PROC4 * PROCA JSB LOUT LDA .4 (4) SET FOR RESTRICTED LISTING JMP HC30+1 * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION * * ************************************** * * PROCESS DEFINITION OF BYTE ADDRESS * * * CODES ARE 'DBL' AND 'DBR' * * ************************************** * BYTE LDA .20B STA CODE SET CODE = 'DEF' JSB CHOPI GO EVALUATE OPERAND JMP BYERR+1 ERROR EXIT CLE,ELB ADDRESS * 2; E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP BYERR NO GO TELL EM ADB INST STB SUMP SUMP = BYTE ADDRESS STA INST SZA ABSOLUTE? JMP BYEX NO ADB M200B YES ã¶þú SSB,RSS LESS THAN 200B? JMP BYERR NO, ERROR BYEX CPA .4 (4) EXT? JMP BYERR YES, ERROR BYOUT ADA .M1 (-1) AND .3 (3) SET 'MR' CHARACTERS FOR LOADER STA INST LDA .6 (6) STA BYFLG SET FLAG FOR BREC RPROCESSING LDA RELC JSB ?DCOD GO SET UP LIST CHARACTERS STB SAVB SAVE RELOCATION ASCII CHARS. CLB,INB SET FOR INSERTING A WORD JSB BREC GO TO BINARY OUTPUT ROUTINE LDB SAVB LDA SUMP STA INST SET UP ADDRESS FOR LISTING CLA JMP HC30+1 CONTINUE TO LAST PART BYERR JSB OPERR CLA STA RELC JMP BYOUT M200B OCT -200 OPNUM NOP .20B EQU .16 (20B) * SKP * ****************************** * * PASS 2 END PROCESSOR * * ****************************** ENDRC OCT 120000 FOR RIC = 5 * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD. CLA STA ?BASF CLEAR B.P. FLAG FOR CURRENT PAGE STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 LDA PLEN IF PLEN=0 THERE ARE NO LITERALS SZA,RSS LITERALS PRESENT ? JMP HC56 NO-BYPASS LITERAL PROCESSING. STA PLCN YES, SET PLCN=FWA AFTER PROGRAM LDA ?X NL01 STA ENTV ADDR OF SYMBOL TABLE LDA ENTV,I 1ST WRD OF ENTRY SZA,RSS END OF TABLE? JMP NL99 YES ALF STA 1 AND .7 GET ENTRY LENGTH STA ENTC LDA 1 ALF AND .15 GET ENTRY TYPE CPA .7 LITERAL? JMP NL20 YES NL10 LDA ENTV UPDATE TO NEXT ENTRY ADDRESS ADA ENTC JMP NL01 GO TO PROCESS NEXT ENTRY * * * PROCESS A LITERAL FOR OUTPUT * NL20 LDA ENTV CMA,INA SET UP ADDR OF LITRL CONSTANT LDB ?ICSA GET LOC'N OF ASCI BUFFER STA *+3 LDA .4 4 TO A ð~þúJSB ?MOVE LIT CONST TO ASCI/ASCI+1 NOP LDA ?ASII STA NLST SAVE 2ND WRD LDA ?ASCI PROCESS 1ST WORD STA INST JSB LOUT PUNCH LDA .4 JSB LIST LDA ENTC CPA .3 IS IT 2 WORD CONSTANT? JMP NL30 NO LDA NLST YES STA INST PROCESS 2ND WORD ISZ PLCN BUMP LOCN COUNTER JSB LOUT PUNCH LDA .4 JSB LIST NL30 ISZ PLCN BUMP LOCN CNTR JMP NL10 * * EXIT HERE * NL99 CLB JSB BREC * * * PUNCH 'END' RECORD * HC56 LDA .2000 FOR WCNT = 4 STA WCNT SET WORD COUNT LDA SCN1+2 POINTS TO OPERAND (IF ANY) STA PBUF+3 CLEARED IF NO EXECUTION ADDRESS SZA EXEC.ADDR.PRSNT? * * * PROCESS EXEC.ADDR. * JSB ?CHPI GO EVALUATE OPERAND JMP HC54 ERROR, OR NO EXECUTION ADDRESS CPA .2 (2) B.P. RELOCATABLE ? INA,RSS YES. SET R & T (3); SKIP. CPA .1 RELOCATABLE? JMP HC55 YES JSB ?OPER ERROR - NOT RELOCATABLE HC54 CLA CLB HC55 STB PBUF+3 STORE THE EXECUTION ADDRESS. ADA ENDRC SET RIC = 5 STA PBUF+1 JSB ?PNCH CLA,INA SET A=1 FOR LIST PARAMETER LDB BLNS BLANKS FOR RELOC,INDIC. JSB LIST JSB ?ENDS * PRINT ERROR COUNT * JMP ASMBX EXIT FROM ASSEMBLER NLST NOP TEMPORARY ENTC NOP TEMPORARY ENTV NOP ENTBL COUNTER .2000 OCT 2000 * SPC 1 ******************************************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2340B ****** ******************************************************************** SPC 1 ?ART EQU ART ?BREC EQU BREC ?LKLI EQU LKLIT SPC 1 END ASMB2 ʱ<:66<ÿÿ ÿý! ÿ92067-18073 1940 S C0122 &4ASB3 - ASSEMBLER SEGMENT 3             H0101 ›þúASMB,R,L,C * * NAME: ASMB3 * SOURCE: 92067-18073 * RELOC: 92067-16073 * PGMR: C.C.H.,S.P.K. * MOD 77-01-30 ADDED DEY OP CODE EAS * MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD & GEN INSTR. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED * RTE ASMB3 92067-16073 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB3,5,99 92067-16073 REV.1940 790531 ENT ASMB3,?INS? EXT RWN.C,C.SOR EXT ?BPKU,?RSTA,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?ASMB,?SEGM,EXEC,?ERPR,?X EXT ?MOVE,?LFLG,?TFLG,?CHPI EXT ?V,?ASM1,?MESX,?BNCN,?PRNT,?NDOP,?FMPE EXT ?NDSY,?OPER,?OPLK SPC 2 EXT ?TEMP,?NAMI,?NAME,?SUMP,?CNTB,?CODE,?INST EXT ?PLCN,?PNTR,?SCN1,?SYMI,?SYMP,?ENTV,?IOBF EXT ?BUFF,?PBUF SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .29 DEC 29 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO BLNS ASC 1, .E OCT 105 TEMP EQU ?TEMP NAMI EQU ?NAMI LOC'N FOR TEMP SYMBOL STORAGE NAME EQU ?NAME FOR USE BY 'OPLK' SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) INST EQU ?INST OPCODE FORMAT PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU ?S‡ªþúYMI ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N ENTV EQU ?ENTV * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU ?BUFF PBUF EQU ?PBUF SAVES THE 'NAM' RECORD INFO BPKUP EQU ?BPKU CHOPI EQU ?CHPI ERPR EQU ?ERPR LFLAG EQU ?LFLG MOVE EQU ?MOVE MSYMS EQU ?MSYS PKUP EQU ?PKUP RSTA EQU ?RSTA X EQU ?X SPC 3 ASMB3 LDA FFUB REMOVE INDIRECTS RSS LDA A,I RAL,CLE,SLA,ERA BIT 15 SET? JMP *-2 YES, REMOVE ONE LEVEL OF INDIRECTS STA FFUB NO ASMBA JSB RSTA LDA CODE CPA .15 'HED' STATE? JMP IXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS LDB .2000 STB PLCN INITIALIZE PROGRAM COUNTER CPA .1 IS OPCODE AN ORG? JMP HI12 LDA .NO 'NO'= NO ORG STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMBA HI12 JSB ?CHOP PROCESS AN ORIGIN VALUE JMP HA32+1 ERROR RETURN STB PLCN SET INITIAL COUNTER VALUE JMP HA32 GO TO START PASS 1 * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO THE 'END PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA63 YES * ERROR * CPA .100B USER MICROCODE ('MIC')? JMP MIC YES, GO PROCESS. CPA B33 GEN INFO RECORD? JMP HA63 YES * ERROR * CPA B34 LOADER INFO RECORD? JMP HA63 YES * ERROR * ADA .M3 -3 SSA JMP HA64 ORR OR ORG FOUND CPA .12B NAM? JMP HA63 YES, ERROR ADA .M3 (-3) SSA 'COM','ENT' OR 'EXT' ? JMP Ð þúHA63 YES - ERROR CPA .5 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .13 IGNORE-PASS #1. JMP HA32 IGNORE-PASS #1. CPA .14 (16B) LST/UNL? JMP HA32 IGNORE-PASS #1. * * * TEST FOR LABEL FIELD LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP HALB NO, DONE STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. CLA SET A=0 FOR ABSOLUTE VALUE LDB PLCN JSB INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT HALB LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA DEY IF CODE = DEY THEN JMP HA40 GO TO CONSTANT PROCESSING CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA .7 (7) JMP HA54 TO ASC CPA .26B INTEGER ARITH(HARDWARE)? JMP HA70 YES.... CPA .6 (6) ARITH MACRO? JMP HA63 YES, ERROR ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROC. LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * HA3Z ADA PLCN (HA3B+1) STA PLCN JMP HA32 .26B OCT 26 FOR HARDWARE ARITHMETIC .32B OCT 32 RPL CODE. SPC 1 * * PROCESS BSS * HA3M JSB CHOPI EVAL.OPERAND JMP HA32 ERROR LDA 1 B TO A JMP HA3Z * .12B OCT 12 B33 OCT 33 B34 OCT 34 .M10 DEC -10 .100B OCniþúT 100 M100B OCT -100 DEX OCT 25 OP TYPE FOR 'DEX' DEY OCT 44 OP TYPE FOR 'DEY' BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' * SKP * ************************************************* * * INSR: ADD ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * ************************************************* .DD ASC 2,DDSO INSR NOP STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP JMP INS1 LDA .DD NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR JMP INSR,I GET OUT HERE INS1 LDB NAMI ADB TEMP+2 STB TEMP+1 SET LIMIT LDA ?NDOP GET LWA AVAIL. MEM. CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .DD+1 'SO' SYMBOL TABLE OVERFLOW JMP INSX GO TO PRINT ERROR MESSAGE. LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA TEMP+1 JMP INSEX EXIT INA ISZ SYMI JMP *-6 INSEX LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE HA63 LDA .IL ILLEGAL OPCODE: ABS. ASSEMBLIES ! JMP HA55+2 TO ERPR * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .2 B=3 IF CODE IS 'DEX' CPA DEY IF CODE = DEY THEN LDB .4 B := 4 & FOUR WORD CONSTANTS STB TEMP+5 SET LOCN COUNT;4þú BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * HA41 JSB PKUP (HA40+4 WAS HA41) LDB TEMP+5 GET COUNT BUMPER CPA L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. ADB .M2 IF (TYPE=3) OR (TYPE=4) THEN SSB,RSS GO CONTINUE PROCESSING JMP HA42 YES LDB TEMP+5 CPA L+6 PERIOD? JMP HA48 YES CPA .E 'E' ? JMP HA48 HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB TEMP+5 GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA TEMP+5 ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NUMBER. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING ? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT SKP * ******************************** * * PROCESS ASC (GET VALUE OF N) * * ******************************** HA54 LDA .2 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 * ERROR-NOT ABS.VAL. SZB,RSS ZERO WORD COUNT ? JMP HA55 YES, * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * LDA .MBLN 'M' ERROR(BAD OPo±þúERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB CHOPI EVALUATE OPERAND JMP HA32 *ERROR* CPA .4 (4) EXT ? LDA .5 (5) SET FOR NON-PNCH EXT STA TEMP NO STB TEMP+1 CLB,INB JSB MSYMS GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP JMP HA32 * ****************************** * * ORG ORR REP PROC.JUMPS * * ****************************** HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDA .2 A=2 JMP HA3Z * SKP * ************************ * * PASS 1 END PROCESSOR * * ************************ NOP HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS LDA FFUB ADA .4 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA,RSS COMPLETED? JMP HB08 YES - GO TO FINISH PASS 1 LDB ENTV GET TBL ENTRY LOCATION CMB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 STB BUFF+3 LDB FFUB ADDR. OF BUFF TO B SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * ALF AND .7 (7) FOR NO.OF WRDS. STA SUMP CPA .2 (2) CLA IOR .1 JSB MOVE HMOV5 NOP * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB .M1 ADB ENTV STB ENTV LDA 1,I ISZ ENTV CLE þú SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .14 (14) JSB ?PRNT GO TO PRINT JMP HBX ENTRY DONE. * .PASS ASC 2,PASS * SKP * * ERRORS PRINTED * HB08 JSB ?ENDS GO TO END PASS PROCESSOR * ******************************** * * START 'ABSOLUTE' PASS 2 HERE* * ******************************** SPC 1 HB11 JSB RWN.C REWIND SOURCE FILE DEF C.SOR INPUT FILE FCB JMP HBERR LDA .4 PICK UP ENT CODE TO GET ASMB5 JMP ?SEGM GO TO LOADER FOR NEXT SEGMENT * HBERR CCB INPUT FILE ERROR JMP ?FMPE FMP ERROR * .2000 OCT 2000 FFUB DEF BUFF * SKP * ******************************************************** * * PROCESS EXTENDED INSTRUCTION SET AND USER MICROCODES * * ******************************************************** * XMIC STA B CODE-100B NOW IN B LDA .2 SET A=2 CPB .12 TYPE 114B? INA YES, A=3 CPB .13 TYPE 115B? INA YES, A=3 ADB .M8 SSB,RSS USER CODE? (101B THRU 107B) JMP HA3Z NO, USE VALUE IN A FOR PLCN BUMP ADB .7 ADA B A = MACRO INSTRUCTION COUNT. JMP HA3Z * ********************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION (I.E. USER MICROCODE) * * * FORMAT: MIC MMM,CCC,N * * * WHERE * * * MMM = USER DESIGNATED MNEMONIC (ALL ALPHABETIC) * * * CCC = USER DESIGNATED FUNCTION CODE (0 TO 177777B) * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * ********************************************************{þú** * MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE MNEMONIC JMP MIC01 GOOD - MNEMONIC NOT FOUND MICOP JSB ?OPER ERROR IN OPERAND ('M' TERM) STA CODE -SET CODE NOT = 100B JMP HA32 GO GET NEXT INSTRUCTION * MIC01 LDA TEMP+5 * * SAVE USER MNEMONIC HERE * * STA SCODE SAVE 1ST 2 CHARS. LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST 3 CHARACTERS FOR ALPHA ONLY MNEMONIC * LDA .M3 STA TEMP MIC04 JSB PKUP PICK UP A CHARACTER CMA,INA ADA .100B SSA,RSS LESS THAN LETTER A? JMP MICOP YES - NON-ALPHA ADA .32B SSA GREATER THAN LETTER Z? JMP MICOP YES - NON-ALPHA ISZ TEMP LAST CHARACTER TESTED? JMP MIC04 NO - GO GET NEXT ONE LDA .21B STA CODE SET CODE 'ABS' TO FOOL CHOP RTN. LDA .2 SET FOR COMMA STOP IN CHOP JSB VMIC PICK UP MICRO CODE AND TEST PART STA INST SAVE USER FUNCTION CODE * CLA SET FOR NO COMMA STOP IN CHOP JSB VMIC GET VALUE OF N SSB IS VALUE OF N POSITIVE JMP MICOP NO - ERROR ADB .M8 SSB,RSS IS N GREATER THAN 7? JMP MICOP YES - ERROR ADA .100B CPA .100B WILL CODE BE 100B? LDA .30B YES - NO PARAMS. THUS IT'S =30B STA CODE SAVE CODE FOR OPTABLE ENTRY * * **************************************************** * * ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * **************************************************** * LDA ?NDOP GET ORG OF SUPPL. OPCODE TABLE ADA .M3 SET NEW ORIGIN STA B CMB,INB START TEST FOR OVERFLOW ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .SO YES - PRINT 'SO' ERROR JSB ERPR JMP HA‰ñ64032 GO FOR NEXT STATEMENT * MIC10 STA ?NDOP SET NEW OPTABLE ORIGIN LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP GET 3RD CHAR. ADB CODE INSERT CODE STB A,I STORE IT INTO THE TABLE INA LDB INST STB A,I STORE THE MICROCODE (FUNCTION) JMP HA32 GO FOR NEXT STATEMENT * SKP * ********************************************************** * * VMIC CHECKS FOR COMMAS, NUMERICS, AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR (MICROCODE AND # OF PARAMETERS * * ********************************************************** * VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP PICK UP A CHAR. CPA L+4 IS IT A COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER FOLLOWING BLANKS STB SCN1+2 SET OPERAND PNTR TO NEXT PARAM. LDA CTM JSB ?CHOP EVALUATE THE PARAMETER JMP HA32 ERROR - GO TO NEXT SOURCE STATE. SZA ABSOLUTE VALUE? JMP MICOP ERROR - NO LDA SUMP VALUE IN BOTH A AND B ON EXIT JMP VMIC,I RETURN * CTM NOP SAVE A FOR CHOP ENTRY .21B OCT 21 (21B) .30B OCT 30 SCODE NOP SAVE 1ST 2 NMEMONIC CHARS. MTEMP NOP SAVE 3RD CHAR. A EQU 0 B EQU 1 .SO ASC 1,SO * SPC 1 ******************************************************************** ********** CHANGE LOC'N. Z IN ASMB IF THIS PROGS. LWA > 1550B ****** ******************************************************************** SPC 1 ?INS? EQU INSR SPC 1 END ASMB3 Tö6ÿÿ ÿý  ÿ92067-18074 1940 S C0222 &4AS41 - ASSEMBLER SEGMENT 4             H0102 þ›þúASMB,R,L,C * * NAME: ASMB4 * SOURCE: 92067-18074 * RELOC: 92067-16074 * PGMR: C.C.H.,S.P.K. * MODIFIED BY EARL STUTES 1976-09-20-1600 * MOD 77-01-30 ADDED DEY OP CODE EAS * MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD & GEN INSTR. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB4 92067-16074 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB4,5,99 92067-16074 REV.1940 790531 ENT ASMB4,?AREC EXT WRT.C,C.BIA EXT ?SUP,?BPKU,?PKUP,?LFLG,?RSTA,?ERPR EXT ?OPLK,?GETC,?LINC,?LIST,?LOUT EXT ?CHOP,?CHPI,?OPER,?ASCN,?MSYM,?ASM1,?LINS EXT ?LST,?LPER,?PERL,?SETM,EXEC,?FMPE EXT ?ENDS,?PLIN,?ASMB,?BINF SPC 2 EXT ?TEMP,?RELC,?SIGN,?SUMP,?TERM,?T,?CNTB EXT ?CODE,?DSIG,?FLAG,?FLAQ,?INST,?LAST,?PASS EXT ?PLCN,?PNTR,?SCN1,?TEST,?IOBF,?PBUF SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .NO ASC 1,NO .OP ASC 1,OP .OV ASC 1,OV .IL ASC 1,IL BLNS ASC 1, TW10 OCT 176000 ADDRESS MASK B1000 OCT 1000 BIT15 OCT 100000 .E OCT 105 TEMP EQU ?TEMP RELC EQU ?RELC RELOCATION FLAG SIGN EQU ?SIGN SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' TERM EQU ?TERM NO. OF TERMS IN AN OPERAND T EQU ?T CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) DSIG EQU ?DOþúSIG 'ASCN' FLAG EQU ?FLAG FLAQ EQU ?FLAQ INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PASS EQU ?PASS PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) TEST EQU ?TEST TEST CHARACTER * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF PBUF EQU ?PBUF WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST OPERR EQU ?OPER RSTA EQU ?RSTA A EQU 0 B EQU 1 SPC 1 * **************************************** * * CONTINUE PASS 2 OF ABSOLUTE ASSEMBLY * * **************************************** SPC 1 ASMB4 LDA .VAL0 REMOVE INDIRECTS FROM ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA .VAL0 DIRECT ADDRESS LDA ?LPER LENGTH OF CLEAR AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA CLB DST PBUF DST PBUF+1 LDA .2000 STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .15 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .1 JMP HI12 LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT HI12 JSB ?CHOP EVALUATE ORG JMP HC02 ERROR RETURN STB PLCN JMP HC02 * .2000 OCT 2000 * SKP * ÿZþú ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA .M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO TOP OF FORM STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT CCA SKIP TO TOP OF FORM STA LINC JMP HC04 EXIT TO GET NEXT STATEMENT * * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M57 DEC -57 DEF PBUF+2 BREC NOP LDA ?BINF BINARY OUTPUT REQUESTED? SZA,RSS JMP BRECX NO, THEN RETURN LDA WCNT SZB RECORD OUT? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. HI60 LDA WCNT ** OUTPUT A BINARY RECORD ** ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF ALF,ALF ADA .3 ADD 3 TO THE DATA COUNT STA CNTB SET COUNTER = WCNT+3 JSB WRT.C WRITE RECORD ON BINARY OUTPUT FILE DEF C.BIA DEF PBUF PUNCH BUFFER DEF CNTB WORD COUNT JMP HIERR FMP ERROR BRECX CLA STA WCNT INITIALIZE WCNT =0 JMP BREC,I AND EXIT * HIERR CLA,INA ERROR IN O}vþúUTPUT FILE JMP ?FMPE DISPLAY ERROR AND ABORT ASSEMBLER HI66 SZA 1ST WORD OF BINARY RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+59 PUT IN CHECKSUM SAVER STB PBUF+1 SET RECORD ADDR. LDA BREC-1 STA STOR SET STOR=L(PBUF+2) LDA .M57 STA CNTB SET COUNT=-57 HI70 LDA INST STA STOR,I SET CURRENT BIN. WORD ISZ STOR BUMP POINTER ADA PBUF+59 UPDATE CHECKSUM STA PBUF+59 STA STOR,I SAVE IN LWA+1 OF PUNCH RECORD ISZ WCNT ISZ CNTB IS RECORD FULL? JMP BREC,I NO - EXIT JMP HI60 YES - GO PUNCH STOR BSS 1 SPC 2 HC02 LDA .2 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * * HC05 LDA CODE LDB INST CPA .100B CODE = 'MIC' ? JMP X39 YES, GO TO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, IT'S A MICROCODE MACRO. LDA CODE GET OPCODE I.D. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .3 60 OR 70?(MICRO-OP?) JMP MICR YES LDA CODE ADA CODLC SET UP ADDRESS OF PROCESSOR JMP A,I JUMP TO OPCODE PROCESSOR * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF HC38 *COM 3 DEF HC38 *ENT 4 DEF HC38 *EXT 5 DEF HC38 *ARITH 6 DEF ASCP ASC 7 DEF DCNUM DEC 10 DEF OCNUM [~þú OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF HC38 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF DXNUM DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO, ETC. 30 .I OCT 111 ASCII I 31 DEF HC38 *RPL 32 DEF HC38 *GEN 33 DEF HC38 *LOD 34 DEF X52 REP 35 M17 DEC -17 36 -17 FOR SHIFT-ROT CNTC NOP 37 MICRO-OP PROC DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 DEF DYNUM DEY 44 INSV NOP MICRO-OP PROC SUM. EQU INSV MEMORY REF PROC. DEX OCT 25 'DEX' OPCODE TYPE DEY OCT 44 'DEY' OPCODE TYPE CBIT OCT 175777 .1777 OCT 1777 * SKP * * PROCESS MEMORY REFERENCE INSTRUCTIONS * * MEMRY LDA INST AND .M2 CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERAND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDA SUM. LDB CODE CPB .16 (16) DEF? JMP HC17 ADA TW10 NO - TEST FOR OPERAND>1023 SSA,RSS IS IT? JMP *+5 YES. LDA INST NO - SET TO CLEAR'CURRENT' BIT. AND CBIT CURRENT BIT MASK(175777) STA INST RESTORE JMP HC14 LDA PLCN TEST NOW FOR OPER.AND INSTR. AND TW10 IN THE SAME –ùþúPAGE OF MEMORY CMA,INA ADA SUM. AND TW10 SZA,RSS IN SAME PAGE? JMP *+3 YES LDA .OV NO - IT'S AN OVERFLOW JSB ERPR LDA .1777 AND SUM. STRIP UPPER 6 BITS OF OPERAND STA SUM. HC14 LDA SUM. GET ADDRESS HC17 IOR INST FOR INSTRUCTION, AND STA INST SET LOADER FLAG * * * OUTPUT A BINARY WORD * * HC19 CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * * LDB BLNS GET BLANKS FOR LIST ROUTINE LDA TERM GET THE LIST PARAMETER JSB LIST ISZ PLCN JMP HC04 * SKP * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** HC70 JSB LOUT OUTPUT THE ARITH. OPERATION JSB LIST LIST THE FIRST WORD LDA .16 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ISZ PLCN BUMP LOCATION COUNTER STB SUM. SAVE OPERAND VALUE LDB .4 LIST PARAMETER=4 JMP HCXL HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OKAªþú.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * * * COM,ENT,EXT AND ARITH MACRO * HC38 LDA .IL ILLEGAL IN ABSOLUTE ASSEMBLY JSB ERPR X39 CLA,INA 1 TO A JMP HC03 * SKP * * * PRE-PROCESSOR FOR ORG AND ORR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE CCA SPACE TO BOTTOM OF PAGE STA LINC JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 EAS 1976-09-20-1600 X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA .2 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .15 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * **********************ùgþú*** OCNUM CLA JMP NUMPX DCNUM LDA .1 JMP NUMPX DXNUM LDA .3 JMP NUMPX DYNUM LDA .4 NUMPX STA WHAT NUMP LDA SCN1+2 STA PNTR SET POINTER LDA .M1 STA T+1 INITIALIZE FPAS HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC LDB WHAT STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .8 IF OP CODE # DEC THEN GO COUNTEMUP JMP *+2 JMP CNTUP LDB .2 TEST FOR REAL OR INTEGER CPA L+6 IF DECIMAL POINT THEN JMP *+2 RELC := 2 CPA .E ELSE IF "E" THEN STB RELC RELC := 2 CNTUP ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDB RELC BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION JMP ASCER THIS IS THE ERROR RETURN STA TEMP+1 LDA .VAL0 STA WPNTR SET UP WORKING POINTER LDA RELC CMA,INA,SZA,RSS SET UP WORKING COUNTER CCA OOPS IT WAS ZERO, MAKE IT -1 STA RELC NUMLP LDA WPNTR,I OUTPUT A WORD TO THE DATA STREAM JSB NOUT ISZ WPNTR ISZ RELC IF U DUN DEN BUG OUT JMP NUMLP IF NOT DEN LOOP HE18 LDA TERM GET THE TERMINATOR CPA BLNK IS THIS THE END OF THE TERM ? JMP HC04 YES, EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1600 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SAB þúE CLA MAKE A NOP JSB NOUT DUMP IT JMP HC04 BUG OUT, U DONE * ASCER CLA JSB NOUT PUT A ZERO IN THE DATA STREAM JMP HE18 CONTINUE SCAN .VAL0 DEF TEMP+1 WPNTR BSS 1 WHAT BSS 1 .8 DEC 8 * * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP STA INST CLA ISZ T+1 IF NOT FIRST LINE THEN LDA .4 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCP LDA SCN1+2 INITIALIZE FOR ASC PROCESSING STA PNTR LDA .M1 STA T+1 LDA .2 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; ERROR SZB,RSS ASKING FOR ZERO WORDS? JMP HP2D-1 YES * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; ERROR LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND CPA L+1 'HvTþúLT'? JMP HP2D YES * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB B1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT LDA 1 LDB INST LOAD B WITH OCTAL INSTR ADA IOPR-2 MASK FIRST PART CPB RAM SEE IF A RAM INSTR RSS SKIP NEXT MASK IF RAM ADA IOPR-1 IF NOT RAM ADD SECOND PART LDB SUMP RESTORE B REG * SKP * * * TEST FOR VALUE>63 * * SSA VALUE >64 ? JMP *+4 YES-O.K. LDA .OV 'OV' ADDRESS OVERFLOW JSB ERPR GO PRINT ERROR MESSAGE. Q CLB ADB INST (HE54+1) STB INST JMP HP2D .C OCT 103 ASCII 'C' * * * PROCESS SOC OR SOS * HC28 LDA SCN1+2 PNTR TO OPERAND SZA,RSS OPERAND PRESENT? JMP HP2D NO LDB 0 A TO B JSB ?MSYM ADA .M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * * LDA INST IOR B1000 MASK IN CURRENT BIT STA INST JMP HP2D * SKP * ********************** * * MICRO-OP PROCESSOR * * ********************** MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * * START HERE FOR EACH NEW CODE * F LDA INST UNPACK THE MICRO-OP CODE * ÏŽþú * THE FORMAT IS: * BITS 14-13=1 IF SRG,2 IF ASG, 0 IF * EITHER * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF * NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE IT'S BIGGER THAN THE LAST. ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE BITS 0 AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3, TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA †IHFBINSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA .3 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 YES, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * SKP * ***************** * * PROCESS 'END' * * ***************** * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD CLA,INA LDB BLNS JSB LIST LIST 'END' STATEMENT 3Hÿÿþú JSB ?ENDS GO TO END SUBROUTINE JMP ASMBX GO TO COMPLETION * SKP * * ********************************************************* * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************* * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START SETTING PARAMETER COUNT ADA .7 SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM IS OK LDB .M1 B = -1 CPA .M6 BIT TYPE INSTR.? (115B) ADB .M1 B = -2 IF YES STB OPNUM SAVE PARAMETER COUNT PROCX JSB LOUT OUTPUT MICROCODE TO PUNCH JSB LIST LIST SOURCE STATEMENT LDA PLCN GET CURRENT LOCN COUNTER VALUE STA STAR SAVE IN PSEUDO COUNTER STA STARX SAVE AS ORIGINAL VALUE ISZ STAR BUMP PSEUDO ISZ PLCN BUMP ACTUAL * PROC1 LDA .20B SET CODE TO = 20B(DEF) STA CODE IN ORDER TO FAKE OUT CHOP LDA STARX STA PLCN RESET PLCN TO STARTING VALUE CLA STA INST CLEAR INSTRUCTION LDA SCODE CPA .13B IS CODE = 113B?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE AN OPERAND JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN * PROC2 JSB CHOPI EVALUATE OPER.(NON-INDIRECT) JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN PROC3 CLA STA SUMP SET VALUE = 0 PROC4 LDA PNTR STA SCN1+2 RESET POINTER TO NEXT OPERAND LDA SUMP IOR INST STA INST INST = OPERAND VALUE SSA WAS ADDR INDIRECT? ISZ SCN1+2 YES, BUMP LOCN OF OPERAND LDB STAR STB PLCN SET LOCN COUNTER TO ACTUAL VALUE JSB LOUT GO PUNCH IT LDA .4 JSB LIST GO LIST IT ISZ PLCN BUMP LOCN COUNTER ISZ STAR BUMP PSEÌPþúUDO LOCN COUNTER CLA STA INST CLEAR INST IN CASE FINAL NOP LDB SCODE CPB .12 CODE=114B? (NOP IN LAST WORD) JMP PROCA YES - EXIT ISZ OPNUM LAST OPERAND? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - GO FOR NEXT SOURCE STATEM. * PROCA JSB LOUT GO PUNCH NOP LDA .4 SET FOR RESTRICTED LIST JMP HC30+1 GO. * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION .13B OCT 13 13B SCODE NOP SAVE CODE-100B .100B OCT 100 100B M100B OCT -100 -100B OPNUM NOP SAVE OPERAND COUNT .20B EQU .16 20B ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 377B UMASK EQU RAM+1 177400B .7 DEC 7 * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE CLA STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNT LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GR3 TR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RIGHT FLAG IOR INST NO - SET UP TO GENERATE A WORD BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RIGHT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ******************************************************* * * PROCESS BYTE LOCN DEFINE INSTRUCTIONS - DBL AND DBR * * ******************************************************* * BYTE LDA .20B STA CODE SET CODE=DEF TO FAKE OUT CHOP JSB CHOPI JMP HC17E ERROR EXIT CLE,ELB ADDRESS * 2. E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP HP2D-1 NO,GO TELL EM JMP HCX GO COMPLETE PROCESSING * SPC 1 ******************************************************************** ********** CHANGE LOC'N. Z IN ASMB IF THIS PROGS. LWA > 1550B ****** ******************************************************************** SPC 1 ASMBX EQU ?ASMB ?AREC EQU BREC SPC 1 END ASMB4 ÿMÿÿ ÿý ÿ92067-18075 2013 S C0122 &DBUGR DBUGR SUBROUTINE             H0101 âÇþúASMB,Q,C * * DATE: 780117 * NAME: DBUGR * SOURCE: 92067-18075 * RELOC: 92067-16075 * PGMR: B.S.,G.A.,D.D.,D.S.,J.N.,R.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED DBUG(USER VERSION) NAM DBUGR,7 92067-16075 REV.2013 800128 ENT DBUGR ENT .DBUG,.SDBG EXT EXEC,$LIBX,$LIBR,IFBRK,LOGLU,REIO EXT SGBPT,SGBPE SUP * * A EQU 0 B EQU 1 R EQU 1 HED SYMBOL TABLES * E N D * * USER DEFINED SYMBOL TABLE AREA * * SYMBOLS WILL RESIDE IN IDENTICAL FORMAT TO TABLE "ISL" * FOLLOWING THIS TABLE IN MEMORY. THAT FORMAT IS: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * END BSS 50 SYMBOL TABLE FREE AREA ISL0 EQU * SPECIAL REGISTERS OCT 51476,61146 CBTEST DEF SKP OCT 51467,44535 CBMASK DEF BMSK OCT 51453,54714 CBADDR DEF BADD OCT 51500,716 CBVAL DEF BVAL OCT 110625,25 MASK DEF MSK OCT 60704,1151 EOREG DEF FLGBX OCT 157457,21 YREG DEF ACCY OCT 154357,21 XREG DEF ACCX OCT 47557,21 BREG DEF ACCB OCT 44457,21 AREG DEF ACCA OCT 47560,1601 BRFLG (0=CHK FOR BRK, NOT 0, NO CHK) DEF BRFLG OCT 151276,1617 WRTLU (WHERE DOES OUTPUT GO?) Õ]þú DEF LU SKP * I S L * * INSTRUCTIONS SYMBOL TABLE * * CONTAINS SYMBOLS FOR THE 2100 ALTER SKIP,SHIFT ROTATE AND * I O INSTRUCTIONS SET IN SQOZE CODE. TABLE ENTRIES ARE IN * THE FOLLOWING FORMAT: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * ISL EQU * OCT 45 . LOC NOP USED AS THE LOCATION COUNTER OCT 2755 .. DDOT NOP * * I S L 2 * * REMAINDER OF TABLE "ISL" SOMETIMES REFERRED TO DIRECTLY AND * SOMETIMES REFERRED TO AS A PART OF TABLE "ISL" * ISL2 EQU * OCT 44115,0,1000 ALS OCT 44475,0,1100 ARS OCT 130316,0,1200 RAL OCT 130324,0,1300 RAR OCT 44114,0,1400 ALR OCT 61053,0,1500 ERA OCT 60473,0,1600 ELA OCT 44100,0,1700 ALF OCT 47215,0,5000 BLS OCT 47575,0,5100 BRS OCT 130366,0,5200 RBL OCT 130374,0,5300 RBR OCT 47214,0,5400 BLR OCT 61054,0,5500 ERB OCT 60474,0,5600 ELB OCT 47200,0,5700 BLF ISL3 EQU * OCT 52273,0,2400 CLA OCT 52343,0,3000 CMA OCT 51523,0,3400 CCA OCT 52274,0,6400 CLB OCT 52344,0,7000 CMB OCT 51524,0,7400 CCB SEZ OCT 133674,0,2040 SEZ OCT 133674,0,6040 SEZ CLE OCT 52277,0,2100 CLE OCT 52277,0,6100 CLE OCT 52277,0,40 CLE OCT 52277,0,4040 CLE çÆþú OCT 52277,35,40 CLES OCT 52347,0,2200 CME OCT 52347,0,6200 CME OCT 51527,0,2300 CCE OCT 51527,0,6300 CCE OCT 131645,0,2001 RSS OCT 131645,0,6001 RSS OCT 134723,0,2020 SSA OCT 75213,0,2004 INA OCT 135353,0,2002 SZA OCT 134724,0,6020 SSB OCT 75214,0,6004 INB OCT 135354,0,6002 SZB SLA OCT 134273,0,10 SLA OCT 134273,0,2010 SLA OCT 44115,0,20 ALS LOWER OCT 44475,0,21 ARS LOWER OCT 130316,0,22 RAL LOWER OCT 130324,0,23 RAR LOWER OCT 44114,0,24 ALR LOWER OCT 61053,0,25 ERA LOWER OCT 60473,0,26 ELA LOWER OCT 44100,0,27 ALF LOWER SLB OCT 134274,0,4010 SLB OCT 134274,0,6010 SLB OCT 47215,0,4020 BLS LOWER OCT 47575,0,4021 BRS LOWER OCT 130366,0,4022 RBL LOWER OCT 130374,0,4023 RBR LOWER OCT 47214,0,4024 BLR LOWER OCT 61054,0,4025 ERB LOWER OCT 60474,0,4026 ELB LOWER OCT 47200,0,4027 BLF LOWER OCT 23,100000 I O15 OCT 15,1000 C OCT 72016,0,102000 HLT HLT EQU *-1 OCT 52300,0,103100 CLF OCT 135000,0,102100 STF STF EQU *-1 OCT 133715,0,102200 SFC OCT 133735,0,102300 SFS OCT 111303,0,102400 MIA OCT 111304,0,106400 MIB OCT 120373,0,102600 OTA OCT 120374,0,106600 OTB OCT 134775,0,102700 STC OCT 52275,0,106700 CLC OCT 106203,0,102500 LIA OCT 106204,0,106500 LIB %þú OCT 44544,0,101020 ASR OCT 44536,0,100020 ASL ASL EQU *-1 OCT 107044,0,101040 LSR OCT 107036,0,100040 LSL LSL EQU *-1 OCT 131574,0,101100 RRR OCT 131566,0,100100 RRL RRL EQU *-1 OCT 51432,0,101741 CAX OCT 51433,0,101751 CAY OCT 51502,0,105741 CBX OCT 51503,0,105751 CBY OCT 53233,0,101744 CXA OCT 53234,0,105744 CXB OCT 53303,0,101754 CYA OCT 53304,0,105754 CYB OCT 153132,0,101747 XAX OCT 153133,0,101757 XAY OCT 153202,0,105747 XBX OCT 153203,0,105757 XBY OCT 105576,0,105763 LBT OCT 133476,0,105764 SBT OCT 106013,0,101727 LFA OCT 106014,0,105727 LFB OCT 110663,0,105702 MBI OCT 110701,0,105704 MBW OCT 112373,0,105705 MWI OCT 112411,0,105707 MWW OCT 131623,0,101730 RSA OCT 131624,0,105730 RSB OCT 132013,0,101731 RVA OCT 132014,0,105731 RVB OCT 154043,0,101722 XMA OCT 154044,0,105722 XMB OCT 154065,0,105721 XMS OCT 56052,0,105761 DSX OCT 56053,0,105771 DSY OCT 75552,0,105760 ISX OCT 75553,0,105770 ISY OCT 110660,0,105703 MBF OCT 112370,0,105706 MWF OCT 122103,0,101712 PAA OCT 122104,0,105712 PAB OCT 122153,0,101713 PBA OCT 122154,0,105713 PBB OCT 135303,0,101710 SYA OCT 135304,0,105710 SYB OCT 143123,0,101711 USA OCT 143124,0,105711 USB OCT 154057,0,105720 XMM OCT 63432,0,105100 FIX OCT 63616,0,105120 ¦üþúFLT OCT 133714,0,105767 SFB SKP "CR" EQU O15 DOUBL EQU * OCT 111763,0,100200 MPY OCT 55230,0,100400 DIV OCT 55376,0,104200 DLD OCT 56046,0,104400 DST OCT 62706,0,105000 FAD OCT 63120,0,105060 FDV OCT 63662,0,105040 FMP OCT 64224,0,105020 FSB OCT 43422,0,105746 ADX OCT 43423,0,105756 ADY OCT 105532,0,101742 LAX OCT 105533,0,101752 LAY OCT 105602,0,105742 LBX OCT 105603,0,105752 LBY OCT 105722,0,105745 LDX OCT 105723,0,105755 LDY OCT 153773,0,101724 XLA OCT 153774,0,105724 XLB OCT 133432,0,101740 SAX OCT 133433,0,101750 SAY OCT 133502,0,105740 SBX OCT 133503,0,105750 SBY OCT 135022,0,105743 STX OCT 135023,0,105753 STY OCT 134737,0,105714 SSM OCT 100223,0 JLY JLY OCT 105762 OCT 100463,0 JPY JPY OCT 105772 * FOLLOWING INSTRUCTIONS ARE IN THE 21MX BASE SET * BUT ARE NOT SIMULATED BY DDT AND CANNOT BE TRACED. OCT 55272,0,105732 DJP IVINS EQU *-1 OCT 55275,0,105733 DJS OCT 134172,0,105734 SJP OCT 134175,0,105735 SJS OCT 142372,0,105736 UJP OCT 142375,0,105737 UJS OCT 154423,0,101725 XSA OCT 154424,0,105725 XSB STTP2 EQU * OCT 100575,0,105715 JRS OCT 153223,0,101726 XCA OCT 153224,0,105726 XCB * THE FOLLOWING ARE INCLUDED BY DDT AND CAN BE TRACED STTP3 EQU * OCT 51476,0,105766 CBT OCT 110676,0,105765 MBT OCT 51475,0,105774 CBS OCT 133475,0,105773 SBS OCT 136575,0,10577©þú5 TBS OCT 112341,0,105777 MVW OCT 52371,0,105776 CMW STTP EQU * SKP DSPTB DEF PLUS SPACE DEF EXCL ! DEF ASCIN " DEF NUMSN # DEF EXI $ DEF PCT % DEF DAQ & DEF ASO ' DEF PFIX ( DEF EXASC ) DEF STAR * DEF PLUS + CMADD DEF COMMA , DEF MINUS - DEF DOT . DEF BAR / NMFLG BSS 1 NOT USED FOR DISPATCHING (ASCII # 0) BSS 1 NOT USED FOR DISPATCHING (ASCII # 1) BSS 1 NOT USED FOR DISPATCHING (ASCII # 2) BSS 1 NOT USED FOR DISPATCHING (ASCII # 3) BSS 1 NOT USED FOR DISPATCHING (ASCII # 4) BSS 1 NOT USED FOR DISPATCHING (ASCII # 5) TEMP4 BSS 1 NOT USED FOR DISPATCHING (ASCII # 6) TEMP3 BSS 1 NOT USED FOR DISPATCHING (ASCII # 7) TEMP2 BSS 1 NOT USED FOR DISPATCHING (ASCII # 8) TEMP1 BSS 1 NOT USED FOR DISPATCHING (ASCII # 9) DEF COLON : DEF SEMI ; DEF LSSN < DEF EQLS = DEF GRTR > DEF MSTAT ? DEF EXA @ DEF AT A DEF BRK B DEF CT C DEF PNCH D DEF EAS E DEF FT F DEF GO G DEF HT H ERRX DEF ERR I DEF USMAP J DEF KILL K DEF TABL L DEF MT M DEF NWS N DEF BPM O DEF PROC P DEF QT Q DEF RSET R DEF ST S DEF TRACE T DEF ECSL U DEF VFY V DEF WDS W DEF XEC X DEF LOAD Y DEF ZRO Z DEF SBRK [ DEF ALT \ DEF CR ] DEF UPARW ^ DEF LARR _ HED DBUG INITIALIZATION * .DBUÛÖþúG NOP WHERE LOADER WILL PLACE TRUE RETURN. $DDT NOP EVERYONE'S ENTRY POINT DBUGR EQU $DDT JSB SVST NOMINAL ENTRY POINT LDB .DBUG DETERMINE IF CALLED FROM LDA $DDT LOADER($DDT = 0)OR SZA DIRECTLY. LDB $DDT,I SET EXIT ADDRESS STB DDOT FOR PROCEED ISZ $DDT STEP TO POSSIBLE LU ADDRESS. SZA IF APPENDED BY LOADER OR CPB $DDT IF THERE IS NO LU GIVEN, JMP TST THEN GO GET LOG LU OR LU 1. * LDA $DDT,I YES GET IT LDA A,I TO A * TST1 AND O77 ISOLATE IT IOR O400 DO NOT MAKE HONEST MODE STA LU SAVE AS THE LU JSB EXEC GET TYPE CODE DEF TSTRT-1 IN CASE OF EXEC CALL ERROR DEF NAB15 (OCT 15+NO ABORT BIT) DEF LU PCH DEF CH TEMP * JSB EXERR IN CASE OF EXEC ERROR TSTRT LDA PCH,I GET EQT WORD 5 AND C374 KEEP TYPE STA TMODE SET MODE (0= '\' #0= '\\' STA B SAVE TYPE FOR LU SETUP LDA LU CPB DV07 DVR07 TYPE LU? RSS YES, SKIP SETTING HONEST MODE IOR O2100 NO,SET HONEST MODE STA LUC LDA M80 TEST FOR DVR07 CPB DV07 STA IBUFL YES, SET TO READ UP TO 16 CH. LDB PNT10 PRINT 'START JSB OUTMS DBUGR' MESSAGE. JMP LSE * TST JSB LOGLU GO RECOVER LOG DEF *+2 LU OR IF NONE, DEF LU THEN USE LU 1. JMP TST1 A-REG = LU#. * C374 OCT 37400 O2100 OCT 2100 DV07 OCT 3400 PNT10 DEF MSG01 MSG01 OCT 6412 CR/LF ASC 6,START DBUGR O6412 OCT 6412 CR/LF ASC 1,// HED DBUG - CHARACTER DISPATCH * * COMMAND INTERPRETER * LSE RSS CLEARED ON FIRST ENTRY JMP LSE1 * * THE CODE FROM HERE TO LSE1 IS DONE ONLY ONCE AS INITIALIZATION * LDA BIX GET THE ADDRESS TO USE AGE AND G74 °’þú FOR BREAK INSTRUCTIONS XOR BIX SAVE THE ADDRESS ONLY STA DSYMX SAVE IT FOR BREAK LDA LNEV SET FENCES CMA,INA FOR STA LNEV EVAL CHECKS LDA LXEV MUST BE NEG CMA,INA STA LXEV * LDA 1777B SET DM BOUNDS STA CEND SET END OF MEMORY INA STA UPBD CMA,INA STA MUPBD * LDA BIXP SAVE BIX JMP TABLE INSTRS LDB BIXBP MVW O3 * LSE1 JSB CRLF CLA PROTECT STA PFLAG STORES * LSF LDA PM STA EXPM * LSF2 CLA FROM TABP. STA TRAC CLEAR TRACE COUNT STA LSE CLEAR FIRST TIME RSS STA $DDT CLEAR JSB ENTRY POINT. STA LFLG LDA O3 STA LL LDA CEND STA UL * LSS CLA FROM LIM SET. STA CHI STA WRD STA CLEFG CLEAR CLE FLAG STA CMFLG CLEAR COMMA FLAG STA INSTR STA ALTMI LDA CAD * SSN STA SGN CLA * LSQ STA ONM STA DNM CLA,CLE CLE IS DECORATION. STA SYM STA SYM+R STA LETF STA CHC LDB SYMXI STB SYMX STA WSD MAKE A NO-OP. * LSR0 EQU * STA ASCI * LSR EQU * CHARACTER DISPATCH JSB TTYOP GET A CHAR STA CH CPA O177 JMP DEL * LDB LFP LF? CPA O12 JMP LFCRT YES * LDB CRP CR? CPA O15 JMP LFCRT YES * LDB CH USE DISPATCH TABLE ADB DSPP LDB B,I ADA M40 SSA LDB ERRX 0-37, ERROR UNLESS... LDA CH CPA O11 LDB TBP CPA O176 LDA O33 CPA O33 JMP ALTMD * STB PN ADA M72 SSA,RSS JMP LT 72-177, CHECK FOR LETTER. * ADA O12 SSA JMP LSCG 0-57, NOT NUMBER OR LETTER. * JSÍ©þúB BUMP PROCESS DIGIT JMP L1 SKP ASCI NOP M40 OCT -40 M41 OCT -41 M72 OCT -72 M80 DEC -80 O11 OCT 11 O176 OCT 176 O1000 OCT 1000 O3 OCT 3 O32 OCT 32 CRP DEF CR CAD DEF PLUS DSYMX DEF SYMX,I CONFIGURED ON 1ST ENTRY DSPP DEF DSPTB-40B EXPM NOP INSTR NOP LETF NOP LFP DEF LF SGN NOP TBP DEF TAB SKP * LT ADA M41 CHECK FOR LETTER LDB ALTMI CCE,SSA SEZ,SZB SZB: ALT MODE PRESENT? JMP LSET OPERATOR. * ADA O32 SSA JMP LSCG 72-100 * ISZ LETF PROCESS LETTER * L ADA O12 MAKE SQOZE CODE * L1 INA LDB CHC CPB O3 ISZ SYMX ADB M6 CLE,SSB,INB,RSS SSB,RSS: MORE THAN SIX CHARS? JMP LSR * ISZ CHC ISZ CHI LDB SYMX,I TIMES 50 RBL,RBL ADB SYMX,I BLF,RBR ADB A STB SYMX,I USED AS CONSTANT LDA ASCI ALF,ALF ADA CH JMP LSR0 * LFCRT XOR C3007 SWAP CR AND LF STB PN JSB TYO CLA * LSET ADA M6 72-177 SSA,RSS CHECK FOR 141-177 JMP ERR YES, LOSE. * LSCG LDB PN GET DISPATCH ADDRESS ADB LNEV CLA FOR MT,FT OCT 5254 RBL,CLE,SLB,BLR :THE BLR IS DISABLED JMP PN,I NO-EVAL, DISPATCH NOW. * CPA LETF IF NO LETTERS, JMP LSCI ANY OPERAND IS NUMERIC. * LDB SYM+R SZB JMP NOTOP * OPLK LDB A SEARCH OP TABLE ADB OPPTR LDB B,I GET SYMBOL CPB SYM JMP OPFND * INA SZB JMP OPLK * NOTOP JSB EVS EVALUATE SYMBOLIC TERM. JMP SGN,I DEFINED; GO COMBINE TERMS. * LDA CH125 U - UNDEFINED JMP ERRP * CH125 OCT 125 * OPFND ALF,RAR MOVE INDEX TO OP POSN ALF,CLE,SLA,ALF ALWAYS SKIPS: USED AS CONSTANT CPA IAmMþúDR,I STA INSTR * LSCI LDA ONM COMBINE OPERANDS JMP SGN,I PERFORM SIGN OPERATION. SKP * * BUMP * * UPDATES CURRENT NUMERIC ENTRY * * CALLING SEQUENCE: * LDA * JSB BUMP * P+1 * * BUMP NOP LDB ONM PROCESS DIGIT BLF,RBR SAVE CURRENT ADB A NUMBER AS STB ONM OCTAL LDB DNM SAVE RBL,RBL CURRENT ADB DNM NUMBER RBL AS ADB A DECIMAL STB DNM JMP BUMP,I HED NON-EVALUATION OPERATORS * DOT CPA CHC IF FIRST CHAR, ISZ LETF TREAT AS LETTER. LDB DNM STB ONM LDA O32 BECOMES SQOZE CODE. JMP L * DEL LDA CH130 X JMP ERRP * CH130 OCT 130 * SYMO LDA O117 SYMBOL TABLE OVERFLOW RSS * BADP LDA CH120 P JSB TYO * ERR LDA O77 ? * ERRP JSB TYO * OTST LDA TAS REGISTER OPEN? CPA LIMBO JMP LSE NO. JMP TABP YES. * CH120 OCT 120 * ASCIN LDA ASCI ASCII INPUT JMP N1 * DAQ LDA LWT DEFINE SYMBOL AS ADDRESS JSB ADRC CLEARS E LDA B ELA,SLA,RAR CLEAR SIGN & SKIP * COLON LDA LOCP,I DEFINE SYMBOL AS LOCATION LDB LFLG SZB LDA LL LDB LETF CHECK SYMBOL SZB,RSS JMP ERR * JSB DEFS JMP TABP * O117 OCT 117 LWT NOP TAS DEF SYM ADDRESS OF OPEN REGISTER SKP * ALTMD LDA O134 BACKSLASH JSB TYO ECHO LDA O134 IF SET FOR A ESC GOBBLER LDB TMODE THEN SZB JSB TYO SEND TWO '\' 'S * ALT ISZ ALTMI JMP LSR * ECSL LDA TMODE 'U' CHANGE ESC DOUBLE '\' OPTION CPA DV07 IF DVR07 BYPASS ²þúCHANGE JMP OTST * LDB ALTMI IF DOUBLE ESCAPE CPB O2 THEN A SWITCH BETWEEN CHARACTER JMP ECSL2 AND BLOCK MODE * SZA ELSE CHANGE DOUBLE ESCAPE OPTION CLA,RSS CCA STA TMODE JMP OTST * ECSL2 LDA LUC XOR O2100 CHANGE HONESTY MODE STA LUC AND O2100 LDB M80 IF NOT HONEST BUFFER IS 72 CHARS SZA CCB ELSE IT IS ONE CHAR STB IBUFL JMP OTST * TMODE NOP INITIAL SET FOR NON '\' GRABBER * END OF ESSENTIAL NO-EVALS. HED MISCELLANEOUS OPERATORS * KILL LDA SISL0 KILL SYMBOLS "\K" STA STEND JMP LSE * FT ADA STED "\F" JMP N1 * BPM LDA PM "\O" STA BM JMP OTST * HT INA SET PRINT MODE HOLLERITH "\H" * CT INA CONSTANT "\C" * ST INA SYMBOLIC "\S" * AT ADA STPPP ADDRESS MODE "\A" LDA A,I USED AS CONSTANT STA PM SET MODE STA EXPM JMP OTST * QT LDA LWT "\Q" JMP N1 * STAR LDA LOCP,I * N1 CLB STB ALTMI ISZ CHI JMP LSQ RESET SYMBOL STUFF. * PFIX CCA UNPROTECT STA PFLAG STORES JMP LSF * LNEV DEF * END OF NO-EVALS. BM DEF NUMP STPPP DEF ADRPP LINK TO MASTER MODE TABLE PFLAG NOP PROTECT FLAG SISL0 DEF ISL0 SKP * "\M[CR]" MT LDB MTMS1 PRINT THE SPECIAL REGISTERS JSB OUTMS CCB ADB SISL0 ADB O36 STB MTCNT * MTLOP LDA MTCNT,I LDA A,I ONE MORE LEVEL OF INDIRECTION JSB NUMP LDA PNCNT HOW MANY SPACES TO RIGHT FILL? ADA M7 STA PNCNT SSA,RSS JMP MTL2 * ISZ PNCNT RSS JMP MTL2 @5þú* LDA CH40 JSB TYO JMP *-5 * MTL2 LDA CH40 JSB TYO LDA MTCNT ADA M3 STA MTCNT CMA,INA ADA SISL0 ADA O3 SSA JMP MTLOP * JSB PTAB 3 SPACES LDA MTCNT,I GET CBTEST LDA A,I JSB INSTP JMP LSE * MTMS1 DEF *+1 ASC 14,AREG BREG XREG YREG ASC 7,EOREG MASK ( ASC 15,CBVAL-CBADDR,I)^CBMASK =CBTEST OCT 6412 ASC 1,// MTCNT BSS 1 O36 OCT 36 SKP * MINUS CMA,INA * PLUS ADA WRD JMP WSET * COMMA IOR WRD * WSET STA WRD RETURN HERE FROM SIGN OP. LDA PN LDB PN CPB CMADD IF COMMA SET COMMA FLAG STB CMFLG ADB LXEV OCT 5257 RBL,CLE,SLB,BLF :THE BLF IS DISABLED JMP SSN SET SIGN FOR NEXT TIME. * LDA INSTR CHECK FOR PAGE ERROR * CSNZA SZA,RSS JMP NAOP NOT ADDRESSABLE. * LDA WRD AND G76 PAGE BITS? LDB A SAVE 'EM SZA,RSS JMP NAOP BASE PAGE. * XOR IADR AND G76 * CSZA SZA JMP BADP YOU CAN'T GET THERE FROM HERE. * LDA O2000 PUT IN PAGE BIT. XOR B * NAOP XOR WRD RESTORE LOCAL ADDRESS. ADA INSTR STA WRD CLB STB INSTR LDB CHI SZB,RSS LDA LWT STA LWT JMP PN,I DISPATCH TO PROCESSOR (EVALS) SKP * LXEV DEF * END OF COMBINING OPERATORS. * * BEGIN ESSENTIAL EVALS. * GRTR JSB DMCHK CHECK IF IN PARTITION STA UL LIMIT SET * CSKP RSS * LSSN STA LL ISZ LFLG JMP LSS * RSET LDB A SET RADIX "\R" ADA M2 CLE,SSA JMP ERR * ADA M40 SSA,RSS JMP ERR * STB RADIX JMP LSE * M2 OCT -2 O2000 OCT 2000 G76 OCT 76000 HED REGISTER EXAMINATION ASO LDA ASCPP PRëÁþúINT AS ASCII JMP SETM * EXCL LDA INSPP PRINT AS INSTRUCTION JMP SETM * LARR LDA ADRPP PRINT AS ADDRESS JMP SETM * EQLS LDA NUMPP PRINT AS NUMBER * SETM STA PN ONE TIME MODE SET LDB ALTMI SZB STA EXPM TEMP MODE SET LDA LWT JSB CLESB CHECK CLE FLAG, ADD CLE INS TO AREG? JSB PN,I JMP TABP * SEMI JSB EXPM,I PRINT IN CURRENT MODE JMP TABP * EXASC LDB ASCPP EXAMINE AS ASCII JMP EXAM * EXI LDB INSPP EXAMINE AS INSTRUCTION JMP EXAM * EXA LDB ADRPP EXAMINE AS ADDRESS JMP EXAM * NUMSN LDB NUMPP EXAMINE AS NUMBER JMP EXAM * PCT JSB STORE CLB STB CHI FOOL BAR LOGIC * BAR LDB EXPM USE TEMP MODE * EXAM STB STORE SET IMMEDIATE MODE LDB ALTMI SZB JSB ADRC LDA LWT ELA,CLE,ERA PURGE INDIRECT BIT LDB CHI SZB,RSS ADDRESS SPECIFIED? JMP TA6 NO, USE LWT * LDB STORE YES, SET TEMP MODE, TOO. STB EXPM JMP TA5 * TAB JSB STORE LDB ALTMI SZB JSB ADRC LDA LWT TA3 STA TAS JSB CRLF LDA TAS * TA4 ELA,CLE,ERA PURGE INDIRECT BIT STA TAS JSB ADRP PRINT ADDRESS JSB TYO PRINT / LDB EXPM STB STORE SET TO USE TEMP MODE LDA TAS * TA5 STA LOCP,I SET LOCATION COUNTER * TA6 STA TAS STA IADR JSB DMCHK TEST IF IN PARTITION JSB PTAB LDA ACCA B LOADED BY PTAB-TYO-TTYOP LDA TAS,I STA LWT JSB STORE,I PRINT CONTENTS * TABP JSB PTAB JMP LSF2 * CR JSB STORE "CR" CCA SET NO LINE FEED FLAG STA LFLAG JMP LSF * UPARW JSB STORE "^" CCA ADA LOCP,I DECREMENT LOCATION COUNTER JMP TA3 * LF JSB STORE Wþú "LF" CLA,INA NEXT LOCATION ADA LOCP,I JMP TA4 * "/" OCT 57 SLASH SPACE OCT 40 "M" OCT 115 SKP * A "?" DISPATCHES HERE * MSTAT LDB MSTMS " MS = " "?" JSB OUTMS LDA M6 INITIALIZE STA TEMP1 COUNTER TO 6 RSA GET MEM STATUS * MST01 STA TEMP2 SAVE ROTATED STATUS LDB A PRINT BIT15 AND SPACE LDA ZERSP SSB ADA O400 JSB TY2 LDA TEMP2 RESTORE ROTATED STATUS RAL ROTATE NEXT BIT ISZ TEMP1 DONE? JMP MST01 NO,CONTINUE * ALF,ALF YES,GET RAL,RAL ORIGINAL A AND O1777 MASK BP FENCE LDB O10 WRITE BP FENCE JSB PN ON CONSOLE JSB PTAB 3 SPACES JMP LSF2 * "=" OCT 75 O10 OCT 10 O1777 OCT 01777 MSTMS DEF *+1 ASC 5, MS = // ZERSP ASC 1,0 SKP USMAP JSB CRLF CR LF "\J" JSB PTAB 3 SPACES * USM01 JSB TTYOP GET 1ST OPERATOR INPUT CPA "A" ABORT? JMP USM02 YES * CPA "CR" CR? JMP USMAP YES,NO ACTION * CPA SPACE SPACE? JMP USM01 YES,IGNORE * AND O177 SAVE 1ST ALF,ALF CHARACTER STA TEMP1 IN UPPER BYTE JSB TTYOP GET 2ND OPERATOR INPUT AND O177 FORM IOR TEMP1 WORD * CLB CPA "SM" SYSTEM MAPS? LDB SYA CPA "UM" USER MAPS? LDB USA CPA "PA" PORT A? LDB PAA CPA "PB" PORT B? LDB PBA SZB JMP USM03 IF B NOT 0, GO DO * CPA "XL" CROSS LOAD? JMP XLOAD JMP ERR * USM02 JSB PTAB 6 JSB PTAB SPACES JMP LSF2 * "PA" ASC 1,PA "PB" ASC 1,PB "SM" ASC 1,SM "UM" ASC 1,UM "XL" ASC 1,XL O20 OCT 20 O72 OCT 72 SKP ¯Yþú USM04 BSS 1 USM03 STB USM04 LDA O72 : JSB TYO LDA USM04 STA RMAP1 LDA IMAPS BUFFER ADDRESS,I JSB $LIBR UNPROTECT FOR OLD MX'S NOP RMAP1 NOP JSB $LIBX DEF *+1 DEF USE00 USE00 CLA SET UP INDEX STARTING AT 0 LDB IMAP B-REG GETS MAP BUFFER ADDRESS USE01 JSB SHMAP 2 MAPS CPA O20 DONE? RSS YES JMP USE01 NO,CONTINUE JSB CRLF CR LF JMP USMAP SKP XLOAD CLA CLEAR STORE FLAG STA XADR CLEAR LAST ADDRESS LDA IMAPS GET SYSTEM MAPS JSB $LIBR ****PROTECT FOR OLD MX'S NOP SYA JSB $LIBX DEF *+1 DEF *+1 * X01 JSB CRLF CR LF JSB PTAB 6 JSB PTAB SPACES LDA "XL" X JSB TY2 JSB PTAB 3 SPACES JSB GETAD GET ADDRESS FROM OPERATOR JMP ERR INPUT ERROR * CPB M1 ABORT? JMP USMAP SEE IF DONE * SZB,RSS ANY CROSS OPERATION? JMP X01 NO,NO ACTION * STA TEMP1 SAVE STA XADR ADDRESS JSB PTAB 3 SPACES ALF,RAL COMPUTE PAGE ADDRESS RAL AND O37 ADA IMAP LDA A,I GET MAP SSA READ PROTECTED JMP DMCK6 YES, GO TO DM ERROR * LDA XADR RESTORE A XLA TEMP1,I CROSS LOAD JSB NUMP NO,DISPLAY CONTENTS JMP X01 SEE IF MORE CROSS OPERATIONS * XADR NOP USA USA SYA SYA PAA PAA PBA PBA O37 OCT 37 SKP * G E T A D * * TAKE AN ADDRESS FROM OPERATOR * * JSB GETAD * P+1 * P+2 * GETAD NOP CLB ASSUME SIGN IS + INITIALLY STB ONM AND CLEAR CHARACTER COUNT STB DNM AND CLEAR OCTAL NUMBER STB CHC A6þúND CLEAR DECIMAL NUMBER GETA5 JSB TTYOP TAKE 1ST CHARACTER CPA "A" ABORT? JMP GETA1 YES * CPA "LF" LF? JMP GETA4 YES * CPA "^" ^? JMP GETA7 YES * CPA SPACE SPACE? JMP GETA5 YES,IGNORE IT * RSS NO,TREAT 1ST CHARACTER AS NUMBER GETA2 JSB TTYOP TAKE NEXT NUMBER CPA "CR" DEFAULT? JMP GETA1 YES * CPA "/" DONE? JMP GETA3 YES * ADA M72 NO,CHARACTER SSA,RSS >71B? JMP GETAD,I YES,ERROR * ADA O12 NO,CHARACTER SSA <60B? JMP GETAD,I YES,ERROR * JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER CPA O5 COUNT ALREADY =5? JMP GETAD,I YES,THIS ONE MAKES IT AN ERROR * ISZ CHC NO,BUMP CHARACTER COUNT JMP GETA2 CONTINUE * GETA3 LDA ONM A=NUMBER RSS GETA1 CCB,RSS SET ABORT FLAG GETA6 LDB CHC SET UP DEFAULT FLAG ISZ GETAD ADJUST RETURN JMP GETAD,I * GETA7 CCB,RSS GETA4 CLB,INB LDA XADR PREVIOUS SZA ADDRESS? JMP GETA8 * CLB JMP GETAD,I NO,ERROR * GETA8 ISZ CHC CLEAR ABORT FLAG LDA XADR DISPLAY ADA B ADJUST ADDRESS STA XADR JSB NUMP ADDRESS LDA "/" / JSB TYO LDA XADR A=ADDRESS=NUMBER JMP GETA6 * "^" OCT 136 "LF" OCT 012 O5 OCT 05 * HED NUMBER AND SYMBOL PRINT SKP * * SHMAP * * DISPLAYS 2 MAP VALUES ON CONSOLE * * CALLING SEQUENCE: * LDA * LDB * JSB SHMAP * P+1 , * SHMAP NOP STA SHMAI INDEX STB SHMAM MAP JSB CRLF JSB SIXSP 6 SPACES LDA SHMAI "INDEX=[MAP+INDEX]" b.þú JSB SHMA2 JSB PTABC LDA SHMAI "INDEX+20=[MAP+INDEX+20]" ADA O20 JSB SHMA2 LDA SHMAI A=A+1 INA LDB SHMAM RESTORE MAP ADDRESS JMP SHMAP,I * SHMA2 NOP LDB SHMAM MAP ADB A MAP+INDEX LDB B,I B <- [MAP+INDEX] STB SHMAN JSB NUMP "INDEX LDA "=" = JSB TYO LDA SHMAN [MAP+INDEX]" JSB NUMP JMP SHMA2,I * SHMAI BSS 1 SHMAM BSS 1 SHMAN BSS 1 IMAPS DEF MAPS,I IMAP DEF MAPS MAPS BSS 32 SKP * * GETNM * * TAKES OPERATOR NUMERICAL INPUT * * CALLING SEQUENCE: * LDA * JSB GETNM * P+1 * P+2 * GETNM NOP * GET05 JSB TTYOP TAKE 1ST CHARACTER CLB ASSUME SIGN IS + INITIALLY STB CHC AND CLEAR CHARACTER COUNT STB ONM AND CLEAR OCTAL NUMBER STB DNM AND CLEAR DECIMAL NUMBER CPA "A" ABORT? JMP GET01 YES * CPA SPACE SPACE? JMP GET05 YES,IGNORE IT * CPA NEG IS IT -? INB YES,SET - FLAG STB NMFLG SAVE + OR - FLAG CPA POS IS IT +? RSS YES SZB NO,1ST CHARACTER TREATED AS 1ST NUMBER? GET02 JSB TTYOP GET CHARACTER CPA "CR" DONE? JMP GET06 YES * CPA "LF" DONE? JMP GET06 YES * ADA M72 NO,CHARACTER SSA,RSS >71B? JMP GETNM,I YES,ERROR * ADA O12 CHARACTER SSA <60B? JMP GETNM,I YES,ERROR * JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER COUNT CPA O6 ALREADY = 6? JMP GETNM,I YES,THIS ONE MAKES IT AN ERROR * ISZ CHC NO,BUMP CHARACTER COUNT JMP GET02 CONTINUE * GET06 LDA ONM A=NUMBER LD&!þúB NMFLG NEGATIVE SZB,RSS NUMBER? JMP GET04 NO,POSITIVE,LEAVE IT ALONE * CMA,INA,RSS YES GET01 CCB,RSS SET ABORT FLAG ON EXIT GET04 LDB CHC SET UP DEFAULT FLAG ON EXIT ISZ GETNM ADJUST RETURN JMP GETNM,I * O6 OCT 6 POS OCT 53 NEG OCT 55 SKP * STORE NOP SZB,RSS ANYTHING TYPED? JMP STORX NO, RETURN. * JSB CLESB WAS CLE FLAG SET * STA TEMP3 SAVE VALUE LDB PFLAG UNPROTECT SZB THE STORE? JMP STORZ * LDA TAS NO CHECK FOR MP SZA A OR B REGISTER CPA O1 JMP STORY YES, STORE IT * JSB MPCHK CHECK FOR MP & DM ERROR JMP MPMSG GO PRINT "MP?" * STA IADR JSB ADCHK CHECK FOR DBUGR OVERWRITE JMP STORY OK TO STORE * STORZ JSB $LIBR YES,GO NOP PRIVELEGED STORY LDB TAS SZB,RSS STORE TO A REG LDB DACCA YES GET PHONY A REG ADDRESS CPB O1 LDB DACCB YES GET PHONY B REG ADDRESS STB TAS LDA TEMP3 RESTORE VALUE STA TAS,I LDB PFLAG JUST STORE SZB,RSS UNPROTECTED? JMP STORX NO,GO ON * JSB $LIBX YES,GO DEF *+1 UNPRIVELEGED DEF STORX STORX LDB LIMBO STB TAS CLOSE REGISTER JMP STORE,I * CLESB NOP WAS CLE FLAG SET STB CLES1 SAVE B LDB CLEFG SZB,RSS JMP CLES2 NO, RETURN * LDB A AND O2000 YES, WHICH GROUP SZA ADA O40 SRG CLE=2100B ADA O40 ASG CLE=40B IOR B AND MERGE WITH INSTRUCTION * CLES2 LDB CLES1 RESTORE B JMP CLESB,I * CLES1 BSS 1 HED BREAKPOINT * BRK SZB USER ENTER ADDRESS? JMP BRK1 YES,SEE IF VALID FOR BREAKPOINT * * NO, CLEAR BREAKPOINTS * LDA ALTMI "\\BÙ‰þú"? CLEAR ALL BREAKPOINTS? CPA O2 JMP BRK20 YES * JSB CRLF FIRST PRINT CURRENT VALID BREAKPOINTS LDA SGBPT TABLE PTR STA BRKTP BREAKPOINT TABLE POINTER CLA STA BRKTC BREAKPOINT TABLE COUNT * BRK10 LDA BRKTP,I PRINT BREAKPOINT TABLE CONTENTS SZA,RSS IF ZERO, IS EMPTY JMP BRK11 * LDA BRKTC PRINT INDEX OF BREAKPOINT JSB NUMP JSB PTAB * LDA BRKTP,I PRINT THE SEGMENT NAME (3A2) JSB TY2 ISZ BRKTP LDA BRKTP,I JSB TY2 ISZ BRKTP LDA BRKTP,I JSB TY2 JSB PTAB * ISZ BRKTP LDA BRKTP,I PRINT THE BREAKPOINT ADDRESS JSB ADRP JSB CRLF * LDA BRKTP MOVE PTR BACK ADA M3 STA BRKTP * BRK11 LDA BRKTP ADA O5 ISZ BRKTC INCR COUNT CPA SGBPE END OF TABLE? JMP *+3 STA BRKTP JMP BRK10 * BRK12 LDB BRKX1 TELL THE USER TO ENTER THE INDEX OF BPS TO REMOVE JSB OUTMS CLA JSB GETNM GET THE USER'S INPUT OF THE INDEX NUMBER JMP ERR IF PROBLEMS ARISE * SSB SEE IF 'A' WAS THERE FOR ABORT JMP LSE * STA B NOW CALCULATE TABLE ADDR FROM INDEX ALS,ALS DO A *5+SGBPT ADA B ADA SGBPT STA BRKTP JSB CRLF DO A CRLF FROM GETNM LDB SGBPE SEE IF TOO BIG CMB,INB ADB BRKTP SSB,RSS JMP ERR TOO BIG * LDB SGBPT SEE IF TOO SMALL CMB,INB ADB BRKTP SSB JMP ERR TOO SMALL * CLB STB BRKTP,I ALL THAT IS NECESSARY TO CLEAR THE BP JMP BRK12 SEE IF ANOTHER IS WANTED * BRKX1 DEF *+1 ASC 10,ENTER INDEX OF BP TO ASC 10, DELETE OR CHAR "A" ASC 5,TO END // BRKTP BSS 1 BRKTC BSS 1 M3 OCT -3 * BRK20 CLA CLEAR ALL BREAKPOINTS LDB SGBPT j„þú POINTER TO SEGMENT BREAKPOINT TABLE BRK21 STA B,I INB CPB SGBPE POINTER TO END OF TABLE JMP LSE DONE JMP BRK21 NOT YET DONE SKP * * ADD A BREAKPOINT TO THE BREAKPOINT TABLE * BRK1 STA TEMP4 SAVE ADDRESS JSB MPCHK CHECK FOR MEM PROTECT JMP MPMSG GO PRINT ERROR * STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP LDA A,I GET INSTRUCTION JSB AHEAD NOT VALID FOR BREAKPOINT? RSS NO, CHECK FOR 3 WORD INSTR JMP *+3 YES, GO AHEAD AND PROCESS JSB TWINT NOT VALID YET, SEE IF 3 WRD INSTR JMP PR9 NO, DON'T ALLOW IT * LDA TEMP4 YES RESTORE ADDRESS STA BKADR LDA SGBPT FIND A HOLE * BRK4 LDB A,I SZB,RSS JMP BRK3 FOUND A HOLE * LDB A IS THIS AN ATTEMPT TO REDEFINE ADB O3 AN EXISTING BREAKPOINT? LDB B,I GET BREAKPOINT ADDRESS FROM TABLE CPB BKADR DOES IT MATCH? STA BRKFG YES, SAVE AWAY FOR LATER FURTHER CHECK * ADA O5 LOOK IN NEXT SLOT CPA SGBPE END? RSS JMP BRK4 * LDB PSBRK NO ROOM, SORRY JSB OUTMS JSB CRLF JMP LSE * BRK3 STA BRKTM SAVE PTR TO BPTABLE LDB A LDA BLANK MVW O3 CLEAR OUT NAME LDA B LDB XB IS BP IN MAIN OR SEG MEMORY? ADB O15 XLB B,I CMB,INB ADB BKADR SSB JMP BRK5 MAIN MEMORY BP, OK * ADA M3 RESTORE POINTER TO NAME FIELD STA B LDA SNAME,I MOVE SEGMENT NAME TO NAME FIELD CPA ""A" BUT FIRST BE SURE OF SEG NAME JMP BRK9 IF NO SEG LOADED, NO SEG NAME * LDA SNAME MOVE SNAME INTO NAME FIELD MVW O3 LDA B JMP BRK5 OK, PUT IN ADDR AND BP * BRK9 CLA CLEAR NAME OUT STA B,I JMP ERR TELL USER ÓèþúTHAT IS A NO-NO * BRK5 LDB BKADR A PTR TO ADDR FIELD STB A,I INA LDB A LDA LTRAP CALCULATE A BREAKPOINT IOR JSBII STA B,I PUT INTO BREAKPOINT TABLE * LDA BRKFG BE SURE USER IS NOT TRYING TO SZA,RSS REDEFINE AN EXISTING BREAKPOINT JMP LSE USER IS NOT. * LDA BRKTM USER MAYBE. CHECK SEGNAME. LDB BRKFG CMW O3 DO SEGNAMES MATCH? JMP *+3 EQUAL! BREAKPOINT ALREADY EXISTS JMP LSE NOT EQUAL JMP LSE NOT EQUAL * CLA BREAKPOINT ALREADY EXISTS STA BRKTM,I CLEAR THIS NEW ENTRY STA BRKFG CLEAR BRKFG FOR NEXT TIME JMP LSE * BRKTM BSS 1 A TEMPORARY FOR HERE BRKFG OCT 0 SIGNAL FOR POSSIBLE BREAKPOINT REDEFINITION SKP TRAP JSB SVST SAVE STATUS CCA CALCULATE CURRENT PC ADA TRAP0 STA BPADR BREAKPOINT ADDRESS STA DDOT CURRENT PC CPA TADDR IS THIS THE "\\T" BREAKPOINT? JMP TRAP3 YES * CPA CNDBP IS THIS THE CONDITIONAL BREAKPOINT RSS YES JMP TRAP1 NO * LDA ACCA RESTORE A,B LDB ACCB LDA BADD,I DO THE CONDITIONAL BREAKPOINT TEST XOR BVAL AND BMSK * SZSKP RSS THE CONDITIONAL BREAKPOINT INSTR HERE JMP TRAP2 SIMULATE WITHOUT BREAK * TRAP1 ISZ PROCC A HIT, ADVANCE COUNT JMP TRAP2 SIMULATE WITHOUT BREAK * CLA A BREAK, CLEAR CNDBP STA CNDBP LDA BPADR JSB BRKMS BREAK MESSAGE JSB PTAB JMP LSF2 * TRAP2 LDA NOP SIMULATE WITHOUT A BREAK STA TRFLG CONTROL PASSES TO PROG AFTER SIMULATION JSB BRTST TEST FOR TTY BREAK JSB PR3 SIMULATE JMP TRAP * TRAP3 LDB TINST THE INSTR OF "\\T" STB A,I CCA STA TADDR PUT AN IMPOSSIBLE ADDR IN THERE ˲þú LDA DDOT JSB BRKMS DO BREAK MESSAGE JSB PTAB JMP LSF2 AND RETURN TO COMMAND INTERPRETER * CNDBP OCT 0 COND BP ADDR RSS RSS BKADR BSS 1 BREAKPOINT ADDRESS TEMPORARY O33 OCT 33 CONSTANT 33 * BRTST NOP BREAK TEST LDA BRFLG SHALL WE CHECK FOR A BREAK? SZA JMP *+5 JSB IFBRK CHECK FOR BREAK DEF *+1 SZA JMP LSE JMP BRTST,I * PSBRK DEF *+1 OCT 6412 CR/LF ASC 16,NO MORE ROOM FOR BREAKPOINTS// SKP * ************************************************************************ * * ROUTINE .SDBG: * * .SDBG PROVIDES A SPECIAL ENTRY POINT TO DBUGR FOR SEGMENTED * PROGRAMS LOADED ON-LINE USING THE RTE-IV RELOCATING LOADER. * THE LOADER INSERTS THE FOLLOWING SUBROTINE(*.STDB*)FROM THE * SYSTEM LIBRARY WITH EACH SEGMENT: * * EXT .SDBG * ENT .DBSG,.STDB * .STDB JSB .SDBG * .DBSG NOP * END .STDB * * THE LOADER PLACES THE ACTUAL ENTRY POINT ADDRESS FOR THE SEGMENT * INTO *.DBSG*. THE SEGMENT'S ID SEGMENT'S ENTRY POINT IS SETUP * TO POINT TO *.STDB*. THIS EFFECTIVELY INSERTS DBUGR JUST BEFORE * ENTRY INTO THE SEGMENT. * * IF A SEGMENT ENTRY BREAKPOINT EXISTS FOR THE NEWLY LOADED * SEGMENT A 'SEGMENT BREAK' MESSAGE WILL BE PRINTED. DBUGR CONTINUES * AND GETS THE NEXT DEBUG COMMAND FROM THE USER. * * WHEN A PROCEED COMMAND OCCURS, DBUGR WILL CONTINUE AT THE ENTRY * POINT OF THE SEGMENT. * ************************************************************************ * .SDBG NOP JSB SVST SAVE STATE, WHICH ALSO EXCHS BPS WITH INSTRS * * NOW, THE NEW SEGMENT INSTRUCTIONS WHICH OCCURRED AT THE OLD * SEGMENT BREAKPOINT ADDRESSES ARE IN THE BREAKPOINT TABLE * FILED UNDER THE OLD SEGMENT NAME AND BREAKPOINT ADDRESS. * WE MUST PUT THOSE INSTRUCTIONS BACK INTO MEMORY AND FILL * THE BP TABLE INSTR FIELDS OF TøþþúHOSE BPADDRS WITH BREAKOOINT * INSTRUCTIONS. * LDA SGBPT * SDBGX LDB SNAME DO THIS ONLY FOR OLD SEGMENT NAME JSB CMWDS OCT 3 RSS JMP SDBGY NOT OLD SEGMENT NAME * ADA O3 SEE IF THIS IS TRUE BP OR JUST ENTRY BP LDB A,I SSB ENTRY BP = -1 JMP SDBGZ IT IS A ENTRY BP * STB BKADR BREAKPOINT ADDRESS INA LDB A,I B HOLDS INSTRUCTION OF NEW SEGMENT STB BKADR,I PUT OUT INTO MEMORY LDB A LDA LTRAP IOR JSBII STA B,I NOW PUT A BREAKPOINT INTO TABLE INSTR FIELD LDA B RSS * SDBGZ INA INA RSS * SDBGY ADA O5 CPA SGBPE END OF LOOP? RSS YES JMP SDBGX NO * LDX O5 GET NEW SEGMENT NAME LDA ACCA ADA O14 RAL LDB SNAME RBL MBF * LDA .SDBG,I SAVE RETURN ADDRESS STA DDOT * LDA SGBRK SHALL WE DO AN ENTRY BREAK? SZA NONE/ALL FLAG JMP SDBG1 YES, DO ONE * LDA SGBPT SEARCH THE BP TABLE FOR ENTRY BREAK * SDBG2 LDB SNAME JSB CMWDS OCT 3 RSS JMP SDBG3 GO TO NEXT ENTRY * ADA O3 ADVANCE TO ADDR FIELD LDB A,I B HOLDS ADDRESS, -1 IS ENTRY BP SSB JMP SDBG1 YES! DO A SEGMENT ENTRY BP * ADA M3 * SDBG3 ADA O5 ADVANCE TO NEXT ENTRY CPA SGBPE END OF TABLE? RSS YES... JMP SDBG2 NO * JSB RSST JMP DDOT,I CONTINUE * SDBG1 CCB SET THE FLAG FOR SEGMENT ENTRY BREAK STB SBFLG LDA DDOT PASS RTN ADDR IN A-REG JSB BRKMS PRINT THE BREAK MSG JSB CRLF JMP LSE GO TO THE COMMAND INTERPRETER * SGBRK OCT 0 SEGMENT ENTRY BREAK FLAG, NONE/ALL BKINS BSS 1 BREAKPOINT INSTR TEMPORARY BLANK DEF BLAN1 PTR TO 6A1 OF SPACES BLAN1 ASC 3, 6 SPACES SKP * * BREAKPOINT TABLE * * THÊhþúERE ARE 8 ENTRIES OF 3 FIELDS EACH: * FIELD 1) 3A2, SEGMENT NAME * IF THE NAME IS 0,0,0 - EMPTY ENTRY * (N.B., 1ST WORD 0 IMPLIES EMPTY ENTRY) * IF THE NAME IS ' ' - MAIN MEM BP * ELSE, FIELD IS SEGMENT NAME * FIELD 2) 1@, BREAKPOINT ADDRESS * IF THE ADDRESS IS NEGATIVE, THIS IS A SEG ENTRY BP * OTHERWISE, THE BREAKPOINT ADDRESS * FIELD 3) 1@, BREAKPOINT INSTR * HOLDS THE INSTR THE BREAKPOINT REPLACES * * SGA BSS 1 SGB BSS 1 SBFLG OCT 0 SBNAM DEF SBNM1 SBNM1 OCT 0 ASC 2, BYADD BSS 1 BLKBL ASC 1, "]" OCT 135 "B" OCT 102 O14 OCT 14 * XB EQU 1732B SNAME DEF SNAM1 PSGMS DEF SGMSG SGMSG OCT 6412 CR/LF. ASC 4,SEGMENT SNAM1 ASC 3,"A CURRENT SEGMENT NAME * * THE PRECEDING IS AN IMPOSSIBLE INITIAL * SEGMENT NAME. 6 SPACES IS THE 'SEGMENT * NAME' FOR MAIN MEMORY SPACE BREAKPOINTS. * THEREFORE WE USE "A AS THE INITIAL * SEGMENT NAME INSTEAD OF JUST SPACES. * ASC 3,BREAK OCT 6412 CR/LF. ASC 1,// * SKP * * * THIS ROUTINE SETS UP BREAKPOINT WITHIN * A SEGMENT * SBRK STA SGA SAVE A & B STB SGB SZB,RSS IF ADDRESS SUPPLIED JMP SBRK0 * JSB MPCHK CHECK FOR MP VIOLATION JMP MPMSG * STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP * SBRK0 LDB SBNAM CLEAR OUT NAME WITH SPACES RBL CALCULATE BYTE ADDRESS STB BYADD FOR LATER RBR LDA BLANK MVW O3 * GET SEGNAME TO SBNAM LDA M6 SET CHAR COUNT STA SBTMP * SBRK1 JSB SBRK6 GET A CHAR CPA "]" END? JMP SBRK3 * LDB BYADD SBT ISZ BYADD ISZ SBTMP JMP SBRK1 JMP ERR TOO MANY CHARS IN SEG NAME * SBRK3 JSB SBRK6 ESCAPE? GET \B ORÉþú ^B CPA O176 LDA O33 CPA O33 JSB SBRK5 SEND BACKLASH CPA O134 RSS JMP ERR NOT \ OR ^ * JSB SBRK6 GET "B" CPA "B" RSS JMP ERR WHATEVER IT WAS, WAS WRONG * LDA SBNM1 SHALL WE SET THE SGBRK FLAG? AND HOW? CCB B=-1 INDICATES NO CHANGE TO SGBRK CPA BLKBL [] IS = ["N] RSS CPA ""N" CLB B=0 INDICATES A "N OR '0' FOR SGBRK CPA ""A" CLB,INB B=1 INDICATES A "A OR NON'0' FOR SGBRK SSB IS A CHANGE INDICATED? JMP *+3 NO CHANGE IS INDICATED STB SGBRK CHANGE SGBRK JMP LSE DO NOT ENTER [],["N], OR ["A] IN TABLE * LDA SGBPT NOW LOOK FOR AN EMPTY SLOT SBRK2 LDB A,I SZB,RSS JMP SBRK4 FOUND A SLOT * ADA O5 ADVANCE PTR CPA SGBPE END OF TABLE? RSS JMP SBRK2 * * NO AVAILABLE SLOTS, TELL USER * LDB PSBRK JSB OUTMS JMP LSE * * SBRK4 LDB A B HOLDS PTR LDA SBNAM A HOLDS SOURCE ADDR MVW O3 B <- B+3 AS A RESULT STA B,I ADDR FIELD STB SBTMP SAVE TABLE PTR AWAY FOR A FEW LINES LDA IADR WE SAVED IADR JUST AFTER SBRK LDB SGB WAS THERE AN ADDRESS SUPPLIED? SZB,RSS CCA MUST BE SEG ENTRY BP LDB SBTMP GET THAT POINTER STA B,I PUT BP ADDR INTO TABLE * INB B PTR TO INSTR FIELD LDA LTRAP CALCULATE A BP IOR JSBII STA B,I PUT BP INTO INSTR FIELD JMP LSE * SBRK5 NOP LDA O134 BACKSLASH JSB TYO ECHO LDA O134 LDB TMODE IF SET FOR ESC GOBBLER SZB JSB TYO SEND SECOND BACKSLASH ISZ SBRK5 ADJUST RETURN JMP SBRK5,I * ""N" ASC 1,"N * SBRK6 NOP READS CHAR AND CHECKS FOR RUBOUT þú JSB TTYOP CPA RUB JMP DEL * CPA BSPAC JMP DEL * JMP SBRK6,I * RUB OCT 177 BSPAC OCT 10 BACKSPACE ""A" ASC 1,"A SBTMP BSS 1 A TEMPORARY FOR HERE HED INSTR SIMULATE * PROC SZB,RSS SET PROCEED COUNT CLA,INA IF B EQ 0 THEN A=1; CMA,INA PROCC=-A; STA PROCC PROCEED COUNT * JSB BYE SET BPADR TO LIMBO IF NO BREAKPOINTS * LDB DDOT DDOT IS PROGRAM COUNTER STB TRAP0 TRAP0 WILL POINT AFTER 1ST INSTR CPB BPADR PROCEED FROM LAST BREAKPOINT? JMP PR01 YES, SKIP FOLLOWING TESTS * LDB BPADR INA,SZA PROCEED COUNT = 1? JMP ERR NO, MUST BE 1 FIRST TIME * LDA RSS STA SZSKP LDA ALTMI /P? CPA O1 RSS JMP ERR NO, CANNOT BE //P FIRST TIME. * * ONE MAY ONLY //P FROM A BP AFTER A BREAK * CPB LIMBO SHALL WE PRINT 'END DBUGR'? RSS JMP *+3 NO LDB PNT11 YES JSB OUTMS * LDA NOP CONTROL GOES TO PROGRAM STA TRFLG LDA DDOT SYMX <- DDOT; STA SYMX LDA DSYMX BIX <- "JMP SYMX,I" IOR B24 JMP OPCODE STA BIX JSB CRLF JSB FLUSH BE SURE IT GETS OUT JSB RSST JSB BIX0 JMP TRAP * PR01 JSB CRLF LDA ALTMI CPA O1 /P? JMP PR02 YES * LDA BPADR NO, //P STA CNDBP SET CONDITIONAL BREAKPOINT FOR TRAP LDA SKP CNDBP'S TEST INSTR STA SZSKP JMP PR03 * PR02 CLA /P STA CNDBP PR03 JSB PR3 SIMULATE JMP TRAP SKP PR3 NOP SIMULATE INSTR AT DDOT LDA BIXBP RESTORE BIX TABLE JMP INSTRS LDB BIXP MVW O3 LDA DDOT OLD PC, NEW PC WILL BE RETURNED IN TRAP0 STA IADR INSTRUCTION ADDRESS INA STA ­þúTRAP0 NEW PC LDA IADR,I GET INSTRUCTION AT IADR JSB AHEAD VALID INSTR IN AREG? JMP TWINS NO, CHECK FOR 3 WORD INSTR * JSB ADRC GET OPERAND ADDRESS, INSTR JMP MAC NO ADDRESSABLE AS MR INSTR TYPE * JSB DMCHK MAKE DIRECT ADDRESS STA SYMX OPERAND ADDRESS LDA IADR,I GET INSTR INTO AREG AND B74 GET OPCODE OF INSTR CPA B24 JMP OPCODE? JMP PJMP YES * CPA B14 JSB OPCODE? JMP PJSB YES * * N.B. ONLY JMP, JSB, JLY, JPY ARE TESTED FOR MP ERROR * PR2 IOR DSYMX MERGE OPCODE WITH "DSYMX,I" STA BIX MADE UP INSTR -> BIX * PR4 JSB RSST RESTORE STATUS JSB BIX0 JMP PR3,I RETURN SKP PJMP LDA SYMX OPERAND ADDRESS JSB MPCHK CHECK OPERAND ADDRESS JMP MPMS FOR OUT OF BOUNDS STA TRAP0 WHERE WE WILL BE IN A MINUTE PJMP2 LDA TRFLG ARE WE GOING TO USER OR PROGRAM? SZA JMP PJMP3 TO THE USER * STA BIX TO THE PROGRAM, BIX <- NOP JSB RSST RESTORE STATE JSB BIX0 JMP TRAP * PJMP3 JSB RSST JMP PR3,I TO THE USER, RETURN PJSB LDA SYMX CHECK FOR OUT OF BOUNDS DESTINATION JSB MPCHK JMP JSBIN OUT; CHECK FOR EXEC CALL CASE * LDA DDOT PUT RETURN ADDR INTO ENTRY POINT INA STA SYMX,I ISZ SYMX ALTER PC ADDRESS AND MAKE A JMP JMP PJMP JSBII JSB 0,I PROCC BSS 1 BIXBP DEF BIXBF POINTER TO BIX JMP TABLE POINTER BIXP DEF BIX01+0 POINTER TO BIX JMP INSTRS BIXBF BSS 3 BIX JMP TABLE BUFFER B14 OCT 14000 B24 OCT 24000 B74 OCT 74000 NOP NOP PRTMP BSS 1 A TEMPORARY SKP TWINS JSB TWINT TEST FOR 3 WORD INSTR JMP ILINS ILLEGAL INSTR ERROR * LDA DDOT MOVE 3 WORDS TO BIX AREA CCB ADB BIXP MVW O3 JMP PR4 YES, INSTR RÍwþúEADY, GO AND DO * TWINT NOP LDA IADR,I GET INSTRUCTION LDB TWDIN GET POINTER TO TABLE * TWIN1 CPA B,I COMPARE INSTR TO TABLE INSTR JMP TWINX FOUND A MATCH, IS LEGAL INSTR * ADB O3 ADVANCE PTR CPB TWDIE DONE? JMP TWINT,I YES JMP TWIN1 NO, CONTINUE * TWINX ISZ TWINT ADVANCE RETURN FOR FOUND JMP TWINT,I * TWDIN DEF STTP3+2 TWDIE DEF STTP+2 SKP JSBIN CPA CEXEC EXEC ADDRESS? RSS YES JMP MPMS NO, MP ERROR * * SIMULATE AN EXEC CALL * LDA DDOT HOW MANY ARGS TO THIS CALL? INA LDB A,I INA CMA,INA ADA B STA NARGS LDA DDOT MOVE ARGS ADA O2 LDB PARGS MVW NARGS LDA PARGS CREATE RTN ADDR ADA NARGS STA PRTN,I LDA P2 CREATE RSS CHAIN LDB RSS STB A,I INA CPA PRTN1 RSS JMP *-4 * JSB RSST RESTORE STATE JSB EXEC P2 NOP RETURN ADDRESS P3 BSS 12 RTN1 JSB RTN3 RTN2 JSB RTN3 RTN3 NOP JSB SVST SAVE STATE LDB RTN3 CALCULATE RETURN ADDRESS CLA WAS FIRST OR SECOND RETURN TAKEN? CPB PRTN3 INA XOR NARGS AND O1 0 OR 1 DEPENDING ON PARITY OF #ARGS LDB DDOT GET THE ORIGINAL RETURN ADDRESS INB ADA B,I STA TRAP0 JMP PJMP2 * PARGS DEF P3 NARGS OCT 0 PRTN DEF P2 PRTN1 DEF RTN1 PRTN3 DEF RTN3 CEXEC DEF EXEC+0 SKP * BIX0 NOP BIX STA SYMX,I INSTRUCTION BIX01 JMP NOSKP BIX02 JMP SK1 JMP SK2 JMP SK3 SK4 ISZ TRAP0 ADVANCE PC SK3 ISZ TRAP0 SK2 ISZ TRAP0 SK1 ISZ TRAP0 NOSKP EQU * TRFLG NOP BECOMES RSS WHEN TRACING JMP TRAP0,I RETURN TO PROGRAM * JMP BIX0,I RETURN TO DEBUGGER (NEXT INSTR IS JMP TRAP) * TRAP0 NOP BREAKPOIÞþúNTS FALL IN HERE JMP BIX0,I GO TO TRAP SKP * * RESTORE STATUS ROUTINE * RSST NOP * JSB EXCH EXCHANGE BREAKPOINTS WITH INSTRUCTIONS * LDA DIDTP LDB IDWD1 RESTORE SEGMENT WORDS 1 TO 5 LDX O5 JSB $LIBR GO PRIVILIGED NOP MWI TRANSFER WORDS INTO ALTERNATE MAP JSB $LIBX GO UNPRIVILIGED DEF *+1 DEF *+1 * * RESTORE REGISTERS AND FLAGS * JSB RSREG JMP RSST,I * RSREG NOP LDB ACCB LDX ACCX LDY ACCY LDA FLGBX CLF 1 CLEAR OVERFLOW SLA,RAR STF 1 ERA LDA ACCA JMP RSREG,I AND RETURN * SKP * * EXCH * * EXCHANGES BREAKPOINTS WITH INSTRUCTIONS * * CALLING SEQUENCE: * JSB EXCH * EXCH NOP EXCHANGE BREAKPOINTS WITH INSTRUCTIONS LDA SGBPT A-REG WILL USUALLY POINT TO BREAKPOINT TABLE * EXCH1 LDB SNAME B-REG POINTS NOW TO CURRENT SEGMENT NAME JSB CMWDS IS THE ENTRY SEGNAME = CUR SEG NAME? OCT 3 3 WORDS JMP EXCH2 YES * LDB BLANK IS THE ENTRY SEGNAME = MAIN MEMORY? JSB CMWDS OCT 3 JMP EXCH2 YES * ADA O5 * EXCH3 CPA SGBPE END OF TABLE? JMP EXCH,I YES JMP EXCH1 NO, CONTINUE SEARCH * EXCH2 ADA O3 A-REG POINTS TO ADDR FIELD OF ENTRY LDB A,I B HOLDS BP ADDRESS SSB IS THIS AN ENTRY BREAKPOIN? JMP EXCH4 YES, IGNORE * STB BKADR INA A-REG POINTS TO INSTR FIELD OF ENTRY LDB A,I STB BKINS NOW THE ADDR AND INSTR ARE IN TEMPS LDB BKADR,I GET WHAT IS IN MEMORY STB A,I AND PUT IT INTO THE TABLE LDB BKINS STB BKADR,I PUT THE INSTR INTO MEMORY RSS * EXCH4 INA INA JMP EXCH3 SKP * * CMWDS * * CALLING SEQUENCE: * LDA PTR1 * LDB PTR2 * JSB CMWDS * OCT LENGTH OF }WþúSTRINGS * CALLING SEQUENCE: * LDA PTR1 * LDB PTR2 * JSB CMWDS * OCT N * ...EQUAL... * ...NOTEQ... * * A,B ARE RETURNED UNCHANGED * CMWDS NOP CAX SAVE A CBY SAVE B LDA CMWDS,I GET NUMBER OF ARGS STA CMWDC SAVE COUNT ISZ CMWDS ADVANCE RETURN ADDRESS CXA RESTORE A-PTR CMW CMWDC DO THE COMPARISON JMP *+3 NOP ISZ CMWDS ADVANCE RETURN ADDRESS, A.NE.B CXA RESTORE A CYB RESTORE B JMP CMWDS,I CMWDC BSS 1 * SKP MAC LDA IADR,I GET INSTRUCTION STA BIX SET INSTRUCTION CPA HLT IF A HLT JMP MPMS THEN GO PRINT MP MESSAGE * AND M6000 =B172000 CPA HLT IF AN IO INSTRUCTION JMP IO THEN GO CHECK SELECT CODE * MAC00 LDA BIX ELSE RESTORE A WITH BIX JSB GET2 2 WORD INSTRUCTION? JMP PR4 NO,GO SET UP INSTRUCTION * LDA IADR YES,SET ADDRESS INA STEP TO MAC ADDRESS IOR B1 OF SECOND WORD STA BIX01 FOR BIX * LDA BIX GET INSTRUCTION CPA JPY JPY? JMP PR6 YES,GO FIX JPY * CPA JLY JLY? JMP PR11 YES,GO FIX JLY * JMP PR4 NO,GO FINISH THE SET UP * * JPY SIMULATION PR6 LDY ACCY BE SAFE LDA BIX01 GET 2ND WORD ELA,CLE,ERA ELIMINATE LDA A,I ADDED INDIRECT ADA ACCY FORM DESTINATION ADDRESS JMP PR12 * * JLY SIMULATION PR11 LDA IADR SET UP ADA O2 ACTUAL STA ACCY Y LDA BIX01 ELA,CLE,ERA ADA MUPBD TEST FOR DM ERROR SSA,RSS JMP DMCK5 BAD GO PRINT MESSAGE * ADA UPBD GOOD SZA,RSS LDA DACCA GET PHONY A REG LDA A,I GET INDIRECT ADDRESS * * FINISH JLY, JPY SIMULATIONŸþú * PR12 LDB TRAC SZB,RSS TRACING? JMP PR2 NO,GO SET UP * JSB MPCHK CHECK ADDRESS FOR BOUNDS JMP MPMS * STA TRAP0 JSB RSST JMP PR3,I * IO LDA BIX GET INSTUCTION AND O77 CPA O1 IF S.C. = 1 JMP MAC00 THEN OK JMP MPMS ELSE GO PRINT MP MESSAGE * M6000 OCT 172000 B1 OCT 100000 O2 OCT 2 SKP * XEC SZB,RSS "EXECUTE" COMMAND "N\X" JMP ERR * JSB AHEAD VALID INSTRUCTION FOR EXECUTION? JMP PR9 * JSB CLESB CLE FLAG SET? STA XECIN SAVE INSTRUCTION JSB GET2 TWO WORD INSTRUCTION? RSS JMP PR9 NOT ALLOWED * LDA DDOT SAVE PC STA XECT1 LDA PXECI SET PC STA DDOT LDA RSS RETURN HERE AFTER SIMULATION STA TRFLG LDA BIXBP RESTORE JMP TABLE LDB BIXP MVW O3 JSB PR3 SIMULATE JSB SVST SAVE STATE JSB CRLF CLA CLEAR THE FLAG STA TRFLG LDA XECT1 RESTORE PC STA DDOT JMP LSE * PXECI DEF XECIN XECIN NOP INSTRUCTION TO BE EXECUTED XECT1 BSS 1 SAVED DDOT * GO SZB,RSS "GO" COMMAND "N\G" JMP ERR * STA DDOT CHANGE PC CLB SET PROCEED COUNT JMP PROC HED BREAKPOINT AND TRACE ROUTINES * ADRC NOP GET ADDRESS OF INSTRUCTION LDB A AND G70 CLE,SZA,RSS JMP ADRCX NON-ADDRESSABLE. * ISZ ADRC SET SKIP RETURN LDA B AND O2000 PAGE BIT SZA LDA IADR GET PROPER PAGE XOR B AND G76 REMOVE OPCODE AND PAGE BIT * ADRCX XOR B JMP ADRC,I A-REG IS ADDR, B-REG IS INSTR SKP * * AHEAD * * CHECKS INSTRUCTION ABOUT TO BE EXECUTED TO SEE IF * THE INSTRUCTION IS ALLOWED FOR EXECUTION * * Šeþú LDA * JSB AHEAD * P+1 * P+2 * AHEAD NOP STA TEMP1 AND DSMSK IF DOUBLE SHIFT CPA ASL JMP AHE02 * CPA LSL JMP AHE02 * CPA RRL JMP AHE02 * AND M6000 OR IOG CPA HLT JMP AHE02 * AND G70 OR MRG SZA JMP AHE02 * LDA TEMP1 OR SRG OR ASG SSA,RSS JMP AHE02 * * ELSE CHECK REST LEGAL OPCODES * LDB PNT08 POINT TO START OF TABLE * AHE01 CPA B,I GOT A MATCH? JMP AHE02 YES, VALID FOR DDT * ADB O3 NO,BUMP POINTER CPB PNT09 DONE? JMP AHEAD,I YES,NOT VALID JMP AHE01 NO,CONTINUE * AHE02 LDA TEMP1 RESTORE VALIDATED INSTRUCTION ISZ AHEAD ADJUST RETURN JMP AHEAD,I * PNT08 DEF RRL+3 LINK TO START OF REST OF VALID'S PNT09 DEF IVINS LINK TO START OF INVALID INSTR'S SKP * * BRKMS * * PRINTS BREAK MESSAGE FOR BREAKPOINTS AND TRACING * * CALLING SEQUENCE: * LDA * JSB BRKMS * BRKMS NOP PRINT BREAK MESSAGE STA DDOT SAVE THE TRAP ADDRESS STA IADR FOR THE SAKE OF INSTP LDA SBFLG PRINT SEGMENT BREAK? SZA,RSS JMP BRKM1 * CLA STA SBFLG CLEAR FLAG LDB PSGMS PRINT 'SEGMENT NAME0 BREAK' JSB OUTMS MESSAGE * BRKM1 LDA DDOT RESTORE A JSB ADRP LDA SRDX JSB TYO ( JSB PTAB A FEW SPACES LDA DDOT,I NOW THE INSTRUCTION JSB INSTP IN SYMBOLIC JSB PTAB PUT IN SOME SPACES LDA SRDX INA JSB TYO ) JSB PTAB MORE SPACES LDA ACCA A REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCB B REG. JSB BM,I JSB PTAB YET MORE SPACES ºgþú LDA ACCX X REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCY Y REG. JSB BM,I JSB PTAB MORE SPACES LDA FLGBX E,O,INT STA LWT SET LAST WORD TYPED JSB NUMP JMP BRKMS,I * SRDX OCT 50 SKP * * B Y E * * PRINTS END MESSAGE * BYE NOP STA TEMP5 SAVE A,B REGS STB TEMP6 LDA SGBRK IS SEGMENT BREAK SET ["A] SZB JMP BYE2 YES, DO NOT PRINT MESSAGE * LDA SGBPT SEE IF ANY BREAKPOINTS EXIST BYE1 LDB A,I IF ANY EXIST, DO NOT SZB PRINT MESSAGE 'END DBUGR' JMP BYE2 BREAKPOINT EXISTS, DONT PRINT * ADA O5 ADVANCE PTR TO NEXT BREAKPOINT CPA SGBPE RSS JMP BYE1 * LDB LIMBO THERE ARE NO BREAKPOINTS STB BPADR TELL USER VIA BPADR * BYE2 LDA TEMP5 RESTORE A,B REGS LDB TEMP6 JMP BYE,I * TEMP5 BSS 1 TEMP6 BSS 1 PNT11 DEF MSG04 MSG04 OCT 6412 ASC 5,END DBUGR OCT 6412 CR LF ASC 1,// SKP * ******************************************************************* * * SUBROUTINE OUTMS: * * OUTMS WILL OUTPUT A MESSAGE WHICH TERMINATES WITH A '//' AND * CONTAINS NO INTERNAL /'S. * * CALLING SEQUENCE: * LDB POINTER TO FIRST WORD OF MESSAGE * JSB OUTMS * * RETURN: * ALL REGISTERS ARE DESTROYED. * ******************************************************************* * OUTMS NOP CLA INITIALIZE TO LEFT BYTE STA TEMP1 OF MESSAGE STRING. STB TEMP2 SAVE STRING'S ADDRESS. * OTMS1 LDA TEMP2,I GET WORD FROM STRING. LDB TEMP1 GET SLB,RSS APPROPRIATE ALF,ALF BYTE. AND O177 MASK OFF CHARACTER. CPA "/" IF FOUND A "/", THEN END JMP OUTMS,I OF MESSAGE, SO RETURN. * JSB TYO OTHERWIZE, PRINTÀþú LATEST LDB TEMP1 CHARACTER. SLB IF BYTE COUNT IS ODD, THEN ISZ TEMP2 BUMP WORD POINTER. ISZ TEMP1 INCREMENT BYTE COUNTER JMP OTMS1 AND RETURN FOR MEXT BYTE. * * * MPCHK * * SKIP RETURN IF ADDRESS IN AREG ABOVE FENCE * DICTATED BY 1775B. NORMAL RETURN IF MP ERROR. * * CALLING SEQUENCE: * LDA
* JSB MPCHK * ...AREG UNCHANGED, BREG BASHED, MP ERR * .AREG UNCHANGED, BREG BASHED, NO ERR * MPCHK NOP MEMORY PROTECT & DM CHECK JSB DMCHK GO RESOLVE INDIRECTS LDB 1775B CHECK FOR MEMORY PROTECT ERROR CMB,INB SUBTRACT FENCE FROM ADB A ADDRESS SSB,RSS IF OK RETURN +1 ISZ MPCHK JMP MPCHK,I ELSE RETURN * MPMS LDA DDOT BACK OUT THE INTERPIT STEP CPA PXECI EXECUTE INSTR? LDA XECT1 YES RESTORE STA DDOT RESTORE THE ADDRESS STA IADR STA DDOT JSB CRLF RETURN THE CARRAGE LDA IADR JSB BRKMS SEND A BREAK MESSAGE JSB PTAB SEPARATE THE MP? * MPMSG LDA "M" FETCH AN M JSB TYO PUT IT OUT JMP BADP FOLLOW IT WITH A P? * DACCA DEF ACCA POINTER TO A-REG CONTENTS DACCB DEF ACCB POINTER TO B-REG CONTENTS CH40 OCT 40 SKP * * GET2 * * SEARCHES DOUBLE WORD INSTRUCTIONS TABLE TO SEE IF * CURRENT INSTRUCTION IS DEFINED THERE. * * LDA * JSB GET2 * P+1 * P+2 <2 WORD INSTRUCTION,A=SQOZE CODE> * GET2 NOP STA TEMP1 SAVE INSTRUCTION LDB PNT07 POINT TO DOUBLE WORD INSTRUCTIONS * MAC02 CPB DSTOP DONE? JMP GET2,I YES,GO FINISH THE SET UP * ADB O2 POINT TO OPCODE IN SYMBOL TABLE LDA B,I GET OPCODE CPA TEMP1 DOUBLE WORD INSTRUCTION? JMP MAC01 YES,SET UP FOR 2 WORD INSTRUCTION õþú* INB NO,POINT TO NEXT ENTRY JMP MAC02 CONTINUE LOOKING * MAC01 ADB M2 POINT BACK TO ENTRY(SETS EREG) LDA B,I GET SQOZE CODE ISZ GET2 ADJUST RETURN JMP GET2,I * DSTOP DEF STTP2 LINK TO END OF 2 WORD INSTR SECTION PNT07 DEF DOUBL LINK TO 2 WORD INSTR SECTION SKP * SVST NOP RESTORE STATUS * * RESTORE BREAKPOINTS TO MAIN AND CURRENT SEGMENT * JSB SVREG SAVE REGISTERS * LDA BIXS RESTORE THE DOUBLE WORD INSTRUCTION SZA IF NOT SET UP, SKIP STA BIX01 THIS IS DONE CAUSE BIX01 GETS MESSED LDA BIX01 AFTER 1ST TIME THROUGH STA BIXS * LDA BPADR STA IADR FOR PRINT * LDA IDWD1 SAVE PROGRAM'S TEMP WORDS FROM ITS ID SEGMENT LDB DIDTP DESTINATION ADDRESS LDX O5 5 WORDS MWF MOVE FROM ALTERNATE MAP TO ENABLED MAP * JSB EXCH EXCHANGE BREAKPOINTS WITH INSTRUCTIONS JMP SVST,I AND RETURN * BIXS NOP HOLDS COPY OF 2ND WORD BEFORE RETURN IDWD1 EQU 1721B ID SEGMENT WORD 1 DIDTP DEF IDTMP POINTER TO BUFFER FOR SAVING IDTMP BSS 5 ID SEGMENT'S TEMP WORDS. * SVREG NOP SAVE REGISTERS STA ACCA STB ACCB STX ACCX STY ACCY CLA SAVE FLAGS ELA,RAL SAVE E-BIT SOC OVERFLOW ON? INA YES STA FLGBX JMP SVREG,I HED TRACE ROUTINE TRACE SZB,RSS MAKE A ZERO CLA,INA INTO A 1 CMA,INA SET NEG FOR STA TRAC COUNT AND SET LDA ALTMI CHECK FOR "\\T" CPA O2 JMP TRAC1 * LDA RSS COME BACK HERE AFTER PR3 CALL STA TRFLG * TRNX JSB CRLF JSB PR3 SIMULATE DDOT'S INSTR JSB SVST SAVE STATE * TRMS LDA TRAP0 NEW PC STA DDOT CURRENT PC JSB BRKMS BREAK MESSAGE ISZ TRACšdþú DONE COUNT? JMP TRNX NO * LDA NOP YES, RESET TRFLG STA TRFLG JSB PTAB JMP LSF RETURN TO DEBUG COMMAND INTERPRETER * TRAC1 LDA DDOT "\\T" INA LDB A,I GET THE INSTR STB TINST STA TADDR CLA STA TRAC CLEAR OUT TRACE COUNT CLA,INA STA ALTMI SET BACKSLASH COUNT FOR PROC LDA LTRAP MAKE THE TRAP INSTR IOR JSBII STA TADDR,I LDA DDOT DO A PROCEED CLB JMP PROC * TINST BSS 1 THE INSTRUCTION TADDR OCT 177777 THE ADDRESS * ILINS LDA DDOT ILLEGAL INSTRUCTION TRAP CPA PXECI LDA XECT1 STA DDOT STA IADR JSB CRLF LDA IADR JSB BRKMS * PR9 JSB PTAB LDA "IN" JSB TY2 JMP ERR * "IN" ASC 1,IN HED SEARCH ROUTINES * EAS LDA CSKP STA WSD * WDS LDA CSZA CLE,SSA,SLA ALWAYS SKIPS * NWS LDA CSNZA SZB,RSS JMP ERR * STA WSTST JSB CRLF LDA LL STA IADR * WSL JSB ADCK SEE IF DONE JMP WSIDX IN DEBUG, IGNORE * LDA IADR,I * WSD NOP SKIP IF EFFECTIVE ADDR. JMP WSC * JSB ADRC JMP WSIDX NOT ADDRESSABLE. * JSB DMCK GO RESOLVE INDIRECTS JMP WSIDX TOO MANY INDIRECTS * NOP DM ERROR * WSC XOR WRD AND MSK * WSTST NOP SZA OR SZA,RSS JMP WSIDX * JSB PAC PRINT ADDRESS AND CONTENTS JSB CRLF * WSIDX ISZ IADR NOP ALLOW WRAPAROUND JSB BRCHK CHECK FOR OPERATOR BREAK JMP WSL SKP * BRCHK NOP CHECK FOR OPERATOR BREAK STA BRCH1 SAVE A-REG STB BRCH2 SAVE B-REG LDA BRFLG SHALL WE CHECK FOR BREAK? SZA ZERO MEANS YES JMP BRCH3 GET OUT IF NON ZERO * JSB IFBRK DEF *+1 Ð~þú SZA JMP LSE YES, OPERATOR WANTS BREAK * BRCH3 LDA BRCH1 NO, OPERATOR WANTS NO BREAK LDB BRCH2 JMP BRCHK,I RESTORE REGS AND GO BACK * BRCH1 BSS 1 A-TEMP BRCH2 BSS 1 B-TEMP SKP * * DMCHK * * DM AND MULTIPLE INDIRECT CHECK * * INPUT: A REG=INDIRECT ADDRESS * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCHK NOP JSB DMCK JMP DMCK3 GO PRINT INDIRECT ERROR JMP DMCK4 GO PRINT DM ERROR JMP DMCHK,I RETURN * * LDA ADDR * JSB DMCK * * * * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCK NOP LDB M20 SET UP INDIRECT COUNT STB DMCNT LDB ACCB SET UP B REG JMP DMCK1 GO TEST ADDRESS * DMCK0 ISZ DMCNT RSS JMP DMCK,I YES,ERROR 1 RETURN * SZA,RSS TRYING TO USE A REG LDA DACCA YES,GET PHONY A REG ADA MUPBD TEST FOR UPPER BOUND SSA,RSS (DM ERROR) JMP DMCK2 ERROR RETURN * ADA UPBD GOOD THEN CORRECT A LDA A,I AND GET NEXT LEVEL * DMCK1 RAL,CLE,SLA,ERA IS IT IN DIRECT? JMP DMCK0 YES,GO GET NEXT LEVEL * ADA MUPBD NO,CHECK FOR DM ERROR SSA ISZ DMCK BUMP ONE MORE FOR GOOD * DMCK2 ADA UPBD RESTORE A REG ISZ DMCK JMP DMCK,I * "I" OCT 111 M20 OCT -20 DMCNT BSS 1 DMCK3 LDA "I" JSB TYO PRINT "I?" JMP ERR * * DMCK5 ADA UPBD RESTORE A DMCK4 JSB NUMP PRINT DM? ERROR DMCK6 JSB PTAB SEPARATE "DM?" LDA "DM" TYPE "DM?" JSB TY2 JMP ERR * "DM" ASC 1,DM MUPBD BSS 1 NEGATIVE OF UPPER BOUND UPBD BSS 1 POSITIVE BOUND * * PAC * * PRINT ADDRESS AND CONTENTS * PAC NOP LDA IADR PRINT ADDRESS AND CONTENTS JSGÅþúB ADRP JSB TYO PRINT / JSB PTAB LDA IADR,I JSB PM,I JMP PAC,I SKP * * CLEAR CORE * ZRO LDB ALTMI ADB M2 SSB JMP ERR * LDB LL STB IADR LDA WRD * ZROL JSB ADCHK STA IADR,I ISZ IADR JMP ZROL * ADCK NOP CHECK FOR DEBUG OVERLAP STA PN SAVE AC LDA IADR CMA,INA ADA UL OCT 1256 RAL,CLE,SLA,ELA :THE ELA IS DISABLED JMP SOXA DONE, GO RESET * LDA IADR CMA,SEZ E CLEAR: WILL SKIP G70 OCT 70000 LDB A ADA STEND SSA,RSS JMP ADCKR BELOW DEBUG * ADB DEBOP SSB,RSS JMP ADCKO WITHIN DEBUG, LOSE * LDA IADR TEST IF IN PARTITION JSB DMCHK * ADCKR ISZ ADCK BUMP FOR NORMAL RETURN * ADCKO LDA PN RESTORE AC JMP ADCK,I RETURN * ADCHK NOP JSB ADCK OCT 1053 ALS,CLE,SLA,RAR :THE RAR IS DISABLED JMP ADCHK,I JSB PTAB 3 SPACES LDA "T" JSB TYO T JMP BADP * "T" OCT 124 HED TAPE OPERATIONS * TABL LDA ALTMI IS THIS \L OR \\L? CPA O1 JMP LIST THE FOLLOWING HANDLES \\L, LIST IS \L * JSB SOI * TABL1 JSB RWDB STA SYM JSB RWDB STA SYM+R AND G70 STA ADCK SAVE FLAGS XOR SYM+R DELETE FLAGS STA SYM+R JSB RWDB LDB ADCK BLF ADB RELTB ADA B,I RELOCATE SYMBOL JSB DEFS JMP TABL1 * LOAD JSB SOI * LOA JSB RWDB JSB ADCHK IS ADDRESS OK STA IADR,I STORE JMP LOA * VFY JSB CRLF JSB SOI * LDV JSB RWDB JSB ADCK NOP CPA IADR,I COMPARE JMP LDV STORE DONE OR CORE MATCH. * SZA,RSS JMP LDV IGNORE ZERO ON TAPE. * STA RWDB SAVE TAPE WORD. JSB <þúPAC PRINT DISCREPANCY. JSB PTAB LDA RWDB JSB PM,I JSB CRLF JMP LDV * RELTB DEF WRD-1 SKP LIST SZB,RSS \L OR N\L? IF B.NE.0 THEN N\L JMP LIST2 * LDB ONM WHERE THE N IS KEPT SSB,RSS NEGATIVE OR ZERO N NOT ALLOWED SZB,RSS JMP ERR * STB LISTN CHANGE THE DEFAULT * LIST2 LDA LISTN PREPARE THE COUNT CMA,INA STA LISTC LISTC IS THE NEG. NUM. OF LINES TO PRINT * CLA,INA ADVANCE ADDRESS POINTER BY ONE ADA LOCP,I THE FOLLOWING IS COPIED FROM "EXAM"[DBUGR] * LIST1 ELA,CLE,ERA STA TAS STA LOCP,I STA IADR JSB CRLF LDA TAS JSB ADRP JSB TYO LDA TAS JSB DMCHK JSB PTAB LDA TAS,I STA LWT JSB EXPM,I JSB PTAB * CLA,INA ADA LOCP,I ISZ LISTC JMP LIST1 JMP LSE * LISTN OCT 20 NUMBER OF LINES TO BE PRINTED LISTC BSS 1 COUNT FOR #LINES PRINT-LOOP SKP * SOI NOP LDB SOI INB STB RWDB * SOF JSB RDCH INB,SZB,RSS COUNT BLANK TAPE JMP SOX LOTS: END OF FILE. * C3007 CMA,INA,SZA,RSS HAVE WE A WORD COUNT? JMP SOF NOT YET. * STA CHC JSB RDCH DISCARD ONE FRAME JSB RDWD BLOCK ADDRESS STA CHI INIT CHECKSUM ELA,CLE,ERA MAKE SURE NOT INDIRECT STA IADR * RWDG JSB RDWD LDB A ADB CHI STB CHI JMP RWDB,I RETURN * RWDB NOP ISZ IADR ISZ CHC INDEX WORDCOUNT JMP RWDG * JSB RDWD READ CHECKSUM LDB M6 MAX. RECORD GAP CPA CHI JMP SOF CKSM OK, GO TO NEXT RECORD * LDA RDCHK BAD CHECKSUM LDB SRDX JSB PN COMPLAIN * SOX EQU * SOXA LDA LOCP,I STA IADR JMP LSE SKP * RDWD NOP READ A&þú WORD JSB RDCH ALF,ALF STA CH JSB RDCH ADA CH JMP RDWD,I * RDCH NOP READ A CHARACTER STB BS SAVE B JSB EXEC GO TO EXEC FOR ONE CHAR. ON 5 DEF RDRTN-1 IN CASE OF EXEC CALL ERROR DEF NAB1 (OCT 1+NO ABORT BIT) DEF O2105 DEF BF DEF M1 * JSB EXERR IN CASE OF EXEC CALL ERROR RDRTN LDA BF GET THE CHAR ALF,ALF AND O377 LDB BS RESTORE B JMP RDCH,I * O2105 OCT 2105 O377 OCT 377 RDCHK OCT 50245 * EXERR NOP EXEC ERROR HANDLER STA EXER1 SAVE A,B REGISTERS STB EXER2 JSB CRLF CRLF LDB EXMSG "EXEC CALL ERROR: A,B=" JSB OUTMS LDA EXER1 JSB TY2 PRINT A2 FORMAT JSB PTAB LDA EXER2 LDB O10 JSB PN PRINT OCTAL FORMAT JSB CRLF LDA EXER1 LDB EXER2 JMP EXERR,I * EXER1 BSS 1 EXER2 BSS 1 EXMSG DEF *+1 ASC 12,EXEC CALL ERROR: A,B=// SKP PNCH JSB STORE LDA LFLG SZA JMP PCH1 LIMITS SPECIFIED * LDA IADR USE CURRENT REGISTER STA LL STA UL * PCH1 LDA LL CMA,INA ADA UL SSA JMP LSE DONE * AND O77 CMA STA CHC WORDS THIS BLOCK CMA,CCE,INA ALF,ALF JSB PWD WORD COUNT LDA LL STA CHI CHECKSUM JSB PWD ORIGIN * PCHL LDA LL,I JSB PWD ADA CHI STA CHI ISZ LL ISZ CHC JMP PCHL * JSB PWD CHECKSUM CLA JSB PWD BLANK FRAMES JSB PWD FOR INTER-RECORD GAP JMP PCH1 * PWD NOP PUNCH A WORD STA BF SET WORD JSB EXEC GO TO PUNCH WITH ONE WORD DEF PWRTN-1 IN CASE OF EXEC CALL ERROR DEF NAB2 (OCT 2+NO ABORT BIT) DEF O2104 HONEST BINARY Ã&þú DEF BF DEF O1 * JSB EXERR IN CASE OF EXEC CALL ERROR PWRTN LDA BF RESTORE A JMP PWD,I * O2104 OCT 2104 BF NOP BS NOP HED SYMBOL TABLE OPERATIONS * DEFS NOP STA RDCH JSB EVS JMP DRDF * LDA START CHECK FOR OVER FLOW CMA,INA ADA STEND SSA JMP SYMO OVERFLOW GO BITCH * CCB NAKE NEW ENTRY ADB STEND LDA RDCH STA B,I ADB M1 LDA SYM+R STA B,I LDA SYM SSA ADA C1031 ADA M3100 SSA,RSS ADB M1 LDA SYM STA B,I STB STEND JMP DEFS,I * DRDF LDA RDCH FIX OLD ENTRY STA CH,I JMP DEFS,I * START DEF END+4 SKP * EVS NOP LDB SYM IS IT A CLE CPB CLE JMP CLEFD YES GO SET CLE FLAG * LDA STEND STA CH * EVSL LDA CH CPA STTOP JMP EVSU UNDEFINED. * LDB CH,I GET LEFT HALF ISZ CH G74 STB A USED AS CONSTANT SSB ADB C1031 OVERFLOW. ADB M3100 CPA SYM JMP EVSM1 LEFT HALF MATCH. * SSB,RSS ISZ CH EVSI ISZ CH JMP EVSL TRY AGAIN. * EVSM1 LDA CH,I SSB CLA,RSS ISZ CH CPA SYM+R JMP EVSF RIGHT HALF MATCHES. JMP EVSI * EVSF LDA CMFLG HAS A COMMA BEEN TYPED SZA,RSS JMP EVSF2 THEN VALUE IS OK * LDA ISEXP YES MAKE SURE NOT CMA,INA FIRST ROTATE ADA CH SSA BELOW ROTATES JMP EVSF2 YES THEN OK * ADA M60 SSA ABOVE FIRST ROTATES JMP EVSI NO THEN CONTINUE JMP EVSF2 YES RETURN * * EVSU ISZ EVS UNDEFINED: SKIP RETURN * EVSF2 LDA CH,I PICK UP VALUE JMP EVS,I * CLEFD STB CLEFG SET CLE FLAG CLA SET VALUE TO ZERO JMP €(þúEVS,I * CMFLG OCT 0 M60 OCT -60 CLEFG OCT 0 O40 OCT 40 M3100 OCT -3100 C1031 CLF 0 STTOP DEF STTP LINK TO END OF SYMBOL TABLE SKP * * SYMBOL TABLE SEARCH * SRCST NOP STA CH SAVE TABLE LIMITS STB TYO LDA C1000 STA DNM STA NUMP * SRCL LDB CH CPB TYO JMP SRCST,I DONE, RETURN * LDA CH,I SSA ADA C1031 ADA M3100 CLE,SSA,RSS ISZ CH ISZ CH LDA CH,I FETCH SYMBOL VALUE CMA,SEZ,INA,RSS WON'T SKIP ADA ONM COMPARE SEZ,CLE,RSS JMP SRCI ENTRY TOO BIG, LOSE * STA PN LDA B IF >2 CARACTERS INA CPA CH RSS JMP SRCI1 THEN LOOSE * LDA PN YES TEST VALUE ADA NUMP CCE,SSA,RSS JMP SRCI1 AS GOOD OR BETTER ALREADY * CMA,SEZ,INA GOOD MATCH (WON'T SKIP) ADA NUMP STA NUMP UPDATE CLOSENESS LDA B,I SAVE SYMBOL STA SYMP SKP SRCI1 LDA PN CHECK IF BETTER ADA DNM THAN LAST ONE CMA,SSA,INA JMP SRCI NO FORGET IT * CLA CLEAR TEMP ",C" FLAG STA CMACT LDA TYO IF SEARCH OF USER TABLE CPA ISEND THEN JMP SRCI2 SKIP * LDA C1000 CLEAR SINGLE DEF IF OP-CODE STA NUMP LDA CH,I GET THE VALUE AND ONM MASK CPA CH,I MUST HAVE ALL THE DEFINED RSS BITS ELSE JMP SRCI FORGET SYMBOL * SSA IF MAC GROUP GO CHANGE OFFSET JMP SRCI4 * XOR ONM OR NOT SAME GROUP AND O6000 SZA JMP SRCI FORGET SYMBOL * LDA B,I IF A CPA SEZ SEZ, JMP SRCI3 * CPA SLA SLA, JMP SRCI3 * CPA SLB OR SLB JMP SRCI3 THEN STOP SEARCH * SRCI2 LDA PN OK UPDAT‡dþúE CMA,INA STA DNM LDA CMACT ",C" FLAG STA CMAC LDA B,I AND SAVE THE STA SYM THE SYMBOL INB LDA B,I CPB CH CLA STA SYM+R SRCI ISZ CH JMP SRCL * SRCI3 LDA CH SET END TO NEXT POINTER INA STA TYO JMP SRCI2 AND CONTINUE * SRCI4 AND DSMSK IF DOUBLE SHIFT CPA ASL GO ALLOW O17 OFFSET JMP SRCI8 * CPA LSL JMP SRCI8 * CPA RRL JMP SRCI8 * CPA STF IF STF DONT STRIP C BIT JMP SRCI7 * AND O2000 SZA JMP SRCI6 IF NOT IO GROUP * SRCI5 CMA MUST BE EXACT ADA PN SSA,RSS IS IT WITHIN LIMITS JMP SRCI NO FORGET IT * LDA CH40 SET TERMINATOR TO SPACE STA TERM JMP SRCI2 * SRCI6 LDA ONM AND O1000 SET ",C" FLAG STA CMACT IN TEMP VALUE XOR PN REMOVE THE CLEAR FLAG BIT STA PN * SRCI7 LDA O77 JMP SRCI5 * SRCI8 LDA O17 JMP SRCI5 * DSMSK OCT 176760 CMAC OCT 0 CMACT OCT 0 TERM OCT 54 O17 OCT 17 C1000 OCT 100000 HED PRINT ROUTINES * ADRP NOP PRINT ADDRESS IN SYMBOLIC STA ASCP ELA,CLE,ERA GET DIRECT ADDRESS STA ONM LDA STEND USER'S SYMBOL AREA LDB ISEND JSB ADRSP OCT 10 LIMIT OFFSET TO 10 LDA ASCP SSA,RSS INDIRECT? JMP ADRPX NO, DONE. * LDA COMMI JSB TY2 ADRPX LDA CH57 JMP ADRP,I * COMMI ASC 1,,I * ADRSP NOP PRINT SYMBOLIC EXPRESSION JSB SRCST SEARCH PART OF SYMBOL TABLE LDA ONM LDB ADRSP,I ISZ ADRSP STEP RETURN ADB DNM CLOSE ENOUGH? SSB,RSS JMP PSYM YES PRINT ABSOLUTE. * LDB SYMP GET SINGLE SYMBOL STB SYM AND SET CLB IT UP STB SYM+^þúR LDB NUMP SET VALUE STB DNM CPB C1000 IF NOT DEFINED JMP AABS FORGET IT. * PSYM JSB SYMP PRINT BEST SYMBOL LDA DNM SZA,RSS EXACT? JMP PCMAC YES, GO CHECK ",C" * LDA CH53 + LDB ADRSP IF INSTRUCTION CPB DINRT THEN LDA TERM PRINT "," OR " " INSTEAD JSB TYO LDB DNM PRINT DIFFERENCE CMB,INB LDA ADRSP GET RETURN ADDRESS CPA DINRT PRINTING NON ADDRESSABLE INSTR? JMP INONB YES GO RECURE * AABSS STB A NO SET OFFSET IN A * AABS JSB NUMP * PCMAC LDA CMAC IS ",C" REQUIRED SZA,RSS JMP ADRSP,I NO, THEN RETURN * LDA COMMC JSB TY2 CLA CLEAR ",C" FLAG STA CMAC JMP ADRSP,I AND RETURN * CH57 OCT 57 CH53 OCT 53 CH54 OCT 54 DINRT DEF INONC COMMC ASC 1,,C SKP * I N S T P * * PRINT SYMBOLIC INSTRUCTION * * LDA * JSB INSTP * INSTP NOP JSB ADRC MRG INSTRUCTION? JMP INOND NO,SEE IF 2 WORD INSTRUCTION STA DNM SAVE REFERENCED ADDRESS LDA B AND G74 GET OPCODE ALF,RAL TO LOW BITS ADA OPPTR INDEX INTO MRG SYMBOL TABLE LDA A,I FETCH OPTAB ENTRY LDB SRDX JSB PN PRINT IT * INONE LDA CH40 SPACE JSB TYO LDA DNM FETCH ADDRESS JSB ADRP PRINT ADDRESS JMP INSTP,I * INONB LDA ONM SSA IF MAC GROUP JMP AABSS JUST PRINT IT * AND O6000 ISOLATE THE GROUP BIT ADB A ADD IT BACK STB ONM NON-ADDRESSABLE. * INONA LDA CH54 SET TERMINATOR TO "," STA TERM LDA ISEXP POINT TO LDB STTOP TABLE "ISL2" JSB ADRSP SEARCH INSTRUCTION OCT 1777 * INONC JMP INSTP,I * INOND STB ONM SAVE INSTRUCTION JS zþúB GET2 2 WORD INSTRUCTION? JMP INONA NO,NON-ADDRESSABLE * LDB SRDX YES JSB PN PRINT IT LDA TRAC SZA,RSS TRACING? JMP INSTP,I NO,DON'T PRINT ADDRESS * LDA DDOT POINT TO INSRUCTION'S INA ADDRESS PARAMETER LDA A,I GET ADDRESS STA DNM SAVE IT JMP INONE * ISEXP DEF ISL2 O6000 OCT 6000 SKP * TY2 NOP TYPE OUT 2 CHARS, ARG IN AREG STA TY2MP PUT INTO TEMP ALF,ALF GET THE 1ST CHAR JSB TYO LDA TY2MP GET THE 2ND CHAR JSB TYO JMP TY2,I * TY2MP BSS 1 * CRLF NOP LDA O6412 JSB TY2 JMP CRLF,I * SIXSP NOP 6 SPACES JSB PTAB JSB PTAB JMP SIXSP,I * PTAB NOP LDA SPSP JSB TY2 LDA CH40 JSB TYO JMP PTAB,I SPSP ASC 1, * ASCP NOP ASCII PRINT JSB TY2 PRINT TWO CHARS LDA CH42 ADD A " JSB TYO JMP ASCP,I * CH42 OCT 42 * SYMP NOP SYMBOL PRINT LDA SYM LDB SRDX JSB PN LDA SYM+R LDB SRDX SZA JSB PN JMP SYMP,I * NUMP NOP NUMBER PRINT LDB RADIX JSB PN LDA CH56 PRINT . LDB RADIX CPB O12 THESE 4 INSTR STAY TOGETHER ISZ PNCNT ANOTHER CHAR TO PRINT CPB O12 IF DECIMAL. JSB TYO JMP NUMP,I * PTABC NOP RIGHT FILL AFTER NUMP WITH SPACES LDA PNCNT ADA M7 STA PNCNT SSA,RSS JMP PTAB2 PTAB1 ISZ PNCNT RSS JMP PTAB2 LDA CH40 JSB TYO JMP PTAB1 PTAB2 LDA CH40 JSB TYO JMP PTABC,I HED NUMBER AND SYMBOL PRINT * PN NOP A=NUMBER, B=RADIX. STA NUMBR STB PNRDX CMB,INB STB PNRDN CLB SET UP PNCNT STB PNCNT Hþú DO > 5 CHARS GET PN'ED? * * ENTER: B= NUMBER. * PDNC STB PNEND LDB NUMBR * PDVD STB PNENT LDA M20 STA CH CLA * PDVL CLE,ELB LONG LEFT SHIFT. ELA ADA PNRDN TRIAL DIVIDE SSA,RSS GOES? INB,RSS YES, BUMP QUOTENT ADA PNRDX NO, RESTORE ISZ CH ROUND AND ROUND... JMP PDVL WE GO. * CPB PNEND QUOTIENT IN B, REM IN A. JMP PDPNT JMP PDVD DIVIDE AGAIN. * PDPNT LDB PNRDX CPB SRDX ADA M1 ADA M12 SSA SKIP IF LETTER ADA M7 NUMBER FIXUP ADA O101 CONVERT TO ASCII CPA O133 PERIOD? LDA CH56 YES. CPA O134 $ ? LDA CH44 YES. CPA O135 % ? LDA CH45 YES. JSB TYO ISZ PNCNT PNCNT IS COUNT OF CHARACTERS PRINTED LDB PNENT CPB NUMBR JMP PN,I JMP PDNC * PNCNT BSS 1 NUMBR BSS 1 PNRDX BSS 1 PNRDN BSS 1 PNEND BSS 1 PNENT BSS 1 M7 OCT -7 M12 OCT -12 O133 OCT 133 O135 OCT 135 CH56 OCT 56 CH44 OCT 44 CH45 OCT 45 SKP TYO NOP LDB OBFPN GET BYTE POINTER SBT PUT BYTE IN BUFFER STB OBFPN RESTORE BYTE POINTER ISZ CCO BUMP CHAR COUNT CPB MAXOP IF BUFFER FULL JSB FLUSH THEN PRINT IT LDB ACCB RESTORE B REG JMP TYO,I * * * FLUSH DUMPS OUTPUT BUFFER * FLUSH NOP LDA CCO GET CHARACTER COUNT SZA,RSS IF ZERO JMP RTN02 THEN EXIT * CMA ELSE MAKE COUNT NEGATIVE STA CCO FOR EXEC * LDB OBFPN LDA O137 APPEND UNDERSCORE(FOR NO CRLF) SBT * JSB EXEC WRITE BUFFER DEF RTN01-1 IN CASE OF EXEC CALL ERROR DEF NAB2 (OCT 2+NO ABORT BIT) DEF LU DEF OBUF DEF CCO * JSB EXERR IN C•‹þúASE OF EXEC CALL ERROR RTN01 CCA SET FLAG TO IGNOR LF STA LFLAG AT END OF BUFFER * RTN02 CLA CLEAR CHAR COUNT STA CCO LDB OBFAD RESET BUFFER POINTER STB OBFPN JSB BRCHK CHECK FOR BREAK * * IF THERE IS A BREAK, THERE WILL BE NO RETURN TO HERE * JMP FLUSH,I RETURN SKP TTYOP NOP JSB FLUSH FLUSH OUTPUT BUFFER LDB IBFPN GET INPUT BUFFER POINTER ISZ CCI IF ANYTHING IN BUFFER JMP GCHAR THEN GO GET CHAR * ISZ LFLAG ELSE IF NOT FIRST CHAR AFTER JMP GTLF LINE FEED THEN GO GET (LF) * GTBUF JSB REIO ELSE GET NEXT BUFFER DEF RTN03 DEF O1 DEF LUC DEF IBUF DEF IBUFL * RTN03 SZB,RSS IF TLOG=0 GO GET LF JMP GTLF * CMB,INB SET CHAR COUNT FROM STB CCI TRANSMISSION LOG LDB IBFAD GET START OF BUFFER * GCHAR LBT FETCH CHAR AND O177 STRIP PARITY BIT STB IBFPN RESTORE POINTER JMP TTYOP,I AND RETURN * GTLF CCA RESET CHAR COUNT STA CCI CPA IBUFL IF HONEST THEN GO GET BUFFER JMP GTBUF * LDA O12 GET LINE FEED JMP TTYOP,I RETURN * IBFPN DBL IBUF IBFAD DBL IBUF CCI DEC -1 LFLAG DEC -1 IBUFL DEC -1 O137 OCT 137 CCO DEC 0 OBFPN DBL OBUF OBFAD DBL OBUF MAXOP DBL OBUFE LUC BSS 1 IBUF BSS 40 OBUF BSS 35 OBUFE BSS 1 NAB1 OCT 100001 1+NO ABORT BIT NAB2 OCT 100002 2+NO ABORT BIT NAB15 OCT 100015 15+NO ABORT BIT SKP OPTAB OCT 115002 NOP - 0 OCT 3 OCT 44216 AND - 10 OCT 100624 JSB - 14 OCT 154204 XOR - 20 OCT 100262 JMP - 24 OCT 75304 IOR - 30 OCT 75554 ISZ - 34 OCT 43373 ADA - 40 OCT 43374 ADB - 44 OCT 52533 CPA - 50 OCT 52534 CPB - 54 OCT 105673 LDA - 60 OCT 105674 LDB - 64 C   OCT 134773 STA - 70 OCT 134774 STB - 74 OCT 0 DUMMY ADDRESS FOR LOADR SKP M1 OCT -1 M6 OCT -6 O1 OCT 1 O12 OCT 12 O77 OCT 77 O101 OCT 101 "A" EQU O101 O134 OCT 134 O177 OCT 177 O400 OCT 400 TRAC NOP TRACING FLAG WRD NOP LL NOP UL NOP CH NOP CHI NOP SYMXI DEF SYM SYMX NOP SYM OCT 0,0 ONM NOP DNM NOP CHC NOP ALTMI NOP LFLG NOP LIMBO EQU SYMXI IADR NOP RADIX OCT 10 PM DEF INSTP ISEND DEF ISL LOCP DEF LOC STED DEF STEND OPPTR DEF OPTAB * ADRPP DEF ADRP MASTER MODE TABLE - MODE INSPP DEF INSTP IS SET BY INDEXING INTO NUMPP DEF NUMP THIS TABLE AND PICKING ASCPP DEF ASCP UP POINTER FOR DISPATCHING * SKP DEBOP DEF *+1 FIRST WORD WICH CAN BE MODIFIED * CEND OCT 77777 DO NOT MOVE DEF END THESE VALUES!!!!!!!!!!!!!!!!!! LTRAP DEF $TRAP ADDRESS OF BP POINTER TO "TRAP" STEND DEF ISL0 "F" BRFLG OCT 0 BREAK FLAG, SEE BRCHK LU OCT 400 LU FOR WRITING ACCA NOP A-REGISTER ACCB NOP B-REGISTER ACCX NOP X-REGISTER ACCY NOP Y-REGISTER FLGBX NOP O,E, AND INTERRUPT STATUS MSK OCT 177777 "M" BVAL NOP "M+5" BREAKPOINT COMPARE VALUE BADD NOP "M+7" REG OR MEMORY TO BE TESTED BMSK OCT 177777 "M+6" BREAKPOINT MASK SKP SZA "M+8" SENSE OF TEST SZA =,SZA,RSS /= BPADR DEF SYM BP ADDRESS 2 ORB PLANT A DEF ON THE BASE PAGE $TRAP DEF TRAP0 ADDRESS OF TRAP FOR JSB ORR ONLY NEED ONE WORD * * END DBUGR ‚æ ÿÿ ÿý4= ÿ92067-18076 1805 S C0122 &STDB4 RTE-IV .STDB ROUTINE             H0101 æASMB,L,C HED .STDB ROUTINE * SOURCE: 92067-18076 * RELOC: PART OF 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .STDB,7 92067-16035 REV.1805 771107 ENT .STDB,.DBSG EXT .SDBG SUP * * THIS PIECE OF CODE IS APPENDED TO EACH SEGMNET OF A SEGMENTED * PROGRAM LOADED WITH THE RTE-IV LOADER USING THE 'DB'(DEBUG) * COMMAND. THE SEGMDENT'S PRIMARY ENTRY POINT CONTAINED IN ITS * ID SEGDMENT IS SET TO *.STDB*. THE LOADER WILL STORE THE * TRUE PRIMARY ENTRY POINT OF THE SEGDMENT IN *.DBSG*. THE * DEBUG SUBROUTINE *DBUGR*, WHEN ENTRED FROM *.STDB*, WILL * EXECUTE A PSUEDO BREAK. IT WILL THEN RETURN TO THE SEGMENT'S * PRIMARY ENTRY POINT WHENEVER THE USER ENTERS THE '/P' COMMAND. * ****************************************************************** * .STDB JSB .SDBG SEGMENT ENTERED HERE. .DBSG NOP LOADER STORES TRUE ENTRY POINT HERE. END .STDB ã]ÿÿ ÿý  ÿ92067-18077 1805 S C0122 &IDGET4 RTE-IV IDGET SUBROUTINE             H0101 5|þúASMB,R,L,C HED "IDGET" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG * SOURCE: 92067-18077 * RELOC: 92067-16035 * PGMR: D.L.B.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IDGET,6 92067-16037 REV.1805 771227 ENT IDGET EXT .ZPRV * CALLED: * IDSEG = IDGET(NAME) * WHERE: * NAME = THREE WORD ASCII (5 CHARS) BUFFER WITH NAME OF PROG * IDSEG = THE ID SEGMENT ADDRESS OF THE NAME * RETURN: * A-REG = ID SEGMENT ADDRESS OF NAME IF FOUND OR = 0 IF NOT FOUND * E-REG = 0 IF NAME FOUND OR = 1 IF NOT FOUND. * B-REG = 0 * (I BELEAVE THAT THIS ROUTINE IS COMPATABLE WITH ID.A) * NOTE: IF NAME IS NULL THEN FIND BLANK IDSEG ADDRESS. SPC 1 IDGET NOP ENTRY FTN CALLING SEQUENCE JSB .ZPRV DO THE $LIBR THING DEF LIBX ISZ IDGET AVOID .ENTR,.DFER LDB IDGET GET NAME ADDRESS LDB B,I GET NEXT LEVEL RBL,CLE,SLB,ERB TRACK DOWN INDIRECTS JMP *-2 STB NAME AND SAVE FOR LATER USE INB BUMP TO 2ND WORD IN NAME STB NAME+1 SAVE ADDRESS OF NAME(2) INB BUMP TO LAST CHAR LDA B,I PICK UP AND OM400 NULL LAST CHAR STA NAME+2 SAVE VALUE OF NAME(3) LDB KEYWD GET KEYWORD POINTER ON BASE PAGE STB POINT SAVE TEMP RSS SKIP THE ISZ 1ST TIME LOOP ISZ POINT BUMP TO NEXT IDSEG ADDRESS XLB POINT,I GET IDSEG ADD OF NEXT PROG CCE,SZB,RSS CHECK IF LAST ENTRY JMP ENDTA YES, NOT FOUND PROGRAM ADB D12 POINT TO PROGRAM NQï  AME AREA XLA B,I GET CHARS 1 & 2 CPA NAME,I EQUAL ? INB,RSS YES, CHECK NEXT 2 JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET CHARS 3,4 CPA NAME+1,I EQUAL? INB,RSS YES, BUMP AGAIN JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET LAST CHAR AND OM400 MASK TO 5TH CHAR CPA NAME+2 CLB,CLE,RSS FOUND!!!! JMP LOOP TRY NEXT PROG ENDTA XLA POINT,I RETURN A= IDSEG ADDRESS ISZ IDGET SET RETURN POINT E=FOUND FLAG LIBX JMP IDGET,I P+3 DEF IDGET FOR JSB $LIBX SPC 1 NAME REP 3 NOP POINT NOP OM400 OCT -400 D12 DEC 12 KEYWD EQU 1657B B EQU 1 END Ä% ÿÿ ÿý  ÿ92067-18078 1940 S C0322 &SMP4 RTE IV SMP PROG             H0103 v þúASMB,Q,C ASSEMBLY STATEMENT FOR RTE IV * HED SMP ROUTINE * NAME: SMP * SOURCE: 92067-18078 * RELOC: 92067-16028 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SMP,18,30 92067-16028 REV.1940 790802 * * * * SSTAT STATES * * 0 NORMAL * 1 SPOUT IS WORKING ON A MENU * * EXT .DFER THREE WORD MOVE ROUTINE EXT REIO I-O ROUTINE EXT .MVW MOVE WORDS ROUTINE EXT RMPAR RETRIEVE PARAMETERS EXT SP.CL SPOUT CLASS ID EXT $LUAV SPOOL LU TABLE EXT .IS43 IN SP.CL HAS ADDR OF IS43 IN DVS43 EXT $LUSW LU TRANSFORM TABLE EXT .DRCT PICK UP DIRECT ADDRESS EXT $LIBR GO PRIVILEGED EXT $LIBX SUSPEND PRIVILEGED OPERATION EXT READF FMGR READ EXT WRITF FMGR WRITE EXT EXEC SYSTEM CALLS EXT PRTN PASS PARAMETERS TO CALLER EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFERS A EQU 0 B EQU 1 XEQT EQU 1717B SUP HED SMP CALL PRAMS * PRAMS P1 THRU P5 DESCRIBE THE FUNCTION TO PREFORM * AS FOLLOWS: * * P1 =0 SET UP CALL REQUIRES A 16 WORD CLASS BUFFER * P2 =CLASS NUMBER * P3 =BATCH CHECK FLAG (ID ADDRESS OF PRIV. PROGRAM OR ZERO) * * P1 =1 CHANGE PURGE TO SAVE ON AN EXISTING FILE * P2 =LU ASSIGNED LU OR IF BATCH THE SWITCHED LU MAY BE USED * * P1 =2 CHANGE SAVE TO PURGE * P2 =LU ASSIGNED LU OR IF BATCH THE SWITCHED LU * * * P1 =3 PASS THE FILE TO OUT SPOC&þúOL * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =4 CLOSE AND PASS THE FILE * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =5 CHANGE LU AND OR PRIORITY OF OUT SPOOL * P2 =LU ASSIGNED OR SWITCHED IF IN BATCH * P3 =NEW OUT LU * P4 =NEW PRIORITY * * * P1 =6 SET BUFFERED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =7 CLEAR BUFFERRED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =8 GET CURRENT POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * * * P1 =9 CHANGE POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * P3 =POSITION PRAMETER 1 * P4 =POSITION PRAMETER 2 * P5 =POSITION PRAMETER 3 * * * P1 =10 SPOUT CAN NOT OUT SPOOL BECAUSE OF FAILURE * OF LULOCK REQUEST * * * * P1 =11 SPOUT CAN BEGIN OUT SPOOL * P2 =LU SELECTED FOR OUT PUT * * * P1 =12 DEQUEUE OUT SPOOL (SPOUT IS DONE) * P1 =12 DEQUEUE OUT SPOOL (SPOUT IS DONE) * P2 =LU ASSIGNED LU OF FILE * P3 = #0 IF A BAD EOF FOUND ELSE 0 * * * P1 =13 KILL SPOOL * P2 =SPLCON RECORD NUMBER OF FILE TO KILL * P3 =LU ASSIGNED FROM WORD 1 OF RECORD * P4 =0 * P5 =CURRENT STATUS OF FILE * * * P1 =14 HOLD A OUTSPOOL FILE * P2 =SPLCON RECORD NUMBER OF FILE * P3 =OUTSPOOL LU (CURRENT) * P4 =0 * P5 =CURRENT STATUS SPLCON RECORD WILL SHOW 'H' * * * P1 =15 RELEASE A HOLD * P2 =SPLCON RECORD NUMBER OF FILE * P3 =CURRENT OUT SPOOL LU * P4 =NEW LU OR 0 CAN CHANGE LU ON RELEASE * P5 =CURRENT STATUS OF FILE * * * P1 =16 SHUT DOWN OUTSPOOLING * * * P1 =17 START UP OUT SPOOLING * * * P1 =18 CALL FROM SPOUT A LU IS DOWN * P2 =LU CURRENT ASSIGNED LU SKP SKP DTAB DEF }^þúCPTS 1 CHANGE PURGE TO SAVE. DEF CSTP 2 CHANGE SAVE TO PURGE. DEF PASS 3 PASS NOW DEF CSAP 4 CLOSE SPOOL AND PASS DEF MPI 5 MODIFY PASS INFORMATION DEF SBF 6 SET BUFFER FLAG DEF CBF 7 CLEAR BUFFER FLAG DEF GCDP 8 GET CURRENT DISK POSITION DEF CSRP 9 CHANGE STARTING RECORD POSITION DEF LULOK 10 LU LOCK CONDITION IN SPOUT DEF SPSEL 11 SPOOL SELECTION BY SPOUT DEF DEQUX 12 DEQUEUE OUTSPOOL. DEF KILL 13 KILL SPOOL DEF HOLD 14 HOLD A SPOOL FILE DEF RELSE 15 RELEASE A HOLD. DEF SHUT 16 SHUT DOWN OUTSPOOLING. DEF STUP 17 START UP OUTSPOOLING. DEF DVCDN 18 I/O DEVICE DOWN SET HOLD * * JOBFL BSS 2 HOLDS FIRST 16 WORDS OF JOBFIL DCB OCT 2 BSS 3 DEC 16 OCT 100201 BSS 5 OCT 0,200,0 SPLFL BSS 2 HOLDS FIRST 16 WORDS OF SPLCON DCB OCT 2 BSS 3 DEC 16 OCT 100201 UP DATE WRITE OK 128 WORD DCB BSS 5 OCT 0,200,0 * DCB1 BSS 144 BUF21 BSS 16 HOLDS SPLCON #1 MOSTLY BUF22 BSS 16 HOLDS SPLCON #2 AND #3 MOSTLY BUF23 BSS 16 HOLDS CURRENT SPLCON FILE RECORD MOSTLY BUF24 BSS 16 HOLDS JOB RECORD #17 AND USED TO CHECK Q BLOCKS BUF25 BSS 62 HOLDS JOB RECORD FROM JOBFIL ALSO MENU MOSTLY LIMIT BSS 2 * * ALL BUFFERS ARE USED TO HOLD THE LU Q AT TIMES * * ORG DCB1 INITIALIZE CODE IS IN THE BUFFERS * * SMP JSB RMPAR DEF *+2 DEF PARM1 LDA XEQT GET MY ID ADDRESS STA JOBFL+9 SET THE OPEN FLAGS STA SPLFL+9 IN THE DCB SAVE AREAS CCE SET THE SIGN BIT RAL,ERA AND STA IID,I AND SAVE FOR NOW AND LATER JSB EXEC CALL D.RTR TO LOOK UP JOB FILE DEF *+7 DEF D23 DEF D.RTR IID DEF ID DEF JOBNA z‡þú FILE NAME (NON-EXCLUSIVE) DEF JOBNA+1 DEF JOBNA+2 LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * STA JOBFL+5 SET THE FILE SIZE INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA JOBFL INB LDA B,I IN STA JOBFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA JOBFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA JOBFL+4 XOR B,I ALF,ALF STA JOBFL+8 SET THE SEC/TRACK WORD JSB EXEC CALL D.RTR TO LOOK UP SPOL FILE DEF *+7 DEF D23 DEF D.RTR DEF ID DEF SPLNA FILE NAME (NON-EXCLUSIVE) DEF SPLNA+1 DEF SPLNA+2 LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * STA SPLFL+5 SET THE FILE SIZE INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA SPLFL INB LDA B,I IN STA SPLFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA SPLFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA SPLFL+4 XOR B,I ALF,ALF STA SPLFL+8 SET THE SEC/TRACK WORD JMP SMP0 GO CONTINUE THE SET UP * BAIL JSB FILER REPORT THE ERROR AND JMP RETN4 EXIT * X377 OCT 377 * TS EQU BUF21-* IF ERROR WE RAN OUT OF THE DCB * ORG BUF21 GET OUT OF THE DCB SO IT CAN BE USED * * SMP0 LDB DDCB1 LDA PTRJ SET UP TO ACCESS THE JOB FILE JSB .MVW DEF D16 NOP LDB X17 GET THE JOB FILE RN LDA PTX21 JMP SMP00 BAIL OUT OF THIS BUFFER * ORG BUF22 SAFE GROUND * SMP00 JSB RDREC READ JOBFILE RECORD 17 JMP RETN4 IF ERROR GET OUT * LDA BUF21 ÅýþúGET THE RN STA DJRN,I SAVE IT JSB .DRCT GET IS43 ADDRESS FOR DEF .IS43 FOR FUTURE EQT CHECKING. LDA A,I STA IS43A SAVE THE ADDRESS. JSB .DRCT GET ADDRESS OF DEF $LUAV $LUAV TABLE AND SAVE. STA LUAVA LDB DDCB1 SET UP TO ACCESS THE SPOOL CONTROL FILE LDA PTRS JSB .MVW DEF D16 NOP * LDA PTX21 GET FIRST SPLCON RECORD. CLB,INB TS1 EQU *-BUF21-16 IF ERROR THEN CODE WILL BE OVERLAYED JSB RDREC JMP RETN4 ERROR EXIT * LDA PTX23 LDB X3 JMP SMP01 GET TO HIGH GROUND * ORG BUF24 GET OUT OF THE BUFFER * SMP01 JSB RDREC READ SHUT DOWN WORD. JMP RETN4 EXIT IF ERROR * LDA BUF21 STA SRN SAVE SPLCON RESOURCE #. LDA BUF23 SAVE CURRENT SHUT DOWN CONDITION. STA SHUTX,I LDA BUF23+1 SAVE HOLD RN. STA WRN JSB .DRCT INITIALIZE THE MENU. DEF BUF21+6 POINTER TO LU AREA STA TEMX1 LDA MPTRX POINTER TO MENU STA TEMX2 CONTAINS LU-#FILES ON QUE LDA X9 SMP2 STA TEMX3 LDA TEMX2,I SZA,RSS MUST GO THROUGH ALL THE OUTSPOOL JMP SMP4 QUEUES PICKING UP THE NUMBER * LDB TEMX1,I OF OUTSPOOLS WAITING ON EACH STB TEMX2,I ONE. THIS WILL ENABLE A ISZ TEMX2 START-UP TO PICK THEM UP. SZB,RSS JMP SMP5 * LDA PTX23 LDB TEMX3 READ IN THE BEGINNING JSB RDREC OF A QUEUE BLOCK. JMP RETN4 * LDB BUF23+1 GET COUNT OF OUTSPOOLS. SMP5 STB TEMX2,I ISZ TEMX2 STEP MENU ADDRESS ISZ TEMX1 STEP LU LIST ADDRESS LDA TEMX3 STEP RECORD ADDRESS ADA X8 BY 8 JMP SMP2 AROUND WE GO * SMP4 LDA SP.CL CHECK IF CLASS HAS BEEN SZA ALLOCATED FOR SPOUT. IF SO, JMP SMP1 DON'T DO IT AGAIN. * JSB EXEC°eþú ALLOCATE CLASS FOR DEF *+5 SPOUT REQUESTS. DEF X19 DEF ZERO DEF ZERO DEF SP.CL LDA SP.CL GET THE CLASS AND IOR B20K SET THE DON'T RELEASE STA SP.CL BIT JMP SMP1 * X3 DEC 3 DDCB1 DEF DCB1 B20K OCT 20000 SHUTX DEF SHUTD X8 DEC 8 X19 DEC 19 X17 DEC 17 X9 DEC 9 JOBNA ASC 3,JOBFIL SPLNA ASC 3,SPLCON PTRJ DEF JOBFL PTRS DEF SPLFL PTX21 DEF BUF21 PTX23 DEF BUF23 MPTRX DEF .MENU TEMX1 NOP TEMX2 NOP TEMX3 NOP DJRN DEF JRN TS3 EQU LIMIT+2-* IF ERROR CODE GOES BEYOND BUFFER ORR * SMP1 JSB EXEC SCHEDULE SPOUT WITHOUT WAIT DEF *+3 AND IGNORE THE RESPONSE DEF D10 FROM EXEC. DEF SPOUT JSB POST MAKE SURE WE'RE SET DEF *+2 FOR NEW RECORDS TO BE DEF DCB1 READ CLEAN FROM DISK. JSB LOCK LOCK THE SPLCON RN. DEF SRN LDA PTR21 CLB,INB JSB RDREC NOP ********************************************** LDA PARM1 WHAT TYPE OF REQUEST? SZA,RSS JMP SETUP NEW SETUP. * CPA D18 IF DOWN DEVICE JMP USEOR GO GET THE RECORD * CPA D12 JMP USEOR DEQUEUE. * ADA M10 SSA,RSS JMP CJUMP GASP OR SPOUT REQUEST. * LDA XEQT MUST BE IN BATCH MODE TO ADA D20 USE THE SWITCH TABLE LDA A,I GET THE FLAG SSA,RSS IF NOT IN BATCH JMP USEOR USE THE GIVEN LU * JSB .DRCT MODIFICATION. DEF $LUSW MUST GO THROUGH $LUSW LDB A,I TABLE TO SEE IF WE CMB,INB MUST TRANSLATE THE GIVEN STB TEMP2 LU #. THE ACTUAL SPOOL INA LU IS THE ONE NEEDED STA TEMP1 TO LOOK UP IN THE LOOP6 LDA TEMP1,I SPOOL LU AVAILABILITY SSA TABLE. JMP LOOP7 * AND B77 INA CPA PARM2 JMP AFþúIND * LOOP7 ISZ TEMP1 ISZ TEMP2 JMP LOOP6 * JMP USEOR DIDN'T FIND. USE LU GIVEN. * AFIND LDA TEMP1,I ALF,ALF AND B77 INA STA PARM2 USEOR JSB FLU SEARCH LU AVAILABILITY JMP MENU CAN'T FIND. * * LDB TEMP1,I SAVE CORRESPONDING RECORD SZB,RSS (IF NOT ASSIGNED JMP MENU SKIP OUT) * STB RECNO # OF SPLCON RECORD. LDA PTR23 JSB RDREC READ THE APPROPRIATE RECORD. JMP RETRN READ ERROR. * CJUMP CCA IS THE REQUEST ADA PARM1 PARAMETER VALID? SSA JMP MENU ILLEGAL REQUEST PARAMETER. * STA B ADB M18 SSB,RSS JMP MENU ILLEGAL REQUEST PARAMETER. * ADA RTAB BRANCH TO APPROPRIATE JMP A,I SERVICE ROUTINE * FLU NOP ROUTINE TO FIND LU IN LUAV LDB LUAVA SEARCH LU AVAILABILITY LDA B,I SZA,RSS JMP FLU,I CAN'T FIND. * STA TEMP2 LOOP5 INB LDA B,I AND B77 INB CPA PARM2 DOES THE LU MATCH JMP FOUND THE ONE GIVEN? * ISZ TEMP2 JMP LOOP5 * JMP FLU,I NOT FOUND * FOUND ISZ FLU FOUND STEP ADDRESS STB TEMP1 SET ADDRESS FOR LATER JMP FLU,I AND EXIT * RTAB DEF DTAB,I REQUEST TABLE. LUAVA BSS 1 D20 DEC 20 M10 DEC -10 D18 DEC 18 M18 DEC -18 * CSTP CLE,RSS CHANGE SAVE TO PURGE. * CPTS CCE CHANGE PURGE TO SAVE. LDA BUF23+8 ERA,RAL STA BUF23+8 WRTRC LDA PTR23 WRITE OUT SPOOL CONTROL LDB RECNO RECORD. JSB WTREC JMP MENU * * PASS LDB BUF23+8 BATCH INPUT? RBL SSB JMP MENU YES - ILLEGAL REQUEST. * LDA BUF23+15 IF NO LU SZA,RSS THEN JMP MENU IGNOR * LDB BUF23+8 WAS THE FILE BEING RBR,SLB HELD UNTIL CLOSEÐþú. JMP PCHK1 YES - WE ARE OK. * JMP MENU NO - FILE WILL HAVE BEEN PASSED. * * CSAP LDA PARM2 CALL SMD TO POST ANY XOR B3700 REMAINING BUFFERS TO THE STA TEMP2 SPOOL FILE AND-OR CLEAR LDA BUF23+15 IS FILE IS TO BE PASSED SZA,RSS NO SKIP JMP CPST THE LU CLEAR * CLA CLEAR THE REC. NUMBER IN CASE SPOUT LDB TEMP1 HAS CAUGHT UP JSB PUT WILL DO THE WHOLE THING AFTER THE POST CPST JSB EXEC IN-CORE INDICATORS. DEF *+5 DEF D1 DEF TEMP2 DEF BUF21 DEF D16 * LDA BUF23+15 IS FILE TO BE PASSED?? SZA WELL? JMP PCHK YES GO PASS IT * BATIN JSB PRGEX CLOSE THE FILE JMP MENU GO CHECK THE MENU * * PCHK LDB TEMP1 GET LUAV ADDRESS JSB FRELU FREE THE LU AND EQT LDA BUF23+8 WAS IT PASSED BEFORE? RAR,SLA IS HOLD BIT SET? RSS JMP MENU YES. * PCHK1 LDA BUF23+8 REMOVE HOLD BIT. IOR D2 SET JUST IN CASE XOR D2 NOW CLEAR IT STA BUF23+8 JMP QUEUE GO SET IT UP * "W" OCT 127 * MPI LDA PARM4 SAVE NEW PRIORITY IF SZA,RSS IF GIVEN. JMP MPI1 * SSA,RSS STA BUF23+9 MPI1 LDA BUF23+15 SAVE OLD LU. STA TEMP2 LDA PARM3 GET NEW LU STA PARM4 IF GIVEN. SZA,RSS SKIP IF NOT GIVEN JMP CKVAL * STA BUF23+15 LDB "W" SET STATUS TO WAIT LDA BUF23+10 IF NONE WAS DEFINED SZA,RSS PREVIOUSLY STB BUF23+10 CKVAL JSB SMENU CHECK VALIDITY. JMP MPIER NEW LU NOT GOOD. * LDB BUF23+10 IF SPOOL IS ACTIVE, CPB "A" WE CAN PERFORM JMP MPIER THIS OPERATION. * CLB STB TEMP1 LDA TEMP2 IF NO OLD LU, SZA,RSS WRITE RECORD AND JMP SS4 QUEUE IF NEEDED NOW. * #íþú LDB BUF23+8 REQUEUE UNLESS THE RBR,SLB FILE IS BEING HELD JMP SS4 FROM THE QUEUE * STA BUF23+15 LDA PTR23 WRITE THE CURRENT RECORD LDB RECNO TO THE SPLCON FILE JSB WRTRC CCE SET TO SHOW NOT ACTIVE JMP DEQ18 UNTIL IT IS CLOSED. * MPIER LDA TEMP2 STA BUF23+15 LDA M21 STA TEMP1 JMP WRTRC * SBF JSB FEQT SET BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD JSB PUTM JMP MENU * PTR21 DEF BUF21 PTR23 DEF BUF23 D3 DEC 3 D12 DEC 12 BUFRD OCT 40000 * CBF JSB FEQT CLEAR BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD SET BIT TO BE CLEARED CLE SET THE CLEAR FLAG JSB PUTM CLEAR THE BIT JMP MENU * SETEQ NOP SUB TO SET EQT ADDRESSES JSB FEQT GET CURRENT DISK POSITION. ADA D2 ADDRESS OF EQT18 (CURRENT TRACK) STA TEMP5 SAVE IT ADA D2 STEP TO EQT20 (EXTENSION NUMBER) STA TEMP2 AND SAVE IT INA NOW EQT21 (CURRENT SECTOR) STA TEMP1 SAVE IT ADA D3 EQT24 (FIRST TRACK OF EXTENT) STA TEMP3 SAVE IT INA EQT25 (FIRST SECTOR OF EXTENT) STA TEMP4 SAVE IT INA EQT26 (FILE SIZE) STA DFSIZ SAVE ADDRESS OF FILE SIZE ADA D4 EQT30 (# SECTORS/TRACK) STA D#PTR SAVE IT JMP SETEQ,I RETURN * GCDP JSB SETEQ SET THE EQT ADDRESSES LDA TEMP3,I GET THE BASE TRACK CMA,INA SUBTRACT FROM ADA TEMP5,I CURRENT TRACK MPY D#PTR,I TIMES #/TRACK D#PTR EQU *-1 LDB TEMP4,I GET BASE SECTOR CMB,INB AND SUBTRACT ADA B IT THEN ADA TEMP1,I ADD CURRENT SECTOR A=SECTOR OFFSET STA TEMP1 IN CURRENT EXTENT LDA TEMP2,I GET EXTENT MPY DFSIZ,I TIMES EXTENT SIZE = SECTOR OFFSET OF DFSIZ gþúEQU *-1 THIS EXTENT CLE NOW ADD THE TWO ADA TEMP1 DO DOUBLE WORD SEZ,CLE INB ADD STA TEMP1 SET FOR STB TEMP2 RETURN ISZ TEMP5 GET THE OFFSET LDA TEMP5,I AND STA TEMP3 SET IT FOR RETURN JMP SRSEX GO SEND IT (SST #4236) * CSRP JSB SETEQ SET UP THE EQT ADDRESSES ADB D10 ADDRESS OF EQT11 STB SETEQ SAVE IT FOR LATER LDA DFSIZ SET ADDRESSES INA SET UP TO GET THE EXTENT STA DIRCT IN ALL CASES INA STA DIRCT+1 LDA PARM3 GET THE DOUBLE WORD LDB PARM4 SECTOR OFFSET DIV DFSIZ,I DIVIDE BY FILE SIZE STA PARM1 SET EXTENT NUMBER FOR D.RTR CALL STB PARM2 SAVE THE REST * JSB EXEC SCHEDULE D.RTR TO OPEN DEF *+8 THE EXTENT. DEF D23 DEF D.RTR DEF 1717B ID SEGMENT ADDRESS. DEF PARM1 EXTENSION #. DIRCT BSS 2 DEF D6 JSB RMPAR DEF *+2 DEF D.1 LDA D.1 SSA JMP RETRN * LDA D.5 AND B377 JSB $LIBR GO PRIV TO SET THE EQT NOP STA TEMP4,I STORE BEGINNING SECTOR (EQT25). CLB,CLE SET UP THE ADA PARM2 OFFSET SEZ INB NOW DIV D#PTR,I GET TRACK OFFSET AND SECTOR ADDRESS STB TEMP1,I SET CURRENT SECTOR ADA D.4 SET CURRENT TRACK STA TEMP5,I IN EQT 18 LDA D.4 STA TEMP3,I STORE BEGINNING TRACK (EQT24). LDA PARM5 IOR DM128 MAKE SURE RANGE IS RIGHT ISZ TEMP5 STEP TO EQT19 STA TEMP5,I STORE CURRENT OFFSET (EQT19). LDA PARM1 STA TEMP2,I STORE CURRENT EXTENT (EQT20). LDA SETEQ,I GET EQT11 AND AND NTEOF CLEAR THE EOF FLAGS STA SETEQ,I RESTORE IT JSB $LIBX GO TEST MENU DEF *+1 DEF MENU * "A" ÜkþúOCT 101 C377 OCT 177400 NTEOF OCT 117777 MASK TO CLEAR EOF FLAGS M26 DEC -26 M22 DEC -22 D4 DEC 4 B3700 OCT 3700 B377 OCT 377 B77 OCT 77 BMASK OCT 137777 BPAT NOP ADDR1 NOP RECNO NOP D2 DEC 2 M1 DEC -1 M2 DEC -2 M4 DEC -4 M16 DEC -16 PARM1 BSS 1 PARM2 BSS 1 PARM3 BSS 1 PARM4 BSS 1 PARM5 BSS 1 * ERM26 LDA M26 JMP NOGO1 * SETUP LDA PTR22 HAVE RECORD 1. STA ADDR1 SAVE FOR LATER LDB D2 GET RECORD 2. JSB RDREC JMP NOGO1 READ ERROR. * * FIND IF THERE IS AN AVAILABLE SPLCON RECORD. * LDA M16 SET UP STA TEMP1 COUNTER LDA BUF21+3 GET REC. # OF FIRST REC STA RECNO SAVE IT LDA BUF21+1 GET NUMBER OF RECORDS CMA,INA SET FOR COUNTER STA TEMP3 IN TEMP3 LOOP1 LDA M16 SET UP STA TEMP2 COUNTER TWO CLB,INB SET INITIAL BIT MASK LOOP2 LDA ADDR1,I TRY AND B ONE SZA,RSS AVAILABLE?? JMP HAVIT YES USE IT * ISZ TEMP3 ANY RECORDS LEFT? RSS YES SKIP JMP NOGO NO SO SORRY! * RBL NO ADVANCE BIT MASK ISZ RECNO SEP RECORD NUMBER ISZ TEMP2 AND COUNT WORD EXHAUSTED?? JMP LOOP2 NO TRY NEXT BIT * ISZ ADDR1 YES TRY NEXT WORD ISZ TEMP1 IS THERE A NEXT WORD?? JMP LOOP1 YES TRY IT. * JMP NOGO NO AVAILABLE RECORD. * HAVIT LDA ADDR1,I SAVE NEW BIT PATTERN XOR B IN A TEMPORARY. STA BPAT LDA BUF21+4 CMA,INA SET NEGATIVE STA PARM5 SAVE MAX. # PENDING OUTSPOOLS. * * FIND OUT WHETHER ANY OUTPUT QUEUES ARE FULL * OR TOTAL PENDING OUTSPOOLS MATCH THE MAXIMUM. * LDB MPTR GET THE MENU ADDRESS LOOP3 LDA B,I GET ENTRY SZA,RSS END OF LIST? JMP SMP3 YES * INB NO STEP TO COUNT LDA B,²RþúI GET COUNT RAL,CLE,ERA CLEAR THE SIGN CPA D63 FULL?? JMP ERM26 YES SENT BACK ERROR * ADA PARM5 ADD TO TOTAL STA PARM5 RESET TOTAL SSA,RSS IF NEG. THEN JMP ERM26 TOO MANY * INB NEXT JMP LOOP3 AROUND AGAIN * * * FIND AN AVAILABLE LU #. * * SMP3 JSB FINDL NOGO LDA M22 USE ZERO TO FLAG ERROR AND DO CLASS GET * NOGO1 STA TEMP1 JSB EXEC DO A CLASS GET TO RETRIEVE DEF *+5 THE SETUP BUFFER. DEF D21 DEF PARM2 DEF BUF23 DEF D16 JSB SMENU JMP ERM21 * LDA TEMP1 STA BUF23+1 SAVE LU# IN SETUP BUFFER. SSA,RSS IF NO LU THEN TAKE GAS! JSB OPNSP TRY TO OPEN THE SPOOL FILE. SZA,RSS CHECK FOR ERRORS. JMP ERM16 CANNOT USE TYPE 0 FILES. * SSA JMP ERMES COULDN'T OPEN THE FILE? * LDA BUF23+8 IF BATCH INPUT RAL,ELA THEN CLA,SEZ CLEAR STA BUF23+15 OUTSPOOL LU. LDA BUF23+9 IF PRIORITY IS NEG SSA THEN CLA SET ZERO STA BUF23+9 TO AVOID Q PROBLEMS LDA BUF23+15 IF FILE IS FOR OUTSPOOL SZA,RSS IF NOT FOR OUTSPOOL JMP SSEQT JUST SET IT UP * LDB BUF23+10 GET STATUS CPB "H" IF NOT HOLD JMP SSEQT * LDB "W" SET TO WAIT STB BUF23+10 * * SET UP SPOOL EQT ENTRY. * SSEQT JSB FEQT FIND ADDRESS OF EQT. INB MAKE SURE THAT THIS IS LDA B,I REALLY A SPOOL EQT. CPA IS43A DO THIS BY CHECKING JMP SS3 EQT2 AGAINST THE INIT. * JMP ERM22 ENTRY POINT OF DVS43. * SS3 ADB D2 HAVE EQT ADDRESS. STB TEMP3 GET EQT4 ADDRESS. JSB $LIBR GO PRIVILEGED TO BE ABLE NOP TO STUFF THE EQT. LDA TEMP3,I SET OR CLEAR BUFFERING AND BMASK âNLH FLAG. LDB BUF23+8 SSB XOR BUFRD STA TEMP3,I ISZ TEMP3 LDA BUF23+7 GET DRIVER TYPE AND PUT ALF,ALF AND POSITION CORRECTLY STA TEMP3,I IN EQT5. LDB TEMP3 ADB D6 SET UP REMAINDER OF STB CLSPT SAVE ADDRESS OF EQT 11 LDA PARM1 IF THIS CMA,CLE,INA IS A SET UP FOR SPOUT CLEAR E LDA D16 SET THE STANDARD BIT AT ALL TIMES SEZ IF SPOUT USE ONLY THE STD. BIT IOR BUF23+8 DISPOSITION FLAGS. AND DMASK EQT11. STA B,I ADB D2 INDEX TO EQT EXTENSION. LDB B,I ADB D2 SAVE ADDRESS OF CURRENT STB TEMP3 TRACK/SECTOR. ADB D8 LDA D.1 SAVE FILE SIZE IN EQT26. STA B,I SAVE MASTER DIRECTORY ENTRY INB IN EQT27 AND EQT28. LDA D.2 STA B,I INB LDA D.3 STA B,I ADB M4 LDA D.4 STA B,I SAVE BEGINNING TRACK (EQT24). STA TEMP3,I SAVE CURRENT TRACK (EQT18). ISZ TEMP3 LDA DM128 SET STA TEMP3,I OFFSET ISZ TEMP3 CLA CLEAR THE STA TEMP3,I EXTENT #. ISZ TEMP3 LDA D.5 SAVE CURRENT SECTOR. AND B377 STA TEMP3,I INB ôNÿÿþú STA B,I SAVE BEGINNING SECTOR. ADB D4 LDA BUF23+8 SET BATCH CHECK FLAG RAL,ELA IN E LDA PARM1 SETUP FOR SPOUT? SEZ IF NOT BATCH IN CHECK USE ZERO SZA ALSO FOR SPOUT CLA,RSS BATCH CHECKING DOESN'T APPLY. LDA PARM3 PUT BATCH CHECKING INFO. STA B,I INTO EQT29. INB LDA D.5 ALF,ALF AND B377 STA B,I SAVE # SECTORS TRACK. INB CLA INITIALIZE RECORD COUNT. STA B,I INB STA B,I INITIALIZE CLASS PARAMETER INB WORDS. STA B,I JSB $LIBX DEF *+1 DEF SS2 * IS43A BSS 1 DVS43 ENTRY POINT SAVE. DM128 DEC -128 D6 DEC 6 D63 DEC 63 D8 DEC 8 D.1 NOP D.2 NOP D.3 NOP D.4 NOP D.5 NOP PTR22 DEF BUF22 PTR24 DEF BUF24 RECRD NOP DMASK OCT 630 "H" OCT 110 * SS2 LDA PARM1 IF SET UP IS FOR SPOUT CPA D11 SKIP JMP SS4 SKIP THE EOF WRITE * LDA BUF23+8 IF A WRITE ONLY ALF,ALF ACCESS SLA,RSS JMP SS5 NOT WRIT ONLY * LDA BUF23+1 GET THE LU IOR B100 SET UP A EOF REQUEST STA TEMP6 ADA B100 AND A BACKSPACE RECORD STA TEMP5 REQUEST JSB EXEC DO EOF DEF *+3 DEF D3 DEF TEMP6 JSB EXEC NOW BACKSPACE DEF *+3 DEF D3 DEF TEMP5 * SS5 LDA BUF23+8 FIX THE STD. FLAG CMA AS REQUIRED AND D16 ISOLATE THE BIT XOR CLSPT,I CLEAR IT IF NEED BE LDB CLSPT JSB PUT SET THE WORD BACK IN EQT11 SS4 LDA PTR23 LDB RECNO JSB WTREC * * THE FOLLOWING QUEUES A FILE FOR OUTSPOOLING. * QUEUE LDA PTR23 WRITE CONTROL RECORD (SST #4341) LDB RECNO JSB WTREC LDA BUF23+15 IS THIS FILE TO SZA,RSS OUTSPOOLED? JMP SE‰þúT10 NO. * LDB PARM1 IS THIS A SETUP FOR CPB D11 SPOUT? (SPSEL) JMP SPS5 YES. * * ENTER HERE FROM CSAP OR PASS. * AND B77 STA TEMP6 SAVE OUTSPOOL LU #. LDA BUF23+9 SAVE SPOOL PRIORITY. STA TEMP5 JSB SMENU GET SET TO PASS THIS JMP QUE1 SPOOL FOR OUTSPOOLING. * INB SAVE THE ADDRESS OF THE COUNT WORD STB SMENU FOR LATER LDB BUF23+8 CHECK IF THERE IS RBR,SLB A HOLD ON THIS FILE. JMP SET10 YES. * LDB BUF23+10 MUST ALSO BE IN "W" STATUS CPB "W" WELL RSS YES CONTINUE JMP SET10 NO DO NOT QUEUE * JSB RDLUQ GET THE LU QUEUE TO CORE JSB .DRCT SETTING UP HERE TO SEARCH DEF BUF21+3 THE QUEUE AND FIND OUT STA TEMP4 WHERE THE NEW ENTRY ADA M1 SET A FOR SCAN SET2 LDB A,I CAN BE PUT. INA STEP TO PRIORITY SZB,RSS END OF QUEUE? JMP SET1 YES. * LDB A,I GET PRIORITY CMB,INB WE HAVE A PRIORITY. ADB TEMP5 COMPARE WITH PRIORITY SSB OF NEW ENTRY. JMP SET1 NEW ENTRY IS LESS. * INA KEEP LOOKING FOR A JMP SET2 SPOT TO PUT NEW ENTRY. * SET1 ADA M1 HAVE A PLACE. STA TEMP3 SAVE A POINTER. LDA BUF21+1 FIND THE END OF ALS THE LIST. THE LIST FROM ADA TEMP4 POINT OF NEW ENTRY INA WILL BE SHIFTED TO MAKE SET4 STA TEMP6 ROOM FOR NEW ENTRY. ADA M2 SET UP SHIFT POINTERS. STA TEMP4 DLD TEMP4,I DO A SHIFT ON A DST TEMP6,I TWO-WORD ENTRY. LDA TEMP4 DECREMENT POINTERS. CPA TEMP3 JUST MOVED LAST ONE? RSS YES SKIP JMP SET4 NO - BACK THROUGH LOOP. * LDA RECNO PUT THE NEW ENTRY LDB TEMP5 IN THE VACATED SPACE. ×&þú DST TEMP4,I ISZ BUF21+1 INCREMENT THE ENTRY COUNT. JSB WRLUQ WRITE OUT THE LU QUEUE LDA SMENU,I UPDATE THE MENU. ELA SAVE THE SIGN BIT LDA BUF21+1 GET THE NEW COUNT RAL,ERA SET SIGN IF NEEDED STA SMENU,I RESET THE COUNT SET10 LDA PARM1 SETUP PROCESSING? SZA IF NOT, BYPASS BIT SETTING. JMP MENU * LDA PTR22 READ AVAILABILITY BITS. LDB D2 JSB RDREC NOP *********************************************** LDB BPAT RESET AVAILABILITY BITS. STB ADDR1,I LDA PTR22 WRITE OUT AVAILABILITY RECORD. LDB D2 JSB WTREC LDB TEMP2 LDA B,I FIX UP $LUAV. CCE MAKE THE LU UNAVAILABLE. ELA,RAR JSB PUT INB LDA RECNO JSB PUT * MENU LDA SHUTD IS THERE A SHUT DOWN SZA IN EFFECT? JMP RETRN * LDA SSTAT IS SPOUT ALREADY WORKING CPA D1 ON A MENU? JMP SRSEX YES - RETURN. * LDA PARM1 JSB FINDL IS THERE AN AVAILABLE LU JMP SRSEX FOR SPOUT? * STA RESLU MENU1 LDA PTR25 MAKE UP A NEW MENU TO SEND STA TEMP3 TO SPOUT. PUT ONLY LU'S CLB SET TO CLEAR THE BUFFER STB A,I SET SEED LDB A INB JSB .MVW MAKE IT GROW DEF D15 NOP LDA MPTR IN THE MENU THAT ARE NOT STA TEMP4 IN USE AND ALSO HAVE A QUEUE MENU2 LDB TEMP4,I OF FILES TO BE OUTSPOOLED. STB TEMP3,I SZB,RSS END OF .MENU? JMP MENU3 YES. * ISZ TEMP4 NO - GO AHEAD AND CHECK IF LDB TEMP4,I IF THE LU IS IN USE BY ISZ TEMP4 SPOUT. SSB JMP MENU2 SPOUT IS ALREADY USING THE LU. * SZB IS ANYTHING ON THIS QUEUE. ISZ TEMP3 YES - SAVE THE ENTRY JUST MADE. JMP MENU2 * MENU3 LDA BUF25 ¦þú SZA,RSS IS THERE ANYTHING TO SEND SPOUT? JMP SRSEX NO. * CLB,INB SET STATUS TO SHOW STB SSTAT SPOUT WORKING ON MENU LDA D2 SEND CLASS REQUEST STA TEMP5 TO SPOUT WITH A MENU. CLA,CCE STA TEMP6 LDA RESLU RESERVE THE LU ELA,RAR FOR SPOUT LDB TEMP2 JSB PUT MENU4 JSB CLSPT JMP MENU GIVE SPOUT ALL IT CAN TAKE. * CLSPT NOP JSB EXEC DEF *+8 DEF D20 WRITE-READ REQUEST DEF ZERO LU #. PTR25 DEF BUF25 MENU BUFFER. DEF D12 DEF TEMP5 CLASS PARAMETER 1. DEF TEMP6 CLASS PARAMETER 2. DEF SP.CL CLASS ID. JMP CLSPT,I * * D1 DEC 1 D11 DEC 11 M21 DEC -21 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP4 BSS 1 TEMP5 BSS 1 TEMP6 BSS 1 MPTR DEF .MENU SHUTD NOP RESLU NOP SSTAT NOP * NTRDY CLA,RSS ERM16 LDA M16 ERMES STA TEMP1 JMP MENU * QUE1 CCA OUTSPOOL LU NOT LEGAL. STA BUF23 LDA PTR23 LDB RECNO JSB WTREC ERM21 LDA M21 JMP ERMES * ERM22 LDA M22 JMP ERMES * RETRN LDA MPTR THEN DO A COMPLETE RETN3 LDB A,I TERMINATION SO AS TO SZB,RSS ALLOW ACCESS TO THE JMP RETN2 SPLCON FILE FOR A * INA USER PACK, ETC. LDB A,I IF SPOUT IS NOT ACTIVE SSB AND THERE IS A SHUTDOWN JMP SRSEX IN EFFECT. * INA JMP RETN3 * RETN2 CLA,RSS OK TO SHUT DOWN SRSEX CLA,INA SAVE RESOURCES SHUT DOWN STA EXIT,I SAVE FOR EXIT * JSB POST MAKE SURE SPLCON BUFFERS DEF *+2 ARE POSTED. DEF DCB1 JSB UNLOK CLEAR SPLCON RN #. DEF SRN RETN4 JSB PRTN PASS BACK PARAMETERS DEF *+2 TO THE CALLER. DEF TEMP1 CCB SET B AS INDICATOR JSB EXEC COMPLETION RETURN. DEF „8þú*+4 DEF D6 DEF ZERO INDICATE CALLER. EXIT DEF WRLUQ SAVE RESOURCES TERMINATION. SSB IF TIME ENTRY JMP TRYAG GO TRY THE MENU AGAIN * JSB RMPAR THIS ENABLES US TO SAVE DEF *+2 INDICATORS AND KEEP SPLCON DEF PARM1 OPEN ALL THE TIME. JMP SMP1 * LULOK CLB SPOUT HAS LU LOCK CONDITION. STB SSTAT JSB SPS RELEASE THE RESERVED LU SWP JSB PUT JSB EXEC SCHEDULE SMP WITH OFFSET DEF *+6 AND CHECK THE HOW WE GOT TO THIS DEF D12 POINT OF SUSPENSION WHEN WE DEF SMPNA ARRIVE. IF ORDINARY SCHEDULE DEF D2 DEF ZERO DEF M8 REQUEST, PROCESS NORMALLY. JMP SRSEX GO EXIT * RDLUQ NOP ROUTINE TO READ THE LU QUEUE LDA PTR21 SET UP TO READ 8 RECORDS. LDB M8 THIS IS ONE LU QUEUE. STB TEMP3 LDB LUREC READ THE APPROPRIATE SET6 JSB RDREC BLOCK. JMP ERMES READ ERROR. * LDB RECRD CLB SET FOR AUTO REC. INCREMENT LDA BUFSP FOR NEXT RECORD. ADA D16 ISZ TEMP3 FINISHED READING BLOCK? JMP SET6 * JMP RDLUQ,I YES RETURN * LUREC NOP M8 DEC -8 * WRLUQ NOP WRITE OUT THE LU Q LDA PTR21 SET UP TO WRITE LDB M8 OUT THE LU QUEUE. STB TEMP3 8 - 16 WORD RECORDS. LDB LUREC SET7 JSB WTREC WRITE A 16 WORD RECORD. LDA BFSP1 UPDATE BUFFER POINTER ADA D16 TO NEXT RECORD. CLB ISZ TEMP3 JMP SET7 * JMP WRLUQ,I DONE SO EXIT * * TRYAG JSB LOCK DEF SRN JMP MENU GO TRY THE MENU * UNLOK NOP LDA UNLOK,I STA RESNO ISZ UNLOK JSB RNRQ DEF *+4 DEF D4 RESNO BSS 1 DEF IERR JMP UNLOK,I * LOCK NOP LDA LOCK,I STA RESNU ISZ LOCK JSB RN=¾þúRQ DEF *+4 DEF D1 RESNU BSS 1 DEF IERR JMP LOCK,I * * BITFX NOP STB A AND D15 CMA STA FEQT CLA,INA ISZ FEQT JMP *+4 * BRS,BRS BRS,BRS JMP BITFX,I * RAL JMP *-6 * * * SUBROUTINE TO FIND EQT ADDRESS CORRESPONDING * TO A GIVEN LU #. * FEQT NOP CCA,CCE FIND ADDRESS OF EQT CORRESPONDING ADA DRT TO THE AVAILABLE LU #. ADA BUF23+1 LDA A,I AND B77 GET EQT NUMBER AND INDEX ADA M1 TO THE PROPER ENTRY. MPY D15 ADA EQTA STA B ADA D12 SET EXTENSION LDA A,I ADDRESS IN A JMP FEQT,I * FINDL NOP FIND AVAILABLE LU. LDA LUAVA STA TEMP2 LDA TEMP2,I STA FEQT FIND1 ISZ TEMP2 LDA TEMP2,I SSA,RSS JMP FIND2 * ISZ TEMP2 ISZ FEQT JMP FIND1 * RSS FIND2 ISZ FINDL JMP FINDL,I * SPS NOP LDA LUAVA GET ADDRESS OF $LUAV. SPS0 INA STEP TO FIRST ENTRY LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER SSB IF BUSY, LDB A,I GET THE RECORD NUMBER SZB IF ZERO THEN THIS IS IT JMP SPS0 ELSE TRY NEXT ONE * STA TEMP2 SAVE THE RECORD NO. ADDRESS ADA M1 AND THE LU ADDRESS LDB A,I GET THE LU RBL,CLE,ERB CLEAR THE BUSY BIT STB RESLU AND SAVE THE LU JMP SPS,I * SPSEL CLA CLEAR WORK STA SSTAT IN PROGRESS FLAG LDA PARM2 GET THE LU AND SET IN CASE WE NEED TO STA BUF23+15 CALL OFF SPOUT JSB SPS SEARCH $LUAV FOR A RESERVED LU. JSB SMENU GET THE MENU ENTRY JMP KILL3 CAN'T FIND?? SHOULD NEVER HAPPEN * INB STB TEMP6 SAVE THE POINTER LDB A RECORD NUMBER TO B LDA PTR24 þú READ THE TOP OF THE JSB RDREC LU QUEUE AND PICK NOP ******************************************* CLA SET THE Q ENTRY PRIORITY TO STA BUF24+3 TO ZERO TO INDICATE LDA PTR24 IT AS ACTIVE (PREVENTS LDB LUREC INSERTS AHEAD OF IT) JSB WTREC WRITE IT BACK OUT LDB BUF24+2 UP THE FIRST ENTRY. STB RECNO SAVE SPLCON RECORD # OF FILE. LDA PTR23 READ SPLCON RECORD. JSB RDREC NOP ********************************************** LDA RECNO SET THE RECORD NUMBER LDB TEMP2 IN THE LUAV TABLE JSB PUT LDA RESLU AND THE LU STA BUF23+1 IN THE RECORD JSB OPNSP TRY TO OPEN THE FILE. SSA JMP KILL3 YES - KILL THE SPOOL. * LDB "A" SET FILE TO ACTIVE - STB BUF23+10 IT WILL BE OUTSPOOLED. JMP SSEQT GO SET UP EQT ENTRY. * * SPS5 CLA,CCE,INA COME HERE AFTER SETTING STA TEMP5 UP SPOOL EQT. LDA TEMP6,I GET POSITION OF LU IN ELA,RAR MENU AND MARK IT TO STA TEMP6,I SHOW THAT SPOUT IS SPS7 LDB BUF23+8 IS BUSY WITH THAT LU. CCE POTENTIAL OVERLAP PROBLEM? RBR,SLB IF SO, SET SIGN BIT IN CME CLASS PARAMETER TO BE PASSED LDA BUF23+15 TO SPOUT. ELA,RAR STA TEMP6 RBR,CLE,RBR RBR,SLB CCE LDA BUF24 GET # QUEUED LINES. AND C377 ISOLATE IOR RESLU INDICATE LU AND FILE TYPE. ELA,RAR STA BUF25 JMP MENU4 * * SMENU NOP LDA BUF23+15 IF NO LU AND B77 SZA,RSS THEN JMP SM2 JUST EXIT * STA FINDL SAVE THE REQUESTED LU LDB MPTR SEARCH MENU FOR DEQ4 LDA B,I OUTSPOOL LU. CPA FINDL THIS IT?? JMP SM1 YES GO EXIT FOUND * SZA,RSS IF END OF TABLE JMP SMENU,I TAKE NYþúOT FOUND EXIT * ADB D2 JMP DEQ4 * SM1 LDA MPTR COMPUTE THE LU QUEUE CMA,INA RECORD NUMBER ADA B FOR THIS LU ALS,ALS ADA D9 STA LUREC AND SAVE IT FOR RDLUQ SM2 ISZ SMENU STEP TO FOUND EXIT JMP SMENU,I AND RETURN * D9 DEC 9 P21.2 DEF BUF21+2 * DEQUX LDA PARM3 IF NO ERROR CMA,INA,SZA,RSS JUST D Q JMP DEQUE * JSB MSFIX FIX UP THE MESSAGE ASC 3,EOF ER STRING FOR MESSAGE DEC 13 * DEQUE JSB PRGEX RELEASE THE SPLCON RECORD JSB DQ DEQUE THE FILE JMP NTRDY EXIT * DQ NOP DEQUE SUBROUTINE ENTER WITH E=0 IF JSB SMENU FIND THE LU FOR THIS FILE JMP ERM21 DIDN'T FIND - ERROR. * INB SAVE THE ADDRESS FOR UPDATE STB PRGEX JSB RDLUQ GET THE LU QUEUE TO CORE LDA PTR21 DEQ11 ADA D2 FIND THE POSITION IN LDB A,I THE QUEUE. CPB RECNO JMP DEQ10 FOUND IT * CPA LIM END OF QUEUE? JMP DQ,I YES - LEAVE. * JMP DEQ11 KEEP LOOKING * DEQ10 LDB PRGEX,I GET THE # OF ENTRIES FLAG ADB M1 DECREMENT IT CPA P21.2 IF FIRST ENTRY RBL,CLE,ERB CLEAR THE BUSY FLAG STB PRGEX,I SET IT BACK DEQ12 STA TEMP2 HAVE IT. ADA D2 STA TEMP3 CMA,INA ADA PTR21 ADA D127 SSA END OF BLOCK? JMP DEQ13 YES. * DLD TEMP3,I NO - MOVE UP NEXT ENTRY. DST TEMP2,I LDA TEMP3 JMP DEQ12 * DEQ13 CLA CLB DST TEMP2,I CCA ADA BUF21+1 DECREASE # OF ENTRIES. STA BUF21+1 JSB WRLUQ WRITE OUT THE LU QUEUE JMP DQ,I ELEMENT DEQUED SO EXIT * * CLRAV NOP CLEAR THE LUAVA ENTRY USING RECNO LDB LUAVA FIND THE SPOOL LU LDA B,I SET THE COUNT STA PUT INCASE NOT FOUND c¾þúDEQ16 ADB D2 INDEX TO THE NEXT RECORD ENTRY LDA B,I CPA RECNO THIS THE ONE?? JMP DEQ15 YES GO DO IT * ISZ PUT MORE?? JMP DEQ16 YES TRY NEXT ONE * CCE INDICATE NOT FOUND JMP CLRAV,I RETURN * DEQ15 JSB FRELU FREE THE LU JMP CLRAV,I RETURN * * FRELU NOP FREE LU AND ITS EQT IF ONE CLA CLEAR THE RECORD # SLOT JSB PUT IN THE LUAV ADB M1 BACK TO THE LU NUMBER LDA B,I GET THE NUMBER RAL,CLE,ERA CLEAR THE SIGN STA BUF23+1 SET FOR POSSIBLE FURTURE USE JSB PUT RESET WORD SEZ,CME,RSS IF NOT BUSY OR NOT FOUND JMP FRELU,I EXIT WITH E = 1 * JSB FEQT GET THE EQT ADDRESS STA B SET TO ADB D11 CLEAR EQT27 TO STOP LDA B,I SAVE IT FOR CLOSE STA D.2 FIRST CLA,CLE ANY ACCESSES JSB PUT DO IT JSB UNLOK CLEAR THE HOLD RN DEF WRN CLE CLEAR E TO INDICATE FOUND JMP FRELU,I RETURN * RELSE LDA PTR23 LDB PARM2 STB RECNO JSB RDREC NOP ********************************************** LDA BUF23+1 NEED TO SAVE IN CASE STA PARM2 OF RESTART. LDB PARM4 LOOK AT REL/RES FLAG. LDA PARM5 CPA "AH" ACTIVE FILE? JMP RELS1 YES. * SSB RELEASE? JMP QUEUE YES - REQUEUE. * SZB POSSIBLE LU CHANGE. STB BUF23+15 SAVE NEW LU. JMP QUEUE * RELS1 SSB,RSS A RELEASE? JMP RELS2 NO MUST RESTART. * JSB FEQT ADB D10 CLE SET TO CLEAR THE BIT LDA HMASK SET THE BIT TO BE CLEARED JSB PUTM GO CLEAR IT LDA BUF23+1 STA RESLU JSB SMENU (SST #4197) JMP KILL3 ERROR * INB STB TEMP6 SAVE FOR NOW ¿Aþú LDB A LU QUEUE RECORD # LDA PTR24 JSB RDREC READ LU QUEUE RECORD NOP ************************************* * LDA PARM3 STA PARM2 CLA,INA STA TEMP5 JMP SPS7 * RELS2 JSB SPTUN JSB FLU FIND THE LU RSS IF NONE SKIP JSB FRELU FREE IT DEQ18 JSB DQ DEQUE THE FILE LDA PTR23 RELEASING AN ACTIVE LDB RECNO FILE AND RESTARTING IT - JSB RDREC MUST QUEUE IT UP. NOP ********************************************** LDA PARM4 NEW LU? SZA WELL?? STA BUF23+15 YES - SAVE IT. LDA PTR21 READ IN 1ST RECORD CLB,INB FOR QUEUE. JSB RDREC NOP ********************************************** JMP QUEUE * LIM DEF LIMIT "AH" ASC 1,AH D127 DEC 127 D15 DEC 15 * KILL LDB PARM2 STB RECNO SAVE SPLCON RECORD #. LDA PTR23 READ THE SPLCON RECORD JSB RDREC FOR THIS FILE. NOP *********************************************** LDA PARM5 IS THIS AN ACTIVE CPA "A" FILE (BEING OUTSPOOLED)? RSS YES TREAT AS IF ACTIVE HOLD * CPA "AH" ACTIVE HOLD? KILL3 JSB SPTUN YES. * JMP DEQUE GO DO IT. * B100 OCT 100 * PUTM NOP ROUTINE TO SET OR CLEAR BIT SET IN A JSB $LIBR AND ADDRESSED BY 'B' 'E'=1 TO SET NOP 'E'=0 TO CLEAR THE BIT STA FEQT SAVE THE BIT(S) IOR B,I SET THE BIT IN ANY CASE SEZ,RSS IF CLEAR REQUEST XOR FEQT CLEAR THE BIT STA B,I RESET AND JSB $LIBX DEF PUTM EXIT * * SPTUN NOP JSB FEQT SET HOLD BIT TO STOP SPOUT ADB D10 LDA HMASK HOLD BIT TO EQT11 JSB PUTM GO SET IT CLA MAKE SURE AND CALL STA BUF25 SPOUT SO THAT IT ˆäþú LDA D3 WILL UNLOCK THE LU STA TEMP5 BEING USED TO LDA BUF23+15 DUMP THIS FILE AND B77 STA TEMP6 JSB CLSPT JMP SPTUN,I * "D" OCT 104 * SHUT LDA "D" STA SHUTD JMP RETRN * STUP CLA STA SHUTD JSB UNLOK RELEASE JOB HOLD JUST IN CASE DEF WRN JMP MENU * DVCDN JSB MSFIX DEVICE WENT DOWN WHILE ASC 3,DOWN OUT SPOOLING D16 DEC 16 LENGTH OF MESSAGE (WORDS) JMP HOLD1 GO HOLD THE FILE * HOLD LDB PARM2 PICK UP AND SAVE RECORD STB RECNO NUMBER OF FILE IN SPLCON. LDA PTR23 READ IN APPROPRIATE FILE JSB RDREC RECORD IN SPLCON. NOP *********************************************** LDA PARM5 HOLDING AN ACTIVE FILE? CPA "A" JMP HOLD1 * JSB DQ NO - DEQUEUE THE FILE. JMP NTRDY AND EXIT * HOLD1 JSB FEQT SET A BIT IN SPOOL EQT ADB D10 FOR SMD. LDA HMASK JSB PUTM GO SET THE HOLD BIT LDA "AH" SET HOLD FLAG STA BUF23+10 LDA PTR23 WRITE THE RECORD LDB RECNO JSB WTREC JMP NTRDY * D10 DEC 10 HMASK OCT 10000 * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * OPNSP NOP LDA BUF23+2 SET SIGN BIT ON 1ST CCE WORD OF FILE NAME. ELA,RAR STA TEMP4 SAVE IT. JSB EXEC TRY TO OPEN THE FILE. DEF *+8 DEF D23 SCHEDULE WITH WAIT. DEF D.RTR D.RTR. DEF ID ID SEGMENT ADDRESS. DEF TEMP4 NAME(1). DEF BUF23+3 NAME(2). DEF BUF23+4 NAME(3). DEF BUF23+6 CARTRIDGE ID. JSB RMPAR DEF *+2 GET PARAMETERS BACK DD.1 DEF D.1 FROM D.RTR. LDA D.1 SUCCESSFUL OPEN? JMP OPNSP,I * PRGEX NOP LDA PTR22 LDB D2 READ SPLCON AVAILABILIdþúTY BITS. JSB RDREC NOP ************************************************ LDB BUF21+3 GET SPLCON RECORD # CMB,INB RELATIVE TO THE BEGINNING ADB RECNO OF THE FILE DESCRIPTOR JSB BITFX RECORDS. ADB PTR22 STA BITFX IOR B,I CLEAR THE BIT. XOR BITFX STA B,I LDA PTR22 LDB D2 JSB WTREC WRITE AVAILABILITY RECORD. CCA STA BUF23 LDA PTR23 LDB RECNO JSB WTREC WRITE FILE DESCRIPTOR RECORD. JSB CLRAV CLEAR ANY LU ASSOCIATED WITH THIS FILE SEZ WAS THERE A CURRENT ONE? JMP PRNLU NO, MUST OPEN TO CLOSE * JSB FEQT YES LU WAS SET FOR FEQT ADA D10 GET ADDRESS OF FILE PRAMS PRPU LDB A,I GET THE FILE SIZE CMB,INB SET NEGATIVE FOR PURGE ADA D2 STEP TO THE DIR. ADDRESS WORD STA TEMP4 LDA BUF23+8 GET THE OPTION WORD SLA IF SAVE IN EFFECT CLB CHANGE TO SIMPLE CLOSE AND D8 ISOLATE SPOOL POOL FILE BIT SZA IF POOL FILE LDB A CHANGE TO PURGE EXTENTS STB WTREC SET THE PRAMETER JSB EXEC SCHEDULE D.RTR DEF *+8 DEF D23 WITH WAIT TO DEF D.RTR CLOSE A FILE DEF 1717B AND PURGE EXTENTS. DEF WTREC DEF D.2 DEF TEMP4,I DEF ZERO PRNFL LDA BUF23+8 GET SPOOL POOL FLAG AND D8 CPA D8 IF SPOOL POOL JMP PRG0 GO SET UP * JMP PREX ELSE JUST RETURN * PRNLU JSB OPNSP OPEN THE FILE SO CAN PURGE SSA WAS IT FOUND?? JMP PRNFL NO * LDA DD.1 YES SET THE ADDRESSES JMP PRPU AND GO PURGE THE FILE * PRG0 JSB POST MUST ACCESS JOB FILE DEF *+2 DDCB DEF DCB1 LDA PTRJF SET UP THE JOB FILE LDB DDCB JSB .MVW DEF D16 BY MOVINHRNLHG IN THE DCB NOP JSB LOCK DEF JRN LDA PTR24 READ IN SPOOL POOL FILE LDB D17 AVAILABILITY BITS. JSB RDREC NOP ********************************************* LDA BUF23+4 CONVERT POOL FILE # AND D15 STA TEMP4 LDA BUF23+4 ALF,ALF AND D15 MPY D10 ADA TEMP4 CCB SET NUMBER LESS 1 ADB A IN B JSB BITFX FIND AVAILABILITY BIT. STB TEMP4 SET OFFSET ADDRESS ADB PTR24 ADB D4 CMA MAKE AN ANDING MASK STA TEMP5 AND SAVE IT IN CASE A JOB AND B,I CLEAR THE BIT AND STORE. STA B,I LDA PTR24 WRITE OUT JOBFIL RECORD 17. LDB D17 JSB WTREC SPOOL FILE IS RETURNED TO POOL LDA PTR25 LDB BUF23+11 IF SPOOL NOT CONNECTED SZB,RSS WITH A JOB, FORGET THIS STUFF. JMP DEQ7 * JSB RDREC ELSE READ IN THE JOB RECORD NOP *************************************** LDB P2511 GET ADDRESS OF POOL BITS STB TEMP6 SAVE FOR RELEASE CHECK ADB TEMP4 INDEX INTO AND LDA TEMP5 CLEAR AND B,I THE FREEDED BIT STA B,I FIX OWNED SPOOL BITS OF THE JOB. LDA BUF25+2 GET THE JOB STATUS ðNÿÿþú CPA "CS" IF NOT CS RSS THEN JMP DEQ6 DO NOT CLEAR THE ENTRY * LDB M5 CHECK IF ALL OWNED FILES ARE CLOSED? DEQ8 LDA TEMP6,I SZA ANY HERE? JMP DEQ6 YES DO NOT FREE THE RECORD * ISZ TEMP6 STEP THE COUNT INB,SZB ALL TESTED? JMP DEQ8 NO TRY NEXT ONE * CCA ALL OWNED SPOOLS ARE CLEAR. STA BUF25 DEALLOCATE THE RECORD. DEQ6 LDA PTR25 LDB BUF23+11 WRITE OUT THE RECORD. JSB WTREC DEQ7 JSB POST DEF *+2 PDCB DEF DCB1 JSB UNLOK DEF JRN JSB UNLOK DEF WRN LDA PTRSF RESET UP THE SPOLCON FILE LDB PDCB JSB .MVW DEF D16 NOP PREX JSB CLRAV CLEAR ANY ADDITIONAL SEZ,RSS LU'S ASSIGNED TO THIS JMP PREX FILE * JMP PRGEX,I EXIT TO CALLER * JRN NOP SRN NOP WRN NOP D17 DEC 17 M5 DEC -5 P2511 DEF BUF25+11 "CS" ASC 1,CS * WTREC NOP STA BFSP1 STB RECRD JSB WRITF DEF *+6 DEF DCB1 DEF IERR BFSP1 BSS 1 DEF D16 DEF RECRD JSB FILER REPORT FILE ERROR IF ANY JMP WTREC,I * RDREC NOP STA BUFSP STB RECRD JSB READF DEF *+7 DEF DCB1 DEF IERR BUFSP BSS 1 DEF D16 DEF FILER DUMMY PLACE HOLDER DEF RECRD SSA,RSS IF NO ERROR ISZ RDREC TAKE OK EXIT ELSE P+1 JSB FILER REPORT FILE ERROR IF ANY JMP RDREC,I * FILER NOP TEST FOR ERROR AND PRINT IF ONE CMA,SSA,INA SET NEGATIVE ERROR + JMP FILER,I IF NONE JUST EXIT * JSB CVTNO CONVERT THE NUMBER STA MESS SET IN THE MESSAGE JSB PRINT PRINT IT DEF SMPER DEF D6 JMP FILER,I RETURN TO CALLER * CVTNO NOP TWO DIGIT NUMBER CONVERTER CLB SET FOR DIVIDE DIV D10 °   A HAS HIGH DIGIT, B LOW ALF,ALF ROTATE TO HIGH ADA B PUT TOGETHER ADA "00" ADD THE ASCII OFFSETS JMP CVTNO,I RETURN NUMBER IN A * "00" ASC 1,00 * PRINT NOP PRINT TO LU 1 DLD PRINT,I GET THE BUFFER AND COUNT ADDRESSES DST BUFAD SET IN CALL ISZ PRINT ADVANCE THE RETURN ADDRESS ISZ PRINT ADVANCE THE RETURN ADDRESS JSB REIO SENT THE WORD TO THE SYSTEM TTY DEF RTN DEF D2 DEF D1 BUFAD NOP SET TO THE BUFFER ADDRESSES NOP ALSO SET RTN JMP PRINT,I EXIT BACK TO CALLER * MSFIX NOP FIX UP THE MESSAGE LDA BUF23+15 FIRST GET THE AND B77 JSB CVTNO LU AND CONVERT STA LUXX SET IN MESSAGE JSB .DFER NOW MOVE IN THE STRING DEF DNEOF DEF MSFIX,I RETURNS A POINTS TO NEXT SOURCE SO STA MSFIX SAVE AS LENGTH ADDRESS JSB .DFER MOVE IN THE DEF FILEN FILE DEF BUF23+2 NAME JSB PRINT NOW PRINT THE MESSAGE DEF SVERF DEF MSFIX,I POINT TO LENGTH ISZ MSFIX STEP TO RETURN ADDRESS JMP MSFIX,I AND RETURN * PTRSF DEF SPLFL PTRJF DEF JOBFL SMPER ASC 5,SMP: FMP -XX ERORR MESSAGE MESS NOP HOLDS XX FROM MESSAGE SVERF ASC 4,SMP: LU LU DOWN AND BAD EOF TEMPLATE LUXX ASC 2, LU PLUS 2 BLANKS DNEOF ASC 4,EOR ER OR DOWN PLUS 2 BLANKS FILEN ASC 6,XXXXXX HELD. SMPNA ASC 3,SMP .MENU DEC 1 SUP REP 19 DEC 1 DEC 0 D21 DEC 21 D23 DEC 23 SPOUT ASC 3,SPOUT D.RTR ASC 3,D.RTR IERR NOP DRT EQU 1652B EQTA EQU 1650B ZERO DEC 0 ID NOP * END SMP Êä ÿÿ ÿý "0 ÿ92067-18079 1805 S C0122 &4SPOT RTE-IV SPOUT             H0101 q˜þúASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE IV *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II IFN HED OUTSPOOL ROUTINE FOR RTE II XIF IFZ HED OUTSPOOL ROUTINE FOR RTE IV XIF * NAME: SPOUT * SOURCE: 92002-18009 (RTE II) 92067-18079 (RTE IV) * RELOC: 92002-16009 (RTE II) 92060-16011 (RTE III) * RELOC: 92067-16028 (RTE-IV)--SRC: 92067-18079 (RTE IV) * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM SPOUT,1,11 92002-16009 REV. 1740 770810 XIF IFZ NAM SPOUT,17,11 92067-16028 REV.1805 780309 XIF * * *** THE GREAT SPOOL OUT ROUTINE *** * * * *** SMP REQUESTS TO SPOUT *** * * (1) NEW MENU TO SEARCH * STAT1 = 2 * STAT2 = 0 * IOBUF CONTAINS MENU * * (2) UNLOCK LU AND SEARCH NEW MENU * STAT1 = 3 * STAT2 = LU TO UNLOCK * IOBUF CONTAINS MENU * * (3) START UP A NEW SPOOL * STAT1 = 1 * STAT2 = NEW STAT2 CLASS PARAMETER * IOBUF CONTAINS NEW STAT1 * * * *** FORM OF CLASS PARAMETERS *** * * STAT1 SIGN BIT SET = STANDARD FILE * SIGN BIT CLEAR = OUTSPOOL WITH HEADERS * BIT 12 SET = CAME FROM DVS43 * BITS 11-8 = LINE COUNT * BITS 5-0 = LU # TO READ * * STAT2 SIGN BIT SET = CHECK OVERLAP CONDITION * SIGN BIT CLEAR = NO OVERLAP CHECK NEEDED * BITS 11-6 = FUNCTION BITS FOR STANDARD FILE * BITS 5-0 = OUTSPOOL LU # * * STD. I/O REQUEST: * * OPT. PRAM #1 STAT1 * OPT. PRAM #2 SET UP COUNT WORD (FLCÌÐþúNT) * * EQT 32/33 * 32 STAT1 * 33 STAT2 * 29 FLCNT * EXT $LIBR TURN OFF INTERRUPTS EXT $LIBX TURN ON INTERRUPTS EXT LURQ LU LOCK/UNLOCK REQUEST EXT $LUAV LU AVAILABILITY TABLE EXT EXEC SYSTEM CALLS EXT SP.CL SPOOL CLASS ID EXT .DRCT * * IOBUF BSS 69 * ORG IOBUF * * SPX CLA STA SPOUT LDA SP.CL IOR DONT JSB $LIBR NOP STA SP.CL JSB $LIBX DEF *+1 DEF SPT2 * ORR * SPOUT JMP SPX * SPT2 JSB EXEC CLASS GET LOOP STARTS HERE. DEF *+8 FLOW OF CONTROL DIRECTED DEF D21 FROM THIS POINT. DEF SP.CL BUFAD DEF IOBUF DEF D69 DEF STAT1 DEF STAT2 DEF ICNWD LDB ICNWD WHAT TYPE ORIGINAL REQUEST? CPB D2 JMP WRREQ ORDINARY WRITE. * CPB D3 JMP SPT2 CONTROL - BACK THROUGH LOOP. * LDA STAT1 WRITE-READ. CPA D2 HAVE AN SMP REQUEST JMP MENU * CPA D1 JMP FILAT * JSB LURQ MUST UNLOCK LU OF FILE DEF *+4 WHICH SMP FAILED TO OPEN DEF B40K DEF STAT2 DEF D1 NOP IGNORE ERROR JMP SPT2 GET THE NEXT CHORE * MENU LDA BUFAD HAVE A MENU TO SEARCH. STA TEMP1 MENU5 LDA TEMP1,I GO THROUGH LU'S IN MENU SZA,RSS TRYING TO LOCK EACH ONE. JMP MENU4 * * JSB LURQ TRY TO LOCK. DEF *+4 DEF NOABT WITHOUT ABORT. DEF TEMP1,I DEF D1 JMP MENU6 ERROR JUST IGNORE THIS ONE SZA,RSS JMP MENU3 SUCCESSFUL LOCK. * SSA UNSUCCESSFUL. JMP MENU4 NO RN'S AVAILABLE. QUIT. * MENU6 ISZ TEMP1 LU ALREADY LOCKED. TRY JMP MENU5 SEARCHING MORE OF MENU. * MENU4 CLB CPB STAT2 JMP MENU2 * STB STAT2 JMP MENU * MExpþúNU2 CPB IOBUF NULL MENU? JMP SPT2 YES - BACK TO GET. * LDA D10 TELL SMP ABOUT THE LOCK PROBLEM JMP SMPC * MENU3 LDA D11 SUCCESS TELL SMP LDB TEMP1,I FIRST MOVE UP THE PRAM STB TEMP1 JMP SMPC * FILAT LDA IOBUF HAVE A SET OF FILE STA STAT1 ATTRIBUTES. AND B77 STA ICNWD START UP THE SPOOL. JSB GETEQ GET EQT ADDRESS OF ADB M2 STARTING NEW FILE. LDA FILNO INCREMENT AND SET CCE,INA,SZA,RSS ERA FILE COUNTER INTO EQT29. STA FLCNT STA FILNO JSB PUT STUFF THE EQT. ADB D3 STB LCNT SAVE EQT32 ADDRESS. JSB SLCNT STAT2 IN EQT32 AND EQT33. CCA SET FLAG IN STA GETEQ GETEQ TO INDICATE SET UP JMP WRR10 * WRREQ LDA STAT2 STA FLCNT LDA STAT1 NORMAL READ-WRITE LOOP AND B77 STARTS HERE. STA ICNWD JSB GETEQ GET ADDRESS OF EQT32. ADB M2 BACK UP AND GET LDA B,I THE SET UP COUNT CPA FLCNT IS IT GOOD? INB,RSS YES SKIP JMP SPT2 NO OLD NEWS IGNOR IT * ADB D2 SET B TO EQT32 ADDRESS STB LCNT SAVE EQT32 ADDRESS. INB LDA B,I PICK UP STAT2 FROM THE EQT AND STA STAT2 SAVE IT LDB STAT1 PICK UP STORED STAT1 VALUE. LDA LCNT,I AND SAVE VERSION BLF,SLB IF FROM EXTEND RSS SKIP THE INCREMENT ADA B400 ELSE STEP THE COUNTER STA STAT1 SET STAT1 FOR LOCAL USE AND B7400 ISOLATE THE COUNTER SZA,RSS IF COUNT IS ALREADY TO ZERO JMP SPT2 IGNOR THE EXTEND WAKE UP. * JSB SLCNT UPDATE THE EQT WRR10 LDA STAT2 NEED WE CHECK THE SSA,RSS OVERLAP CONDITION? JMP WRR6 NO NEED. * JSB .DRCT WE MUST CHECK OVERLAP DEF $LUAV CONDITIONS BEFOR;`þúE CONTINUING. LDB A,I STB TEMP1 INA STA TEMP2 SAVE ADDRESS OF TABLE. WRR LDB A,I SEARCH THE $LUAV TABLE INA FOR THE READ LU. BLR,BRS CPB ICNWD JMP WRR3 WE HAVE IT. * INA JMP WRR * B400 OCT 400 * WRR3 LDB A,I SAVE SPLCON RECORD # STB TEMP5 CORRESPONDING TO THIS LDA TEMP2 SPOOL LU. WILL FIND IF WRR5 INA WE HAVE A POTENTIAL OVERLAP LDB A,I CONDITION BY FINDING CPB TEMP5 ANOTHER ENTRY OF SAME JMP WRR4 RECORD #. * WRR7 INA ISZ TEMP1 JMP WRR5 * LDB STAT2 CLEAR OVERLAP CHECK BIT. BLR,BRS STB STAT2 WRR6 JSB EXEC READ THROUGH SMD. DEF *+5 DEF LOKOP WITH NO ABORT BIT SET. DEF ICNWD DEF IOBUF DEF D69 JMP SPT2 HOLD I.O. * ALF,ALF CHECK STATUS WORD. SSA JMP EOF END OF FILE. * STB TEMP2 SAVE THE TRANSMITTED LENGTH LDA STAT1 CCE,SSA,RSS WHAT TYPE OF FILE? CPB D1 FIRST REASONABLE NESS TEST ONE WORD JMP RSTAN STANDARD. * LDA IOBUF OUTSPOOL WITH HEADERS. XOR STAT2 FORM THE CON WORD AND B3700 XOR STAT2 UNDER THE RULES OF WOO STA TEMP5 SALT IT AWAY LDA IOBUF GET THE REQUEST CODE AND OKBIT (=B24077) ALL BUT LEAST 2 SHOULD BE 0 CCE,SZB FORCE ZERO LENGTH READS TO FAIL CPA D3 IF CONTROL JMP CNTST GO TRY IT * CPA D2 BETTER BE A WRITE RSS GOOD SHOW GO DO IT JMP RSTAN WRONGLY FLAGGED * LDA IOBUF+1 FIGURE FINAL LENGTH OF LINE CCE,SSA IF CHAR ARS CONVERT TO WORDS SSA CMA,INA ADA D2 SHOULD MATCH THE READ LENGTH IN B CPA B DOES IT?? JMP OK YES STILL OK * LDA D67 ÷9þú CPB D69 COULD BE TOO LONG A LINE IF SO JMP LONG USE IT * JMP RSTAN WRONGLY FLAGGED AS NON STANDARD FILE * OK LDA IOBUF+1 LONG STA TEMP2 SET THE LENGTH LDA TEMP5 SAVE THE CONFIGURED STAT WORD FOR EOF STA STAT2 LDB BUFR2 GET THE BUFFER ADDRESS JMP SEND1 * RSTAN LDA STAT1 REFLAG IT ELA,RAR SET THE STANDARD BIT STA STAT1 AND LDB BUFAD GET THE BUFFER ADDRESS LDA STAT2 AND THE CON WORD SEND1 ALR,ARS CLEAR THE SIGN BIT STA TEMP5 SET THE CON WORD STB BUFFR AND THE BUFFER ADDRESS * JSB DOWN? MAKE SURE NOT DOWN (NO RETN IF SO) JSB EXEC WRITE A LINE TO DEF *+8 A DEVICE. DEF D18 DEF TEMP5 BUFFR BSS 1 BUFFER ADDRESS DEF TEMP2 BUFFER LENGTH DEF STAT1 CLASS PARAMETER. DEF FLCNT CLASS PARAMETER. DEF SP.CL LDA STAT1 FIRST TIME THROUGH ADA C377 DECREASE COUNT OF LINES STA STAT1 SET IT BACK JSB SLCNT LDA STAT1 NEED TO DO ANOTHER AND B7400 ISZ GETEQ IF FIRST LINE WAIT FOR COME BACK SZA,RSS IF COUNT DOWN TO ZERO WAIT JMP SPT2 YES- BACK TO GET LOOP. * JMP WRR10 COUNT NOT ZERO AND NOT FIRST LINE * D67 DEC 67 C377 OCT 177400 OKBIT OCT 24077 B7400 OCT 7400 CNTST CPB D2 BETTER BE A TWO WORD RECORD RSS GOOD SHOW JMP RSTAN NO GOOD GO RETYPE IT * JSB DOWN? NO RETURN IF DOWN DEVICE JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF TEMP5 DEF IOBUF+1 DEF SP.CL JMP WRR10 * WRR4 ADA M1 LDB A,I FOUND A RECORD MATCH. BLR,BRS IS THIS THE SAME ENTRY INA CPB ICNWD WE PICKED UP BEFORE. JMP WRR7 YES. * LDA B GET THE LU TO A FOR GETEQ JSB GETEQ NO. CHEàDþúCK FURTHER. CCA GET CURRENT LINE COUNT ADA LCNT FROM THE READ EQT LDA A,I TO A CMA AND COMPARE ADA B,I WITH THE WRITE EQT SSA,RSS JMP WRR6 WE ARE OK. * INB SET UP WRITE EQT STB LCNT LDA STAT1 OVERLAP FAILED - SET EQT32 IOR DVCHK AND EQT33 IN LU OF FILE LDB FLCNT BEING WRITTEN SO THAT SMD STA STAT1 STB STAT2 JSB SLCNT WILL CALL US BACK WHEN IT JMP SPT2 HAS WRITTEN ANOTHER RECORD. * GETEQ NOP THIS ROUTINE FINDS US THE ADA M1 EQT ADDRESS CORRESPONDING ADA DRT TO A GIVEN LU #. LDA A,I AND B77 ADA M1 MPY D15 ADA EQTA ADA D12 LDB A,I ADB D15 JMP GETEQ,I * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * EOF STB GETEQ SAVE THE EOF STATUS FLAG LDB LCNT ADB M3 CLA JSB PUT CLEAR THE FLAG SO WILL NOT BELIEVE FURTHER GETS LDA STAT2 END OF FILE. AND B77 ISOLATE OUTSPOOL LU. STA TEMP1 AND SAVE IT. LDB GETEQ GET THE EOF FLAG LDA STAT2 AND THE LAST USED MODE AND B100 ISOLATE THE MODE BIT SZB IF GOOD EOF SZA OR BINARY FILE JMP EOF0 SKIP MESSAGE * JSB DOWN? DO THE DOWN CHECK JSB EXEC SEND THE BAD EOF MESSAGE DEF *+8 DEF D18 DEF TEMP1 DEF EOFER DEF D4 DEF STAT1 DEF STAT2 DEF SP.CL JMP EOF1 NOW SEND ALL POSSIBLE EOFS * EOF0 SSB IF BAD EOF JMP EOF1 SEND ALL POSSIBLE EOF'S FOR ALL FILES * LDA STAT1 SSA,RSS STANDARD FILE? JMP EOF2 NO - HAVE HEADERS.. * EOF1 LDA B100 JSB CNTRL SEND EOF LDA B1000 JSB CNTRL SEND LEADER REQUEST ™´þú LDA B1100 JSB CNTRL SEND TOP OF FORM REQUEST EOF2 JSB LURQ UNLOCK THE LU DEF *+4 OF THE OUTSPOOL DEF B40K JUST COMPLETED. DEF TEMP1 DEF D1 NOP IGNORE ERROR RETURN LDA STAT1 TELL SMP WE ARE GOOD AND B77 AND FINISHED WITH THIS FILE. STA TEMP1 LDA D12 SEND DEQUE TO SMP SMPC STA SLCNT SET CALL CODE JSB EXEC DEF *+6 DEF D24 DEF SMP DEF SLCNT RQ PRAM DEF TEMP1 CURRENT LU DEF GETEQ EOF STATUS JMP SPT2 * SLCNT NOP JSB $LIBR NOP LDA STAT1 LDB STAT2 DST LCNT,I LCNT EQU *-1 JSB $LIBX DEF SLCNT * CNTRL NOP IOR TEMP1 PICK UP STA ICNWD AND SET THE CON WORD JSB DOWN? CHECK IF DOWN JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF ICNWD DEF M1 DEF SP.CL JMP CNTRL,I * DOWN? NOP TEST FOR DOWN DEVICE CCA ADA STAT2 THAN THE LU AND B77 ISOLATE ADA DRT INDEX INTO THE DRT STA B SAVE FOR LU TEST CCA SET TO GET THE EQT JSB $LIBR GO PRIV TO STOP RACES NOP ADA B,I EQT NO-1 AND B77 ISOLATE THE EQ NO. CPA B77 IF NO EQT THEN JMP DWNEX GO SENT THE LINE * ADB LUMAX INDEX TO LU FLAG LDB B,I IF SIGN SET THEN DOWN SSB ELSE UP JMP DOWN * MPY D15 GET EQT ADDRESS ADA EQTA ADA D4 TO A LDA A,I GET THE WORD RAL,SLA IF DOWN JMP DWNEX NOT DOWN EXIT * SSA,RSS SKIP JMP DWNEX ELSE GO EXIT * DOWN JSB $LIBX DEVICE IS DOWN DEF *+1 DEF *+1 LDA ICNWD SET UP TO CALL SMP AND STA TEMP1 IOR B200 BACK SPACE ON RECORD STA TEMP2 âò0.* JSB EXEC BACK SPACE IN FILE DEF *+3 DEF D3 DEF TEMP2 LDA D18 JMP SMPC GO NOTIFY SMP TO PUT IN HOLD * DWNEX JSB $LIBX UP SO DEF DOWN? GO DO THE CALL * * STORAGE * D4 DEC 4 B200 OCT 200 A EQU 0 B EQU 1 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B SMP ASC 3,SMP EOFER ASC 4, BAD EOF TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP5 BSS 1 FILNO OCT 100000 FLCNT BSS 1 STAT1 BSS 1 STAT2 BSS 1 LOKOP OCT 100001 NOABT OCT 140001 ICNWD BSS 1 BUFR2 DEF IOBUF+2 B40K OCT 40000 D1 DEC 1 D2 DEC 2 D3 DEC 3 D10 DEC 10 D11 DEC 11 D12 DEC 12 D15 DEC 15 D18 DEC 18 D19 DEC 19 D21 DEC 21 D24 DEC 24 D69 DEC 69 M1 DEC -1 M2 DEC -2 M3 DEC -3 B77 OCT 77 B100 OCT 100 B1000 OCT 1000 B1100 OCT 1100 B3700 OCT 3700 DVCHK OCT 10000 DONT OCT 20000 * END SPOUT 0ÿÿ ÿý  ÿ92067-18080 1840 S 0122 RTE-IV IXGET              H0101 Ù ASMB,R,Q,C HED IXGET * NAME: IXGET * SOURCE: 92067-18080 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXGET,7 92067-16035 REV.1840 780731 ENT IXGET * * * CALLING SEQUENCE: * *C GET IDATA FROM IADDR * IDATA=IXGET(IADDR) * * WHERE: IADDR = ADDRESS TO BE READ * IDATA = VALUE IN LOCATION "IADDR" * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * A EQU 0 B EQU 1 END ìÿÿ ÿý ÿ92067-18081 1840 S 0122 RTE-IV IXPUT              H0101 êASMB,R,Q,C HED IXPUT * NAME: IXPUT * SOURCE: 92067-18081 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXPUT,7 92067-16035 REV.1840 780731 ENT IXPUT EXT $LIBR,$LIBX * * * CALLING SEQUENCE: * * *C PUT IDATA INTO IADDR * CALL IXPUT(IADDR,IDATA) * * WHERE: IADDR = ADDRESS TO BE STUFFED * IDATA = VALUE TO BE PUT INTO "IADDR" * * * IXGET NOP IXPUT NOP JSB $LIBR NOP LDA IXPUT,I STA IXGET ISZ IXPUT DLD IXPUT,I LDA A,I LDB B,I XSB A,I JSB $LIBX DEF IXGET * * A EQU 0 B EQU 1 END ï…ÿÿ ÿý ÿ92067-18082 1840 S 0122 RTE-IV FTIME              H0101 ÞúþúASMB,R,Q,C HED TIME FORMAT SUBROUTINE * NAME: FTIME * SOURCE: 92067-18082 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FTIME,7 92067-16035 REV.1840 780731 ENT FTIME EXT EXEC * CALLING SEQUENCE: * *C GET THE TIME IN A 15 WORD STRING * DIMENSION IBUF(15) * CALL FTIME(IBUF) * SUP * * GET TIME AND BUILD HEADER MESSAGE * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 * * P1 NOP FTIME NOP DLD FTIME,I STA FTIME RSS INDCT LDB B,I TRACK DOWN INDIRECTS RBL,CLE,SLB,ERB JMP INDCT STB P1 * JSB EXEC DEF *+4 DEF O13 GET TIME DEF ITIME DEF IYEAR LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 YEARS LDB IDAY¼þú ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB DM15 SET WORD COUNT STB COUNT LDA TMSGA AND THE TIME ARRAY OLOOP LDB A,I MOVE IT STB P1,I INA ISZ P1 ISZ COUNT JMP OLOOP * JMP FTIME,I RETURN * * * PD00 NOP CONVERT TO 2 ASCII DIGITS CLB DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 DM15 DEC -15 COUNT BSS 1 O5 OCT 5 O7 OCT 7 D31 DEC 31 D100 DEC 100 D153 DEC 153 D366 DEC 366 * SPC 1 * ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * END P‚ ÿÿ ÿý ÿ92067-18083 1926 S C0122 &HELP              H0101 zjþú HELP 92067-18083 DATE CODE 1926 PREPARED BY R. ENGLUND 790717 HELP FILE FOR RTE-IV SOURCE PROGRAMS TAPE #1 FILENAME LANGUAGE PART NO. DATE CODE -------- -------- -------- --------- OPERATING SYSTEM &CSY4 ASMB 92067-18014 1926 &4DISP ASMB -18015 1926 &RTIM4 ASMB -18016 1805 &ASCM4 ASMB -18017 1805 &4RTIO ASMB -18018 1926 &4EXEC ASMB -18019 1926 &$TRN4 ASMB -18020 1805 &4SCHD ASMB -18021 1926 &$ALC4 ASMB -18022 1805 &4OCMD ASMB -18023 1805 &PERR4 ASMB -18024 1840 &4CNFG ASMB -18025 1926 &$TB14 ASMB -18026 1926 &$TB24 ASMB -18027 1926 MAPPING ROUTINE &4PVMP ASMB 92067-18001 1805 LOADR &4LDR ASMB 92067-18002 1926 MULTI-TERMINAL MONITOR &4MTM ASMB 92067-18003 1926 POWERFAIL &4DP43 ASMB 92067-18004 1926 AUTO RESTART &4AUTR FTN4 92067-18005 1805 CONFIGURATION EXTENSION &$CNFX ASMB 92067-18006 1926 BATCH MONITORkþú PROGRAM &D.RTR ASMB 92002-18007 1926 &FMGR ASMB/SPL -18008 1926 BATCH MONITOR LIBRARY &BMLIB ASMB/SPL 92002-18006 1926 SPOOL SYSTEM &4GPOL SPL/ASMB 92067-18028 1805 &JOB4 ASMB -18029 1805 &4DV43 ASMB -18030 1926 &EXTD4 ASMB -18031 1805 &SPCL4 ASMB -18032 1805 &4SMP ASMB -18078 1926 &4SPOT ASMB -18079 1805 SYSTEM LIBRARY &4SYLB ASMB 92067-18035 1926 &ALRN4 ASMB -18036 1805 &RNRQ4 ASMB -18037 1805 &LURQ4 ASMB -18038 1805 &PRTN4 ASMB -18039 1805 &EQLU4 ASMB -18040 1805 &DRCT4 ASMB -18041 1805 &REIO4 ASMB -18042 1926 &IFBK4 ASMB -18043 1913 &CORA4 ASMB -18044 1805 &CORB4 ASMB -18045 1805 &CVT34 ASMB -18046 1805 &KCVT4 ASMB -18047 1805 &MESS4 ASMB -18048 1840 &PARS4 ASMB -18049 1840 &PRSE4 ASMB -18050 1805 &TMVL4 ASMB -18051 1913 &CNMD4 ASMB Ïþú -18052 1805 &CNMO4 ASMB -18053 1805 &IPRS4 ASMB -18054 1805 &.MVW4 ASMB -18055 1805 >ST4 ASMB -18056 1805 &.EMAP ASMB -18057 1805 &EMIO4 ASMB -18058 1805 &MMAP4 ASMB -18059 1805 &EMAS4 ASMB -18060 1805 &EMST4 ASMB -18061 1805 &TRLU4 ASMB -18062 1805 &IFTY4 ASMB -18063 1805 &LGLU4 ASMB -18064 1826 &.IAE4 ASMB -18065 1805 &.RAE4 ASMB -18066 1805 &.XAE4 ASMB -18067 1805 &.TAE4 ASMB -18068 1901 &.ZAE4 ASMB -18069 1901 &STDB4 ASMB -18076 1805 &IDGT4 ASMB -18077 1805 &IXGET ASMB -18080 1840 &IXPUT ASMB -18081 1840 &FTIME ASMB -18082 1840 &XLUEX ASMB -18117 1913 &LUTRU ASMB -18198 1913 &ENSES ASMB -18199 1913 &LIMEN ASMB -18256 1913 &SEGLD ASMB -18257 1913 &.ERES ASMB -18258 1913 TAPE #2 FILENäšþúAME LANGUAGE PART NO. DATE CODE -------- -------- -------- --------- GENERATOR &RT4GN ASMB 92067-18009 1926 SWITCH PROGRAM &4SWTH ASMB 92067-18010 1926 WHZAT PROGRAM &4WHZT ASMB 92067-18007 1926 LOG TRACK TABLE &LGTAT ASMB 92067-18008 1926 EMA VERIFIER &#EMA ASMB 92067-18013 1805 KEYS UTILITY &KEYS FTN4 92060-18052 1707 KEYS DUMP UTILITY &KYDMP FTN4 92060-18053 1707 SAVE PROGRAM &SAVE ASMB/FTN4 92060-18039 1901 RESTORE PROGRAM &RESTR ASMB/FTN4 92060-18040 1901 VERIFY PROGRAM &VERFY ASMB/FTN4 92060-18041 1704 COPY PROGRAM © ASMB/FTN4 92060-18042 1704 DISC BACK-UP PROGRAM &DBKLB ASMB/FTN4 92060-18043 1901 FLEXI DISC BACK-UP &MSAFD FTN4 92064-18232 1740 READ NAMR PROGRAM &RDNAM SPL 92060-18045 1926 TAPE #3 FILENAME LANGUAGE PART NO. DATE CODE -------- -------- -------- --------- ASSEMBLER &4ASMB ASMB 92067-18011 1805 &4ASB0 ASMB -18070 1805 &4ASB1 ASMB -18071 1805 &4ASB2 ASMB -14bþú8072 1926 &4ASB3 ASMB -18073 1805 &4ASB4 ASMB -18074 1805 CROSS REFERENCE &4XREF ASMB 92067-18012 1805 EDIT0R &EDITR ASMB 92002-18010 1926 FORTRAN IV &FTN4 ASMB 92060-18092 1926 &FFTN4 ASMB -18093 1913 &0FTN4 ASMB -18094 1913 &1FTN4 ASMB -18095 1926 &2FTN4 ASMB -18096 1926 &3FTN4 ASMB -18097 1913 &4FTN4 ASMB -18098 1926 &5FTN4 ASMB -18101 1913 FORMATTER LIBRARY &FF4.N ASMB 24998-18002 1926 DECIMAL STRING ARITH. &ADD ASMB 24306-18004 1840 &A2DE ASMB -18005 1840 &CARY ASMB -18006 1840 &JSCOM ASMB -18007 1840 &DCAR ASMB -18008 1840 &DEA2 ASMB -18009 1840 &DIV ASMB -18010 1840 &EDIT ASMB -18011 1840 &D1D2 ASMB -18012 1840 &D2D1 ASMB -18013 1840 &FILL ASMB -18014 1840 &GET ASMB -18015 1840 &MOVE ASMB -18016 1840 &MPY ASMB ¬þú -18017 1840 &PUT ASMB -18018 1840 &SIGN ASMB -18019 1840 &SUB ASMB -18020 1840 &ZONE ASMB -18021 1840 RTE/DOS LIBRARY &RLIB1 ASMB 24998-18001 1926 &RLIB2 ASMB -18009 1926 &RLIB3 ASMB -18011 1926 COMPILER LIBRARY &OPN.C ASMB 92060-18054 1926 &CLO.C ASMB -18055 1913 &RED.C ASMB -18056 1926 &WRT.C ASMB -18057 1901 &SPC.C ASMB -18058 1901 &RWN.C ASMB -18059 1901 &EOF.C ASMB -18060 1901 &GMM.C ASMB -18061 1901 &OLY.C ASMB -18062 1901 &RUN.C ASMB -18063 1913 &END.C ASMB -18064 1901 &PRM.C ASMB -18065 1901 &GMS.C ASMB -18066 1901 &WARC. ASMB -18067 1901 &GES.C ASMB -18068 1901 &GEX.C ASMB -18069 1901 &CRE.C ASMB -18070 1901 &ADS.C ASMB -18071 1901 &C.BS2 ASMB -18072 1901 &ID.AD ASMB -18073 1901 &C.TRN ASMB Zlþú-18074 1901 &C.SAU ASMB -18075 1901 &C.SOR ASMB -18076 1901 &C.BIN ASMB -18077 1901 &C.LST ASMB -18078 1901 &C.SC0 ASMB -18079 1901 &C.SC1 ASMB -18080 1901 &C.SC2 ASMB -18081 1901 &C.BNS ASMB -18082 1901 &C.BSA ASMB -18083 1901 &C.BSO ASMB -18086 1901 &C.BBI ASMB -18087 1901 &C.BLI ASMB -18088 1901 &C.BS0 ASMB -18089 1901 &C.BS1 ASMB -18090 1901 &SUP.C ASMB -18091 1901 &$CLBR ASMB -18099 1913 &C.BIA ASMB -18100 1901 &C.RP ASMB -18102 1926 &GETBF ASMB 92067-18084 1913 &RETBF ASMB -18085 1913 &TRIM ASMB -18086 1913 &MEMBF ASMB -18087 1913 TAPE #4 FILENAME LANGUAGE PART NO. DATE CODE -------- -------- -------- --------- DRIVER PACKAGE &DVM72 ASMB 9580-18079 B &DSCHD ASMB 9580-18126 A &DVR15 ASMB 9601-18021 1901 &DVR3‰J0.*3 ASMB 12732-18001 1805 &DVR10 ASMB 20808-80001 C &PLOT ASMB 20810-80001 C &DVR31 ASMB 29013-80001 1710 &DVR12 ASMB 29028-80002 1805 &DVR00 ASMB 29029-80001 1740 &DVR11 ASMB 29030-80001 1710 &DVR37 ASMB 59310-18005 1926 &HPIB ASMB 59310-18006 1926 &SRQ.P ASMB 59310-18007 1805 &MESS ASMB 59310-18011 1926 &1DV10 ASMB 72008-80001-4 A &2DV10 ASMB 72009-80001 A &DVA13 ASMB 91200-18001 1648 &CHARS ASMB 91200-18002 1648 &TVERF ASMB 91200-18004 1648 &DVA12 ASMB 92001-18020 1826 &DVR05 ASMB 92001-18026 1926 &DVA05 ASMB 92001-18035 1913 &DVR32 ASMB 92060-18031 1840 &LP31 ASMB 92062-18009 1805 &DVB12 ASMB 92062-18010 1926 &DVR23 ASMB 92202-18001 1913 &DVA47 ASMB 92900-18002 1913 ó0ÿÿ ÿý  ÿ92067-18084 1913 S C0122 &GETBF /COMPILER LIB             H0101 ‡[þúASMB,Q,C NAM GETBF,7 92060-16102 REV. 1913 781006 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92067-18084 * RELOC: 92067-16084 * * *****************************************************************: EXT .ENTR,LIMEM,.MVW,UNMEM,UNM2,AVLM,ENDM ENT GETBF,CMPK SKP * * * ABSTRACT: * * THE MEMORY MANAGER USES A GARBAGE COLLECTION ALGORITH. THE * ALGORITHM ALLOCATES FROM THE TOP OF FREE MEMORY TO THE BOTTOM. * (TOP OF MEMORY IS CONSIDERED TO BE LOW MEMORY.) MEMORY IS * ONLY RETURNED TO THE HEAP ON TWO OCCASIONS. THE FIRST * OCCASION IS WHEN MEMORY IS COMPACTED AND ALL THE UNUSED BLOCKS ARE * SQUEEZED TO THE BOTTOM OF MEMORY. THE SECOND OCCASION IS WHEN A * BLOCK OF MEMORY CONTIGUOUS TO THE TOP OF THE HEAP IS RELEASED. * THIS CONTIGUOUS MEMORY IS GATHERED INTO THE HEAP. NOTE THAT WHEN * A MEMORY BLOCK IS RELEASED WHICH IS SANDWICHED BETWEEN TWO USED * BLOCKS, THE BLOCK IS LEFT UNUSED UNTIL MEMORY IS COMPACTED. * * SINCE BLOCKS OF MEMORY ARE MOVED ABOUT IN PHYSICAL MEMORY, POINTERS * TO THE MEMORY MUST BE TREATED IN A SPECIAL WAY. WHEN MEMORY IS * ALLOCATED, THE CALLER DEDICATEDS A WORD OF MEMORY AS A PRIMARY * BUFFER POINTER. THIS PRIMARY BUFFER POINTER IS THE ONLY POINTER * THAT IS UPDATED BY THE BUFFER MANAGER WHEN MEMORY IS COMPACTED. * THEREFORE, SINCE THE VALUE OF THE PRIMARY BUFFER POINTER MAY THE * BE MODIFIED AFTER A CALL TO GETBF, IT IS WISE TO HAVE ONLY * ONE COPY OF THE PRIMARY POINTER. THEREFORE ALL OTHER POINTERS * INTO THE BUFFER MUST BE RELATIVE TO THE PRIMARY POINTER. * * * * DESCRIPTION OF THE BUFFER * * * EACH BUFFER HAS TWO WORDS OFš„þú OVERHEAD. * * WORD 1 = THE SIZE OF THE BUFFER EXCLUDING THE OVERHEAD WORDS * WORD 2 = BACK POINTER TO THE PRIMARY POINTER * THIS WORD IS SOMETIMES REFERED TO AS THE BUFFER'S * PRIMARY POINTER. WHEN THE WORD IS ZERO THE BUFFER * HAS NO OWNER AND IS CONSIDERED UNUSED. * WORD 3-N = THE USER'S BUFFER * * * THIS MODULE CONTAINS THE SUBROUTINES TO GET MEMORY, AND TO * COMPACT MEMORY. MORE DETAILED DESCRIPTIONS PRECEED EACH MODULE. * * * * SKP * * * TITLE: GETBF * GET BUFFER * * ABSTRACT: * * GETBF VERIFIES THAT THE REQUEST FOR MEMORY IS LEGAL AND THAT * ENOUGH MEMORY EXISTS FOR THE NEW BUFFER. WHEN THERE IS NOT * ENOUGH MEMORY IN THE UNUSED-MEMORY BUFFER, GETBF CALLS THE * GARGAGE COLLECTION ROUTINE CALLED CMPK. WHEN THERE IS * NOT ENOUGH MEMORY AFTER CALLING CMPK, GETBF GENERATES AN ERROR. * OTHERWISE IT CALLS THE ROUTINE THAT SETS UP THE OVERHEAD FOR * THE BUFFER. THIS ROUTINE IS CALLED ALLOC. * * THERE MUST ALWAYS BE AN UNUSED-MEMORY BUFFER, EVEN IF THE * BUFFER CONTAINS NO USER BUFFER, (IE. WHEN THE SIZE OF THE * BUFFER IS ZERO). GETBF WILL NOT ALLOCATE A BUFFER WHEN THERE * IS NOT ALSO ROOM TO CREATE A NEW OVERHEAD BLOCK FOR THE UNUSED-MEMORY * BUFFER. * * GETBF MAINTAINS FOUR POINTERS: AVLM WHICH POINTS TO THE FIRST * WORD OF AVAILAVBLE MEMORY, ENDM WHICH POINTS TO THE LAST WORD * OF AVAILABLE MEMORY, AND UNMEM AND UNM2 WHICH POINT TO THE FIRST, * AND SECOND WORD OF THE UNUSED-MEMORY BUFFER'S OVERHEAD. * * GETBF AUTOMATICALLY GETS ALL THE MEMORY BETWEEN THE USER'S * PROGRAM AND THE END OF THE PARTITIAN WHENEVER UNMEM IS ZERO, * THUS ALLOWING AN ITELLIGENT USER TO SHARE MEMORY WITH THE BUFFER * MANAGER BY INTIALIZING THE FOUR RESERVED WORDS DESCRIBED ABOVE. * OTHERWISE, GETBF WILL INITIALIZE THEM. * * CALLING SEQUENCE: * * JSB GETBF * DEF *+4 * DEF (SIZE OF REQUESTED BUFFER) * DEF (WORD WHICH WILL BECOME THE PRIMARY POINTER) * DEF (ERROR RETURN WORD) *  Œþú * EXIT: * * THE PRIMARY POINTER WILL CONTAIN THE ADDRESS OF THE USER * BUFFER. THE ADDRESS TO THIS DATA WORD IS STORED IN * THE SRECOND OVERHEAD WORD OF THE BUFFER. THIS WORD * WILL BE UPDATED WHENEVER MEMORY IS COMPACTED. * ALTHOUGH, THE USER IS UNAWARE OF THE OVERHEAD WORDS, * THE USER IS RESPONSIBLE FOR STAYING WITHIN THE * SIZE LIMITATIONS THAT WAS SPECIFIED. * * THE ERROR WORD WILL CONTAIN THE NEGETIVE VALUE OF THE * LARGEST AVAILABLE BUFFER WHEN THE USER'S REQUEST CAN * NOT BE SATISFIED. WHEN THE REQUEST CAN BE SATISFIED * THE ERROR WORD WILL CONTAIN A ZERO. NOTE THAT THE * ERROR WORD MAY CONTAIN A ZERO WHEN THERE IS ZERO MEMORY * AVAILABLE, AS WELL. THE ERROR CONDITION IS DETERMINED * BY EXAMINING THE A-REGISTER. * * A-REGISTER CONTAINS THE ADDRESS OF THE USER BUFFER WHEN * A BUFFER WAS ALLOCATED, OTHERWISE IT CONTAINS A NEGITIVE * ONE. ****************************************************************** BUFSZ BSS 1 SIZE OF REQUESTED BUFFER PRIM BSS 1 USER'S PRIMARY BUFFER POINTER ERR BSS 1 ERROR RETURN WORD GETBF NOP JSB .ENTR GET PARAMETERS DEF BUFSZ * CLA INITIALIZE USER'S PRIMARY POINTER STA PRIM,I TO ZERO * STA ERR,I INITIALIZE ERROR TO ZERO * LDA BUFSZ,I IS REQUEST LEGAL? SSA JMP ILLRQ SZA,RSS JMP ILLRQ NO,ERROR-EXIT * LDA UNMEM HAS MEMORY BEEN INITIALIZED? SZA JMP GETB1 YES, THEN GO GET BUFFER * JSB LIMEM NO, GET THE MEMORY BOUNDS DEF *+4 DEF .0 DEF AVLM DEF ROTMX * LDA AVLM AVLM = FIRST WORD OF AVAILABLE MEMORY STA UNMEM UNMEM = FIRST WORD OF UNUSED MEMORY'S INA OVERHEAD STA UNM2 UNM2 = SECOND OVERHEAD WORD LDB ROTMX SET B-REG TO SIZE OF UNUSED-MEMORY BUFFER ADB MO=þúVRZ ACCOUNT FOR OVERHEAD ADA B GET ADDRESS TO LAST WORD OF MEMORY STA ENDM ENDM = LAST WORD OF AVAILABLE MEMORY * STB UNMEM,I INITIALIZE OVERHEAD WORDS OF CLA UNUSED MEMORY STA UNM2,I * GETB1 LDA BUFSZ,I IS UNUSED MEMORY'S BUFFER LARGE ENOUGH? ADA OVRSZ ALLOW FOR NEW UNUSED-MEMORY OVERHEAD CMA,INA STA T1 SAVE NEGETIVE SIZE OF REQUESTED BUFFER ADA UNMEM,I SSA,RSS JMP GETB2 * * * * UNUSED MEMORY BUFFER IS NOT LARGE ENOUGH * COMPACT MEMORY * * * JSB CMPK MOVE USED BUFFERS TO LOW MEMORY DEF *+1 * * * CMPK RETURNS: * B-REG = SIZE OF UNMEM'S BLOCK * ADB T1 NOW IS THERE ENOUGH UNUSED MEMORY? SSB JMP NOMEM NO, GO PROCESS ERROR * GETB2 JSB ALLOC YES, ALLOCATE MEMORY DEF *+3 DEF BUFSZ,I DEF PRIM,I * LDA PRIM,I RETURN A-REG = ADDRESS OF BUFFER GETBX JMP GETBF,I * * * * ERROR PROCESSORS * * NOMEM LDA UNMEM,I RETURN LARGEST MEMORY BLOCK ADA MOVRZ AVAILABLE TO CALLER SSA ACCOUNT FOR OVERHEAD OF NEW UNUSED-MEMORY CLA BUFFER CMA,INA STA ERR,I ILLRQ CCA RETURN -1 IN A-REG JMP GETBX * * * DATA * * .0 DEC 0 CONSTANT ZERO - USED IN THE LIMEM CALL ROTMX BSS 1 SIZE OF MEMORY FROM THE END OF THE USER'S * PARTITIAN TO THE END OF THE USER'S * PROGRAM. SKP * * TITLE: CMPK * COMPACT MEMORY * * ABSTRACT: * * CMPK MOVES ALL USED BLOCKS TO LOW MEMORY AND CONSOLIDATES * ALL THE UNUSED BLOCKS IN HIGH MEMORY UPDATING UNMEM, AND * UNM2 ACCORDINGLY. CMPK STARTS AT THE BEGINNING OF AVAILABLE * MEMORY, SEARCHING FOR AN UNUSED BLOCK OF MEMORY, MAKING USE OF * THE CURRENT BUFFER'S SIZE TO LOCATE THE NEXT BUFFER. WHEN A°þúN * UNUSED BUFFER IS FOUND, SUBSEQUENT UNUSED BUFFERS ARE GATHERED * TOGETHER TO FORM A BLOCK OF UNUSED MEMORY. WHEN A USED BUFFER * IS DISCOVERED, IT IS PHYSICALLY MOVED ABOVE THE BLOCK OF UNUSED * MEMORY, UNTIL ALL USED MEMORY PHYSICALLY RESIDES ABOVE THE * BLOCK OF UNUSED MEMORY. WHEN ALL OF MEMORY IS SEARCHED THE * BLOCK OF UNUSED MEMORY BECOMES THE HEAP, OR THE UNUSED-MEMORY * BUFFER, AND UNMEM, AND UNM2 ARE UPDATED TO REFLECT THE CHANGE. * * CMPK DEPENDS ON THE FACT THAT GETBF HAS ALWAYS PROVIDED FOR * ONE UNUSED-MEMORY BUFFER. THIS ASSUMPTION IS CAREFULLY NOTED * IN THE COMMENTS. * * CALLING SEQUENCE: * * JSB CMPK * DEF *+1 * * UNMEM, UNM2, ENDM, AND AVLM ARE EXPECTED TO BE * SET UP. * * EXIT: * * UNMEM POINTS TO THE FIRST OVERHEAD WORD * THE NEW UNUSED-MEMORY BUFFER. * UNM2 POINTS TO THE SECOND OVERHEAD WORD OF THE * UNUSED-MEMORY BUFFER. * * B-REGISTER CONTAINS THE POSITIVE SIZE OF THE UNUSED-MEMORY * BUFFER. * * MEMORY IS COMPACTED * * ******************************************************************* * * CMPK NOP JSB .ENTR GET THE RETURN ADDRESS DEF CMPK * LDA AVLM BEGIN AT THE FIRST WORD OF MEMORY. STA UNMEM INA STA UNM2 * CLA INITIALIZE SIZE OF UNUSED MEMORY TO ZERO STA SIZE * * * * SEARCH FOR FIRST UNUSED BUFFER * NOTE: ON EXIT FROM LOOP, UNMEM IS POINTING TO THE AREA BELOW THE * LAST USED BUFFER. WHEN OTHER USED BUFFERS ARE FOUND * THEY WILL BE PLACED THERE. * * CMP1 LDA UNMEM ARE THERE ANY MORE BUFFERS STA B INB CMB,INB IS UNMEM .LT. ENDM? ADB ENDM SSB JMP CMPX * LDB UNM2,I DOES THIS BUFFER HAVE A PRIMARY SZB,RSS POINTER? JMP CMP10 NO, THEN HAVE FOUND FIRST UNUSED BUFFER * * ADA UNMEM,I YES, GET NEXT BUFFER ADA OVRSZ STA UNMEM INA ØMþú STA UNM2 JMP CMP1 * * GATHER UP UNUSED BLOCKS * CMP10 LDA UNMEM INITIALIZE TEMPORARY MEMORY POINTER STA TM INA STA TM2 * CMP12 CLA INITIALIZE SIZE OF UNUSED BLOCK STA BLKSZ * CMP15 LDA TM ARE THERE ANY MORE BUFFERS? STA B INB IS TM .LT. ENDM CMB,INB ADB ENDM SSB JMP CMP30 * * * * YES, THEN GATHER UP THE UNUSED BLOCKS * * * LDB TM2,I DOES THIS BUFFER HAVE A PRIMARY POINTER? SZB JMP CMP20 * LDB TM,I ADB OVRSZ NO, THEN GATHER IT INTO * THE UNUSED BLOCK ADB BLKSZ PUT SIZE OF UNUSED BLOCK IN MEMORY STB BLKSZ * ADA TM,I ADA OVRSZ STA TM UPDATE TEMPORARY POINTER TO POINT INA TO NEXT BLOCK STA TM2 JMP CMP15 KEEP LOOPING  * * * * * INCREASE SIZE OF UNUSED MEMORY BY SIZE OF CURRENT * UNUSED BLOCK OF MEMORY * * * * CMP20 LDA SIZE ADA BLKSZ STA SIZE * * * * MOVE USED BLOCK UP, BENEATH LAST USED BLOCK * * * * A-REG = SIZE OF BLOCK * B-REG = POINTER TO USER'S PRIMARY POINTER * * * SZA,RSS DOES THE BLOCK NEED TO BE MOVED? JMP CMP25 * LDA UNMEM UPDATE THE USER'S PRIMARY POINTER ADA OVRSZ BY THE SIZE OF THE BUFFER STA B,I * * * MOVE BLOCK POINTED TO BY TM TO SPACE POINTED TO BY * UNMEM * * * * LDA TM,I GET SIZE OF BLOCK TO BE MOVED ADA OVRSZ STA MOVZ * LDA TM SET A-REG TO ADDRESS OF SOURCE LDB UNMEM SET B-REG TO ADDRESS OF DESTINATION JSB .MVW DEF MOVZ DEF 0 * STA TM PUT NEW ADDRESS OF SOURCE IN TM INA  STA TM2 * STB UNMEM PUT NEW ADDRESS OF DESTINATION IN UNMEM INB STB UNM2 * CMP25 JMP CMP12 * * * CMP30 4 þúLDA SIZE ADA BLKSZ STA SIZE * * INITIAIZE HEAPS OVERHEAD * CMPX CLB INITIALIZE SIZE OF UNUSED MEMORY * BUFFER TO ZERO LDA SIZE IS THERE ROOM FOR OVERHEAD ADA MOVRZ SSA JMP CMPXX * STA UNMEM,I INITIALIZE UNUSED BUFFER TO SIZE OF * STB UNM2,I SET PRIMARY POINTER TO ZERO * LDB UNMEM,I RETURN SIZE OF UNUSED MEMORY IN B-REG CMPXX JMP CMPK,I * * * DATA * * BLKSZ BSS 1 ACCUMALATOR FOR THE UNUSED-MEMORY BLOCK * WHILE GATHERING THE UNUSED MEMORY * TOGETHER. MOVZ BSS 1 * HOLDS THE SIZE OF THE USED BUFFER BEING MOVED * TO LOW MWMORY. SIZE BSS 1 ACCUMULATOR FOR SIZE OF THE UNUSED-MEMORY BUFFER SKP * * * TITLE: ALLOC * ALLOCATE A MEMORY BUFFER * * ABSTRACT: * * ALLOC ALLOCATES BUFFERS. IT ASSUMES THAT THE UNUSED * BLOCK OF MEMORY IS LARGE ENOUGH TO CONTAIN THE NEW BUFFER * PLUS THE OVERHEAD FOR THE NEW UNUSED-MEMORY BUFFER. * IT PUTS THE ADDRESS OF THE USER'S PRIMARY POINTER OF * SECOND WORD OF THE OVERHEAD, AND PLACED THE ADDRESS TO THE * USER'S BUFFER IN THE USER'S PRIMARY POINTER. * * CALLING SEQUENCE: * * JSB ALLOC * DEF *+3 * DEF (SIZE OF USER'S BUFFER) * DEF (USER'S PRIMARY POINTER) * * * EXIT: * * THE NEW USER'S BUFFER AND THE NEW UNUSED-MEMORY BUFFER * ARE CREATED. * * NO ERRORS ARE RETURNED BECAUSE ALL ERROR CHECKING * TAKES PLACE IN GETBF. * * BUFZ BSS 1 REQUESTED BUFFER SIZE PTR BSS 1 ADDRESS TO PRIMARY POINTER ALLOC NOP JSB .ENTR DEF BUFZ * LDA UNMEM STA TM SAVE POINTER TO BUFFER INA STA TM2 INA * ADA BUFZ,I UPDATE UNMEM STA UNMEM INA STA UNM2 * LDA BUFZ,I UP×80.*DATE UNMEM'S BUFFER SIZE ADA OVRSZ TO OLD SIZE - REQUESTED BUFFER SIZE CMA,INA - OVERHEAD SIZE ADA TM,I STA UNMEM,I * CLA UPDATE UNMEM'S PRIMARY POINTER STA UNM2,I * LDA BUFZ,I INITIALIZE OVERHEAD ON USER'S BUFFER STA TM,I * LDA PTR INITIALIZE USER'S PRIMARY POINTER LDB TM ADB OVRSZ STB A,I * STA TM2,I INITIALIZE BUFFER'S PRIMARY POINTER JMP ALLOC,I * * * * DATA * * TM BSS 1 TEMPORARY MEMORY POINTER FOR OVERHEAD WORD 1 TM2 BSS 1 TEMPORARY MEMORY POINTER FOR OVERHEAD WORD 2 * T1 BSS 1 THIS IS A TEMPORARY STORAGE USED IN GETBF * A EQU 0 THIS REFERS TO THE A-REGISTER B EQU 1 THIS REFERS TO THE B-REGISTER * OVRSZ DEC 2 SIZE OF THE OVERHEAD BLOCK MOVRZ DEC -2 MINUS THE SIZE OF THE OVERHEAD BLOCK END Ä´0ÿÿ ÿý  ÿ92067-18085 1913 S C0122 &RETBF /COMPILER LIB             H0101 ˆfþúASMB,Q,C NAM RETBF,7 92060-16102 REV. 1913 780630 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92067-18085 * RELOC: 92067-16085 * * *****************************************************************: EXT .ENTR,ENDM,AVLM,UNMEM,UNM2 ENT RETBF SKP * * TITLE: RETBF * RETURN BUFFER * * ABSTRACT: * * RETBF RETURNS A USER'S BUFFER TO THE BUFFER POOL, AND * COALESCES UNUSED BUFFERS AROUND THE UNUSED MEMORY * BUFFER WHEN THE BUFFER BEING RELEASED IS ADJACENT TO * THE UNUSED MEMORY BUFFER. * * CALLING SEQUENCE: * * JSB RETBF * DEF *+2 * DEF (USER'S PRIMARY POINTER) * * UNMEM, UNM2, AVLM, AND ENDM MUST BE INITIALIZED * * * ON EXIT: * * A-REG CONTAINS ERROR INDICATOR * 0 IMPLIES NO ERROR * -1 IMPLIES BAD POINTER * * PPTR BSS 1 ADDRESS TO USER'S PRIMARY POINTER RETBF NOP JSB .ENTR DEF PPTR * LDA PPTR,I SET UP POINTER TO BUFFER ADA MOVRZ STA T1 INA STA T2 INA * LDB T2,I IS THE PRIMARY POINTER GOOD? CPA B,I RSS JMP ERROR * CLA YES STA T2,I CLEAR BUFFER'S PRIMARY POINTER STA PPTR,I CLEAR USER'S PRIMARY POINTER * * * * COALESCE UNUSED BUFFERS * * NOTE: IT IS GAURANTEED THAT THERE EXISTS 1 UNUSED BUFFER, * I.E., THE UNUSED MEMORY BUFFER POINTED TO BY UNMEM. * * * LDB T1 IS IT NECESSARY TO COALESCE BUFFERS? ADB T1,I ADB OVRSZ CLA CPB UNMEM RSS JMP RETX NO, GO EXIT * LDA AVLM YES,START ATIþú TOP OF MEMORY STA UNMEM INA STA UNM2 * CLA INITIALIZE POINTER TO START OF STA T1 UNUSED MEMORY TO ZERO STA SIZE INITIALIZE SIZE TO 0 * RET10 LDA UNMEM ARE THERE ANY MORE BUFFERS? STA B INB CMB,INB IS UNMEM .LT. ENDM ADB ENDM SSB JMP RET30 * LDA UNM2,I DOES THIS BUFFER HAVE A SZA A PRIMARY POINTER JMP RET20 YES,GO FIND ANOTHER GROUP OF BLOCKS * LDA T1 IF THIS IS THE FIRST UNUSED SZA BUFFER IN THIS BLOCK JMP RET15 THEN SAVE IT'S ADDRESS * LDA UNMEM STA T1 * RET15 LDA UNMEM,I INCREASE SIZE OF UNUSED MEMORY ADA SIZE ADA OVRSZ STA SIZE JMP RET25 * RET20 CLA INITIALIZE ADDRESS OF UNUSED STA T1 MEMORY TO ZERO STA SIZE INITIALIZE SIZE OF UNUNSED BLOCK TO ZERO * RET25 LDA UNMEM ADA UNMEM,I ADA OVRSZ STA UNMEM INA STA UNM2 JMP RET10 * * RET30 LDA T1 INITIALIZE UNUSED MEMORY OVERHEAD SZA,RSS IN CASE OF DEBUG ERROR JMP ERROR RETURN NEGETIVE ONE * STA UNMEM NOTE: IT IS GAURANTEED THAT T1 HAS INA A VALUE OTHER THAN ZERO BECAUSE STA UNM2 GETBF ALWAYS PROVIDES FOR AT LEAST LDA SIZE ONE UNUSED BUFFER AT THE END OF MEMORY ADA MOVRZ STA UNMEM,I * CLA INITIALIZE BUFFER'S PRIMARY STA UNM2,I POINTER TO ZERO RETX JMP RETBF,I RETURN ERROR INDICATOR IN A-REG * * * * ERROR PROCESSOR * * ERROR CCA RETURN -1 IN A-REG JMP RETX SKP * * * * DATA * * * OVRSZ DEC 2 SIZE OF BUFFER OVERHEAD MOVRZ DEC -2 MINUS SIZE OF BUFFER OVERHEAD * * T1 BSS 1 TEMPORARY MEMORY POINTER T2 BSS 1 TEMPORARY POINTER TO OVERHEAD WORD 2 * E SIZE BSS 1 SIZE OF UNUSED MEMORY WHENEVER BUFFERS * AROUND THE UNUSED-MEMORY BUFFER * ARE COALESCED * A EQU 0 REFERS TO A-REGISTER B EQU 1 REFERS TO B-REGISTER END œÿÿ ÿý ÿ92067-18086 1913 S C0122 &TRIM /COMPILER LIB             H0101 ¡7þúASMB,Q,C NAM TRIM,7 92060-16102 REV. 1913 780628 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92067-18086 * RELOC: 92067-16086 * * *****************************************************************: EXT .ENTR,RETBF,UNMEM,UNM2,ENDM,AVLM ENT TRIM SKP * * * * TITLE: TRIM * TRIM BUFFER * * ABSTRACT: * * TRIM RETURNS PART OF A BUFFER TO THE BUFFER POOL * IF THE THE USER POINTER IS INVALID A NEGETIVE * ONE IS RETURNED IN THE A-REG * * TRIM ALLOWS A USER TO RETURN THE BOTTOME PORTION OF A BUFFER * WHILE RETAINING OWNERSHIP OF THE UPPER PART. THIS ROUTINE * IS USEFUL IN CASES WHERE THE AMOUNT OF MEMOR REQUIRED IS DETERMINED * WHEN THE MEMORY REQUEST IS MADE,(IE. WHEN RECEIBING VARIABLE * LENGTH PARAMETERS). THE USER MAY REQUEST THE MAXIMUM BUFFE, RETURNING * THE UNUSED PORTION WHEN THE MEMORY REQUIRTEMENTS ARE FULLY DETERMINED. * * TRIM IS PASSED THE ADDRESS OF THE USER BUFFER AND THE SIZE OF THE * BUFFER IT WISHES TO KEEP. WHEN THE SIZE OF THE KEEP BUFFER IS * ZERO THE WHOLE BUFFER IS RETURNED. WHEN THE SIZE OF THE KEEP-BUFFER * IS LESS THAN ZERO AN ERROR IS RETURNED IN THE A-REGISTER. * * * * CALLING SEQUENCE: * * JSB TRIM * DEF *+3 * DEF (USER'S PRIMARY POINTER) * DEF ( SIZE OF BUFFER TO KEEP) * * * EXIT: * A-REGISTER CONTAINS A ERROR INDICATOR * -1 INDICATES AN ERROR * 0 INDICATES NO ERROR * * * PRM BSS 1 ADDRESS TO USER'S PRIMARY POINTER KEEP BSS 1 SIZE OF BUFFER TO KEEP TRIM NOP JSB .ENTR DEF PRM * LDA KEEP,I IS KEEP LESS THAN ZERO? u–þú SSA JMP TRIMR YES, THEN ERROR-EXIT SZA IS KEEP EQUAL TO ZERO? JMP TRM10 * JSB RETBF YES, SET UP TO RETURN ALL THE BUFFER DEF *+2 DEF PRM,I JMP TRIMX * * NO, IS THIS A VALID BUFFER? * TRM10 LDA PRM,I GET POINTER TO BUFFER'S OVERHEAD ADA MOVRZ * STA T1 INA STA T2 INA LDB T2,I CPA B,I IS THIS A VALID POINTER RSS JMP TRIMR NO, GO PROCESS ERROR * CLA LDB KEEP,I IS KEEP SIZE .GT. SIZE OF BUFFER? CMB,INB ADB T1,I SSB JMP TRIMR YES, ERROR-EXIT * SZB,RSS IS KEEP SIZE = BUFFER SIZE? JMP TRIMX YES, RETURN (NO ERROR) * ADB MOVRZ IS THERE ENOUGH ROOM FOR NEW BUFFER? SSB JMP TRIMX NO, GO EXIT (NO ERROR) * LDA T1 SET UP NEW BUFFER ADA KEEP,I ADA OVRSZ STA TT1 GET NEW BUFFER POINTER INA STA TT2 NOTE: B-REG CONTAINS SIZE OF NEW BUFFER * STB TT1,I SAVE NEW BUFFER SIZE * LDA KEEP,I UPDATE SIZE OF KEEP BUFFER STA T1,I * LDA TT1H KLUDGE UP TT1 TO ACT AS PRIMARY POINTER * STA TT2,I PUT ADDRESS TO POINTER IN OVERHEAD LDA TT1 UPDATE POINTER TO OVERHEAD ADA OVRSZ TO POINT TO USER'S BUFFER STA TT1 * TRM40 JSB RETBF DEF *+2 DEF TT1 * * RETURN NO ERROR INDICATOR IN A-REG * TRIMX JMP TRIM,I * * * * ERROR PROCESSOR * * TRIMR CCA RETURN -1 IN A-REG INDICATING ERROR JMP TRIMX * * * * * DATA * * * TT1H DEF *+1 * TT1 BSS 1 TT2 BSS 1 * T1 BSS 1 T2 BSS 1 * OVRSZ DEC 2 MOVRZ DEC -2 * A EQU 0 B EQU 1 END  ÿÿ ÿý ÿ92067-18087 1913 S C0122 &MEMBF /COMPILER LIB             H0101 ŠZASMB,Q,C NAM MEMBF,7 92060-16102 REV. 1913 781005 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92067-18087 * RELOC: 92067-16087 * * ENT UNMEM,UNM2,AVLM,ENDM UNMEM BSS 1 UNM2 BSS 1 AVLM BSS 1 ENDM BSS 1 END ÒÉÿÿ ÿý ÿ92067-18088 1903 S C0122 &.CLGN              H0101 r{þúASMB,R,L,C,Q * NAME: .CLGN * SOURCE: 92067-18088 * RELPC: 92067-16125 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .CLGN,7 92067-16125 REV.1903 780928 * * * ENT .CLGN * EXT $DSCS,EXEC,$LGON * * A EQU 0 B EQU 1 * * * PURPOSE: PASS A SPECIAL REQUEST TO THE LOGON PROGRAM AND * RETURN A CLASS NUMBER FOR INTEGERATION OF RESULT. * * * CALLING SEQUENCE: (A)=ADDRESS OF BUFFER TO PASS * (B)=LENGTH * JSB .CLGN * DEC -CALL CODE FOR LOGON * * RTN (A)-1= SESSION NOT INITIALIZED OR NOT INSTALLED * ELSE = CLASS# TO FETCH RESULT * * SKP * * * .CLGN NOP STB BUFF ADDRESS STA TLEN LENGTH XLA $DSCS FETCH DISC POOL POINTER (UP\DOWN FLAG) SSA IF NEGATIVE JMP ERR1 WE CAN'T CONTINUE * XLA $LGON FETCH LOGON CLASS # SZA,RSS IF NOT DEFINED JMP ERR1 SESSION NOT YET UP * IOR SAVC . MAKE SURE THE CLASS # ISN'T RELEASED STA LGC SAVE LOGON CLASS NUMBER * * MAKE SURE LOGON EXISTS AND IS EXECUTING * JSB EXEC DEF EX.4 DEF DS10 DEF LOGON EX.4 EQU * NOP POSSIBLE ERROR CONDITION CPB "05" IF SCO5 ERROR JMP ERR1 DON'T GO ANY FURTHER * * GET CLASS # FOR RESPONSE FROM LOGON * CLA STA CCLAS FORCE ALLOCATION * JSB EXEC DEF EX1 DEF D18 CLASS WRITE DEF NOP LU 0 DEWÀ  F * DEF NOP ZERO LENGTH TRANSFER DEF * DEF * DEF CCLAS CLASS # RETURNED HERE EX1 EQU * * * * * * ISSUE CLASS WRITE-READ TO LOGON * * * JSB EXEC DEF EX3 DEF DS20 NO-ABORT CLASS WRITE-READ DEF NOP LU 0 BUFF NOP BUFFER ADDR DEF TLEN LENGTH DEF CCLAS COMMUNICATION CLASS FOR RETURN STATUS DEF .CLGN,I CALL CODE DEF LGC LOGON CLASS NUMBER EX3 EQU * * JMP ERR1 IF CLASS REQUEST REJECTED, BAD NEWS. * * * * MAKE SURE LOGON IS EXECUTING * * JSB EXEC DEF EX4 DEF DS10 NO-ABORT SCHED, NO QUEUE OR WAIT DEF LOGON EX4 EQU * * NOP POSSIBLE ERROR RETURN * * LDA CCLAS RETURN COMMUNICATION CLASS IOR SAVC SET SAVE CLASS BIT RSS ERR1 CCA BAD STATE OF SESSION ISZ .CLGN BUMP RTN JMP .CLGN,I * * LOGON ASC 3,LOGON DS10 OCT 100012 DS20 OCT 100024 NOP NOP SAVC OCT 20000 CCLAS NOP TLEN NOP LGC NOP D18 DEC 18 D21 DEC 21 "05" ASC 1,05 END | ÿÿ ÿý ÿ92067-18089 1903 S C0122 &.CACT              H0101 ovþúASMB,R,L,C,Q * NAME: .CACT * SOURCE: 92067-18089 * RELPC: 92067-16125 * PGMR: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .CACT,7 92067-16125 REV.1903 780921 * * * ENT .CACT * EXT $DSCS,ISMVE,$SMD# * * A EQU 0 B EQU 1 XEQT EQU 1717B * * * PURPOSE: RETURN DIRECTORY ENTRY # OF CURRENT SESSION * * * * CALLING SEQUENCE: JSB .CACT * RTN (A) 0= NOT IN SESSION * >0= DIRECTORY ENTRY # * -1= SESSION NOT INSTALLED OR INITIALIZED * -2= SESSION IN SHUTDOWN MODE * * SPC 5 .CACT NOP LDA $DSCS FETCH STATUS FLAG SSA IF NEGATIVE, JMP .CACT,I RETURN BAD STATUS FOUND * LDA XEQT FETCH MY ID ADDR ADA D32 ADVANCE TO SESSION POINTER XLB A,I FETCH IT CLA PRESET FOR NOT IN SESSION RETURN SZB SSB IF NOT SESSION JMP .CACT,I RETURN (A)=0 * STB TMP SAVE SESSION POINTER * JSB ISMVE DEF IRTN DEF TMP FROM LOCATION DEFINED BY TMP DEF $SMD# WITH THIS OFFSET DEF TMP PUT VALUE HERE DEF .1 MOVE ONE WORD IRTN EQU * * LDA TMP FETCH DIRECTORY ENTRY NUMBER JMP .CACT,I RETURN * D32 DEC 32 TMP NOP .1 DEC 1 * END O  ÿÿ ÿý ÿ92067-18090 1903 S C0122 &.UACT              H0101 xwþúASMB,R,L,C,Q * NAME: .UACT * SOURCE: 92067-18090 * RELPC: 92067-16125 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .UACT,7 92067-16125 REV.1903 790129 * * * ENT .UACT * EXT .CLGN,EXEC * * A EQU 0 B EQU 1 * * * PURPOSE: GIVEN A LOG-ON STRING, RETURN DIRECTORY ENTRY # FOR * THE SPECIFIED USER. * * CALLING SEQUENCE: (A)=NEGATIVE CHARACTER COUNT * (B)=WORD ADDRESS OF INPUT STRING * JSB .UACT * DEF ERROR MESSAGE BUFFER(128) * * RTN (A)>0= DIRECTORY ENTRY NUMBER * (B)=0 * OR * (A)=-1= SESSION NOT INITIALIZED OR NOT INSTALLED * (B) NOT DEFINED * * ELSE (A) = - TRANS LOG (BYTES) OF TERMINATING ERROR MSG * (ERROR STRING IN BUFFER ) * (B) = ERROR CODE * * SKP * * * .UACT NOP JSB .CLGN SEND REQUEST TO LOGON (A = LENGTH) DM4 DEC -4 DIRECTORY # FETCH REQUEST * LDB .UACT,I FETCH ERROR BUFFER LOCATION STB BUFA * SSA ERROR ? JMP ERR1 YES GET OUT * STA CCLAS SAVE COMMUNICATION CLASS * GETIT LDA DM256 FETCH BUFFER SIZE JSB GETR GO DO A GET JMP ERR1 ERROR ON GET REQUEST * LDA CALL FETCH CALL TYPE ( THAT THE GET FETCHED) CPA D1 MUST BE READ OR WRITE\READ RSS JMP GETIT TRY AGAIN * CMB,INB SET TRANS LOG NEG STB TEMP AND SAVE AS POSSIBLE ERROR FLAGê¹   LDA BUFA,I FETCH POSSIBLE DIRECTORY ENT # LDB IOP2 FETCH LOGON RETURN STATUS STB TEMP3 CPB OK? IF GOOD COMPLETION EXIT STA TEMP SAVE RETURN STATUS * LDA CCLAS CLEAR THE XOR SAVC SAVE CLASS BIT STA CCLAS IN CLASS WORD AGAIN CLA AND ISSUE GET (ZERO LENGTH BUFFER) JSB GETR MAKE SURE THE COMMUNICATION CLASS WAS RETURNED CLB,RSS ERROR ON GET SO GET OUT JMP AGAIN * LDA TEMP3 FETCH LOGON RETURN STATUS ALF ISOLATE POSSIBLE ERROR CODE TO (B MUST=0) ASL 6 LOW 6 BITS OF (B) FOR RETURN TO CALLER LDA TEMP FETCH RETURN STATUS ISZ .UACT .BUMP RETURN ADDR JMP .UACT,I * * * INPUT STRING STARTS ON ODD BYTE. * BLANK THE EVEN BYTE OF THAT WORD SO THE PARSE OF THE NAME * IS CORRECT. * * * GETR NOP STA TEMP2 JSB EXEC DEF GET1 DEF DS21 DEF CCLAS DEF BUFA,I RESULT BUFFER DEF TEMP2 BUF LEN DEF IOP DEF IOP2 DEF CALL GET1 EQU * RSS ISZ GETR JMP GETR,I * ERR1 CCA JMP EXIT * * * B40 OCT 40 CALL NOP SAVC OCT 20000 D1 DEC 1 D2 DEC 2 TEMP NOP TEMP2 NOP TEMP3 NOP DM256 DEC -256 DS21 OCT 100025 IOP NOP IOP2 NOP OK? OCT 110011 CCLAS NOP BUFA NOP END ú} ÿÿ ÿý ÿ92067-18091 2001 S C0122 &.LGON LOGON LGOFF SUBROUTINE             H0101 gþúASMB,R,L,C,Q * NAME: .LGON * SOURCE: 92067-18091 * RELPC: 92067-16125 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .LGON,7 92067-16125 REV.2001 791028 * * MODIFIED 701028 TO ISSUE ONLY ERROR MESSAGES RETURNED * FROM LOGON. GLM * * * ENT .LGON * EXT .CLGN,EXEC,$LIBR,$LIBX * * A EQU 0 B EQU 1 * * * PURPOSE: GIVEN ACCOUNT DIRECTORY ENTRY NUMBER, PERFORM LOGON * CALLING SEQUENCE: (A)=DIRECTORY ENTRY NUMBER * JSB .LGON * DEF BUFFER(128 WORDS) FOR POSSIBLE ERROR RETURN * * RTN (A) 0= LOGON OK (B)=0 * -1= SESSION NOT INITIALIZED OR NOT INSTALLED * (B) NOT DEFINED * ELSE (A) = - TRANS LOG (BYTES) OF TERMINATING ERROR MSG * (ERROR STRING IN BUFFER) * (B) = ERROR CODE * * NOTE: THE CALLING PROGRAM IS PLACED IN THE SESSION CREATED * BY THIS CALL ( IF GOOD LOG-ON ). * * ERROR DIAGNOSTIC MESSAGES RETURNED BY LOGON WILL BE * ISSUED TO THE SYSTEM CONSOLE. * * SKP * * * .LGON NOP STA TEMP SAVE DIRECTORY ENT # LDA .LGON,I FETCH ERROR RETURN BUFFER ADDR STA BUFA CLA,INA SEND 1 WORD LDB DTEMP TO LOGON (ADDR OF DENT IN (B)) JSB .CLGN DM2 DEC -2 LOGON REQUEST * SSA ERROR ? JMP ERR1 YES GET OUT * STA CCLAS SAVE COMMUNICATION CLASS * GETIT LDA DM256 FETCH BUFFER SIZE JSB GETR GO DO A GET JMP ERR1 ER${þúROR ON GET REQUEST * LDA CALL FETCH CALL TYPE ( THAT THE GET FETCHED) CPA D1 MUST BE READ OR WRITE\READ RSS JMP GETIT TRY AGAIN * LDA IOP2 FETCH LOGON STATUS STA TEMP3 SAVE POSSIBLE ERROR CODE SSA,RSS IF NEGATIVE (ERROR TERMINATION) SZA,RSS OR ZERO (GOOD LOGON RETURN) CMB,INB,RSS CONTINUE (SET BYTE COUNT NEG) JMP ISSUE GO PRINT DIAGNOSTIC THEN GET NEXT MESSAGE * SZA IF BAD RETURN LDA B FETCH NEGATIVE TRANS LOG OF ERROR MESSAGE EXIT STA TEMP SAVE RETURN STATUS LDA CCLAS XOR SAVC REMOVE SAVE CLASS BIT STA CCLAS * AGAIN CLA BUFFER LEN IS ZERO JSB GETR MAKE SURE COMMUNICATION CLASS IS RELEASED CLB,RSS ERROR RETURN= CLASS RELEASED JMP AGAIN * ISZ .LGON BUMP RETURN ADDR LDA TEMP3 FETCH POSSIBLE ERROR CODE ALF POSITION IT TO (B). (B) MUST BE ZERO FIRST ASL 6 LDA TEMP RESTORE RETURN STATUS SZA IF GOOD LOG-ON, APPEND THIS PROG TO THE SESSION JMP .LGON,I EXIT * * * THE CALLING PROGRAM IS PLACED IN SESSION BY INSERTING THE * SCB ADDRESS (RETURNED IN CLASS BUFFER BY LOGON) INTO XEQT+32. * LDA XEQT FETCH ID ADDR ADA D32 ADVANCE TO SESSION WORD LDB BUFA,I FETCH SCB ADDRESS JSB $LIBR NOP XSB A,I STORE IN ID SEGMENT LDA TEMP RESTORE RETURN STATUS CLB NO ERROR TO REPORT JSB $LIBX DEF .LGON RETURN * XEQT EQU 1717B * * * * * GETR NOP STA TEMP2 JSB EXEC DEF GET1 DEF DS21 DEF CCLAS DEF BUFA,I RESULT BUFFER DEF TEMP2 DEF IOP1 DEF IOP2 DEF CALL GET1 EQU * RSS ISZ GETR JMP GETR,I * * ERR1 CCA SET ERROR STATUS TO -1 JMP EXIT * * ISH$ SUE CMB,INB SET BYTE COUNT NEGATIVE STB TEMP SAVE TRANS LOG * AND B7700 CHECK FOR ERROR FLAG (791028 2001) SZA,RSS AND CONTINUE IF NON-ERROR JMP GETIT MESSAGE FROM LOGON * JSB EXEC ISSUE LOG-ON DIAGNOSTIC TO SYSTEM CONSOLE DEF IS.1 DEF D2 WRITE DEF D1 LU 1 DEF BUFA,I BUFFER LOCATION DEF TEMP LENGTH IS.1 EQU * JMP GETIT GO MAKE NEXT GET REQUEST * * * * BUFA NOP B7700 OCT 7700 CALL NOP SAVC OCT 20000 D1 DEC 1 D2 DEC 2 D32 DEC 32 TEMP NOP DTEMP DEF TEMP TEMP2 NOP TEMP3 NOP DM256 DEC -256 DS21 OCT 100025 IOP1 NOP IOP2 NOP CCLAS NOP END 7Eÿÿ ÿý" ÿ92067-18092 1903 S C0122 &.UNAM              H0101 x}þúASMB,R,L,C,Q * NAME: .UNAM * SOURCE: 92067-18092 * RELPC: 92067-16125 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .UNAM,7 92067-16125 REV.1903 790129 * * * ENT .UNAM * EXT .CLGN,EXEC * * A EQU 0 B EQU 1 * * * PURPOSE: GIVEN A DIRECTORY ENTRY NUMBER, RETURN CORRESPONDING * USER.GROUP NAME. * * CALLING SEQUENCE: (A)=DIRECTORY ENTRY NUMBER * (B)=RESULT BUFFER ADDRESS (11 WORDS) * JSB .UNAM * DEF ERROR MESSAGE BUFFER(128) * * RTN (A) 0= USER.GROUP NAME IS IN THE RESULT BUFFER (B=0) * -1= SESSION NOT INITIALIZED OR NOT INSTALLED * (B)=0 * ELSE (A) = - TRANS LOG (BYTES) OF TERMINATING ERROR MSG * (ERROR STRING IN BUFFER 2) * (B) = ERROR CODE * * * SKP * * * .UNAM NOP STA TEMP SAVE DIRECTORY ENT # STB RBUF SAVE RESULT BUFFER ADDRESS LDA .UNAM,I FETCH ERROR BUFFER ADDRESS STA BUFA CLA,INA SEND ONE WORD LDB DTEMP TO LOGON (ADDR OF DENT IN (B)) JSB .CLGN DM3 DEC -3 RETURN USER.GROUP NAME * SSA ERROR ? JMP ERR1 YES GET OUT * STA CCLAS SAVE COMMUNICATION CLASS GETIT LDA DM256 FETCH BUFFER SIZE JSB GETR GO DO A GET JMP ERR1 ERROR ON GET REQUEST * LDA CALL FETCH CALL TYPE ( THAT THE GET FETCHED) CPA D1 MUST BE READ OR WRITE\READ RSS JMP GETIT TRË‚  Y AGAIN * LDA IOP2 FETCH LOGON RETURN STATUS STA TEMP3 SAVE POSSIBLE ERROR CODE CPA OK? IF COMPLETION STATUS RETURNED JMP MOVE GO MOVE THE USER.GROUP NAME INTO CALLERS BUFFER * CMB,INB,RSS SET TRANS LOG NEGATIVE & SKIP ERR1 CCB ERROR =-1 EXIT STB TEMP SAVE RETURN STATUS * LDA CCLAS CLEAR SAVE CLASS XOR SAVC BIT STA CCLAS * AGAIN CLA GET ZERO LENGTH BUFFER JSB GETR RELEASE COMMUNICATION CLASS CLB,RSS ERROR ON GET SO GET OUT JMP AGAIN * LDA TEMP3 FETCH POSSIBLE ERROR CODE FROM LOGON ALF POSITION TO (B) (B MUST = 0 FIRST) ASL 6 LDA TEMP FETCH RETURN STATUS ISZ .UNAM .BUMP RETURN ADDR JMP .UNAM,I AND RETURN * * * MOVE LDA BUFA FETCH FROM ADDRESS LDB RBUF FETCH "T0" ADDRESS MVW D11 CLB JMP EXIT RETURN STATUS=0 * * GETR NOP STA TEMP2 JSB EXEC DEF GET1 DEF DS21 DEF CCLAS DEF BUFA,I RESULT BUFFER DEF TEMP2 DEF IOP1 DEF IOP2 DEF CALL GET1 EQU * RSS ISZ GETR JMP GETR,I * * * * SAVC OCT 20000 CALL NOP D1 DEC 1 D11 DEC 11 TEMP NOP TEMP2 NOP TEMP3 NOP DTEMP DEF TEMP OK? OCT 110011 RBUF NOP BUFA NOP DM256 DEC -256 DS21 OCT 100025 IOP1 NOP IOP2 NOP CCLAS NOP END Ž ÿÿ ÿý" ÿ92067-18096 1903 S C0122 &$BITM              H0101 |nASMB,R,L * * NAME: $BITM * SOURCE: 92067-18096 * RELOC: 92067-16103 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $BITM,15 92567-16103 REV.1903 790420 * ENT !BITM * !BITM OCT 0,0,0,0,0,0,0 END 'ÿÿ ÿý" ÿ92067-18097 1903 S C0122 &$MCON              H0101 ƒiASMB,R,L,C * * DATE: 3/02/78 * NAME: $MCON * SOURCE: 92067-18097 * RELOC: 92067-16103 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $MCON,15 92067-16103 REV.1903 790213 * ENT $SMLK,$SMLN,$SMEX,$SMCA,$SMER,$SMCP ENT $SMID,$SMGP,$SMST,$SMDL,$SMII,$SMD# * * $SMLK DEC -15 OFFSET TO LINK WORD $SMLN DEC -14 OFFSET TO LENGTH WORD $SMEX DEC -13 OFFSET TO SCBE WORD $SMII DEC -12 OFFSET TO IDENTIFIER $SMD# DEC -11 OFFSET TO DIRECTORY ENTRY NUMBER $SMCA DEC -10 OFFSET TO CAPABILITY $SMER DEC -9 OFFSET TO ERROR MNEMONIC $SMCP DEC -5 OFFSET TO CPU USAGE WORD $SMID DEC -3 OFFSET TO USER ID $SMGP DEC -2 OFFSET TO GROUP ID $SMDL DEC -1 OFFSET TO DISC LIMIT $SMST DEC 3 OFFSET TO SESSION IDENTIFIER (FROM LINK WORD) END $SMLK xÿÿ ÿý# ÿ92067-18098 2001 S C0122 &$OSAM SAM DESCRIPTOR             H0101 ÂeASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18098 * * RELOCATABLE PART NUMBER : 92067-16103 * * PROGRAMER(S) : J.M.N. * * * * ORIGINAL SAM DESCRIPTOR * BLOCK * NAM $OSAM,13 92067-16103 REV.2001 791016 ENT $OSAM,$BRTX EXT $RTN * $OSAM BSS 20 DEC -1 * * USER INTERFACE TO $RTN * * CALLING SEQUENCE: * * LDA ADDRS ADDRESS OF MEM TO BE RETURNED * LDB WORDS NUMBER OF WORDS TO BE RETURNED * SJS $BRTX * RTN . . . RETURN POINT * $BRTX NOP STA FWA TRANSFER PARAMEERS STB WRDS JSB $RTN FWA NOP WRDS NOP UJP $BRTX,I RETURN END nÞÿÿ ÿý$ ÿ92067-18100 1926 S C0122 &$CLBS              H0101 hqASMB,L NAM $CLIBS 92067-12001 REV.1926 790425 * THIS THE PART NUMBER NAM RECORD FOR THE RTE-IV * VERSION OF THE COMPILER LIBRARY * THE PART NUMBER OF THIS THING IS * 92067-18100 END ˆÚÿÿ ÿý% ÿ92067-18101 1926 S C0122 &GEX.C              H0101 WþúASMB,L,C NAM GEX.C,7 92067-16100 790405 REV. 1926 $CLIB SPC 3 * NAME: GEX.C * SOURCE: 92067-18101 * PGMR: EARL STUTES\SAM * * * CALLING SEQUENCE: LDA function * LDB cr * JSB GEX.C * DEF parameter *iff function<=3 * SPC 3 *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 3 * THIS PROCEDURE HANDLED SEVERAL OF THE DIFFERENCES BETWEEN * RTE II-III AND RTE-M FOR THE COMPILER LIBRARY - THIS IS RTE-IV VERSION * PROC CALLD.RTR(FUNCTION,PRAM,CR); * VALUE FUNCTION,CR; INTEGER FUNCTION,CR; * POINTER PRAM; * FUNCTION IS PASSED IN THE A REGISTER * CR IS PASSED IN THE B REGISTER * PRAM IS A POINTER TO THE SET OF DATA NEEDED BY THE FUNCTION REQUESTED * * THE FUNCTION VALUES ARE: * 0 => CLOSE * 1 => CREATE * 2 => OPEN NEW FILE * 3 => OPEN EXTENT * 4 => OPEN SCRATCH FILE * 5 => CLOSE SCRATCH FILE * * THE PARAMETERS ARE DEFINED BY THE FUNCTION: * * 0 => PRAM = POINTER TO THE NUMBER OF SECTORS TO BE DELETED * 1 => PRAM = A POINTER TO THE SKELETON DIRECTORY ENTRY IN CORE* * 2 => PRAM = POINTER TO THE NAME BUFFER * 3 => PRAM = POINTER TO THE READ/WRITE FLAG * * THE RETURNED PARAMETERS WILL BE RETRIEVED AND PLACED * VARIABLES VISIBLE TO THE CALLER * THE FIRST FIVE ARE THOSE COMING DIRECTLY FROM D.RTR * THE 6TH & 7TH ARE THOSE PARAMETERS NEEDED BY THE NEW OPEN FUNCTION ENT .R1 D.RTR RETURN PARAMETER #1 ENT .R2 D.RTR RETURN PARAMETER #2 ENT .R3 D.RTR RETURN PARAMETER #3 ENT .R4 D.RTë­þúR RETURN PARAMETER #4 ENT .R5 D.RTR RETURN PARAMETER #5 ENT .R6 D.RTR RETURN SECURITY CODE-STRING(6) ENT .R7 D.RTR RETURN TYPE CODE-STRING(1) * BEGIN * CASE FUNCTION OF * MAKECLOSECALL; * MAKECREATCALL; * MAKEOPENCALL; * MAKEOPENEXTCALL; * * *SHOULD BE OF THE FORMAT: * (1) NAME (1,2) * (2) NAME (3,4) * (3) NAME (5,6) * (4) TYPE * (5) * (6) 0 OR -1 * (7) #SECTORS REQUESTED OR -1 FOR REST OF CART * (8) RECORD SIZE * (9) SECURITY CODE * DOSCRATCHOPENTRICK; * DOSCRATCHCLOSETRICK; * ESAC; * FETCHRETURNPRAMETERS; * IF ERROR THEN * GO ERROR EXIT; * IF FUNCTION = NEWOPEN * END OF CALLD.RTR SKP ENT GEX.C ENT PROBT EXT EXEC GUESS WHO EXT RMPAR PARAMETER PASSING - DOS LIB EXT C.FAD FCB FILE DIRECTORY WORD EXT C.EXT FCB EXTENT COUNTER EXT C.HLU FCB HEAD LU EXT C.HTR FCB HEAD TRACK EXT C.STR FCB CURRENT START TRACK EXT C.FLU FCB LOGICAL UNIT EXT C.#SC FCB BLOCKS / EXTENT A EQU 0 B EQU 1 PROBT OCT 74000 DISC PROTECT BITS MYID EQU 1717B FUNCT BSS 1 THE PASSED IN FUNCTION PARAMETER CR BSS 1 THE PASSED IN CR PARAMETER SCTRS BSS 1 EITHER CURRENT SECTOR OR #OF SECTORS TRACK BSS 1 THE TRACK BEING WRITEN ON OR READ FROM DLU BSS 1 .M1 DEC -1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .9 DEC 9 .14 DEC 14 QSKED DEC 23 EXEC SCHEDULE REQUEST CODE NEWOP EQU .2 NEW OPEN FUNCTION CODE D.RTR ASC 3,D.RTR LIMEM EQU 0 A FAKE FOR RTE II-III SPC 2 GEX.C DEF LIMEM THIS IS REALLY THE ENTRY POINT DST FUNCT SAVE PASSED PARAMETERS AD‰MþúA JTAB FUNCTION CASE STATMENT JMP A,I SPC 2 JTAB DEF JTBL JTBL JMP CLOSE JMP CREAT JMP NOPEN JMP EOPEN JMP SOPEN JMP SCLOS SPC 3 CREAT JSB INDC. GET THE PARAMETER JSB EXEC CALL D.RTR DEF *+10 DEF QSKED DEF D.RTR DEF MYID DEF .1 DEF CR DEF .0 DEF .0 DEF .PRAM,I DEF .9 JMP FETCH EXIT CASE SPC 3 NOPEN JSB INDC. GET THE PARAMETER POINTER LDA .PRAM,I GET THE PARAMETER IOR =B100000 SET THE EXCLUSIVE OPEN BIT IN THE NAME STA .PRAM,I LDA MYID IOR =B100000 SET THE NEW OPEN BIT IN THE ID STA IMYID ADB .4 .PRAM IS IN B ALSO LDA B,I STA .R6 JSB EXEC CALL D.RTR DEF *+10 DEF QSKED DEF D.RTR DEF IMYID DEF .0 DEF CR DEF .R6 DEF .0 DEF .PRAM,I DEF .3 JMP FETCH EXIT CASE SPC 3 * THE FOLLOWING ALGORITHM IS THE EXTENT OPEN ALGORITM * THAT WILL HANDLE BOTH SYSTEM TRACKS AND FMGR EXTENTS * NOTE THAT SYSTEM TRACKS ARE REUSED WHEN POSSIBLE AND * IN FACT THE REWIND FUNCTION IS SIMPLY AN OPEN EXTENT 0 * OF AN ALREADY OPEN FILE * IF NOT FMGRFILE THEN * [ IF FCB.EXTENT = 0 THEN * [ NEWLU := FCB.HLU; * TRLU := FCB.HEADTRACK; ] * ELSE * [ READPRIVATEDIRECTORY; * IF NEWTRACK THEN * IF R/WFLAG THEN * [ A := -12 * GO ERROR EXIT;] * ELSE * [ INITIALIZEANEWTRACK; * WRITEPRIVATEDIRECTORY; ] * SETUPD.RTRETURN ] * ELSE SPC 2 * IF NOT FMGRFILE THEN EOPEN JSB INDC. GET THE PARAMETER POINTER LDB C.FAD,I SZB JMP L2 * IF FCB.EXTENT = 0 THEN LDA C.EXT,I SZA JMP LX * [ NEWLU := FCB.HLU; * TRLU := FCB.HEADTRACK; DLD C.HTR,I JMP LA * ELSE * [ READPRIVATEDIRECTORY; LX EQU * LDA ·ÐþúC.FLU,I STA DLU LDA C.STR,I STA TRACK LDA C.#SC,I ALS STA SCTRS JSB REDPD * IF NEWTRACK THEN DLD TRLU FROM EXEC READ SSA,RSS JMP LA * IF R/WFLAG THEN LDA .PRAM,I SSA,RSS JMP LB * [ A := -12 LDA =D-12 * GO ERROR EXIT;] JMP EXIT * ELSE * [ INITIALIZEANEWTRACK; LB EQU * JSB INNEW * WRITEPRIVATEDIRECTORY; ] * (LINK DATA ONTO OLD TRACK) LDA C.#SC,I ALS STA SCTRS JSB EXEC DEF *+6+1 DEF .2 DEF C.FLU,I DEF TRACK DEF .2 DEF C.STR,I DEF SCTRS DLD TRACK FROM EXEC WRITE ABOVE LA EQU * * SETUPD.RTRETURN ] STB C.FLU,I JSB SD.RN ISZ GEX.C JMP EXIT * ELSE L2 EQU * LDA .PRAM,I MAKEOPENEXTCALL LDB .6 SZA,RSS ADB .2 STB FUNCT JSB EXEC DEF *+8 DEF QSKED DEF D.RTR DEF MYID DEF FUNCT DEF C.FAD,I DEF C.FAD+1,I DEF C.EXT,I JMP FETCH SPC 2 CLOSE JSB INDC. MAKECLOSECALL LDB B,I .PRAM STILL IN B ASR 16 MAKE .PRAM DBL WRD * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-ALLOWS CORRECT TRUNCATION OF FILES (ALMOST). *NOTE THAT 1 BLOCK IS STILL LEFT AFTER TRUNCATION. * STA .PRAM+1 STB .PRAM * *THAT'S IT! * CEXEC JSB EXEC DEF *+10 DEF QSKED DEF D.RTR DEF MYID DEF .0 DEF C.FAD,I DEF C.FAD+1,I DEF .0 DEF .PRAM DEF .2 JMP FETCH SPC 3 SOPEN JSB INNEW INITIALIZEANEWTRACK; * SET UP PRAMS FOR D.RTR LIKE RETURN LDA TRACK JSB SD.RN LDA DLU STA .R2 CLA STA C.FAD,I STA C.FAD+1,I STA .R6 LDA =D3 STA .R7 JMP EXIT SCLOS LDA C.HTR,I STA E†þúTRACK STA TRLU * DLU := NLU := FCB.HLU; LDA C.HLU,I AND =B77 STA DLU STA NLU LDA C.#SC,I ALS STA SCTRS *DO [ READPRIVATEDIRECTORY; CLOOP JSB REDPD * GIVETRACKBACK; ] JSB GIVBK LDA NLU AND =B77 STA DLU LDA TRLU STA TRACK * UNTIL (TRLU < 0); SSA,RSS JMP CLOOP JMP GEX.C,I * ESAC; SPC 3 FETCH ISZ GEX.C JSB GETPR LDA .R1 CHECK FOR ERRORS SSA JMP GEX.C,I ERROR OUT JSB EXEC DEF *+5 DEF .14 DEF .1 DEF .R7 DEF .6 LDB .R7 BLR,RBR STB .R7 LDA .R7+3 MOVE FILE SIZE TO IMITATE OLD D.RTR SZB,RSS CLA STA .R1 * IF FUNCTION = NEWOPEN LDA FUNCT CPA NEWOP JMP FILID CPA .1 JMP *+2 JMP EXIT FILID DLD .R2 DST C.FAD,I EXIT ISZ GEX.C JMP GEX.C,I SPC 3 GETRK BSS 1 GET A SCRATCH TRACK FROM THE SYSTEM JSB EXEC DEF *+5+1 DEF .4 DEF .1 DEF TRACK DEF DLU DEF SCTRS JMP GETRK,I SPC 3 GIVBK BSS 1 GIVE A TRACK BACK TO THE SYSTEM JSB EXEC DEF *+4+1 DEF .5 DEF .1 DEF TRACK DEF DLU JMP GIVBK,I SPC 3 INNEW BSS 1 GET A NEW TRACK FROM THE SYSTEM JSB GETRK LDA SCTRS ADA =D-2 STA SCTRS JSB EXEC AND INITIALIZE THE LAST BLOCK TO DEF *+6+1 INDICATE THE END OF THE TRACK CHAIN DEF .2 DEF DLU DEF .M1 DEF .1 DEF TRACK DEF SCTRS JMP INNEW,I SPC 3 REDPD BSS 1 READ THE TRACK LINK DATA JSB EXEC DEF *+6+1 DEF .1 DEF DLU DEF TRLU DEF .2 DEF TRACK DEF SCTRS JMP REDPD,I SPC 3 SD.RN BSS 1 SETUPD.RTRETURN ¾$"STA .R4 THE TRACK WORD LDA SCTRS STA .R1 NUMBER OF SECTORS IN THE FILE ADA =D2 ALF,ALF STA .R5 JMP SD.RN,I SPC 3 INDC. BSS 1 CLEAR INDIRECTS AND FETCH THE PARAMETER POINTER LDB GEX.C ILOOP LDB B,I RBL,CLE,SLB,ERB CLEAR THE I-BIT AND TEST JMP ILOOP STB .PRAM JMP INDC.,I GETPR BSS 1 FETCH THE D.RFP\D.RTR RETURN PARAMETERS JSB RMPAR DEF *+2 DEF .R1 JMP GETPR,I SPC 3 .R1 BSS 1 .R2 BSS 1 .R3 BSS 1 .R4 BSS 1 .R5 BSS 1 .R7 BSS 5 4 PLACEHOLDERS FOR RTE 2,3+4 .R6 BSS 1 .PRAM EQU .R1 TRLU EQU .R4 IMYID EQU .R5 NLU EQU .R5 END Ò¿$ÿÿ ÿý + ÿ92067-18103 2040 S C0122 &$CSY4 OPERATING SYSTEM HEADER             H0101 RASMB,R,L * NAME: $CSY4 * SOURCE: 92067-18103 * RELPC: 92067-16102 * PGMR: G.L.M.,AJIT * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $CSY4,0 92067-16102 REV.2040 800801 * * * * * * * * * * * * * * * * * * END sqÿÿ ÿý!' ÿ92067-18104 2040 S C0122 &DISP4 DISPATCHER MODULE             H0101 ÍÎþúASMB,R,L,C,Q ** DISP4 -- RTE-IV DISPATCHER MODULE ** HED DISP4 -- RTE-IV DISPATCHER * DATE: 2/16/77 * NAME: DISP4 * SOURCE: 92067-18104 * RELOC: PART OF 92067-16102 * PGMR: G.A.A.,L.W.A.,D.L.S.,E.J.W.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DISP4,0 92067-16102 REV.2040 800730 * ***** AMD ***** JUL,73 GAA ***** GSD ***** FEB,77 EJW * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$BRED,$ZZZZ,$XCQ,$RVAL,$DCPU,$LICE ENT $ALDM,$DMAL,$SMAP,$PRCN ENT $XDM,$MAXP,$UNPE ENT $BG1,$BG2,$BG3,$BG4,$BG5 ENT $RT1,$RT2,$RT3,$RT4,$RT5 ENT $MM1,$MM2,$MM3,$MM4,$MM5 ENT $PGID,$SGID,$DS1K * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $MRMP,$MATA,$MPFT,$BGFR,$RTFR,$SVAL,$SMCP,$SPRI EXT $EMRP,$RSRE,$ABRT,$XSIO,$DREQ EXT $WATR,$TIME,$DREL,$TRRN,$SZIT EXT $MCHN,$MBGP,$MRTP,$CFR,$WORK EXT $IOCL,$IRT,$IDLE,$DVPT,$IDEX,$CMST EXT $SDA,$SDT2,$MNP,$XDMP,$SCXX EXT $ABRE,$LIST,$RTST,$SGAF,$OTAT,$OPRI,$ERMG EXT $ELTB,$EQCL * * ******************************************************************** SKP * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--¿9þú------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *********** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * * ACTIVITY PART'N STATUS ID STATUS *................................................................ * PROGRAM BEING LOADED 0 1 BIT 8 SET * PROGRAM IS IN PARTITION 1 1-6 * SWAPPING OUT 2 €Öþú 1-6 * SEGMENT BEING LOADED 2 2 * PROGRAM IS SWAPPED OUT 3 1-6 * SUBPARTITIONS BEING SWAPPED OUT 4 1-6 * SUBPARTITIONS ALL SWAPPED OUT 5 1 * * NOTE: IF BIT 8 IS SET IN THE STATUS WORD, THE PROGRAM CAN NOT * BE DISPATCHED. * SKP * * * THE DISP MODULE OF THE REAL TIME EXECUTIVE PERFORMS: * * 1. IDLE LOOP IF NO PROGRAMS ARE SCHEDULED OR CAN'T BE EXECUTED * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * SPC 2 ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS * CPB BPOWN DOES THIS GUY OWN THE CPU ? STA BPOWN YES, BUT NOT ANY MORE. * STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES ADA D14 CHECK IF DISC RES. LDA A,I PROGRAM AND D15 STA ATMP SAVE TYPE FOR LATER CHECK CPA D1 IS IT DISC RES. PROG? RSS NO, SKIP. JSB DREL RELEASE ANY SWAP TRACKS * LDB TMP GET THE ID SEG ADDRESS FOR DIST SYS $DS1K NOP AND PROVIDE DS A HOOK INTO THE OS * * * BUMP TERMINATION SEQUENCE COUNTER THEN CLEAR SESSION POINTER * IF PROGRAM NOT UNDER SESSION. * LDB TMP FETCH ID ADDR ADB D31 ADVANCE TO TERMINATION SEQUENCE COUNTER LDA B,I FETCH OLD COUNT ADA B10K BUMP IT (HIGH NIBBLE ONLY) STA B,I RESTORE COUNTER INB ADVANCE TO SESSION WORD * LDA TMP FETCH ID ADDR AGAIN ADA D17 ADVANCE TO TIME ¾iþúWORD LDA A,I ALF,SLA IF THE PROG IS IN THE TIME LIST JMP TIML SKIP THE CLEAR OF SESSION WORD * CLA STA B,I ZAP THE SESSION WORD * * SET (A) FOR RELEASE CALL * TIML LDA ATMP GET PROGRAM TYPE CPA D1 IF MEM RES A<> 0 RSS CLA IF DISC RES A=0 * * LDB TMP RELEASE ANY RE-ENTRENT JSB $ABRE MEMORY PROGRAM OWNS. LDB TMP RELEASE ANY STRING STORAGE JSB $RTST MEMORY THAT THE PROGRAM OWNS. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP LDA B ADA D20 STA TEMP SAVE ADDR OF FLAG WORD LDA A,I ALF,ALF GET FLAG WORD SLA ANY RESOURCES HELD? JSB $TRRN YES, RELEASE THEM * LDA TMP GET ID SEG ADDR OF TERMINATING PROG. LDB $ELTB,I GET EQT LOCK TABLE HEADER. SSB IF TABLE IS NOT EMPTY, JSB $EQCL GO UNLOCK HIS LOCKED EQTS. IF REQUIRED. * CLA IF CURRENTLY LDB TEMP,I STA TEMP,I (CLEAR FLAG WORD) SLB IS HE SERIALLY REUSABLE JMP $XCQ YES,LEAVE IN MEMORY * LDA ATMP GET TYPE CPA D1 IS IT MEM RES? JMP $XCQ YES,DONT FOOL WITH PARTITION * LDA TMP GET ID SEG ADR JSB MATEN GO SET UP POINTERS LDB MID,I GET PARTITION OCCUPANT WORD CPB TMP IS PROG STILL RESIDENT? RSS YES JMP $XCQ NO, DONT BOTHER WITH IT * LDA MLNK,I DID PTTN GET UNDEFINED INA,SZA,RSS BY A PARITY ERROR? JMP X0154 YES. KILL POSSIBLE I/O TRANSFER * LDA MADR,I SSA IS IT A MOTHER PTTN? JMP XN353 YES, MOVE PTTN FROM ALLOC TO FREE * LDB MFLGS SSB IS IT A REAL TIME PARTITION? JMP XN253 YES, RT. MOVE PTTN FROM ALLOC TO FREE JMP XN153 NO, BG. MOVE PTTN FROØ¥þúM ALLOC TO FREE SPC 2 * * D17 DEC 17 D31 DEC 31 B10K OCT 10000 DM8 DEC -8 SPC 2 $MAXP NOP RE-ESTABLISH MAXIMUM PTTN LIST SIZE WORDS CLA INIT ALL MAX SIZE WORD TO ZERO STA $MCHN STA $MRTP STA $MBGP STA NUMCH INIT ALL PTTN COUNTS BY TYPE TO ZERO STA NUMBG STA NUMRT LDA $MNP CMA,INA,SZA,RSS JMP MXPDN IN CASE 0, EXIT DONE * STA CNT SAVE NEG NUMBER OF PTTN ENTRIES LDA $MATA START AT FIRST PTTN * MXPSL JSB MATAD SET UP PTRS TO MAT ENTRY LDA MLNK,I INA,SZA,RSS IS THIS ENTRY UNDEFINED? JMP MXPNX YES, CHECK NEXT PTTN * LDA MADR,I SSA IS THIS A MOTHER PTTN? JMP MXPCH YES, INCRE COUNT * LDA MFLGS SSA IS THIS A RT PTTN? JMP MXPRT YES, INCRE COUNT * LDB DMBGP SET ADDR OF BG POINTER ISZ NUMBG INCRE COUNT OF BG PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX * MXPCH LDB DMCHN SET ADDR OF MOTHER PTTN PTR ISZ NUMCH INCRE COUNT OF CH PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX * MXPRT LDB DMRTP SET ADDR OF RT POINTER ISZ NUMRT INCRE COUNT OF RT PTTNS * MXPSZ LDA MLTH,I RAL,CLE,ERA SEZ IS THIS PTTN RESERVED? JMP MXPNX YES, SKIP MAX SIZE CHECK * AND B1777 CHECK LENGTH OF THIS PTTN STA TEMP AGAINST MAX SIZE SO FAR CMA,INA ADA B,I SSA,RSS IS THIS ONE LARGER? JMP MXPNX NO, TRY NEXT PTTN * LDA TEMP YES, SET UP NEW MAX STA B,I * MXPNX LDA MLNK ADA MATSZ INCRE TO NEXT PTTN MAT ENTRY ISZ CNT DONE YET? JMP MXPSL NO, DO NEXT PTTN * MXPDN LDA NUMCH YES, DONE SZA,RSS SET THE PROPER FREE LIST PTR STA $CFR TO ZERO IF THE LIST IS EMPTY LDA NUMRT FOR THE LSTIN SUBROUTINE 7xþú SZA,RSS STA $RTFR LDA NUMBG SZA,RSS STA $BGFR JSB LSTIN RE-INIT MAT LIST PTRS JMP $MAXP,I RETURN * * NUMCH NOP 0 AT BOOT UP NUMBG NOP 0 AT BOOT UP NUMRT NOP 0 AT BOOT UP DMCHN DEF $MCHN+0 DMBGP DEF $MBGP+0 DMRTP DEF $MRTP+0 * * * INITIALIZE PARTITION MEMORY ALLOCATION TABLE ENTRY LIST POINTERS * CALLED BY BOTH DISPATCHER'S STARTUP CODE AND $MAXP * LSTIN NOP LDA $RTFR IS THERE A RT LIST OR CPA NUMRT WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI1 YES, CHECK BG LIST * LDA ABGFR NO, SET UP RT TO SAME AS BG STA ARTFR LDA ABGPR STA ARTPR LDA ABGDM STA ARTDM LDA $MBGP STA $MRTP JMP LSTI2 * LSTI1 LDA $BGFR IS THERE A BG LIST OR CPA NUMBG WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI2 YES, CHECK MOTHER PTTN LIST * LDA ARTFR NO, SET BG LIST POINTERS TO RT STA ABGFR LDA ARTPR STA ABGPR LDA ARTDM STA ABGDM LDA $MRTP STA $MBGP * LSTI2 LDA $CFR IS THERE A MOTHER PTTN LIST OR CPA NUMCH WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTIN,I YES, RETURN * LDA ABGFR NO, SET MOTHER LIST SAME AS BG STA ACHFR LDA ABGPR STA ACHPR LDA ABGDM STA ACHDM LDA $MBGP STA $MCHN JMP LSTIN,I RETURN. AT LEAST ONE LIST REQUIRED * * SKP * CALLING SEQUENCE * JMP $XCQ DIRECT ENTRY IN SYSTEM MAP * OR * JMP $XEQ ENTRY VIA TABLE AREA I IN EITHER MAP * $XCQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO £©þú JMP $IRT GO CONTINUE CURRENT PGM * X0005 LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME X0035 LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA,RSS ANY MORE IN SKEDD LIST? JMP ILOOP NO, GO TO IDLE LOOP * CPA SGSUP IS THIS PROG SEGMENT SUSPENDED? LDA A,I YES, SKIP TO NEXT PROG SZA IF ZERO,THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * ILOOP STA FENCE SET THE FENCE TO ZERO OTA 5 STA XEQT CLEAR XEQT ADDRESS VALUE LDA DSLIC FETCH LOCATION OF DUMMY SLICE COUNTER STA $LICE AND SET IT UP FOR RTIME LDA SCPU FETCH ADDR OF DUMMY CPU USAGE BUFFER STA $DCPU AND SET THAT UP FOR RTIME LDB DIDLE RSS LDB B,I GET DIRECT ADDR RBL,CLE,SLB,ERB FOR IDLE LOOP JMP *-2 STB XSUSP SET BASE PAGE POINTERS INB TO POINT TO DUMMY STB XA LOCATIONS. STB XB STB XEO STB XI JMP $IRT GO TO IDLE LOOP (JMP *) * DIDLE DEF $IDLE+0 DIRECT ADDR TO IDLE LOOP SKP * * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DúÃþúETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS INA STA ZSTAT STATUS ADDRESS ADA D6 STA ZMPID MAP WORD ADDRESS ADA D7 STA ZEMA EMA WORD (ID WORD 28) ADA D2 STA ZTSLC TIMESLICE WORD ADA D2 STA ZSESN SESSION WORD * LDA ZEMA,I JSB IDXAD GET ID EXT ADDR JMP X0012 NOT EMA, CLEAR ZIDEX X0012 STA ZIDEX SAVE ADDR OF ID EXT OR 0 * * CHECK IF CURRENT PGM IS STILL TOP. * LDB XEQT SEE IF PROGRAM CURRENTLY EXECUTING SZB,RSS YES SKIP JMP X0030 NO, SO GO SET NEW ONE UP * ADB D15 CHECK STATUS OF XEQT ID SEGMENT LDA B,I AND B417 MASK TO MAJOR STATUS & LOAD FLAG * * NOTE: THE LOAD FLAG SHOULD NEVER BE SET ON THE * XEQT PROGRAM. THIS FLAG IS ONLY SET WHEN * A PROGRAM IS IN TRANSITION (LOAD OR SWAP * IN) FROM THE DISC. * CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH * LDA ZPRIO,I FETCH PRIORITY OF PGRM ON TOP OF LIST CMA,INA SET IT NEGATIVE ADA XPRIO,I AND COMPARE WITH XEQT'S PR-þúIORITY * SSA IF XEQT HIGHER PRIORITY, JMP $RENT GO CONTINUE. * SZA IF PGRM ON TOP OF LIST HIGHER, JMP X0030 GO ATTEMPT SWITCH OF CONTROL. * * * THE CONTENDING PROGRAM HAS EQUAL PRIORITY. * * * IF THE XEQT PROGRAM HAS USED A FULL TIMESLICE, ATTEMPT * EXECUTION SWITCHING. * ADB D15 ADVANCE TO XEQT'S TIMESLICE WORD LDA B,I FETCH IT SZA IF FULL SLICE NOT USED JMP $RENT GO CONTINUE XEQT * LDA $RVAL FETCH TS. RESET VALUE IN CASE CONTENDER CPB ZTSLC IS REALLY XEQT. JMP SETS2 YEP IT'S XEQT, SO RESET TS. VALUE AND CONTINUE * * * * NOTE: THE TIMESLICE WORD IS SET TO A 1 WHEN THE PROGRAM * IS ENTERED INTO THE SCHEDULED LIST ($LIST PROCESSOR). * * * * * CHECK NEW PROGRAM FOR "LOAD IN PROGRESS" FLAG. * X0030 LDA ZSTAT,I IF THIS ALF,ALF PROGRAM IS SLA BEING LOADED, JMP X0035 GO GET THE NEXT ONE IN THE LIST. * * * CHECK PROGRAM TYPE * LDA ZTYPE,I PROGRAM TYPE AND D15 CPA D1 CHECK IF MEMORY RESIDENT JMP X0F40 YES, SET UP TO RUN NOW * LDB ZMPID,I SSB ASSIGNED TO A PARTITION? JMP PCHK YES, GO SEE WHAT TYPE * LDB ZIDEX SZB IS THIS AN EMA PROG? JMP X0300 YES * CPA D2 REAL TIME DISC RESIDENT? JMP X0200 YES * CPA D3 BACKGROUND DISC RESIDENT? JMP X0100 YES, TREAT AS BG * CPA D4 LARGE BACKGROUND DISC RESIDENT? JMP X0100 YES * JMP X0035 NOT LEGAL TYPE, IGNORE * PCHK LDA B ASSIGNED TO PTTN AT LOAD TIME? AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR ADA D3 LDB A,I SSB IS IT MOTHER PTTN? JMP X0300 YES * ADA D2 GET FLAG WORD LDA A,I X.þú SSA IS IT RT? JMP X0200 YES JMP X0100 NO,BACKGROUND * ATMP NOP B417 OCT 417 SKP ADMEM DEF MEMID MEMID NOP MPN NOP INDEX TO MPFT, BP FLAG LTH NOP LSTHD NOP NPGN NOP SPRIO NOP BPOWN NOP BPOWN IS CURRENT OWNER OF BP & THUS CPU HED DISP4 -- SET UP PROGRAM ID SEG ADR IN XEQT AREA * * ******************************************************************** * * OK, WE HAVE ARRIVED AT THE POINT THAT WE KNOW WHICH * PROGRAM WE INTEND TO EXECUTE. SO LETS SET UP THE * BASE PAGE POINTERS ON BEHALF OF THE NEW XEQT PROGRAM. * * REMEMBER XEQT OWNS ALL OF BASE PAGE FOR AS LONG AS HE * EXECUTES. ON SIMPLE INTERUPTS WE DON'T NEED TO RESET * UP BASE PAGE BECAUSE IT IHAS ALREADY BEEN SET UP TO * BELONG TO XEQT. * ******************************************************************** * * * * * ****************************************** * * * * * INITIAL (RE)DISPATCH OF MEM RES PROG * * * * * ****************************************** * * X0F40 LDA ZWORK GET THE ID OF PROG WE WANT TO DISPATCH LDB ZMPID CPA BPOWN DOES HE ALREADY OWN CPU ? JMP XRENT YES, SO SKIP THE BASE PAGE SET UP * CLA STA XMATA STA XIDEX * LDA $EMRP LDB A GET THE MEM RES BP LIMITS. JMP RTSET NOW SET EM UP. * * * ****************************************** * * * * * INITIAL (RE)DISPATCH DISC RES PROG * * * * * ****************************************** * * X0040 LDA ZWORK GET THE ID OF PROG WE WANT TO DISPATCH LDB ZMPID CPA BPOWN DOES HE OWN THE CPU ? JMP XRENT YES, SO SKIP%þú THE BASE PAGE SET UP. * LDA MLNK GET THE MATA LINK ADDRESS STA XMATA SET INTO BASE PAGE LDA ZIDEX SAME WITH EMA PROG FLAG STA XIDEX * LDB ZWORK ADB D21 LDA B,I GET LENGTH OF PROG AND B76K ADA DM1 STA LTH ADB DM7 LDA B,I GET TYPE ADB D8 INDEX TO LOW MAIN LDB B,I B = LOW MAIN, A = TYPE WORD * ERA,RAR NOW SET E= 0 FOR RT PROGRAM SEZ,CCE,SLA,RSS AND E= 1 FOR BG PROGRAM CLE * LDA B A = B = LOW MAIN ADA LTH A = XX777 IE HIGHEST ADDRESS OF PROGRAM SEZ,RSS THIS A RT PROGRAM ? JMP RTSET YES. * STB BGDRA NO, BG. SET UP THE BASE PAGE ADB DM1 B = LOW MAIN - 1 STB AVMEM JMP R.SET * RTSET STA BGDRA SET UP THE RT BP WORDS STA AVMEM R.SET STA BGLWA STB RTDRA * LDB ZWORK ADB D21 INDEX TO MEMORY PROTECT FENCE SETTING LDA B,I RAL,ALF ALF SET UP THE VALUE FOR LATER AND D7 STA MPN * XRENT INB LDA B,I STA XI SET AS X REGISTER SAVE AREA * LDB ZWORK !!!!!!!!!!!!!!! COMMIT !!!!!!!!!!!!!!!!!!!!!!! STB XEQT !!!!!!!!!!!!!!! RTE IV !!!!!!!!!!!!!!!!!!!!!!! * STB BPOWN THIS CPU BELONGS TO BPOWN * * * LDA DM12 LOAD PROGRAM TO BE EXECUTED STA TMP INTO XEQT AREA LDA XQDEF X0041 STB A,I INA INB ISZ TMP JMP X0041 * * * ************************************************ * * * * * DEFINE TIMESLICE WORD AND CPU USAGE * * * LOCATION. THE SLICE VALUE IS CALCULATED * * * AS FOLLOWS: S=SYS QU* PRI MULT+SYS QU * * * WHERE : SYS QU= DEFAULT SYSTEM QUANTUM * * * DEFINED BY "QU" CMND×jþú * * * : PRI MULT=BITS 8-15 OF PROG'S * * * PRIORITY (IN LOW END) * * * * * * NOTE: SYSTEM LOCATIONS ARE USED IF XEQT * * * IS NOT TO BE TIMESLICED OR ISN'T A * * * SESSION PROGRAM. * * * * * ************************************************ * * DEFINE CPU USAGE LOCATION * X0042 LDB ZSESN,I FETCH POSSIBLE SCB ADDRESS FOR THIS PROGRAM ADB $SMCP ADD OFFSET TO CPU USAGE LOCATION INB BUMP TO LEAST SIGNIFICANT WORD (DOUBLE INTEGER) LDA ZSESN,I FETCH ID'S SESSION WORD SZA IF SSA NOT A SESSION PROGRAM LDB SCPU USE THE DUMMY SYSTEM LOCATION * STB $DCPU THE DOUBLE WORD INTEGER LOCATION * * * * DEFINE TIMESLICE VALUE FOR TIMESLICED PROGRAMS * * LDB DSLIC FETCH DUMMY SYSTEM TIMESLICE LOCATION LDA ZPRIO,I FETCH PRIORITY OF PROGRAM TO BE ENTERED ADA $SPRI COMPARE WITH TIMESLICE PRIORITY SSA,SZA IF HIGHER (LOWER NUMBER) THAN TIMESLICE PRIORITY JMP SETS DO NOT TIMESLICE THIS PROGRAM * LDA ZTSLC,I ANY REMAINING SLICE FOR THIS PROGRAM ? SSA JMP SETS2 YES - CONTINUE WITH REMAING SLICE * LDA ZPRIO,I NO REMAINING SLICE SO ALF,ALF CALUCLATE A NEW ONE. USE BITS 8-15 AND B377 AS A MULTIPLIER CLO MPY $SVAL TO ARRIVE AT TS VALUE * * ADA $SVAL ADD DEFAULT SLICE BACK IN SOC CHECK FOR RESULT LDA D32K > 32K. USE 32K, YOU CAN'T BE SERIOUS! CMA,INA SET SLICE NEGATIVE * SETS2 LDB ZTSLC FETCH ADDR OF ID WD 30 STA B,I SET THE TIMESLICE VALUE STA $RVAL SAVE ORIGIONAL VALUE FOR POSSIBLE RESET SETS STB $LICE SET POINTER TOÖþú TIMESLICE LOCATION * LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * SKP * ******************************************* * * * * * CONTINUE WITH XEQT * * * * * ******************************************* * * * CHECK IF POINT OF SUSPENSION IS LIBRARY AREA * * * $RENT LDA XEQT (RETURN FROM EXEC) INDEX TO TYPE ADA D14 WORD STA ZTYPE AND SAVE FOR A MOMENT LDA A,I LDB $MRMP & ADDRESS OF MEM RES MAP AND D7 KEEP ONLY TYPE BITS CPA D1 THIS A MEM RES PROG ? USB YES, SO SET UP USER MAP * LDB XEQT GET THE RENT BIT ADB D20 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE * SLB IF MEMORY MOVED JSB $RSRE GO RESTORE IT LDA ZTYPE,I ERA,RAR CMA,SSA,SLA,RSS IS THE PROG MEM RESIDENT ? JMP X0028 NO, DISC RES CAN'T BE USING MEM RES LIB * LDA LBREG MEMORY RESIDENT AND REENTRANT LDB LB#PG CBX CLEAR WRITE-PROTECT BITS FROM LDB LBPG# RESIDENT LIBRARY PAGES XMS LDA MPN CHECK MRP'S MPFTI ARS SZA MPN > 1 ? JMP X0028 YES, USE THAT MP FENCE SETTING * LDA LBORG NO, LOWER MP FENCE FOR M.R.L. JMP X0029 FROM MRP WITH NO COMMON * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * ID SEG WORD 21 !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !RP/ #PAGES / MPFTI /**/ PARTITION # ! * ©þú !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * * MPFTI (MPN) = 0 DISC RESIDENT(TYPE 4), NO COMMON * 1 MEMORY RESIDENT, NO COMMON * 2 ANY PROGRAM, RT COMMON * 3 ANY PROGRAM, BG COMMON * 4 ANY PROGRAM, SSGA * 5 DISC RESIDENT(TYPE 2 & 3), NO COMMON * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM * XQDEF DEF XLINK * LBREG NOP RES. LIB. REGISTER # IN USER MAP LBPG# NOP RES. LIB. PHYSICAL PAGE # LB#PG NOP RES. LIB. SIZE IN # OF PAGES $RVAL NOP ***************** DUMMY CPU USAGE LOCATIONS $DCPU NOP SYSTEM POINTER TO CPU USAGE BUFFER SCPU DEF *+2 SYSTEM DUMMY BUFFER NOP NOTE: DOUBLE INTEGER FORMAT NOP ***************** ***************** DUMMY TIMESLICE LOCATION $LICE NOP SYSTEM POINTER TO TIMESLICE COUNTER DSLIC DEF *+1 NOTE: RTIME EXPECTS THE DUMMY SLICE LOCATION NOP TO BE AT (THE ADDRESS OF) $LICE+2 ***************** * D32K DEC 32767 * HED DISP4 -- BUFFERS, CONSTANTS, POINTERS, ETC * ZIDEX NOP ZEMA NOP ZMPID NOP * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE LDB SKEDD SCHED LIST PRIORITY ADDRESS ZSTAT NOP SCHED LIST STATUS ADDRESS ZTSLC NOP SCHED LIST TIMESLICE ADDRESS ZSESN NOP SCHED LIST SESSION ADDRESS SPC 1 TEMP ADB D6 TEMPORARY WORKING STORAGE AREA TEMP1 STB ZPRIO SAVE ADDR OF PRIORITY TEMP2 LDB B,I FETCH FMGR'S ORIGIONAL PRIORITY TEMP3 STB $OPRI AND SAVE IT IN TABLE AREA 2 TEMP4 CLB SET FMGR'S TEMP5 STB ZPRIO,I PRIORITY TO ZERO TEMP6 NOP ZE9•þúXIT JMP $ZZZZ,I TMP NOP TEMPORARY WORKING STORAGE TMP1 NOP TMP2 NOP CN#SC NOP CURRENT # SECTORS/TRACK (-) * DM12 DEC -12 DM3 DEC -3 * D1 DEC 1 D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 D20 DEC 20 D21 DEC 21 D22 DEC 22 D27 DEC 27 D32 DEC 32 D33 DEC 33 * C77 OCT 177700 * B7 EQU D7 B17 EQU D15 B37 OCT 37 B77 OCT 77 B100 OCT 100 B177 OCT 177 B377 OCT 377 B1777 OCT 1777 B76K OCT 76000 * HED DISP4 -- USER MAP BUILDING ROUTINES ******************************************** *ROUTINE TO SET USER MAP CALLED BY DISP4 AND RTIO4 *CALL: * (B) =ADDR MAT ENTRY * (E) = 0 REBUILD USER MAP, SAVE IN BP COPY * (E) = 1 USE CURRENT BP COPY OF USER MAP, IF ANY * JSB $SMAP * REGISTERS MEANINGLESS ******************************************** * * $SMAP NOP STB XMAT SAVE MAT ENTRY ADDR ADB D2 LDA B,I GET ID SEG ADDR STA XIDA ADA D8 LDA A,I SEZ,SZA PT SUSP=0? OR (E)=0? JMP REMAP NO, USE BP COPY OF USER MAP * INB YES, HAVE TO REBUILD USER MAP LDA B,I AND B1777 STA XSTP SAVE PTTN START PAGE # * LDB XIDA ADB D21 LDA B,I AND B76K GET BITS 10-14 ALF RAL,RAL STA XNUM SAVE # OF PROG PAGES * LDA B,I ALF,ALF RAL AND B7 GET MPFT INDEX VALUE SZA,RSS JMP NOCOM =0, DISC RES(TYPE 4), NO COMMON * LDA XIDA =2,3,4 TYPE BG/RT USING COMMON ADA D14 OR TYPE 2 OR 3 WITHOUT COMMON LDA A,I AND B7 GET ID SEG TYPE CCB SET UP FOR TYPES 2,3, OR 4 WITH COMMON ADB $SDA CLE CPA D2 IS IT TYPE 2? RSS YES, RT NEEDS TAII + SDA CPA D3 IS IGþúT TYPE 3? CCE YES, SET E=1 MAP COMMON + TAII + SDA JMP SYSRG NO, LEAVE E=0 MAP ONLY COMMON * NOCOM CCB NO COMMON, TYPE 4 ADB $CMST CLE (E)=0 FOR NOT PRIVILEGED * SYSRG CBX (X)= # PAGES IN TABLES, ETC. LDA D33 (A)= START REG # 33 FOR USER MAP CLB,INB (B)= 1 XMS SEZ,RSS PRIVILEGED PROG? JMP USERG NO * LDB $SDT2 YES, SET WRITE PROTECT BIT CBX (X)= # PAGES IN SDA + $$TB2 LDB $SDA ADB WRPRT (B)= PAGE # OF SDA WITH WRITE PROTECT XMS * USERG LDB XNUM NOW MAP USER CODE PAGES CBX LDB XSTP INB XMS MAP USER PROGRAM * LDB A CMB,INB ADB B100 CBX (X)= # REGISTERS LEFT LDB RWPMP (B)= READ-WRITE PROTECT FLAGS SET XMS * CLB,INB CBX (X)= 1 REGISTER LDB XSTP (B)= 1ST PAGE OF PTTN FOR BASE PAGE LDA D32 (A)= USER BASE PAGE REGISTER # XMS * LDB XMAT JSB PHYBP MAP IN USER BP TO SAVE USER MAP IOR BIT15 (A) = SIGN SET FOR SAVE MAP IN MEMORY USA JMP $SMAP,I RETURN * REMAP LDB XMAT JSB PHYBP MAP IN USER BP TO LOAD USER MAP USA RESTORE USER MAP FROM BP COPY JMP $SMAP,I RETURN * * * PHYBP MAP IN THE PHYSICAL BASE PAGE COPY OF USER MAP * CALL SEQUENCE: (B) = MAT ADDR * JSB PHYBP * (A) = ADDR OF PHYSICAL BP COPY * PHYBP NOP MAP PHYSICAL BP FOR USER PROG ADB D3 FOR SAVE & RESTORE MAP REGS LDA B,I GET PTTN'S FIRST PAGE # AND B1777 WHICH IS THE PHYSICAL BP STA B (B) = PAGE # OF BP CLA,INA CAX (X) = 1 TO SET ONE REGISTER LDA $DVPT WHERE DRIVER PTTN REG NORMALLY IS XMS MAP IN THE PHYSI£þúCAL BP LDA ADBPC GET LOGICAL ADDR FOR BP COPY JMP PHYBP,I RETURN WITH ADDR IN (A) * * ADBPC NOP LOGICAL ADDR IN DRIVER PTTN FOR USER BP COPY RDWRP OCT 140000 READ & WRITE PROTECT RWPMP OCT 141740 READ & WRITE PROTECT END OF MEM WRPRT OCT 040000 WRITE PROTECT ONLY XSTP NOP XIDA NOP XNUM NOP XDMST NOP D3 DEC 3 XMAT NOP DFDMR DEF DVMPR ADDR OF STORAGE FOR DRIVER MAP REG DVMPR NOP DRIVER MAP REGISTER CONTENTS * * *************EXTERNAL ROUTINE TO SET USER MAP******** ***************************************************** **********CALL: LDA IDADR (A) HAS ID SEG ADDR ********** JSB $XDMP ********** ********** (A) =0 IF ERROR-- PROGRAM NOT IN PARTITION * $XDM RBL,RBL CALLED VIA $XDMP ($$TB1) BY JMP STB XDMST SAVE DMS STATUS STA XIDA TEMP SAVE OF ID ADR LDB A ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP * ADB D7 GET MPID WORD LDA B,I AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR STA XMAT SAVE MAT ENTRY ADDR ADA D2 LDA A,I CPA XIDA IS PROG STILL IN PARTITION? JMP XDMOK YES ,CONTINUE * CLA NO, ERROR JMP XDMEX RETURN (A)=0 * XDMOK CCA CAX (X)=1 READ 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DFDMR (B)=ADDR OF SAVE AREA XMM SAVE REG USED FOR MAPPING USER BP CCE (E)=1 TO REUSE BP COPY OF MAP LDB XMAT (B)=MATA ENTRY ADDR JSB $SMAP GO SET MAP CLA,INA CAX (X)=1 WRITE 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DVMPR (B)=SAVED DRIVER PTTN REG VALUE XMS RESTORE REG USED FOR MAPPING USER BP XDMEX JRS XDMST $XDMP,I RETURN (A)#0 * MRPV LDA $MRMP ¼ˆþúUSA SET MEM RES MAP JMP XDMEX RETURN (A)=0 * HED DISP4 -- FIND PARTITION FOR SCHEDULED PROGRAM * ***************************************** * * ROUTINE TO SEARCH FOR A PARTITION * * ***************************************** SPC 2 * FNDSG NOP LDA ZWORK SET UP PTRS TO PTTN JSB MATEN FNDAG LDA ZMPID,I FNDSH CLE,ELA GET ASSIGNED FLAG IN (E) * *AT THIS POINT THE FOLLOWING WORD ARE IN USE * CNT--PARTITION NUMBER PROG LAST IN * MID--MAT ENTRY ADDR FOR PARTITION ID SEG * MPN--BITS 0-3,MPFT INDEX * BIT 15,BP LOAD FLAG(1,RECOVER BP AREA * EREG--RESERVED FLAG,E=1,CNT IS PTTN SPECIFIED * AT LOAD,E=0,CNT IS PTTN LAST IN * LDA MLTH,I RAL (A) HAS "C" BIT IN SIGN LDB MID,I CPB ZWORK PROG STILL IN PARTITION? JMP FDNSW YES * SEZ,CLE NO,IS ASSIGNED FLAG SET? JMP FDSWP YES, TRY TO SWAP OUT OCCUPANT * * SPC 2 * AT THIS POINT WE KNOW THAT THE PROGRAM IS NOT ASSIGNED TO * A PARTITION AND THAT THE PROGRAM IS NOT CURRENTLY IN THE * PARTITION. THAT IS, THE PROGRAM DOES NOT OWN THE PARTITION. * SINCE THE PROGRAM DOESN'T OWN THE PARTITION AN $XSIO CALL * WILL BE REQUIRED TO BRING HIM OFF THE DISC & INTO MEMORY. * THIS MEANS THAT IN ORDER TO DO ANYTHING USEFUL WITH THE * PROGRAM WE NEED AN $XSIO CALL. IF THE CALL IS NOT AVAILABLE * THEN NOTHING CAN BE DONE FOR THIS TYPE PROGRAM (BG) AND WE SHOULD * GO TO THE NEXT GUY IN THE SCHED LIST IF HE IS RT OR EMA SOMETHING * USEFUL IS POSSIBLE. SPC 2 * LDB FNDSG,I GET THE CONTENTS OF THE LDB B,I $XSIO BUSY WORD SZB CALL BUSY ? JMP X0035 YES, GO GET THE NEXT GUY IN SCHED LIST  * ISZ FNDSG NO, SO FIX RETURN & HOP TO IT !!! * * * ********************************** * * SEARCH FOR PARTITION * * *****4qþú***************************** * * LDA ZMPID,I AND B76K GET #PAGES OF CODE - BP ALF (PLUS MSEG, IF ANY) RAL,RAL CMA,INA STA NPGN LDA ZEMA,I SZA,RSS EMA PROG? JMP FNDS3 NO * AND B1777 YES, EMA CMA,INA GET EMA SIZE ADA NPGN ADD TO PROG SIZE STA B LDA ZIDEX,I AND B37 GET #PAGES IN MSEG ADA B SUBTRACT FROM PROG SIZE FOR STA NPGN SIZE PTTN NEEDED EVEN THOUGH EMA * FNDS3 LDB FLIST GET POINTER TO FREE LIST HEADER * * * SEARCH FOR A FREE PARTITION * (B) = POINTER TO LIST HEADER * NPGN= NEGATIVE CURRENT LENGTH * GOES TO NOFRP IF NONE FOUND * * FREE LIST IS IN ORDER OF INCREASING SIZE * SCHFR LDA B,I GET ADR ENTRY(HAS LINK WORD) SZA,RSS END OF LIST JMP NOFRP YES,NO FREE PTTN * STA LSTHD STORE CURRENT ENTRY ADDR * CAX SET UP THE INDEX REGISTER * LAX D4,I GET LENGTH PARTITION SSA PTTN RESERVED JMP FR2 YES, CAN'T USE * RAL,CLE,ELA RAR,RAR SEZ,RSS IS IT IN CHAIN MODE? JMP FR1 NO, SEE IF LARGE ENOUGH * LAX D3,I YES, CHAIN MODE SSA,RSS BUT WAS IT MOTHER PTTN? JMP FR2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * LAX D4,I MOTHER IN CHAIN MODE, OK TO USE * FR1 AND B1777 SCREEN OUT FLAGS ADA NPGN SEE IF GRTR,EQUAL TO CURRENT PRG SSA,RSS IS S=0 PTTN BIG ENOUGH JMP FNDFR FOUND ONE * FR2 LDA LSTHD STA B JMP SCHFR * * UNLINK PTTN FROM FREE LIST * LINK PTTN INTO ALLOCATED LIST * FNDFR LAX D3,I WE SEARCHING THE MOTHER LIST ? SSA WELL ? JMP SUBCH YES, SO GO LOOK AT THE SUB PART'N AVAIL * LDA LSTHD,I GET ADR NEXT ENTRY ST‰SþúA B,I UNLINK CURRENT ENTRY JSB SCHND GO SET MAP ID WORD LDA ZWORK JSB MATEN GO SET UP MAT POINTERS * FNDF1 LDA ZPRIO,I GET NEW PRIORITY STA MPRIO,I PUT IN PARTITION JSB ALINK LINK INTO ALLOCATED LIST CLB SET TO CLEAR RESIDENT FLAG STB MID,I CLEAR PTTN ID WORD JMP FNDSG,I RETURN TO CALLER * * * FOUND A PARTITION AND DON'T NEED TO SWAP * PROGRAM IS STILL IN PARTITION (ALLOCATED) BUT IS DORMANT * OR PROGRAM WAS JUST SWAPPED OUT AND IS STILL IN THERE. * IF IT IS A MOTHER PARTITION, CHAIN IS STILL ACTIVE * FDNSW LDB MADR,I SSA,RSS TEST C-BIT JMP FDNS2 C=0 IT'S OK. * SSB,RSS TEST M-BIT JMP FNDS5 C=1, M=0 SUBPTTN BUSY IN CHAIN! * FDNS2 ISZ FNDSG SET UP RETURN ADDRESS JSB FND C=1 M=1 SET UP FLAGS AND USE IT LDA ZPRIO,I GET PARTITION PRIORITY CPA MPRIO,I IS IT THE SAME AS CURRENT? JMP FNDSG,I YES, CONTINUE * STA MPRIO,I NO, RELINK IN ALLOCATED LIST JSB RLNK CAUSE PROG WAS DORMANT JMP FNDSG,I CONTINUE * FNDS5 LDA MRDFL,I SUBPTTN BUSY, AND D7 GET PTTN STATUS CPA D3 IS HE ALL SWAPPED OUT ?TTN RSS YES, SO RELEASE THIS PART'N & GET ANOTHER JMP X0035 NO, LETS WAIT ON THIS GUY FOR A WHILE * LDA DLIST GET DORM LIST POINTER LDB MLNK AND MAT POINTER JSB UNLNK MOVE OUT OF DORM OR ALLOC LIST AND LDB FLIST INTO FREE LIST. STB TEMPS (SAVE & RESTORE FLIST CAUSE JSB FLINK FLINK CHANGES IT) * LDB TEMPS NOW GO TO TOP OF PART'N SCAN ROUTINE & STB FLIST RESET FREE LIST POINTER FIRST CLA RELEASE OWNERSHIP WORD STA MID,I JMP FNDAG NOW GO GET HIM ANOTHER PARTITION. * * * * * ***************************************** * * PROGRAM WAS ASSIGNED T†úþúO A PARTITION * * ***************************************** * FDSWP LDB MLNK,I INB,SZB,RSS PTTN UNDEFINED BY P.E.? JMP FDOOH OH-OH, YES * ISZ FNDSG FIX RETURN ADDRESS LDB MADR,I SSA,RSS TEST C-BIT JMP FDSW2 C=0 C-BIT NOT SET, IT'S OK. * SSB,RSS TEST M-BIT JMP FDSUB C=1 M=0 SUBPTTN IN CHAIN, MAYBE SWAP. * FDSW2 LDA MID,I C=1 M=1 OR C=0 OK TO TRY SWAP CLE,SZA IS PTTN EMPTY? JMP FDSW1 NO * SSB,RSS THIS A MOTHER ? JMP USEIT NOT A MOM & NOT IN CHAIN. * LDA MLTH,I IS A MOM, BUT IS CHAIN IN EFFECT ? RAL C BIT IN SIGN SSA,RSS IN CHAIN MODE ? JMP SUBAS IS A MOM BUT NOT IN CHAIN JMP FDSW1 IS A MOM IS ALSO IN CHAIN * * USEIT LDA FLIST YES, AN EMPTY PARTITION LDB MLNK UNLINK FROM FREE LIST JSB UNLNK AND USE THIS PARTITION JMP FNDF1 NOW GO LINK IT INTO ALLOCATED LIST * FDSW1 JSB FND GO SET UP AND SWAP LATER JMP FNDSG,I CONTINUE * FDOOH LDA ZMPID,I UNASSIGNED PROG SINCE RAL,CLE,ERA THE PARTITION WENT AWAY STA ZMPID,I BECAUSE OF PARITY ERROR THERE JMP FNDSH TRY TO FIND A PARTITION * * * PROGRAM IS ASSIGNED TO A SUBPARTITION, HOWEVER THAT SUB IS * IN THE CHAIN MODE. SO LETS SEE WHO OWNS THE MOTHER PARTITION * AND SEE IF THAT GUY IS SWAPABLE. * * FDSUB LDB MLNK SAVE MAT ADDR OF PTTN STB LSTHD THAT WE NEED LDB MSUBL,I GIVEN SUBPTTN WITH "C" SET FDSMO LDA D3 FIND THE MOTHER PTTN ADA B LDA A,I SSA IS THIS THE MOTHER PTTN? JMP FDSMD YES, SEE IF MOTHER IS DORMANT * ADB D6 NO, TRY NEXT LINK LDB B,I JMP FDSMO * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION BUT THE MOTHER PARTITION * IS STILL OCCUPIED. SEE IF WE CAN STILL QUALIFY TO FORCE A SWAP * OUT FROoþúM THE MOTHER PARTITION. THE USER SHOULD NOT ASSIGN PROGRAMS * TO A SUBPARTITION IF THAT PROGRAM IS CONTINUOUSLY COMING IN AND * OUT OF THE SCHEDULE LIST. EMA PROGRAM PERFORMANCE WILL BE SEVERELY * DEGRADED. * * FNDSM IS ENTERED WHEN A PROGRAM IS NOT ASSIGNED TO ANY PARTITION * AND NO PARTITION OF THE PROPER TYPE WAS FOUND BUT A SUITABLE * SUBPARTITION WAS FOUND IN A DORMANT MOTHER PROGRAM. * FDSMD STB MOTHR SAVE SUBPTTN'S MOTHER ADDR ADB D5 LDA B,I AND D6 CPA D4 CLEARING OR CLEARED SUBPTTNS? JMP X0035 YES, SKIP IT FOR NOW * FNDSM LDA MOTHR YES, SET MAT ADDRS OF MOTHER PTTN JSB MATAD CCE (E) = 1 FOR SPECIAL SWAP CHECK LDB MID,I (B) = ID FOR SWPCK JSB SWPCK JMP SMABT ABORT - ONLY IF ASSIGNED TO SUBPTTN JMP SWMOM SWAP IS OK, PROG SAVE RES. OR SUSPENDED JMP SMLOD LOAD - PROG TERM. SERIAL REUSE. JMP X0035 CAN'T SWAP, TRY NEXT SCHED PROG * SMLOD CLA LOAD - PROG TERM. SERIAL REUSE. STA MID,I CLEAR MOTHER OCCUPANT, BEFORE USE SUBPTTN LDA FLIST SAVE CURR FREE LIST HEADER STA TEMPS CAUSE UNMOM+FLINK MESSES IT UP LDB MLNK GET MOTHER MAT ADDR JSB UNMOM RELEASE SUBPTTNS LDA TEMPS RESTORE FREE LIST HEADER STA FLIST LDB LSTHD GET MAT ADDR OF SUBPTTN WE NEED JSB UNLNK UNLINK FROM FREE LIST LDA LSTHD JSB MATAD SET UP MAT ADDR JMP FNDF1 SET INTO ALLOC LIST, RETURN * SWMOM LDA CHSWP MOTHER PTTN I/O CALL BUSY? SZA JMP X0035 YES, TRY SCHED NEXT PROG JMP X0325 NO, DO SWAP OUT OF MOTHER PTTN * SMABT LDA ZIDEX CAN WE ABORT MOM FOR LOAD IN SUBPTTN? SZA IS THIS EMA PROG? JMP XM352 YES, ABORT LOAD IN MOM CAUSE CHSWP WILL BE FREE * LDB BGSWP LDA MFLGS SSA IS THIS PROG FOR BG TYPE PTTN? LDB RTSWP *Cþú NO, RT PTTN HAS TO BE USED FOR LOAD SZB IF WE DO ABORT, CAN WE LOAD? JMP X0035 NO, WAIT TILL I/O CALL IF FREE. JMP XM352 YES, ABORT MOM LOAD, WE CAN LOAD. TEMPS NOP SKP * * REACHED END OF FREE LIST AND COULD NOT FIND A PARTITION. * SO NOW WHAT WE WANT TO DO IS SEE IF THIS PROGRAM HAS IN THE * PAST FORCED A SWAP. IF WE HAVE GONE THROUGH FNDSG BEFORE * ON BEHALF OF THIS PROGRAM AND FORCED A SWAP, THEN THAT PART'N * NUMBER WILL BE IN THE PROGRAMS ID SEGMENT. LETS LOOK AND * AND SEE IF THAT PROGRAM IS SWAPPED OUT. IF SO WE WILL USE THAT * PARTITION. THIS SAVES US NEEDLESS SWAP OUTS ON BEHALF OF * A SINGLE PROGRAM. ALSO WE WON'T RETURN A PARTITION BEING * SWAPPED BECAUSE DURING THE SWAP THE $XSIO CALL WILL BE BUSY * AND WE DON'T EVEN GET HERE. * NOTE THAT EVEN IF THIS PROGRAM DIDN'T FORCE THE SWAP, WE CAN * CUT DOWN ON SEARCH TIME. * ONE WORD OF CAUTION. FRESHLY LOADED PROGRAMS HAVE A ZERO * (1ST PARTITION) IN THEIR ID SEGMENT. WE CAN'T TRUST * PARTITION ZERO TO BE THE CORRECT TYPE OF PARTITION. * * NOFRP LDA ZPRIO,I COME HERE IF NO FREE PTTN CMA,INA STA SPRIO SEARCH ALLOC LIST FOR PTTN LDA MRDFL,I GET THE PART'N STATUS WORD AND B7 KEEP ONLY STATUS BITS CPA D3 THE RESIDENT PROG SWAPPED OUT ? CLA,RSS YES ! JMP MMSWP NO, SEE IF WE CAN STEAL IT. * CPA CNT THIS PARTITION = ZERO ? JSB PTNOK YES, SO GO SEE IF PART'N IS A LEGAL ONE. SZA IS ALL OK ? JMP SRCNT NO. GO SEARCH ALLOC LIST. * LDA MADR,I MOTHER BIT IN SIGN OF A-REG LDB MLTH,I GET CHAIN BIT IN E-REG ELB,ELB * SEZ,SSA M=1,C=1/ IE MOTHER & IN CHAIN MODE. JMP FNDSG,I REUSE THE PARTITION. * SEZ,SSA,RSS M=0,C=0 /IE NOT A MOM & NOT IN CHAIN JMP FNDSG,I REUSE THIS PARTITION JMP SRCNT M=1 ÙÚþú& C=0 / OR M=0 & C=1 (CAN'T USE PART'N) * * * * OK, SO SOMEBODY ELSE OWNS THE PARTITION. IF ITS A MOTHER PARTITION * AND THIS THE RESIDENT IS HAVING SUBPARTITIONS CLEARED, THEN IT'S * POSSIBLE TO STEAL THIS PARTITION FROM THE OLD OWNER. LETS SEE. * MMSWP CPA D4 PARTITIONS BEING CLEARED ? CLA,RSS YES CPA D5 PARTITIONS ALL CLEARED CLA,RSS YES JMP SRCNT NO, JUST FORGET THE WHOLE THING. * CPA CNT PART'N # = ZERO JSB PTNOK YES, SEE IF THE PARTITION IS RIGHT TYPE SZA ALL OK ? JMP SRCNT NO. SO GO SEARCH ALLOC LIST. * LDA MPRIO,I GET THE RESIDENTS PRIORITY CMA,INA ADA ZPRIO SEE HOW THIS COMPARES TO THE CONTENDERS PRIORITY SSA,RSS WHO WINS ? JMP SRCNT THE RESIDENT. * LDA ZPRIO THE CONTENDER STA MPRIO,I SET NEW PRIORITY IN MAT TABLE LDA ZWORK AND NEW OWNER TOO * STA MID,I ****** COMMIT PARTITION ****** * JSB RLNK RELINK IN ALLOCATED LIST SINCE THE PRIORITY IS JMP FNDSG,I DIFFERENT. NOW RETURN * * SKP * * THE PTNOK ROUTINE LOOKS AT A PARTITION AND DETERMINES IF * IT IS THE TYPE OF PARTITION WE ARE LOOKING FOR. IT IS * USED BY THE FNGDG ROUTINE TO DETERMINE IF IT IS OK TO * LOAD THE CURRENT ZWORK PROGRAM INTO THIS PARTITION. IN THE * FUTURE THE ROUTINE COULD BE USED TO LOOK AT THE ZWORK * PROGRAMS FATHER AND IF THE SCHEDULE WAS WITH WAIT FORCE A * SWAP OF THE FATHER PROVIDING THE PARTITION THE FATHER * WAS IN IS THE SAME TYPE AS THE SON COULD USE. THIS FEATURE * PREVENT HIGH PRIORITY PROGRAMS FROM HOGGING PARTITIONS * WHEN THEY DON'T NEED THEM. THE ROUTINE SHOULD BE USED * AFTER SCANNING THE FREE LIST AND NOT FINDING AND EMPTY * PARTITION. * * * CALLING SEQUENCE JSB PTNOK * ALL MAT POINTERS (IE MLNK ETC) SET UP * * * * ON RETURN: ›Vþú A REG = 0 ALLS WELL USE THE PARTITION * A REG = -1 PARTITION OF WRONG TYPE OR * PROGRAM TO BIG FOR PARTITION. * * * PTNOK NOP LDB ACHPR FIRST SEE WHAT TYPE PARTITION LDA MADR,I WE ARE SET UP FOR SSA MOTHER ? JMP MOMIT YES. * LDB ABGPR NO. LDA MRDFL,I SSA BG PARTITION ? LDB ARTPR NO, A RT PARTITION. * MOMIT CPB ALIST IS THIS THE TYPE OF PART'N FNDSG CALLED FOR? RSS YES JMP NOPTN NO, MAKE THE NO GO RETURN. * LDA MLTH,I RIGHT TYPE OF PARTITION BUT IS SSA THE PART'N RESERVED ? JMP NOPTN YES, SO WE CAN'T USE IT. * AND B1777 NO, SO GET THE SIZE OF THE PARTITION. ADA NPGN AND CHECK AGAINST THE SIZE OF THE PROG SSA,RSS DOES IT FIT CLA,RSS YES, MAKE THE OK RETURN. NOPTN CCA NO, MAKE THE NO GO RETURN. JMP PTNOK,I RETURN TO CALLER. * SKP * * SRCNT LDB DLIST,I LESS OR EQUAL PRIORITY * * SEARCH FOR SUITABLE ALLOCATED PARTITION. * ALLOCATED LIST IS IN ORDER * OF INCREASING PRIORITIES(I.E. DECREASING * NUMBERS)--EXCEPTION:DORMANT PROGS WITH * SAVED RESOURCES AT FRONT OF LIST * (OF,SS,COMPLET)*********** * NPGN--NEG LENGTH CURRENT * SPRIO--NEG PRIO CURRENT * GOES TO X0035 IF NO PTTN * * SCHAL CPB ALIST END OF DORM LIST? LDB B,I YES, BUMP TO ALLOC LIST CCE,SZB,RSS LIST EMPTY? JMP SCHMO YES, SEARCH DORMANT MOTHER PTTNS * STB LSTHD STORE CURRENT LIST HEAD CBX SET THE INDEX REGISTER * LAX D4,I SSA PARTITION RESERVED JMP SCHL2 YES, CAN'T USE IT * RAL,CLE,ELA RAR,RAR SEZ,RSS IS PTTN IN CHAIN MODE? JMP SCHL4 NO, TEST SIZE * LBX D3,I SSB,RSS MOTHER IN CHAIN MODE? JM“þúP SCHL2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * SCHL4 AND B1777 GET PARTITION LENGTH ADA NPGN SSA,RSS IF S=0, PTTN IF .GE. IN LENGTH JMP SCHL3 LONG ENOUGH * SCHL2 LDB LSTHD,I CCE,SZB,RSS END OF LIST JMP SCHMO NO PTTNS, TRY DORMANT MOTHER PTTNS JMP SCHAL GO TRY NEXT ONE * * * SCHL3 LBX D2,I GET PART ID ADDR SZB,RSS ANYBODY STILL THERE? JMP FNDAL NO, SO USE IT * ADB D14 LDA B,I AND B100 SZA IS CORE LOCK BIT SET? JMP SCHL2 YES, KEEP LOOKING * LAX D1,I NO GET PARTITION PRIORITY ADA SPRIO SUBTRACT CURRENT PRIORITY CMA,SSA,INA,SZA JMP FNDAL CURRENT IS .GT., GO DO IT * * CHECK FOR EQUAL PRIORITY AND RESIDENT HAVING USED A FULL TIMESLICE. * SZA IF CURRENT LIST HEAD LOWER PRIORITY JMP SCHL5 GO SEE IF RESIDENT IS SCHEDULED * LDA D16 FETCH ADA B TIMESLICE WORD LDA A,I OF RESIDENT. SZA,RSS IF A FULL SLICE HAS BEEN USED JMP FNDAL LET THE CURRENT LIST HEAD HAVE IT * SCHL5 INB CURRENT IS .LE. PTTN PRIORITY LDA B,I GET STATUS AND D15 CPA D1 IS PTTN SCHEDULED? JMP SCHL2 YES, GO TRY SOMEONE ELSE * FNDAL JSB SCHND GO SET MAP ID WORD JSB FND GO SET UP RES FLAGS AND MAT JMP FNDSG,I * * * NO RT OR BG ALLOC PTTNS CAN BE FOUND FOR PROGRAM * SO SEARCH THROUGH THE DORMANT MOTHER PARTITION LIST * TO SEE IF ANY SUBPARTITIONS CAN BE RELEASED WHICH * CAN BE USED FOR THIS PROGRAM * * NOTE: E MUST=1 AND B MUST=0 * SCHMO LDA ACHDM SEARCH DORMANT MOTHER LIST CPA DLIST ALREADY LOOKED BECAUSE EMA? JMP NOMOR YES, NOTHING CAN BE DONE * STA MOTHR LDA FLIST WERE WE SCANNING FOR CPA ARTFR A RT PTTN ERB YES, SET TEMP=100000 ÁþúSTB TEMP NO, SET TEMP=000000 * SCHMN LDB MOTHR,I GET NEXT ENTRY SZB ACCIDENTLY END OF LIST? CPB ACHPR OR END OF DORMANT LIST? JMP NOMOR YES, CAN'T USE BUSY MOTHER PTTNS * STB MOTHR ADB D4 LDA B,I SSA IS MOTHER PTTN RESERVED? JMP SCHMN YES, TRY NEXT DORMANT MOTHER PTTN * LDA ABGFR GET THE BG FREE LIST HEAD CPA ARTFR IF SAME AS RT, THEN SKIP TYPE CHECK. JMP SCHSB * INB LDA B,I AND BIT15 JUST KEEP RT BIT CPA TEMP PTTN TYPE MATCH WHAT WE NEED? JMP SCHSB YES, TRY SUBPTTN SIZE CHECK JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * SCHSB LDA MOTHR JSB MATAD LDA MID,I GET ID OF MOTHER PTTN OCCUPANT ADA D14 LDA A,I AND B100 SZA IS CORE LOCK SET? JMP SCHMN YES, TRY NEXT MOTHER PTTN * SCHSN LDA MSUBL,I GET NEXT SUBPTTN PTR SCHNX CPA MOTHR ANY MORE SUBPTTNS? JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * JSB MATAD SET UP MAT PTRS LDA MLTH,I SSA SUBPTTN RESERVED? JMP SCHSN YES, SKIP TO NEXT SUBPTTN * AND B1777 GET SUBPTTN LENGTH ADA NPGN ADD NEG LENGTH NEEDED SSA IS SUBPTTN LONG ENOUGH? JMP SCHSN NO, TRY NEXT SUBPTTN * LDB MLNK YES, SAVE MAT ADDR OF SUBPTTN STB LSTHD FOR FNDSM JSB SCHND SET UP ID SEG FOR SUBPTTN JMP FNDSM MOVE SUBPTTN FROM FREE LIST INTO ALLOC LIST * SPC 1 * SO NOW WE KNOW THAT THERE IS NO PARTITION THAT THE PROGRAM * CAN USE. THAT IS, THE PARTITIONS HE COULD USE ARE LOCKED * UP OR THERE HAS BEEN A PARITY ERROR IN WHAT WAS FORMERLY * THE LARGEST PARTITION OF THAT TYPE (IE BG, RT, OR MOM). * NOW IF THERE HAS BEEN A PARITY ERROR, THEN IF THIS PROGRAM * IS TOO LARGE FOR THE SYSTEM WE SHOULD ABORT IT. IF THERE * HAßSþúS NOT BEEN A PARITY ERROR, THEN JUST GO GET THE NEXT * GUY IN THE SCHED LIST. SPC 1 * NOMOR LDA $UNPE HAS THERE EVER BEEN A SZA,RSS PARITY ERROR ? JMP X0035 NO, SO GET THE NEXT GUY IN THE SCHED LIST * LDA ZWORK YES, I WONDER IF THIS GUY STILL FITS STA $WORK SET UP TO CALL $SZIT & FIND OUT JSB $SZIT GO SEE IT HE STILL FITS SZA,RSS DOES HE STILL FIT ? JMP X0035 YES, GO GET NEXT GUY IN SCHED LIST * LDA ZWORK NO, FLUSH HIM !!! STA XEQT MAKE HIM THE CURRENTLY EXECUTING PROG LDA DP GET THE ERROR CODE LDB BLANK JSB $ERMG ABORT THE MOTHER JMP $XCQ FINISH UP THE ABORTION. * DP ASC 1,DP BLANK ASC 1, D16 DEC 16 * * SUBROUTINE TO SET UP PROGRAM ID SEG TO USE A PARTITION * WHICH WAS FOUND IN A SEARCH OF A LIST. * CALL: * (LSTHD) = ADDR OF PARTITION WHICH WAS FOUND * (ZMPID) = ADDR OF PTTN WORD IN ID SEG * JSB SCHND * * SCHND NOP LDA $MATA GET ADR OF MAT CMA,INA ADA LSTHD CLB DIV MATSZ CALCULATE PTTN # LDB A LDA ZMPID,I GET MAP ID WORD AND C77 IOR B STA ZMPID,I PUT NEW PTTN # IN JMP SCHND,I * * ************************************** * FOUND A PARTITION, SET UP MAT POINTERS AND BP POINTERS * CALL: WORK = ID SEG ADDR OF PROG * JSB FND * ************************************** * FND NOP LDA ZWORK JSB MATEN GO SET UP MAT POINTERS JMP FND,I * DM1 DEC -1 MOM NOP TEMPORARY STORE OF MOTHER MATA ENTRY MOTHR NOP MOTHER MATA ENTRY ADDR OF CURRENT SUBPTTN MOMFL NOP SUBFL NOP SUBFR NOP SUBDM NOP * * * ******************************************** * * FOUND A FREE MOTHER OR WE HAVE * * * A PROGRAM THAT WAS ASSIGNED TO * * * A ™ÌþúSUBPARTITION AND THAT MOTHER * * * PARTITION WAS EMPTY NOW GO SEE * * * IF SUBS ARE OVERLAYABLE OR * * * SWAPABLE * * ******************************************** * * SUBCH JSB SCHND SET PART'N # INTO ID SEG LDA ZWORK SET UP THE MATA POINTERS JSB MATEN * LDA MLTH,I RAL SSA IS "C" SET ALREADY? JMP FNDSG,I YES, USE THIS PTTN * SUBAS LDA MOMFL THIS SECTION OF CODE IN USE ? SZA WELL ? JMP X0035 YES, CAN'T DO THIS, TRY ANOTHER PROGRAM. * LDA MFLGS SSA,RSS SET UP PROPER LIST HEADERS JMP BGSUB * LDA ARTFR RT MOTHER PTTN STA SUBFR LDA ARTDM STA SUBDM JMP SUBC2 * BGSUB LDA ABGFR BG MOTHER PTTN STA SUBFR LDA ABGDM STA SUBDM * * SUBC2 LDB MLNK STB MOMFL SET UP SUBPTTN SWAPOUT FLAGS STB SUBFL WITH THE MOTHER PTTN ADDR * SUBN1 LDA MSUBL,I CHECK NEXT SUBPTTN CPA MOMFL DONE YET? JMP SUBRS YES, SET "C" START SWAPS * JSB MATAD SET UP MAT PTRS LDB MID,I CCE,SZB,RSS IS SUBPTTN EMPTY? JMP SUBN1 YES, SKIP SWAP CHECK * * FIRST SCAN THROUGH SUBPTTNS FOR SWAPPABILITY * JSB SWPCK (E)=1 FOR SUBPTTN SWAP CHECK NOP STOP LOAD NOP SWAP OUT JMP SUBN1 LOAD OK, TEST NEXT SUBPTTN CLA CAN'T SWAP, SUBPTTN NOT AVAILABLE STA MOMFL CLEAR THE CHECK IN PROGRESS FLAGS STA SUBFL LDA ZMPID,I GET THE PARTITION WORD SSA,RSS THIS PROG ASSIGNED ? JMP FR2 NO, SO GO LOOK FOR ANOTHER PART'N JMP X0035 YES, SO FORGET IT * * SUBRS LDA MOMFL ALL SUBPTTNS SWAPPABLE SUBR1 JSB MATAD SO SET "C" FLAG ON ALL * LDA MLTH,I IOR B40K STA MLTH,I LDA MSUBL,I CPS‚þúA MOMFL DONE YET? JMP SUBS0 YES, INITIATE SWAPOUTS JMP SUBR1 NO, KEEP GOING * * SUBS0 LDA MOMFL SEE IF MOTHER PTTN JSB MATAD HAS ANY SUBPTTNS * LDA FLIST *** UNLINK FROM FREE LIST *** LDB MLNK JSB UNLNK * LDA ZPRIO,I GET THE PRIORITY STA MPRIO,I INTO THE PARTITION JSB ALINK *** MOVE INTO ALLOC LIST * LDA ZWORK ***** COMMIT THE PARTITION ***** STA MID,I ***** COMMIT THE PARTITION ***** * LDA MSUBL,I CPA MOMFL ANY SUBPTTNS? JMP SUBDN NO, SO DONE SET PTTN STATUS=5 * LDA MFLGS SET MOTHER PTTN STATUS=4 IOR D4 FOR SUBPTTNS SWAPPING OUT STA MRDFL,I * SUBNX LDA SUBFL GET NEXT SUBPTTN ADA D6 LDA A,I CPA MOMFL ARE WE DONE YET? JMP SUBDN YES, DONE. STA SUBFL SET NEW SUBPTTN ADDR * * * TRY TO SWAP SUBPARTITION. GET HERE FROM I/O CALL COMPLETE CODE SUBSS LDA CHSWP CHECK IN CASE WE CAME FROM RT OR BG CODE SZA IS MOTHER PTTN/EMA CALL BUSY? JMP X0005 YES, SKIP IT FOR A WHILE * SUBS2 LDA SUBFL SET UP MAT PTRS TO SUBPTTN JSB MATAD LDB MID,I CCE,SZB,RSS IS IT EMPTY? (E=1) FOR SWPCK JMP SUBNX YES, DO NEXT SUBPTTN * * SECOND SCAN THROUGH SUBPTTNS AND ACTUAL DO SWAPS * SUBSC JSB SWPCK (E=1) FOR SUBPTTN SWAP CHECK JMP SUBAB ABORT CURRENT LOAD JMP X0325 SWAP CURRENT OCCUPANT OUT JMP SUBNX LOAD OK, CHECK NEXT SUBPTTN LDB MOMFL CAN'T SWAP, SUBPTTN NOT AVAILABLE SUBNL ADB D4 LDA B,I AND C40K CLEAR "C" BIT STA B,I PUT IT BACK ADB D2 LDB B,I GET NEXT SUBPTTN CPB MOMFL DONE YET? JMP SUBDE YES, DEALLOCATE MOTHER PTTN JMP SUBNL NO, CLEAR CHAIN BIT * SUBDE LDA MOMFL UNLINK MOTHER PTTN FROM JSB MATAD ALLOCATED LIST KþúSINCE WE LDA MFLGS STA MRDFL,I SET PTTN STATUS = 0 LDA ACHDM FOUND AN UNSWAPPABLE SUBPTTN LDB MOMFL JSB UNLNK LDA ACHFR STA FLIST LINK IT INTO THE FREE LIST JSB FLINK CLA CLEAR SUBPTTN CLEARING FLAGS STA MID,I UNCOMMIT THE PARTITION STA MOMFL STA SUBFL JMP X0005 GO TO TOP OF SCHED LIST * * SUBAB LDB MID,I ABORT LOAD IN SUBPTTN JSB CLRLD CLEAR LOAD BIT OF PROGRAM BEING LOADED LDA SUBDM TO EXECUTE LATER LDB MLNK UNLINK IT FROM ALLOCATED LIST JSB UNLNK LDA SUBFR AND LINK IT INTO THE FREE LIST STA FLIST JSB FLINK JMP X0154 GO CANCEL LOAD (EXITS VIA $IOCL) * * SUBDN LDA MOMFL SET UP MOTHER PTTN PTRS JSB MATAD SUBDX LDA MSUBL,I NOW UNLINK ALL SUBPTTNS FROM LISTS CPA MOMFL DONE YET? JMP SUBCL YES, SUBPTTNS ALL CLEARED * JSB MATAD SET UP SUBPTTN PTRS LDA SUBFR GET FREE LIST HEADER LDB MID,I SZB IS SUBPTTN EMPTY? LDA SUBDM NO, UNLINK FROM ALLOC LIST LDB MLNK JSB UNLNK UNLINK ENTRY FROM LIST CLA STA MID,I CLEAR OUT OCCUPANT WORD LDA MFLGS STA MRDFL,I CLEAR STATUS FIELD TOO LDA MADR,I ALSO CLEAR THE DORM BIT IOR B20K XOR B20K STA MADR,I JMP SUBDX GO DO NEXT SUBPTTN * SUBCL LDA MOMFL JSB MATAD SET UP PTRS TO MOTHER PTTN LDA MFLGS SUBPTTNS ALL CLEARED NOW IOR D5 SET UP MOTHER PTTN STATUS = 5 STA MRDFL,I CLA CLEAR OUT SUBPTTN STA MOMFL SWAPOUT FLAGS STA SUBFL JMP X0005 HAVE TO GO TO TOP OF SCHED LIST * * * * UNLINK SUBPARTITIONS FROM MOTHER PARTITION AND * RETURN SUBPARTITIONS TO THE BG OR RT FREE LIST * CALL: * MAT ADDRESSES SET UP BY MATAD (MLNK, ETC.) * (B) = MOTHER'S MAT AõÔþúDDR * JSB UNMOM CALL * (A) = MOTHER'S MAT ADDR * UNMOM NOP CPB MOMFL IS MOTHER TRYING TO CLEAN HOUSE? JMP X0035 YES, LEAVE HER ALONE. * STB MOM SAVE MOTHER MAT ADDR TEMP LDA ACHDM UNLINK MOTHER PTTN FROM ALLOC LIST JSB UNLNK UNLINK FROM ALLOCATED LIST LDA ACHFR STA FLIST LINK PTTN INTO FREE LIST JSB FLINK LDA MLTH,I CLEAR "C" BIT TOO AND C40K STA MLTH,I LDA MRDFL,I GET PTTN STATUS AND D7 IF MOTHER PTTN STILL IN PROCESS CPA D4 OF CLEANING OUT SUBPTTNS JMP UNMOM,I FORGET RELINKING SUBPTTNS * UNMOL LDA MSUBL,I ANY SUBPARTITIONS? CPA MOM END OF LIST? JMP UNMOM,I YES. RETURN * JSB MATAD SET UP PTRS TO CURRENT MAT LDB ABGFR LDA MFLGS SSA RT PTTN? LDB ARTFR YES, CHANGE TO RT FREE LIST STB FLIST SET PROPER FREE LIST PTR JSB FLINK TO LINK SUBPTTN INTO LDA MLTH,I CLEAR "C" BIT TOO AND C40K STA MLTH,I JMP UNMOL LINK NEXT SUBPTTN SOMEWHERE * C40K OCT 137777 ULFRE NOP HED DISP4 -- MEMORY ALLOCATION TABLE LIST LINKAGE ROUTINES * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ïZþú ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *********** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * * PARTITION STATUS = * 0 PROGRAM BEING LOADED * 1 PROGRAM IS IN PARTITION * 2 SWAPPING OUT OR SEGMENT BEING LOADED * 3 PROGRAM IS SWAPPED OUT * 4 SUBPARTITIONS ARE BEING SWAPPED OUT * 5 SUBPARTITIONS ALL SWAPPED OUT * ************************************** * SET UP POINTERS TO ENTRY IN MAT * CALL: (A) = ID SEG ADDR OF PROG * JSB MATEN * ************************************** * MATEN NOP ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PARTITION # STA CNT MPY MATSZ MULTIPLY BY MAT ™‡þúENTRY LENGTH ADA $MATA JSB MATAD JMP MATEN,I RETURN * * * SET UP THE MAT POINTERS FROM THE MAT ADDR * MATAD NOP STA MLNK SET MAT ENTRY POINTER INA STA MPRIO ID SET PRIORTY INA STA MID ID SEG ADR INA STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LINK WORD LDA MRDFL,I AND C7 STA MFLGS FLAGS IN PTTN STATUS WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MPRIO NOP PRIORITY RESIDENT MID NOP ID SET ADR MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP CNT NOP PARTITION # MFLGS NOP UPPER BITS * * * CALCULATE ID SEGMENT EXTENSION ADDRESS * CALL: * (A) = ID SEG WORD 29 * JSB IDXAD * * * IDXAD NOP SZA,RSS ANY EMA? JMP IDXAD,I NO, RETURN P+1 * ALF YES, GET ID EXT# RAL,RAL AND B77 ADA $IDEX INDEX THRU KEYWORD TABLE LDA A,I GET THE ID EXT ADDR ISZ IDXAD JMP IDXAD,I RETURN AT P+2 SKP * ****************************************** *RELINK PART BY NEW PRIORITY ***************************************** * RLNK NOP RELINK BY NEW PRIORITY LDA MADR,I AND DMFLG SEE IF IN DORMANT PTTN ALLOC LIST SZA,RSS JMP RLN1 NO * XOR MADR,I YES STA MADR,I CLEAR FLAG LDA DLIST RLN2 LDB MLNK GET ADR CURRENT ENTRY JSB UNLNK GO UNLINK JSB ALINK GO RELINK IN ALLOC BY NEW PRIO JMP RLNK,I * RLN1 LDA ALIST GO UNLINK ALLOC LIST JMP RLN2 * * ******UNLINK ROUTINE******Oèþú************** ****CALL: (A) = POINTER TO LIST HEAD * (B) = ADDR MAT ENTRY LOOKING FOR * JSB UNLNK * AFTER UNLINKING ***************************************** * UNLNK NOP UNLN1 SZA,RSS SHOULD NEVER GET CAUGHT HERE! BUT IF WE DO... HLT06 HLT 6 AT LEAST WE HAVE A CHANCE TO FIND IT STA ULST RIGHT, JIM? LDA ULST,I GET ADR CURRENT ENTRY CPB A SAME AS ONE SEARCHING FOR RSS YES,GO UNLINK JMP UNLN1 GO TRY NEXT ENTRY LDB B,I GET THIS ENTRY'S LINK STB ULST,I STORE IN PREVIOUS ENTRY LINK JMP UNLNK,I * ULST NOP * * ****LINK INTO FREE LIST******* * CALL: MLNK IS THE PTTN ENTRY TO BE ENTERED IN FREE LIST * FLIST IS SET TO THE PROPER FREE LIST (SMALLEST PTTN FIRST) * JSB FLINK * PTTN IS LINKED BY SIZE (SMALLEST PTTN FIRST) ****************************** * FLINK NOP LDA MADR,I IOR DMFLG XOR DMFLG CLEAR DORMANT FLAG STA MADR,I LDA MLTH,I GET CURRENT LENGTH AND B1777 SCREEN OUT FLAGS LDB A CMB,INB FLN1 LDA FLIST,I GET FIRST ENTRY IN LIST SZA,RSS JMP FLN2 * ADA D4 BUMP TO LENGTH WORD LDA A,I AND B1777 SCREEN OUT FLAGS ADA B SSA,RSS S=1 NEXT PARTITION SMALLER JMP FLN2 S=0, GO LINK * LDA FLIST,I STA FLIST GO CHECK NEXT ENTRY IN LIST JMP FLN1 * FLN2 LDA FLIST,I GET PREVIOUS POINTER STA MLNK,I PUT IN THIS ENTRY LINK WORD LDA MLNK GET ADR THIS ENTRY STA FLIST,I PUT IN LINK WORD PREVIOUS ENTRY JMP FLINK,I * *******LINK IN ALLOCATED LIST********** * ALINK NOP LDA MLNK SET PTTN LINK ADR STA XLNK LDA MLTH SET PTTN LENGTH ADR STA XLTH LDB MPRIO,I GET CURRENT PRIORITY CLA STA XEND SET END LIST LDA ALIST #þú STA XLST SET UP LINK LIST JSB XXLNK GO LINK JMP ALINK,I * XLTH NOP XLNK NOP XEND NOP XLST NOP C7 EQU DM8 SKP * * ****SETUP FOR DORMANT LINK******* ******CALL: (A) = ID SEG ADDR * JSB DSET * WITH ULST-ALLOC LIST * XLST-DORM LIST ******************************** * DSET NOP STA XLTH SAVE IN TEMP CELL ADA D14 LDA A,I GET TYPE WORD AND D15 CPA D1 JMP DSET,I MEM RES,DONT LINK * LDA XLTH ADA D21 LDA A,I GET MAPID WORK AND B77 GET PTTN # MPY MATSZ CALCULATE ADR ADA $MATA STA XLNK STORE ADR JPARTITIONS LIND ADA D2 LDB A,I GET PTTN RES CPB XLTH SAME AS THE PROGRAM RSS YES JMP DSET,I NO, DON'T LINK * INA INCRE TO WORD 3 LDB A,I SSB IS THIS A MOTHER PTTN? JMP DLMOM YES, SET UP FOR LINKING MOTHER * INA SET UP TO PUT TOP ALLOC STA XLTH SAVE ADDR OF PTTN LENGTH WORD INA LDA A,I GET FLAG WORD SSA IS THIS A BG PTTN? JMP DLRT NO, IT IS RT * LDA ABGDM ADD TO BG DORMANT LIST STA XLST LDA ABGPR GET BG ALLOC LIST ADDR DLN1 STA ULST SET UNLINK HEADER STA XEND SET END LIST ISZ DSET JMP DSET,I * DLRT LDA ARTDM STA XLST SET RT DORM LIST ADDR LDA ARTPR GET RT ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DLMOM LDA ACHDM STA XLST SET MOTHER DORMANT LIST ADDR LDA ACHPR GET MOTHER ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DMFLG OCT 20000 BIT 13 OF MAT WORK 3 INDICATED DMLIST *** * *********LINK DORMANT PROGAM IN ALLC LIST**** * * DLINK NOP JSB DSET GO SETUP JMP DLINK,I†þú NO LINK RETURN,NOT STILL IN PART * LDB XLNK ADB D3 LDA B,I GET WORK 3 MAT ENTRY AND DMFLG SZA IS IT ALREADY IN DORMANT LIST JMP DLINK,I YES, DON'T LINK AGAIN * LDA DMFLG NO IOR B,I SO SET FLAG AND LINK STA B,I LDB XLNK LDA ULST JSB UNLNK GO UNLINK ALLOCATED LIST LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK JMP DLINK,I SKP ****PERFORM LINK INTO ALLOCATED LIST**** ******ROUTINE WILL INSERT IN ALLOCATED * LIST IN ORDER OF INCREASING * PRIORITY(DECREASING NUMBER). PTTN * OF SAME PRIORITY WILL BE IN ORDER * OF INCREASING LENGTH.*************** *CALL:XLNK ADDR OF CURRENT MAT LINK WORD * XLTH ADDR OF CURRENT MAT LENGTH WORD * XLST ADDR OF ALLOCATED LIST TO BE ADDED INTO * JSB XLINK * *************************************** * * XXLNK NOP ALN1 LDA XLST,I GET FIRST ENTRY IN LIST CPA XEND END OF LIST JMP ALN3 YES * INA BUMP TO PRIORITY WORK LDA A,I CMA,INA SCREEN OUT FLAGS ADA B ADD TO CUTTENT PRIORITY SSA,RSS S=1,NEXT PARTITION LOWER PRIORITY JMP ALN2 S=0,GO LINK * ALNXT LDA XLST,I GO CHECK NEXT ENTRY STA XLST JMP ALN1 * ALN2 SZA,RSS ARE PRIORITIES THE SAME JMP ALN4 GO ARRANGE BY LENGTH * ALN3 LDA XLST,I GET PREVIOUS POINTER STA XLNK,I PUT IN THIS ENTRY LINK WORD LDA XLNK GET ADR THIS ENTRY STA XLST,I PUT IN LINK WORK PREVIOUS JMP XXLNK,I * ALN4 LDA XLTH,I GET LENGTH CURRENT ENTRY AND B1777 SCREEN OUT FLAGS CMA,INA STA CLTH LDA XLST,I ADA D4 LDA A,I GET LENGTH NEXT ENTRY IN LIST AND B1777 SCREEN OUT FLAGS ADA CLTH SSA S=1,CURRENT LENGTH Gº„þúREATER JMP ALNXT GO SEE IF NEXT ENTRY BIGGER JMP ALN3 CURRENT SMALLER,GO LINK * CLTH NOP SKP *******UNLINK ALLOCATED,LINK DORMANT**** * CALL: (A) = ID SEG ADDR * JSB $ALDM * *************************************** * $ALDM NOP JSB DLINK JMP $ALDM,I NOT STILL IN PTTN OR ALREADY IN DM * * ************************************* ****UNLINK DORMANT,LINK ALLOCATED**** * CALL: (A) = ID SEG ADDR * JSB DMAL * **NOTE--MUST MAKE SURE IN DORMANT LIST ** BEFORE GET HERE**** ************************************* * $DMAL NOP JSB DSET GO SET UP JMP $DMAL,I NOT IN PTTN,DONT CHANGE * LDB XLNK ADB D3 LDA B,I XOR DMFLG CLEAR DM LIST FLAG STA B,I LDA XLST GO UNLINK DORM LIST LDB ULST STB XLST SET TO INSERT ALLOC LIST LDB XLNK JSB UNLNK CLA STA XEND LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK IN ALLOC LIST JMP $DMAL,I SKP *****RELINK FOR PR COMMAND********* **RELINKS IN ALLOC LIST BY NEW PRIORITY** * * $PRCN NOP STB NEWPR JSB DSET GO SET UP JMP $PRCN,I NOT STILL IN PTTN,DONT RELINK * LDB XLNK ADB D3 LDA B,I AND DMFLG IS IT IN DORM LIST SZA,RSS JMP PRCG2 NO, MUST BE IN ALLOC * LDA XLST YES, IN DORM PRCG1 LDB XLNK JSB UNLNK GO UNLINK LDA XLNK INA LDB NEWPR PUT NEW PRIO IN PTTN STB A,I JSB XXLNK GO LINK BY NEW PRIO JMP $PRCN,I * PRCG2 CLA SET UP FOR ALLOC LIST STA XEND LDA ULST STA XLST JMP PRCG1 * NEWPR NOP ABGFR DEF $BGFR+0 ADR BG FREE LIST ABGPR DEF BGPR ADR BG ALC LIST HD ABGDM DEF BGDM ADDR BG DORMANT SUBLIST HEADER BGDM DEF BGPR INIT BG DORMANT SUBLIST HEAD ®þúBGPR NOP BG ALLOCATED LIST HEADER * * EXT DEFS FOR CMM4 & CDA4 * $BG1 EQU ABGFR $BG2 EQU ABGPR $BG3 EQU ABGDM $BG4 EQU BGDM $BG5 EQU BGPR * ARTFR DEF $RTFR+0 ADDR RT FREE LIST HEADER ARTPR DEF RTPR ADDR RT ALLOCATED LIST HEADER ARTDM DEF RTDM ADDR RT DORMANT SUBLIST HEADER RTDM DEF RTPR INIT RT DORMANT SUBLIST HEAD RTPR NOP RT ALLOCATED LIST HEADER * * EXT DEFS FOR CMM4 & CDA4 * $RT1 EQU ARTFR $RT2 EQU ARTPR $RT3 EQU ARTDM $RT4 EQU RTDM $RT5 EQU RTPR * ACHFR DEF $CFR+0 ACHPR DEF CHPR ACHDM DEF CHDM CHDM DEF CHPR CHPR NOP * * EXT DEFS FOR CMM4 & CDA4 * $MM1 EQU ACHFR $MM2 EQU ACHPR $MM3 EQU ACHDM $MM4 EQU CHDM $MM5 EQU CHPR * FLIST NOP CURRENT FREE LIST POINTER ALIST NOP CURRENT ALLOCATED LIST POINTER DLIST NOP CURRENT DORMANT SUBLIST POINTER SKP * $UNPE - UNLINK PARTITION AND UNDEFINE IT FOR PARITY ERROR MODULE * CALLED BY PERR4 * CALL: * (B) = MAT ADDR OF PARTITION * JSB $UNPE * REGISTERS MEANINGLESS * * $UNPE NOP STB NEWPR SAVE MAT ADDR ADB D3 LDA B,I SSA IS IT A MOTHER PTTN? JMP ULMOM YES, UNLINK AND UNDEFINE MOM * ADB D2 LDA B,I ADB DM3 LDB B,I (B) = ID ADDR SSA IS IT RT PARTITION? JMP ULRT YES * LDA ABGFR BG PARTITION SZB IS PTTN EMPTY? LDA ABGDM NO, USE BG ALLOC LIST JMP ULPTN YES, USE BG FREE LIST * ULRT LDA ARTFR USE RT FREE LIST IF EMPTY SZB IS PTTN EMPTY? LDA ARTDM NO, USE RT ALLOC LIST ULPTN LDB NEWPR JSB UNLNK UNLINK THE ENTRY CCA STA NEWPR,I UNDEFINE THE MAT ENTRY * CLA NOW SET THE MAT FREE LDB NEWPR ADB D2 STA B,I ZAP THE ID ADDRESS ADB D3 LDA B,I GET THE STATUS WORD ×þú AND BIT15 SAVE ONLY TYPE STA B,I ZAP THE STATUS JMP $UNPE,I RETURN * ULMOM LDA NEWPR CPA MOMFL SAME AS ONE WE'RE TRYING TO CLEAN OUT CLB,RSS YES, SKIP JMP ULM2 NO, UNLINK FROM LISTS * STB MOMFL YES, CLEAR SWAP OUT FLAGS STB SUBFL ULM2 ADA D4 LDA A,I RAL SSA,RSS IS MOTHER IN CHAIN MODE? JMP ULM3 NO, SKIP UNMOM * LDA NEWPR JSB MATAD SET UP MAT ADDRS LDB NEWPR JSB UNMOM UNLINK SUBPTTNS FROM MOM LDA ACHFR UNLINK MOM FROM CH FREE LIST JMP ULPTN * ULM3 LDB NEWPR (UNMOM CHECKS PTTN STATUS = 4) ADB D2 LDA B,I GET PTTN STATUS AND D7 LDB A LDA ACHFR EITHER IT IS IN FREE LIST CPB D4 JMP ULMSP OR IN ALLOC LIST (SWAPPING SUBPTTNS) * LDB NEWPR ADB D2 LDB B,I SZB OR ULMSP LDA ACHDM IN ALLOC LIST (OCCUPIED) JMP ULPTN GO UNLINK AND UNDEFINE HED DISP4 -- CLEAR "LOAD IN PROGRESS" FLAG * * THIS ROUTINE CLEARS BIT EIGHT OF ID WORD * 16 (STATUS WORD). THIS FLAG (BIT) INDICATES TO THE * SWITCHING SECTION (X0030) THAT THE SPECIFIED PROGRAM * IS NOT YET IN MEMORY. THIS REDUCES THE OVERHEAD * REQUIRED TO FIND A DISPATCHABLE PROGRAM. * * THE "LOAD-IN PROGRESS" BIT IS SET BY THE COMIT ROUTINE. * * NOTE: PROGRAMS ARE NOT PLACED IN I/O SUSPENSION * WHILE THEY ARE BEING LOADED FROM THE DISC. * * * BIT 8 WORD 16 SET= LOAD IN PROGRESS * * * CLRLD NOP ISZ $LIST FORCE ONE MORE LIST SCAN ADB D15 CALLED WITH (B)=ID ADDRESS LDA B,I FETCH STATUS IOR B400 PRESET BIT XOR B400 SO WE CAN CLEAR LOAD BIT STA B,I RESTORE STATUS JMP CLRLD,I RETURN * * B400 OCT 400 SKP HED DISP4 -- BACKGROUND DISK PROGRAM LOADING * BACKGROUND DISK RESIDENT PROGRAM SCHEDULEDy#þú * * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0100 LDA ABGFR SET UP LIST HEADERS STA FLIST LDA ABGPR STA ALIST LDA ABGDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO BG PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF BGSWP & SUPPLY THE $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLG SSA IS PROG IN RT PTTN JMP XB200 YES,GO THERE * XR100 LDB MID,I PROGRAM RESIDENT IN PTTN? SZB,RSS YES, SKIP JMP XN120 NO, SO GO READ IT IN * CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * * SET UP TO CALL SWPCK * LDA BGSWP IS BG SWP OR LOAD IN PROGRESS SZA NO,SO GO TO IT CPA B YES, IS IT SAME PTTN (B)=MID,I CLE,RSS OK,GO TO SWPCK (E=0) JMP X0035 * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0152 (P+1) GO CLEAR CURRENT LOA‚þúD JMP X101 (P+2) GO SWP OUT CURRENT PRGM * * LOAD RETURN FROM SWPCK * XN120 LDA BGSWP (P+3) GO LOAD OVER CURRENT OCCUPANT SZA JMP X0B35 YES, CALL BUSY, RELEASE PTTN IF FREE * JSB COMIT COMMIT THE PARTITION HED DISP4 -- BACKGROUND DISK RESIDENT PROGRAM SWAP OUT * SETUP TO SWAP OUT BACKGROUND DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * SEZ,RSS *E=1 IS LOAD IN OR SWAP BACK IN X101 JSB SWOUT *E=0 IS SWAP OUT (GO SAVE MAP REG FIRST) CLB,SEZ,INB,RSS INB STB BGRQ SET UP REQUEST CODE LDB MID,I LDA BTRPA JSB PREST EXITS VIA X0035 IF NO DISC SPACE FOR SWAP STB BGLU SET UP REQUEST LU STA BTRP SET UP TRIPLETS ADDR LDA MID,I SET CALL BUSY AFTER PREST RETURNS STA BGSWP LDA MRDFL STA BRDFL SAVE FLAGS ADDR LDA MFLGS STA BFLGS SAVE HIGH ORDER BITS LDA ZPRIO,I STA BSPR SET UP PRIORITY * JSB $XSIO MAKE DISC I/O CALL BGLU NOP LOGICAL UNIT DEF X0122 COMPLETION ADDR½iþú X0155 NOP LINK WORD BGRQ OCT 1 REQUEST CODE BTRP DEF BTRIP TRIPLETS ARRAY ADDR BSPR NOP BG SWAPPING PRIORITY BGSWP NOP ID ADDR OF PROG ISZ BRDFL,I SWAPPING OUT? JMP X0035 YES, FLAG = 2 * LDA BFLGS NO, LOAD. FLAG = 0 IOR BRDFL,I SET UP HIGH BITS STA BRDFL,I JMP X0005 * * BRDFL NOP BFLGS NOP SKP * * BACKGROUND READ IN COMPLETION PROCESSOR * * * THE BACKGROUND DISC RESIDENT READ COMPLETION PROCESSOR, * * IF NO READ ERROR, IT CLEARS THE READ IN WAIT FLAG, * * ENTERS PROGRAM INTO SCHEDULE LIST VIA LIST * * SUCH THAT EXECUTION CAN BEGIN AT THE NEXT * * OPPORTUNITY THE PROGRAM BECOME THE TOP OF LIST.* * IF READ ERRORS OCCURRED, CALL $ABRT PROCESSOR . * X0122 STB TEMP SAVE READ IN STATUS OF DISC ISZ BRDFL,I STEP BG RD FLAG (1 LOADED, 3 SEG LOADED) LDA BFLGS IOR BRDFL,I STA BRDFL,I SET READ FLAG=1 IF READ (A=1) LDB BGSWP CLA STA BGSWP CLEAR BG I/O FLAG LDA BGRQ * X0125 ISZ $LIST SET LIST FLAG TO FORCE SCAN SLA,RSS A=1 IF READ,0 IF WRITE JMP X0127 IT IS WRITE, GO SCAN LIST * STB TEMP1 SAVE ID-SEG. ADDRESS JSB CLRLD (B)=ID ADDR -- CLEAR LOAD BIT LDA TEMP CHECK READ IN STATUS FLAG SSA,RSS SKIP IF DISC ERROR JMP X0127 ALL O-K SO GO SCAN THE LIST * X0126 LDA TEMP1 A CONTAINS ID SEG ADDR JSB $ABRT GO TO ABORT ROUTINE * X0127 LDA MOMFL SZA ANY SUBPTTNS TO SWAP OUT? JMP SUBSS YES, GO DO IT JMP $XCQ NO, DO NEXT SCHEDULE/ABORT * * CLEAR OUT CURRENT LOAD * X0152 LDB MID,I RESCHEDULE THE JSB CLRLD PROGRAM BY CLEARING LOAD BIT (B)=ID ADDR XN153 LDA ABÀþúGDM LDB MLNK JSB UNLNK REMOVE LDA ABGFR STA FLIST STRING BY LENGTH JSB FLINK INSERT INTO FREE LIST X0154 CLB LDA MRDFL,I AND D7 CPA D5 DID WE JUST CLEAR MOTHER PTTN LOAD? JMP XABIO YES, ABORT I/O * SLA IS I/O GOING ON IN THIS PTTN? JMP XX154 NO, GO TO $XCQ * XABIO LDA MID,I GET RESIDENT PTTN STB MID,I CLEAR RESIDENT CPA BGSWP WAS I/O BUSY IN BG? JMP XB154 YES * CPA RTSWP RT CALL BUSY? JMP XR154 YES, CLEAR IT * CPA SGSWP JMP XS154 * CPA CHSW2 CHUNK I/O CALL BUSY? JMP XC154 YES, CLEAR IT * CPA CHSWP MOTHER PTTN I/O BUSY? JMP XM154 YES, CLEAR IT * XX154 STB MID,I NONE OF ABOVE, JMP $XCQ JUST CLEAR RESIDENCY WORD * XM154 STB CHSWP CLEAR MOTHER PTTN FLAG LDA DX355 BECAUSE IT WAS NONE OF ABOVE JMP $IOCL GO CANCEL LOAD * XC154 STB CHSW2 STB CHSWP LDA DX366 CHUNK I/O BUSY. JMP $IOCL GO CANCEL LOAD * XR154 LDA DX255 STB RTSWP CLEAR RT FLAG JMP $IOCL GO CANCEL LOAD * XB154 STB BGSWP CLEAR BG FLAG LDA DX155 JMP $IOCL GO CANCEL LOAD * XS154 STB SGSWP CLEAR SG FLAG LDA DX455 JMP $IOCL GO CANCEL LOAD * SPC 1 DX155 DEF X0155 ADDR OF LINK WORD IN BG $XSIO CALL DX255 DEF X0255 ADDR OF LINK WORD IN RT $XSIO CALL DX355 DEF X0355 ADDR OF LINK WORD IN MOTHER $XSIO CALL DX366 DEF X0366 ADDR OF LINK WORD IN CHUNK $XSIO CALL DX455 DEF X0455 ADDR OF LINK WORD IN SEGMENT $XSIO CALL EMAOF NOP MSGSZ NOP MSGPG NOP ZIDX0 NOP ZIDX1 NOP * B40 OCT 40 B176K OCT 176000 DM7 DEC -7 * X0B35 LDA MID,I GET PTTN RESIDENT SZA IF EMPTY PUT BACK IN FREE LIST JMP X0035 OTHERWISE ,DONT BOTHER * LDA ALIST GO REMOVE ALLOCAgiþúTD LIST LDB MLNK JSB UNLNK JSB FLINK JMP X0035 * * SKP * * * THE COMMIT ROUTINE INSURES THE THE PARTITION IS COMMITTED TO * THE PROGRAM BEFORE THE PROGRAM IS LOADED INTO THE PARTITION. * IF THE PARTITION USED TO BE IN THE DORM LIST IT IS MOVED TO * THE ALLOC LIST. WHAT WE SHOULD PROBABLY DO HERE LATER * IS ALSO TO MOVE THE PARTITION OUT OF THE FREE LIST INTO THE * ALLOC LIST. CURRENTLY THIS IS DONE IN THE FNDSG ROUTINE. OH * WELL MAYBE NEXT PASS WE'LL GET THE TIME. * * * COMIT NOP * LDA MID,I ANYBODY ALREADY OWN THE PARTITION ? SZA,RSS WELL ? JMP ALLOK NO, SO PARTITION IN CORRECT LIST ( VIA FNDSG ) * LDA MADR,I GET THE DORM BIT WORD AND B20K FETCH DORM BIT SZA,RSS THIS PART'N IN DORM LIST ? JMP ALLOK NO. * XOR MADR,I YES, SO STA MADR,I CLEAR DORM BIT & LDA DLIST MOVE OUT OF DORM LIST INTO LDB MLNK THE ALLOC LIST. JSB UNLNK JSB ALINK * ALLOK LDA ZPRIO,I ASSIGN NEW PRIORITY TO PTTN CPA MPRIO,I IS IT SAME AS PARTITION PRIORITY? JMP XW120 YES, CAN'T RELINK * STA MPRIO,I ASSIGN NEW PRIORITY JSB RLNK GO RELINK IN ALLOCATED LIST XW120 LDB ZWORK STB MID,I *** COMMIT THE PARTITION *** !!!!!! ISZ $LIST FORCE A NEW LIST SCAN LDA ZSTAT,I FETCH STATUS WORD IOR B400 ADD "LOAD-IN-PROGRESS" BIT STA ZSTAT,I RESTORE STATUS CCA,CCE (E)=1 FOR PREST ON LOAD STA MRDFL,I * JMP COMIT,I RETURN * B20K OCT 20000 HED DISP4 -- RT DISK RESIDENT LOAD TESTS * * REAL TIME DISC RESIDENT * * REAL TIME DISC RESIDENT PROGRAM EXECUTION * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THþúE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0200 LDA ARTFR SET POINTERS TO LIST HEADERS STA FLIST LDA ARTPR STA ALIST LDA ARTDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO RT PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF RTSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLAG SSA,RSS IS PROG IN BG PTTN? JMP XR100 YES,GO DO IT * XB200 LDB MID,I IS PROGRAM RESIDENT? SZB,RSS JMP XN220 NO, SO GO READ IT IN * CPB ZWORK YES, DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * SET UP TO CALL SWPCK * LDA RTSWP IS RT I/O CALL BUSY? SZA NO, GO TO IT CPA B YES, IS IT SAME PTTN? (B)=MID,I CLE,RSS YES, GO TO SWPCK (E=0) JMP X0035 NO, I/O CALL BUSY, TRY NEXT PROG * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0252 GO CLEAR CURRENT LOAD JMP X201 GO SWAP OUT CURRENT PGM. JMP XN220 * SPC 1 X0230 AND B7 PROG IN MEMORY, SCHED IF DONE LOAD CCE,SLA,RSS READ IN COMPLETE? JMP X0035 NO, GO TRY THE NEXT PGM * SÍþúCPA D3 STILL IN MEMORY AFTER SWAP? JMP X02IN YES, USE IT AGAIN * LDA ZWORK ADA D27 LDA A,I SWAP BACK IN? CCE,SZA JSB SWPIN *YES, SO SET UP THE MAPS FOR DISPATCH CCE *NO, REDISPATCH, USE MAP ON USER B.P. XW230 LDB MLNK JSB $SMAP SET UP USER MAP LDB ZWORK GET THE ID-SEG. ADDRESS JSB DREL RELEASE SWAP TRACKS IF ANY JMP X0040 GO EXECUTE THE PGM. * X02IN LDB MFLGS CCE,INB STB MRDFL,I FORCE PTTN STATUS=1 JSB SWOUT *RESET MAP BACK TO WHAT IT WAS. JMP XW230 RE-USE BP COPY OF USER MAP (E=1) HED DISP4 -- RT DISK RESIDENT READ IN * * SETUP TO READ IN RT DISK PROGRAM * * READ IN OF REAL TIME DISC RESIDENT PROGRAM * * IF ID SEGMENT SWAP ADDRESS IS ZERO, THE SYSTEM * * GENERATED DISC ADDRESS IS USED TO COMPUTE THE * * PARAMETERS FOR DISC I/O CALL. * * IF THERE IS SWAP ADDRESS, THEN THIS DISC ADDRESS * * IS USED. * * * XN220 LDA RTSWP TRANSFER IN ANOTHER AREA? SZA NO, OKAY TO LOAD JMP X0B35 YES, FREE UP PTTN AGAIN * JSB COMIT COMMIT THE PARTITION HED DISP4 -- RT DISK RESIDENT PROGRAM SWAP OUT * * SETUP TO SWAP OUT RT DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * 3…þú THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * (E)=0 SWAP OUT (E)=1 LOAD IN * SEZ,RSS *E=1 IS A LOAD OR SWAP BACK IN X201 JSB SWOUT *E=0 IS A SWAP OUT SO SAVE THE MAP INFO CLB,SEZ,INB,RSS SET UP THE REQUEST CODE INB AND SET STB RTRQ LDB MID,I ID SEGMENT ADDRESS LDA RTRPA GET THE QUE ADDRESS JSB PREST GO SET UP THE SWAP STB RTLU SET THE LU STA RTRP SET THE TRIPLET QUE ADDRESS LDA MID,I STA RTSWP LDA MRDFL STA RRDFL LDA MFLGS SAVE FLAGS STA RFLGS LDA ZPRIO,I SET THE REQUEST PRIORITY STA RTSPR IN THE CALL JSB $XSIO CALL FOR DISK I/O RTLU NOP LOGICAL UNIT DEF X0251 COMPLETION ADDRESS X0255 OCT 0 RTRQ NOP REQUEST CODE READ/WRITE RTRP DEF RTRIP ARRAY ADDRESS RTSPR NOP RT SWAP PRIORITY RTSWP NOP EXTENDED XSIO CALL--ID ADR ISZ RRDFL,I SWAPPING OUT? JMP X0035 YES, CONTINUE SEARCH (FLAG = 2) * LDA RFLGS NO, IT'S LOAD IOR RRDFL,I PUT FLAGS BACK IN MAT WORD STA RRDFL,I NOW=0 IF LOADING OR SWAPPING IN JMP X0005 RESCAN LIST, NEW PROG MAY BE READY. * RFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD RRDFL NOP ADDR OF MAT PTTN STATUS WORD SPC 2 * * * READ IN COMPLETION PROCESSOR * * THE REAL TIME DISC RESIDENT READ COMPLETION PROCESSOR, * * * IF NO ERRORS, IT CLEARS READ IN WAIT FLAG, AND * * SCHEDULES PROGRAM SUCH THAT T¾þúPROGRAM EXECUTION * * CAN BEGIN AT THE NEXT OPPORTUNITY. * * IF READ ERRORS, CALL $ABRT PROCESSOR * * * X0251 STB TEMP SAVE READ IN STATUS OF DISK ISZ RRDFL,I SET FLAG =1 LOAD DONE, =3 SWAP DONE LDA RFLGS IOR RRDFL,I STA RRDFL,I LDB RTSWP GET ID SEG ADR CLA STA RTSWP CLEAR SWAP IN PROGRESS LDA RTRQ GET REQUEST CODE JMP X0125 GO FINISH CHECKS SPC 2 X0252 LDB MID,I ABORT LOAD IN PTTN WHICH WE NEED JSB CLRLD AND CLEAR LOAD BIT IN ABORTED PROG (B)=ID XN253 LDA ARTDM LDB MLNK JSB UNLNK REMOVE PTTN FROM ALLOCATED LIST LDA ARTFR STA FLIST JSB FLINK INSERT PTTN INTO FREE LIST JMP X0154 GO CANCEL LOAD SPC 1 RTRPA DEF RTRIP SPC 1 HED DISP4 -- MOTHER PARTITION RESIDENT PROGRAM PROCESSING * DISPATCHING EMA PROGRAM * OR A BG OR RT PROGRAM ASSIGNED TO A MOTHER PARTITION X0300 LDA ACHFR SET UP LIST HEADERS STA FLIST LDA ACHPR STA ALIST LDA ACHDM STA DLIST * LDA ZIDEX SZA,RSS IS IT AN EMA PROG? JMP X0310 NO * XE300 LDB ZWORK YES, IT IS EMA PROG ADB D8 LDB B,I GET POINT OF SUSPENSION FROM ID SEG SZB INITIAL DISPATCH? JMP X0310 NO, LEAVE EMA SIZE OR EMA START PAGE ALONE * LDA ZIDEX YES, INITIAL DISPATCH CCE,INA STA ZIDX1 SAVE ADDR OF WORD 1 IN ID EXT LDA ZIDEX,I AND B37 GET #PAGES IN MSEG STA B SAVE # PAGES IN MSEG RAL,ERA SET SIGN AND CLEAR MSEG # STA ZIDEX,I SO MSEG PAGES GET PROTECTED LDA ZMPID,I AND B76K ALF RAL,RAL GET SIZE OF PROG LESS BP CMB,INB SUBTRACT MSEG FOR ACTUAL CODE SIZE ADB A õ+þú KEEP PROG SIZE IN (B) * LDA ZIDX1,I GET ID EXT WORD 1 ALF,RAL SSA,RSS WAS DEFAULT BIT SET? JMP X0310 NO, JUST USE SPECIFIED EMA SIZE * LDA ZEMA,I AND B1777 CPA D1 IS IT DEFAULTED TO 1? RSS YES, SET UP NEW EMA SIZE JMP X0310 NO, USE GIVEN SIZE * CMB,INB SUBTRACT ACTUAL CODE SIZE FROM PTTN SIZE LDA ZMPID,I SSA,RSS ASSIGNED TO A PTTN? JMP X0308 NO, USE $MCHN SIZE * STB NPGN SAVE NEG PROG SIZE LDA ZWORK YES, FIND THE PTTN'S SIZE JSB MATEN LDA MLTH,I AND B1777 LDB NPGN SUBTRACT PROG SIZE ADB A FROM PTTN SIZE TO CALCULATE RSS EMA SIZE X0308 ADB $MCHN USE MOTHER PTTN SIZE TO CALCULATE LDA ZEMA,I GET EMA WORD FROM ID SEG AND B176K IOR B AND FILL IN NEW EMA SIZE STA ZEMA,I SAVE NEW EMA SIZE WORD * X0310 JSB FNDSG GO FIND A PTTN LARGE ENOUGH DEF CHSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDB MID,I PROG ASSIGNED TO MOTHER PTTN SZB,RSS IS ANY PROG IN PTTN? JMP XS320 NO, READ PROG IN IF REALLY FREE * CPB ZWORK YES, BUT IS IT THE CORRECT ONE? JMP X0330 YES, CHECK FOR READ COMPLETE * SWEMA LDA CHSWP NO, TRY SWAP IT OUT SZA IS I/O CALL BUSY? CPA B YES, CALL BUSY. IN THIS PTTN? (B)=MID,I CLE,RSS CALL NOT BUSY OR ONLY BUSY IN THIS PTTN JMP X0035 CALL IS BUSY, SO DO SOMETHING ELSE. * JSB SWPCK CHECK SWAP CONDITION (E=0) JMP X0352 THIS PROG PR > CURR PROG READ IN, STOP IT JMP X0325 WE CAN SWAP OUT OLD OCCUPANT JMP XN320 OCCUPANT NOT EXECUTED SINCE LOAD, OVERLAY IT * * * WE CAN SWAP OUT OLD PROGRAM IN PARTITION * X0325 LDB MID,I *GET OLD OCCUPANT ID ADDR ADB D28 * INDEX TO EMA WORD 8Hþú LDA B,I * STB ZEMA *SET UP FOR SWAP OUT CODE JSB IDXAD *GET ID EXT ADDR STA ZIDEX * NOT EMA, SET ID EXT ADD=0 STA ZIDEX * IS EMA, SAVE THE ID EXT ADDRESS * CLE * JSB SWOUT *SAVE USER MAP REGISTERS JMP X301 *GO SWAP * SPC 3 * SWAPPED EMA PROGRAM BACK IN * SINCE IT MAY COME BACK IN DIFFERENT PARTITION, WE MUST * REBUILD THE MSEG PAGE REGISTERS AND SAVE A NEW COPY OF * THE MAP IN THE USER'S PHYSICAL BASE PAGE. * * EMA START OFFSET = PG# CURR EMA PAGE - OLD EMA START PAGE * NEW EMA START PG = 1ST PG NEW PTTN + #PAGES IN ID + 1 - MSEG SIZE * #PG TO MAP IN MSEG= MSEG SIZE + 1 * * IF MSEG IS NOT COMPLETELY FILLED BY EMA PAGES BECAUSE * END OF THE EMA WAS REACHED OR IF THERE WAS NO MSEG MAPPED * AT THE TIME OF THE SWAP-OUT, THEN THOSE PAGES WILL BE * SET UP WITH READ-WRITE PROTECT. * * X0330 LDA MRDFL,I AND D7 GET PTTN STATUS CPA D4 STILL TRY TO SWAP OUT SUBPTTNS? JMP XS322 YES, DO SOME MORE * CPA D5 ALL DONE WITH SUBPTTNS? JMP XN320 YES, LOAD INTO IT * LDB ZIDEX NONE OF ABOVE, SO READ STARTED ALREADY SZB,RSS IS IT AN EMA PROG? JMP X0230 NO, JUST SET UP BP MAP * CCE,SLA,RSS IS EMA LOAD ALL DONE? JMP X0035 NO, GO DISPATCH NEXT PROG * CPA D3 STILL IN MEMORY AFTER SWAP OUT? JMP X03IN YES, CHANGE PTTN STATUS TO 1 * LDA ZWORK *PROGRAM IS IN MEMORY ADA D27 * LDA A,I *GET SWAP TRACKS WORD CCE,SZA,RSS *IS THIS A LOAD BACK IN FROM A SWAP OUT? JMP X0333 *NO,EITHER A REDISPATCH OR INITIAL RUN. * JSB SWPIN *YES, SO SET UP THE USERS MAP REGS CCE * LDB MLNK *GET THE MATA LINK WORD & JSB $SMAP *NOW GO ENABLE THE USER MAP * XW330 LDB ZWORK *GET THE ID ADDRESS JSB DREL *RELEASE Sm“þúWAP TRACKS, IF ANY JMP X0040 * GO EXECUTE PROG * X03IN LDB MFLGS * CCE,INB * STB MRDFL,I *SET STATUS=1 FOR PROG IN MEMORY JSB SWOUT *RESTORE SAVED MAP TO WHAT IT USED TO BE LDB MLNK *GET THE MAT ADDRESS & JSB $SMAP *RE-USE USER MAP (E=1) JMP XW330 * AFTER SWAP, SO GET RID OF SWAP TRACKS * * * THIS IS EITHER A REDISPATCH OR THE INITIAL RUN OF THE PROGRAM * X0333 LDB MLNK * LDA ZWORK *GET THE ID ADDR ADA D8 * LDA A,I *GET PT OF SUSP CCE,SZA,RSS * INITIAL EXECUTION ? JMP X0335 *YES,SO SET UP THE START PAGE OF EMA * JSB $SMAP *NO,A REDISPATCH SO JUST USE MAP ALREADY THERE JMP X0040 *SO GO EXECUTE THE GUY. * * THIS IS THE FIRST DISPATCH OF THE EMA PROGRAM * X0335 CLE *(E=0) TO FORCE NEW MAP JSB $SMAP *SET UP USER MAP LDA ZIDEX,I *EMA PROG JUST LOADED AND B37 *NEEDS MAP REGS SET UP FOR MSEG LDB A *NEGATE # PGS IN MSEG CMB,INB * LDA ZMPID,I *GET # PAGES IN USER ALF * (WITHOUT BASE PAGE) RAL,RAL * AND B37 * TO GET ACTUAL CODE SIZE INA * ADB A * IN (B) * LDA MADR,I *GET PHYSICAL START PAGE OF PTTN AND B1777 * FROM MATA ENTRY ADB A *ADD TO GET NEW START PAGE EMA LDA ZIDX1,I * AND B176K * IOR B *ADD OLD BITS IN HIGH PART LDB ZIDEX *GET THE ID EXT ADDR INB * THE START PHYSICAL PAGE OF EMA WORD STA B,I * AND SET UP THE EMA PHYSICAL PAGE WORD. JMP X0040 * OK, SO GO EXECUTE THE PROGRAM. * * B40K OCT 40000 * * X0352 LDB MADR,I NEED TO ABORT LOAD IN PROGRESS SSB MOTHER PTTN? JMP XM352 YES, MOTHER PTTN * LDB MFLGS NO, MUST BE EMA ASSIGNED TO RT/BG SSB JMP X0252 Âþú ASSIGNED TO RT (UNLINK RT PTTN) JMP X0152 ASSIGNED TO BG (UNLINK BG PTTN) * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION AND THE SWPCK ROUTINE * DETERMINED THAT IT IS HIGHER PRIORITY THAN THE PROGRAM BEING * LOADED INTO THE MOTHER PARTITION SO STOP THE LOAD. * XM352 LDB MID,I JSB CLRLD CLEAR LOAD BIT OF PROG IN MOTHER PTTN * XN353 LDB MLNK PROG ABORTED BY OPERATOR OR SYSTEM JSB UNMOM OR PROGRAM COMPLETED NORMALLY XW354 JSB MATAD RESET UP PTRS FOR MOTHER PTTN JMP X0154 THEN CANCEL LOAD IF NEED TO * * * DO THE LOAD OF PROGRAM INTO MOTHER PTTN * XN321 LDA MADR,I MOTHER/EMA CALL IS BUSY SSA NEED TO LOAD INTO MOTHER PTTN? JMP X0035 YES, HAVE TO WAIT. TRY NEXT SCHED JMP X0B35 NO, EMA ASSIGNED TO RT/BG. RELEASE PTTN * * XS320 LDA MRDFL,I AND B7 STILL TRYING TO CLEAR SUBPTTNS? CPA D4 RSS YES, DO SOME MORE OR GO TO NEXT PROG JMP XN320 NO, DO LOAD IF CALL IS FREE * XS322 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA (NEED THIS, IN CASE OF ABORT IN SUBPTTN) JMP X0035 YES, BUSY SO SKIP IT FOR A WHILE JMP SUBS2 NO, DO NEXT SUBPTTN. * * XN320 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA JMP XN321 YES, BUSY. TRY NEXT PROG IF MOTHER PTTN * JSB COMIT COMIT THE PARTITION * SKP * * SWAP-OUT OR LOAD * X301 CLB,SEZ,INB,RSS SET UP REQ CODE INB AND SET UP STB CHRQ IN MOTHER PTTN CALL STB CHRQ2 LDA MLNK STA CHMAT SAVE MAT ADDR LDB MID,I (B) = ID SEG ADDR LDA CTRPA (A)=BOTTOM OF TRIPLETS JSB PREST SET UP FOR SWAP OR LOAD OF PROG STB CHLU1 SAVE LU STB CHLU2 STA CTRP SET TRIPLET QUEUE ADDR LDA TEMP1 STA CHTRK SAVE NEXT TRACK # LDA TEMP2 STA CHSCT òîþú SAVE NEXT SECTOR # LDA MID,I STA CHSWP SET EMA/MOTHER PTTN I/O CALL BUSY LDA MRDFL STA CRDFL SET ADDR OF READ-IN FLAG LDA MFLGS STA CFLGS SET HIGH BITS OF READ-IN FLAG LDA ZPRIO,I STA CHSPR SET REQUEST PRIORITY STA CHSP2 LDA ZEMA,I STA CHEMA SAVE CONTENT OF EMA WORD LDA ZIDEX AND ID EXT ADDR STA CHIDX FOR COMPLETION CODE * JSB $XSIO DO LOAD OR SWAP I/O CALL CHLU1 NOP DISC LU DEF X0351 COMPLETION ADDR X0355 NOP LINK WORD CHRQ NOP READ/WRITE CTRP DEF CTRIP TRIPLET ADDR CHSPR NOP PRIORITY CHSWP NOP ID ADDR OF PROG, CODE BUSY FLAG * ISZ CRDFL,I JMP X0035 SWAP OUT FLAG = 2, CONTINUE * LDA CFLGS LOAD IN OR SWAP IN IOR CRDFL,I STA CRDFL,I JMP X0005 CONTINUE * * CHEMA NOP CONTENTS OF EMA WORD CHIDX NOP ID EXT ADDRESS * * * * EMA/MOTHER PTTN I/O COMPLETE * X0351 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERRORS JMP X03AB ERROR, ABORT! * LDA CHEMA DONE LOAD/SWAP OF PROG, SZA,RSS EMA? JMP X0380 NO, DONE NOW * LDB CHSWP ADB D8 LDB B,I GET POINT OF SUSPENSION WORD CCE,SZB,RSS INITIAL LOAD? JMP X0380 YES, SKIP EMA CHUNK MOVES * LDB CHSWP STB CHSW2 SET CHUNK I/O CALL BUSY RBL,ERB SET SIGN BIT FOR $XSIO CALL STB CHSW3 * LDA CHIDX,I GET THE MSEG SIZE AND B37 CMA,INA MAKE IT NEGATINVE INA ADD 1 FOR BP STA B SAVE -MSEGSIZE+1 LDA CHMAT GET THE PHYS. START ADA D3 PAGE OF THIS PARTITION LDA A,I AND B1777 ADB A B HAS S.P.PART-MSEGSIZE+1 LDA CHSWP GET THE PROG¨¦þúS ID ADRS ADA D21 GET #PAGES FROM ID LDA A,I ALF,RAL SHIFT DOWN TO BOTTOM BITS RAL AND B37 ADB A B HAS S.P.PART+#PGS+1-MSEGSIZE STB CHKPG SET STARTPAGE EMA TO START SWAP LDA CHEMA GET EMASIZE TO FIND END OF AND B1777 SWAPPED AREA ADA B STA EMAEN * X0360 LDA SVCUR SAVE CURRENT USER MAP USA BEFORE MAPPING CHUNK CLA,INA CAX (X) = 1 REGISTER CLB (B) = 0 FOR PAGE# LDA D32 (A) = USER BASE PAGE REGISTER XMS ZAP B.P. SO RTIOC WON'T GET CONFUSED * LDA CHKPG ADA CHKSZ ADD CHUNK SIZE STA CHKNX TO GET START OF NEXT CHUNK CMA,INA ADA EMAEN SSA IS CHUNK PAST END OF EMA? JMP CHKSM YES, ADJUST # PAGES * LDA CHKSZ MAP IN THE CHUNK CHKMP CAX (X) = # PAGES IN CHUNK ALF,ALF RAL,RAL STA TEMP SAVE # WORDS IN CHUNK LDB CHKPG (B) = CHUNK PAGE START LDA CHKRG (A) = REGISTER # XMS * LDB CHMAT JSB PHYBP MAP IN USER'S BP ADA DM32 SAVE CHUNK MAP IN SECOND BP COPY IOR BIT15 USA * LDA CHKAD STA TEMP3 SET UP BEGINNING LOGICAL ADDR OF CHUNK LDA CHTRK STA TEMP1 SET TRACK # FOR SETUP LDA CHSCT STA TEMP2 SET SECTOR # FOR SETUP LDA CTRPA JSB SETUP BUILD TRIPLETS FOR CHUNK STA CTRP2 SET TOP ADDR OF TRIPLETS LDB TEMP1 STB CHTRK SAVE TRACK # FOR NEXT CHUNK, IF ANY LDB TEMP2 STB CHSCT SAVE SECTOR # FOR NEXT CHUNK, IF ANY * JSB $XSIO CHLU2 NOP DEF X0370 COMPLETION ADDR X0366 NOP LINK WORD CHRQ2 NOP READ/WRITE CTRP2 DEF CTRIP TRIPLET ADDR CHSP2 NOP PRIORITY CHSW3 NOP USE CURR USER MAP (ID ADDR + SIGN) * LDA RSCUR ®Äþú RESTORE USER MAP USA JMP X0005 SCHED NEXT PROG OR GO IDLE * * CHSW2 NOP CHUNK I/O BUSY FLAG CFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD CRDFL NOP ADDR OF MAT PTTN STATUS WORD CHKPG NOP PAGE NUMBER OF CURRENT EMA CHUNK CHKNX NOP NEXT CHUNK PAGE NUMBER EMAEN NOP END OF EMA CHTRK NOP TRACK CHSCT NOP SECTOR EMAS NOP EMAL NOP CHMAT NOP MAT ADDR OF PROG D28 DEC 28 DM32 DEC -32 BIT15 OCT 100000 SVCUR DEF CURMP,I RSCUR DEF CURMP CURMP BSS 32 * * AN EMA CHUNK IS FROM LOGICAL PAGE 1 THRU PAGE 31 IN USER MAP * SO THAT LOGICAL PAGE 0 IS NOT USED. THE REASON IS THAT WE * WILL NOT HAVE TO RELOAD THE BASE PAGE FENCE TO PREVENT THE * SYSTEM COMMUNICATION AREA FROM SHOWING THROUGH THE TOP PART * OF THE USER BASE PAGE. IT IS NO BIG LOSS TO MAP JUST ONE * PAGE LESS! CHKSZ NOP CHUNK SIZE CHKRG NOP REGISTER NUMBER OF CHUNK IN USER MAP CHKAD NOP LOGICAL ADDR OF CHUNK * * CHKSM LDA CHKPG GET SIZE OF CHUNK FROM HERE CMA,INA TO END OF EMA ADA EMAEN LDB EMAEN STB CHKNX THERE IS NO NEXT CHUNK JMP CHKMP * * X0370 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERROR JMP X03AB ERROR, ABORT! * LDA CHKNX STA CHKPG CMA,INA INSTEAD OF COMPARE, ADA EMAEN SUBTRACT TO SEE IF DONE SZA IF CHKNX = EMAEN THEN DONE JMP X0360 NO, NOT DONE YET * X0380 ISZ CRDFL,I FLAG =1 LOAD DONE, =3 SWAP DONE LDA CFLGS IOR CRDFL,I STA CRDFL,I LDB CHSWP CLA STA CHSWP STA CHSW2 LDA CHRQ ISZ $LIST FORCE LIST SCAN SLA WAS IT SWAP OUT? * JSB CLRLD NO, IT WAS LOAD. CLEAR LOAD BIT(B)=ID * CHECK SUBPTTN SWAPOUT * * X0385 LDA SUBF²þúL ANY SUBPTTNS NEED TO SWAP OUT? SZA JMP SUBSS YES, START/CONTINUE SUBPTTN SWAP OUT JMP $XCQ NO, GO CHECK SCHEDULE/ABORT LISTS * * X03AB LDA CHSWP GET ID SEG ADDR OF PROGRAM JSB $ABRT AND GO ABORT IT JMP X0385 NOW GO SCAN THE LISTS * SKP DREL NOP ROUTINE TO RELEASE DISC SWAP TRK STB TEMP3 ADB D27 COMPUTE ID SEGMENT SWAP ADDRESS LDA B,I CCE,SZA,RSS SWAPPED, SO GO TO RELEASE JMP DREL,I NOT, SWAPPED, SO RETURN STA TEMP SAVE LU/TRK/#TRK AND B177 STA TEMP2 ISOLATE # TRACKS TO RELEASE CLA CLEAR ID SEGMENT STA B,I SWAP VALUE LDA TEMP ALF,ALF RAL AND B377 LDB TEMP SSB ADA TATSD L. U. 3 SO ADD # SYS TRACKS STA TEMP1 LDB TEMP2 (B) TO # OF TRACKS TO REL JSB $DREL CALL DISC TRACK RELEASE PROCESOR LDB TEMP3 ADB D28 LDA B,I JSB IDXAD GET ID EXT ADDR JMP DREL,I NOT EMA, EXIT ADA D2 LDA A,I GET # EMA SWAP TRACKS AND B1777 FROM WORD 2 SZA,RSS IF NO TRACKS JMP DREL,I DON'T RELEASE * STA B (B)=#TRACKS TO RELEASE LDA TEMP1 TRACK ADDR OF PROG + #TRACKS ADA TEMP2 = BEGIN TRACK OF EMA JSB $DREL RELEASE THE TRACKS JMP DREL,I RETURN HED DISP4 -- SWAP CHECK ROUTINE. CAN AND SHOULD WE SWAP? TEMP7 NOP * * SWPCK CHECKS TO SEE IF AN AREA SHOULD BE SWAPPED, * IT CHECKS: * 1. IF A SWAP OUT IS UNDER WAY (IF SO FORGET IT) * 2. IF THE BASE PAGE SWAP FLAG FOR THE AREA ALLOWS SWAPPING. * 3. IF THE RESIDENT PROGRAM HAS INHIBITED SWAPPING. * 4. IF THE RESIDENT PROGRAM IS SCHEDULED AND HAS HIGHER * OR EQUAL PRIORITY. * 5. IF THE RESIDENT IS DORMANT BUT HAS PRIORITY AND IS IN * THE TIMEÎçþú LIST AND ITS TIME IS "NEAR". * 6. IF THE RESIDENT IS I/O SUSPENDED * WITH THE BUFFER IN HIS AREA. * * ALL OF THE ABOVE CONDITIONS INHIBIT A SWAP. ( JMP X0035 ). * THE FOLLOWING CONDITIONS CAUSE THE INDICATED ACTIONS. * * 7. THE RESIDENT IS BEING READ IN BUT DOES NOT HAVE PRIORITY * CAUSES AN ABORT (I.E. STOP THE READ) RETURN. * 8. THE RESIDENT HAS NOT BEEN EXECUTED SINCE IT WAS LAST * LOADED FROM THE DISC CAUSES A READ RETURN (I.E. ASSUME * THE RESIDENT CAN BE RELOADED WHEN NEEDED) * * CALLING SEQUENCE: * * ALL THE MAT PTRS ARE SET UP BY EITHER MATEN OR MATAD * MRDFL,I = THE READ IN FLAG 0=READING, 1 = INCORE, 2 =SWAPPING OUT OR * SEGMENT LOAD, 3 = INCORE AND SWAPPED OUT. * (B)= THE RESIDENTS ID-SEGMENT ADDRESS * (E)= 0 NORMAL SWAP CHECK CALL * 1 SUBPARTITION SWAP CHECK CALL * JSB SWPCK * JMP ABORT ABORT (I.E. STOP LOAD) RETURN (A=B=E=0). * JMP SWP SWAP OUT RETURN * JMP LOAD LOAD RETURN * JMP NOSWP CAN'T SWAP RETURN, ONLY SUBPTTN CHECK (E=1) * * THE FOLLOW TEMP AREAS ARE USED IN SWPCK: * RINF EQU TEMP READ IN FLAG SAVE LOCATION RBUFA EQU TEMP1 ADDRESS OF CONWRD THEN BUFFER ADDRESS RPRIO EQU TEMP2 ADDRESS OF RESIDENTS PRIORITY, THEN TEMP RSUSP EQU TEMP3 ADDRESS OF RESIDENTS SUSP RTIML EQU TEMP4 ADDRESS OF RESIDENTS T BIT. RTIME EQU TEMP5 ADDRESS OF RESIDENTS TIME. RSWTR EQU TEMP6 ADDRESS OF RESIDENTS SMAN. RTSLC EQU TEMP7 ADDRESS OF RESIDENTS TIMESLICE WORD. SKP SWPCK NOP LDA MRDFL,I GET CURRENT PTTN STATUS AND B7 CPA D3 IF CURRENT IS SWAPPED OUT JMP SWPC4 GO MAKE LOAD RETURN * RAL,ERA PUT (E) INTO SIGN OF RINF STA RINF SAVE THE READ IN FLAG ELA,CLE,ERA IF SWAPPING OR LOADING A SEGMENT CPA D2 OR IF CLEARING SUBPARTITIONS RSS þú CPA D4 THEN RETURN CAN'T SWAP JMP X0N35 FORGET THE SWAP, TRY NEXT PTTN * INB INDEX TO THE I/O CONWRD ADDRESS STB RBUFA SAVE IT ADB D5 INDEX TO THE PRIORITY ADDRESS STB RPRIO SAVE IT ADB D2 INDEX TO THE SUSPENSION ADDRESS STB RSUSP SAVE IT ADB D6 INDEX TO THE TYPE/CORE LOCK BIT ADDRESS LDA B,I GET THE WORD AND B100 ISOLATE THE CORE LOCK BIT SZA IF SET JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * INB INDEX TO THE STATUS LDA B,I GET STATUS TO A AND B417 ISOLATE THE STATUS (INCLUDE "LOADING" BIT) ADB D2 INDEX TO THE TIME LIST ADDRESS STB RTIML SAVE IT INB INDEX TO THE TIME ADDRESS STB RTIME SAVE IT ADB D9 INDEX TO THE SWAP TRACK ADDRESS STB RSWTR AND SAVE IT ADB D3 INDEX TO THE TIMESLICE ADDRESS STB RTSLC AND SAVE IT * LDB RPRIO,I GET THE PRIORITY CMB,CLE,INB SUBTRACT ADB ZPRIO,I SET E IF RES. WINS PRIORITY TEST STB RPRIO AND SAVE RESULT FOR TIMESLICE CHECK LDB RINF GET THE READ FLAG BLR,BRS CLEAR BITS 14,15 DON'T CHANGE (E) CPA D2 IF I/O SUSPENDED JMP SWPC3 GO DO I/O SUSP. CHECKS * CPA B401 IF IT'S BEING LOADED FROM DISC JMP SWPC3 GO DO I/O SUSP. CHECKS * SEZ,RSS IF THE CONTENDER HAS PRIORITY JMP SWPC1 GO CHECK IF SWAP IS NEEDED * LDB RPRIO IF CONTENDER HAS LOWER PRIORITY SZB GO CHECK JMP SW.1 RESIDENTS STATUS * * * CONTENDER IS SAME PRIORITY AS RESIDENT. IF RESIDENT HAS USED * A FULL SLICE (SLICE COUNT=0), LET THE CONTENDER USE THE PARTITION. * * LDB RTSLC,I FETCH TIMESLICE WORD OF RESIDENT SZB,RSS IF FULL SLICE USED, JMP SWPC1 LET Oþú CONTENDER HAVE IT * SW.1 CPA D1 IF RESIDENT IS SCHEDULED JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * LDB RTIML,I GET THE TIME LIST BIT BLF,SLB IF IN TIME LIST CLE,SZA AND DORMANT JMP SWPC1 NO SO GO CHECK IF SWAP IS NEEDED * DLD $TIME GET THE SYSTEM TIME DIV BTRIP !! DIVIDE BY ZERO TO SET POS. !! BTRPA EQU *-1 DEF TO BTRIP ADA RTIME,I SUBTRACT THE ID-SEG TIME VALUE SEZ,CLE IF OVERFLOW INB STEP B ISZ RTIME STEP TO NEXT TIME WORD ADB RTIME,I ADD THE HIGH WORD ADA SWPTM ADD THE NEG. OF # OF TICKS SYS WILL WAIT. SEZ,SZB,RSS IF HIGH VALUE IS ZERO AND SSA,RSS THE DIFF < LIMIT JMP SWPC1 * CPB SWPTM & LIMIT NOT = 0 RSS JMP X0N35 FORGET THE SWAP, TRY NEXT PTTN * SWPC1 LDA RSUSP,I SWAP IN ORDER TEST IF THE RESIDENT LDB RSWTR,I WAS RUN SINCE LAST LOAD CLE,SZB,RSS IF SWAP TRACKS STILL ASSIGNED OR SZA,RSS POINT OF SUSP IS ZERO SWPC4 ISZ SWPCK THEN JUST READ SWPC2 ISZ SWPCK ELSE SET SWAP RETURN (E=0) JMP SWPCK,I EASY ISN'T IT? SPC 1 * * NOTE: IF LOAD IN PROGRESS, DON'T ABORT IT UNLESS * CONTENDER IS OF HIGHER PRIORITY (I.E., DON'T * ABORT IF SAME PRIORITY FOR TIMESLICING). (E) * WILL BE SET IF RESIDENT IS > OR = IN PRIORITY* * SWPC3 CLA E = 0 IF HE HAS PRIORITY SEZ,SZB,RSS IF READING IN AND PRIORITY JMP SWPCK,I RETURN P+1 WITH A = 0 (ABORT) * SZB,RSS IF READING IN BUT NOT PRIORITY JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * * THE FOLLOWING CODE WILL ALLOW THE SWAPPING OF * PROGRAMS SUSPENDED FOR UNBUFFERED I/O REQUESTS. * * LDA RBUFA,I GET CONWRD. * RAR IF IT IS A * SSA,SLA CONTROL REQUEST * JMP SWPC2 THEN ALLOW SWAP. * * IF UNBUFFERED CONTROL DON'T‹ïþú SWAP * LDA RBUFA,I GET COMMAND AND D3 IF CONTROL CPA D3 JMP X0N35 DON'T SWAP * * ISZ RBUFA ELSE INCREMENT TO THE BUFFER ADDRESS. LDA RBUFA,I GET BUFFER ADR CLE,SSA IS IT A RE-ENT BUFFER JMP SWPC2 YES CAN SWAP * LDA RBUFA ADA D20 INDEX TO LOW MAIN LDA A,I CMA,CLE,INA SUBTRACT FROM BUFF ADDR ADA RBUFA,I IF BUFF ADDR IS BELOW LOW MAIN SEZ,RSS THEN IT IS IN COMMON, SWAP OK. JMP SWPC2 (E=0) SWAP RETURN * * X0N35 - GET HERE IF SWPCK TRIED TO DISPATCH A PROGRAM * IN A PARTITION BUT FOUND THAT IT WAS NO SWAPPABLE * AT THE TIME (IF EVER). IF THE PROGRAM TO BE * DISPATCHED DOES NOT REQUIRE A SPECIFIC PARTITION * NUMBER, THEN A SWAP WILL BE TRIED ON THE NEXT * PARTITION IN THE ALLOCATED LIST. * X0N35 LDA RINF SSA,RSS DOING SPECIAL SUBPTTN CHECK? JMP X0N36 NO * ISZ SWPCK YES, RETURN NOSWP CONDITION JMP SWPC4 * X0N36 LDA ZMPID,I WAS SPECIFIC PTTN ASSIGNED FOR SSA PROGRAM TRYING TO DISPATCH? JMP X0035 YES, CAN'T USE ANOTHER PTTN. JMP SCHL2 NO, TRY NEXT PTTN IN LIST, IF ANY LEFT * SPC 1 SWPTM DEC -15 MAX WAIT IS 150 MS. D9 DEC 9 B401 OCT 401 HED SWOUT & SWPIN THE MAP SAVE & RESTORE SWAPPING ROUTINES * * * THE SWOUT ROUTINE IS CALLED FOR ALL PROGRAMS TO BE SWAPPED OUT TO THE * DISC. IT'S PURPOSE IS TO SAVE THE USER MAPS IN THE USER AREA SO * THAT ON SWAP IN THE MAP REGISTERS WILL BE RESTORED TO THE SAME * CONDITION, RELATIVE TO THE START OF THE PARTITION, THAT THEY WERE WHEN * THE SWAP OUT OCCURED. THIS IS DONE BY MAPPING IN THE FIRST TWO PAGES * OF THE USERS PARTITION AND THEN SAVING THE MAP AS IT EXISTS IN THE * UNUSED PORTION OF THE USERS BASE PAGE INTO WORDS 2 - 34 OF THE * SECOND PAGE OF THE PARTITION. THIS IS THE AREA wþúRIGHT BEHIND THE * THE X & Y REGISTER SAVE AREA. ON SWAP IN THIS INFO WILL BE USED * TO REBUILD THE MAP REGISTERS. * * * CALLING SEQUENCE : JSB SWOUT * * MADR = ADDRESS OF MAT START PAGE WORD * (IE MATAD HAS BEEN CALLED) * * E-REG = 0 SWAP OUT * E-REG = 1 ALREADY SWAPPED OUT BUT * BUT WE INTEND TO RESCHEDULE * THE PROGRAM. * * E-REGISTER IS PRESERVED. * * SWOUT NOP LDA MADR,I GET THE START PHYS PAGE OF PART'N AND B1777 KEEP ONLY THE START PAGE # STA B B = START PAGE LDA D2 CAX X = # OF PAGES TO MAP LDA $DVPT A = START REGISTER # XMS MOVE 1ST TWO PAGES OF PART'N INTO DVR MAP * LDA ADBPC GET THE ADDRESS OF THE REGISTERS (A=SOURCE) LDB A NOW GET THE DESTINATION ADB D34 ADDRESS TO B. SEZ ARE WE SAVING OR RESTORING ? SWP RESTORING. MVW D32 *** SAVE OR RESTORE THE USER MAP AS IT EXISTS *** JMP SWOUT,I RETURN * SKP * * * THE SWPIN ROUTINE IS CALLED FOR ALL PROGRAMS THAT HAVE BEEN * SWAPPED BACK INTO MEMORY. IT GETS THE 32 WORDS OF MAP INFO * SAVED BY SWOUT AND CONFIGURES THESE WORDS TO MAKE SENSE FOR * THE CURRENT PARTITION. IT USES $LOW & $HIGH AS THE LIMITS * OF THE PARTITION AREA. $HIGH WILL PROBABLY BE USED LATER * FOR SHAREABLE EMA. * * * CALLING SEQUENCE JSB SWPIN * MLNK = ADDR OF MAT ENTRY OF * INTEREST. * * SWPIN NOP LDB MLNK GET MAT ADDR OF INTEREST ADB D3 SAVE THE START PG OF THIS PART'N LDA B,I AND B1777 STA STPG# STPG# = START PG # OF THIS P“ÍþúART'N * STA B B = START PG # LDA D2 CAX X = # OF PAGES TO MAP LDA $DVPT A = START REGISTER # XMS MAP 1ST TWO PAGES OF PART'N INTO SYS MAP * LDB ADBPC GET THE DEST BUFFER ADDRESS OF NEW MAP INFO STB NEW AND SAVE FOR OFFSET TESTS. ADB D34 GET THE READ BUFFER ADDRESS OF OLD MAP INFO LDA STPG# NOW IF THE CURRENT START PAGE # EQUAL OLD CPA B,I THEN WE MUST HAVE SWAPPED THIS GUY BACK INTO THE JMP NOMAP SAME PARTITION & NO OFFSET TESTS ARE NEEDED. * STB OLD OLD = ADDRESS OF BUFFER OF OLD MAP INFO LDB B,I GET THE OLD START PAGE CMB,INB & MAKE NEG FOR TESTS STB OBASE OBASE = OLD BASE ( START PG OF LAST PART'N) * LDB DM32 GET THE MAP REG COUNT & STB KNTR SET IT UP SPC 1 * WHEN SHAREABLE EMA COMES KNTR = #PGS PROG ONLY * THAT WAY THE EMA PAGE #'S WON'T BE EFFECTED. SPC 1 JMP SETIT OK, SO SET UP THE NEW MAPS. * * NXPG# LDA OLD,I GET THE NEXT OLD PAGE # LDB $LOW GET THE LOWEST PAGE # FOR PART'NS CMB,CLE,INB MAKE NEG ADB A NOW IF THE OLD PAGE WE ARE LOOKING LDB A AT IS BELOW THE LOWEST PARTITION PAGE CMB,SEZ,CLE,INB OR IS ABOVE THE LARGEST ADB $HIGH PAGE KNOWN BY THE SYSTEM, SEZ,RSS JMP SETIT THEN JUST LEAVE IT AS IS. * ADA OBASE HERE IF $LOW <= (OLD PG #) <= $HIGH ADA STPG# ADD START PAGE OF THIS PART'N * SETIT STA NEW,I THIS IS NOW THE NEW PAGE # ISZ OLD BUMP A FEW POINTERS ISZ NEW ISZ KNTR DONE ? JMP NXPG# NO, SO AROUND WE GO. * LDB ZIDEX ONE LAST THING TO DO. SZB,RSS THIS AN EMA PROG ? JMP SWPIN,I NO, SO WE'RE DONE. * INB YES, SO WE NEED TO SET UP THE ‹ þúNEW START LDA B,I PAGE OF EMA. SO GET THE OLD AND B1777 EMA START PAGE. ADA OBASE AND CALCULATE THE NEW START PAGE ADA STPG# * XOR B,I NOW PLACE IT BACK AND B1777 INTO THE ID EXTENSION UNDER THE XOR B,I RULES OF STA B,I WOO. JMP SWPIN,I SO NOW WE'RE DONE. RETURN TO CALLER. * * NOMAP LDA B PROG SWAPPED BACK INTO SAME PART'N LDB ADBPC MVW D32 RESTORE MAP TO BASE PAGE JMP SWPIN,I RETURN * * $LOW NOP STARTING PAGE # OF THE PROG PART'N AREA $HIGH NOP LAST PAGE # OF THE PROGRAM PART'N AREA OLD NOP BUFFER ADDRESS OF OLD MAP INFO NEW NOP BUFFER ADDRESS OF NEW MAP INFO KNTR NOP LOOP COUNTER SET TO -32 OBASE NOP NEG START PAGE # OF LAST PART(N PROG WAS IN STPG# NOP STARTING PAGE # OF THIS PARTITION D34 DEC 34 * HED DISP4 -- PRELIMINARY SETUP FOR DISK CALL HED DISP4 -- PRELIMINARY SETUP FOR DISK CALL * PREST SETS UP FOR A DISC LOAD OR SWAP AS FOLLOWS: * * 1. SETS MEMORY BOUNDS FOR THE PROGRAM * TEMP = #WORDS IN MAIN * TEMP3 = FIRST WORD OF MAIN * TMP = #WORDS IN BASE PAGE * TMP1 = FIRST WORD OF BASE PAGE * * 2. IF SWAP, GET SWAP TRACKS IF REQUIRED * AND SETS SMAN IN THE ID-SEGMENT. * * 3. SETS THE INITIAL DISC ADDRESS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * B = LU OF DISC * * 4. SETS THE NUMBER OF SECTORS: * CN#SC = -NUMBER OF SECTORS/TRACK * * 5. CALLS SETUP TO BUILD THE TRIPLET FOR THE LOAD * * PREST CHECKS THE FOLLOWING OPTIONS: * * 1. SHORT ID-SEGMENT (BG-SEGMENT LOAD) * 2. THE "ALL OF CORE" BIT CAUSES THE WHOLE AREA * TO BE SWAPPED ALONG WITH ALL OF THE AREA * BASE PAGE. * [¼þú 3. IF SWAP THEN THE FIRST WORD IS ALWAYS THE AREA * BOUNDRY. * 4. IF SWAP AND NO TRACK ASSIGNED THEN SWAP TRACKS * ARE ALLOCATED. * * CALLING SEQUENCE: * * PREST ASSUMES -BGLWA- AND -AVMEM- ARE SET UP FOR PROG TO BE SWAPPED * B = ID-SEGMENT ADDRESS * E = 1 FOR LOAD * E = 0 FOR SWAP OUT * A = BOTTOM OF TRIPLET TABLE * JSB PREST * * ON RETURN: * B = DISC LU * A = DEF OF TRIPLET TABLE FOR XSIO CALL * * ABNORMAL EXIT * * A JMP IS MADE TO X0035 IF NO DISC TRACKS ARE AVAILABLE * FOR SWAPPING. * * INTERNAL TEMP AREA USAGE: * TEMP4 - TRIPLET QUE ADDRESS * TEMP5 - PROGRAM TYPE WORD * TEMP6 - MEMORY ADDRESS POINTER TO ID-SEGMENT. * TMP2 - DISC ADDRESS POINTER TO ID-SEGMENT. SKP PREST NOP STA TEMP4 SAVE THE TRIPLET QUE ADDRESS CLA SET THE START SECTOR STA TEMP2 ADDRESS FOR SWAP OPTION CPB XEQT IF CURRENT EXECUTING STA XEQT PROGRAM CLEAR THE FLAG ADB D14 INDEX TO TYPE WORD LDA B,I GET PROGRAM TYPE TO A STA TEMP5 SAVE IT ALF,ALF ROTATE THE SHORT ID-SEG. BIT ALF,SLA,RAR TO ZERO AND TEST INB,RSS ADB D8 INDEX TO MEMORY ADDRESSES STB TEMP6 SAVE THE MEMORY ADDRESS ADB D4 INDEX TO THE DISC ADDRESS STB TMP2 AND SAVE IT SSA IF SHORT ID-SEG. JMP SEGCK GO CHECK SEGMENT LIMITS ALF,RAL AND D15 IF PROG TYPE = 5 CPA D5 JMP SEGCK GO CHECK SEGMENT LIMITS * * ******************************************* **E=0IF SWAP,B=0 IF FIRST LOAD******* ******************************************* * SEZ,INB STEP TO SWAP DISC ADDRESS LDB B,I GET SWAP ADDRESS (SKIPPED IF SWAP) CMB,CLE,INB,SZB IF SWAP TRACK OR SWAPPING égþú ISZ TMP2 STEP THE DISC ADDRESS TO SMAN. PRES1 LDB TEMP6,I GET THE ID-SEG LOW MAIN ADD. ISZ TEMP6 STEP THE MEMORY ADDRESS TO HIGH MAIN STB TEMP3 CMB,INB NEGATE SEZ IF FIRST LOAD JMP PRES2 GO SET UP TRUE TO ID-SEG. * LDA TMP2 INA LDA A,I STA ZIDX0 JSB IDXAD GET ID EXT ADDR JMP PRES6 NOT EMA, ZIDX0=0 STA ZIDX0 SAVE ID EXT ADDR INA LDA A,I RAR AND B76K ADB A JMP PRES5 MAKE SURE (A)#0 * PRES6 LDA TEMP6 INDEX TO # OF PAGES WORD ADA DM2 LDA A,I AND B76K GET # OF WORDS LDB A TO B REG * CCA (A) = -1 SWAP ALL OF PTTN PRES5 STB TEMP SET #WORDS IN MAIN ISZ TEMP6 STEP TO LOW BASE PAGE LDB TEMP6,I GET LOW BP STB TMP1 AND SET IT ISZ TEMP6 STEP TO HIGH BASE PAGE CMB,INB SZA INITIAL LOAD? JMP PRES9 NO, USE ALL OF POSSIBLE BP (A#0) * ADB TEMP6,I YES, USE ACTUAL HIGH BP BOUND (A=0) RSS PRES9 ADB BPA2 STB TMP SET BASE PAGE SIZE CMA,CLE,INA SET E IF FIRST LOAD LDA TMP2,I GET THE DISC ADDRESS SZA IF NONE SKIP JMP PRES7 DISC DEFINED GO SET UP * * GET SWAP TRACKS * LDA B GET BASE PAGE SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TMP SAVE LDA TEMP WHILE CHECK MAIN SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TEMP SAVE MAIN SIZE FOR SETUP ADA TMP ADD IF ANY ROUNDED UP FROM BP ALF,ALF DIVIDE BY 128 WORDS RAL TO GET #SECTORS STA PRSCT CLB DIV #SCT DIVIDE BY MIN #SECTORS/TRACK SZB IF REMAINDER INA BUMP STA SETUP l@þú SET #TRACKS IN SMAN * LDB TMP2 INB INCRE TO EMA WORD LDA B,I SZA EMA PROG? JMP PRESA YES, ADD EMA TRACK NEEDS * STA EMTRK NO, JUST SWAP PROG LDA SETUP JMP PRESB * PRESA AND B1777 GET EMA SIZE (IN PAGES) ALF,RAR MULT BY 8 TO GET #SECTORS ADA PRSCT ADD #SECTORS NEEDED FOR PROG CLB DIV #SCT DIVIDE BY #SECTORS/TRACK SZB TO GET # OF TRACKS INA BUMP #TRACKS IF ANY OVERFLOWED LDB SETUP CMB,INB SUBTRACT #TRACKS FOR PROG ADB A FROM TOTAL #TRACKS STB EMTRK FOR #TRACKS IN EMA * PRESB CLB GO TO SYS TO GET TRACKS JSB $DREQ ERB,SLB SET LEAST LU BIT IN E SKIP IF NONE ALF,SLA,ALF ROTATE TRACK SKIP ALWAYS JMP X0035 NO TRACKS EXIT TO SWITCHER * ERA,CLE SET LU BIT IN TRACK WORD IOR SETUP ADD THE # TRACKS STA TMP2,I AND SET BACK IN ID-SEG * LDB ZIDX0 (A)=SWAP WORD, (E)=0 SZB,RSS EMA PROG? JMP PRES7 NO * STA SETUP SAVE (A) TEMPORARILY ADB D2 INDEX TO EMA SWAP TRACKS WORD LDA EMTRK STA B,I SET #EMA SWAP TRACKS LDA SETUP RESTORE (A) * * DECODE TRACK/SECTOR ADDRESS IN A * PRES7 AND B177 MASK OUT THE SECTOR/#TRACKS CLB,SEZ,INB SET B TO 1,SKIP IF SWAP STA TEMP2 SET SECTOR ADDRESS XOR TMP2,I GET THE TRACK/LU ASL 1 SET LU IN B/TRACK IN HIGH A ALF,ALF BRING DOWN THE TRACK STA TEMP1 SET THE TRACK ADDRESS LDA SECT2 GET THE SECTOR SIZE FOR LU 2 SLB IF LU IS 3 LDA SECT3 USE 3'S NUMBER CMA,INA SET NEGATIVE STA CN#SC NUMBER OF SECTORS/TRACK * * NOW CALL SETUP TO BUILD THE TRIPLETS * STB TEMP6 SET LU IN A SAFE PLACE LDA TEMP4 GET THE TR91þúIPLET ADDRESS JSB SETUP SET UP THE MAIN LDB TMP STB TEMP SET UP FOR THE LDB TMP1 BASE PAGE STB TEMP3 AND JSB SETUP GO BUILD IT'S TRIPLETS LDB TEMP6 RESTORE THE LU TO B JMP PREST,I NOW THAT WASN'T HARD WAS IT? SPC 2 PRES2 CLA (A) = 0 TO USE REAL BOUNDS ADB TEMP6,I JMP PRES5 * SEGCK LDB FENCE IS IT BELOW THE FENCE CMB,INB ADB TEMP6,I LOW MAIN(SEGMENT) SSB JMP SEGER YES GO ABORT * LDB TEMP6 INB LDB B,I GET HIGH MAIN (SEGMENT) CMB,INB ADB BGLWA DOES IT FIT IN PART'N INB CCE,SSB,RSS SET E FOR OK COND'N JMP PRES1 IT WILL FIT * SEGER LDB D8 IT WON'T FIT JMP $SCXX GO PRINT SC08 AND ABORT * SPC 2 C177 OCT 177600 DM2 DEC -2 #SCT NOP EMTRK NOP PRSCT NOP HED DISP4 -- DISK CALLING SEQUENCE GENERATOR * * DISK READ/WRITE CALLING SEQUENCE GENERATOR ROUTINE * ON ENTRY * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * A = PARAMETER TABLE ADDRESS * * THE DISC PARAMETER GENERATOR FUNCTION IS TO GENERATE * * PARAMETERS FOR DISC CALL GUARANTEEING THAT ALL * * TRACK CROSSING CALLS ARE BROKEN DOWN INTO SUB-CALLS * * SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * * THE CALLS ARE BROKEN UP IN TRIPLETS OF * * STARTING CORE MEMORY ADDRESS * * NUMBER OF WORDS TO TRANSFER * * STARTING TRACK/SECTOR ADDRESS. * * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING * * THE LAST TRIPLET. * * ýþú * SETUP NOP ENTRY/EXIT LDB TEMP COMPUTE NUMBER OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA DM3 SET UP TRIPLET STA DSTAD ADDRESS ADB B177 ROUND UP NUMBER ASR 7 OF SECTORS BLS STB TEMP5 SAVE NUMBER OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B ADA CN#SC SUB CURRENT # SECTORS/TRACK LDB TEMP3 STB DSTAD,I STORE STARTING MEMORY ADDRESS ISZ DSTAD INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES, USE REST OF TRACK IF OVER. ASL 6 UPSET LDB TEMP1 FORM BLF,RBL TRACK RBL,RBL ADDRESS ADB TEMP2 AND SECTOR ADDRESS DST DSTAD,I STORE LAST TWO WORDS OF TRIPLET DSTAD EQU *-1 ADA TEMP3 UPDATE STARTING STA TEMP3 MEMORY ADDRESS LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB DSTAD,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUB 1 FOR CORRECT NEXT TRIPLET ADA DSTAD ADDRESS CALC. JMP SETU1 GO TO NEXT LOOP SPC 1 SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET HED DISP4 -- READ SETUP * * SETUP TO READ IN BACKGROUND DISK RESIDENT PROGRAM SEGMENT * $BRED EQU * $SGLD NOP ENTRY/EXIT CLA CPA SGSWP SEGMENT LOAD CALL BUSY? JMP SGLD1 NO, SO DO SEGMENT LOAD * LDB XEQT YES, SEGMENT LOAD CALL BUSY STA XEQT CLEAR CURRENT EXECUTING PROG STB SGSUP AND SET IT SEGM€­þúENT SUSPENDED JMP X0035 TRY NEXT SCHEDULED PROG * SGLD1 STB SGTMP SAVE THE SHORT ID SEG ADDRESS LDA XEQT GET THE MAINS ID SEG ADDRESS JSB MATEN NOW SET UP THE MAT POINTERS LDB SGTMP GET THE SHORT ID ADDRESS * LDA D2 IOR MFLGS SET READ IN WAIT FLAG STA MRDFL,I PTTN STATUS =2 LOAD SEG CLA,CCE,INA (E=1) FOR PREST TO LOAD STA SGRQ SET READ REQUEST LDA MPRIO,I STA SGPR SET PRIORITY LDA STRPA JSB PREST ADB MSIGN STB SGLU SET LU STA STRP SET TRIPLETS ADDR LDA MID,I AFTER PREST CALL RETURNS STA SGSWP SET SEGMENT I/O CALL BUSY LDA MRDFL STA SRDFL SAVE FLAG WORD ADDR LDA MFLGS STA SFLGS SAVE HIGH BITS * JSB $XSIO SGLU NOP LOGICAL UNIT DEF X0422 COMPLETION ADDR X0455 NOP LINK WORD SGRQ OCT 1 REQUEST CODE STRP DEF STRIP TRIPLETS ARRAY ADDR SGPR NOP PRIORITY SGSWP NOP ID SEGMENT ADDR LDB MID,I JSB $LIST SUSPEND SEGMENT UNTIL DONE OCT 402 JMP $SGLD,I RETURN, SEGMENT LOAD INITIATED * * SRDFL NOP SGTMP NOP SFLGS NOP $PGID EQU SGSWP $SGID EQU SGTMP STRPA DEF STRIP MSIGN OCT 100000 SGSUP NOP * * * SEGMENT LOAD COMPLETION SECTION * X0422 STB TEMP SAVE COMPLETION STATUS LDB SFLGS INB STB SRDFL,I FORCE PTTN STATUS=1 * LDB SGSWP FETCH ID ADDR STB TEMP1 SAVE FOR POSSIBLE $LIST ERROR & CLRLD CLA STA SGSWP CLEAR BUSY FLAG STA SGSUP CLEAR SEGMENT SUSPEND FLAG * JSB $LIST CALL $LIST TO SCHEDULE PROGRAM OCT 401 * SZA IF LIST ERROR JMP X0126 GO ABORT PROGRAM * LDA SGRQ LDB TEMP1 FETCH ID ADDRESS JMP X0125 DO OTHER COMPLETION STUFF * HED DISP4 -- SYSTEM START UP **Ëþú****************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * SETS FENCE REGISTER TO 0 * * CLEARS XEQT * * SCHEDULES 'FMGR' IF PRESENT * STARTS THE CLOCK BY CALLING $SCLK IN RTIME MODULE * THIS SECTION IS EXECUTED ONCE - IT IS OVERLAYED ******************************************************************** * $ZZZZ NOP * STB DFMG SET THE NAME ADDRESS CLC 0 CLEAR INTERRUPT SYSTEM JSB MPINT GO DO MAP STUFF * * DEFINE HIGH AND LOW BOUNDS OF PARTITION PAGES * LDA $MNP GET THE MAX # OF PART'NS CMA,INA AND SET NEG FOR LOOP N#PTN LDB $MATA GET THE MATA TABLE ADDRESS * MADD STA *-1 LOOKS STRANGE DOESN'T IT ? NXPTN STB *-1 * ADB D3 INDEX TO THE START PAGE WORD LDA B,I AND B1777 KEEP ONLY PAGE BITS STA STPG# INB LDA B,I GET THE # OF PAGES IN THE PART'N AND B1777 KEEP ONLY PAGE BITS ADA STPG# A = START PG# + # OF PAGES LDB $HIGH GET THE HIGHEST PAGE # SO FAR CMB,INB NOW IF THE CURRENT SUM IS LARGER ADB A THAN THE PAST SUM SSB,RSS THEN USE THE CURRENT SUM AS LAST PAGE STA $HIGH IN THE SYSTEM (USED BE SWAPPING ROUTINES) * LDB MADD GET THE CURRENT PART'N MATA ADDRESS ADB D7 INDEX TO THE NEXT ONE ISZ N#PTN WE DONE ? JMP NXPTN NO, SO DO NEXT PARTITION. * LDB $MATA YES, SO NOW FIGURE ADB D3 OUT THE START OF THE PARTITION AREA LDA B,I GET THE PAGE # AND B1777 KEEP ONLY PAGE BITS STA $LOW SET AS START OF THE PARTITION AREA * * LDA SWAP SET UP THE SWAP DELAY ALF,ALF ziþú AND B377 CMA,INA SET NEGATIVE STA SWPTM SET THE VALUE * LDA SECT2 FIND MINIMUM # SECTORS/TRACK LDB SECT3 SUBTRACT # FOR LU 3 CMB,INB,SZB FROM # FOR LU 2. ADB SECT2 IF POSITIVE RESULT, CMB,SSB,INB,SZB LU 3 IS SMALLER. LDA SECT3 OTHERWISE, USE LU 3 ARS CONVERT 64 WORD SECTORS STA #SCT TO 128 WORD SECTORS LDA SKEDD SAVE THE CURRENT STA ZWORK SCHEDULE POINTER SPC 1 JSB $LIST SCHEDULE 'FMGR' PROGRAM OCT 201 IF IT IS IN THE SYSTEM. DFMG DEF * SZA JMP ZEXIT NO - BTRIP NOP END OF BG TRIPLETS CHKBG EQU BTRIP-$ZZZZ-21 INSURE AT LEAST 7 TRIPLETS LDA SKEDD LDB A,I INSURE 'FMGR' IS CPB ZWORK FIRST IN THE SWP SCHEDULED LIST. STB SKEDD STA B,I CLB STB A,I LDB TATLG INHIBIT ALL TRACK STB $OTAT ALLOCATIONS UNTIL (SAVE IN TBL AREA 2) CCB 'FMGR' EXECUTES. STB TATLG 'FMGR' UNDOES THIS SPC 1 JMP ZTYPE * FNMP OCT 2000 B1740 OCT 1740 * ********MAP INITIALIZATION************** ******* MPINT NOP LDA $MPFT ADA D4 LDA A,I GET START OF SSGA ADA DM1 STA $SGAF RTRIP NOP END OF RT TRIPLETS CHKRT EQU RTRIP-BTRIP-21 INSURE AT LEAST 7 TRIPLETS * LDA $DVPT SET UP LOGICAL ADDR ALF,ALF IN DRIVER PARTITION FOR RAL,RAL ACCESSING USER'S BP COPY IOR B1740 OF USER MAP STA ADBPC * LDA $MPFT INA LDA A,I GET START OF MEM RES LIB AND B76K ALF RAL,RAL STA B LDA LBORG AND B76K ALF RAL,RAL STA LBREG LIB PAGE REGISTER START CMA,INA ADA B STA LB#PG NUMBER OF PAGES IN LIB LDA $MRMP ADA LBREG LDA A,I STRIïïþúP NOP END OF SEGMENT TRIPLETS CHKSG EQU STRIP-RTRIP-21 INSURE AT LEAST 7 TRIPLETS AND B1777 STA LBPG# LDA LBREG ADA B40 STA LBREG * LDA $CMST USE AREA FROM START OF COMMON CMA,INA TO THE END OF USER MAP ADA D32 FOR DOING I/O ON CHUNKS OF STA CHKSZ EMA TO BE SWAPPED LDA $CMST ADA D32 STA CHKRG STARTING REG# IN USER MAP LDA $CMST ALF,ALF RAL,RAL STA CHKAD SAVE LOGICAL ADDR * LDA $MRMP GET ADDRESS MEM RES MAP USA LOAD USER MAP CLA XMA SET DMA1 FROM SYS MAP INA XMA SET DMA2 FROM SYS MAP LDA BPA2 GET LAST USER LINK INA INCREASE TO FIRST SYSTEM LINK IOR FNMP SET BIT 10 TO SHOW LOWER MAPPED LFA SET FENCE FOR BP JSB LSTIN INITIALIZE PTTN LIST PTRS JMP MPINT,I * CTRIP NOP END OF MOTHER PTTN TRIPLETS CHKCH EQU CTRIP-STRIP-21 INSURE AT LEAST 7 TRIPLETS CTRPA DEF CTRIP HED DISP4 -- ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XIDEX EQU 1645B ADDR OF CURR ID SEG EXT XMATA EQU 1646B ADDR OF CURR MAT ENTRY XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * INTBA EQU 1654B SKEDD EQU 1711B * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW SWAP EQU 1736B * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RT켺¶DRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BGDRA EQU .+68 FWA OF BGG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BGLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH ORIGINALLY 2716 (8) ? EQU *-2716B END $ZZZZ ò‰¼ÿÿ ÿý"Nq ÿ92067-18105 2040 S C0122 &RTIM4 TIMER MODULE             H0101 EþúASMB,R,L,C,Q ** RT TIME MODULE ** HED REAL TIME TIME MODULE * NAME: RTIME * SOURCE: 92067-18105 * RELOC: PART OF 92067-16102 * PGMR: G.A.A.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RTIME,0 92067-16102 REV.2040 800730 * * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * RTIME ENTRY POINT NAMES * ENT $TADD,$CLCK,$TREM,$TIMV ENT $ETTM,$TIMR,$ONTM,$TMRQ,$SCLK * * RTIME EXTERNAL REFERENCE NAMES * EXT $INER,$DEVT,$LIST,$XEQ,$RLNK,$LICE,$RVAL,$DCPU EXT $ERMG,$MSEX,$YMG,$IDSM EXT $WORK,$BATM,$TIME * ******************************************************************** * * THE RTIME MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * * 1. TIME PROCESSOR ROUTINES * * 2. CLOCK START UP ROUTINE. * * ******************************************************************** HED REAL TIME CLOCK-TIME LIST PROCESSING ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP-2100 REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMENT REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. SCHEDULE PROGRAMS AT THE REQUESTED TIME AND COMPUTE ITS* * NEXT START TIME. * * 3. ADD PROGRAMS TO THE TIME LIST. *àþú * 4. REMOVE PROGRAMS FROM THE TIME LIST. * * 5. OUTPUT CURRENT SYSTEM TIME TO USER ARRAY. * * 6. SET ID SEGMENT VALUES AS REQUESTED BY USER. * ******************************************************************** SPC 1 * THE $CLCK ROUTINE FUNCTIONS AS FOLLOWS: * * THE ROUTINE IS ENTERED EVERY 10 MILLISECOND DUE * * TO TIME BASE GENERATOR INTERRUPTS. * * THE TIME VALUE IS INCREMENTED BY 10 MILLISECONDS. * * THE TIME VALUES OF EACH PROGRAM IN TIME LIST IS * * COMPARED TO THE CURRENT TIME. IF THE TIMES * * COMPARE AND THE PROGRAM IS DORMANT, A SCHEDULE * * REQUEST IS MADE VIA LIST PROCESSOR. REGARDLESS * * OF PROGRAM STATUS, THE NEXT START TIME IS * * COMPUTED UNLESS THE MULTIPLE VALUE IS ZERO- * * WHICH MEANS THAT THE PROGRAM IS TO BE REMOVED * * FROM TIME LIST. * * THE TIME-OUT CLOCKS FOR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * $CLCK ISZ $TIME STEP THE LOW ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS ISZ $TIME+1 STEP THE HIGH ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL STA $TIME DAYS WORTH OF STB $TIME+1 OF TENS OF MS. ISZ $TIME+2 STEP THE DAYS/YEARS COUNTER * * CHECK IF TIME TO SCHEDULE PROGRAM * CL010 LDB TLIST TIME LIST CL011 CLE,SZB,RSS IF THRU PROCESSING IT, GO JMP TOSLC PROCESS CPU USAGE AND TIMESLICE STB POINT SAVE TIME LINK ADB D2 B NOW PTS TO IDSEG TIME VAOþúULE DLD B,I GET THE SCHEDULE TIME CPA $TIME IF BOTH WORDS MATCH CCE THEN CPB $TIME+1 THE SEZ,RSS TIME IS JMP CH010 JSB TMSCH NOW SO SCHEDULE THE PROG. * * INCREMENT TO NEXT PROGRAM IN LIST * CH010 LDB POINT,I GET ADDR OF NEXT PROG IN LIST JMP CL011 GO TO COMPARE NEXT PROG IN LIST * * * * BUMP THE CPU USAGE WORDS (DOUBLE INTEGER) * TOSLC ISZ $DCPU,I BUMP USAGE BUFFER JMP UNDER AND CONTINUE WITH TIMESLICE WORK * LDA $DCPU FIRST WORD FULL ADA N1 SO BUMP MOST ISZ A,I SIGNIFICANT PART OF COUNTER NOP FILLER FOR POSSIBLE SKIP * UNDER ISZ $LICE,I BUMP TIMESLICE COUNTER JMP TOBAT NO SWITCHING REQUIRED * LDB SKEDD FETCH TOP OF SCHEDULED LIST SZB,RSS IF NO ONE SCHEDULED (IDLE LOOP) JMP IOTOP GO DO DEVICE TIME OUTS * CPB XEQT IS THE XEQT PROGRAM TOP OF THE LIST CLA,RSS YES -- MUST CHECK FURTHER. CLEAR A FOR LOAD,I JMP RLNK XEQT NOT TOP, GO RELINK WITHIN IT'S PRIORITY * LDA B,I FETCH ID ADDR OR ZERO OF NEXT PROG IN LIST SZA,RSS IF NO ONE ELSE OUT THERE JMP RSET RESET SLICE AND CONTINUE * ADA D6 ADVANCE TO PRIORITY WORD OF NEXT GUY LDA A,I AND FETCH IT CPA XPRIO,I IF SAME AS XEQT JMP RLNK GO RELINK XEQT WITHIN IT'S PRIORITY LEVEL * RSET LDA $RVAL FETCH ORIGIONAL SLICE VALUE STA $LICE,I AND RESET THE COUNTER * * IF CURRENT PGM IS BATCH THEN STEP THE TIMER * TOBAT LDB XEQT GET THE BATCH BIT SZB IF NO CURRENT PGM SKIP CPB DD.RT IF CURRENT PGM IS D.RTR DO NO TIME JMP IOTOP BUT GO DO DEVICE TIME OUTS * CPB $IDSM IF SMP JMP IOTOP ADB D20 TO LDA B,I GET THE BATCH FLAG SSA,RSS IF NOT BATCH JMP IOYþúTOP SKIP TEST * ISZ $BATM STEP BATCH TIMER JMP IOTOP IF NO ROLL OVER EXIT * ISZ $BATM+1 ELSE STEP NEXT WORD JMP IOTOP IF NO ROLL OVER SKIP * RAL PUT FATHER BIT IN 15. SSA IF THIS IS A SON JMP ABOR THEN ABORT HIM * RAR RESTORE A IOR B10K SET THE BREAK FLAG STA B,I AND RESET THE WORD JMP IOTOP CONTINUE WITH TIME OUTS * ABOR LDA ATI GET THE TI ABORT MESSAGE LDB BLANK JSB $ERMG GO ABORT HIM * * PROCESS DEVICE TIME-OUT CLOCKS * IOTOP LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA $TIMV ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA D14 OF FIRST EQT ENTRY LDB A,I LOAD WORKING CLOCK- SZB IS IT ACTIVE? ISZ A,I YES: INCREMENT IT INA,RSS IT HAS NOT TIMED-OUT JMP $DEVT GO TO TIME-OUT PROCESSOR ISZ $TIMV THRU? JMP IOTO2 NO: GO DO NEXT ONE JMP $XEQ YES; NO TIME-OUTS-RETURN SPC 1 D20 DEC 20 M7777 OCT 7777 RS1 OCT 25000 RS2 OCT 177574 PRS1 OCT 153000 PRS2 OCT 203 BLANK ASC 1, N1 DEC -1 D6 DEC 6 ******************* DSLIC DEF $LICE+2 NOTE: $LICE IS DEFINED IN DISP4 ***************** SPC 10 * RLNK JSB $RLNK CALL LINK PROCESSOR IN SCHEDULER TO RELINK JMP TOBAT * HED REAL TIME CLOCK SCHEDULE ON TIME ROUTINE * * PROGRAM TO BE SCHEDULED * * THE TMSCH ROUTINE SCHEDULES THE PROGRAM IF DORMANT * THEN COMPUTES ITS NEXT SCHEDULE TIME FROM ITS * RES CODE AND MULT FACTOR IN ITS ID-SEGMENT. * IF THE RES CODE IS ZERO THE PROGRAM IS REMOVED FROM * THE TIME LIST. * * THE CALLING SEQUENCE IS: * SET POINT TO THE ADDRESS OF THE TIME LINK WORD * JSB TMSCH * TMSCH NOP CCB COMPUTE THE STATUS ADDRESS ADB POINT LDA B,I ñ^þú GET THE STATUS AND D15 GET THE LOW BITS SZA IF NOT DORMANT JMP CH026 FORGIT IT ADB DM15 ELSE SET B TO THE ID-SEG ADDRESS JSB $LIST CALL LIST PROCESSOR TO SCHED PROG OCT 401 THE PROGRAM * * CHECK IF NEXT SCHEDULE TIME TO BE COMPUTED * CH026 LDB POINT INB LDA B,I RES CODE/MULT FACTOR AND M7777 SZA,RSS IF ZERO, THEN NO NEW START TIME JMP CH040 GO REMOVE PROG FROM LIST STA TEMP SAVE MULTIPLICATION FACTOR JSB TUDAT GO UPDATE THE SCHEDULE TIME JMP TMSCH,I RETURN * * REMOVE PROGRAM FROM TIME LIST * CH040 LDA B10K CLEAR THE RESOLUTION TOO. STA B,I AND RESET IN THE ID-SEGMENT. LDB POINT VALUE OF TLINK JSB $TREM GO TO REMOVE PROGRAM JMP TMSCH,I GO TO PROCESS NEXT PROGRAM HED REAL TIME CLOCK PROCESSING ID-TIME UPDATE * TUDAT USES THE RES AND MULT FROM THE ID-SEGMENT TO * UPDATE THE EXECUTE TIME OF THE PROGRAM WHOES ID- * SEGMENT RESOLUTION CODE ADDRESS IS IN B. * * CALLING SEQUENCE: * * SET TEMP TO THE MULT FACTOR * SET B TO THE RES CODE ADDRESS * JSB TUDAT * TUDAT DEF SETMS ENTRY POINT LDA B,I GET THE RES CODE TO A INB SET STB TEMP1 TEMPS TO THE TIME INB ADDRESSES STB TEMP2 IN THE ID-SEGMENT RAL,CLE,SLA,RAL IF HOURS JMP HR GO DO SPECIAL HOURS UPDATE RAL,CLE ELSE SET UP AND D7 FOR THE APPROPIATE ADA TTAB BASE LDA A,I AND MULTIPLY BY THE MULT. CH030 MPY TEMP CH031 ADA TEMP1,I ADD THE CURRENT VALUE SEZ IF OVERFLOW INB STEP B ADB TEMP2,I ADD THE HIGH BITS. STA TEMP1,I RESTORE THE NEW TIME STB TEMP2,I TO THE ID-SEG. CLE,SSB IF NEGATIVE RESULT THEN JMP TUDAT,I EXIT * LDA RS1 POé4þúSITIVE RESULT SO ADD NEG. OF LDB RS2 DAY TO MAKE NEGATIVE JMP CH031 * HR LDA TEMP FOR HOURS FIRST CLB INSURE LESS THAN DIV D24 ONE DAY LDA B RESULT IS MODULO 24 MPY D15 NOW SET UP TO MULTIPLY BY 60,000 STA TEMP IN TWO STEPS TO PREVENT OVERFLOW LDA D24K FIRST BY 15, JMP CH030 AND NEXT BY 24,000 * NOP TLIST NOP TOP OF TIME SCHEDULE LIST DAYS OCT 4552 RELEASE DATE. TTAB DEF * TTAB1 DEC 1 TTAB2 DEC 100 TTAB3 DEC 6000 D24K DEC 24000 D2 DEC 2 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D24 DEC 24 DM15 DEC -15 SPC 4 * * SYSTEM START TBG ROUTINE * * THE $SCLK ROUTINE STARTS THE CLOCK PROVIDES * AN ENTRY POINT TO AID THE POWERFAIL ROUTINE. * * ON FIRST ENTRY THIS ROUTINE: * * 1. CONFIGURES IT SELF * 2. STARTS THE TBG. * 3. PRINTS "SET TIME" * 4. EXITS TO THE DISPATCHER. * * ON SUBSEQUENT ENTRIES IT IS A SUBROUTINE TO RESTART * TIME BASE GENERATOR. * $SCLK JMP CONFI GO CONFIGURE ON FIRST ENTRY LDA D2 PROGRAM THE TBG FOR 10'S OF MS. OTATB OTA 0 STCTB OCT 1100 CONFIGURED TO A STC TBG,C STFTB OCT 1600 CONFIGURED TO A STF TBG JMP $SCLK,I RETURN SPC 2 CONFI LDA TBG CONFIGURE THE TBG TEMP IOR OTATB MAKE AN OTA TBG TEMP1 STA OTATB SET IT TEMP2 IOR STCTB FORM AN STC TBG,C TCC STA STCTB SET THE STC XOR STFTB SET UP THE STF STA STFTB TLINC JSB $SCLK START THE TBG POINT LDA TUDAT SEND THE DD.RT STB DD.RT SAVE D.RTR ID-SEG. ADDRESS JSB $YMG SET TIME JMP $XEQ MESSAGE AND GO TO THE DISPATCHER SPC 2 SETMS DEC -10 LENGTH OF SET TIME MESSAGE OCT 6412 PUT CR/LF OUT FIRST ASC 2,SET TIME ATI ASC 1,TI TI USED BY BATCH TIMER HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIærþúMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * RQP3 (OPTIONAL) CONTAINS ADDRESS OF YEAR BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * ARRAY(5) = DAYS * RQP3,I = YEAR (197X) * * E IS SET * A IS THE YEAR * $TIMV ASC 1,ME ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME ADA D365 ADD 1 YEAR TO MAKE CALCS EASIER DIV D1461 1461 DAYS/4 YEARS RAL,RAL A = NUMBER OF YEARS SO FAR STA YEAR SAVE IT LDA B CLB DIV D365 CPA D4 DO WE HAVE A LEAP YEAR? RSS YES JMP NLEAP NO * LDA D3 LDB D365 NLEAP ADA YEAR ADA DM1 TAKE Oê þúFF YEAR ADDED ADA D1970 ADD BASE YEAR CCE,INB ADJUST DAY TO START FROM 1 STB RQP2,I SET DAY STA RQP3,I SET YEAR JMP $TIMV,I RETURN SPC 2 D3 DEC 3 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR DM197 DEC -1970 NEG OF BASE YEAR DM1 DEC -1 D1461 DEC 1461 NUMBER OF DAYS PER 4 YEARS YEAR NOP HED REAL TIME ON REQUEST FOR TIME SCHED PROGRAM * ON REQUEST CONTINUATOR * * IF CURRENT TIME VALUES ARE ZERO OR NOW IS CODED THEN * THE CURRENT TIME IS PUT IN THE ID-SEG. AND R/M USED * TO COMPUTE THE NEXT TIME. * * IF CURRENT TIME VALUES ARE NOT ZERO THE PROGRAM IS * JUST PUT IN THE TIME LIST. * * CALLING SEQUENCE * * A=-1 IF NOW OPTION * A#-1 IF NOT NOW BUT PUT IN TIME LIST * B=ID-SEGMENT TIME ADDRESS. * * JMP $ONTM * $ONTM STB DLDAD SET LOAD ADDRESS STA TCC SET NOW FLAG FOR LATER INA,SZA,RSS IF NOW SKIP LOAD JMP NOW DLD DLDAD,I GET THE CURRENT TIME VALUES DLDAD EQU *-1 SZA,RSS IF TIME NOT ZERO SZB THEN JMP TIMIN THEN GO PUT IN TIME LIST NOW DLD $TIME GET CURRENT TIME DST DLDAD,I AND SET IN THE ID-SEG TIMIN LDB DM2 COMPUTE TIME LIST ADDRESS ADB DLDAD AND STB POINT AND SET FOR LIST ROUTINE JSB $TADD ADD PROG TO TIME LIST. ISZ TCC SKIP IF NOW RSS JSB TMSCH SCHEDULE THE PROG. AND UPDATE MESEX CLA SET A FOR NO ERROR JMP $MSEX HED $TIMR ROUTINE SETS UP ID SEGMENT TIME VALUES * THE $TIMR ROUTINE WHICH ALLOWS USER TO ENTER TIME VALUES * * INTO AN ID SEGMENT FUNCTIONS AS FOLLOWS: * * IF PROG VALUE IS ZERO, THEN CURRENT EXECUTING PROG. * * AND IF NON-ZERO, THEN SEARCH FOR ID SEGMENT * * ADDRESS. * * IF RESOLUTION C€gþúODE IS NON-ZERO, THEN RES/MULT WORD * * STORED. THE NEXT VALUE IS CHECKED FOR + OR -. * * IF PLUS, THEN NEXT START TIME VALUES GIVEN AND * * ARE STORED AND PROGRAM ENTERED INTO TIME LIST. * * IF MINUS, THEN THE COMPLEMENT OF VALUE IS ADDED* * TO THE CURRENT TIME AND ENTERED INTO THE ID * * SEGMENT. IF PROG VALUE IS ZERO, THIS IS TO BE A* * TIME DELAY OF CURRENT PROGRAM AND THUS PROGRAM * * IS SET DORMANT VIA LINK PROCESSOR BUT POINT OF * * SUSPENSION IS NOT CLEARED. IF PROG VALUE IS NON* * ZERO, THEN PROGRAM IS ENTERED INTO TIME LIST. * * THIS IS METHOD FOR SPECIFYING AN INITIAL OFFSET* * TIME. * * * ROUTINE TO SET ID SEGMENT TIME VALUES * CALLING SEQUENCE * JSB EXEC * DEF *+6 OR DEF *+9 * DEF REQUEST CODE ADDRESS RQP1 * DEF PROG RQP2 * DEF RES RQP3 * DEF MULT RQP4 * DEF OFFSET OR DEF HRS RQP5 * DEF MINS RQP6 * DEF SECS RQP7 * DEF TENS OF MSEC RQP8 * WHERE * PROG = 0 IF CURRENTLY EXECUTING * = ADDRESS OF PROGRAM NAME * RES = 1 FOR 10 MILLISECOND RESOLUTION * = 2 FOR SECONDS RESOLUTION LIST * = 3 FOR MINUTES RESOLUTION LIST * = 4 FOR HOURS RESOLUTION LIST * MULT = 0 FOR N0 MULTIPLE VALUE * = N A POSITIVE INTEGER FOR COMPUTING * NEXT SCHEDULE TIME * Oùþú OFFSET= M A NEGATIVE INTEGER FOR COMPUTING INITIAL * OFFSET TIME * HRS= START TIME HOURS * MINS= START TIME MINUTES * SECS= START TIME SECONDS * TENS= START TIME TENS OF MILLISECONDS * * EXEC PRE-PROCESSOR CHECKS FOR RESOLUTION CODE * ERRORS AND FINDS THE ID-SEGMENT ADDRESS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JMP $TIMR SKP $TIMR ADB D16 GET ADDRESS OF TIME LINK STB TCC AND SAVE IT INB STEP TO RESOLUTION ADDRESS STB TEMP1 AND SAVE LDA B,I GET RESOLUTION CODE/T/MULT INB STEP TO TIME LOCATION STB DSTAD SAVE THE ADDRESS * ALF,ERA SAVE BIT 12 SINCE PROGRAM MAY XLA RQP4,I ALREADY BE IN THE TIME LIST ALF,ERA COMBINE MULT AND SAVED T-BIT XLB RQP3,I RESOLUTION TO B LSR 3 SHIFT RESULT TO A STA TEMP1,I SET IT IN THE ID-SEG. XLA RQP5,I NEGATIVE IF OFFSET SSA,RSS POSITIVE IF START TIME JMP TI100 CMA,INA SET POSITIVE AND STA TEMP SAVE IN TEMP XLA RQP2,I CHECK IF CURRENT XEQ PROGRAM SZA JMP TI012 NO * LDB XEQT YES, SET THE SAVE- STB $WORK RESOURCES BIT IN STA XEQT THE PROGRAM'S STATUS ADB D15 WORD. LDA B,I (CLEAR XEQT SO THAT $LIST WILL IOR B200 SET THE NP BIT IF THE USER IS STA B,I MODIFING ITS ON TIME VALUES). JSB $LIST MAKE PROGRAM DORMANT OCT 300 TI012 LDA $TIME GET THE CURRENT TIME LDB $TIME+1 AND SET DST DSTAD,I IT IN THE ID-SEG DSTAD EQU *-1 LDB TEMP1 GET THE RES. CODE ADDRESS TO B JSB TUDAT UPDATE THE TIME * TI015 LDB TCC JSB $TADD ENTER PROG INTO TIME LIST JMP $XEQ DONE - EXIT TO DISPATCHER * * GIVEN öbþúSTART TIME * TI100 XLA RQP5,I BRING PARAMETERS 5 - 8 STA LOCL1 LOCALLY. XLA RQP6,I STA LOCL2 XLA RQP7,I STA LOCL3 XLA RQP8,I STA LOCL4 * LDA DEFLC NOW SET UP LOCALL ADDRESSES STA RQP5 FOR THE $ETTM ROUTINE INA STA RQP6 INA STA RQP7 INA STA RQP8 * LDB DSTAD SET B TO THE TIME ADDRESS AND JSB $ETTM GO TO STORE VALUES IN ID SEGMENT JMP TI015 GO PUT PROG IN TIME LIST * DM2 DEC -2 B200 OCT 200 DEFLC DEF LOCL1 LOCL1 NOP LOCL2 NOP LOCL3 NOP LOCL4 NOP HED REAL TIME CLOCK PROCESSOR SET TIME IN ID-SEG * $ETTM SETS A TIME IN THE REFERENCED ID-SEGMENT. * * CALLING SEQUENCE * * RQP5,I=HOURS * RQP6,I=MINUTES * RQP7,I=SECONDS * RQP8,I=TENS OF MS. * * B=TIME ADDRESS IN THE ID-SEG. * $ETTM NOP ENTRY POINT STB DSTA2 SAVE THE ID-SEG. ADDRESS LDA RQP7,I GET SECONDS MPY TTAB2 CONVERT TO MS (MPY D100) ADA RQP8,I ADD THE MS VALUE AND STA RQP8 AND SAVE LDA RQP5,I GET HOURS MPY D60 CONVERT TO MINUTES ADA RQP6,I ADD MINUTES MPY TTAB3 CONVERT MINUTES TO MS (MPY D6000) CLE PREPARE FOR ADD ADA RQP8 ADD MS VALUE SEZ IF OVERFLOW INB STEP HIGH PART SET01 CLE,SSB IF POSITIVE JMP SET02 ADA RS1 SUBTRACT 24 HRS SEZ,CLE UNTIL INB ADB RS2 IT IS JMP SET01 NEGATIVE SET02 DST DSTA2,I SET THE VALUE IN THE ID-SEG. DSTA2 EQU *-1 JMP $ETTM,I RETURN HED ADDITION OF PROGRAM TO TIME RESOLUTION CODE LIST * THE $TADD ROUTINE FUNCTIONS AS FOLLOWS: * * IF RESOLUTION CODE IS ZERO, THEN EXIT * * IF NON-ZERO RESOLUTION, AND PROGRAM NOT IN TIME LIST* * (BIT 12 OF RES/T/MUL…¾þúT 0), THEN SET BIT 12 OF * * MULT WORD TO SIGNIFY THAT IT IS IN TIME LIST. * * IF TIME LIST IS NULL, THEN SET IT TO POINT TO * * PROGRAM TIME LINK AND SET TLINK TO ZERO. * * IF PROGRAM NOT IN LIST, THEN IT IS ADDED TO * * TOP OF TIME LIST AND ITS TLINK VALUE MADE * * TO POINT TO THE PREVIOUS TOP OF LIST * * PROGRAM. * * * * * ADDING A PROGRAM TO A TIME RESOLUTION CODE LIST * CALLING SEQUENCE * LDB ADDRESS OF ID SEGMENT TLINK VALUE * JSB $TADD * $TADD NOP STB TLINC SAVE TLINK ADDRESS INB INCR TO RES CODE/MULT FACTOR ADD LDA B,I ALF,CLE,ERA AND D7 SZA,RSS JMP $TADD,I EXIT SEZ PROG IN TIME LIST? JMP $TADD,I YES, SO EXIT * LDA B,I IOR B10K SET T BIT STA B,I LDB TLIST LOAD VALUE OF TOP OF LIST LDA TLINC SET LINK OF NEW PROG TO PREVIOUS STB A,I OF TIME LIST STA TLIST SET TOP OF TIME LIST TO NEW PROG TLINK ADDRESS JMP $TADD,I RETURN HED REMOVE A PROGRAM FROM TIME LIST * * * THE $TREM ROUTINE FUNCTIONS AS FOLLOWS: * * IF PROGRAM NOT IN TIME LIST, THEN EXIT * * IF PROGRAM IN TIME LIST, THEN CLEAR BIT 12 OF * * RES/T/MULT TO INDICATE NOT IN TIME LIST. * * A SEARCH IS MADE OF THE TIME LIST PROGRAMS * * UNTIL PROGRAM FOUND OR END OF LIST. THE * * TLINK VALUES ARE CHANGED AS NECESSARY. * * * * * CALLING SEQUENCEqþú * LDB TLINK ADDRESS OF ID SEGMENT * JSB $TREM * $TREM NOP ENTRY/EXIT STB TLINC COMPUTE LIST ADDRESS INB LDA B,I CHECK IF PROGRAM IS IN TIME LIST AND B10K SZA,RSS JMP $TREM,I NO, SO EXIT XOR B,I CLEAR T-BIT STA B,I LDA DTLST GET ADDR OF TOP OF LIST PNTR * TR010 LDB A,I GET CURRENT TOP OF LIST CPB TLINC IS THIS THE PROG? JMP TR030 YES SZB,RSS END OF LIST? JMP $TREM,I YES, RETURN STB A SAVE ADDR OF CURRENT LINKWORD JMP TR010 GO CHECK NEXT PROG * TR030 LDB B,I LINK NEXT PROG STB A,I TO PREV PROG TO REMOVE JMP $TREM,I RETURN SPC 1 DTLST DEF TLIST B10K OCT 10000 HED MESSAGE PROCESSOR TM REQUEST COMPLETION * THIS ROUTINE COMPLETES THE SET TIME REQUEST * * CALLING SEQUENCE: * * LDB DEFP1 SET B TO ADDRESS OF PRAM LIST * JMP $TMRQ * $TMRQ LDA DM6 SET UP PRAM ADDRESSES ON STA TEMP THE BASE PAGE LDA DRQP3 TM1 STB A,I ADB D4 PRAMS SEPERATED BY FOUR WORDS INA ISZ TEMP DONE? JMP TM1 NO * LDA RQP3,I GET YEAR ADA DM197 SUBTRACT THE BASE STA YEAR SAVE RELATIVE ERROR INA ARS,ARS DIVIDE BY 4 STA LDAYS LEAP DAYS LDA YEAR GET YEAR AGAIN MPY D365 MULTIPLY BY DAYS/YEAR ADA LDAYS ADD LEAP DAYS ADA RQP4,I ADD THE DAY CMB SET B TO -1 IF LEGAL RESULT ADA B SUBRTACT ONE FROM DAY INB,SZB IF B WAS NOT ZERO AFTER MULT. THEN JMP $INER INPUT ERROR STA $TIME+2 SET DAY COUNTER * LDB DTIME GET TIME ADDRESS TO B JSB $ETTM SET THE TIME JMP MESEX EXIT TO MESSAGE PROCESSOR SPC 2 DM6 DEC -6 DRQP3 DEF RQP3 D4 DEC 4 DTIME DEF $TIME ïþú LDAYS NOP HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU Óþú.+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ± `^Z ORG * PROGRAM LENGTH END $SCLK f`ÿÿ ÿý#8 ÿ92067-18106 1903 S C0122 &ASCM4              H0101 ‡cASMB,R,L ** RT MESSAGE MODULE ** HED RT MESSAGE MODULE * NAME: $ASC4 * SOURCE: 92067-18106 * RELOC: 92067-16102 * PGMR: G.A.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ASC4,0 92067-16102 REV.1903 780125 * SUP * ENTRY REFERENCE NAMES * ENT $OPER,$ERIN,$NOPG,$ILST,$NOLG,$LGBS,$NMEM * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $NOLG DEF *+1 DM12 DEC -12 ASC 6,NO LGO SPACE * $LGBS DEF *+1 DM10 DEC -10 ASC 5,LGO IN USE * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * $NMEM DEF *+1 DEC -18 ASC 9,CMD IGNORED-NO MEM * END $ERIN dÿÿ ÿý$* ÿ92067-18107 2040 S C0122 &RTIO4 REAL TIME I/O CONTROL             H0101 9ÁþúASMB,L,C,R,Q ** RTE-IV INPUT/OUTPUT CONTROL MODULE ** HED ** RTE-IV INPUT/OUTPUT CONTROL MODULE ** * DATE: 1/07/77 * NAME: RTIO4 * SOURCE: 92067-18107 * RELOC: PART OF 92067-16102 * PGMR: G.A.A.,L.W.A.,D.L.S.,E.J.W.,G.L.M.,A.D.,B.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAM RTIO4,0 92067-16102 REV.2040 800731 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** ***** AMD-DAS ***** AUG,72 ***** REV.GAA ***** ***** AMD-DAS ***** APR,75 ***** REV.LWA ***** ***** DSD ***** FEB,77 ***** REV.EJW ***** * * ENT $CIC0,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$DEVT,$CXC,$CYC,$BFOT,$YMG ENT $GTIO,$UP,$CVEQ,$DMS,$BLLO,$BLUP ENT $BITB,$UNLK,$XXUP,$DLAY,$DMEQ,$CKLO ENT $CON1,$CON2,$CON3,$DRVM,$RSM,$PSTE,$LU?? ENT $DVC,$CJMP,$LIA4 ENT $EQCL * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN,$CIC EXT $LUSW,$SCD3,$RNTB,$CNV3,$ERMG,$CALL EXT $CNV1,$CLAS,$REIO,$ABRT,$INER,$ZZZZ EXT $PDSK,$UCON,$UIN,$PERR,$SMER EXT $ERAB,$IDNO,$SMAP,$MATA EXT $MRMP,$MVBF EXT $DVPT,$DLTH,$DVMP,$SDA EXT $ELTB * * * * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E ¹@þúN T R A L I N T E R R U P T C O N T R O L *** * * THE PROCESSING OF SYSTEM INTERRUPTS IS CONTROLLED * BY DIRECTING ALL SOURCES TO THE ENTRY POINT < $CIC0>. * < $CIC0> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC0. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * M×ÙþúEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM DRIVER) OR IS SCHEDULED IN THE NORMAL * PRIORITY ORDER IF IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC0>. * SKP * <$CIC0> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * 6 - TIME BASE GENERATOR(TBG)INTERRUPT * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE M‡ÌþúANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS OF THE ENTRY IS * ASSUMED TO BE THE FWA OF AN EQT ENTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC0 TRANS- * FERS DIRECTLY TO THE * IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC0>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC0 RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * C. RETURN AT (P+3): CONTINUATION REQUESTING A DMA * CHANNEL. IF ASSIGNED NOW OR * LATER, THEN ENTRY WILL BE MAD þúE * INTO INTIATION SECTION OF DRIVER * FROM SUBROUTINE *DRIVR*. RETURN * FROM THIS INITIATION WILL ACT AS * A CONTINUATION RETURN. THE DRIVER * IS RESPONSIBLE FOR KEEPING A FLAG * INDICATING WHETHER THE NEXT ENTRY * INTO THE INITIATOR FOR THIS CHANNEL * IS A RESULT OF A NORMAL INITIATION * OR A CONTINUATION REQUEST FOR DMA. * THIS FEATURE IS AN UNADVERTISED * ABILITY FOR THE USE OF DVR07 (MULTIPOINT) * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * * - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PRO"þúGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY A JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC0 IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENABLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAN THE INDICATORS. * THIS FACILITY IS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE y;þúINTERRUPT * OCCURRED AND THAT MEMORY * PROTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE INTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - SKP $CIC0 EQU * OCT 103300 INTERRUPT SYSTEM ALREADY OFF? ISZ $INT YES, FLAG IT FOR $PERR4 * TURN IT OFF IN ANY CASE !! * * PRESERVE CURRENT STATUS OF MACHINE * SSM $DMS SAVE DMS STATUS AT INTERRUPT FOR P.E. STA TEMPA SAVE A-REG IN CASE OF PARITY ERROR LIA 4 GET INTERRUPT SOURCE STA INTCD AND SAVE IT CPA .5 IS IT MP, DMS, OR PE? JMP PE? MAYBE. * IOR CLF NO, CONSTRUCT CLF XX INSTRUCTION STA *+1 * $DVC NOP CLEAR DEVICE FLAG * CIC1 STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I LDA TEMPA STA XA,I CIC2 ISZ MPTFL SET 'MPTFL' = 1 TO MEAN MP IS OFF. * SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * * PROVIDE FOR SPECIAL (PRIVILEGED) INTERRUPTS * * CLC 6 CLEAR DMA CHANNELS CLC 7 CONTROL FF. * STF 0 RE-ENABLE INTERRUPTS * * CIC.0 EQU * LDA XI SAVE INDEX REGISTERS CXB XSB A,I STORE X THROUGH USER MAP INA CYB XSB A,I STORE Y THROUGH USER MAP LDA INTCD RESTORE THE INT CODE LDB $CIC SAVE P-REGISTER SOON AS POSSIBLE STB XSUSP,I POINT OF SUSPENSION. * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPA .5 IF MEMORY PROTECT VIOLAÅ6þúTION, JMP $RQST GO TO EXAMINE MP VIOLATION. * CPA TBG IF TIME BASE GENERATOR, $CJMP JMP $CLCK GO TO TBG PROCESSOR ROUTINE. * * CHECK LEGALITY OF INTERRUPT * ADA N6 CODE - 6. STA B (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM DRIVER IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B ADDRESS, SET IN B TO <$LIST>. * ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 CLF CLF 0 N6 DEC -6 TEMPA NOP $DMS NOP DMS STATUS AT INTERRUPT $INT NOP ($DMS+1)INTERRUPT SYSTEM: 0 ON, 1 OFF * * PE? LIA 5 GET VIOLATION REGISTER SSA,RSS IS IT PARITY ERROR? JMP CIC1 NO, SAVE REGISTERS FOR REAL * LDA TEMPA RESTORE A-REG JMP $PERR CALL PARITY ERROR ROUTINE * * $CXC LIA 4 *** SPECIAL ENTRY TO SKIP CLF *** $CYC STA INTCD SAVE INTERRUPT SOURCE CODE SSM $DMS SAVE DMS STATUS JMP CIC2 SKP * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE E½ÃþúNTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. * CIC.6 JSB $DRVM GO SET RIGHT MAP * LDA INTCD (A) = INTERRUPT SOURCE CODE * LDB EQT14,I SET DEVICE SZB TIME-OUT CLOCK DLS 780217 STB EQT15,I IF USER SPECIFIED A TIMEOUT. * * CALL I/O PROCESSOR, COMPLETION SECTION * LDB EQT3,I CALL DRIVER CONTINUATION SECTION ELB,CLE,ERB (GET RID OF FLAG BIT USED ELSEWHERE.) SEZ IN THE JMP $UCON USER MAP, * JSB B,I OR SYSTEM MAP, AS THE CASE MAY BE. JMP $CON1 (P+1): *COMPLETION RETURN* JMP $CON2 (P+2): *CONTINUATION RETURN* $CON3 CPA .6 (P+3): *NEED/GIVE-UP DMA RETURN* JMP $CON4 IF (A) .NE. 6 (SHOULD BE 5), IT'S A LDA EQT3,I NEED-DMA RETURN. SO FIRST SET THE IOR B100K DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. JSB $RSM RESTORE USER MAP. ISZ CONFL FAKE *DRIVR* CALL, FLAG=1 IN CASE WE GET LDA DIOCR TO *REXIT* VIA SUBROUTINE *DRIVR* STA DRIVR DUMMY UP RETURN ADDR IN *DRIVR* JMP DVR0 JUMP INTO MIDDLE OF *DRIVR* IOCRT JMP IOCO1 (P+1) TO ALLOC DMA CHAN, REENTER INITIATOR JMP NOTRD (P+2) * $CON4 JSB CLDMA IT WAS A GIVE-UP-DMA RETURN, SO DO IT. LDA EQT5,I CHANGE EQT STATE AND MSK14 FROM "WAITING_FOR_DMA" (BIN. 11) STA EQT5,I TO "BUSY" (BIN. 10). LDA EQT3,I THEN CLEAR THE DRIVER-EXITED-FROM- ELA,CLE,ERA CONTINUATION-SECTION- STA EQT3,I TO-GET-DMA FLAG. JSB $RSM RESTORE USER MAP IF NECESSARY. JMP IOCX ALLOCATE DMA FREED-UP, & EXIT TO DISP. * $CON2 JSB $RSM RESTORE USER MAP. IOCO1 CLA LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP 2lþú$TYPE ACKNOWLEDGE. * LDA $LIST IF $LIST ENTERED SZA,RSS SKIP TO ENTER $XEQ JMP $IRT RETURN TO POINT OF INTERRUPT * JMP $XEQ GO DISPATCH POSSIBLE NEW PROGRAM * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CNV1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7 STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $YMG MESSAGE GOES TO LU 1 ONLY -780221 GLM- * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT LDA XSUSP,I GET THE EXECUTE ADDRESS * STA RTN SAVE THE RETURN ADDRESS LDB XI RESTORE INDEX REGISTERS XLA B,I INB XLB B,I CAX CBY LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN CLA CLEAR 'MPTFL' TO MEAN CLF 0 TURN OFF THE INTERRUPT SYSTEM STA MPTFL MEMORY PROTECT IS ON. * SW2 JMP IRT2 RETURN IF NOT PRIV. (ELSE CLC) * STF1 STF 12B BUFFER ON DUMMY I/O CARD * DLD INTBA,I CHECK CONDITION OF DMA CHANNELS SSA IF BIT = 1 FOR DMA #1 (ACTIVE) STC 6 THEN SET CONTROL TO ENABLE SSB “[þú INTERRUPTS. SAME FOR STC 7 DMA CHANNEL #2. * IRT2 LDA XA,I RESTORE THE A AND B REGS LDB XB,I STF 0 TURN ON THE INTERRUPT SYSTEM STC 5 AND MEMORY PROTECT UJP * ENABLE USER MAP AND RETURN RTN EQU *-1 SPC 4 CICM1 DEF *+1 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 DEC -15 ASC 8,SC03 INT XXXXX * INTCD NOP HOLDS INTERRUPT SOURCE CODE $LIA4 EQU INTCD D$LUT DEF $LUSW+0 DIRECT ADDRESS OF BATCH LU TABLE DIOCR DEF IOCRT * $BLLO DEC -100 $BLUP DEC -300 B100K OCT 100000 MSK14 OCT 137777 AN "AND MSK14" WILL MASK OUT BIT 14. HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > *** I N P U T / O U T P U T C O N T R O L *** * * THE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC0> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETION*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC0> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * <þú* 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDLE POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDLE TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BEFORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: LAST SUBCHANNEL REFERENCED ON THIS EQT. * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT STATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL DEVICE ADDRESSING OF PHYSICAL I-O * SLOTS DEFINED IN THE *EQT*. THE *DRT* CONSISTS * OF TWO SEQUENTIAL TABLES EACH TABLE CONSISTING * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * EACH LOGICAL UNIT'S WORD ONE IS AS FOLLOWS: * BITS 5-0 DEVICE'S EQT NUMBER * BITS 6-10 THE LOCKING RESOURCE NUMBER * BITS 11-15 THE DEVICE'S SUBCHANNEL ON THE EQT. * THE CONTENTS OF EACH LOGICAL UNIT'S DEVICE * REFERENCE TABLE WORD TWO CONTAINS A * POINTER TO THE I/O QUEUE OF THE I/O REQUESTS * FOR THIS DEVICE WHEN T5üþúHE DEVICE IS DOWN: * BIT 15=0 FOR AN UP LU. * =1 FOR A DOWN LU. * BITS 14-0=0 FOR AN UP LU. * #0 FOR A DOWN LU WHERE * = ADDRESS OF THE I/O QUEUE IF THIS * IS THE FIRST LU(MAJOR LU)POINTING * TO THE DEVICE. * = 1 TO 1777(8). THE LU NUMBER OF * DEVICE(MAJOR LU)ON WHICH THE I/O * IS QUEUED. * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 0 - BIT BUCKET(DUMMY LU)(NO ENTRY IN DRT) * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' INPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - SKP * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THK þúE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINED BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * EXEC I/O REQUEST "NO SUSPEND" BIT * * THE "NO SUSPEND" BIT (BIT 14) IN EXEC I/O REQUESTS (CODES = * 1,2,3,17,18,19,20) PROVIDES NO SUSPEND I/O PROCESSING. IF AN * I/O EXEC REQUEST CAN'T BE PROCESSED IMMEDIATELY BECAUSE OF A * DOWNED DEVICE OR A LOCKED EQT OR LU, THE CALLING PROGRAM IS * SUSPENDED. BY SETTING THE NO SUSPEND BIT, THE CALLING PROGRAM * IS NOT SUSPENDED UNDER THESE CONDITIONS. INSTEAD THE PROGRAM * RESUMES EXECUTION AT THE FIRST LINE OF CODE FOLLOWING THE EXEC * CALL WITH AN "IO" ERROR CODE RETURNED IN THE A,B REGISTERS. IF * THERE ARE NO EXCEPTIONS IN THE I/O REQUEST, THE PROGRAM'S SECOND * LINE OF CODE FOLLOWING THE EXEC CALL IS EXECUTED. * * IF AN EXEC I/O REQUEST IS MADE TO A DEVICE WHOSE EQT OR LU IS * LOCKED TO ANOTHER LOCKER AND THE NO SUSPEND BIT IS SET, THE * PROGRAM IS CONTINUED AT THE FIRST LINE OF CODE FOLLOWING THE EXEC * CALL WITH THE A,B REGISTER SET TO IO13. IF THE NO SUSPEND BIT * IS NOT SET IN THE ABOVE CASE, THE PROGRAM IS SUSPENDED ON THE EQT * OR LU LOCK. IO13 INDICATES THAT THE I/O REQUEST CANNOT CURRENTLY * BE SATISFIED DUE TO A LOCKED LU OR EQT. * * IF AN EXEC I/O REQUEST IS MADE TO A DEVICE WHICH IS DOWN AND * THE NO SUSPEND BIT IS SET, THE PROGRAM IS CONTINUED AT THE FIRST * LINE OF CODE FOLLOWING THE EXEC CALL WITH THE A,B REGISTERS SET * TO IO14. IF THE NO SUSPEND BIT IS NOT SET IN THE ABOVE CASE, * THE PROGRAM IS SUSPENDED ON THE DOWNED DEVICE. IO14 INDICATES * THAT THE I/O REQUEST CANNOT CURRENTLY BE SATISFIED DUE TO A * DOWNED DEVICE. * * IF A DEVICE GOES DOWN (EITHER BY AÁþúN OPERATOR DN REQUEST OR * AN EQUIPMENT MALFUNCTION) WHILE REQUESTS ARE PENDING ON THE EQT, * THE REQUESTS LINKED ON THE EQT FOR THE DOWNED DEVICE ARE * UNLINKED FROM THE EQT AND HANDLED IN THE FOLLOWING WAY: * UNBUFFERED REQUESTS MADE WITH THE NO SUSPEND BIT SET ARE UNLINKED * AND THE CALLING PROGRAM IS RESCHEDULED AT THE FIRST LINE OF CODE * FOLLOWING THE EXEC CALL WITH THE A,B REGISTERS SET TO IO14; * UNBUFFERED REQUESTS MADE WITH THE NO SUSPEND BIT CLEAR ARE * UNLINKED AND SUSPENDED IN STATE 3; BUFFERED REQUESTS REGARDLESS * OF THE NO SUSPEND BIT ARE UNLINKED AND RELINKED ON THE MAJOR * LU'S DRT WORD 2 QUEUE. * * IF AN EXEC I/O REQUEST (CODES = 1,2,3) IS BUFFERED AND NO MEMORY * IS AVAILABLE NOW AND THE NO SUSPEND BIT IS SET, THE REQUEST * CONTINUES TO BE PROCESSED UNBUFFERED. ON COMPLETION OF THE I/O * REQUEST, THE PROGRAM IS RESCHEDULED AT THE SECOND LINE OF CODE * FOLLOWING THE EXEC REQUEST. IF THE NO SUSPEND BIT IS NOT SET * IN THE ABOVE CASE, THE PROGRAM IS SUSPENDED IN THE MEMORY * SUSPEND LIST. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * DEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * ¯}þú* EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE * * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP * C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * DEF STAT3 (DEFINE STATUS WORD 3 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP WORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * STAT3 NOP IF PRESENT, THEN BIT 15 INDICATES * THE LU IS UP(0) OR DOWN(1) AND BITS * 0-4 GIVE THE LU'S SUBCHANNEL. * * * IV. GENERAL OPERATION µþú * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER * OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND * NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * * A. READ/WRITE AND WRITE-READ REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINE READ (17) WRITE (18) WRITE-READ (20) * DEF CONWD (SAME AS STANDARD READ/WRITE) * DEF IBUFR (SAME AS STANDARD (NOT USED ON READ) * DEF BUFFL (SAME AS STANDARD) * DEF OPT1 (SAME AS STANDARD (TRACK)) * DEF OPT2 (SAME AS STANDARD (SECTOR)) * DEF CLASS (CLASS TO QUEUE REQUEST ON m þú) * EXIT --- * . * . * RCODE DEC 17 OR 18 OR 20 (SEE NOTE BELOW) * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * OPT1 DEC N (SEE GET CALL BELOW) * OPT2 DEC N (SEE GET CALL BELOW) * CLASS DEC N DEFINES CLASS TO BE USED IN GET CALL. * IBUFR BSS N DATA BUFFER * * * NOTES: * THE WRITE-READ CALL IS FOR DEVICES WHICH EXPECT DATA IN * THE READ BUFFER. THIS CAUSES THE SYSTEM TO MOVE THE BUFFER * TO SYSTEM MEMORY AND ALSO TO SAVE AND PASS TO THE USER * THE BUFFER ON THE GET CALL. THE REQUEST CODES RECEIVED * BY THE DRIVER ARE: * 1 FOR REQUEST 17 OR 20 * 2 FOR REQUEST 18 * 3 FOR REQUEST 19 * * THE CLASS WORD HAS THE FOLLOWING FORMAT * BITS 0-7 DEFINE THE CLASS. IF ZERO OR NOT SUPPLIED * THE SYSTEM WILL ASSIGN A CLASS FOR THE REQUEST. * BITS 8-12 CONTAIN THE SECURITY CODE ASSIGNED BY THE * SYSTEM UPON CLASS ALLOCATION. * BITS 13-14 ARE NOT USED BY READ/WRITE OR WRITE-READ * BUT WILL BE RETURNED TO CALLER IF A CLASS * IS ALLOCATED. * BIT 15 SHOULD BE SET TO INDICATE THAT THE PROGRAM IS TO * BE CONTINUED WITHOUT MAKING THE REQUEST IF THERE * IS NOT ENOUGH SYSTEM MEMORY AT THE CURRENT TIME. * * ON RETURN TO THE PROGRAM THE A REGISTER WILL BE SET AS * FOLLOWS (IF BIT 15 WAS SET): * * A = -1 DYNAMIC CLASS ASSIGNMENT FAILED (NO FREE CLASS NOW) * -2 NO MEMORY AVAILABLE FOR BUFFERING. * = >0 THE NEWLY ALLOCATED CLASS NUMBER AND SECURITY CODE. * * B. CLASS CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINES REQUEST CODE) * DEF CONWD (DEFINES CONTROL WORD) * DEF PRAMD (DEFINES PRAMETER WORD) * ZÛþúDEF CLASS (CLASS TO QUEUE REQUEST ON) * EXIT --- * . * . * RCODE DEC 19 CLASS CONTROL REQUEST CODE * CONWD OCT NNNN CONTROL INFO/LOGICAL UNIT # * PRAM DEC N PRAMETER AS REQUIRED BY TYPE OF CODE * CLASS DEC N DEFINES CLASS TO USED IN GET CALL. * * THE CLASS CONTROL IS THE SAME AS THE STANDARD CONTROL EXCEPT * COMPLETION INFORMATION IS QUEUED ON THE DESIGNATED CLASS QUEUE. * * C. CLASS GET REQUEST FORMAT. * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE RETURN ADDRESS) * DEF RCODE (DEFINE REQUEST CODE ADDRESS) * DEF CLASS (DEFINE CLASS ADDRESS) * DEF IBUFR (DEFINE BUFFER ADDRESS) * DEF IBUFL (DEFINE BUFFER LENGTH) * DEF IRP1 ((RETURN PRAMETER 1 (OPTIONAL)) * DEF IRP2 ((RETURN PRAMETER 2 (OPTIONAL)) * DEF RCLAS (RETURN CLASS WORD ADDRESS)(OPTIONAL) * EXIT --- * . * . * RCODE DEC 21 REQUEST CODE FOR GET REQUEST * CLASS OCT NNN CLASS THE GET IS TO GET FROM. * IBUFR BSS N BUFFER TO HOLD THE READ DATA * IBUFL DEC N OR -N WORD OR CHARACTER LENGTH OF BUFFER * IRP1 BSS 1 OPTIONAL PRAMETER ONE RETURNED HERE * IRP2 BSS 1 OPTIONAL PRAMETER TWO RETURNED HERE * RCLAS BSS 1 CLASS RETURN WORD. * * NOTES: * THE CLASS WORD HAS THE FOLLOWING OPTIONS: * BITS 0 - 7 CLASS TO BE USED * BITS 8 -12 CLASS SECURITY CODE * BIT 13 DO NOT DEALLOCATE THE CLASS. IF THIS BIT * IS NOT SET AND THE CLASS IS EMPTY (NO * COMPLETED OR PENDING REQUESTS) IT IS * DEALLOCATED. * BIT 14 RETURN THE INFORMATION BUT DO NOT DEQUEUE * THE REQUEST (MUST MAKE ANOTHER REQUEST TO * DEQUEUE THE REQUEST). * BIT 15 IF NO ENTRIES IN QUEUE RETURN TO PROGRAM * (NORMAL ACTION IS TO SUSPEND UNTIL A * REQUEST IbþúS PUT ON THE QUEUE). * * THE RETURNED CLASS WORD (RCLAS) IS AS FOLLOWS: * BITS 0 - 7 SET TO THE REQUEST CODE SENT TO THE DRIVER I.E. * 17 IS SET TO 1 * 18 IS SET TO 2 * 19 IS SET TO 3 * 20 IS SET TO 1 * * THE PARAMETERS IRP1/IRP2 ARE SET TO THE ORIGINAL REQUEST * PARAMETERS OPT1/OPT2. THEY ARE PROTECTED FROM DRIVER * MODIFICATION AND SO SHOULD BE AS SUPPLIED, EXCEPT IF * BIT 12 IN THE CONWORD IS SET "IRP1" POINTS TO * THE BUFFER AREA THE SYSTEM USED (I.E. IT IS NONSENSE). * * THE A REGISTER ON RETURN IS SET AS FOLLOWS: * A = -N N IS THE NUMBER OF REQUESTS PENDING ON THE CLASS * IN ONE'S COMPLEMENT [-(N+1)] = [-N-1] * (NO REQUEST HAS COMPLETED YET) * A = 10XXXX (WHERE 1 IS BIT 15, 0 IS BIT 14, * AND XXXX IS THE REST OF EQT5 WHEN THE * REQUEST EITHER WAS REJECTED BY THE DRIVER * OR WAS IMMEDIATELY COMPLETED BY THE DRIVER. * ON REJECT B = -1,ON IMMEDIATE COMPLETION * B = TLOG. * A = > 0 A IS THE STATUS (EQT5) OF THE DEVICE AT * COMPLETION OF THE REQUEST. (IF BIT 14 IS SET * THE REQUEST CAUSED THE DEVICE TO GO DOWN). * B = TLOG IN THIS CASE. * * ON COMPLETION OF AN 18 REQUEST THE DATA BUFFER IS RETURNED * TO SYSTEM MEMORY. * THE GET REQUEST WILL ALWAYS GET A BUFFER WHICH IS THE * MINIMUM OF THE ALLOTTED SIZE ON THE GET AND THE BUFFER * IN THE QUEUE. THE CONTROL BUFFER (BIT 12 OPTION) IS AT THE * END OF THE ALLOTED BUFFER AND MAY BE RETURNED ON A GET IF * THE BUFFER SUPPLIED WILL HOLD IT AND THE REQUEST WAS NOT A * CLASS WRITE (18) REQUEST. SKP * CLASS I/O QUEUE FORMAT AND ITS USE * * THE CLASS QUEUE CAN BE IN FOUR DIFFERENT STATES. * 15 14 13 12 à;þú11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0! * ------------------------------------------------------ * STATE 1: CLASS DEALLOCATED, AVAILABLE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------- * ! 0 ! A D D R E S S O F F I R S T E N T R Y ! * ------------------------------------------------------- * STATE 2: POINTER TO FIRST ENTRY IN CLASS QUEUE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 0 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 3: CLASS ALLOCATED, NO ONE WAITING ON CLASS * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 1 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 4: CLASS ALLOCATED, SOMEONE WAITING (SUSPENDED) * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * ACTIONS TO BE TAKEN WHEN HANDLING A CLASS I/O OR GET REQUEST * DEPEND ON THE CURRENT STATE OF THE CLASS QUEUE HEAD * GET REQUESTS: * STATE 1. ABORT THE PROGRAM IO00, NO CLASS. * STATE 2. RETURN THE DATA FROM CLASS BUFFER * STATE 3. SET THE SOMEONE WAITING BIT(BIT14), SUSPEND PROGRAM * STATE 4. ABORT THE PROGRAM IO00, ONLY ONE PROGRAM MAY BE * SUSPENDED PER CLASS. * CLASS I/O REQUESTS: * STATE 1. STATE 3 IS SET UP, SECURITY CODE IS LOW 5 BITS OF * PROGRAM ID NUMBER, COUNTER IS SET TO 1. * STATE 2. THE COUNTER AT END OF QUEUE IS INCREMENTED BY 1 * STATE 3. THE COUNTER IS INCREMENTED BY 1. * STATE 4. THE COUNTER IS INCREMENTED BY 1.ããþú * ON COMPLETION OF CLASS I/O REQUESTS: * STATE 1. ILLEGAL--SHOULD NEVER HAPPEN--BUFFER IS RETURNED * AND THE COMPLETION IS IGNORED. * STATE 2. THE NEW DATA IS ADDED AT THE END OF THE LIST (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 3. THE NEW DATA IS ADDED AT THE END OF THE LIST (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 4. THE WAITING PROGRAM IS SCHEDULED AND THE COUNTER * IS DECREMENTED BY 1 AND THE SOMEONE WAITING BIT(BIT14) * IS CLEARED. SKP .254 DEC 254 $IORQ EQU * CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMPL AND 'DISC R/W USER REQ' FLAG STA CLASS CLEAR THE CLASS WORD STA TEMP5 CLEAR LU FLAG FOR LU 0 * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * * * LDA DRQ2I GET ADDR OF EXEC'S PRAMS STA TEMP1 LDA DPARM GET ADDR OF DIRECT PARMS STA TEMP2 LDB N8 GET 8 PARMS DIRECT GTPAR CLA CLEAR (A) IN CASE XLA TEMP1,I NO PARM WAS PASSED STA TEMP2,I ISZ TEMP1 ISZ TEMP2 INB,SZB DONE YET? JMP GTPAR NO * * CHECK FOR XLUEX (EXTENDED LU EXEC) REQUEST * * IF YES, FETCH THE SECOND WORD OF THE CON WORD * AND SAVE IT AS PARM2 (FUNCTION CODE). NOTE THAT * THE LU IS SAVED IN "REQLU". * * NOTE ALSO THAT IF BIT 15, OF THE FIRST WORD OF THE CON * WORD (XLUEX ONLY), IS SET, NO SWITCHING OF THE LU TAKES PLACE. * * * * LDA PARM2 PRE-FETCH THE LU PARAMETER LDB $CALL FETCH ENTRY FLAG FROM EXEC CLE,SSB,RSS <0 = XLUEX ENTRY, >0 = EXEC ENTRY JMP OLD EXEC ENTRY,LU IS SIX BITS WIDE * LDB RQP2 XLUEX ENTRY SO RQP2 IS A 2 WD PARM INB ADVANCE TO 2ND WD (FUNCT CODE) SSB CHECK FOR MEMORY WRAP JMP RQ þúERR YEP--BAD PARAMETER. * XLB B,I FETCH FUNCTION CODE (2ND WORD OF RQP2) STB PARM2 AND SAVE IT FOR FUTURE USE * LDB A MOVE NO SWITCH OPTION TO (B) RSS XLUEX LU IS 8 BITS WIDE-- SKIP EXEC WORK * * * LOGICAL UNIT REFERENCE VALIDITY CHECK * ***780221 GLM*** * * ** NOTE: IF SIGN OF (B) IS SET, NO LU SWITCHING IS PERFORMED. * OLD AND B77 ISOLATE LU TO 6 BITS FOR EXEC ADA N1 TRANSLATE BY -1(XLUEX CONTINUES HERE) AND B377 ISOLATE LU-1(NOTE LU 0=B377) STA REQLU SAVE LU-1 FOR LATER USE CPA B377 IF LU IS ZERO JMP L.00X DO IMMEDIATE COMPLETION THING * SSB IF NO SWITCH OPTION SET JMP L.0 CONTINUE WITH SPECIFIED LU. * * * CHECK FOR LU SWITCH REQUIRMENT * -BATCH FLAG=BIT 15 ID WORD 21 * -SESSION WORD=ID WORD 33 * LDB XSUSP FETCH POINTER INTO ID SEG ADB .12 ADVANCE TO BATCH FLAG LDA B,I FETCH IT ADB .12 ADVANCE TO SESSION WORD LDB B,I FETCH IT * SZB IF SESSION WORD =0 SSB OR IS < 0 THEN JMP NSESS PROG IS NOT IN SESSION * * THE PROGRAM IS A SESSION PROGRAM. * -BATCH SESSIONS USE THE SESSION SWITCH TABLE ONLY * -THE REQUESTED LOGICAL UNIT MUST BE DEFINED FOR * THIS SESSION'S USE (MUST BE IN IT'S SST) * * JSB MPTAB GO MAP IN TABLE PTN( IF DEFINED). RETURNS LOGICAL * ADDR IN (B). LDA B,I FETCH LENGTH OF SWITCH TABLE JSB SWTCK GO SEE IF THIS LU IS SWITCHED JMP ERR12 P+1 LU NOT DEFINED FOR SESSION USE JMP L.0.1 P+2 SWITCH FOUND, (A) AND TEMP1 ARE * SET TO THE SWITCHED LU BY SWTCK * * * THE PROGRAM IS NOT IN SESSION * CHECK FOR BATCH SWITCH REQUIRMENT * -(A)=ID WORD 21 (BATCH FLAG = BIT 15) * NSESS SSA,RSS IS THIS A BATC9þúH REQUEST? JMP L.0 NOPE-- USE PASSED LU * LDA $LUSW FETCH LENGTH OF BST CMA,INA SET IT NEGATIVE LDB D$LUT FETCH ADDR OF BST JSB SWTCK GO SEE IF LU SWITCHED L.0 LDA REQLU P+1 NO SWITCH,USE SUPPLIED LU L.0.1 LDB A P+2 SWITCH FOUND [IN (A) & REQLU] CPB B377 IF 0 SPECIFIED JMP L.00X DO IMMEDIATE COMPLETION THING ** CPB .254 IF MAX LU, THEN SPOOL FILE HAS BEEN KILLED JMP ERR26 RETURN IO26 ERROR * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. ADB DRT INDEX INTO THE DRT. LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 CCE,SZA,RSS IF ZERO JMP L.00X THEN DO IMMEADIATE COMPLETION THING * JSB $CVEQ CONVERT TO ABS.EQT ADD(WILL MASK SUBCH.). * LDA EQT4,I AND B77 GET I/O SELECT CODE SZA,RSS IF SELECT CODE = 0 JMP ERR03 GIVE IO03 ERROR * * SKP * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDA REQLU GET LU-1 AND DETERMINE JSB STADV IF THE LU OR EQT ARE DOWN. JMP L.014 IF DOWN, SUSPEND THE PROGRAM. * LDA RQPX UP, SO CONTINUE. LDB XPRIO,I SET THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.01 SKIP FURTHER ANALYSIS. * LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. LDA RQP1 GET THE RQ CODE * * BUFFER LEGALITY CHECK. VERIFY THAT BUFFER RESIDES WITHžHþúIN THE * USER'S ADDRESS SPACE. * BFCK LDB PARM4 GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE BFCK1 STB TMP8 AND SAVE. CPA B21 IF CLASS READ JMP L.01 SKIP BUFFER CHECK SPC 1 ADB N1 CALCULATE ADDR OF LAST WORD CLO IN BUFFER ADB RQP3 AND IN CASE IT'S PAST 32K SOC ADDRESS SPACE, JMP ERR04 GIVE ERROR MESSAGE * STB LWABF SAVE THE LAST WORD BUFFER ADDR. LDA RQP3 GET THE 1ST WORD ADDRESS. LDB XEQT AND ID SEG ADDRESS JSB COMN IS THE 1ST WORD OF BUFFER IN COMMON ? JMP CHKWR NO, SO JUST GO DO THE WRITE PROTECT CHECK. * LDA LWABF YES, IF 1ST WORD IN COMMON, THEN THE LAST LDB XEQT WORD BETTER BE IN COMMON ALSO. JSB COMN IS IT ?? JMP ERR04 NO !!! WHEW ! THAT WAS A CLOSE ONE ! JMP ALCOM YES, THE WHOLE BUFFER IS IN COMMON. * CHKWR LDB LWABF BUFFER NOT IN COMM, NOW INSURE CLA THAT THE LAST WORD IS IN MAPPED MEM. RRL 6 SO SHIFT PAGE # TO (A), ADA B40 ADD IN OFFSET FOR USER MAP *1940DLS* CCB CBX SET X=-1 FOR READ 1 REG TO MEMORY LDB DCURU READ IT INTO 'CURUS' XMM LDA CURUS RAL TEST BIT 14 SSA WRITE PROTECTED? JMP ERR04 YES, ERROR * ALCOM LDA RQPX NO ERROR CLE,SZA,RSS IF GET REQUEST JMP G.01 GO FINISH GET OPERATION * * CHECK FOR EQT LOCK * L.01 LDA $ELTB,I GET EQT. LOCK TABLE HEADER. SSA,RSS IF NOT_EMPTY BIT IS CLEAR, JMP L.019 SKIP EQT. LOCK CHECK. * RAL,ARS GET RID OF NOT_EMPTY BIT. STA TEMP3 STORE TABLE LENGTH. CMA,INA COMPUTE 2'S COMPLE OF LENGTH STA LTEMP AND SAVE IT. ‘žþú LDB $ELTB GET TABLE ADDR. ADB .1 GET 1ST ENTRY ADDR. LDA TEMP5 GET DRT ENTRY 1ST WORD. AND B77 ISOLATE THE EQT. #. SZA,RSS IF IT'S THE DUMMY EQT. (VIZ., #0), JMP L.019 SKIP EQT. LOCK CHECK. * L.016 CPA B,I COMPARE WITH $ELTB ENTRY 1ST WORD. JMP L.017 JIF THIS EQT. IS LOCKED. * INB NEXT ENTRY IN $ELTB. ISZ LTEMP IF MORE ENTRIES EXIST IN $ELTB, JMP L.016 GO LOOP. * JMP L.019 SKIP LOCKED_TO_HIM CHECK IF UNLOCKED. * LTEMP NOP 2'S COMPLE OF #-OF-COMPARES YET UNDONE * L.017 LDA B GET ADDR OF $ELTB ENTRY WHICH MATCHED. ADA TEMP3 GET ADDR OF ENTRY'S 2ND WORD. LDA A,I GET THE WORD. ELA,CLE,ERA GET RID OF UPPERMOST BIT. CPA XEQT IF IT MATCHES CALLER'S ID SEG ADDR, JMP L.018 GO CHANGE PRIOR. FOR FIFO PURPOSES. * JMP L.001 ELSE SUSPEND HIM ON $ELTB ENTRY. * L.018 LDB C100K SET 77777 STB TEMP2 FOR LINK PRIORITY CLB,INB AND 1 STB TEMP6 FOR BUFFERING PRIORITY. JMP L.01A SKIP LU LOCK CHECK SINCE EQT LOCK IS BOSS SKP * * CHECK FOR LU LOCK * L.019 LDA TEMP5 GET DRT ENTRY WORD 1 RRR 6 GET LOCK BITS TO LOW A. AND B37 ISOLATE LOCK BITS. SZA,RSS IF NO LOCK ON THIS LU, JMP L.01A SKIP LOCKED_TO_HIM? CHECK. * STA TEMP3 SAVE RN FOR PASS TEST. LDB C100K SET 77777 STB TEMP2 AS LINK PRIORITY CLB,INB AND 1 STB TEMP6 AS BUFFERING PRIORITY ADA D$RN INDEX INTO STA XTEMP,I RN TABLE LDA A,I GET ENTRY AND B377 ISOLATE OWNER'S OFFSET STA TEMPW (STASH IT AWAY) ADA KEYWD PICK UP ID SEG ADDR OF ADA N1 OWNER FROM KEYWD LDA A,I TABLE ENTRY. CPA XEQT IS THIS THE LOCK OWNER'S REQUEST ? 0Fþú JMP L.01A YES, SO CONTINUE. * LDA PARM9 NO, SO SEE IF HE'S GOT XOR TEMP3 THE KEY (I.E., RN #) ALF,ALF IN PARAMETER LIST. XOR TEMPW MILLION DOLLAR QUESTION SZA DOES SUPPLIED RN MATCH OWNER'S RN ? JMP L.002 NO, SO SUSPEND CALLER * L.01A LDA RQPX GET LOW BITS OF REQUEST CODE SAVED BEFORE CPA .3 IS THE REQUEST OF THE CONTROL ILK? JMP L.020 -YES, SO SKIP SOME FURTHER ANALYSIS. * LDB RQCNT GET REQUEST COUNT ADB N5 AND SET 'E' FOR FIVE PRAM TEST LDA EQT5,I CHECK REFERENCED DEVICE AND B36K FOR BEING A CPA B14K DISC FILE (DVR30,31,32,33) RSS JMP L.02 NO, UNIT IS NOT DISC. STA TEMPL SET 'DISC R/W USER REQ' FLAG SKP * * DISC ACCESS VALIDITY CHECK. * LDA RQP1 CLASS REQUESTS ALF,ALF TO THE DISC ALF,SLA ARE NOT JMP ERR02 ALLOWED. * SSB DISC REQUEST MUST HAVE 5 PRAMS. JMP ERR01 -ERROR-. * LDB REQLU GET (LU-1) CPB .1 IF LU # 2 OR 3, RSS SET INTO LOW CPB .2 BITS OF 'DISC INB,RSS R/W USER REQ' JMP DPOPT,I FLAG. IF USER DISC JUMP ON PROTECT OP. * L.10 IF NOT PROTECTED ELSE L.012 ADB TEMPL STB TEMPL * LDA PARM5 GET TRACK ADDRESS FROM AND B377 STA TEMP0 REQUEST - SAVE. LDA TATLG COMPUTE POSITIVE ADA TATSD LENGTH OF CMA,INA AUXILIARY DISC IN *TAT*. SLB,RSS IF REF TO SYSTEM DISC (LU #2), LDA TATSD USE SYS DISC SIZE. CMA,INA SUBTRACT MAX SIZE ADA TEMP0 FROM USER TRACK #. SSA,RSS JMP ERR05 -ERROR, ILLEGAL TRACK #. * LDA SECT2 (A)= # SECTORS/TRACK FOR LU #2 SLB IF LU FOR REQUEST = 3, LDA SECT3 SET (A) = #ÔÕþú SECTORS FOR LU #3 CMA,CLE,INA SET VALUE NEG. LDB PARM6 GET SECTOR ADDRESS ADB A ERROR CCB,SEZ IF STARTING SECTOR LESS THAN 0 JMP ERR05 OR GREATER THAN TRACK SIZE. * ADB TMP8 CHECK FOR TRACK OVERFLOW BRS,BRS DIVIDE BUFFER LENGTH BRS,BRS (IN WORDS) BRS,CLE,BRS BY 64(10) ADB PARM6 ADD STARTING SECTOR # STB TMP8 SAVE FOR L.G. UPDATE ADB A ERROR IF LAST SECTOR CLA,SEZ,INA GT= JMP ERR08 LIMIT (EXCEEDS TRACK BOUNDARY) * CPA RQP1 INPUT IS ALLOWED TO REFERENCE ANY JMP L.10 TRACK. * LDA TEMP0 (A) = TRACK #. LDB REQLU (LU-1) TO (B). SLB,RSS IF REF TO LU #3 ADD ADA TATSD SYS DISC SIZE TO TRACK #. ADA TAT INDEX TO TRACK ASSIGNMENT TABLE. LDA A,I GET REFERENCED TRACK ASSIGNMENT. CPA XEQT (ID SEGMENT ADDRESS). IF SAME AS JMP L.10 REQUESTOR, ALLOW ACCESS. * CPA C100K ALLOW ACCESS IF TRACK IS JMP L.10 GLOBALLY ASSIGNED. * INA IF FMP TRACK THEN CPA C100K GO CHECK JMP L.012 FOR LEGAL CALL. * * CHECK FOR LOAD-AND-GO ACCESS * ERB,ERB CONSTRUCT LDB TEMP0 L.G. WORD BLF,BLF FOR CURRENT RQ. ERB SET SIGN IF LU 3. ADB PARM6 SET SECTOR IN LOW BITS CPB LGOC IF NOT = TO CURRENT LGO CLA,RSS ADDRESS, THEN JMP L.011 GO TO CHECK FOR "LOADR". * * UPDATE FOR NEXT LGO ACCESS - THIS ACCESS ALLOWED * ISZ TMP8 SAVE THE NEXT SECTOR ADDRESS IN TMP8 CPA LGOTK IS LGO AREA IS ASSIGNED. JMP L.011 -NO, CHECK LOADR. * LDA SECT2 SET (A) TO APPROPRIATE RBL,SLB,ERB # SECTORS (SET E IF LU 3) LDA SECT3 PER TRACK FOR LU #. CPA TMP8 IF NEW SECTOR EXCEEDS TRACK, CLA,RSS GO TO UjþúPDATE TRACK #. JMP L.010 -NO OVERFLOW. * STA TMP8 SET SECTOR # TO 0. ISZ TEMP0 ADD 1 TO TRACK #. LDA LGOTK GET LGO TRACK ASSIGNMENT WORD. AND B177 -ADD # STA B OF TRACKS XOR LGOTK ASSIGNED CLE,ELA LU BIT TO E. ALF,ALF TO STARTING ADA B CHECK CPA TEMP0 FOR OVERFLOW. JMP ERR09 ---YES, '09' ERROR AND ABORT. * L.010 LDA TEMP0 RECONSTRUCT TRACK ALF,ALF THE CURRENT ERA LGO AREA IOR TMP8 DISC STA LGOC RESET. JMP L.10 SPC 1 * * I\O REQUEST ON A DOWN LU OR EQT * * ISSUE IONR MESSAGE TO USER TERM AND THE SUSPEND PROG * * L.014 LDA XEQT GET POINTER TO THE ID SEGMENT JSB NSBIT IS THE "NO SUSPEND" BIT SET ? JMP ERR14 YES, DON'T SUSPEND. PASS BACK IO14 ERROR. * DON'T PRINT IO MESSAGE, THE PROGRAM HANDLES IT * LDA REQLU SAVE REQUEST LU CCE,INA (ADJUST FOR INTERNAL STRUCTURE--LU-1) STA XTEMP+1,I BEFORE TEMP (REQLU) IS MODIFIED * LDA EQT1 FETCH ADDRESS OF EQT1 STA HEAD SET UP FOR LUERR CALL LDA A,I SAVE ADDRESS OF CURRENT REQUEST STA STMP3 FOR POSSIBLE ERROR ECHO WORK. LDA TEMP5 FETCH DRT WD2 OF DOWN DEVICE AND C3700 REMOVE LOCK INFO STA TEMP8 SET UP FOR LUERR CALL AND B77 ISOLATE EQT# STA XTEMP+2,I *1940* SAVE IT IN ID TEMP WD 3 JSB $CNV1 AND CONVERT IT TO ASCII (DECIMAL) STA IOMSG+6 AND SET INTO MESSAGE LDA TEMP8 FETCH EQT SC WORD ALF,RAL ISOLATE SUBCHANNEL AND B37 CONVERT IT JSB $CNV1 TO ASCII THEN STA IOMSG+8 SET IT INTO THE ERROR MESSAGE LDA ASNR FETCH ASCII "NR" STA IOMSG+1 AND SET IT INTO ERROR MESSAGE * DLD ASTER DEVICE STATUS COULD BEÒmþú INVALID DST IOMSG+9 SO REPLACE IT WITH "***" * CCA PRINT ONLY ON SESION(MTM) TERMINALS JSB LUERR GO ISSUE THE ERROR LDB .4 4 TO B L.013 STB XTEMP,I SET 4 IN FIRST WORD OF TEMP AREA. L.015 JSB $LIST PUT PGM IN WAIT LIST OCT 503 UNTIL DEVICE COMES UP. JMP $XEQ EXIT TO DISPATCHER * L.001 STB XTEMP,I IF WE SUSPEND, DO IT ON EQT LOCK TABLE L.002 LDA XEQT GET POINTER TO ID SEGMENT JSB NSBIT IS THE "NO SUSPEND" BIT SET ? JMP ERR13 YES, DON'T SUSPEND. PASS BACK IO13 ERROR JMP L.015 NO, GO SUSPEND PROGRAM * ICOMX NOP DUMMY EQT FOR LU=0 B36K OCT 36000 .12 DEC 12 B14K OCT 14000 EQT4 OF DUMMY(BITS 0-5 = 0). .13 DEC 13 TEMP1 NOP EQT6 OF DUMMY N3 DEC -3 N5 DEC -5 C100K OCT 77777 $DMEQ DEF ICOMX ADDRESS OF DUMMY EQT DPOPT DEF L.10 DISC PROTECT OPTION (L.012 IF PROTECTED) B40 OCT 40 DRQ2I DEF RQP2,I DPARM DEF PARM2 ADDRESS OF ACTUAL PARAMETERS PARM2 NOP ACTUAL USER PARAMETER #2 PARM3 NOP ACTUAL USER PARAMETER #3 PARM4 NOP ACTUAL USER PARAMETER #4 PARM5 NOP ACTUAL USER PARAMETER #5 PARM6 NOP ACTUAL USER PARAMETER #6 PARM7 NOP ACTUAL USER PARAMETER #7 PARM8 NOP ACTUAL USER PARAMETER #8 PARM9 NOP ACTUAL USER PARAMETER #9 ASTER ASC 2, *** REQLU NOP SPC 2 L.00X LDA $DMEQ SET UP DUMMY EQT FOR LU=0 JSB $ETEQ ON BASE PAGE JMP L.000 CONTINUE PROCESSING SPC 2 SKP * * * SWTCK (SWITCH TABLE CHECK) * * SCAN THE SPECIFIED TABLE (LOW BYTE OF SESSION OR BATCH SWITCH TABLE) * FOR A MATCH WITH THE VALUE IN TEMP1. * * CALLING SEQUENCE:LDA -LENGTH * LDB ADDRESS OF TABLE(POINTS AT LENGTH) * REQLU = ISOLATED SEARCH LU (LU-1) * JSB SWTCK * RETURN P+1 NO SWITCH FOUND * P+2 SWITCH FOUND,(A) AND REZ*þúQLU = SWITCHED LU * * * SWTCK NOP STA STMP1 SAVE NEG LENGTH SWT.0 INB ADVANCE TABLE ADDRESS LDA B,I FETCH ENTRY AND B377 IF SAME CPA REQLU AS CURRENT LU JMP SWT.1 GO SWITCH IT * ISZ STMP1 STEP COUNT JMP SWT.0 AND LOOP JMP SWTCK,I UNTIL DONE--NO MATCH FOUND,RTN P+1 * SWT.1 LDA B,I FETCH SWITCH TABLE WORD ALF,ALF USE HIGH HALF OF TABLE AND B377 ISOLATE "NEW" LU STA REQLU SET THE NEW LU (LU-1) ISZ SWTCK MATCH FOUND, RTN P+2 JMP SWTCK,I CONTINUE AT P+2, (A) ALSO = NEW LU * * STMP1 BSS 2 NEED 2 WORDS FOR $PSTE SPC 5 RQERR DLD ASRQ FETCH ASCII "RQ " JSB $ERMG GO ISSUE ERROR AND ABORT JMP $XEQ CONTINUE * ASRQ ASC 2,RQ SKP * ALLOW PRIVILEGED ACCESS TO "LOADR" TO PERMIT * UPDATING OF ID SEGMENTS AND PROGRAMS ON THE * SYSTEM AREA OF THE DISC. * L.011 LDB XEQT COMPARE ADB .12 NAME LDA B,I 3 CPA LDRNM WORD INB,RSS AREA JMP ERR06 IN * LDA B,I CURRENT CPA LDRNM+1 ID INB,RSS SEGMENT JMP ERR06 WITH * LDA B,I 'LOADR' AND C377 -IF CPA LDRNM+2 SO, JMP L.10 ALLOW FULL ACCESS * JMP ERR06 - ERROR - * LDRNM ASC 2,LOAD L O A D OCT 51000 R -ZERO- SPC 1 B177 OCT 177 B74K OCT 74000 B160K OCT 160000 KEEP BITS 13-15 LWABF NOP SPC 2 L.012 LDA PARM2 FMP TRACK LDB RQP1 AND B74K IF FLAG SET SLB,RSS OR IF READ CPA B74K THEN ALLOW JMP L.10 ACCESS. * JMP ERR06 ELSE ILLEGAL DISC WRITE. SKP L.02 CLA,SEZ,RSS IF BIT 12 OF CONWORD LDA PARM2 SET AND ALF,SLA NOT FIVE PRAMS JMP ERR01 TAKE GAS! * L.020 LDB RQPX GET THE MASK6ÁþúED REQUEST CPB RQP1 IF STANDARD I/O JMP L.027 SKIP THE CLASS CODE SKP * * * CLASS I/O ALLOCATE CLASS FROM HIGH END OF TABLE * IF HE DID NOT SPECIFY A CLASS. * CLA,CLE E=0 IF USE OLD CLASS NUMBER STA XA,I A=0 FOR INIT.GOOD RETURN LDA RQP7 ADDR FROM THE REQUEST CPB .3 IF CONTROL REQUEST (19) LDA RQP4 USE THE CONTROL CLASS WORD SZA,RSS IF CLASS WORD ADDR = 0 JMP ERR01 FLUSH IT OUT. * STA TEMP3 SAVE ADDR OF CLASS WORD XLA TEMP3,I USER'S CLASS WORD AND B160K GET BITS 15,14, AND 13 STA SECCD L.025 XLA TEMP3,I GET CLASS WORD STA CLASS SET THE CLASS WORD AND B377 MASK TO THE CLASS DEF. STA B SAVE CLASS NUMBER IN B CMA,INA,SZA IF SUPPLIED JMP L.021 SKIP ALLOCATION CODE * * * ALLOCATE A CLASS FROM THE HIGH END OF THE TABLE * LDB XEQT GET ID SEG ADDR JSB $IDNO CONVERT TO ID # LDA B37 FOR USE AS SECURITY CODE AND B ALF,ALF IOR SECCD FILL IN USER'S BIT15,14,13 XSA TEMP3,I FOR RETURN AS CLASS NUMBER * LDA $CLAS GET THE LENGTH OF THE TABLE ADA DCLAS ADD THE TABLE ADDRESS * L.022 LDB A,I GET THE ENTRY TO B CCE,SZB,RSS IF FREE (0) JMP L.023 GO USE IT * ADA N1 NO STEP TO NEXT ONE CPA DCLAS END OF TABLE? CCA,RSS YES SKIP (A = -1) JMP L.022 NO - GO TEST NEXT ONE. * L.026 STA XA,I SET REASON FOR REJECT IN A REG. LDB DCLAS SET B=CLASS TABLE ADDR LDA CLASS FOR L.013 IN CASE OF SUSPEND SSA NO-WAIT REQUESTED? JMP L.16 NO, GIVE NO CLASS STATUS * JMP L.013 YES, SUSPEND UNTIL CLASS AVAILABLE * L.023 STA PTR SAVE CLASS QUEUE WORD ADDR XLB TEMP3,I GET SECURITY CODE AND USER BIT ÈÍþú ADA MCLAS SUBTRACT THE CLASS TABLE ADDRESS IOR B ADD SECURITY CODE AND USER BIT XSA TEMP3,I RETURN NEW CLASS WORD TO USER AND B174C GET SECURITY CODE FOR CLASS QUEUE-HEAD RAL,ERA SET THE ALLOCATED BIT STA PTR,I PUT INTO CLASS QUEUE CCE SET E=1 AGAIN FOR NEW ALLOC JMP L.025 GO SET UP * L.021 ADB DCLAS USE CLASS# (IN B) TO INDEX AND STB PTR SET POINTER TO TABLE STA B LDA CLASS GET CLASS WORD AND B174C SAVE REAL SECURITY CODE STA SECCD LDA PTR,I GET CONTENTS SEZ,CLE,RSS IF NOT NEW ALLOCATION SZA AND NOT ALLOCATED, FORCE ERROR ADB $CLAS IF OUTSIDE OF TABLE CLB,SEZ,RSS THEN JMP ERR00 SEND ERROR 'IO00' * LDA PTR L.13A STA B SET B TO ADDR OF QUEUE ENTRY LDA B,I GET CONTENTS SSA,RSS A POINTER? JMP L.13A YES, TRACE IT MORE * AND B174C GET SECURITY CODE FROM QUEUE CPA SECCD COMPARE IT WITH USER'S RSS DOES IT MATCH? JMP ERR00 NO, ERROR 'IO00' * STB SECCD SAVE QUEUE ENTRY ADDR IN SECCD LDB RQPX GET THE MASKED REQUEST CODE JMP L.028 AND GO DO THE BUFFER THING SKP * * CHECK FOR AUTOMATIC BUFFERING REQUIREMENT * L.027 CPB .1 SKIP CHECK IF REQUEST JMP L.10 IS INPUT. * LDA EQT4,I CHECK THE UNIT DESCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA,RSS FOR BUFFERING. JMP L.10 -NO * LDA PARM2 DYNAMIC STATUS AND B3700 REQUESTS ADA B ARE NEVER CPA B603 BUFFERED JMP L.10 DYNAMIC STATUS DO STD. USER RQ. * * * AUTOMATIC BUFFERING SECTION * L.028 CLA STA TMP6 CPB RQP1 IF NOT CLASS, USE 5 WORDS FOR CONTROL LDA N2 USE 5 WORDS FOR CONTROL REQUEST CPB .3 Ih þúF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA TMP8 GET THE XFER LENGTH STA TEMP3 -SET AS MOVE INDEX- LDB PARM2 IF DOUBLE BUFFER REQUEST BLF,SLB THEN RSS JMP L.03 * LDB PARM6 GET SECOND BUFFER SIZE SSB,RSS NEGATIVE CHARACTER COUNT? JMP L.029 NO, USE WORD COUNT * BRS YES, CONVERT TO WORDS CMB,INB L.029 LDA B GET SECOND BUFFER SIZE ADA TMP8 ADD TO FIRST BUFFER STB TMP6 SAVE SECOND BUFFER SIZE L.03 ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. LDB RQPX GET MASKED REQ. CODE CPB RQP1 IF NOT CLASS REQUEST ADA N1 THEN SUBTRACT 1 STA L.04 AND SET UP IN CALL * SSA IF BUFFER SIZE IS NEGATIVE (TOOOOOO BIG) JMP ERR04 REJECT THE REQUEST WITH IO04. * LDA N41 IF PRIORITY ADA XPRIO,I LT 41 THEN SSA DO NOT DO BUFFER LIMIT JMP L.031 TEST * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB QCHK ON THIS DEVICE JMP L.040 YES GO CHECK FOR CLASS RQ * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP L.041 NEVER ANY MEMORY, TRY NO BUFFER. JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * L.040 LDA CLASS IF CLASS AND NO SUSP. SSA,RSS ON BUFFER LIMIT SKIP TO EXIT JMP L.013 ELSE GO SUSPEND * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 LDA N2 IF CLASS I/O CHECK LDB CLASS FOR NO SUSP OPTION SSB IF SET JMP L.026 GO SET FLAG AND EXIT * SZB IS THIS A CLASS REQU›êþúEST ? JMP L.043 YES, GO MEMORY SUSPEND. LDA XEQT POINT AT THE ID SEGMENT. JSB NSBIT IS "NO SUSPEND" BIT SET ? JMP L.10 YES, PROCESS THE REQUEST UNBUFFERED. * L.043 JSB $LIST NO, CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMP $XEQ * L.041 LDA CLASS NEVER ENOUGH MEMORY SZA IF CLASS REQUEST JMP ERR04 ABORT PROGRAM IO04 * JMP L.10 ELSE GO UNBUFFERED. * SECCD NOP B603 OCT 603 N41 DEC -41 SKP * * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. STA TEMP1 SAVE BLOCK CLE,INA STA TEMPW SAVE ADDRESS JSB WORD2 ASSEMBLE CONTROL WORD LDB RQP1 IF A CLASS CPB RQPX REQUEST CLE THEN RAL,ERA SET THE FIELD TO 3 IOR B40K SET = 1 FOR BUFFERING. LDB TEMPW STA B,I AND SET IN WORD 2 OF BLOCK. INB LDA TEMP6 SET REQUESTING PROGRAM PRIORITY STA B,I IN WORD 3. INB LDA L.04 SET BLOCK LENGTH IN STA B,I WORD 4. INB LDA TEMPW,I GET THE CONWORD SSA,RSS IF STANDARD REQUEST JMP L.061 SKIP * LDA CLASS ELSE SET THE CLASS STA B,I WORD IN INB THE BUFFER L.061 LDA .3 IF REQUEST CPA RQP1 IS STANDARD CONTROL, SKIP JMP L.08 BUFFER MOVE * LDA PARM4 SET USER BUFFER LENGTH STA B,I IN WORD 5. CMA,CLE,INA SET E IF ZERO LENGTH BUFFER (SAVE A CYCLE IF SO) LDA PARM5 GET FIRST OPTIONAL WORD INB STEP TO STORE LOCATION STB TEMPW SAVE THE ADDRESS OF THE LOCATION STA B,I SET IT INB SET FOR NEXT WORD LDA PARM6 GET SECOND OPTIONAL WORD STA B,I SET IT IN THE ñ‘þúBUFFER LDA RQP1 IF CLASS READ OR CPA B23 IF CLASS CONTROL, JMP L.078 GO FINISH ITS SET UP * CPA B21 IF CLASS READ ADB TMP8 ADJUST BUFFER ADDRESS FOR DOUBLE BUF. SEZ,CLE,INB,RSS IF LENGTH = 0, CPA B21 OR CLASS READ JMP L.075 SKIP BUFFER MOVE. * * MOVE USER BUFFER TO TEMPORARY BLOCK. * LDA RQP3 SET USER BUFFER L.065 EQU * ADDRESS FOR MOVE. LDX TEMP3 GET # WORDS TO MOVE MWF MOVE INTO SYSTEM MAP FROM USER MAP * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA PARM2 GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * STB TEMPW,I SET BUFFER ADDRESS IN REQUEST LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.078 ADB N2 CORRECT (B) FOR CLASS CONTROL L.08 LDA PARM3 FOR CONTROL REQUEST, SET WORD 3 STA B,I (PARAM) IN PLACE OF RECORD JMP L.13 LENGTH. SPC 2 B21 OCT 21 B23 OCT 23 D$RN DEF $RNTB+0 DIRECT ADDRESS OF RN TABLE SKP SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * * L.10 CLE CLEAR (E) FOR WORD2 CALL LATER LDB PARM3 GET CONTROL WORD LDA RQP1 (A) = REQUEST CODE. CPA .3 IF CONTROL GO JMP L.101 SET IT UP * LDB XTEMP+4 GET THE ADDRESS OF THE RENT ADB .15 BIT IN THE ID-SEG. LDA B,I GET THE WORD TO A ALF,RAL PUT THE BIT IN SIGN OF A LDB RQ¼•þúP3 BUFFER ADDRESS TO B CLE,SSA IF BIT SET JSB $REIO GO MOVE THE TDB (IF NEEDED) * CLA,SEZ DID WE CALL $REIO? CPA $MVBF -YES, BUT DID $REIO MOVE THE BUFFER? CLE,RSS -NO. $REIO NOT CALLED OR BUFFER NOT MOVED. ADB MSIGN E-REG IS SET. $REIO CALLED & BUFFER MOVED. STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA PARM4 BUFFER STA XTEMP+2,I LENGTH AND LDA PARM2 GET THE CON WORD CMA,CME SET COMPLEMENT IOR TEMPL MIRGE WITH DISC FLAG LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS IF NONE USE JMP L.102 ZERO XLB B,I GET THE OPTION WORD L.102 SEZ,SLA,RSS IF RENT AND DOUBLE BUFFER JSB $REIO GO CHECK OUT THE BUFFER ADDRESS STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * LDA PARM6 SET THE FINAL OPTIONAL WORD STA XTEMP+4,I IN THE ID-SEGMENT * CLE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD JSB WORD2 ASSEMBLE CONTROL WORD (E)=0 ALREADY STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 LDA RQP1 IF STANDARD I/O CPA RQPX THEN JMP L.131 GO UP DATE AND EXIT * * CLASS I/O SO SET THE CLASS QUEUE TO SHOW * ANOTHER REQUEST IS PENDING. * LDA SECCD,I INA INCREMENT CLASS QUEUE COUNT BY 1 STA SECCD,I JMP L.132 SKIP XSUSP SET UP * * L.131 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. üàþú JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB $DMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB PARM4 GET THE REQUEST LENGTH L.136 SSB AND SET UP CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION JMP R00 AND GO TO COMPLETION SECTION * SKP * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY XSB RQP3,I IN 'STAT1'. LDA EQT4,I STORE WORD 4 OF EQT ENTRY XSA RQP4,I IN 'STAT2'. * LDB REQLU GET SUBCHANNEL ADB DRT FROM DRT LDA B,I WORD 1. AND B174K ALF,RAL PUT SUBCHANNEL IN ADB LUMAX LOWER 5 BITS. LDB B,I GET UP/DOWN BIT FROM CLE,ELB DRT WORD 2 AND OR RAL,ERA WITH SUBCHANNEL. XSA RQP5,I STORE IN 'STAT3'. L.16 LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP CLASS NOP DCLAS DEF $CLAS+0 DIRECT ADDR OF CLASS TABLE MCLAS NOP CONFIGURED TO BE NEGATIVE OF ABOVE. B174C OCT 17400 BITS 8-12 B37 OCT 37 N2 DEC -2 .22 DEC 22 SKP * $GTIO IS THE ENTRY POINT THE EXEC CALLS FOR A 'GET' EXEC * CALL. * $GTIO XLA RQP2,I GET REAL PARAM STA PARM2 XLA RQP4,I FOR BFCK STA PARM4 LDA PARM2 GET THE CLASS AND B377 MASK STA B SAVE AND CMA,CLE,INA,SZA,RSS IF CLASS=0 CLE,RSS ûþúSEND "IO00" * ADA $CLAS IF GREATER THAN MAX THEN CLA,SEZ,RSS SEND JMP ERR00 'IO00' ERROR * STA RQPX CLEAR REQ CODE ADB DCLAS SET THE STB CLASS CLASS TABLE ADDRESS JMP BFCK GO CHECK THE BUFFER ADDRESS. * * BFCK RETURNS TO G.01 * G.01 LDA PARM2 GET SECURITY CODE AND B174C BITS FROM CLASS WORD STA SECCD LDB CLASS,I GET QUEUE HEAD SSB IF A COUNTER JMP G.06 GO SUSPEND THE PROGRAM * SZB,RSS IF QUEUE-HEAD = 0 JMP ERR00 ERROR "IO00" * STB PTR SAVE THE ADDRESS INB GET THE CON WORD LDA B,I AND AND .3 ISOLATE THE REQUEST CODE XSA RQP7,I RETURN IT TO USER'S IRCLS INB STEP TO STATUS WORD LDA B,I GET COMPLETION STATUS. STA XA,I AND SET IT IN THE A REG. INB GET THE BUFFER LENGTH LDA B,I AND SET IT STA CLTMP FOR RETURN INB STEP TO USER CLASS WORD LDA B,I GET IT AND B174C KEEP SECURITY CODE CPA SECCD MATCHES CALLER'S? RSS JMP ERR00 NO, ERROR IO00 * INB INDEX TO THE LDA B,I TLOG AND STA XB,I SET IT IN THE 'B' REG INB INDEX TO THE LDA B,I FIRST OPTIONAL WORD AND XSA RQP5,I SET IT IN THE USERS BUFFER INB NOW DO THE SECOND OPTIONAL WORD LDA B,I XSA RQP6,I * STB TEMP4 SAVE THE BUFFER ADDRESS LDA .8 GET THE BUFFER LENGTH CMA,INA SET NEGATIVE ADA CLTMP LOP OFF THE HEAD WORDS STA TEMP3 SET THE MOVE COUNT LDB TMP8 GET THE SUPPLIED LENGTH CMA,INA SET MOVE COUNT NEG ADA TMP8 SUBTRACT FROM USER BUFFER SIZE SSA,RSS IF QUEUE COUNT IS SMALLER, LDB TEMP3 USE QUEUE SIZE, MAY BE 1 BIGGER!5Jþú! SSB IF COUNT LESS THAN ZERO THEN JMP G.05 THEN SKIP MOVE * LDA TEMP4 GET THE BUFFER ADDRESS. INA STEP TO THE PROPER WORD CBX GET MOVE COUNT LDB RQP3 GET DESTINATION MWI MOVE FROM SYSTEM TO USER G.05 LDA PARM2 IF SAVE RAL,RAL QUEUE OPTION SLA,ELA THEN JMP L.16 EXIT * LDA PTR,I ELSE STA CLASS,I UPDATE THE LIST SSA IF POINTER, SKIP COUNT CHECK AND B37 GET # PENDING REQUESTS LEFT SEZ,SZA,RSS NO REQUESTS LEFT STA CLASS,I AND IF DEALLOCATE WANTED, DO IT. JSB $RTN RETURN THE MEMORY PTR NOP AND CLTMP NOP THEN JMP G.08 SCHEDULE WAITERS AND EXIT * G.06 LDA B174C GET SECURITY CODE AND B FROM QUEUE CPA SECCD MATCH? RSS JMP ERR00 NO, ERROR IO00 * RBL,CLE,ELB MOVE BIT14 (SOMEONE WAITING) TO E G.065 LDA CLASS,I GET CLASS WORD AND B377 CMA,SEZ ANYONE WAITING? (SET ONES COMP) JMP SCEDT YES,SORRY SOMEBODY BEAT YOU TO IT * STA XA,I SET A FOR POSSIBLE RETURN INA GET CORRECT 2'S COMPLEMENT STA B LDA PARM2 GET THE OPTION FLAG ELA,RAL SET E=BIT15 NO-WAIT OPT. SZB,RSS IF QUEUE-HEAD = 0 SSA AND BIT14 SET, JMP G.07 DON'T DEQUEUE * STB CLASS,I IF Q-H=0 AND BIT14=0 DEQUEUE! G.08 LDA DCLAS NOW SCHEDULE ALL THOSE WAITING JSB $SCD3 FOR AN AVAILABLE CLASS NUMBER. JMP L.16 RETURN * G.07 SEZ,CCE JMP L.16 BIT15=1 FOR NO-WAIT. RETURN. * LDB CLASS GET CLASS ADDR IN B FOR L.013 LDA B,I SET "SOMEONE IS WAITING" FLAG RAL,RAL ERA,RAR STA B,I AND JMP L.013 PUT IT BACK INTO WAIT LIST SPC 1 C377 OCT 177400 COMPÝþúLEMENT OF 377 SKP * * * * THE COMN ROUTINE IS USED TO DETERMINE IF THE BUFFER * SPECIFIED IS IN COMMON. TO BE IN COMMON THE BUFFER * MUST BE BELOW THE LOAD POINT OF THE PROGRAM SPECIFIED. * AND ALSO BE BELOW $SDA, THE START OF THE SYSTEM DRIVER * AREA. IT IS NOT ENOUGH TO JUST SEE IF THE BUFFER IS BELOW * THE LOAD POINT AS THE BUFFER COULD BE IN THE MEMORY RESIDENT * LIBRARY. WE ALSO DON'T HAVE TO CHECK IF THE ADDRESS IS BELOW * $CMST AS EXEC DOES THIS FOR ALL I/O REQUESTS IN THE * MEMORY PROTECT CHECK PROCESSOR. * * * * CALLING SEQUENCE: LDA BUFFER ADDRESS * LDB ID SEG ADDRESS * JSB COMN * - HERE IF BUFFER NOT IN COMMON * - HERE IF BUFFER IS IN COMMON * * * COMN NOP CMA MAKE BUF ADDR NEG +1 & STA BUFAD SAVE FOR NEXT CHECK. * ADB .22 INDEX TO LOAD POINT ADA B,I OF PROGRAM. SSA BUFFER BELOW LOAD POINT ? JMP COMN,I NO, SO IT CAN'T BE IN COMMON. * LDA $SDA GET PAGE # OF SDA & CONVERT ALF,ALF TO RAL,RAL AN ADDRESS ADA BUFAD NOW IS THE BUFER ALSO SSA,RSS BELOW THE SYSTEM DRIVER AREA ? ISZ COMN YES, BUFFER MUST BE IN COMMON. JMP COMN,I NO, SO RETURN. * * BUFAD NOP **************************************************************** * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILT AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 * ******************************************************** * * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR]þú BUFFERED RQ. = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * ***************************************************************** WORD2 NOP LDB RQPX IF CLASS WRITE-READ CPB .4 THEN CHANGE CLB,CLE,INB CHANGE TO READ REQUEST LDA PARM2 COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD LDB TEMPL IF NOT DISC CCE,SZB,RSS REQUEST, JMP WORD2,I EXIT - * AND C114C OTHERWISE, SWP SET BITS (9,8) AND .3 TO INDICATE ALF,ALF SYSTEM, AUXILIARY, IOR B OR PERIPHERAL TYPE JMP WORD2,I EXIT - * B137C OCT 13700 B3700 OCT 3700 C114C OCT 166377 * * SCEDT ERB,RBR CLEAR THE BIT AND STB CLASS,I RESET THE CLASS HEAD LDB $LIST SAVE STATUS OF STB STADV $LIST ENTRY POINT. LDA CLASS GET HEAD ADDRESS TO A AND JSB $SCD3 RESCHEDULE THE WAITER IF ANY CLE E=0 FOR G.065. IF $LIST ENTRY POINT LDA $LIST IS UNCHANGED, THEN THERE WAS CPA STADV NO WAITER. JMP G.065 NO, SO MUST HAVE BEEN ABORTED. CONVðþúTINUE. JMP ERR10 YES. ERROR, SO GO ABORT. * * **************************************************************** * * SUBROUTINE STADV: * * STADV WILL RETURN AT THE UP EXIT IF LU=0. IT NEXT * CHECKS TO DETERMINE IF THE CURRENT EQT IS DOWN(BIT * 14 EQT WORD 5)OR IF THE LU IS DOWN(BIT 15 DRT WORD 2). IF * DOWN, RETURN IS MADE AT P+1. IF UP, RETURN IS MADE AT P+2. * * CALLING SEQUENCE: * :=ADDRESS OF STATUS WORD FOR THIS EQT. * :=LU#-1. * JSB STADV * * RETURN: * (P+1) EQT OR LU DOWN. * (P+2) EQT AND LU UP. * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * STADV NOP CPA B377 IF LU=0(IE, 377B), THEN JMP STAD9 GOTO UP EXIT. * ADA DRT GET DRT WORD ADA LUMAX 2 AND CHECK LDA A,I IF THE LU IS SSA UP OR DOWN. JMP STADV,I LU IS DOWN. * LDB EQT5,I LU IS UP, SO RBL,SLB CHECK IF THE JMP STAD9 EQT IS UP OR SSB DOWN. JMP STADV,I EQT IS DOWN. * STAD9 ISZ STADV LU AND EQT JMP STADV,I ARE UP. SKP * SUBROUTINE NSBIT * * "NO SUSPEND" BIT CHECK SUBROUTINE * * THIS SUBROUTINE EXAMS THE "NO SUSPEND" BIT (BIT 14) OF * WORD 15 OF THE ID SEGMENT POINTED TO BY THE AREG ON * ENTRY. RETURN AT P+1 IF BIT SET. RETURN AT P+2 IF BIT * IS NOT SET. * * CALLING SEQUENCE: * * LDA ID SEGMENT ADDRESS * JSB NSBIT * (P+1) "NO SUSPEND" BIT SET * (P+2) "NO SUSPEND" BIT NOT SET * * AREG IS DESTROYED. * NSBIT NOP ADA .15 POINT AT WORD 15 OF ID SEGMENT. LDA A,I PICK UP THE ACTUAL WORD AND RAL ROTATE BIT 14 TO MSB. SSA,RSS IS "NO SUSPEND" BIT (BIT 14) SET ? ISZ NSBIT NO, RETURN AT P+2. JMP NSBIT,I YES,RETURN AT ®äþúP+1. SKP * THE QUEUE CHECK ROUTINE CHECKS TO SEE IF THE QUEUE ON * THE CURRENT EQT HAS MORE THEN THE 'LIMIT' NUMBER OF WORDS * OF BUFFER MEMORY ON IT AT THE CURRENT TIME. * THE LIMIT IS PASSED IN THE B REG. SO THE ROUTINE CAN * CAN BE USED FOR BOTH UPPER AND LOWER LIMIT CHECKS. * * CALLING SEQUENCE: * * LDB NEGATIVE OF LIMIT * JSB QCHK * --- MORE THAN LIMIT WORDS ON QUEUE * --- LESS THAN LIMIT WORDS ON QUEUE * EQT1 ADDRESS IS IN B ON EXIT * QCHK NOP STB TEMP1 SET LIMIT LDA EQT1,I START AT EQT HEAD RAL,CLE,ERA CLEAR POSSIBLE SIGN AND E CLE,SZB SET E FOR NOT EXCEEDED QCHK1 SZA,RSS END OF QUEUE? JMP QCHK3 YES GO EXIT * STA TEMPW SET CURRENT ELEMEMT INA GET THE CON WORD LDB A,I TO B RBL CHECK IF A BUFFERED SSB,RSS REQUEST? JMP QCHK2 NO TRY NEXT ONE * ADA .2 YES STEP TO THE COUNT LDB A,I GET COUNT TO B ADB TEMP1 ADD TO LIMIT STB TEMP1 AND RESET QCHK2 LDA TEMPW,I GET NEXT ELEMENT JMP QCHK1 GO CHECK THIS ELEMENT * QCHK3 LDB EQT1 GET SUSPEND POINTER SEZ,RSS OVERFLOW? ISZ QCHK NO STEP RETURN JMP QCHK,I RETURN * SKP * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE * NEW ONE IN THE PRIORITY CHAIN. * FOR ALL REQUESTS WITH PRIORITIES * ABOVE 40 (LARGER NUMBER), THE REQUEST * IS LINKED ON A FIFO BASIS. FOR ALL * OTHER PRIORITIES (0 - 40) THE * NEW ENTRY IS LINKED ACCORDING * TOG$þú ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKED INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW * REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * * NOTE: TEMP2 IS SET = 77777B IF REQUEST PRIORITY * IS > 40. SKP LINK NOP LDB C100K FETCH MAX POS NUMBER LDA TEMP2 FETCH PRIORITY OF REQUEST ADA N41 IF PROORITY LESS THAN 40 SSA,RSS USE FIFO STB TEMP2 BY SETTING REQUEST PRIORITY NEGATIVE * LDB EQT1 GET THE HEAD OF THE LIST CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * ********Èþú***************************************** **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LINK WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * LDA TEMPL SYSTEM IS IT A DISC SZA,RSS REQUEST ? JMP LINK2 NO USE ZERO PRIORITY * INB,RSS YES USE THE PROVIDED WORD LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIGN (SAVES E) SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST * * RETURN A BUSY STATUS (E=1) IF THE ONLY REQUEST ON THE * EQT IS A SYSTEM CLEAR REQUEST. * SEZ,RSS IF SOMETHING ELSE IS IN THE QUEUE, SKIP NEXT LINE ELA IF ONLY REQUEST IS SYSTEM CLEAR, RETURN (E)=1 * JMÀ¡þúP LINK,I RETURN * SPC 1 .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 SKP ***************************************************** * JSB DRVMP SET UP DRIVER MAP FROM ORIGINAL CALL * * (E)=0 ENTER DRIVER IN SYSTEM MAP * (E)=1 ENTER DRIVER IN USER MAP * (B)=0 SET PORT MAP WITH SYSTEM MAP * (B)=100000 SET PORT MAP WITH USER MAP ***************************************************** DRVMP NOP CLA STA DVMPS INIT USER MAP SAVE FLAG TO 0 STA MATAD INIT USER MAT ADDR TO 0 STA FLAG INIT DEFAULT MAP AS SYS MAP STA MAP? INIT DEFAULT REBUILD USER MAP JSB CPEQT GET EQT # INTO (A) CCB ADB A CALCULATE INDEX TO ADB $DVMP THE DRIVER MAP TABLE STB DVMP1 ADB EQT# INDEX TO SECOND WORD STB DVMP2 LDB EQT1,I GET DRIVER LINK WORD * **A790220* STB TID SAVE IT AWAY MIGHT BE ID SEG ADDRESS CLE,SSB,RSS BIT15=1 FOR TIME-OUT ON CLEAR REQUEST CLE,SZB,RSS CLEAR (E) FOR SYSTEM MAP JMP DVUSY MAP DRIVER IF IN PTTN * LDA B INA LDA A,I CHECK T FIELD IN CONTROL WORD STA TWORD (SAVE FOR LATER TOO) RAL CLE,SSA T=1 0R 3 IF S=1 JMP DVUSY (E) CLEARED FOR SYSTEM MAP * SLA,RSS JMP DVUSE T=0,GO SET USER MAP * ADB .4 T=2,GET ID WORD IN SYS CALL LDB B,I STB TID SAVE IT AWAY IT IS AN ID SEG ADDRESS. CLE,SZB,RSS IS IT 0 ? JMP DVUSY YES,USE SYSTEM MAP (E)=0 * SSB IS IT SPECIAL $XSIO CALL? JMP DVCUR YES, USE CURRENT USER MAP * * THIS IS AN $XSIO CALL. IF IT IS A LOAD IN, * SWAP IN, OR SWAP OUT THEN THE MAP TO SET * UP IS THE ORIGIONAL VIRGIN MAP. IF THIS * IS A SEGMENT LOAD,Þ¥þú THEN WE WANT TO USE THE * MAP AS IS. * * LDA EQT1,I GET THE ADDRESS OF THE $XSIO LINK WORD ADA N2 INDEX TO THE LU WORD. IF THE SIGN BIT LDA A,I IS SET, THEN IT IS A SEGMENT LOAD CALL RAL (LSB=1 MEANS USE CURRENT MAP) ELSE IT STA MAP? IS A LOAD OR SWAP(LSB=0 MEANS VIRGIN MAP) JMP DVUSR NOW GO SEE IF HE IS STILL MAPPED IN. * * DVUSE CCA STA FLAG SET FLAG FOR USER MAP NEEDED STA MAP? SET USER MAP NEW/OLD FLAG * LDA EQT1,I NO, OK GET BUFFER ADDRESS ADA .2 LDA A,I GET USER BUFFER ADR FROM ID TMP WORDS CLE,SSA WAS BUFFER MOVED TO SAM? JMP DVUSY YES,NEED SYSTEM MAP (E)=0 * LDB TWORD GET THE T FIELD WORD RBR GET THE REQUESTR CODE TO MSB & LSB SSB,SLB IF THIS IS A CONTROL RQ THEN GO JMP DVUSR UNBUFFERED & IN USER MAP (THIS STINKS) * LDB TID GET BACK THE ID SEG ADDR. JSB COMN IS THE BUFFER IN COMMON? RSS -NO. JMP DVUSY -YES. ENTER DRIVER UNDER SYSTEM MAP. * DVUSR LDA .32 (A) = REG# OF USER BASE PAGE * **A790220* ^^^ CCB CBX (X) = READ 1 REGISTER LDB DCURU (B) = ADDR OF CURR USER BP SAVE XMM READ REGISTER * LDB TID ADB .14 IS CURRENT USER LDA B,I CORE RESIDENT? AND .15 STA TYP CPA .1 WELL? JMP MEMRS YES GO SET MEM RES MAP * ADB .7 STEP TO THE MAP ADDRESS LDA B,I GET MAPID WORD AND B77 GET PARTITION NUMBER MPY .7 MULTIPLY BY 7 ADA $MATA GET MAT ENTRY ADDR STA MATAD SAVE ADDR FOR $SMAP CALL LATER * ADA .3 IT IS DISC RESIDENT USER LDA A,I GET PAGE# FROM MATA ENTRY AND B1777 STA DVMP2,I SAVE SECOND WORD * LDB MAP? DO WE NEED¢þú TO FORCE BUILD MAP? ERB (E)=0 FORCE BUILD (E)=1 REUSE CPA CURUS IS USER ALREADY MAPPED? JMP SAMUS YES, SEE IF WE CAN JUST REUSE IT * ISZ DVMPS NEED TO SET UP USER MAP LDA ASVUI FIRST, SAVE CURRENT USER MAP USA NEWUS LDB MATAD SET UP NEW USER MAP JSB $SMAP SET UP USER MAP (B)=MATA ADDR * DVUDV LDA FLAG USER MAP IS NOW SET UP SLA,RSS WAS IT NEEDED BY $XSIO CALL? JMP DVSYS YES, ENTER IN SYSTEM MAP * LDA DVMP1,I SDA? SSA,RSS JMP MAPDV NO, MAP DRIVER INTO DRIVER PTTN * CLE,SLA SDA DRIVER DOES OWN MAPPING? JMP DVDON YES, OK (E)=0 * CCE (E) = 1 MAY BE JUST BIG DRIVER FOR USER LDA TYP SDA + USER MAP CPA .4 BIG BG TYPE? JMP ERR11 YES, NO SDA IN USER MAP JMP DVDON NO, OK FOR SDA IN USER MAP * SAMUS SEZ SAME USER BP, BUT NEED TO REBUILD MAP? JMP DVUDV NO, REUSE MAP JMP NEWUS YES, DON'T SAVE OLD COPY, REBUILD * * * DRIVER SET UP NEEDING MEMORY RESIDENT MAP * MEMRS LDA $MRMP CPA CURUS MEM.RES.MAP ALREADY SET UP? JMP MEMR2 YES * ISZ DVMPS NO, SO SAVE CURRENT USER MAP LDB ASVUI BEFORE SET UP MEM.RES.MAP USB USA SET UP MEM.RES. IN USER MAP MEMR2 LDA FLAG SLA,RSS WAS IT $XSIO CALL? JMP DVSYS YES, ENTER IN SYS MAP * LDB MSIGN STB DVMP2,I SET WORD 2 = 100000 LDA DVMP1,I SSA,RSS SDA? JMP MAPDV NO, MAP DRIVER INTO DRIVER PTTN * CLE,SLA SDA + SELF-MAPPING? JMP DVDON YES, (E)=0 FOR SDA IN SYS * CCE (E) = 1 BIG DRIVER NEED USER MAP LDA $MRMP MEM.RES. MAP INCLUDE ADA $SDA SDA AND TABLE AREA II? LDA A,I AND B1777 MASK OUT PROTECT BITS CPA $SDA JMP DVDON YESïÂþú, (E)=1 FOR SDA IN USER MAP * ERR11 JSB $RSM RESTORE USER MAP LDA .11 NEED USER MAP AND SDA DRIVER DOESN'T MAP JMP ILLCD SO GIVE ERROR IO11 * * * * DRIVER SET UP NEEDING SYSTEM MAP * DVCUR CLA,INA $XSIO CALL IN SYS MAP STA MAP? NEEDS USER IN PORT MAP RBL,CLE,ERB (B)= ID SEG ADDR SZB,RSS $CNFG CALLING? JMP DVSYS YES, THERE IS NO ID SEG * ADB .21 LDA B,I GET MAP WORD AND B77 MPY .7 GET MAT ADDR ADA $MATA ADA .3 LDA A,I AND B1777 STA B (B)= PAGE # OF USER BASE PAGE JSB MPUBP MAP IN USER BASE PAGE ADA N32 SET ADDR TO SECOND COPY IN BP ISZ DVMPS LDB ASVUI USB SAVE CURRENT USER MAP USA SET UP MAP FROM SECOND COPY IN BP JMP DVSYS ENTER UNDER SYS MAP * DVUSY CLA USER SWITCHING TO SYS MAP STA FLAG STA MAP? * DVSYS CLA,CLE STA DVMP2,I SET WORD 2 = 0 LDA DVMP1,I SSA SDA? JMP DVDON YES, ENTER IN SYS (E)=0 * MAPDV LDA FLAG MAP DRIVER INTO DRIVER PTTN ERA OF THE APPROPRIATE MAP JSB MPDRV LDB DVMP2,I SEZ ENTER IN SYS MAP? SSB OR USING MEM.RES MAP? JMP DVDON YES, DON'T SAVE USER MAP IN BP * JSB MPUBP MAP IN USER BP IOR MSIGN NO, NEED TO SAVE USER MAP USA IN DISC RES MAP COPY IN BP * DVDON LDB MAP? SZB ANY USER MAP SET UP? LDB MSIGN SET PORT MAP WORD UP JMP DRVMP,I RETURN (E)=0 SYS (E)=1 USER * * * MAP DRIVER INTO THE DRIVER PARTITION AREA * USING CURRENT DRIVER MAP TABLE ENTRY @DVMP1 * CALLING SEQUENCE: * (E) = 0 USE SYSTEM MAP * (E) = 1 USE USER MAP * JSB MPDRV * * (E) = PRESERVED * ALL OTHER REGISTERS MEANINGLESS * MPDRV Ì|þúNOP LDA DVMP1,I GET PAGE # OF DRIVER AND B1777 STA B LDA $DLTH CAX (X) = # PAGES TO MAP LDA $DVPT (A) = PAGE # OF DRIVER PTTN SEZ ARE WE MAPPING FOR USER ? ADA .32 YES, ADD 32 FOR USER REGISTERS XMS MAP IT JMP MPDRV,I RETURN * * * MAP USER'S PHYSICAL BASE PAGE * CALLING SEQUENCE: * (B) = USER BASE PAGE # * JSB MPUBP * * (A) = LOGICAL ADDR OF SAVE AREA IN USER BP IN SYS MAP * (E) = PRESERVED * ALL OTHER REGISTERS MEANINGLESS * MPUBP NOP CLA,INA (B) = PAGE# OF USER BP CAX (X) = 1 REGISTER TO SET UP LDA $DVPT (A) = PAGE # OF DRIVER PTTN XMS MAP USER BP AT DRIVER PTTN AREA LDA DVPTA (A) = LOG ADDR OF USER MAP COPY JMP MPUBP,I RETURN * * * TWORD NOP TFIELD WORD .14 DEC 14 .21 DEC 21 N32 DEC -32 DVPTA NOP LOG ADDR OF USER MAP COPY (INIT SET UP) DVMP1 NOP DVMP2 NOP MATAD NOP FLAG NOP DCURU DEF CURUS CURUS NOP B1777 OCT 1777 *** * TID NOP TYP NOP ASVUI DEF SVUSR,I ADDRESS WITH SIGN SET FOR SAVE ASVUS DEF SVUSR SVUSR BSS 32 DVMPS BSS 1 DRIVER MAP FLAG * ********RESTORE USER MAP TO PRE-****** ********DRIVER STATE****************** * * $RSM NOP CLA CPA DVMPS WAS USER MAP CHANGED JMP $RSM,I NO,RETURN * STA DVMPS YES,CLEAR CHANGE MAP FLAG LDA ASVUS USA RESTORE ORIGINAL USER MAP RSEX JMP $RSM,I ENABLE SYSTEM MAP * * * ************************************** * $DRVM DRIVER MAP SET-UP FOR CONTINUATION * CALLING SEQUENCE: * * SET UP EQT ADDRESSES * JSB $DRVM * --- RETURN WITH (E) INDICATING WHICH MAP * (E)=0 NEEDS SYSTEM MAP * (E)=1 NEEDS USER MAP * ALL OTHER REGISTERS MEANINGLESS * ************************************************ ****ÆLþú*******NO EXTERNAL ROUTINE SHOULD CALL ***********$DRVM OR $RSM EXCEPT SPOOL AND POWER-FAIL ************************************************** * * $DRVM NOP JSB CPEQT GET EQT # INTO (A) CCB ADB A ADB $DVMP STB DVMP1 SAVE ADDR DRIVER MAP TABLE WORD 1 ADB EQT# LDA B,I CLE,SZA,RSS IS SECOND WORD = 0? JMP SDDRV YES, SYSTEM MAP NEEDED * STB DVMP2 SAVE ADDR DRIVER MAP TABLE WORD 2 LDA .32 (A) = REG# OF USER BASE PAGE CCB CBX (X) = READ 1 REGISTER LDB DCURU READ INTO 'CURUS' XMM READ MAP REGISTER LDB DVMP2,I GET SECOND WORD CCE,SSB MEM RES PROG? (E)=1 JMP MRPUS YES * CPB CURUS SAME USER ALREADY MAPPED? JMP SDUSE YES, RETURN (E)=1 * ISZ DVMPS NO, DIFFERENT USER LDA ASVUI SAVE CURRENT USER MAP USA JSB MPUBP AND MAP IN USER BASE PAGE USA TO MAP USER WITH COPY OF MAP SDUSE LDA DVMP1,I SSA,RSS SDA? JMP $DRVM,I NO, RETURN * SDADV SLA YES, BUT IS IT SDA+MAPPING? CLE YES, ENTER IN SYS MAP (E)=0 JMP $DRVM,I RETURN (E)=0 SYS (E)=1 USER * * MRPUS LDA CURUS CPA $MRMP,I WAS MEM RES MAP IN USER MAP? JMP SDDRV YES, JUST MAP IN DRIVER * ISZ DVMPS NO, DIFFERENT USER LDB ASVUI SAVE CURRENT USER MAP USB * MRDRV LDA $MRMP SET UP MEM.RES. MAP USA * SDDRV LDA DVMP1,I (E)=0 SYS (E)=1 USER SSA IS DRIVER IN SDA? JMP SDADV YES, SEE IF SELF-MAPPING * JSB MPDRV NO, NEED TO MAP DRIVER IN CORRECT MAP JMP $DRVM,I RETURN (E IS STILL SAME) * SKP * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * ›àþú CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED OR COMPLETED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * RETURNED TO THE CALLER FOR * FURTHER ACTION. * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL —Dþú# 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE RAL SSA,SLA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * RAR IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * LDA B SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING RAL SSA,SLA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. RAR ALR,RAR CLEAR STA EQT5,I FIELD. * JSB DRVMP GO SET MAP INITIALLY ADB CHAN (B) HAS MAP INDICATOR FOR PORT XMB JMP DV02C CONTINUE * * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * JSB DRVMP GO SET MAP INITIALLY DV02C ELA SAVE (E) STA MAP? LDA EQT3,I IF HERE ONLY TO GET DMA SSA AT THE REQUEST OF DRIVER, JMP DRV4 SKIP SETTING UP EQT. * LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. LDA B,I GET REQUEST CONTROL WORD, AND NTSUB SE$|þúT SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT,CLEAR LOW. STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. * AND .6 CPA .6 CCA,RSS THIS IS A CONTROL CALL LDA C100K NOT CONTROL SET TO MASK OUT SIGN * AND B,I * DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. * * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I EQT4 IS THUS FULLY CONFIGURED. DRV4 LDA EQT4,I GET THE CHANNEL # AND B77 (I.E., SELECT CODE) IN A. LDB MAP? ERB LDB EQT2,I CALL DRIVER *INITIATION* ELB,CLE,ERB CLEAR SIGN OF I.ENTRY_POINT * (DON'T ALTER E). SEZ ENTER DRIVER IN USER MAP? JMP INUS YES * JSB B,I NO, ENTER IN SYSTEM MAP JMP DRVRT * MAP? NOP * INUS JSB $UIN ENTER IN USER MAP, RETURN TO DRVRT SKP * * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJECT, WITH (B)=TRANSMISSION LOG. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT^þú DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * = 6 INITIATION OK, BUT DRIVER WANTS TO GIVE UP DMA * DRVRT STA TEMP6 SAVE DRIVER CODE. JSB $RSM GO RESTORE USER MAP LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. LDA TEMP6 RESTORE DRIVER CODE SZA,RSS IF SUCCESSFULLY INITIATED, JMP DRV00 CONTINUE * CPA .6 ELSE IF THIS WAS NOT A RSS GIVE-UP-DMA RETURN, JMP DRVRJ INVESTIGATE REJECTION * JSB CLDMA ELSE GIVE UP DMA. * * OPERATION INITIATED * DRV00 EQU * CCE SET (E) FOR WHAT FOLLOWS. LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I IF NO QUE SZA SKIP BUSY SET STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED * DRVRJ STB TLOG SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE SPC 1 C7700 OCT 170077 NTSUB OCT 153703 B174K OCT 174000 B20K OCT 20000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR > * SYSTEM I/O REQUEST PROCESSOR - $XSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A P¼èþúRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * 8 OCT <0> OR * OR <100000 IF USE USER MAP UNCHANGED> * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * Ñšþú FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. * **A790220* RBL,CLE,ERB STRIP SIGN BIT IF SPECIAL SEG LOAD CALL STB $CKLO SAVE FOR *STADV*. ADB DRT INDEX INTO THE DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * CLA XSEQ1 IS USED TO SAFEKEEP (EQT1) IF STA XSEQ1 CALLING "LINK" FOR LOCKED EQT LINKING. * LDB $ELTB,I GET EQT. LOCK TABLE HEADER. SSB,RSS IF TABLE IS EMPTY, JMP XSIO3 SKIP CHECK FOR LOCK ON THIS EQT. * ELB,CLE,ERB GET RID OF NOT_EMPTY BIT. STB TEMP1 STORE TABLE LENGTH. CMB,INB THEN STORE 2'S COMPLE STB TEMP3 OF TABLE LENGTH. LDA TEMPL GET SUBCHANNEL/EQT.# WORD. AND B77 ISOLATE EQT.#. STA TEMP5 KEEP IT TO COMPARE AGAINST. LDA $ELTB GET $ELTB TABLE ADDR. ADA .1 GET ADDR OF 1ST EQT. # IN TABLE. XSIO1 LDB A,I GET AN EQT. # FROM TABLE. CPB TEMP5 IF IT MATCHES THIS REQUEST'S EQT. #, JMP XSIO2 SET UP TO HANG REQUEST ON $ELTB ENTRY. * INA BUMP ENTRY ADDR IN $ELTB. ISZ TEMP3 IF TABLE NOT ALL DONE, JMP XSIO1 LOOP BACK. * JMP XSIO3 SKIP: THIS EQT. IS NOT LOCKED. * XSIO2 LDB EQT1 FIRST PRESERVE (EQT1) STB XSEQ1 BEFORE FOOLING "LINK". * ADA TEMP1 COMPUTE ADDR OF LIST OF HUNG $XSIO ADA TEMP1 REQUESTS (WORD 3 OF THIS EQT. #'S STA EQT1 ENTRY) AND PASS IT TO "LINK" IN "EQT1". * XSIO3 LDB $XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE THE SUB CHANNEL CLE,INB SET ADDRESS OF HIS CON WORD ELA,ALF MOST BIT TO 'E', REST AROUND ELß{þúA,SLA,RAL TO BITS 2-5, SKIP IF MOST IS ZERO ADA B20K SET MOST IN BIT 13 IF REQUIRED ADA MSIGN ADD THE 'SYSTEM REQUEST' BIT XOR B,I ADD HIS INFORMATION AND SUBCH =B120074 THROW OUT THE EXCESS XOR B,I SET HIS BITS AGAIN STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). STA TEMPL SET DISC FLAG TO ZERO (NON-DISC) LDA EQT5,I GET THE DRIVER TYPE AND B36K MASK TO TEST FOR DISC ADB .4 SET B TO THE RETURN ADDRESS STB $XSIO AND SAVE IT ADB N2 SET B TO DISC PRIORITY WORD LDB B,I GET PRIORITY WORD CPA B14K IF DISC STB TEMP2 SET PRIORITY CPA B14K AND STA TEMPL THE DISC FLAG FOR * JSB LINK CALL TO LINK REQUEST IN I/O LIST. LDA XSEQ1 IF WE MODIFIED (EQT1) FOR SZA EQT. LOCKING, THIS IS THE STA EQT1 TIME TO RESTORE IT. SZA ALSO, IF EQT. IS LOCKED, JMP $XSIO,I DON'T INITIATE THIS $XSIO CALL. * SEZ IF DEVICE IS BUSY JMP $XSIO,I THEN EXIT. * LDA $CKLO ELSE, IF DEVICE IS JSB STADV DOWN, THEN RETURN RSS TO CALLER. * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. SPC 1 XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK, (PLUS SYSTEM RQ CODE) XSEQ1 NOP TEMP. STORAGE FOR (EQT1) HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STÍBþúATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCATION * OF THE TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * <$CON1> IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) * * THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * * 2) USER OR SYSTEM (AUTOMATIC OUTPUT BUFFERING) RT * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 =0 IF SYSTEM * 4 * 5 øÈþú* 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . * N+8 * SKP * * 4) SYSTEM REQUEST * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER OR SYSTEM (AUTOMATIC BUFFERING) RT * 10 SYSTEM * 11 CLASS I/O * * SKP $CON1 RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE £™þúIN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION LOG STB XLOG SAVE TRANSMISSION LOG FOR RETRRN. * JSB $RSM GO RESTORE USER MAP IF NECESSARY * CLA CLEAR STA EQT15,I TIME-OUT CLOCK. * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. * L.49 LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB REQUEST BLOCK TO JMP L.502 IF CLEAR COMPLETION GO CLEAN IT UP. STB IOE11 SAVE CONWD FOR *IOERR* USE. * LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. LDB EQT1,I STB STMP3 SAVE REQUEST ADDR. FOR ERROR ECHO WORK. LDA TEMP3 IF ERROR, CPA .1 GO PROCESS. JMP NOTRD * LDA B,I UNLINK STA EQT1,I CURRENT I/O LDA TEMP0 REQUEST. RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. * SEZ,RSS IF = 0, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 IF MALFUNCTION OCCURRED, SZA THEN UNDO THE RELINKING STB EQT1,I AND BY PASS RELEASE OF SZA BUFFER. JMP L.70 STB L.50 * ADB .3 GET TOTAL LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 JSB $CKLO CHECK IF BELOW THE LIMIT. IF SO,?³þú JMP L.54 SCHED ANY WAITERS. START NEXT REQUEST. * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. SKP * * NORMAL USER OPERATION COMPLETION * L.51 STB L.52 SET CURRENT ADDR. FOR SCHEDULER. ADB .9 SET (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 STB PTR SAVE THE QUEUE ADDRESS SEZ IF CLASS REQUEST JMP C.01 GO REQUEUE THE REQUEST * ADB N1 GET WORD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. SKP * * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * BACK INTO THE LIST, OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 BY PASS INITIATING THE NEXT CMA,SSA,INA,SZA OPERATION IF A MALFUNCTION HAS JMP L.70 OCCURRED ON THIS DEVICE. * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXTßFþú * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JSB CLDVM CLEAR DRVR MAP TABLE WORD 2 JMP L.68 GO START THE NEXT REQUEST * .11 DEC 11 N8 DEC -8 * * CHECK IF BELOW THE BUFFER LIMIT ON THE CURRENT EQT. * $CKLO NOP LDB $BLLO CHECK IF BELOW THE LIMIT. JSB QCHK JMP $CKLO,I NO, SO RETURN. * LDA B YES, SO SCHEDULE ANY WAITERS JSB $SCD3 AND JMP $CKLO,I RETURN. * * * CLEAR WORD 2 OF DRIVER MAP TABLE * SO THAT SPURIOUS INTERRUPTS ENTER DRIVER IN SYTEM MAP. * IF THE LAST DRIVER REQUEST HAPPEN TO HAVE BEEN A NORMAL USER * REQUEST, THAT PROGRAM MIGHT NOT BE IN MEMORY ANY LONGER. * A PARTITION RESIDENT PROGRAM MAY HAVE BEEN REPLACED BY ANOTHER. * CLDVM NOP LDA EQT1 CPA $DMEQ IS THIS COMPLETION OF BIT BUCKET? JMP CLDVM,I YES, IGNORE DRIVER MAP TABLE CLEAR * JSB CPEQT CONVERT EQT1 ADDR TO EQT# CCB SUBTRACT 1 FROM EQT# ADB A WHICH IS IN (A) ADB $DVMP GET ADDR OF WORD 1 ADB EQT# GET ADDR OF WORD 2 CLA OF DRIVER'S MAP TABLE ENTRY STA B,I CLEAR WORD TO FORCE SYS MAP JMP CLDVM,I RETURN SKP * CLASS REQUEST COMPLETION * * CLASS COMPLETION IS HANDLED AS FOLLOWS: * * 1. THE EXCESS BUFFER IS RETURNED ON WRITE COMPLETION * 2. IF THE CLASS QUEUE IS NOT EXPECTING A REQUEST * THE WHOLE BUFFER IS RELEASED AND WE EXIT. * 3. IF A PROGRAM IS WAITING FOR THE REQUEST IT IS * RESCHEDULED. * 4. THE REQUEST IS MODIFIED TO PUT THE STATUS WORD * AND THE TRANSMISSION LOG (TLOG) IN WORDS * 3 (PRIORITY) AND 6 (USER LENGTH WORD) * 5. THE CLASS QUEUE IS UPDATED AND WE EXIT. * * SEE DESCRIPTION OF CLASS QUEUE IN COMMENTS AT BEGINNING * OF SECTION OaöþúN USER REQUESTS. * * C.01 LDB PTR GET THE QUEUE ADDRESS INB LDA B,I GET THE CON WORD ADB .2 STEP TO LENGTH WORD STB CLTMP SET LENGTH ADDRESS SLA IF READ JMP C.03 SKIP RETURN * LDA B,I GET BLOCK SIZE TO A. ADB .5 STEP TO RETURN BUFFER ADDRESS ADA N8 SUBTRACT SIZE OF OVERHEAD STA CLRTN SET RETURN SIZE ADA N2 IF LESS THAN TWO WORDS SSA THEN SKIP JMP C.03 THE RETURN * STB CARTN SET THE BUFFER ADDRESS JSB $RTN RETURN THE WRITE BUFFER CARTN NOP BUFFER ADDRESS CLRTN NOP BUFFER LENGTH * LDA CLRTN SET THE CMA,INA NEW BLOCK SIZE ADA CLTMP,I IN THE BLOCK STA CLTMP,I SET THE NEW SIZE * C.03 ISZ CLTMP STEP TO CLASS WORD LDA CLTMP,I GET THE CLASS AND B377 COMPUTE THE ADA DCLAS CLASS HEAD ADDRESS * C.04 LDB A,I GET THE CONTENTS OF CLASS HEAD. * CLE,SSB,RSS IF POSITIVE JMP C.08 GO TRACK DOWN THE QUE. * STA CLASS SAVE THE CLASS QUEUE ADDRESS RBL,CLE,ELB IF PROGRAM WAITING SEZ,CLE,RSS JMP C.05 SKIP,ELSE GO LINK IN THE RQ. * * PROGRAM IS WAITING, CLEAR THE WAIT FLAG * AND RESCHEDULE THE PROGRAM * ERB,RBR CLEAR THE WAIT FLAG STB A,I AND RESET IN THE QUEUE. * JSB $SCD3 SCHEDULE ANY PROGRAMS WAITING C.05 LDB CLASS,I GET CURRENT END OF LIST ADB N1 SUBTRACT ONE PENDING REQUEST STB PTR,I SET IN NEW END OF LIST LDB PTR SET NEW ELEMENT IN STB CLASS,I THE LIST. * ISZ PTR STEP TO ISZ PTR PRIORITY ADDRESS ISZ CLTMP STEP TO BUFFER LENGTH WORD LDA EQT5,I GET CURRENT STATUS ALR,RAL CLEAR DOWN/BUSY BITS. LDB TEMP3 GET COMPLETION STATUS CMB,CLE,INB IF F¨|þúROM ILCODD * CME IF BAD COM CODE ERA,CLE,RAR SET BIT 14 LDB TLOG GET THE TRANSMISSION LOG. STA PTR,I SET THE STATUS WORD STB CLTMP,I AND THE TLOG * JMP L.501 ELSE STANDARD COM EXIT * C.08 LDA B TRACK DOWN JMP C.04 THE END OF THE LIST SPC 1 * * THIS DEVICE IS COMPETING WITH OTHER DEVICES FOR * THE USE OF THE AVAILABLE DMA CHANNEL. THE * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT# SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IF A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABORTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. JSB $ETEQ SET EQT ADSþúDRESSES. * LDA EQT1,I IF NO I/O QUEUED ON THIS SZA,RSS DEVICE, THEN GO CLEAN OUT JMP L.60 ITS 'WAITING ON DMA ALLOC.' FLAG. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1 GO CLEAN OUT ANY CPA $DMEQ I-O REQUESTS IF THIS JMP IOCX7 IS THE BIT BUCKET. * LDB EQT1,I IF NO REQUEST SZB,RSS IS WAITING, THEN JMP IOCX GO EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. SKP * **************************************************************** * * I/O COMPLETION - EXIT SECTION. * * THIS ROUTINE FIRST CHECKS FOR A DMA QUEUE AND IF ANY AND IF A * CHANNEL IS AVAILABLE, THEN THE CHANNEL ASSIGNMENT ROUTINE * IS ENTERED. IF THIS CONDITION DOES NOT EXIST, THEN * IF THE "BIT BUCKET FLAG" IS SET, THEN THE BIT BUCKET * I/O REQUEST ARE CLEANED OUT. IF THE FLAG IS NOT SET, THEN * IF THE REQUEST IS A SYSTEM REQUEST WITH A COMPLETION ADDRESS, * THEN CONTROL IS TRANSFERED TO THE COMPLETION ADDRESS. IF * NEITHER OF THESE CONDITIONS EXITS, THEN THE OPERATOR ATTENTION * FLAG IS CHECKED. IF SET, THEN THE OPERATOR ACKNOWLEDGEMENT * ROUTINE IS ENTERED. IF NOT SET, THEN CONTROL IS RETURNED * TO THE SYSTEM. * ***************************************************************** * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDB $BITB CHECK THE "BIT BUCKET FLAG" TO SEE SZB TO SEE IF THE BIT BUCKET MUST BE JMP IOCX0 CLEANED OUT. * LDA COMPL IF SYSTEM REQUEST STB COMPL CLEAR COMPLETION SPECIFICêcþúATION. LDB XLOG SZA COMPLETION ROUTINE SPECIFIED, JMP A,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ OTHERWIZE, RETURN TO THE DISPATCHER. * XLOG NOP SKP * * * CLEAN OUT BIT BUCKET REQUESTS. * * IOCX0 LDA $DMEQ SET UP THE BIT JSB $ETEQ BUCKET EQT ADDRESSES. IOCX7 LDB EQT1,I CHECK IF THERE IS ANY SZB,RSS I/O REQUEST TO BE JMP IOCX9 INITIATED ON THE BIT BUCKET. * LDB EQT1,I YES, SO GET THE REQUEST'S ADB .3 SIZE AND DO AN IMMEDIATE LDB B,I COMPLETION. JMP L.136 * IOCX9 STB $BITB NO, SO CLEAR BIT BUCKET FLAG AND JSB $CKLO CHECK BUFFER LIMITS AND SCHED.WAITERS. JMP IOCX1 * $BITB NOP BIT BUCKET FLAG. DO NOT TOUCH. SKP * * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ON JMP IOERR OTHER DEVICE, PRINT DIAG. * * DISC ERROR PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CNV3 CONVERT TO DECIMAL ASCII. LDB A,I FETCH 1ST WORD OF RESULT **780221 GLM** STB DMSG+1 AND SET IT INTO MESSAGE INA ADVANCE TO FINAL TWO WORDS DLD A,I FETCH THEM DST DMSG+2 AND SAVE IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). JSB $CNV1 STA DMSG+6 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII H¯þú AND B37 JSB $CNV1 STA DMSG+8 * LDB TEMP0 (B)= REQUEST TYPE LDA BLS (A)= " S" SSB,RSS IF USER TYPE REQUEST, LDA BLU (A)= " U" STA DMSG+9 SET "S" OR "U" IN MESSAGE * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS LDA DMSGA PRINT DIAGNOSTIC SSB IF SYSTEM REQUEST JMP SYSE WRITE ON LU 1 ONLY * LDB L.52 FETCH THE LOSER'S ID ADDRESS JSB $PSTE POST ERROR TO SCB (IF IN SESSION) JSB $BFOT ECHO ERROR TO SESSION TERMINAL <(A) IS SAVED> * SYSE JSB $YMG SEND "TRNNNN EQTXX,UYY S(OR U)" TO LU 1 * CCB LDA TEMP0 IF DISC ERROR SSA FROM SYSTEM REQUEST, JMP L.71 CONTINUE. * STB TEMP9,I SET TLOG IN ID-SEGMENT FOR ABORT ALF,ALF IF LU # 2 OR 3, AND .3 SET TRACK DOWN SZA,RSS IN TAT- JMP L.71 OTHERWISE, CONTINUE * SLA,RSS CLB,RSS LDB TATSD ADB TLOG INDEX TO ADB TAT TAT, SET ERROR LDA MSIGN TRACK STA B,I "DOWN" (ASSIGNED TO SYSTEM). * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * L.71 STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * DMSGA DEF *+1 DEC -20 DMSG ASC 10,TR NNNNN EQTXX UYY S BLS ASC 1, S BLU ASC 1, U HED < I/O CONTROL MODULE - ERROR SECTION > * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYº2þúSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR00 CLB,RSS ILLEGAL CLASS NUMBER OR SECURITY CODE ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR03 LDB .3 ILLEGAL EQT REFERENCE. SELECT CODE = 0 RSS ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM RSS OR OTHER BOUNDARIES. ERR05 LDB .5 ILLEGAL DISC TRACK OR SECTOR RSS ADDRESS IN DISC REQUEST. ERR06 LDB .6 REFERENCE TO PROTECTED DISC TRACK RSS ERR08 LDB .8 DISC TRANSFER EXCEEDS TRACK BOUND RSS ERR09 LDB .9 LOAD-N-GO AREA OVERFLOW RSS ERR10 LDB B400 DOUBLE REQUEST ON SAME CLASS RSS ERR12 LDB B402 REQUESTED LU NOT DEFINED FOR THIS SESSION RSS ERR13 LDB B403 EQT/LU LOCKED AND "NO SUSPEND" BIT SET RSS ERR14 LDB B404 DEVICE DOWN AND "NO SUSPEND" BIT SET RSS ERR26 LDB B1006 REFERENCE TO A SPOOL LU THAT HAS BEEN KILLED * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * * NOTE: $ERAB ADDS AN ASCII "00" TO THE (A) REG UPON ENTRY. * * ERIO ASC 1,IO B400 OCT 400 B402 OCT 402 B403 OCT 403 B404 OCT 404 B1006 OCT 1006 SKP * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJEC¬FþúT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORY. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETION ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TLOG ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. CPA .2 SET ERROR FLAG FOR CLA CLASS COMPLETION. CMA,INA NEGATE TO AVOID STA TEMP3 REPORT AT L.54. LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * CCE,SLA IF CLASS REQUEST JMP L.49 GO DO CLASS COMPLETION. ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01B SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01A IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01A NOP - FWA - R01B NOP - # WORDS - JMP REXIT * R02 SLA,RSS öþú CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL ADDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE CCE,INA SET XSUSP(SET E FOR $CNV1 STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA TEMP4 CPA .1 CHANGE ANY NOT READY REJECT LDA .7 CODE TO 7. JSB $CNV1 CONVERT TO ASCII AND IOR AS00 FILL LEADING ZEROES LDB A STORE IN B REG. LDA ERIO (A) = ASCII * IO * JSB $ERMG PRINT DIAGNOSTIC AND ABORT PROG CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05A ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TLOG STORE INA TRANSMISSION LOG STB A,I IN XB. JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK R05A NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD CLB CLEAR ERROR STB TEMP3 FLAG. CPB CONFL IF $XSIO CALL SSA,RSS ˜Æþú THEN SKIP, JMP L.501 ELSE DO NEXT REQUEST. JMP $XSIO,I $XSIO ERROR RETURN (REQUEST SKIPPED) * * AS00 ASC 1,00 SKP * ********************************************************************** * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE IS UNAVAILABLE FOR * INITIATION OF AN OPERATION OR WHEN AN ERROR IS DETECTED AT THE * END OF AN OPERATION. A DIAGNOSTIC MESSAGE IS PRINTED ON THE * SYSTEM CONSOLE IN THE FOLLOWING FORMAT: * * IONM L XXX EYY SZZ QQQ * * WHERE: XXX = THE LOGICAL UNIT NUMBER OF THE DEVICE * YY = THE EQT NUMBER OF THE DEVICE * ZZ = THE SUBCHANNEL NUMBER OF THE DEVICE * QQQ = THE DEVICE STATUS AT THE TIME OF FAILURE * MN = A MNEMONIC DESCRIBING ONE OF THE FOLLOWING CONDITIONS * 1. NR - DEVICE IS NOT READY * 2. ET - END-OF-TAPE OR TAPE SUPPLY LOW ON THE DEVICE * 3. PE - TRANSMISSION PARITY ERROR TO/FROM THE DEVICE * 4. TO - THE DEVICE TIMED OUT * -- NEW CODES MAY BE ADDED HERE -- * * GIVEN A BAD I/O REQUEST, IOERR WILL DOWN ALL LU'S ASSOCIATED WITH * THE DEVICE(DEFINED BY THE EQT AND SUBCHANNEL). ALL I/O CHANNELS * ASSOCIATED WITH THE EQT ARE CLEARED. ALL I/O REQUESTS ASSOCIATED * WITH THE DEVICE ARE UNSTACKED FROM THE EQT'S I/O REQUEST QUEUE AND * RELINKED IN THE LOWEST LU'S(MAJOR LU) I-O REQUEST QUEUE(DRT ENTRY * WORD 2)BY THE SUBROUTINE UNLNK. DRT ENTRY WORD 2 OF OTHER DOWNED * LU'S ARE SET TO THE LU NUMBER OF THE MAJOR LU. THE LU DOWN BIT(BI * 15 OF DRT ENTRY WORD 2)FOR EACH DOWNED LU IS SET. THE EQT ENTRY I * NOT SET DOWN. I/O ERROR MESSAGES ARE ISSUED FOR ALL LU'S SET DOWN * * ON ENTRY, CONTAINS A NUMBER CORRESPONDING TO THE ASSOCIATED * MNEMONIC AND EQT1 CONTAINS THE ADDRESS OF WORD ONE OF THE ASSOCIAT * DEVICE'S EQT ENTRY. * * –äþú THE FOLLOWING TEMPORARY LOCATIONS ARE USED FOR TEMPORARY STORAGE B * IOERR: * :=SUBCHANNEL-EQT WORD FOR THE BAD I-O REQUEST GIVING THE * SUBCHANNEL IN BITS 11-15 AND THE EQT IN BITS 0-5(USED BY * LUERR). * :=WORD 2 OF THE BAD I-O REQUEST. * ********************************************************************** * SKP NOTRD LDB EQT1,I LU NOT READY ENTRY. INB GET BAD I-O REQUEST CONWD STB IOE11 AND SAVE FOR LATER. CLA,INA SET A=1 FOR NOT READY. * LDB EQT1,I SAVE CURRENT REQUEST ADDRESS STB STMP3 FOR POSSIBLE ERROR ECHO WORK. IOERR LDB EQT1 REMOVE ALL ENTRIES IN THE QUEUE STB HEAD RELATED TO THE BAD I-O REQUEST. ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND SET STA IOMSG+1 IN DIAGNOSTIC MESSAGE. JSB CLDVM CLEAR DRIVER MAP TABLE WORD 2 * JSB CPEQT GET EQT NUMBER(SETS E=1). STA TEMP8 SAVE EQT NUMBER. JSB $CNV1 CONVERT TO ASCII STA IOMSG+6 AND SAVE(E MUST = 1). * LDA EQT4,I GET LAST USED SUBCHANNEL ALF,RAL FORM EQT4 AND POSITION AND B174K TO HIGH 5 BITS. IOR TEMP8 ADD IN EQT NUMBER STA TEMP8 AND SAVE AS SUBCHANNEL-EQT WORD. * ALF,RAL GET SUBCHANNEL AND B37 NUMBER. JSB $CNV1 CONVERT TO ASCII(ON ENTRY,E MUST=1) STA IOMSG+8 AND SAVE. * ***780221 GLM*** * LDA EQT5,I FETCH DEVICE STATUS AND B377 ISOLATE IT CLE AND CONVERT IT JSB $CNV3 TO OCTAL INA DLD A,I FETCH RESULT DST IOMSG+9 AND SAVE IN MESSAGE BUFFER * * JSB LUERR DOWN THE LOGICAL UNITS(ENTRY A#0).WAIT UNTIL LDA EQT5,I AFTER LUERR CALL TO SET AVAIL FIELD TO 0 SO ALR,RAR WE WON'T ENTER DRIVER(VIA $XSIO)TO PRINT STA EQT5,I ERROR MESSAGEÿùþú ON SAME EQT WE'RE DOWNING. * SEZ CHECK IF WE TRIED TO JMP IOER9 DOWN LU 1. IGNORE ATTEMPT. * LDA EQT1 LDB A,I CHECK IF WE MUST SZB INITIATE AN JSB $DLAY I/O REQUEST OF THIS EQT. * LDB IOE11,I GET SAVED WORD 2(CONWORD) LDA CONFL FOR THE BAD I/O REQUEST. SZA IF COMPLETION SECTION IS IN JMP IOCX CONTROL, THEN EXIT IOC. * RBL,SLB IF REQUEST SECTION IN CONTROL, SSB CHECK IF USER OR SYSTEM I/O REQUEST. JMP IOCX IF USER, GO TO EXECUTION SECTION. JMP XSIOE,I IF SYSTEM, RETURN TO SYSTEM CALLER. * IOER9 LDA CONFL SAVE CONTROL STA SCONF FLAG. CLA,INA SET JSB $CNV1 ASC11 1 STA IOMSG+4 INTO MESSAGE. LDA BLKS FETCH 2 BLANKS STA IOMSG+3 AND PAD BUFFER LDA IOMSA FETCH MESSAGE ADDR JSB $YMG ISSUE MESSAGE TO LU 1. LDA SCONF RESTORE FLAG. STA CONFL JMP L.60 * HEAD NOP IOE11 NOP BLKS ASC 1, * * IOMSA DEF *+1 DEC -22 IOMSG ASC 11,IONM L XXX EYY SZZ QQQ * * * * I/O DEVICE ERROR MNEMONIC TABLE--ORDERED BY * ERROR CODE DESCRIBING CONDITION. * ERTBL DEF * ASNR ASC 1,NR - NOT READY - ASC 1,ET - END OF TAPE (INFORMATION) - ASC 1,PE - TRANSMISSION PARITY ERROR - ASC 1,TO - TIMED-OUT - * * NEW CODES MAY BE ADDED AT THIS POINT * SBMSK OCT 20074 * SKP * ***************************************************************** * * SUBROUTINE LUERR * * THIS SUBROUTINE IS USED TO DOWN ALL LU'S CORRESPONDING TO A * SPECIFIC EQT AND SUBCHANNEL. IT WILL OPTIONALLY PRINT AN * ERROR MESSAGE FOR EACH DOWNED LU. * * CALLING SEQUENCE: * :=0 DO NOT PRINT I/O ERROR MESSAGES * :>0 PRINT I/O ERROR MESSAGES(ASSUMES ASCII EQT AND * zþú SUBCHANNEL ALREADY SET) * :<0 PRINT I/O ERROR MESSAGE ON SESSION (MTM) * TERMINAL ONLY (THE DEVICE HAS ALREADY BEEN SET DOWN) * := POINTER TO I-O REQUEST LIST TO SCAN. * :=SUBCHANNEL-EQT WORD FROM THE BAD I-O REQUEST. * JSB LUERR * * RETURN: * :=1 TRIED TO DOWN LU 1 * :=0 DID NOT TRY TO DOWN LU 1 * NO REGISTERS ARE SAVED. * SUBROUTINE UNLNK USES TEMP0 AND OTHERS. * USES THE FOLLOWING REGISTERS: * :=FLAG AS TO WHETHER TO PRINT(#0) OR NOT PRINT(=0) * I/O ERROR MESSAGES. * :=USED TO STORE THE MAJOR LU. * :=COUNTER FOR SCAN THROUGH DRT. * :=USED TO SAVE POINTER INTO DRT. * :=USED TO SAVE EQT1. * :=USED TO STORE LU TEMPORARILY. * ****** ****** UPDATE NEW TEMPS USED 780223 GLM ***** ****** ****************************************************************** * STMP2 NOP STMP3 NOP STMP4 NOP STMP5 NOP * * LUERR NOP STA TMP1 * LDA CONFL SAVE CURRENT STA SCONF CONTROL FLAG. * CLA SET MAJOR LU STA TMP2 TO ZERO. * LDA LUMAX SET CMA,INA UP STA TMP3 COUNTER. LDB DRT GET FIRST DRT ENTRY. * SKP D.00 LDA B,I GET DRT WORD 1 STB TMP4 SAVE POINTER IN DRT. AND C3700 COMPARE DRT WORD 1 TO THE SUBCHANNEL- CPA TEMP8 EQT WORD(LESS THE LOCK FLAG). RSS IF EQUAL,FOUND A LU,SO GO PROCESS. JMP D.04 OTHERWIZE,GO CONTINUE SCAN OF DRT. * LDA LUMAX FOUND A LU MATCH SO PROCESS IT. CCE,INA COMPUTE THE(SET E=1 FOR POSSIBLE LU=1) ADA TMP3 LU NUMBER. STA TMP8 SAVE LU NUMBER FOR LATER. CPA .1 CHECK TO SEE IF SYSTEM CONSOLE. IF SO, JMP D.06 DO NOT SET THE ÆZþúDEVICE DOWN. ADB LUMAX POSITION POINTER TO DRT WORD 2. LDA TMP2 CHECK TO SEE IF A MAJOR SZA LU HAS BEEN FOUND JMP D.02 IF SO,THEN STORE THE MAJOR LU # IN WORD * 2,SET THIS LU BUZY,ISSUE MESSAGE. * STB A SAVE DRT WORD 2 ADDRESS. LDB EQT1 SAVE EQT1 ADDRESS STB TMP6 FOR RESTORATION. LDB TMP1 FETCH CALL FLAG SSB IF DEVICE HAS ALREADY BEEN PUT DOWN * (THIS WAS A REQUEST AGAINST A DOWN * DEVICE) JMP D.001 SKIP THE UNLINK WORK (ALREADY DONE). * LDB HEAD GO UNLINK ANY I-O REQUESTS FROM JSB $UNLK THE GIVEN I-O QUEUE. (A&B PASS PARMS) DEF TEMP8 D.001 LDA TMP8 SAVE THIS LU STA TMP2 AS MAJOR LU. LDB TMP4 RESTORE POINTER TO DRT WORD 2. ADB LUMAX LDA B,I D.02 CCE RAL,ERA SET THE(E MUST=1) STA B,I LU DOWN. LDB TMP1 CHECK IF WE ARE TO PRINT ERROR CCE,SZB,RSS MESSAGES(SET E=1 FOR $CNV1). JMP D.025 NO, SO SKIP. * * PRINT ON BOTH SYSTEM AND SESSION TERMINALS * LDA TMP8 *** ***780223 GLM*** *** JSB $CNV3 CONVERT LU TO INA ASCII, ADVANCE TO LAST TWO DIGITS DLD A,I FETCH THEM DST IOMSG+3 AND SAVE IN ERROR MESSAGE. LDA TMP1 PRINT ONLY ON SESSION TERM? (CALL FROM L.014) SSA YES--CURRENT PROG IS REQUESTOR JMP D.021 SO GO DO IT * LDA IOMSA GET LU I/O ERROR MESSAGE JSB $YMG AND ISSUE TO SYS CON. LDA TMP6 RESTORE JSB $ETEQ EQT POINTERS FOR ECHO WORK * * * * ECHO ERROR TO SESSION TERMINAL * * 1ST DETERMINE REQUEST TYPE AND WHO IS IN * CONTROL (INITIATION OR COMPLETION SECTION). * * * * LDA STMP3 FETCH CONTROL INA WORD OF T™€þúHE LDA A,I BAD REQUEST AND AND B140K (B140000) ISOLATE FIELD. LDB SCONF FETCH SAVED CONTROL FLAG SZB INITIATION OR COMPLETION SECTION????? JMP COMP1 --COMPLETION SECTION IS IN CONTROL * * * REQUEST SECTION IS IN CONTROL * ECHO ALL BUT SYSTEM REQUESTS ( FIELD = 10 ) * CPA MSIGN SYSTEM REQUEST? JMP D.025 YES -- CONTINUE * D.021 LDB XEQT USER REQUEST AND THE CURRENT PROG IS THE LOSER STB STMP3 SAVE IN LOCAL TEMP JMP SCAN GO CHECK FOR SESSION * * * COMPLETION SECTION IS IN CONTROL * * ONLY ECHO IF REQUEST WAS NORMAL USER REQUEST ( FIELD =0 ) * COMP1 SZA NORMAL REQUEST ? JMP D.025 NOPE -- SKIP ECHO * LDB STMP3 NORMAL USER REQUEST-- FETCH ID ADDRESS * * * * OK TO ECHO -- NOW GO FIND OUT WHERE THE ECHO IS TO GO. * * (GO FIND SYSTEM LU FOR SESSION LU 1, OR MTM LU) * SCAN JSB $LU?? NOTE: (B) = PROG ID ADDRESS JMP D.025 NOT SESSION OR MTM\ OR LU 1 NOT DEFINED FOR SESSION ADA DRT SAVE RTN STATUS IN ENT (B<0=-MTM LU) A=SYSTEM LU (LU LDA A,I ADVANCE TO DRT ENTRY AND FETCH IT AND C3700 COMPARE EQT & SC (LESS LOCK FLAG) CPA TEMP8 WITH CURRENT LU TO BE PUT DOWN JMP D.025 IF SAME , REJECT ECHO. * * * IF MTM, JUST ECHO (UNLESS MTM LU = 1) (B)=TYPE * SSB,RSS SEE IF PROG IS SESSION OR MTM JMP ITSES IT'S SESSION--GO CHECK FOR POSSIBLE LU SWITCH * CPB N1 DON'T ECHO IF MTM LU = 1 JMP D.025 IT'S A ONE SO CONTINUE * LDB STMP3 FETCH PROG'S ID ADDRESS LDA IOMSA FETCH MESSAGE BUFFER ADDR JSB $BFOT GO ECHO JMP D.024 AND THEN CONTINUE ERROR PROCESSING * * * (A) = SESSION WORD. LU?? MAPPED IN THE TABLE PARTITION (IF DEFINED). * * FOR EVERY MATCH (SYS LU IN SST WITH LU BEING PUT DOWN), PLACE THE * AßËþúSSOIATED SESSION LU INTO THE ERROR MESSAGE AND ECHO TO SESSION * TERMINAL. * * NOTE THAT AN * (ASTERISK) IS INSERTED BEFORE THE LU TO INDICATE * THAT THE LU IS THE SESSION RELATED LU. * * ITSES LDA B,I FETCH SST LENGTH STA STMP4 SAVE FOR SCAN INB ADVANCE TO FIRST ENTRY ADDRESS STB STMP5 SAVE FOR SCAN * SSTLK LDA STMP5,I FETCH SST ENTRY ALF,ALF SHIFT AND AND B377 ISOLATE SYSTEM LU INA ADJUST FOR INTERNAL STRUCTURE (LU-1) CPA TMP8 SAME AS CURRENT DOWNER?? CCE,RSS YEP -- GO MODIFY ERROR MESSAGE JMP SSNXT NOPE -- CONTINUE SCAN * LDA STMP5,I FETCH SESSION LU AND B377 ISOLATE AND ADJUST INA FOR INTERNAL DATA STRUCTURE JSB $CNV3 CONVERT TO ASCII ( E SET ABOVE FOR DECIMAL) INA ADVANCE TO LAST TWO DIGITS DLD A,I FETCH ASCII LU IOR B25K (B25000) INCLUDE SESSION INDICATOR "*" DST IOMSG+3 SAVE IN ERROR DIAGNOSTIC LDB STMP3 FETCH PROG'S ID ADDRESS LDA IOMSA FETCH MESSAGE BUFFER ADDRESS JSB $PSTE POST ERROR TO SCB JSB $BFOT ECHO MESSAGE TO SESSION TERMINAL SEZ IF REQUEST REJECTED (DOWN, NO SAM ,OR WHATEVER) JMP D.024 ABORT ECHO REQUEST * SSNXT ISZ STMP5 BUMP SST ADDRESS ISZ STMP4 BUMP COUNT, DONE? JMP SSTLK NOPE, CONTINUE SCAN OF SST * D.024 LDA TMP6 SET EQT BACK UP JSB $ETEQ IN CASE ECHO WAS PERFORMED * D.025 LDB TMP4 * D.04 INB INCREMENT POINTER TO NEXT DRT ENTRY. ISZ TMP3 JMP D.00 GO SCAN NEXT ENTRY. * JSB $CKLO CHECK BUFFER LIMITS AND SCHED WAITERS. CLE D.06 LDA SCONF RESTORE CONTROL STA CONFL FLAG. JMP LUERR,I IF NO MORE LU ENTRIES, RETURN. * B25K OCT 25000 * SKP * ****************************************************pþú******************* * * SUBROUTINE $UNLK * * THIS SUBROUTINE IS USED TO UNLINK I/O REQUESTS FROM THE EQT I/O * REQUEST QUEUE POINTED TO BY EQT1. IT MAY BE USED IN ONE OF TWO * MODES: * MODE I. IF ON ENTRY THE A REGISTER EQUALS ZERO, NORMAL USER * (UNBUFFERED)I-O REQUESTS ARE UNLINKED WITH THE CALLING * PROGRAMS SUSPENDED IN THE GENERAL WAIT LIST. IT IS * ASSUMED THAT THE EQT WILL BE SET DOWN BY THE CALLER. * MODE II. IF ON ENTRY THE A REGISTER IS NONZERO, THEN ONLY I/O * REQUESTS MATCHING THE SUBCHANNEL GIVEN IN SUEQT ARE * UNLINKED. UNBUFFERED I/O REQUESTS ON THIS SUBCHANNEL AR * HANDLED AS IN MODE I. BUFFERED, CLASS AND SYSTEM * I/O REQUESTS ARE STACKED UPON AN LU I/O REQUEST QUEUE AF * THE I/O REQUEST POINTED TO BY THE A REGISTER IN THE ORDE * THAT THEY APPEARED IN THE EQT QUEUE. * * CALLING SEQUENCE: * :=THE SUBCHANNEL-EQT WORD DEFINING THE DEVICE(MODE II * ONLY, UNUSED WITH MODE I). * :=EQT1(HEAD OF THE I-O REQUEST QUEUE)OF THE DEVICE'S * EQT(USED WITH MODE I AND II). * :=0 INDICATES MODE I PROCESSING. * :#0 INDICATES MODE II PROCESSING. POSITION IN LU I/O REQ * QUEUE AFTER WHICH ALL UNLINKED I-O REQUESTS ARE * TO BE RELINKED. * JSB $UNLK * DEF SUEQT * * RETURN: * NO REGISTERS ARE SAVED. * USES UNLK3,UNLK8,TEMPX,TEMP0 * ************************************************************************ SKP $UNLK NOP STB TMP5 SAVE EQT ADDRESS STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. LDA $UNLK,I LDA A,I AND B174K GET SUBCHANNEL CLE,ELA AND SHIFT RAL,RAL UPPER BIT ALF TO BIT 13 SEZ ADD IN LOWER 4 BITS @¹þú ADA B20K AT BITS 2-5 STA TEMP0 AND SAVE. RSS * UNLK0 LDB TEMPX,I GET NEXT ENTRY. UNLK1 STB TEMPX SAVE POINTER TO PREVIOUS REQUEST. UNLK2 LDB TEMPX,I GET POINTER TO THIS REQUEST. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. SZB,RSS IF END, JMP UNLK6 THEN GO EXIT. * STB UNLK3 SAVE POINTER TO THIS REQUEST. INB STEP TO CONTROL WORD OF THIS REQUEST. LDA UNLK8 CHECK IF MODE I OR II PROCESSING. SZA,RSS JMP UNL25 MODE I SO SKIP SUBCHANNEL CHECK. LDA B,I GET CONTROL WORD OF THIS REQUEST. AND SBMSK PICK OFF SUBCHANNEL INFORMATION AND CPA TEMP0 COMPARE TO THE SUBCHANNEL INFO OF RSS THE BAD I/O REQUEST. IF NOT EQUAL, JMP UNLK0 GO CHECK THE NEXT I/O REQUEST. * UNL25 LDA B,I GET CONTROL WORD OF THIS I/O RAL REQUEST AND ROTATE IT. CMA,SSA,SLA,RSS IF NOT STANDARD USER REQUEST, JMP UNLK4 GO PROCESS AS OTHER TYPES. * * STANDARD USER REQUEST LDA UNLK3,I UNLINK THIS STA TEMPX,I I/O REQUEST LDA UNLK3 POINT A AT THE REQUEST'S ID SEGMENT JSB NSBIT IS THE "NO SUSPEND" BIT SET ? JMP UNLK5 YES, SCHEDULE WITH IO14 ERROR LDA .4 NO, SO SUSPEND THE PROGRAM STA B,I IN GENERAL WAIT LIST. LDA TMP5 SET ID TMP WD #1 TO 4. CMA,INA NEGATE EQT ADDR INB TO SAVE IN TEMP WD #2 OF ID SEGEMENT STA B,I BECAUSE WE DON'T KNOW LU# 2 ADB .7 ADVANCE TO SAVE A REG LOCATION. LDA B,I FETCH SAVED ADB N1 POINT OF SUSPENSION, AND STORE STA B,I IT IN XSUSP FOR THIS PROGRAM. JSB $LIST LINK THIS PROGRAM INTO THE OCT 103 GENERAL WAIT LIST. UNLK3 NOP JMP UNLK2 GO TRY NEXT ENTRY. * UNLK5 ADB .7 POINT AT POINT OF SUSPENSION. ~þú CCA BACK IT UP -1 FOR ADA B,I THE ERROR RETURN POINT STA B,I FOR IO14 ERROR MESSAGE. INB POINT AT SAVED AREG LDA ERIO TO INSERT THE STA B,I ASCII "IO". INB POINT AT SAVED BREG LDA A14 TO INSERT THE STA B,I ASCII "14". LDB UNLK3 POINT AT THE ID SEGMENT JSB $LIST AND GO SCHEDULE THE PROGRAM. OCT 401 JMP UNLK2 GO LOOK AT NEXT ENTRY. * UNLK4 LDA UNLK8 CHECK IF MODE I OR II. SZA,RSS IF MODE I, DO NOT UNLINK JMP UNLK0 THIS REQUEST. GO TRY NEXT ONE. LDB UNLK8,I IF MODE II, CLEAR RBL,CLE,ERB POSSIBLE SIGN BIT LDA UNLK3,I AND LINK THIS I-O STA TEMPX,I STB UNLK3,I REQUEST TO THE LDB UNLK3 END OF THE DOWN STB UNLK8,I I/O REQUEST QUEUE. STB UNLK8 SET UNLK8 TO POINT TO THE LAST REQUEST. JMP UNLK2 GO TRY NEXT ENTRY. * UNLK6 ISZ $UNLK JMP $UNLK,I RETURN * * UNLK8 NOP TEMPX NOP * TMP1 NOP TMP2 NOP TMP3 NOP TMP4 NOP TMP5 NOP TMP6 NOP * TMP8 NOP A14 ASC 1,14 SKP * ****************************************************************** * * SUBROUTINE $DLAY: * * $DLAY IS USED TO SET UP A SHORT TIMEOUT(10 MSEC)WHICH, WHEN IT * OCCURS, SIGNALS THAT AN I/O OPERATION MUST BE INITIATED ON THE * TIMED-OUT EQT(SEE $DEVT). * * CALLING SEQUENCE: * LDA * JSB $DLAY * * RETURN: * ALL REGISTERS ARE MODIFIED. * ***************************************************************** * $DLAY NOP CCE,INA SET THE SIGN BIT LDB A,I ON TO INDICATE RBL,ERB WE MUST INITIATE AN STB A,I OPERATION. ADA .3 CCE LDB A,I SET THE RBL,ERB EQT STB A,I BUZY. ADA .10 LDB N1 SE­:þúT A STB A,I TIMEOUT JMP $DLAY,I OF 10 MSEC. HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * $CON1 IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * IF THE TIMEOUT WAS DUE TO THE NEED TO INITIATE AN * I/O OPERATION(BIT 15 EQT2 SET)THEN THIS BIT * IS CLEARED AND $CON1 IS ENTERED(AT L.60) TO * INITIATE THE I/O OPERATION. * * * ENTER FROM SCHEDULER MODULE: * * (A)
* * $DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I GET THE CLEAR BIT SSA IF CLEAR TIME OUT JMP CLTIM JUST CLEAR * LDA EQT2,I CHECK IF THE TIMEOUT SSA IS FOR INITIATING I/O JMP INTDL ON THIS EQT. * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A STA INTCD BLF,SLB IF DRIVER TO HANDLE TIME JMP CIC.6 OUT GO CALL THE DRIVER. * CLTIM JSB CLCHS CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP $CON1 RETURN FROM DRIVER * INTDL RAL,CLE,ERA CLEAR INITIATION STA EQT2,I BIT. ISZ CONFL SET CONTROL FLAG TO NONZERO. JMP L.60 GO INITIATE. * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * ***************************************************************** * * CONSTANT AND VARIABLE STORAGE AREA * ******************************************************************* * A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .3 DEC 3 .5 DEC 5 .8 DEb@þúC 8 .9 DEC 9 .10 DEC 10 N1 DEC -1 * B77 OCT 77 B377 OCT 377 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 MSIGN OCT 100000 * TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP7 NOP TEMP8 NOP TEMP9 NOP TEMP0 NOP TEMPL NOP TEMPW NOP * CONFL NOP SCONF NOP TLOG NOP COMPL NOP DO NOT USE FOR INIT CODE(MUST=0 BEGIN). DMACF NOP FLAGS USED IN ALLOCATING HED ** I/O CONTROL - OPERATOR COMMUNICATION ** * ***************************************************************** * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM USES COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR STATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWO OF THE I-O CONTROL STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE * AND ARE INCLUDED IN RTIOC. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-OUT, AND EQT STATUS) * ARE OPTIONAL AND ARE CONTAINED IN THE USER PROGRAM * $$$CMD WHICH IS SCHEDULED BY SCHED. THESE COMMANDS * MAY BE REMOVED BY DELETING $$CMD. * ****************************************************************** * SKP * **************************************************************** * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,N1 OR DN,,N2 * WHERE N1 IS THE EQT # OF THE I/O SLOT TO BE SòRþúET DOWN * OR N2 IS THE LU # OF THE I/O DEVICE TO BE SET DOWN. * * ACTION: WHEN SETTING THE EQT DOWN, THE AVAILABILITY FIELD OF THE * REFERENCED SLOT IS SET = 1(SLOT DISABLED). * WHEN SETTING THE LU DOWN, BIT 15 OF DRT WORD 2 IS SET AND * ANY I/O FOR THIS DEVICE IS REMOVED FROM THE EQT I/O * QUEUE AND ADDED TO THE LU I/O QUEUE HEADED AT DRT * WORD 2. * * CALL (FROM MESSAGE PROCESSOR): * * := N1 (EQT #) IN BINARY OR 0 * :=-1 OR N2 (LU #) IN BINARY * JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR TO -MESS.I- TO PRINT * * INPUT ERROR * IF N1 OR N2 ARE ILLEGAL OR IF BOTH ARE PRESENT. * **************************************************************** * $IODN SZA,RSS CHECK IF DOWN LU OR JMP DNLU DOWN EQT COMMAND. * INB,SZB DOWN EQT COMMAND. IF BOTH LU AND EQT ARE JMP $INER GIVEN, ISSUE INPUT ERROR MESSAGE. * JSB IODNS CHECK LEGALITY OF EQT & SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO DOWN EQT OF SYSTEM CPA SYSTY CONSOLE, ISSUE INPUT ERROR MESSAGE. JMP $INER LDA EQT5,I SET AVAILABITY FIELD ALR,RAR TO 1 IOR B40K TO SET STA EQT5,I DOWN. * JSB XUPIO SET ANY DOWNED LU'S UP. * LDB EQT1,I GO PUT ALL WAITERS(UNBUFFERED RBL,CLE,ERB I/O)INTO THE BENERAL WAIT SZB,RSS LDB EQT1 CLA LIST. SKIP FIRST REQUEST. JSB $UNLK DEF A (DUMMY DEF FOR THIS MODE). JMP $XEQ RETURN. * DNLU STB A SAVE LU NUMBER. CMB,CLE,INB,SZB,RSS ISSUE AN ERROR MESAGE JMP $INER IF THE LU IS LESS THEN ADB LUMAX 1 OR IS GREATER THEN CCB,SEZ,RSS LUMAX. JMP $INER * ADB A USE LU NUMBER ADB DRT TO POSITION TO LDA B,I WORD 1 OF THE AND C370šXþú0 DRT ENTRY. STA TEMP8 SET UP SUBCHANNEL-EQT WORD. AND B77 INPUT SZA,RSS ERROR IF JMP $INER DOWNING BIT BUCKET DEVICE. * STB TEMP9 SAVE ADDRESS OF DRT WORD 1. JSB $CVEQ SET EQT ENTRY ADD(WILL MASK SUBCH.). * LDB EQT5,I CHECK IF RBL,SLB EQT IS JMP DNLU5 UP OR IS SSB DOWN. JMP DNLU9 EQT IS DOWN. * DNLU5 LDB EQT1,I SKIP FIRST EQT I-O REQUEST QUEUE SZB,RSS ENTRY UNLESS THE QUEUE IS EMPTY. LDB EQT1 STB HEAD SAVE THIS POINTER. CLA SET FOR NO ERROR MESSAGES. JSB LUERR GO DOWN ALL LU'S POINTING TO DEVICE. SEZ ERROR IF ATTEMPT JMP $INER TO DOWN LU 1. JMP $XEQ NO, RETURN TO SYSTEM. * DNLU9 LDB TEMP9 IF EQT IS DOWN, THEN ADB LUMAX GET DRT WORD 2 LDA B,I AND SET THE LU IOR MSIGN DOWN. STA B,I JMP $XEQ RETURN. * C3700 OCT 174077 * * *IODNS* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * IODNS HLT 2 HLT FOR INIT CODE STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $INER GO TO $MESS ERROR EXIT. JSB $CVEQ SET EQT ENTRY ADDRESSES. STB CONFL SET ALL THE FLAGS TO ZERO. JMP IODNS,I SKP * **************************************************************** * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE REFERENCED SLOT(EQT ENTRY * #)IS SET = 0 (UNIT AVAILABLE). THE AVAILABILITY FIELD OF * ANY DEVICES(BIT 15 DRT WORD 2) REWpþúFERENCING THIS EQT ARE * SET = 0 AND THE LU'S' I/O QUEUES ARE ADDED TO THE EQT'S * I/O QUEUE. IF THE EQT WAS AVAILABLE OR DOWN, THEN THE * *$CON1* SECTION(AT *L.68*)IS ENTERED TO INITIATE ANY * WAITING I/O REQUESTS. * * CALL (FROM MESSAGE PROCESSOR): * * := NN (EQT #) IN BINARY * JMP $IOUP * * RETURN IS MADE TO *$CON1* OR TO *$XEQ* IF ANY ACTION * IS TAKEN. IF NN IS ILLEGAL, THEN RETURN IS MADE TO * *MESS,I* TO PRINT 'INPUT ERROR'. * ****************************************************************** * $IOUP JSB IODNS CHECK 'NN' AND SET EQT QDDRESSES. $UP EQU * JSB $RSM GO RESTORE USER MAP IN CASE DRIVER CALL JSB CPEQT GET EQT # STA TMP1 FROM EQT1. LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 (RETURN B=0). LDA EQT5,I GET AVAILABILITY. SSA,RSS IF DOWN OR AVAILABLE, JSB CLDMA HELP OUT POWER FAIL WITH DMA. * JSB XUPIO SET ANY ASSOCIATED LU'S UP. * LDA EQT5,I GET AVAILABILITY ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. SKP * ************************************************************************ * * SUBROUTINE XUPIO: * * XUPIO IS USED TO UP ANY LU'S ASSOCIATED WITH THIS EQT. * * CALLING SEQUENCE: * :=THE ADDRESS OF THE FIRST WORD OF THIS EQT. * :=THE EQT NUMBER. * JSB XUPIO * * RETURN: * ALL REGISTERS ARE DISTROYED. * USES TMP2,TMP4,TMP6. * CALLS SUBROUTINE XXUP. * ************************************************************************ * XUPIO NOP LDA LUMAX SET CMA,INA UP STA TMP2 COUNTER. LDB DRT POSITION TO FIRST STB TMP6 DRT ENTRY. * UPIO1 LDA TMP6,I CHECoØþúK IF THIS AND B77 DRT ENTRY POINTS CPA TMP1 TO THE EQT. JMP UPIO5 YES. UPIO3 ISZ TMP6 NO. SO ISZ TMP2 GO CHECK JMP UPIO1 NEXT DRT ENTRY. JMP XUPIO,I RETURN. * UPIO5 LDB TMP6 POSITION TO DRT ADB LUMAX WORD2. STB TMP4 GO PLACE LDB B,I ENTRIES LDA EQT1 INTO EQT JSB $XXUP I/O QUEUE(RETURN B=0). STB TMP4,I SET THE LU 'UP'. JMP UPIO3 GO CHECK NEXT DRT ENTRY. SKP **************************************************************** * * SUBROUTINE $XXUP: * * $XXUP TAKES AN I/O QUEUE AND(USING LINK)POSITIONS THE I/O * REQUESTS IN THE CURRENT EQT QUEUE ACCORDING TO THEIR PRIORITY. * IT RETURNS A FLAG IF AN I/O OPERATION SHOULD BE INITIATED. * * CALLING SEQUENCE: * := EQT1 OF OLD DEVICE. * :=ADDRESS OF FIRST STACKED I/O REQUESTS TO BE LINKED ON * THE CURRENT EQT(SIGN BIT WILL BE STRIPPED). * JSB $XXUP * * RETURN: * :=0 * :#0 A NEW I/O OPERATION IS AT THE HEAD OF THE CURRENT * EQT I/O QUEUE SO IT MUST BE INITIATED. = * THE ADDRESS OF THE FIRST WORD OF THE EQT. * USES TEMP1,TEMP2,UNLK8,TEMP4,XXUP7 * ***************************************************************** * $XXUP NOP STA TEMP4 SAVE OLD DEVICE EQT1. CLA CLEAR STA XXUP7 INITIATION FLAG. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. XXUP9 SZB,RSS RETURN WHEN END OF I/O JMP XXUP2 REQUEST QUEUE IS FOUND. * STB TEMP1 SET UP POINTER FOR LINK. ADB B176K IF POINTER IS < 2000, SSB THEN NO I-O STACKED ON JMP XXUP2 THIS LU SO EXIT B=0. * LDB TEMP1 OTHERWIZE, GET I-O REQUEST ADDRESS. LDA B,I UNLINK THIS STA UNLK8 I/O REQUEST. INB œËþú LDA B,I GET INB PRIORITY RAL OF THE SSA I-O REQUEST JMP XXUP8 SLA,RSS BUFFERED AND CLASS I-O REQUESTS. JMP XXUP5 NORMAL USER REQUEST. LDA TEMP4 SYSTEM REQUEST. ADA .4 LDA A,I AND B36K CHECK IF THE OLD DEVICE CPA B14K IS A DISK OR NOT. JMP XXUP1 CLA IF OLD DEVICE IS NOT A DISK, STA TEMPL SET TEMPL=0 AND USE JMP XXUP3 ZERO PRIORITY. XXUP1 STA TEMPL IF OLD DEVICE IS A DISK, THEN INB,RSS SET TEMPL#0 AND USE PRIORITY. XXUP5 ADB .4 XXUP8 LDA B,I XXUP3 STA TEMP2 SAVE PRIORITY FOR LINK. JSB LINK LINK THIS REQUEST ONTO THE EQT. LDA EQT1 SEZ,RSS IF ONLY REQUEST ON THE EQT, THEN STA XXUP7 STORE INTO THE INITIATION FLAG. LDB UNLK8 LOOP FOR NEXT JMP XXUP9 I/O REQUEST. * XXUP2 CLB SET B=0. LDA XXUP7 GET INITIATION FLAG JMP $XXUP,I RETURN * XXUP7 NOP B176K OCT 176000 HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $YMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 15 12-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 22 * CHARACTERS (11-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $YMG * (P+1) -RETURN- * * ON RETURN: IŠþú * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $YMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY * LDB SY# IF BUFFER CPB .15 IS FILLED (15 MESSAGES), JMP $YMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 ENTRY ADDRESS FOR MOVE MVW .12 MOVE THE WORDS. * ISZ SY# INCREMENT COUNT ENTRY. LDB SYC (B) = CURRENT ENTRY ADDRESS. LDA SYT1 ADA .12 (A) = NEXT ENTRY ADDRESS. CPA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * CLA,CLE (A) = 0 FOR EXIT WITH JMP $YMG,I MESSAGE ACCEPTED. * * CALL <$XSIO> TO INITIATE OUTPUT * SYSCL NOP LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH NOP SAYS DO NOT NEED USER MAP JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .11 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 NOP SYC DEF SBUF SBF DEF SBUF SKP * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURP þúOSE: THIS ROUTINE ROUTES ERROR DIAGNOSTICS TO THE * SYSTEM CONSOLE (LU 1) VIA THE $YMG SUBROUTINE. * ALSO, ERRORS WILL BE ECHOED ON THE SESSION TERMINAL * OF THE CURRENTLY EXECUTING PROGRAM VIA THE $BFOT * SUBROUTINE. NOTE : * IF THE SESSION (MTM) TERMINAL = SYSTEM CONSOLE, * THE ERROR HAS ALREADY BEEN ISSUED SO THE ECHO IS NOT * PERFORMED. * * * CALL: (A) = ADDRESS OF FIRST WORD OF MESSAGE BLOCK. * THIS WORD CONTAINS THE CHARACTER LENGTH * OF THE MESSAGE AS A NEGATIVE VALUE. * * * (P) JSB $SYMG * (P+1) -RETURN- * * * ON RETURN: * * * * (A) = 0 -MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT 0 = - BUFFER FILLED, * MESSAGE REJECTED. * * (E) = 0 * * SYTMP NOP LOCAL TEMP USED TO SAVE $YMG RTN STATUS * $SYMG NOP STA STMP4 SAVE MESSAGE BLOCK ADDRESS JSB $YMG ISSUE ERROR DIAGNOSTIC TO LU 1 STA SYTMP SAVE CALL STATUS LDB XEQT FETCH CURRENT PROGRAMS ID ADDRESS JSB $LU?? GO LOOK FOR SESSION TERM LU JMP SYM.2 NOT SES OR MTM\ OR LU 1 NOT DEFINED FOR SES SZA,RSS (A)= SYS LU(LU-1) OF SES TERM JMP SYM.2 IF LU 1, ALL DONE! * LDB XEQT FETCH CURRENT PROG'S ID ADDR AGAIN LDA STMP4 FETCH BUFFER ADDRESS JSB $BFOT GO ECHO DIAGNOSTIC TO USER * SYM.2 LDA SYTMP FETCH STATUS OF CALL CLE AND CLEAR "E" TO MATCH $YMG. JMP $SYMG,I * * SKP * * * * SUBROUTINE: <$BFOT> (BUFFERED SYSTEM OUTPUT) * * PURPOSE: THIS ROUTINE DETERMINES THE SESSION (MTM) TERMINAL * &Àþú AND SETS UP A BUFFERED OUTPUT REQUEST (T FIELD=01) * IF ALL THE FOLLOWING CONDITIONS ARE TRUE: * * 1) LU IS NOT ZERO (LU-1=B377) * 2) LU IS DEFINED (NOT GREATER THAN MAX) * 3) EQT IS NOT EQT 0 * 4) ENOUGH SAM IS AVAILABLE FOR THE REQUEST * 5) LU IS UP * * * THIS ROUTINE WILL NEVER CAUSE A REQUEST TO BE * INITIATED (CALL DRIVER) AS ANY PROBLEMS WILL * CAUSE THE NOTRD ROUTINE TO BE ENTERED. THATS A * NO NO AS NOTRD CALLS THIS ROUTINE. * * * IF NO OTHER REQUESTS ARE PENDING, $DLAY IS CALLED * TO CAUSE INITIATION OF THE REQUEST ON THE NEXT * TBG TICK. * * * CALLING SEQUENCE: LDA BUF (1ST WORD IS -LEN, BUFFER FOLLOWS) * LDB ID SEG ADDR OF PROG FOR ECHO * JSB $BFOT * * RETURN (A) IS NOT CHANGED * ALL OTHER REGISTERS MODIFIED * * * THE REQUEST HEADER IS DEFINED AS FOLLOWS: * * NOTE: DON'T MESS WITH THE ORDER. * ****************************************************** BF.HD DEF BF.CN DEFINES START OF THE HEADER * * LINK WORD IS ADDED IN SAM * BF.CN NOP *CONTROL WORD IS PLACED HERE NOP PRIORITY OF REQUEST=0 BF.TL NOP *TOTAL BLOCK LENGTH IS PLACED HERE BF.UL NOP *MESSAGE LENGTH PLACED HERE NOP TRACK NOP AND SECTOR INFO * ****************************************************** * OUTPUT BUFFER FOLLOWS IN SAM * BFCON OCT 40002 BUFFERED WRITE/SFUN=0 BFTM1 NOP BFTM2 NOP BFTM3 NOP * * * $BFOT NOP STA BFTM2 SAVE BUF LOCATION LDA XTEMP,I SAVE CONTENTS OF XTEMP AS STA BFTM3 $ALC WILL ALTER IT IF CALLED. JSB $LU?? FIND SES TERM LU 1 (B=ID ADDRESS) JMP BFEX NOT SES OR MTM\ OR SES LU 1 NOT DEFINED CPA B377 IFîþú LU =0 JMP BFEX WERE ALL DONE. STA STMP2 SAVE SYS LU (LU-1) * * * SESSION LU 1 (OR MTM TERMINAL) IS DEFINED AND IS NOT * LU 0. NOW CHECK FOR : LU > LUMAX AND EQT=0 * * CMA,CLE CHECK FOR AN LU ADA LUMAX GREATER THAN THE SEZ,RSS LARGEST DEFINED LU. JMP BFEX TOO BAD, REJECT REQUEST. * LDB STMP2 RESTORE LU ADB DRT INDEX INTO DRT LDA B,I GET EQT ASSIGNMENT STA BFTM1 SAVE DRT WORD 1 FOR CON WORD WORK * AND B77 CHECK FOR EQT SZA,RSS = ZERO JMP BFEX YEP-- REJECT REQUEST * * * LU IS OK - SET UP BP EQT POINTERS,CHECK FOR DOWN EQT\LU * AND GRAB SOME SAM * * * JSB $CVEQ CONVERT EQT# (IN A) AND SET UP ADDRS LDA STMP2 FETCH LU (LU-1) JSB STADV IS EQT OR LU DOWN? JMP BFEX YES-GO EXIT * * CHECK THE BUFFER LIMIT OF THIS EQT * LDB $BLUP FETCH UPPER LIMIT JSB QCHK AND GO CHECK UPPER LIMIT JMP CKQUE BUFFER LIMIT REACHED-SEE IF ANY SYS REQUESTS PENDI * * ECHO LDA BFTM2,I FETCH LENGTH WORD STA BF.UL SET FOR CALL (INTO HEADER--NOTE: NEG CHAR COUNT) ARS CALCULATE POSITIVE # OF WORDS CMA,INA REQURIED FROM NEG CHAR COUNT STA $LU?? SAVE TRANSFER LENGTH FOR MOVE TO SAM ADA .7 ADD IN REQUEST HEADER STA BF.01 SAVE FOR $ALC CALL JSB $ALC BF.01 NOP REQUEST LENGTH JMP BFEX EXIT- NEVER ENOUGH MEM JMP BFEX EXIT- NO MEMORY NOW STB BF.TL GOT IT- SAVE ACTUAL LENGTH STA TEMP1 SAVE ADDR OF BLOCK(FOR LINK ROUTINE) * * * INITIALIZE TEMP2 AND TEMP3 FOR "LINK" CALL AND * CLEAR E FOR CON WORD WORK. * * CLA,CLE STA TEMP2 PRIORITY OF REQUEST STA TEMP3 THIS IS NOT A DISC REQUEST * * * BUILD THE CONTROL WORD-- ALL THE FIELDS ARE FIXED…Wþú, EXCEPT * FOR THE SUB CHANNEL (SEE BFCON AND WORD2 ROUTINE). * * LDA BFTM1 FETCH DRT ENTRY FOR THIS LU AND B174K GET SUB CHANNEL ELA,RAL SAVE HIGH BIT ("E" CLEARED ABOVE) ALF,RAL AND POSITION THE REST ADA BFCON ADD STANDARD CONTROL WORD FOR BUF OUTPUT SEZ IF HIGH BIT SET ADA B20K SET IT IN CONTROL WORD STA BF.CN AND SAVE IN REQUEST HEADER * * * MOVE REQUEST HEADER TO SAM * * LDA BF.HD FETCH REQUEST HEADER ADDRESS LDB TEMP1 FETCH SAM BLOCK ADDRESS INB 1ST WORD IS DEFINED BY "LINK" MVW .6 MOVE HEADER OUT * * * MOVE MESSAGE BUFFER TO SAM * LDA BFTM2 FETCH BUFFER LOCATION INA ADVANCE PAST LENGTH MVW $LU?? MOVE HER OUT * * * LINK THE REQUEST TO THE EQT AND SET UP FOR * DELAYED INITIATION IF REQUIRED. * * JSB LINK TEMPS 1-3 AND EQT ADDRS ALREADY SET UP SEZ,CLE IF DEVICE IS BUSY- JMP BFOK WERE ALL DONE * LDA EQT1 ELSE, SET UP FOR INITIATION OF REQUEST JSB $DLAY ON NEXT TICK. CLE,RSS SET UP FOR GOOD EXIT * BFEX CCE ERROR EXIT BFOK LDA BFTM2 RESTORE BUFFER ADDR LDB BFTM3 RESTORE SAVED CONTENTS OF XTEMP,I STB XTEMP,I IN CASE $ALC WAS CALLED JMP $BFOT,I AND EXIT * * * THE BUFFER LIMIT HAS BEEN REACHED ON THE SESSION TERMINAL. * TO AVOID THE POSSIBILITY OF EATING UP SAM, ONLY ONE ERROR * ECHO WILL BE STACKED WHILE IN THIS STATE. * IF THE SECOND REQUEST ON THE EQT IS PRIORITY 0 (ZERO), THEN * SKIP THE ECHO AS ONE ERROR HAS BEEN STACKED. THE SECOND * REQUEST IS CHECKED AS THE FIRST ONE IS ASSUMED TO BE THE CURRENT * REQUEST. * * CKQUE LDA EQT1,I FETCH CURRENT ENTRY RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT LDA A,I FETCH SECOND ENTRY RAL,CLE,ERA AND CLEAR POSSIBLE SIGN BIT AGAIN èþú* SZA,RSS IF ONLY ONE REQUEST PENDING- GO ECHO JMP ECHO * ADA .2 ADVANCE TO PRIORITY LDB A,I AND FETCH IT SZB IF NOT ZERO JMP ECHO GO ECHO AS NO SYS ERRORS PENDING JMP BFEX ELSE ABORT ECHO AS ANOTHER ECHO IS STILL PENDING. SKP * * *SUBROUTINE : < $LU?? > (FIND SESSION TERMINAL LU IN SYSTEM LU TERMS) * * PURPOSE * THIS ROUTINE INTERPERTS THE PASSED PROGRAMS ID SEGMENT * LOOKING FOR THE SESSION OR MTM TERMINAL LU IT IS ASSOIATED * WITH. * * * CALLING SEQUENCE: LDB ID SEG ADDR * JSB $LU?? * * RETURN P+1 NOT IN SESSION OR MTM\ OR LU 1 NOT DEFINED (SESSION) * P+2 A=SYS LU (LU-1) OF ASSOIATED TERMINAL * B=LOGICAL ADDRESS OF SST IF SESSION PROG * OR * B=- TERMINAL LU IF MTM PROG * * * * $LU?? NOP SZB,RSS IF ID NOT PASSED ( IF XEQT=0) JMP $LU??,I GET OUT * ADB .32 ADVANCE TO SESSION WORD LDB B,I AND FETCH IT SSB MTM ? (NEG VALUE=MTM PROGRAM) JMP LU3 YES-- PREPARE FOR RETURN * SZB,RSS SESSION PROG (POS NON-ZERO=SESSION) JMP $LU??,I NOPE SO JUST EXIT * * THIS IS A SESSION PROGRAM * * * JSB MPTAB MAP IN TABLE PTN(IF DEFINED) AND STB STMP2 SAVE LOGICAL ADDRESS IN TMP FOR RTN CLA DEFINE SEARCH FOR LU 1 (LU-1) STA REQLU SET FOR SWTCK CALL LDA B,I FETCH LENGTH OF SST JSB SWTCK GO FIND ASSOIATED SYSTEM LU JMP $LU??,I NOT DEFINED GOUT ISZ $LU?? BUMP RTN ADDR LDB STMP2 FETCH LOGICAL ADDR IF SESSION\ NEG LU IF MTM JMP $LU??,I EXIT * * LU3 STB STMP2 SAVE NEG LU FOR RTN CMB SET IT POS - 1 LDA B PREPARE FOR EXIT JMP GOUT * * .32 DEC 32 * * * * DUMMY PARTITION MARþúP ROUTINE ***780224 GLM*** * *MPTAB NOP * JMP MPTAB,I ** * * SKP * * * * * SUBROUTINE : <$PSTE> (POST ERROR TO SESSION CONTROL BLOCK) * * PURPOSE * THIS ROUTINE DETERMINES IF THE SPECIFIED PROGRAM * IS UNDER SESSION AND IF SO, PLACES THE 1ST FOUR * WORDS OF THE SPECIFIED ERROR MESSAGE INTO THE * ERROR BUFFER IN THE SCB. * * * CALLING SEQUENCE: LDA BUFFER ADDRESS * LDB PROG'S ID ADDRESS * JSB $PSTE * * (A) AND (B) ARE RETURNED UNCHANGED * * $PSTE NOP SZB,RSS IF NO ID ADDR SUPPLIED JMP $PSTE,I RETURN * DST STMP1 SAVE BUF AND ID ADDR'S ADB .32 ADVANCE TO SESSION WORD LDB B,I AND FETCH IT SSB,RSS IF NEGATIVE OR SZB,RSS OR ZERO (NOT SESSION) JMP PSTEX RESTORE REGS AND EXIT * * JSB MPTAB MAP IN TABLE PTN IF DEFINED (B= SESSION WORD) ADB $SMER ADD OFFSET TO ERROR PARAMETER (EXTERNAL) * * * MOVE ERROR INTO SCB * * LDA STMP1 FETCH MESSAGE BUFF ADDR INA ADVANCE PAST LENGTH MVW .4 AND MOVE 1ST FOUR WORDS * * PSTEX DLD STMP1 RESTORE REGISTERS JMP $PSTE,I * * SKP * * * * * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # IN LOWER 6 BITS. * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * ™Éþú OF THE ENTRY DESCRIBED BY -EQT1-. * * CALLING SEQUENCE: (P) JSB CPEQT * (P+1) - RETURN - * ON RETURN, (A) = EQT # * (E) = 1 * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. JMP CPEQT,I SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP STA EQT1 INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * * SKP * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPERATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * «Ñþú STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF- * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S DRIVER IS * CALLED WITH A CLEAR REQUEST (CONTROL * WITH ZERO SUBFUNCTION. IF THE DRIVER * ACCEPTS THE REQUEST (A=0 ON RETURN) THEN * EQT1 SIGN BIT IS SET AND A 1 SEC. TIME OUT * IS SET UP. (THIS TIME OUT IS TRAPED BY THE * SYSTEM AND IS NEVER GIVEN TO THE DRIVER). * $ABRT IS CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "$CON1" TO INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE DMA CANNEL) * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. * LDA A,I GET LINK ADDR RAL,CLE,ERA CLEAR SIGN ,SET E IF SIGN WAS SET CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. (TEMP2 = -EQT -1 ON EXIT) * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT,Ð9þú GO (TEMP2 = -EQT -1 ON EXIT) JMP IOCL TO SCAN NEXT ENTRY LIST. * * SCAN ALL DRT WORD 2 I/O QUEUES * LDA LUMAX SET TEMP2 = NEGATIVE CMA,INA NUMBER OF DRT STA TEMP2 ENTRIES. LDA DRT INITIALIZE ADA LUMAX FOR FIRST STA IOC50 DRT WORD IOC41 STA IOC51 TWO. LDA A,I GET LINK RAL,CLE,ERA CLEAR SIGN, SET E IF SIGN SET. CPA TEMP1 JUMP IF A MATCH JMP IOC62 TO A PROGRAM. * SZA IF NOT END OF LIST, JMP IOC41 CONTINUE SCAN. * ISZ IOC50 SET = NEXT LDA IOC50 ADDRESS OF NEXT ISZ TEMP2 DRT WORD 2. JMP IOC41 IF NOT END OF DRT, CONTINUE SCAN. * * SCAN $ELTB ENTRY WORD 3 I/O QUEUES * LDB $ELTB,I GET $ELTB HEADER WORD. SSB,RSS IF NOT_EMPTY BIT NOT SET, JMP IOC6X NOT HUNG ON ANY LIST, OK TO ABORT. (GLM.2013) * RBL,BRS GET RID OF NOT_EMPTY BIT. LDA $ELTB GET TABLE ADDR. ADA .1 GET ADDR OF ADA B 1ST $ELTB ENTRY WORD 3 ADA B IN A. STA IOC50 THEN STORE IT. CMB,INB STORE 2'S COMPLE STB TEMP2 OF TABLE LENGTH. IOC45 STA IOC51 STORE POTENTIALLY RIGHT LINK. LDA A,I GET LINK WORD. RAL,CLE,ERA CLEAR SIGN, SET (E) = SIGN. CPA TEMP1 COMPARE AGAINST ID SEG IN QUESTION. JMP IOC62 JIF MATCH FOUND. * SZA IF NOT END OF CHAIN, JMP IOC45 GO LOOP. * ISZ IOC50 SET (A) = ADDR OF LDA IOC50 NEXT $ELTB ENTRY WORD 3. ISZ TEMP2 IF NOT ALL WORD 3 POINTERS CHECKED, JMP IOC45 GO LOOP. * IOC6X LDA TEMP1 FETCH ID SEGMENT ADDRESS (GLM.2013) JMP IOC63 NOT HUNG ON ANY LIST, OK SKP * * PROGRAM REQUEST FOUND IN DRT OR $ELTB. NOW TO UNLINK IT. * IOC62 LDB A,I GET NEXT LINK, PROPOGATE RBk{þúL,ERB SIGN IF SIGN WAS SET AND STB IOC51,I STORE IN PREVIOUS LINK. * LDA TEMP1 CHECK IF THIS ISZ TEMP1 IS A SYSTEM LDB TEMP1,I REQUEST. SSB,RSS IF SO SKIP ABORT. IOC63 JSB $ABRT 'ABORT PROGRAM' (GLM.2013) JMP $XEQ RETURN. * * PROGRAM REQUEST ENTRY FOUND IN EQT, UNLINK REQUEST. * * EQT#-TEMP2+1 = EQT OF I/O RQ TO ABORT * IOCL2 LDB A,I GET NEXT LINK AND SET RBL,ERB PROPOGATE SIGN IF SIGN SET STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP2 GET THE EQT INVOLVED STA NEQT AND SAVE BECAUSE $ABRT MODIFIES IT(VIA $SYMG) * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING SKIP TO CLEAR DEVICE. JMP $XEQ -EXIT TO $XEQ. SKP JSB $ETEQ JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT * WHAT'S HAPPENING BELOW 'TIL THE NEXT LABEL IS THIS: * IF THE EQT IS DOWN OR FREE, I/O WAS NOT ONGOING, SO THERE IS NO NEED TO * ISSUE THE CLEAR REQUEST. IF THE DRIVER IS BUSY, WE CERTAINLY NEED TO * ISSUE THE CLEAR REQUEST. IF NEITHER, THEN THE DRIVER IS IN DMA-WAIT * STATE. IN THIS CASE, IF THE "D" BIT IS SET IN EQT4, THIS DRIVER AUTO- * MATICALLY GETS DMA AT INITIAL ENTRY: IT DOESN'T SCREW AROUND WITH * DYNAMIC ALLOCATION OF DMA. HOWEVER, IOC NEVER CALLED THE DRIVER FOR * THIS CALL, BECAUSE DMA WAS UNAVAILABLE. HENCE, AGAIN, THERE IS NO NEED * TO ISSUE THE CLEAR REQUEST. IF THE "D" BIT IS NOT SET, IT IS STILL * POSSIBLE THAT THE DRIVER ASKED FOR DMA ALLOCATION FROM ITS CONTINUATION * SECTION (IF SO, THE "DRIVER-EXITED-FROM-CONTINUATION-ûžþúSECTION-TO-GET-DMA" * FLAG, EQT3 BIT 15, WILL BE SET), AND, IN THAT CASE, WE DO NEED TO ISSUE * THE CLEAR REQUEST. IF NEITHER "D" (IN EQT4) NOR "D-E-C-S-G-D" (IN EQT3) * IS SET, THEN THE REASON FOR THE DMA-WAIT STATE OF THE EQT CAN ONLY BE * THAT THE DRIVER REQUESTED DMA FROM THE INITIATION SECTION. IN THIS CASE, * NOTHING WAS STARTED (HOPEFULLY) BY THE DRIVER FOR THIS CALL, AND AGAIN * WE DO NOT ISSUE THE CLEAR REQUEST. LDA EQT5,I GET CURRENT STATUS RAL GET AV BITS IN BITS 15 & 1 SLA,RSS IF DOWN (OR FREE), JMP $XEQ LEAVE THE EQT BE, * SSA,RSS ELSE IF BUSY JMP IOC65 GO ISSUE THE CLEAR, * LDB EQT4,I ELSE IF THE D BIT SSB IS SET, JMP $XEQ LEAVE THE EQT BE, * LDB EQT3,I ELSE IF THE DECSGD SSB,RSS BIT IS CLEAR, JMP $XEQ LEAVE THE EQT BE. * IOC65 LDA EQT5,I MAKE AND MASK THE EQT STA EQT5,I NOT BUSY. * LDB NEQT GET EQT# OF INTEREST ADB EQT# B=EQT# ADB $DVMP NOW INDEX INTO ADB EQT# PART 2 OF DVR MAP TABLE CLA AND CLEAR IT SO THAT THE DVR STA B,I IS ENTERED IN THE SYS MAP ON * FUTURE INTERRUPTS JSB $DRVM SET UP FOR MAPPING LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS ELB,CLE,ERB CLEAR POSSIBLE SIGN (SET BY $DLAY),SAVE E STB EQT2,I RESTORE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND SEZ ENTER DRIVER IN USER MAP? JMP IOCUS YES * JSB B,I ENTER DRIVER IN SYSTEM MAP JMP IOCWT * IOCUS JSB $UIN ENTER DRIVER IN USER MAP, RETURN TO IOCWT * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE~ûþú DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO $CON1 TO GET THE NEXT REQUEST * IOCWT CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR $CON1 (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP $CON1 NO SO JUST GO TO $CON1 * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. JSB $RSM *RESTORE USER MAP TO PRE-DRIVER STATA JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 NOP IOCL6 NOP IOC50 NOP IOC51 NOP MASK OCT 37777 NEQT NOP SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * CLCHS NOP JSB CLDMA CLEAR DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- Rþú ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA CLCSC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? CLCSC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP CLCHS,I YES-EXIT * ISZ CLCSC JMP CLRNX * CLR10 CLC 10B B3.I DEF 3,I N100 DEC -100 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 180 15 * 12 SBL DEF * * ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT * ADA CLCP CONFIGURE THE DUMMY ADDRESSES STA CLC2,I USE INDIRECTS TO AVOID LINKS XOR STCP MAKE STC STA STC2,I STC STA STCP SET IN LINE TOO XOR STFP STF STA STF2,I AND STF STA STFP NEED THIS IN LINE ALSO STCP OCT 4000 SET UP THE PRIV. CARD STFP OCT 600 NOW FOR DISC DRIVERS ETC. NOPRV LDA CLE REPLACE CALL TO HERE STA $YMG+1 WITH A CLE LDB DL.12 GET DEF TO L.012 FOR LDA PDSK DISC PROTECT OPTION SZA PROTECT?? STB DPOPI,I YES, SET IT UP LDB HLT2 PUT HALT 2 IN LOCATION 2 STB 2 AND HALT 3 IN LOCATION 3 CCE,INB OF SYSTEM MAP FOR TRAPPING STB 3 ERRORS LDA $DVPT GET PAGE OF DRIVER PTTN ALF,ALF CONVERT TO LOGICAL ADDR RAL,RAL IOR B1740 FORM ADDR OF USER MAP COPY AREA STA DDVPT,I SAVE LOG ADDR LDA ACLAS CMA,INA STA DDMCL,I SBUF3 LDA SBUF RESTORE A JMP $YMG+1 EXIT INITIALIZATjþúION CODE * * CLE CLE PDSK DEF $PDSK DL.12 DEF L.012 CLCP CLC 0 DPOPI DEF DPOPT STC2 DEF SW1 STF2 DEF STF1 CLC2 DEF SW2 LOCAL DEFS TO AVOID LINKS DDVPT DEF DVPTA DDMCL DEF MCLAS ACLAS DEF $CLAS+0 HLT2 HLT 2 B1740 OCT 1740 * L EQU 165+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER SKP HED ** RTE IV B EQT LOCK CLEARING ROUTINE ** ****************************************************************** * * EQUIPMENT LOCK CLEARING ROUTINE * * $EQCL IS THE EQUIPMENT UNLOCKING ROUTINE. * IT IS CALLED BY THE ABORT PROCESSOR (IN THE DISPATCHER) ON * FINDING ONE OR MORE EQTS. IN THE SYSTEM LOCKED. * * ON NORMAL TERMINATION, THIS ROUTINE * CLEARS THE $ELTB ENTRY FOR THE SPECIFIED EQUIPMENT, * UPDATES THE NOT_EMPTY BIT (IF NEED BE) IN THE TABLE HEADER, * ELEVATES THE PRIORITY OF THE I/O CALLS AT THE LOCKED EQT * (ALL OF WHICH BELONG TO THE LOCKER) TO ZERO, * CALLS THE SCHEDULER TO SCHEDULE ANY PROGRAMS WAITING FOR THIS * EQUIPMENT OR FOR A SLOT IN THE TABLE, * TRANSFERS THE LINKED LIST OF $XSIO REQUESTS HUNG ON THE ENTRY * JUST CLEARED BACK ON THE EQT FOR THAT EQUIPMENT, * RIGHT BEHIND THE ERSTWHILE LOCKER'S ZERO-PRIORITY * CALLS, * CALLS "DRIVR" TO INITIATE THE FIRST $XSIO CALL REHUNG ON THE * EQT, IF THE EQT. WAS IDLE AT THE TIME OF REHANGING, * CALLS "NOTRD" FOR DIAGNOSTIC PROCESSING, IF "DRIVR" MAKES AN * ERROR RETURN, * AND RETURNS TO THE CALLER. * * CALLING SEQUENCE: * LDA ID_SEGMENT_ADDR_OF_TERMINATING_PROGRAM * LDB $ELTB,I * JSB $EQCL * ******************************************************************* * * $EQCL NOP STA TMP STORE ID SEG ADDR OF ABORTING PROG. ELB,CLE,ERB OMIT NOT EMPTY BIT FROM TABLE HEADER. STB T4 STORE TABLE LENGTH. LDA $ELTB GET TABLE ADÛæþúDR. ADA .1 GET ADDR OF 1ST EQT.# IN TABLE. STA TB STORE IT. ADA B GET ADDR OF 2ND WORDS OF TABLE ENTRIES. STA T1 STORE IT. CMB,INB COMPUTE 2'S COMPLE OF #_OF_ENTRIES, STB T2 AND STORE IT HERE. CLA INITIALIZE STA T6 #_OF_EMPTIES. EQC10 LDB T1,I GET ID SEG ADDR FROM TABLE. RBL,CLE,ERB (E)= LOCK_ON_ABORT, (B)= ID SEG ADDR. LDA TB,I LOAD NEXT EQT. # IN TABLE. SZA,RSS IF A BLANK ENTRY IS ENCOUNTERED, ISZ T6 BUMP #_OF_EMPTIES. CPB TMP IF THIS EQT. IS LOCKED TO OUR MAN, JMP EQC30 GO LOOK INTO THE SITUATION. * EQC20 ISZ TB INCREMENT TO NEXT ENTRY'S 1ST WORD. ISZ T1 INCREMENT TO NEXT ENTRY'S 2ND WORD. ISZ T2 IF NOT ALL ENTRIES COMPARED YET, JMP EQC10 LOOP BACK. * LDA T6 GET TOTAL #_OF_EMPTIES IN TABLE. CPA T4 COMPARE WITH TABLE LENGTH. RSS IF TABLE NOT EMPTY, JMP $EQCL,I RETURN W/O CLEARING NOT_EMPTY BIT. * LDA $ELTB,I GET TABLE HEADER WORD. ALR,RAR CLEAR NOT_EMPTY BIT, STA $ELTB,I AND RESTORE. JMP $EQCL,I THEN RETURN. * EQC30 ADB .20 GET ADDR OF FLAG WORD IN ID SEG. LDA B,I ISOLATE THE NORMAL_TERM. FLAG AND .2 THAT WAS SET IN "MPT1". SZA IF NORMAL TERMINATION, JMP EQC40 GO DO THE FULL UNLOCK. * SEZ,RSS ELSE, IF LOCK_ON_ABORT NOT SET, JMP EQC40 GO DO THE FULL UNLOCK. * STA T1,I ELSE, CLEAR ONLY WORD 2 (ID SEG ADDR). JMP EQC20 THEN LOOK FOR MORE LOCKS. * EQC40 LDA TB,I FIRST PRESERVE STA T3 EQT. # TO BE UNLOCKED. LDA TB THEN PRESERVE ADDR OF STA T7 ENTRY FOR SEMAPHORING. CLB CLEAR THE STB A,I 1ST WORD. ADA T4 COMPUTE ADDR OF EN®tþúTRY'S 2ND WORD. STB A,I CLEAR 2ND WORD. ADA T4 COMPUTE ADDR OF ENTRY'S 3RD WORD. LDB A,I GET THE 3RD WORD (LIST POINTER), STB T8 AND PRESERVE IT. CLB THEN CLEAR STB A,I THE 3RD WORD ALSO. * ISZ T6 BUMP #_OF_EMPTIES FOR BLANK CREATED. * CCA GET ADDR OF LOCKED EQUIPMENT'S EQT ADA T3 ENTRY'S "PENDING I/O CALLS POINTER" MPY .15 WORD (VIZ., WORD ZERO IN THE ADA EQTA EQT ENTRY). STA TA STORE POINTER WORD ADDR HERE, STA TC AND HERE. EQC75 LDA TA,I GET ADDR OF NEXT ENTRY IN CHAIN. SZA,RSS IF END OF LIST, JMP EQC80 THAT'S WHERE TO HANG $XSIO PENDING. * ELA,CLE,ERA GET RID OF "I/O CLEARED" FLAG. STA TA STORE CURRENT ENTRY ADDR. INA 2ND WORD HAS "REQUEST TYPE LDB A,I IDENTIFIER" IN BITS 14-15. INA 3RD WORD POTENTIALLY HAS PRIORITY. RBL GET BUFFERED/UNBUFFERED (1/0) IN 15. SSB,RSS IF UNBUFFERED, JMP EQC75 IT'S SOMEONE ELSE'S PRE-LOCK REQ. CLB CHANGE REQUEST PRIORITY TO ZERO STB A,I TO FLUSH IT OUT BEFORE ANYTHING ELSE. JMP EQC75 LOOP TO DO LIKEWISE TO ALL HIS CALLS. * EQC80 LDA T7 GET $ELTB ENTRY ADDR. JSB $SCD3 SCHEDULE ANY WAITERS_FOR_THIS_EQT. LDA $ELTB GET TABLE HEADER ADDR. JSB $SCD3 SCHEDULE WAITERS_FOR_A_PLACE_IN_TABLE. LDA T8 GET POINTER TO $XSIO LINKED LIST. STA TA,I REHANG IT ON THE EQT. SZA,RSS IF THERE WERE NO $XSIO CALLS, JMP EQC20 SKIP POTENTIAL "DRIVR" CALL. * LDB TA IF THERE IS (ARE) USER CALL(S) CPB TC ALREADY QUEUED AHEAD OF RSS THE $XSIO CALL(S) JMP EQC20 AGAIN NO NEED TO CALL "DRIVR". * LDA T3 GET EQT.# TO INITIATE I/O FOR, ·éþúJSB $CVEQ AND GO SET UP EQT1-15. JSB DRIVR GO INITIATE I/O. JMP EQC20 THEN LOOK FOR MORE LOCKS. * LDA EQC20 ERROR, SO PASS RETURN ADDR STA XSIOE TO DIGNOSTIC PROCESSOR, JMP NOTRD AND JUMP TO HIM. * * .20 DEC 20 TMP NOP ID SEG ADDR OF TERMINATING PROGRAM T1 NOP ADDR OF CURRENT ID SEG ADDR IN $ELTB T2 NOP 2'S COMPLE OF #_OF_COMPARES_YET_UNDONE T3 NOP EQT. # CURRENTLY BEING UNLOCKED T4 NOP TABLE LENGTH T6 NOP CURRENT # OF EMPTIES IN TABLE T7 NOP ADDR OF CURRENT LOCKED EQT.'S ENTRY T8 NOP POINTER TO $XSIO LINKED LIST TA NOP ADDR OF CURRENT EQT LINK TB NOP ADDR OF CURRENT EQT.# IN $ELTB TC NOP ADDR OF 1ST EQT LINK (I.E., EQT1) HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT AG#ˆ†‚DDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 RQP9 EQU .+32 9 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) * ORG * LENGTH OF RTIOC END $CIC0 þuˆÿÿ ÿý%p– ÿ92067-18108 2001 S C0422 &EXEC4 EXECUTIVE             H0104 V&þúASMB,R,L,C,Q ** RT EXEC CENTRAL CONTROL MODULE ** HED ** REAL-TIME EXECUTIVE CENTRAL CONTROL MODULE ** * NAME: EXEC * SOURCE: 92067-18108 * RELOC: PART OF 92067-16102 * PGMR: G.A.A., L.W.A., C.M.M., G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EXEC4,0 92067-16102 REV.2001 790917 * SUP PRESS EXTRANIOUS LISTING ****************************************************************** * HISTORY * * * ***G.A.A. RTE 2 VERSION JULY 1973 ***L.W.A. RTE 3 VERSION APRIL 1975 ***C.M.M. RTE 4 VERSION JANUARY 1978 * ***************************************************************** * * * ENT $ERMG,$RQST,$OTRL,$USER ENT $DREQ,$DREL,$SDRL,$SDSK ENT $ERRA,$REIO,$CREL,$RSRE,$ABRE ENT $PDSK,$ABXY,$CALL ENT $PWR5,$MVBF,$SGAF ENT $LEND,$DHED,$LBR,$LBX,$XEX ENT $EX4,$EX5,$EX8,$EX15,$EX16 * EXT $CNV3,$SYMG,$LIST,$XEQ,$PVCN,$PSTE EXT EXEC,XLUEX,$LIBR,$LIBX,$IDLE,$PVST EXT $RENT,$CVEQ,$ABRT,$DMS,$IDEX EXT $TRRN,$SCLK,$ALC,$RTN EXT $MATA,$IDNO EXT $MRMP,$PBUF EXT $MNP,$MPFT,$PERR,$CNV1 * * $PDSK EQU 0 DEFINE DEFAULT FOR DISC PROTECT * ***** < EXEC > PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECUTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKجþúNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- * QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOS ûþúTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PROGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * SKP ************MEU INSTRUCTIONS***************** *EXEC NOP * HLT 0 PROTECTION AGAINST DIRECT CALL. * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! (ADDRESS OF INTERUPT) CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STB $LIBR SAVE (P+1) OF ISZ $LIBR CALL. (JUST LIKE A REAL SUBROUTINE CALL) * STB XSUSP,I SAVE AS POINT OF SUSP IN ID SEG XLA B,I GET WORD. STA INSTR SAVE THE OFFENDING INSTRUCTION. AND B074K ISOLATE INSTR. CODE. CPA JSBI IF INSTRUCTION IS JSB JMP *+2 (RSS) CHECK OPERAND ADDRESS. JMP MPERR -MEMORY PROTECT ERROR- LDA INSTR CHECK FOR EFFECTIVE AND B2000 ADDRESS SZA LINK THRU CURRENT PAGE? LDA B YES, USE CURRENT PAGE BITS XOR INSTR MIRGE THE PAGE OFFSET AND G76 UNDER THE RULES OF WOO. XOR INSTR NOW HAVE THE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT INDR XLA A,I GET NEXT LEVEL RAL,CLE,SLA,ERA CHECK FOR MULTI LEVEL JMP INDR FOUND ONE SO LOOP (MUST END) * SFC 5 IS THE VIOLATION MP OR DM ? JMP CHKDM A DM VIOLATION * CPA EXECA MP VIOLATION. SEE IF ITS A JSB EXEC JMP R0 YES, REQUEST TO BE ANALYSED. * ***780302 GLM * CPA XLUAD SEE IF ITS A JSB XLUEX JMP RR YES, REQUEST TO BE ANALYSED * CPA LIBRA -LIBRARY ROUTINE CALLING FOR JMP LIBRC RE-ENTRANT OR PRIVILEGED RUN. CPA LIBXA -LIBRARY ROUTINE RETURNING JMP LIBXC TO CALLER. JMP MPERR A MP ERROR ! FLUSH HIM ! * * CHECK FOR USER CALL TO LIBRARY PROGRAM * CHKDM LDB XMATA GET THE CURRENT MATA E-*þúNTRY SZB IS THIS A MEMORY RES PROGRAM ? JMP MPERR NO, SO FLUSH HIM ! * STA B SAVE OPERAND ADDRESS. LDA LBORG SUBTRACT LIBRARY CMA,CLE,INA AREA ORIGIN FROM ADA B OPERAND ADDRESS. LDA B (E = 0 IF SYSTEM VIOLATION ) CMA,SEZ,CLE,INA SKIP IF VIOLATION ALREADY ELSE ADA $LEND TEST FOR ABOVE LIB. SEZ,RSS IF NOT CALL TO LIBRARY RESIDENT, JMP MPERR THEN VALID DMS ERROR. LDA $LIBR -CALL TO LIBRARY. XSA B,I SET (P+1) ADDRESS OF JSB INTO THE ADB D2 1ST WORD OF SUB.(JUST LIKE NORMAL CALL) STB $LIBR PUT P+1 OF JSB $LIBR INTO $LIBR ALSO JMP LIBRC - TRANSFER TO $LIBR SECTION $LEND NOP END OF MEMORY RES LIB $SGAF NOP SPC 1 JSBI JSB 0 B074K OCT 074000 G76 OCT 76000 EXECA DEF EXEC+0 A DIRECT ADDRESS XLUAD DEF XLUEX+0 ANOTHER DIRECT ADDRESS $CALL NOP RQP1A DEF RQP1 INSTR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 * * * $CALL IS SET UP TO DEFINE THE TYPE OF CALL BEING PROCESSED * * IF EXEC, $CALL > 0 * IF XLUAD, $CALL < 0 * * * ANALYZE SYSTEM REQUEST (A VALID JSB XLUEX) * RR CCA SET NEG TO INDICATE XLUEX ENTRY * * ANALYZE SYSTEM REQUEST (A VALID JSB EXEC) * R0 STA $CALL SAVE ENTRY IDENTIFIER XLA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 IS GREATER CLA,SEZ THAN JMP RQERR 8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 Ëfþú STA RQP7 AREA STA RQP8 STA RQP9 * LDA RQP1A SET TEMP2 = STA TEMP2 ADDRESS OF RQP1 IN BASE PAGE STA TEMP3 SAVE FOR CALL BY NAME TEST R1 LDA $LIBR GET EFFECTIVE OPERAND ADDRESS. R1D1 XLA A,I FIRST LEVEL TO A SZA IF THROUGH A CPA D1 OR B JMP RQERR BAD NEWS FELLOW! * RAL,CLE,SLA,ERA REMOVE INDIRECT BIT,SKIP IF DIRECT JMP R1D1 STILL INDIRECT GO TRY AGAIN. * STA TEMP2,I SET IN BASE PAGE. ISZ TEMP2 INDEX ISZ $LIBR ADDRESSES AND INB,SZB PARAMETER COUNT. JMP R1 - CONTINUE - SKP * CHECK LEGALITY OF REQUEST CODE * XLA RQP1,I GET REQUEST CODE STA RQP1 SAVE FOR NOW LDB XEQT COMPUTE ADB D15 THE STATUS WORD ADDRESS XOR B,I MERGE ABORT AND NO-SUSP BITS FROM AND B140K THE REQUEST CODE INTO STATUS WORD XOR B,I UNDER THE RULE OF WOO STA B,I UPDATE STATUS WORD IN THE ID SEGMENT AND B140K GET ABORT AND NO-SUSPEND OPTION BITS SZA IF EITHER OPTION SELECTED ISZ RQRTN STEP THE RETURN ADDRESS LDA RQP1 GET REQUEST CODE AND C140K =37777B CLEAR OPTION BITS STA RQP1 AND SAVE THE REQUEST CODE SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED SSA,RSS -THEN JMP RQERR TOUGH LUCK, YOUR A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS SZA,RSS IF THIS REQUEST ILLEGAL JMP RQERR SEND ERROR MESSAGE * STA INSTR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD LDË9þúB RQCNT GET THE NUMBER OF PRAMS TO CMB,SEZ,RSS TEST SET COUNT ALF,ALF ROTATE IF ODD REQUEST CODE STB TEMP1 SET PRAMETER COUNT * R3 ISZ TEMP3 STEP THE PRAMETER ADDRESS LDB TEMP3,I GET THE ADDRESS ISZ TEMP1 SKIP IF END OF LIST CMB,CLE,RSS SET UP FOR TEST AND SKIP JMP INSTR,I GO EXERCISE THE REQUEST SLA,RAR IF FLAG NOT SET THEN ADB FENCE SKIP THE ADD CLB,SEZ,RSS SET B FOR ERROR SKIP IF ERROR JMP R3 NO ERROR GO TEST NEXT PRAM * LDA RQ1 SET A FOR ERROR JMP $ERRA GO SEND 'RQ00' ERROR * * P22 DEC 22 P12 DEC 12 P14 DEC 14 P11 DEC 11 P24 DEC 24 P23 DEC 23 P10 DEC 10 P9 DEC 9 P8 DEC 8 P7 DEC 7 P6 DEC 6 * D1 DEC 1 D2 DEC 2 D5 DEC 5 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D25 DEC 25 D26 DEC 26 D29 DEC 29 D32 DEC 32 DM1 DEC -1 DM32 DEC -32 B140K OCT 140000 C140K OCT 37777 CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION PROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * ªþú - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PROGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * LIBRA DEF $LIBR+0 A DIRECT ADDRESS * *$LIBR NOP * SJP $LBR $LBR STA XA,I DIRECT ENTRY MUST BE PRIV & GOING DEEPER XLA $LIBR,I MAKE SURE SZA AND IF GOING REENTRANT JMP MPERR SEND SOUTH INSTEAD.(FLUSH HIM !!) * LDA $PVST GET THE STATUS HE CAME IN WITH RAL,RAL AND SET IT UP FOR THE RETURN STA $PVST * LIBRX LDA XA,I RESTORE THE A REGISTER & RETURN ISZ $LIBR SET RIGHT ADDRESS ISZ $PVCN AND STEP THE DEPTH COUNTER JRS $PVST $LIBR,I SET UP CORRECT MAP AND RETURN TO CALLER. * LIBRC XLB $LIBR,I GET (P+2) OF -$LIBR- CALL. SZB,RSS IF (P+2) = 0, THEN CALLED PROGRAM JMP PVEXC IS IN 'PRIVILEGED' FORMAT. * STB TEMP1 SAVE -TDB- ADDRESS. XLA B,I GET WORD 1 OF DATA BLOCK. LDA A,I GET ID SEG ADDRESS OR ZERO RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT SZA,RSS IS THE TDB FREE ? JMP LIBR1 YES GO SET IT UP. CPA XEQT DOES SAME PROG ALREADY OWN IT ? JMP ERE01 RECURSIVE ENTRY !! FLUSH HIM !!! INB ALREADY OWNED, SO GET THE TDB LENGTH XLA B,I TO THE AE‡þú REG LIBR1 ADA D4 USE JUST FOUR WORDS (OR ADD 4 WORDS) STA TEMP4 SAVE LENGTH FOR ALLOCATE CALL LDB $DHED GET POINTER TO HEAD OF RENT LDA XEQT LIST ADA D20 CHECK IF ALREADY IN LIST STA TEMP3 SAVE ID-SEG POINTER LDA A,I GET THE STATUS WORD ALF,RAL BIT 10 IS RENT BIT SSA,RSS IF CLEAR THEN THIS IS FIRST ENTRY JMP RE2 SO GO SET UP * LDB XEQT NOT FIRST ENTRY SO FIND OTHERS JSB FINDL USING FINDL ROUTINE JMP ERE01 LIST ERROR ABORT THE PGM ADB D3 STEP TO SUB QUE HED RE2 STB TEMP2 SET POINTER TO LIST HEAD * JSB $ALC ALLOCATE THE MEMORY TEMP4 NOP NUMBER OF WORDS REQUIRED JMP NVRM IF NEVER ANY MEMORY, TRY 4 ONLY JMP LB05 NO MEMORY NOW, SUSPEND. CCE ALLOC DONE. * CPB TEMP4 DID WE GET THE REQUESTED NUMBER? B40 CLE YES CLEAR E AS A FLAG * LDB TEMP2,I GET OLD POINTER STA TEMP2,I SET NEW BLOCK ADDRESS STB A,I LINK OLD BLOCKS INTO THE LIST LDB XEQT GET THE ID-SEG ADDRESS SEZ,INA STEP A AND SKIP IF EXACT ALLOCATION ADB SIGN ELSE ADD SIGN BIT TO ID-ADDRESS STB A,I SET IN WORD 2 STA TEMP4 SET TDB ADDRESS POINTER INA SET TO WORD 3 ADDRESS LDB TEMP1 SET TDB ADDRESS IN WORD THREE STB A,I INA CLEAR CLB WORD STB A,I FOUR * XLB TEMP1,I IF BLOCK AVAILABLE THEN SZB,RSS SKIP THE JMP RE4 MOVE * SEZ,INA SET A TO SAVE BLOCK ADDRESS INA (EXTRA WORD USED IN ID-EXTENSION) LDB TEMP1 DIG THE TDB SIZE OUT CLE,INB OF THE TDB XLB B,I AND SET IN B JSB MTDB MOVE OUT THE TDB RE4 LDA TEMP4 GET THE ADDRESS OF THE ID-SEG. ADDRESS XSA TEMP1,I AND SET IN THE¸aþú TDB LDA TEMP3,I GET THE ID-STATUS WORD IOR B2000 SET THE RENT BIT STA TEMP3,I RESTORE THE WORD LDB TEMP1 (B) = ADDR. OF TDB. ADB D2 SET LDA $LIBR (P+1) ADA DM2 OF ORIGINAL XLA A,I CALL IN XSA B,I WORD 3 OF TDB IN PROGRAM. ISZ $LIBR SET TO FIRST INSTR IN LIB. PROG. * LDB $LIBR SET RETURN ADDRESS STB XSUSP,I IN THE ID-SEG. JMP $RENT RETURN TO THE DISPATCHER * SKP * * REJECT SECTION CAUSED BY NO MEMORY * AVAILABLE FOR -TDB-. CALLING USER PROGRAM * IS SUSPENDED BACK TO POINT OF CALL AND * LINKED INTO MEMORY SUSPENSION LIST. * NVRM LDA D4 NEVER ENOUGH MEMORY, REQUEST 4 NEXT TIME STA XTEMP,I LB5 JSB $LIST SUSPEND OCT 504 PROGRAM JMP $XEQ TRANSFER TO EXECUTE SECTION. * LB05 LDA $LIBR BACK UP TO ADA DM2 THE ENTRY POINT. XLB A,I SUBTRACT ONE FROM THE RETURN ADB DM1 ADDR TO GET ADDR OF THE CALL. STB XSUSP,I POST THIS ADDR AS SUSP.POINT. JMP LB5 SUSPEND PROGRAM FOR MEMORY. * * * INITIATE PRIVILEGED EXECUTION OF USER PROGRAM * PVEXC EQU * RESTORE REGISTERS. LDB XI GET X,Y TO A,B XLA B,I CAX INB XLA B,I CAY NOTMX LDA XEO,I CLO SLA,ELA STF 1 LDB XB,I * LDA $DMS GET THE DMS STATUS @ INTERUPT STA $PVST AND SET FOR RETURN * JMP LIBRX GO GET A AND EXIT * HED RENT SUBROUTINES * MTDB MOVES A TDB TO SYSTEM MEMORY AND UPDATES THE LINKAGES * AS REQUIRED. * * CALLING SEQUENCE: * * TEMP6 = NUMBER OF WORDS REQUIRED (IF ALLOCATION) * TEMP1 = ADDRESS OF TDB TO BE MOVED * A = CORE ADDRESS (FROM $ALC ) * B = NUMBER OF WORDS ALLOCATED (FROM $ALC ) * E = 0 IF MEMORY IS ALREADY ALLOCATED * = 1 IF TEMP6 IS SET AND A AND B ARE NOT. *  ’þú* THE SECOND WORD OF THE SAVE AREA IS SET TO THE CONTENTS * OF B WHILE THE SECOND WORD OF THE TDB DETERMINS HOW * MANY WORDS TO MOVE. * * TEMP USAGE IN THIS ROUTINE IS: * * AHLD DESTINATION ADDRESS * TEMP7 ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,I) * MTDB NOP SEZ,RSS IF NO ALLOCATE OPTION JMP MTDB2 SKIP ALLOCATE CALL * JSB $ALC GET THE MEMORY TEMP6 NOP JMP MTDB0 NEVER ANY MEMORY JMP LB5 NO MEMORY NOW, SUSPEND PROG * MTDB2 STA AHLD SET UP DESTINATION POINTER XLA TEMP1,I SAVE THE ID-EXTENSION ADDRESS STA TEMP7 LDA TEMP1 GET THE TDB ADDRESS STA AHLD,I AND SET IT IN THE SAVE AREA. ISZ AHLD STEP TO WORD TWO STB AHLD,I AND SET ACTUAL COUNT ADB DM2 ADJUST COUNT FOR MOVE CBX AND SET FOR MWW ADA D2 ADJUST THE FROM ADDRESS LDB AHLD GET THE TO ADRESS INB ADJUST TO ADDRESS MWF MOVE BLOCK FROM USER TO SYS MAP. * CLA XSA TEMP1,I SET THE TDB "FREE" LDB TEMP7,I GET THE ID-SEGMENT ADDRESS FOR RBL,CLE,ERB THE OWNING PROGRAM ADB D20 INDEX TO THE STATUS WORD LDA B,I FETCH IT AND SET IOR B4000 THE RENT MEMORY MOVED STA B,I BIT ISZ TEMP7 STEP TO THE TDB POINTER ADDRESS LDA AHLD GET THE NEW LOCATION ADA C100K SUBTRACT ONE AND ADD SIGN STA TEMP7,I AND SET IN THE EXTENSION. MTDBX JMP MTDB,I NOW RETURN AHLD NOP 1 * MTDB0 CLA NEVER ANY MEMORY CLB RETURN (A)=0, (B)=0 JMP MTDBX SPC 2 * FINDL FINDS A ID-EXTENSION GIVEN THE ID-SEGMENT ADDRESS * * CALLING SEQUENCE: * * LDB ID-SEG ADDRESS * JSB FINDL * NOT FOUND RETURN * FOUND RETURN B = ADDRESS OF EXTENSION,TEMP5 = ADDRESS OF * PREVIOUS BLOCK IN THE LIST (FOR UNLINKINû0þúG). * E = 0. * * TEMP USAGE: * * TEMP5 = LAST POINTER * TEMP6 = ID-SEGMENT ADDRESS * FINDL NOP STB TEMP6 SAVE THE ID-SEGMENT ADDRESS LDB $DHED GET THE HED OF THE LIST ADDRESS FIND1 STB TEMP5 SET LAST POINTER LDB B,I GET THE ADDRESS OF THE EXTENSION SZB,RSS END OF LIST? JMP FINDL,I YES- MAKE NOT FOUND RETURN LDA B ADDRESS TO A INA STEP TO THE ID-ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT CPA TEMP6 THIS IT? CLE,RSS YES RETURN E = 0 JMP FIND1 NO TRY NEXT ENTRY ISZ FINDL STEP TO TRUE RETURN JMP FINDL,I RETURN SKP * RTN4 RETURNS THE FOUR WORD ID-EXTENSION AND CAN CLEAR * THE PROGRAMS RENT BIT * * CALLING SEQUENCE: * * TEMP2 = ADDRESS OF THE FOUR WORD BLOCK * E = 0 IF THE RENT BIT IS TO BE CLEARED. * TEMP1 = ADDRESS OF THE TDB (TO SET FIRST WORD TO ZERO) * JSB RTN4 * * TEMP USAGE: * TEMP2 AS ABOVE * TEMP3 NUMBER OF WORDS TO RETURN * TEMP1 AS ABOVE * RTN4 NOP LDA TEMP2 GET BLOCK ADDRESS INA INDEX TO ID SEG ADDRESS LDB A,I GET ID-SEG ADDRESS LDA D4 SET A TO THE REQUEST LENGTH RBL,SLB,ERB IF WE GOT 4 SKIP INA ELSE SET TO 5. STA TEMP3 SET RETURN LENGTH SSB IS RENT BIT CLEAR REQUESTED? JMP RTNA NO SKIP ADB D20 YES INDEX TO THE BIT LDA B,I GET THE WORD XOR B2000 ZAP THE BIT STA B,I RESET THE WORD RTNA CLA CLEAR THE TDB FLAG XSA TEMP1,I JSB $RTN RETURN THE MEMORY TEMP2 NOP TEMP3 NOP JMP RTN4,I RETURN SPC 2 $DHED DEF *+1 NOP HED OF ID-EXTENSION LIST DM3 DEC -3 D20 DEC 20 B4000 OCT 4000 B2000 OCT 2000 SIGN DEF 0,I HED $REIO RENT I/O PROCESSOR «›þúROUTINE * $REIO MOVES TO SYSTEM MEMORY THE TDB CONTAINING THE * REFERENCED ADDRESS - IF ANY. THIS ROUTINE IS CALLED * BY RTIOC TO ALLOW I/O FROM A RE-ENTRENT ROUTINE. * * CALLING SEQUENCE * * LDB BUFAD BUFFER ADDRESS IN B. * JSB $REIO * ON RETURN B IS THE NEW BUFFER ADDRESS, E IS SET. * * TEMP USAGE: * * TEMP1 = TDB ADDRESS * TEMP3 = NEG. OF PASSED BUFFER ADDRESS * TEMP4 = NEXT ENTRY POINTER. * TEMP5 = TDB PTR ADDRESS IN ID-EXTENSION * $REIO NOP CMB,INB SET BUFFER ADDRESS NEGATIVE FOR TESTS. STB TEMP3 TEST AND SAVE IT CLB STB $MVBF CLEAR MOVE TO REENT MEM FLAG LDB XEQT GET THE ID-ADDRESS JSB FINDL AND SO THE ID-EXTENSION JMP REIO2 NOT FOUND - EXIT * REIO1 LDA B SET ADDRESS IN A TOO SZB,RSS IF END OF LIST JMP REIO2 EXIT WITH SAME ADDRESS * SEZ,RSS FIRST POINTER IS ADA D3 + 3 STA TEMP4 REST ARE STANDARD LINK ADB D2 INDEX TO THE TDB ADDRESS STB TEMP5 SAVE THE TDB ADDRESS LDA B,I TDB ADDRESS TO A RAL,CLE,SLA,ERA CLEAR MOVED FLAG, SKIP IF NOT LDA A,I IF MOVED,GET TRUE TDB ADDRSS STA TEMP1 SAVE FOR MTDB ROUTINE * LDB A PUT IN A TOO SO CLE,INA WE CAN INDEX TO LENGTH XLA A,I NOW GET THE LENGTH OF THE TDB ADB TEMP3 ADD IN NEG OF PASSED BUFFER ADDRESS SEZ,CLE,RSS E SET =>BELOW TDB SO SKIP ADB A ADD TDB LENGTH LDB TEMP4,I GET THE NEXT ENTRY TO B SEZ,CCE,RSS E=0 IF NOT IN THE TDB. JMP REIO1 TRY NEXT TDB HE OWNS.(PERHAPS WRONG TDB) * STA TEMP6 FOR MTDB LDA TEMP5,I IF ALREADY MOVED XLB TEMP1,I THEN SKIP SZB MOVE AND USE CURRENT POINTER JSB MTDB GO MOVE THE TDB RAL,CLE,ERA CLEAR THE SIGN BIT (A = ADDR OF MOVED TDB) LDB A,I a2NLHOLD TDB ADDRESS TO B CMA,INA NEG. OF NEW ADDRESS TO A STA $MVBF SET MOVED TDB TO SAM FOR RTIOC ADB A NEG. OF OFFSET TO B REIO2 ADB TEMP3 NEG OF NEW BUFFER ADDRESS TO B CMB,CCE,INB SET POSITIVE AND SET E. JMP $REIO,I RETURN TO CALLER $MVBF NOP MOVED TDB TO SAM FLAG FOR RTIOC ¸˜Nÿÿþú HED RESTORE MOVED TDB'S FOR CURRENT PROGRAM * $RSRE MOVES BACK ANY TDB MOVED OUT BY CONTENDING PROGRAMS * THIS ROUTINE IS CALLED BY THE DISPATCHER WHEN IT IS * ABOUT TO DISPATCH A PROGRAM AND THE RENT MEMORY * MOVED BIT IS SET IN THE PROGRAMS ID-SEGMENT. * * CALLING SEQUENCE: * * SET UP BASE PAGE (XEQT ETC.) * JSB $RSRE * * ON RETURN THE PROGRAM IS READY TO RUN * * IF MEMORY IS NEEDED BUT NOT AVAILABLE THE PROGRAM IS * MEMORY SUSPENDED AND RETURN IS TO $XEQ. * * TEMP USAGE: * * TEMP1 = TDB POINTER * TEMP3 = THE FROM ADDRESS * TEMP6 = # WORDS FOR ALLOCATION * TEMP4 = MOVE COUNTER * TEMP5 = RETURN MEMORY ADDRESS * TEMP9 = RETURN # WORDS * $RSRE NOP RSRE1 LDB XEQT GET THE ID-SEGMENT EXTENSION JSB FINDL JMP RSRE3 NOT FOUND GO EXIT * RSRE2 ADB D2 INDEX TO THE TDB ADDRESS LDA B,I GET THE TDB ADDRESS TO A SSA IF NOT MOVED OUT THEN SKIP JMP RSRE4 ELSE GO MOVE BACK * SEZ,CCE,INB GET ADDRESS OF NEXT BLOCK ADB DM3 TO B LDB B,I SZB IF ZERO THEN DONE JMP RSRE2 ELSE GO TEST NEXT ONE * RSRE3 LDB XEQT GET THE ID-ADDRESS ADB D20 AND REMOVE LDA B,I THE MEMORY XOR B4000 MOVE REQUIRED BIT STA B,I RESET THE WORD JMP $RSRE,I RETURN AND RESTORE MEU STATUS * RSRE4 RAL,CLE,ERA CLEAR THE SIGN BIT AND STA TEMP5 SAVE THE ADDRESS STB TEMP3 SET THE FORM ADDRESS LDB A,I GET THE TDB ADDRESS STB TEMP1 SET THE TDB ADDRESS INA STEP TO THE ALLOCATED COUNT LDA A,I GET AND STA TEMP9 SET FOR RETURN CALL XLA B,I GET THE OWNER INB AND THE XLB B,I COUNT. STB TEMP6 SET COUNT FOR ALLOCATION ADB DM2 SET UP THE MOVE COUNT STB TEMP4 SAVE IT CC^þúE,SZA SKIP IF SUBROUTINE IS FREE JSB MTDB MOVE THE OTHER USER TO SYS. MEM. * LDB TEMP4 PUT MOVE COUNT IN CBX X CCB ADB TEMP3 BACK UP TO THE ID ADDRESS IN THE EXTENSION XSB TEMP1,I SET IN THE TDB TO SHOW OWNER LDB TEMP1 SET UP ID-EXTENSION STB TEMP3,I LDA TEMP5 GET ADDRESS OF MEMORY ADA D2 ADJUST FOR MOVE ADB D2 ADJUST TO ADDRESS ALSO * MWI MOVE FROM SYS TO USER * JSB $RTN RETURN THE MEMORY TEMP5 NOP TEMP9 NOP JMP RSRE1 GO TRY AGAIN HED ABORT PROCESSOR FOR PROGRAM ABORTED IN A RENT SUBROUTINE * $ABRE CLEANS UP MEMORY ALLOCATION AND OWNERSHIP FLAGS * FOR A PROGRAM ABORTED (OR TERMINATED) WHILE IN A REENTRENT * SUBROUTINE. * * CALLING SEQUENCE: * * A=0 IF DISC RESIDENT * A#0 IF CORE RESIDENT * * LDB ID-SEG ADDRESS * JSB $ABRE * * TEMP USAGE: * * TEMP2 = ADDRESS OF 4 WORD ID EXTENSION * TEMP4 = NEXT ID-SEG EXTENSION * TEMP6 = ID ADDRESS (FROM FINDL) * TEMP1 = TDB ADDRESS * TEMP7 = MEMORY ADDRESS * TEMP8 = # WORDS TO RETURN * TEMP9 = CORE RESIDENT FLAG (PASSED IN A) * SAVER = ID-SEGMENT ADDRESS SAVE WHILE RN RELEASE CALLED * $ABRE NOP STA TEMP9 SAVE THE RESIDENCY FLAG LDA B ADA D20 ADVANCE TO FATHER PTR LDA A,I ALF,RAL TEST REENTRANT BIT SSA SEARCH ONLY IF NEED TO. JSB FINDL DOES HE HAVE ANY? JMP ABRX NO EXIT * LDA B,I YES UNLINK FROM LIST STA TEMP5,I ABRE1 STB TEMP2 SET ID-EXTENTION ADDRESS CLA,SEZ,RSS COMPUTE ADDRESS LDA D3 OF NEXT ENTRY ADA B IN THE PROGRAMS LIST LDA A,I AND SAVE STA TEMP4 IT * ADB D2 INDEX TO THE TDB ADDRESS LDA B,I FETCH IT RAL,CLE,SLA,ERA CLEAR MOVED BIT, SKIP IF NqOþúOT JMP ABRE2 NOT MOVED CONTINUE * STA TEMP1 SET THE TDB ADDRESS FOR CLEAR LDB TEMP9 GET THE RESIDENCY FLAG CMA,CLE IF THE TDB IS NOT IN THE LIB. AREA ADA RTORG AND THE PROG IS DISC RESIDENT SEZ,CCE,RSS THEN DO NOT CLEAR THE TDB SZB JMP ABRE4 EITHER RESIDENT OR TRUE LIB. JMP ABRE3 IN DISC RESIDENT PGM. * ABRE2 STA TEMP7 SET UP TO RETURN IT INA STEP TO THE LENGTH LDA A,I GET IT STA TEMP8 SET FOR RETURN CALL JSB $RTN RETURN THE SAVE AREA TEMP7 NOP TEMP8 NOP * ABRE3 CLA,CCE CLEAR TEMP1 TO AVOID PROBLEMS STA TEMP1 JSB RTN4 RETURN THE 4 WORD EXTENSION ABRE6 LDB TEMP4 GET ADDRESS OF NEXT CCE,SZB EXTENSION JMP ABRE1 GO DO IT IF IT EXISTS ABRX JMP $ABRE,I RETURN * ABRE7 LDA $PBUF GET THE ADDRESS OF OUR 32 WORD MAP BUFFER ADA SIGN ADD SIGN BIT TO INSURE WRITE TO MEMORY USA PERFORM THE WRITE LDA $MRMP NOW GET ADDRESS OF MEM RES MAP USA SET IT UP JSB RTN4 RETURN THE 4 WORDS AND RELEASE THE TDB LDA $PBUF GET THE SAVED MAP USA PUT IT BACK JMP ABRE6 GO GET THE NEXT BLOCK * * ABRE4 SZB DISC RES PROGRAM ? JMP ABRE7 NO, MEM RES. * LDA TEMP6 GET THE ID ADDRESS ADA D21 AND INDEX TO THE SSGA WORD LDA A,I ALF,ALF GET IT TO LOW END RAL AND D7 KEEP ONLY MPFT INDEX CPA D4 WAS SSGA ALLOWED ? STB TEMP1,I YES, ZAP THE TDB CAUSE IT'S IN SSGA(SET FREE) JMP ABRE3 NO, DON'T ZAP IT. IT WAS IN PROG AREA. * D21 DEC 21 HED $LIBX EXIT PROCESSOR FOR RENT/PRIV LIB ROUTINES SKP * < $LIBX> IS ENTERED WHEN A LIBRARY * PROGRAM TERMINATES ITS EXECUTION. A * TEMPORARY DATA BLOCK IS MOVED BACK * INTO THE LIBRARY PROGRAM, IF REQUIRED, * “þúBEFORE RETURN TO THE ORIGINAL CALLER. * * LIBXA DEF $LIBX+0 A DIRECT ADDRESS * *$LIBX NOP * SJP $LBX $LBX STA XA,I NON MP ENTRY MUST BE PRIV SUB RETURN. LDA $PVCN SUBTRACT ONE FORM THE COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LB10 IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK XLA $LIBX,I TRACK DOWN THE RETURN XLA A,I ADDRESS STA $LIBX AND SET IT * LDA $PVST GET DMS STATUS RAL,RAL ROTATE & SET FOR RETURN TRIP STA $PVST * LDA XA,I RESTORE A AND JRS $PVST $LIBX,I RETURN * LB10 STA $PVCN RETURN NON PRIV. SET COUNTER STB XB,I TO ZERO AND FINISH THE REG. SAVE ERA,ALS E SOC O INA STA XEO,I XLA $LIBX,I GET THE XLA A,I RETURN ADDRESS STA XSUSP,I AND SAVE IT LDB XI GET THE X & Y REGISTER SAVE AREA CXA GET X TO A XSA B,I SAVE X INB BUMP POINTER CYA XSA B,I SAVE Y JMP $RENT NOW GO SET THE FENCE * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LIBXC XLB $LIBR,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. XLA B,I AND GET CONTENTS (TEMP4 = ADDRESS OF STA TEMP4 WORD 2 OF ID EXT TO BE RETURNED) ISZ $LIBR SET TO (P+2) OF CALL TO -$LIBX-.(RETRN ADJ) ADB D2 GET XLA B,I ORIGINAL RETURN ADDRESS XLB $LIBR,I ADD IN THE RETURN ADJUSTMENT ADA B STA XSUSP,I AND SET FOR RETURN TO USER. * LDB XEQT GET ID EXTENSION JSB FINDL ADDRESS JMP MPERR NOT FOUND??? JMP LB14 START SEARCH * LB15 SEZ,CCE,RSS FIND NEXT ENTRY ADDRESS ADB D3 GO TO 4TH WORD (ONLY DONE ONCE) STB TEMP5 SAVE POINTER LDB B,I GET ADDRESS * SZB,RSS 1Ðþú IF THIS IS THE END JMP ERE01 THEN EXTENSION NOT FOUND * LB14 STB A OF INA ID WORD CPA TEMP4 THIS ONE?? RSS YES GO DO IT JMP LB15 NO TRY NEXT ONE * STB TEMP2 SAVE BLOCK ADDRESS LDB B,I RELINK THE BLOCKS STB TEMP5,I JSB RTN4 RETURN THE ID-EXTENSION JMP $RENT TDB = 0, GO TO CHECK RETURN. * HED ** SYSTEM DISC ALLOCATION/RELEASE PROCESSOR ** * SYSTEM DISC ALLOCATION/RELEASE REQUESTS * * THESE REQUESTS CONFORM TO THE GENERAL * SYSTEM REQUEST FORMAT. * * A. DISC TRACK ALLOCATION * * THE ALLOCATION REQUEST INCLUDES THE * NUMBER OF CONTIGUOUS TRACKS DESIRED, A * PARAMETER TO INDICATE SUSPENSION OR * NO SUSPENSION IF THE REQUESTED SPACE IS * NOT AVAILABLE AND VARIABLE STORAGE FOR * RETURNING THE STARTING TRACK NUMBER, THE * DISC LOGICAL UNIT NUMBER AND THE NUMBER * OF SECTORS PER TRACK FOR THE ASSIGNED * DISC. * * (P) JSB EXEC * (P+1) DEF *+6 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS DESIRED) * (P+4) DEF STRAK ( " WORD FOR TRACK #) * (P+5) DEF DISC ( " " FOR DISC LU #) * (P+6) DEF SECT# ( " " FOR # SECTORS) * (P+7) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * SECT# NOP * * M = 4 ALLOCATE TRACK TO PROGRAM * = 15 ALLOCATE TRACK GLOBALLY * * #TRAK (BIT 15):= 0 TO MEAN SUSPENSION IF * TRACKS NOT AVAILABLE * = 1 TO MEAN NO SUSPENSION AND * SET (STRAK) = -1 IF NO * TRACKS AVAILABLE. * * STRAK : THE STARTING TRACK NUMBER OF THE * CONTIGUOUS GROUP ALLOCATED IS * STORED IN THIS WORD ( OR = -1 AS * DESCRIBED FOR 'NO SUSPENSION' ABOVE). * * &%þú DISC : THE LOGICAL UNIT NUMBER OF THE DISC * ON WHICH THE TRACK(S) WERE ALLOCATED * IS STORED IN THIS WORD. * * SECT#: THE NUMBER OF SECTORS PER TRACK FOR * THIS DISC ALLOCATION IS STORED IN * THIS WORD. SKP * * B. DISC TRACK RELEASE * * THE RELEASE REQUEST PROVIDES FOR RELEASING * A SINGLE TRACK, A CONTIGUOUS GROUP OF TRACKS * OR ALL TRACKS ASSIGNED. THE TRACKS TO BE * RELEASED MUST BE EITHER ASSIGNED TO THE * REQUESTING PROGRAM (REQUEST CODE 5) OR * ASSIGNED GLOBALLY (REQUEST CODE 16). * * (P) JSB EXEC * (P+1) DEF *+5 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS TO RELEASE) * (P+4) DEF STRAK ( " STARTING TRACK #) * (P+5) DEF DISC ( " DISC LU # ) * (P+6) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * * M = 5 RELEASE PROGRAM TRACK * = 16 RELEASE GLOBAL TRACK * * #TRAK: = N, TO INDICATE THE NUMBER OF CONTIG- * UOUS TRACKS TO RELEASE BEGINNING * AT THE TRACK NUMBER IN 'STRAK'. * * = -1, TO MEAN RELEASE ALL TRACKS ASSIGNED * TO THE USER PROGRAM - * VALID ONLY FOR PROGRAM ASSIGNED TRACKS * IN THIS CASE, THE 'STRAK' ANDNk * 'DISC' PARAMETERS NEED NOT * BE INCLUDED. * * STRAK: THE STARTING TRACK OF THE GROUP TO * BE RELEASED IS STORED IN THIS WORD. * * DISC: THE LOGICAL UNIT NUMBER OF THE DISC * CONTAINING THE TRACKS IS STORED * IN THIS WORD. SKP * * ** TRACK ASSIGNMENT TABLE ** * * THE *TAT* IS A VARIABLE LENGTH TABLE DESCRIBING * THE AVAILABILITY OF EACH DISC TRACK ON THE * SYSTEM DISC AND, IF INCLUDED, THE AUXILIARY DISC. * THE *TAT* IS CONSTRUCTED BY BASED ON * USER PARAMETERS D‰~þúECLARING THE SIZE OF THE SYSTEM * DISC AND THE AVAILABILITY AND SIZE OF AN AUXILIARY * DISC. EACH TRACK IS REPRESENTED BY A 1-WORD ENTRY. * THE FIRST WORDS OF THE TABLE CORRESPOND TO THE * N TRACKS OF THE SYSTEM DISC, USUALLY 32, 64 OR * 128. THE WORD "TATSD" IN THE BASE PAGE COMMUNI- * CATION AREA CONTAINS THE SIZE OF THE SYSTEM DISC * AS A POSITIVE INTEGER. IF AN AUXILIARLY DISC IS * INCLUDED, THE REST OF THE *TAT* CONTAINS 1-WORD * ENTRIES TO DESCRIBE THE TRACKS ON THAT DISC. * RTGEN INITIALIZES THE PROTECTED TRACKS OF THE * SYSTEM DISC TO BE ASSIGNED TO THE SYSTEM (PERM- * ANENTLY UNAVAILABLE). * THE CONTENTS OF A TRACK ASSIGNMENT ENTRY WORD * MAY BE ONE OF THE FOUR VALUES: * * 0 - AVAILABLE FOR ASSIGNMENT * 100000 - ASSIGNED TO THE SYSTEM (OR PROTECTED) * 077777 - ASSIGNED GLOBALLY * NNNNN - USER PROGRAM ASSIGNMENT. NNNNN IS THE * ID SEGMENT ADDRESS OF THE PROGRAM. * * THE WORD "TATLG" IN THE BP COMMUNICATION AREA * CONTAINS THE NEGATIVE LENGTH OF THE TAT. * THE WORD "TAT" CONTAINS THE FWA OF THE TABLE. * * ** VARIABLE NUMBER OF SECTORS PER TRACK ON FIXED-HEAD SYSTEMS ** * * ONE RTE CAN ACCOMODATE TWO FIXED-HEAD * DISC UNITS TERMED THE SYSTEM DISC (LU #2) * AND THE AUXILIARY DISC (LU#3). THESE DISCS * MAY BE DIFFERENT MODELS OF A FIXED-HEAD * DISC AND WITH DIFFERING NUMBER OF SECTORS * PER TRACK. FOR THIS REASON THE WORDS * 'SECT2' AND 'SECT3' IN THE BASE PAGE * COMMUNICATION AREA CONTAIN THE NUMBER OF * SECTORS PER TRACK FOR LOGICAL UNITS 2 AND 3. * * SKP * TRACK ALLOCATION (USER CALL) * DISCA CCB,RSS SET DISC1 LDB XEQT ENTRY LDA RQCNT INSURE ADA DM4 THAT SSA 4 PARAMETERS ARE SUPPLIED. JMP DERR1 -NO, ERROR 'DR01' * XLA RQP2,I GET '#TRAK' PARAMETER TO CHECK AND C100K 'N'. REMOVE BIT 15, SZA,RSS -ERROR IF JMP DERR2 #TRAK = 0. * ELÑ…þúB,CLE,ERB JSB $DREQ CALL FOR CONTIGUOUS ALLOCATION * SZB IF TRACKS ALLOCATED, JMP DSC3 CONTINUE. * * NO TRACKS ARE AVAILABLE * CCA CHECK SUSPENSION XLB RQP2,I PARAMETER. SSB IF BIT 15 = 1, GO TO SET STRAK JMP DSC3 = -1 AND RETURN TO CALLER. * * SUSPEND PROGRAM - LINK INTO DISC SUSPENSION LIST * JSB $LIST SUSPEND OCT 505 PROGRAM JMP $XEQ - EXIT - * * AVAILABLE TRACK FOUND * DSC3 XSA RQP3,I SAVE STARTING TRACK #. LDA SECT2 SET TO STORE CPB D3 # SECTORS PER TRACK IN LDA SECT3 'SECT#' DEPENDING ON LU # IN B. XSA RQP5,I SET # SECTORS. * XSB RQP4,I SET DISC LOGICAL UNIT #. * DSC4 LDA RQRTN SET *XSUSP* TO STA XSUSP,I BE EXIT ADDRESS JMP $XEQ - EXIT -. * D3 DEC 3 DM2 DEC -2 DM4 DEC -4 C100K OCT 77777 * * * TRACK RELEASE (USER CALL) * DISC2 CLA,CLE,RSS SET DISCB CLA,CCE,INA ENTRY STA TEMP7 SWITCH LDA RQCNT INSURE SZA,RSS THAT AT LEAST 1 PARAMETER GIVEN. JMP DERR1 - NO, ERROR LDA XEQT (A)= ID SEGMENT ADDRESS XLB RQP2,I GET PARAMETER: CPB DM1 IF = -1, JMP DSC7 GO TO RELEASE ALL FOR THIS PROG * LDA RQCNT INSURE THAT THE ADA DM3 STRAK AND DISC PARAMETERS SSA ARE PROVIDED. JMP DERR1 -NO, ERROR * XLA RQP4,I GET DISC LU #. XLB RQP3,I AND THE # OF TRACKS CLE,ERA CHECK VALIDITY. CPA D1 IF NOT 2 OR 3 RSS THEN GO SEND HIM JMP DERR2 DOWN THE TUBES. * SEZ IF LU 3 USE ADB TATSD AUXILIARY DISC * XLA RQP2,I GET #TRAK. CMA,INA SET NEGATIVE FOR SSA,RSS COUNTER. ERROR IF 0 OR JMP DERR2 ORIGINALLY NEGATIVE. STA TEMP1 SET CO[þúUNTER. * LDA TEMP7 RELEASE CCE,SZA NON-GLOBAL JMP DSC8 GLOBAL * ADB TAT ADD THE TAT ADDRESS DSC5 LDA B,I GET CURRENT TRACK ASSIGNMENT CPA XEQT COMPARE TO PROGRAM ID SEG ADDRESS CLA,RSS JMP DERR3 OTHERWISE, REQUEST ERROR. STA B,I = 0 TO BE AVAILABLE. INB ADD 1 TO TAT ADDRESS. ISZ TEMP1 -INDEX COUNTER. JMP DSC5 -MORE * DSC6 JSB $SDSK FINISHED-SCHEDULE DISC SUSP PROGS * JMP DSC4 GO ADVANCE RETURN ADDRESS AND EXIT * DSC8 LDA TEMP1 SET A TO NUMBER OF TRACKS(-) JSB $CREL TRY CONDITIONAL RELEASE STB XA,I SET RESULT IN USER A REG. JMP DSC4 AND GO EXIT * DSC7 SEZ IF GLOBAL RELEASE JMP DERR1 SHOT DOWN THE CLOD. JSB $SDRL RELEASE ALL TRACKS JMP DSC6 GO SCHEDULE ALL WAITING PGMS. * * * $CREL CONDITIONALLY RELEASES SYSTEM OR GLOBAL TRACKS * THE CONDITION BEING: * A) THAT THEY ARE ASSIGNED AS EXPECTED AND * B) THAT THEY ARE NOT IN A DISC I/O QUEUE. * * CALLING SEQUENCE: * * E = 1 IF GLOBAL TRACK RELEASE * E = 0 IF SYSTEM TRACK RELEASE * A = THE NEGATIVE OF THE NUMBER OF TRACKS TO RELEASE. * B = THE FIRST TRACK'S OFFSET IN THE TAT. * * JSB $CREL * * RETURN CONDITIONS ARE: * * B = -1 ONE OR MORE OF THE TRACKS IS IN USE * = -2 ONE OR MORE OF THE TRACKS IS NOT ASSIGNED AS SPECIFIED. * = 0 TRACKS WERE RELEASED. * $CREL NOP ADB TAT GET THE TAT ADDRESS TO B STB TEMP4 STB TEMP7 ENTRY IN TAT SPC 1 STA TEMP1 SET THE COUNTERS STA TEMP6 LDA C100K SET UP THE SEZ,RSS ASSIGNMENT FLAG INA STEP GLOBAL TO SYSTEM STA TEMP2 SAVE IT LDA TATSD COMPUTE THE DISC LU ADA TAT A IS THE TAT POSITION CMA,INA (-) OF THE FIR¥þúST WORD OF LU 3. ADA B SUBTRACT FROM TAT POSITON OF FIRST TRACK CLE,SSA IF NEG. THEN ADJUST ADA TATSD FOR LU 2 (SETS E) STA TEMP8 SET THE TRACK NUMBER CLB,SEZ,INB,RSS SET B TO INB THE DISC LU LESS ONE. STB $OTRL SAVE THE LU ISZ $OTRL ADD THE MISSING ONE. ADB DRT GET THE EQT ADDRESS LDA B,I INTO JSB $CVEQ EQT1 * SPC 1 DSC9 LDA TEMP7,I GLOBAL CPA TEMP2 TRACK? RSS YES-GO SEE IF IN USE JMP DSC15 NO-RETURN TO PROG WITH A=-2 LDB EQT1,I GET REQUESTS QUEUED ON DISC ELB,CLE,ERB STRIP POSSIBLE SIGN BIT DSC10 STB TEMP9 DISC QUEUE EXHAUSTED? SZB,RSS JMP DSC12 YES-GO TO NEXT TRACK INB NO-SEE IF REQUEST LDA B,I IS FOR THIS TRACK ALF,ALF AND D3 CPA $OTRL SAME LU? I.E. DISC? RSS YES-CHECK IF SAME TRACK JMP DSC11 NO ADB D3 LDA B,I CPA TEMP8 SAME TRACK? JMP DSC14 YES-RETURN WITH A=-1 SPC 1 DSC11 LDB TEMP9,I GO TO NEXT REQUEST JMP DSC10 IN QUEUE SPC 1 DSC12 ISZ TEMP7 SET UP FOR NEXT TRACK ISZ TEMP8 CHECK NEXT TRACK ISZ TEMP1 ALL TRACKS CHECKED? JMP DSC9 NO TRY AGAIN SPC 1 DSC13 STB TEMP4,I CLEAR ALL ISZ TEMP4 TRACKS ISZ TEMP6 JMP DSC13 SETUP TO RETURN JSB $SDSK SCHEDULE ANY WAITING PGMS. JMP $CREL,I AND RETURN SPC 1 DSC14 CCB,RSS STORE B REGISTER DSC15 LDB DM2 TO INDICATE WHY NO TRACKS JMP $CREL,I RELEASED AND RETURN * * * * * DISC REQUEST ERROR SECTION * DERR1 CLB,INB,RSS -ILLEGAL DISC REQUEST - DR01 - DERR2 LDB D2 -ILLEGAL TRACK # - DR02 - JMP DERR DERR3 LDB D3 -TRACK NOT ASSIGNED TO PROG- DR03 DERR LDA DRA (A) = DR IN ASCII. $ERRA FŸþúADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG. AND ABORT PROG JMP $XEQ -EXIT- * DRA ASC 1,DR AS00 ASC 1,00 * * * SUBROUTINE: <$OTRL> * * PURPOSE: THIS SUBROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * ADDRESS IS IN THE A REGISTER. * * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * WHOSE TRACKS ARE TO BE RELEASED * (P) JSB $OTRL * (P+1) -RETURN- * * $OTRL NOP STA TEMP3 SAVE ID SEGMENT ADDRESS LDA $OTRL AND RETURN ADDRESS FOR STA $SDRL $SDRL ROUTINE AND JUMP JMP SDSC1 TO IT SKP * * SUBROUTINE: < $SDRL > * * PURPOSE: THIS ROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * IS DEFINED IN *XEQT* OR ANY TRACKS ASSIGNED * GLOBALLY DEPENDING ON A REG CONTENTS ON ENTRY. * * * EXCEPTION: IF THE NAME OF THE SUBJECT PROGRAM IS * "EDIT",OR "D.RTR" AN IMMEDIATE EXIT IS MADE TO * AVOID RELEASING SAVED SOURCE FILES AND * DIRECTORY TRACKS IN THE NAME OF THESE * PROGRAMS. * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * OR 077777B (GLOBAL FLAG) * (P) JSB $SDRL * (P+1) -RETURN- * * $SDRL NOP STA TEMP3 DLD IDADD,I GET THE ID ADDRESSES OF D.RTR IDADD EQU *-1 AND EDIT (NOT EDITR DUMMY) CPA TEMP3 IF D.RTR RSS CPB TEMP3 OR EDIT JMP $SDRL,I DON'T RELEASE THEIR TRACKS * SDSC1 LDA TAT SET *TAT* STA TEMP1 ADDRESS LDA TATLG AND TAT LENGTH STA TEMP2 AS INDEX. CLB (B) = 0 FOR RELEASE * SDSC2 LDA TEMP1,I GET CURRENT TRACK ASSIGNMENT. CPA TEMP3 IF ASSIGNED TO THIS PROGRAM, STB TE0ìHFBMP1,I RELEASE IT. ISZ TEMP1 SET ISZ TEMP2 FOR JMP SDSC2 NEXT TRACK. JSB $SDSK SCHEDULE DISC SUSPENDED PROGRAMS JMP $SDRL,I -FINISHED- * ¶(Hÿÿþú SKP * * SYSTEM SUBROUTINE: < $DREQ> * * PURPOSE: THIS SUBROUTINE PROVIDES FOR THE * ALLOCATION OF 'N' CONTIGUOUS TRACKS * FOR BOTH SYSTEM ROUTINES AND NORMAL * USER PROGRAMS. THE 'N' CONTIGUOUS * TRACKS ALLOCATED WILL BE ON THE SAME * DISC UNIT, NO SPANNING OF DISCS WITH * ONE ALLOCATION IS ALLOWED. * * CALL: (A) = NUMBER OF CONTIGUOUS TRACKS * (B) = : 0 FOR CALL FROM SYSTEM ROUTINE * : (XEQT) FOR AN ACTUAL USER * REQUEST. THE ID SEGMENT * ADDRESS (XEQT) IS STORED IN * THE ASSIGNED TRACK WORDS IN * THE -TAT-. * : (077777B) FOR A GLOBAL ASSIGNMENT REQUEST. * THIS OCTAL NUMBER IS STORED IN THE * ASSIGNED TRACK WORDS IN THE -TAT-. * * (P) JSB $DREQ * (P+1) -RETURN- * * ON RETURN: 1) B = 0 IF N TRACKS WERE * NOT AVAILABLE * * 2) A = STARTING TRACK ADDRESS * OF N TRACKS. * B = LOGICAL UNIT # OF DISC * * $DREQ NOP CMA,INA SET COUNT NEGATIVE FOR LOOPS STA TEMP1 SAVE '-N' * CLA,INA ALLOCATION IS TOP DOWN FOR SYS CLE,SZB REQUEST AND BOTTOM UP JMP DREQ0 FOR USER REQUEST - USER JMP. * CCA,CCE SET INCREMENT VALUE AND SYSTEM FLAG LDB SIGN B= SYS TAT FLAG WORD DREQ0 STB TEMP6 SAVE ASSIGNMENT VALUE. STA $DREL SET TABLE INCREMENT VALUE (+1 OR -1) * LDB TAT SET *TAT* LDA B COMPUTE ADDRESS OF LU 3'S ADA TATSD TAT POSITION SEZ IF SYSTEM RQ. ADA $DREL SUBTRACT ONE STA TEMP7 SET ADDRESS OF FIRST WORD ON OTHER DISC LDA TATLG AND TAT LENGTH STA TEMP4 AS INDEX. CMA,SEZ IF SYSTEM RQɸþú. ADB A SET TO START AT THE TOP * DREQ1 LDA B,I GET CURRENT TRACK ASSIGNMENT. SZA,RSS IF NOT ASSIGNED, JMP DREQ3 CHECK FOR N CONTIGUOUS. * DREQ8 ADB $DREL SET FOR DREQ5 ISZ TEMP4 NEXT JMP DREQ1 TRACK. * DREQ2 CLB NOT AVAILABLE, EXIT JMP $DREQ,I WITH (B) = 0. * * AVAILABLE TRACK FOUND - CHECK NEXT 'N-1' TRACKS * DREQ3 STB TEMP3 (B) = FIRST TRACK TAT INDEX. LDA TEMP1 SET STA TEMP2 'N' AS INDEX. DREQ4 LDA B,I CHECK CURRENT SZA TRACK ASSIGNMENT. JMP DREQ8 -ASSIGNED, CONTINUE OTHER SCAN. * ISZ TEMP2 INDEX -'N' RSS NOT ZERO, CHECK NEXT TRACK. JMP DREQ6 - FOUND N TRACKS - * ADB $DREL INDEX TO NEXT TRACK CPB TEMP7 DISC (LU 2)? JMP DREQ5 YES - DO NOT SPAN * ISZ TEMP4 INDEX AND TRACK INDEX. JMP DREQ4 -NOT FINISHED WITH TAT SIZE. * JMP DREQ2 NOT N AVAILABLE. * * N CONTIGUOUS TRACKS FOUND * DREQ6 SEZ IF SYSTEM REQUEST STB TEMP3 SET START ALLOCATION ADDRESS LDB TEMP3 SET THE FIRST TRACK TAT ADDRESS. LDA TEMP6 SET TRACK WORD DREQ7 STA B,I = 100000 FOR SYSTEM USE INB OR TO THE ID SEGMENT ADDRESS ISZ TEMP1 OF THE USER PROGRAM OR TO JMP DREQ7 077777B FOR GLOBAL ASSIGNMENT. * LDA TEMP7 GET ADDRESS OF LU 3 TR 0 IN TAT CMA,SEZ,RSS AND SUBTRACT FROM INA ADA TEMP3 ALLOCATED POSITION CLE,SSA IF ON LU 3 THEN WE HAVE THE TRACK ADA TATSD ELSE NOW WE HAVE IT (E SET TOO) CLB,CME,INB TURN E AROUND TO LEAST LU BIT ELB SET DISC LU IN B JMP $DREQ,I -EXIT-. SPC 1 TEMP1 NOP SKP * * SYSTEM SUBROUTINE: < $DREL> * * PURPOSE: THIS ROUTINE RELEASES 'N' CONTIGUOUS * TRACKS (ASSIGNED TO THE SYSTEM) * BEå…þúGINNING AT TRACK 'M'. * * CALL: (A) = 'M' - STARTING TRACK # (+ SIZE OF * SYSTEM DISC IF LU #3) * (B) = 'N' - # OF CONTIGUOUS TRACKS * (P) ) JSB DREL * (P+1) -RETURN- A = 0. * * $DREL CXA CXA FOR X,Y CONFIGURATION ADA TAT COMPUTE *TAT* ADDRESS STA TEMP1 OF STARTING ADDRESS. LDA A,I GLOBAL TRACKS SSA,RSS ARE NOT TO JMP $DREL,I BE RELEASED * CMB,INB SET 'N' AS INDEX. CLA SET CURRENT DREL0 STA TEMP1,I TRACK ISZ TEMP1 RELEASED INB,SZB JMP DREL0 JSB $SDSK SCHEDULE ANY SUSPENDED PROGRAMS. JMP $DREL,I -EXIT- * SKP * SUBROUTINE: < $SDSK > * * PRUPOSE: THIS ROUTINE CALLS FOR THE * SCHEDULING OF ALL USER PROGRAMS * SUSPENDED BECAUSE OF DISC TRACK * AVAILABILITY. * * CALL: (P) JSB $SDSK * (P+1) - RETURN - A = 0 * * $SDSK DEF IDADD LINK FOR START UP CODE ISZ $LIST FORCE ENTRY INTO DISPATCHER. DSKD1 LDB SUSP4 GET DISC SUSPENSION LIST POINTER. CCE,SZB,RSS IF EMPTY LIST, JMP $SDSK,I EXIT. * JSB $LIST CALL *SCHEDULER* TO OCT 401 LINK INTO SCHEDULE LIST. * JMP DSKD1 SCHEDULE NEXT PROGRAM SKP HED - EXEC - PARTITION STATUS REQUEST PROCESSOR * EXEC CALL FOR PARTITION STATUS * * CALLING SEQUENCE : JSB EXEC * DEF *+6 RETURN * DEF D25 CODE=25 * DEF PART# PARTITION NUMBER * DEF PAGE# RETURNED STARTING PAGE # * DEF #PGS RETURNED NUMBER OF PAGES * DEF PSTAT RETURNED PARTITION STATUS * BIT15 = BG/RT 0/1 * BIT14 = FREE FOR ALL/RESERVED 0/1 * BITõ5þú13 = NORMAL/MOTHER PART'N 0/1 * BIT12 = ISN'T/IS A SUB PART'N 0/1 * BIT11 = CHAIN ISN'T/IS IN EFFECT * 0/1 * * * TEMP USAGE : TEMP1 = INPUT PARTITION # * * FORMAT OF PSTAT * 15 14 13 12 11 7 *----------------------------------------------------------- *I RS I RT I M I S I C I ---- 0 ---- I ID SEGMENT NUMBER I *----------------------------------------------------------- * * #PGS = -1 ON RETURN IF PARTITION NUMBER IS ERRONEOUS * $PTST LDA RQCNT GET THE REQUEST COUNT ADA DM4 SUBTRACT THE PRAMETER COUNT SSA ARE THERE ENOUGH PARAMETERS ? JMP RQERR NO, SO TAKE GAS ! * XLA RQP2,I GET THE PART'N # STA TEMP1 AND SAVE CMA,INA IF NEG OR 0 SSA,RSS FORGET IT . JMP PT.ER * ADA $MNP ADD IN THE MAX # OF PARTITIONS SSA IF PARTITION REQUESTED IS TOO JMP PT.ER LARGE, FLUSH HIM ! * CCA NOW INDEX TO ADA TEMP1 THE REFERENCED MPY D7 PARTITION ADA $MATA CAX PUT ADDRESS IN X FOR FUTURE INDEXING LDA A,I GET THE CONTENTS OF 1ST WORD SSA IS THE PARTITION DEFINED ? JMP PT.ER NO, FLUSH HIM !!! * LBX D2,I GET THE USERS ID SEG # SZB IF NOBODY HOME, FORGET IT JSB $IDNO RETURNS IS SEG # IN B-REG * LAX D4,I GET THE RESERVED WORD RAL,CLE,SLA,ELA R =LSB C = E-REG ADB SIGN IF RESERVED,SET B-REG SIGN BIT RAR,RAR MOVE RESERVED WORD BACK AND B1777 KEEP ONLY #PGS SEZ,INA ADD BASE PAGE, SKIP IF CHAIN IN EFFECT ADB B4000 SET C BIT TO INDICATE CHAIN XSA RQP4,I GIVE # OF PAGES TO USER * LAX D5,I GET RT WORD SSA IF RT BIT SET THEN ADB B40K Ì^þú SET THE RT BIT IN PSTAT * RBL,RBL PLACE M&S BITS INTO BIT 15 & 14 * LAX D3,I GET THE START PAGE WORD SSA IS THE M BIT SET ? ADB SIGN YES, SO SET THE PSTAT M BIT AND B1777 KEEP ONLY START PG # XSA RQP3,I GIVE IT TO THE USER * SSB IS THIS A MOTHER PARTITION JMP PT.MB YES, SO CAN'T BE A SUB PARTITION * LAX D6,I NO, GET THE SUBPARTITION LINK WORD SZA IS THERE A SUB PARTITION ? ADB B40K YES, SO SET THE PSTAT S BIT PT.MB RBR,RBR FIX B- REG XSB RQP5,I AND GIVE THE PSTAT TO THE USER * PT.RT LDA RQRTN GET THE RETURN ADDRESS STA XSUSP,I DET AS THE POINT OF SUSPENSION JMP $XEQ AND SEE WHAT TO DO NEXT. * * PT.ER CLA XSA RQP3,I RETURN 0 AS START PG # CMA XSA RQP4,I RETURN -1 AS # OF PAGES JMP PT.RT * D6 DEC 6 B1777 OCT 1777 B40K OCT 40000 * HED - EXEC - PARTITION SIZE REQUEST PROCESSOR * * * EXEC 26 CALLING SEQUENCE * * JSB EXEC * DEF RETURN * DEF CODE# = 26 * DEF FWMEM = ADDRESS OF PROGRAM'S HIGHEST WORD + 1 * DEF NWLM = # OF WORDS AFTER PROG END & END OF ADDRESS SPACE * DEF PTS12 = LENGTH OF CURRENT PARTITION IN PAGES * DEF MAP = OPTIONAL 32 WORD BUFFER FOR COPY OF USER MAP * * * TEMP USAGE: TEMP1 = - [ HIGH MAIN + LARGEST SEGMENT + 1 ] * * * * PTSIZ LDA RQCNT GET THE REQUEST COUNT ADA DM3 SUBTRACT ACTUAL PRAMETER COUNT SSA AT LEAST 3 PARAMETERS SUPPLIED ? JMP RQERR NO, FLUSH HIM !!! SZA,RSS DID HE SUPPLY THE OPTIONAL PARAMETER ? JMP NMOVE NO. * LDA $PBUF GET THE DESTINATION ADDRESS ADA SIGN SPECIFY READ NOT WRITE USA GET THE MAP * LDA $PBUF NOW THAT WE HAVE THE MAP LDB RQP5 LET'S GIVE IT TO THE USER LDX D32 X = # OF WORÛàþúDS TO MOVE MWI MOVE THE WORDS. * NMOVE LDA XMATA GET ADDR OF CURRENT $MATA ENTRY SZA,RSS IS THIS A MEMORY RESIDENT PROG ? JMP MEMER YES, FORGET THE REST OF THE CALL ADA D4 INDEX TO THE SIZE WORD LDA A,I GET IT. INA ACCOUNT FOR BASE PAGE. AND B1777 KEEP ONLY THE SIZE BITS XSA RQP4,I AND GIVE IT TO THE USER * LDB XEQT NOW GET THIS PROS'S ID SEG ADDRESS ADB D29 INDEX TO THE HIGH MAIN + SEGMENT +1 LDA B,I GET THE SIZE ADB DM6 NOW INDEX TO HIGH MAIN + 1 SZA,RSS IS THE PROGRAM SEGMENTED ? LDA B,I NO, SO USE HIGH MAIN + 1 XSA RQP2,I NOW GIVE IT TO THE USER. CMA,INA * ADB DM1 NOW INDEX TO LOW MAIN WORD IN ID SEG ADA B,I GET THE WORD STA TEMP1 AND SAVE * ADB DM1 NOW INDEX TO # OF PAGES WORD LDA B,I GET THE WORD AND G76 & KEEP SIZE IN PAGES ADA TEMP1 ADD LOAD POINT. A = # OF WORDS LEFT XSA RQP3,I GIVE IT TO THE USER. * ADB D7 *E INDEX TO EMA WORD *780627* LDA B,I *E SZA,RSS * IS THIS AN EMA PROG? JMP MYEND * NO, DONE * ALF *E YES, EMA PROG RAL,RAL *E GET INDEX VALUE AND B77 *E ADA $IDEX *E LDA A,I *E LDA A,I *E (A) = 1ST WORD ID EXT AND B37 *E KEEP ONLY MSEG SIZE ALF,ALF *E RAL,RAL *E CONVERT TO # OF WORDS CMA,INA *E XLB RQP3,I *E SUBTRACT FROM # OF WORDS ADA B *E THAT USER COULD HAVE XSA RQP3,I *E (A) = DYNAMIC BUFFER AREA SIZE IN # WDS * * MYEND LDA RQRTN GET RETURN POINT STA XSUSP,I SAVE OIN ID SEG AS POINT OF SUSPENSION. JMP $XEQ NOW GO SEE WHAYT TO DO NEXT. * MEMER STA RQP2,I MEMORY RESIDENT PROGRAM STA RQP3,I SO DONT RETUQ‚þúRN STA RQP4,I PARTITION SIZE OR FREE MEMORY JMP MYEND * * B77 OCT 77 B37 OCT 37 HED * EXEC - ERROR MESSAGE SECTION * * * MEMORY PROTECT * * IN RTE 4 THE OPERATING SYSTEM IS PROTECTED BY A HARDWARE * MEMORY PROTECT. THIS MEANS THAT ANY PROGRAM THAT ILLEGALLY * TRIES TO MODIFY OR JUMP TO THE OPERATING SYSTEM WILL CAUSE * A MEMORY PROTECT INTERUPT. THE OPERATING SYSTEM INTERCEPTS * THE INTERUPT AND DETERMINES IT'S LEGALITY. IF THE MEMORY * PROTECT IS ILLEGAL, THEN THE PROGRAM IS ABORTED AND THE FOLLOWING * MESSAGE IS REPORTED TO THE SYSTEM CONSOLE : * * MP INST = XXXXXX XXXXX = OFFENDING OCTAL INSTRUCTION CODE * ABE PPPPPP QQQQQQ R CONTENTS OF A,B & E REGISTERS AT ABORT * XYO PPPPPP QQQQQQ R CONTENST OF X,Y & O REGISTERS AT ABORT * MP YYYYY ZZZZZ YYYYY = PROGRAM NAME, ZZZZZ = VIOLATION ADDRESS * YYYYY ABORTED * * * DYNAMIC MAPPING VIOLATION * * A DYNAMIC MAPPING VIOLATION OCCURS WHEN AN ILLEGAL READ OR * WRITE OCCURS TO A PROTECTED PAGE OF MEMORY. THIS MAY HAPPEN * WHEN ONE USER TRIES TO WRITE BEYOND HIS OWN ADDRESS SPACE TO * NON EXISTANT MEMORY OR SOMEONE ELSES MEMORY. IN THIS CASE THE * PROGRAM IS ABORTED AND THE FOLLOWING MESSAGE IS PRINTED: * * * DM VIOL = WWWWW WWWWW = CONTENTS OF DMS VIOLATION REGISTER * DM INST = XXXXXX * ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R * DM YYYYY ZZZZZ * YYYYY ABORTED * * * EX ERRORS * * IT IS POSSIBLE TO EXECUTE IN THE PRIVLEDGED MODE (IE INTERUPT * SYSTEM OFF) IN THIS CASE THE USER MAY NOT MAKE EXEC REQUESTS * BECAUSE MEMORY PROTECT, WHICH IS THE ACCESS VEHICLE TO EXEC IS OFF. * AN ATTEMPT TO MAKE AN EXEC CALL WITH THE INTERUPT SYSTEM OFF * WILL CAUSE THE CALLING PROGRAM TO BE ABORTED AND THE FOLLOWING * MESSAGE PRINTED : * *EX YYYYY ZZZZZ *EX ABORTED * * * * UNEXPECTED DM AND MP ERRORS ØÔþú* * THE OPERATING SYSTEM HANDLES ALL MP AND DM VIOLATIONS. * CERTAIN OF THESE VIOLATIONS ARE LEGAL AND OTHERS ARE NOT. * IN ANY CASE THE OPERATING SYSTEM ASSOCIATES THESE VIOLATIONS * WITH PROGRAM ACTIVITY. IF A DM OR MP ERROR OCCURS AND NO PROGRAM * WAS ACTIVE THEN, THIS IS AN UNEXPECTED MP OR DM VILATION. * SINCE NO PROGRAM IS PRESENT, THERE IS NO PROGRAM TO ABORT * IN THIS CASE THE FOLLOWING MESSAGE WILL BE PRINTED : * * * DM VIOL = WWWWW * DM INST = XXXXX OR MP INST = XXXXX * ABE PPPPPP QQQQQQ R ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R XYO PPPPPP QQQQQQ R * DM 0 MP = 0 * * * WARNING WARNING WARNING WARNING WARNING WARNING * ------------------------------------------------- * * THE ABOVE MESSAGE WHICH SPECIFIES AS THE PROGRAM * NAME IS A SIGNAL TO THE USER THAT AN UNEXPECTED MEMORY PROTECT * OR DYNAMIC MAPPING VIOLATION ERROR HAS OCCURED. THIS IS A * SERIOUS VIOLATION OF OP SYSTEM INTEGRITY. MOST TIMES IT MEANS * USER WRITTEN SOFTWARE (DRIVER, PRIVLEDGED SUBROUTINE) HAS DAMAGED * THE OPERATING SYSTEM INTEGRETY OR INADAQUATELY PERFORMED REQUIRED * (DRIVER) SYSTEM HOUSEKEEPING. IT MAY ALSO MEAN THAT THE CPU * HAS FAILED AND THAT THE OPERATING SYSTEM CAUGHT THE FAILURE * IN TIME TO AVOID A SYSTEM CRASH. * * IF THIS ERROR OCCURS IT IS SUGGESTED THAT USERS SAVE WHATEVER * THEY WERE DOING (IE FINISH UP EDITING, ETC) AND REBOOT THE SYSTEM. * IF ONLY H-P SYSTEM MODULES ARE PRESENT IN THE OPERATING SYSTEM, * CPU FAILURE IS HIGHLY SUSPECTED AND CPU DIAGNOSTICS SHOULD BE RUN. * * * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * MPERR LDA MP ASSUME A MP ERROR SFS 5 IS IT A MEMORY PROTECT OR DM ERROR ? JMP MPER MEMORY PROTECT RVA GET THE VIOLATION REGISTER CLE SPECIFY OCTAL CONVERSION JSB $CNV3 CONVERT TO OCT±„þúAL LDB A,I GET THE 1ST WORD STB VBUFR+7 INA BUMP POINTER DLD A,I PULL IN LAST TWO DST VBUFR+8 AND SET IN OUTPUT BUFFER * LDA VBUFR GET ADDRESS JSB $SYMG AND REPORT ERROR * LDA DM (A) = 'DM' * MPER STA IBPBF+2 (SAVE THER ERROR CODE ) CLE OCTAL CONVERSION LDA INSTR GET THE INSTRUCTION JSB $CNV3 CONVERT TO OCTAL LDB A,I GET THE 1ST WORD STB IBPBF+7 & SAVE INA DLD A,I AND THE LAST TWO DST IBPBF+8 LDA IBPBF GET THE ADDRESS & JSB $SYMG TELL THE FOLKS THEY BLEW IT JSB $ABXY REPORT THE AB,XY, & EO REGISTERS LDA IBPBF+2 GET THE CODE JMP DOABT AND DO THE ABORTION * RQERR LDA RQ1 (A) 'RQ' JMP DOABT * ERE01 LDA RE (A) 'RE' JMP DOABT * $XEX LDA XEQT GET THE ID ADDRES OF CURRENT PROG SZA,RSS IS THERE ONE ? LDB $IDLE NO ! THEN SET POINT OF SUSP TO IDLE LOOP SZA IS THERE A PROGRAM ? LDB EXECA,I YES, SO GET CONTENTS OF EXEC SZA IF WE HAVE A PROG, COVER BOTH ENTRIES ADB XLUAD,I BY ADDING XLUEX'S CONTENTS(ONLY 1 # 0) SZB IF A JSB EXEC, USE AS POINT OF SUSP STB XSUSP,I (SYS CAN BE RESTARTED AFTER A CRASH BY * SETTING P = EXEC + 1 CLA SET EXEC AND XLUEX BACK TO NOPS AGAIN STA EXECA,I STA XLUAD,I JSB $ABXY REPORT X & Y REGISTERS * LDA EX GET THE ERROR CODE * DOABT LDB BLANK (B) = BLANKS JSB $ERMG GO ABORT THE PROGRAM & REPORT ABORTION * JMP $XEQ GO SEE WHAT TO DO NEXT * MP ASC 1,MP RQ1 ASC 1,RQ RE ASC 1,RE PE ASC 1,PE EX ASC 1,EX * VBUFR DEF *+1 DEC -16 DM ASC 8,DM VIOL = XXXXX IBPBF DEF *+1 DEC -16 ASC 8,XX INST = XXXXX * SKP * * * $ABXYèþú PRINTS OUT THE A, B, X, Y, E, & O REGISTERS ON THE * SYSTEM CONSOLE. * IT IS CALLED FOR MP, DM, & PE ERRORS. * * * SET UP TO SEND A & B / X & Y REGISTERS TO SYS CONSOLE * $ABXY NOP DLD AB GET THE ASCII 'AB' DST ABBUF+2 AND PUT INTO MESSAGE * LDA XEO,I GET THE E & O REGISTERS LDB ASC.0 GET AN ASCII ' 0' CLE,SSA WAS E REG SET ? INB YES * LDA XA GET A REG @ SUSPENSION ADDRESS GETXY STA TEMP8 AND SAVE STB ABBUF+11 SAVE E & O REG ALSO LDA A,I GET THE VALUE TO REPORT JSB $CNV3 CONVERT TO ASCII LDB A,I GET 1ST WORD STB ABBUF+4 CLE,INA BUMP POINTER (CLEAR E FOR NEXT CONVERSION) DLD A,I GET LAST TWO WORDS DST ABBUF+5 & PUT INTO BUFFER * ISZ TEMP8 BUMP TO NEXT WORD (B REG OR Y REG) LDA TEMP8,I GET IT JSB $CNV3 AND DO IT AGAIN LDB A,I STB ABBUF+8 CLE,INA DLD A,I DST ABBUF+9 * LDA ABBUF GET THE ADDRESS JSB $SYMG REPORT THE REGISTER CONTENTS * DLD XY GET X & Y REGISTER MESSAGE CPA ABBUF+2 DONE THIS BEFORE ? JMP $ABXY,I YES, SO RETURN TO CALLER * DST ABBUF+2 NO, SO REPORT X&Y REGISTERS LDB XI GET ADDRESS OF X REGISTER XLA B,I GET IT STA X &SAVE INB XLA B,I STA Y * LDA XEO,I GET THE E&O REGISTER LDB ASC.0 AND THE ' 0' CLE,SLA O REGISTER SET ? INB YES * LDA X.Y PUT ADDRESS IN TEMP8 JMP GETXY * * X.Y DEF *+1 LOCAL X & Y REGISTER SAVE AREA X NOP Y NOP AB ASC 2,ABE XY ASC 2,XYO ABBUF DEF *+1 DEC -20 ASC 10,ABE XXXXXX XXXXXX X ASC.0 ASC 1, 0 SKP * * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A þú FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * THE ROUTINE ALSO ATTEMPTS TO RECOVER FROM * PROCESSOR FAILURE. IT SEEMS THAT WHEN THE * CPU HICCUPS CONTROL IS TRANSFERED HERE. * THAT IS, THE HICCUP IS DECODED AS A MP, DM, * OR OTHER TYPE ERROR. IF THERE IS A PROGRAM * CURRENTLY EXECUTING, THEN THAT PROGRAM IS ABORTED * AND ALL THE ASSOCIATED PROGRAM CLEAN UP IS DONE * VIA THE CALL TO $ABRT. IF HOWEVER, XEQT = 0, THEN * THERE IS NO ONE TO ABORT & WE'RE IN TROUBLE. * IN THIS CASE THE MESSAGE * * DM VIOL = XXXXX * DM INST = XXXXX OR MP INST = XXXXXX * DM 0 MP 0 * * IS PRINTED AND NO CALL TO $ABRT IS MADE. WHAT THIS * DOES IS TO ALLOW THE SYSTEM TO RECOVER FROM A * CPU FAILURE. * * HINT ! SAVE WHAT YOUR DOING BECAUSE THE SYSTEM * (CPU) IS IN TROUBLE !!! * * NOTE THE FRIENDLINESS, THE OP SYSTEM IS ACTUALLY * PROTECTING THE USER FROM HIS OWN CPU !!!!! * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) * $ERMG JMP EXINT FIRST ENTRY BY JMP GOES TO INIT STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * $USER NOP RESERVE SPACE FOR USER HANDLING OF ERRORS NOP RESERVE SPACE FOR USER HANDLING OF ERRORS * LDB XEQT GET ID ADDR OF PROGRAM TO ABORT SZB IS THERE ANYBODY TO ABORT ? ADB D8 YES, SO GET POINT OF SUSPENSION ADDRESS STB $SDSK AND SAVE FOR ABORT OPTION ADB D4 SET (B) =r þú ADDRESS OF 3-WORD NAME CPB D4 BUT IF THERE'S NOBODY TO ABORT LDB .INT. GET THE ADDRESS ERAB1 LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF AND B140K ABORT OR NO-SUSP OPTION SZA IN EFFECT JMP NOABT GO SET IT UP. * ERM CLA **IF $SDSK=0, MAKE POINT OF SUSP 0**DO NOT REMOVE LDA $SDSK,I GET ERROR LOCATION (DON'T USE XSUSP) JSB $CNV3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. CLE,INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA FETCH MESSAGE BUFFER ADDRESS LDB XEQT FETCH ID ADDRESS OF PROG WITH PROBLEM JSB $PSTE ATTEMPT POST OF ERROR TO SCB [(A) SAVED] JSB $SYMG OUTPUT DIAGNOSTIC. * * * DOAB ISZ $LIST FORCE A NEW LIST SCAN LDA MSG+1 GET FIRST 2 CHARS OF MESSAGE CPA ASCPE IS IT A PARITY ERROR ? JMP $ERMG,I YES, DON'T ABORT PROG (LET PERR4 DO IT) * LDA XEQT NOW GO DO ABORT PROCESSING. SZA BUT BE CAREFUL THAT THERE IS JSB $ABRT REALY SOMEONE TO ABORT. * JMP $ERMG,I D4 DEC 4 D8 DEC 8 C377 OCT 177400 ASCPE ASC 1,PE * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * LDA XEQT IS THERE REALY SOMEONE TO ABORT ? SZA,RSS WELL ? JMP ERM NO !!!!! WOW, THAT WAS A CLOSE ONE !!!!!! CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (%%NLHBUT IF "MP","RQ","DM","RE", JMP ERM OR "PE" ABORT ANYWAY) ADA RQRTN STA $SDSK,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * * DM6 DEC -6 * .INT. DEF *+1 PROCESSOR FAILURE ERROR CODE ASC 3, * * MSGA DEF *+1 * MSG DEC -18 EXINT STB $SDSK,I SET THE TWO SPECIAL ID-SEG. ADDS ASC 1, XOR 40 WHEN EXECUTED BLANK ASC 1, JMP $TRRN GO SET UP RN CODE IF ANY LDB B,I GET THE ADDR OF D.RTR'S ID-SEG. JMP $SCLK GO START THE CLOCK SPC 1 BSS 7+BLANK-* * A EQU 0 B EQU 1 ëªNÿÿþú HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ+0 CODE 1 I/O READ DEF $IORQ+0 CODE 2 I/O WRITE DEF $IORQ+0 CODE 3 I/O CONTROL * $EX4 DEF DISC1+0 CODE 4 DISC TRACK ALLOCATION $EX5 DEF DISC2+0 CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1+0 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2+0 CODE 7 OPERATOR SUSPENSION * EXT $MPT3 $EX8 DEF $MPT3+0 CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4+0 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5+0 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6+0 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7+0 CODE 12 TIME SELECTION * DEF $IORQ+0 CODE 13 I/O DEVICE STATUS * EXT $MPT9 DEF $MPT9+0 CODE 14 GET-PUT STRING * $EX15 DEF DISCA+0 CODE 15 GLOBAL TRACK ASSIGNMENT $EX16 DEF DISCB+0 CODE 16 GLOBAL TRACK RELEASE * DEF $IORQ+0 CODE 17 READ CLASS I/O DEF $IORQ+0 CODE 18 WRITE CLASS I/O DEF $IORQ+0 CODE 19 CONTROL CLASS I/O DEF $IORQ+0 CODE 20 WRITE-READ CLASS I/O * EXT $GTIO DEF $GTIO+0 CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8+0 CODE 22 SWAP/CORE USAGE REQUEST * DEF $MPT4+0 CODE 23 SCHEDULE WITH WAIT/WAIT * DEF $MPT5+0 CODE 24 SCHEDULE NO WAIT/WAIT DEF $PTST+0 CODE 25 PARTITION STATUS †Rþú DEF PTSIZ+0 CODE 26 PARTITION SIZE * * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS H3 2/3 (WRITE BUFFER) ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS L8 8/9 (SCHEDULE) ABS L2+L3+H8 10/11 (SCHED WWAIT),(TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5+H3 14/15 (G/S PRM.ST),(GL.ALC.PRM) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS L8 22/23 (SCHEDULE W WAIT/WAIT) ABS L3+L4+L5+H8 24/25 (SCHEDULE NO WAIT/WAIT),(PART.STATUS) ABS H5+H4+H3+H2 26/- (PARTITION SIZE INFO/---) SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * XIDEX EQU .-3 ADDRESS OF CURRENT ID EXTENSION XMATA EQU .-2 $MATA ADDRESS FOR CURRENT PR˜þúOGRAM XI EQU .-1 X,Y SAVE ADDRESS EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15 - WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQÄU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BABKGSMUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * PROGRAM LENGTH P END $RQST Å ÿÿ ÿý)1[ ÿ92067-18109 1903 S C0122 &TRN4              H0101 pmþúASMB,R,L,C ** $TRRN RN-LU SYSTEM ROUTINES ** HED ** REAL-TIME EXECUTIVE $TRRN RN-LU SYSTEM ROUTINES ** * NAME: $TRRN * SOURCE: 92067-18109 * RELOC: PART OF 92067-16103 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $TRN4,0 92067-16103 REV.1903 780104 * EXT $RNTB,$IDNO,$SCD3,$SCLK,$ULLU,$CGRN ENT $TRRN,$CRN#,$ULU * SUP A EQU 0 B EQU 1 * * * $TRRN IS THE RN/LU LOCK CLEAN UP ROUTINE. * IT IS CALLED BY THE DISPATCHER WHEN EVER A PROGRAM COMPLETES * (THE CALL IS BY WAY OF THE REENTRENT CLEAN UP ROUTINE. * * ITS FUNCTION IS TO RELEASE ANY LOCAL LOCKS AND ANY LOCAL * ALLOCATIONS THE PROGRAM HAS. IT ALSO RELEASES ANY LU * LOCKS THE PROGRAM HAS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JSB $TRRN * NORMAL RETURN REGISTERS MEANING LESS * * $TRRN JMP TEMP1 INITIALIZATION ON FIRST JMP HERE JSB $ULLU RELEASE ANY LU LOCKS / SET UP TEMPS LDA D$RN SET THE TABLE ADDRESS FOR STA TEMP1 BOTH LOOPS STA TEMP2 LDA A,I GET THE TABLE SIZE CMA,INA,SZA,RSS SET NEGATIVE / IF ZERO EXIT JMP $TRRN,I * STA TEMP3 SET LOOP COUNTERS STA RQP8 FOR BOTH LOOPS * TRRN1 ISZ TEMP2 DALLOCATE LOOP LDA TEMP2,I GET THE RN ALF,ALF PUT OWNER FLAG IN LOW A AND B377 MASK CPA RQP5 IF OWNED BY COMPLETING STA TEMP2,I PROGRAM FLAG FOR NEXT LOOP ISZ RQP8 STEP COUNTER JMP TRRN1 LOOP IF NOT DONE * TRRN3 ISZ TEMP1 ¼pþúLOCAL LOCK LOOP LDA TEMP1,I GET THE RN AND B377 IF LOCAL LOCK CPA RQP5 TO COMPLETING PROGRAM JMP TRRN6 GO RELEASE THE LOCK * TRRN4 ISZ TEMP3 STEP COUNT JMP TRRN3 IF NOT DONE LOOP * LDB TEMP2 GET THE DEALLOCATE FLAG LDA D$RN AND THE ALLOCATE SUSPEND FLAG SZB,RSS IF ANY DEALLOCATED JSB $SCD3 SCHEDULE ANY WAITING PROGRAMS JMP $TRRN,I RETURN * TRRN6 XOR TEMP1,I CLEAR THE LOCK STA TEMP1,I FLAG AND RESET SZA,RSS IF DEALLOCATED STA TEMP2 SET FLAG FOR END OF LOOP JSB SRNW SCHEDULE ANY WAITERS FOR THIS RN JMP TRRN4 RETURN TO LOOP SKP * $CGRN IS THE CLEAR GLOBAL RN ROUTINE FOR USE BY DRIVERS * AND OTHER SUCH USER WRITTEN SYSTEM PROGRAMS * * CALLING SEQUENCE: * * LDA RN SET A TO USER RN WORD * JSB $CGRN CALL THIS ROUTINE * RETURN REGISTERS MEANING LESS. * $CRN# RBL,RBL SET DMS STATUS FOR OUR STB DMRTN RETURN STA B SAVE THE RN NUMBER AND B377 CACULATE THE TABLE ADA D$RN ADDRESS STA TEMP1 AND SET IT LDA B GET RN WORD AGAIN IOR B377 SET THE GLOBAL FLAG CPA TEMP1,I IS THIS A LEGAL RN? RSS YES SKIP JMP DONE NO RETURN NO ACTION AND C377 CLEAR THE RN STA TEMP1,I AND RESET IT JSB SRNW SCHEDULE ANY WAITING PROGRAMS DONE JRS DMRTN $CGRN,I RETURN TO CALLER SPC 3 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (TEMP1) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA TEMP1 GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN SKP * * THIS SUBROUTINE RELEASES ALL LU'S LOCKED BY A PROGRAM * AND SCHEDULES ANY PROGRAMS WAITING FOR AN * LU OR AN RN. * * CALLING SEQUENCE: * Ý«þú * LDB ID ADDRESS * JSB $ULLU * RETURN - REGISTERS MEANNINGLESS * $ULU RAL,RAL FIX STATUS FOR RETURN STA DMRTN AND SAVE JSB $IDNO GET THE ID NUMBER STB RQP5 SET FOR $TRRN BLF,BLF PUT THE FLAG WORD STB RQP6 IN HIGH END ADB RQP5 AND IN BOTH ENDS STB RQP7 SET IN RQP7 LDA LUMAX SET UP TO SCAN THE CMA,CLE,INA DRT STA TEMP2 * LDA DRT GET THE DRT ADDRESS STA TEMP3 AND SET FOR LOOP ULLU1 LDA TEMP3,I SEARCH FOR ALL AND B3700 LOCKED LU'S SZA THIS ONE LOCKED? JMP ULLU4 YES - GO TEST * ULLU2 ISZ TEMP3 NO / YES STEP TO NEXT ENTRY ISZ TEMP2 IF NOT DONE JMP ULLU1 TRY NEXT ONE * CLB,SEZ,RSS IF NONE RELEASED JMP RTNDM JUST EXIT * STB TEMP1,I CLEAR THE RN JSB SRNW SCHEDULE RN WAITERS LDA D$RN AND ALLOCATION JSB $SCD3 WAITERS RTNDM JRS DMRTN $ULLU,I RETURN * DMRTN NOP DMS STATUS WORD * ULLU4 CLB LSL 10 SHIFT LOCK FLAG TO LOW B ADB D$RN AND INDEX INTO THE RN TABLE LDA B,I GET THE RN FLAG CPA RQP7 CURRENT PROGRAM? CCE,RSS YES SKIP JMP ULLU2 NO CONTINUE SEARCH * STB TEMP1 YES SET ADDRESS FOR SCHEDULE LDA TEMP3,I GET THE DRT ENTRY AND C3700 CLEAR THE FLAG STA TEMP3,I RESET IT AND JMP ULLU2 CONTINUE SEARCH * D$RN DEF $RNTB B377 OCT 377 C377 OCT 177400 B3700 OCT 3700 C3700 OCT 174077 SPC 2 TEMP1 STA D$RN INITIALIZE CODE TEMP2 LDB B,I GET ADDRESS OF TEMP3 JMP $SCLK D.RTR AND GO START CLOCK * DRT EQU 1652B LUMAX EQU 1653B RQP5 EQU 1704B RQP6 EQU 1705B RQP7 EQU 1706B RQP8 EQU 1707B * ORG * PROGRAM LENGTH END $TRRN K¡ÿÿ ÿý*3 ÿ92067-18110 2040 S C0122 &SCHD4 SCHEDULER MODULE             H0101 ÈšþúASMB,L,C,Q,Z ** RT SCHEDULER MODULE ** NON-DEBUG *ASMB,L,C,Q,N ** RT SCHEDULER MODULE ** DEBUG * HED RTE SCHEDULER/MESSAGE PROCESSOR * NAME: SCHED * SOURCE: 92067-18110 * RELOC: 92067-16103 * PGMR: G.A.A.,L.W.A.,D.L.S.,C.M.M.,G.L.M. * DATE: 6/27/78 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SCHD4,0 92067-16103 REV.2040 800731 * * SUP PRESS EXTRANIOUS LISTING ******************************************************************* * HISTORY * * *G.A.A. RTE 2 VERSION JULY 1973 *L.W.A. RTE 3 VERSION APRIL 1975 *D.L.S. ENHANCEMENTS MAY 1977 *C.M.M. RTE 4 VERSION JAN 1978 *G.L.M. RTE 4 SM VERSION JUN 1978 * ******************************************************************* * * SCHED ENTRY POINT NAMES * ENT $ABRT,$TYPE,$PRSE,$CNV1,$CNV3,$OP ENT $MPT1,$MPT2,$MPT3,$MPT4,$MPT5,$MPT6 ENT $STRT,$INER,$MPT7,$ASTM,$WATR,$SZIT ENT $MPT8,$IDSM,$PBUF,$EX6 ENT $MPT9,$RTST,$CVWD,$STRG ENT $MSEX,$LSTM,$RLNK,$SVAL,$SPRI ENT $LST,$SCD,$ID#,$MSG,$SCXX EXT $LMES,$CES ENT $BRKP * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG,$DREQ EXT $DLP,$PLP,$MPFT,$MEU EXT $CMST,$COML,$SDA,$SDT2,$RLB,$RLN EXT $MPSA,$MPS2,$IDEX EXT $IOCL,$OTRL,$DREL,$CHTO,$LUPR,$EQST EXT $MESS,$LIST,$IDNO,$SCD3,$CNFG EXT $ERAB,$ZZZZ,$TIME,$PVCN,$MNP EXT $ERIN,$NOPG,$OPER,$ILST,$NOLG,$LGBS,$NMEM EXT $XEQ,$TMRQ,$ONTM,$ALC,$RTN,$WORK EXT $BRED,$TIMR,$ETTM,$TIMV,$TREM EX½þúT $RNTB,$CREL,$YMG,$SDRL EXT $ALDM,$DMAL,$MATA,$PRCN EXT $MBGP,$MRTP,$MCHN,$MAXP EXT $BFOT,$LU?? ALDM EQU $ALDM DMAL EQU $DMAL PRCNG EQU $PRCN * ******IFN SYSTEM SESSION CONSOLE WORK EXT !BITM,$SHED,$SMST,$DSCS ******XIF * * *******************MEU INSTRUCTIONS*********** ********************************************** EXT $BLLO,$BLUP * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* HED --BUFFERS, CONSTANTS, POINTERS, ETC * TEMP LDA EQT11 ***TEMPORARY WORKING STORAGE AREA TEMP1 STA TEMP5 * TEMP2 LDB EQT12 * TEMP3 STB TEMP6 * TEMP4 JSB $RTN * THESE TEMPS ARE USED TO INITIALIZE TEMP5 NOP *** SYSTEM AVAILABLE MEMORY. TEMP6 NOP * AND ALSO TMP JMP $ALC * USED BY $PARS AS CONTIGUOUS BUFFER SPACE NOP ?? WORK EQU $WORK WPRIO NOP * ASCI BSS 1 * ASCI1 BSS 1 *** ASCI2 BSS 1 DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D14 DEC 14 D15 DEC 15 D17 DEC 17 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B177 OCT 177 B377 OCT 377 * ZERO REP 5 NOP DEF0 DEF ZERO * * RETRN NOP DMST NOP DMM5 DEC -5 D22 DEC 22 NWCNT NOP HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! 9 þú ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O L R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! Hšþú ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 29 ID EXTENSION # (15-10) EMA SIZE (9-0) * ! ! ! ! ! ! * 30 HIGH MAIN + LARGEST SEGMENT + 1 ( = 0 IF NO SEGMENT) * ! ! ! ! ! ! * 31 SESSION MONITOR WORD 1 * ! ! ! ! ! ! * 32 SESSION MONITOR WORD 2 * ! ! ! ! ! ! * 33 SESSION MONITOR WORD 3 * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SPC 5 * <<<<<<<<<>>>>>>>> SPC 5 * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * 1 NS / CURRENT MSEG # / # PAGES MSEG * ! ! ! ! ! ! * 2 MSEG STRT PAGE #/DE/ EMA START PAGE PHYSICAL * ! ! ! ! ! ! * 3 /# OF TRACKS FOR EMA SWAP * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 SKP * WHERE THE FLAG BITS MEAN: * * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP„­þú) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * L = LOAD IN PROGRESS * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * NS = 0/1 MSEG POINTING TO STD SEGMENT(SET BY .EMAP) / * MSEG POINTING TO NON STD SEG (SET BY .EMIO)/ * DE = SET IF EMA SIZE WAS DEFAULTED * * * $LIST STATE TRANSITION TABLE: * * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * * 0- OP SUSPEND BIT IS A DEFERRED ACTION BIT. SUSPEND ON NEXT SCHEDULE * ATTEMPT. CAN'T DO IT NOW BECAUSE PROGRAM IS OP SUSPENDED OR * IN THE TIME LIST. * * W- WAIT BIT (EXEC 9 & 23) THIS PROGRAM SCHEDULED ANOTHER WITH WAIT. * ID ADDRESS OF PERSON HE­9þú SCHEDULED IS IN 2ND OF WORD OF ID. * * R- SAVE RESOURCES WHEN SETTING DORMANT. NOT LEFT IN ID SEG AFTER * PROG IS SET DORMANT. * * D- DORMANT BIT IS A DEFERRED ACTION BIT. IT MEANS TO SET THE * PROGRAM DORMANT ON THE NEXT SCHEDULE ATTEMPT. WE CAN'T DO IT * NOW BECAUSE HE IS I/O SUSPENDED. * * * * * THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. * * ONE FINAL NOTE TO THE UNWARY. THE CODE OF THE LIST PROCESSOR * IN NO WAY FOLLOW THE CHART BELOW. THE CHART IS TO GIVE THE * READER AN IDEA OF WHAT THE FOREST LOOKS LIKE NOT THE TREES. * DON'T MAKE THE MISTAKE OF THINKING THAT THE CHART SHOWS HOW * ANYTHING IS DONE. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1oþú X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O 16.0 X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!-„Sþú----- * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE & B = PROG ID ADDRESS * IF A NOT= 0, THE A = ASCII ERROR CODE ADDRESS * & B CONTAINS DECIMAL ERROR CODE * * * ADDRESS CODES OF 0, 6, & 7 ARE RESERVED FOR * DRIVERS. THE ONLY FUNCTION CODE ALLOWED WITH * THESE ADDRESS CODES IS 1 (SCHEDULE) * IF SUCCESSFUL A = 0 ELSE * B = 3 ILLEGAL STATUS * B = 5 NO SUCH PROG * * FOR A DRIVER THAT WANTS TO CONVERT A PROG NAME * TO AN ID ADDRESS : JSB $LIST * OCT 217 * DEF PNAME (PROG NAME) * * THIS PERFORMS A SIMPLE LIST MOVE LIKE CHANGES TO PRIORITY. * (IF THE PROGRAM IS DORMANT ITS A BIG NOP ). UPON * A SUCCESSFUL RETURN (A = 0) B WILL BE THE ID ADDRESS * OF THE PROGRAM. IF THE PROGRAM IS SCHEDULED MANY TIMES * DOING THIS REMOVES TèþúHE SEARCH TIME FOR THE ID SEG OF * THE PROGRAM. * * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMORY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * ADDRESS CODE * 0 = ID SEGMENT ADDRESS(5 PARAMETERS PASSED) * 1 = ID SEGMENT ADDRESS(AS NEXT OCT VALUE) * 2 = ASCII PROGRAM NAME ADDRESS(A DEF) * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEGMENT ADDRESS (NEXT PRAM IS VALUE TO * PUT INTO B REG @ SUSP) * 7 = ASCII PROG NAME (PASSES 5 PARAMETERS) * * * * FOR EXAMPLE * * ---0,7,& 6 (FOR DRIVERS)------- ---1---- ---2---- ----3----- * - - - - - - - - * * JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST * OCT 001 OCT 701 OCT 601 OCT 1XX OCT 2XX OCT 3XX * DEF RETRN DEF RETRN OCT IDADR OCT IDADR DEF PNAME ID ADR IN $WORK * OCT IDADR DEF PNAME OCT BVAL * DEF PRAM1 DEF PRAM1 * DEF PRAM2 DEF PRAM2 * DEF PRAM3 DEF PRAM3 (NO INDIRECT DEFS !!) * DEF PRAM4 DEF PRAM4 * DEF PRAM5 DEF PRAM5 * * * * ---4----- ------5-------- * - - - - * * JSB $LIST JSB $LIST * OCT 4XX OCT 5XX * ID ADR IN B REG ID ADR IN XEQT * * * * * SKP * * µÈþú ************** WATCH THE E REGISTER ****************** * * * ENTRY MADE BY $LIST NOP * RSA * SJP $LIST * * $LST RAL,RAL ROTATE THE DMS STATUS AND SAVE STA DMST NOW PUT DMS STATUS IN E-REGISTER RAL,ELA E = 0/1 CALL CAME FROM SYS/USER MAP * LDA $LIST GET ADDRESS OF CALL STA $LSTM SAVE FOR CRASH DUMP ANALIZER ( HOPE WE * NEVER USE IT !!!!!!) SEZ (E= 0/1 CAME FROM SYS/USER MAP) JMP UMAP1 CALL CAME FROM THE USER MAP ! * LDA $LIST,I CALL FROM SAME MAP (SYSTEM MAP) AND D15 PUT FUTURE STATUS INTO L0091 STA L0091 STORE AWAY FUNCTION CODE XOR $LIST,I FORM ADDR CODE * LIST1 ALF,ALF AND PUT INTO LOW END RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD * SEZ WHICH MAP ? JMP UMAP2 USER MAP (ALTERNATE MAP) * LDB $LIST,I THIS MAP SO GET IT TO B LIST2 CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP * CPA D2 DOES B POINT TO AN ASCII NAME ? JMP DL02 YES SO SEE IF THE PROGRAM EXISTS CPA D6 JMP DL06 * STB RETRN B MUST BE A RETURN ADDRESS ISZ $LIST BUMP TO THE PROGRAM ADDRESS OR NAME LDB $LIST AND SAVE AS A POINTER STB TEMP1 FOR PARAMETER PASSING LDB RETRN GET THE RETURN ADDRESS CMB,INB DECREMENT WITHOUT AFFECTING E-REG CMB STB $LIST THIS THEN SETS UP RETURN ADDRESS * SEZ WHICH MAP JMP UMAP3 STILL THE USER MAP LDB TEMP1,I GET THE ID ADDÎ>þúRESS OR PROG NAME ADDR * LIST3 CPA D7 ASCII PROGRAM NAME ? JMP DL07 YES SZA,RSS ID ADDRESS JMP DL00 YES * * * L0075 LDA $ILST ILLEGAL STATUS MESSAGE LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 * SPC 6 * * * * UMAP1 XLA $LIST,I GET THE REQUEST CODE AND D15 SAVE LOWER BITS STA L0091 SOCK IT AWAY AS FUTURE STATE OF PROGRAM XLA $LIST,I GET IT AGAIN XOR L0091 NOW GET THE UPPER BITS JMP LIST1 NOW GO SEE WHAT TYPE CALL * * UMAP2 XLB $LIST,I GET POSSIBLE ID ADDRESS JMP LIST2 AND CONTINUE * * UMAP3 XLB TEMP1,I GET ID ADDRESS OF PROGRAM NAME ADDRESS & JMP LIST3 CONTINUE HED LIST PROCESSOR--REQUEST CODE DETERMINATION * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * DL02 SEZ IS NAME IN THIS MAP JSB PLNAM NO, SO PULL IT IN LOCALLY JSB TNAME NOW ID ADDR IN B REG SEZ,RSS SKIP IF NOT FOUND OR SHORT ID JMP L0021 GO SET UP WORK ADDRESSES * NPRG LDA $NOPG GET THE NO SUCH PROG ADDRESS LDB D5 AND THE NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * L0060 LDB WORK GET ID SEGMENT ADDRESS L0021 JSB DORM? GO SET UP WORK ADDRESSES * LDB L0091 GET THE REQUEST CODE SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE SPC 3 HED LIST PROCESSOR--DRIVER SERVICING SECTION. * * THIS PROCESSES LIST CALLS OF 0, 6, & 7. THESE ARE RESERVED * FOR DRIVERS. THE OPERATING SYSTEM MAKES THE ASSUMPTION * THAT IF YOU KNOW HOW TO CALL $LIST YOU KNOW WHAT YOUR * DOING.f¹þú IN ADDITION, IF A DRIVER WANTS A PROGRAM IT WANTS * IT IN A HURRY. THUS $LIST DOES MINIMAL ERROR CHECKING FOR * DRIVERS (AND NONE FOR THE OP SYSTEM). HERE A CHECK IS MADE * ONLY TO SEE IF THE PROGRAM IS DORMANT (ALSO IF THE PROGRAM * EXISTS IF THE CALL WAS BY NAME RATHER THAN BY ID ADDRESS). * NO SIZE CHECKS OR EMPTY ID CHECKS ARE MADE. IF YOUR KNOW * ENOUGH TO CALL $LIST, YOU KNOW ENOUGH TO MAKE SURE THE * PROGRAM EXISTS AND THAT THERE IS A PARTITION TO RUN IT IN. * THE REAL ADVANTAGE TO THIS PHILOSOPHY IS THAT DRIVERS ARE * GIVEN OP SYSTEM STATUS AND THEREFOR OP SYSTEM SPEED IN * PROGRAM SCHEDULING. THE SYSTEM WILL SCHEDULE THE PROGRAM AS * FAST AS IT POSSIBLY CAN. * HINT. IF YOUR SCHEDULING DISC RESIDENT PROGRAMS, HAVE THEM * TERMINATE SAVING RESOURCES OR SERIALLY REUSABLE. IT WILL * SAVE LOTS OF DISC TIME. * * * * DL07 SEZ WELL WHICH MAP IS IT IN ? JSB PLNAM ALTERNATE MAP, SO PULL IN LOCALLY JSB TNAME GET THE ID ADDRESS SEZ DID THE PROGRAM EXIST ? JMP NPRG NO, SO TELL THE FOLKES * DL00 JSB DORM? SET UP THE $LIST PRAMS & SEE IF DORMANT SZA PROG DORMANT ? JMP L0075 NO, TELL THE DRIVER TO FORGET IT JSB PRAMX GO PICK UP THE PARAMETERS JMP L0275 GO SCHEDULE THE PROGRAM * DL06 ISZ $LIST BUMP TO FUTURE B-REG @ SUSP(SETS RETURN ADDR) SEZ WHICH MAP ? JMP DL061 THE OTHER ONE. * LDA $LIST,I GEY THE B REG @ SUSP DL062 STA TEMPX AND SAVE TEMPORARIALLY JSB DORM? SET UP LIST PARAMETERS & CHK FOR DORMANT SZA PROG DORMANT ? JMP L0075 TELL DRIVER TO FORGET IT. LDB WORK GET THE ID ADDRESS ADB D10 AND INDEX TO THE B REG @ SUSP WORD LDA TEMPX GET THE VALUE STA B,I AND PUT IT IN THE ID SEG JMP L0275 NOW GO SCHEDULE THE PROGRAM * DL061 XLA $LIST,I GET øðþúTHE B REG AT SUSP VALUE JMP DL062 CONTINUE * * SKP * HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * IOR WSTAT,I MERGE THE CURRENT STATUS AND CL.NP CLEAR NO PARMS BIT L0105 STA WSTAT,I RESET THE NEW STATUS JMP L0014 GO TO EXIT * L0115 LDA WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 (CLEAR 5 TEMP WORDS TO 0) JSB PRAM LDB WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED ADB D6 INDEX TO TYPE WORD LDA B,I AND CLEAR AND NCLAM THE CORE LOCK AND ALL OF MEMORY STA B,I BITS CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THÔœþúE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN LDB WORK RETURN THE ID ADDRESS L0015 ISZ $LIST STEP TO RETURN ADDRESS JRS DMST $LIST,I LOOK MA ! NO LABEL !! SPC 1 SPC 1 L0350 SLB,RSS IF RESOURCE BIT NOT SET JMP L0115 GO MAKE DORMANT CPA D6 IF OPERATOR SUSPENDED JMP L0103 GO SET DORMANT BIT TOO. * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR THE "R" AND "D" BITS LDB WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 $LSTM NOP DON'T MOVE OR REARRANGE THESE THREE L0090 NOP WORDS. CRASH DUMP ANALIZER USES THEM. L0091 NOP SPC 1 NCLAM OCT 177637 CL.NP OCT 157777 HED LIST PROCESSOR--SCHEDULE REQUEST * * SCHEDULE REQUEST * * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT ADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND * REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * NOTE: THE ID TIMESLICE WORD IS SET TO A 1 TO INDICATE * A NEW SCHEDULE HAS BEEN PERFORMED. * * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD * SZA IF DORMANT OR CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 …=þúRBL DORM BIT TO 15 L0271 CLA,INA SET A FOR SCHEDULE SSB IF DORM BIT SET JMP L0100 GO SET DORMANT * * CHECK FOR SERIALLY REUSABLE OR SAVE RESOURCES * OR OP SUSPEND TERMINATION LAST TIME THROUGH . * * LDB L0090 GET THE CURRENT STATUS SZB IF 0 CPB D6 OR 6 RSS THEN CHECK ON THE PROGS LAST PARTITION JMP L0290 ELSE GO SCHEDULE THE PROGRAM * L0275 LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I GET THE TYPE AND D15 ONLY CPA D1 NOW IF ITS MEMORY RES, THEN NO PARTITION JMP L0290 SO, WE JUST SCHEDULE * ADB D7 MUST BE 1ST DISPATCH & DISC RES LDA B,I GET THE PARTITION WORD AND B77 AND USE IT TO INDEX INTO THE MPY D7 $MATA TABLE ADA $MATA ADA D3 GET TO THE D BIT WORD LDA A,I AND PULL IT IN AND B20K MASK IT SZA,RSS IS IT SET ? JMP L0290 NO, SO GO SCHEDULE * LDA WORK GET THE ID ADDRESS TP 1 JSB DMAL AND SEE IF HE IS STILL IN THE PARTITION. * L0290 CLA,INA SET FOR SCHEDULE STA WTSLC,I INDICATE NEW SCHEDULE JMP L0130 AND DO IT TO IT !!! * * * * * L0220 RBL,SLB CHECK RESOURCE BIT JMP L0230 IF SET GO CLEAR OP-SUSP SSB IF DORM BIT SET JMP L0271 GO MAKE DORMANT * L0230 XOR B1006 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDB WSTAT,I GET THE WHOLE STATUS WORD BLF,BLF SHIFT LEFT EIGHT. LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, GO SCHEDULE. * ðRþúXOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT, THEN ENTER INTO OPERATOR SUSPEND LIST * IF ALREADY OPERATOR SUSPEND, THEN STATUS ERROR EXIT * IF SCHEDULED, THEN ENTER INTO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, THEN OPERATOR-SUSPEND BIT SET * L0300 CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * CCE,SZA IF DORM WITH RESOURCES SKIP JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * ELA,ELA IF DORM BUT IN TIME LIST ADA WSTAT LDA A,I AND B10K THEN SET O BIT SZA IN TIME LIST ? JMP L0310 YES * LDB WSTAT,I GET FULL STATUS WORD SZB,RSS ENTIRE STATUS WORD = 0 ? JMP L0075 YES, ITS AN ERROR * LDA B306 ELSE SET "R" AND "D" BITS AND IOR B PUT IN OP-SUSP LIST JMP L0130 * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS IOR WSTAT,I JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B306 OCT 306 B1006 OCT 1006 CLD.R OCT 57460 D21 DEC 21 SKP * * THE PLNAM SUBROUTINE PULLS THREE WORDS OUT OF THE ALTJ|þúERNATE * MAP (ASCII PROGRAM NAME). THE ROUTINE IS TYPICALLY CALLED * DIRECTLY BEFORE TNAME SO THAT THE PROGRAM NAME IS LOCAL AND * THE ID SEGMENTS CAN BE SEARCHED. * * * CALLING SEQUENCE LDB ADDRESS OF THREE WORD ARRAY * JSB PLNAM * * ON RETURN B = LOCAL ADDRESS OF ARRAY * A = DESTROYED * * PLNAM NOP XLA B,I GET THE 1ST ONE STA PNAME AND SAVE IT INB DO THIS TWO MORE TIMES XLA B,I STA PNAME+1 INB XLA B,I STA PNAME+2 LDB DPNAM JMP PLNAM,I * DPNAM DEF PNAME PNAME BSS 3 DON'T REARRANGE THESE WORDS OR MOVE THEM TEMPX NOP I NEED THEM LATER FOR CONTIGIOUS SPACE TEMPY NOP IN THE PRAMX ROUTINE TEMPZ NOP * * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR FOR * ALL CALLS IT'S PRIMARY FUNCTION IN LIFE IS TO SET UP * WORK, WPRIO, WSTAT, AND L0090. IN ADDITION IT RETURNS * L0090, THE PROGRAMS CURRENT STATUS IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6, AND 7 (THE DRIVER $LIST * CALLS) USE THIS TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE LDB ID ADDRESS * JSB DORM? * ON RETURN A-REG = CURRENT STATUS 0-6 * * DORM? NOP STB $WORK SET UP THE ID ADDRESS FOR LATER ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD LDA B,I GET THE OLD STATUS AND D15 KEEP ONLY STATUS STA L0090 SET UP THE STATUS WORDTATUS ADB D15 ADVANCE TO ID 30 STB WTSLC AND DEFINE TIMESLICE WORD JMP DORM?,I RETURN TO THE CALLER * WTSLC NOP HED SET UP ID SEGMENT TEMP PARAMETERS * * * THE PRAMX SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ADDRESS CODES OF 0 & 7. THESE ADDRESS CODES * HAVE BEEN RESERVED FOR DRIVERS WHO WISH TO SCHEDULE!`þú * PROGRAMS. THE SUBROUTINE CALLS EITHOR THE PRAM OR * XPRAM SUBROUTINE TO STUFF THE PARAMETERS INTO THE PROGRAMS * ID SEGMENT TEMP AREA. PRAM IS CALLED IF THE DRIVER CALLED * $LIST FROM THE SYSTEM MAP, XPRAM IS CALLED IF THE DRIVER * IS IN THE SYSTEM MAP. * ACTUALLY PRAMX IS ONLY CALLED ONCE & THUS NEED NOT BE A * SUBROUTINE. HOWEVER, FOR THOSE WHO MUST READ THIS CODE * IT HELPS SEPERATE THE LIST MOVE PROBLEM FROM THE PARAMETER * MOVE PROBLEM AND MAKES THE CODE MUCH EASIER TO READ & * UNDERSTAND. * * * CALLING SEQUENCE JSB PRAMX * * $WORK HAS PROG ID ADDRESS * DMST HAS THE DMS STATUS IN IT * TEMP1 POINTS TO THE WORD BEFORE THE PARAMETER LIST * RETRN HAS RETURN ADDRESS OF THE LIST CALL * * RESTRICTIONS - ASSUMPTIONS * 1) DEFS IN THE $LIST CALL MUST BE DIRECT * (NEED NOT APPLY IF DRIVER IN SYSTEM MAP) * 2) AT LEAST ONE PARAMETER MUST BE SUPPLIED (IE 1 DEF) * 3) RETURN ADDRESS MUST DELIMIT PARAMETER LIST. * 4) 5 PARAMETERS MAX * * PRAMX NOP ISZ TEMP1 BUMP $LIST TO POINT TO 1ST PRAM LDB RETRN GET RETURN ADDRESS CMB,INB AND USE THIS TO ADB TEMP1 SEE HOW MANY PARAMETERS TO PASS STB DM5 SAVE TO FAKE OUT PRAM OR XPRAM * LDA DMST NOW GET THE DMS STATUS RAL,ELA E = 1 MEANS CALL FROM USER MAP SEZ,RSS WELL, WHICH MAP ? JMP PRMEX SYS MAP , SO GO STUFF THE PRAMETERS * CMB,INB USER, SO PULL ADDRESSES IN LOCALLY CBX PUT # IN X LDA TEMP1 GET SOURCE LDB DPNAM AND DESTINATION MWF AND BRING EM IN. * LDA WORK NOW GET THE PROGRAMS ID ADDRESS LDB DPNAM AND THE LOCAL ADDRESS ADB SIGN MAKE IT ADDRESS INDIRECT JSB XPRAM AND GO STUFF THE ID SEGMENT JMP PRMX3 NOW GO RETURN * PRMEX LDA WORK ID ADDRESS TO A LDB TEMP1 ADDRESS OF PARAMETERS TO B ADB SIGN SET THE SIGN BIT TOþúO JSB PRAM GO STUFF THE ID SEGMENT * PRMX3 LDA DMM5 GET A -5 BACK TO STA DM5 LOCATIOM DM5 SO THAT THE OTHER PROCESSORS JMP PRAMX,I ARE HAPPY. - RETURN TO CALLER - * * * * HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR SECTION OF THE HP-21XX REAL TIME * EXECUTIVE * 1. REMOVES A PROGRAM FROM A LIST * AND * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * NOTE: THE ROUTINE $RLNK PROVIDES AN INTERFACE BETWEEN THE * RTIME MODULE AND THE LINK PROCESSOR. IT'S FUNCTION * IS TO MOVE A PROGRAM BEHIND ALL OTHER PROGRAMS (OF THE * SAME PRIORITY) IN THE SCHEDULED LIST. THIS ROUTINE IS * CALLED ONLY WHEN A TIMESLICED PROGRAM HAS USED A FULL * TIMESLICE. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUSt8þú PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LINK,I FORGET IT ????????????????????????????? CPB WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION. * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS <þú WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA WORK,I LINK THIS TO FOLLOW WORK LDA WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS WSTAT NOP WORK STATUS ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 SKP * * $RLNK ALLOWS THE RTIME MODULE TO MOVE A PROGRAM BEHIND ALL * OTHER PROGRAMS OF THE SAME PRIORITY IN THE SCHEDULED LIST. * THIS IS ACCOMPLISHED BY CALLING LINK TO REMOVE THE PROGRAM * FROM THE SCHEDULED LIST AND THEN INSERT THE PROG BACK INTO * * * $RLNK NOP LDA XEQT DEFINE THE PROGRAM STA WORK TO BE RELINKED LDA XPRIO DEFINE IT'S STA WPRIO PRIORITY ALSO * CLA,INA REMOVAL CODE (SCHEDULED LIST) CLB,INB INSERTION CODE (SCHEDULED LIST) STA $LIST FORCE A SCAN OF SCHEDULED LIST * JSB LINK GO DO IT JMP $RLNK,I RETURN SKP * THE SAME LIST (SCHEDULED LIST). HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * * 1. TURN ON A PROGRAM * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIMEi^þú CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A SLOT OR DEVICE DOWN. * DN,N1 * DN,,N2 * 11. SET A SLOT AND DEVICES UP * UP,NN * 12. LOGICAL UNIT SWITCH AND STATUS * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 * 23. SIZE REQUEST/CHANGE * SZ,XXXXX * SZ,XXXXX,P1 * SZ,XXXXX,P1,P2 * 24. ASSIGN PROGRAM TO PARTITION * AS,XXXXX,N * 25 UNRESERVE A PARTITION * UN, N * 26 EXAMINE OR ALTER TIMESLICING PARAMETERS * QU,ZZZZZ,XXXXX * * * * * SPC 3 * IN GENERAL THERE ARE TWO CLASSES OF COMMANDS. THOSE THAT PERFORM * A SERVICE IN WHICH SPEED IS OF IMPORTANCE (RU, ON, OF ETC) AND * AND THOSE COMMANDS WHICH GIVE STATUS INFORMATION OR WHICH MUST * BE ENTERED BEFORE A PROGRAM IS RUN. IN THE FORMER CASE A CONSIDERABLE * AMOUNT OF EFFORT IS SPENT EXECUTING THE COMMAND AS FAST AS POSSIBLE. * IN THE LATER CASE EFFORT IS SPENT IN MAKING THE CODE AS SMALL AS * POSSIBLE SO AS TO SAVE ROOM. * * HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIS ROUTINE ÎùþúASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * MESS MUST KEEP TRACK OF WHICH MAP THE CALLER CAME IN FROM * IF THE ENTRY TO $MESS IS FROM THE SYSTEM MAP THEN THE CALL * WAS FROM THE $TYPE ROUTINE. IF FROM THE USER MAP THEN THE * CALL IS FROM THE SYSTEM LIBRARY ROUTINE MESSS. (PRMPT & * R$PN$ THING) * IF FROM $TYPE, THEN INPUT BUFFER = INBUF * OUTPUT BUFFER = INBUF * IF FROM MESSS, THEN INPUT BUFFER PULLED IN LOCALLY TO * IBUFX * OUTPUT BUFFER = THE PROCESSOR'S BUFFER * GENERALLY SHARED W/PARSE * BUFFER. * * * ENTRY MADE BY $MESS NOP * SSM $MEU * SJP $MSG * * NOTE: BFCNT=BUFFER CHAR COUNT (USED BY "OP") * BFADD=BUFFER LOCATION " " * * * $MSG STA BFADD SAVE INPUT BUF ADDRESS FOR STRING ROUTINE STA OP INVALIDATE PREVIOUS CMND (GLM.2013) STB BFCNT SAVE COUNT FOR STRING ROUTINE TOO. STB NWCNT ONE MORE TIME. * LDA $MEU GET THE DMS STATUS RAL,RAL ROTATE THE STATUS FOR STA $MEU OUR RETURN TRIP * SSB IF NEG ITS AN ERROR JMP $INER SZB,RSS IF THE CHAR COUNT = 0 JMP M0150 JUST RETURN * RAL,ELA PUT DMS STATUS IN E REG (0/1 SYS USER) LDA BFADD GET THE BUFFER ADDRESS BACK AGAIN SEZ,RSS WELL, WHICH MAP ? JMP ©ŠþúNMESS SYSTEM (SYSTEM CONSOLE) * INB CONVERT CHAR COUNT TO BRS WORD COUNT (DIVIDE BY 2) CBX SAVE WORD COUNT FOR MOVE * ADB DM41 NOW CHECK OUT WORD COUNT SSB GREATER THAN 22 WORDS ? JMP GTMES NO,SO PULL IT IN LOCALLY LDB D40 YES, SO ONLY PULL IN 22 WORDS ANYWAY CBX SAVE FOR MOVE RBL NOW CONVERT TO CHARACTERS FOR $PARS ROUTINE STB NWCNT * GTMES LDB IBUFX GET THE DESTINATION STB BFADD SAVE BUFF ADDR FOR OP COMMAND AND STRING PASSING MWF AND MOVE THE WORDS * LDA IBUFX GET THE BUFFER ADDRESS LDB NWCNT AND THE LENGTH NMESS JSB $PRSE AND GO PARSE THE INPUT STRING BUFAD DEF PRAMS * * * HED MESSAGE PROCESSOR--OP REQUEST SEARCH * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. UNL IFN LST CPB DBUG **********DEBUG********** CLB,RSS **********DEBUG********** JMP M0030 **********DEBUG********** STB FLG **********DEBUG********** ENT $DDDT **********DEBUG********** $DDDT JSB $DDT **********DEBUG********** DEF $TYPE+2 **********DEBUG********** DBUG ASC 1,DB **********DEBUG********** PZþú EXT $DDT **********DEBUG********** UNL XIF LST M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT JUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX JRS $MEU $MESS,I RETURN AND RESTORE MEU STATUS MSEX EQU $MSEX D40 DEC 40 DM41 DEC -41 UNL IFZ NON-DEBUG BSS 7 BSS 7 MAKE RELEASED LISTING ALLIGN W/DBUG XIF LST * * * SKP * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 8,RTONOFSSGOSTPRIT $ASTM ASC 9,TMDNUPLUEQLSLGTOTI ASC 8,BRABRUBLSZASURQU * ******IFN SYSTEM SESSION CONSOLE ASC 2,ENOP ******XIF * OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0070 RELEASE PROGRAM'S TRACKS DEF M0100 TURN ON DEF M0200 TURN OFF DEF M0300 OPERATOR SUSPEND DEF M0400 REMOVE OPERATOR SUSPEND DEF M0500 STATUS DEF M0650 PRIORITY CHANGE DEF M0600 INTERVAL TIME CHANGE DEF M0700 REAL TIME CLOCK INITIALIZATION DEF M0800 DN REQUEST DEF $IOUP+0 UP REQUEST DEF M0850 LU REQUEST DEF M0900 EQ REQUEST DEF M0960 LS REQUEST DEF M0970 LG REQUEST DEF M0990 TO REQUEST DEF M0750 TI REQUEST DEF M0725 BR REQUEST DEF M0950 AB REQUEST DEF M0408 RU REQUEST DEF BLIM BL REQUEST DEF SIZE SZ REQUEST DEF ASIGN AS REQUEST DEF URESV UR REQUEST DEF QUTM QU REQUEST * ******IFN SYSTEM/SESSION CONSOLE WORK DEF ENAB EN COMMAND DEF OPIN OP COMMAND ******XIF * DEF OPER OPERATOR ERROR * ON EQU LDOPC+2 RU EQ·þúU LDOPC+20 OF EQU LDOPC+3 ST EQU LDOPC+6 * * HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PRSE * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PRSE NOP CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PRSE,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ~Íþú ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHAR JMP DEC10 YES, SO SKIP CHAR LDB TEMP2 CHECK IF SIX CHARS IN PARM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHAR STA SABRT SAVE THE LAST CHAR ISZ TEMP2 STEP FOR NEXT CHAR * JMP DEC10 GO TO PROCESS NEXT CHAR * * ATTEMPT NUMERIC CONVERSION OF PARM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PRSE,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASEÒjþú TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PRSE STEP RETURN ADDRESS JMP $PRSE,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP HED MESSAGE PROCESSOR--RT,XXXXX COMMAND * * RT,XXXXX * * THE RELEASE TRACKS ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS NOT DORMANT, STATU_ þúS ERROR. * IF DORMANT, ALL TRACKS ASSIGNED TO THAT PROGRAM * ARE RELEASED - ALL PROGRAMS IN DISC TRACK * ALLOCATION SUSPENSION ARE RESCHEDULED. * M0070 JSB TTNAM GO FIND ID SEGMENT ADDRESS ADB D8 PROGRAM MUST BE DORMANT. LDA B,I WILL BE IF POINT OF SZA SUSPENSION IS ZERO. JMP M0405 OTHERWIZE, ILL STATUS ERROR. LDA WORK GET ID SEGMENT ADDRESS JSB $OTRL RESCHEDULE DISC-SUSP PROGRAMS JMP M0150 RETURN- HED MESSAGE PROCESSOR--ON,XXXXX COMMAND * ***************************************************************** * * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * * THE ON REQUEST FUNCTIONS AS FOLLOWS: * IF NO RESOLUTION CODE, THEN PROGRAM SCHEDULED. * IF -NOW- OPTION, THEN ENTER PROGRAM INTO TIME LIST * AND SET TIME VALUES TO CURRENT TIME PLUS 10 MSC * IF NOT ONE OF ABOVE, AND TIME VALUES ARE ZERO THEN * PROGRAM FUNCTIONS SAME AS -NOW- OPTION. * IF NOT ONE OF ABOVE, AND TIME VALUES ARE PRESENT, * THEN PROGRAM IS ADDED TO TIME LIST. * NOTE: 1)ALL THE ABOVE OPTIONS ALLOW PARAMETERS TO BE * PASSED TO THE PROGRAM. THESE MUST BE ASCII * DECIMAL NUMBERS WHICH ARE CONVERTED TO BINARY * AND STORED IN ID SEGMENT TEMP AREA. UPON * EXECUTION, THE B REGISTER WILL POINT TO TEMP. * UP TO 5 PARAMETERS MAY BE INPUT. IF NO PARA- * METERS ARE INPUT, THE TEMP AREA ARE ZEROS BUT * B REGISTER WILL STILL POINT TO TEMP. AREA * 2) THE ABOVE OPTIONS WILL ALLOW THE ORIGINAL * SCHEDULING STRING TO BE SAVED(UNLESS 'IH' * IS SPECIFIED OR THERE ARE NO PARAMETE $þúRS). * THE SCHEDULED PROGRAM MAY RECOVER THIS STRING * WITH AN EXEC 14 CALL. * ******************************************************************** * M0100 JSB TTNAM FIND ID SEGMENT ADDR LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA CHECK IF PROGRAM DORMANT JMP M0405 ILLEGAL STATUS ERROR JSB $SZIT CHECK OUT THE PROGRAM SIZE SZA IS IT OK ? JMP MSEX NO, FLUSH HIM ! * JSB PLOAD GO TO PROCESS CONTROL PRAMETERS LDB WORK ADB D17 COMPUTE RES/T/MULT ADDR LDA B,I ALF,RAR AND D7 CHECK RESOLUTION CODE SZA NONE, SO GO TO SCHED NOW JMP M0110 M0105 JSB $LIST SCHEDULE PROGRAM OCT 301 JMP MSEX RETURN M0110 INB SET B FOR $ONTM LDA CP2 IF ASCII RAR,SLA "NO" ENTERED LDA P2 THEN CPA NO GO PUT CCA IN THE TIME LIST FOR NOW+10MS. JMP $ONTM COMPLETE IN TIME MODULE HED MESSAGE PROCESSOR--OF,XXXXX COMMAND * * OF,XXXXX * OF,XXXXX,1[,NP] "ABORT" * OF,XXXXX,8[,NP] "ABORT AND REMOVE FROM SYSTEM" * * THE NP OPTION SUPPRESSES THE "PROGX ABORTED" MESSAGE. * * THE OF REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT, IT MAY STILL BE IN TIME LIST SO * A CALL IS MADE TO REMOVE PROGRAM FROM TIME LIST * IF ABORT OPTION 1, THEN $ABRT PROCESSOR IS * CALLED. IF ABORT OPTION 8, IN ADDITION TO * $ABRT PROCESSOR BEING CALLED, IF BIT 7 OF THE * TYPE FIELD IS SET, THEN TRACK(S) WHERE PROGRAM * IS STORED IS ALSO RELEASED BY $DREL. THE NAME * FIELD IN THE ID SEGMENT IS CLEARED SO THAT THE * PROGRAM CANNOT BE CALLED AGAIN. * IF PRË7þúOGRAM SCHEDULED OR OPERATOR-SUSPENDED, THEN * DORMANT REQUEST MADE VIA LIST PROCESSOR AND * PROCEED AS ABOVE. * IF PROGRAM STATUS NOT ONE OF ABOVE, THE DORMANT BIT * IS SET IN STATUS, IF NOT ABORT OPTION. IF ABORT * OPTION, CHECK IF AVAILABLE MEMORY OR UNAVAILABL * DISC TRACK SUSPENSION-IN WHICH CASE THE ABORT * BIT IS SET AND $ABRT CALLED. IF STATUS IS I/O * SUSPENSION, SET ABORT BIT AND RETURN. * IF INPUT SUSPENSION, CHECK IF * PROGRAM BEING READ IN FROM DISC. IF YES, THEN * SET ABORT BIT AND RETURN. IF NOT BEING READ IN * FROM DISC, SET ABORT BIT AND CALL $IOCL TO * CLEAR THE I/O REQUEST * M0200 JSB TTNAM GO TO FIND ID SEG ADDR M0202 LDB WORK GET ID SEG ADDRESS AND STB TEMPH SAVE IT IN LOCAL STORE SEZ IF SHORT ID-SEG. JMP M0207 GO TEST FOR 8 * * CLEAR NO-PARMS BIT IN CASE PROG IS IN THE TIME LIST * ADB D15 ADVANCE TO ID16 LDA B,I FETCH IT AND CL.NP REMOVE THE NO-PARM BIT STA B,I RESTORE THE WORD LDB WORK FETCH ID ADDR AGAIN * LDA P2 GET PRAM TWO SZA IF NOT ZERO JMP CHKNP CHECK NO PRINT PARAMETER * M0240 JSB SABRT GO DO SOFT ABORT JMP $XEQ EXIT DONE * CHKNP LDA P3 NO PRINT OPTION CHOSEN? CPA NP STA NOPRN YES, SET THE NO PRINT FLAG M0250 LDA WSTAT,I POWER ABORT SO AND D15 GET CURRENT STATUS SWP PUT ID-SEG. ADDRESS IN A,STAT IN B CPB D2 IF I/O SUSP THEN JMP $IOCL GO ABORT THE I/O * JSB $ABRT GO TO ABORT ROUTINE B40 CLE CLEAR E FOR TRACK RELEASE M0207 LDA P2 RELEASE PROG'S TRACKS? CPA D8 IF P = 8, RSS YES JMP ïÕþú$XEQ NO-SO RETURN * LDB TEMPH ADB D14 GET ADDRESS OF LAST LDA B,I NAME WORD ALF,ALF CHECK IF TYPE BIT 7 SET SSA,RSS JMP $XEQ NO-CANNOT REL PROG TRACKS * SEZ,INB,RSS IF SHORT ID-SEG. SKIP ADB D7 ELSE INDEX TO MEM ADDRESS FOR LONG * ALF,ALF *A790216** RE-POSITION TYPE TO LOW END AND D15 SAVE PROGRAM TYPE STA TEMP5 FOR TYPE 5 CHECK * *A790216** LDA B,I CMA,INA INB ADA B,I STA TEMP3 # WORDS OF MAIN INB LDA B,I CMA,INA INB ADA B,I # WORDS IN BASE PAGE INB SET UP THE DISC ADDRESS POINTER STB TEMP1 IN TEMP1 * * * IF THE PROGRAM BEING TERMINATED IS A CLONE (I AM A COPY BIT IS SET) * DON'T RELEASE TRACKS, GO KILL THE ID. NOTE: DON'T ALTER (A). * * * *A790216** LDB TEMP5 FETCH PROGRAM TYPE CPB D5 IF SEG, SKIP CLONE CHECK JMP M0208 * *A790216** * LDB TEMP1 FETCH ID 27 ADDR ADB D5 ADVANCE TO 2ND SESSION WORD LDB B,I AND FETCH IT BLF,BLF IF THE "IM A COPY" BIT (BIT 9) RBR,SLB IS SET JMP M0227 DON'T GIVE THE TRACKS BACK * M0208 CLB CLEAR FOR DOUBLE SHIFT ADA B177 ROUND UP TO NEAREST SECTOR IOR B177 SET THE LOW BITS AND ADA TEMP3 ADD AND ROUND UP THE MAIN LSR 6 DIVIDE BY 64 TO GET SECTORS STA TEMP5 TOTAL # SECTORS IN PROGRAM LDA TEMP1,I GET THE DISC ADDRESS LSR 7 SHIFT TO TRACK AND B377 ADDRESS AND LDB TEMP1,I CHECK IF LU 2 OR 3 SSB LU 2 ADA TATSD LU 3 STA TEMP2 ACTUAL STARTING TRACK # LDB SECT2 LDA TEMP1,I CHECK IF LU 2 OR 3 SO CAN DIVIDE SSA BY # OF TRACKS FOR THATŒðþú LDB SECT3 DISC. STB TEMP LDA TEMP1,I GET THE TRACK ADDRESS AND B177 MASK OUT THE SECTOR ADDRESS CMA,INA,SZA,RSS IF ZERO RELEASE THIS TRACK JMP M0226 ADA TEMP ELSE SUBTRACT FROM TRACK ISZ TEMP2 SIZE STEP TO NEXT TRACK CMA,INA AND COMPUTE THE REMAINING SECTORS M0226 ADA TEMP5 A IS TOTAL NUMBER TO CLB CLEAR FOR DIVIDE SZA GEORGES FIX 3/13 SSA RELEASE IF NEGATIVE JMP M0227 FORGET THE WHOLE THING DIV TEMP SZB CHECK IF PARTIAL TRACK INA YES STA B (B)=# TRACKS LDA TEMP2 (A)=STARTING TRACK JSB $DREL CALL EXEC SYS RELEASE TRACKS M0227 LDB TEMPH ADB D12 CLA STA TEMP1,I CLEAR THE TRACK WORD STA B,I INB STA B,I INB LDA B,I SAVE THE OLD SHORT/LONG AND B77 FLAG STA B,I * * * NOTE: MEMORY RESIDENT ID'S ARE SAME LENGTH AS DISC RESIDENT * AND D7 LOOK FOR AN ID EXTENSION CPA D5 A SEGMENT ? JMP $XEQ THEN WE'RE FINISHED * ADB D14 INDEX TO ID EXT WORD LDA B,I PULL IN EMA INFO SZA,RSS IS THIS AN EMA PROG ? JMP $XEQ NO, SO WERE DONE * ALF YES, SO GET THE ID EXT RAL,RAL AND M77 ADA $IDEX GET THE ID EXT ADDRESS LDA A,I NOW HAVE THE ADDRESS CLB STB A,I NOW ZAP THE WORD. JMP $XEQ NOW WE'RE DONE. GO SEE WHAT'S NEW. * M77 OCT 77 NP ASC 1,NP NOPRN NOP * * * SKP SPC 1 * * THE SOFT ABORT ROUTINE CLEARS ANY RESOURCE FLAGS * CALLS THE TERMINATION ROUTINE AND REMOVES A PROGRAM FROM * THE TIME LIST. * * IT ALSO SETS THE ABORT FLAG (100000) IN THE FATHERS ID-SEG. * (IF THERE IS A FATHER AND HE IS WAITING) SO THAT RMPAR * MAY RECOVER THE PRAMETERDŠþú. * * IF THE PROGRAM IS WAITING FOR A SON IT CLEARS THE SONS * "FATHER IS WAITING" FLAG. * * CALLING SEQUENCE: * * LDB ID-SEG. ADDRESS * JSB SABRT * * RETURN REGISTERS MEANING LESS. * * THIS ROUTINE DOES NOT GENERATE AN ABORT MESSAGE NOR DOES IT * PULL A PROGRAM OUT OF AN I/O LIST. ($LIST DOES SET A FLAG * WHICH WILL PUT THE PROGRAM DORMANT ON I/O COMPLETION. * SABRT NOP STB TEMPH SAVE THE ID ADDRESS ADB D15 GET THE STATUS LDA B,I WORD AND ZAPR CLEAR THE RESOURCE BIT STA B,I RESET IT INB SET B TO THE TIME LIST WORD JSB $TREM REMOVE PGM FROM THE TIME LIST LDB TEMPH RESTORE THE ID ADDRESS AND ADB D15 INDEX TO THE STATUS WORD LDB B,I AND FETCH IT BLF,SLB IF PROGRAM IS WAITING JMP SABT2 GO CLEAR THE SONS FLAG * SABT1 LDB TEMPH RESTORE THE ID-SEG. ADDRESS AND JSB TERM CALL THE TERMINATION PROCESSOR ISZ POP STEP TO THE FATHER'S FIRST PRAM WORD RSS JMP SABRT,I LDA SIGN SET SIGN BIT FOR FATHER ABORT FLAG STA POP,I SET THE ABORT FLAG LDB POP CACULATE THE B-REG ADDRESS ADB D9 AND LDA POP SET IT TO STA B,I POINT TO THE ABORT WORD JMP SABRT,I DONE RETURN * SABT2 LDB TEMPH GET THE SONS ID ADDRESS INB FROM WORD TWO LDB B,I OF THE ID-SEGMENT ADB D20 INDEX TO THE FATHER WAIT FLAG WORD LDA B,I GET THE WORD RAL,CLE,RAL CLEAR BIT 14 ERA,RAR AND STA B,I RESTORE THE WORD JMP SABT1 GO TERMINATE THE PROGRAM SPC 2 TEMPH DEF FMGR D12 DEC 12 DM24 DEC -24 DM60 DEC -60 ZAPR OCT 177477 HED MESSAGE PROCESSOR--SS,XXXXX COMMAND * * SS,XXXXX PROCESSOR * * THE SUSPEND REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT OR Oo×þúPERATOR SUSPENDED, THEN * ILLEGAL STATUS ERROR * IF SCHEDULED, THEN OPERATOR SUSPEND VIA $LIST * IF OTHER THAN ABOVE, SET THE OPERATOR-SUSPEND BIT * IN STATUS. AND ALL THESE WONDERS ARE * BY $LIST. * M0300 JSB $LIST OCT 206 SCHED TO OPER-SUSP DEFP1 DEF P1 BY NAME SZA IF ERROR JMP MSEX EXIT * LDA WSTAT,I SET THE NO PRAMS IOR B20K BIT STA WSTAT,I TO PREVENT PRAMS ON RESTART LDA WORK GET ID ADR JSB ALDM GO PUT IN DORM LIST & SET DM FLAG JMP M0150 EXIT SPC 2 B20K OCT 20000 HED MESSAGE PROCESSOR--GO COMMAND * ***************************************************************** * * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * * THE CONTINUE FROM POINT OF SUSPENSION FUNCTIONS AS * FOLLOWS: * IF NOT OPERATOR SUSPEND: * BIT SET - REMOVE OPER-SUSP BIT IN STATUS * BIT NOT SET - ERROR EXIT FOR MESSAGE * IF OPERATOR SUSPEND, SCHEDULE PROGRAM. UNLESS * 'IH' IS SPECIFIED OR NO PARAMETERS ARE GIVEN, * ANY PREVIOUS OPERATOR SCHEDULING STRING IS * RELEASED AND THE 'GO' SCHEDULING STRING IS * SAVED FOR RETRIEVAL BY THE PROGRAM USING AN * EXEC 14 CALL. * ***************************************************************** * M0400 JSB TTNAM GO TO FIND ID SEG ADDR CPA D6 CHECK IF PROGRAM OPERATOR-SUSPEND JMP M0410 OPERATOR-SUSPEND--SO GO TO PROCESS LDA WSTAT,I NOT OPER SUSP - AND B1000 IS BIT SET? SZA,RSS JMP M0405 NO, ERROR- XOR WSTAT,I YES, CLEAR BIT STA WSTAT,I AND M0150 CLA EXIT JMP MSEX * M0405 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS JMP MSEX EXIT SKP * ******(„þú*********************************************************** * * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * * THE RU COMMAND FUNCTIONS AS FOLLOWS: * IF DORMANT, THE PROGRAM IS SCHEDULED. * PARAMETERS MAY BE PASSED TO THE PROGRAM. THESE * ARE TREATED LIKE PARAMETERS IS THE GO COMMAND * (SEE NOTE 1 FOR THE GO COMMAND). * THE SCHEDULING STRING MAY BE SAVED. SEE NOTE 2 * FOR THE GO COMMAND. * ******************************************************************* * M0408 JSB TTNAM RUN COMMAND ROUTINE LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA IF NOT DORMANT JMP M0405 GIVE THE MESSAGE,ELSE DO IT * JSB $SZIT CHECK OUT PROGRAM SIZE SZA OK ? JMP MSEX NO ! * M0410 LDA D2 CHECK IF CONTROL PARAMETERS FOLLOW CPA PARAM JMP M0105 NO,DO NOT RETURN STRING,SCHEDULE PROGRAM. * JSB PLOAD GO TO PROCESS CONTROL PARAMETERS JMP M0105 GO SCHEDULE THE PROGRAM HED MESSAGE PROCESSOR--ST,XXXXX COMMAND * * ST,XXXXX PROCESSOR * * IF XXXXX = 0 NAME AND PARTITION# OF CURRENT PGM IS PRINTED * IF XXXXX > 0 NAME OF THE PGM IN PARTITION #XXXXX IS PRINTED * THE STATUS REQUEST OUTPUTS THE REQUESTED PROGRAM STATUS * IN THE FOLLOWING FORMAT: * PRPRP S R MMMM HR MN SC MS T * * PRPRP =PRIORITY * S = STATUS (0 THRU 6 * R = RESOLUTION CODE (0 THRU 4) * MMM = MULTIPLE VALUE * HR = NEXT START TIME -HR * MN = NEXT START TIME -MIN * SC = NEXT START TIME -SEC * MS = NEXT START TIME -10 MSEC * T = PRESENT IF PROGRAM IN TIME LIST * M0500 LDB XEQT IF ZERO SZA,RSS GIVE STATUS OF JMP M0540 CURRENT PGM ê‡þú SSA JMP M0505 IF NEG, ASSUME WANT PRG STATUS LDB $MNP GET THE MAX # OF PARTITIONS CMB IF (A) .LE. TOTAL ADB A NUMBER OF PTTNS SSB THEN GIVE PTTN STATUS JMP M0530 * M0505 JSB TTNAM GO TO FIND ID SEGMENT ADDR CPB D5 IS THIS A SEGMENT ? LDA D9 THEN GET THE SEGMENT FLAG CLB,CCE STB RQP3 SET UP FOR $TIMV CALL JSB $CNV1 CONVERT STATUS TO ASCII. ALF,ALF MOVE TO HIGH HALF WORD STA BUFF4 STORE STATUS IN BUFFER. LDB DM28 CPA BL9 IF SHORT ID-SEG LDB DM8 SET FOR 8 CHAR. MESS STB BUFFR STORE CHARACTER COUNT IN BUFFER LDB WORK ADB D6 PRIORITY ADDRESS CPA BL9 IF SHORT ID-SEG CLA,RSS SET PR TO 0 LDA B,I JSB $CNV1 CONVERT PRIORITY TO ASCII LDB ASCI1 GET DIGITS 23-45 TO B-A RRL 8 34-52 IN B-A STB BUFF2 SET 34 LDB ASCI 1-52 IN B-A ALF,ALF 1-25 IN B-A RRL 8 12-5 IN B-A STB BUFF1 SET 12 STA BUFF3 SET 5 BLANK LDB TEMP6 RESTORE B TO PRIOR ADDRESS ADB D11 RESOL CODE/MULT ADDRESS LDA B,I ALF,RAR AND D7 JSB $CNV1 CONVERT RESOLUTION CODE TO ASCII ALF,ALF ROTATE TO HIGH HALF WORD STA BUFF5 STORE RESOLUTION CODE IN BUFFER LDA B,I AND B7777 JSB $CNV1 CONVERT MULTIPLE TO ASCII STA BUFF7 STORE MULTIPLE IN BUFFER LDA ASCI1 STA BUFF6 STORE MULTIPLE IN BUFFER LDA B,I CHECK IF PROG IN TIME LIST ALF,SLA TEST BIT 12 (T) BIT JMP M0510 YES LDA AASCI PROGRAM NOT IN TIME LIST RSS M0510 LDA TZERO PROG IN TIME LIST STA BUF14 STORE ASCII BLANK OR T IN BUFFER INB SET B TO TIME ADDRESS Ašþú LDA DTEMP SET UP TO GET TIME TO STA RQP2 TEMP AREA DLD B,I GET TIME FROM ID-SEG JSB $TIMV CONVERT THE TIME LDA TEMP3 GET HOURS JSB $CNV1 CONVERT LDB ASCI1 GET VALUE RRR 8 ROTATE TO BLANK ON EACH SIDE DST BUFF8 SET IN MESSAGE LDA TEMP2 GET MIN. VALUE JSB $CNV1 CONVERT STA BUF10 STUFF IN BUFFER LDA TEMP1 AND AGAIN FOR SEC JSB $CNV1 LDB ASCI1 VALUE TO A BLANK TO B RRR 8 ROTATE DST BUF11 SET IN BUFFER LDA TEMP ONE MORE TIME FOR 10'S OF MS. JSB $CNV1 STA BUF13 STORE TENS OF MSEC IN BUFFER M0520 LDA BUFAD LOAD A WITH OUTPUT BUFFER ADDRESS JMP MSEX RETURN SPC 1 TZERO ASC 1, T D11 DEC 11 B7777 OCT 7777 DTEMP DEF TEMP BL9 ASC 1,9 BLANK 9 DM28 DEC -28 DM1 DEC -1 SPC 1 M0530 ADA DM1 MPY D7 (PTTN#-1)*7 IS ADA $MATA ADDR OF ENTRY IN MATA ADA D2 +2 FOR ID SEG ADDR WORD LDB A,I (B)=ID SEG ADDR JMP M0550 GO PRINT PRG NAME * M0540 SZB,RSS ANY PRG RUNNING? JMP M0550 NO PRINT 0 ADB D21 GET PARTITION # LDA B,I FROM ID SEG WORD 22 AND B77 CCE,INA GET USERS ACTUAL PART NUMBER JSB $CNV1 CONVERT TO DECIMAL STA BUFF4 SET IN MESSAGE LDB XEQT (B)=ID SEG ADDR LDA DM8 (A)=COUNT 8 CHARS JMP M0560 GO PRINT M0550 CCA SET A FOR ZERO PRINT SZB SKIP IF NO PROGRAM LDA DM5 ELSE RESET A FOR PGM PRINT M0560 STA BUFFR SET MESSAGE LENGTH LDA MPT81 GET UPPER ASCII "0" TO A SZB SKIP IF NO PGM ADB D12 ELSE STEP TO NAME ADDRESS LDA B,I STA BUFF1 SET NAM12 INB STEP TO NEXT NAME WORD DLD B,I GET THE NEXT WORDS STA BUFF2 ?¸þúSET NAM34 LDA AASCI FILL RIGHT BLANK BLF,BLF INTO NAM5 RRL 8 STB BUFF3 SET NAM5 JMP M0520 GO EXIT * * SPC 2 HED OVERLAY - INPUT - OUTPUT BUFFER AREA $PBUF DEF PRAMS SET ADDR OF OVERLAY AREA FOR EXEC *********************************************************************** * INPUT MESSAGE BUFFER IBUFX DEF *+1 LOCAL MESS INPUT BUFFER (FOR MESSS) IBUFY BSS 40 * * INBUF BSS 40 MESSAGE INPUT BUFFER BUFFL EQU *-INBUF+*-INBUF LENGTH IN #CHARS * *********************************************************************** * SPC 2 * SYSTEM OUTPUT BUFFER * BUFFR EQU * SHOULD BE AT LEAST 15 WORDS LONG BUFF1 EQU BUFFR+1 BUFF2 EQU BUFFR+2 BUFF3 EQU BUFFR+3 BUFF4 EQU BUFFR+4 BUFF5 EQU BUFFR+5 BUFF6 EQU BUFFR+6 BUFF7 EQU BUFFR+7 BUFF8 EQU BUFFR+8 BUFF9 EQU BUFFR+9 BUF10 EQU BUFFR+10 BUF11 EQU BUFFR+11 BUF12 EQU BUFFR+12 BUF13 EQU BUFFR+13 BUF14 EQU BUFFR+14 * * PARAMETER POINTERS FOR DATA STORAGE * PRAMS BSS 1 CHARACTER COUNT-OP CODE OP BSS 3 OPERATION CODE CP1 BSS 1 CHAR COUNT-PARAM 1 P1 BSS 3 PARAM 1 (UP TP 3 WORDS-6CHAR.) CP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 CP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER * $OP EQU OP ENDT EQU * ********************************************************************** * HED SYSTEM START UP ROUTINE * * WHEN THE SYSTEM IS BOOTED UP A JMP 3,I IS MADE. * THE DESTINATION OF THE JUMP IS $STRT. THE CODE FROM HERE TO * OVCHK IS EXECUTED ONCE AT START UP AND LATER OVERLAYED FO³þúR I/O * BUFFERS AND OTHER TEMPS NEEDEDBY THE SYSTEM. * * ORG IBUFY PUT INIT CODE IN BUFFER * * $STRT LIA 1 GET THE SWITCH REGISTER LIB 1 AND B70K KEEP TOP OCTAL DIGIT SZA,RSS = 0 ? JMP TOIT YES, NO HALT &NO DBUG ALF ROTATATE TO LOW END * IFN CPA D7 IF = 7 & DDT IN SYS, THEN HALT CLA,RSS TO LET THEM SET SWITCH REGISTER JMP DOHLT AND THEN CALL $DDT ON THEIR BEHALF OTA 1 CLEAR THE SWITCH REGISTER FIRST HLT 75B JSB $DDT DEF TOIT XIF UNL IFZ BSS 7 XIF LST * DOHLT CPA D6 HLT 76B TOIT JSB $SYMP SET UP THE SYSTEM MAP JSB $CNFG NOW GO DO RECONFIGURATION * LDA DM5 GET THE LOOP VARIABLE STA TEMP5 PREPARE TO CALL $ALC LDA DEQT1 TO RETURN BLOCKS OF MEMORY STA TEMP6 TO INITIALIZE SYSTEM AVAILABLE MEMORY MRTNL LDA TEMP6,I BLOCK ADDRESSES ARE IN PAIRS STA MADR1 EQT1 THRU EQT12 ISZ TEMP6 LDA TEMP6,I STA NWDS1 ISZ TEMP6 JSB $RTN RETURN A BLOCK MADR1 NOP NWDS1 NOP ISZ TEMP5 DONE WITH EQT1 THRU EQT10? JMP MRTNL NO, RELEASE NEXT BLOCK JMP $ALC NEXT GO TO $ALC FOR CONFIGURATION * DEQT1 DEF EQT1 GOES TO GTFMG FROM $ALC VIA $WORK * GTFMG LDB TEMPH GET FMGR'S NAME ADDRESS JSB $ZZZZ GO TO DISPATCHER TO SET UP LDB TERM GET ADDRESS JSB TNAME OF D.RTR TO B SEZ,RSS IF NONE SKIP STB ID.RT SET FOR LATER. LDB P1OR2 LOOK UP EDIT'S ADDRESS JSB TNAME ALSO SEZ,RSS IF NONE SKIP STB ID.RT+1 SET IN LIST LDB TEMPH NOW FIND JSB TNAME FMGR'S ID-SEGMENT ADDRESS SEZ,RSS IF NONE SKIP STB IDFMG SET ADDRESS LDB DSMP JSB TNAME SEZ,RSS STB $IDSM * þRþú LDA IDFMG GET FMGR'S ID ADDRESS SZA,RSS ANY FMGR ? JMP NOFMG NO, SO FORGET ABOUT ANY CHECKS * STA WORK SET UP HIS ADDRESS IN $WORK JSB $SZIT SEE IF THERE'S A PART'N LARGE ENOUGH SZA WELL IS THERE ? JMP NGFMG NO, YOU BLEW THE RECONFIGURATION TURKEY !!!! * LDA ID.RT OK, SO YOU DID THAT RIGHT. BUT DID YOU SZA,RSS YOU GIVE D.RTR ENOUGH ROOM ? JMP NOFMG NO D.RTR HUH . * STA WORK SET UP FOR THE TEST JSB $SZIT SEE IF THERE IS ENOUGH ROOM SZA OK ? JMP NGFMG NO. * NOFMG LDA D$RN TRACK DOWN RN TABLE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT LDA A,I USE NEXT LEVEL * LDB IDADS GET ADDRESS OF ID ADDRESSES JMP $ERMG GO TO EXEC TO SET UP NO RETURN * NGFMG HLT 10B NO ROOM FOR FMGR, SO YOU LOSE !!!!!!! JMP *-1 YOU LOSE AGAIN ! * * * IDADS DEF ID.RT FMGR ASC 3,FMGR D.RTR ASC 3,D.RTR DSMP DEF *+1 ASC 3,SMP D$RN DEF $RNTB * $SYMP NOP LDA $DLP GET THE LOAD POINT ALF AND GET THE # OF PAGES RAL,RAL STA $CMST * LDA $DLP GET IT AGAIN CMA,INA MAKE IT NEG ADA BKCOM ADD LENGTH & START OF COMMON LDB $MPFT ADB D3 ADA B,I * SZA,RSS ANY COMMON AT ALL ? JMP NCOMN NO AND B76K YES. SO GET PAGE BITS ALF TO LOW END RAL,RAL AND SAVE IT NCOMN STA $COML THIS IS THE LENGTH(IN PAGES) OF COMMON * ADA $CMST ADD IN START PAGE OF COMMON & STA $SDA WE HAVE THE START OF THE SYS DVR AREA * LDB $PLP GET THE PRIV LOAD POINT BLF GET PAGE # TO LOW END RBL,RBL CMA,INA SUBTRACT FROM START OF SYS DVR AREA ADA B TO GET LENGTH OF TB 1 & SYS DVR AREA STA $SDT2 * LDA LBORG NOW GET THE LIغþúBRARY ORGIN ALF CONVERT TO PG # RAL,RAL STA $RLB AND SET AS START OF RES LIB * LDB $MPFT NOW INB GET START OF MEM RES AREA LDB B,I TO LOW END BLF RBL,RBL CMA,INA ADD IN START OF LIBRARY ADA B AND WE GET THE LENGTH STA $RLN OF THE RES LIBRARY * * SPC 1 * SET UP THE SYSTEM MAP AND RETURN SPC 1 * CLA START REGISTER 0 CLB START VALUE = 0 LDX $SDA SET EM UP TO START OF SYS DVR AREA XMS DO IT ! * ADB WRTPR NOW GET THE WRITE PROTECT STA TBL SAVE START REGISTER LDA $SDA GET START VALUE CMA,INA MAKE NEG TO GET # OF REGS ADA D32 LEFT TO SET UP CAX PUT IN X-REG LDA TBL RESTORE START REG XMS AND PLAY IT AGAIN SAM. * LDA $MPSA GET START PAGE SYS AV AND B1777 STA TBL B HAS START VALUE LDA EQT1 AND B1777 XOR EQT1 KEEP ONLY PAGE ALF RAL,RAL GET IN LOW 5 BITS STA NWDS1 START PAGE OF SAM LDA TBL XOR $MPSA GET LENGTH ALF RAL,RAL A HAS LENGTH CAX PUT IN XREG LDB TBL START PAGE NUMBER ADB WRTPR AND WRITE PROTECT LDA NWDS1 START REGISTER XMS LOAD MAP * * STA NWDS1 SAVE REGISTER # LDA $MPS2 GET THE 2ND CHUNK OF SAM AND B1777 SAVE THE PHY PG # LDB A PUT IN B ADB WRTPR AND SET UP WRITE PROTECT XOR $MPS2 NOW GET # OF PAGES ALF RAL,RAL TO LOW END CAX AND PUT INTO X AS # OF REGISTERS LDA NWDS1 GET START REG BACK AGAIN XMS AND DO IT SJP $SYMP,I SET UP SYSTEM MAP & RETURN TBL NOP *$MPSA-$MPS2 0-9 START PG SAM * 10 - _þú15 NUMBER PGS SAM WRTPR OCT 40000 B70K OCT 70000 B76K OCT 76000 * OVCHK EQU *-ENDT OVERLAY CHECK * HED MESSAGE PROCESSOR--IT,XXXXX COMMAND * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR LDA WORK SET ADA D17 UP THE TIME PRAMETER STA TEMPP STARTING ADDRESS. LDB P2 GET THE RESOLUTION ADB DM5 CODE AND TEST SSB,RSS FOR MORE THAN 4. JMP $INER GREATER THAN 4-ILLEGAL CODE LDA P3 GET THE MULT. FACTOR. LDB TEMPP,I GET THE OLD TIME PRAM. BLF,ERB IF IN TIME LIST ALF,ERA SET BIT IN NEW WORD. LDB P2 GET RESOLUTION TO B SZB,RSS IF ZERO RESOLUTION JMP M0605 GO REMOVE FROM TIME LIST LSR 3 SHIFT THE WHOLE MESS TO A M0604 STA TEMPP,I SET NEW RESOLUTION MULT. ISZ TEMPP INCR TO TMS ADDRESS LDA P7 GET TENS OF MS. ADA DM100 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P6 GET SECONDS VALUE ADA DM60 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P5 GET MINUTES. ADA DM60 SSA,RSS YES, SO CONVERT TO DECIMAL JMP $INER INPUT ERROR LDA P4 GET HOURS ADA DM24 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA DP4 SET DEFS TO THE PRAMS STA RQP5 NlþúON THE BASE LDA DP5 PAGE FOR STA RQP6 $ETTM LDA DP6 THE SET TIME STA RQP7 SUBROUTINE LDA DP7 IN THE STA RQP8 RTIME MODULE LDB TEMPP GET ID-SEG ADDRESS AND JSB $ETTM GO SET VALUES IN ID-SEG JMP M0150 EXIT $MESS SPC 2 M0605 CCB REMOVE PGM FROM TIME ADB TEMPP LIST JSB $TREM CLA AND CONTINUE JMP M0604 SETTING UP THE ID-SEG SPC 1 DM100 DEC -100 SPC 2 BLIM CLB,CCE,INB CHECK TO SEE IF EXAMINE CPB PARAM ONE PRAM? JMP BLIMP YES GO PRINT LIMITS * LDB P2 GET THE SECOND PRAMETER * * LOWER LIMIT IN (A) UPPER LIMIT IN (B) * SSB,RSS NEGATIVE LIMITS SSA ARE NOT JMP $INER ALLOWED * CMB,INB,SZB GET NEW UPPER LIMIT STB $BLUP IF ZERO SKIP THE STORE CMA,INA SET UP THE LOWER LIMIT STA $BLLO JMP M0150 GO EXIT DONE SPC 1 BLIMP LDA $BLLO GET THE LOWER LIMIT CMA,INA SET POSITIVE JSB $CNV1 CONVERT TO ASCII OCTAL STA BUFF3 SET LOW DIGITS DLD ASCI GET THE HIGH 4 DIGITS DST BUFF1 AND SET IN BUFFER LDA $BLUP GET THE UPPER LIMIT CMA,CCE,INA SET POSITIVE JSB $CNV1 CONVERT STA BUFF7 SET THE LOW DIGITS DLD ASCI GET THE HIGH DIGITS DST BUFF5 SET IN THE BUFFER LDA AASCI GET A DOUBLE BLANK STA BUFF4 SET BETWEEN THE NUMBERS LDA DM14 GET RECORD LENGTH STA BUFFR SET IN THE BUFFER AND JMP M0520 GO SEND THE MESSAGE SPC 1 HED MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM ½þú* LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR LDA P2 GET PRIORITY SSA,RSS SZA,RSS CHECK IF ZERO PRIORITY REQ JMP $INER ERROR-ILLEGAL VALUE LDB WORK ADB D6 STA B,I STORE NEW PRIORITY VALUE STA NPCNG SAVE NEW PRIORITY JSB $LIST RELINK THE PROGRAM OCT 317 BY NEW PRIORITY LDB NPCNG GET NEW PRIO LDA WORK GET ID ADR JSB PRCNG GO RELINK IN ALLOCATED LIST CLA JMP MSEX RETURN NPCNG BSS 1 SPC 5 * MESSAGE PROCESSOR -- TM COMMAND * M0700 LDB DEFP1 PASS PRAM. ADDRESS TO JMP $TMRQ RTIME PROCESSOR SPC 2 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM M0730 ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT HED MESSAGE PROCESSOR--TI COMMAND * * TI COMMAND * * THE REQUEST TO GET CURRENT SYSTEM TIME OUTPUTS CURRENT * YEAR, DAY NUMBER, HOUR, MINUTES, AND SECONDS IN THE * FOLLOWING FORMAT: * YEAR.DAY..HR..MN..SC * WHERE THE .'S ARE BLANKS * M0750 LDA DM20 STA BUFFR SET OUTPUT CHARACTER COUNT LDA DTEMP SET UP TO GET THE TIME STA RQP2 TO TEMP AREA ADA D5 STA RQP3 DLD $TIME JSB $TIMV GO GET TIME JSB $CNV1 CONVERT YEARS STA BUFF2 SET LEAST TWO DIGITS LDA ASCI1 GET THE NEXT TWO DIGITS STA BUFF1 AND SET THEM LDA TEMP4 GET DAYS JSB $CNV1 CONVERT AND STORE DAYS STA BUFF4 SET LEAST TWO DIGITS LDA ASCI1 GET NEXT DIGIT STA BUFF3 SET IN BUFFER LDA AASCI STUFF NECESSARY WORDS WITH STA BUFF5 BLANKS STA BUFF7 |ïþú STA BUFF9 LDA TEMP3 GET HOURS JSB $CNV1 CONVERT AND STORE HOURS STA BUFF6 LDA TEMP2 JSB $CNV1 CONVERT AND STORE MINUTES STA BUFF8 LDA TEMP1 JSB $CNV1 CONVERT AND STORE SECONDS STA BUF10 JMP M0520 GO SET A AND EXIT SPC 1 DM20 DEC -20 * * DN,N1 OR DN,,N2 * * THE REQUEST TO DOWN AN EQT OR LU WORKS AS FOLLOWS: * IF N1 IS GIVEN, DOWN THE EQT POINTED TO BY N1. * IF N2 IS GIVEN, DOWN THE LU POINTED TO BY N2. * M0800 CCE NO THIRD PARAMETER. JSB P1OR2 SET A=PARAMETER 1, B=PARAMETER 2. JMP $IODN GO TO 'DOWN' ROUTINE. HED MESSAGE PROCESOR--LU,EQ AND TO COMMANDS * * MESSAGE PROCESSOR --LU,N1,N2 COMMAND * * REQUEST OF LOGICAL UNIT ASSIGNMENT (N1 VALUE ONLY) OR * REQUEST LOGICAL UNIT REASSIGNMENT(N1 & N2 - OR * N1, N2 ,& N3 PRESENT) * M0850 CLE SET THE N3 POSSIBLE SWITCH JSB P1OR2 SET UP PARAMETERS JMP $LUPR * * SPC 1 SPC 1 * * MESSAGE PROCESSOR ---- EQ,N1,N2 COMMAND * * * REQUEST EQUIPMENT STATUS (N1 PARAMETER ONLY) * REQUEST EQUIPMENT BUFFERING OR NON BUFFERING (N1 & N2) * N2 = 0 FOR NO BUFFERING * N2 = 1 FOR BUFFERING * M0900 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $EQST * * D29 DEC 29 D28 DEC 28 DM12 DEC -12 DM6 DEC -6 SPC 1 SPC 1 * MESSAGE PROCESSOR TO,N1,N2 COMMAND * * * REQUEST DEVICE TIME OUT PARAMETERS (N1 ONLY) * REQUEST TO ASSIGN DEVICE TIMEOUT (N1 & N2) * N1 = DEVICE EQT # * N2 = TIME OUT PARAMETER TO BE ASSIGNED * M0990 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $CHTO * * * * SKP P1OR2 DEF ABM ENTRY/EXIT LDA CP2 CHECK IF JUST SZA,RSS ONE PARAMETER JMP P1OR5 YES - GO EXIT LD:nþúA P2 GET SECOND PRAM. SEZ,RSS IS A THIRD PARAMETER POSSIBLE? JMP P1OR7 YES P1OR3 LDB A LOAD B WITH 'N2' OR 'N3:N2' P1OR4 LDA P1 LOAD A WITH N1 JMP P1OR2,I P1OR5 CCB SET B REG TO -1 FOR 1 PARAMETER JMP P1OR4 P1OR7 AND B377 SAVE BITS 7-0 STA P2 OF 'N2' LDA P3 GET 'N3' AND B37 KEEP BITS 4-0 AND LSL 11 MOVE THEM TO POSITIONS 15-11 ADA P2 ADD IN THE 'N2' PRAM JMP P1OR3 GO EXIT * B37 OCT 37 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP MSEX RETURN HED MESSAGE PROCESSOR -- AB COMMAND * * MESSAGE PROCESSOR -- AB COMMAND * * THE AB COMMAND ABORTS THE BATCH PROGRAM CURRENTLY * BEING EXECUTED * * IT TRACKS DOWN THE LOWEST LEVEL USING FMGR AS THE * FIRST LEVEL. IF FMGR IS NOT WAITING THEN IT'S BREAK * FLAG IS SET. IF FMGR IS DORMANT THE REQUEST IS ILLEGAL * IF D.RTR IS AT THE END OF THE LIST THEN THE * INVOLKING PROGRAM IS ABORTED OR, IF FMGR, THE BREAK FLAG * IS SET. * M0950 ALR,ALF KILL BIT 3 (NEVER =8) STA P2 SET THE OPTION FLAG LDB IDFMG GET FMGR'S ID-SEG. ADDRESS M0951 STB WORK AND SET UP WORK SZB IF NO FMGR SKIP ADB D15 INDEX TO STATUS LDA B,I GET STATUS AND D15 IF FMGR IS DORMANT SZA,RSS THEN JMP M0405 ILLEGAL STATUS EXIT * LDA B,I GET STATUS ALF,CLE,SLA IF WAITING JMP M0958 GO TRACK DOWN * M0955 LDB IDFMG GET FMGR'S ID-SEG ADDRESS CPB WORK IF SAME AS CURRENT JMP M0730 GO SET BREAK FLAG * JMP M0202 ABORT * M0958 LDB WORK GET CURRENT ID INB STEP TO WAIT PROGRAM LDB B,I GET ADDRESS CPB ID.RT IF D.RTR JMP M0955 GO DO PREVIOUS PGM. * CPB $IDSM IFÑÏþú SMP JMP M0955 GO TO PREV. JMP M0951 AND CONTINUE HED MESSAGE PROCESSOR - LS N1,N2 PROCESSOR * * SET "SOURCE FILE" IDENTIFICATION * * THE OPERATOR REQUEST IS: * "LS,LUN,1ST TRACK # " * THIS STATEMENT SETS THE SOURCE FILE CONTROL WORD * IN THE COMMUNICATION AREA IN THE FOLLOWING * FORMAT( THE WORD IS LABELED "SFCUN" ): * ******************************* * *LU* ST. TRACK #* ZERO * * ******************************* * 15,14 - 7,6 - 0 (BITS) * * THE LOGICAL UNIT # AND STARTING TRACK # ARE * RECORDED BY THE 'EDITOR' WHEN THE SOURCE FILE * IS CREATED. * * VALIDITY CHECKS ARE FOR LOGICAL UNIT = 2 OR 3, * HOWEVER, A LU = 0 WILL SET "SFCUN" = 0. * M0960 CLB IF PARAM 1 = 0, GO TO SZA,RSS JMP M0961 CLEAR "SFCUN" CLE,ERA SET E IF LU 3. CPA D1 IF NOT LU 2 OR THREE CPB CP2 OR P2 NOT SUPPLIED THEN TAKE JMP $INER ERROR EXIT. ERB SET SIGN OF B TO 1 IF LU 3. ADB P2 ADD THE TRACK AND ASL 7 NORMALIZE (I.E. PUT IN 14-07) * M0961 STB SFCUN SET "SFCUN" JMP M0150 GO EXIT * ID.RT NOP ID.ED NOP IDFMG NOP $IDSM JMP GTFMG START UP CODE HED MESSAGE PROCESSOR - LG,N COMMAND * * SET "LOAD-AND-GO" PARAMETERS * * THE OPERATOR STATEMENT IS: * "LG,# OF TRACKS" * * THIS STATEMENT ALLOWS THE OPERATOR TO: * 1. ALLOCATE A NUMBER OF CONTIGUOUS DISC * TRACKS FOR 'LOAD-AND-GO' USAGE. * 2. RELEASE TRACK(S) CURRENTLY ASSIGNED TO LGO. * * THIS REQUEST HAS NO EFFECT IF LGO CURRENTLY IN USE * * THE BASE PAGE COMMUNICATION AREA WORDS DESCRIBED * BELOW CONTAIN THE LGO TRACK ASSIGNMENTS: * * ******************************** * 'LGOTK' *LU* ST. TRACK # * # OF TRACKS * * ******************************** * 15,14---------07,06---------00 * * ******************************** * 'LGOC'÷xþú *LU* TRACK # * SECTOR # * * ******************************** * 15,14---------07,06---------00 * * LGOTK DEFINES THE LU #, THE STARTING TRACK # * AND THE NUMBER OF CONTIGUOUS TRACKS. THIS * WORD IS ZERO IF NO TRACKS ARE ALLOCATED. * * LGOC DEFINES THE CURRENT AVAILABLE SECTOR. * THIS IS UPDATED BY 'RTIOC' AND RESET TO * THE BEGINNING OF THE AREA BY THE LOADER * AFTER LOADING FROM THE LGO AREA; ALSO BY * THIS ROUTINE WHEN THE TRACKS ARE ALLOCATED. * * M0970 AND B177 MAX. VALUE OF 127. STA P1 -SAVE P- SZA,RSS IF P = 0, GO TO JMP M0971 RELEASE LGO TRACK(S). CLA CHECK FOR CPA LGOTK CURRENT ASSIGNMENT. M0975 CLB,RSS -NONE JMP M0971 -RELEASE CURRENT * LDA P1 (A) = # OF TRACKS JSB $DREQ ALLOCATE TRACKS * SZB,RSS IF P TRACKS NOT JMP M0972 AVAILABLE, GO FOR DIAG. RETURN. * RBR SET SIGN OF B IF LU 3. ASL 16 MOVE THE TRACK UP ASL 7 TO BITS 14-07 OF B. STB LGOC SET LGOC. ADB P1 SET # OF TRACKS IN 06-00 STB LGOTK AND SET LGOTK. * JMP MSEX -RETURN- * M0971 CPA LGOTK JMP MSEX LDB LGOTK GET ASSIGNMENT WORD TO RELEASE. CLE,ELB SET E IF LU = 3 LSR 8 SET FIRST TRACK IN B ALF,ALF PUT # OF RAR TRACKS IN A CMA,SEZ,CLE,INA SET NEGATIVE,SKIP IF LU 2. ADB TATSD ADD SYSTEM DISC SIZE JSB $CREL GO RELEASE IF POSSIBLE SZB RELEASE OK? JMP M1973 NO SEND THE NASTY MESSAGE. STB LGOTK CLEAR 'LOAD-AND-GO' STB LGOC CONTROL WORDS. CPB P1 IF P = 0, JMP M0150 -RETURN- JMP M0975 GO TO ALLOCATE NEW TRACKS. * M0972 LDA $NOLG PRINT: NO LGO SPACE RSS M1973 LDA $LGBS PRINT: LGO IN USE JMN×þúP MSEX * HED MESSAGE PROCESSOR SIZE COMMAND * * * THE SIZE COMMAND COMES IN THREE FLAVORS * * 1) SZ,XXXXX PRINTS SIZE INFORMATION ON PROGRAM XXXXX * 2) SZ,XXXXX,P2 FOR NON EMA PROGRAMS, CHANGES MAX LOGICAL * ADDRESS SPACE OF XXXXX TO P2 PAGES. * FOR EMA PROGRAMS P2 BECOMES THE NEW * SIZE OF PROGRAM + EMA SIZE, IE, THE * NEW MINIMUM PARTITION SIZE OF THE PROG. * 3) SZ,XXXXX,P2,P3 THIS FORM IS FOR EMA PROGRAMS ONLY. P2 * IS AS DESCRIBED ABOVE. P3 IS THE NEW * MSEG SIZE. * * * TEMPS: TEMPY = # OF PAGES IN PROG (NO MSEG) + DYNAMIC BUFFER AREA * IF THE PROGRAM IS AN EMA PROGRAM * = NEG LOW MAIN ADDRESS IF PROG NOT EMA * * * SIZE LDA PARAM GET THE PARAMETER COUNT CPA D2 IS IT JUST 2 ? JMP SZRPT YES,SO REPORT THE SIZE INFO * JSB SZCHK NO, SO GO SEE IF MODS OK JSB $SZIT NOW GO GET ALL THE PARAMETERS LDB TEMPB,I *E SZB *E IS IT AN EMA PROG? JMP ESIZX YES * LDB WORK GET THE LOW MAIN ADDRESS ADB D22 LDA B,I STA TEMPI SAVE IT FOR LATER CMA,INA MAKE NEG STA TEMPY AND SAVE ADB D7 NOW CALCULATE THE # OF WORDS IN ADA B,I IN THE PROGRAM CODE ADB DM6 CPA TEMPY PROG SEGMENTED ? ADA B,I NO. ADA B1777 ALLIGN TO PAGE ALF NOW, CONVERT TO # OF PAGES OF CODE. RAL,RAL AND B37 CMA MAKE NEG & ADD IN BASE PAGE ADA P2 NOW ADD NEW SIZE SPECIFIED SSA IS LOWER LIMIT CHECK OK ? JMP SZERR NO, SO ITS A SIZE ERROR * * WE ALREADY HAVE MAX PARTITION SIZE, BUT MIGHT BE GREATER * THAN MAX PROGRAM ADDRESS SPACE. LETS SEE. * LDA TEMPI GET THE LOW MAIN ADD/¬þúRESS ALF GET PAGE # RAL,RAL ADA DM32 NOW SEE WHICH IS SMALLER LDB A SAVE IT CMB,INB BUT MAKE POSITIVE ADA TEMPA ADD IN LARGEST PARTITION SIZE SSA,RSS OF THE TWO KEEP THE SMALLEST STB TEMPA USE LOGICAL ADDRESS SPACE * * LDB P2 GET THE INPUT SIZE CMB,INB MAKE NEG ADB TEMPA ADD IN MAX SIZE INB SSB OK ? JMP SZERR NO ! SEND SIZE ERROR. * CCB NOW GO ADB P2 GET THE REQUESTED SIZE ESIZW BLF,BLF AND SHIFT UP RBL,RBL LDA TEMPC,I GET THE # OF PAGES WORD AND BPG# OUT GOES THE OLD ADA B IN GOES THE NEW * SSA,RSS IF PART'N ISN'T RESERVED, ZAP PART'N # AND B177K BECAUSE PROG MIGHT NOT RUN THERE ANTMORE STA TEMPC,I SOCK IT AWAY JMP M0150 AND RETURN * * B177K OCT 177700 SPC 2 * EMA PROGRAM CHECK SPC 2 * ESIZX LDA TEMPF GET THE MSEG SIZE CMA,INA SUBTRACT FROM PROG SIZE ADA TEMPI STA TEMPY TEMPY = PROG SIZE (NO MSEG) * LDB CP3 GET THE LAST PARAMETER SZB,RSS ANY SUPPLIED ? JMP ESFX1 NO, SO DON'T CHECK IT OUT CCB NOW CHECK MSEG SIZE ADB P3 SSB,INB MUST NOT BE LESS THAN 1 JMP $INER IT IS, SO FORGET IT * CLA,INA *E ADA TEMPE *E INDEX TO 2ND ID EXT WORD LDA A,I *E AND GET MSEG START PAGE ALF,RAL *E AND B37 *E GET VALUE FROM LOW 5 BITS CMA,INA *E SUBTRACT FROM 32 TO GET ADA D32 A = MAX MSEG SIZE CMB,INB B = - INPUT SIZE ADA B SSA WELL,IS IT OK OR NOT ? JMP SZERR NOT ! FLUSH HIM JMP ESFX3 IS. * ESFX1 LDA TEMPF USE OLD MSEG SIZE AS NEW. STA P3 * ESFX3 LDA CP2 WAS THIS PARAMETER SUPPLIED ? ÿœþú SZA,RSS WELL ? JMP ESFX2 NO LDA TEMPE GET ADDRESS OF ID EXTENSION INA LDA A,I INDEX TO DE BIT WORD ALF,RAL NOW IF THE DE BIT IS CLEAR SSA,RSS THEN CHANGE IS ILLEGAL JMP SZERR SO YOU LOSE ! * LDA P2 GET THE INPUT EMA SIZE SZA IF = 0 SSA OR IF < 0 JMP $INER ITS AN ERROR. * ADA TEMPY ADD # OF PAGES OF PROG (NO MSEG) CMA,INA NOW SEE IF PROGRAM WILL FIT INTO ADA TEMPA PROPER PARTITION SSA WELL ? JMP SZERR NO, YOU LOSE. * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD ADA P2 IN GOES THE NEW STA TEMPB,I * ESFX2 LDA TEMPE,I GET THE 1ST ID EXTENSION WORD XOR TEMPF OUT GOES THE OLD ADA P3 IN GOES THE NEW IOR SIGN ANS THE NON STANDARD BIT STA TEMPE,I * LDB TEMPY GET THE # OF PAGES IN PROG ADB P3 ADD IN THE NEW MSEG SIZE JMP ESIZW NOW GO PUT IT IN THE ID SEG * D32 DEC 32 SKP * * SZRPT JSB TTNAM GET THE ID INFO ADB D14 GET THE PROGRAM TYPE LDA B,I AND D7 CPA D1 MEMORY RESIDENT ? JMP $INER YES, INPUT ERROR. JSB $SZIT PICK UP THE SIZE WORDS LDB WORK NOW GET THE ID ADDRESS ADB D29 INDEX TO HIGH MAIN OF LARGEST SEG LDA B,I PULL IT IN ADB DM6 NOW INDEX TO HIGH MAIN OF PROG CLE,SZA,RSS IF ZERO THEN NO SEGMENT SO USE LDA B,I PROGRAM SIZE JSB $CNV3 NOW CONVERT TO ASCII (OCTAL) * LDA ASCI GET THE 1ST WORD STA BUFF1 AND PUT IT IN THE BUFFER DLD ASCI1 AND GET THE LAST 2 WORDS DST BUFF2 AND SAVE THEM TOO * * LDA TEMPI GET SIZE OF PROG (+ MSEG IF EMA ) LDB TEMPB,I IS THE PROGRAM EMA ? SZB,RSS JMP LSIZE NO JUSn:þúT GO LIST SIZE LDB TEMPF YES GET MSEG SIZE CMB,INB AND SUBTRACT IT ADB TEMPG FROM THE EMA SIZE ADA B AND ADD (A = PROG + EMA SIZE) LSIZE CCE,INA ACCOUNT FOR BASE PG & DO DECIMAL CONVERSION JSB $CNV3 DO THE CONVERSION * DLD ASCI1 GET THE LOWER 2 WORDS (MAX = 1024) DST BUFF5 AND SET INTO BUFFER LDA ASCI GET A BLANK STA BUFF4 AND PUT IT OUT AS A DELIMITER STA BUFF7 ON BOTH SIDES STA BUF10 AND FOR THE NEXT ONE STA BUF11 AND FOR THE NEXT ONE * LDA TEMPB,I GET THE EMA WORD AND B1777 KEEP ONLY EMA SIZE LDB DM12 GET A CHAR COUNT CCE,SZA,RSS (DECIMAL CONVERSION) IF NO EMA THEN, JMP SZEXT WE'RE DONE * JSB $CNV3 NOW THEN,CONVERT TO ASCII * DLD ASCI1 GET THE RESULT (MAX = 1024) DST BUFF8 * LDA TEMPF AS LONG AS WE'RE HERE LETS JSB $CNV3 GIVE THEM THE MSEG SIZE TOO. DLD ASCI1 DST BUF12 * * LDB DM26 GET THE CHAR COUNT SZEXT STB BUFFR AND PUT IT IN THE BUFFER LDA BUFAD THE BUFFER ADDRESS TO A JMP MSEX NOW , GO TELL THE FOLKES. * DM26 DEC -26 SKP * THE SZCHK SUBROUTINE IS CALLED BY THE SZ & AS PROCESSORS * IT MAKES SURE THAT THE PROGRAM EXISTS, IS NOT A SEGMENT, * IS DORMANT, IS NOT MEMORY RESIDENT, AND DOES NOT CURRENTLY * OWN ANY PARTITION. * * SZCHK NOP JSB TTNAM GO LOOK FOR THE PROGRAM SZA IF NOT DORMANT, TAKE GAS ! JMP M0405 SEND ILLEGAL STATUS ERROR. * LDB WORK NOW GO SEE WHAT TYPE ADB D14 PROGRAM THIS IS LDA B,I AND D7 KEEP ONLY LOWER 3 BITS CPA D1 IS IT MEMORY RESIDENT ? JMP M0405 THEN SEND ILLEGAL STATUS ERROR * ADB D7 NOW GET TO THE PARTITION WORD LDA B,I PULL IT IN AND KEEP ONLY AND B77 THE ×÷þúPARTITION BITS MPY D7 USE THIS AS AND INDEX INTO ADA $MATA THE $MATA TABLE ADA D2 SO WE CAN SEE WHO OWNS THAT PARTITION LDA A,I PULL IN THE OWNERS ID ADDRESS CPA WORK AND COMPARE IT TO THIS GUY JMP M0405 IF SAME THEN SEND ILLEGAL STATUS ERROR JMP SZCHK,I IF YOU GOT HERE, YOUR A WINNER !!! * * SZERR LDA $SERR JMP MSEX * * $SERR DEF *+1 DEC -10 ASC 5,SIZE ERROR * BPG# OCT 101777 B1777 OCT 1777 * * HED MESSAGE PROCESSOR --- UR COMMAND * * * WHY, YOU ASK YOURSELF, IS THERE A UNRESERVE COMMAND. * IT SEEMS INTUITIVELY OBVIOUS TO THE MOST CASUAL OBSERVER * THAT A RESERVE COMMAND WOULD BE MORE USEFUL. BUT WHAT * HAPPENS TO THE POOR PROGRAM THAT IS SWAPPED OUT, AND THEN * THE ONLY PARTITION HE WILL RUN IN IS RESERVED. WHERE IS * HE TO GO ? REMEMBER ! PARANOIA IS THE WATCH WORD OF * A GOOD OPERATING SYSTEM. * UR, N N = NUMBER OF PARTITION TO BE UNRESERVED * URESV ADA DM1 SUBTRACT 1 FROM PART'N # SSA IF NEG, SEND ILLEGEL PART'N MESSAGE JMP IPRTN CMA MAKE NEG & CHECK AGAINST ADA $MNP MAX # OF PARTITIONS SSA IS IT OK ? JMP IPRTN NO SEND ILLEGAL PARTITION MESSAGE * CCA ADA P1 INDEX INTO MPY D7 PROPER MATA TABLE ENTRY ADA $MATA LDB A,I GET THE LINK WORD SSB IF PARTITION UNDEFINED JMP IPRTN SEND ERROR MESSAGE * ADA D4 NOW GET THE ENTRY LDB A,I STB TEMPX SAVE THE SIZE FOR A LATER CHECK RBL,CLE,ERB STRIP SIGN BIT STB A,I AND PUT IT BACK * INA BUMP TO TYPE WORD LDB A,I GET IT SSB IS IT RT ? JMP URRT YES CHECK SIZE ADA DM2 NOW GO CHECK MOTHER BIT LDB A,I PULL IT IN SSB IS IT SET ? JMP URMT ÏÇþú YES * LDB $MBGP GET MAX BG PART'N SIZE MCHEK LDA TEMPX GET PARTITION SIZE AND B1777 KEEP ONLY SIZE CMB AND COMPARE AGAINST THAT TYPE PTN SIZE ADA B NOW IS THE UNRESERVED SSA PARTITION BIGGER THAN LAST OLD PARTITION ? JMP M0150 NO SO WERE FINISHED * JSB $MAXP YES, SO SET UP THE LARGER PARTITION JMP M0150 * * * URRT LDB $MRTP GET CURRENT RT MAX SIZE JMP MCHEK * URMT LDB $MCHN JMP MCHEK * * IPRTN LDA $ILPN JMP MSEX * B777K OCT 77700 * $ILPN DEF *+1 DEC -14 ASC 7,ILLEGAL PART'N * HED MESSAGE PROCESSOR --- AS COMMAND * * AS,XXXXX, Y * * * THE AS COMMAND WILL ASSIGN PROGRAM XXXXX TO PARTITION # Y * XXXXX MUST BE DORMANT AND NOT RESIDENT IN ANY PARTITION. * (IE HE MAY NOT HAVE PREVIOUSLY TERMINATED SERIALLY * REUSABLE. DO AN OF,XXXXX,1 IF HE DID) * ASIGN JSB SZCHK 1ST GO SEE IF CMND LEGAL JSB $SZIT GET THE NEEDED ADDRESSES. LDA P2 GET THE PARTITION CLE,SZA,RSS IF = 0 WE UNASSIGN JMP ASTUF GO UNASSIGN * SSA IF NEG IT'S AN JMP IPRTN ERROR CMA,INA IF GREATER THAT MAX # PART'NS ITS ADA $MNP AN ERROR SSA JMP IPRTN ALSO. * CCA NOW GO LOOK AT THE PARTITION ADA P2 ACCOUNT FOR BASE PAGE STA P2 AND SAVE MPY D7 INDEX TO THE ADA $MATA PROPPER $MATA ENTRY LDB A,I GET THE LENGTH WORD SSB IF ENTRY UNDEFINED ITS AN ERROR JMP IPRTN * ADA D4 NOW INDEX TO THE # PAGES LDA A,I WORD. AND B1777 KEEP ONLY THE PAGES STA TEMPX AND SAVE FOR LATER * LDB TEMPB,I GET THE EMA WORD SZB IS THIS AN EMA PROG ? JMP EMASS YES, SO DO THE EMA THING * GTPGS LDA TEMPI GET THE # OF PAGp`þúES WORD CMA,INA MAKE IT NEG ADA TEMPX AND CHECK IT. CCE,SSA IF NEG ITS AN ERROR JMP IPRTN * ASTUF LDA TEMPC,I GET THE SIZE WORD BACK AND B777K THROW AWAY OLD PARTITION IOR P2 PUT IN NEW PARTITION RAL,ERA FIX THE RESERVED BIT STA TEMPC,I AND PUT THE WORD BACK JMP M0150 AND RETURN * * EMASS LDA TEMPE GET THE ID EXTENSION ADDRESS INA LDA A,I GET THE DE BIT WORD ALF,RAL PUT IN SIGN BIT SSA,RSS WAS DEFAULT TAKEN ? JMP EMESS NO. * LDA TEMPB,I GET THE EMA SIZE WORD XOR TEMPG GET RID OF OLD SIZE INA SET DISPATCHER FLAG FOR MAX SIZE STA TEMPB,I CLA,INA,RSS * EMESS LDA TEMPG GET THE EMA SIZE CMA,INA ADA TEMPF REDUCE BY MSEG SIZE EMES1 ADA TEMPX OFSET THE PARTITION SIZE STA TEMPX AND RESET IT JMP GTPGS NOW GET # OF PAGES IN PROGRAM HED MESSAGE PROCESSOR --- QU COMMAND * * QU,XXXXX,YYYYY * * THE QU COMMAND WILL ASSIGN A SYSTEM SLICE VALUE AND/OR * THE PROGRAM PRIORITY LEVEL AT WHICH TIMESLICING BEGINS. * THE STATUS OF THE SYSTEM SLICE AND PRIORITY LEVEL IS * ALWAYS RETURNED UPON COMPLETION OF THIS COMMAND. * * * QUTM LDA PARAM FETCH PARAMETER COUNT CPA D1 IF JUST DISPLAY REQUEST, JMP QURPT GO DO IT * LDA $SVAL FETCH CURRENT SYSTEM QUANTUM LDB CP1 WAS A NEW QUANTUM ENTERED ? CPB D2 IF ASCII, JMP $INER INPUT ERROR * SZB,RSS IF NULL, JMP NOQU DON'T ALTER SYSTEM QUANTUM * LDA P1 FETCH NEW SYSTEM QUANTUM SSA IF NEGATIVE, JMP $INER INPUT ERROR * CLB CONVERT TO DIV D10 10'S OF MILLISECONDS ADB N5 IF REMAINDER SSB,RSS >= 5 INA BUMP Tü@þúO NEXT TENTH OF MS * * NOTE: (A) MUST NOT BE ALTERED UNTIL PRIORITY IS CHECKED OUT * AND THE SYSTEM QUANTUM IS UPDATED (@QUTM2). * NOQU LDB CP2 SEE IF A PRIORITY WAS ENTERED. CPB D2 IF ASCII, JMP $INER INPUT ERROR * SZB,RSS NULL ? JMP QUTM2 YEP -- CONTINUE * LDB P2 FETCH NEW PRIORITY SSB IF NEGATIVE, JMP $INER INPUT ERROR * CMB,INB SET IT NEGATIVE STB $SPRI AND SAVE IN GLOBAL LOCATION * QUTM2 STA $SVAL SAVE SYSTEM QUANTUM IN GLOBAL LOCATION ALSO * CLA FORCE A STA XEQT NEW DISPATCH ISZ $LIST USING THE NEW TIMESLICE PARAMETERS JMP $XEQ * * * * * * * THIS SECTION FORMATS AND PRINTS THE TIMESLICE PARAMETERS IN * THE FOLLOWING FORMAT: * * Q=XXXXX P=YYYYY * * * QURPT LDA $SVAL FETCH SYSTEM VALUE CCE SET E FOR DECIMAL CONVERSION JSB $CNV3 CONVERT IT TO ASCII INA ADVANCE TO LAST TWO WORDS DLD A,I AND FETCH THEM DST QUB2 SAVE IN BUFFER * * * LDA $SPRI FETCH PRIORITY CMA,INA SET IT POSITIVE JSB $CNV3 AND CONVERT LDB A,I FETCH FIRST 2 CHARS OF RESULT STB QUB6 INA ADVANCE TO LAST 2 WORDS DLD A,I FETCH DST QUB7 THEN SAVE IN PRINT BUFFER LDA DQUBF FETCH BUFFER ADDRESS JMP MSEX * SPC 5 N5 DEC -5 $SPRI DEC -50 BOOT PRIORITY=-50 $SVAL DEC 150 BOOT QUANTUM=1500MS NOTE: STORED AS 10' OF MS DQUBF DEF *+1 DEC -16 QUBUF ASC 8,Q=XXXX0 P=YYYYYY QUB2 EQU QUBUF+1 QUB6 EQU QUBUF+5 QUB7 EQU QUBUF+6 HED MESSAGE PROCESSOR CONSTANTS ETC. LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER MASKU OCT 177400 UPPER CHARACTER MASK (AND) TEMPP NOP TEMPORARY STORAGE KEY NOP TEMPORARY STORAGE * DEFP2 DEF DP2,I DP‡Vþú0 DEF OP DP1 DEF P1 DP2 DEF P2 DP3 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT * * * THE PLOAD SUBROUTINE IS CALLED BY THE RU, ON, & GO PROCESSORS * IT DECIDES WHETHER THE USER WANTED TO DO STRING PASSING AND/OR * SET UP THE 5 TEMP WORDS IN THE PROGRAMS ID SEGMENT. * * NOTE ! THE STRING TO BE PASSED IS ASSUMED TO BE IN THE SYSTEM * MAP. IF THE REQUEST CAME FROM THE USER MAP, THE $MSG * ROUTINE MOVES THE COMMAND BUFFER INTO A LOCAL BUFFER * IN THE SYSTEM MAP. * * * PLOAD NOP ENTRY/EXIT LDA WSTAT,I IF NO PRAM BIT IS RAL,RAL SET THEN DO NOT PASS CLE,SSA THE SCHEDULING STRING JMP PLOAD,I (SET E=0 FOR ALCST BELOW). LDB PARAM IF NO PARAMETERS, CPB D2 THEN DO NOT PASS JMP PLOD5 THE SCHEDULING STRING. LDB OP+1 CHECK FOR "IH" IN CPB ASCIH COMMAND TO INHIBIT JMP PLOD5 PASSAGE OF STRINGS. * CCA,CLE INDICATE THAT BUFFER IS IN SYSTEM MAP STA MVFLG AND SET A FLAG FOR THE ALCST SUBROUTINE * LDB WORK NO "IH",SO GET ID-SEG ADDRESS JSB ALCST AND GO STORE THE STRING. JMP NOMEM MEMORY ALLOCATION ERROR? JMP NOMEM YES, GO SEND MESSAGE. * PLOD5 LDB DEFP2 GET INDIRECT DEF TO PRAMS. LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA WORK GET ID-SEGMENT ADRESS JSB PRAM GO SET PRAMS. JMP PLOAD,I RETURN. * NOMEM LDA $NMEM GO ISSUE NO MEMORY JMP $MSEX MESSAGE AND RETURN. * ASCIH ASC 1,IH NO ASC 1,NO SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET ãþúNO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP PRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP PRAM1 NO- CONTINUE JMP PRAM,I YES , SO EXIT HED CROSS MAP PARAMETER CONTROL STORE SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. XPRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * NOTE THAT THE PARAMETERS THAT ARE BROUGHT IN ARE * FROM THE USER MAP, THAT IS, THE ALTERNATE MAP. THIS * MEANS THAT THE PARAMETERS TRUE ADDRESS MUST BE IN THE * CURRENT MAP BECAUSE THE CROSS LOAD INSTRUCTION CHASES * DOWN INDIRECTS IN THE CURRENT MAP BEFORE GOING ACROSS * MAPS TO PICK UP THE VALUE. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB XPRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. þú * XPRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP XPRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER XRAM1 CLA ZERO ADDRESS GETS A ZERO XLA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP XRAM1 NO- CONTINUE JMP XPRAM,I YES-EXIT * HED MESSAGE PROCESSOR NAME SEARCH * * CALL BY NAME SEARCH ROUTINE * * CALLING SEQUENCE: * * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * * WORK = ID ADDRESS * B = ID ADDRESS IF A PROGRAM, IF SEGMENT B = 5 (IE TYPE) * A = LEAST 4 STATUS BITS * E = 0 STANDARD ID SEGMENT * E = 1 SHORT ID SEGMENT * * TTNAM NOP ENTRY/EXIT LDB DEFP1 ADDRESS OF ASCII PROG NAME JSB TNAME CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! * LDA WORK SEE WHAT TYPE PROGRAM IS ADA D14 WITHOUT EFFECTING E REG LDA A,I AND D7 CPA D5 IS IT A SEGMENT ? JMP OPOK? YES, SEE WHO WANTS TO KNOW SPC 2 OPOK! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND JMP TTNAM,I RETURN SPC 2 OPOK? STA B A SEGMENT SET B = 5, B NOT = ID ADDR. LDA OP GET THE INPUT COMMAND CPA OF OFF COMMAND ? JMP OPOK! YES. CPA ST ST COMMAND ? JM””þúP OPOK! YES. SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR (YOU LOSE !) JMP MSEX EXIT HED SEARCH KEYWORD LIST FOR PROGRAM NAME * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B AND WORK ARE THE ID SEGMENT ADDRESS OF REQUESTED PROGRAM * WSTAT = THE STATUS WORD ADDRESS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT OR NOT FOUND * TNAME NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP TNAME,I EXIT HED CVT3 (BINARY TO ASCI¤ÚþúI CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CNV3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CNV3 NOP STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CNV3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 HED $CNV1 (BINARY TO ASCII CONVERSION) * CALLING SEQUENCE: SAME AS $CNV3 * * RETURN RESULTS LEAST TWO DIGITS IN A. * OTHERS AS PER $CNV3 * $CNV1 NOP JSB $CNV3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CNV1,I RETURN HED PROGRAM SIZE .VS. PART'N SIZE CHECK * * * THE $SZIT SUBROUTINE IS CALLED BY THE EXEC 9,10,23 & 24 * PROCESSORS AND IS CALLED FOR THE ON, RU, & SZ bßþúCOMMANDS. * IT IS ALSO CALLED BY THE DISPATCHER IF A PARITY ERROR * HAS OCCURED AT ANY TIME IN THE PAST AND A SEARCH WAS MADE * FOR A PARTITION & NONE OF THE PROPER SIZE WAS FOUND. * THE SUBROUTINE MAKES SURE THAT THE PROGRAM TO BE SCHEDULED * WILL FIND A PARTITION LARGE ENOUGH TO RUN IN. THAT IS * IT MAKES SURE THAT NO PROGRAM IS FOREVER SCHEDULED BUT * BUT NEVER DISPATCHED. THIS CASE WILL OCCUR IF A PROGRAM * IS LOADED, THEN SP 'D , THE SYSTEM THEN REDEFINED, AND THEN * THE PROGRAM RP 'D AND PROGRAM EXECUTION ATTEMPTED. * * * CALLING SEQUENCE JSB $SZIT * ID ADDRESS IN WORK * * ON RETURN A = 0 ALL IS WELL * A = ASCII ERROR CODE ADDRESS. (PROG TOO LARGE) * B = 8 IF PROG ASSIGNED TO A PARTITION * = 9 IF PROGRAM IS NOT ASSIGNED TO ANY PARTITION. * * TEMPS : TEMPA = $MBGP, $MRTP, $MCHN, OR PARTITION SIZE * TEMPB = ADDR OF ID SEG WORD # 29, THE EMA SIZE WORD * TEMPC = ADDR OF ID SEG WORD # 22, SIZE - PARTITION WORD * TEMPD = ERROR COSE 8 OR 9 (AS IN B-REG ABOVE) * TEMPE = ADDRESS OF ID EXTENSION * TEMPF = MSEG SIZE * TEMPG = EMA SIZE * TEMPI = #OF PAGES OF PROG (INCLUDES 1 MSEG) * * * $SZIT NOP LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I PULL IT IN AND D7 KEEP ONLY TYPE BITS CPA D1 IF MEM RES JMP SIZOK THE MAKE SUCCESSFUL RETURN * LDB $MBGP ASSUME PROG IS BG CPA D2 IS IT ? LDB $MRTP NO, BETTER LUCK NEXT TIME. STB TEMPA SAVE THE PROPER SIZE WORD * LDB WORK GET THE ID ADDRESS AGAIN ADB D28 NOW GET TO THE EMA WORD STB TEMPB (SAVE THE ADDRESS TOO ) LDA B,I AND PULL IT IN LDB $MCHN GET THE MAX EMA SIZE SZA IS PROG EMA ? STB TEMPA YES œ!þúSO SIZE IS EMA * LDB WORK GET THE ID ADRESS AGAIN ADB D21 INDEX TO THE PARTITION WORD STB TEMPC (SAVE THE ADDRESS TOO ) LDA B,I PULL IT IN NOTAS LDB D9 GET THE PROPPER ERROR CODE SSA,RSS IS PROG ASSIGNED ? JMP GOSIZ NO * AND B77 GET THE PARTITION MPY D7 AND USE AS INDEX ADA $MATA INTO THE LDB A,I GET THE 1ST WORD SSB IF UNASSIGNED, JMP UNASN THEN UNASSIGN THE PROGRAM & TRY AGAIN ADA D4 $MATA TABLE LDA A,I GET THE SIZE OF THE AND B1777 PARTITION STA TEMPA AND SAVE LDB D8 GET THE ERROR CODE * * GOSIZ STB TEMPD AND SAVE IT IF WE NEED IT LDA TEMPC,I ALF GET # OF PAGES IN PROG (+ MSEG IF EMA) RAL,RAL AND B37 STA TEMPI SAVE FOR LATER * LDB TEMPB,I GET THE EMA FLAG SZB IS PROGRAM EMA ? JMP EMACK YES SO CHECK IT OUT * CMA,INA NOW SEE IF ADA TEMPA IF IT IS DISPATCHABLE SZBAD LDB TEMPD GET THE ERROR CODE READY * SSA,RSS WELL ? SIZOK CLA,RSS YES ALL IS WELL, SO CLEAR A LDA $SERR NO, SEND ERROR CODE TO CALLER JMP $SZIT,I RETURN * UNASN LDA TEMPC,I GET THE PART'N WORD AND B777K UNASSIGN THE PROGRAM STA TEMPC,I AND JMP NOTAS TRY AGAIN. * TEMPA NOP TEMPB NOP TEMPC NOP TEMPD NOP TEMPE NOP TEMPF NOP TEMPG NOP TEMPI NOP * * EMACK LDA B ALF GET ID EXTENSION TO LOW END RAL,RAL AND B77 NOW USE THIS AS AN INDEX TO THE ADA $IDEX PROG'S ID EXTENSION LDA A,I PULL IT IN STA TEMPE SAVE THE ADDRESS LDA A,I NOW GET THE AND B37 MSEG SIZE STA TEMPF SAVE THIS TOO * LDA TEMPB,I NOW GET THE EMA SIZE FXEMA AND B1777 LDB A PUT IN I “þúN B=REG TOO STB TEMPG AND SAVE AGAIN ADA TEMPI A= [ #PGS + EMA SIZE ] CMA,INA A= -[ #PGS + EMA SIZE ] ADA TEMPA A = $MCHN - [#PGS + EMA SIZE] ADA TEMPF A = $MCHN -[#PGS - MSEG + EMA SIZE ] SPC 1 * A = $MCHN - [#PGS - MSEG + EMA SIZE ] OR SPC 1 SSA,RSS IS IT OK ? JMP SIZOK YES * CPB D1 IF EMA SIZE = 1, THEN IT'S AN JMP SZBAD ERROR * CLB,INB WELL, PAL YOU GET ONE LAST CHANCE ADB TEMPE INDEX TO THE DE BIT IN THE LDB B,I ID EXTENSION BLF,RBL NOW SEE IF THE EMA SIZE WAS DEFAULTED SSB,RSS WELL ? JMP SZBAD NO, SO YOU'RE A LOSER ! * LDB WORK OK, BUT HAS THE PROGRAM EXECUTED ? ADB D8 LDB B,I GET POINT OF SUSPENSION SZB HAS IT EVER EXECUTED ? JMP SZBAD YES, CAN ONLY HAVE BEEN A PARITY ERROR * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD SIZE INA IN GOES THE DEFAULT (A FLAG TO THE STA TEMPB,I DISPATCHED TO GIVE LARGEST SIZE) JMP FXEMA PLAY IT AGAIN SAM HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * THE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLED. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHE9¤þúCK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ * ******IFN SYSTEM\SESSION CONSOLE WORK LDA $CES+1 CHECK SYS/SES CON FLAG SZA IF ENABLED JMP $SCON GO PROCESS SESSION WORK ******XIF * * STANDARD SYSTEM CONSOLE PROCESSING * JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLAG JMP $XEQ GO TO $XEQ * * SYSTEM SESSION CONSOLE CONTINUES HERE FOR "OP" CMND PROCESSING * TYP10 CLA CLEAR THE COM FLAG STA FLG LDA IBUF GET BUFFER ADDRESS TO A * TYP11 JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP27 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT  CMB,INB TO POSITIVE WORD COUNT. STB TYPCO SAVE WORD COUNT. LDB IBUF GET BUFFER INA ADDRESSES. MVW TYPCO GO MOVE WORDS. * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ * TYP27 LDA OP GET THE OP CODE CPA RU WAS IT A RUN ? RSS YES CPA ON NO, WAS IT AN ON ? RSS YES JMP TYP30 NO, DO COMPLETION STUFF * LDB WORK GET THE ID ADDRESS ADB D3#jþú2 GET SESSION WORD # 3 ADDRESS CCA A = -1 (NEG LU # OF SYS CONSOLE) STA B,I SET THE LU IN THE ID SEGMENT TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW **** **** 11 WORD LOG-ON PROMPT FIELD **** ** $BRKP DEC -15 COMMON BREAK MODE PROMPT (11 WORDS ALSO) BRKMS ASC 10,S= 1 COMMAND ?_ **** **** ******IFN SYSTEM/SESSION CONSOLE WORK HED SYSTEM/SESSION CONSOLE ROUTINES * * * * * * * LDA $SHED * JSB MAPIN *SET UP CORRECT MAP * $SCON LDA $SHED FETCH HEAD OF SCB LIST SZA,RSS ANYTHING DEFINED ? JMP SLGON NO-- GO ISSUE LOG-ON PROMPT. * ADA $SMST OFFSET TO SESSION ID LDA A,I FETCH IT CPA D1 IF=1 JMP SBREK A SESSION ALREADY EXISTS * * ISSUE LOGON PROMPT * * NOTE: THE DEFAULT LOG-ON PROMPT IS "PLEASE LOG-ON:". THE * ACCTS PROGRAM HAS THE ABILITY OF CHANGING THIS BY * MOVING THE NEW PROMPT STRING INTO THE 11 WOR BUFFER * SLGON LDB !BITM FETCH WORD WITH POSSIBLE RBR,SLB LU 1 BUSY FLAG SET. JMP LPEN IT'S BUSY, GO DO SPECIAL PROMPT * * LDA $LMES SET LOG-ON STA LLEN PROMPT LENGTH * * JSB $XSIO OCT 1 WRITE LOG-ON PROMPT NOP NOP OCT 2 DEF $LMES+1 MESSAGE BUFFER LLEN NOP OCT 0 DON'T NEED USER MAP * * IF IN SHUT DOWN STATE, ISSUE MESSAGE THEN GIVE SPECIAL PROMPT. * LDA $DSCS+1 FETCH SHUT DOWN FLAG SSA IF SHUT DOWN JMP LPEN GO ISSUE SPECIAL PROMPT * * * ISSUE READ OF RESPONSE * * JSB $XSIO OCT 1 DEF SESIN COMPLETION ADDR NOP OCT 401 READ WITH ECHO DEF INBUF+1 FIRST WORD OF BUFF USED AS FLAG ABS -BUFFL+1 OCT 0 DON'T NEED USER MAP ¾þú ISZ FLG SET SYS CON BUSY JMP $XEQ CONTINUE * * * * * LOG-ON COMPLETION PROCESSOR * * * SESIN STB TLOG SAVE TRANSFER LOG CLA SET LOG-ON FLAG STA INBUF FOR STRING * * * SEND STRING TO COMMUNICATION PROGRAM. THE STRING IS THEN * PASSED TO LOGON OR PRMPT VIA A CLASS WRITE\READ REQUEST. * * * * * * TLOG=BYTE COUNT OF STRING * * INBUF=FLAG(FIRST WORD) AND STRING * FLAG=0 IF LOG-ON REQUEST * =1 IF BREAK MODE REQUEST * * PSTNG LDB DCOM FETCH ADDR JSB TNAME OF NAME OF COMMUNICATION SZA,RSS PROGRAM. FIND IT? JMP NOTIN NO--NOT INITIALIZED ERROR * STB COMID SAVE COMMUNICATION PROG'S ID ADDR LDA IBUF SET UP FOR STRING STA BFADD REQUEST LDB TLOG FETCH BYTE COUNT ADB D2 ADD TWO CHARS FOR FLAG STB BFCNT SET STRING LENGTH * CCA,CLE CLEAR E FOR CALL AND SET BUFFER STA MVFLG IN SYSTEM MAP FLAG LDB COMID FETCH PROG'S ID ADDR JSB ALCST AND GO SET UP STRING NOP JMP MEMER NO MEMORY ERROR * LDB COMID MAKE SURE PROGRAM IS SCHEDULED ADB D15 LDA B,I AND D15 SZA IF NOT DORMANT JMP SETB CONTINUE * LDB COMID ELSE JSB $LIST CALL LIST OCT 401 PROCESSOR TO GET PROGRAM SCHEDULED * SETB LDA D2 SET SESSION BUSY IOR !BITM FLAG IN STA !BITM BIT MAP CLA CLEAR SYS CON BUSY STA FLG FLAG JMP $XEQ CONTINUE * * TLOG NOP "OP" ASC 2,OP, B.SY ASC 9,S=?? COMMAND ?OP,_ * DCOM DEF COMPG COMMUNICATION PROGRAM NAME COMPG ASC 3,$YCOM COMID NOP SPC 5 MEMER LDA $NMEM,I FETCH MESSAGE LENGTH STA ELN.1 SAVE FOR XSIO * JSB $XSIO ISSUE THE NO MEMORY ERROR OCT 1 NOP NOP ‹”þú OCT 2 DEF $NMEM+2 ELN.1 NOP NOP JMP LPEN GO ISSUE SPECIAL PROMPT FOR THIS TYPE OF A MESS * I.E., THE ONLY COMMAND ALLOWED IS THE "OP" COMMAND * * SKP * * * * A SESSION EXISTS FOR LU 1. THIS SECTION PROCESSES THE BREAK * MODE REQUESTS. * * SBREK JSB $XSIO OCT 1 NOP PROMPT NOP FOR BREAK MODE OCT 2 INPUT DEF BRKMS DEC -15 OCT 0 DON'T NEED USER MAP * * JSB $XSIO OCT 1 DEF BRKIN COMPLETION ROUTINE NOP FOR READ OF INPUT OCT 401 DIBF DEF INBUF+1 ABS -BUFFL+1 1ST WORD IS FLAG OCT 0 * ISZ FLG SET SYS CON BUSY FLAG JMP $XEQ CONTINUE * * * BRKIN STB TLOG SAVE TRANSFER LOG LDA DIBF FETCH BUFFER ADDR JSB $PRSE GO DO A PARSE ON INPUT DEF PRAMS CLA,INA SET FLAG FOR STA INBUF BREAK MODE STRING REQUEST * LDA OP FETCH OPERATION CODE CPA "OP" IF OPERATOR REQUEST CLA,RSS SKIP JMP PSTNG NOT OPERATOR REQUEST--SEND COMMAND TO SESSION MONITOR * STA FLG CLEAR TTY BUSY FLAG LDA DIBF FETCH INPUT BUFFER ADDR LDB TLOG AND TRANSFER LENGTH JMP TYP11 GO PROCESS COMMAND * * * SKP * * * * * * THE ACTION IN PROGRESS BIT (BIT MAP !BITM) WAS SET AND ANOTHER * INTERRUPT WAS RECEIVED. THE ONLY COMMAND PERMITTED IN THIS STATE * IS THE "OP" COMMAND. THEREFORE, THE PROMPT ISSUED HERE CONTAINS * THE "OP" TO INFORM THE OPERATOR OF THE STATE. * * * LPEN JSB $XSIO OCT 1 WRITE NOP NOP OCT 2 BUSY STATE PROMPT DEF B.SY DEC -18 OCT 0 * * DLD "OP" SET ASCII "OP, " INTO BUFFER FOR PARSE DST INBUF * * * ISSUE READ OF RESPONSE * JSB $XSIO OCT Q›þú1 DEF LP.CM COMPLETION ROUTINE NOP OCT 401 D.BF DEF INBUF+2 ABS -BUFFL+4 OCT 0 ISZ FLG SET SYS CON BUSY JMP $XEQ CONTINUE * * * BUSY STATE COMPLETION PROCESSOR * * * LP.CM ADB D4 ADD LENGTH OF "OP, " JMP TYP10 GO PROCESS THE REQUEST * * * * * * * * * * * * * ENABLE FOR SESSION * * $DSCS= SESSION INITIALIZED FLAG <0=NOT INIT * $CES = SYSTEM SECURITY CODE (SET BY FMGR) * $CES+1= SESSION ENABLED FLAG 0=NOT ENABLED, <0=ENABLED BUT SEC * CODE NOT REQUIRED, >0= ENABLED AND * SECURITY CODE REQUIRED (=$CES). * * FORMAT OF COMMAND= EN,SC,OPTION * * * * * ENAB LDB $DSCS FETCH SESSION INIT FLAG SSB IF NOT INITIALIZED JMP NOTIN GO REPORT IT * LDB DCOM FETCH ADDR OF NAME OF COMM PROGRAM JSB TNAME SEE IF COMMUNICATION PROGRAM IS PRESENT SZA,RSS IF NOT FOUND JMP NOTIN ISSUE INITIALIZATION ERROR * * SEE IF SEC CODE REQUIRED AND IF IT WAS PASSED. * LDA $CES FETCH REQUIRED PASSWORD SZA,RSS IF NOT REQUIRED JMP NOSEC SKIP VERIFICATION * XOR MSKSC REMOVE SECURITY CODE MASK INA AND ADD ONE BACK IN CPA P1 IF REQUIRED, WAS IT CORRECTLY RSS SPECIFIED -- SKIP JMP $INER ELSE ISSUE "INPUT ERROR" * LDB P2 FETCH OPTION WORD SZB,RSS IF SC OPTION NOT SELECTED NOSEC CCA SET NOT REQUIRED FLAG (GLM.2013) STA $CES+1 ELSE SET REQUIRED SC AS FLAG * * CLA,RSS * NOTIN LDA SESER JMP MSEX * * SESER DEF *+1 DEC -15 ASC 8,NOT INITIALIZED * * MSKSC DEC 31178 * * * * * * * * * "OP" COMMAND * * OP,SC,COMMAND * * OPIN LDB BFCNT FETCH CHAR COUNT CMB,INB SET IT NE ™þúGATIVE STB BFCNT LDA $CES+1 FETCH ENABLED FLAG SZA,RSS IF NOT ENABLED JMP $INER THIS WAS A BOO BOO * SSA,RSS IF $CES+1 < 0 S.C. NOT REQUIRED CPA P1 REQUIRED, DOES IT MATCH ? RSS CONTINUE JMP $INER BAD INPUT "INPUT ERROR" * LDA DM2 STA TEMP1 TEMP1 * LDB BFADD FETCH BYTE ADDR OF PRE-PARSE INPUT BUFFER CLE,ELB NBYTE LBT CPA B54 COMMA JMP C.1 NBYT2 ISZ BFCNT JMP NBYTE LDA $OPER ISSUE JMP MSEX "OP CODE ERROR" * * B54 OCT 54 * C.1 ISZ TEMP1 JMP NBYT2 * SLB,RSS IF COMMAND STARTS ON JMP EVEN WORD BOUNDARY - CONTINUE * ADB DM1 BACK UP TO COMMA ADDR LDA B40 ASCII BLANK SBT * EVEN SLB,RSS IF STARTS ON WORD BOUNDRY ISZ BFCNT SUBTRACT 1 FOR LAST COMMA FOUND * CLE,ERB SET WORD ADDR LDA B MOVE WORD ADDRESS TO (A) LDB BFCNT B=CHAR COUNT CMB,INB SET IT POSITIVE STB BFCNT RESTORE CHARACTER COUNT STA BFADD RESTORE BUFFER ADDRESS JMP NMESS GO PARSE INPUT STRING & DO REAL COMMAND * * NOTE (A) AND (B) MUST BE SET-UP FOR NMESS WORK * ******XIF HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE AND THE SESSION TERMINAL * (UNLESS THE NO PRINT OPTION WAS SPECIFIED). * * CAL¬-þúL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR SABRT CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB SABRT THE SOFT ABORT ROUTINE LDA TEMPH GET THE ADDRESS AND JSB $SDRL GO RELEASE THE DISC TRACKS LDA NOPRN GET NO PRINT OPTION FLAG SZA,RSS SET? JMP PRNT NO, PRINT MESSAGE * CLA CLEAR THE FLAG STA NOPRN JMP $ABRT,I EXIT * PRNT LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 * LDB TEMPH FETCH PROG'S ID ADDR JSB $LU?? GET SESSION/MTM TERM LU CCE,RSS DIDN'T FIND A GOOD LU--PRINT ON LU 1 ONLY CMA,CLE,INA SET E IF LU=1 (LU-1) LDA ABMA FETCH BUFFER ADDRESS LDB TEMPH FETCH ID ADDR FOR POSSIBLE ECHO WORK SEZ,RSS IF TERM LU NOT = 1 JSB $BFOT GO ECHO ON SESSION TERMINAL JSB $YMG ISSUE "XXXXX ABORTED" ON LU 1 JMP $ABRT,I EXIT * * ABMA DEF *+1 DM14 DEC -14 ABM ASC 7,PROGX ABORTED AASCI ASC 1, HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT9 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND ($ þúOPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) * SET/CLEAR ALL-OR-MEMORY AND CORE-LOCK FLAGS * GET/PUT A COMMAND STRING ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A FATHER CHECKS * ADB D20 STEP TO FATHER POINTER ADDRESS CCA GET ADA B,I TO A AND B377 AND MASK ADA KEYWD ADDRESS OF ID OF FATHER IN A LDA A,I NOW CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * MPT1A LDB P2 RESTORE THE ID-SEGMENT ADDRESS TO B LDA RQRTN UPDATE THE RETURN STA XSUSP,I ADDRESS CLA SET A TO ZERO IN CASE XLA RQP3,I PRAMETER NOT SUPPLIED $EX6 NOP SZA FOR RTE-M4, TERM.REUSABLE (GLM.2013) CMA,SZA,RSS IS THIS GUY SERIALLY REUSABLE JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B STANDARD TERMINATION CALL. * INA,SZA,RSS IS IT JMP MPT1C A SAVE RESOURCES TERMINATION * INA,SZA,RSS MAY BE A SOFT ABORT JMP M0240 YES GO TO ABORT ROUTINE * INA,SZA,RSS HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CLOSE! * ESC02 LDB D2 YOU LOSE - UNRECOGNIZED PRAMETER. JMP ESCXX GO ABORT HIM * MPT1C LDA WORK GET ID ADR JSB ALDM GO PUT IN DORMANT LIST & SET FLG LDB WORK RESTORE B LDA WSTAT,I SET THE IOR B200 RESOURCE BIT IN THE STATUS STA WSTAT,I AND THEN9›þú CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIAL REUSE LDA IDCKK JSB ALDM GO PUT IN DORMANT LIST & SET FLAG JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F ISZ TMP,I FINALLY, ALSO SET A FLAG (BIT 1) ISZ TMP,I IN WORD 20 TO INDICATE NORMAL_TERM. LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER. * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB XPRAM TRANSFER THE PRAMETERS JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 SKP * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 3. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB TREM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM DEF D.RTR JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST * STB IDCKK SAVE THE ID-ADDRESS ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR RESTORE A AND SET E TO FATHER WAIT‚ýþúING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D20 DEC 20 SIGN OCT 100000 B200 OCT 200 B7400 OCT 7400 DEFR4 DEF RQP4,I SPC 2 $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN * SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 LDA XEQT GET ADDR OF ID SEG ADA D20 LDA A,I GET FATHER POINTER CLB SSA IF BATCH FLAG IS SET JMP ESCXX ABORT SC00 LDA XEQT GET CURRENT ID ADR JSB ALDM GO PUT IN DORMANT LST & SET DM FLAG JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST JMP MEM15 GO UPDATE XSUSP SPC 3 * * READ IN BACKGROUND PROGRAM SEGMENT * $MPT3 CCA CHECK PARAMETER COUNT ADA RQCNT SSA JMP ESC01 ERROR, SO RETURN LDB RQP2 ADDR OF ASCII PROG SEGMENT JSB PLNAM PULL IT IN LOCALLY JSB TNAME GO FIND THE ID SEG. SZA,RSS IF NOT FOUND JMP ESC05 TAKE GAS! ADB D7 STEP TO PRIMARY ENT PT. SEZ IF SHORT ID-SEG. STEP ADB D4 TO THE SHORT ID-SEG PRI ENT PT. ADD LDA B,I FETCH AND STA $WATR SET AS RETURN ADDRESS ð²þúADB D7 STEP TO TYPE ADDRESS LDA B,I BET TYPE AND D7 MASK IT SEZ,RSS IF SHORT IT MUST BE A SEG. CPA D5 SEGMENT?? CCE,RSS YES SKIP. JMP ESC03 NO TAKE GAS! LDA $WATR SET UP RETURN ADDRESS STA RQRTN LDB WORK GET THE ID-SEG ADDRESS STB XA,I JSB $BRED GO SET UP TO LOAD CCB SET THE ALL OF CORE ADB WSTAT BIT LDA B,I FOR THE IOR LASCI DISPATCHER STA B,I JSB PRAMO PASS PRAMETERS IF ANY JMP MEM15 ADVANCE THE RETURN ADDRESS AND EXIT SPC 3 * PRAMO PASSES PRAMETERS FROM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * * CALLING SEQUENCE: * * SET UP WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRAMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB XPRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. SKP * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * * * ENTRY MADE BY $SCD3 NOP * RSB * SJP $SCD * * * $SCD RBL,RBL STB TEMPD STA $IDNO SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB IF END OF LIST JMP SCDMR JRS TEMPD $SCD3,I RETURN * SCDMR LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA $IDNO THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TRþþúEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA PRAMO AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOES ID-SGEMENT ADDRESS IS IN B LDB PRAMO GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST * SKP * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT CLE CLEAR E FOR SCHOK ROUTINE * * NOTE: "WORK" MUST = ID ADDR OF TARGET PROGRAM * JSB SCHOK GO CHECK TIME LIST RESTRICTIONS OF TARGET PROGRAM JSB PASES GO PASS SESSION WORD OF FATHER TO SON LDB XEQT GET THE ADDRESS ADB D20 OF THE BATCH FLAG LDA $IDNO,I FETCH SON'S FATHER WORD XOR B,I AND SET IT AND C120K INTO THE XOR B,I THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STATUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM JMP MEM15 * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT CLE CLEAR E FOR SCHOK * * NOTE: "WORK" MUST = ID ADDR OF TARGET PROGRAM * JSB SCHOK GO CHECK TIME LIST RESTRICTIONS OF TARGET PROGRAM JSB PASES GO PASS SESSION WORD FROM FATHER TO SON * MEM15 LDA RQRTN SET UP SUSPENSION STA XSUSP,I POINT JMP $XEQ * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESC03 LDB D3 RSS ESC04 LDB D4 RSS ESC05 LDB D5 NO SUCH PROGRAM ERROR CODE. RSS ESC07 LDB D7 RSS ESC10 LDB B400 (SC10) NO MEM EVER FOR STRING PASSAGE. RSS ESC11 LDB B401 (SC11) REQUESTED PROGRAM IN TIME LIST FOR DIFF SESSION ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE $SCXX EQU ESCXX Gkþú* B40K OCT 40000 B400 OCT 400 B401 OCT 401 C120K OCT 57777 SKP * * SCHOK CHECKS THE TARGET PROGRAM TO SEE IF IT MAY BE SCHEDULED * OR HAVE IT'S TIME VALUES CHANGED BY THE CURRENTLY EXECUTING * PROGRAM. * * IF THE TARGET IS IN THE TIME LIST, ONLY PROGRAMS OF THE SAME * SESSION MAY ACCESS IT. THIS IS BECAUSE THE PROGRAM MAY DEPEND * ON OPERATING WITHIN THE ENVIRONMENT DEFINED BY IT'S SESSION. IF * ANOTHER SESSION WERE TO RUN THIS PROGRAM, THE ORIGIONAL SESSION * WORD WOULD BE REPLACED BY THE NEW SESSION'S SCB ADDR. * * ANY REQUEST TO DEFINE THE TIME VALUES OF A PROGRAM (EXEC 12) IS * ALSO RESTRICTED TO WORK ONLY WITH PROGRAMS OF THE SAME SESSION. * * SPC 3 * CALLING SEQUENCE: XEQT=ID ADDR OF REQUESTING PROGRAM * WORK=ID ADDR OF TARGET PROGRAM * E=1 IF EXEC 12 REQUEST * ELSE E=0 * * JSB SCHOK * * RETURN : ALL REGISTERS MODIFIED * * * * SCHOK NOP LDB WORK FETCH ID ADDR OF TARGET PROG ADB D17 ADVANCE TO TIME LIST WORD LDA B,I ALF,SLA IF IN THE TIME LIST JMP CKSSN GO DO MORE CHECKS * SEZ,RSS NOT IN TIME LIST SO RETURN IF JMP SCHOK,I CALL IS NOT FOR EXEC 12 REQUEST * CKSSN ADB D15 ADVANCE TO SESSION WORD OF TARGET LDA B,I SZA IF PROGRAM NOT UNDER SSA SESSION CONTROL JMP SCHOK,I LET THE REQUEST GO THROUGH * LDB XEQT FETCH ADB D32 SESSION WORD CPA B,I IF MATCH WITH TARGET PROGRAM JMP SCHOK,I LET IT CONTINUE * JMP ESC11 REJECT WITH SC11 ERROR * * SPC 5 * * * PASES WILL PASS THE SESSION WORD FROM FATHER TO SON * "WORK" MUST BE SET UP TO POINT AT THE SON PROGRAM * * PASES NOP LDB XEQT FETCH ADB D32 FATHER'S LDB B,I SESSION WORD LDA WORK FETCîþúH ADA D32 ADDR OF SON'S SESSION WORD STB A,I PLACE FATHER'S SESSION WORD INTO SON'S ID JMP PASES,I * SKP * * CALL TO GET SYSTEM REAL TIME * $MPT6 LDA RQP2 SAVE THE BUFFER STA TEMP1 ADDRESSES LDA RQP3 STA TEMP2 * LDA DPNAM GET THE ADDRESS OF OUR LOCAL BUFFER STA RQP2 AND USE IT ADA D5 INSTEAD STA RQP3 * DLD $TIME GET THE TIME JSB $TIMV AND CONVERT IT * LDA D5 GET THE # OF CAX TO X LDA DPNAM THE SOURCE LDB TEMP1 THE DESTINATION MWI GIVE THE DATA TO THE USER * LDA DPNAM+6 GET THE YEAR XSA TEMP2,I GIVE TO USER(IF TEMP2 = 0 ITS A NOP) JMP MEM15 GO TO STORE RETURN ADDRESS * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"IS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS * GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME XLA RQP2,I GET THE PRAMETER SZA,RSS ANY SUPPLIED ? JMP GTID# NO LDB RQP2 GET ADDRESS OF NAME JSB PLNAM PULL IT IN LOCALLY GTID# JSB TNAME GO SEARCH FOR IT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $ID# RAL,RAL STA TEMPD STB GETID SAVE THE REQUESTED ID-ADOqþúDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JRS TEMPD $IDNO,I RETURN * SKP * * CALL TO SET ID SEGMENT TIME VALUES * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 4 OR 7 ADA RQCNT SZA,RSS IF SEVEN THEN JMP MPT7A CONTINUE, ELSE ADA D3 CHECK FOR 4 SZA JMP ESC01 YOU LOSE, WRONG # OF PRAMS XLA RQP5,I NO CHECK PRAM 5 SZA,RSS IF = 0 JMP ESC02 YOU LOSE * MPT7A XLA RQP3,I IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET SET UP ID-SEG POINTERS ("WORK") * CCE SET (E) FOR SCHOK JSB SCHOK GO CHECK TIME LIST RESTRICTIONS JSB PASES GO PASS SESSION WORD FROM FATHER TO SON LDB WORK FETCH ID ADDR LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE * DM7 DEC -7 * SKP * * THE IDCKK SUBROUTINE CHECKS THE STATUS OF POTENTIAL * SON PROGRAMS & DETERMINES WHETHER TO HONOR THE FATHER- * SON SCHEDULE REQUEST. * * * SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE IDCKK NOP LDB RQP2 GET PROG NAME ADDRESS JSB PLNAM PULL IT IN LOCALLY JSB TNAME NOW SEE IF THE PROGRAM EXISTS SEZ JMP ESC05 NO SUCH PROGRAM ERROR ADB D14 MAKE SURE IT IS NOT LDA B,I A SEGMENT AND D7 CPA D5 IF SEGMENT JMP ESC03 TAKE GAS! JSB $SZIT SEE IF IT WILL FIT SZA WELL ? JMP ESCXX NO,SO TAKE GAS !G›þú * LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA WORK ALSO COMPUTE THE ADA D20 FATHER POINTER WORD ADDRESS STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * XLB RQP9,I (A MUST=0)CHECK IF THE OPTIONAL SZB,RSS PARAMETER STRING IS INCLUDED. JMP IDCK4 IF NOT,SKIP STRING STORAGE. JSB $CVWD CONVERT BUFFER LENGTH TO STB BFCNT POSITIVE CHARS AND SAVE. LDA RQP8 SET UP BUFFER ADDRESS. STA BFADD CLE LDB WORK GET ID-SEGMENT ADDRESS JSB ALCST AND STORE PARM.STRING. JMP ESC10 ABORT PROGRAM(SC10)IF NO MEM EVER. JMP NMNOW SUSPEND FATHER IF NO MEM NOW. * IDCK4 JSB PRAMO PASS THE PARAMETERS,IF ANY,TO IDCK5 JSB $LIST THE ID-SEG.AND THEN SCHEDULE. OCT 301 STA XA,I SHOW THAT IT WAS DONE STB XTEMP,I SON'S ID ADDR TO FATHER'S 1ST TEMP WORD LDA $IDNO,I (MIGHT BE EXEC 9). GET THE CURRENT FLAG BITS AND C377 MASK OUT ANY OLD FATHER NUMBER. IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK5 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I ANÜOþúD RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * DM8 DEC -8 C377 OCT 177400 SKP * *SCHEDULE WITH WAIT WITH WAIT REQUEST * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 SKP * * $MPT8 SET/CLEAR ALL OF MEMORY AND CORE LOCK FLAGS * * EXEC 22 REQUEST WITH ONE PRAMETER * PRAMETER MEANING * 0 CLEAR CORE LOCK * 1 SET CORE LOCK * 2 CLEAR ALL OF MEMORY FLAG * 3 SET ALL OF MEMORY FLAG. * $MPT8 LDB XEQT GET THE ADDRESS ADB D14 OF THE BITS IN THE ID-SEGMENT STB $LIST SAVE ADDRESS LDA B,I GET CURRENT STATUS XLB RQP2,I GET THE REQUEST WORD CMB,INB,SZB,RSS IF ZERO JMP CLCL CLEAR THE CORE LOCK * INB,SZB,RSS IF ONE JMP STCL SET THE CORE LOCK * INB,SZB,RSS IF TWO JMP MEM15 CLEAR ALL OF MEMORY FLAG * INB,SZB IF NOT THREE THEN JMP ESC02 GO ABORT HIM. JMP MEM15 * STCL LDB SWAP CHECK IF LEGAL REQUEST RBR,RBR GET LEGAL FLAG SLA TO LEAST B RBR,CLE CLE,SLB,RSS IF ILLEGAL JMP ESC07 GO DO HIM IN * CLCL LDB B100 GET THE CORE LOCK FLAG TO B MPT81 ÀþúIOR B SET THE FLAG SEZ AND IF A CLEAR REQUEST XOR B CLEAR THE FLAG STA $LIST,I RESET THE WORD JMP MEM15 GO EXIT. SKP ********************************************************************** * * EXEC 14--GET/PUT A COMMAND STRING. * * FOUR PARAMETERS USED: * . * . * . * JSB EXEC * DEF RTN * DEF ICODE * DEF GPCOD * DEF IBUFR * DEF IBUFL * RTN . * . * . * ICODE DEC 14 * GPCOD DEC 1 OR 2 1 = GET(RETRIEVE)PARAMETER STRING * 2 = PUT(WRITE)PARAMETER STRING TO FATHER * IBUFR BSS N BUFFER OF N WORDS * IBUFL DEC N(OR -2N) BUFFER LENGTH WORDS(+) OR CHARACTERS(-) * ****************************************************************** * $MPT9 LDA RQCNT CHECK TO SEE ADA DM3 IF THERE ARE SSA FOUR PARAMETERS. JMP ESC01 SORRY BUDDY, YOU BLEW IT! LDA RQP3 SAVE ADDRESS STA BFADD OF BUFFER. XLB RQP4,I GET BUFFER LENGTH, SAVE STB $IDNO FOR TRANS.LOG CHECK, JSB $CVWD CONVERT TO POSITIVE STB BFCNT CHAR COUNT AND SAVE. XLA RQP2,I GET TYPE OF REQUEST. ADA DM2 SZA,RSS JMP MPT9W 2=WRITE. INA,SZA 1=READ. JMP ESC02 ILLEGAL REQUEST. * LDB XEQT READ A STRING BLOCK FOR AN ID-SEG. JSB $STSH TO THE BUFFER(E=1,EXTRA WORD). SZA,RSS GET THE STRING BLOCK ADDRESS JMP NOPAW FOR THIS PROG. IF NO STRING, ADA D2 THEN SET A=1, CLEAR B, AND RETURN. LDB A,I GET ACTUAL SIZE OF STORED CMB,CLE,INB STRING AND COMPARE TO ADB BFCNT TO THE REQUESTED LDB A STRING SIZE. SEZ,INA,RSS SET A REG. TO SOURCE ADDRESS. LDB BFCTA USE WHICHEVER SIZE IS LD +þúB B,I SMALLER AND CONVERT STB BFCNT INB TO WORDS AND USE BRS AS MOVE WORDS STB XB,I COUNT. LDB BFADD SET B REG. TO DESTINATION ADD. LDX XB,I MWI GO MOVE WORDS. LDB XEQT WHEN COMPLETE, RETURN THE JSB $RTST STRING BLOCK TO MEMORY. LDB XB,I GET MOVE WORDS COUNT. LDA $IDNO IF ORIGINAL REQUEST WAS SSA FOR CHARS, THEN DOUBLE LDB BFCNT WORD COUNT FOR TRANS.LOG. JMP MPT91 GO SETUP REGS. AND RETURN. * MPT9W LDA XEQT WRITE A STRING BLOCK TO THE FATHER. ADA D20 GET CURRENT PROGRAM LDA A,I AND DETERMINE IF THERE AND B377 IS A FATHER. SZA,RSS JMP NOPAW ERROR, NO FATHER. CCB,CCE GET ID(SET E=1 FOR ALCST) ADB KEYWD SEGMENT ADB A ADDRESS OF LDB B,I FATHER. JSB ALCST DEALLOCATE AND THEN ALLOC.BLOCK FOR PAW. JMP ESC10 IF SUCCESS ALLOC.,THEN SET A=0.IF NO JMP NMNOW MEM EVER,ABORT SON(SC10).IF NO MEM MPT91 CLA NOW, SUSPEND THE SON. * MPT95 STB XB,I SET UP B REGISTER. STA XA,I SET UP A REGISTER. JMP MEM15 RETURN. * NMNOW LDA WORDS FETCH STRING LENGTH (GLM.2013) STA XTEMP,I AND SAVE FOR WAKE-UP CALL (GLM.2013) JSB $LIST NOT ENOUGH MEMORY NOW SO OCT 504 LINK PROGRAM INTO MEMORY JMP $XEQ SUSPENSION LIST. * NOPAW INA IF NO STRING ON 'GET' OR CLB NO FATHER ON 'PUT', THEN JMP MPT95 SET A=1 OR B=0. * DM2 DEC -2 SKP ************************************************************** * * SUBROUTINE TO STORE A STRING IN SYSTEM AVAILABLE MEMORY. * ALCST DEALLOCATES ANY STRING MEMORY, ALLOCATES A BLOCK OF * MEMORY, TRANSFERS THE STRING INTO THE BLOCK, AND LINKS THE * BLOCK INTO THE HEAD OF THE STACK L}CþúOCATED AT $STRG. THE LINKED * BLOCKS LOOK AS FOLLOWS: * * * *********** ********************* * $STRG * ---------* 0 OR LINK-------------- * *********** *-------------------* * EXTRA WORD BIT------* ID SEG ADDRESS * * *-------------------* * * # CHARS IN STRING * * *-------------------* * * CHAR 1 CHAR 2 * * *-------------------* * * * * *-------------------* * * CHAR M * * ********************* * * EXTRA WORD * * *-------------------* * * * WORD 1 = LINK TO NEXT BLOCK OR 0 FOR LAST BLOCK * WORD 2 = BITS 0-14 = ID-SEGMENT ADDRESS * BIT 15 = EXTRA WORD IN BLOCK BIT(SEE $ALC) * WORD 3 = ACTUAL NUMBER OF CHARS (M) IN STRING * * CALLING SEQUENCE: * BFADD:= BUFFER ADDRESS * BFCNT:= POSITIVE BUFFER CHARACTER COUNT * MVFLG:= -1/0 STRING IN SYS/USER MAP * CLE/CCE (SEE BELOW) * LDB ID-SEGMENT ADDRESS * JSB ALCST * * RETURN: * (P+1) =-1, =XTEMP UNSUCCESSFUL,NO MEM EVER * (P+2) =0 , =XTEMP UNSUCCESSFUL,NO MEM NOW * (P+3) =+ , =XTEMP SUCCESSFUL ALLOCATION EVER * * AND ARE MODIFIED * TEMP1, TEMP4 AND TEMP6 ARE USED. * CALLS $RTST WHICH USES TEMP2, TEMP3 AND TEMP5. * * ON ENTRY, IF E REG=0, THE BASE PAGE WORD XTEMP(1721B)IS * SET TO THE ID SEGMENT WORD 2 ADDRESS INDICATED BY THE B REG * AND THEN RESTORED ON EXIT. IF THE E REG = 1, THEN XTEMP IS * NOT MODIFIED. SINCE ON "NOT ENOUGH MEMORY", $ALC WILL STORE * THE AMOUNT OF MEMORY REQUIRED IN 'XTEMP,I', THIS WILL RESULT: * 1)E=0,SAVE MEMORY SIZE IN XTEMP OF B REG P]¹þúROGRAM, OR * 2)E=1,SAVE MEMORY SIZE IN XTEMP OF CURRENT PROGRAM(USED * ONLY IN EXEC 14 CALL FROM SON TO FATHER). * *************************************************************** * ALCST NOP STB TEMP1 SAVE ID ADDRESS. LDA XTEMP SAVE CURRENT PROGRAM'S ID STA TEMP4 WORD 4. * INB IF E=0, THE SET UP OUR PROGRAM'S ID SEZ,INB,RSS WORD 2 FOR USE BY $ALC. STB XTEMP OTHERWIZE, USE CURRENT PROGRAM. LDB TEMP1 GET ID ADDRESS AND JSB $RTST RETURN ANY STRING MEMORY. LDA BFCNT GET CHAR COUNT. INA CHANGE TO ARS WORD COUNT STA RTSTW AND SAVE. ADA D3 INCREMENT WORD COUNT BY STA WORDS 3 FOR LINKAGE WORDS AND JSB $ALC GO GET MEMORY. WORDS NOP JMP ALST9 NO MEMORY EVER RETURN. JMP ALST8 NO MEMORY NOW RETURN. CCE OK RETURN. SET E REG TO CPB WORDS 1 IF AN EXTRA WORD WAS CLE RETURNED. LDB $STRG LINK THE BLOCK INTO STB A,I THE HEAD OF THE STA $STRG STACK HEADED AT $STRG. LDB TEMP1 GET ID-SEG ADDRESS, ADD IN RBL,ERB EXTRA BLOCK WORD BIT, INA AND STORE IN SECOND STB A,I BLOCK WORD. LDB BFCNT STORE BUFFER CHAR INA COUNT IN THIRD STB A,I WORD OF BLOCK. INA LDB A GET ADD.OF DESTINATION BUFFER. LDA BFADD GET ADDRESS OF SOURCE BUFFER. * ISZ MVFLG WHERE IS THE STRING RIGHT NOW ? JMP ALST5 USER MAP * MVW RTSTW SYS MAP, SO GO MOVE THE WORDS JMP ALST6 * ALST5 LDX RTSTW MWF GO MOVE WORDS FROM USER MAP. ALST6 ISZ ALCST SUCCESSFUL RETURN. ALST8 ISZ ALCST NO MEMORY NOW RETURN. ALST9 CLB CLEAR OUT SYS/USER MAP FLG STB MVFLG LDB TEMP4 RESTORE CU±þúRRENT PROGRAM'S STB XTEMP ID WORD 2 ADDRESS. JMP ALCST,I NO MEMORY EVER RETURN--A=STATUS. * STRGA DEF $STRG $STRG OCT 0 HEAD OF STRING STORAGE STACK. BFCTA DEF BFCNT BFCNT BSS 1 BFADD BSS 1 MVFLG NOP -1/0 STRING CURRENTLY IN SYS/USER MAP SKP ************************************************************** * * SUBROUTINE TO RETURN SYSTEM AVAILABLE MEMORY ALLOCATED * FOR A STRING. GIVEN A PROGRAM'S ID-SEGMENT ADDRESS, $RTST * LOCATES THE STRING IN THE BLOCK HEADED AT $STRG, UNLINKS * IT AND RETURNS IT TO SAVMEM. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $RTST * * RETURN: * NO REGISTERS ARE SAVED. * USES TEMP2 AND TEMP5 FOR TEMPOARAY STROAGE. * CALLS $STSH WHICH USES TEMP3. * ************************************************************** * $RTST NOP STB TEMP2 SAVE ID-SEGMENT ADDRESS. RTST1 JSB $STSH GET STRING BLOCK ADD.(E=1,EXTRA WD). SZA,RSS CHECK IF STRING JMP $RTST,I BLOCK FOUND. STA RTSTA STORE STARTING BLOCK ADDRESS. LDA A,I UNLINK BLOCK STA B,I FROM STACK. LDA RTSTA ADA D2 GET SIZE OF LDB A,I BLOCK, CONVERT INB TO WORDS BRS AND ADB D3 ADD 3. SEZ IF EXTRA WORD BIT SET, INB ADD 1 TO SIZE. STB RTSTW STORE TOTAL SIZE OF BLOCK. JSB $RTN RETURN MEMORY BLOCK. RTSTA NOP RTSTW NOP * LDB TEMP2 GET ID SEGMENT ADDRESS. STB WORK SET UP $WORK IN CASE ANY PROG SCHEDULED JMP RTST1 CHECK FOR ANY MORE BLOCKS. * SKP ********************************************************************** * * SUBROUTINE $STSH CHASES DOWN A STRING BLOCK IN THE STACK * HEADED AT $STRG GIVEN THE ID-SEGMENT ADDRESS. ASSUMES ENTRY * IN THE SYSTEM MAP. * * CALLING SEQUENCEóõþú: * LDB ID-SEGMENT ADDRESS * JSB $STSH * * RETURN: * =0 = COULD NOT FIND NAMED BLOCK * =+ = ADDRESS OF BLOCK, E=1 = EXTRA WORD IN BLOCK * B= ADDRESS OF PREVIOUS BLOCK * USES TEMPORARY LOCATION TEMP3. * ********************************************************************** * $STSH NOP STB TEMP3 SAVE ID-SEGMENT ADDRESS LDB STRGA GET POINTER TO HEAD OF STACK. STSH1 LDA B,I GET BLOCK ADDRESS AND CLE,SZA,RSS IF ZERO, THEN END JMP STSH9 OF STACK. INA OTHERWIZE,INCREMENT IT,AND GET LDA A,I GET ID-SEGMENT ADDRESS. ELA,RAR SAVE EXTRA WORD BIT IN E REG. CPA TEMP3 IF THIS IS CORRECT JMP STSH2 BLOCK, THEN RETURN. LDB B,I OTHERWIZE, GO CHECK JMP STSH1 NEXT BLOCK. * STSH2 LDA B,I SET A=BLOCK ADDRESS AND STSH9 JMP $STSH,I RETURN. * ********************************************************************** * * $CVWD CONVERTS NEGATIVE CHARACTER COUNT OR POSITIVE WORD COUNT * TO POSITIVE CHARACTER COUNT. * * CALLING SEQUENCE: * LDB COUNT(+ = WORDS, - = CHARACTERS) * JSB $CVWD * * RETURN: * B = +CHARACTERS * ********************************************************************** * $CVWD NOP SSB CONVERT NEGATIVE CMB,INB,RSS CHARACTERS AND BLS POSITIVE WORDS TO JMP $CVWD,I POSITIVE CHARACTERS. HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT òwþúTABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF I<DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $LST yzÿÿ ÿý+^Š ÿ92067-18111 1903 S C0122 &ALC4              H0101 bPþúASMB,R,L,C,Q HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * NAME: $ALC * SOURCE: 92067-18111 * RELOC: PART OF 92067-16103 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALC,0 92067-16103 REV.1903 780511 * ENT $ALC,$RTN,$PNTR,$MAXE EXT $LIST,$WORK * * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * * IF, WHEN BUFFER REQUESTED, - (AVMEM) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * * JSB $ALC * DEC 32767 * * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKãþúED THROUGH * THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * * * REGISTERS ARE NOT PRESERVED * SKP $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA AVMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. \ðþú STA ADX SET BUFFER LENGTH STB A BUFFER ADDRESS TO A CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB AVMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS JMP $ALC,I AND RETURN * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA AVMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN LDA $RTN,I # OF WORDS RETURNED (X) ADA DM2 SSA <2? JMP RETNR BUFFER TO SMALL - IGNORE LDA PNTRA GET THE STARTING POINTER .R11 STA BAD BAD _ AAD INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS CPB PNTRA IF LOCAT POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT THE NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADND OLD UPPER LENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA AVMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB AVMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP $RTN,I RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA AVMEM COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP $RTN,I NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * * * PNTRA DEF AVMEM DUMMY BLOCK ADDRESS(DON'T MESS!) AVMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) $PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA AVMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE $MAXE EQU MAXEV JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * BSS 0 LENGTH OF PROGRAM * END $ALC Swÿÿ ÿý,5 ÿ92067-18112 1903 S C0122 &OCMD4              H0101 j|þúASMB,L,C HED RTE-IV SYSTEM COMMAND MODULE * * NAME: OCMD4 * SOURCE: 92067-18112 * RELOC: PART OF 92067-16103 * PGMR: D.L.S.,E.J.W.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OCMD4,0 92067-16103 REV.1903 780304 * ********************************************** * ENT $LUPR,$EQST,$CHTO EXT $CVEQ,$CNV1 EXT $CNV3,$UNLK,$XXUP,$DLAY,$DMEQ,$SCD3,$ETEQ EXT $CKLO,$BITB,$INER,$XCQ,$MSEX A EQU 0 B EQU 1 SUP * ***************************************************************** * * RTE SYSTEM PROGRAM OCMD4: * * OCMD4 PROVIDES EXECUTION OF THE FOLLOWING SYSTEM COMMANDS: * * LU,P1[,P2[,P3]] LU STATUS AND LU CHANGE. * EQ,P1[,P2] EQT STATUS AND BUFFERING CHANGE. * TO,P1[,P2] SHOW TIMEOUT OR CHANGE TIMEOUT. * * ******************************************************************* * $EQST STA P1 STB P2 JSB IODNS CHECK P2 AND SET EQT ADDRESSES. LDB P2 CHECK PARAMETER #2. LDA EQT4,I GET EQT CHANNEL WORD. CLE,SSB,RSS IF P2=-1, OUTPUT EQT STATUS JMP EQST1 OTHERWIZE, SET BUFFERING BIT IN EQT. * JSB $CNV1 OUTPUT THE EQT STATUS. STA EQMS1 CONVERT THE CHANNEL NUMBER. * LDA EQT4,I CONVERT ASR 6 UNIT #. AND B37 JSB $CNV1 STA EQMS5 LDA EQT4,I SET LDB EQBLK D (FOR DMA CHANNEL) RAL,SLA OR LDB EQBD 0 STB EQMS3 LDB EQBLK SET SSA B (FOR AUTOMATIC BUFFERING) LDB EQBB gÛþú OR STB EQMS4 0 LDA EQT5,I SET RAL,RAL AVAILABILITY AND .3 STATUS ADA EQBLK (0,1,2,OR3) STA EQMS6 LDA EQT5,I CONVERT ALF,CLE,ALF EQUIPMENT ADA B3000 TYPE (SET HIGH BITS TO JSB $CNV1 FOOL LEADING BLANK GENERATOR) STA EQMS2 DV.NN. LDA EQMSA (A) = ADDRESS OF REPLY JMP $MSEX RETURN. * EQST1 ERB ROTATE BIT 1 TO E RAL,RAL AND PUT IN ERA,RAR 14 OF EQT4 STA EQT4,I AND RESTORE JMP $XCQ ALL DONE * EQMSA DEF *+1 DEC -20 ASC 1, EQMS1 NOP I/O CHANNEL # EQBD ASC 2, DV. EQMS2 NOP EQUIP TYPE CODE EQMS3 NOP D OR 0 EQMS4 NOP B OR 0 ASC 1, U EQMS5 NOP UNIT # EQMS6 NOP AVAILABILITY * EQBLK ASC 1, 0 EQBB ASC 1, B * .2 DEC 2 .3 DEC 3 B37 OCT 37 * SKP * **************************************************************** * * 'LOGICAL UNIT' STATEMENT * * FORMAT: LU,P1(,P2(,P3)) WHERE: * * P1 = LOGICAL UNIT # * P2 = 0, EQT ENTRY #, OR NOT PRESENT * P3 = SUBCHANNEL # OR NOT PRESENT IN WHICH * CASE IT DEFAULTS TO ZERO * * ACTION: 1) P2 AND P3 NOT INPUT; THE ASSIGNMENT OF * LOGICAL UNIT P1 IS PRINTED AS: * ' LU #P1 = EXX SYY D ' * WHERE: * P1=LOGICAL UNIT NUMBER * XX=EQT NUMBER * YY=SUBCHANNEL NUMBER * D=IF PRESENT, THE LU IS DOWN. * 2) P2 = 0; THE ASSIGNMENT IS RELEASED, * I.E, THE CORRESPONDING * WORD IN THE DEVICE * REFERENCE TABLE (DRT) * IS SET = 0. * 3) N2 # 0 THE LU'S ASSIGNMENT IS CHANGED TO POINT * TO THE NEW EQT AND SжþúUBCHANNEL. ANY I/O * ASSOCIATED WITH THE OLD EQT AND SUBCHANNEL * (DEVICE)IS TRANSFERRED TO THE NEW DEVICE. * * THE FOLLOWING LOCATIONS ARE USED AS TEMPORARIES BY LUPR: * := LU NUMBER := P3,P2 NEW SUBCH-EQT WORD * :=DRT WORD 1 ADDRESS :=DRT WORD 2 ADDRESS * :=EQT1 ADDRESS OF OLD :=NEW DEVICE'S EQT NUMBER * DEVICE * :="NEW DEVICE'S EQT IS :=NEW DEVICE SPLIT SUB. * DOWN" FLAG. * :=NEW DEVICE'S MAJOR LU * :#0 INITIATE REQUEST :#0 MORE THAN ONE LU FOR * ON NEW DEVICE UP OLD DEVICE * :=SEE SUB. SDRT2 * :=OLD SUBCH-EQT WORD :=OLD DEVICE MAJOR-LU * :=OLD DEVICE MAJOR-LU :=OLD DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * :=NEW DEVICE MAJOR-LU :=NEW DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * **************************************************************** * SKP $LUPR STA P1 STB P2 CPB M1 IF P2= -1, PRINT CURRENT ASSIGNMENT. JMP LUPR0 * CPA .2 PREVENT REASSIGNMENT JMP $INER OF LU 2 AND LU 3 CPA .3 JMP $INER * LUPR0 CMA,CLE,INA,SZA,RSS ILLEGAL LU NUMBER JMP $INER IF THE LU IS LESS ADA LUMAX THEN 1 OR GREATER CCA,SEZ,RSS THEN LUMAX. JMP $INER * ADA P1 SAVE ADA DRT DRT WORD STA DRT1A 1 AND ADA LUMAX WORD 2 STA DRT2A ADDRESSES. * CCE,INB,SZB,RSS IF P2=-1, THEN GO(SET E=1 FOR LUPR3) JMP LUPR3 PRINT CURRENT ASSIGNMENT. * LDB DRT PREVENT CLE,INB ASSIGNMENT(CLEAR E) DLD B,I OF ANY OTHER CPB P2 DEVICE SZB,RSS hðþú TO CPA P2 LU 2 JMP $INER OR 3. SKP * LDA P2 CONSTRUCT I/O AND B174K SUBCHANNEL WORD ELA,RAL FOR NEW DEVICE(E WAS ALF,RAL CLEARED)WITH LOWER CLB,SEZ BITS IN BITS 2-5 ADA B20K AND UPPER BIT IN STA WORD2 BIT 13(CLEAR B REG). * STB NINTF CLEAR "NEW DEVICE I/O INITIATE" FLAG. STB TTEMP CLEAR "NEW DEVICE EQT IS DOWN" FLAG. * LDA DRT1A,I SAVE AND C3700 OLD SUBCH-EQT STA OSBEQ WORD AND AND B77 EQT1 SZA,RSS JMP LUP25 ADA M1 OF MPY .15 OLD(CLEAR B REG.) ADA EQTA DEVICE'S LUP05 STA OEQT1 EQT. * LDA P2 CHECK LEGALITY OF AND B77 N2(NEW EQT)AND STA NEQT# SZA,RSS SET THE EQT JMP LUPR2 * JSB IODNS ADDRESSES. * * SPECIAL TEST TO SEE IF MOVING I-O TO A DISK.IF SO, ERROR. * LDA EQT1 IS NEW ADA .4 DEVICE A LDA A,I AND B36K DISK? CPA B14K JMP LU100 YES, SO GO DO CHECK. * **************************************************************** * DETERMINE IF THE OLD DEVICE IS UP OR DOWN. **************************************************************** * LUPR1 LDA DRT2A,I CHECK IF OLD SSA DEVICE IS JMP DNXX UP OR DOWN. SKP **************************************************************** * OLD DEVICE IS UP. IS THERE MORE THAN ONE LU FOR IT? **************************************************************** UPXX LDA LUMAX SET UP TO SCAN THE LUS CMA,INA STA XLUS IF COUNT GOES TO ZERO THERE IS BUT ONE. LDB DRT GET ADDRESS OF THE FIRST ONE LUCO LDA B,I GET AN ENTRY AND C3700 DROP POSSIBLE LOCK BITS CPA OSBEQ IF NOT THE SAME CPB DRT1A OR IF ;ùþúSAME ENTRY INB,RSS SKIP TO GO ROUND AGAIN JMP MLUS ELSE THERE ARE MORE THAN ONE * ISZ XLUS COUNT DOWN THE ENTRIES JMP LUCO AROUND WE GO *************************************************************** * IF THE DEVICE IS UP AND HAS MORE THAN ONE LU THEN ITS * QUEUE IS NOT MOVED. THIS PREVENTS UNWANTED LOSS OF DATA * CAUSED BY UNRELATED LU CHANGES. *************************************************************** * * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. **************************************************************** MLUS LDA NEQT# CHECK IF NEW SZA,RSS DEVICE IS THE JMP UPBIT BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP UPDN NEW DEVICE IS DOWN. ISZ TTEMP NEW DEVICE'S EQT IS DOWN. SKP **************************************************************** * THE OLD AND NEW DEVICE ARE UP OR THE OLD DEVICE IS UP * AND THE NEW DEVICE'S EQT IS DOWN. ******************************************************************* UPUP LDA P1 NEW DEVICE IS UP. CPA .1 CHECK IF OLD JMP UPLU1 DEVICE IS LU 1. * UPUP5 LDA XLUS IF ANOTHER LU EXISTS SZA THEN JMP UPMU DON'T MOVE THE QUEUE * LDB OEQT1,I UNLINK I/O REQUESTS FROM THE RBL,CLE,ERB OLD DEVICE. SKIP THE SZB,RSS LDB OEQT1 LDA DRT2A FIRST I-O REQUEST. JSB $UNLK DEF OSBEQ * LDB DRT2A,I RESET WORD 2 OF THE I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. LDA OEQT1 LDB DRT2A,I LINK THE I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STB DRT2A,I CLEAR UP THE CURRENT LU STA NINTF SET THE MUST START NEW I/O FLAG UPMU LDA TTEMP IS THE NEW DEVICE'S SZA,RSS EQT DOWN? JMP LUP50 NO, SO CONTINUE. * LDB EQT1,I YES, SO RBL,CLE,ERB UNSTACK ĺþú SZB,RSS NORMAL USER LDB EQT1 I/O(SKIP FIRST JMP DNDE5 ENTRY)AND CONTINUE. * XLUS NOP SKP UPLU1 LDA EQT5,I GET DEVICE AND B374C TYPE OF THE SZA,RSS NEW DEVICE AND SEE JMP UPLU2 IF IT IS LEGAL CPA B2400 (00 OR 05 SUB 0) RSS FOR A SYSTEM JMP $INER CONSOLE. LDA WORD2 SZA JMP $INER * UPLU2 LDA TTEMP MAKE SURE NEW DEVICE'S SZA EQT IS NOT DOWN. JMP $INER LDA EQT1 SET NEW SYSTEM CONSOLE STA SYSTY ADDRESS IN BASE PAGE. JMP UPUP5 GO TRANSFER I/O. * * UPBIT LDA P1 CHANGING AN UP DEVICE TO CPA .1 THE BIT BUCKET. ERROR JMP $INER IF THE OLD DEVICE IS JMP UPUP5 THE SYSTEM CONSOLE. SKP ****************************************************************** * THE OLD DEVICE IS UP AND THE NEW DEVICE IS DOWN. ********************************************************************* UPDN STB TTEMP SAVE LU# OF FIRST LU(MAJOR LU)OF NEW DEVICE. STA NDML2 SAVE DRT WORD 2 ADDRESS OF NEW-MAJOR-LU. ADB M1 COMPUTE NEW- ADB DRT MAJOR-LU STB NDML1 DRT WORD 1. * LDB P1 CHECK IF THIS CPB .1 WILL SET LU JMP $INER 1 DOWN. * LDB TTEMP CHECK IF LU IS CMB,INB LOWER THEN THE ADB P1 MAJOR LU FOR SSB,RSS THE NEW DOWNED JMP UPDN5 DEVICE. * LDB A,I LU IS BELOW NEW DEVICE'S MAJOR LU. STB DRT2A,I MOVE I/O FROM MAJOR LU TO LU. LDB XLUS IF CURRENT DEVICE STILL HAS AN LU SZB THEN JMP DNDN6 SKIP THE MOVE * LDB DRT2A CHASE DOWN THIS DOWN I/O JSB CHASE QUEUE TO ITS END. LDA B * LDB OEQT1,I UNLINK I/O REQUESTS FOR THE RBL,CLE,ERB OLD DEVICE AND ADD 4ÑþúTO SZB,RSS LDB OEQT1 JSB $UNLK THE I-O QUEUE. SKIP FIRST ENTRY. DEF OSBEQ JMP DNDN6 GO MODIFY LU'S FOR THE NEW DEVICE. SKP UPDN5 LDB XLUS IF WE STILL HAVE A LU FOR THIS DEVICE SZB THEN JMP UPDN6 SKIP THE MOVE * LDB NDML2 NEW DEVICE'S MAJOR LU IS BELOW LU. JSB CHASE CHASE DOWN THIS I-O QUEUE LDA B TO ITS END. * LDB OEQT1,I UNLINK I/O REQUESTS RBL,CLE,ERB FOR THE OLD DEVICE SZB,RSS (SKIP FIRST REQUEST)AND LDB OEQT1 ADD TO DOWNED LU I/O JSB $UNLK QUEUE. DEF OSBEQ * UPDN6 LDA TTEMP SET ADA MSIGN THE LU STA DRT2A,I DOWN. JMP LUP50 GO FINISH. SKP **************************************************************** * THE OLD DEVICE IS DOWN. ******************************************************************* * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. * DNXX LDA NEQT# CHECK IF SZA,RSS NEW DEVICE JMP DNUP IS BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP DNDN NEW DEVICE IS DOWN. JMP DNDNE NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE IS UP(OR BIT BUCKET) ********************************************************************** DNUP JSB DETOL DETERMINE THE OLD-MAJOR-LU. LDB ODML2,I RESET WORD 2 OF I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. * LDA OEQT1 LDB ODML2,I LINK OLD DEVICE'S I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STA NINTF * JSB FOLDD FIX ALL OLD DOWNED LU'S THAT NEED IT. JMP LUP52 ****************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE'S EQT IS DOWN. ******************************************­Wþú*************************** DNDNE JSB DETOL DETERMINE OLD DEVICE'S MAJOR-LU LDA OEQT1 LINK OLD DEVICE'S I/O REQUESTS ON THE LDB ODML2,I NEW DEVICE'S EQT. JSB $XXUP STA NINTF * JSB FOLDD FIX OLD DOWNED DEVICE'S LU'S THAT NEED IT. * LDB EQT1 UNLINK ANY NORMAL USER DNDE5 CLA I/O FROM THE NEW DEVICE'S EQT. JSB $UNLK DEF P2 JMP LUP50 SKP **************************************************************** * THE OLD AND NEW DEVICES ARE DOWN. ********************************************************************* DNDN STB TTEMP SAVE NEW DEVICE MAJOR-LU AND STA NDML2 ITS DRT WORD 2 ADDRESS. ADB M1 SAVE ITS ADB DRT DRT WORD STB NDML1 2 ADDRESS. * JSB DETOM DETERMINE THE OLD DEVICE'S MAJOR-LU. * LDB TTEMP CHECK IF NEW CMB,INB NEW DEVICE'S MAJOR ADB P1 LU IS < LU. SSB,RSS LU < NEW DEVICE'S MAJOR LU. JMP DNDN5 * DNDN9 LDB DRT2A LU IS BELOW NEW DEVICE'S MAJOR LU. JSB CHASE CHASE DOWN THE LU'S I/O LDA NDML2,I QUEUE TO ITS END AND RAL,CLE,ERA ADD THERE THE NEW DEVICE'S STA B,I MAJOR-LU I/O QUEUE. * LDA OMJLU IF OLD MAJOR LU EQUALS TO CPA P1 LU, THEN FIX UP OLD DEVICE'S RSS LU'S TO INCLUDE THE NEW OLD- JMP DNDN6 MAJOR-LU. OTHERWIZE, CONTINUE. * LDA OSBEQ A=OLD SUBCHANNEL-EQT WORD. LDB DRT1A INB B=LU WORD 1 ADDRESS + 1. JSB FXOLD GO FIX OLD DEVICE'S LU'S. * DNDN6 LDA P2 MODIFY ALL LU'S STA SSBEQ FOR NEW DEVICE LDA P1 TO POINT TO IOR MSIGN LU. LDB NDML1 CLE JSB SDRT2 JMP LUP50 SKP DNDN5 SZB,RSS CASE WHERE OLD AND NEW DEVICES ARE JMP $XCQ BOTH DOWN AND EQUAL. * LDB NDML2 LU > N±PþúEW DEVICE MAJOR-LU. JSB CHASE CHASE DOWN THE NEW MAJOR-LU'S. CCA I/O QUEUE TO ITS END. * ADA DRT CALCULATE DRT ADA OMJLU WORD 2 OF STA ODML1 OLD MAJOR-LU. * ADA LUMAX LINK OLD MAJOR LU I/O LDA A,I RAL,CLE,ERA QUEUE TO END OF NEW STA B,I MAJOR I/O QUEUE. * LDA TTEMP MAKE LU POINT TO IOR MSIGN NEW DEVICE MAJOR-LU. STA DRT2A,I * LDA OMJLU IF LU = OLD CPA P1 MAJOR-LU, RSS THEN CONTINUE, JMP LUP50 ELSE DONE. * LDA OSBEQ FIX OLD LDB ODML1 DEVICE'S INB LU'S. JSB FXOLD SKP ****************************************************************** * FINISH SWITCHING LU ******************************************************************* LUP50 LDA DRT1A,I SET UP DRT AND B3700 WORD 1 WITH ADA P2 NEW DEVICE AND STA DRT1A,I OLD LOCK FLAG. * LUP52 LDA NINTF CHECK IF AN I/O SZA,RSS OPERATION MUST BE JMP LUP55 INITIATED ON THE NEW EQT. CPA $DMEQ YES, IF THE NEW DEVICE IS THE BIT BUCKET, JMP LUP80 THEN SET A FLAG FOR IOCX. JSB $DLAY IF NOT,SET A TIMEOUT FOR INITIATION. * LUP55 LDA .4 SCHEDULE ANY WAITERS ON JSB $SCD3 DOWNED DEVICES. LDA OEQT1 SET UP THE OLD DEVICE'S JSB $ETEQ EQT ADDRESSES, CHECK BUFFER JSB $CKLO LIMITS AND SCHED WAITERS. * LDA P1 IF LU CHANGED WAS CPA .1 SYSTEM CONSOLE THEN JMP LUP70 ISSUE A MESSAGE. JMP $XCQ * LUP70 LDA NSYSM ISSUE '**' MESSAGE TO JMP $MSEX CONSOLE. * LUP80 ISZ $BITB SET A FLAG FOR IOCX SO THAT JMP LUP55 IT WILL CLEAN OUT THE BIT BUCKET. * LUPR2 LDA $DMEQ SET UP DUMMY JSB $ETEQ EQT ADDRESES FOR JMP LUPR1 THE BIT BUCKET. œÑþú* LUP25 LDA $DMEQ JMP LUP05 * SKP * SPECIAL TEST TO DISALLOW SWTCHING AN LU TO A DISK IF THE * LU HAS I/O STACKED ON IT(OR IT'S EQT). * LU100 LDA DRT2A,I DOES THE LU RAL,CLE,ERA HAVE ANY I/O SZA HUNG ON IT? JMP $INER YES, ISSUE ERROR MESSAGE. * SEZ IF NO I/O AND LU IS DOWN, JMP LUPR1 THEN ALLOW SWTCH. LDA OEQT1,I OTHERWIZE, IF UP AND NO I/O IS SZA,RSS HUNG ON THE OLD EQT, THEN JMP LUPR1 ALLOW SWTCH. * JMP $INER IF I-O HUNG ON OLD EQT,ISSUE ERROR MESS. * ****************************************************************** * DISPLAY LU AND IT'S STATUS ****************************************************************** * LUPR3 LDA P1 GET AND JSB $CNV3 SAVE THE INA THE LAST TWO WORDS DLD A,I OF THE ASCII ADA B1.4K (ADD THE #) DST LUMSG+2 LU # IN MESSAGE LDA DRT1A,I GET AND AND B77 SAVE JSB $CNV1 THE ASCII STA LUMSG+6 EQT #. LDA DRT1A,I CHECK IF AND B174K A SUBCHANNEL CCE,SZA IS SPECIFIED. JMP LUP14 LDA DBLBK IF SUBCHANNEL=0, STA LUMSG+7 THEN DO NOT DISPLAY JMP LUP15 THE SUBCHANNEL. * LUP14 LDB BLS IF SUBCHANNEL#0, STB LUMSG+7 THEN DISPLAY ALF,RAL THE ASCII JSB $CNV1 SUBCHANNEL. LUP15 STA LUMSG+8 LDB DBLBK CHECK IF LDA DRT2A,I THE DEVICE SSA IS UP OR LDB EQBD DOWN. IF STB LUMSG+9 DOWN, LDA LUMGA PRINT A "D". JMP $MSEX RETURN. SKP * * VARIABLES, CONSTANTS AND BUFFERS FOR LUPR * NSYSM DEF *+1 DEC -2 ASC 1,** * LUMGA DEF *+1 DEC -20 LUMSG ASC 10,LU #MN1 = EXX SYY * B174K OCT 174000 B176K OCT 176000 B20K OCT 20000 B14K OC‚þúT 14000 B1.4K OCT 1400 HIGH BYTE = "#" B36K OCT 36000 B77 OCT 77 B3700 OCT 3700 C3700 OCT 174077 MSIGN OCT 100000 .1 DEC 1 .4 DEC 4 .15 DEC 15 M1 DEC -1 * DBLBK ASC 1, BLS ASC 1, S * P1 NOP P2 NOP DRT1A NOP DRT2A NOP NINTF NOP TTEMP NOP OEQT1 NOP NEQT# NOP WORD2 NOP OSBEQ NOP OMJLU NOP OLD DEVICE MAJOR LU. ODML1 NOP OLD DEVICE MAJOR-LU DRT WORD 1 ADDRESS. ODML2 NOP OLD DEVICE MAJOR-LU DRT WORD 2 ADDRESS. NDML1 NOP NEW DEVICE MAJOR-LU DRT WORD 1 ADDRESS. NDML2 NOP NEW DEVICE MAJOR-LU DRT WORD 2 ADDRESS. SKP ***************************************************************** * * SUBROUTINE CKNLU: * * CKNLU DETERMINES IF THE DEVICE(LU) OR THE EQT POINTED TO BY * THE SUBCHANNEL-EQT WORD IS UP OR DOWN. * * CALLING SEQUENCE: * := SUBCHANNEL IN BITS 11-15, EQT IN BITS 0-5. * :=ADDRESS OF FIFTH EQT WORD. * JSB CKNLU * * RETURN: * (P+1) DEVICE IS DOWN. * (P+2) EQT IS DOWN. * (P+3) DEVICE IS UP OR NO DEVICE FOUND. * ALL REGISTERS ARE VIOLATED. * AT (P+1): :=MAJOR LU # OF DOWNED DEVICE. * :=MAJOR LU DRT WORD 2 ADDRESS. * USES SDRT2 AS A TEMPORARY. * **************************************************************** * CKNLU NOP LDA EQT5,I CHECK IF RAL,SLA THE EQT JMP CKNL0 IS UP OR SSB DOWN. JMP CKNL2 THE EQT IS DOWN. * CKNL0 LDB LUMAX CMB,INB STB SDRT2 LDB DRT CKNL1 LDA B,I DETERMINE AND C3700 IF THE CPA P2 NEW JMP CKNL7 DEVICE INB EXISTS. ISZ SDRT2 JMP CKNL1 JMP CKNL9 THE DEVICE DOES NOT EXIST. * CKNL7 ADB LUMAX DETERMINE IF THE DEVICE LDA B,I IS UP OR DOWN. SSA JMP CKNL8 B†þú CKNL9 ISZ CKNLU THE DEVICE IS UP, RETURN TO P+3. CKNL2 ISZ CKNLU THE EQT IS DOWN, RETURN TO P+2. JMP CKNLU,I RETURN. * CKNL8 STB A THE DEVICE IS DOWN. LDB LUMAX SET =DRT WORD 2 ADDRESS. ADB SDRT2 SET =LU #. INB JMP CKNLU,I RETURN TO P+1. SKP **************************************************************** * SUBROUTINE SDRT2: * * SDRT2 WILL STORE THE A REG IN DRT WORD 2 FOR ANY DRT ENTRIES * WHICH CORRESPOND TO THE SUBCHANNEL AND EQT GIVEN IN P2. IF * ON ENTRY E=1, THEN SDRT2 WILL SCAN ONLY TO THE FIRST ENTRY * CORRESPONDING TO P2. IF E=0, THEN SDRT2 WILL SCAN THE ENTIRE * DRT FROM THE GIVEN ENTRY TO ITS END. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD FOR THE LU'S TO SCAN FOR: * BITS 5-0=EQT * BITS 15-11=SUBCHANNEL * :=DRT WORD 1 ADDRESS FROM WHICH TO BEGIN SCAN. * :=CONTENTS TO STORE INTO DRT WORD 2. * :=0 SCAN TO END OF DRT. * :=1 SCAN ONLY FOR FIRST ENTRY. * JSB SDRT2 * USES TEMPORARY LOCATIONS CKNLU,SDRT8,SDRT9 * RETURN: * NO REGISTERS ARE SAVED ON EXIT. * ON EXIT: * :=NEXT DRT WORD 1 ADDRESS TO BE SCANNED. * := LUMAX - LAST LU# SCANNED. ***************************************************************** * SDRT2 NOP STA CKNLU SAVE CONTENTS TO STORE INTO DRT WORD 2. LDA LUMAX SET ADA DRT CMA,INA UP ADA B STA SDRT9 COUNTER. STB SDRT8 SAVE ADDRESS OF FIRST DRT ENTRY TO SCAN. SZA,RSS JMP SDRT2,I * SDR29 LDA SDRT8,I SET CONTENTS AND C3700 OF DRT WORD 2 CPA SSBEQ AND COMPARE TO JMP SDR22 SUBCHANNEL-EQT WORD. SDR25 ISZ SDRT8 INCREMENT DRT ADDRESS. ISZ SDRT9 INCREMENT COUNT. JMP SDR29 CLA JMP ˆ1þúSDRT2,I NO MORE ENTRIES, SO RETURN. * SDR22 LDB CKNLU FOUND AN ENTRY, LDA SDRT8 POSITION TO ADA LUMAX WORD 2 AND STB A,I STORE NEW CONTENTS. SEZ,RSS IF E=1, JMP SDR25 THEN CONTINUE SCAN. ISZ SDRT8 OTHERWIZE, INCREMENT DRT LDA SDRT9 ADDRESSES AND RETURN. INA JMP SDRT2,I * SDRT8 NOP SDRT9 NOP SSBEQ NOP * ********************************************************************* * * SUBROUTINE CHASE: * * CHASE WILL FIND THE END OF AN I/O QUEUE GIVEN IT'S HEAD. * * CALLING SEQUENCE: * :=ADDRESS OF HEAD OF I/O QUEUE. * JSB CHASE * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=ADDRESS OF LINK WORD OF LAST I/O REQUEST. * :=0 * ******************************************************************** * CHASE NOP CHASE CHAS1 LDA B,I DOWN RAL,CLE,ERA THE LU'S SZA,RSS I/O QUEUE JMP CHASE,I TO ITS LDB A END. JMP CHAS1 SKP * ***************************************************************** * * SUBROUTINE FXWD2: * * FXWD2 CHANGES THE SUBCHANNEL IN WORD 2 OF EACH I/O REQUEST * IN THE GIVEN I/O QUEUE. * * CALLING SEQUENCE: * :=NEW SUBCHANNEL: BITS 2-5=LOWER 4 BITS * BIT 13 =UPPER BIT. * :=POINTER TO FIRST I-O REQUEST =0 IF NO REQUESTS. * JSB FXWD2 * * RETURN: * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * FXWD2 NOP RBL,CLE,ERB STRIP POSSIBLE SIGN BIT. FWD21 SZB,RSS IF END OF I/O QUEUE, JMP FXWD2,I THEN EXIT. STB SDRT2 INB POSITION TO I/O LDA B,I CONTROL WORD. AND WD2SB STRIP OFF OLD SUBCHANNEL IOR WORD2 AND ADD IN NEW SUBCHANNEL. +zþúSTA B,I LDB SDRT2,I FIX NEXT I/O REQUEST. JMP FWD21 * WD2SB OCT 157703 SKP * **************************************************************** * * SUBROUTINE DETOL * * DETOL DETERMINES WHAT THE OLD DEVICE'S MAJOR-LU IS AND SETS * UP LOCATIONS OMJLU, ODML1 AND ODML2. * * CALLING SEQUENCE: * JSB DETOL * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=OLD DEVICE'S MAJOR-LU. * :=OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * :=OLD DEVICE'S MAJOR-LU DRT WORD 2 ADDRESS. **************************************************************** * DETOL NOP JSB DETOM DETERMINE THE OLD MAJOR-LU. ADA M1 COMPUTE THE ADA DRT OLD DEVICE'S STA ODML1 MAJOR-LU'S ADA LUMAX DRT WORD 1 STA ODML2 AND 2 ADDRESSES. JMP DETOL,I RETURN. * * ************************************************************************ * * SUBROUTINE DETOM: * * DETOM RETURNS THE OLD DEVICE'S MAJOR-LU. * * CALLING SEQUENCE: * JSB DETOM * * RETURN: * :=OLD DEVICE'S MAJOR-LU. * *********************************************************************** * DETOM NOP LDA DRT2A,I DETERMINE IF LU IS RAL,CLE,ERA THE OLD MAJOR-LU. CLE,SZA,RSS IF NO QUEUE, THEN LU CCE IS THE OLD MAJOR-LU. STA B IF QUEUE ELEMENT IS < 2000, ADB B176K THEN QUEUE ELEMENT IS SEZ OLD MAJOR-LU. LDA P1 IF 2000 >= QUEUE ELEMENT, THEN ELEMENT STA OMJLU IS ADDRESS AND LU IS OLD MAJOR-LU. JMP DETOM,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FOLDD: * * FOLDD WILL FIX THE DRT WORD 2'S OF THE OLD DEVICE'S LU'S. * * CALLING SEQUENCE: * :=THE OLD DEVICE'S MAJOR-LU. * ªþú :=THE OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * JSB FOLDD * * RETURN: * ALL REGISTERS ARE MODIFIED. ***************************************************************** * FOLDD NOP LDA DRT1A,I SET UP DRT WORD 1 AND B3700 OF LU WITH THE NEW ADA P2 DEVICE AND OLD STA DRT1A,I LOCK FLAG. * CLA SET DRT WORD 2 OF STA DRT2A,I LU TO UP STATE. * LDA OMJLU IF LU=OLD DEVICE MAJOR-LU CPA P1 THEN FIX LU'S FOR THE RSS OLD DEVICE. JMP FOLDD,I OTHERWIZE, RETURN. LDA OSBEQ OLD MAJOR LU. LDB ODML1 INB JSB FXOLD FIX LU'S FOR THE OLD DEVICE. JMP FOLDD,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FXOLD: * * FXOLD WILL CREATE A NEW MAJOR-LU FOR THE OLD DEVICE, POINT * ANY OTHER LU'S FOR THIS DEVICE TO THE MAJOR-LU, AND SET ALL * THESE LU'S DOWN. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD OF THE LU TO SCAN FOR. * :=DRT WORD 1 ADDRESS TO BEGIN SCAN. * JSB FXOLD * CALLS SUBROUTINE SDRT2 * * REUTRN: * NO REGISTERS ARE SAVED. * ***************************************************************** * FXOLD NOP STA SSBEQ LDA MSIGN CREATE A NEW CCE OLD-MAJOR- JSB SDRT2 LU. SZA,RSS IF A=0, THEN NO OTHER JMP FXOLD,I LU'S ON OLD DEVICE. * ADA LUMAX OTHERWIZE, POINT IOR MSIGN ALL OTHER LU'S LDB SDRT8 FOR OLD DEVICE CLE TO THE NEW JSB SDRT2 OLD-MAJOR-LU. JMP FXOLD,I RETURN. SKP * **************************************************************** * * ' DEVICE TIME-OUT PARAMETER ' STATEMENT * * FORMAT: TO,P1,P2 WHERE * * P1 = EQT # * ‹‚þú P2 = TIME-OUT PARAMETER OR -1 * * ACTION: IF P2 = -1, A SECOND PARAMETER WAS NOT * RECEIVED FROM THE MESSAGE PROCESSOR; * THEREFORE, PRINT THE CURRENT TIME-OUT * PARAMETER OF DEVICE P1. * * BOTH P1 AND P2 PRESENT, ASSIGN P2 AS THE * NEW TIME-OUT PARAMETER FOR DEVICE P1. * ***************************************************************** * $CHTO STA P1 STB P2 JSB IODNS CHECK VALIDITY OF EQT # LDB P2 LOOK AT P2 SZB,RSS IF N2 ZERO, DISABLE JMP CHTO2 TIME-OUT FOR DEVICE * INB,SZB IF N2 = -1, OUTPUT T-O PARAMETER JMP CHTO1 OTHERWISE, ENTER NEW T-O VALUE * LDA EQT14,I CONVERT T-O PARAMETER CCE,SZA TO DECIMAL ASCII B3000 CMA JSB $CNV3 LDB A,I GET THE HIGH WORD ADB B164C ADD '=' - 'BLANK' STB TOMS+3 CCE,INA DLD A,I STORE IN MESSAGE DST TOMS+4 * LDA P1 CONVERT EQT # JSB $CNV1 TO DECIMAL ASCII STA TOMS+2 STORE INTO MESSAGE LDA TOMSA JMP $MSEX RETURN. SKP CHTO1 CMB,INB ERROR IF ATTEMPT LDA EQT5,I TO SET TYPE 0 OR 5 AND B374C DEVICE TIME-OUT SZA VALUE TO LESS THAN CPA B2400 FIVE SECONDS. RSS JMP CHTO2 OTHERWISE, STORE * LDA .500 NEW TIME-OUT ADA B VALUE. SSA,RSS JMP $INER * CHTO2 STB EQT14,I JMP $XCQ RETURN WITHOUT MESSAGE. * TOMSA DEF *+1 DEC -12 TOMS ASC 2,TO# NOP ASC 1, = NOP NOP * .500 DEC 500 B164C OCT 16400 B2400 OCT 2400 B374C OCT 37400 SKP IODNS NOP STA B IF CMB,INB,SZB EQT SSA NUMBER CCB,RSS IS ZERO ADB EQT# SSB THEN TAKEE, JMP $INER ERROR EXIT. <`fd` JSB $CVEQ OTHERWIZE, SET EQT ENTRY ADDRESSES. JMP IODNS,I RETURN. * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT14 EQU .+83 * SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * ORG * LENGTH OF SYSTEM COMMAND MODULE. END $EQST ÷˜fÿÿ ÿý-C ÿ92067-18113 1903 S C0122 &PERR4              H0101 {‚þúASMB,R,L,C *** RTE-IV PARITY ERROR MODULE *** * DATE: 7/26/77 * NAME: PERR4 * SOURCE: 92067-18113 * RELOC: PART OF 92067-16103 * PGMR: E.WONG,M.MANLEY,G.MCANALLY * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PERR4,0 92067-16103 REV.1903 790102 ENT $PERR,$PETB EXT $CNV1,$CNV3,$YMG,$ERMG,$XCQ,$UNPE,$MAXP EXT $MATA,$DMS,$ABXY,$CIC,$BFOT,$LU?? EXT $IOCL,$ABRT A EQU 0 B EQU 1 * * THIS MODULE OF RTE-IV HANDLES PARITY ERRORS. * CALL SEQUENCE FROM RTIO4: * JMP $PERR * <$PERR EXITS VIA $CIC,I> * * IF THE PARITY ERROR IS IN THE OPERATING SYSTEM OR CONFIGURATOR PROGRAM, * $PERR HALTS: HLT 5 * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS DETECTED IN A DCPC TRANSFER * WHILE THE OPERATING SYSTEM IS EXECUTING IN THE SYSTEM MAP, * $PERR HALTS: HLT 5,C * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS A SOFT ERROR (UNREPRODUCABLE), * $PERR PRINTS THE MESSAGES: * "PE @ #####" * "DMS STAT = ######" * * IF THE PARITY ERROR IS IN A PARTITION, * $PERR UNLINKS THE PARTITION FROM THE SYSTEM (UNTIL * NEXT BOOT UP). IT THEN RETURNS WITH : * "PART'N ## DOWN" * "PART'N ## DOWN" (IF THERE IS A MOTHER PTTN) * * IF THE PARITY ERROR WAS IN A MEMORY RESIDENT PROGRAM, * $PERR WILL ONLY PRINT THE FOLLOWING MESSAGES * (THESE WILL FOLLOW THE PARTITION DOWN MESSAGES * IN THE CASE OF A PARTITION RESIDENT PROGRAM): * BÑþú "PE PG# ##### BAD" * "ABE ###### ###### #" * "XYO ###### ###### #" * "PE XXXXX #####" * "XXXXX ABORTED" * * * NOTE THAT THE PROGRAM THAT ENCOUNTERED THE PARITY ERROR * IS NOT NECESSARIALLY THE CURRENTLY EXECUTING PROGRAM. * IE, THE PE ERROR MAY HAVE OCCURED DURING A DMA TRANSFER. SKP $PERR STA SAVA INTERRUPT SYSTEM IS TURNED OFF BY RTIO4 STB SAVB SAVE ALL USER REGISTERS LDA $CIC IN CASE OF STA SAVAD POWER FAIL ERA,ALS (DMS STATUS SAVED IN $DMS BY RTIO4) SOC INA STA SAVEO CXB STB SAVX CYB STB SAVY * LIB 5 RBL,CLE,ERB STB LOGPE SAVE LOGICAL PARITY ERROR ADDR LDA 5 PE ALREADY TURNED OFF PE INTERRUPTS STA SAV5 SAVE TRAP CELL 5 LDA JMPPE STA 5 SWITCH TRAP CELL TO LOCAL CLB STB PTNPE INITIALIZE PTTN# TO ZERO STB PEID INITIALIZE ID SEG ADDR TO ZERO STB PHYPG INITIALIZE PHYSICAL PAGE # TO ZERO JSB TRYPE TRY FOR P.E. IN SYSTEM MAP (B)=0 * * NOT IN SYSTEM MAP , TRY DCPC MAPS * DCPC? LDA SAVEU SAVE CURRENT USER MAP USA LDA INTBA,I SZA,RSS IS PORT A BUSY? JMP DCPCB NO, TRY PORT B * LDA SAVEP GET A COPY OF PORT A MAP PAA LDA RSTRP TO PUT INTO USER MAP USA LDB D6 JSB TRYPE TRY FOR P.E. IN PORT A (B)=6 * DCPCB LDA INTBA TRY IT IN PORT B INA LDA A,I SZA,RSS PORT B BUSY? JMP USEPE NO, WE'LL TRY USER MAP FINALLY. * LDA SAVEP GET A COPY OF PORT B MAP PBA LDA RSTRP TO PUT INTO USER MAP USA LDB D7 JSB TRYPE TRY FOR P.E. IN PORT B (B)=7 * * TRY USER MAP * USEPE LDA RSTRU RESTORE USER MAP USA CCB JSB TRYPE TRY FOR P.E. IN USER MAP (B)=-1åŽþú * * NOT IN SYSTEM, USER, PORT A, NOR PORT B. SOFT PARITY ERROR. * SOFPE LDA SAV5 STA 5 RESTORE LOCATION 5 FOR $CIC CLE SET UP FOR OCTAL ASCII CONVERSION LDA $DMS GET THE DMS STATUS VALUE JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT2+8 CLE,INA DLD A,I AND THE SECOND DST SOFT2+9 * LDA LOGPE GET LOGICAL PARITY ERROR ADDR JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT1+4 AND PUT INTO BUFFER INA DLD A,I AND NOW THE LAST TWO DST SOFT1+5 * LDA SOFT1 GET THE 1ST MESSAGE JSB $YMG AND REPORT TO USER LDA SOFT2 GET THE SECOND MESSAGE JSB $YMG AND REPORT IT TOO * PEDON LDB SAVY RESTORE REGISTERS BEFORE RETURNING CBY LDB SAVX CBX LDA SAVEO CLO SLA,ELA STF 1 LDB SAVB CLA CPA $INT,I IS INT SYS ON? $INT=0? JMP INTON YES * STA $INT,I NO, CLEAR $INT LDA SAVA RESTORE A-REG JMP EXIT REENABLE PARITY ERROR AND RETURN * INTON LDA SAVA RESTORE A-REG STF 0 TURN ON INTERRUPT SYSTEM EXIT STF 5 REENABLE PARITY ERROR JRS $DMS * RETURN SAVAD EQU *-1 * * SOFT1 DEF *+1 DEC -10 ASC 5,PE @ XXXXX SOFT2 DEF *+1 DEC -18 ASC 9,DMS STAT = XXXXXX D6 DEC 6 D7 DEC 7 SAVA NOP SAVE A-REGISTER SAVB NOP SAVE B-REGISTER SAVEO NOP SAVE E AND O REGISTERS SAVX NOP SAVE X-REGISTER SAVY NOP SAVE Y-REGISTER $INT DEF $DMS+1 SAV5 NOP SAVE LOCATION 5 CONTENTS SAVEU DEF UMAP,I SAVE USER MAP IN MEMORY RSTRU DEF UMAP STORE MEMORY IN USER MAP SAVEP DEF PMAP,I SAVE PORT MAP IN MEMORY RSTRP DEF PMAP STORE MEMORY IN PORT MAP UMAP BSS 32 PMAP BSS 32 * * JMPPE JMP ÁýþúPELNK,I TRAP CELL INSTRUCTION FOR P.E. ORB PELNK DEF GOTPE BASE PAGE LINK TO PARITY ERROR CODE ORR * * * SUBROUTINE TO TRY TO GET PARITY ERROR AGAIN * CALL SEQUENCE: * (LOGPE) = LOGICAL ADDRESS * (B) = 0 TRY IT IN SYSTEM MAP * (B) # 0 TRY IT IN CURRENT USER MAP * JSB TRYPE CALL * NO PARITY ERROR OCCURRED * TRYPE NOP TRY TO VERIFY PARITY ERROR STB PORT SAVE MAP INDICATOR RETRY STF 5 ENABLE PARITY INTERRUPTS SZB DO IT IN SYSTEM MAP? JMP TRYUS NO, TRY IT IN USER MAP * LDA LOGPE,I DO READ OF SUSPECTED LOCATION JMP NOPE NO P.E. RETURN * TRYUS XLA LOGPE,I TRY READ OF SUSPECTED LOCATION NOP WAIT FOR MX HARDWARE TO COOL OFF! NOPE CLF 5 TURN OFF PE INT SO WE DON'T GET CONFUSED JMP TRYPE,I NO P.E. IN USER MAP, RETURN * * * GOT A PARITY ERROR FROM TRYPE SUBROUTINE * GOTPE LIA 5 GOT A PARITY ERROR RAL,CLE,ERA BUT IS IT A SECOND PE ERROR CPA LOGPE OR IS IT A VERIFICATION OF SAME ONE? RSS SAME, SKIP JMP RETRY SECOND ONE, TRY AGAIN TO VERIFY FIRST * LDA SAV5 WE CAN NOW SAFELY RESTORE STA 5 TRAP CELL FOR MP/DMS/PE INTERRUPTS * LDA LOGPE GET PE ADDR AND B76K GET LOGICAL PAGE # ALF RAL,RAL (A) = LOGICAL PAGE # SZB USING SYSTEM MAP? ADA B40 NO, USE USER MAP REG# CCB CBX (X) = -1 FOR READ 1 REGISTER LDB DPHYP READ IT INTO 'PHYPG' XMM READ MAP REGISTER LDA PHYPG AND B1777 KEEP LOWER 10 BITS STA PHYPG AS PHYSICAL PAGE NUMBER * LDB PORT SSB WAS THE PE IN USER MAP? JMP INPRG - YES, FIND PROGRAM * SZB WAS THE PE IN SYSTEM MAP? JMP DMAPE + NO, FIND THE CURȬþúRENT DMA REQUESTOR * * PARITY ERROR WAS VERIFIED TO BE IN THE SYSTEM MAP * OR IT WAS IN A USER PAGE CONTAINING SYSTEM TABLES. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INSYS LDA PHYPG PE IN SYS OR SYS TABLES LDB LOGPE HLT05 HLT 5 102005 HALT FOR SYS PE ERROR JMP *-1 DON'T ALLOW TO PROCEED * * * PARITY ERROR WAS VERIFIED TO BE IN A DCPC TRANSFER * WHILE THE SYSTEM MAP WAS ENABLED. SINCE RTE IS NOT * REENTRANT, WE CANNOT PROCESS ERROR MESSAGES OR ABORT * ANY PROGRAMS BECAUSE WE MAY HAVE INTERRUPTED FROM * THAT CODE. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INDMA LDA PHYPG PE IN DCPC TRANSFER DURING SYS MAP LDB LOGPE HLTC5 HLT 5,C 103005 HALT FOR DCPC DURING SYS JMP *-1 DON'T ALLOW TO PROCEED * * * $PETB EQU * ENTRY POINT FOR ANALYSER PHYPG NOP $PETB+0 PHYSICAL PAGE NUMBER LOGPE NOP $PETB+1 LOGICAL PARITY ERROR ADDRESS PORT NOP $PETB+2 MAP CONTAINING PARITY ERROR PEID NOP $PETB+3 ID SEGMENT ADDRESS IF PROGRAM PE PTNPE NOP $PETB+4 PARTITION NUMBER(S) IF PROGRAM PE B1777 OCT 1777 B76K OCT 76000 B40 OCT 40 HED PARITY ERROR IN A PORT MAP DMAPE LDA $DMS GET DMS STATUS AT PE INTERRUPT RAL SSA,RSS DID WE INTERRUPT FROM SYSTEM MAP? JMP INDMA YES, HLT 5,C * LDA RSTRU RESTORE ORIGINAL USER MAP USA LDA PORT AND D1 ADA INTBA LDA A,I GET EQT ADDR OF DMA USER RAL,CLE,ERA CLEAR SIGN BIT FIRST LDB A,I GET EQT LINK WORD SSB,RSS DOING SYSTEM CLEAR? SZB,RSS OR EQT ALREADY UNLINKED? JMP INSYS YES, JUST GIVE SYS PE, DON'T KNOW PROG * LDA B INA LDA A,I GET CONTROL WORD TO CHECK T RAL SSA T=1 OR T=3? JMP INSYS YES, SYSTEM IS DOING I/O * SLA,RSS ¨þú T=0? JMP PRGPE YES, USER DOING I/O * ADB D4 T=2. LDB B,I GET TYPE OF $XSIO CALL RBL,CLE,ERB CLEAR SIGN, KEEP IT IN (E) SZB,RSS IS IT A SYSTEM REQUEST? JMP INSYS YES, =0 OR 100000 JMP PRGPE NO, USER REQ (B)=ID SEG ADDR * * B77 OCT 77 D1 DEC 1 D2 DEC 2 D4 DEC 4 D14 DEC 14 D15 DEC 15 D21 DEC 21 DPHYP DEF PHYPG HED PARITY ERROR IN A USER PROGRAM INPRG LDB XEQT IN CURRENT USER MAP SZB IS PROG = 0? JMP PRGPE NO, PROG. GET MAT INFO * LDB EQT1,I YES, MAYBE INTERRUPT DRIVER. RBL,CLE,ERB SZB,RSS I/O IN PROGRESS? JMP INSYS NO, DO SYS PE HALT * LDA B LEAVE POSSIBLE ID ADDR IN (B) INA LDA A,I CHECK T-FIELD IN CONTROL WORD RAL,RAL AND D3 SZA T=00? (UNBUFFERED USER) JMP INSYS NO, DO SYS PE HALT * PRGPE STB PEID (B)=ID SEG ADDR OF USER * JSB $LU?? FETCH THE TERMINAL LU FOR THIS PROG(LU RTNS IN (A) CLA IF NOT SESSION/MTM, PRINT ON LU 1 ONLY INA IF LU = 1 (LU=LU-1) SET ECH1=1 FOR TEST STA ECH1 LDB PEID FETCH ID ADDR * ADB D14 LDA B,I AND D15 GET PROG TYPE CPA D1 IS IT MEMORY RESIDENT PROG? JMP ABPRG YES, JUST ABORT PROG * LDA PEID ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PTTN # MPY MATSZ MULT BY MAT ENTRY SIZE ADA $MATA JSB MATAD SET UP MAT PTRS * LDA MLNK,I GET THE LINK WORD INA,SZA,RSS DID WE ALREADY UNDEFINE THIS GUY ? JMP PEDON YES, SO DON'T DO IT AGAIN. * LDA MADR,I IS PE IN MOTHER PTTN? SSA JMP MOMPE YES, HAVE TO FIND SUBPTTN * * PE IS IN A SUBPARTITION, FIND THE MOTHER PARTITION * JSB INPT? IS LOCATION IN PTTN? JMPaçþú INSYS NO, PE IN SYS PORTION OF USER MAP! LDB MLNK SUBPTTN OR REGULAR PTTN STB SUB HAS THE PE JSB $UNPE UNLINK FROM ALLOC LIST AND UNDEFINE NXSPE LDA MSUBL,I STA MOM SAVE POSSIBLE MOTHER PTTN ADDR SZA,RSS IS THIS A SUBPTTN? JMP BLDPT NO, GO BUILD PTTN PE WORD * JSB MATAD YES, SEARCH FOR MOTHER PTTN LDA MADR,I SSA,RSS IS THIS THE MOTHER? JMP NXSPE NO, TRY NEXT SUBPTTN LINK * LDB MLNK YES, FOUND THE MOTHER LINK JSB $UNPE UNLINK MOTHER PTTN FROM FREE LIST JMP BLDPT FOUND IT ALL NOW * * * PE IS MOTHER PARTITION, FIND THE AFFECTED SUBPARTITION * MOMPE JSB INPT? IS PE ACTUALLY IN MOTHER PTTN? JMP INSYS NO, SAY IT IS IN SYS. LDB MLNK YES, PE OCCURRED IN MOTHER PTTN STB MOM SAVE FOR PTTN PE WORD JSB $UNPE UNLINK MOTHER PTTN FROM ALLOC LIST * NXSP2 LDA MSUBL,I CPA MOM DONE YET? JMP BLDP2 YES, PE JUST IN MOTHER PTTN * STA SUB NO, NEED TO FIND SUBPTTN WITH PE JSB MATAD JSB INPT? IS PE IN THIS SUBPTTN? JMP NXSP2 NO, TRY NEXT * SBPPE LDB MLNK UNLINK AND UNDEFINE JSB $UNPE THIS SUBPARTITION. * BLDPT LDB SUB GET PTTN/SUBPTTN OF PE JSB PTTNO CONVERT IT TO PTTN# STA PTNPE SET INTO BITS 0-7 OF PTTN PE WORD BLDP2 LDB MOM GET POSSIBLY MOTHER PTTN ADDR STB A CPB SUB BUT IF SAME AS SUBPTTN CLA THEN USE 0 IN PTTN PE WORD SZA THEN USE 0 IN PTTN PE WORD BITS 8-15 JSB PTTNO CONVERT TO PTTN# ALF,ALF IOR PTNPE STA PTNPE PUT INTO BITS 8-15 * UNCHN LDA MOM NOW UNCHAIN SUBPTTNS SZA,RSS ANY MOTHER PTTN AFFECTED? JMP UPEDN NO, USER PE. DONE. * UNCH2 JSB MATAD YES, MOTHER PTTN INVOLVED LDA MLTH,I AND C40K CLEAo þúR "C" BITS IF SET STA MLTH,I LDA MSUBL,I GET NEXT SUBPTTN ADDR CLB STB MSUBL,I CLEAR LINK WORD CPA MOM DONE YET? JMP UPEDN YES, RETURN PE TO EXEC JMP UNCH2 NO, DO NEXT SUBPTTN * UPEDN JSB $MAXP RE-ESTABLISH MAX PTTN SIZES * * LDA PTNPE GET PTTN NUMBERS AND B377 SAVE LOWER BYTE SZA,RSS ANY SUBPTTN? JMP P1TRY NO, JUST MOTHER PTTN? * P1MOR CCE COUNT FROM 1 & DO DECIMAL CONVERSION. JSB $CNV1 CONVERT TO ASCII STA PEMSG+6 PUT INTO THE ERROR MESSAGE LDA PEMSG GET THE LOCATION OF THE ERROR MESSAGE LDB PEID GET ID ADDR OF PROG LDX ECH1 FETCH ECHO FLAG DSX IF IT WAS = 1, PRINT ON LU 1 ONLY JSB $BFOT NOPE-- ECHO ON USER TERMINAL JSB $YMG ISSUE DOWN PTN ERROR TO LU 1 * P1TRY LDA PTNPE GET THE PARTITION NUMBER(S) AGAIN ALF,ALF GET NEXT PARTITION TO LOWER BYTE AND B377 SAVE THE LOWER BYTE SZA,RSS IS THERE A MOTHER PARTITION ? JMP ABPRG NO,TELL BAD PAGE # STA PTNPE SAVE PARTITION # JMP P1MOR DO IT ONCE MORE * * ABPRG LDA PHYPG GET THE BAD PG# CCE DO DECIMAL CONVERSION FROM 0 JSB $CNV3 AND CONVERT TO DECIMAL ASCII LDB A,I GET THE 1ST WORD STB BDPG#+5 AND SAVE INA DLD A,I NOW GET THE LAST TWO DST BDPG#+6 LDA BDPG# GET THE ADDRESS OF THE MESSAGE LDB PEID FETCH ID ADDR OF PROG LDX ECH1 FETCH ECHO FLAG DSX IF USER TERMINAL NOT = LU 1 JSB $BFOT ISSUE PE ERROR TO SESSION TERM JSB $YMG AND SEND IT TO THE SYS CON ALSO * * LDB PEID GET ID SEG ADDR OF PROG SZB,RSS JMP PEDON STB XEQT FAKE OUT ABORT PROCESSORS CBX * LDA LOGPE GET LOGICAL PARITY ERROR ADDR SAX D8,I AND PU@–þúT IT INTO THE POINT OF SUSP WORD JSB $ABXY DUMP A,B,E,X,Y,O REGS LDA PE NOW GO ABORT THE PROGRAM LDB BLANK * JSB $ERMG NOTE! SPECIAL PROCESSING: ONLY PRINTS MESSAGE * STF 5 REENABLE PARITY ERROR * * SPECIAL WORK MUST BE DONE HERE IN CASE THE PROGRAM CAUGHT * BY THE PARITY ERROR WAS I/O SUSPENDED. * LDA PEID FETCH ID ADDR OF PROG TO BE ABORTED ADA D15 ADVANCE TO STATUS LDA A,I AND D15 ISOLATE STATUS LDB A SAVE IN (B) LDA PEID FETCH ID ADDRESS FOR $IOCL OR $ABRT CPB D2 IF I/O SUSPEND JMP $IOCL YES, DO I/O CLEAN UP, ABORT , XEQ. JSB $ABRT NO, JUST ABORT THE PROGRAM. JMP $XCQ * * * ECH1 NOP B377 OCT 377 D8 DEC 8 * BLANK ASC 1, PEMSG DEF *+1 DEC -16 ASC 8,PART'N XX DOWN BDPG# DEF *+1 DEC -16 PE ASC 8,PE PG# XXXXX BAD * * * INPT? - VERIFY IF PE PAGE IN IS A PARTITION * * CALL SEQUENCE: * MATA ADDR SET UP BY MATAD * JSB INPT? * * * REGISTERS ARE MEANINGLESS * INPT? NOP IS PE IN PTTN PAGES? LDA MADR,I TRY TO FIND IF PE OCCURRED IN PAGES AND B1777 WITHIN THE SUBPTTN OR STA B IT WAS IN THE SYSTEM PAGES CMA,INA OF THE USER MAP ADA PHYPG SSA PE PAGE# < FIRST PAGE PTTN? JMP INPT?,I YES, PE BELOW PTTN PAGES. RETURN P+1 * LDA MLTH,I AND B1777 ADA B ADD #PAGES IN PTTN FOR LAST PAGE CMA,INA ADA PHYPG SZA SSA PE PAGE# > LAST PAGE PTTN? ISZ INPT? NO, PE IN PTTN PAGES. RETURN P+2 JMP INPT?,I YES, PE ABOVE PTTN PAGES. RETURN P+1 * * * PTTNO - CONVERT PTTN MAT ADDR TO PTTN NUMBER * * CALL SEQUENCE: * (B) = MAT ADDR * JSB PTTNO * * (A) = PTTN # * PTïNþúTNO NOP (B) = MAT ADDR LDA $MATA CMA,INA SUBTRACT BEGINNING OF MAT ADA B TABLE FROM MAT ADDR CLB DIV MATSZ DIVIDE BY #WORDS PER ENTRY INA JMP PTTNO,I RETURN PTTN # IN (A) * * C40K OCT 137777 D3 DEC 3 SUB NOP MAT ADDR OF SUBPTTN MOM NOP MAT ADDR OF MOTHER PTTN * * * SKP * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *****!***** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! hbB@ ************************************** * MATAD NOP STA MLNK SET MAT ENTRY POINTER ADA D3 STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LINK WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP * * * XMATA EQU 1646B ADDR OF CURR MAT ENTRY INTBA EQU 1654B INTERRUPT TABLE ADDR EQT1 EQU 1660B WORD 1 ADDR OF CURRENT EQT XEQT EQU 1717B ADDR OF CURRENT PROG ID SEG * BSS 0 SIZE OF MODULE END $PERR |ùBÿÿ ÿý.> ÿ92067-18114 2040 S C0122 &$CNFG RTE IVB CONFIGURATOR             H0101 ×þúASMB,R,Q,C HED RTE IV B CONFIGURATOR 92067-16516 * NAME: $CNFG * SOURCE: 92067-18114 * RELOC: PART OF 92067-16516 * PGMR: S.K.,D.J.V.,J.M.N * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $CNFG,16 92067-1X114 REV.2040 800730 IN REL 92067-16516 * SUP ENT $CNFG,$EXIT,$PCHN,$WRRD,$USRS,$ABDP,$SMTB ENT $TRTB,$TREN,$NPGQ,$GDPG,$SAVE * EXT $SBTB,$OSAM,$SSCT EXT $XSIO,$CMST,$ENDS,$MRMP,$XCQ,$LIST EXT $CNV3,$PRSE,$PLP,$MATA,$MNP,$CNV1 * * A EQU 0 B EQU 1 JSBCI EQU 5 EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B INTBA EQU 1654B INTLG EQU 1655B KEYWD EQU 1657B EQT1 EQU 1660B EQT3 EQU 1662B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B TBG EQU 1674B SYSTY EQU 1675B SKEDD EQU 1711B DUMMY EQU 1737B BPA2 EQU 1743B LBORG EQU 1745B SECT2 EQU 1757B * HED CONSTANTS AND MESSAGES * * $SAVE IS A 14 WORD TABLE USED TO SAVE SOME LOCATIONS IN THE SYSTEM * THAT WILL BE OVERLAYED DURING THE CONFIGURATOR USE. MOST OF THESE * LOCATIONS ARE NEEDED FOR SYSTEM INITIALIZATION, THEY WILL BE RESTORED * BEFORE EXITING $CNFG * THE CONTENTS OF $SAVE ARE: * WORD 0 -- SYSTY+3 I.E. WORD 4 OF SYSTEM CONSOLE EQT * WORD 1 THRU 4 -- EQT1 THRU EQT4 IN SYSTEM COMMUNICATION AREA * WORD 5 -- DUMMY - LOCATION OF PRIV I/O CARD * WORD 6 -- SKEDD - ADDRESS OF SCHEDULE LIST * WORD 7 -- $LIST - ENTRY POINT IN SCHEDULER * WORD 8 -- ADDRESS OF WORD 4 OF LIST DEVICE EQT¶þú * WORD 9 -- 1 IF SYSTEM CONSOLE EQT WAS BUFFERED, 0 OTHERWISE * WORD 10 -- 1 IF LIST DEVICE EQT WAS BUFFERED, 0 OTHERWISE * WORD 11 -- TRAP CELL CONTENTS FOR POWER FAIL (LOC 4) * WORDS 12 & 13 -- EQT5 AND EQT6 IN SYSTEM COMMUNICATION AREA * $SAVE BSS 9 NOP NOP BSS 3 TBGSV NOP CONTENTS OF TBG FROM SYSTEM COMM. AREA PRVSV NOP CONTENTS OF PRIV I O CARD FROM SYSTEM COMM. AREA ACN1 DEF CN1 MRSET OCT 150077 * .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .31 DEC 31 .32 DEC 32 .44 DEC 44 .168 DEC 168 * N1 DEC -1 N3 DEC -3 N4 DEC -4 N6 DEC -6 * B10 EQU .8 B37 EQU .31 B40 EQU .32 B41 OCT 41 B74 OCT 74 B75 OCT 75 B177 OCT 177 B1777 OCT 177700 B377 OCT 377 B1774 OCT 177400 B1776 OCT 1776 HLT4 OCT 102004 * YE ASC 1,YE NO ASC 1,NO * MSG4 ASC 13,CURRENT I/O CONFIGURATION: MSG5 ASC 8,SELECT CODE = MSG6 ASC 6,EQT ,TYPE MSG8 ASC 4,PRIV I/O MSG10 ASC 25,CURRENT SELECT CODE#,NEW SELECT CODE# ?(/E TO END) MSG12 ASC 20,NEW I/O CONFIGURATION PERMANENT?(YES/NO) MSG21 ASC 13,PHYSICAL MEM SIZE?(#PAGES) AMSG5 DEF MSG5 AMSG6 DEF MSG6 AMSG8 DEF MSG8 ACNFX DEF *+1 SWREG ASC 3,$CNFX ***OVERLAYED AFTER $CNFX ID SEGMENT FOUND TEMP EQU ACNFX CTRCL EQU SWREG+1 CINTB EQU SWREG+2 LTRCL NOP LINTB NOP OLSTB BSS 56 * * HED SET UP FOR CONFIGURATOR * *** FOLLOWING CODE UPTO START OF RECONFIGURATION IS OVERLAYED *** AFTER BEING EXECUTED ONCE *** THE TABLES THAT WILL RESIDE IN THIS CODE ARE: *** TRPCL - 70 OCTAL WORDS LONG - CONTAINS CHANGES MADE TO TRAP CELLS *** PRMTB - PARAMETER TABLE USED FOR XSIO CALLS, PRMTB IS THE LAST *** LOCATION OF TABLE - TABLE GROWS UPWARD *** THIS TABLE OCCUPIES SAME AREA AS TRPCL *** INTBL - 70 OCTAL WORDS LONG - CONTAINS CHANGES MADE TO INTERRUPT TABLE *** EQTBL - 70 OCTAL WOR¶þúDS LONG - CONTAINS ADDRESS OF EQT 4 OF OLD SC *** IF THERE WAS AN EQT POINTING TO THIS SELECT CODE *** RDBUF - 80 WORDS LONG - USED FOR BUFFER TO READ USER INPUT *** PRSBF - 32 WORDS LONG - USED FOR PARSED USER INPUT * $CNFG NOP CURNT CLC 0 CLEAR ALL INTERRUPTS LDA SYSTY GET CONSOLE EQT ADDRESS ADA .3 POINT TO WORD 4 OF CONSOLE EQT STA $SAVE SAVE IT SVTBL LDA .4,I TRAP CELL CONTENTS FOR POWER FAIL STA $SAVE+11 SLOT LDA HLT4 INSERT HALT 4 IN TRAP CELL SO THAT THE SYSTEM STA .4,I HALTS ON POWER FAIL DURING CONFIGURATION LDA DUMMY SAVE PRIV INT CARD LOC STA $SAVE+5 FROM BASE PAGE STA PRVSV LDA TBG STA TBGSV LDA SKEDD SAVE CONTENTS STA $SAVE+6 CLB CLEARSYSTY TO PREVENT USER FROM STB SYSTY GETTING OPERATOR ATTENTION STB DUMMY & DUMMY TO LET INTERRUPTS COME THRU STB SKEDD PREVENT PROG FROM BEING SCHEDULED LDA $LIST SAVE CONTENTS RSTBL STA $SAVE+7 ISZ $LIST DLD EQT1 SAVE EQT WORDS 1-6 ON DST $SAVE+1 BASE PAGE COMMUNICATION AREA DLD EQT3 DST $SAVE+3 DLD EQT5 DST $SAVE+12 * LDB ACNFX GET $CNFX'S ID SEGMENT ADDRESS JSB TNAME SEZ PRESENT? CLB NO STB CNXID ID SEGMENT ADDRESS * LIA 1 READ THE SWITCH REGISTER CONTENTS STA SWREG AND SAVE IT CLB CLEAR THE SWITCH REGISTER OTB 1 SSA,RSS BIT 15 SET? OLD JMP MEMLD NO,LOAD MEM RES & DRIVER PARTNS * CCA YES,INITIALIZE SVTBL TO -1 LDB .48 INITIALIZE CURNT(4 WORDS), SVTBL(16 WORDS), JSB SETM RSTBL (24 WORDS), OLD (4 WORDS) WFLAG DEF CURNT STARTING FROM LOC CURNT TEMP1 LDA SWREG TEMP2 ALF,ALF GET NEW DISC SC IN BITS 0-5 TEMP3 RAL,RAL TEMP4 AND B77 MASK DISC SC TEMP5 SZA,RSª©þúS 0? OLDSC JMP MEMLD YES, DISC SC DOES NOT CHANGE NEWSC STA NEWSC TEMP6 CLA TRPCL LDB NEWSC CPB TBG USED TO BE TBG? STA TBG YES, THEN CLEAR TBG CPB $SAVE+5 USED TO BE PRIV I/O CARD? STA $SAVE+5 YES, THEN CLEAR PRIV I/O CARD * LDA .2 FIND EQT WORD 4 FOR LU 2 JSB LUSUB STA RSTBL+5 SAVE FOR NOW LDA A,I GET CONTENTS OF EQT WORD 4 AND B77 GET OLD SELECT CODE FOR DISC STA OLD SAVE FOR SENDING MESSAGE LATER CPA NEWSC SAME AS NEW? JMP MEMLD YES, SKIP DISC RECONFIGURATION * LDA ASVTB SAVE NEWSC'S ORIGINAL TRAP CELL, JSB SVENT INTERRUPT TABLE & EQT WORD 4 ADDRESS LDB RSTBL+5 EQT WORD 4 FOR OLD SC JSB EQTCN SET EQT WORD 4 FOR NEW SELECT CODE LDA INTBA INTERRUPT TABLE ADDRESS ADA OLDSC ADD OLD SELECT CODE # ADA N6 ADJUST ADDRESS LDB A,I GET CONTENTS OF INTRPT TBL ENTRY INA POINT TO NEXT SC IN INTRPT TBL CPB A,I BOTH SELECT CODES THE SAME? CCA,RSS YES CLA STA TEMP -1 IF 2 SC'S FOR DISC, 0 OTHERWISE JSB INTRP SET TRAP CELL AND INTRPT TBL FOR NEW SC LDA TEMP SSA,RSS 2 DISC SC'S? JMP MEMLD NO, THEN LOAD MEMORY ISZ NEWSC YES,SECOND SELECT CODE# FOR DISC ISZ OLDSC SECOND SELECT CODE FOR DISC LDA ASVTB ADA .4 ENTER SECOND SC ENTRIES IN SVTBL JSB SVENT JSB INTRP SET UP TRAP CELL & INTRPT TBL FOR 2ND SC CCA GET OLD SC BACK TO ORIGINAL VALUE ADA OLDSC OLD SC - 1 CCB ADB NEWSC NEW SC - 1 PRMTB DST OLDSC RESTORE THEM * HED LOAD DRIVER PARTITIONS AND MEMORY RESIDENT PROGARAMS * * $SBTB TABLE IS SET UP BY THE GENERATOR CONTAINING INFORMATION * USED TO LOAD THE DRIVER PARTITIONS AND MEMORY RESIDENT PROGRAMS * THE FORMAT OF $SBTB IS: * WORD 1 ¸Qþú-- DISC ADDRESS FOR START OF DRIVER PARTITIONS * WORD 2 -- # OF PAGES FOR ALL DRIVER PARTITIONS * WORD 3 -- DISC ADDRESS FOR MEMORY RESIDENT BASE PAGE * WORD 4 -- # OF PAGES FOR MEMORY RESIDENT BASE PAGE * (ALWAYS 1 IF MEM RES PROGRAMS ARE PRESENT) * WORD 5 -- DISC ADDRESS FOR MEMORY RESIDENT LIBRARY * WORD 6 -- # OF PAGES FOR MEMORY RESIDENT LIBRARY * * * $SBTB RESIDES IN TABLE AREA II * HED LOAD DRIVER PARTITIONS * * MEMLD LDA $SBTB+1 GET # OF PAGES IN DRIVER PARTITIONS SZA,RSS ANY GENERATED INTO SYSTEM? DRPGS JMP MEMRS NO, LOAD MEMORY RESIDENT PROGRAMS STA DRPGS USE THIS AS COUNTER LDA B41 BUILD DISC RESIDENT PROGRAM LDB $CMST MAP TO LOAD DRIVER PARTITIONS ADB N1 MWOCM CBX # OF PAGES TO BE LOADED NPGS CLB,INB START LOADING FROM PAGE 1 XMS TRANSFER SEQUENTIAL MEMORY STA MEMLD A REG POINTS TO NEXT MAP REG# LDB $ENDS START PAGE OF DRIVER PARTITIONS STB MEMLD+1 LDB $CMST # OF PAGES IN THE MAX.ADDRESSABLE CMB,INB SPACE WITHOUT COMMON ADB .31 STB MWOCM SAVE IT LDA $SBTB DISC ADDRESS OF DRIVER PARTNS JSB DSCAD SEPARATE TRACK AND SECTOR #'S * LDA $CMST START PAGE OF COMMON LSL 10 MULTIPLY BY 2000B STA TEMP3 LOAD FOR DRIVER PARTN DRVLD LDA DRPGS LDB DRPGS # OF PAGES IN DRIVER PARTITIONS CMB,INB # OF PAGES LEFT TO BE LOADED ADB MWOCM > MAX ADDRESS SPACE IN MAP? SSB LDA MWOCM YES,#PGS TO LOAD AT ONE TIME=MWOCM STA NPGS # OF PAGES OF DRVR PARTN TO BE LOADED CAX BUILD THE REST OF THE DISK RES MAP DLD MEMLD XMS LOAD MAP DST MEMLD SAVE NEW VALUES OF A&B REG LDA NPGS BUILD TRIPLETS TO READ DATA LSL 10 FROM DISC W/OUT CROSSING TRACK BOUNDARY STA TEMP SAVE # OF WORDS IN Bh¨þúUFFER JSB LOAD LOAD NPGS OF DRIVER PARTITION LDA NPGS # PAGES LOADED CMA,INA ADA DRPGS #PAGES THAT HAD TO BE LOADED SZA,RSS ANY LEFT? JMP MEMRS NO, DONE LOADING DRIVER PARTNS * STA DRPGS #PAGES LEFT TO BE LOADED ISZ PRMAR ADDRESS OF PARAMETER ARRAY LDB PRMAR,I GET # OF WORDS IN LAST TRIPLET LSR 6 DIVIDE IT BY 64 CBX SAVE B REG VALUE ISZ PRMAR GET TRACK / SECTOR # FOR LAST TRIPLET LDA PRMAR,I JSB DSCAD SEPARATE DISC ADDRESS CXB GET X REG IN B ADB TEMP2 B REG HAS NEW SECTOR # CMB -(NEW SECTOR# + 1) ADB SECT2 # OF SECTORS/TRACK ON SYS DISC SSB,RSS NEW SECT#># SECTORS/TRACK ON SYS DISC? JMP DRVLD NO ISZ TEMP1 YES, INCREMENT TRACK# BY 1 CLA SECTOR# IS 0 STA TEMP2 SECTOR# FOR SETUP JMP DRVLD LOAD THE NEXT PAGES * * * INTRP - THIS PROCEDURE IS PERFORMED TO ENTER * INTERRUPT TABLE AND TRAP CELL VALUES FOR DISC * SELECT CODES * * CALLING SEQUENCE: JSB INTRP * INTRP NOP LDB OLDSC,I TRAP CELL VALUE FOR OLD SELECT CODE STB NEWSC,I STORE VALUE IN NEWSC'S TRAP CELL * LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 STA TEMP2 SAVE THIS ADDRESS LDB OLDSC OLD SELECT CODE ADB A POINT INTO INTERRUPT TABLE LDA B,I OLD SC'S INTERRUPT TABLE VALUE LDB NEWSC ADB TEMP2 STA B,I SAVE OLDSC VALUE IN NEWSC ENTRY JMP INTRP,I IN INTERRUPT TABLE - RETURN * * * TNAME - SEARCH KEYWORD LIST FOR PROGRAM NAME * CALLING SEQUENCE: B REG = ADDRESS OF ASCII PROGRAM NAME * JSB TNAME * RETURNS: A REG = 0 IF PROGRAM NOT FOUND (E=1) * B REG = ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E REG = 0 IF STANDARD ID SEGMENT * E REG = 1 IF SHORT IDMþú SEGMENT OR NOT FOUND * * TNAME NOP TNTM3 STB TNTM3 ADDRESS OF NAME 1 AND 2 TNTM4 INB INCREMENT TO CHAR 3 AND 4 ADDR TNTM5 STB TNTM4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND B1774 MASK OFF X STA TNTM5 SZA IF NULL CHAR. FORCE ERROR RETURN LDA KEYWD STA TEMP TN005 LDA TEMP,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST RETURN ADA .12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TNTM3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 5,X CPB TNTM4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND B1774 MASK OFF X CPA TNTM5 COMPARE CHAR 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ TEMP INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB TEMP,I LOAD B WITH ID SEG ADDRESS JMP TNAME,I EXIT * HED LOAD MEMORY RESIDENT PROGRAMS AND LIBRARY * MEMRS LDA B40 LOAD THE MEMORY RESIDENT MAP IN DMS REG LDB .32 32 REGISTERS CBX LDB $MRMP MEM RES MAP XMM TRANSFER MEM TO MAPS * LDA $SBTB+3 # OF PAGES IN MEM RESIDENT BASE PAGE SZA,RSS MEM RES PROGRAMS EXIST? JMP IOCNF NO, THEN CONFIGURE I/O * LDA B1776 1776B WORDS TO LOAD FOR STA TEMP MEM RESIDENT BASE PAGE LDA $SBTB+2 DISC ADDRESS FOR MEM RES BASE PAGE JSB DSCAD LDA .2 START ADDRESS IS 2 STA TEMP3 JSB LOAD LOAD MEM RES BASE PAGE LD^—þúA $SBTB+5 #PAGES FOR MEM RES LIB & PROGS LSL 10 MULTIPLY BY 2000B STA TEMP # OF WORDS IN BUFFER LDA $SBTB+4 DISC ADDRESS FOR MEM RES LIB & PROGS JSB DSCAD LDA LBORG STARTING MEM ADDRESS STA TEMP3 FOR RESIDENT LIBRARY JSB LOAD LOAD THE MEM RES PROGS & LIB * HED RECONFIGURE DISC SELECT CODES IOCNF LDA SWREG RE-CONFIGURATION REQUESTED? SSA,RSS BIT 15 IN SWITCH REGISTER SET? JMP $EXIT NO, THEN DONE * CCA YES,INITIALIZE TRPCL,INTBL,EQTBL TO -1 LDB .168 168 ENTRIES POSSIBLE JSB SETM DEF TRPCL START AT LOC TRPCL CCA INITIALIZE OLD SC TABLE TO -1 LDB B70 JSB SETM DEF OLSTB LDA SVTBL DISC I/O SELECT CODE CHANGED? SSA,RSS JMP CNDSC YES, CONFIGURE DISC SC * LDA .2 FIND SC # FOR LU2 JSB LUSUB LDA A,I GET EQT WORD 4 OF LU 2 EQT AND B77 GET SC # STA CURNT SAVE IT IN CURNT ADA INTBA ADD ADDRESS OF INTERRUPT TABLE ADA N6 POINT TO DISC SC ENTRY IN INTERRUPT TABLE LDB A,I GET THE CONTENTS INA CPB A,I NEXT SC ENTRY SAME AS DISC SC ENTRY? RSS YES, THEN DISC HAS 2 SELECT CODES JMP CONSL NO, CONFIGURE SYSTEM CONSOLE SC * LDA CURNT GET FIRST DISC SC INA INCREMENT IT STA CURNT+1 SET SECOND DISC SC IN CURNT LDA OLD GET OLD SELECT CODE FOR DISC SSA,RSS ANY? INA YES, SECOND DISC SC FOR OLD SC STA OLD+1 SAVE JMP CONSL NO, THEN CONFIGURE CONSOLE SC * CNDSC JSB JNENT ENTER DISC SC IN INTBL AND TRPCL NOP ERROR RETURN NOT POSSIBLE LDA NEWSC GET NEW SELECT CODE FOR DISC STA CURNT SAVE IN CURNT FOR LATER CHECKS ADA AEQTB POINT TO NEW DISC SC ENTRY ADA NB10 IN EQTBL LDB RSTBÕþúL+5 EQT WORD 4 ADDRESS FOR DISC EQT STB A,I SET UP ENTRY IN EQTBL FOR DISC JSB CLRSC CLEAR SC IN INTERRUPT TABLE &TRAP CELL LDA ARSTB ADDRESS OF RSTBL JSB RSENT MAKE ENTRIES IN RESTORE TABLE LDA SVTBL+4 DISC HAS TWO SELECT CODES? CPA N1 ENTRY MADE IN SVTBL? JMP CONSL NO, THEN CONFIGURE CONSOLE SC ISZ NEWSC YES LDA NEWSC GET THE SECOND DISC SELECT CODE STA CURNT+1 SAVE IT IN CURNT ISZ OLDSC JSB JNENT ENTER 2ND DISC SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN JSB CLRSC CLEAR SC IN INTERRUPT TABLE & TRAP CELL LDA ARSTB POINTER INTO RSTBL FOR ADA .6 SECOND DISC SC ENTRIES JSB RSENT MAKE ENTRIES IN RSTBL * HED RECONFIGURE SYSTEM CONSOLE SELECT CODE CONSL LDA SWREG GET BITS 0-5 OF SWITCH REGISTER AND B77 GET CONSOLE SELECT CODE SZA 0? JMP CNTTY NO, CONFIGURE NEW CONSOLE SELECT CODE * LDB $SAVE UNBUFFER CONSOLE EQT JSB EQUNB LDA TEMP2 STA $SAVE+9 JMP CONS2 * CNTTY STA NEWSC NO, NEW SELECT CODE FOR CONSOLE JSB CHKSC NEW SYTEM CONSOLE SC IS ONE OF DISC SC'S? JMP EQERR YES, HALT ERROR * LDA SWREG GET SWITCH REGISTER CONTENTS AND B70K MASK BITS 12,13,14 STA TEMP3 SAVE THIS VALUE CPA B10K JUST BIT 12 SET? JMP CONTY YES, THEN USE SAME EQT AS CURRENT SC * CPA B20K BIT 13 SET? RSS YES, USE EQT WITH THE NEW SELECT CODE JMP GTTYP FIND CONSOLE TYPE * LDA NEWSC GET NEW CONSOLE SELECT CODE JSB EQTFN FIND AN EQT POINTING TO NEWSC SSB FOUND ANY? JMP EQERR EQT ERROR -- HALT * ISZ TEMP5 SET UP EQT # FOR SYSTEM CONSOLE INB POINT TO WORD 5 OF SYS CONSOLE EQT LDA B,I GET CONTENTS ALF,\ŠþúALF EQUIPMENT TYPE CODE IN LOW BYTE AND B77 GET EQUIPMENT TYPE CODE JMP FNDEQ GO SET UP DRT ENTRY FOR SYS CONSOLE * GTTYP LDA $SAVE DETERMINE DRIVER TYPE FOR CURRENT INA SYSTEM CONSOLE - POINT TO WORD 5 LDA A,I OF CURRENT SYSTEM CONSOLE EQT ALF,ALF GET EQUIPMENT TYPE CODE AND B77 INTO BITS 0-7 STA TEMP1 SAVE IT LDA N3 CONFIGURE I/O INSTR TO FIND OUT TYPE CONLP LDB ACN1,I OF CONSOLE ATTACHED TO NEW SC ADB NEWSC STB ACN1,I RESTORE INSTR ISZ ACN1 POINT TO NEXT INSTR INA,SZA ALL INSTR CONFIGURED? JMP CONLP NO LDB .5 LDA MRSET MASTER RESET WORD CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 CLB DVR00 DRIVER CLA CPB TEMP1 IS THIS CONSOLE SAME TYPE AS CURRENT ONE JMP CONTY YES, USE THE SAME EQT FOR NEW SC * STB TEMP1 NO, THEN SAVE NEW CONSOLE TYPE * * FIND AN EQT WITH EQUIPMENT TYPE CODE MATCHING * THE NEW SELECT CODE * LDA NEWSC JSB EQTFN FIND AN EQT # WITH NEW SC SSB,RSS FOUND? JMP FNCNE YES * CNEQT CLA,INA NO FIND EQT WITH RIGHT DRIVER TYPE STA TEMP5 TEMP5 KEEPS COUNT OF EQT'S LOOKED AT LDB EQTA EQUIPMENT TABLE START ADB .4 POINT TO WORD 5 OF THE FIRST EQT EQTLP LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF EQUIPMENT TYPE CODE IN LOW 6 BITS AND B77 CPA TEMP1 IS IT SAME AS THAT OF NEWSC? JMP FNDEQ YES,THE RIGHT EQT HAS BEEN FOUND LDA TEMP5 CPA EQT# ALL EQT'S DONE? JMP EQERR YES, THEN ERROR ISZ TEMP5 NO, POINT TO NEXT EQT'S WORD 5 ADB .15 JMP EQTLP * FNCNE ISZ TEMP5 SET UP EQT # FOR SYSTEM CONSOLE INB POINT TO WORD 5 OF EQT LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF AND B77 GET EQUI÷³þúPMENT TYPE CODE CPA TEMP1 IS IT SAME AS THAT OF NEW CONSOLE? JMP FNDEQ YES, THEN FOUND THE RIGHT EQT JMP CNEQT NO, THEN FIND EQT * EQERR HLT 55B HALT SYSTEM JMP *-1 * CONTY LDB $SAVE DRIVER TYPE SAME FOR JMP EQTTY OLD AND NEW SYSTEM CONSOLE * B10K OCT 10000 B20K OCT 20000 B70K OCT 70000 * * * CLRSC - ROUTINE TO CLEAR INTERRUPT TABLE ENTRY FOR OLDSC * AND TO INSERT A JSB $CIC,I INSTR IN CORRESPONDING * TRAP CELL ENTRY * CALLING SEQUENCE: JSB CLRSC * * CLRSC NOP LDA OLDSC CPA SVTBL IS OLDSC SAME AS NEW DISC SC #1? JMP CLRSC,I YES, THEN RETURN CPA SVTBL+4 IS OLDSC SAME AS NEW DISC SC #2? JMP CLRSC,I YES, RETURN LDA JSBCI JSB $CIC,I INSTR STA OLDSC,I IN TRAP CELL ENTRY FOR OLD SC LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 ADA OLDSC POINTER INTO THE INTERRUPT TABLE CLB CLEAR ENTRY FOR OLD SC IN INTERRUPT TABLE STB A,I JMP CLRSC,I RETURN * * * EQT HAS BEEN FOUND, CHANGE EQT# IN DRT ENTRY FOR * LU1 - THE SYSTEM CONSOLE AND IN BASE PAGE LOC SYSTY * FNDEQ ADB N1 POINT TO WORD 4 OF NEW EQT ADDRESS STB $SAVE SAVE IS WHERE SYSTY+4 IS SAVED CPA .5 IN THIS DVR05 TYPE CONSOLE? JMP NOSUB YES, THEN SUBCHANNEL IS 0 * STDRT LDA LUMAX # OF LOGICAL UNITS DEFINED CMA,INA STA TEMP3 SAVE AS NEGATIVE COUNTER LDB DRT START OF DEVICE REFERENCE TABLE DRTLP LDA B,I GET AN ENTRY FROM DRT AND B77 MASK EQT # CPA TEMP5 SAVE AS NEW SYS CONSOLE'S EQT JMP DRTEN YES, FOUND NEW SYS CONSOLE'S ENTRY IN DRT * INB POINT TO NEXT ENTRY IN DRT ISZ TEMP3 INCREMENT COUNTER JMP DRTLP CHECK NEXT DRT ENTRY * NOSUB LDA TEMP5 EQT # OF NEW SYS CONSOLE RSS DRTEN LDA B,I SET UP DRT ENTRY FOR LU 1 STA DRÏÈþúT,I * EQTTY LDB $SAVE NEW CONSOLE'S EQT WORD 4 ADDRESS LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 STA OLDSC OLD SC # FOR CONSOLE STA OLD+2 SAVE FOR PRINTING LATER JSB EQUNB UNBUFFER EQT LDB TEMP2 SAVE BUFFERED/UNBUFFERED STATUS STB $SAVE+9 LDA ASV8 POINT TO ENTRY FOR SYS CONSOLE IN SVTBL JSB SVENT ENTER NEW SC IN SVTBL LDA NEWSC NEW SELECT CODE FOR SYSTEM CONSOLE CPA OLDSC SAME AS OLD SELECT CODE? RSS YES JMP MKENT NO, MAKE ENTRIES IN INTBL AND TRPCL * LDA SVTBL+11 EQT WORD 4 ADDRESS FOR OLD SC CPA $SAVE SAME AS FOR NEW SELECT CODE? RSS YES JMP MKENT NO, CONFIGURE SYTEM CONSOLE SC * CCA RE-INITIALIZE ENTRY FOR SYSTEM LDB .4 CONSOLE IN SVTBL JSB SETM ASV8 DEF SVTBL+8 JMP CONS2 SAVE INTERRUPT TABLE AND TRAP CELL CONTENTS * MKENT JSB JNENT ENTER NEW & OLD SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR CURRENT EQT'S FOR NEW SC LDA OLDSC GET OLD SELECT CODE # JSB IPROC CONFIGURE INTRPT TBL & TRAP CELL LDA NEWSC NEW SELECT CODE JSB IPROC CONFIGURE NEW SELECT CODE LDA ARSTB POINTER INTO RSTBL FOR CONSOLE SC ADA .12 JSB RSENT MAKE ENTRIES IN RSTBL FOR CONSOLE SC CLA CLEAR FLAG STA NOCLR LDB RSTBL+17 EQT WORD 4 ADDRESS OF CONSOLE ADB N3 POINT TO FIRST WORD OF CONSOLE EQT STA B,I CLEAR THIS WORD * CONS2 LDA $SAVE,I GET WORD 4 OF CONSOLE EQT AND B77 GET THE SELECT CODE STA CURNT+2 SAVE FOR FUTURE CHECKS LDB A,I GET THE TRAP CELL CONTENTS FOR SYS CONSOLE STB CTRCL SAVE TRAP CELL CONTENTS ADA INTBA INDEX INTO THE INTERRUPT TABLE ADA N6 ”Çþú LDA A,I STA CINTB INTERRUPT TABLE ENTRY FOR SYS CONSOLE HED LIST DEVICE RECONFIGURATION STRCN LDB .11 JSB WRTTY DEF MSG0 START RECONFIGURATION * CONFIGURE LIST DEVICE SELECT CODE * LSTDV LDB .8 JSB QUERY ASK FOR DEF MSG1 LIST DEVICE LU? LSTLU LDA PRSBF GET FIRST WORD OF PARSE BUFFER TRTMP SZA,RSS NULL? JMP LUDFL YES, THEN DEFAULT LU# SAVPG LDB APRSB ADDRESS OF PARSE BUFFER SVPG1 LDA LUMAX UPPER LIMIT FOR LU# STA MXLU# CLA,INA LOWER LIMIT FOR LU# JSB TST# TEST LU# MXLU# NOP JMP LUERR RSS LUDFL INA YES, THEN DEFAULT LU IS 1 STA LSTLU LIST DEVICE LU# * * LIST DEVICE SELECT CODE # * CCB LDA LSTLU CPA .1 SAME AS CONSOLE LU? JMP ECHO2 YES, DO NOT ASK FOR SELECT CODE# LDA LSTLU GET EQT# FOR LIST DEVICE LU JSB LUSUB SZA,RSS JMP LUERR BIT BUCKET LU, ERROR * STA $SAVE+8 SAVE ADDR OF WORD 4 OF LIST DEV EQT LDB A ALSO, SAVE ADDR IN B REG LDA A,I GET CONTENTS OF THE EQT WORD 4 AND B77 GET OLD SC AND SAVE STA OLDSC JSB EQUNB UNBUFFER LIST DEV EQT LDA TEMP2 SAVE BUFFERED/UNBUFFERED FLAG STA $SAVE+10 * LULST LDB .13 JSB QUERY DEF MSG2 LIST DEVICE SELECT CODE #? LDB OLDSC GET OLD SELECT CODE FOR LIST DEVICE LDA PRSBF FIRST WORD OF PARSE BUFFER SZA 0? JMP CNLST NO, CONFIGURE LIST DEVICE * STB CURNT+3 SAVE LIST DEV SC FOR FUTURE CHECKS JMP SVLST * CNLST STB OLD+3 SAVE OLD SELECT CODE FOR PRINTING INFO LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST VALIDITY OF LIST DEVICE SELECT CODE# JMP LULST SELECT CODE # NOT VALID STA NEWSC NEW SELECT CODE # FOR LIST DEVICE JSB CHKSC MAKE SURE LIST DEVICE SC IS BþúNOT JMP LSTER DISC OR CONSOLE SC * LDA NEWSC STA CURNT+3 SAVE IN CURNT FOR FUTURE CHECKS CPA OLDSC SELECT CODE SAME AS OLD SC? JMP SVLST YES, SKIP RECONFIGURATION FOR LIST DEV * LDA ASVTB ADDRESS OF SVTBL ADA .12 POINT TO LIST DEVICE ENTRIES JSB SVENT MAKE NEWSC ENTRY IN SVTBL JSB JNENT INTBL AND TRPCL ENTRIES NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR SC # FROM CURRENT NEWSC EQT'S LDA OLDSC ENTRY IN INTERRPT TABLE AND JSB IPROC AND TRAP CELL FOR OLD SELECT CODE LDA NEWSC AND NEW SELECT CODE FOR LIST DEVICE JSB IPROC LDA ARSTB POINTER INTO RSTBL FOR ADA .18 LIST DEVICE JSB RSENT MAKE ENTRIES IN RSTBL FOR LIST DEVICE CLA STA NOCLR RESET FLAG LDB RSTBL+23 GET EQT WORD 4 ADDR FOR LIST DEV ADB N3 POINT TO FIRST WORD OF LIST DEV EQT STA B,I CLEAR THE WORD JMP ECHOQ * SVLST LDB A,I SAVE LIST TRAP CELL STB LTRCL ADA INTBA SAVE INTERRUPT TABLE ADA N6 FOR LIST DEV LDA A,I STA LINTB * * ECHOQ LDB .7 JSB QUERY ECHO?(YES/NO) DEF MSG3 LDA PRSBF PARSE BUFFER CPA .1 NUMERIC VALUE? JMP ECHOQ YES, THEN ASK AGAIN CCB LDA PRSBF+1 FIRST TWO CHARACTERS CPA NO NO? JMP ECHO2 ECHO NOT REQUIRED? CPA YE YES? RSS JMP ECHOQ ERRONEOUS REPLY, ASK AGAIN ECHO CLB ECHO2 STB ECHO ECHO=0 ECHO WANTED,-1 ECHO NOT WANTED * HED PRINT I/O RECONFIGURATION ALREADY PERFORMED CLA STA TEMP2 SET FOR INDEX COUNT STA TEMP1 SET FLAG FOR PRINTING HEADER LKAGN LDB AOLD ADDRESS OF OLD TABLE ADB TEMP2 INDEX INTO IT LDA B,I GET CONTENTS SSA,RSS AN?ýþúY DEFINED? JMP PRHED YES, PRINT OLD,NEW SC INFO * INCR LDB TEMP2 GET INDEX CPB .3 DONE? JMP STIO YES * ISZ TEMP2 NO, INCREMENT INDEX JMP LKAGN LOOK AGAIN * * PRHED LDA TEMP1 GET PRINT HEADER FLAG SZA ALREADY SENT OUT? JMP PRINF YES, THEN JUST PRINT SC * CLA,INA SET FLAG TO INDICATE STA TEMP1 HEADER ALREADY PRINTED LDB .19 SEND OUT JSB WRLST I/O RECONFIGURATION ALREADY PERFORMED DEF MSG7 MESSAGE LDB .19 SEND OUT JSB WRLST CURRENT SELECT CODE#,NEW SELECT CODE# DEF MSG10 MESSAGE * PRINF LDA AOLD GET ADDRESS OF OLD TABLE ADA TEMP2 ADD INDEX LDA A,I GET CONTENTS CLE CONVERT TO OCTAL ASCII JSB $CNV1 STA RDBUF SET UP OLD SC IN MESAGE BUFFER LDA SPCCM GET " ," STA RDBUF+1 SET IN OUTPUT BUFFER LDA ACURN GET ADDRESS OF CURRENT SC TABLE ADA TEMP2 ADD INDEX LDA A,I GET NEW SELECT CODE CLE JSB $CNV1 CONVERT TO ASCII OCTAL STA RDBUF+2 * LDA SPACE INTIALIZE NEXT PART OF BUFFER LDB .5 WITH SPACES JSB SETM DEF RDBUF+3 LDA ADEF ADDRESS OF DEF TABLE ADA TEMP2 INDEX INTO IT LDA A,I GET ADDRESS OF MESSAGE LDB ARDBF DESTINATION ADB .7 BUFFER ADDRESS MVW .8 MOVE THE COMMENT INTO MESSAGE LDB SPC2 IF MESSAGE FOR SYSTEM LDA TEMP2 DISC 2 MODIFY THE CPA .1 OUTPUT BUFFER STB RDBUF+13 LDB .15 JSB WRLST XX ,YY *ZZZZZZZZZZZZ DEF RDBUF JMP INCR GET NEXT SELECT CODE * * MSG7 ASC 19,I/O RECONFIGURATION ALREADY PERFORMED: SPCCM ASC 1, , SPC2 ASC 1, 2 ADEF DEF *+1 DEF SYSDS DEF SYSDS DEF SYSCN DEF LIST SY8‰þúSDS ASC 8,*SYSTEM DISC 1 SYSCN ASC 8,*SYSTEM CONSOLE LIST ASC 6,*LIST DEVICE SPACE ASC 2, AOLD DEF OLD HED PRINT CURRENT I/O CONFIGURATION * PRINT A LIST OF CURRENT I/O CONFIGURATION * STIO DLD .ENT SET UP MESSAGE DST MSG4+2 LDB .13 JSB WRLST DEF MSG4 CURRENT I/O CONFIGURATION: JSB PRNIO * * WANT I/O CONFIGURATION? * WNTIO LDB .14 JSB QUERY DEF MSG9 I/O RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO CNTRP JMP MEMCN I/O CONFIG NOT REQIURED CNINT CPA YE LSTRP RSS LSINT JMP WNTIO ASK QUES AGAIN HED I/O RECONFIGURATION * * * I/O RECONFIGURATION IS DESIRED * IOCN2 LDB .25 JSB WRTTY DEF MSG10 CURRENT SELECT CODE#,NEW SELECT CODE#?(/E TO END) IOCN3 CLB,INB JSB QUERY DEF HYPHN HYPHEN (-) PROMPT LDA PRSBF CPA .2 ASCII? JMP ENDIO CHECK IF END OF LIST LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STA OLDSC OLD SELECT CODE LDA PRSBF+4 SECOND PARAMETER ASCII? CPA .2 RSS YES, CHECK IF IT IS PR JMP NEWCH NO, TEST NEW CHANNEL # LDA PRSBF+5 CPA PI PRIVILEGED I/O CARD TO BE ADDED? RSS YES JMP IOERR NO, THEN ERROR LDA OLDSC OLD SELECT CODE VALUE JSB CHKSC NEW SC VALUE FOR DISC,CONSOLE OR LIST? JMP ERR3 YES, THEN CONFIG ERR 3 LDA OLDSC NO, GET OLDSC # STA $SAVE+5 SET UP DUMMY WORD ON BASE PAGE ADA NB10 ADA AINTB POINT INTO INTBL CLB STB A,I CLEAR THE INTBL ENTRY FOR OLDSC LDA OLDSC CPA TBG TBG CHANNEL? STB TBG YES, CLEAR TBG WORD ON BASE PAGE ADA NB10 ADA ATRPC POINT INTO TRPCL TABLE LDB JSBCI INSERT JSB $CIC,I INSTR IN STB A,I TRPCL ENTRY FOR OLDSC þúC LDA OLDSC ADA NB10 CAX SAVE A REG VALUE ADA AOLSC POINT TO OLD SC TABLE JSB PRVOL RESTORE PREV OLDSC IF NECESSARY CXA GET OLDSC - 10B ADA AOLSC POINT TO OLDSC ENTRY IN OLSTB CCB STB A,I NO OLDSC ASSIGNED CXA GET OLDSC -10B ADA AEQTB EQT TBL STB A,I ENTRY TO -1 JMP IOCN3 ASK FOR MORE * NEWCH LDB APRSB ADB .4 POINT TO VALUES FOR NEW SC LDA B IF THE NEW SELECT CODE # IS 0 INA DO NOT GO THRU TSTCH ROUTINE LDA A,I SZA JMP TSTNS NOT 0 THEN TEST NEW SELEC CODE LDB OLDSC GET OLD SELECT CODE # CPB PRVSV IS IT A PRIV I/O CARD? JMP STNWS YES, THEN 0 FOR NEWSC IS VALID JMP IOERR NO, THEN ERROR TSTNS JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STNWS STA NEWSC NEW SELECT CODE JSB INENT ENTER IN INTBL AND TRPCL JMP ERR3 GIVE CONFIG ERR 3 JMP IOCN3 ASK FOR MORE * ENDIO LDA PRSBF+1 /E ? CPA /E JMP IOCN7 CPA /R RESTART? JMP RSTRT * IOERR LDA A2 INVALID SELECT CODE # RSS ERR3 LDA A3 JSB ERROR JMP IOCN3 * LUERR LDA A1 JSB ERROR INVALID LIST DEVICE LU # JMP LSTDV * LSTER LDA A3 INVALID LIST DEVICE SC JSB ERROR JMP LULST * MSG0 ASC 11,START RECONFIGURATION MSG1 ASC 8,LIST DEVICE LU#? MSG2 ASC 13,LIST DEVICE SELECT CODE#? MSG3 ASC 7,ECHO?(YES/NO) * NOCLR NOP INTBL EQU TRPCL+56 EQTBL EQU INTBL+56 RDBUF EQU EQTBL+56 PRSBF EQU RDBUF+80 ENDT EQU PRSBF+32 END OF OVERLAY TABLES AINTB DEF INTBL $ABDP DEF INTBL ARSTB DEF RSTBL .11 DEC 11 .18 DEC 18 .ENT ASC 2,ENT .25 DEC 25 A1 ASC 1,1 A2 ASC 1,2 A3 ASC 1,3 AEQTB DEF EQTBL PI ASC 1,PI SKP * * LUSUB - THIS SUBROUTINE GIVES "ûþúTHE EQT WORD 4 ADDRESS * CORRESPONDING TO AN LU#. * * CALLING SEQUENCE: A REG = LU # * JSB LUSUB * RETURNS: A REG = 0 IF LU POINTS TO BIT BUCKET * = EQT WORD 4 ADDRESS OF EQT THAT * THE LU POINTS TO * * LUSUB NOP ADA N1 LU# - 1 ADA DRT ADDRESS OF DRT TABLE LDA A,I GET CONTENTS AND B77 LIST DEVICE EQT# IN A REG SZA,RSS BIT BUCKET? JMP LUSUB,I YES, RETURN ADA N1 MPY .15 GET EQT ADDRESS ADA EQTA ADA .3 POINT TO WORD 4 OF LIST DEV EQT JMP LUSUB,I RETURN HED RESTART I/O RECONFIGURATION * * RESTART THE I/O RECONFIGURATION * * RSTRT CCA INITIALIZE TABLES FOR I/O LDB .168 RE-CONFIGURATION TO -1 JSB SETM ATRPC DEF TRPCL CCA LDB B70 SET OLDSC TABLE TO -1 JSB SETM AOLSC DEF OLSTB * LDA TBGSV CHANGE TBG VALUE TO THE NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES, THEN CLEAR TBG LDA TBGSV NO STA TBG LDA PRVSV CHANGE PRIV I/O VALUE TO NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES LDA PRVSV NO STA $SAVE+5 CLB STB TEMP2 LDA ARSTB ADDRESS OF RESTORE TABLE STA TEMP USE TEMP AS POINTER RSLP LDB TEMP,I OLD SELECT CODE # SSB ENTRY MADE? JMP SKPRS NO, THEN NOTHING TO RESTORE STB OLDSC ADB NB10 RESTORE OLD SC VALUES IN INTBL AND TRPCL JSB RESTR LDB ASVTB ADDRESS OF SAVE TABLE ADB TEMP2 INDEX INTO IT LDB B,I GET NEW SC # ADB NB10 CBX SAVE FOR NOW ADB AOLSC POINT INTO OLDSC TABLE LDA OLDSC STA B,I RESTORE OLDSC VALUE CXB RESTORE B REG VALUE A¯þúCAX JSB RESTR RESTORE NEW SC VALUES IN TRPCL &INTBL ISZ TEMP CXA ADA AEQTB RESTORE EQT WORD 4 ADDRESS ADA NB10 LDB TEMP,I STB A,I ISZ TEMP RSLPE LDA TEMP2 ALL ENTRIES IN SVTBL RESTORED? CPA .12 JMP IOCN2 YES RESTART I/O CONFIGURATION ADA .4 NO, POINT TO NEXT SET OF ENTRIES STA TEMP2 JMP RSLP SKPRS LDA TEMP * ADA .6 POINT TO NEXT SET OF ENTRIES IN RSTBL STA TEMP JMP RSLPE * MSG9 ASC 14,I/O RECONFIGURATION?(YES/NO) MEM ASC 2,MEM NEW ASC 2,NEW HYPHN ASC 1,- /R ASC 1,/R /E ASC 1,/E N2 DEC -2 B70 OCT 70 #WRDS ABS EQTBL+56-SVTBL LENGTH OF ALL IO TABLES .20 DEC 20 CONSC EQU SVTBL+8 LSTSC EQU SVTBL+12 HED TRANSFER I/O RECONFUGRATION CHANGES TO SYTEM TABLES * * TRANSFER I/O RECONFIGURATION CHANGES TO ACTUAL TRAP CELL, * INTERRUPT TABLE AND EQT ENTRIES IN THE SYSTEM IN MEMORY * IOCN7 LDA INTLG GET LENGTH OF INTERRPUT TABLE ADA N2 CMA,INA STA TEMP2 USE AS -VE COUNTER LDA B10 FIRST SELECT CODE VALUE STA TEMP3 IOLP1 CPA CONSC NEW CONSOLE SELECT CODE? JMP ENIOL YES,DO NOT CHANGE CONSOLE SELECT CODE VALUE CPA LSTSC NEW LIST DEVICE SELECT CODE? JMP ENIOL YES, DO NOT CHANGE IT JSB IPROC TRANSFER INTBL AND TRPCL VALUES RSS ENIOL JSB JPROC CLEAR NEWSC'S PREV EQT'S IF NOT ASSIGNED ISZ TEMP3 TO INTRPT TABLE AND TRAP CELL LDA TEMP3 ISZ TEMP2 INCREMENT COUNTER JMP IOLP1 LDA EQT# # OF EQT'S DEFINED CMA,INA USE AS COUNTER STA TEMP5 LDA EQTA ADDRESS OF START OF EQT TABLES CLB CLREQ STB A,I CLEAR FIRST WORD OF ALL EQT'S ADA .15 ISZ TEMP5 JMP CLREQ * DLD NEW SET UP MESSAGE DST MSG4+2 LDB .11 PRTMP JSB WRLST NEW I/O CONFIGURATION DEF MSG4+2 PRTM2 ‰ÕþúJSB PRNIO PRINT NEW I/O CONFIGURATION * * HED MAKE I/O RECONFIGURATION PERMANENT PERMQ LDB .20 JSB QUERY NEW I/O CONFIGURATION PERMANENT?(YES/NO) DEF MSG12 LDA PRSBF+1 CPA NO RESPONSE IS NO? JMP MEMCN YES, THEN MEMORY CONFIGURATION CPA YE JMP PRMIO MAKE I/O CONFIG PERMANENT CPA /R RESTART I/O CONFIGURATION? RSS YES JMP PERMQ ERROR IN RESPONSE CCA INITIALIZE ALL I/O RE-CONFIGURATION LDB #WRDS TABLES TO -1 JSB SETM ASVTB DEF SVTBL CCA LDB B70 JSB SETM SET OLD SC TABLE TO -1 DEF OLSTB LDA TBG TBG CHANNEL STA TBGSV LDA $SAVE+5 STA PRVSV JMP STIO START I/O RE-CONFIGURATION * * PRMIO LDA CURNT+2 CURRENT SELECT CODE FOR CONSOLE ADA INTBA SAVE ITS CURRENT INTERRUPT TABLE ADA N6 CONTENTS LDB A,I TO BE DONE BECAUSE A DRIVER CAN CHANGE STB CNINT CAN CHANGE INTERRUPT TABLE ENTRIES LDB CURNT+2,I GET CURRENT TRAP CELL CONTENTS FOR SYS CONSOLE STB CNTRP SAVE THIS VALUE LDB CONSC NEW SELECT CODE FOR SYS CONSOLE? SSB JMP PRM1 NO * LDB RSTBL+15 GET CONTENTS OF ORIGINAL VALUE IN INTERRUPT STB A,I TABLE FOR THE CONSOLE SELECT CODE LDB RSTBL+16 ORIGINAL TRAP CELL VALUE FOR STB CONSC,I THE CONSOLE SELECT CODE JMP CHKLS CHECK LIST DEVICE * PRM1 LDB CINTB STB A,I RESOTRE ORIGINAL INTERRUPT TABLE LDB CTRCL RESTORE ORIGINAL TRAP CELL CONTENTS STB CURNT+2,I * CHKLS LDA CURNT+3 LIST DEVICE SELECT CODE ADA INTBA GET INTERRUPT TABLE VALUE CURRENTLY ADA N6 ASSIGNED TO LIST DEVICE SELECT CODE LDB A,I STB LSINT SAVE THIS VALUE LDB CURNT+3,I STB LSTRP LDB LSTSC NEW SELECT CODE DEFINED FOR LIST DEV? SSB XŸþú JMP PRM2 NO * LDB RSTBL+21 GET ORIGINAL INTERRUPT TABLE STB A,I VALUE FOR LIST DEVICE LDB RSTBL+22 GET ORIGINAL TRAP CELL VALUE FOR STB LSTSC,I FOR LIST DEVICE JMP PRCNT * PRM2 LDB LINTB RESOTRE INTERRUPT TABLE CONTENTS STB A,I FOR LIST DEVICE LDB LTRCL RESTORE TRAP CELL CONTENTS FOR STB CURNT+3,I LIST DEVICE * PRCNT LDA INTBA ADDRESS OF INTERRUPT TABLE LDB INTLG LENGTH OF INTERRUPT TABLE JSB $TRTB WRITE INTERRUPT TABLE ON DISC LDA B10 WRITE TRAP CELLS ON DISC LDB B70 JSB $TRTB LDB CNTRP GET SAVED VALUE OF TRAP CELL FOR STB CURNT+2,I CONSOLE SELECT CODE LDA CURNT+2 ADA INTBA ADA N6 LDB CNINT RESTORE CURRENT VALUE OF INTERRUPT TABLE STB A,I LDB LSTRP RESTORE CONTENTS OF LIST DEVICE STB CURNT+3,I TRAP CELL LDA CURNT+3 ADA INTBA ADA N6 LDB LSINT RESTORE CONTENTS OF LIST DEVICE STB A,I INTERRUPT TABLE ENTRY * PREQT JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S CLA STA PRTM2 USE AS COUNTER LDA EQTA START ADDRESS OF EQT TABLES ADA .3 POINT TO WORD 4 OF FIRST EQT STA TEMP3 PREQL CLB JSB $TREN TRANSFER EQT WORD 4 TO DISC ISZ PRTM2 LDA PRTM2 CPA EQT# JMP UNBFR DONE LDA TEMP3 ADA .15 STA TEMP3 POINT TO WORD 4 OF NEXT EQT JMP PREQL UNBFR LDA $SAVE+9 CONSOLE EQT WAS BUFFERED? SZA,RSS JMP LSUNB NO LDA PRTMP YES, RESTORE UNBUFFERED WORD STA $SAVE,I LSUNB LDA $SAVE+10 LIST DEVICE EQT WAS BUFFERED? SZA,RSS JMP PRDRT NO LDA PRTMP+1 RESTORE UNBUFFER STATUS STA $SAVE+8,I * PRDRT LDA DRT ADDRESS OF DRT ENTRY FOR SYSTEM CONSOLE SC CLB MAKE IT PERMANENT JSB $TREN * * LDA ywþúATBG MAKE TBG WORD ON BASE PAGE PERMANENT LDB TBG GET CONTENTS OF TBG WORD FROM BASE PAGE JSB LOCTR TRANSFER IT TO DISC LDA ASYST SYSTY WORD ON BASE PAGE TO BE TRANSFERRED LDB $SAVE CONTENTS OF SYSTY (+3) ARE IN $SAVE ADB N3 POINT TO START OF CONSOLE EQT JSB LOCTR TRANSFER WORD TO DISC LDA ADUMY TRANSFER PRIVILEGED I/O CARD ADDRESS LDB $SAVE+5 CONTENTS OF WORD ON BASE PAGE JSB LOCTR * * I/O CONFIGURATION COMPLETED * HED MEMORY RECONFIGURATION * PRINT INFORMATION ON CURRENT MEMORY SETUP * MEMCN LDB $MNP MAX # OF PARTITIONS ALLOWED BDTMP CMB,INB STB TEMP USE AS COUNTER LDB $MATA GET STARTITNG ADDRESS OF MAT ENTRIES MATLP LDA B,I GET CONTENTS OF FIRST WORD OF THIS ENTRY SSA -1? JMP BCKUP YES, BACKUP TO FIND # PAGES IN MEM ADB .7 NO ISZ TEMP ALL PARTITIONS CHECKED? JMP MATLP NO, IS NEXT ENTRY THE LAST ONE? BCKUP ADB N1 GET CONTENTS OF LAST WORD LDA B,I OF PREVIOUS MAT ENTRY SZA,RSS 0? JMP FOUND YES, THEN NOT A SUBPARTITION ADB N3 POINT TO WORD 3 OF PREVIOUS MAT ENTRY LDA B,I SSA IS IT A MOTHER PARTITION? JMP MFND YES ADB N4 POINT TO LAST ENTRY OF PREV PARTN JMP BCKUP+1 * FOUND ADB N3 POINT TO WORD 3 OF THIS MAT ENTRY MFND LDA B,I GET VALUE AND BIT09 MASK # OF PAGES IN PART'N CAX SVE THIS VALUE INB LDA B,I GET WORD 4 OF THE MAT ENTRY AND BIT09 MASK # PAGES IN PARTITION CXB ADA B CCE,INA CONVERT #PAGES IN PHYSICAL MEM TO ASCII JSB $CNV3 INA DLD A,I GET ASCII VALUE FOR LEAST 4 DIGITS DST MSG23+14 SET UP MESSAGE LDB .19 JSB WRLST CURRENT PHYSICAL MEM SIZE: XXXX PAGES DEF MSG23 * (-þúDLD MEM SET UP MESSAGE DST MSG9 MEMC0 LDB .14 MESSAGE LENGTH JSB QUERY DEF MSG9 MEM RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO NO? JMP $EXIT RETURN CONTROL TO SYSTEM CPA YE RSS MEM RECONFIGURATION WANTED JMP MEMC0 ERROR IN RESPONSE * $NPGQ LDB .13 JSB QUERY DEF MSG21 PHSICAL MEM SIZE?(#PAGES) LDA .48 LOWER BOUNDS IS 48 PAGES LDB APRSB ADDRESS OF PARSE BUFFER JSB TST# TEST VALIDITY OF RESPONSE .1024 DEC 1024 UPPER LIMIT JMP NPGSE ERROR IN RESPONSE STA MEMSZ SAVE MEM SIZE ADA N1 GET LAST PAGE # IN MEMORY STA LASTP LDA $SBTB+1 # PAGES IN DRIVER PARTITION ADA $SBTB+5 # OF PAGES IN MEM RES PART'N ADA $SBTB+3 # PAGES IN MEM RES BASE PAGE ADA $ENDS # PAGES IN SYSTEM UPTO SAM DEFAULT STA $USRS START OF SAM EXTENSION CCE CONVERT PAGE# TO ASCII DECIMAL JSB $CNV3 INA DLD A,I GET LAST 4 DIGITS DST MSG22+17 * HED DEFINE BAD PAGES * DEFINE BAD PAGES * A MAXIMUM OF 100 BAD PAGES ARE ALLOWED * THE TABLE CONTAINING BAD PAGE NUMBERS OVERLAYS MEMORY THAT WAS * OCCUPIED BY INTBL * THE END OF BAD PAGE TABLE IS MARKED BY A -1 * BDPAG LDB .25 JSB WRTTY DEFINE BAD PAGES BEGINING AT PAGE XXXX ( E TO END) DEF MSG22 LDA N100 MAX # OF BAD PAGES ALLOWED STA BDTMP USE AS COUNTER LDA $ABDP START OF BAD PAGE LIST ADA N1 MINUS ONE STA TEMP1 TEMP1 WILL BE THE POINTER LDB $USRS INITIALIZE LIST OF BAD PAGES TO ADB N1 LAST PAGE OF MEMORY RESIDENT PROGRAMS STB TEMP1,I BDPGQ CLB,INB WORD COUNT JSB QUERY SEND HYPHEN PROMPT DEF HYPHN LDA PRSBF+1 RESPONSE IS /E? CPA /E JMP ENBDP YES, THEN END BAD PAGE LIST CPA /R RESTyíþúART ENTRIES FOR BAD PAGES? JMP BDPAG YES LDA TEMP1,I LOWER LIMIT FOR A BAD PAGE # INA IS PREVIOUS BAD PG# + 1 LDB APRSB POINTER TO BAD PAGE # IN PARSE BUF JSB TST# TEST VALIDITY OF BADE PAGE # LASTP NOP LAST PAGE # IN MEMORY JMP BDPGE BAD PAGE ERROR ISZ TEMP1 INCREMENT POINTER STA TEMP1,I SAVE THE BAD PAGE # IN LIST ISZ BDTMP INCREMENT COUNTER JMP BDPGQ PROMPT FOR NEXT BAD PG # JMP ENBDP 100 PAGES ENTERED DONE * BDPGE LDA A11 BAD PAGE ERROR JSB ERROR JMP BDPGQ * NPGSE LDA A10 # OF PAGES IN MEM ERROR JSB ERROR JMP $NPGQ * ATBG DEF TBG ASYST DEF SYSTY ADUMY DEF DUMMY * MEMSZ NOP MSG22 ASC 25,DEFINE BAD PAGES BEGINNING AT PAGEXXXX (/E TO END) MSG23 ASC 19,CURRENT PHYSICAL MEM SIZE: XXXX PAGES .48 DEC 48 N100 DEC -100 .17 DEC 17 .19 DEC 19 BIT09 OCT 1777 A10 ASC 1,10 A11 ASC 1,11 * ENBDP CCA -1 TO INDICATE END OF BAD PAGE LIST ISZ TEMP1 INCREMENT POINTER STA TEMP1,I * HED LOAD CONFIGURATOR EXTENSION INTO MEMORY * LDA CNXID GET ID SEGMENT ADDRESS FOR $CNFX ADA .21 LDA A,I GET # PAGES WORD ALF,RAL MOVE # PAGES (NO BP) TO LOW BITS RAL AND B37 MASK # PAGES USED FOR $CNFX STA #PGS SAVE CMA SAVE NEGATIVE # OF PAGES PLUS BASE PG STA #NPGS LDA $USRS SAVE START OF SAM EXT PAGE LDB $ABDP SAVE POINTER TO BAD PAGE LIST DST SAVPG POINTER INTO BAD PAGE LIST CHNKL CLA A REG = 0 TO INDICATE CALL FROM SYSTEM MAP JSB $PCHN GET THE NEXT CHUNK OF GOOD PAGES SZA,RSS 0? JMP ABORT YES,THEN NO SPACE TO LOAD $CNFGX ADA #NPGS SPACE LARGE ENOUGH FOR $CNFX? SSA,RSS JMP FCHNK YES * LDA $ABDP,I GET CURRENT BAD PAGE SSA ALL BAD PAGE>þúS USED UP? JMP ABORT YES, THEN HLT 22 * INA STA $USRS TRY WITH THIS USER START PAGE JMP CHNKL FIND ANOTHER CHUNK OF MEMORY * FCHNK LDA $PLP LOAD POINT FOR PRIVILEGED PROGRAMS ALF RAL,RAL AND B37 # OF PAGES BEFORE LOAD POINT ADA N1 CAX USE AS COUNTER TO LOAD PAGES LDA B41 START LOGICAL PAGE FOR TABLE AREA I THRU SDA CLB,INB PHYSICAL PAGE # TO BE LOADED XMS LDB #PGS # OF PAGES FOR USER AREA CBX USE AS COUNTER LDB $USRS INB B REG HAS PHYSICAL PAGE XMS TO LOAD USER AREA CLA,INA CAX COUNTER TO LOAD BASE PAGE LDA B40 LOGICAL START PAGE LDB $USRS XMS LDB CNXID GET ID SEG ADDRESS FOR $CNFX SZB,RSS PRESENT? JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .14 POINT TO TYPE WORD IN ID SEG LDA B,I GET CONTENTS AND B37 MASK TYPE OF PROGRAM CPA .3 IS IT A BACKGROUND DISC RESIDENT PROG? RSS YES JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .8 GET WORD 23 OF ID SEGMENT LDA B,I GET CONTENTS STA TEMP3 LOW MAIN ADDRESS CMA,INA INB POINT TO WORD 24 OF ID SEG ADA B,I HIGH MAIN +1 - LOW MAIN STA TEMP SAVE # OF WORDS TO BE LOADED FOR MAIN ADB .3 POINT TO WORD 27 OF ID SEGMENT LDA B,I DISC ADDRESS OF MAIN PROGRAM JSB DSCAD SET UP TRACK & SECTOR #'S FOR SETUP JSB LOAD LDB CNXID ADDRESS OF THE ID SEGMENT ADB .24 POINT TO LOW BASE PAGE ADDR LDA B,I STA TEMP3 CMA,INA INB POINT TO HIGH BASE PAGE ADDR + 1 ADA B,I # OF WORDS IN BASE PAGE STA TEMP SAVE FOR SETUP ROUTINE LDA PRMAR ADDRESS OF LAST TRIPLET JSB NXTAD FIND NEX@}þúT DISC ADDRESS LDA TEMP2 GET NEW SECTOR # SLA EVEN #? INA NO, THEN MAKE IT EVEN CPA SECT2 ALL SECTORS ON TRACK TRANSFERRED? RSS YES JMP SETSC NO ISZ TEMP1 INCREMENT TRACK ADDRESS CLA SET SECTOR ADDRESS TO 0 SETSC STA TEMP2 NEW SECTOR ADDRESS JSB LOAD DLD SAVPG RESTORE SAVED VALUES STA $USRS FOR USER PART'N START PAGE STB $ABDP AND BAD PAGE POINTER LDA MEMSZ PASS MEMORY SIZE TO $CNFX STA $PCHN LDA LSTLU PASS LIST DEVICE LU$# TO $CNFX STA $WRRD LDA ECHO STA $TRTB PASS ECHO FLAG TO $CNFX CLA,INA SET THE BASE PAGE FENCE ADA BPA2 LWA OF USER BASE PAGE LINKS IOR BIT10 LFA LDB CNXID GET PRIMARY ENTRY POINT FOR $CNFX ADB .7 LDB B,I UJP B,I ENABLE USER MAP AND JUMP TO $CNFX * * CNXID NOP .24 DEC 24 .21 DEC 21 #PGS NOP #NPGS NOP BIT10 OCT 2000 B63 OCT 63 $SMTB NOP THIS TABLE HOLDS CHUNKS OF SAM EXTENSION NOP THE FORMAT FOR EACH TWO WORD ENTRY IS: NOP WORD 1 - START PHYSICAL PAGE# OF A CHUNK NOP WORD 2 - # PAGES IN THIS CHUNK NOP NOP NOP NOP NOP NOP E$SMT DEF *-1 A$SMT DEF $SMTB AEQT4 DEF EQT4 * ABORT HLT 22B HALT SYSTEM JMP *-1 * HED EXIT CONFIGURATOR $EXIT LDA $GDPG MEMORY RE-CONFIGURATION WAS SSA,RSS MADE PERMANENT? JMP EXIT2 NO, RESET SYTEM MAP FOR SAM EXT LDA AEQT4 YES, MAKE EQT4 WORD ON BASE PAGE LDB $SAVE+4 CONTENTS JSB LOCTR JMP EXIT5 * EXIT2 LDA $SMTB+2 SYSTEM MAP NEEDS TO BE SZA,RSS RESET FOR SAM EXTENSION? JMP EXIT5 NO LDB A$SMT YES, POINTER TO $SMTB STB TEMP LDA $ENDS LOGICAL START PAGE OF SAM EXTENSION SM9ÕþúELP LDB TEMP,I PHYSICAL START PG OF A CHUNK OF SAM EXT SZB,RSS DEFINED? JMP EXIT5 NO, THEN DONE ADB BIT14 WRITE PROTECT SAM EXTENSION ISZ TEMP YES,POINT TO #PGS IN THIS CHUNK OF SAM EXT LDX TEMP,I COUNTER IN X REG XMS TRANSFER SEQUENTIALLY TO DMS REGISTERS LDB E$SMT POINTER TO END OF $SMTB CPB TEMP AT THE END OF THE TABLE? JMP EXIT5 YES, THEN DONE ISZ TEMP NO, THEN SET UP NEXT CHUNK OF SAM EXT JMP SMELP * EXIT5 LDB CNXID ID SEG ADDR OF $CNFX SZB,RSS PRESENT? JMP EXIT1 NO LDA COMMA YES, CHANGE NAME TO ,,,,, ADB .12 STA B,I INB STA B,I INB LDA B,I GET CONTENTS OF NAME 5 WORD AND B377 MASK LOWER BYTE STA B,I SAVE IT LDA COMMA AND B1774 MASK UPPER BYTE ADA B,I STA B,I RESTORE 5TH CHAR OF NAME * EXIT1 LDA SWREG GET THE SWITCH REGISTER SSA,RSS RECONFIGURATION WAS REQUESTED? JMP EXIT4 NO * LDA $SAVE,I GET THE EQT WORD 4 OF SYS CONSOLE EQT STA $SMTB SAVE THE WORD IN A TEMP LOCATION LDA $SAVE ADDRESS OF EQT WORD 4 OF SYS CONSOLE ADA N3 POINT TO EQT WORD 1 LDB .15 # OF WORDS IN EQT JSB DSKRD READ THE EQT FROM DISC * LDA $SMTB GET THE CONTENTS OF EQT 4 SAVED STA $SAVE,I RESTORE IN EQT 4 WORD AND B77 GET SC FOR SYS CONSOLE STA $SMTB SAVE SELECT CODE FOR SYS CONSOLE ADA INTBA INDEX INTO THE INTERRUPT TABLE ADA N6 STA $SMTB+1 SAVE POINTER INTO INTERRUPT TABLE FOR SYS CONSOLE LDA $SAVE ADDRESS OF EQT WORD 4 ADA .8 POINT TO EQT EXTENSION SIZE WORD LDB A,I GET THE EQT EXTENSION SIZE WORD SZB,RSS EQT EXTENSION DEFINED? JMP EXIT8 NO * INA YES, POINT TO EQT EXTENSION ADDRDJþúESS LDA A,I JSB DSKRD READ EQT EXTENSION FROM THE DISC * EXIT8 LDA CTRCL GET SAVED CONTENTS OF TRAP CELL LDB CINTB AND INTERRUPT TABLE FOR SYS CONSOLE STA $SMTB,I RESTORE TRAP CELL AND INTERRUPT TABLE STB $SMTB+1,I ENTRIES WITH ORIGINAL CONTENTS * EXIT4 LDA $SAVE RESTORE THE SAVED BASE PAGE ADA N3 POINT TO START OF CONSOLE EQT STA SYSTY DLD $SAVE+1 EQT1 AND EQT2 DST EQT1 DLD $SAVE+3 EQT3 & EQT4 DST EQT3 DLD $SAVE+12 EQT5 & EQT6 DST EQT5 CLA STA EQT7 STA EQT8 STA EQT9 STA EQT10 STA EQT11 STA EQT12 * * SET ORIGINAL SAM DESCRIPTOR BLOCK * SOSAM DLD DEQT1,I GET NEXT BLOCK OF SAM SZA,RSS JMP EXIT3 NONE THEN FINISHED SWP $OSAM IS WORDS/ADDRESS DST OSAM,I ADB A SEE IF NEXT BLOCK IS ISZ DEQT1 CONTIGUOUS ISZ DEQT1 CPB DEQT1,I RSS JMP SOSM1 ISZ DEQT1 THEN COMPUTE TOTAL BLOCK SIZE ADA DEQT1,I STA OSAM,I AND STUFF ISZ DEQT1 SOSM1 ISZ OSAM ISZ OSAM JMP SOSAM * EXIT3 LDA $SAVE+5 DUMMY STA DUMMY LDA $SAVE+6 SKEDD STA SKEDD LDA $SAVE+7 STA $LIST LDA $SAVE+11 TRAP CELL CONTENTS FOR POWER FAIL STA .4,I RESTORE TRAP CELL 4 JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S * * JMP $CNFG,I RETURN CONTROL TO THE OP SYSTEM * BIT14 OCT 40000 COMMA ASC 1,,, DEQT1 DEF EQT1 OSAM DEF $OSAM+0 HED SUBROUTINES FOR I/O RECONFIGURATION * * * INENT - THIS PROCEDURE IS PERFORMED FOR EVERY OLD AND * NEW SELECT CODEL PAIRS. APPROPRIATE INTERRUPT TABLE * AND TRAP CELL VALUES ARE INSERTED INTO INTBL AND TRPCL * OLDSC AND EQT WORD 4 ADDRESS ARE INSERTED INTO ENTRIES * IN OLSCT AND EQTBL * * JNENT - ENTRY POINT IS USED FOR DISC , CONSOLE AND LIST * w\þú DEVICE SC CONFIGURATION * * CALLING SEQUENCE: JSB INENT * OLD AND NEW SELECT CODE VALUES ARE ASSUMED * TO BE IN OLDSC AND NEWSC RESP. * RETURN: P FOR ERROR RETURN IF OLDSC WAS ASSIGNED TO * OR NEWSC IS SC NEWSC FOR DISC,CONSOLE OR LIST DEV * SAME AS DISC , CONSOLE OR LIST DEVICE SC * * INENT NOP CLA CLEAR FLAG TO ALLOW CHECKS FOR STA JNENT OLD SC AGAINST CURNT ENTRIES LDA B10 START SC # STA TEMP3 SAVE IT LDB AOLSC ADDRESS OF OLD SC TABLE OLDSL LDA B,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPA OLDSC OLDSC ALREADY ASSIGNED? RSS YES JMP ENSCL NO LDA TEMP3 SC # TO WHICH OLDSC WAS ASSIGNED JSB CHKSC NEWSC FOR DISC,CONSOLE OR LIST DEV? JMP INENT,I YES, ERROR RETURN LDA NEWSC NEW SC # IS DISC ,CONSOLE OR LIST DEV? JSB CHKSC JMP INENT,I YES, ERROR RETURN LDA TEMP3 TEMP3 IS SC TO WHICH OLDSC WAS ASSIGNED ADA NB10 LDB AINTB ADB A POINT INTO INTBL FOR TEMP3 ENTRY STB TEMP1 SAVE THIS ADDRESS LDB ATRPC ADB A POINT INTO TRPCL TABLE FOR TEMP3 ENTRY STB TEMP2 SAVE IT LDA .N56 COUNTER FOR OLD SC TABLE STA TEMP4 LDB AOLSC START OF OLDSC TABLE OLDS2 LDA B,I INB CPA TEMP3 HAS SC TO WHICH OLD SC WAS ASSIGNED JMP ASGND BEEN ASSIGNED TO ANOTHER SC ISZ TEMP4 NO JMP OLDS2 CCA CCB JMP INEN2 ASGND CLA YES, THEN CLEAR INTBL ENTRY LDB JSBCI AND JSB CIC,I IN THIS SC'S ENTRIES INEN2 STA TEMP1,I SET UP INTBL AND TRPCL ENTRIES FOR PREV SC STB TEMP2,I LDA TEMP3 POINT INTO OLD SC TABLE FOR ADA NB10 PREV ENTRY STA TEMP2 SAVE IT ADA AOLSC CCB STB A,I ERASE IT LDA AEQTB ERAS…]þúE ENTRY IN EQTBL ADA TEMP2 STB A,I LDA TBGSV CPA TEMP3 WAS IT A TBG? STA TBG YES, RESET TBG LDA PRVSV PRIV I/O? CPA TEMP3 WAS IT A PRIV I/O? STA $SAVE+5 YES, RESET PRIV I/O CARD JMP INEN5 CONTINUE I/O CONFIGURATION * ENSCL ISZ TEMP3 LDA TEMP3 CPA B77 ALL OLDSC TABLE ENTRIES LOOKED AT? JMP INEN3 YES INB NO JMP OLDSL * INEN3 LDA NEWSC JSB CHKSC NEW SC # THAT OF DISC,CONSOLE OR LISTDEV? JMP INENT,I ERROR JMP INEN5 * JNENT NOP ENTRY POINT FOR DISC,CONSOLE AND LIST DEVICE LDA JNENT STA INENT INEN5 CLB LDA NEWSC NEW SELECT CODE # CPA TBG IS NEW SELECT CODE TBG CHANNEL? STB TBG YES CPA $SAVE+5 IS NEW SELECT CODE PRV CHANNEL? STB $SAVE+5 YES, CLEAR IT LDB OLDSC OLD SELECT CODE # CPB TBGSV IS THE OLD SELECT CODE TBG CHANNEL? STA TBG YES, THEN RESET TBG CHANNEL CPB PRVSV IS THE OLD SELECT CODE PRIV I/O CHANNEL? RSS YES JMP INEN7 NO SZA,RSS IS NEW SELECT CODE 0? STB NEWSC YES, SET NEW SELECT CODE TO OLDSC STA $SAVE+5 * INEN7 LDB NEWSC GET NEW SELECT CODE VALUE ADB NB10 PREPARE TO INDEX INTO INTBL AND TRPCL STB TEMP1 LDA AINTB ADDRESS OF INTBL PGSRM ADA B POINT TO NEWSC ENTRY IN INTBL STA TEMP2 SAVE IT LDA ATRPC ADA B POINT TO NEWSC ENTRY IN TRPCL STA TEMP3 SAVE POINTER $USRS LDA N4 IS OLDSC ENTRY MADE IN SVTBL? ENDSM STA TEMP TEMP IS COUNTER LDA ASVTB ADDRESS OF SVTBL SVLP LDB A,I GET VALUE CPB OLDSC OLD SELECT CODE? JMP SVTBE YES ADA .4 NO, LOOK AT NEXT ENTRY ISZ TEMP JMP SVLP * OLD SELECT CODE ENTRY IS NOT IN SVTBL * NEWEN LDA JNENT GET FLAGºÇþú, CHECK IF CONFIGURING SZA SYSTEM CONSOLE, DISC OR LIST DEV JMP GTTRP YES, SKIP CHECK AGAINST CURNT ENTRIES LDA OLDSC IS OLDSC SAME AS SC FOR DISC, SYS JSB CHKSC CONSOLE OR LIST DEV CURRENT SC? JMP INENT,I YES, ERROR RETURN * GTTRP LDA OLDSC,I GET TRAP CELL ENTRY FOR OLDSC STA TEMP3,I STORE OLDSC VALUE IN NEWSC ENTRY IN TRPCL LDA INTBA INTERRUPT TABLE ENTRY FOR OLDSC ADA N6 ADA OLDSC LDA A,I STA TEMP2,I STORE OLDSC VALUE IN NEWSC ENTRY IN INTBL LDA OLDSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR OLDSC STEQT LDA AEQTB ADA TEMP1 POINTER INTO EQTBL FOR NEWSC ENTRY STB A,I STORE EQT ADDRESS IN EQTBL ENTOL LDA AOLSC ADA TEMP1 POINT TO OLDSC TABLE ENTRY FOR NEWSC CAX SAVE THIS ADDRESS JSB PRVOL RESTORE PREV OLD SC IF NECESSARY CXA RESTORE ADDRESS INTO AOLSC LDB OLDSC GET OLDSC VALUE STB A,I STORE IT * OLDEN LDB OLDSC OLD SELECT CODE ENTRY ADB NB10 LDA AINTB GET VALUE OF OLDSC IN INTBL ADA B STA TEMP2 SAVE ADDRESS LDA A,I CPA N1 HAS IT BEEN ASSIGNED A VALUE SO FAR? RSS NO JMP RINEN YES,RETURN CLA CLEAR INTBL ENTRY FOR OLDSC STA TEMP2,I LDA ATRPC ADDRESS OF TRPCL ADA B POINT TO OLDSC ENTRY IN TRPCL LDB JSBCI ENTER JSB CIC,I FOR OLD SC STB A,I IN TRPCL JMP RINEN RETURN * OLD SC ENTRY IS IN SVTBL SVTBE INA LDB A,I STB TEMP3,I NEWSC ENTRY IN TRPCL INA LDB A,I STB TEMP2,I NEWSC ENTRY IN INTBL INA LDB A,I EQT PRESENT FOR THIS SC? SSB JMP ENTOL NO JMP STEQT YES, THEN SET EQT ADDRESS * RINEN ISZ INENT GOOD RETURN JMP INENT,I * NB10 OCT -10 .N56 DEC -56 * * * CHKSC -(qþú ROUTINE TO CHECK IF GIVEN SC IS SAME AS SC CURRENTLY * USED FOR DISC, CONSOLE OR LIST DEVICE * CALLING SEQUENCE: A REG = SC# * JSB CHKSC * RETURN: P IF SC# MATCHES NEW SC FOR ABOVE * P+1 OTHERWISE * * CHKSC NOP STA EQTFN SAVE LDA N4 COUNTER FOR CURNT STA PRVOL SAVE IT LDB ACURN ADDRESS OF CURNT CHKLP LDA B,I GET A SC # CPA EQTFN MATCHES? JMP CHKSC,I YES INB POINT TO NEXT ENTRY IN CURNT ISZ PRVOL ALL ENTRIES CHECKED? JMP CHKLP NO * ISZ CHKSC JMP CHKSC,I RETURN TO P+1 * ACURN DEF CURNT * * * EQTFN - THIS ROUTINE FINDS ADDRESS OF WORD 4 OF * EQT BELONGING TO SELECT CODE VALUE IN OLDSC * EQT # - 1 IS ALSO RETURNED * * CALLING SEQUENCE: A REG = SC # * JSB EQTFN * RETURNS: B REG = ADDR OF EQT WORD 4 IF EQT PRESENT * = -1 IF EQT NOT FOUND * TEMP5 = EQT # - 1 (VALID ONLY IF EQT FOUND) * * EQTFN NOP STA TEMP6 CLA STA TEMP5 COUNTER TO FIND THE RIGHT EQT LDB EQTA ADDRESS OF EQT ADB .3 POINT TO WORD 4 OF EQT LPEQT LDA B,I GET CONTENTS OF WORD 4 AND B77 MASK SELECT CODE # CPA TEMP6 IS IT SAME AS OLDSC JMP EQTFN,I YES, THEN RETURN ISZ TEMP5 NO LDA TEMP5 CPA EQT# ALL EQT'S LOOKED AT? JMP EXEQT YES ADB .15 NO,POINT TO WORD 4 OF NEXT EQT JMP LPEQT * EXEQT CCB EQT NOT FOUND JMP EQTFN,I RETURN * * * PRVOL - ROUTINE CHECKS IF THIS NEWSC WAS ASSIGNED * A SELECT CODE PREVIOUSLY. IF SO, CHECK IF THIS * PREVIOUS SELECT CODE WAS ASSIGNED A NEW VALUE * IF NO VALUE WAS ASSIGNED DO NOT DESTROY ITS ORIGINAL * VALUE * FOR EG. 12,10 * 13,10 * THEN 12 SHOULD NOT BE DESTROYED pþú* * CALLING SEQUENCE: A REG = POINTER INTO OLSCT FOR NEWSC ENTRY * JSB PRVOL * * PRVOL NOP LDB A,I WAS NEWSC PREVIOUSLY ASSIGNED ANOTHER SC? CPB N1 JMP PRVOL,I NO, THEN RETURN ADB NB10 YES CBY ADB AOLSC LDA B,I CPA N1 DOES IT HAVE AN ASSIGNMENT MADE? RSS NO JMP PRVOL,I YES CYB NO, THEN CHANGE ITS TRPCL AND INTBL ADB ATRPC ENTRIES TO -1 STA B,I CYB ADB AINTB STA B,I CYB ADB AOLSC -1 IN OLDSC ENTRY STA B,I CYB ADB AEQTB -1 IN EQTBL ENTRY STA B,I JMP PRVOL,I RETURN * * * RSENT - ROUTINE TO MAKE ENTRIES IN RSTBL, * THE RESTORE TABLE USED TO SAVE TRPCL,INTBL,EQTBL VALUES * FOR OLD SC AND NEW SC OF DISC, CONSOLE AND LIST DEVICE * FORMAT OF RSTBL IS : ENTRIES FOR DISC SC # 1 * " " " " # 2 * " " CONSOLE * " " LIST DEVICE * * EACH SET OF ENTRIES IS 6 WORDS LONG AS FOLLOWS: * WORD 1 - OLD SC# * WORD 2 - INTBL VALUE FOR OLDSC * WORD 3 - TRPCL VALUE FOR OLDSC * WORD 4 - INTBL VALUE FOR NEWSC * WORD 5 - TRPCL VALUE FOR NEWSC * WORD 6 - EQT WORD 4 ADDRESS FOR NEWSC * * CALLING SEQUENCE: A REG = POINTER INTO RSTBL FOR ENTRIES * JSB RSENT * NOTE: RSENT ASSUMES OLDSC AND NEWSC CONTAIN VALUES * FOR OLD AND NEW SELECT CODES RESPECTIVELY * * RSENT NOP STA TEMP SAVE POINTER INTO RSTBL LDA OLDSC OLD SELECT CODE VALUE STA TEMP,I STORE IT IN RSTBL JSB SVRST STORE OLD SC'S INTBL & TRPCL ENTRIES LDA NEWSC NEW SELECT CODE VALUE JSB SVRST STORE NEW SC'S INTBL & TRPCL ENTRIES ISZ TEMP POINT TO WORD 6 LDA AEQTB ADDRESS OF EQTBL ADA NB10 POINT TO ENTRY FOR NEWSC ADA NEWSC Âþú LDA A,I GET EQT WORD 4 ADDRESS STA TEMP,I MAKE ENTRY IN RSTBL JMP RSENT,I RETURN * * * SVRST - ROUTINE TO STORE INTBL AND TRPCL VALUES * OF A GIVEN SELECT CODE INTO RSTBL * CALLING SEQUENCE: A REG = SELECT CODE VALUE * JSB SVRST * NOTE: TEMP IS ASSUMED TO BE POINTING AT ENTRY * PREVIOUS TO THE ONE TO BE MADE BY SVRST * * SVRST NOP ISZ TEMP POINT TO RSTBL ADA NB10 INDEX INTO INTBL STA B ADA AINTB LDA A,I GET VALUE FOR INTBL ENTRY STA TEMP,I STORE IT IN RSTBL ISZ TEMP ADB ATRPC INDEX INTO TRPCL LDA B,I GET VALUE STA TEMP,I STORE VALUE IN RSTBL JMP SVRST,I RETURN * * * RESTR - ROUTINE TO RESTORE INTBL AND TRPCL VALUES * FOR A GIVEN SELECT CODE THAT WERE SAVED IN RSTBL * CALLING SEQUENCE: B REG = SELECT CODE# - 10B (INDEX * VALUE TO BE USED IN INTBL & TRPCL) * JSB RESTR * * RESTR NOP STB TEMP1 SAVE INDEX VALUE ADB AINTB POINTER INTO INTBL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL LDA TEMP,I VALUE OF INTBL ENTRY STA B,I RESTORE IT IN INTBL LDB TEMP1 ADB ATRPC POINTER INTO TRPCL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL LDA TEMP,I VALUE OF TRPCL ENTRY STA B,I RESTORE IT IN TRPCL JMP RESTR,I RETURN * * * IPROC - THIS ROUTINE TRANSFERS A SELECT CODE'S VALUES * FROM INTBL AND TRPCL INTO INTERRUPT TABLE AND TRAP CELL * AND CHANGES SELECT CODE # IN EQT IF NECESSARY * * CALLING SEQUENCE: JSB IPROC * A REG = SELECT CODE # * * IPROC NOP STA TEMP ADA NB10 STA TEMP1 SAVE VALUE ADA AINTB POINT TO SC ENTRY IN INTBL LDB A,I CPB N1 GIVEN A VALUE? JMP IPROC,I NO, THEN RETURN * LDA INTBA ADDRESS OF INTERRUPT TABLE ADA mñþúN6 ADA TEMP POINT TO SC ENTRY IN INTERRUPT TABLE STB A,I STORE INTBL VALUE IN INTERRUPT TABLE LDA ATRPC ADDRESS OF TRPCL ADA TEMP1 POINT TO SC ENTRY IN TRPCL LDA A,I STA TEMP,I STORE IT IN TRAP CELL LDA AEQTB ADA TEMP1 LDB A,I GET EQTBL ENTRY FOR THIS SC SSB DEFINED? JMP IPRC5 NO,CLEAR EXISTING EQT ENTRIES FOR NEWSC LDA B,I YES, GET CONTENTS OF EQT WORD 4 AND B77 MASK OLD SELECT CODE # CPA TEMP OLDSC = NEWSC? JMP IPROC,I YES, NO NEED TO CHANGE SC'S STA OLDSC NO, SAVE THIS OLDSC VALUE LDA EQT# # OF EQT'S DEFINED CMA,INA STA TEMP5 USE AS COUNTER LDB EQTA ADDRESS OF START OF EQT TABLES ADB .3 POINT TO WORD 4 LEQT# CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENEQL YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENEQL CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENEQL YES LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET OLD SC# CPA OLDSC MATCHES ONE WE ARE LOOKING FOR? RSS YES JMP ENEQL NO, LOOK AT NEXT EQT LDA N3 POINT TO FIRST WORD OF THIS EQT ADA B STA TEMP4 SAVE ADDRESS OF THIS EQT LDA A,I GET CONTENTS OF THE FIRST WORD CPA N1 PREVIOUSLY CHANGED ? JMP ENEQL YES CCA NO,CHANGE TO NEWSC AND SET FLAG STA TEMP4,I TO INDICATE THIS LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B1777 CLEAR BITS FOR SC IOR TEMP INSERT NEW SC STA B,I RESTORE EQT WORD 4 ENEQL ADB .15 POINT TO NEXT EQT'S WORD 4 ISZ TEMP5 INCREMENT COUNTER JMP LEQT# DO NEXT ONE * IPRC5 LDA NOCLR FLAG SET TO SKIP THIS? SSA JMP IPROC,I YES, THEN RETURN JMP IPRC7  šþú JPROC NOP ENTRY POINT FOR CONSOLE AND LIST SC STA TEMP LDA JPROC SET UP RETURN ADDRESS STA IPROC IPRC7 LDA AOLSC START OF OLDSC TABLE LDB .N56 USE AS COUNTER STB TEMP5 OLSLP LDB A,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPB TEMP SAME AS NEW SELECT CODE? JMP IPROC,I YES, RETURN INA NO, LOOK FURTHER ISZ TEMP5 JMP OLSLP LDA EQT# NEW SC IS NOT ASSIGNED TO ANY OTHER SC# CMA,INA THEN CLEAR OUT NEW SC # FROM OLD EQT'S STA TEMP5 LDB EQTA IPRLP LDA B,I GET FIRST WORD OF EQT SSA -1? JMP ENIPR YES, THEN NEW SC IN IT ADB .3 NO CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENIPR YES, LOOK FOR NEXT EQT LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET SC # CPA TEMP IS THIS SAME AS NEW SC#? RSS YES JMP ENIPR NO, LOOK AT NEXT EQT LDA B,I YES AND B1777 THEN CLEAR SC# STA B,I RESTORE EQT WORD 4 ENIPR ADB .12 POINT TO NEXT EQT ISZ TEMP5 MORE EQT'S LEFT? JMP IPRLP YES JMP IPROC,I NO, RETURN * * * TSTCH - ROUTINE TO TEST THE VALIDITY OF A SELECT CODE# * CALLING SEQUENCE: JSB TSTCH * B REG = POINTER TO PARSE BUFFER * CONTAINING THE 4 WORD SET FOR SELECT CODE# * TO BE TESTED * * RETURN : LOC P IF AN ERROR RETURN * LOC P+1 IF NORMAL RETURN * * TSTCH NOP STB TEMP4 POINTER TO PARSE BUFFER INB STB TEMP5 LDA B,I GET VALUE CLB DIV .10 CONVERT VALUE TO OCTAL ALS CMA,INA ADA TEMP5,I STA TEMP5, þúI RESTORE VALUE LDB TEMP4 GET POINTER TO PARSE BUFFER LDA B10 10 OCTAL IS LOWER LIMIT JSB TST# TEST THE SELECT CODE # B77 OCT 77 UPPER LIMIT FOR SELECT CODE # JMP CHNLE ERROR ISZ TSTCH VALID SELECT CODE # JMP TSTCH,I NORMAL RETURN TO P+1 LOC * CHNLE LDA A2 JSB ERROR DISPLAY ERROR MESSAGE JMP TSTCH,I * .10 DEC 10 * * * * TST# - ROUTINE TO TEST VALIDITY OF A GIVEN # * CALLING SEQUENCE: A REG=LOWER LIMIT OF RANGE FOR # * B REG=POINTER TO 4 SET OF WORDS * FOR # IN PARSE BUFFER * JSB TST# * DEC(OR OCT) UPRLM UPPER LIMIT * RETURN: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * NUMBER IS IN THE A REG * * TST# NOP CBX SAVE CONTENTS OF B REG LDB B,I TYPE OF VALUE CPB .1 NUMERIC? RSS YES JMP TSTE NO THEN ERROR RETURN CXB RETRIEVE VALUE OF B REG INB LDB B,I GET VALUE CMA,INA -VE OF LOWER LIMIT ADA B VALUE-LOWER LIMIT SSA LOW LIMIT > VALUE? JMP TSTE YES, ERROR RETURN LDA B CMA,INA ADA TST#,I UPPER LIMIT-VALUE SSA VALUE > UPPER LIMIT? JMP TSTE YES, ERROR LDA B ISZ TST# NORMAL RETURN TSTE ISZ TST# JMP TST#,I RETURN * * * SVENT - ROUTINE TO MAKE ENTRY IN SVTBL * SVTBL HAS ENTRIES FOR TWO DISC SELECT CODES, * CONSOLE AND LIST DEVICE SELECT CODES IN THAT ORDER * EACH ENTRY IN SVTBL IS 4 WORDS LONG AND * CONTAINS THE FOLLOWING: * WORD 1 - NEW SC # * WORD 2 - ORIGINAL TRAP CELL CONTENTS OF NEW SC * WORD 3 - ORIGINAL INTERRUPT TABLE CONTENTS OF NEW SC * WORD 4 - ORIGINAL EQT WORD 4 ADDRESS OF NEW SC * * CALLING SEQ]þúUENCE: A REG = POINTER TO ENTRY IN SVTBL * JSB SVTBL * ASSUME: NEWSC HAS VALUE OF SC FOR SVTBL ENTRY * * SVENT NOP LDB NEWSC NEW SELECT CODE # STB A,I ENTER IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB NEWSC,I VALUE OF NEWSC'S TRAP CELL STB A,I SAVE IT IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB INTBA ADDRESS OF INTERRUPT TABLE ADB N6 ADB NEWSC POINTER TO NEWSC ENTRY IN LDB B,I INTERRUPT TABLE STB A,I STORE INTRPT TABLE VALUE IN SVTBL INA POINT TO NEXT ENTRY STA TEMP SAVE IT LDA NEWSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR THIS SC STB TEMP,I STORE IT IN SVTBL JMP SVENT,I RETURN * * * EQTCN - INSERT NEW SC IN EQT, FIND OLD SC # AND * UNBUFFER DEVICE IF BUFFERED * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQTCN * RETURN: TEMP2=0 IF DEVICE NOT BUFFERED * 1 OTHERWISE * EQTCN NOP JSB EQUNB UNBUFFER EQT IF BUFFERED BIT SET LDA B,I VALUE OF EQT WORD 4 AND B77 MASK SELECT CODE STA OLDSC SAVE IT LDA B,I AND B1777 CLEAR LOW 6 BITS ADA NEWSC ADD NEW SELECT CODE STA B,I RESTORE WORD 5 JMP EQTCN,I RETURN * * * EQUNB - ROUTINE TO UNBUFFER EQT WORD 4 IF THE B BIT WAS SET * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQUNB * RETURNS: TEMP2 = 0 IF EQT BUFFER STATUS WAS NOT CHANGED * = 1 IF EQT BUFFER STATUS WAS CHANGED * NOTE: B REG IS UNCHANGED * * EQUNB NOP CLA STA TEMP2 LDA B,I CONTENTS OF WORD 4 OF EQT RAL,RAL CLE,SLA BUFFERED? - BIT 14 SET? ISZ TEMP2 YES, THEN TEMP2 IS SET ERA,RAR CLEAR BIT 14 IF SET STA B,I RESTORE EQT WORD 4 JMP EQUNµ+þúB,I RETURN * * * BUFFR - ROUTINE RESTORES THE STATUS OF CONSOLE * AND LIST DEVICE EQT'S TO BUFFERED IF THEY WERE ORIGINALLY * BUFFERED * CALLING SEQUENCE: JSB BUFFR * * BUFFR NOP LDA $SAVE+9 WAS CONSOLE EQT BUFFERED? SZA,RSS JMP LSBUF NO LDA $SAVE,I YES, GET CONTENS OF WORD 4 OF CONSOLE EQT STA PRTMP SAVE IT TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE,I RESTORE EQT WORD 4 LSBUF LDA $SAVE+10 LIST DEVICE EQT WAS BUFFERED? SZA,RSS JMP BUFFR,I NO, THEN RETURN LDA $SAVE+8,I YES, GET CONTENTS OF WORD 4 OF LIST DEV EQT STA PRTMP+1 SAVE EQT WORD 4 CONTENTS TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE+8,I RESTORE EQT WORD 4 CONTENTS JMP BUFFR,I RETURN * * * SETM - ROUTINE SETS MEMORY LOCATIONS TO GIVEN VALUE * CALLING SEQUENCE: A REG= VALUE * B REG = # OF LOCATIONS TO BE CHANGED * JSB SETM * DEF LOC STARTING LOCATION * SETM NOP CAX SAVE VALUE OF A REG IN X LDA SETM,I STARTING LOCATION STA TEMP ADDRESS OF LOC ISZ SETM CMB,INB -VE COUNT CXA VALUE IN A SETLP STA TEMP,I STORE VALUE INB,SZB,RSS INCREMENT COUNTER JMP SETM,I RETURN ISZ TEMP POINT TO NEXT MEM LOC JMP SETLP HED SUBROUTINES TO LOAD DATA FROM DISC TO MEMORY * * * DSCAD - ROUTINE TO SEPARATE DISC ADDRESS INTO * TRACK AND SECTOR # * CALLING SEQUENCE: A REG = DISC ADDR BITS 0-6 SECTOR * 7-15 TRACK * JSB DSCAD * RETURNS: TEMP1 IS TRACK #, TEMP2 IS SECTOR # * * DSCAD NOP CLB LSL 9 TRACK # IN B REG STB TEMP1 SAVE IT ALF,ALF SECTOR# RAR STA TEMP2 SAVE IT JMP DSCAD,I RETURN * * * LOAD - S½þúROUTINE TO LOAD DATA FROM DISC INTO MEMORY * CALLING SEQUENCE : JSB LOAD * * LOAD NOP JSB SETUP SET UP TRIPLETS STA PRMAR ADDRESS OF START OF TRIPLETS JSB $XSIO MAKE SYSTEM I/O REQUEST .2 OCT 2 LU# DEF CLOAD COMPLETION ROUTINE ADDRESS NOP FOR SYSTEM USE OCT 1 PRMAR NOP ARRAY ADDRESS DEC 0 BIT15 OCT 100000 LEAVE USER MAP AS IS JMP $XCQ WAIT FOR I/O TO COMPLETE CLOAD JMP LOAD,I RETURN * * * SETUP - THIS ROUTINE IS TAKEN FROM THE DISPATCHER * IT GENERATES PARAMETERS FOR DISC CALL GUARANTEEING * THAT ALL TRACK CROSSING CALLS ARE BROKEN DOWN INTO * SUB-CALLS SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * THE CALLS ARE BROKEN UP IN TRIPLETS OF * STARTING MEMORY ADDRESS * NUMBER OF WORDS TO TRANSFER * TRACK/SECTOR ADDRESS * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING LAST TRIPLET * CALLING SEQUENCE: * NOTE: THE TABLE OF TRIPLETS IS BUILT BOTTOM-UP. * THE CONTENTS OF LAST WORD OF TABLE MUST BE 0 - THIS WORD'S * ADDRESS IS ASSUMED TO BE APRMT * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * RETURNS : ADDRESS OF START OF TRIPLETS IN PRMAR * * SETUP NOP CLA END OF PRMTBL MARKED BY 0 STA PRMTB LDA APRMT ADDRESS OF END OF PARM TABLE LDB TEMP COMPUTE # OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA N3 SET UP TRIPLET STA PRMAR ADDRESS ADB B177 ROUND UP NUMBER OF SECTORS ASR 7 BLS STB TEMP5 SAVE # OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B LDB SECT2 # OF SECOTRS ON SYSTEM DISC CMB,INB ADA B SUBTRACT # OF SECTORS/TRACK LDB TEMP3 STARTING MEMORY ADDRESS STB PRMAR,I STORE IT IN MEMORY ISZ PRMAR INCREMENT ARÀEþúRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES,USE REST OF TRACK IF OVER ASL 6 UPSET LDB TEMP1 FORM TRACK BLF,RBL AND RBL,RBL SECTOR ADDRESS ADB TEMP2 DST PRMAR,I STORE LAST 2 WORDS OF TRIPLET ADA TEMP3 UPDATE STARTING ADDRESS STA TEMP3 LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB PRMAR,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUBTRACT 1 FOR CORRECT NEXT TRIPLET ADA PRMAR ADDRESS CALCULATION JMP SETU1 GO TO NEXT LOOP * SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET * HED READ AND WRITE MESSAGES TO THE SYSTEM CONSOLE * * ERROR - ROUTINE PRINTS ERROR MESSAGE * CALLING SEQUENCE: A REG = ERROR# IN ASCII * JSB ERROR * ERROR NOP STA ERR00+6 LDB .7 LENGTH OF BUFFER JSB WRTTY DISPLAY ON CONSOLE DEF ERR00 JMP ERROR,I RETURN * ERR00 ASC 7,CONFIG ERR * * * $WRRD- ROUTINE TO PERFORM I/O USING THE SYSTEM * I/O ROUTINE $XSIO * CALLING SEQUENCE: A REG = REQUEST CODE * B REG = BUF LNGTH OR * PRIORITY CODE IF DISC I/O * BIT 15 OF BREG SET IF CALLING FROM USER MAP * Y REG = LU # * 1 IF BUFFER IN USER MAP * JSB $WRRD * DEF BUFAD ADDRESS OF BUFFER * NOTE: SEE WRITE-UP ON $XSIO ROUTINE FOR FURTHER INFO * * $WRRD NOP STA REQCD REQUEST CODE STB TEMP SSB,RSS BIT Ç[þú15 SET? JMP WRRD5 NO ELB,CLE,ERB CALLING FROM SUER MAP - CLEAR SIGN BIT STB BUFLN SET UP BUFFER LENGTH XLA $WRRD,I GET ADDRESS OF BUFFER IN USER AREA STA TEMP5 SAVE ADDRESS OF BUFFER IN USER MAP LDA ARDBF USE RDBUF TO MOVE USER BUFFER INTO STA BUFAD IT IS ALSO THE BUFFER ADDRESS LDA REQCD GET REQEST CODE SLA IS IT FOR WRITE? JMP WRRD7 NO, IT IS A READ REQUEST CBX BUFFER LENGTH IN X REG FOR MOVE LDB ARDBF DESTINATION BUFFER ADDRESS LDA TEMP5 SOURCE ADDRESS MWF MOVE WORDS FROM USER MAP INTO SYSTEM MAP JMP WRRD7 CONTINUE WITH I/O REQUEST WRRD5 LDA $WRRD,I GET VALUE OF BUFFER LNGTH DST BUFAD STORE BUFFER ADDRESS & LENGTH WRRD7 CYA RETRIVE Y REG STA LU# JSB $XSIO LU# NOP DEVICE LU# DEF CWRRD COMPLETION RETURN ADDRESS NOP FOR SYS USE REQCD NOP REQUEST CODE BUFAD NOP BUFFER ADDRESS BUFLN NOP BUFFER LENGTH DEC 0 MAP WORD=0 SINCE BUFFER ALWAYS IN SYS MAP JMP $XCQ WAIT FOR I/O COMPLETION CWRRD ISZ $WRRD COMPLETION RETRUN LDA TEMP SSA,RSS CALLING FROM SYSTEM MAP? JMP $WRRD,I YES, RETURN LDA REQCD GET REQUEST CODE SLA,RSS READ REQUEST? JMP RWRRD NO, THEN RETURN STB TEMP YES, THEN SAVE TRANSMISSION LOG CBX #OF WORDS READ LDA ARDBF ADDRESS OF READ BUFFER LDB TEMP5 ADDRESS OF DEST BUFFER IN USER MAP MWI MOVE WORDS INTO USER MAP LDB TEMP TRANSMISSION LOG RESTORED IN B REG RWRRD UJP $WRRD,I ENABLE USER MAP AND RETURN * * * QUERY - ROUTINE TO DISPLAY QUESTION ON CONSOLE AND * READ RESPONSE ANDS PARSE IT * * WRTTY - EMBEDDED IN QUERY, DISPLAYS MESSAGE ON CONSOLE * * CALLING SEQUENCE: B REG = # OF WORDS IN BUFFER TO DIžþúSPLAY * JSB QUERY(WRTTY) * DEF BUFR MESSAGE TO BE DISPLAYED * QUERY NOP CCA SET FLAG TO INDICATE QUERY ROUTINE JMP CONTQ CONTINUE WRTTY NOP LDA WRTTY STA QUERY CLA CLEAR FLAG TO INDICATE CONSOLE WRITE ROUTINE CONTQ STA WFLAG SET FLAG TO -1 LDA QUERY,I STA QBUFR CLA,INA LU # 1 CAY IN Y REG INA REQ CODE IS 2 FOR WRITE JSB $WRRD QBUFR NOP ISZ WFLAG WRTTY ROUTINE? JMP RQUER YES, RETURN * * READ RESPONSE JSB $XSIO .1 OCT 1 CONSOLE LU DEF CREAD COMPLETION ROUTINE ADDRESS NOP OCT 401 REQUEST CODE ARDBF DEF RDBUF READ BUFFER .80 DEC 80 80 WORDS NOP SYSTEM MAP JMP $XCQ WAIT FOR I/O COMPLETION CREAD LDA ARDBF ADDRESS OF READ BUFFER BLS CONVERT WORD COUNT TO CHAR. COUNT JSB $PRSE SYSTEM ROUTINE TO PARSE APRSB DEF PRSBF PARSE BUFFER RQUER ISZ QUERY JMP QUERY,I RETURN * * * WRLST - ROUTINE TO WRITE BUFFER ON LIST DEVICE AND * THE SYS CONSOLE IF ECHO IS REQUESTED * * CALLING SEQUENCE: B REG = BUFFER LENGTH * BIT 15 OF B REG SET IF CALLING FROM USER MAP * JSB WRLST * DEF BUFR BUFFER ADDRESS * * NOTE: IT IS ASSUMED THAT IF CALLING FROM USER MAP, * THE BUFFER IS ALSO IN THE USER MAP * WRLST NOP STB TEMP4 LDA WRLST,I BUFFER ADDRESS FROM SYSTEM MAP STA CNBF STA LSBF LDA ECHO ECHO REQUIRED? SZA JMP NECHO NO ECHO JSB WRTTY WRITE ON CONSOLE CNBF NOP * NECHO LDA LSTLU LIST LU CAY LU # IN Y REG LDB TEMP4 BUFFER ADDRESS LDA B202 REQUEST CODE,CONTROL INFO JSB $WRRD LSBF NOP ISZ WRLST POINT TO RETURN ADDRESÕGþúS JMP WRLST,I RETURN * B202 OCT 202 * * * PRNIO - THIS ROUTINE PRINTS I/O CONFIGURATION OF THE SYSTEM * THE FORMAT IS: * CALLING SEQUENCE : JSB PRNIO * * PRNIO NOP LDA AMSG5 SOURCE BUFFER ADDRESS LDB ARDBF DEST BUFFER ADDRESS MVW .8 LDA INTBA ADDRESS OF THE INTERRUPT TABLE ADA .2 POINT TO ENTRY FOR SC 10 OCTAL STA TEMP1 SAVE IT LDB INTLG LENGTH OF THE INTERRUPT TABLE ADB N2 ADJUST TO SKIP I/O SELECT CODES 6 AND 7 CMB,INB USE AS COUNTER STB TEMP2 LDA B10 STA TEMP3 COUNTER FOR SELECT CODE # PRNLP LDA TEMP3 CLE CONVERT SC # TO ASCII JSB $CNV3 SYSTEM ROUTINE TO CONVERT ADA .2 POINT TO LAST DIGITS LDA A,I STA RDBUF+6 SELECT CODE# IN MESSAGE LDA TEMP3 GET SELECT CODE # CPA TBG IS IT THE TBG SELECT CODE? JMP TBGPR YES CPA $SAVE+5 IS IT THE PRIV I/O CARD? JMP PRIV YES * LDA TEMP1,I INTERRUPT TABLE ENTRY SZA,RSS 0? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT SSA PROGRAM ID SEGMENT? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT ADA .4 EQT ADDRESS SPECIFIED STA TEMP4 SAVE ADDRESS OF WORD 5 OF EQT LDA EQTA START OF EQT TABLE CMA,INA ADA TEMP1,I # WORDS OFFSET TO THE BEGINING OF THIS EQT CLB DIV .15 GET EQT # STA TEMP5 SAVE EQT#-1 JMP CNVE# CONVERT IT TO ASCII * SRCHE LDA TEMP3 GET SC # JSB EQTFN FIND EQT WORD 4 ADDRESS AND EQT # INB POINT TO WORD 5 STB TEMP4 SAVE EQT WORD 5 ADDRESS SZB,RSS FOUND AN EQT? JMP NOEQT NO EQT FOR THIS SC CNVE# LDA AMSG6 SOURCE BUFFER ADDRESS LDB ADEST DEST BUFFER ADDRESS MVW .6 LDA TEMP5 EQT # - 1 FOR THIS DEVICE ÙKþúCCE,INA CONVERT IT TO DECIMAL ASCII JSB $CNV3 ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE FOR EQT STA RDBUF+10 STORE IT IN RDBUF LDA TEMP4 GET WORD 5 OF EQT LDA A,I ALF,CLE,ALF EQUIPMENT TYPE CODE IN BITS 0-6 AND B77 JSB $CNV3 CONVERT EQ TYPE CODE TO OCTAL ASCII ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE STA RDBUF+14 STORE IT IN BUFFER LDA SPACE CLEAR REMAINING WORD STA RDBUF+15 * PRENT LDA TEMP1,I GET INTERRUPT TABLE ENTRY SZA,RSS IS IT AN ENTRY POINT? JMP ENINS YES SSA IS IT A PROG ID SEGMENT JMP PROGN YES JMP PRNT * NOEQT LDA SPACE LDB .8 JSB SETM SET FIRST PART OF MESSAGE TO BLANKS ADEST DEF RDBUF+8 JMP PRENT * ENINS LDA TEMP3,I GET TRAP CELL VALE FOR SC CPA JSBCI IS IT JSB CIC,I? JMP NOENT YES CLE CONVERT TRAP CELL CONTENTS TO ASCII OCTAL JSB $CNV3 LDB ARDBF ADDRESS OF RDBUF ADB .16 MVW .3 MOVE ASCII VALUE LDB .19 # OF WORDS TO LIST JMP PRNT+1 * NOENT LDA TEMP4 EQT WAS FOUND? SZA JMP PRNT YES, PRINT LINE JMP ENDLP NO, SKIP PRINTING * PROGN CMA,INA MAKE THE ID SEG ADDR +VE ADA .12 POINT TO WORD 13 OF ID SEG STA TEMP5 SAVE ADDRESS DLD A,I GET PROGRAM NAME DST RDBUF+16 LDA TEMP5 ADA .2 GET LAST CHAR OF PROG NAME LDA A,I AND B1774 BLANK THE LOWER BYTE IOR B40 ADD A SPACE STA RDBUF+18 STORE IT IN READ BUFFER LDB .19 JMP PRNT+1 PRINT * TBGPR DLD .TBG TBG SELECT CODE DST ADEST,I LDB .10 JMP PRNT+1 * PRIV LDA AMSG8 PRIVILEGED I/O CARD LDB ADEST MVW .4 LDB .12 RSS * PRNT LDB .15 îþú JSB WRLST DEF RDBUF ENDLP ISZ TEMP3 POINT TO NEXT SELECT CODE # ISZ TEMP1 INCREMENT POINTER TO THE INTERRUPT TBL ISZ TEMP2 INCREMENT COUNTER JMP PRNLP PRINT NEXT SC ENTRY JMP PRNIO,I RETURN * .TBG ASC 2,TBG * HED DISC TRANSFERS FOR PERMANENT RECONFIGURATION * * TRWRD - ROUTINE TRANSFER A WORD FROM SYSTEM IN MEMORY * TO A CORRESPONDING LOCATION ON DISC * CALLING SEQUENCE: A REG = DISC ADDRESS * B REG = CONTENTS OF WORD IN MEMORY * #OFST = # OF WORDS OFFSET IN THE SECTOR * * TRWRD NOP STB TEMP4 SAVE CONTENTS OF MEM LOC STA PRMTB-1 BUILD TRIPLETS FOR $XSIO ROUTINE LDB APRMT ADDRESS OF PARAMETER TABLE ADB N3 STB WRAD1 ADDRESS OF START OF TRIPLET STB WRAD2 LDA ASCBF START MEM ADDRESS STA PRMTB-3 LDB .128 # OF WORDS TO BE READ STB PRMTB-2 LDA .2 CAY LU# CLA,INA REQUEST CODE TO READ CLB READ BUFFER INTO THE SYTEM MAP JSB $WRRD WRAD1 NOP LDA ASCBF ADDRESS OF START OF BUFFER ADA #OFST ADD OFFSET TO IT LDB TEMP4 CONTENTS OF WORD TO BE TRANSFERRED STB A,I CHANGE CORRESP WORD IN BUFFER LDA .2 REQ CODE IS 2 TO WRITE CAY LU# IS ALSO 2 FOR DISC CLB WRITE BUFFER FROM SYSTEM MAP JSB $WRRD WRAD2 NOP JMP TRWRD,I RETURN * APRMT DEF PRMTB .128 DEC 128 * * * MEMDS - ROUTINE TO CONVERT GIVEN MEMORY LOCATION * IN SYSTEM CODE INTO A CORRESPONDING DISC LOCATION * CALLING SEQUENCE: A REG = MEMORY LOCATION * JSB MEMDS * RETURNS: TEMP1 = TRACK# * TEMP2 = SECTOR# * #OFST = # OF WORDS OFFSET INTO SECTOR * * MEMDS NOP LDB SECT2 # OF SECTORS/TRACK ON SYS DISC BLF MULTIPLY BY 100B TO GET RBL,RBL STB NWRDS # OF;•þú WORDS / TRACK CLB DIV NWRDS DIVIDE MEM LOC BY # OF WORDS/TRACK STA TEMP1 TRACK # CLA RRR 6 DIVIDE REMAINING WORDS BY 100B ADB $SSCT ADD SECTORS TO ACCOUNT FOR BOOT EXT STB TEMP2 QUOTIENT IS SECTOR# LDB SECT2 # OF SECTORS PER TRACK ON SYS DISC CMB,INB ADB TEMP2 SECTOR# - # SECTORS/TRACK SSB SECTOR # >= # OF SECTORS/TRACK? JMP CALOF NO, CALCULATE OFFSET STB TEMP2 YES,SECTOR# = SECTOR#-#SECTORS/TRACK ISZ TEMP1 INCREMENT TRACK # * CALOF ALF A REG HAS REMAINDER RAL,RAL LDB TEMP2 GET SECTOR # SLB,RSS EVEN SECTOR? JMP SETOF YES * ADB N1 ODD SECTOR, SO MAKE EVEN STB TEMP2 NEW SECTOR # ADA B100 ADD 64 WORDS TO THE OFFSET SETOF STA #OFST # OF WORDS OFFSET INTO SECTOR JMP MEMDS,I RETURN * NWRDS NOP #OFST NOP B100 OCT 100 * * * $TREN - ROUTINE TO TRANSFER A SYSTEM ENTRY POINT VALUE * FROM MEMORY TO A CORRESPONDING LOC ON DISC * CALLING SEQUENCE: A REG = ADDRESS OF ENTRY POINT * B REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * JSB $TREN * $TREN NOP RSS LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS FROM ADDRESS JMP *-2 STB TRTMP SAVE VALUE OF B REG LDB A,I GET CONTENTS OF MEM LOC JSB LOCTR TRANSFER WORD TO DISC LDA TRTMP CALLING FROM SYSTEM MAP? SSA,RSS JMP $TREN,I YES,RETURN UJP $TREN,I NO, RETURN TO USER MAP * * * LOCTR - ROUTINE FINDS DISC ADDRESS FOR A GIVEN MEMORY LOCATION * AND TRANSFERS THE CONTENTS OF THIS LOCATION TO A CORRESPONDING * LOCATION IN MEMORY * * CALLING SEQUENCE: A REG = ADDRESS OF LOC IN MEMORY * B REG = CONTENTS OF LOCATION * JSB LOCTR * * LOCTR NO6þúP STB TRTMP+1 SAVE IT JSB MEMDS FIND DISC ADDRESS FOR THIS LOC LDA TEMP1 GET TRACK# ALF,RAL RAL,RAL TRACK # IN BITS 7-15 ADA TEMP2 SECTOR # IN BITS 0-6 LDB TRTMP+1 JSB TRWRD TRANSFER WORD TO DISC JMP LOCTR,I RETURN * * * $TRTB - PROCEDURE USED TO TRANSFER A TABLE FROM * THE SYSTEM AREA IN MEMORY TO A CORRESPONDING LOCATION * ON THE SYSTEM DISC * CALLING SEQUENCE: JSB $TRTB * A REG = START ADDRESS OF TABLE * B REG = LENGTH OF TABLE (BIT 15 SET IF * CALLING FROM USER MAP) * * $TRTB NOP RSS LDA A,I REMOVE INDIRECTS FROM ADDRESS RAL,CLE,SLA,ERA JMP *-2 STA TRTMP SAVE THE ADDRESS OF TABLE SSB,RSS CALLING FROM USER MAP? JMP TRTB1 NO ELB,CLE,ERB YES LDA $TRTB SET BIT 15 OF THE RETURN ADDRESS ADA BIT15 STA $TRTB LDA TRTMP START ADDRESS OF TABLE TRTB1 STB TRTMP+1 JSB MEMDS CONVERT START ADDRESS INTO DISC LOC LDA ASCBF ADDRESS OF SECOTR BUFFER STA TEMP3 LDA .128 # OF WORDS TO BE READ STA TEMP JSB SETUP SET UP A TRIPLET TO READ STA TRBFA THE FIRST SECTOR THE TABLE OCCUPIES STA TRBFB ADDRESS OF TRIPLET LDA .2 LU # CAY CLA,INA REQ CODE TO READ CLB BUFFER IN SYS MAP JSB $WRRD READ THE FIRST SECTOR TRBFA NOP OF THE TABLE LDB #OFST # OF WORDS OFFSET INTO FIRST CMB,INB SECTOR FOR START OF TABLE ADB .128 #WORDS FROM START OF TABLE TO END OF SECTOR LDA TRTMP+1 CMA,INA - ( # OF WORDS IN THE TABLE ) ADA B + (# WORDS TILL END OF SECTOR) SSA,RSS #WORDS IN TABLE <= #WORDS LEFT IN SECTOR? LDB TRTMP+1 YES,#WORDS TO MOVE=# WORDS IN TABLE STB TEMP1 INTO TdnþúHE FIRST SECTOR LDA TRTMP ADDRESS OF TABLE ADB TRTMP STB TRTMP NEW START LOC OF TABLE STB TEMP3 LDB ASCBF ADDRESS OF SECTOR BUFFER ADB #OFST ADDRESS TO WHICH FIRST PART OF MVW TEMP1 TABLE MUST BE MOVED LDA .2 WRITE BUFFER BACK ON DISC CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFB NOP * LDA TEMP1 CMA,INA ADA TRTMP+1 LENGTH OF TABLE-# OF WORDS TRANSFERRED STA TRTMP+1 # OF WORDS REMAINING TO BE TRANSFERED CLB RRR 7 DIVIDE BY 200B TO GET BLF,RBL # OF WORDS IN LAST SECTOR OCCUPIED BY TABLE RBL,RBL STB #OFST SAVE THE REMAINDER CMB,INB - ( # OF WORDS IN LAST SECOTR) ADB TRTMP+1 ADD # OF WORDS REMAINING TO BE TRANSFERRED STB TEMP # OF WORDS TO TRANSFER TO DISC IN ONE CHUNK STB TRTMP+1 RESET TO USE LATER LDA TRBFB ADDRESS OF LAST TRIPLET USED JSB NXTAD GET THE NEXT DISC ADDRESS JSB SETUP BUILD TRIPLETS FOR THIS CHUNK OF MEMORY STA TRBFC ADDRESS OF TRIPLETS LDA .2 REQ CODE IS 2 CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFC NOP * LAST SECTOR OF TABLE TO BE TRANSFERRED LDA TRTMP START MEM ADDRESS FOR LAST CHUNK ADA TRTMP+1 # OF WORDS JUST WRITTEN STA TRTMP START ADDRESS FOR LAST PART OF THE TABLE LDA .128 # OF WORDS TO BE READ FROM DISC STA TEMP LDB TRBFC,I CONTENTS OF FIRST WORD OF LAST TRIPLET LDA TRBFC ADDRESS OF THE LAST TRIPLET USED SZB,RSS WAS LAST TRIPLET EMPTY? LDA TRBFB YES,USE TRIPLET ADDR FROM PREVIOUS TRANSFER JSB NXTAD CALCULATE NEXT DISC ADDRESS LDA ASCBF STA TEMP3 JSB SETUP BUILD THE LAST TRIPLET STA TRBFD ADDRESS OF TRIPLET STA TRBFE LDA .2 CAY CLA,INA REQ CODE IS TO REA´·þúD SECTOR CLB BUFFER IS IN SYSTEM MAP JSB $WRRD READ SECTOR CONTAINING LAST PART OF THE TABLE TRBFD NOP LDA TRTMP START ADDRESS OF LAST PART OF TABLE LDB ASCBF ADDRESS OF SECTOR BUFFER MVW #OFST # OF WORDS LEFT IN THE TABLE LDA .2 REQ CODE IS 2 TO WRITE CAY CLB BUFFER IS IN SYSTEM MAP JSB $WRRD WRITE LAST PART OF THE TABLE TRBFE NOP LDA $TRTB CALLING FROM USER MAP? SSA,RSS JMP A,I NO, RETURN ELA,CLE,ERA CLEAR SIGN BIT UJP A,I RETURN TO USER MAP * ASCBF EQU ARDBF * * * NXTAD - ROUTINE TO FIND TRACK AND SECTOR # TO BE * USED FOR NEXT SEQUENTIAL DISC ACCESS * CALLING SEQUENCE: A REG = ADDRESS OF LAST TRIPLET USED * JSB NXTAD * RETURNS: TEMP1=NEW TRACK # * TEMP2=NEW SECTOR # * * NXTAD NOP INA POINT TO # OF WORDS IN LAST TRIPLET CAY LDA A,I CLB RRR 6 DIVIDE #OF WORDS BY 100B TO GET # OF SECTORS SZB REMAINDER? INA YES, THEN INCREMENT # OF SECTORS STA TEMP4 SAVE THIS VALUE CYA GET POINTER TO TRIPLET INA POINT TO DISC ADDRESS LDA A,I JSB DSCAD BREAK UP DISC ADDRESS INTO TRACK & SECTOR# LDA TEMP2 GET SECTOR # ADA TEMP4 ADD # OF SECTORS TRANSFERRED CPA SECT2 ALL SECTORS IN TRACK DONE? RSS JMP SECTR NO, SET SECTOR # ISZ TEMP1 INCREMENT TRACK # CLA SECTR STA TEMP2 CLEAR SECTOR # JMP NXTAD,I RETURN * * * DSKRD - ROUTINE TO READ TWO 128 WORD SECTORS FROM DISC AND * MOVE THE REQUIRED PORTION OF THE BUFFER INTO ADDRESS IN MEMORY * * CALLING SEQUENCE: A REG = ADDRESS IN SYTEM AREA * B REG = NUMBER OF WORDS TO TRANSFER * JSB DSKRD * * DSKRD NOP STA PRTMP SAVE ADDRESS IN SYYþúSTEM AREA CMB,INB NEGATIVE # OF WORDS STB PRTMP+1 USE AS COUNTER TO MOVE WORDS JSB MEMDS GET DISC ADDRESS LDA ARDBF BUFFER TO READ DATA FROM DISC STA TEMP3 LDA .256 # OF WORDS TO READ STA TEMP JSB SETUP SET UP TRIPLETS FOR DISC READ STA TRPAD SAVE ADDRESS OF TRIPLETS LDA .2 DISC LU# CAY IN Y REG CLA,INA READ OPERATION CLB PRIORITY CODE JSB $WRRD READ THE 2 SECTORS FROM DISC TRPAD NOP ADDRESS OF TRIPLETS * LDA ARDBF ADDRESS IN READ BUFFER AT WHICH ADA #OFST TO START TRANSFER OF WORDS MVWLP LDB A,I GET THE WORD STB PRTMP,I RESTORE IT IN SYSTEM INA POINT TO NEXT WORD ISZ PRTMP NEXT ADDRESS IN SYSTEM ISZ PRTMP+1 INCREMENT NEGATIVE COUNTER JMP MVWLP * JMP DSKRD,I RETURN * .256 DEC 256 * * * * $GDPG - ROUTINE FINDS THE FIRST POSSIBLE GOOD PAGE * STARTING FROM THE PAGE # PASSED AS PARAMETER * * CALLING SEQUENCE : A REG = STARTING PAGE# * BIT 15 SET IF CALLING FROM USER MAP * JSB $GDPG * RETURNS: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * A REG = NEXT GOOD PAGE# * * $GDPG NOP STA PRTMP SAVE A REG SSA CALLING FROM SYSTEM MAP? ELA,CLE,ERA NO, CLEAR SIGN BIT BDPGL CPA MEMSZ PAGE IS EQUAL TO MEMORY SIZE? JMP EXGDP YES, THEN ERROR RETURN LDB A PAGE# IN B REG CMB,INB STB TEMP LDB $ABDP,I GET BAD PAGE# CPB N1 -1? JMP GDPGR YES, END OF BAD PAGE LIST CPB A EQUAL TO START PAGE # PASSED? JMP FNDBD YES, THEN BAD PAGE FOUND ADB TEMP BAD PAGE # > START PAGE? SSB JMP INCBD NO, THEN INCREMENT THE BAD PAGE# GDPGR ISZ $GDPG YES, RETURN EXGDP LDB PRTMP [862 SSB,RSS JMP $GDPG,I RETURN IN SYSTEM MAP UJP $GDPG,I RETURN IN USER MAP FNDBD INA INCREMENT START PAGE # INCBD ISZ $ABDP INCREMENT BAD PAGE POINTER JMP BDPGL TRY AGAIN * * * $PCHN - ROUTINE TO FIND A CHUNK OF MEMORY LARGER THAN * ONE PAGE BETWEEN BAD PAGES * CALLING SEQUENCE : JSB $PCHN * A REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * RETURNS: A REG = SIZE OF CHUNK OF MEMORY * * $PCHN NOP STA TEMP1 LDA $USRS GET START OF USER PART'N JSB $GDPG GET THE NEXT GOOD PAGE JMP ZEROP NO, MORE GOOD PAGES STA $USRS NEW GOOD PAGE PCHLP LDA $ABDP,I GET BAD PAGE VALUE CPA N1 END OF BAD PAGE LIST? JMP NBDPG YES LDB $USRS START OF USER PART'N AREA CMB,INB ADA B BAD PAGE# - START OF USER PART'N CPA .1 SIZE OF THIS CHUNK IS 1? JMP ONEPG YES JMP RPCHN * ONEPG LDA $ABDP,I INCREMENT USER PART'N START PG INA JSB $GDPG FIND GOOD PAGE STARTING AT THE NEW JMP ZEROP NO MORE PAGES LEFT STA $USRS NEW USER PART'N START PAGE JMP PCHLP * ZEROP CLA JMP RPCHN RETURN * NBDPG LDA $USRS START OF USER PART'N CMA,INA ADA MEMSZ MEM SIZE - START USER PART'N PAGE CPA .1 ONLY ONE PAGE? JMP ZEROP YES, THEN RETURN WITH 0 PAGES RPCHN LDB TEMP1 SSB,RSS CALLING FROM SYSTEM MAP? JMP $PCHN,I YES, RETURN UJP $PCHN,I NO, ENABLE USER MAP AND RETURN * END $CNFG U{8ÿÿ ÿý/8h ÿ92067-18115 2013 S C0122 &$$TB1 TABLE AREA ONE MODULE             H0101 ǽþúASMB,R,L,C ** RT TABLE AREA 1 MODULE ** * * DATE: 9/21/77 * NAME: $$TB1 * SOURCE: 92067-18115 * RELOC: PART OF 92067-16103 * PGMR: E.WONG,G.L.M.,AJIT * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB1,15 92067-16103 REV.2013 800201 * * * EXEC4: ENT $ERAB,$PVCN,EXEC,XLUEX,$LIBR,$LIBX,$PVST * RTIO4: ENT $UPIO,$XCIC,$YCIC,$CIC ENT $UIN,$UCON * DISP4: ENT $XEQ,$XDMP,$IDLE * SCHD4: ENT $SCD3,$IDNO,$MEU,$LIST,$MESS,$WORK,$$OP * TRRN4: ENT $ULLU,$CGRN * MTM: ENT $MTM * ENT $OPSY,$DATC * * FMP ENT $CL1,$CL2,$$CPU * * SESSION MONITOR * ENT $CMAD,$ACFL,$LGON,$LGOF,$STH,$LME$,$DSCS,$SHED * * EXEC4: EXT $ERRA,$LBR,$LBX,$XEX * RTIO4: EXT $UP,$CXC,$CYC,$CIC0 EXT $CON1,$CON2,$CON3 * DISP4: EXT $XCQ,$XDM * SCHD4: EXT $SCD,$ID#,$LST,$MSG,$IDSM,$OP * TRRN4: EXT $ULU,$CRN# * * SESSION MONITOR * EXT $CMND,$LMES * * A EQU 0 B EQU 1 * * EXEC4 * HLT 0 TRAP IN CASE OF FALL THROUGH. JMP *-1 DON'T ALLOW RE-RUN EXEC NOP JMP EXEC OR JSB EXEC WITHOUT MP SJP $XEX WILL BE CAUGHT IN EXEC CODE * XLUEX NOP JMP XLUEX OR JSB XLUEX WITHOUT MP SJP $XEX WILL BE CAUGHT IN EXEC CODE * $ERAB SJP $ERRA * $PVCN NOP LEVEL COUNT FOR PRIVILEGED CALL $PVST NOP DMS STATUS FOR PRIVILEGED CALL * $LIBR NOP SSM $PVST SJP $LBR * $LIBX NOP SSM $PVST SJP $LBX M  * * * RTIO4 * $UPIO SJP $UP * $XCIC SJP $CXC * $YCIC SJP $CYC * $CIC NOP JMP $CIC0 SYSTEM MAP ALREADY ENABLED (BY INTERRUPT) * $UIN NOP UJS B,I ENTER DRIVER IN USER MAP SJP $UIN,I RETURN IN SYSTEM MAP * $UCON UJS B,I ENTER DRIVER IN USER MAP JMP UCON1 P+1 RETURN JMP UCON2 P+2 RETURN SJP $CON3 P+3 RETURN UCON1 SJP $CON1 UCON2 SJP $CON2 * * * DISP4 * $XEQ SJP $XCQ * $XDMP NOP RSB SJP $XDM * IDLE JMP * $IDLE DEF IDLE ADDR OF IDLE LOOP NOP DUMMY A,B,EO,X NOP DUMMY Y * * * SCHD4 * $LIST NOP RSA SJP $LST * $SCD3 NOP RSB SJP $SCD * $IDNO NOP RSA SJP $ID# * $MESS NOP SSM $MEU SJP $MSG $MEU NOP SAVES MEU STATUS FOR $MESS * $WORK JMP $IDSM * $$OP DEF $OP+0 DIRECT ADDRESS OF LAST PARSED OP CODE * * * TRRN4 * $ULLU NOP RSA SJP $ULU * $CGRN NOP RSB SJP $CRN# * * * MTM * $MTM NOP * * $OPSY DEC -9 RTE-IV IDENTIFICATION $DATC DEC 2013 DATE CODE OF 92067-16102 * * * * SESSION MONITOR * $DSCS OCT -1 SESSION UP\DOWN FLAG (-1 IF NOT INSTALLED) NOP $DSCS+1::= ACCTS BUSY FLAG $SHED NOP HEAD OF SCB LIST * $CMAD DEF $CMND+0 ADDRESS OF SESSION COMMAND TABLE $ACFL NOP ACCOUNT FILE CRN $LGON NOP LOGON CLASS # $LGOF NOP LGOFF CLASS # $STH NOP R$PN$ CLASS # $LME$ DEF $LMES+0 * * FMP * $CL1 DEC 75 $CL2 NOP $$CPU NOP * * END $OPSY * * 3 ÿÿ ÿý07 ÿ92067-18116 2001 S C0122 &$$TB2 TABLE AREA II             H0101 9þúASMB,R,L,C ** RT TABLE AREA 2 MODULE ** * DATE: 7/26/77, UPDATED 3/29/79-AVD * NAME: $$TB2 * SOURCE: 92067-18116 * RELOC: PART OF 92067-16103 * PGMR: EJW, AVD * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB2,13 92067-16103 REV.2001 791016 * ENT $MATA,$MCHN,$MBGP,$MRTP ENT $DLTH,$DVPT,$TIME,$BATM ENT $DLP,$PLP,$SSCT,$STRK ENT $ENDS,$MPFT,$BGFR,$RTFR,$IDEX ENT $MRMP,$MPS2,$EMRP,$MPSA ENT $SDA,$SDT2,$CMST,$COML ENT $CFR,$MNP,$DVMP ENT $RLB,$RLN,$SBTB,$OTAT,$OPRI ENT $SPCR ENT $ELTB ENT $PNTI,$MAXI ENT $SALI,$SRTI,$CES,$LMES,$SMEM * EXT $PNTR,$MAXE EXT $SALC,$SRTN * * $MATA NOP $MCHN NOP $MBGP DEC 14 $MRTP DEC 5 $DLTH DEC 1 $DVPT NOP $TIME OCT 16000 JUN 1, 1979 8:00 AM OCT 177650 OCT 6100 (YEAR-1970)*365 + (JULIAN_DAY - 1) $BATM NOP 1. NOP 2. $DLP NOP $PLP NOP $ENDS NOP $OTAT NOP $OPRI NOP $MPFT NOP $BGFR NOP $RTFR NOP $IDEX NOP $MRMP NOP $MPSA NOP $MPS2 NOP $SDA NOP $SDT2 NOP $CMST NOP $STRK NOP $SSCT NOP $COML NOP $CFR NOP $MNP NOP $DVMP NOP $EMRP NOP $RLB NOP $RLN NOP $SBTB NOP 1. NOP 2. NOP 3. NOP 4. NOP 5. NOP 6. * * SPOOL DISC CRN * $SPCR NOP * SKP ********************************************************************** * * EQUIPMENT LOCK TABLE * * THE EQUIPMENT LOCKING TABLE IS USED TO LOCK AN EQUIPMENT * TO A PROGRAM ÛÐþúAND TO HANG A LINKED LIST OF REQUESTS WAITING * EITHER FOR USE OF THAT EQUIPMENT, OR TO LOCK THAT EQUIPMENT * TO THEMSELVES. * ENTRY POINT $ELTB CONTAINS A POINTER TO THE TABLE (TO THE TABLE * HEADER, IN FACT). * THE TABLE HEADER, NAMED "HEADR" BELOW, IS ONE WORD LONG, AND * CONTAINS THE TABLE LENGTH (# OF 3-WORD ENTRIES IN TABLE) IN ITS * LOWER BITS, AND THE UPPERMOST BIT IS SET IF THE TABLE HAS CUR- * RENTLY AT LEAST ONE NONBLANK ENTRY (I. E., IT IS THE TABLE_ * NOT_EMPTY BIT). * THERE FOLLOWS THE FIRST WORDS OF ALL ENTRIES, FOLLOWED BY THE * SECOND WORDS, AND THEN THE THIRD WORDS. * THE FIRST WORD OF EACH ENTRY, WHEN NON-ZERO, IS AN EQUIPMENT #, * LOCKED TO THE PROGRAM WHOSE ID SEGMENT ADDRESS IS IN WORD 2 OF * THAT ENTRY. BIT 15 OF THIS WORD 2 IS SET IF THE EQT. LOCKING * REQUEST SPECIFIED THAT THE EQUIPMENT SHOULD NOT BE RELEASED IF * THE PROGRAM TERMINATED PREMATURELY (I. E., IT IS THE LOCK_ON_ * ABORT BIT). * WORD 3 OF EACH ENTRY, WHEN NON-ZERO, POINTS TO A LINKED LIST * OF $XSIO REQUESTS (FROM THE OPERATING SYSTEM) FOR THAT EQUIP- * MENT ISSUED SINCE THE LATTER WAS LOCKED, TO BE REHUNG ON THE * EQT FOR THAT EQUIPMENT WHEN THE EQUIPMENT FINALLY IS UNLOCKED. * * +--------------------------------+ * ! $ELTB ! ---- * +--------------------------------- / * / * / * / * / * / * / * / * / * / * / +--------------------------------+ * HEADR --> !N! TBLEN ! * +--------------------------------+ * ! EQT. # ! * €~þú !--------------------------------! * ! EQT. # ! * +--------------------------------+ * ! . ! * ! . ! * N: TABLE_NOT_EMPTY BIT ! . ! * +--------------------------------+ * L: LOCK_ON_ABORT BIT !L! ID SEGMENT ADDRESS ! * !--------------------------------! * !L! ID SEGMENT ADDRESS ! * +--------------------------------+ * ! . ! * ! . ! * ! . ! * +--------------------------------+ * ! LIST POINTER ! * !--------------------------------! * ! LIST POINTER ! * +--------------------------------+ * ! . ! * ! . ! * ! . ! * +--------------------------------+ * * TBLEN EQU 2 TABLE_LENGTH_DEFINING EQUATE $ELTB DEF *+1 TABLE NAME AND POINTER TO TABLE HEADER. HEADR ABS TBLEN TABLE HEADER. BSS TBLEN+TBLEN+TBLEN THREE WORDS PER ENTRY. * * * * FOR USE BY 2001 WHZAT (92067-16501) * $PNTI DEF $PNTR+0 INDIR PNTR TO FREE SAM LIST $MAXI DEF $MAXE+0 PNTR TO MAX NO. OF WDS OF SAM EVER $SALI DEF $SALC+0 PNTR TO ENTRY $SALxŒC FOR ACCTS $SRTI DEF $SRTN+0 PNTR TO ENTRY $SRTN FOR ACCTS $SMEM BSS 2 $LMES DEC -16 PROMPT STRING FOR SESSION ASC 10,PLEASE LOG-ON: _ * $CES NOP FMP MASTER SECURITY WITH MASK $ENBL NOP $CES+1=FMP MASTER SECUTIRY WITHOUT MASK (NO ENT) * * * END $MATA :Žÿÿ ÿý1: ÿ92067-18117 2013 S C0122 &XLUEX              H0101 {¨þúASMB,R,L,C HED XLUEX - DUMMY ROUTINE FOR EXTENDED EXEC CALLS * NAME: XLUEX * SOURCE: 92067-18117 * RELOC: PART OF 92067-16035 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XLUEX,7 92067-16035 REV.2013 800211 EXT .MVW,EXEC,.ENTR ENT XLUEX * * NOTE: * DO NOT CHANGE THE ORDER OF XLUEX,RTN1,FRTN * XLUEX NOP LDA XLUEX .FETCH ADDRESS OF 'DEF RTN' LDB A,I .FETCH 'RTN' ADDRESS STA YLUEX .SET UP FOR PRAM ADDRESS TRANSFER CMA .CALCULATE PARAMETER COUNT ADA B STA CNT STB XLUEX .SET RETURN ADDRESS JMP MVPRM .DO THE PRAMETER FETCH * TOP LDB .PRAM .SET RETURN ADDRESS ADB CNT STB RTN1 .IN THE FAKED CALL LDA .FRTN .PUT IN RETURN CODE JSB .MVW DEF .3 NOP * * THE FOLLOWING CODE WILL FILTER OUT THE IO REQUESTS * ONLY THOSE REQUESTS WILL HAVE THE SECOND PARAMETER * CHANGED TO A SINGLE WORD QUANITY * LDB TABLE STB TEMP .SET TABLE LENGTH LDB .TABL .SET TABLE ADDRESS LDA PRAM,I AND M77 .FETCH ICODE WORD TOP2 CPA B,I .IF A MATCH - PATCH ICNWD JMP DOIT ISZ TEMP .DONE ? INB,RSS .NO LOOK MORE JMP NODO .YES FINISHED NOT AN IO REQUEST JMP TOP2 * DOIT DLD ICNWD,I .FETCH THE DOUBLE WORD LU/FUNCTION CODE AND M77 .ELIMINATE ANY BITS ABOVE 5 IOR B .BLEND IN FUNCTION CODE STA TEMP .SET UP TEMP WITH PROPER VALUE LDA .TEMP .CHANGE PARAMETER 2;  ADDRESS STA ICNWD * NODO JSB EXEC .DO THE EXEC CALL RTN1 NOP PRAM NOP ICNWD NOP REP 12 NOP YLUEX NOP MVPRM JSB .ENTR .PRAM DEF PRAM JMP TOP * FRTN JMP XLUEX,I .P+1 RETURN POINT ISZ XLUEX JMP XLUEX,I .P+2 RETURN POINT .3 DEC 3 TEMP NOP .TEMP DEF TEMP M77 OCT 77 CNT NOP .FRTN DEF FRTN .TABL DEF TABLE+1 *2013 DLS* TABLE DEC -8 DEC 1,2,3,13,17,18,19,20 A EQU 0 B EQU 1 END € ÿÿ ÿý29 ÿ92067-18121 1903 S C0122 &HELP              H0101 waþúASMB,R,L,C,Q HED HELP * NAME: HELP * SOURCE: 92067-18121 * RELOC: 92067-16121 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM HELP,3 92067-16121 REV.1903 790312 ENT HELP EXT EXEC,OPEN,CLOSE EXT READF,LOGLU,GTERR SUP * * BUFFR BSS 128 PRAM1 BSS 4 INTEG NOP ABUF DEF BUFFR APRM1 DEF PRAM1 * * GPTR NOP POINTER FOR PARSE; POINTER FOR COMPR PPTR NOP POINTER FOR PARSE; POINTER FOR COMPR EOL NOP COUNT NOP COUNTER FOR ASCIN; COUNTER FOR COMPR SAVE NOP TEMP STORAGE FOR ASCIN; ERROR RETURN SIGN NOP CHAR NOP TERLU NOP * * DCB BSS 144 DCBA DEF DCB LNDCB NOP LENGTH OF DCB BEING USED ADCB NOP ADDRESS OF DCB BEING USED LEN EQU CHAR CNWRD EQU SIGN * * NAME ASC 3,"HELP CODE ASC 19,HELP INFO FILE FOR PROGRAM 92067-18121 ACODE DEF CODE "" ASC 1,"" A"" DEF "" * * ZERO DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .14 DEC 14 .128 DEC 128 * * N1 DEC -1 N4 DEC -4 N8 DEC -8 N10 DEC -10 N16 DEC -16 N64 DEC -64 * * A EQU 0 B EQU 1 XEQT EQU 1717B BGLWA EQU 1777B * * * * * ENTRY - HELP MAY BE SCHEDULED IN ANY OF THE FOLLOWING WAYS * * :HE,P1,P2 * *HE,P1,P2 * :RU,HELP,P1,P2 * *RU,HELP,P1,P2 * * * THE RUN STRING RETRIEVED BY HELP WILL BE EITHER * * RU,HELP,PARAM1,PARAM2 * OR * ON,HELP,PARAM1,PARAM2 * OR * HELP,PARAM1,PARAM2 * OR * ¥µþú HE,PARAM1,PARAM2 * * * ** ********************* ** ** ** SECTION I ** ** ** ********************* ** ** ** CALCULATE LARGEST BUFFER BEHIND PROGRAM THAT CAN BE USED ** ** HELP EQU * LDB XEQT GET ID SEGMENT ADDRESS OF ADB .14 HELP POSITION TO AND XLA B,I FETCH PROGRAM TYPE AND =B17 MASK TO LOWER 4 BITS CPA .1 MEMORY RESIDENT? JMP BUF.2 YES - MUST USE IN-PROGRAM BUFFER ADB =D9 POSITION TO AND GET XLA B,I HIGH MAIN + 1 STA ADCB SAVE THIS ADDRESS CLB CMA,INA EXTRA = #WORDS BETWEEN HIGH MAIN ADA BGLWA +1 AND END OF THE PARTITION. ADA N16 ALLOW FOR 16 DCB CONTROL WORDS LSR 7 DIVIDE TO GET # BLOCKS SZA,RSS LESS THAN 1 BLOCK FOR DCB BUFFER? JMP BUF.2 YES - JUST USE IN-PROGRAM BUFFER LSL 7 LENGTH IN WORDS (EVEN 128) OF SPACE BEHIND ADA =D16 PROGRAM - (ADD BACK IN 16 CONTROL WORDS) STA LNDCB SAVE LENGTH OF BUFFER BEING USED. JMP RETRV NOW GO PROCESS HELP REQUEST * BUF.2 LDA =D144 SET UP LENGTH OF IN-PROGRAM STA LNDCB BUFFER FOR DCB LDA DCBA SET UP ADDRESS OF BUFFER STA ADCB TO BE USED FOR DCB * * ** ******************** ** ** ** SECTION II ** ** ** ******************** ** ** ** RETRIEVE RUN STRING AND PARSE IT ** ** * * CLEAR 1ST PARAMETER BY MOVING IN BLANKS * FIND OUT LU# OF TERMINAL * RETRV LDA =B20040 STA PRAM1 STA PRAM1+1 STA PRAM1+2 STA PRAM1+3 * JSB LOGLU CALL LOGLU TO GET LU# DEF *+2 OF TERMINAL SCHEDULING HELP DEF SAVE DUMMY VARIABLE - GETS CHANGED STA TERLU SAVE LU# OF THE TERMINAL * * RETRIEVE RUN STRING * JSB EXEC EXEC 14 CALL TO DEF *+5 R ÉþúETRIEVE RUN STRING DEF .14 TO BUFFER STRNG DEF .1 DEF BUFFR DEF .128 * LDA ABUF SET UP POINTERS IN STRING FOR GETCR IN CLE,ELA FORMAT: ADDRESS IN BITS 15-1, U\L CHAR STA GPTR =0\1 UB BIT 0. BLS SHIFT STRING LENGTH TO SAME FORMAT ADA B ADD IT TO ADDRESS OF STRING TO STA EOL GET ADDRESS FOR END OF LINE * * 1ST CHARACTER IN STRING MUST BE EITHER A BLANK (40B), AN * H (110B), AN O (117B), OR AN R (122B). THIS SECTION LOOKS * AT THE 1ST NON-BLANK CHARACTER. IF IT IS AN H, IT SEARCHES * FOR THE 1ST DELIMITER. IF IT IS AN R OR AN O, IT SEARCHES * FOR THE SECOND DELIMITER. * PARS0 JSB GETCR GET A CHARACTER JMP CKPRM END OF LINE (SHOULDN'T EVER HAPPEN - JUST DEFAULT) CPA =B40 IS THIS A SPACE? JMP PARS0 YES - KEEP LOOKING FOR 1ST NON-BLANK CHARACTER CPA =B110 IS THIS AN H? JMP DEL.2 YES - JUST WANT TO LOOK FOR 1 DELIMITER DEL.1 JSB GETCR MUST BE AN R OR AN O SO LOOK FOR 1ST DELIMITER JMP CKPRM END OF LINE (SHOULDN'T EVER HAPPEN - JUST DEFAULT) CPA =B54 IS THIS A COMMA? RSS YES - NOW LOOK FOR 2ND DELIMITER JMP DEL.1 NO - KEEP LOOKING * * LOOK FOR SECOND COMMA. * DEL.2 JSB GETCR GET A CHARACTER JMP CKPRM END OF LINE - GO CHECK PARAMETERS CPA =B54 IS THIS A COMMA? RSS YES - NOW WE CAN GET THE PARAMETERS JMP DEL.2 NO - KEEP LOOKING * * NOW POSITIONED AT BEGINNING OF 1ST PARAMETER. * WANT TO GET RID OF LEADING BLANKS BUT ALLOW IMBEDDED BLANKS. * LDA APRM1 STUFF THE 1ST PARAMETER CLE,ELA INTO PARM1 TAKING INTO STA PPTR ACCOUNT FORMAT FOR PUTCR LDA N8 IT CAN BE 8 CHARACTERS LONG STA COUNT (THROW ANYTHING AFTER THAT OUT) * PAR.1 JSB GETCR NO - GET THE NEXT CHARACTER JMP CKPRM þúEND OF LINE - GO CHECK PARAMETERS CPA =B40 A BLANK? JMP PAR.1 YES - SQUEEZE OUT LEADING BLANKS PAR.2 CPA =B54 COMMA? JMP PAR.3 YES - END OF THIS PARAMETER LDB COUNT HAVE WE ALREADY SSB "PUT" 8 CHARACTERS IN PARM1? JSB PUTCR NO - "PUT" THIS ONE ISZ COUNT STEP THE COUNT NOP (IN CASE WE GET TO ZERO) JSB GETCR NO - GET ANOTHER CHARACTER JMP CKPRM END OF LINE - GO CHECK PARAMETERS JMP PAR.2 AND GO PROCESS IT * * * READY TO GET THE SECOND PARAMETER. JUST IN CASE THERE IS A COMMA * FOLLOWING IT, STOP THERE. * PAR.3 LDA GPTR SAVE BEGINNING ADDRESS STA SAVE OF SECOND PARAMETER COMFD JSB GETCR GET A CHARACTER JMP DOCON FOUND END OF LINE BEFORE A COMMA CPA =B54 COMMA? RSS YES JMP COMFD NO - KEEP LOOKING LDA GETCR BACK UP POINTER TO POINT ADA N1 TO COMMA AND USE THAT STA EOL AS END OF LINE ADDRESS DOCON LDA SAVE RESTORE STARTING ADDRESS STA GPTR OF SECOND PARAMETER JSB ASCIN PARSE AND CONVERT TO INTEGER JMP ER04 BAD PARAMETER ** ********************* ** ** ** SECTION III ** ** ** ********************* ** ** ** IF PARAMETERS NOT SUPPLIED, CALCULATE DEFAULTS ** GET KEYWORD FROM SCB. GET LU FROM LOGLU ** ** CKPRM LDA PRAM1 WAS THERE A MNEUMONIC? CPA =B20040 SENT? RSS NO JMP GETLU YES - SKIP SCB STUFF AND CHECK LU JSB GTERR GET ERROR CODE DEF *+3 FROM THE SESSION DEF PRAM1 CONTROL BLOCK. DEF SAVE LDA SAVE SZA UNDER SESSION CONTROL? JMP ER01 NOT IN SESSION AND DIDN'T PASS KEYWORD STA BUFFR WORDS OF BUFFR STA BUFFR+1 FOR THE COMPARE STA BUFFR+2 STA BUFFR+3 LDA .4 +åþú SEE IF THE ERROR RETREIVED LDB APRM1 FROM GTERR IS ALL ZEROS JSB COMPR RSS IT ISN'T JMP MS01 IT IS - THERE WASN'T ANY 'LAST' ERROR * GETLU LDA TERLU GET LU # OF THE TERMINAL LDB INTEG GET SECOND PARAMETER SZB,RSS WAS ONE SUPPLIED? STA INTEG SAVE LU IN SECOND PARAMETER * * THESE CHECKS ARE IN CASE LU SUPPLIED BY USER IS BAD * IF PASS, PARAMETERS ARE ALL SET UP * LDA INTEG GET LU NUMBER AGAIN SSA NEGATIVE LU? JMP ER04 YES ADA N64 LU GREATER SSA,RSS THAN 64? JMP ER04 YES ** ******************** ** ** ** SECTION IV ** ** ** ******************** ** ** OPEN HELP FILE AND SEARCH FOR KEYWORD ** IF FOUND DUMP INFORMATION TO LU IN INTEG ** ** PROCS JSB OPEN OPEN THE HELP FILE DEF *+8 DEF ADCB,I DEF SAVE ERROR RETURN DEF NAME DEF .3 FORCE TO A TYPE 1 FILE DEF ZERO DEF ZERO DEF LNDCB LDA SAVE GET ERROR RETURN SSA ANY ERRORS? JMP ER03 YES - HELP FILE NOT FOUND * JSB RDREC READ 1ST RECORD JMP ER03 CAN'T EVEN FIND A 1ST RECORD? LDA =D19 LDB ACODE JSB COMPR IS THIS THE CODE RECORD? JMP ER03 NOPE - WON'T BE ABLE TO FIND RIGHT HELP FILE * FIND" JSB RDREC READ NEXT RECRD JMP ER02 ERROR ON READ AND DIDN'T FIND KEYWORD LDA =D1 LDB A"" JSB COMPR IS THIS A DELIMITER RECORD JMP FIND" NO - KEEP LOOKING * * FOUND "" NEXT RECORD'S A KEYWORD * JSB RDREC READ NEXT RECORD WILL BE A KEYWORD JMP ER02 READ ERROR - DIDN'T FIND KEYWORD LDA LEN GET LENGTH OF KEYWORD READ LDB N4 IF LENGTH OF KEYWORD IS GREATER ADB LEN THAN 4 JUST USE 4 SSB,RSS ELSE USE THE LENGTH READ. 3 þúLDA =D4 LDB APRM1 JSB COMPR DOES THIS MATCH THE KEYWORD WE WANT?? JMP FIND" NO - LOOK FOR NEXT DELIMITER RECORD * * FOUND THE KEYWORD AND EXPLANATION. NO JUST DUMP IT OUT * TO THE SPECIFIED LU #. * DUMP JSB WTREC WRITE THE RECORD WE HAVE IN THE BUFFER JSB RDREC READ THE NEXT RECORD JMP EXIT READ ERROR - MUST BE AT EOF SO RETURN LDA =D1 LDB A"" JSB COMPR IS THIS A DELIMITER RECORD?? JMP DUMP NO - KEEP SENDING INFORMATION * * ALL DONE SO CLOSE THE HELP FILE AND TERMINATE * EXIT JSB CLOSE DEF *+2 DEF ADCB,I * JSB EXEC DEF *+2 DEF .6 ** ******************* ** ** ** SECTION V ** ** ** ******************* ** ** ** SUBROUTINES USED BY THE PARSING SECTION ** ** * * * GETCR - ROUTINE TO GET THE NEXT CHARACTER FROM THE RUN STRING * AND PUT IT IN CHAR AND IN A * * THE FORMAT OF GPTR IS: ADDRESS OF WORD IN STRING IN * BITS 15-1, BIT 0 IS 0/1 INDICATING U/L CHARACTER * * GETCR NOP LDB GPTR CPB EOL JMP GETCR,I CLE,ERB LDA B,I ELB SLB,INB,RSS ALF,ALF STB GPTR AND =B377 STA CHAR ISZ GETCR JMP GETCR,I * * * * PUTCR - ROUTINE TO PUT THE CHARACTER IN CHAR INTO THE * PARAMETER BUFFER. * * THE FORMAT FOR PPTR IS THE SAME AS FOR GPTR IN GETCR * * PUTCR NOP LDB PPTR LDA CHAR CLE,ERB XOR B,I AND =B377 XOR B,I SEZ,RSS ALF,ALF STA B,I ISZ PPTR JMP PUTCR,I * * * ASCIN - ROUTINE TO CONVERT A NUMERIC ASCII FIELD BEGINNING * AT GPTR TO AN INTEGER IN INTEG * * ENTRY: GPTR - ADDRESS OF CHARACTER IN THE FIELD * EOL - CHARACTER ADDRESS OF THE END OF THE LINE * * RETURN: INTEG - CONVERTED INTEGER * P+1 I;1þúF OVERFLOW * P+2 NORMAL FINDING A NON-NUMERIC CHARACTER TERMINATES * CONVERSION, BUT STILL RETURNS HERE. * * * CONVERSION IS TERMINATED BY A NON-NUMERIC CHARACTER OR * FINDING EOL. * * NUMERIC CHARACTER - BLANK,+,-,NUMBER * * ASCIN NOP CLO CLA STA INTEG ALL BLANK FIELD => 0 STA SIGN STA SAVE C0 JSB GETCR GET A CHARACTER JMP DONE FOUND END OF THE LINE CPA =B40 A BLANK? JMP C0 YES - JUST SKIP IT CPA =B53 + SIGN JMP C1 YES CPA =B55 - SIGN CCB,RSS YES JMP C5 NO STB SIGN * C1 JSB GETCR GET A CHARACTER JMP DONE FOUND END OF THE LINE CPA =B40 IS THIS A BLANK? JMP C1 YES - SO JUST SKIP IT C5 JSB CHECK CHECK IT STA INTEG LDA SAVE ADA A STA B ADA A ADA A ADA B ADA INTEG STA SAVE JMP C1 * * DONE SOS RETURN P+1 OF THERE IS AN ERROR ISZ ASCIN ELSE STEP RETURN TO P+2 ERR LDA SAVE LDB SIGN INSERT THE SZB SIGN CMA,INA STA INTEG JMP ASCIN,I EXIT * * CHECK NOP ADA =B177720 CHECK FOR SSA ASCII NUMBER JMP DONE (>57B, ADA N10 <72B) SSA,RSS JMP DONE END CONVERSION IF NON-NUMERIC CHAR IS FOUND ADA =D10 JMP CHECK,I ** ******************* ** ** ** SECTION V ** ** ** ******************* ** ** ** OTHER SUBROUTINES ** ** * * * RDREC ROUTINE TO READ THE NEXT SEQUENTIAL RECORD INTO * 128-WORD BUFFER BUFFR. * * RETURN - P+1 IF AN ERROR WAS RETURNED FROM READF * P+2 IF NORMAL * * RDREC NOP JSB READF DEF *+6 DEF ADCB,I DEF SAVE DEF BUFFR G­þú DEF .128 DEF LEN * LDA SAVE GET ERROR RETURN SSA,RSS ERROR? ISZ RDREC NO - STEP TO P+2 RETURN JMP RDREC,I * * * WTREC ROUTINE TO WRITE A RECORD OF LENGTH LEN FROM BUFFER * BUFFR TO LU IN INTEG * * WTREC NOP LDA INTEG ADA =B200 STA CNWRD JSB EXEC DEF *+5 DEF .2 DEF CNWRD DEF BUFFR DEF LEN JMP WTREC,I * * * COMPR ROUTINE TO COMPARE THE CONTENTS OF BUFFR WITH A * SPECIFIED STRING * * ENTRY A - # WORDS TO COMPARE * B - ADDRESS OF STRING TO BE COMPARED AGAINST BUFFR * * RETURN P+1 - DID NOT COMPARE * P+2 - COMPARE WORKED * * COMPR NOP CMA,INA MAKE NEGATIVE COUNTER STA COUNT OF WORDS TO BE COMPARED STB PPTR POINTER IN STRING LDA ABUF POINTER STA GPTR IN BUFFR NXTWD LDA GPTR,I CPA PPTR,I RSS THIS WORD COMPARES JMP COMPR,I NO MATCH - RETURN AT P+1 ISZ GPTR ISZ PPTR ISZ COUNT JMP NXTWD GO DO THE NEXT ONE ISZ COMPR DONE - STEP RETURN ADDRESS TO P+2 JMP COMPR,I RETURN ** ** ******************** ** ** ** SECTION VI ** ** ** ******************** ** ** ** MESSAGE AND ERROR HANDLING ** ** MS01 LDA A.MS1 RSS ER01 LDA A.ER1 GET ADDRESS OF ERROR 1 INFORMATION RSS ER02 LDA A.ER2 GET ADDRESS OF ERROR 2 INFORMATION RSS ER03 LDA A.ER3 GET ADDRESS OF ERROR 3 INFORMATION RSS ER04 LDA A.ER4 GET ADDRESS OF ERROR 4 INFORMATION STA PPTR SAVE AS A POINTER LDA PPTR,I GET NUMBER OF LINES TO BE PRINTED OUT STA COUNT IT IS ALREADY NEGATIVE - USE AS COUNTED ISZ PPTR STEP POINTER SENDM LDA PPTR,I GET LENGTH OF THIS LINE STA LEN AND SAVE IT ISZ PPTR þú STEP POINTER JSB EXEC DEF *+5 DEF .2 DEF TERLU DEF PPTR,I DEF LEN LDA PPTR STEP POINTER PAST LINE JUST WRITTEN ADA LEN STA PPTR ISZ COUNT STEP LINE COUNTER DONE? JMP SENDM GO SEND ANOTHER LINE JMP EXIT ALL DONE GO CLOSE FILE AND LEAVE * * * * #LNM1 DEC -1 DEC 8 ASC 8,NO ERROR IN SCB A.MS1 DEF #LNM1 * #LNS1 DEC -5 DEC 14 ASC 14,HELP PROGRAM ERROR HELP0001 DEC 11 ASC 11,NOT ENOUGH PARAMETERS DEC 27 ASC 27, NOT OPERATING UNDER SESSION CONTROL AND A KEYWORD DEC 28 ASC 28, WAS NOT SPECIFIED. RE-ENTER THE COMMAND AND SPECIFY DEC 26 ASC 26, THE APPROPRIATE KEYWORD AS THE FIRST PARAMETER. A.ER1 DEF #LNS1 * #LNS2 DEC -4 DEC 14 ASC 14,HELP PROGRAM ERROR HELP0002 DEC 9 ASC 9,KEYWORD NOT FOUND DEC 26 ASC 26, KEYWORD WAS NOT FOUND IN THE HELP FILE. IF THE DEC 26 ASC 26, KEYWORD WAS SPECIFIED IN THE COMMAND, CHECK IT. A.ER2 DEF #LNS2 * #LNS3 DEC -4 DEC 14 ASC 14,HELP PROGRAM ERROR HELP0003 DEC 10 ASC 10,HELP FILE NOT FOUND DEC 22 ASC 22, HELP PROGRAM COULD NOT FIND FILE "HELP. DEC 13 ASC 13, NOTIFY SYSTEM MANAGER. A.ER3 DEF #LNS3 * #LNS4 DEC -6 DEC 14 ASC 14,HELP PROGRAM ERROR HELP0004 DEC 7 ASC 7,BAD PARAMETER DEC 26 ASC 26, THE SECOND PARAMETER, THE LOGICAL UNIT NUMBER TO DEC 24 ASC 24, WHICH THE HELP INFORMATION IS TO OUTPUT, WAS DEC 25 ASC 25, SPECIFIED BUT WAS NOT A LEGAL LU#. CHECK THE DEC 16 ASC 16, LU# AND RE-ENTER THE COMMAND. A.ER4 DEF #LNS4 * * * * END HELP {Ã<:66<ÿÿ ÿý3B ÿ92067-18122 2026 S C0122 "HELP              H0101 w[þúHELP INFO FILE FOR PROGRAM 92067-18121 "" REV "HELP 92067-18122 REV.2026 800430 RTE-IVB HELP FILE "" FMGR-102 ILLEGAL D.RTR CALL SEQUENCE A LOCK WAS NOT REQUESTED FIRST OR THE FILE WAS NOT OPENED EXCLUSIVELY. POSSIBLY AN OPERATOR ERROR, SUCH AS REMOVING A CARTRIDGE WITHOUT DISMOUNTING IT FIRST. "" FMGR-101 ILLEGAL PARAMETER IN D.RTR CALL POSSIBLY AN OPERATOR ERROR. RECHECK THE PREVIOUS ENTRIES FOR ILLEGAL OR MISPLACED PARAMETERS. THIS ERROR CAN ALSO HAPPEN WHEN A REQUEST IS MADE TO CREATE A SCRATCH FILE AND THAT SCRATCH FILE ALREADY EXISTS. IF D.RTR IS UNABLE TO PURGE THE EXISTING SCRATCH FILE, THIS ERROR IS RETURNED. THIS CAN ONLY HAPPEN IF SOME OTHER PROGRAM HAS THE SCRATCH FILE OPEN. SEE THE SYSTEM MANAGER. "" FMGR-099 DIRECTORY MANAGER EXEC REQUEST WAS ABORTED AN EXEC REQUEST MADE BY D.RTR WAS ABORTED. MAKE SURE THAT ALL DISCS BEING ACCESSED ARE UP. NOTIFY SYSTEM MANAGER. "" FMGR-048 SPOOL NOT INITIALIZED OR SMP CANNOT BE SCHEDULED IF SPOOLING NOT INITIALIZED RUN GASP TO DO SO. OTHERWISE, SMP PROGRAM IS NOT FOUND OR THERE IS NOT A BIG ENOUGH PARTITION TO RUN SMP. THE DEFAULT FOR SMP IS TYPE 2 (REALTIME) AND 6 PAGES IN SIZE. "" FMGR-047 NO SESSION LU AVAILABLE FOR SPOOL FILE IF THE SESSION LU TO BE USED FOR THE SPOOL FILE IS NOT SPECIFIED DURING SET UP, SMP ALLOCATES A SESSION LU LESS THAN 64 THAT IS NOT ALREADY USED IN THE SESSION SWITCH TABLE. USE :SL,LU,- COMMAND TO RELEASE A SESSION LU IN THE SPARE PART OF THE SESSION SWITCH TABLE. "" FMGR-046 GREATER THAN 255 EXTENTS ATTEMPT TO CREATE EXTENT 256. MAKE FILE SIZE OF MAIN LARGER. IF GENERATED DURING A SM COMMAND, THE MESSAGE IS NOT PUT IN THE MESSAGE FILE. IT IS TRUNCATED AT THE LAST VALID MESSAGE. "" FMGR-041 NO ROOM IN SST THERE ARE NO SPARE ENTRIES LEFT IN THE SESSION SWITCH TABLE. SPARE ENTRIES CAN BE RECOVERED BY USING THE :SL,LU,- COMMAND, WHERE LU IS A SESSION LOGICAL UNIT NUMBER THAT IS NOT NEEDED. "" FMGR-040 LU NOT FOUND IN SSÚþúT TRYING TO ACCESS AN LU THAT IS NOT IN YOUR SESSION SWITCH TABLE. USE THE SL COMMAND TO ADD THE LU TO THE SST. "" FMGR-039 SPOOL LU NOT MAPPED TO THE SPOOL DRIVER SPOOL LU MUST POINT TO A SPOOL EQT. SWITCH ALL SPOOL LU'S TO POINT TO SPOOL EQT'S AND TRY THE SPOOL FILE SET UP AGAIN. "" FMGR-038 ILLEGAL SCRATCH FILE NUMBER ATTEMPT TO CREATE A SCRATCH FILE WILL AN ILLEGAL SCRATCH FILE NUMBER. THE RANGE FOR SCRATCH FILE NUMBERS IS 0 THROUGH 99. ISSUE CREATE AGAIN WITH A NUMBER IN THE CORRECT RANGE. "" FMGR-036 LOCK ERROR ON DEVICE A CALL TO OPENF CAUSED AN ATTEMPTED LOCK ON A DEVICE AND THAT LOCK WAS UNSUCCESSFUL. THIS COULD HAPPEN IF THE DEVICE IS ALREADY LOCKED OR IF THERE ARE NO RESOURCE NUMBERS AVAILABLE. "" FMGR-035 ALREADY 63 DISCS MOUNTED TO SYSTEM AN ATTEMPT WAS MADE TO MOUNT A DISC WHEN THERE ARE ALREADY 63 DISCS MOUNTED. A DISC WILL HAVE TO BE DISMOUNTED BEFORE A NEW ONE MAY BE MOUNTED. "" FMGR-034 DISC ALREADY MOUNTED. AN ATTEMPT WAS MADE TO MOUNT A DISC THAT IS ALREADY MOUNTED IN THE CARTRIDGE DIRECTORY. EITHER DISMOUNT THE DUPLICATE DISC OR MOUNT A DIFFERENT ONE. "" FMGR-033 NOT ENOUGH ROOM ON CARTRIDGE AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE WHICH DOES NOT HAVE ENOUGH ROOM. TRY USING ANOTHER CARTRIDGE OR DECREASE THE FILE SIZE. "" FMGR-032 CARTRIDGE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE THAT CANNOT BE FOUND IN THE CARTRIDGE LIST. CHECK THE CARTRIDGE NUMBER FOR CORRECTNESS. "" FMGR-030 VALUE TOO LARGE FOR PARAMETER 1. THE VALUE SUPPLIED IN THE PARAMETER IS BEYOND THE DEFINED RANGE. 2. THIS ERROR CAN BE GENERATED WHEN A PARAMETER IS SUPPLIED FOR THE PURPOSE OF GETTING RETURN INFORMATION FROM A ROUTINE. IF THE PARAMETER SUPPLIED IS A SINGLE WORD BUT THE VALUE OF THE INFOR- MATION TO BE RETURNED IS A DOUBLE WORD, THE ERROR WILL BE GENERATED. "" FMGR-026 QUEUE FULL OR MAX PENDING SPOOLS EXCEEDED THE SPOOL QUEUE IS FULL OR THE MAXIMUM NUMBER OF SPOOLS PEND3¹þúING HAS BEEN EXCEEDED. THE JOB MUST BE RE-RUN WHEN THE SPACE BECOMES AVAILABLE. "" FMGR-025 NO SPLCON ROOM THE SPLCON IS FULL. THIS ERROR MAY OCCUR WHEN THE SPOOL SYSTEM IS COMPETING WITH PROGRAMS USING THEIR OWN SPOOLING FILE AND RUNNING OUTSIDE OF BATCH. "" FMGR-024 NO MORE BATCH SWITCHES THE LU SWITCH TABLE IS FULL. THE SIZE OF THE SWITCH TABLE SPECIFIED AT SYSTEM GENERATION IS INADEQUATE. NOTIFY THE SYSTEM MANAGER OF THIS CONDITION. "" FMGR-023 NO AVAILABLE SPOOL FILES ALL SPOOL FILES ARE CURRENTLY BEING USED. RE-RUN THE JOB AFTER A SPOOL FILE BECOMES AVAILABLE. "" FMGR-022 NO AVAILABLE SPOOL LU'S ALL SPOOL LOGICAL UNITS ARE CURRENTLY UNAVAILABLE. RE-RUN THE JOB AFTER A SPOOL LU BECOMES AVAILABLE. "" FMGR-021 ILLEGAL DESTINATION LU THE LU SPECIFIED WAS NOT ALLOCATED BY GASP. TRY AGAIN USING A LU ALLOCATED BY GASP. "" FMGR-020 ILLEGAL ACCESS LU 1. THE LOGICAL UNIT NUMBER SPECIFIED IN THE LU OR CS COMMAND WAS NOT A POSITIVE LOGICAL UNIT NUMBER. RE-ENTER THE CORRECTED COMMAND. OR 2. THERE IS AN LU ENTRY IN THE CARTRIDGE LIST THAT DOES NOT POINT TO A DISC DEVICE. THIS HAPPENED BECAUSE AFTER THE DISC WAS MOUNTED THE LU COMMAND WAS USED TO DO A LOGICAL UNIT SWITCH ON THE DEVICE. SWITCH THE LU BACK TO ITS DISC DEFINITION. IF DESIRED, DISMOUNT THE DISC. THE LU CAN THEN BE SWITCHED TO A NON-DISC DEVICE. "" FMGR-019 ILLEGAL ACCESS ON A SYSTEM DISC AN ATTEMPT WAS MADE TO WRITE ON A SYSTEM DISC. THE SYSTEM MANAGER IS THE ONLY USER THAT HAS THIS CAPABILITY. "" FMGR-018 ILLEGAL LU ATTEMPT TO ACCESS AN LU THAT IS (1) NOT ASSIGNED TO THE SYSTEM, OR (2) IS NOT DEFINED IN THE USER'S SESSION SWITCH TABLE (SST). "" FMGR-017 ILLEGAL READ/WRITE ON TYPE 0 FILE 1. AN ATTEMPT WAS MADE TO READ, WRITE, OR POSITION A TYPE 0 FILE THAT DOES NOT SUPPORT THE OPERATION. THIS ERROR MAY ALSO OCCUR ON AN ATTEMPT TO PERFORM SUCH AN OPERATION ON A SPOOL FILE WHICH DOES NOT SUPPORT TH*ÏþúE OPERATION (E.G., AN ATTEMPTED WRITE ON A READ- ONLY SPOOL FILE). CHECK THE FILE PARAMETERS OR THE NAMR. 2. WRITING TO A SPOOL FILE AND THERE IS NO MORE ROOM ON CARTRIDGE. "" FMGR-016 ILLEGAL TYPE 0 OR SIZE=0 ONE OF THE FOLLOWING OCCURED: 1) THE WRONG FILE TYPE WAS SPECIFIED, 2) AN ATTEMPT WAS MADE TO CREATE OR PURGE A TYPE 0 FILE, OR 3) THE SIZE SPECIFIED WAS ZERO. CHECK THE SIZE AND TYPE PARAMETERS. "" FMGR-015 ILLEGAL NAME THE FILE NAME DOES NOT CONFORM TO THE SYNTAX RULES. CORRECT THE NAME AND RE-ENTER THE COMMAND. "" FMGR-014 DIRECTORY FULL THERE IS NO MORE ROOM IN THE FILE DIRECTORY. PURGE ANY UNUSED FILES AND PACK THE DISC IF POSSIBLE. OTHERWISE, TRY ANOTHER CARTRIDGE. "" FMGR-013 DISC LOCKED THE CARTRIDGE SPECIFIED IS LOCKED. INITIALIZE THE CARTRIDGE IF IT WAS NOT INITIALIZED, OTHERWISE KEEP TRYING. "" FMGR-012 EOF OR SOF ERROR AN ATTEMPT WAS MADE TO READ, WRITE, OR POSITION A FILE BEYOND THE FILE BOUNDARIES. CHECK THE RECORD POSITION PARAMETERS. THE RESULTS DEPEND ON THE FILE TYPE AND THE CALL. "" FMGR-011 DCB NOT OPEN AN ATTEMPT WAS MADE TO ACCESS AN UNOPENED DCB. USE THE CREATE OR OPEN CALL TO OPEN THE DCB AND CHECK FOR ERRORS. "" FMGR-010 NOT ENOUGH PARAMETERS ONE OR MORE OF THE REQUIRED PARAMETERS WERE OMITTED FROM THE CALL. ENTER THE REQUIRED PARAMETERS. "" FMGR-009 ATTEMPT TO USE APOSN OR FORCE TO 1 A TYPE 0 FILE A TYPE 0 FILE CANNOT BE POSITIONED WITH APOSN OR BE FORCED TO A TYPE 1 FILE. CHECK THE FILE TYPE. "" FMGR-008 FILE OPEN OR LOCK REJECTED AN ATTEMPT WAS MADE TO OPEN A FILE THAT WAS ALREADY OPENED EXCLUSIVELY OR WAS ALREADY OPENED TO SEVEN PROGRAMS, OR THE CARTRIDGE CONTAINING THE FILE IS LOCKED. USE THE CL OR DL COMMAND TO LOCATE THE LOCK. IF THE CARTRIDGE IS BEING PACKED, CHECK TO SEE IF SPOOLING IS SHUT DOWN. "" FMGR-007 ILLEGAL SECURITY CODE OR ILLEGAL WRITE ON LU2 OR 3 1. AN ATTEMPT WAS MADE TO ACCESS A FILE WITHOUT SPECIFYING THE SECURITY CODEŒþú OR WITH THE WRONG SECURITY CODE. FIND OUT THE CORRECT CODE AND USE IT OR DO NOT ACCESS THE FILE. OR 2. AN ATTEMPT WAS MADE BY A SESSION USER (NOT THE SYSTEM MANAGER) TO WRITE ON LU 2 OR 3. SESSION USERS DO NOT HAVE WRITE ACCESS TO LU 2 OR 3. "" FMGR-006 FILE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A FILE THAT CANNOT BE FOUND. CHECK THE FILE NAME OR THE CARTRIDGE REFERENCE. "" FMGR-005 RECORD LENGTH ILLEGAL AN ATTEMPT WAS MADE TO READ OR POSITION A FILE TO A RECORD THAT HAS NOT BEEN WRITTEN, OR TO WRITE AN ILLEGAL RECORD LENGTH ON AN UPDATE. CHECK THE FILE POSITION OR SIZE PARAMETER. "" FMGR-004 RECORD SIZE OF TYPE 2 FILE IS 0 OR UNDEFINED AN ATTEMPT WAS MADE TO CREATE A TYPE 2 FILE WITHOUT SPECIFING THE RECORD SIZE OR SPECIFYING IT TO BE 0. CHECK THE SIZE PARAMETER. "" FMGR-003 BACKSPACE ILLEGAL AN ATTEMPT WAS MADE TO BACKSPACE A DEVICE (OR TYPE 0 FILE) THAT CANNOT BE BACKSPACED. CHECK THE DEVICE TYPE. "" FMGR-002 DUPLICATE FILE NAME A FILE ALREADY EXISTS WITH THE NAME SPECIFIED. REPEAT THE COMMAND WITH A NEW NAME OR PURGE THE EXISTING FILE. "" FMGR-001 DISC ERROR THE DISC IS DOWN. TRY AGAIN AND THEN REPORT THE PROBLEM TO THE SYSTEM MANAGER. "" FMGR 000 BREAK THIS IS AN INFORMATIVE MESSAGE ONLY. NO ERROR HAS OCCURRED. "" FMGR 001 DISC ERROR - LU REPORTED THE DISC ASSOCIATED WITH THE LU REPORTED IS DOWN. REPORT THE PROBLEM TO THE SYSTEM MANAGER. EXAMPLE: FMGR 001 THIS 2-LINE MESSAGE INDICATES A DISC ERROR FMGR 034 HAS BEEN DETECTED ON DISC LU 34. "" FMGR 002 INITIALIZE LU 2! THIS ERROR INDICATES A REQUEST FOR THE USER TO INITIALIZE THE SYSTEM DISC (LU 2) BY ASSIGNING SPECIFIC SYSTEM TRACKS TO FMGR. BEFORE IT IS INITIALIZED, FMGR OBTAINS ALL THE AVAILABLE TRACKS ON THE SYSTEM AND AUXILIARY DISCS AND ASSIGNS THEM TO ITSELF. AFTER IT IS INITIALIZED, FMGR OWNS ONLY THOSE TRACKS SPECIFICALLY ASSIGNED TO IT. THEREAFTER, EACH TIME THE SYSTEM IS LOADED FRW»þúOM DISC (BOOTED UP), IT RECOVERS THESE TRACKS AUTOMATICALLY AND NO FURTHER INITIALIZATION IS REQUIRED. TO INITIALIZE THE SYSTEM DISC, USE THE FMGR INITIALIZE (IN) COMMAND. EXAMPLE: IN,SC,-2,2,SYS,100 THIS COMMAND WOULD INITIALIZE LU 2, SETTING THE MASTER SECURITY CODE TO "SC", THE CRN TO 2, THE ASCII LABEL TO "SYS" AND THE STARTING FMP DISC TRACK TO 100. THE STARTING FMP TRACK MUST BE AT LEAST 8 TRACKS GREATER THAN THE LAST TRACK USED BY THE SYSTEM. (SYSTEM SIZE IS REPORTED AT THE END OF SYSTEM GENERATION.) "" FMGR 003 INITIALIZE LU 3! THIS ERROR INDICATES A REQUEST FOR THE USER TO INITIALIZE THE AUXILIARY DISC (LU 3) BY ASSIGNING SPECIFIC SYSTEM TRACKS TO FMGR. BEFORE IT IS INITIALIZED, FMGR OBTAINS ALL THE AVAILABLE TRACKS ON THE SYSTEM AND AUXILIARY DISCS AND ASSIGNS THEM TO ITSELF. AFTER IT IS INITIALIZED, FMGR OWNS ONLY THOSE TRACKS SPECIFICALLY ASSIGNED TO IT. THEREAFTER, EACH TIME THE SYSTEM IS LOADED FROM DISC (BOOTED UP), FMGR RECOVERS THESE TRACKS AUTOMATICALLY AND NO FURTHER INITIALIZATION IS REQUIRED. TO INITIALIZE THE AUXILIARY DISC, USE THE FMGR INITIALIZE (IN) COMMAND. EXAMPLE: IN,SC,-3,3,AUX,70 THIS COMMAND WOULD INITIALIZE LU 3, SETTING THE CRN TO 3, THE ASCII LABEL TO "AUX" AND THE STARTING FMP DISC TRACK TO 70. IF AUXILIARY DISC TRACKS ARE NOT TO BE ASSIGNED TO FMGR, THE INITIALIZE COMMAND SHOULD STILL BE SPECIFIED IN RESPONSE TO FMGR 003, BUT THE CARTRIDGE REFERENCE NUMBER SHOULD BE SPECIFIED AS 0. "" FMGR 004 ILLEGAL RESPONSE TO FMGR 002 OR FMGR 003 A COMMAND OTHER THAN AN INITIALIZE COMMAND WAS ENTERED IN RESPONSE TO EITHER A FMGR 002 OR FMGR 003 ERROR. ENTER THE APPROPRIATE INITIALIZE COMMAND. "" FMGR 005 REQUIRED TRACK NOT AVAILABLE - RELATIVE TAT POSITION REPORTED THE FIRST TRACK SPECIFIED IN THE INITIALIZE COMMAND IS NOT AVAILABLE. NOTE THAT THE STARTING TRACK MUST BE AT LEAST 8 TRACKS GREATER THAN THE LAST TRACK USED BY THE SYSTEM. RE-ENTER THE INITIALIZE COMMAND ­RþúWITH THE FIRST AVAILABLE TRACK REPORTED IN THIS MESSAGE. "" FMGR 006 FMGR SUSPENDED THE FILE MANAGER SUSPENDED ITSELF. READY THE DOWN DEVICE AND ENTER 'GO,FMGR'. "" FMGR 007 CHECKSUM ERROR A CHECKSUM ERROR OCCURRED WHEN READING A PAPER TAPE OR THE FILE BEING READ IS NOT BINARY (TYPE 5 OR 7). CHECK THE FILE TYPE. "" FMGR 008 D.RTR NOT LOADED THE PROGRAM D.RTR WAS NOT FOUND IN THE SYSTEM. LOAD D.RTR AS A PERMANENT PROGRAM. "" FMGR 009 ID SEGMENT NOT FOUND AN RP COMMAND WAS USED TO DEALLOCATE OR REASSIGN THE ID SEGMENT TO THE PROGRAM BEING RESTORED. THE SYSTEM LOOKS FOR A BLANK ID SEGMENT. "" FMGR 010 INPUT ERROR A SYNTAX ERROR IN THE STATEMENT OCCURRED. LOOK FOR A MISSING COLON (BATCH INPUT) OR EXTRA COLON (INTERACTIVE INPUT), AN UNDEFINED COMMAND, AN ERROR IN THE NAMR SUBPARAMETERS, A COMMAND THAT IS TOO LONG, ETC. RE-ENTER THE COMMAND. IF RECEIVED AFTER ENTERING AN ABORT COMMAND, THERE WERE NO ACTIVE JOBS. "" FMGR 011 DO 'OF,XXXXX,8' ON NAMED PROGRAMS AN ATTEMPT WAS MADE TO PACK A DISC TO WHICH THE NAMED PROGRAMS ARE STILL ALLOCATED. ENTER EITHER 'RP,NAMR,PROGRAM' OR 'OF,PROGRAM,8' TO REMOVE THE NAMED PROGRAMS. "" FMGR 012 DUPLICATE DISC LABEL OR LU AN ATTEMPT WAS MADE TO MOUNT A CARTRIDGE THE SAME LABEL OR LOGICAL UNIT NUMBER OF A CARTRIDGE THAT IS ALREADY MOUNTED. RE-ENTER THE THE COMMAND WITH ANOTHER LABEL OR LU, OR DISMOUNT THE DUPLICATE CARTRIDGE. THE ERROR MAY ALSO OCCUR IF THE USER DISMOUNTS A PRIVATE CARTRIDGE FROM HIS SESSION AND ATTEMPTS TO RE-MOUNT IT AS A GROUP CARTRIDGE, OR CONVERSELY, IF HE DISMOUNTS A GROUP CARTRIDGE FROM HIS SESSION AND ATTEMPTS TO RE-MOUNT IT AS A PRIVATE CARTRIDGE (DEFAULT). "" FMGR 013 TR STACK OVERFLOW MORE THAN 10 NESTED TR COMMANDS HAVE BEEN USED. "" FMGR 014 REQUIRED ID SEGMENT NOT FOUND AN ID SEGMENT CANNOT BE FOUND FOR THE SPECIFIED PROGRAM. CHECK THE PROGRAM NAME OR LOAD THE PROGRAM. A BLANK ID SEGMENT CANNOT BE FOUND FOR A PROGRAM BEING RESTORED¢Ðþú. ENTER AN 'OF' COMMAND TO RELEASE AN ID SEGMENT. "" FMGR 015 LS TRACK REPORT THIS IS AN INFORMATIVE MESSAGE TO REPORT THE LOGICAL UNIT NUMBER AND TRACK OF THE CURRENT LS AREA. "" FMGR 016 INSUFFICIENT SYSTEM TRACKS FOR RP AN ATTEMPT WAS MADE TO RESTORE A PROGRAM FILE THAT IS NOT ON THE SYSTEM OR AUXILIARY DISC AND THERE IS INSUFFICIENT SPACE IN THE SYSTEM TRACK POOL TO COPY THE PROGRAM. EITHER WAIT UNTIL MORE TRACK POOL SPACE BECOMES AVAILABLE, OR MOVE THE FILE TO LU 2 OR LU 3, AND THEN RE-ENTER THE COMMAND. "" FMGR 017 ID SEGMENT NOT SET UP BY RP IN ORDER FOR AN ID SEGMENT TO BE RELEASED BY A 'RP' COMMAND, IT MUST HAVE BEEN SET UP BY A 'RP' COMMAND. TRY USING 'OF,PROGRAM' TO RELEASE THE SPECIFIED PROGRAM. "" FMGR 018 PROGRAM NOT DORMANT AN 'RP,NAMR,PROGRAM' COMMAND WAS ATTEMPTED WHEN THE PROGRAM IS ACTIVE. ENTER 'OF,PROGRAM' AND THEN REPEAT THE 'RP' COMMAND. "" FMGR 019 FILE NOT SET UP BY SP ON CURRENT SYSTEM THE PROGRAM FILE BEING RESTORED HAD A PARITY ERROR, WAS NOT SET UP CORRECTLY, OR WAS NOT SET UP BY A 'SP' COMMAND IN THE CURRENT SYSTEM. RELOAD THE PROGRAM AND TRY AGAIN. "" FMGR 020 ILLEGAL TYPE 0 FILE AN ATTEMPT WAS MADE TO CREATE A TYPE 0 FILE ON A LOGICAL UNIT THAT IS NOT ASSIGNED IN THE SYSTEM. RE-ENTER THE COMMAND USING ANOTHER LOGICAL UNIT. "" FMGR 021 ILLEGAL DISC SPECIFIED AN ATTEMPT WAS MADE TO COPY FILES TO OR FROM THE SAME DISC OR A DISC THAT IS NOT MOUNTED. MOUNT ANOTHER DISC OR USE ANOTHER ALREADY MOUNTED. "" FMGR 022 COPY TERMINATED COPY HAS BEEN TERMINATED AS A RESULT OF COPY ERROR. CHECK THE PARAMETERS AND THE SPECIFIED DISCS. "" FMGR 023 DUPLICATE PROGRAM NAME THE PROGRAM BEING RESTORED IS ALREADY DEFINED IN THE SYSTEM. CHANGE THE NAME OF THE PROGRAM, ENTER 'OF,PROGRAM', OR RELEASE THE ID SEGMENT. "" FMGR 041 PROGRAM CANNOT BE A SEGMENT THE PROGRAM SPECIFIED IS A PROGRAM SEGMENT (TYPE 5). LS TRACKS CANNOT BE ASSIGNED TO A PROGRAM SEGMENT. ORDINARILY, THE LÈþúLS TRACKS ARE ASSIGNED TO THE PROGRAM EDITR WHEN MS IS EXECUTED. IF THE LS TRACKS ARE TO BE ASSIGNED TO A DIFFERENT PROGRAM, SPECIFY THIS PROGRAM'S NAME. "" FMGR 042 LU CANNOT BE SWITCHED AN ATTEMPT WAS MADE TO SWITCH A LOGICAL UNIT WHICH CANNOT BE SWITCHED. IF A DISC LU, THE SESSION LU MUST BE THE SAME AS THE SYSTEM LU. SESSION LU 1 CANNOT BE SWITCHED. "" FMGR 043 LU NOT FOUND IN SST AN ATTEMPT WAS MADE TO ACCESS A LOGICAL UNIT THAT IS NOT DEFINED IN THE USER'S SESSION SWITCH TABLE. USE THE SL COMMAND TO ADD THE LU TO THE SST. "" FMGR 044 NO MESSAGES WAITING CALLER ISSUED A ME COMMAND BUT THERE WERE NO MESSAGES WAITING TO BE READ. "" FMGR 045 SESSION COMMAND ONLY THE SPECIFIED COMMAND OPERATES ONLY IN THE SESSION ENVIRONMENT. "" FMGR 046 INSUFFICIENT CAPABILITY AN ATTEMPT WAS MADE TO EXECUTE A COMMAND THAT REQUIRES A HIGHER CAPABILITY LEVEL THAN THE CAPABILITY LEVEL DEFINED FOR THIS SESSION USER. THE USER'S CAPABILITY LEVEL CAN BE DISPLAYED USING THE FMGR COMMAND :DP,9P. TO INCREASE YOUR COMMAND CAPABILITY LEVEL, SEE THE SYSTEM MANAGER. "" FMGR 047 SPOOL SET UP FAILED THERE ARE NO AVAILABLE SPOOL FILES OR LOGICAL UNITS, OR THE LOGICAL UNIT TABLE IS FULL. YOU CAN TRY RUNNING THE JOB AGAIN, BUT IF THE ERROR IS FROM A LACK OF SPOOL LOGICAL UNITS OR THE LOGICAL UNIT TABLE BEING FULL YOU MUST RECONFIGURE. "" FMGR 048 GLOBAL SET OUT OF RANGE A GLOBAL WAS SPECIFIED OUT OF THE RANGE OF THE GLOBALS. CHECK THE PARAMETERS AND RE-ENTER THE COMMAND CORRECTLY. "" FMGR 049 CAN'T RUN RP'ED PROGRAM THE PROGRAM RESTORED FROM THE FILE DOES NOT EXECUTE. USUALLY THIS IS CAUSE BY ATTEMPTING TO RUN A SEGMENT OF THE SPECIFIED PROGRAM. CHECK THE PROGRAM. "" FMGR 050 NOT ENOUGH PARAMETERS LESS THAN THE REQUIRED NUMBER OF PARAMETERS WERE SPECIFIED. RE-ENTER COMMAND CORRECTLY. "" FMGR 051 ILLEGAL MASTER SECURITY CODE AN ATTEMPT WAS MADE TO RE-INITIALIZE A CARTRIDGE OR LIST FILES WITH AN INCORRECT MASTER SECQÄþúURITY CODE. RE-ENTER THE COMMAND WITH THE CORRECT CODE. "" FMGR 052 ILLEGAL LU 1. AN ATTEMPT WAS MADE TO SWITCH A SESSION LU TO A SYSTEM LU WHICH IS A DISC, BUT THE SESSION LU NUMBER DOES NOT EQUAL THE SYSTEM LU NUMBER. (FOR DISCS, THE MAPPING FROM SESSION LU TO SYSTEM LU MUST BE DIRECT.) OR 2. ILLEGAL LU(S) SPECIFIED IN THE SL COMMAND. CHECK THAT THE LU IS POSITIVE AND LESS THAN THE LARGEST LU DEFINED IN THE SYSTEM, AND THAT THE SESSION LU IS LESS THAN 64. OR 3. AN ATTEMPT WAS MADE TO INITIALIZE THE FILE MANAGER USING A LOGICAL UNIT OTHER THAN LU 2 OR 3. THE RESPONSE TO THE FMGR 002 MESSAGE MUST BE A COMMAND TO INITIALIZE LU 2. THE RESPONSE TO THE FMGR 003 MESSAGE MUST BE A COMMAND TO INITIALIZE LU 3. "" FMGR 053 ILLEGAL LABEL OR ILABEL THE SPECIFIED CARTRIDGE REFERENCE NUMBER OR CARTRIDGE ID IS ILLEGAL. THE CARTRIDGE REFERENCE NUMBER MUST BE A POSITIVE NON-ZERO INTEGER AND THE CARTRIDGE ID MUST BE A LEGAL FILE NAME. "" FMGR 054 DISC NOT MOUNTED AN ATTEMPT WAS MADE TO DISMOUNT OR REFERENCE A DISC CARTRIDGE NOT MOUNTED TO THE CALLER. TO REFERENCE IT, MOUNT THE DISC CARTRIDGE USING THE "MC" COMMAND. IF UNDER SESSION CONTROL, THE "AC" COMMAND COULD BE USED INSTEAD TO ALLOCATE DISC SPACE WITH THE SPECIFIED CRN. THIS ERROR ALSO OCCURS IF AN ATTEMPT IS MADE BY A SESSION USER (NOT THE SYSTEM MANAGER) TO DISMOUNT A SYSTEM DISC. A SESSION USER IS ALLOWED ACCESS TO A SYSTEM DISC EVEN THOUGH IT DOES NOT REALLY BELONG TO HIM, I.E. HE HAS NO CONTROL OVER THE MOUNTING OR THE DISMOUNTING OF IT. "" FMGR 055 MISSING PARAMETER A REQUIRED PARAMETER HAS BEEN OMITTED. CHECK THE COMMAND AND RE-ENTER IT WITH THE MISSING PARAMETER. "" FMGR 056 BAD PARAMETER A PARAMETER WAS SPECIFIED INCORRECTLY OR A TRACK PARAMETER SPECIFIES A TRACK THAT IS OUTSIDE THE RANGE OF THE FMGR TRACKS. CHECK THE COMMAND AND RE-ENTER IT CORRECTLY. "" FMGR 057 BAD TRACK NOT IN FILE AREA THE SPECIFIED TRACK IS IN THE SYSTEM AREA ÊþúOR IS A DIRECTORY TRACK. CORRECT THE COMMAND AND RE-ENTER IT. "" FMGR 058 LG AREA EMPTY AN ATTEMPT WAS MADE TO SAVE THE CONTENTS OF THE LG AREA WHICH IS EMPTY. USE THE MR COMMAND TO MOVE A FILE TO THE LG AREA. "" FMGR 059 REPORTED TRACK UNAVAILABLE A RE-INITIALIZATION ATTEMPT WILL LOWER THE FIRST TRACK INTO THE SYSTEM AREA. THE LAST TRACK IS REPORTED. RE-ENTER THE COMMAND WITH THE FIRST TRACK SPECIFIED AS THE LAST TRACK + 8 (THE MINIMUM). "" FMGR 060 DO YOU REALLY WANT TO PURGE THIS DISC? A RE-INITIALIZATION ATTEMPT WILL RAISE THE FIRST TRACK OR LOWER THE DIRECTORY TRACKS INTO THE FILE AREA AND DESTROY A FILE. ENTER '??' OR 'NO' TO STOP THE REINITIALIZATION. ENTER 'YES' TO CONTINUE. "" FMGR 061 DO A "DC" AND A "MC" ON THIS CR AN ATTEMPT WAS MADE TO REPLACE A MOUNTED CARTRIDGE WITH AN CARTRIDGE THAT HAS NOT BEEN PREVIOUSLY INITIALIZED WITHOUT ENTERING A 'DC' AND A 'MC' COMMAND. ENTER A 'DC' AND 'MC' COMMAND FOR THIS CARTRIDGE. NOTE: BE SURE TO DO A DC SPECIFING THE RELEASE RESOURCES "RR" OPTION. "" FMGR 062 MORE THAN 63 DISCS AN ATTEMPT WAS MADE TO MOUNT THE 64TH CARTRIDGE (THE LIMIT IS 63 CARTRIDGES). DISMOUNT A CARTRIDGE TO MAKE ROOM, IF POSSIBLE. "" FMGR 063 EXCEEDING SESSION DISC LIMIT AN ATTEMPT IS BEING MADE TO MOUNT MORE DISCS TO A SESSION THAN IS ALLOWED IN THE USER'S ACCOUNT. DISMOUNT AN UNUSED DISC AND RE-ENTER THE COMMAND. TO INCREASE YOUR ACCOUNT'S DISC LIMIT, CONSULT THE SYSTEM MANAGER. "" FMGR 064 NO DISC AVAILABLE FROM DISC POOL ALL DISCS IN DISC POOL ARE ALLOCATED OR THERE ARE NO DISCS AVAILABLE THAT ARE BIG ENOUGH. THIS ERROR CAN ALSO OCCUR IF # DIRECTORY TRACKS SPECIFIED IS TOO LARGE. #DIRECTORY TRACKS SPECIFIED MUST BE A REASONABLE NUMBER IN RELATIONSHIP TO THE TOTAL NUMBER OF TRACKS ON THE DISC. IF DISC SPACE IS BEING ALLOCATED FROM THE DISC POOL AND SIZE WAS NOT SPECIFIED (I.E. FIRST FREE DISC IS ALLOCATED), THE MOUNT ROUTINE WILL CONTINUE TO SEARCH THE DISC POOL UNTIL A DISC IS FOUND THAT W8¹þúIL PASS THE "REASONABLE" TEST. IN THIS CASE, IT IS POSSIBLE THAT EVEN THOUGH THERE ARE FREE DISCS IN THE POOL, NONE WILL BE ALLOCATED BECAUSE # DIRECTORY TRACKS WAS SO LARGE. "" FMGR 065 CONFLICT IN SST DEFINITION THE SPECIFIED LU NUMBER IS ALREADY DEFINED AS A SESSION LU IN THE USER'S SESSION SWITCH TABLE (SST). THIS WILL OCCUR IF THE USER HAS SPECIFIED A DISC LU NUMBER IN THE MOUNT COMMAND, BUT THIS NUMBER IS ALREADY DEFINED IN THE SST. IF IT IS NECESSARY TO MOUNT THIS DISC LU, CHANGE THE CONFLICTING ENTRY IN THE SST. THIS CAN BE DONE BY USING THE SL COMMAND TO REMOVE THE SST ENTRY WITH THE CONFLICTING SESSION LU AND, IF DESIRED, RE-ENTERING IT IN THE SWITCH TABLE WITH A DIFFERENT SESSION LU NUMBER. "" FMGR 066 NO ROOM IN SST THERE ARE NO SPARE ENTRIES LEFT IN THE SESSION SWITCH TABLE. SPARE ENTRIES CAN BE RECOVERED BY USING THE :SL,LU,- COMMAND, WHERE LU IS A SESSION LOGICAL UNIT NUMBER THAT IS NOT NEEDED. "" FMGR 067 PROGRAM NOT FOUND THE PROGRAM TO BE EXECUTED WAS NOT FOUND AMONG THE SYSTEM ID SEGMENTS, NOR WAS IT FOUND AS A TYPE 6 FILE ON A SYSTEM DISC. CHECK THE PROGRAM NAME SPECIFIED FOR CORRECTNESS OR RELOAD THE PROGRAM. ON A HE (HELP) COMMAND, THE FMGR 067 ERROR INDICATES THE PROGRAM HELP COULD NOT BE FOUND. ON A WH (WHZAT) COMMAND, THE ERROR INDICATES THE PROGRAM WHZAT COULD NOT BE FOUND. "" FMGR 068 LU NOT IN VARIABLE PART OF SST ONLY LU'S IN THE VARIABLE PART OF THE SESSION SWITCH TABLE (SST) MAY BE DELETED. "" FMGR 069 JOB LOGON FAILED THE JOB ACCOUNT COULD NOT BE LOGGED ON. THE REASON FOR THE FAILURE IS PRINTED ON THE SYSTEM CONSOLE. "" FMGR 070 SECTORS/TRACK VALUE TOO LARGE THE SECTORS PER TRACK VALUE SPECIFIED IN THE INITIALIZE COMMAND IS LARGER THAN THE ACTUAL SECTORS PER TRACK VALUE FOR THE DISC. LET THE SECTORS PER TRACK PARAMETER DEFAULT TO THE ACTUAL SECTORS PER TRACK VALUE FOR THE DISC, OR SPECIFY A SMALLER VALUE. "" FMGR 071 DO "EX,SP" TO SAVE OR "EX,RP" TO RELEASE PRIVATE CARTRE¡þúIDGES AN ATTEMPT WAS MADE TO LOG-OFF WITH A PRIVATE DISC(S) STILL MOUNTED TO THE USER'S SESSION. SPECIFYING "EX,RP" WILL RELEASE THE USER'S PRIVATE DISC(S); IF THE DISC WAS ALLOCATED FROM THE DISC POOL, IT IS RETURNED TO THE POOL FOR POSSIBLE RE-ALLOCATION TO ANOTHER USER. IF "EX,SP" IS SPECIFIED, THE USER'S PRIVATE DISC(S) WILL REMAIN MOUNTED TO THIS USER; ON THE NEXT LOG-ON BY THIS USER, THE DISC(S) WILL BE MOUNTED TO THE NEW SESSION. NOTE THAT GROUP DISCS ARE, BY DEFAULT, LEFT MOUNTED AT LOG-OFF. TO RELEASE GROUP DISCS AT LOG-OFF, SPECIFY "EX,,RG". "" FMGR 072 LU NOT INTERACTIVE THE LOGICAL UNIT SPECIFIED IN A CT COMMAND MUST REFER TO AN INTERACTIVE DEVICE. "" FMGR 073 ACCOUNT NOT FOUND AN ATTEMPT WAS MADE TO SEND A MESSAGE TO A USER FOR WHOM AN ACCOUNT DOES NOT EXIST. CHECK THE USER.GROUP NAME OR THE ORDER OF THE PARAMETERS IN THE SM COMMAND FOR CORRECTNESS. "" FMGR 074 JO COMMAND EXPECTED THE FIRST COMMAND IN A JOB MUST BE, AND WAS NOT, A JO COMMAND. "" FMGR 075 CAN'T RESTORE TYPE 6 PGM (USER PROTECTED) THE SPECIFIED PROGRAM IS SAVED AS A TYPE 6 FILE WITH USER PROTECTION ("SP,PROG,PR"). IT CAN ONLY BE RUN OR RP'ED FROM THE TYPE 6 FILE BY THE USER WHO ISSUED THE SP COMMAND, OR BY USERS WHO ARE LINKED TO THE ACCOUNT OF THE USER WHO ISSUED THE SP COMMAND. "" FMGR 076 CAN'T RESTORE TYPE 6 PGM (GROUP PROTECTED) THE SPECIFIED PROGRAM IS SAVED AS A TYPE 6 FILE WITH GROUP PROTECTION ("SP,PROG,GR"). IT CAN ONLY BE RUN OR RP'ED FROM THE TYPE 6 FILE BY USERS BELONGING TO THE SAME GROUP AS THE USER WHO ISSUED THE SP COMMAND. "" FMGR 077 CAN'T RESTORE TYPE 6 PGM (INSUFFICIENT CAPABILITY) THE SPECIFIED PROGRAM IS SAVED AS A TYPE 6 FILE WITH CAPABILITY LEVEL PROTECTION ("SP,PROG,,CAP", WHERE CAP IS THE MINIMUM CAPABILITY LEVEL REQUIRED TO RUN OR RP THE PROGRAM). THE PROGRAM CAN ONLY BE RUN OR RP'ED FROM THE TYPE 6 FILE BY USERS POSSESSING A CAPABILITY LEVEL GREATER THAN OR EQUAL TO THE LEVEL SPECIFIED WHEN THE PROGRAM WAYþúS SP'ED. FOR EXAMPLE, THE COMMAND "SP,PROG,,50" WILL SAVE PROGRAM "PROG" AND ONLY USERS WITH A CAPABILITY LEVEL OF 50 OR GREATER WILL BE ALLOWED TO RUN OR RP THE PROGRAM FROM THE TYPE 6 FILE. NOTE THAT COMMAND CAPABILITY CHECKING IS STILL IN EFFECT. (THE USER STILL MUST HAVE SUFFICIENT CAPABILITY TO INVOKE THE RU OR RP COMMAND, REGARDLESS OF THE CAPABILITY LEVEL SPECIFIED IN THE SP COMMAND.) "" FMGR 078 CAN'T RESTORE TYPE 6 PGM (INTERNAL ERROR) INTERNAL CONSISTENCY CHECKS HAVE FAILED WHILE ATTEMPTING TO RESTORE A PROGRAM FILE. "" FMGR 079 WARNING - RECORDS TRUNCATED TO 128 WORDS IN A TYPE 2 FILE, RECORDS WHICH ARE LONGER THAN 128 WORDS HAVE BEEN TRUNCATED TO 128 WORDS. "" READ 001 THE REQUESTED MAG TAPE UNIT IS DOWN. USE THE "UP" COMMAND (SPECIFYING THE APPROPRIATE EQT) TO ENABLE THE DEVICE. "" READ 002 THE MAG TAPE READT IS TRYING TO RESTORE CONTAINS INFORMATION IN A FORMAT NOT RESTORABLE BY READT. THE TAPE MAY HAVE BEEN SAVED WITH ANOTHER UTILITY, OR IT MAY HAVE BEEN CONSTRUCTED THROUGH THE FMGR'S "DU" OR "ST" COMMANDS. IN ANY CASE READT CANNOT RESTORE THE DATA. THIS ERROR WILL ALSO RESULT WHEN THE NEXT TAPE OF A TWO OR MORE TAPE CARTRIDGE IS NOT THE CORRECT ONE. MOUNT THE CORRECT TAPE AND DO AS THE UTILITY SUGGESTS. "" READ 003 THE MAG TAPE UNIT YOU WISH TO USE IS LOCKED TO SOME PROCESS. FIND OUT WHO CURRENTLY HAS THE MAG TAPE LOCKED (.E.G. RU,WHZAT) AND WAIT UNTIL IT'S RELEASED OR HAVE THE USER RELEASE IT FOR YOU. "" READ 004 THE PARAMETER DESCRIBING THE DESIRED MAG TAPE UNIT DOES NOT SATISFY READT'S REQUIREMENTS FOR A LEGAL MAG TAPE LU. THE POSSIBLE CAUSES FOR THIS ERROR INCLUDE: 1. THE SPECIFIED MAG TAPE LU IS NOT BETWEEN -63 AND +63. 2. THE DRIVER OF THE SPECIFIED LU IS NOT A MAG TAPE DRIVER. "" READ 005 THE DESIRED MAG TAPE UNIT IS OFF-LINE. THE ON-LINE BUTTON MUST BE DEPRESSED TO ENABLE THE ON-LINE SWITCH. "" READ 006 READT REJECTED THE USE OF THE SPECIFED DISC LU. THERE ARE A VARIETY OF REASONS FOR TשZXTHIS, THEY INCLUDED: 1. THE DISC LU NUMBER MUST BE A NEGATIVE NUMBER BUT NO SMALLER THAN -63. 2. THE DESIRED DISC LU IS NOT IN YOUR SST. 3. THE DRIVER TYPE OF THE REQUESTED DISC LU IS NOT A DISC DRIVER. "" READ 007 THE DRIVER DETECTED A PARITY ERROR WHEN READING FROM THE MAG TAPE. IF THIS HAPPENS AGAIN THE TAPE MAY BE IRRECOVERABLE. CALL THE SYSTEM MANAGER. AGAIN, IF IT OCCURS THEN THE TAPE MAY BE IRRECOVERABLE. CALL SYSTEM MANAGER. "" READ 008 THE END OF TAPE WAS REACHED. MOUNT THE FOLLOWING TAPE TO READ THE REMAINING PORTIONS OF THE CARTRIDGE. TO CONTINUE THE PROGRAM ENTER "GO". TO HALT THE PROCESS ENTER "AB". NOTE HOWEVER THAT A REPLY OF AN "AB" WHEN RUNNING READT WILL CAUSE AN INCOMPLETE CARTRIDGE TO BE PRESENT ON THE SYSTEM. "" READ 009 THE DESIRED CARTRIDGE HAS A FILE OPEN OR THE CARTRIDGE IS LOCKED TO ANOTHER PROGRAM. TRY DOING A DL ON THAT CARTRIDGE AND FIND OUT WHAT'S LOCKING THE PROGRAM OR WHAT FILE IS OPEN. "" READ 010 YOU ARE OPERATING IN A NONSESSION ENVIRONMENT. AN LU MUST BE SPECIFEID (NEGATIVE LU) SINCE THERE ISN'T A FREE DISC POOL. "" ^ÙZÿÿ ÿý4H ÿ92067-18124 2026 S C0122 &D.RTR DIRECTORY MANAGER              H0101 ªþúASMB,R,L,C,Q HED RTE FILE MANAGER DIRECTORY ROUTINE **************** * NAME: D.RTR * SOURCE: 92067-18124 * RELOC: 92067-16124 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM D.RTR,131,1 92067-16124 REV.2026 800428 EXT EXEC,PRTN,P.PAS,XLUEX EXT .DAD,.DNG,GTSCB EXT $CL1,$CL2,$$CPU EXT $SMLK,$SMST,$SMID,$SMGP SUP * * * RTE FMP DIRECTORY ROUTINE NOV/72**GAA * MODIFIED TO REUSE DISC SPACE MAR/76**GAA * MODIFIED TO USE RTE-IV TABLE AREA 2 OCT/77**BL * MODIFIED TO TRUNCATE TYPE 6 FILES JAN/78**GLM * CORRECTLY * MODIFIED FOR SESSION MONITOR PROJECT FEB/78**NR * * * DISC BUFFER MANAGEMENT * * THIS PROGRAM DECLARES A BUFFER OF 6144 WORDS - ONE 96 SECTOR TRACK. * THIS IMPLIES D.RTR SHOULD BE DISC RESIDENT. HOWEVER THIS PROGRAM WILL * WORK WITH ANY DECLARED BUFFER SIZE >= 128 WORDS. IT WILL ALSO HANDLE * ANY TRACK SIZE. * * FOR OPTIMAL EFFICIENCY, LENGTH OF THE DECLARED BUFFER SHOULD BE THE TRACK * SIZE OF THE DISC WITH THE LARGEST TRACK THAT WILL BE ACCESSED. * * THIS PROGRAM ASSUMES A SECTOR SKIP VALUE OF 7. * * * NOTE: THE AMOUNT OF DISC BUFFER THAT IS USED BY D.RTR IS INDICATED BY THE * FOLLOWING CONDITIONS: * * BUFFER SIZE = 128 * (N * 7 + 1) * WHERE N IS A POSITIVE INTEGER * BUFFER SIZE <= SUPPLIED BUFFER SIZE * BUFFER SIZE <= TRACK SIZE * BUFFER SIZE = MAX DISC READ LENGTH * THAT IS, BUFFER SIZES USED ARE 128, 1024, 1920, 281êþú6, 3712, 4608, * 5504, 6400, 7296, 8192, ... OR EXACTLY THE TRACK SIZE. * SKP * * THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT * SYSTEM (FOR RTE-IV). IT OWNS THE DIRECTORY AND PERFORMS ALL * WRITES ON IT. * * PROGRAMS WISHING TO ACCESS THE DIRECTORY MUST * SCHEDULE (WITH WAIT) THIS PROGRAM. * * * * CALLING SEQUENCES TO D.RTR * * * * 1. OPEN * * P1. 1,ID (BIT 15 SET) * P2. BIT 15 SET = SESSION MONITOR OVERRIDE (ALL DISCS) * BIT 14 SET = SESSION MONITOR OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET = SESSION MONITOR OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN, 0 * P4. SECURITY CODE * * STRING: 1. E,NAME(1,2) E - BIT 15 = SET IF EXCLUSIVE OPEN * 2. S,NAME(3,4) S - BIT 15 = SCRATCH FILE PURGE * 3. NAME(5,6) * 2. CLOSE * * P1. ID * P2. 0 * P3. -\ DIRECTORY * P4. -/ ADDRESS * * STRING: 1. -\ NEGATIVE - DOUBLE WORD # OF SECTORS TO BE TRUNCATED * 2. -/ POSITIVE - PURGE EXTENTS ONLY * * * 3. CREAT * * P1. ID * P2. 1 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN, 0 * * STRING: 1. NAME(1,2) * 2. NAME(3,4) * 3. NAME(5,6) * 4. TYPE * 5. * 6. DOUBLE WORD SIZE IN +(SECTORS) OR -(128 BLOCK CHUNKS) * 7. OR DOUBLE WORD -1 = ALLOCATE REST OF DISC (<=32767X128) * OR SINGLE WORD -1 = ALLOCATE REST OF DISC (<=32767) * 8. RECORD LENGTH * 9. SECURITY CODE SKP * * * 4. CHANGE NAME * * P1. ID * P2. 2 * P3. -\ DIRECTORY * P4. -/ ADDRESS * * STRING: 1. -\ 6-CHARACTER * 2. -> NEW * íjþú 3. -/ NAME * * * * 5. SET, CLEAR LOCK * * P1. ID * P2. 3 FOR SET, 5 FOR CLEAR * BIT 15 SET = SESSION MONITOR OVERRIDE (ALL DISCS) * BIT 14 SET = SESSION MONITOR OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET = SESSION MONITOR OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN 0 NOT LEGAL * * * * 6. EXTENSION OPEN * * P1. ID * P2. 6 FOR READ, 8 FOR WRITE * P3. -\ DIRECTORY ADDRESS * P4. -/ OF MAIN FILE * P5. EXTENT NUMBER * * * * 7. GENERATE, PACK, UPDATE * * P1. ID * P2. 7 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN 0 NOT LEGAL * P4. S, #SECTORS/TRACK S - BIT 15 = SET IF DISC DIRECTORY UPDATE * * STRING: 1. -\ DATA TRACK * 2. -/ ADDRESS * * * SKP * * 8. PACK * * P1. ID * P2. 9 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN 0 NOT LEGAL * P4. RELATIVE DIRECTORY SECTOR * * STRING: -\ 128-WORD * -\ DIRECTORY * -/ SECTOR TO * -/ BE WRITTEN * * * * 9. MOUNT CARTRIDGE * * P1. ID * P2. 13 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU 0 NOT LEGAL * P4. SCB ADDRESS IF MOUNTING TO SESSION OTHER THAN THE ONE * OPERATING UNDER. * P5. ID TO WHICH DISC IS TO BE MOUNTED * BIT 15 = 1 - INITIALIZE THE DIRECTORY * * STRING: -\ 1ST 9 WORDS OF úgþú* -\ CARTRIDGE * -/ SPECIFICATION * -/ ENTRY * * * * 10. REMOVE CARTRIDGE * * P1. ID * P2. 11 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU 0 NOT LEGAL * P4 SCB ADDRESS IF DISMOUNTING FROM SESSION OTHER THAN ONE * OPERATING UNDER. * * * * 11. ALTER CL ENTRY * * P1. ID * P2. 15 BIT 15 SET - SES MONIT OVERRIDE (ALL DISCS) * BIT 14 SET - SES MONIT OVERRIDE (PRIV,GROUP,SYST ONLY) * BIT 13 SET - SES MONIT OVERRIDE (SYSTEM DISCS ONLY) * P3. -LU, +CRN 0 NOT LEGAL * * STRING: -\ 4 WORD * -\ CARTRIDGE * -/ DIRECTORY * -/ ENTRY * * SKP * * * ID - ID SEGMENT ADDRESS OF CALLING PROGRAM * * * * DIRECTORY ADDRESS FORMAT * * !SECTOR! !LU # OF FILE! * !OFFSET! SECTOR # ! DIRECTORY ! * WORD 1 !------!-------------!------------! * 15 13 12 6 5 0 * * * ! TRACK # ! * WORD 2 !---------------------------------! * 15 0 * * * * * * DATA TRACK ADDRESS FORMAT * * ! ! LU # ! * WORD 1 !----------------!----------------! * 15 8 7 0 * * ! TRACK # ! * WORD 2 !---------------------------------! * 15 0 * * * * * RETURN PARAMETERS * * R1. ERROR CODE OR 0 * R2. -\ DIRECTORY * R3. -/ ADDRESS * R4. STARTING TRACK # OF FILE * LU # IF TYPE = 0 * R5. # SECTORS/TRACK (BITS 8-15) STARTING SHéþúECTOR (BITS 0-7) * * STRING IS RETURNED ONLY FOR OPEN AND CREAT CALLS * STRING: 1. FILE TYPE BIT 15 SET INDICATES THIS IS LU 2 OR 3 * 2. STARTING TRACK * 3. EXTENT # (BITS 8-15) STARTING SECTOR (BITS 0-7) * 4. SIZE IN +SECTORS OR -#128 BLOCK CHUNKS * 5. RECORD LENGTH * 6. SECURITY CODE * SKP * * * * ERROR CODES * 0 OR POSITIVE -NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -3 FILE NOT FOUND * -5 READ EXTENT OPEN AND EXTENT NOT FOUND * -6 FILE NOT FOUND * -7 SECURITY CODES DON'T MATCH * -8 FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK) * -9 FILE CURRENTLY OPEN TO THE SAME PROGRAM * -11 FILE NOT OPEN (CLOSE) * -13 DISC LOCKED * -14 DIRECTORY FULL * -20 ILLEGAL ACCESS LU * -32 CARTRIDGE NOT FOUND * -33 NOT ENOUGH ROOM ON CARTRIDGE * -19 ILLEGAL ACCESS ON A SYSTEM DISC * -34 DISC ALREADY MOUNTED * -35 ALREADY 63 DISCS MOUNTED TO SYSTEM * -40 DISC NOT IN SST * -46 ALREADY 255 EXTENTS * * -99 DIRECTORY MANAGER WAS REJECTED ON AN EXEC REQUEST * -101 ILLEGAL PARAMETERS IN CALL OR * SCRATCH FILE PURGE FAILED - ANOTHER PROGRAM HAS IT OPEN * -102 ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) SKP *************************************** * * DECLARE 1 TRACK BUFFER BUFL DEC 6144 * (96 SECT TRACK X 64 WORDS SECT) BUF BSS 6144 * * * *************************************** * SQCPU NOP * * DEST NOP N5 DEC -5 .20 DEC 20 .22 DEC 22 PRAMA DEF P1 P1 NOP P2 NOP P3 NOP P4 NOrþúP P5 NOP * SCB EQU BUF+265 BEGINNING OF SCB IN BUF A.SCB DEF SCB ADDRESS OF SCB IDSSW NOP POINTS TO SST LENGTH WORD IN SCB MTDSC NOP POINTS TO FIRST ENTRY IN DISCS MOUNTED AREA OF SCB DISCL NOP MAXIMUM # DISCS IN DISCS MOUNTED AREA IERR NOP SCBAD NOP MASK NOP PTR1 NOP EXTRA NOP OFFST NOP * ID1 NOP -\ ID2 NOP -> ID TABLE ID3 NOP -/ A.ID DEF ID1 COUNT NOP SESSN NOP IN SESSION MODE FLAG =0 IF NOT IN SESSION * .3 DEC 3 .144 DEC 144 .64 DEC 64 N2 OCT -2 N4 DEC -4 B7777 OCT 7777 RDNAB OCT 140001 EXEC READ WITH NO ABORT(15) & NO SUSPEND(14) BITS SET WTNAB OCT 140002 EXEC WRITE WITH NO ABORT(15) & NO SUSPEND(14) BITS SET STAT OCT 100015 LUTYP OCT 34000 DISTP OCT 14000 MSKAL OCT 177777 SYMID EQU B7777 SYSTEM MANAGER ID MASK1 OCT 177000 MASK2 OCT 170000 ACDIS OCT 20377 O.MSK OCT 160000 TMP3 NOP CAN BE USED AS TEMP STORAGE NOP FOR DOUBLE WORD KEYLN NOP LENGTH OF KEYWORD TABLE DISID NOP SKP * * FETCH 5 INCOMING PARAMETERS AND SAVE IN P1-P5. * TAKES CROSS MAP LOAD PROBLEM FOR DIFFERENT OP SYSTEMS INTO ACCOUNT. * BEGIX LDA PRAMA PARAMETER DESTINATION ADDR STA DEST SAVE IT LDA N5 PARAMETER COUNT STA COUNT LOOP XLA B,I GET NEXT PARAMETER STA DEST,I SAVE IN P1 TO P5 ISZ DEST BUMP DESTINATION ADDR INB BUMP TO NEXT PARAMETER ISZ COUNT BUMP PARAMETER COUNT JMP LOOP * * LDB P1 GET THE FIRST PRAM RBL,CLE,ERB LIST; CLEAR POSSIBLE SIGN BIT STB ID SAVE ID SEG ADDRESS PASSED IN CALL ADB .31 POSITION TO SEQUENCE NUMBER XLA B,I LOAD A FROM B,I AND MASK2 MASK TO SEQUENCE NUMBER ALF,ALF POSITION CPU TO ALF BITS 11-8 AND IOR $$CPU CPU NUMBER IN BITS 14-12 —wþúSTA SQCPU AND SAVE * * * * MAKE SURE THAT D.RTR INVOCATION WAS FROM A SCHEDULE WITH WAIT CALL * WITH THE PROPER ID SEGMENT ADDRESS SUPPLIED. * * LDB XEQT GET ID ADDRESS ADB .20 ADVANCE TO FATHER INFO XLA B,I AND FETCH IT RAL POSITION FATHER WAIT BIT TO SIGN SSA,RSS CONTINUE ONLY IF FATHER IS WAITING JMP EXIT2 NOT WAITING--ILLEGAL CALL * RAR REPOSITION ID# OF FATHER AND B377 ISOLATE IT STA IDNUM KEEP FATHER'S OFFSET IN KEYWORD TABLE. CCB B=-1 ADB A COUNT FROM 0(USE B FOR LOADA ROUTINE) ADB KEYWD ADD TO TABLE OF ID SEGS XLA B,I FETCH ID SEG ADDR OF CALLER CPA ID MUST MATCH VALUE PASSED IN P1 CLB,RSS OK JMP EXIT2 --NOPE --ERROR (BAD CALL) * * * STB SESSN CLEAR SESSION FLAG STB FIRST CLEAR THE FIRST FLAG STB DISID CLEAR LAST DISC ID STB SCBAD CLEAR SCB ADDRESS * LDA BUFL CALCULATE SBFLN TO BE THE DIV .64 LENGTH OF BUFFER BUF IN STA SBFLN LOGICAL SECTORS CLB ADA N2 CALCULATE SBLFM TO THE THE LARGEST DIV .14 2 + (N * 14) NOT GREATER THAN SBFLN. MPY .14 THIS IS USED IF BUFFER ADA .2 IS NOT LARGE ENOUGH TO STA SBFLM READ ONE ENTIRE TRACK. * LDA ABUF SET LOCK SEARCH FOR FIRST STA DIRAD ENTRY * CLA STA KEYLN START COUNT AT 0 LDB KEYWD GET ADDRESS OF KEYWORD TABLE KEY XLA B,I GET ENTRY SZA,RSS ZERO? JMP CLSCB YES - FOUND THE END ISZ KEYLN NO - STEP COUNTER INB AND POINTER IN KEYWORD TABLE JMP KEY AND LOOK AT NEXT ENTRY. * CLSCB LDA A.SCB SCB WILL BE READ INTO BUF AT THIS ADDRESS. CMA,INA CALCULATE POINTER TO SST LENGTH WORD ADZDþúA $SMLK IN SCB SO CAN USE SCB OFFSET GLOBALS ADA $SMST IN ACCESSING ELEMENTS OF THE SCB. CMA,INA STA IDSSW LDA A.ID START WITH FIRST ID STA PTR1 IN BLOCK. * LDA P2 GET FUNCTION CODE AND B77 MASK TO LOWER BITS CPA .11 DISMOUNT CALL RSS YES CPA .13 MOUNT CALL? RSS YES JMP RDSCB NEITHER - SEND 0 FOR SCBAD LDA P4 GET SCB ADDRESS IF PASSED STA SCBAD AND SAVE IT SPC 5 * * * NEXT AND THE LOCK ROUTINE SEARCH THE DIRECTORY FOR THE * REFERENCED DISC. * * THIS SECTION READS THE SCB IF THERE IS ONE. IT THEN DECIDES WHICH * DISCS THE CALLER MAY LEGALLY ACCESS AND SAVES THAT INFO IN THE ID TABLE. * * 0) IF THE CALLER IS THE SYSTEM MANAGER HE MAY TALK TO ANY DISC ON THE * SYSTEM. (SYSMG) * * 1) IF THE CALLER IS NOT UNDER SESSION CONTROL HE MAY ACCESS * A) SYSTEM DISCS AND B) NON-SESSION DISCS. (NTSES) * * 2) IF THE CALLER IS UNDER SESSION CONTROL AND OVRD. = 0 (DISC ACCESS * RESTRICTIONS OVERRIDE FLAG) HE MAY ACCESS ONLY HIS PRIVATE AND * GROUP DISCS AND SYSTEM DISCS OTHER THAN LU 2 AND 3. * * 3) IF THE CALLER IS UNDER SESSION CONTROL AND OVRD. HAS BIT 14 SET * HE MAY ACCESS A) HIS PRIVATE DISCS, B) HIS GROUP DISCS, * AND C) ALL SYSTEM DISCS. (OVRRD) * * 4) IF BIT 15 IS SET ON OVRD., CALLER IS TREATED LIKE THE SYSTEM MANAGER; * HE MAY ACCESS ANY DISC ON THE SYSTEM. (SYSMG) * * 5) IF OVRD. HAS BIT 13 SET THEN THE CALLER MAY ACCESS ONLY SYTEM * CARTRIDGES. * * THE ID TABLE IS SET UP WITH THE ID'S REPRESENTING THESE DISCS. THEY * ARE SAVED IN THE ORDER THEY SHOULD BE SEARCHED FOR IN THE DEFAULT CASE. * FOR CASES WHERE -1 IS USED TO INDICATE ANY DISC COULD BE USED, THE -1 * MUST BE THE LAST ENTRY IN THE ID TABLE. EXCEPT IN THE CASE OF THE * SYSTEM MANAGER, IT IS THE ONLY ENTRY IN THE ID TACÑþúBLE. * * RDSCB JSB GTSCB READ SCB INTO BUF AT A.SCB DEF *+5 DEF SCB DEF .144 DEF IERR DEF SCBAD * LDB IERR CPB N1 IN SESSION MODE? JMP NTSES NO * STB SESSN SET IN-SESSION FLAG NON-ZERO LDA IDSSW CALCULATE ADDRESS OF LDB A,I 1ST ENTRY IN DISCS MOUNTED CMB,INB AREA OF THE SCB USING ADA .2 THE POINTER TO THE SST ADA B LENGTH WORD. STA MTDSC MTDSC = IDSSW + 2 + C(IDSSW) * LDA IDSSW GET AND SAVE LENGTH OF DISCS'S ADA N1 MOUNTED AREA IN THE SCB. LDA A,I STA DISCL * LDB P1 IF THIS IS A MOUNT CALL, WANT TO SEARCH LDA P2 WHOLE CL FOR LU TO MAKE SURE IT'S NOT AND B377 MOUNTED TO ANYONE. IF THIS CALL TO CPA .13 D.RTR HAS AN EVEN FUNCTION CODE (WHEN JMP ALLDS AN ENTIRE DIRECTORY ADDRESS IS SENT SSB,RSS THEN WE'VE ALREADY BEEN THROUGH THE OVRRD SLA AND CARTRIDGE ADDRESSING SPACE CHECKS AND RSS JMP ALLDS JUST WANT TO FIND LU IN THE CL * LDB IDSSW CALCULATE ADDRESS ADB $SMGP OF GROUP ID STB TMP3 AND SAVE IT. LDB IDSSW CALCULATE ADDRESS ADB $SMID OF USER ID LDA B,I GET USER ID IN B-REG LDB P2 GET OVERRIDE FLAGS ELB BIT 15 TO E-REG SEZ BIT 15 SET? JMP ALLDS YES - OVERRIDE FOR ALL DISCS IS SET CPA SYMID SYSTEM MANAGER?? JMP SYSMG YES - THIS IS SYSTEM MANAGER ELB OVERRIDE FLAG BIT 14 TO E-REG SEZ OVERRIDE PRIV,GROUP,SYS? JMP OVRRD YEP SSB OVERRIDE TO SYSTEM ONLY? JMP SONLY YEP * OVRRD LDB TMP3,I **CASE 2** AND **CASE 3** STA ID1 STB ID2 TALK TO THIS SESSION'S PRIVATE LDA SYMID AND GROUP DISCS AND>‹þú SYSTEM STA ID3 DISCS. DISCRIMINATION OF LDA N3 CASE 2 AND CASE 3 WITH OVERRIDE STA COUNT WILL BE DONE LATER. JMP NEX.1 * * NTSES LDA P2 **CASE 1** SSA WAS BIT 15 OVERRIDE SET? JMP ALLDS YES - WANT TO HONOR IT AND B77 MASK TO FUNCTION CODE CPA .13 IS THIS A MOUNT CALL? JMP ALLDS YES - WANT TO SEARCH WHOLE CL FOR FMGR12 LDB P1 IF THIS CALL HAD EVEN FUNCTION CODE (EXCEPT OPEN) SSB,RSS A DIRECTORY ADDRESS WAS SENT AND ALREADY BEEN SLA THROUGH THE OVRRD AND CARTRIDGE ACCESS CHECKS RSS SO JUST FIND THE LU IN THE CL AND CONTINUE JMP ALLDS LDA N2 STA COUNT NOT IN SESSION MODE LDA SYMID SO TALK ONLY TO SYSTEM STA ID1 AND NON-SESSION DISCS CLA STA ID2 JMP NEX.1 * * SONLY LDA N1 **CASE 5** STA COUNT TALK ONLY TO LDA SYMID SYSTEM DISCS STA ID1 JMP NEX.1 * * ALLDS CCA **CASE 0 OR 4** STA ID1 SET ID TABLE AND STA COUNT COUNT TO -1 TO JMP NEX.1 INDICATE SYSTEM MANAGER * * SYSMG STA ID1 SET 7777 AS PRIVATE ID LDB TMP3,I GET GROUP ID STB ID2 AND PUT AS SECOND ENTRY IN TABLE CCA SET -1 AS THIRD ENTRY STA ID3 IN TABLE TO SEARCH WHOLE DIRECTORY LDA N3 THERE ARE THREE STA COUNT ENTRIES IN THE TABLE JMP NEX.1 SPC 3 * * * THE LOCK ROUTINE READS THE DISC DIRECTORY AND SEARCHES FOR THE * SPECIFIED DISC. * * FOR THE 1ST CALL DIRAD SHOULD POINT AT THE 1ST WORD OF THE CL (ABUF). * LOCK WILL UPDATE DIRAD AFTER EACH SEARCH. * * WITH THE EXCEPTION OF THE DISC DIRECTORY UPDATE AND THE MOUNT CARTRIDGE * REQUEST THE DISC MUST BE FOUND. * * A. IF THE DISC WAS SPECIFIED WITH AN LU# THE CL IS SEARCHED FOR THAT * }þú LU. WHEN FOUND THE CORRESPONDING ID IN THE CL ENTRY MUST MATCH ONE * OF THE ID'S IN THE ID TABLE. ELSE AN ERROR -18 IS RETURNED. * * B. IF THE DISC WAS SPECIFIED WITH A CRN, THE CL IS SEARCHED FOR THAT * CRN. A COMPLETE PASS IS MADE FOR EACH ID IN THE ID TABLE UNTIL A * CRN WITH A LEGAL ID IS FOUND. (CRN MAY APPEAR > 1 TIMES IN THE CL.) * * C. IF A SPECIFIC DISC IS NOT INDICATED AND THE CALLER IS THE SYSTEM * MANAGER THE "NEXT" DISC IS USED REGARDLESS OF ID, ETC. * * D. IF A SPECIFIC DISC IS NOT INDICATED AND THE CALLER IS NOT THE * SYSTEM MANAGER THE CL IS SEARCHED FOR AN ID FROM THE CALLER'S ID * TABLE. A COMPLETE PASS IS MADE FOR EACH ID IN THE ID TABLE UNTIL * A DISC IS FOUND. * * E. IN EACH CASE ABOVE, IF UNDER SESSION CONTROL, THE LU MUST ALSO BE * MOUNTED TO THE CALLER, THAT IS IN HIS DISCS' MOUNTED LIST IN THE * SCB. * * ON SUBSEQUENT CALLS TO NEXT/LOCK IF THE DISC WAS NOT SPECIFIED, THE * SEARCH IS CONTINUED. IF THE DISC WAS SPECIFIED A CARTRIDGE NOT FOUND * ERROR EXIT IS TAKEN. * * ON EXIT: ATRAK CONTAINS THE DIRECTORY TRACK (LAST TRACK) * ALU CONTAINS THE DIRECTORY LU * C(DIRAD-4) IS THE LU/LOCK WORD * * * NEXT JSB GTSCB READ THE DEF *+5 SESSION CONTROL DEF SCB BLOCK IF DEF .144 THERE IS DEF IERR ONE. DEF SCBAD NEX.1 CLA CLEAR ON SYSTEM DISC FLAG STA SYSDS BECAUSE WE ARE STARTING OVER WITH ANOTHER DISC STA #SECT CLEAR SEC/TRACK BECAUSE NEXT DISC MAY BE DIFFERENT JSB RDPS READ THE DISC DIRECTORY. LDB P1 GET CALLERS ID SSB CHECK BIT 15. IF SET THIS IS AN OPEN JMP LOCK0 YES - OPEN REQUEST LDA P2 GET FUNCTION CODE SLA EVEN? JMP LOCK0 NO * LDA P3 LU IN P3 AND B77 MASK TO LU STA TMP2 SAVE THE LU STA DISID HERE†Oþú TOO CCE SET E=1 TO INDICATE SEARCHING FOR LU LDB P4 GET TRACK # STB DITR SAVE THE TRACK CPA RDPS DO WE HAVE THIS ONE ALREADY? JMP DEC.1 YES SO GO DECODE THE REQUEST JMP LOCK6 NO SO GO LOOK FOR IT * LOCK0 LDA P3 GET DISC ID SZA,RSS JMP DEFLT A PARTICULAR DISC WAS NOT SPECIFIED CLE,SSA CMA,CCE,INA E=1 IF LU, E=0 IF CRN STA TMP2 TMP2 = +LU OR +CRN LDB DISID GET PREVIOUS ID STA DISID SAVE CURRENT ID SZB IF PREVIOUS ID NOT A ZERO, ID ON SECOND CALL JMP CKERR GO SEE WHICH ERROR EXIT TO TAKE * LOCK6 SEZ LU OR CRN? JMP LU.SH LU - SO GO DO THE SEARCH FOR LU * * * THIS SECTION SEARCHES THE CL FOR A SPECIFIED CRN * * CRNSH LDA MSKAL SET UP A MASK STA MASK LDA .2 AND OFFSET STA OFFST FOR CL SEARCH ROUTINE CRN.1 JSB SCAND SEARCH CL FOR CRN=TMP2 JMP CRN.2 DIDN'T FIND IT - GO TRY ANOTHER ID LDA N1 FOUND IT CPA PTR1,I IS CALLER THE SYSTEM MANAGER? JMP LOCK4 YES - NO MORE CHECKS NEEDED ADB .3 NO - POSITION TO ID WORD LDA B,I GET ID AND B7777 AND MASK CPA PTR1,I DO ID'S MATCH? JMP LU.2 YES JMP CRN.1 NOPE - GO LOOK FOR CRN AGAIN * CRN.2 ISZ COUNT INCREMENT #ID'S COUNTER RSS JMP LOCK5 ALL DONE AND DIDN'T FIND CARTRIDGE - ERROR ISZ PTR1 STEP POINTER TO NEXT ID LDA BUFA START SEARCH OVER AT STA DIRAD BEGINNING OF CARTRIDGE DIRECTORY JMP CRN.1 * * * THIS SECTION SEARCHES THE CL FOR A SPECIFIED DISC LU * * LU.SH LDA B377 SEARCH CL FOR LU# IN TMP2 STA MASK LDA .0 STA OFFST JSB SCAND JMP LOCK5 LU JUST ISN'T THERE ADB .3 NO - POSITION TO ID LDA B,I GET IT AND B7777 AND MAm"þúSK LU.1 CPA PTR1,I DOES IT MATCH? JMP LU.2 YES - GO SEE IF IT'S IN THE SST ISZ COUNT NO - ANY MORE ID'S TO CHECK? RSS JMP LU.15 NOPE - DIDN'T FIND DISC ISZ PTR1 YES - TRY THE NEXT ONE JMP LU.1 * LU.15 LDA N1 DOES CALLER HAVE SYSTEM CPA PTR1,I MANAGER POWERS? JMP LOCK4 YES - CAN USE THIS DISC JMP EX32 NOPE - THIS ONE DOESN'T BELONG TO HIM * LU.2 JSB SCBCK IS LU MOUNTED IN SCB? JMP LOCK4 YES - WE'VE FOUND THE DISC. CONTINUE JMP EX32 ERROR. DISC IS MOUNTED TO SYSTEM BY NOT TO CALLER'S SESSION * * * DEFLT LDA PTR1,I NO DISC ID WAS SPECIFIED CPA N1 IS CALLER THE SYSTEM MANAGER? JMP SYSTM YES - JUST USE "NEXT" DISC * * * THIS SECTION SEARCH THE CL FOR A LEGAL ID * * ID.SH LDA B7777 SET MASK AND OFFSET STA MASK TO SEARCH FOR AN ID LDA .3 STA OFFST ID.1 LDA PTR1,I GET ID WE'RE LOOKING FOR STA TMP2 TO TMP2 JSB SCAND SEARCH CARTRIDGE DIRECTORY JMP ID.2 DIDN'T FIND IT JSB SCBCK IS IT IN CALLER'S SST? JMP LOCK4 YES - SO USE THIS DISC JMP ID.1 * ID.2 ISZ COUNT ANY MORE ID'S LEFT RSS JMP CKERR NO - GO SEE WHICH ERROR EXIT TO TAKE ISZ PTR1 YES - STEP TO NEXT ID LDA BUFA RESET CL POINTER STA DIRAD TO BEGINNING JMP DEFLT AND SEARCH AGAIN * * SYSTM LDB DIRAD LDA B,I GET 1ST WORD OF "NEXT" CL ENTRY SZA,RSS 0? JMP CKERR YES - GO SEE WHICH ERROR EXIT TO TAKE AND B377 MASK STA ALU AND SAVE INB LDA B,I GET TRACK STA ATRAK AND SAVE ADB .3 UPDATE DIRAD STB DIRAD TO NEXT ENTRY * * * * * LOCK4 LDB DIRAD FOUND - POSITION TO ID WORD ADB N4 POSITION TO LOCK WORD JSB CK.LK SEE IF LOCKED AND CHnçþúECK VALIDITY JMP LK.4 NOT LOCKED OR LOCKED TO CALLER OF BAD LOCK WAS CLEARED LDA DISID LOCKED - IF THIS IS SZA,RSS A MULTI-DISC SEARCH JMP NEX.1 CONTINUE WITH NEXT DISC JMP EX13 ELSE EXIT LOCKED DISC * * * IF THE "FOUND" DISC IS LU 2 OR LU 3, CAN ONLY USE IT IF * 1. WE'RE NOT UNDER SESSION CONTROL OR * 2. WE'RE TREATED AS SYSTEM MANAGER OR * 3. BIT 13, 14, OR 15 ON OVRD. WAS SET OR * 4. THIS IS AN OPEN CALL * OTHERWISE GO FIND ANOTHER DISC * * # 2 TAKES CARE OF CASE FOR CLOSE, RENAME, EXT OPEN, ETC * WHERE CARTRIDGE ACCESS CHECKS ARE NOT MADE AFTER FILE IS * OPENED * * LK.4 LDA B,I GET THE LU WORD FROM THE CL ENTRY AND B377 AND MASK TO THE LU CPA .2 IS THIS LU 2? RSS YES - SKIP CPA .3 OR LU 3? RSS YES - SKIP JMP DEC.1 NO - GO AHEAD AND USE THE DISC WE HAVE LDA SIGN CAN USE THIS DISC. SET STA SYSDS THE ON SYSTEM DISC FLAG LDA SESSN GET THE IN-SESSION FLAG SZA,RSS IF NOT IN SESSION JMP DEC.1 GO AHEAD AND USE THIS DISC LDA ID1 GET INDICATOR FROM ID TABLE CPA N1 SYSTEM MANAGER TYPE? JMP DEC.1 YES - HE CAN USE ANY DISC CPA SYMID JMP DEC.1 LDA P1 BIT 15 ON A = 1 ELA AND E = 1 IF AN OPEN CALL LDA P2 GET FUNCTION CODE AND OVERRIDE PARAM AND O.MSK MASK TO OVERRIDE BITS SZA ANY OVERRIDES? JMP DEC.1 YES - CAN USE THIS DISC SEZ OPEN CALL? JMP DEC.1 YES - GO AHEAD AND USE THIS DISC LDA DISID IS THIS A SZA,RSS MULTI DISC SEARCH? JMP NEX.1 YES GO GET THE NEXT DISC JMP EX19 NO - SHOULDN'T EVER HAVE SPECIFIED 2 OR 3 SPC 2 DEC.1 JSB SSTCK MAKE SURE DISC IS IN CALLER'S SST JMP DEC.2 ITµÒþú IS SO GO AHEAD WITH STATUS CHECK LDA DISID IS THIS A MULTI SZA,RSS DISC SEARCH? JMP NEX.1 YES - JUST SKIP THIS ONE THEN JMP EX40 NO - TELL CALLER IT ISN'T IN HIS SST SPC 2 DEC.2 CLB,CLE LDA ALU GET LU AND SET RAL,ERA UP DOUBLE WORD DST TMP1 CONTROL WORD FOR XLUEX JSB XLUEX DO STATUS CHECK TO MAKE SURE DEF *+4 THIS IS A DISC DEVICE. DEF STAT (IN CASE SOMEONE DID AN LU DEF TMP1 SWITCH AFTER IT WAS MOUNTED) DEF TMP3 JMP DEC.3 IT'S BAD LDA TMP3 GET EQT WORD 5 AND LUTYP MASK TO THE LU TYPE CPA DISTP A DISC? JMP DECOD YES - CONTINUE WITH THE PROCESSORS DEC.3 LDA DISID NO - IS THIS A MULTI- SZA,RSS DISC SEARCH? JMP NEX.1 YES - JUST SKIP THIS ONE THEN JMP EX20 NO - GIVE THE GUY AN ERROR SPC 2 DECOD CCA SET THE NONE FOUND YET STA R1 FOR REUSABLE DISC SPACE ROUTINE LDA P1 IF OPEN SSA REQUEST JMP OPEN GO OPEN LDA P2 ELSE AND B77 GET REQUEST CODE (LESS OVERRIDE BITS) ADA N16 SSA,RSS JMP EX101 GREATER THAN 15 - EXIT ADA TABAD INDEX INTO THE FUNCTION JMP A,I GO EXECUTE THE FUNCTION SPC 2 TABAD DEF TABA+16 TABA JMP CLOSE 0 JMP CREAT 1 JMP CNAM 2 JMP RLOCK 3 JMP EX101 4 JMP ULOCK 5 JMP EXOPN 6 JMP GEN 7 JMP EXOPN 8 JMP PACK 9 JMP EX101 10 JMP DISMT 11 JMP EX101 12 JMP EX34 13 MOUNT AND FOUND ALREADY MOUNTED JMP EX101 14 JMP CHGCL 15 * * * CKERR LDA P2 GET FUNCTION CODE PARAMETER AND B77 AND MASK OFF ANY POSSIBLE OVERRIDE BITS CPA .1 CREAT CALL? JMP EX33 ‰|þúYES - MUST NOT HAVE BEEN ENOUGH ROOM JMP EX6 SEND FILE NOT FOUND MESSAGE SPC 3 * * * CK.LK * * CHECK LOCK IN CARTRIDGE LIST. IF INVALID, CLEAR IT * * ENTRY B = ADDRESS OF LOCK WORD IN CL * * RETURN P+1 NOT LOCKED OR LOCKED TO CALLER OR INVALID LOCK * THAT WAS CLEARED * P+2 VALID LOCK BELONGING TO SOMEONE ELSE * * CK.LK NOP STB TMP1 LDA B,I GET WORD FROM CARTRIDGE LIST ALF,ALF AND B377 MASK TO ID SEGMENT NUMBER SZA IF NOT LOCKED CPA IDNUM OR LOCKED TO CALLER JMP CK.L2 JUST RETURN AT P+1 * LDB KEYLN GET LENGTH OF KEYWORD CMB,INB TABLE AND MAKE NEGATIVE ADB A IF LOCK # IS BIGGER THAN KEYWORD SSB,RSS TABLE LENGTH, MUST BE BAD JMP CK.L1 SO CLEAR AND RETURN P+1 * LDB KEYWD GET ADDRESS OF KEYWORD TABLE ADB A AND POSITION TO ENTRY ADB N1 (ACCOUNT FOR STARTING AT 1 INSTEAD OF 0) XLA B,I GET ADDRESS OF ID SEGMENT ADA .8 POSITION TO POINT OF SUSPENSION WORD XLA A,I GET IT SZA POINT OF SUSPENSION 0? JMP CK.L3 NO, GOOD LOCK SO STEP TO P+2 * CK.L1 LDA TMP1,I GET LOCK WORD FROM CL AND B377 MASK OFF LOCK PART STA TMP1,I AND PUT BACK WITHOUT LOCK CK.L2 LDA TMP1,I GET THE LU/LOCK WORD FROM CL AND B377 ISOLATE THE LU ADA N1 ADJUST FOR 1 AS ORIGIN ADA DRT ADD IN BASE OF THE DRT WORD 1 TABLE LDA A,I TO GET THE LU'S DRT WORD 1 ENTRY AND B3700 ISOLATE THE LU LOCK BITS SZA IF ZERO, NO LU LOCK CK.L3 ISZ CK.LK ELSE, LU IS LOCKED, RETURN (P+2) JMP CK.LK,I R E T U R N * B3700 OCT 3700 LU LOCK BITS MASK FOR DRT WORD 1 SKP * * * SCBCK : LU MOUNTED IN CALLER'S SCB? * IF CHECK IS APPROPRIATE (IN SESSION MODE AND NOT SYSTEM DISCážþú * ON OVERRIDE CASE) SCANS THE DISCS' MOUNTED LIST IN SCB FOR ALU * AND MAKES SURE IT IS ACTIVE * * ENTRY: ALU CONTAINS LU# TO BE SEARCHED FOR * PTR1 POINTS TO CURRENT ENTRY IN ID TABLE * * RETURN: P+1 FOUND ALU IN SCB * P+2 NOT THERE * * SCBCK NOP LDA SESSN GET IN SESSION FLAG LDB PTR1,I GET CURRENT ID FROM ID TABLE SZA IN SESSION MODE? CPB SYMID IS ALU A SYSTEM DISC? JMP SCBCK,I YES - DON'T CHECK DISCS' MOUNTED LIST * LDA DISCL GET # DISCS TO BE CHECKED CMA,INA AND USE AS A STA COUN1 COUNTER. LDB MTDSC SCB.1 LDA B,I AND ACDIS (DISC MUST BE ACTIVE TO MATCH) CPA ALU THIS DISC SAME AS ALU? JMP SCBCK,I YES - RETURN INB ISZ COUN1 JMP SCB.1 GO LOOK AT NEXT ONE ISZ SCBCK DIDN'T FIND IT SO JMP SCBCK,I RETURN AT P+2 SPC 4 * * * SSTCK : LU IN CALLER'S SST? * IF CALLER IS IN SESSION, SCANS SST TO MAKE * SURE THE DISC WE'RE GOING TO SEARCH IS IN * HIS ADDRESSING SPACE. * * ENTRY - ALU CONTAINS LU# TO BE SEARCHED FOR * * RETURN- P+1 IT'S THERE * P+2 NOT THERE * * SSTCK NOP LDA SESSN GET IN SESSION FLAG SZA,RSS IN SESSION MODE? JMP SSTCK,I NO - NO SST LIMITATIONS ANYWAY!! * LDB IDSSW GET POINTER TO SST LENGTH WORD LDA B,I GET SST LENGTH WORD STA COUN2 SAVE IT AS COUNTER (IT'S NEGATIVE) CK.1 INB LDA B,I GET SST ENTRY ALF,ALF GET SYSTEM LU TO LOWER BYTE AND B377 MASK IT OFF INA ADD ONE (COMPENSATE FOR SST'S FORMAT) CPA ALU MATCH? JMP SSTCK,I YES - WE'RE DONE! ISZ COUN2 JMP CK.1 TRY THE NEXT ONE ISZ SSTCK END OF SST - STEP RETURN ADDRESS .Âþú JMP SSTCK,I AND RETURN * * * SCAND : SEARCH CARTRIDGE DIRECTORY IN BUF FOR TMP2 * * ENTRY: TMP2 - WHAT WE'RE SEARCHING FOR * OFFST - OFFSET IN ENTRY = 0 FOR LU * = 2 FOR CRN * = 3 FOR ID * MASK - MASK IF NEEDED = 177777B FOR CRN * = 377B FOR LU * = 7777B FOR ID * DIRAD - STARTING POSITION IN CL * * RETURN: P+1 END OF CL AND NOT FOUND IN CL * P+2 FOUND IT * DIRAD - POINTS TO NEXT ENTRY IN CL * B - POINTS TO 1ST WORD OF "FOUND" ENTRY * ALU - LU # FROM "FOUND" ENTRY * ATRAK - LAST TRACK INFO FROM "FOUND" ENTRY * * SCAND NOP LDA OFFST CMA,INA ADA .4 STA EXTRA LDB DIRAD GET STARTING POSITION * SCAN1 LDA B,I SZA,RSS ZERO? END OF LIST? JMP SCAND,I END OF LIST AND NOT FOUND. RETURN P+1 AND B377 STA ALU SAVE LU# ADB OFFST POSITION TO ELEMENT IN QUESTION LDA B,I ADB EXTRA POSITION TO START OF NEXT ENTRY AND MASK CPA TMP2 IS THIS THE ONE? RSS YES. FOUND IT JMP SCAN1 NO - KEEP LOOKING * STB DIRAD UPDATE DIRAD ADB N3 LDA B,I GET LAST TRACK STA ATRAK INFORMATION ADB N1 B POINTS TO BEGINNING OF ENTRY ISZ SCAND RETURN JMP SCAND,I AT P+2 * .4 DEC 4 SKP * * RDPS READS CARTRIDGE DIRECTORY FROM SYSTEM DISC * RDPS OCT -1 JSB WCSR WRITE CURRENT SECTOR BLOCK IF DIRTY JSB EXEC DEF CLRTN READ 256 WORD CARTRIDGE DEF RDNAB DIRECTORY FROM LU2 DEF .2 INTO BUF. DEF BUF TRACK AND SECTA§þúOR DEF .256 ADDRESS OF CARTRIDGE DEF $CL1 DIRECTORY COMES FROM DEF $CL2 EXTERNALS $CL1 AND $CL2. CLRTN JMP EX99 CPB .256 READ 256 WORDS? RSS OK JMP EX1 NO - EXIT DISC ERROR. CLA CLEAR DISC DIRECTORY STA LDRLU IN-CORE FLAG JMP RDPS,I RETURN * .256 DEC 256 SPC 5 * * WCSR WRITE CURRENT BLOCK * WCSR NOP LDA WCS GET WRITTEN-ON FLAG SZA,RSS IF NOT DIRTY JMP WCSR,I JUST RETURN. CLA STA WCS CLEAR WRITTEN-ON FLAG JSB EXEC DEF WRTN WRITE CURRENT 128-WORD DEF WTNAB BLOCK FROM SBUF (IN BUF) DEF LDRLU TO THE DISC. SBUF DEF * LDRLU, LTRAC, LSECT CONTAIN THE DEF .128 CURRENT LU, TRACK, AND DEF LTRAC SECTOR INFORMATION. DEF LSECT WRTN JMP EX99 CPB .128 WRITE ALL 128 WORDS? JMP WCSR,I OK - RETURN. JMP EX1 NO - EXIT DISC ERROR. * DRLU NOP SKP * * RWSUB ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK * * THIS IS THE ONLY ROUTINE THAT READS THE FILE DIRECTORIES * * * 4 CASES OF HOW MUCH WILL BE READ * * CASE SECT/TR SECT SBFLN READ LNG COMMENTS * * 1 UNKNOWN 2-254 2-254 2 USED FOR NORMAL CLOSE NOT * 0 2 2 REQUIRING A SEARCH * * 2 UNKNOWN 0 16-256 16 USED TO READ DISC DIRECTORY * SBFLN MUST BE 16-256 BLOCKS * 3 16-256 0-254 =>SECT/TR ENTIRE TRACK TRACK LENGTH IS KNOWN * AND FITS - READ WHOLE * 4 16-256 0-254 255? CPA P5 YES ? NO? ALF,SLA,ALF NO EXTENSION NO. FOR POSSIBLE JMP EX46 YES GO EXIT ERROR -6 * STA GSEC EXTENSION CREAT JSB EXSHR SEARCH FOR THE REQUIRED EXTENT JMP EXOPT NOT FOUND SO GO TEST IF READ ALF,ALF EXTENT NO TO A AND B377 MASK CPA P5 THIS IT? JMP OPEN4 YES SO GO RETURN THE PRAMS CSER LDA TYPE NO SO CONT@½þúINUE JMP NSHR4 THE SEARCH SPC 1 EXOPT LDB P2 IF EXTENT OPEN IS FOR BLR,BLR WRITE THEN GO RBR,RBR CREAT THE EXTENT CPB .8 JMP CREA0 GO EXIT LDA N5 ELSE RETURN ILLEGAL RECORD ERROR JMP CREX GO EXIT SPC 1 .10 DEC 10 .8 DEC 8 8B .14 DEC 14 ANAME DEF NAME ATRAK NOP SIGN OCT 100000 SPC 2 * * SETDR ROUTINE TO SET UP TO READ A DIRECTORY * SETDR NOP CCA SET FIRST STA FIRST FLAG TO INDICATE FIRST BLOCK LDA ATRAK SET THE TRACK STA TRACK ADDRESS LDA ALU AND THE LU STA DRLU ADDRESS LDA N14 SET SECTOR TO -14 (UDAD ADDS 14) STA SECT SET THE SECTOR JMP SETDR,I RETURN * N14 DEC -14 SKP * * * N.SHR DIRECTORY SEARCH ROUTINE * TARGET NAME IN NAME UNL PRC OCT 74000 LST * RETURNS: * P+1 END OF DIRECTORY A=NEXT ADDR. (IF A=0 END OF SPACE) * P+2 FOUND RETURN A=ENTRY ADDR. * N.SHR NOP NSHR JSB RDNXB READ THE DIRECTORY JMP N.SHR,I END OF DISC RETURN NSHR0 LDA SBUF SET A TO THE BUFFER ADDRESS LDB N8 SET COUNT FOR THE NO. IN A BLOCK STB COUN1 NSHR1 CCE SET FOUND FLAG (E=1) LDB ANAME SET THE NAME ADDRESS STB TMP2 IN TMP2 LDB N3 SET FOR 3-WORD NAME STB COUN2 LDB A,I IF PURGED ENTRY INB,SZB,RSS THEN JMP CKRUS CHECK IF REUSABLE * NSHR2 LDB A,I GET A NAME WORD SZB,RSS IF ZERO - END OF DIRECTORY JMP N.SHR,I SO EXIT * CPB TMP2,I MATCH? INA,RSS YES - SET FOR NEXT WORD SKIP CLE,INA NO - SET NOT FOUND - STEP NAME ISZ TMP2 STEP LOCATIONS ISZ COUN2 AND COUNT MORE NAME JMP NSHR2 YES; GO DO IT * CLB,SEZ,CCE,INB NO; FOUND? JMP NSHR3 YEãÆþúS; GO TAKE FOUND EXIT * NSHR4 ADA .13 NO; SET FOR NEXT ENTRY NSHR5 ISZ COUN1 DONE WITH BLOCK? JMP NSHR1 NO; DO NEXT ENTRY * JMP NSHR YES; GO READ NEXT BLOCK * NSHR3 ADB N.SHR FOUND - STEP RETURN ADDRESS ADA N3 ADJUST TO START OF ENTRY JMP B,I RETURN * CKRUS ADA .3 POSITION TO THE TYPE WORD LDB A,I AND GET IT ADA .3 POSITION TO THE SIZE WORD SZB TYPE 0?? CPB .6 OR TYPE 6?? CCB,RSS YES - DON'T WANT TO REUSE THE FILE LDB A,I NOT TYPE 0 OR 6 SO GET THE SIZE WORD ADA .10 AND POSITION TO THE NEXT DIRECTORY ENTRY SSB WAS THIS TYPE 0 OR 6?? JMP NSHR5 YES - DON'T TRY TO REUSE CPB NAME+6 NO - IS SIZE EXACTLY THE SAME JMP CKRU1 YES - CHECK FURTHER JMP NSHR5 NOPE - HANG IT UP AND GO TO NEXT ENTRY * CKRU1 LDB R1 IF ALREADY GOT ONE SSB,RSS THEN JUST JMP NSHR5 CONTINUE * LDB TRACK ELSE SAVE THE DIRECTORY STB R1 ADDRESS (MUST SAVE A FOR LDB SECT CONTINUATION OF SCAN) STB R2 R1,R2 = DISC ADDRESS LDB SBUF CALCULATE OFFSET OF THIS ENTRY IN CMB,INB IN THE CURRENT BLOCK ADB A ADB N16 HAVE TO BACK UP 16 STB R3 R3 = OFFSET IN CURRENT BLOCK JMP NSHR5 CONTINUE THE SCAN SKP * SETAD TO SET UP ADDRESSES FOR DIRECTORY ENTRY IN BUF AT * ADDRESS POINTED TO BY A * * SETAD NOP CLB,CLE JSB P.PAS N10 DEC -10 DIRA NOP NOP NOP TYPE NOP TRAKA NOP SECTA NOP #SEC NOP RL NOP SC NOP FLAGA NOP JMP SETAD,I SPC 2 SPC 2 * * * RPRM * RPRM NOP STA R1 SET FIRST RETURN PRAM SSA IF RETURNING AN ERROR JMP RPRM1 SKIP STRING RETURN LDA P2 IS THIS A CREAT CANvþúLL? AND B77 CPA .1 CREAT FUNCTION CODE? JMP RPRM0 YES - RETURN STRING BUT DON'T SET SY BIT LDA P1 IS THIS AN SSA,RSS OPEN CALL?? JMP RPRM1 NO - SKIP STRING RETURN LDB TYPE,I ADB SYSDS ADD SIGN BIT IF THIS WAS A SYSTEM DISC STB TYPE,I RPRM0 JSB EXEC YES DEF *+5 DEF .14 USE STRING PASSAGE TO DEF .2 SEND TO FATHER (CALLER) DEF TYPE,I 6 WORDS OF DIRECTORY DEF .6 ENTRY (START AFTER NAME) LDB TYPE,I NOW CLEAR OUT POSSIBLE RBL,CLE,ERB ON SYSTEM DISC FLAG IN STB TYPE,I BIT 15 OF TYPE WORD. RPRM1 CLB CALCULATE OFFSET LDA SBUF OF DIRECTORY ENTRY CMA,INA IN THE SECTOR ADA DIRA OFFSET IS ENTRY NUMBER DIV .16 OF DIRECTORY ENTRY (0-8) ALF,ALF ROTATE OFFSET LEFT RAR 7 BITS IN A-REG ADA SECT ADD IN SECTOR NUMBER ALF ROTATE OFFSET AND SECTOR RAL,RAL LEFT 6 BITS IN A-REG ADA ALU ADD IN LU NUMBER STA R2 SAVE IN 2ND RETURN PARAMETER LDA TRACK TRACK NUMBER OF DIRECTORY STA R3 ENTRY IS 3RD RETURN PARAMETER LDA TRAKA,I STARTING TRACK OF FILE STA R4 IS 4TH RETURN PARAMETER LDA SECTA,I GET THE STARTING SECTOR AND B377 ADDRESS AND ISOLATE IT LDB #SECT GET THE NUMBER OF SECTORS/TRACK BLF,BLF ROTATE AND ADA B COMBINE WITH THE SECTOR STA R5 SAVE AS 5TH RETURN PARAMETER JMP RPRM,I SPC 2 SYSDS NOP R1 NOP R2 NOP R3 NOP R4 NOP R5 NOP * * RDNXB READ NEXT DIRECTORY BLOCK * * * EXIT P+1 - END OF DIRECTORY * P+2 - OK RETURN * * RDNXB NOP JSB UDAD UPDATE THE ADDRESSES JMP RDNXB,I END OF DIRECTORY RETURN JSB RWSUB READ THE BLO©HþúCK ISZ RDNXB STEP TO OK RETURN ISZ FIRST FIRST BLOCK? JMP RDNXB,I NO; SO RETURN SPC 1 CLE JSB DPMM JMP RDNXB,I RETURN * * UDAD -- UPDATE THE DIRECTORY ADDRESS * * * EXIT P+1 - END OF DIRECTORY * P+2 - OK RETURN * * * NOTE: THE FIRST TIME A BLOCK IS READ FROM THE DISC (I.E. TO GET * 16 WORD SPECIF ENTRY) THE DIVIDE BY #SECT IS A 0,0 DIVIDED * BY 0. THE RESULT IS 0,0 WHICH IS WHAT IS WANTED. THIS IS * ONLY CASE WHERE THE #SECT IS A 0 ON THE DIVIDE. * UDAD NOP JSB WCSR WRITE CURRENT BLOCK LDA .14 A_14 ADA SECT ADD 7 TO THE SECTOR CLB PREPARE FOR DIVIDE DIV #SECT DIVIDE BY THE NO OF SECTORS0TRACK STB SECT SET THE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB IF SECTOR IS ZERO THEN SKIP (NEW TRACK) JMP UDAD1 ELSE GO EXIT SPC 1 CCB SET TO DECREMENT TRACK CLA SET A FOR ERROR RETURN ADB TRACK ADDRESS CPB LTR OUT OF DIRECTORY? JMP UDAD,I YES SO RETURN STB TRACK SET THE NEW TRACK UDAD1 ISZ UDAD STEP RETURN JMP UDAD,I TAKE OR RETURN SPC 2 LTR NOP NXSCA DEF BUF+5 SKP * DPMM MOVE DISC PARAMETERS FOR CURRENT UNIT * CALLING SEQUENCE * * E=0 - SAVE PARAMETERS * E=1 - MOVE PARAMETERS BACK * * DPMM NOP LDA NXSCA LDB SIGN JSB P.PAS N11 DEC -11 NXSEC NOP #SECT NOP LASTR NOP #TRK NOP NXTR NOP BAD1 NOP BAD2 NOP BAD3 NOP BAD4 NOP BAD5 NOP BAD6 NOP NOP LDB #TRK ADB TRACK COMPUTE THE ADDRESS OF TRACK STB LTR ELSE SET THE ADDRESS LDB DRLU SAVE THE CURRENT LU STB RDPS FOR CORE RESIDENT SPEED JMP DPMM,I SPC 5 * * FLAG CHECKS FOR OPEN FLAGS * |þú ASSUMES FLAGA POINTS TO THE FLAG AREA * FLAG NOP CLA CLEAR THE OPEN COUNT STA COUN2 AND LDA N7 SET TO TEST STA COUN1 THE OPEN FLAGS LDB FLAGA GET THE FLAG ADDRESS FLAG1 LDA B,I GET OPEN FLAG RAL,CLE,ERA REMOVE POSSIBLE EXCLUSIVE BIT JSB DORM TEST FOR DORMANT ISZ COUN2 STEP OPEN FLAG COUNT INB STEP TO NEXT ENTRY ISZ COUN1 STEP COUNT; END OF FLAGS? JMP FLAG1 NO; TRY NEXT ONE JMP FLAG,I YES; RETURN SKP * * DORM CHECK TO SEE IF PROGRAM IS DORMANT * * OPEN FLAG IN A * LOCATION TO BE SET TO ZERO'S ADDRESS INB * RETURN P+1 IF NOT DORMANT; ELSE P+2 DORM NOP STB TMP2 SAVE B REG STA ASAVE SAVE A-REG SZA,RSS IF 0 THEN JUST JMP DORM0 RETURN AT P+2 AND MASK2 DOES FLAG BELONG CPA $$CPU TO OUR CPU? RSS YES - CAN CONTINUE CHECKS JMP DORM1 NO - SO RETURN P+1 (NOT DORMANT) * LDA ASAVE GET FLAG AND MASK AND B377 TO ID SEGMENT NUMBER OFFSET SZA,RSS JMP DORM2 LDB KEYLN GET KEYWORD TABLE LENGTH CMB,INB MAKE IT NEGATIVE ADB A ADD OPEN FLAG (AN OFFSET IN TABLE) SSB,RSS BEYOND KEYWORD TABLE LIMITS? JMP DORM2 YES - CLEAR AND RETURN P+2 * CPA IDNUM IF SAME ID SEG (OFFSET #) EITHER FLAG JMP DORM2 BELONGS TO CALLER OR NEEDS TO BE CLEARED * LDB KEYWD GET 1ST WORD ADDRESS ADB A OF KEYWORD TABLE ADB N1 PLUS OFFSET XLA B,I LDB A LDA ASAVE GET OPEN FLAG AND B7400 MASK TO SEQUENCE NUMBER ALF MOVE TO BITS 15-12 STA TMP3 AND SAVE ADB .31 POSITION TO SEQUENCE NUMBER IN ID SEG. XLA B,I AND LOAD IT AND MASK2 MASK TO BIà‚þúTS 15-12 CPA TMP3 SAME SEQ # AS IN OPEN FLAG? RSS YES - CONTINUE CHECKING JMP DORM2 NO - MUST BE A JUNK OPEN FLAG ADB N23 POSITION TO POINT OF SUSPENSION XLA B,I AND LOAD IT SZA IF ZERO, PROGRAM IS DORMANT JMP DORM1 NOT DORMANT * DORM2 CLA CLEAR OPEN STA TMP2,I FLAG ISZ WCS SET WRITTEN ON FLAG DORM0 ISZ DORM STEP RETURN ADDRESS DORM1 LDB TMP2 RESTORE B-REG JMP DORM,I RETURN SPC 2 EX1 CLA,INA,RSS EX2 LDA .2 RSS EX6 LDA .6 RSS EX7 LDA .7 RSS EX8 LDA .8 RSS EX11 LDA .11 RSS EX13 LDA .13 RSS EX14 LDA .14 RSS EX19 LDA .19 RSS EX20 LDA .20 RSS EX30 LDA .30 RSS EX32 LDA .32 RSS EX33 LDA .33 RSS EX34 LDA .34 RSS EX35 LDA .35 RSS EX40 LDA .40 RSS EX46 LDA .46 RSS EX99 LDA .99 CMA,INA JMP CREX SPC 2 .7 DEC 7 .9 DEC 9 .13 DEC 13 .30 DEC 30 .32 DEC 32 .33 DEC 33 .34 DEC 34 .35 DEC 35 .40 DEC 40 .46 DEC 46 .99 DEC 99 .128 DEC 128 B77 OCT 77 B7400 OCT 7400 N8 DEC -8 N23 DEC -23 .11 DEC 11 .19 DEC 19 .31 DEC 31 FIRST NOP COUN1 NOP COUN2 NOP COUN3 NOP BTRA DEF BAD1 BADTR NOP ASAVE NOP * * SKP CREAT LDA A.STR LDB .9 JSB RDSTR READ THE SKELETON DIRECTORY LDA A.STR MOVE STRING INTO NAME BUFFER CLE THIS IS DONE IN CASE THERE IS A MULTI-DISC JSB MOVE1 SEARCH (STRING'S NOT ARUOND 2ND TIME) LDA NAME+3 GET THE TYPE OF THE FILE BEING CREATED SZA TYPE ZERO? JMP CR. NO - SKIP THIS STUFF DLD NAME+4 WANT TO PULL OUT WORDS DST TPZER 5,6,7, AND 8 IN THE DLD NAME+6 DIRECTORY ENTRY AND REPLACE DST TPZER+2 THEM WITH ZERO'S CLA /þú CLB DST NAME+4 DST NAME+6 * CR. LDA IDNUM SET UP EXCLUSIVE OPEN FLAG IOR SIGN ADD THE EXCLUSIVE BIT STA IDNUM SAVE IT CLA CLEAR THE EXTENT FLAG STA GSEC SAVE IT FOR THE DIRECTORY * DLD NAME+5 GET DOUBLE WORD SIZE SPECIFIED SWP STB SFLAG SET FLAG FOR MAX SIZE 0 = 32K -1 = 32K X 128 SZB,RSS IF SIZE IS + SECTORS AND < 32767 OR SSA SSB SIZE IS IN -CHUNKS OR -1 SPECIFIED JMP CR.0 THEN JUST USER LOWER HALF OF WORD CPA N1 IF REST OF DISC REQUEST FROM SZB SINGLE WORD CREAT CALL, THEN JUST RSS USE WHAT'S IN A ( -1) JMP CR.0 AGAIN DIV .256 DIVIDE DOUBLE WORD # SECTORS BY "128 QUANTITY" SOC IF OVERFLOW (DIVIDEND TOO BIG) JMP EX30 TAKE ERROR EXIT SZB IF NOT AN EVEN # "128 QUANTITY" INA THEN INCREMENT 1 "128 QUANTITY" CMA,INA MAKE NEGATIVE CR.0 SSA,RSS IF >0 JUST KEEP WHAT'S IN A JMP CR.1 CPA N1 IF -1 WANT REST OF DISC JMP CR.1 LDB .127 IF LESS THAN -128 (X128 BLOCK CHUNKS) ADB A THEN CONVERT TO SECTORS SSB,RSS BY MAKING POSITIVE AND MULTIPLYING BY 256 CMA,INA IF IN + SECTORS ALREADY WILL FALL THROUGH SSB,RSS ALF,ALF CR.1 STA NAME+6 * JSB SETDR SET TO BEGINNING OF DIRECTORY AGAIN JSB N.SHR SEARCH FOR THE NAME CREA0 CCE,RSS NOT FOUND - SKIP JMP EX2 FOUND - TAKE DUP NAME EXIT * LDB R1 WAS A REUSABLE ENTRY FOUND? SSB,RSS WELL! JMP RUSE YES GO SET IT UP. * SZA,RSS ELSE IF DIRECTORY FULL JMP ER14 TAKE EXIT * JSB SETAD SET THE ADDRESSES CCE LDA DIRA MOVE IN JSB MOVE1 LDA IDNUM SET THE OPEN FLAG IOR SQCPU µ©þú ADD IN CPU AND SEQUENCE NUMBERS STA FLAGA,I LDB BTRA SET THE BAD TRACK POINTER CHKBT LDA B,I IF END OF LIST SZA,RSS THEN JMP EOL CONTINUE CMA,CLE ELSE SET ADA NXTR BADTR TO SEZ,RSS POINT TO JMP EOL FIRST BAD TRACK INB => NXTR JMP CHKBT EOL STB BADTR SET BAD TRACK POINTER LDB NXSEC GET THE NEXT TRACK LDA NXTR AND SECT CREA1 STA TRAKA,I SET THE TRACK ADB GSEC ADD THE EXTENT WORD STB SECTA,I SET THE SECT/EXTENT LDB #SEC,I GET THE REQUEST SIZE LDA BADTR,I AND THE FIRST BAD TRACK CPB N1 IF REST OF DISC SZA,RSS ELSE IF TRACK IS GOOD, SKIP JMP CREA2 GO CALCULATE SIZE * CREA3 INA BAD TRACK ON REST OF DISC RQ ISZ BADTR SET FILE ABOVE IT AND CLB TRY AGAIN JMP CREA1 * CREA2 CPB N1 IF REST OF DISC JMP CREA5 JMP * CREA7 JSB NXT/S COMPUTE THE NEXT TRACK AND SECTOR JMP CREA8 WHOOPS - OVERFLOWED OR TRACK > 32767 STA SETAD SECTOR - SAVE LAST TRACK LDA BADTR,I GET LAST AVAILABLE TRACK SZA,RSS IF NOT BAD LDA LASTR THE LAST ON DISC+1 CMA SUBTRACT FROM SZB BUMP TRACK INA IF SOME OF IT USED ADA SETAD LAST FILE TRACK SSA 0 OR +? JMP CREA4 YES; IT FITS * LDA BADTR,I NO; WON'T FIT SZA WAS IT A BAD TRACK? JMP CREA3 YES; TRY ABOVE IT * CREA8 CLA NO - CLEAR ENTRY STA DIRA,I FROM BUFFER LDA GSEC IF EXTENT CREAT SZA,RSS THEN SKIP TO ERROR EXIT JMP NEXT ELSE TRY NEXT DISC * JMP EX33 NO ROOM FOR EXTENT EXIT * CREA4 LDA SETAD IT FIT SO CREA6 STA NXTR UPDATE THE NEXT STB NXSEC TRACK AND SECTOR ISZ WCS SET THE ˜1þúWRITE FLAG * LDA TYPE,I GET THIS FILE'S TYPE SZA TYPE ZERO?? JMP CR.61 NO - SKIP THIS STUFF DLD TPZER REPLACE WORDS 5,6,7, AND 8 STA TRAKA,I IN THE DIRECTORY ENTRY STB SECTA,I THAT WERE REMOVED BEFORE DLD TPZER+2 THE ENTRY WAS CREATED STA #SEC,I STB RL,I CR.61 CLA CLEAR A FOR FIRST RETURN PARAMETER JSB RPRM AND GO SET UP THE RETURN JSB SETDR SET UP TO READ FIRST STA FIRST DIRECTORY BLOCK JSB RDNXB READ IT .2 DEC 2 CCE MOVE NEW JSB DPMM NEXT TRACK AND SECT WORDS ISZ WCS IN - SET TO WRITE JMP EXIT AND EXIT * CREA5 LDA SFLAG SEE WHAT THE MAX FILE SIZE SHOULD BE ELA E=1 --> MAX = 32K X 128 E=0 --> MAX = 32K LDA MAX CALCULATE MAX FILE CLB SIZE IN SECTORS 32767 X "128 QUANTITY" SEZ IF DOUBLE WORD CREAT WANT 32767 INA SO INCREMENT MAX BY 1 SEZ DON'T SHIFT IF MAX = 32K LSL 8 (GET HIGH ORDER BITS TO A) SWP DST TMP1 AND TEMP SAVE IN TMP1 AND TMP2 CLA TEMPORARILY SAVE LDB SECTA,I -(STARTING JSB .DNG SECTOR) DST TMP3 IN TMP3 LDA TRAKA,I CALCULATE -(FILE'S STARTING CMA,INA TRACK ADDRESS) + LAST TRACK ADA LASTR ON SUBCHANNEL X NUMBER MPY #SECT SECTORS PER TRACK - SWP FILE'S STARTING JSB .DAD SECTOR ADDRESS DEF TMP3 = SECTORS ON REST OF SUBCHANNEL DST TMP3 SAVE IN TMP3 SOC OVERFLOWED THE DOUBLE WORD? JMP CR.51 YES - JUST USE MAX FILE SIZE DLD TMP1 GET MAX FILE SIZE JSB .DNG -(MAX FILE SIZE IN SECTORS) JSB .DAD + NUMBER SECTORS ON REST DEF TMP3 OF SUBCHANNEL SSA,RSS REST OF DISC BIGGER THANm¢þú MAX FILE SIZE? JMP CR.51 YES - JUST USE MAXIMUM FILE SIZE DLD TMP3 GET # SECTORS ON REST OF DISC JMP CR.52 SKIP CR.51 DLD TMP1 GET MAX FILE SIZE CR.52 SWP GET HIGH ORDER BITS TO B-REG SZB,RSS <=32767 SSA <= 32767? RSS JMP CR.53 YES - SO SAVE SIZE IN +SECTORS DIV .256 NO - DIV BY "128 QUANTITY" TO GET SIZE * JUST THIS ONE TIME, IGNORE ANY SECTORS LEFT OVER CMA,INA MAKE NEGATIVE CR.53 STA #SEC,I SET FILE SIZE AS +SECTORS OR -"128 QUANTITY" IN FILE ENTRY SZA,RSS IF ZERO JMP NEXT TRY NEXT DISC JMP CREA7 GO WRAP IT UP * ER14 LDA DISID ERROR -14 TRAP. IF THIS IS SZA,RSS MULTI-DISC SEARCH THEN JMP NEXT GO GET THE NEXT DISC. JMP EX14 OTHERWISE, MUST RETURN ERROR. * MAX OCT 77776 MAX NUMBER OF SECTORS IN A FILE .127 DEC 127 SFLAG NOP TPZER BSS 4 SKP *WE HAVE A REUSABLE ENTRY IN THE DIRECTORY AND WE NEED IT *SO THE DIRECTORY BLOCK IS READ BACK IN (IF REQURED) AND *THE ENTRY IS SET UP. * RUSE STB TRACK B HAS TRACK FROM EXISTANCE TEST LDB R2 GET THE SECTOR AND STB SECT SET IT JSB RWSUB READ THE BLOCK TO CORE IF REQUIRED LDA SBUF GET ADDRESS OF CURRENT BLOCK ADA R3 AND ADD IN THE OFFSET JSB SETAD SET UP THE ADDRESSES LDA TRAKA,I SET THE FILE ADDRESSES STA NAME+4 IN THE ENTRY LDA SECTA,I AND B377 PURGE POSSIBLE EXTENT FLAG ADA GSEC ADD IN POSSIBLE NEW EXTENT FLAG STA NAME+5 LDA DIRA MOVE THE ENTRY INTO THE BUFFER CCE JSB MOVE1 LDA IDNUM SET POSSIBLE OPEN FLAG IOR SQCPU ADD IN CPU AND SEQUENCE NUMBERS STA FLAGA,I IN THE ENTRY ISZ WCS SET THE WRITE FLAG JMP OPEN4 AND GO EXIT (AFTER THE WRITE) * * * MOVE1/2 TO MßNþúOVE DIRECTORY ENTRIES TO/FROM * THE LOCAL SAVE AREA DEFINED * HEREIN. * * CALLING SEQUENCE: * * E=0 TO THIS SAVE AREA * E=1 FROM THIS SAVE AREA * * A = ADDRESS OF OTHER AREA * * MOVE1 MOVES 9 WORDS * MOVE2 MOVES 3 WORDS * MOVE1 NOP LDB SIGN SET B TO MOVE WORDS JSB P.PAS CALL TO MOVE N9 DEC -9 9 WORDS NAME BSS 9 CSEC EQU NAME+5 JMP MOVE1,I RETURN SPC 2 MOVE2 NOP LDB SIGN SET B FOR MOVE JSB P.PAS CALL TO MOVE N3 DEC -3 3 BSS 3 WORDS JMP MOVE2,I RETURN SPC 2 GTRK NOP GLU NOP GSEC NOP G#SEC NOP SKP GEN JSB TESTL TEST LEGALITY OF CALL JSB SETDR SET UP TO ACCESS THE DIRECTORY JSB RDPAS READ THE PASSED DATA GEN2 CLE SET E FOR DPMM CALL ISZ FIRST FIRST SECTOR? RSS NO - SKIP JSB DPMM YES - GO EXTRACT DISC PRAMS JSB UDAD UPDATE DIRECTORY ACCESS JMP CREX END GO EXIT JSB ADDR SET UP TRACK AND SECTOR ADDRESS TO BE WRITTEN ISZ WCS SET WRITE FLAG JSB WCSR WRITE THE SECTORS LDA BUFA,I IF A ZERO SECTOR SZA,RSS THEN JMP GEN2 ALL THE REST MUST BE ZERO ALSO. * JMP RDPA2 GO GET THE NEXT BLOCK SPC 2 TESTL NOP LDB DIRAD POSITION TO ADB N4 LOCK WORD LDA B,I GET THE LOCK ALF,ALF AND B377 LDB DISID IF LOCKED CPA IDNUM TO CALLER SZB,RSS AND CORRECT DISC SPEC SKIP JMP EX102 ELSE TAKE ERROR EXIT JMP TESTL,I SPC 5 * * RDPAS READ THE PASSED DATA * RDPAS NOP LDA ATMP3 RETRIEVE PASSED LDB .2 STRING CONTAINING JSB RDSTR DATA TRACK ADDRESS. LDA TMP3 GET LU NUMBER, AND B77 ›2þú ISOLATE IT, STA GLU AND SAVE. LDA TMP3+1 GET TRACK NUMBER STA GTRK AND SAVE. LDA P4 GET THE #SECTORS/TRACK RAL,CLE,ERA ELIMINATE THE SIGN STA G#SEC AND SET CLA SET FOR SECTOR STA GSEC ZERO LDA ABUF SET CURRENT BUFFER POINTER TO BEGINNING STA SBUF OF BUFFER INTO WHICH DATA WAS READ RDPA2 JSB EXEC READ THE SECTORS DEF GRTN DEF RDNAB DEF GLU BUFA DEF BUF DEF .128 DEF GTRK DEF GSEC GRTN JMP EX99 CPB .128 DISC ERROR? RSS NO; CONTINUE JMP EX1 YES; TAKE DISC ERR EXIT LDA GSEC UPDATE THE ADA .2 DISC ADDRESS CPA G#SEC END OF TRACK? CLA YES - USE 0 SECT. STA GSEC SET SECTOR CLE,SZA,RSS IF EOT ISZ GTRK STEP TRACK ADDRESS JMP RDPAS,I RETURN * ATMP3 DEF TMP3 SPC 4 * * * RDSTR RETRIEVES PASSED STRING * * ENTRY: A = ADDRESS OF BUFFER * B = LENGTH OF BUFFER * * EXIT : A = 0 SUCCESSFUL * A = 1 NO STRING FOUND * * RDSTR NOP STA STBUF STUFF BUFFER ADDRESS STB STLEN AND LENGTH INTO EXEC CALL JSB EXEC DEF STRTN DEF .14 CALL EXEC STRING PASSAGE DEF .1 TO RETRIEVE STRING STBUF NOP SAVE IT IN USER DEF STLEN SUPPLIED BUFFER. STRTN JMP RDSTR,I RETURN * STLEN NOP STRNG BSS 9 A.STR DEF STRNG SKP LOCK5 LDB P4 END OF DIRECTORY LDA P2 SEE IF GEN OR MOUNT CALL AND B77 CPA .13 MOUNT? JMP MOUNT YES - GO DO IT. CPA .7 GEN CALL AND SSB,RSS SIGN BIT SET? JMP EX32 NOPE - NOT FOUND EXIT * LDA .2 GET LOGICAL UNIT 2 ADA PRC + PRIVILEDGED BITS STA LDRLU FOR WCSR POST ROUTINE Aªþú LDA $CL1 GET CARTRIDGE DIRECTORY STA LTRAC TRACK AND SECTOR ADDRESS LDA $CL2 FROM EXTERNALS FOR STA LSECT WCSR POST ROUTINE LDA N2 SET UP COUNT FOR STA COUN3 2 CARTRIDGE DIRECTORY BLOCKS JSB RDPAS READ A BLOCK OF THE DIRECTORY FROM STRING INTO BUF ISZ WCS SET WRITTEN ON FLAG ISZ COUN3 2ND BLOCK OF CARTRIDGE DIRECTORY RSS NO - SO SKIP JMP EXIT3 YES - GO WRITE AND EXIT JSB WCSR AND GO POST BLOCK LDA LSECT UPDATE SECTOR ADDRESS ADA .2 OF CARTRIDGE DIRECTORY STA LSECT ON DISC. JMP RDPA2 GO GET 2ND BLOCK SPC 3 MOUNT LDA ANAME READ 9-WORD PASSED LDB .9 STRING INTO BUF AT JSB RDSTR SPCBF. * LDA P3 GET LU NUMBER CMA,INA MAKE IT NEGATIVE STA ALU AND SAVE IT FOR THE CL ENTRY LDA NAME+8 GET NEGATIVE # DIRECTORY TRACKS CMA MAKE POSITIVE AND SUBTRACT ONE ADA NAME+7 AND ADD TO LAST FMP TRACK STA ATRAK SAVE FOR CL ENTRY * LDA P5 GET PARAMETER 5 AGAIN ELA SIGN BIT TO E-REG SEZ INITIALIZE THIS DISC? JMP MT.1 YES JSB CLOPF NO - GO CLEAR OFF ANY OPEN FLAGS JMP MT.3 AND ADD ENTRY TO CL. * MT.1 LDA ABUF MOVE 1ST 9 WORDS OF CARTRIGE SPECIF STA SBUF (SET UP CURRENT BLOCK ADDRESS) JSB MOVE1 INTO BUF E IS ALREADY = 1 CLA ZERO OUT AT LEAST 135 WORDS LDB .144 FOLLOWING THE 9 WORDS OF THE CMB,INB SPECIFICATION ENTRY IN BUF. IT STB COUN1 WILL BE USED TO CLEAR OUT THE LDB ABUF REST OF THE FILE DIRECTORY BEHIND ADB .9 THE SPECIFICATION ENTRY. STA B,I INB ISZ COUN1 JMP *-3 * JSB SETDR SET UP TO ACCESS BEGINNING OF FILE DIRECå…þúTORY CLE CLEAR E FOR DPMM JSB DPMM SAVE DISC PARAMETERS MT.2 JSB UDAD UPDATE FILE DIRECTORY ADDRESS OF DISC JMP MT.3 END OF DIRECTORY SO GO UPDATE CL JSB ADDR SET LAST READ ADDR AS CURRENT DISC ADDR ISZ WCS SET WRITTEN ON FLAG JSB WCSR AND GO WRITE THE BLOCK LDA SBUF,I FROM 2ND TIME THRU FORWARD WANT TO SZA,RSS USE AN ALL ZERO SECTOR SO STEP JMP MT.2 CURRENT BUFER POINTER PAST 16-WORD LDA SBUF SPECIFICATION ENTRY. ADA .16 STA SBUF JMP MT.2 * MT.3 JSB RDPS READ CARTRIDGE DIRECTORY LDB ABUF START AT BEGINNING OF CL MT.4 LDA B,I GET 1ST WORD OF ENTRY SZA,RSS IS THIS THE 1ST EMPTY ENTRY? JMP MT.5 YES ADB .4 NO - STEP TO NEXT ENTRY JMP MT.4 AND CHECK IT * MT.5 LDA ABUF MAKE SURE THAT B ISN'T ADA .251 POINTING TO STOP WORD, I.E. CPA B THAT CL IS ALREADY FULL JMP EX35 STB DIRAD THIS IS THE SPOT TO ADD THE ENTRY * LDA ALU SAVE FOR LATER STA DIRAD,I AND STUFF IN 1ST WORD OF CL ENTRY ISZ DIRAD LDA ATRAK SAVE FOR LATER STA DIRAD,I AND STUFF IN 2ND WORD OF CL ENTRY ISZ DIRAD LDA NAME+3 GET CRN STA DIRAD,I AND STUFF IN 3RD WORD ISZ DIRAD LDA P5 GET ID FROM PARAMETER 5 RAL,CLE,ERA CLEAR SIGN BIT STA DIRAD,I AND PUT IT IN WORD 4 OF THE DIRECTORY JSB PSTCL CL OUT TO LU2 JMP EXIT4 RETURN WITH ERROR = 0 * SPC 4 DISMT LDA DISID A PARTICULAR DISC SZA,RSS MUST HAVE BEEN SPECIFIED JMP EX101 ONE WASN'T ERROR -101 * JSB VALID SEE IF DIRECTORY IS VALID JMP DISM0 IT ISN'T SO SKIP OPEN FLAG CHECK * JSB OPNCK ARE THERE ANY VALID OPEN FLAGS JMP EX8 YES - SO CAN'T DISMOUNT IT * DISMdìþú0 JSB RDPS RE-READ THE CARTRIDGE LIST LDA ABUF REMOVE THIS ENTRY BY MOVING ALL ADA .248 ENTRIES FOLLOWING IT UP ONE (4 WORDS) STA TMP3 TMP3 IS ADDRESS OF LAST POSSIBLE ENTRY LDB DIRAD TO BE MOVED. ADB N4 B CONTAINS LOCATION BEING MOVED TO SHIFT LDA DIRAD,I DIRAD CONTAINS LOCATION BEING MOVED FROM STA B,I MOVE WORD UP 4 CPB TMP3 IS THIS THE LAST ONE? JMP DISM1 YES - SO GO POST REVISED CARTRIDGE DIRECTORY INB STEP TO NEXT WORD ISZ DIRAD TO BE MOVED JMP SHIFT * DISM1 JSB PSTCL THE CARTRIDGE DIRECTORY JMP EXIT4 NO - RETURN SPC 5 CHGCL LDA DISID A PARTICULAR DISC SZA,RSS MUST HAVE BEEN SPECIFIED JMP EX101 ONE WASN'T ERROR -101 * LDA DIRAD WANT NEW ENTRY ADA N4 PUT HERE IN CL LDB .4 FOUR WORDS LONG JSB RDSTR GET STRING AND PUT IN CL ENTRY JSB PSTCL WRITE CL BACK OUT TO DISC JMP EXIT4 AND LEAVE. SKP * * * VALID - MAKES SURE CURRENT DISC HAS A VALID DIRECTORY * * CALLING SEQUENCE: * JSB VALID * RETURN NOT VALID DIRECTORY * RETURN OK * * CAUTION: THIS SUBROUTINE ASSUMES THAT THE 1ST DIRECTORY * BLOCK IS READ INTO THE BEGINNING OF BUF BUFFER. IT USES * BUF INSTEAD OF SBUF, THE ADDRESS OF THE CURRENT BLOCK IN * THE TRACK BUFFER. THAT IS OK NOW, BUT IF ANYTHING IN THE * SCHEME OF MANAGING THE TRACK BUFFER IS CHANGED, IT COULD * BE A PROBLEM. * * * VALID NOP JSB SETDR SET UP TO READ 1ST DIRECTORY BLOCK JSB RDNXB AND READ IT LDA BUF GET 1ST WORD SSA SIGN BIT MUST BE SET. IF NOT JMP VALID,I ILLEGAL DIRECTORY * LDA BUF+3 GET CRN SSA IF NEGATIVE JMP VALID,I THEN ILLEGAL DIRECTORY * LDA BUF+8 H»þú NUMBER OF TRACKS IN DIRECTORY CMA,INA (MADE POSITIVE) PLUS LOWEST ADA BUF+7 DIRECTORY TRACK LESS ADA N1 ONE MUST BE SAME AS CPA TRACK LAST TRACK RSS OK JMP VALID,I ITS NOT SO ILLEGAL DIRECTORY * LDA BUF+5 NEXT SECTOR CAN'T CMA,INA BE LARGER THAN NUMBER OF ADA BUF+6 SECTORS PER TRACK SSA,RSS ISZ VALID OK JMP VALID,I SKP * * * CLOPF CLEAR ANY OPEN FLAGS FOUND IN THE FILE DIRECTORY * OF THE PENDING DISC. * * * ENTRY: ATRAK - LAST TRACK * ALU - LU OF DISC * * CLOPF NOP JSB SETDR SET UP TO READ BEGINNING OF FILE DIRECTORY CL.1 JSB RDNXB READ NEXT BLOCK JMP CLOPF,I END OF DIRECTORY SO LEAVE LDA N8 EIGHT ENTRIES STA COUN3 IN A BLOCK LDA SBUF START AT BEGINNING OF BLOCK CL.2 STA ASAVE SAVE THIS ADDRESS LDB A,I GET 1ST WORD OF ENTRY SSB PURGED? JMP CL.5 YES - IGNORE ENTRY SZB,RSS END OF DIRECTORY? JMP CLOPF,I YES - SO LEAVE JSB SETAD SET ADDRESSES FOR THIS ENTRY LDB FLAGA USE ADDRESS OF OPEN FLAG STB PTR1 LIST AS POINTER LDB N7 SET FOR 7 OPEN STB COUN1 FLAGS PER ENTRY CL.3 LDB PTR1,I GET FLAG SZB,RSS ZERO? JMP CL.4 YES CLB NO - CLEAR STB PTR1,I OPEN FLAG ISZ WCS SET WRITTEN ON FLAG CL.4 ISZ PTR1 STEP TO NEXT ENTRY ISZ COUN1 DONE WITH THIS ENTRY? JMP CL.3 NO - KEEP CHECKING CL.5 LDA ASAVE YES - STEP ADA .16 TO NEXT ENTRY ISZ COUN3 END OF BLOCK? JMP CL.2 JSB WCSR YES - POST BLOCK IF ANY FLAGS WERE CLEARED JMP CL.1 AND GO TO NEXT BLOCK SPC 4 PACK JSB TESTL TEST LEGALITY OF CALL JSB SETPR SET UP THEõþú DISC PARAMETERS LDA P4 GET RELATIVE DOUBLE SECT CMA,INA,SZA,RSS SET NEGATIVE IF ZERO JMP PACK2 SKIP STA COUN1 SET COUNT PACK1 JSB UDAD BUMP ADDRESS JMP EX101 END OF DIRECTORY EXIT ISZ COUN1 STEP COUNTER; DONE? JMP PACK1 NO; GO BUMP AGIN PACK2 LDA ABUF LDB .128 JSB RDSTR JSB ADDR SET TRACK AND SECTOR ADDRESSES TO BE WRITTEN TO EXIT3 ISZ WCS SET WRITE FLAG EXIT4 CLA AND TAKE JMP CREX ACCEPT EXIT SPC 2 66 ID NOP IDNUM NOP TMP1 NOP -\ THESE TWO WORDS MUST BE IN THIS ORDER - TMP2 NOP -/ SOMETIMES USED TO SAVE A DOUBLE WORD DIRAD NOP TRACK NOP SECT NOP WCS NOP ALU NOP DITR NOP SPC 4 * * * PSTCL POSTS 2 BLOCK CARTRIDGE LIST FROM BUF TO LU 2, * TRACK $CL1, SECTOR $CL2 * * PSTCL NOP LDA .2 GET LU 2 ADA PRC + PRIVILEDGED BITS STA TMP1 JSB EXEC DEF *+7 DEF WTNAB WRITE DEF TMP1 TO LU2 DEF BUF FROM BUF DEF .256 256 WORD CL DEF $CL1 TO TRACK IN $CL1 DEF $CL2 AND SECTOR IN $CL2 JMP EX99 CPB .256 CHECK TRANSMISSION LOG JMP PSTCL,I OK - SO RETURN JMP EX1 DISC ERROR * * * ADDR SET LAST LU,TRACK AND SECTOR READ PARAMETERS TO * CURRENT TRACK AND SECTOR PARAMETERS * ADDR NOP LDA DRLU GET CURRENT DIRECTORY LU ADA PRC ADD IN PRIVILEDGED BITS STA LDRLU LDA TRACK STA LTRAC LDA SECT STA LSECT JMP ADDR,I SKP RLOCK LDA DISID DISC MUST BE SPECIFIED SZA,RSS JMP EX101 NOT SPECIFIED - EXIT JSB OPNCK ANY OPEN FLAGS ON THIS DISC? JMP EX8 YES; REJECT LOCK JSB RDPS LOCK GRANTABLE READ CARTRIDGE DIRECTORY LDA IDNUM GET OFFSET IN KEYWORD TABLE OF CALLER'S ALF,ÂþúALF ID SEG ADDRESS AND SHIFT TO HIGH BYTE STA TMP1 KEEP TEMPORARILY LDB N4 SET B-REG TO ADDRESS OF CORRECT ADB DIRAD ENTRY'S LOCK AND LU WORD LDA B,I GET LU WORD AGAIN AND B377 MASK TO JUST LU (IN CASE PROG ALREADY HAS IT LOCKED) ADA TMP1 ADD LU TO LOCK ROCK5 STA B,I AND SET IN CL JSB PSTCL CARTRIDGE DIRECTORY CLA JMP CREX SPC 5 ULOCK LDA B377 UNLOCK - CLEAR LDB N4 CALCULATE LOCK AND LU WORD ADDRESS ADB DIRAD OF APPROPRIATE CL ENTRY AND B,I CLEAR UPPER BYTE (LOCK WORD) JMP ROCK5 GO SET IT. SPC 2 EX101 LDA N102 INA,RSS EX102 LDA N102 JMP CREX SPC 2 N102 DEC -102 .16 DEC 16 B377 OCT 377 N7 DEC -7 .251 DEC 251 .248 DEC 248 SKP CNAM LDA A.STR CHANGE NAM - READ NEW NAME LDB .3 FETCH PASSED STRING WITH JSB RDSTR NEW NAME AND PUT IN ARRAY NAME LDA A.STR MOVE STRING INTO NAME BUFFER CLE THIS IS DNE IN CASE THERE IS A MULTI-DISC JSB MOVE1 SEARCH (STRING'S NOT AROUND 2ND TIME) CLE SAVE SECOND LDA ANAME COPY OF JSB MOVE2 6-CHAR NAME JSB SETDR SET UP TO READ THE DIRECTORY JSB N.SHR SEARCH FOR DUPLICATE NAME RSS NOT FOUND SO SKIP JMP EX2 TAKE DUP NAME EXIT JSB DIRCK GO GET DIRECTORY ENTRY LDA FLAGA,I OPEN EXCLUSIVELY RAL,CLE,ERA CLEAR EXCLUSIVE BIT AND SAVE IN E AND B377 MASK TO ID SEG OFFSET CPA IDNUM TO CALLER? SEZ,CCE,RSS YES SKIP JMP EX102 NO; REJECT CNAM1 LDA DIRA YES; MOVE JSB MOVE2 THE NEW NAME IN JSB EXSH SEARCH FOR EXTENT OF THIS FILE JMP CNAM1 YES GO SET NEW NAME SPC 2 EXSH NOP DIRECTOR SEARCH FOR EXTENTS TO MODIFY ISZ WCS SET THE WRITE FLAG JSB ÅlþúEXSHR SEARCH FOR EXTENT JMP EXIT4 NOT FOUND SO EXIT JMP EXSH,I FOUND RETURN SPC 5 * * DIRCK READ A DIRECTORY ENTRY - SET FLAGS * CHECK OPEN FLAGS ETC. * DIRCK NOP LDA ALU DO WE ALREADY CPA RDPS HAVE THE DISC SPECS? RSS YES SO SKIP SET UP JSB SETPR SET UP THE DISC PARAMETERS LDA DITR SET STA TRACK TRACK CLB GET THE PASSED LDA P3 SECTOR RRL 3 OFFSET TO B-REG BLF MPY BY 16 STB TMP3 AND SAVE IN TMP3 AND MASK1 MASK TO SECTOR NUMBER ALF,ALF POSITION TO RAR BITS 0-6 STA SECT AND SAVE. JSB RWSUB READ THE BLOCK ADA TMP3 JSB SETAD LDA DIRA MOVE THE ENTRY TO LOCAL JSB MOVE1 STORAGE JMP DIRCK,I SKP SPC 5 CLOSE JSB DIRCK CLOSE; GET THE SECTOR LDB N7 SET FOR 7 ENTRIES CLOS1 LDA FLAGA,I FIND RAL,CLE,ERA CALLERS AND B377 FLAG CPA IDNUM JMP CLOS2 FOUND ISZ FLAGA NOT; YET TRY NEXT ONE INB,SZB MORE? JMP CLOS1 YES; OK JMP EX11 NO; ERR - NOT OPEN TO CALLER SPC 2 CLOS2 CLA FOUND; CLEAR THE STA FLAGA,I OPEN FLAG ISZ WCS SET WRITTEN ON FLAG SEZ,RSS EXCLUSIVE OPEN? JMP EXIT3 NO; EXIT LDA ATMP3 GET TRUNCATE CODE LDB .2 FROM 2-WORD JSB RDSTR PASSED STRING CPA .1 WAS THERE A STRING? JMP EXIT3 NO - WE'ER DONE DLD TMP3 LOAD DOUBLE WORD TRUNCATE CODE SZA,RSS IF TRUNCATE SZB CODE IS RSS ZERO THEN JMP EXIT3 EXIT - NO ACTION SSA,RSS IF POSITIVE THEN JMP EXPUR GO PURGE EXTENTS CLB LDA #SEC,I GET CURRENT FILE SIZE SSA,RSÚwþúS IF POSITIVE, ALREADY IN SECTORS JMP CL.21 SO SKIP CMA,INA MAKE POSITIVE LSL 8 AND MULTIPLY BY "128 QUANTITY" CL.21 SWP GET HIGH ORDER BITS TO A-REG JSB .DAD ADD CURRENT FILE SIZE DEF TMP3 TO TRUNCATE CODE SLB,RSS IGNORE IF ODD SECTOR COUNT SSA IF RESULT IS LESS THAN ZERO JMP EXIT3 THEN IGNORE IT CCE,SZA,RSS IF ZERO SZB THEN GO RSS PURGE JMP PURGE FILE SWP GET HIGH ORDER BITS TO B-REG SZB,RSS <=32767? SSA MUST CHECK B AND RSS SIGN BIT ON A JMP CL.22 YES - SO SET SIZE IN + SECTORS DIV .256 NO - MUST USE "128 QUANTITY". SZB DIVIDE BY 128 AND INA ADD 1 IF ANY SECTORS CMA,INA LEFT OVER. CL.22 STA TMP2 SAVE FILE SIZE IN +SECTORS OR -TRACKS JSB LAST? LAST FILE? CLE,RSS NO CCE YES LDA TMP2 NOW SET FILE SIZE IN ENTRY STA #SEC,I SEZ,RSS JMP EXPUR GO PURGE ANY EXTENTS JMP PURG8 - GO UPDATE DISC PARAMETERS SKP * * * NXT/S CALCULATES NEXT TRACK AND SECTOR ADDRESS FROM CURRENT * TRACK AND SECTOR AND SIZE * * RETURN P+1 NEXT TRACK > 32767 * P+2 OK * A = NEXT TRACK * B = NEXT SECTOR * * NXT/S NOP CACULATE THE NEXT TRACK AND SECTOR CLB LDA SECTA,I GET THE STARTING SECTOR AND B377 AND ISOLATE IT SWP GET HIGH ORDER BITS TO A-REG DST TMP3 SAVE AS A DOUBLE WORD (B=0) CLB LDA #SEC,I GET FILE SIZE SSA,RSS IN + SECTORS OR IN -128 BLOCK CHUNKS JMP NXT.1 SECTORS OR IN -128 BLOCK CHUNKS CMA,INA -TRACKS - MAKE POSITIVE MPY .256 AND M¾ýþúPY BY "128 QUANTITY" NXT.1 SWP GET HIGH ORDER BITS TO A-REG JSB .DAD SUM NUMBER SECTORS IN FILE DEF TMP3 AND STARTING SECTOR SWP GET HIGH ORDER BITS TO B-REG DIV #SECT DIVIDE BY THE NO OF SECTORS PER TRACK SOC DID WE OVERFLOW ONE WORD FOR TRACK? JMP NXT.2 YES - SET TO RETURN P+1 ADA TRAKA,I ADD TRACK OVERFLOW TO CURRENT TRACK ADDRESS SSA,RSS IS TRACK >32767?? ISZ NXT/S NO - RETURN P+2 NXT.2 JMP NXT/S,I RETURN WITH A = NEXT TRACK AND B = NEXT SECTOR SPC 5 OPNCK NOP CLA STA OPFLG JSB SETDR SET TO BEGINNING OF FILE DIRECTORY OPN.1 JSB RDNXB READ NEXT DIRECTORY BLOCK JMP OPN.4 END OF DIRECTORY - GRANT LOCK LDA N8 SET COUNTER FOR 8 ENTRIES PER BLOCK STA COUN3 LDA SBUF GET STARTING ADDRESS OF BLOCK OPN.2 LDB A,I GET FIRST WORD OF ENTRY SSB PURGED? JMP OPN.3 YES - IGNORE THIS ENTRY SZB,RSS END OF DIRECTORY? JMP OPN.4 YES - GRANT LOCK JSB SETAD NO - SET ENTRY ADDRESSES JSB FLAG TEST FOR OPEN FLAGS LDB COUN2 ANY OPEN FLAGS SZB IN THIS ENTRY? ISZ OPFLG YES - SET FLAG LDA DIRA NO - GET ADDRESS IN A-REG OPN.3 ADA .16 STEP TO NEXT ENTRY ISZ COUN3 END OF BLOCK? JMP OPN.2 NO - GO DO NEXT ENTRY JMP OPN.1 YES - TRY NEXT BLOCK OPN.4 LDA OPFLG WERE THERE ANY SZA,RSS VALID OPEN FLAGS? ISZ OPNCK NO - STEP RETURN ADDRESS TO P+2 JMP OPNCK,I RETURN * OPFLG NOP SKP EXSHR NOP EXTENT SEARCH ROUTINE LDB DEF SET RETURN ADDRESS IN STB N.SHR NAME SEARCH ROUTINE JMP NSHR0 GO TO NAME SEARCH DEF DEF *+1 RETURN ADDRESS FOR NAME SHEARCH JMP EXSHR,I NOT FOUND SO EXIT JSB SETAD FOUND SET THE ADDRESSES LDB EX0wþúSHR STEP THE RETURN ADDRESS CCE,INB AND LDA SECTA,I MAKE SURE THIS IS NOT THE MAIN CPA CSEC SAME AS MAIN? CCA,RSS YES SO TRY AGAIN JMP B,I RETURN * STA R1 AFTER WE CLEAR THE FOUND FLAG JMP CSER CONTINUE THE SEARCH SPC 2 * * LAST? CHECKS TO SEE IF CURRENT FILE IS LAST ONE IN DL * * EXIT P+1 - NOT THE LAST FILE * P+2 - IS THE LAST FILE * * LAST? NOP JSB NXT/S COMPUTE THE NEXT TRACK AND SECTOR NOP CAN'T GET OVERFLOW CONDITION ON THIS CALL TO NXT/S CPA NXTR SAME TRACK? CCA YES; A_1 CPB NXSEC SAME AS NEXT SECTOR? INA,SZA YES; WAS IT SAME TRACK ALSO? JMP LAST?,I NO; NOT LAST FILE EXIT P+1 JSB FORWD COULD BE POSITION TO NEXT ENTRY JMP LAS.1 END OF DIRECTORY - HAS TO BE LAST FILE LDB DIRA,I GET 1ST WORD OF NEXT ENTRY SZB,RSS ZERO? ISZ LAST? YES - THAT WAS THE LAST FILE JSB BACK NOW GET BACK TO WHERE WE WERE JMP LAS.2 EXIT P+2 LAS.1 LDA #SECT HAVE TO RESET SECT PARAMETER TO WHAT IT WAS ADA N14 BEFORE NXT\S CALL. UDAD HAS SECT=0. IT SHOULD STA SECT POINT TO THE LAST BLOCK OF THE DIRECTORY NOW. ISZ LAST? THIS IS THE LAST ENTRY LAS.2 JMP LAST?,I RETURN SPC 3 SETPR NOP READ AND SET UP THE DISC PARAMETERS JSB SETDR SET UP TO ACCESS THE DIR JSB RDNXB READ AND SET PRAMS N16 DEC -16 JMP SETPR,I RETURN TO CALLER SPC 2 .6 DEC 6 SKP PURGE CCA STA DIRA,I SET PURGE FLAG ISZ WCS SET WRITTEN-ON FLAG LDB TYPE,I IF TYPE 6 FILE 780106 GLM CPB .6 THEN TREAT " " RSS AS NOT LAST " " JSB LAST? LAST FILE? JMP EXPUR NO; GO CHECK†¯þú FOR EXTENTS CLA YES - STUFF A 0 IN 1ST WORD * PURG2 STA DIRA,I LAST FILE SET 0 IN ENTRY ISZ WCS SET WRITTEN-ON FLAG JSB BACK BACK UP ONE ENTRY LDB TYPE,I GET TYPE LDA DIRA,I GET 1ST WORD OF ENTRY CLE CPB .6 IS THIS A TYPE SIX FILE CCE YES - DON'T WANT TO REUSE THE SPACE SEZ,INA,SZA,RSS PURGED? JMP PURG2 YES; TRY PREVIOUS ENTRY * PURG0 SZB TYPE 0? JMP PURG1 NO - GO AHEAD AND CALCULATE NEXT TR AND SEC JSB BACK SET POINTERS BACK 1 MORE FOR NXT/S ROUTINE LDB TYPE,I GET TYPE AGAIN JMP PURG0 AND SEE IF HAVE ANOTHER TYPE 0 FILE * PURG1 LDA DIRA,I GET 1ST WORD OF ENTRY INA INCREMENT TO TAKE CARE OF PURGES ENTRY CASE SSA IS THIS THE JMP PURG3 DISC SPEC ENTRY? - YES JUMP PURG8 JSB NXT/S NO; CACULATE THE NEXT TRACK AND SECT NOP CAN'T GET OVERFLOW CONDITION ON THIS CALL TO NXT/S JMP CREA6 GO SET, WRITE & EXIT * PURG3 LDA TRAKA,I SET NEXT TRACK AND SECTOR CLB TO ZERO. JMP CREA6 GO SET, WRITE AND EXIT * EXPUR JSB EXSH SEARCH FOR EXTENTS TO PURGE JMP PURGE GO PURGE EXTENT * * * BACK BACKS UP TO PREVIOUS ENTRY AND SETS UP ADDRESSES * * ENTRY DIRA = ADDRESS OF CURRENT ENTRY * CURRENT ENTRY CHANGES TO PREVIOUS ENTRY * BACK NOP LDA DIRA GET ADDRESS OF ENTRY CPA SBUF BEGINNING OF BLOCK? RSS YES - MUST READ PREVIOUS BLOCK JMP BACK1 NO - JUST BACK UP 16 WORDS JSB WCSR WRITE CURRENT SECTOR LDB SECT GET SECTOR ADDRESS SZB,RSS IF START OF TRACK ISZ TRACK DIRECTORY TRACK ADB N14 SUBTRACT 14 SECTORS SSB IF NEGATIVE THEN ADB #SECT ADD THE NO. PER TRACK STB SECT SET NEW SECTOR ADDRESS JSB RWSUB READ THE BLOkÿCK ADA .128 SET ADDRESS FOR LAST ENTRY BACK1 ADA N16 POSITION TO BEGINNING OF ENTRY JSB SETAD SET UP ADDRESSES JMP BACK,I AND RETURN SPC 3 * * * FORWD FORWARD SPACES TO NEXT DIRECTORY ENTRY * * ENTRY - DIRA = ADDRESS OF CURRENT DIRECTORY ENTRY * CHANGES TO NEXT DIRECTORY ENTRY * EXIT - P+1 END OF DIRECTORY RETURN * P+2 OK RETURN * * FORWD NOP LDA DIRA GET ADDRESS OF CURRENTY ENTRY ADA .16 POSITION TO NEXT ENTRY LDB SBUF GET ADDRESS OF START OF BLOCK ADB .128 IF CURRENT ENTRY IS LAST IN A BLOCK MUST READ NEXT BLOCK CPB A IS IT? RSS YES - READ NEXT BLOCK JMP FOR.1 NO - JUST SET ADDRESSES AND RETURN JSB RDNXB READ NEXT BLOCK JMP FORWD,I WHOOPS RAN OUT OF DIRECTORY EXIT P+1 FOR.1 JSB SETAD SET UP ADDRESSES ISZ FORWD INCREMENT TO P+2 JMP FORWD,I AND RETURN * SKP * * * P.PAS EXTERNAL * CALLING SEQUENCE * * E_0 FOR SETUP * E_1 TO MOVE OUT * * B_0 TO SET ADDRESS * B_100000 TO SET PARAMETERS * * A = ADDRESS OF FROM-TO AREA * * JSB P.PAS * DEC -N NO. OF PARAMETERS TO BE MOVED * BSS N AREA SET UP OR MOVED OUT SPC 2 .1 DEC 1 A EQU 0 B EQU 1 . EQU 1650B DRT EQU .+2 KEYWD EQU .+7 TATSD EQU .+70 XEQT EQU .+39 LN EQU * END BEGIX d ÿÿ ÿý53i ÿ92067-18125 2026 S C0122 &$BALB FMP LIBRARY HEADER SOURCE             H0101 kASMB,R,L * NAME: $BALB * SOURCE: 92067-18125 * RELOC: 92067-16125 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $BALB 92067-16125 REV.2026 800425 END jnÿÿ ÿý6< ÿ92067-18126 2026 S C0122 &CREAT CREATE FILE SUBROUTINE             H0101 /7þúASMB,R,L,C,Q HED CREAT * NAME: CREAT * SOURCE: 92067-18126 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CREAT,7 92067-16125 REV.2026 800425 ENT CREAT,ECREA EXT CLOSE,$OPEN,.ENTR EXT NAM..,RMPAR EXT EXEC, .DAD EXT D.R,OVRD. SUP * * * CREAT IS THE FILE CREATION MODULE OF THE REAL TIME * FILE MANAGEMENT PACKAGE. * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK,DUM,DUM,ILNM) OR * CALL ECREA(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZE,DUM,ILNAM) * * OR * * IER = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK,DUM,DUM,ILNAM) * * * NOTE: ILNAM IS NOT DOCUMENTED FOR USERS. IT IS INTENDED TO BE USED ONLY * BY INERNAL SUBSYSTEMS ONLY. DUM IS SIMPLY A DUMMY PARAMETER USED * TO SEPERATE ILNAM FROM THE DOCUMENTED PARAMETERS. * * * * W H E R E: * * IDCB IS THE ADDRESS OF A 144-WORD ARRAY WHICH * CREAT WILL USE AS A SCRATCH AREA. IF * ISIZE<0 THEN THE CREATED FILE IS ALSO * OPENED TO THIS DATA CONTROL BLOCK. * * IERR IS THE ADDRESS TO WHICH THE ERROR CODE * IS RETURNED. THIS INFORMATION IS ALSO * RETURNED IN THE A REGISTER. * * ERROR CODES ARE: * * >0 THE CREAT WAS SUCCESSFUL - THE #SECTORS IS RETURNED * -1 THE DISC IS DOWN * -2 DUPLICATE NAME * -4 FILE TOO LONG * -10 NOT ENOUGH PARAMETERS IN THE CALL * -1›Kþú3 DISC LOCKED * -14 DIRECTORY FULL * -15 ILLEGAL NAME * -16 ILLEGAL TYPE OR SIZE * -19 ILLEGAL ACCESS ON A SYSTEM DISC * -32 CARTRIDGE NOT FOUND * -33 NOT ENOUGH ROOM * * IF CREAT IS SUCCESSFUL, FILE SIZE IN SECTORS IS * RETURNED HERE. HOWEVER, IF ECREA IS SUCCESSFUL, IER * WILL CONTAIN 0. SIZE MAY BE OBTAINED FROM JSIZE. * * * * NAME IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME. * THE NAME MUST CONTAIN ONLY LEGAL ASCII * CHARACTERS INCLUDING EMBEDDED BLANKS. COMMAS, * + SIGN, - SIGN ARE NOT ALLOWED. * IN ADDITION THE FIRST * CHARACTER MUST BE NON-NUMERIC AND NON-BLANK. * * ISIZE A TWO-ENTRY ARRAY. * FOR CREAT EACH ENTRY IS A SINGLE WORD * ISIZE(1) > 0 NUMBER OF BLOCKS IN FILE * (UP TO 16383) * ISIZE(1) = -1 USE REST OF DISC * * FOR ECREA EACH ENTRY IS A DOUBLE WORD * ISIZE(1) > 0 NUMBER OF BLOCKS IN FILE * ISIZE(1) = -1 USE REST OF DISC * ISIZE(1) < -1 -DOUBLE WORD # OF 128 BLOCK * MULTIPLES IN FILE ** * * ENTRY 2 IS USED ONLY FOR TYPE 2 FILES AND IS THE * RECORD LENGTH. IT IS A SINGLE WORD FOR CREAT AND A DOUBLE * WORD FOR ECREA. * * ** NOTE: THE OPTION ON ECREA OF ISIZE(1) < -1 FOR -DOUBLE * WORD # OF TRACKS IS FOR INTERNAL USE ONLY. IT IS NOT * DOCUMENTED FOR OUTSIDE USERS. * * * ITYPE IS THE FILE TYPE--MUST BE >0. * * IS (OPTIONAL); IS THE FILE'S SECURITY CODE. * IF IS>0 THE FILE IS WRITE PROTECTED. * IF IS<0 THE FILE IS OPEN PROTECTED. * IF IS=0 OR IS NOT CODED THE FILE IS PUBLIC. * * ILU (OPTIONAL); DIREC–*þúTS THE CREAT TO: * IF ILU<0 THEN THE DISC AT LOGICAL UNIT (-ILU). * IF ILU>0 THEN THE DISC WITH LABEL ILU. * IF ILU=0 OR NOT CODED, THE FIRST AVAILABLE * DISC WITH ENOUGH ROOM IS USED. * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * * JSIZE (OPTIONAL) FOR ECREA CALL ONLY * DOUBLE WORD VARIABLE IN WHICH ACTUAL FILE SIZE CREATED IN * +SECTORS OR -TRACKS IS RETURNED IF CREATION IS SUCCESSFUL * * * DUM DUMMY PARAMETER TO SEPERATE ILNAM FROM DOCUMENTED PARAMETERS. * * * ILNAM IF SET TO 70707 OCTAL, CREAT WILL SKIP NAM.. CALL AND ALLOW * A FILE WITH AN ILLEGAL FILE NAME TO BE CREATED. SKP * * ECREA DEC -1 LDA ECREA STA CREAT JMP CREAT+1 * * DCB NOP IERR NOP NAME NOP SIZE NOP TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO JSIZE DEF ZERO DUM DEF ZERO ILNAM DEF ZERO * * CREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF DCB LDA TYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER10 NO - ERROR EXIT JSB CLOSE GO CLOSE THE DCB (IF OPEN) DEF *+2 DEF DCB,I SZA NO ERROR CPA N11 AND NOT OPEN ERROR - OK RSS SO SKIP IF THIS IS THE CASE JMP EXIT ELSE EXIT SOME CLOSE ERROR LDA ILNAM,I DOES CALLER WANT TO CREATE CPA ILNMF A FILE WITH AN ILLEGAL NAME? JMP CR.1 YES - SKIP NAM.. CALL JSB NAM.. GO CHECK THE NAME DEF *+2 JGþú DEF NAME,I SZA IF OK SKIP JMP EXIT ELSE EXIT ERROR * * CR.1 LDA NAME,I GOOD NAME SO STA BUF SET ISZ NAME UP DLD NAME,I SKELETON DIRECTORY DST BUF+1 ENTRY IN BUF LDA TYPE,I SZA TYPE MUST BE SSA >0 JMP ER16 NOT >0 ; ERR STA BUF+3 LDA ECREA GET CREAT OR ECREA FLAG SSA ECREA CALL? JMP CR.2 NO - GO PROCESS 2 WORD ISIZE ARRAY DLD SIZE,I YES - ISIZE OF 4 WORDS LONG. GET SIZE JSB .DAD DO RANGE CHECK ON FIRST SIZE DEF DNMSZ PARAMETER SSA WITHIN RANGE? JMP ER30 NO - ERROR 30 DLD SIZE,I OK - GET SIZE AGAIN ISZ SIZE STEP ARRAY POINTER TO 2ND ISZ SIZE ENTRY IN THE SIZE ARRAY JMP CR.3 CR.2 LDB SIZE,I CREAT CALL SO SINGLE WORD ENTRIES ADB NMXSZ MAKE SURE SIZE REQUESTED BY SSB,RSS CREAT WAS 16383 BLOCKS OR LESS JMP ER30 IT WAS > 16383 BLOCKS LDB SIZE,I GET SIZE AGAIN SSB IF SIZE SPECIFIED IS CCB <0 THEN FORCE TO -1 CLA SET UPPER HALF OF DOUBLE WORD SSB IF THIS IS THE -1 CASE JMP CR.4 JUST GO SET 0,-1 IN BUFFER CR.3 SWP GET UPPER BITS TO B-REG SSB,RSS IF THIS IS POSITIVE DOUBLE WORD ASL 1 # OF BLOCKS, THEN CONVERT TO SECTORS SWP HIGH BITS TO A-REG AGAIN SZA,RSS IF DOUBLE WORD ZERO SZB THEN ILLEGAL SIZE ERROR RSS JMP ER16 CR.4 DST BUF+5 STORE REQUEST SIZE IN STRING FOR D.RTR ISZ SIZE STEP TO RECORD SIZE (FOR ECREA THIS STEPS TO 2ND WORD * OF THE RECORD SIZE LDA SIZE,I LDB BUF+3 GET TYPE CPB .1 IF TYPE=1 LDA .128 SET SIZE TO 128 CMA,INA NEGATE RECORD SIZE (NOj2þúW IF VALID ONLY IF NEGATIVE) CPB .2 IF TYPE TWO SIZE MUST BE GIVEN SSA VALID? RSS YES; OR NOT TYPE TWO SKIP JMP ER4 ELSE ERROR CMA,INA MAKE RECORD SIZE POSITIVE AGAIN ADB N3 IF THIS FILE IS TYPE 3 OR GREATER SSB,RSS THEN SET RECORD SIZE CLA TO 0 AUTOMATICALLY STA BUF+7 SET RECORD SIZE LDA SC,I SET STA BUF+8 SECURITY CODE * * CLA,INA GET OVERRIDE BITS ADA OVRD. FOR D.RTR CALL STA TMP JSB EXEC SCHEDULE DEF SCHRT D.RTR DEF .23 TO DEF D.R CREAT DEF XEQT THE DEF TMP FILE DEF LU,I PASSING DZERO DEF ZERO THE DEF ZERO STRING DEF BUF DEF .9 * * SCHRT JSB RMPAR CALL RMPAR DEF *+2 TO GET DEF BUF RETURN CODES * JSB EXEC RETRIEVE DEF *+5 THE STRING DEF .14 RETURNED BY DEF .1 D.RTR DEF STR DEF .6 * CLB,CLE LDA STR GET PARAMETER WITH 'ON-SYSTEM-DISC' SSA FLAG. BIT 15 SET? LDB =B20 YES - SET BIT 4 STB TMP IN TEMPORARY FLAG RAL,ERA CLEAR BIT 15 IN 1ST PARAMETER STA STR AND PUT IT BACK LDA BUF GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA BUF+1 YES; SET UP STA DCB,I FIRST 2 LDB DCB WORDS OF CLE,INB THE DCB LDA BUF+2 STA B,I LDA DCB LDB ASTR STO SET UP FOR A UPDATE OPEN JSB $OPEN SET UP REST OF DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF BUF+4 ADDRESS OF NO OF SECTORS/TRACK JMP EXIT DISC ERROR - EXIT LDB DCB GET DCB ADDRESS ADB Oeþú.7 POSITION TO WORD WITH SECURITY CODE FLAG LDA B,I CCE SET SC FLAG (BIT 15) RAL,ERA TO INDICATE READ AND ADA TMP ADD IN ON-SYSTEM-DISC FLAG STA B,I WRITE ACCESS IS ALLOWED FOR THIS FILE LDA TYPE,I GET TYPE ADA N3 IF 3 OR MORE CCE,SSA SKIP TO WRITE EOF JMP EXIT0 NOT RANDOM ACCESS FILE LDA B,I GET DCB WORD 7 AGAIN RAR,ELA STA B,I SET WRITTEN ON FLAG CCA ADB .9 STEP TO THE BUFFER AND SET EOF STA B,I IN FIRST WORD OF BUFFER EXIT0 LDA ECREA GET CREAT\ECREA CALL FLAG SSA ECREA CALL? JMP EXIT2 NO - GO HANDLE CREAT CALL LDA STR+3 GET FILE SIZE FOR RETURN PARAMS CLB SSA,RSS IF SIZE IS ALREADY +SECTORS JMP EXIT1 THEN GO RETURN IT CMA,INA MAKE -QUANTITY POSITIVE LSL 8 MULTIPLY BY 128 BLOCKS (256 SECTORS) EXIT1 SWP SWAP REGISTERS DST JSIZE,I RETURN FILE SIZE IN JSIZE LDA BUF USE D.RTR RETURN FOR ERROR JMP EXIT AND GO EXIT EXIT2 LDA BUF CREAT CALL - GET D.RTR RETURN SSA,RSS ERROR? (NEGATIVE?) LDA STR+3 NO - GET FILE SIZE AND RETURN IT INSTEAD EXIT LDB DZERO CODE STB SC RESTORE STB LU CALL WORDS STB TYPE FOR NEXT CALL STB IBLK STB JSIZE STB DUM STB ILNAM CCB RESET CREAT\ECREA STB ECREA FLAG CLB CLEAR OUT DOUBLE WORD STB ZERO ZERO IN CASE USER STB ZERO+1 DID NOT SUPPLY JSIZE PARAMETER STA IERR,I SET ERROR CODE JMP CREAT,I AND EXIT * * * ER4 LDA N4 SET ERROR JMP EXIT CODE ER10 LDA N10 AND JMP EXIT EXIT ER16 LDA N16 GET THE ERROR CODE JMP EXIT TAKE EXIT ER30 LDA N30 JMP EXIT * Zv*($ * * .1 DEC 1 .2 DEC 2 .6 DEC 6 .7 DEC 7 .9 DEC 9 .14 DEC 14 .23 DEC 23 .128 DEC 128 * N3 DEC -3 N4 DEC -4 N10 DEC -10 N11 DEC -11 N16 DEC -16 N30 DEC -30 NMXSZ DEC -16384 DNMSZ OCT 0 KEEP THESE OCT 100000 TWO TOGETHER * B377 OCT 377 ILNMF OCT 70707 TMP NOP ZERO BSS 2 BUF BSS 11 STR EQU BUF+5 ASTR DEF STR * A EQU 0 B EQU 1 XEQT EQU 1717B * END EQU * * END ú¶*ÿÿ ÿý7 C ÿ92067-18127 2001 S C0122 &OPEN FILE OPEN SUBROUTINE SO             H0101 NþúASMB,R,L,C HED OPEN * NAME: OPEN * SOURCE: 92067-18127 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OPEN,7 92067-16125 REV.2001 791018 ENT OPEN EXT EXEC, CLOSE, RMPAR, $OPEN EXT .ENTR, IFTTY, LURQ EXT D.R, OVRD., SESSN, $SMID, ISMVE SUP * * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUCíþúST BE * A MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED * SIZE IS: USED SIZE = FILE SIZE/N WHERE * N+(FILE SIZE/IBLK)+(1 IF REMAINDER, ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * FROM D.RTR * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -13 DISC LOCKED * -32 CARTRIDGE NOT FOUND * * FROM $OPEN * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * * FROM OPEN * -10 NOT ENOUGH PARAMETERS * -18 LOCK ERROR * -36 LOCK NOT GRANTED * SKP DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO * OPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXIT NO - ERROR EXIT * JSB CLOSE CLOSE DCB DEF *+2 JUST IN CASE DEF DCB,I IT'S OPEN SZA SKIP IF NO CPA N11 ERRORS OR IF CLE,RSS NOT OPEN ERROR JMP EXIT ELSE TAKE ERROR EXIT * * SET UP AND CALL D.RTR * LDA NAME,I GET NAME WORD 1 LDB OP,I AND OPTION WORD ERB EXCLUSIVE BIT TO E CME INVERT E AND RAL,ERA SET IN SIGN OF A STA NAME1 SET FOR CALL TO D.RTR ISZ NAME GET REST OF DLD NAME,I NAME TO STRING DST NAME1+1 BUFFER FOR D.RTR CALL LDA XEQT GET CURRENT PROGRAM ID CCE SET SIGN BIT TO INDICATE RAL,ERA AN OPEN REQUEST STA ID FOR D.RTR CALL * _þú JSB EXEC SCHEDULE D.RTR DEF SCRTN WITH WAIT TO DEF .23 OPEN THE FILE DEF D.R DEF ID ID + SIGN BIT DEF OVRD. OVERRIDE BITS DEF LU,I LU OF FILE DEF SC,I SECURITY CODE DEF ZERO DEF NAME1 SEND 3-WORD STRING DEF .3 CONTAINING NAME * SCRTN JSB RMPAR GET RETURN PARAMETERS DEF *+2 DEF ID LDA ID GET ERROR WORD SSA IF D.RTR ERROR JMP EXIT JUST EXIT AND PASS IT ON * JSB EXEC RETREIVE STRING PASSED DEF *+5 BACK FROM D.RTR DEF .14 DEF .1 DEF DIR DEF .6 * * SAVE ON SYSTEM DISC INFORMATION FROM D.RTR AND CALL $OPEN TO SET UP DCB * CLB,CLE LDA DIR GET 1ST WORD OF STRING FROM D.RTR RAL,ERA CLEAR BIT 15 AND PUT IT IN E SEZ WAS BIT 15 SET? ON 2 OR 3? CCB YES - SET B TO -1 STB SCFLG IF ON 2 OR 3, SFLAG = -1, ELSE 0 STA DIR REPLACE WORD 1 WITH BIT 15 CLEARED DLD ID+1 SET UP FIRST TWO WORDS OF DST DCB,I THE DCB FROM D.RTR RETURNS CLO SET O LDA OP,I TO RAR,SLA,RAR INDICATE STO UPDATE OPTION ERA AND E FOR TYPE 1 OVER-RIDE STA LU SAVE SUBFUNCTION FLAG LDA DCB GET DCB ADDRESS LDB ADIR AND SECURITY CODE * JSB $OPEN GO SET UP THE DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF ID+4 ADDRESS OF NO OF SECTORS PER TRACK JMP OPEN2 ERROR - CLOSE AND EXIT * * * MUST DECIDE WHETHER TO ALLOW WRITE ACCESS TO THIS FILE. WHEN * UNDER SESSION CONTROL, LU 2 AND 3 MAY BE ACCESSED ONLY FOR READS * UNLESS OVERRIDE CONDITION IS SET. * * A. NORMAL RESTRICTIONS FOR WRITE ACCESS * 1. SC IN DIRECTORY IS 0 OR * 2. SC IN DIRECTORY IS +X AND SC PASSED IN IS +X OR -X OR * 8Øþú 3. SC IN DIRECTORY IS -X AND SC PASSED IN IS -X * * B. TO SET SC BIT IN DCB WORD 7 * 1. IF NOT IN SESSION, ONE OF A MUST BE MET * 2. IF IN SESSION AND NOT ON LU 2 OR 3, ONE OF A MUST BE MET * 3. IF IN SESSION AND ON LU2 OR 3, * A. 1 OF A MUST BE MET AND * B. OVRD. MUST BE NONZERO OR CALLER MUST BE SYSTEM MANAGER * * JSB SESSN DEF *+2 DEF XEQT E=0 IF IN SESSION SEZ IN SESSION? JMP OPEN0 NO - GO DO REGULAR SECURITY CHECKING STB NAME1 YES - SAVE SESSION WORD (JUST TEMPORARY) * JSB ISMVE READ THE CALLER'S USER ID DEF *+5 INTO TEMP SPACE DEF NAME1 (SESSION WORD) DEF $SMID (OFFSET TO USER ID) DEF CODE (TEMP SPACE) DEF .1 (JUST ONE WORD) LDA CODE GET USER ID CPA B7777 CALLER THE SYSTEM MANAGER? JMP OPEN0 YES - DO REGULAR SECURITY CHECKING LDA SCFLG A(BIT 15) = 1 IF FILE ON LU 2 OR LU 3 LDB OVRD. B IS #0 IF OVERRIDE CONDITION IS SET SSA FILE ON 2 OR 3?? CLE,SZB YES - OVERRIDE? RSS NOT ON 2 OR 3 OR OVERRIDE IS SET JMP OPEN1 ON 2 OR 3 AND NO OVERRIDE SO READ ONLY ACCESS * * REGULAR SECURITY CHECKS * OPEN0 CLE LDB DIR+5 GET SC FROM DIRECTORY SZB ZERO? CPB SC,I OR = PASSED IN SC? JMP OP.0 YES - SET E FOR SC FLAG SSB IF NEGATIVE SECURITY CODE THEN NO JMP OPEN1 MORE CHECKS - DON'T MATCH ADB SC,I POSITIVE SC - TAKE CARE OF CASE WHERE CLE SC = +X AND -X WAS PASSED IN SZB,RSS (CLEAR E IN CASE GOT SET IN ADDITION) * * SET SC AND OM IN DCB * OP.0 CCE OPEN1 LDB DCB GET DCB ADDRESS ADB .7 POSITION TO WORD WITH SC FLAG LDA B,I RAL,ERA PUT E INTO BIT 15 STA B,I AND RESTORE WORD LDA SCFL âþúG GET ON SYSTEM DISC FLAG ELA IF SET, SET E LDA B,I GET DCB WORD 7 AGAIN SEZ ON 2 OR 3? IOR BIT4 YES - SET BIT 4 STA B,I AND RESTORE JMP OPEN3 GOOD OPEN SO SKIP CLOSE * * CLOSE FILE - SET SUBFUNCTION CODE IF TYPE 0 * OPEN2 STA ID SAVE ERROR CODE JSB CLOSE ILLEGAL OPEN SO CLOSE DEF *+2 THE DEF DCB,I FILE OPEN3 LDA ID GET ERROR CODE LDB DCB POSITION TO TYPE ADB .2 WORD IN THE DCB SSA,RSS WAS THERE AN ERROR? LDA B,I NO - GET TYPE CODE SZA IF NOT TYPE ZERO JMP EXIT THEN EXIT LDB LU GET SUBFUNCTION WORD ERB GET SUBFUNCTION SET BIT IN E-REG * LDB DCB CALCULATE DCB SUB ADB .3 FUNCTION ADDRESS STB SC SAVE IT LDA OP,I GET THE OPTION SUB FUNCTION AND B3700 MASK IT OFF STA B AND SAVE IT LDA SC,I GET THE CURRENT SUBFUNCTION WORD AND B77 SAVE THE LU STA LU KEEP FOR LOCKING THE LU LATER ADA B ADD IN THE NEW SUB FUNCTION SEZ IF SUBFUNCTION BIT WAS'NT SET, DON'T STORE STA SC,I SET IT IN THE DCB * LDB DCB POSITION TO DCB15 WORD ADB .15 AND SAVE ADDRESS OF THIS STB SC POSITION CLA,INA PRESET TO DON'T DO AN STA SC,I UNLOCK (FOR CLOSE) LDA OP,I GET OPEN OPTION WORD SLA EXCLUSIVE OPEN? JMP EXOK NO - SO DON'T LOCK THIS DEVICE * JSB IFTTY SEE IF THIS LU IS DEF *+2 AN INTERACTIVE DEVICE DEF LU SSA INTERACTIVE?? JMP EXOK YES - DON'T LOCK IT * LDA BIT13 SET BIT13 ON LU WORD ADA LU SO 8 BITS WILL BE USED FOR STA LU LU IN THE RESULTING EXEC CALL. * JSB LURQ üÃ$" LOCK CALL DEF *+4 DEF OPTN OPTION - LOCK WITHOUT WAIT, NO ABORT DEF LU LU WITH BIT 13 SET DEF .1 ONE LU JMP EX18 ERROR ON LOCK SZA SUCCESSFUL LOCK? JMP EX36 NO - NO RN'S AVAILABLE OR ALREADY LOCKED STA SC,I STORE LOCK SUCCESSFUL (DO UNLOCK) JMP EXOK EXIT NO ERRORS * EX18 LDA N18 ERROR ON LURQ CALL JMP EXIT EX36 LDA N36 LOCK NOT GRANTED JMP EXIT EXOK CLA CLEAR A AND EXIT EXIT LDB DCB IF NO ERRORS, ADB .2 THEN RETURN SSA,RSS THE TYPE LDA B,I LDB DZERO RESET THE Y REP 5 DEFAULT STB NAME+*-Y PARAMETERS STA ERR,I SET THE ERROR CODE JMP OPEN,I AND RETURN * * SPC 2 SPC 3 DZERO DEF ZERO ZERO NOP * .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .14 DEC 14 .15 DEC 15 .23 DEC 23 * N10 DEC -10 N11 DEC -11 N18 DEC -18 N36 DEC -36 * B77 OCT 77 B7777 OCT 7777 B3700 OCT 3700 BIT4 OCT 20 BIT13 OCT 20000 OPTN OCT 140001 * SCFLG NOP ID NOP NAME1 BSS 3 CODE NOP DIR BSS 6 ADIR DEF DIR SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END $ÿÿ ÿý8 C ÿ92067-18128 2001 S C0122 &PURGE PURGE FILE SUBROUTINE S             H0101 ~þúASMB,R,L,C HED PURGE * NAME: PURGE * SOURCE: 92067-18128 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PURGE,7 92067-16125 REV.2001 790924 ENT PURGE EXT .ENTR, OPEN, ECLOS, EXEC EXT SESSN, ISMVE, OVRD., $SMID * SUP * * PURGE IS THE FILE DELETION ROUTINE FOR THE RTE * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL PURGE(IDCB,IERR,NAME,IS,ILU) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK * WHICH IS USED BY PURGE AS A * WORKING BUFFER. IDCB IS FREE * FOR OTHER USE AFTER A PURGE. * * IERR IS THE ERROR RETURN LOCATION. * * NAME IS THE NAME OF THE FILE TO BE PURGED. * * IS (OPTIONAL) IS THE FILE'S SECURITY CODE. * * ILU (OPTIONAL) IS THE DISC THAT THE FILE IS ON. * IF ILU >0 THEN ON DISC LABELED ILU * IF ILU <0 THEN ON DISC AT LOGICAL UNIT (-ILU) * * ERRORS RETURNED BY PURGE ARE: * * FROM D.RTR * -1 DISC READ/WRITE ERROR * -6 FILE NOT FOUND * -8 FILE IS OPEN TO SOME OTHER PROGRAM * -13 DISC LOCKED * -19 ILLEGAL ACCESS ON SYSTEM DISC * -32 DISC NOT FOUND * * FROM PURGE * -7 ILLEGAL SECURITY CODE * -10 NOT ENOUGH PARAMETERS * -16 ATTEMPT TO PURGE A TYPE 0 FILE SKP DCB NOP IERR NOP NAME DEF ZERO SC DEF ZERO LU DEF ZERO * PURGE NOP 1ªþú ENTRY POINT JSB .ENTR FETCH INCOMING DEF DCB PARAMETERS LDA N10 ENOUGH LDB NAME PARAMETERS CPB DZERO SUPPLIED? JMP EXIT NO - ERROR EXIT CLA CLEAR THE TRUNCATE CLB DOUBLE WORD DST LNG * * OPEN FILE EXCULSIVELY * JSB OPEN DEF OPRTN OPEN FILE DEF DCB,I EXCLUSIVELY DEF IERR,I TO DEF NAME,I CALLER DZERO DEF ZERO DEF SC,I SECURITY CODE DEF LU,I DISC ID OPRTN SSA OPEN ERROR? JMP EXIT YES - ERROR EXIT SZA,RSS TYPE ZERO? JMP EX16 YES - ILLEGAL PURGE CPA .6 TYPE 6 FILE? RSS YES - DO SPECIAL CHECK TO ALLOW PURGE JMP PRG0 NOPE - CONTINUE NORMAL PURGE * * IF A SESSION CALLER, ALLOW PURGE OF TYPE 6 FROM LU 2 OR 3 * IF CALLER IS ONE WHO SP'ED IT. WORD 39 OF RECORD 1 CONTAINS * PRIVATE ID OF CALLER WHO SP'ED THIS PROGRAM * JSB SESSN SEE IF IN SESSION DEF *+2 DEF XEQT * SEZ IN SESSION? JMP PRG0 NO - WILL BE ABLE TO PRG ANY TYPE 6 FILE STB BUF SAVE SESSION ID JSB ISMVE READ USER ID FROM SCB DEF *+5 DEF BUF SESSION ID DEF $SMID OFFSET DEF ID PUT ID HERE DEF .1 GET ONLY 1 WORD * LDB DCB GET ADDRESS OF DCB LDA B,I AND 1ST WORD OF DCB AND B77 MASK TO LU AND ADA PRC ADD IN SPECIAL FUNCTION BITS STA DLU AND SAVE FOR EXEC CALL ADB .3 POSITION TO TRACK WORD LDA B,I AND GET IT STA TRACK SAVE FOR EXEC CALL INB INCREMENT POINTER TO 2ND WORD OF DCB LDA B,I GET SECTOR FROM DCB STA SECT AND SAVE FOR EXEC CALL * JSB EXEC READ 39 WORDS OF 1ST RECORD DEF *+7 OF THE TYPE 6 FIL!xþúE INTO BUF DEF .1 DEF DLU DEF BUF DEF .39 DEF TRACK DEF SECT * LDA N1 PRESET IN CASE OF ERROR CPB .39 CHECK TRANSMISSION LOG RSS OK JMP EXIT ERROR EXIT * LDA ABUF GET ADDRESS OF BUFFER ADA .38 POSITION TO 39TH WORD LDA A,I THIS SHOULD BE THE ID WORD AND B7777 MASK TO LOWER 12 BITS CPA ID SAME AS CALLERS? RSS YES - LET HIM PURGE IT JMP PRG0 NO - GO AHEAD BECAUSE WILL GET KICKED OUT * WITH SECURITY CHECKS LDA OVRD. SET OVERIDE TO ALLOW OPEN ON LU 2 WITH STA BUF WRITE ACCESS - KEEP ORIG TO RESET LATER IOR BIT14 SET BIT 14 - P,G,S - IF NOT ALREADY SET STA OVRD. AND REPLACE JSB OPEN DEF OPRN1 REOPEN WITH OVERRIDE SET DEF DCB,I DEF IERR,I DEF NAME,I DEF ZERO DEF SC,I DEF LU,I OPRN1 SSA ERRORS?? JMP EXIT YES - ERROR EXIT LDA BUF REPLACE OVRD. THE STA OVRD. WAY IT WAS BEFORE * * NORMAL PURGE OPERATION. CHECK SECURITY AND SET UP TO * CLOSE AND TRUNCATE ENTIRE FILE SIZE. * PRG0 LDA DCB GET ADDRESS OF ADA .7 SECURITY BITS LDB A,I FROM DCB SSB,RSS SECURITY BIT SET? JMP EX7 NO - BAD SECURITY OR ON 2 OR 3 - ERROR EXIT * ADA N2 POSITION TO ADDRESS OF FILE SIZE CLB CLEAR B IN CASE SIZE ALREADY IN SECTORS LDA A,I GET FILE SIZE SSA,RSS IN +SECTORS OR -"128 QUANTITY"? JMP PRG1 +SECTORS CMA,INA -"128 QUANTITY" - MAKE POSITIVE LSL 8 MULT BY "128 QUANTITY" TO GET SECTORS PRG1 LSR 1 DIVIDE BY 2 TO GET BLOCKS SWP GET HIGH ORDER BITS TO A-REG DST LNG AND SAVE FOR TRUNCATE * CLOS JSB ECLOS CLOSE THE FILE AND T24RUNCATE TO ZERO SIZE DEF *+4 (I.E. PURGE IT) DEF DCB,I FILE DEF LU DUMMY ERROR RETURN DEF LNG TRUNCATE WORD ADDRESS LDB IERR,I GET CURRENT ERROR CODE SSB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET THE ERROR CODE LDB DZERO RESET STB NAME THE STB SC INCOMING STB LU PARAMETERS JMP PURGE,I AND EXIT * * EX7 LDA .7 SET ERROR CMA,INA,RSS CODE AND SKIP EX16 LDA N16 STA IERR,I SET CODE IN USER AREA JMP CLOS GO CLOSE THE FILE * * * N1 DEC -1 N2 DEC -2 N10 DEC -10 N16 DEC -16 .1 DEC 1 .3 DEC 3 .6 DEC 6 .7 DEC 7 .38 DEC 38 .39 DEC 39 B77 OCT 77 B7777 OCT 7777 BIT14 OCT 40000 PRC OCT 74000 LNG BSS 2 ID NOP TRACK NOP SECT NOP DLU NOP ZERO NOP BUF BSS 39 ABUF DEF BUF * * XEQT EQU 1717B A EQU 0 B EQU 1 * * END EQU * END jéÿÿ ÿý9B ÿ92067-18129 2001 S C0122 &NAMF RENAME FILE SUBROUTINE             H0101 5þúASMB,R,L,C HED NAMF * NAME: NAMF * SOURCE: 92067-18129 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM NAMF,7 92067-16125 REV.2001 790924 ENT NAMF EXT EXEC, .ENTR, CLOSE, NAM.., OPEN, RMPAR EXT SESSN, ISMVE, $SMID, OVRD. * * NAMF IS THE FILE NAME CHANGE MODULE OF THE * RTE FILE MANAGEMENT PACKAGE. * * CALLING SEQUENCE: * * CALL NAMF(IDCB,IERR,NAME,NNAME,IS,ILU,DUM,ILNAM) * * WHERE: * IDCB IS A 144 WORD DATA CONTROL BLOCK * THIS AREA IS FREE AFTER THE CALL. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE RETURNED HERE AND IN * THE A REGISTER. * DEFINED ERRORS ARE: * * * 0 NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -6 FILE NOT FOUND * -7 INVALID SECURITY CODE * -8 FILE CURRENTLY OPEN * -10 NOT ENOUGH PARAMETERS * -13 THE REQUIRED DISC IS LOCKED * -15 ILLEGAL NEW NAME * -19 ILLEGAL ACCESS ON A SYSTEM DISC * -32 CARTRIDGE NOT FOUND * * NNAME THE NEW 6 CHARACTER FILE NAME * * IS OPTIONAL - THE FILE SECURITY CODE * * ILU OPTIONAL - THE FILES DISC ID. * * DUM OPTIONAL - DUMMY PARAMETER TO SEPERATE ILMAN FROM * THE DOCUMENTED PARAMETERS. * * ILNAM OPTIONAL - NOT DOCUMENTED FOR EXTERNAL USE. IF SET * TO 70707B NAMF WILL ALL±ÊþúOW A FILE TO BE * RENAMED WITH AN ILLEGAL FILE NAME. * * SPC 3 DCB DEF ZERO DEFINE IERR DEF ZERO PARAMATER NAME DEF ZERO ADDRESSES NNAME DEF ZERO IS DEF ZERO ILU DEF ZERO DUM DEF ZERO ILNAM DEF ZERO NOP SPC 1 NAMF NOP ENTRY POINT JSB .ENTR FETCH PARAM ADDRESSES DEF DCB TO LOCAL LIST SPC 1 LDA N10 LOAD FOR NOT ENOUGH PRAM REJECT LDB NNAME NEW NAME SUPPLIED? CPB DZERO JMP EXIT NO; GO EXIT SPC 1 LDA ILNAM,I GET ILLEGAL NAME PARAMETER CPA ILNMF EQUAL TO 70707B? JMP NAM.0 YES - SKIP NAM.. CALL. JSB NAM.. YES;NEW NAME DEF NAM.R LEGAL DEF NNAME,I FOR A FILE NAME? NAM.R SZA JMP EXIT NO; EXIT NAM.0 JSB OPEN CALL DEF OPRTN TO DEF DCB,I OPEN DEF IERR,I THE DEF NAME,I FILE DEF ZERO EXCLUSIVELY DEF IS,I WITH DEF ILU,I USER PRAMS OPRTN SSA SUCESSFUL OPEN? JMP EXIT NO; EXIT * CPA .6 TYPE 6?? RSS YES - SPECIAL CHECK TO ALLOW RENAME OF TYPE 6 FILE * ON LU 2 OR 3 IF CALLER IS PERSON WHO SP'ED IT JMP NAMF1 NOPE - CONTINUE NORMAL RENAME * JSB SESSN SEE IF IN SESSION DEF *+2 DEF XEQT * SEZ IN SESSION? JMP NAMF1 NO - WILL BE ABLE TO RENAME ANY TYPE 6 FILE SO SKIP STB BUF KEEP SESSION ID JSB ISMVE LOOK IN SCB AND GET USER ID DEF *+5 DEF BUF SESSION ID DEF $SMID OFFSET DEF ID PUT ID HERE DEF .1 GET ONLY 1 WORD * LDB DCB GET ADDRESS OF DCB LDA B,I GET 1ST WORD OF DCB AND B77 MASK TO LU ADA PRC ADD IN SPECIAL FUNCTION BITS STA DCB2 AND SAVE FOR ¿–þúEXEC CALL ADB .3 POSITION TO TRACK WORD LDA B,I GET TRACK STA TRACK AND SAVE FOR EXEC CALL INB INCREMENT POINTER TO 2ND WORD OF DCB LDA B,I GET SECTOR FROM DCB STA SECT AND SAVE FOR EXEC CALL * JSB EXEC READ 39 WORDS OF 1ST RECORD INTO BUF DEF *+7 DEF .1 DEF DCB2 DEF BUF DEF .39 DEF TRACK DEF SECT * LDA N1 PRESET IN CASE OF ERROR CPB .39 CHECK TRANSMISSION LOG RSS OK JMP EXIT ERROR EXIT * LDA ABUF GET ADDRESS OF BUFFER ADA .38 POSITION TO 39TH WORD LDA A,I THIS SHOULD BE THE ID WORD AND B7777 MASK TO LOWER 12 BITS CPA ID SAME AS CALLERS? RSS YEP - LET HIM RENAME IT JMP NAMF1 NO GO AHEAD - WILL GET KICKED OUT WITH SECURITY CHECKS * LDA OVRD. SET OVEALLOW OPEN ON LU2 WITH WRITE ACCESS STA BUF KEEP AROUND TEMPORARILY IOR BIT14 SET BIT 14 - P,G,S - IF NOT ALREADY SET STA OVRD. AND REPLACE JSB OPEN DEF OPRN1 REOPEN WITH OVERRIDE SET DEF DCB,I DEF IERR,I DEF NAME,I DEF ZERO DEF IS,I DEF ILU,I OPRN1 SSA ERRORS?? JMP EXIT YES - ERROR EXIT LDA BUF REPLACE OVRD. THE WAY IT WAS BEFORE STA OVRD. * NAMF1 LDA DCB YES; CHECK ADA .7 THE LDB A,I SECURITY LDA N7 CODE SSB,RSS MATCH? JMP CLOEX NO; CLOSE AND EXIT DLD DCB,I GET DCB2 TO B STB DCB2 AND SAVE IT JSB EXEC CALL DEF EXR3 D.RTR DEF .23 TO DEF D.RTR CHANGE DEF XEQT THE DEF .2 FILE DEF DCB,I NAME DEF DCB2 DEF ZERO DEF NNAME,I DEF .3 EXµ©R3 JSB RMPAR CALL RMPAR TO GET DEF *+2 RETURN PARAMETERS DEF NAME TO LOCAL AREA. SPC 1 RSS SKIP ERROR ENTRY CLOEX STA NAME SAVE ERROR CODE JSB CLOSE CLOSE DEF CLOR1 THE DEF DCB,I FILE CLOR1 LDB NAME GET ERROR CODE SZB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET RETURN ERROR LDB DZERO RESET STB NNAME ADDRESSES STB IS STB ILU STB DUM STB ILNAM JMP NAMF,I EXIT TO USER SPC 3 DCB2 NOP ID NOP TRACK NOP SECT NOP ZERO NOP DZERO DEF ZERO BUF BSS 39 ABUF DEF BUF * .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .38 DEC 38 .39 DEC 39 N1 DEC -1 N7 DEC -7 N10 DEC -10 * B77 OCT 77 B177 OCT 177 B7777 OCT 7777 PRC OCT 74000 BIT14 OCT 40000 .23 DEC 23 ILNMF OCT 70707 D.RTR ASC 3,D.RTR SPC 2 * ASSEMBLY AIDS SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * PROG. LENGTH SPC 1 END  Uÿÿ ÿý:C ÿ92067-18130 2001 S C0122 &READF READ/WRITE FILE SUBROUT             H0101 ;8þúASMB,R,L,C,Q HED READF - WITH RENT. I/O * NAME: READF * SOURCE: 92067-18130 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM READF,7 92067-16125 REV.2001 791015 ENT READF,WRITF,EREAD,EWRIT EXT EXEC, REIO, .ENTR, P.PAS EXT RW$UB, $KIP, D$XFR, R/W$, RFLG$ EXT .DAD, .DMP, .DDI, .DIN, .DSB, .DDE SUP * * * THIS IS THE RTE FILE MANAGEMENT PACKAGE * READ/WRITE SUBROUTINE. * * THIS ROUTINE WILL READ OR WRITE ANY TYPE FILE. * * * CALLING SEQUENCE: * * CALL READF(IDCB,IERR,IBUF,IL,L,N) OR * CALL EREAD(IDCB,IERR,IBUF,IL,L,N) * * O R * * IER = READF(IDCB,IERR,IBUF,IL,L,N) OR * IER = EREAD(IDCB,IERR,IBUF,IL,L,N) * * TO READ, O R * * CALL WRITF(IDCB,IERR,IBUF,IL,N) OR * CALL EWRIT(IDCB,IERR,IBUF,IL,N) * * O R * * IER = WRITF(IDCB,IERR,IBUF,IL,N) OR * IER = EWRIT(IDCB,IERR,IBUF,IL,N) * * TO WRITE. * * * W H E R E: * * IDCB IS THE 144 WORD DATA CONTROL BLOCK * FOR THE REFERENCED FILE. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE AS FOLLOWS: * * CODE ERROR CONDITION * 0 OR >0 NO ERROR * -1 A REQUIRED DISC OR DEVICE IS DOWN * -5 ILLEGAL RECORD NUMBER OR * ATTEMPT TO READ A RECORD NOT WRITTEN * -7 INVALID SECURITY CODE FOR * WRITE (FILE IS READ ONLY) * _Sþú -10 A REQUIRED PARAMETER IS MISSING * -11 THE DCB IS NOT OPEN * -12 SOF OR EOF SENSED ON READ * -17 ILLEGAL REQUEST TO A TYPE ZERO FILE * -19 ILLEGAL ACCESS ON A SYSTEM DISC * * IER SEE IERR - RETURNED AS FUNCTION * * IBUF IS THE BUFFER TO BE USED TO READ OR WRITE. * * IL IS THE REQUESTED TRANSFER LENGTH IN WORDS. * * L IS THE LENGTH AS READ IN WORDS. * * N IS THE REQUESTED RECORD NUMBER * IF N>0 OR IF N<0 THE RELATIVE RECORD * NUMBER FROM THE CURRENT POSITION. * N IS LEGAL ON TYPE 1 AND 2 FILES ONLY. * FOR READF AND WRITF, N IS A SINGLE WORD RECORD NUMBER. * FOR EREAD AND EWRIT, N IS A DOUBLE WORD RECORD NUMBER. * * * O P T I O N S: * * IL IS OPTIONAL ON TYPE 1 AND 2 FILES. * ON TYPE 1 FILES, 128 IS USED; * ON TYPE 2 FILES THE RECORD LENGTH IS USED. * * L IS OPTIONAL AT ALL TIMES. * * N IS OPTIONAL AND IS IGNORED ON FILES * OF TYPES OTHER THAN 1 AND 2. IF NOT * SUPPLIED, ZERO IS USED. * THE FIRST RECORD IN A FILE IS RECORD #1. * * * E X T E R N A L S: * * RW$UB IS USED TO READ OR WRITE WORDS * FROM OR TO FILES OF TYPE 2 OR * ABOVE. IT HANDLES ALL SECTOR, * TRACK, AND EXTENT SWITCHING FOR * THESE FILES AND ALSO WRITES AND/OR * READS BLOCKS FROM THE FILE AS * REQUIRED. READS ARE CONDITIONAL * ON RFLG$. A GLOBAL FLAG WHICH * MUST BE NON-ZERO BEFORE A READ * IS EXECUTED. * * RW$UB CALLING SEQUENCE IS: * * LDB #WORDS * LDA DCB ADDRESS * CLE/CCE WRITE/READ * JSB RW$UB CALL * DEF UBUF ADDRESS OF USER'S –þúBUFFER * JMP ERROR ERROR RETURN (A = CONDITION) * -- NORMAL RETURN SKP * * EREAD DEC -1 LDA EREAD TRANSFER RETURN ADDRESS STA READF TO READ ENTRY JMP READF+1 CONTINUE * WRITF DEC -1 LDA WRITF TRANSFER RETURN ADDRESS STA READF TO READ ENTRY CLA SET WRITE\READ FLAG TO STA WFLAG INDICATE WRITE (0) JMP READF+1 CONTINUE * EWRIT DEC -1 LDA EWRIT TRANSFER RETURN ADDRESS STA READF TO READ ENTRY CLA SET WRITE\READ FLAG TO STA WFLAG INDICATE WRITE (0) JMP READF+1 CONTINUE * * DCB NOP DCB POINTER IERR NOP ERROR RETURN BUF OCT -17 USER BUFFER ADDRESS IL DEF DM REQUEST LENGTH L DEF ZERO RETURN LNGTH (READ) RECORD NUMBER (WRITE) N DEF ZERO RECORD NUMBER (READ) * READF NOP ENTRY POINT JSB .ENTR FETCH INCOMING DEF DCB PARAMETERS LDA EREAD GET EREAD ENTRY POINT SSA EREAD CALL? #-1? JMP R.1 NO - TRY ANOTHER DLD N,I YES - LOAD DOUBLE WORD RECORD NUMBER JMP READ0 AND GO SAVE IT * R.1 LDA WRITF GET WRITF ENTRY POINT SSA WRITF CALL? #-? JMP R.2 NO - GO TRY ANOTHER LDB L,I YES - GET RECORD NUMBER, CLA MAKE INTO A DOUBLE WORD SSB TAKING INTO ACCOUNT THAT IT CCA MAY BE POSITIVE OR NEGATIVE JMP READ0 AND GO SAVE IT * R.2 LDA EWRIT GET EWRIT ENTRY POINT SSA EWRIT CALL? #-1? JMP R.3 NO - GO TRY ANOTHER DLD L,I YES - GET DOUBLE WORD RECORD NUMBER JMP READ0 AND GO SAVE IT. R.3 CLA MUST BE A READF CALL SO GET RECORD LDB N,I NUMBER AND MAKE INTO A DOUBLE WORD SSB TAKING INTO ACCOUNT THAT IT CCA M¤þúAY BE POSITIVE OR NEGATIVE READ0 DST RECRD SAVE DOUBLE WORD RECORD NUMBER * LDA DCB SET UP THE CLB,CLE DCB JSB P.PAS ADDRESSES N17 DEC -17 DTMP NOP USE FIRST TWO AS DTM1 NOP DOUBLE WORD TEMP STORAGE TYPE NOP ADDRESS OF TYPE LU0 NOP LU (FOR 0 FILE) TRACK EQU LU0 ALSO TRACK EOF0 NOP EOF CODE (0 FILE) BSECT EQU EOF0 ALSO SECTOR SPAC NOP SPACING CODE (0 FILE) SIZE EQU SPAC ALSO FILE SIZE RL NOP RECORD LENGTH SCRWF NOP SECURITY/OPEN MODE/READ\WRITE FLAG #SC/T NOP SECTORS/TRACK OCFLG NOP OPEN FLAG TR NOP CURRENT TRACK SECT NOP CURRENT SECTOR BUFPT NOP CURRENT POSITION RC1 NOP DOUBLE WORD RC NOP RECORD COUNT TMP NOP BFSZ EQU TMP BUFD NOP SPC 2 LDA BUFPT GET CURRENT BUFFER POINTER STA TDCBP AND SAVE IN CASE OF EOD LDA SCRWF,I GET BUFPT AND RWFLG STA TRWFP CONTENTS AND SAVE IN LDA BUFPT,I CASE OF END OF STA TBUFP DATA. * * LDA N10 PRESET FOR MISSING PRAM ERROR LDB BUF BUFFER MUST BE SSB SUPPLIED JMP EXIT ELSE MISSING PRAM * LDB OCFLG,I IF NOT OPEN LDA N11 CPB XEQT THEN RSS JMP EXIT EXIT FILE NOT OPEN * LDB WFLAG GET READ WRITE FLAG LDA SCRWF,I AND SECURITY CODE AND BLMSK MASK TO DCB LENGTH STA BFSZ SAVE BLOCK LENGTH XOR SCRWF,I GET THE SECURITY CODE/UDATE FLAG ARS,ARS KEEP SC IN BIT 15 AND GET OPEN ARS MODE TO BIT 0 SSB,RSS IF WRITE SSA AND JMP SCOK BAD SECURITY * LDA N7 THEN EXIT STA IERR,I SET THE ERROR CODE CPA N33 ERROR -33? (END OF DISC m‡þúON CREAT) JMP EOD CPA N14 ERROR -14? (END OF DIR ON CREAT) JMP EOD EXIT1 LDB N17 STB BUF RESTORE LDB DMBUF OPTIONAL STB IL PARAMETER LDB DZERO ADDRESS STB L FOR STB N NEXT CLB CALL STB ZERO STB ZERO+1 STB DM CCB PRESET READ\WRITE FLAG TO STB WFLAG INDICATE READ (-1) STB EREAD RESET OTHER ENTRY POINTS STB EWRIT STB WRITF JMP READF,I RETURN * * EOD CCB SET -1 INTO LAST STB TBUFP,I POSITION IN DCB. DLD TBUFP NOW RESTORE BUFFER AND STA TDCBP,I FLAG WORDS. STB SCRWF,I LDA IERR,I RESET ERROR CODE JMP EXIT1 AND FINISH EXIT WORK. * * TDCBP NOP TBUFP NOP KEEP THESE TOGETHER TRWFP NOP * * SCOK ERA GET OPEN MODE TO E-REGISTER CLA SSB IF WRITE, A = 0 CCA IF READ, A = -1 SEZ IF WRITE AND UPDATE CCA OPEN, A = -1 STA RFLG$ USE A AS READ FLAG LDA TYPE,I GET TYPE CPA .2 TWO JMP LTEST GO TEST FOR EOF * CPA .1 IF TYPE ONE RSS SKIP JMP EOFTS ELSE GO TO EOF TEST * RANDOM ACCESS FILE * LDA SCRWF,I CLEAR WRITTEN-ON FLAG RAR,CLE,ELA IN DCB TO INHIBIT R/W$ STA SCRWF,I WRITE FOR TYPE ONE FILES LDA .128 FORCE LENGTH TO 128 FOR TYPE 1 FILES STA RL,I FOR THE POSITION ROUTINE STA BFSZ FORCE BLOCK LENGTH TO 128 FOR TYPE 1 * LTEST LDA IL,I GET THE REQUEST LENGTH SSA IF EOF REQUEST THEN JMP EXIOK GO EXIT NO ACTION * CLA SET UP RECORD LENGTH LDB RL,I AND DCB BUFFER LENGTH DST DTMP1 AS DOUBLE WORDS FOR USE LDB BFSZ LATERþüþú IN DOUBLE WORD DST DTMP2 CALCULATIONS. DLD RECRD GET SPECIFIED DOUBLE WORD RECORD NUMBER SZB,RSS IF ZERO SZA OR NEGATIVE SSA IT IS RELATIVE RSS RECORD POSITION. JMP ABPOS ELSE IS ABSOLUTE RECORD NUMBER JSB .DAD RELATIVE - SO ADD DEF RC1,I TO CURRENT RECORD POSITION ABPOS DST DTMP SAVE NEW RECORD NUMBER JSB .DDE DECREMENT NEW RECORD NUMBER BY 1 SSA IF NEGATIVE JMP EOFEX TAKE ERROR EXIT JSB .DMP MULTIPLY RECORD NUMBER - 1 DEF DTMP1 BY RECORD LENGTH DST DTMP1 SAVE (RC - 1)RL JSB .DDI USE DOUBLE WORD DIVIDE THIS DEF DTMP2 TIME. DOUBLE WORD QUOTIENT IN A,B JSB .DMP MULTIPLY BY DCB BUFFER SIZE DEF DTMP2 ((RC - 1)RL/BFSZ)*BFSZ DST DTMP2 KEEP TEMPORARILY DLD DTMP1 GET (RC - 1)RL AGAIN JSB .DSB SUBTRACT POSITION IN WORDS OF DEF DTMP2 RELATIVE BEGINNING OF DCB BUFFER IN FILE STB OCFLG DIFFERENCE IS OFFSET IN DCB BUFFER - SAVE DLD DTMP2 FIND SECTOR ADDRESS OF BEGINNING OF DCB IN FILE SWP CONVERT TO ASR 6 EVEN SECTOR SWP ADDRESS DST DTMP1 AND SAVE * LDA SIZE,I GET FILE SIZE IN +SECTORS OR -TRACKS CLB SSA,RSS IN +SECTORS? JMP INSEC YES CMA,INA NO - CONVERT TO LSL 8 +SECTORS INSEC SWP A,B = DOUBLE WORD # SECTORS IN FILE DST DTMP2 SAVE IT JSB .DSB SUBTRACT NEW DEF DTMP1 SECTOR ADDRESS JSB .DDE DECREMENT BY 1 SIZE - DTMP1 - 1 SSA CHECK FOR EOF JMP EOFEX EOF SO TAKE ERROR EXIT * CLA ADD FILE'S BASE LDB BSECT,I SECTOR TO NEW JSB .DAD SECTOR ADDRESS DEF DTMP1 SWP DIV #SC/T,I DIVIDE BY N\þúO. SECT/TRACK ADA TRACK,I ADD BASE TRACK-A = TRACK DST DTMP1 SAVE NEW TR/SECTOR ADDRESS CPA TR,I IF SAME CCA AS CPB SECT,I CURRENT LDB 0 POSITION CLE,SSB THEN JMP RACS SKIP * LDB DCB ELSE JSB R/W$ WRITE THE CURRENT BLOCK JMP EXIT IF NECESSARY * DLD DTMP1 THEN SET THE NEW DST TR,I TRACK AND SECTOR ADDRESS * * RACS LDA OCFLG SET THE OFFSET ADA BUFD ADD BUFFER ADDRESS STA BUFPT,I AND SET THE POINTER DLD DTMP SET THE DST RC1,I NEW RECORD NUMBER SPC 2 EOFTS LDA BUFPT SET THE INDIRECT ADA MSIGN BIT ON STA BUFPT THE BUFFER POINTER LDA TYPE,I GET FILE TYPE CMA,INA,SZA,RSS IF 0 JMP TYP00 OR 1 * INA,SZA,RSS GO DO 0/1 THING JMP .1TYP * INA,SZA,RSS IF TYPE 2 JMP TWOTY GO DO READ TEST * INTS LDA SCRWF,I GET THE IN CORE FLAG AND =B7 IF IN CCE,SZA CORE JMP TWOSP GO TEST FOR TYPE TWO * LDB DCB ELSE READ JSB R/W$ THE BLOCK JMP EXIT ERROR EXIT SPC 2 TWOSP LDA TYPE,I GET THE TYPE AGAIN TWORW LDB RL,I GET THE RECORD LENGTH (TYPE 2) CPA .2 IF TYPE 2 JMP .2RW GO DO READ WRITE SPC 2 * * TYPE 3 AND ABOVE READ/WRITE LOOP * LDA WFLAG SET READ WRITE FLAG ELA IN E 0=> WRITE 1=>READ LDB BUFPT,I GET CURRENT WORD SSB,RSS IF <0 THEN EOF JMP RDLEN NO <0 - SKIP * LDA SCRWF,I EOF RAR,RAR SET (READ) OR CLEAR (WRITE) ELA,RAL EOF SENT STA SCRWF,I BIT IN DCB LDA WFLAG GET THE DIRECTION AGAIN SSA,RSS IF WRITE JMP SWRI GO BACK UP THE COUNT IF REQUIRED * * READ AT EOF * EOFT0 STA L,I EOÒRþúF HERE WITH A = -1 CLA,SEZ IF FIRST EOF SKIP EOFEX LDA N12 ELSE EOF ERROR SSA IF 2ND EOF THEN RETURN WITH ERROR JMP EXIT DLD RC1,I ELSE STEP JSB .DIN RECORD DST RC1,I COUNT CLA JMP EXIT RETURN NO ERROR * * WRITE AT EOF * SWRI SEZ,RSS EOF WAS PASSED TO THE USER? JMP SWRI1 NO - SKIP DLD RC1,I YES - THEN BACK JSB .DDE UP THE RECORD COUNT DST RC1,I SWRI1 CLB,CLE RECOVER THE E BIT FOR WRITE STB RFLG$ CLEAR THE READ FLAG RDLEN CCB,SEZ IF READ JMP RDLE1 SKIP WRITE CHECKS * LDA IL,I GET REQUEST LENGTH CMA,CCE,SSA,INA,RSS IF WRITE EOF JMP EOFWR GO WRITE EOF * ADA BUFPT,I COMPARE NEW LENGTH TO OLD LDB RFLG$ GET READ FLAG CLE,SZA IF NEW LENGTH = OLD SZB,RSS OR IF NOT UPDATE JMP RDLE2 CONTINUE WRITE SPC 1 ERR5 LDA N5 ELSE UPDATE ERROR JMP EXIT GO EXIT SPC 1 RDLE1 LDA DMBUF GET LENGTH RETURN ADDRESS RDLE2 CLB,SEZ,INB,RSS IF WRITE LDA IL USE REQUEST LENGTH STA BUA SET ADDRESS OF BUFFER LDA DCB SET THE DCB ADDRESS JSB RW$UB GO READ FIRST LENGTH WORD BUA DEF L,I JMP EXIT ERROR EXIT * LDB BUA,I .2RW LDA WFLAG GET READ/WRITE FLAG ELA TO E CLA,SEZ,RSS IF WRITE THEN SKIP JMP WRIT WRITE SO SKIP * LDA IL CHECK IF LENGTH SUPPLIED CPA DMBUF IF COMPARE THEN NO LENGTH CLA,RSS NOT SUPPLIED SO FORCE TRANSFER LDA B SUPPLIED SO CHECK FOR RECORD CMA,INA TOO LONG FOR ADA IL,I BUFFER SSA SKIP IF OK LDB IL,I TOO LONG SO USE SUPPIED LENGTH STB L,I SET AS RETURN LENGTH WRIT STA SKIP SAVE RESIDUE FOR SKIP AFTER READ LDA DCB }½þúDCB TO A JSB RW$UB READ THE RECORD DEF BUF,I TO USER BUFFER JMP EXIT ERROR EXIT * LDB TYPE,I GET FILE TYPE CPB .2 IF 2 JMP EXT0 THEN DONE - GO EXIT * LDA DCB SET UP TO SKIP LDB SKIP THE RESIDUE CMB,SSB,INB SET + NO WORDS SKIP IF >0 JMP NOSKP <0 SO DON'T SKIP * JSB $KIP GO SKIP THE WORDS JMP EXIT ERROR EXIT * NOSKP LDA WFLAG ELSE ELA SET TO LDA ADTMP IF READ USE TEMPORARY SPACE SEZ,RSS READ /WRITE THE LDA IL TWIN WORD STA BUFAA WORD LDA DCB TO TEMP SPACE CLB,INB OR FROM JSB RW$UB USER PARAMETER BUFAA NOP JMP EXIT ERROR - EXIT * LDA BUFAA,I GET TWIN LENGTH WORD CPA BUA,I IF TWIN MISMATCH CCB,RSS JMP ERR5 THEN BAD RECORD - EXIT * LDA RFLG$ GET READ FLAG CLE,SZA,RSS IF NOT READING JMP EOFWR GO SET EOF IN FILE * EXT0 DLD RC1,I STEP THE JSB .DIN RECORD DST RC1,I COUNT EXIOK CLA DONE - OK SO JMP EXIT EXIT * * EOFWR STB BUFPT,I SET EOF IN DCB LDA SCRWF,I SET UP THE EOF RAR,ERA READ FLAG AND CCE THE WRITTEN-ON ERA,RAL FLAG AND THE IN CORE CCE RAL,ELA FLAG IN THE DCB STA SCRWF,I JMP EXT0 GO EXIT SPC 2 TWOTY LDB RFLG$ GET READ WRITE FLAG SZB IF READING JMP INTS GO TEST FOR IN CORE * JMP TWOSP ELSE GO WRITE. SPC 2 * * TYPE 0 OR 1 FILE -- TRANSFER FROM CORE * .1TYP LDA IL GET LENGTH ADDRESS LDB A,I GET LENGTH CPA DMBUF IF NOT SUPPLIED THEN LDB .128 USE 128 STB IL SAVE LOCALLY ADB B177 ROUND UP LSR 7 GET # OF SECTORS COVERED STB SK4™þúIP SAVE ROUNDED LENGTH CLA ADD # SECTORS COVERED JSB .DAD TO CURRENT RECORD # DEF RC1,I = # 128 WORD RECORDS DST DTMP SAVE NEW RECORD NUMBER JSB .DDE DECREMENT SWP LSL 1 CONVERT TO 64-WORD SECTORS SWP DST DTMP1 AND SAVE DLD DTMP2 GET DOUBLE WORD FILE SIZE IN SECTORS JSB .DSB SIZE - 2(SKIP + RC,I - 1) DEF DTMP1 SSA IF OUT OF FILE TAKE JMP EOFEX EOF EXIT * * LDA SKIP GET ROUNDED LENGTH LSL 7 SET TO CORRECT POSITION LDB WFLAG AND SSB,RSS RESET IF STA IL WRITE LDA IL GET XFER LENGTH FOR D$XFR SSB IF READ THEN STA L,I SET THE RETURN LENGTH ELB SET E FOR DXFR$ CALL LDB BUF GET THE BUFFER ADDRESS STB BUFA SET IT IN THE CALL LDB DCB GET THE DCB ADDRESS JSB D$XFR GO DO THE TRANSFER BUFA NOP JMP EXIT ERROR RETURN * DLD DTMP SET THE NEW DST RC1,I RECORD COUNT JMP EXIOK AND EXIT * TYP00 LDB WFLAG IF READ STB TMP SET READ WRITE FLAG FOR EOF TEST LDA RL,I GET THE READ WRITE LEGAL FLAG SSB,RSS IF WRITE RAR SHIFT THE WRITE FLAG TO BIT 15 SSA,RSS TEST THE FLAG JMP EX17 ILLEGAL REQUEST GO EXIT SPC 1 CCA IF READ SSB THEN JMP TYP01 SKIP * CPA IL,I EOF? JMP EOFW0 YES; GO MAKE CONTROL RQ SPC 1 TYP01 CLA,CCE,INA SET UP THE REQUEST CODE SSB,RSS FOR THE CALL INA AND ELA,RAR STA RQ IT. JSB REIO CALL DEF RTN THE DEF RQ EXEC DEF LU0,I FOR DEF BUF,I I/O DEF IL,I TO/FROM USER BUFFER. RTN JMP EX17 DRIVER REJECŠB@0 THEN SKIP NP RECORDS * IF <0 THEN BACK SPACE NP RECORDS * IF =0 THEN NO OPERATION * NP IS A SINGLE WORD FOR POSNT CALLS. * IT IS A DOUBLE WORD FOR EPOSN CALLS. * IR (OPTIONAL) IF NOT CODED OR ZERO * NP IS RELATIVE OTHERWIZE * NP IS ABSOLUTE (NP MUST BE>0) * * * * SKP * * EPOSN DEC -1 LDA EPOSN STA POSNT JMP POSNT+1 * * * DCB NOP ER NOP NP DEF ZERO IR DEF ZERO * POSNT NOP ENTRY POINT JSB .ENTR Þ3þú FETCH DEF DCB ADDRESSES LDA EPOSN GET POSNT\EPOSN FLAG SSA DOUBLE WORD CALL? JMP POSN0 NO - SKIP DLD NP,I GET DOUBLE WORD RECORD NUMBER JMP POSN1 AND GO SAVE POSN0 CLA GET RECORD NUMBER, LDB NP,I MAKE INTO A DOUBLE WORD SSB TAKING INTO ACCOUNT THAT CCA IT MAY BE POSITIVE OR NEGATIVE POSN1 DST RECRD AND SAVE. * SZA,RSS IF NP IS ZERO SZB JMP POSN2 IT'S NOT SO CONTINUE CLA PRESET FOR NO ERROR EXIT LDB IR,I IF NP IS ZERO AND IR IS NON-ZERO SZB (ABSOLUTE POSITION TO RECORD 0) JMP EXIT THEN WANT TO EXIT NO OPERATION * POSN2 LDA N10 ENOUGH LDB NP PRAMS CPB DFZER SUPPLIED? JMP EXIT NO,EXIT STB RFLG$ FOURCE READS WHILE SPACING * CLB,CLE SET UP LDA DCB LOCAL DCB JSB P.PAS ADDRESSES DEC -15 RCOUT NOP USED FOR DOUBLE RCT1 NOP WORD COUNTER TYPE NOP TYPE LU NOP LU FOR TYPE 0 TMP NOP TEMPORARY STORAGE SPACE NOP SPACING LEGAL FLAGE TYPE 0 CONND NOP CONTROL WORD FOR CONTROL REQUEST RWFLG NOP WRITTEN-ON FLAG DSTAT NOP CONTROL WORD FOR STATUS REQUEST OPEN NOP OPEN FLAG LN NOP ONE WORD DUMMY BUFFER RCLN NOP STORAGE FOR TYPE >=3 RECORD LENGTH BFPT NOP BUFFER POINTER RC1 NOP DOUBLE WORD RC NOP RECORD COUNT LDA N11 GET NOT OPEN ERROR.CODE TO A LDB OPEN,I GET OPEN FLAG TO B CPB XEQT OPEN CCE,RSS YES; SKIP;SET E JMP EXIT NO; EXIT OPEN ERROR * LDA BFPT GET BUFFER POINTER ADDRESS RAL,ERA SET INDIRECT BIT STA BFPT RESET POINTER LDA IR,I GET RELATIVE /ABSOLUTE FLAG vOþú CLB IF IR=0, THIS IS A RELATIVE POSITION SZA,RSS SO WANT TO LOAD DOUBLE WORD LDB RC,I CURRENT RECORD NUMBER INTO A,B SZA IF IR#0, THIS IS AN ABSOLUTE POSITION CLA,RSS SO WANT TO CLEAR A,B LDA RC1,I (DOUBLE WORD 0) JSB .DAD ADD TO THIS THE DOUBLE WORD NUMBER DEF RECRD OF RECORDS TO BE POSITIONED DST RECRD AND SAVE. JSB .DNG NEGATE AND JSB .DAD ADD TO CURRENT RECORD NUMBER DEF RC1,I TO GET ABSOLUTE RECORD NUMBER. JSB .DNG MAKE NEGATIVE FOR USE AS COUNTER SZA,RSS ZERO? SZB RSS JMP EXOK YES - GO EXIT DST RCOUT NO - SAVE COUNT * LDB TYPE,I GET TYPE OF FILE CMB,INB,SZB,RSS TYPE ZERO? JMP TYP0 YES; GO TO TYPE ZERO ROUTINE * INB,SZB TYPE; 1 INB,SZB,RSS OR 2 JMP TY1/2 YES; GO TO RANDOM ACESS POSITION * SSA,RSS TYPE 3 OR ABOVE AND FORWARD SPACE? JMP FSRC YES - GO DO IT. * * * TYPE 3 AND ABOVE BACKSPACE ROUTINE * * BSRC LDA BFPT,I GET CURRENT POSITION INA,SZA IS IT EOF? JMP BSRC3 NO; GO BACKSPACE LDA RWFLG,I YES; GET THE READ/WRITE RAR,CLE,RAR FLAG AND CLEAR THE EOF BIT ELA,RAL THEN STA RWFLG,I RESTORE THE FLAG SEZ WAS IT SET? JMP BSRC5 YES; COUNT AS A RECORD BSRC3 CCB NO; BACKSPACE 1 LDA DCB WORD JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET THE RECORD LENGTH STA RCLN AND SAVE IT CMA BACK SPACE STA B TO THE LDA DCB TWIN JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET TWIN CPA RCLN TWINS MATCH? BSRC5 RSS YES - SKIP AND GO COUNT THE RECORD JMP ER5 NO; ERROQþúR -5 DLD RC1,I GET RECORD NUMBER JSB .DDE DECREMENT IT AND DST RC1,I RESTORE IT. JSB .DIS INCREMENT AND SKIP IF ZERO DEF RCOUT RECORDS TO BE SPACED COUNTER RSS MORE TO BACKSPACE JMP EXOK WE'RE DONE - GO EXIT JMP BSRC3 GO BACKSPACE ANOTHER * * * FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES * * FSRC DLD RCOUT GET COUNTER JSB .DNG NEGATE AND SAVE DST RCOUT COUNTER FSRC1 JSB READF READ DEF REART A DEF DCB,I RECORD DEF ER,I TO DEF TMP LOCAL DUMMY DEF .1 ONE WORD BUFFER DEF LN REART SSA IF ERROR JMP EXIT EXIT LDB LN GET WORD SSB EOF? JMP EOFEX YES - TAKE EOF EXIT JSB .DIS INCREMENT AND SKIP IF ZERO DEF RCOUT RECORDS TO BE SPACED COUNTER RSS MORE TO FORWARD SPACE JMP EXIT WE'RE DONE - GO EXIT JMP FSRC1 GO FORWARD SPACE ANOTHER * * * TYPE ZERO SPACE ROUTINE * * TYP0 SSA,RSS IF FORWARD SPACE JMP FSRC GO TO READ ROUTINE LDA N3 PRESET FOR ERROR LDB SPACE,I GET FORWARD OR BACKSPACE SSB,RSS LEGAL CODE JMP EXIT BACK SPACE NOT LEGAL-EXIT LDA LU,I GET AND AND B77 ISOLALE LU ADA B200 ADD BACK SPACE FUNCTION STA CONND SET FOR CALL ADA B400 MAKE A DYNAMIC STATUS RQ STA DSTAT SET IT CCA SET FIRST EOF RECORD FLAG SPC0 STA OPEN IN OPEN JSB EXEC CALL EXEC DEF EXRTN TO DEF .3 BACK DEF CONND SPACE EXRTN JSB EXEC DO DYNAMIC STATUS DEF STRTN DEF .3 DEF DSTAT STRTN AND B200 MASK EOF BIT STA TMP AND SAVE IT DLD RC1,I GET RECORD NUMBER JSB .DDE DECREME½kNT IT AND DST RC1,I RESTORE IT LDA TMP GET EOF BIT AGAIN SZA,RSS AT EOF? JMP NTEOF NO CCA YES - PRESET TO FORWARD SPACE CCB ONE RECORD ISZ OPEN SKIP IF EOF ON FIRST RECORD JMP FSRC ELSE GO FORWARD SPACE NTEOF JSB .DIS INCREMENT AND SKIP IF ZERO DEF RCOUT RECORDS TO BE SPACED COUNTER RSS MORE TO SPACE JMP EXOK ALL DONE - GO EXIT JMP SPC0 CONTINUE SPACING * * ER5 LDA N5 LENGTH MISMATCH ERROR JMP EXIT SEND ERROR CODE * * * TYPE 1 AND 2 SPACE ROUTINE * THE NEW RECORD NO. IS SET ONLY * NO EOF CHECK IS DONE * NEGATIVE OR ZERO RECORD * NUMBERS ARE REPLACED * WITH 1 AND SOF ERROR SENT * * TY1/2 DLD RECRD GET THE ABSOLUTE RECORD NO. CCE,SZA,RSS IF ZERO OR NEGATIVE SZB SET TO RECORD 1 SSA CLA,CLE SEZ,RSS CLB,INB DST RC1,I SET NEW RECORD NO. SEZ IF FORCED TO ONE TAKE SOF EXIT EXOK CLA,RSS GOOD EXIT EOFEX LDA N12 EOF/SOFEXIT EXIT LDB DFZER EXIT - RESET STB NP OPTIONAL STB IR ADDRESSES CCB RESET POSNT\EPOSN STB EPOSN FLAG STA ER,I SET ERROR AND JMP POSNT,I RETURN * * * ZERO BSS 2 .1 DEC 1 .3 DEC 3 * N3 DEC -3 N5 DEC -5 N10 DEC -10 N11 DEC -11 N12 DEC -12 * DFZER DEF ZERO * B77 OCT 77 B200 OCT 200 B400 OCT 400 * RECRD BSS 2 * A EQU 0 B EQU 1 XEQT EQU 1717B * END EQU * * END ‰¤ÿÿ ÿý> H ÿ92067-18134 1903 S C0122 &APOSN              H0101 ˆŒþúASMB,R,L,C,Q HED APOSN * NAME: APOSN * SOURCE: 92067-18134 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM APOSN,7 92067-16125 REV.1903 790503 ENT APOSN, EAPOS EXT $KIP, NX$EC, RFLG$, .ENTR, ELOCF EXT .DNG, .DAD, .DDI SUP * * * THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING * OF RTE FILES * * CALLING SEQUENCE: * * CALL APOSN(IDCB,IERR,IREC,IRS,IOFF) OR * CALL EAPOS(IDCB,IERR,IREC,IRS,IOFF) * * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK * * IERR IS AN ERROR RETURN FLAG. POSSIBLE ERRORS, * 0 NO ERROR * -1 DISC DOWN * -5 SPACING BEYOND END OF DEFINED EXTENT * -9 ATTEMPT TO POSITION TYPE ZERO FILE * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 SOF IE IREC <1 * * IREC THE RECORD NUMBER TO BE READ NEXT * * IRS (REQUIRED FOR 3 & ABOVE ONLY) THE * RELATIVE BLOCK OF THE NEXT RECORD * * * IOFF THE BLOCK OFFSET OF THE NEXT * RECORD (REQUIRED FOR TYPE 3 AND * ABOVE ONLY) * * IREC AND IRS ARE SINGLE WORD INTEGERS FOR THE APOSN CALL. * FOR EAPOS, IREC AND IRS ARE DOUBLE WORD INTEGERS. * * * * * EAPOS DEC -1 LDA EAPOS STA APOSN JMP APOSN+1 * * * DCB NOP ER NOP IRC NOP IRS NOP IOFF NOP * APOSN NOP ENTRY POINT JSB .ENTR FETCH PRAM DEF DCB ADDRESSES LDA ',þúEAPOS GET APOSN\EAPOS CODE SSA DOUBLE WORD CALL? JMP APOS0 NO - SKIP DLD IRC,I GET DOUBLE WORD RECORD # DST RECRD AND SAVE DLD IRS,I GET DOUBLE WORD BLOCK JMP APOS1 AND GO TO SAVE IT APOS0 CLA GET RECORD # LDB IRC,I AND MAKE INTO A DOUBLE WORD SSB AND SAVE CCA DST RECRD CLA LDB IRS,I GET BLOCK AND MAKE INTO A DOUBLE WORD SSB CCA APOS1 DST BLOCK AND SAVE. CLB,INB SET THE READ STB RFLG$ FLAG * LDB DCB COMPUTE ADB .2 TYPE STB TYPE AND ADB .5 STEP TO BLOCK LENGTH LDA B,I FETCH AND AND BLMSK CONVERT CLB TO NUMBER OF WORD BLOCKS LSL 9 (MADE INTO A DOUBLE WORD) DST BLKSZ AND SAVE AS A DOUBLE WORD LDB DCB ADB .9 STEP TO OPEN FLAG LDA N11 IS LDB B,I DCB CPB XEQT OPEN? INA,RSS YES; SKIP JMP EXIT NO; EXIT INA SET A= 9 LDB TYPE,I IS FILE TYPE SZB,RSS ZERO? JMP EXIT YES; EXIT ADB N3 IF TYPE 1 OR 2 LDA IRC TEST FOR RECORD PRAM SSB,RSS ELSE TEST LDA IOFF FOR FULL PRAM SZA,RSS LIST JMP ER10 NOT ENOUGH PRAMS - EXIT SSB IF 1 OR 2 JMP RCSET GO SET RECORD NO. * JSB ELOCF USE LOCF TO DEF LOCRT GET DEF DCB,I CURRENT DEF ER,I RELATIVE DEF RC SECTOR DEF CIRS ADDRESS LOCRT CLB CALL LDA DCB SKIP JSB $KIP TO JMP EXIT SET UP NX$EC * DLD CIRS CALCULATE RELATIVE BLOCK CHANGE JSB .DDI CURRENT BLOCK/DCB BLOCK SIZE - DEF BLKSZ NEW BLOCK/DCB BLOCK SIZE JS mþúB .DNG DST CIRS DLD BLOCK JSB .DDI DEF BLKSZ JSB .DAD DEF CIRS SZA,RSS RELATIVE BLOCK = 0? ALREADY THERE? SZB RSS NO - JMP RCSET YES - SKIP POSITION CALL JSB NX$EC POSITION WITH NX$EC JMP EXIT ERROR - EXIT * RCSET DLD BLOCK CALCULATE BLOCK POSITION WITHIN DCB SWP DIV BLKSZ+1 (WANT REMAINDER) CLA CONVERT TO WORDS RRL 7 (MULTIPLY BY 128) LDA DCB GET DCB ADA .12 COMPUTE BUFFER POINTER ADDRESS STA CIRS ADA IOFF,I COMPUTE DESIRED ADA .4 CONTENTS ADA B ADD THE NO OF 128 WORD BLOCKS STA CIRS,I AND SET ISZ CIRS DLD RECRD GET RECORD NUMBER SZA,RSS IF ZERO OR NEGATIVE SEND SZB SOF\EOF ERROR SSA JMP ER12 DST CIRS,I ELSE PUT NEW RECORD NUMBER IN DCB LDB DCB GET DCB ADDRESS ADB .7 AND POSITION TO EOF FLAG WORD LDA B,I GET BLOCK SIZE/FLAG WORD RAR,CLE,RAR UNCONDITIONALLY CLEAR ELA,RAL CLEAR EOF READ FLAG STA B,I AND RETURN WORD TO DCB CLA,RSS OK - EXIT ER10 LDA N10 EXIT CLB CLEAR STB IRC PRAM STB IOFF ADDRESSES FOR NEXT TIME CCB RESET APOSN\EAPOS STB EAPOS FLAG STA ER,I SET ERROR CODE JMP APOSN,I RETURN. * * ER12 LDA N12 SEND EOF ERROR JMP EXIT * * * A EQU 0 B EQU 1 XEQT EQU 1717B * .2 DEC 2 .4 DEC 4 .5 DEC 5 .7 DEC 7 .9 DEC 9 .12 DEC 12 * N3 DEC -3 N10 DEC -10 N11 DEC -11 N12 DEC -12 * BLMSK OCT 077600 * RECRD BSS 2 BLOCK BSS 2 RC BSS 2 CIRS BSS 2 BLKSZ BSS 2 TYPE EQU RC * END EQU * * END µ´ÿÿ ÿý?H ÿ92067-18135 1903 S C0122 &FCONT              H0101 w—þúASMB,R,L,C,Q HED FCONT * NAME: FCONT * SOURCE: 92067-18135 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FCONT,7 92067-16125 REV.1903 780413 * * CHANGE: 4\13\78 TO NOT CHECK A REG ON RETURN FROM EXEC * FOR EOF INDICATION. (GLM) * ENT FCONT EXT .ENTR,EXEC * * THIS IS THE TYPE ZERO CONTROL ROUTINE OF * THE RTE FILE MANAGEMENT PACKAGE. * * A STANDARD RTE CONTROL REQUEST IS ISSUED * TO THE DEVICE VIA THE EXEC IF THE * PCB IS OPEN TO A TYPE ZERO FILE. * CALLING SEQUENCE * CALL FCONT(IDCB,IERR,ICON1,ICON2) * WHERE: * IDCB IS THE DATA CONTROL BLOCK FOR * THE FILE. * IERR IS THE LOCATION FOR RETURNED * ERRORS. * POSSIBLE ERRORS ARE: * 0 NO ERRORS * -11 DCB NOT OPEN * * >0 NOT A TYPE ZERO FILE (IERR=TYPE) * ICON1 IS CONTROL WORD #1 - THE DEVICE * LU IS MURGED INTO THE LOW * 6 BITS OF THIS WORD * ICON2 IS CONTROL WORD TWO - OPTIONAL * ZERO IS USED IF NOT SPECIFIED * ON RETURN A = IERR * B = DEVICE STATUS SPC 3 * PRE CONSTANT AREA .2 OCT 2 TYPE NOP .7 OCT 7 SPC 3 IDCB DEF ZERO PARAMETER IERR DEF ZERO ADDRESS ICON1 DEF ZERO AREA ICON2 DEF ZERO SPC 1 FCONT NOP ENTRY POINT JSB .ENTR FETCH PARAMETERS DEF IDCB LDB IDCB GET DCB ADB .2 [   ADDRESS STB TYPE OF TYPE ADB .7 AND LDB B,I OPEN FLAG CPB XEQT OPEN? JMP OK YES, CONTINUE LDA N11 NO; SEND NOT OPEN ERROR EXIT STA IERR,I TO CALLER LDB DZERO RESET X REP 4 ENTRY STB *-X+IDCB ADDRESS CLB CLEAR DUMMY STB ZERO ZERO LDB STAT STATUS TO B AND JMP FCONT,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 N11 DEC -11 DZERO DEF ZERO ZERO NOP STAT NOP SPC 1 B77 OCT 77 SPC 3 OK LDA TYPE,I GET FILE TYPE SZA ZERO? JMP EXIT NO; EXIT : TYPE IN A SPC 1 ISZ TYPE YES; STEP TO WORD WITH LU LDA TYPE,I GET LU AND B77 AND ISOLATE THEN STA B SAVE LDA ICON1,I GET THE FUNCTION AND B1777 MAKE SURE THE LOW END IS ZERO IOR B PUT THEM TOGETHER STA ICON1 SET FOR CALL JSB EXEC CALL EXEC TO DEF EXRTN DO DEF FUNC THE DEF ICON1 CONTROL DEF ICON2,I FUNCTION EXRTN JMP EXM17 ERROR RETURN FROM EXEC. STA STAT SAVE STATUS FOR RETURN CLA INDICATE NO ERRORS *780413* JMP EXIT GO; EXIT * EXM17 LDA N17 JMP EXIT * SPC 3 * POST CONSTANT AREA SPC 1 FUNC OCT 100003 B1777 OCT 177700 B200 OCT 200 N17 DEC -17 SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END sc ÿÿ ÿý@G ÿ92067-18136 1903 S C0122 &LOCF              H0101 |]þúASMB,R,L,C,Q HED LOCF * NAME: LOCF * SOURCE: 92067-18136 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOCF,7 92067-16125 REV.1903 781110 ENT LOCF,ELOCF EXT P.PAS,.ENTR EXT .DDE, .DMP, .DAD * * * * * LOCF RETURNS THE CURRENT STATUS OF A * RTE FILE TO THE CALLER. * * * * THE FORTRAN CALLING SEQUENCE IS: * * * CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) OR * CALL ELOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) * * * * W H E R E: * * * IDCB IS THE DATA CONTROL BLOCK FOR THE FILE. * * IERR IS THE ERROR CODE RETURN. * POSSIBLE CODES ARE: * 0 - NO ERROR * -11 - DCB NOT OPEN * -10 - NOT ENOUGH PARAMETERS * -30 - VALUE TOO LARGE FOR PARAMETER * * IREC IS THE RECORD NUMBER OF THE NEXT RECORD. * * IRS IS THE RELATIVE SECTOR OF THE NEXT RECORD./2 * * IOFF IS THE OFFSET IN THE SECTOR OF THE NEXT RECORD. * * JSEC IS THE NO. OF SECTORS IN THE FILE (OR EXTENT). * * JLU IS THE FILE'S LOGICAL UNIT. * * JTY IS THE FILE'S TYPE. * * JREC IS THE RECORD SIZE. * * * ALL PARAMETERS AFTER IREC ARE OPTIONAL. * * * FOR LOCF CALLS, IREC, IRB, JSEC ARE SINGLE WORD INTEGERS. * FOR ELOCF CALLS, IREC, IRB, JSEC ARE DOUBLE WORD INTEGERS. * SKP * * ELOCF DEC -1 LDA ELOCF STA LOCF JMP LOCF+1 * * * DCB NOP IER DEF DM IREC DEF DM IRS DEF DM IOFF½yþú DEF DM JSEC DEF DM JLU DEF DM JTY DEF DM JREC DEF DM * LOCF NOP ENTRY JSB .ENTR GET DFDCB DEF DCB PARAMETER ADDRESSES * LDA N10 TEST FOR LDB IREC NOT ENOUGH CPB DFDM PARAMETERS JMP EXIT NOT ENOUGH - EXIT LDA DCB SET A TO GET DCB CLB,CCE SET TO GET ERB,CLE ACTUAL WORDS JSB P.PAS CALL TO PASS N16 DEC -16 DCB LU NOP PARAMETERS TMP NOP TYP NOP TRK NOP SEC NOP #SEC NOP SIZE NOP COUNT NOP SEC/T NOP OPCLS NOP CTRK NOP CSEC NOP BUFPT NOP REC1 NOP REC NOP EXNO NOP * LDB OPCLS IS LDA N11 FILE CPB XEQT OPEN? JMP OK YES; JUMP EXIT STA IER,I NO; SET EXIT CODE LDB N9 SET UP STB COUNT AND LDB DFDCB RESTORE STB TMP DUMMY LDB DFDM PARAMETER STB TMP,I ADDRESSES ISZ TMP ISZ COUNT IN JMP *-3 CALL CCB RESET LOCF\ELOCF STB ELOCF FLAG JMP LOCF,I EXIT * * * OK LDA #SEC GET SIZE IN +SECTORS CLB OR IN -TRACKS SSA,RSS IF IN -TRACKS CONVERT TO JMP OK.1 DOUBLE WORD NUMBER CMA,INA OF SECTORS LSL 8 OK.1 SWP DST FSIZE SAVE DOUBLE WORD SIZE IN SECTORS LDA AREC1 GET RECORD # LDB IREC AND SET IN JSB PRMRT RETURN PARAMETERS LDA TYP GET THE TYPE SZA,RSS SET NEG AND TEST FOR ZERO JMP TYPST TYPE ZERO SO JUMP LDA AFSIZ SET SIZE LDB JSEC IN RETURN JSB PRMRT PARAMETERS LDA TYP GET TYPE AGAIN CMA,INA AND MAKE IT NEGATIVE ADA .2 IF THREE OR GREATER SSA THEN JMP NOTRA JUMP NOT RAMDOM ACCESS CLA q:þú GET RECORD LENGTH LDB SIZE AND MAKE INTO DST DTMP A DOUBLE WORD DLD REC1 GET CURRENT RECORD NUMBER JSB .DDE LESS ONE JSB .DMP AND MULTIPLY BY DEF DTMP RECORD LENGTH SWP STA TMP AND B177 MASK OFF BLOCK OFFSET AND STA IOFF,I SET IN RETURN PARAMETERS XOR TMP ASR 7 CONVERT TO NUMBER OF BLOCKS SWP JMP STRS GO RETURN IT NOTRA LDA TRK TYPE >= 3 CMA,INA ((STARTING TRACK - CURRENT TRACK) ADA CTRK * #SECTORS PER TRACK) MPY SEC/T - STARTING SECTOR SWP + CURRENT SECTOR DST DTMP LDB SEC CMB,INB ADB CSEC CLA MAKE INTO A DOUBLE WORD SSB SO CAN USE DOUBLE WORD CCA ADD ROUTINE. JSB .DAD DEF DTMP # SECTORS "INTO" THIS EXTENT SWP ASR 1 CONVERT TO BLOCKS SWP DST DTMP # BLOCKS "INTO" THIS EXTEN * CLA MULTIPLY FILE SIZE LDB EXNO IN SECTORS TIMES JSB .DMP THE NUMBER OF DEF FSIZE PREVIOUS EXTENTS SWP ASR 1 CONVERT TO BLOCKS SWP JSB .DAD ADD TO # BLOCKS "INTO" THE CURRENT DEF DTMP EXTENT AND SAVE DST FSIZE * LDA DCB COMPUTE CMA,INA CURRENT ADA BUFPT BUFFER OFFSET ADA N16 ADJUST FOR BUFFER ADDRESS CLB ADJUST OFFSET TO DIV .128 128 WORD BASE STB IOFF,I RETURN OFFSET CLB ADD IN # 128 WORD SWP BLOCKS IN JSB .DAD DCB BUFFER (BEFORE CURRENT DEF FSIZE POSITION) TO GET CURRENT STRS DST FSIZE BLOCK OFFSET INTO FILE LDA AFSIZ LDB IRS JSB PRMRT RETURN CURRENT BLOCK OFFSET TYPST LDB TYP GET AND SET STB JTY,I TYPE Xù LDA LU GET LU (DISC FILE) SZB,RSS IS IT A DISC FILE? LDA TRK NO; USE TYPE 0 LU AND B77 MASK STA JLU,I AND SET LDA SIZE GET THE RECORD STA JREC,I SIZE AND SET IT CLA NO ERRORS JMP EXIT RETURN * * * * * PRMRT ROUTINE TO STUFF A DOUBLE WORD INTO A SINGLE OR * DOUBLE WORD RETURN PARAMETER (DEPENDING ON * WHETHER THE SINGLE WORD OR THE DOUBLE WORD * ROUTINE WAS CALLED) * * ON ENTRY * A = ADDRESS OF DOUBLE WORD * B = ADDRESS OF DESTINATION * * * ERROR 30 EXIT IS TAKEN IF VALUE IS >32K BUT SINGLE WORD * ROUTINE WAS CALLED. * * PRMRT NOP STB TMP LDB ELOCF CPB N1 JMP PR.1 DLD A,I DST TMP,I JMP PRMRT,I PR.1 DLD A,I STB TMP,I LDB N30 SZA JMP EXIT JMP PRMRT,I * * * A EQU 0 B EQU 1 XEQT EQU 1717B * .2 DEC 2 .128 DEC 128 * N1 DEC -1 N9 DEC -9 N10 DEC -10 N11 DEC -11 N30 DEC -30 * B77 OCT 77 B177 OCT 177 * FSIZE BSS 2 AFSIZ DEF FSIZE DTMP BSS 2 DM BSS 2 DFDM DEF DM AREC1 DEF REC1 * END EQU * * END ÅWÿÿ ÿýAJ ÿ92067-18137 2001 S C0122 &CLOSE FLIE CLOSE SUBROUTINE S             H0101 U(þúASMB,R,L,C HED CLOSE * NAME: CLOSE * SOURCE: 92067-18137 * RELOC: 92067-16125 * PGMR: G.A.A. N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CLOSE,7 92067-16125 REV.2001 791019 ENT CLOSE, ECLOS EXT EXEC, .ENTR, R/W$, RMPAR, .DNG, LURQ SUP * * THIS IS THE CLOSE SUBROUTINE--A PART OF THE * REAL-TIME FILE MANAGEMENT PACKAGE * * THE ASSEMBLY CALL TO CLOSE A FILE IS: * * JSB CLOSE OR JSB ECLOS * DEF RTN RETURN ADDRESS * DEF IDCB DATA CONTROL BLOCK ADDRESS * DEF IERR (OPTIONAL) ERROR CODE RETURNED HERE AND IN A REG * DEF IRX (OPTIONAL) NO. OF 128 WORD DOUBLE SECTORS TO BE *RTN DELETED FROM THE FILE. FOR CLOSE IRX IS A SINGLE * WORD INTEGER. FOR ECLOS IRX IS A DOUBLE WORD INTEGER. * * ERRORS ARE: * 0 NONE * -1 DISC DOWN * -10 NOT ENOUGH PARAMETERS * -11 FILE NOT OPEN * -13 DISC LOCKED * -19 ILLEGAL ACCESS TO A SYSTEM DISC * * * SKP ECLOS DEC -1 EXTENDED FILE CLOSE ROUTINE ENTRY POINT LDA ECLOS TRANSFER RETURN ADDRESS STA CLOSE TO CLOSE ENTRY POINT JMP CLOSE+1 AND JUMP TO CLOSE ROUTINE * * IDCB DEF ZERO DCB ADDRESS IERR DEF IDCB ERROR CODE ADDRESS IRX DEF ZERO TRUNICATE CODE ADDRESS * CLOSE NOP ENTRY POINT JSB .ENTR TRANSFER THE ADDRESSES DM DEF IDCB OF THE INCOMING PARAMETERS LDA ECLOS GET CLOSE\ECLOS FLAG SSA DOUBLE WORD CALL? JMP CLOS0 NO - SKIP x™þú* DLD IRX,I GET DOUBLE WORD TRUNCATE CODE JMP CLOS1 AND GO SAVE IT * CLOS0 CLA GET SINGLE WORD TRUNCATE CODE LDB IRX,I AND MAKE IT A DOUBLE WORD SSB TAKING INTO ACCOUNT THAT IT CCA MAY BE POSITIVE OR NEGATIVE CLOS1 DST TRUNC SAVE DOUBLE WORD # SECTORS TO BE TRUNCATED LDA IDCB IF NO PARAMETERS CPA DEF.0 THEN JMP ER10 ERROR EXIT * INA STEP TO WORD TWO STA DCB2 SAVE FOR D.RTR CALL ADA .8 ADD 8 TO GET THE THE OPEN FLAG STA OPNFL SAVE THE OPEN FLAG ADDRESS LDB A,I GET THE OPEN FLAG ADA N2 BACK UP TO THE SECURITY CODE STA SC AND SAVE SECURITY CODE ADDRESS CPB XEQT FILE OPEN? CLE,RSS YES SKIP JMP ER11 NO; ERROR EXIT LDB IDCB GET THE DCB ADDRESS JSB R/W$ CALL TO FLUSH THE BUFFER JMP EXIT DISC ERROR EXIT * LDA IDCB,I GET LU 1ST WORD OF DCB CPA OPFLG WAS THIS DCB SET UP BY OPENF JMP CLOS3 YES - SKIP D.RTR CALL * LDB DCB2 GET THE TYPE FLAG CLE,INB TO THE A- LDA B,I REGISTER. SZA,RSS IF ZERO NO TRUNCATE CCE SO SET E = 1 FOR FLAG ADB .13 STEP TO EXTENT WORD LDB B,I IF NOT THE SZB FIRST EXTENT CCE DO NOT ALLOW TRUNCATION. SET E = 1 LDB SC,I GET THE SECURITY FLAG LDA ATRUN IF TRUNCATE IS VALID (E # 1) SSB AND SC MATCHES, GET DOUBLE WORD TRUNCATE SEZ PARAMETER PASSED IN CALL. LDA DEF.0 ELSE WANT 0 FOR TRUNCATE CODE DLD A,I SO LOAD DOUBLE WORD ZERO. SWP ASL 1 MULTIPLY BY 2 TO ADJUST TO SECTORS SWP JSB .DNG MAKE NEGATIVE DST TRUNC AND SAVE AS TRUNCATE CODE * SCHED JSB EXEC CALL EXEC nrþúDEF SCHRT TO DEF .23 SCHEDULE QUEUE WITH WAIT DEF D.RTR D.RTR DEF XEQT WITH THE EXECUTING PROGRAM'S ID DEF ZERO CLOSE REQUEST NUMBEWR DEF IDCB,I THE FILE'S DIRECTORY DCB2 NOP ADDRESS DEF.0 DEF ZERO ATRUN DEF TRUNC AND A TWO WORD STRING CONTAINING DEF .2 THE DOUBLE WORD # OF SECTORYS TO BE TRUNCATED SPC 2 SCHRT JSB RMPAR CALL RMPAR TO GET DEF *+2 RETURN PARAMETERS DEF ERTN TO LOCAL AREA JMP CLOS4 GO CLEAR OPEN FLAG IN DCB AND RETURN * CLOS3 CLA SET TO ZERO FOR NO ERROR STA ERTN CLOS4 LDB DCB2 GET DCB WORD 2 ADDRESS INB POSITION TO TYPE WORD LDA B,I AND GET IT SZA IF NOT TYPE 0 THEN JMP EX JUST RETURN INB SET TO LU WORD LDA B,I GET LU AND AND B377 MASK TO LOWER BYTE STA ERTN+4 SAVE IT ADB .12 POSITION TO EXTENT WORD LDA B,I GET LOCK UNLOCK FLAG SZA LOCKED ON OPEN? JMP EX NO - JUST RETURN JSB LURQ YES - UNLOCK THE LU DEF *+4 DEF BIT14 (NO ABORT) DEF ERTN+4 LU DEF .1 ONE LU NOP IGNORE ERROR RETURN * EX LDA ERTN GET ERROR RETURN EXIT STA IERR,I SET THE ERROR CODE CLA CLEAR OPEN FLAG WORD STA OPNFL,I IN DCB LDB DM RESET THE STB IERR CALL WORDS LDB DEF.0 FOR THE STB IRX NEXT CALL STB IDCB CCB RESET CLOSE\ECLOS STB ECLOS FLAG JMP CLOSE,I RETURN WITH ERROR CODE IN A SPC 3 ER11 CCA FILE NOT OPEN - ERROR 11 ER10 ADA N10 NOT ENOUGH PRAMS - ERROR 10 JMP EXIT GO EXIT SPC 3 N10 DEC -10 N2 DEC -2 .1 DEC 1 .2 DEC 2 .3 DEC 3 .8 DEC 8 .12 DEC 12 .13 DEC 13 .23 DEC 23 ­ BIT14 OCT 40000 OPFLG OCT 177700 B377 OCT 377 SC NOP OPNFL NOP D.RTR ASC 3,D.RTR ERTN NOP NOP LOCAL STORAGE FOR NOP RETURN PARAMETERS NOP FROM D.RTR NOP ZERO NOP MUST BE DOUBLE WORD FOR NOP DEFAULT CASE IN ECLOS TRUNC BSS 2 DOUBLE WORD TRUNCATE CODE SPC 2 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END åûÿÿ ÿýBK ÿ92067-18138 1903 S C0122 &POST              H0101 ŒqþúASMB,R,L,C HED POST - CLEAR THE DCB BUFFER * NAME: POST * SOURCE: 92067-18138 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM POST,7 92067-16125 REV.1903 740801 ENT POST EXT .ENTR,R/W$ * * * THE POST ROUTINE CLEARS THE DCB BUFFER BY POSTING ANY * DATA THAT NEEDS TO BE WRITTEN ON THE DISC. IT WILL IN * ALL CASES CLEAR THE INCORE FLAG SO THE NEXT FILE * ACCESS WILL FOURCE A DISC READ. * * POST IS TO BE USE WITH THE RN LOCK FEATURE AS * FOLLOWS: * * POST * LOCK * * DO YOUR THING * * POST * UNLOCK * * CALLING SEQUENCE: * * CALL POST(DCB,ER) * * WHERE: * * DCB IS THE DCB ARRAY * ER IS THE OPTIONAL RETURN ERROR CODE * DCB NOP ER NOP POST NOP ENTRY POINT JSB .ENTR GET THE PRAM ADDRESSES DEF DCB LDB DCB CHECK ADB D9 THAT THE DCB LDA B,I IS OPEN CPA XEQT YES? JMP OK YES! * LDA N11 NO RETURN ERROR EREX STA ER,I SET THE ERROR CODE CLB SET ER ADDRESS STB ER FOR NEXT TIME JMP POST,I EXIT * OK LDB DCB GET THE DCB ADDRESS CLE SET E FOR WRITE JSB R/W$ GO POST THE BUFFER JMP EREX DISC ERROR GO EXIT * CLA ALL IS GOOD SET OK ERROR CODE JMP EREX AND GO EXIT * D9 DEC 9 N11 DEC -11 XEQT EQU 1717B A EQU 0 B EQU 1 END —ö  ÿÿ ÿýCJ ÿ92067-18139 1903 S C0122 &NAM..              H0101 YwþúASMB,R,L,C HED NAM.. ROUTINE * NAME: NAM.. * SOURCE: 92067-18139 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM NAM..,6 92067-16125 REV.1903 740801 ENT NAM.. EXT $LIBR,$LIBX,.ENTP SPC 3 * THIS ROUTINE CHECK FOR A LEGAL FILE NAME * CALLING SEQUENCE: * * JSB NAM.. * DEF *+2 * DEF NAME * * ON RETURN A=0 IF A LEGAL NAME -15 IF NOT LEGAL * * LEGAL NAMES MUST START WITH A NON NUMERIC NON BLANK * ASCII CHARACTER * AND MUST NOT CONTAIN +, OR - AS ANY CHARACTER SPC 3 NAME NOP ADDRESS OF THE NAME NAM.. NOP ENTRY POINT JSB $LIBR PRIVLEDGED NOP JSB .ENTP GET THE PRAMS DEF NAME LDB N6 SET TO CHECK STB COUNT 6 CHARACTERS LDB NAME RBL LDA NAME,I DO SPECIAL EXTRA CHECK ALF,CLE,ALF ON AND B377 FIRST CHARACTER ADA N60B IF NUMERIC OR BLANK SEZ,CME THEN ADA N10 TAKE SEZ THE CPA N20B ERR JMP ER15 EXIT CREA1 CLE,ERB GET THE NAME ADDRESS LDA B,I GET A NAME WORD ELB RESTORE ADDRESS FOR NEXT TIME SLB,INB,RSS INCREMENT SKIP IF ODD ELSE ALF,ALF ROTATE AND B377 MASK IT CPA COLON IF COLON CLA FOURCE ERROR ADA N40B BETWEEN " " SZA,RSS IF BLANK THEN JMP BLNK TAKE NOTE SEZ,CME AND ADA N13B "*" Ï%   SEZ,CLE,RSS INCLUSIVE? JMP CREA2 YES - OK ADA N3 NO; BETWEEN SEZ,CME "." AND ADA N62B "_" CREA2 ISZ NAME CHARACTER AFTER BLANK?? SEZ NO; LEGAL OTHER WISE?? JMP ER15 NO GO TAKE ERROR EXIT CREA3 ISZ COUNT DONE? JMP CREA1 NO; DO NEXT CHARACTER CLA,RSS GOOD NAME EXIT ER15 LDA N15 ERROR EXIT JSB $LIBX DEF NAM.. SPC 1 BLNK CCA SET BLANK FLAG STA NAME SO WE CAN DETECT JMP CREA3 INBEDDED BLANKS SPC 2 COUNT NOP COLON OCT 72 N62B OCT -62 N3 DEC -3 N13B OCT -13 N40B OCT -40 B377 OCT 377 N20B OCT -20 N60B OCT -60 N6 DEC -6 N10 DEC -10 N15 DEC -15 A EQU 0 B EQU 1 END /V ÿÿ ÿýDK ÿ92067-18140 1903 S C0122 &IDCBS              H0101 gŽASMB,R,L,C HED IDCBS * NAME: IDCBS * SOURCE: 92067-18140 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IDCBS,7 92067-16125 REV.1903 780602 EXT .ENTR ENT IDCBS * IDCB NOP IDCBS NOP JSB .ENTR FETCH PARAM ADDR DEF IDCB LDB IDCB ADB D9 GET THE OPEN FLAG LDA B,I FROM WORD 9 OF THE DCB CPA XEQT IS THIS FILE OPENED? JMP OPEND YES LDA MD11 NO, ERROR -11 JMP EXIT * OPEND ADB MD7 BACK UP TO WORD 2 LDA B,I CPA D1 FILE TYPE 1? CLA OR 0? SZA,RSS YES, SET BUFFER SIZE=0 * JMP RTNOK * NOT12 ADB D5 ADVANCE TO WORD 7 LDA B,I GET SIZE WORD AND MASK BUT CLEAR OTHER BITS RTNOK ADA D16 ADD 16 TO BUFFER SIZE EXIT JMP IDCBS,I RETURN DCB SIZE IN A * A EQU 0 B EQU 1 XEQT EQU 1717B D1 DEC 1 D2 DEC 2 D5 DEC 5 D9 DEC 9 D16 DEC 16 MD11 DEC -11 MD7 DEC -7 MASK OCT 077600 * END |ôÿÿ ÿýEK ÿ92067-18141 1903 S C0122 &$OPEN              H0101 vqþúASMB,R,L,C,Q HED $OPEN * NAME: $OPEN * SOURCE: 92067-18141 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $OPEN,7 92067-16125 REV.1903 790103 EXT RWND$ ENT $OPEN SUP * * $OPEN IS A ROUTINE OF THE RTE FILE MANAGEMENT PACKAGE. * * $OPEN IS CALLLED BY OPEN AND CREAT TO SET UP THE * DCB. IT READS THE DIRECTORY INFORMATION * AND TRANSFERS THE INFORMATION FROM THERE * TO THE DCB. IT ALSO INITIALIZES THE REST * OF THE DCB. * * CALLING SEQUENCE: * (IT IS ASSUMED THAT WORDS 1 & 2 OF THE DCB ARE SET UP.) * * A = DCB ADDRESS * B = BUF ADDRESS WHERE BUF CONTAINS WORDS 4-8 * OF THE DIRECTORY ENTRY RETURNED FROM D.RTR * E = 1 IF TYPE 1 OVERRIDE * O = 1 IF AN UPDATE OPEN * * JSB $OPEN * DEF IBLK DEF OF LENGTH OF DCB OR ZERO * DEF #SECT DEF OF WORD CONTAINING #SEC/TRACK * IN THE HIGH HALF (PASSED FROM D.RTR) * JMP ERR ERROR RETURN * NORMAL RETURN * ON A NORMAL RETURN: * A AND B = GARBAGE * * ON AN ERROR RETURN, EITHER * A = -1 DISC ERROR OR * A = -9 TYPE ZERO OVERRIDE ERROR * IN EITHER CASE THE DCB IS NOT SET UP. * * $OPEN NOP ENTRY STB BUF SAVE THE BUFFER ADDRESS STA DCB AND THE DCB ADDRESS STA DCB2 ADA .5 OFFSET TO FILE SIZE WORD STA SIZE AND SAVE CLA SET UPDATE OPEN BIT SOC IN OPEN MODE WORD IF :‚þúLDA =B10 UPDATE OPEN WAS REQUESTED STA OPNMD ISZ DCB INCREMENT DCB POINTER ISZ DCB TO TYPE WORD CLB,SEZ,INB IF TYPE 1 OVERRIDE STB DCB,I SET TYPE SEZ AND CCB THE STB TPFLG OVERRIDE SKIP FLAG CLB SET DCB LDA DCB EXTENT ADA .13 WORD STB A,I TO ZERO LDA N9 LDB BUF,I GET FILE TYPE SZB,RSS IF ZERO ISZ TPFLG AND OVERRIDE FLAG SET RSS JMP EREX EXIT - ERROR * LDB N5 SET TO MOVE 5 NXT LDA BUF,I PARAMETERS ISZ TPFLG IF OVERRIDE SET SKIP STA DCB,I SET PARAMETER ISZ DCB STEP ADDRESS ISZ BUF STEP SOURCE INB,SZB AND COUNT - DONE? JMP NXT NO; DO NEXT ONE LDB $OPEN,I GET ADDRESS OF DCB LENGTH ISZ $OPEN STEP POINTER LDA $OPEN,I GET #SECTORS PER TRACK LDA A,I TO A-REG ALF,ALF SHIFT TO LOWER BYTE AND =B377 MASK TO BITS 0-8 STA SEC/T AND SAVE. LDB B,I DCB LENGTH TO B-REG LSR 7 DIVIDE BY 128 TO GET BLOCKS SZB,RSS IF ZERO THEN INB USE ONE BLS CONVERT TO SECTORS NXBUF STB TPFLG SAVE IT CLB LDA SIZE,I GET FILE SIZE SSA,RSS +SECTORS OR -128 BLOCK CHUNKS JMP SEC1 ALREADY SECTORS - SKIP CMA,INA -CHUNKS - CONVERT TO +SECTORS LSL 8 IN B-REG AND A-REG SEC1 STA ASAVE DIVIDE BY DCB SIZE IN SECTORS ASR 15 A REGULAR DIVIDE COULD OVERFLOW ON DIV TPFLG LARGE FILES. SINCE ALL WE WANT TO LDA ASAVE KNOW IS IF THERE IS A REMAINDER, JUST RAL USE THIS ALGORITHM TO AVOID USE OF ASR 1 DOUBLE WORD DIVIDE, MULT, AND SUBTRACT DIV TPFLG COMPLIM#Æ ENTS OF BILL GIBBONS SZB,RSS IF NO REMAINDER JMP BFOK THEN THE SIZE IS OK LDB N2 ELSE TRY ONE SMALLER ADB TPFLG THAN THE CURRENT JMP NXBUF ONE BFOK LDA TPFLG GET THE BUFFER SIZE AND LSL 6 CONVERT SECTORS TO WORDS IOR OPNMD INCLUDE OPEN MODE FLAG STA DCB,I SET IN DCB ISZ DCB GET NUMBER OF LDB SEC/T SECTORS PER TRACK STB DCB,I PUT IT IN THE DCB ISZ $OPEN STEP RETURN ADDRESS CLA OPEN EXTENT ZERO LDB DCB2 GET THE DCB ADDRESS JSB RWND$ SET REST OF DCB JMP $OPEN,I ERROR EXIT ADB N3 GET DOUBLE WORD RECORD CLA NUMBER TO 1 STA B,I INA INB STA B,I ISZ DCB STEP TO THE OPEN FLAG ADDRESS LDA XEQT GET THE CURRENT ID ADDRESS STA DCB,I SET THE OPEN FLAG RSS EREX ISZ $OPEN STEP TO ERROR RETURN ISZ $OPEN STEP AND JMP $OPEN,I AND RETURN * * * SIZE NOP DCB NOP DCB2 NOP BUF NOP SEC/T NOP TPFLG NOP OPNMD NOP ASAVE NOP * .5 DEC 5 .13 DEC 13 N2 DEC -2 N3 DEC -3 N5 DEC -5 N9 DEC -9 * XEQT EQU 1717B A EQU 0 B EQU 1 * END EQU * * END 8ÿÿ ÿýFN ÿ92067-18142 1903 S C0122 &P.PAS              H0101 R¢þúASMB,R,L,Z,C HED P.PAS * NAME: P.PAS * SOURCE: 92067-18142 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM P.PAS,6 92067-16125 REV.1903 740801 EXT $LIBR,$LIBX XIF IFZ NAM P.PAS,7 92067-16125 REV.1903 740801 ENT P.PAS XIF * P.PAS IS USED TO SET UP ADDRESS OR TO MOVE * INFORMATION FROM THE CALL AREA * * CALLING SEQUENCE: * * E=0 SET UP CALL AREA * E=1 MOVE FROM CALL AREA * B=0 SET ADDRESSES ONLY * B=100000 MOVE PARAMETERS * A = ADDRESS OF OTHER AREA OR FIRST ADDRESS * * JSB P.PAS * DEC -N N= NO. OF WORDS TO BE SET UP * BSS N CALL AREA BUFFER * IF B IS 0, THIS WILL BE A * LIST OF ADDRESSES; IF B=100000, * THIS WILL BE THE WORDS AT THE * ADDRESS PROVIDED IN A. * * P.PAS NOP IFN JSB $LIBR CALL FOR PRIVILEGE NOP XIF ADB LOAD CONFIGURE THE LOAD STB NEXT AND SET IT LDB P.PAS,I GET THE COUNT STB COUNT AND SET ISZ P.PAS STEP TO PRAM AREA LDB P.PAS ADDRESS TO B SEZ IF FROM SWP SWAP ADDRESSES STB DEST SAVE THE DESTINATION ADDRESS NEXT LDB A GET ADDRESS OR IF LDB A,I STB DEST,I A WORD - SET IF ISZ DEST STEP DESTINATION INA STEP FROM ISZ COUNT STEP COUNT - DONE? JMP NEXT NO; GET NEXT ONE IFZ SEZ YEõ  S; EXIT TO JMP A,I END OF CALL JMP DEST,I SEQUENCE XIF IFN SEZ,RSS PRIVILEGE - COMPUTE LDA DEST RETURN ADDRESS AND STA P.PAS SET IT JSB $LIBX CALL SYSTEM DEF P.PAS TO RETURN XIF SPC 5 IFN COUNT EQU P.PAS+2 XIF IFZ COUNT NOP XIF DEST NOP LOAD LDB A TEST NOP SPC 2 A EQU 0 B EQU 1 END EQU * END K ÿÿ ÿýGN ÿ92067-18143 1903 S C0122 &RW$UB              H0101 gþúASMB,L,R,C,Q HED RW$UB * NAME: RW$UB * SOURCE: 92067-18143 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RW$UB,7 92067-16125 REV.1903 781003 EXT RWND$, R/W$, RFLG$ EXT EXEC, P.PAS EXT .DAD, .DMP, .DDI, .DNG ENT RW$UB, $KIP, NX$EC SUP * * * * RW$UB READS AND WRITES A WORD OR BLOCK OF WORDS ON A RTE FILE * * CALLING SEQUENCE: * * SET E=1 FOR READ * E=0 FOR WRITE * LDA DCB SET A TO DCB ADDRESS * LDB COUNT SET B TO THE NO OF WORDS TO BE XFERED * JSB RW$UB CALL * DEF BUF BUFFER CONTAING (WRITE) OR RECIEVING (READ) * JMP ERROR ERROR RETURN CODE IN A * --- NORMAL RETURN * * * RW$UB NOP ENTRY CMB,INB,SZB,RSS SET NEGATIVE SKIP IF NOT ZERO JMP ZER0 ZERO GO RETURN STB COUNT NEGATIVE CLB,SEZ,RSS COUNTER LDB RSS SET READ/WRITE SWITCH STB NEXTW RSS IF WRITE, ELSE NOP JSB PRAM GO GET THE PRAMETERS ADA BUFA CALCULATE CMA,INA THE # ADA BUFPT,I OF REMAINING STA LEFT WORDS AND SET LDB BUFPT,I GET THE POINTER TO B LDA RW$UB GET USER BUFFER LDA A,I GET ADDRESS RAL,CLE,SLA,ERA IF INDIRECT JMP *-2 TRY AGAIN ISZ RW$UB STEP RETURN STA PTR SET USER POINTER NEXTW RSS NOP IF READ RSS IF WRITE JMP READ DO READ THING LDA PTR,I WRITE; GET WORD STA B,I SET IT IN DCB ²‚þú RDW ISZ PTR STEP POINTER INB STEP DCB ADDRESS ISZ LEFT ANY ROOM LEFT? RSS RSS YES; SKIP JMP ENDBL NO; GO WRITE IT OUT CONT ISZ COUNT STEP WORD COUNT-DONE? JMP NEXTW NO; DO NEXT WORD STB BUFPT,I RESET THE BUFFER POINTER LDA FLAG,I IF LDB NEXTW WRITE CCE THEN SZB SET THE RAR,ELA WRITTEN- STA FLAG,I ON FLAG EX ISZ RW$UB STEP THE RETURN ADDRESS JMP RW$UB,I RETURN * * ZER0 ISZ RW$UB STEP FOR GOOD RETURN JMP EX EXIT * * ENDBL LDB TYPE,I IF TYPE TWO CPB .2 THEN LDB COUNT IF COUNT IS INB,SZB,RSS EXAUSTED JMP CONT JUST CONTINUE LDA FLAG,I GET DCB WRITTEN-ON FLAG LDB NEXTW GET THE READ\WRITE FLAG CCE IF WRITING SZB THEN SET RAR,ELA THE DCB STA FLAG,I WRITTEN ON FLAG CLA SET TO GET NEXT BLOCK CLB,INB (SENDING DOUBLE WORD BLOCK #) JSB NX$EC GO GET IT JMP RW$UB,I ERROR - RETURN LDB BLKLN OK - CMB,INB RESET STB LEFT LEFT COUNTER LDB BUFA AND BUFFER POINTER JMP CONT AND CONTINUE * READ LDA B,I GET THE WORD STA PTR,I SET IN USER BUFFER JMP RDW RETURN TO WRITE CODE * * COUNT BSS 2 BUFA NOP * * * ENTRY A = DCB ADDRESS * B = # WORDS TO SKIP * * $KIP NOP SKIP ENTRY STB COUNT+1 MAKE THE WORD COUNT SSB A DOUBLE WORD INTEGER CCB,RSS TAKING INTO ACCOUNT CLB WHETHER IT IS POSITIVE STB COUNT OR NEGATIVE JSB PRAM GO SET THE PRAMS LDB BUFA COMPUTE CMB,INB THE ADB BUFPT,I BUFFER CLA OFFSET JSB .DAD ADD THE DOQLþúUBLE DEF COUNT WORD COUNT SWP DIV BLKLN DIVIDE BY BLOCK LENGTH SSB SKIP IF POSITIVE ADA N1 ELSE ADDJUST THE BLOCK SSB IF NEGATIVE ADB BLKLN ADJUST TO POSITIVE ADB BUFA COMPUTE THE NEW BUFFER ADDRESS STB TMP SAVE NEW BUFFER ADDRESS SZA,RSS IF RELATIVE BLOCK IS ZERO, JMP SK1 THEN GO EXIT LSL 16 SSB CCA JSB NX$EC GO GET THE CORRECT BLOCK JMP $KIP,I ERROR RETURN SK1 LDA TMP STA BUFPT,I SET THE BUFFER ADDRESS IN THE DCB ISZ $KIP SET TO NORMAL RETURN JMP $KIP,I MAKE NORMAL RETURN * * * ENTRY A CONTAINS DCB ADDRESS * * EXIT A CONTAINS DCB BLOCK LENGTH IN WORDS * * PRAM NOP FETCH DCB ADDRESS SUBROUTINE CLB,CLE SET UP JSB P.PAS AND DEC -16 FETCH DCB NOP DCB TMP NOP TYPE NOP TR NOP SEC NOP #SEC NOP TMP1 NOP FLAG NOP SEC/T NOP LEFT NOP USED AS LOCAL ONLY CTRK NOP CSEC NOP BUFPT NOP PTR NOP USED AS LOCAL BLKLN NOP EXT# NOP STA BUFA SAVE BUFFER ADDRESS LDA FLAG,I GET THE BLOCK LENGTH WORD AND BLMSK MASK TO BITS 14 - 7 STA BLKLN SET THE BLOCK LENGTH JMP PRAM,I RETURN TO CALLER SKP * NX$EC COMPUTES THE ADDRESS OF THE NEXT SECTOR * FOR ALL READ/WRITE ACCESSES AND FOR * SEQUENTIAL POSITIONING. * * CALLING SEQUENCE: * * DLD RELATIVE BLOCK NO. * JSB NX$EC * DISCERR/EOF RETURN (ON EXTENDABLE FILES EODISC) * NORMAL RETURN * * NX$EC WRITES THE CURRENT SECTOR BUT DOES NOT * SET THE RELATIVE POSITION POINTERS * THE TARGET BLOCK IS READ. * IF RFLG$ IS NON 0. * * * NX$EC NOP DST SECOF SAVE THE RELATIVE BLOCK NUMBER CLA CONVERT BLOCKS (A BLOCK e­þúLDB BLKLN IS AN ENTIRE DCB JSB .DMP BUFFER IN THIS CASE) DEF SECOF TO LOGICAL SECTORS SWP ASR 6 SWP DST SECOF RELATIVE SECTOR OFFSET * CLE SET E TO INDICATE WRITE LDB DCB GO WRITE THE JSB R/W$ CURRENT BLOCK JMP NX$EC,I IF ERROR, RETURN P+1 * CLB LDA #SEC,I GET FILE SIZE IN +SECTORS OR -TRACKS SSA,RSS +SECTORS ALREADY? JMP NX1 YES CMA,INA NO - CONVERT LSL 8 TO SECTORS NX1 SWP GET TO A,B REGISTERS DST SIZE AND SAVE * LDA TR,I COMPUTE THE RELATIVE CMA,INA SECTOR ADDRESS IN ADA CTRK,I THE FILE MPY SEC/T,I SWP JSB .DAD (TR - CTRK)SEC/T + DEF SECOF RELATIVE SECTOR OFFSET DST SECOF * LDB SEC,I CMB,INB ADB CSEC,I CLA RELATIVE SECTOR OFFSET + SSB (TAKE INTO ACCOUNT THAT CCA THIS COULD BE NEGATIVE) JSB .DAD ((TR - CTRK)SEC/T) + (CSEC - SEC)) DEF SECOF DST SECOF * JSB .DDI DIVIDE BY FILE (EXTENT) SIZE DEF SIZE RELATIVE EXTENT IN A,B STB TMP1 SAVE IT (KNOW < 256 EXTENTS/FILE) JSB .DMP MANIPULATE TO GET REMAINDER DEF SIZE MULTIPLY BY SIZE AND JSB .DNG SUBTRACT FROM ORIGINAL JSB .DAD DIVIDEND. DEF SECOF A,B = SECOF - (SECOF/SIZE)*SIZE DST SECOF SAVE RELATIVE SECTOR OFFSET * SSA,RSS IF REMAINDER IS POSITIVE JMP NX2 THEN SKIP JSB .DAD CORRECT SECTOR DEF SIZE OFFSET IN FILE DST SECOF AND SAVE LDB TMP1 CORRECT THE ADB N1 EXTENT # STB TMP1 NX2 LDB TMP1 IF DIFFERENT SZB EXTENT GO GET JMP EXTND ITS ADDRESS * NX$E1 CLA COMPUTE ˆg LDB SEC,I THE NEW JSB .DAD TRACK AND DEF SECOF SECTOR SWP ADDRESS DIV SEC/T,I ADA TR,I STA CTRK,I SET THEM STB CSEC,I IN THE DCB * LDA RFLG$ IF READ FLAG IS CCE,SZA,RSS CLEARED THEN JMP NORD DON'T READ LDB DCB SET UP TO READ JSB R/W$ GO DO IT JMP NX$EC,I ERROR RETURN NORD ISZ NX$EC STEP TO P+2 JMP NX$EC,I AND RETURN * * * * * EXTND ADB EXT#,I ADD CURRENT EXTENT NUMBER LDA TYPE,I GET THE TYPE SSB,RSS IF EXTENT IS LESS THAN ZERO CPA .2 OR IF TYPE 2 THEN JMP SOF END OF FILE LDA B GO SET LDB DCB UP THE JSB RWND$ EXTENT JMP NX$EC,I ERROR RETURN JMP NX$E1 GO COMPUTE NEW TRACK\SECTOR ADDRESS SOF LDA N12 ELSE EOF JMP NX$EC,I RETURN * * BLMSK OCT 77600 N1 OCT -1 N12 DEC -12 * .2 DEC 2 * SECOF BSS 2 SIZE BSS 2 * A EQU 0 B EQU 1 * END EQU * * END Ìÿÿ ÿýH R ÿ92067-18144 1903 S C0122 &RWND$              H0101 €sþúASMB,R,L,C HED RWND$ * NAME: RWND$ * SOURCE: 92067-18144 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RWND$,7 92067-16125 REV.1903 780801 ENT RWND$ EXT EXEC,RMPAR ENT RFLG$ * * RWND$ IS A MODULE OF THE REAL TIME FILE * MANAGEMENT PACKAGE. IT IS INVOKED * TO SET OR RESET WORDS 11 THROUGH 16 * OF THE DCB. THE RECORD COUNT IS RESET IF EXTENT 0. * * CALLING SEQUENCE: * * LDA EXTENT# SET A TO DESIRED EXTENT * LDB DCB SET B TO DCB ADDRESS * JSB RWND$ CALL * JMP ERR ERROR EXIT (A=CODE) * --- NORMAL RETURN * SPC 3 TMP NOP TMP2 NOP RWND$ NOP ENTRY POINT STB DCB SAVE THE DCB INB ADDRESS STB TRACK FOR THE D.RTR CALL ADB .2 SAVE THE STB TMP TRACK ADDRESS STA TMP2 AND THE EXTENT ADB .12 INDEX TO THE EXTENT# CPA B,I IF SAME - CONTINUE JMP SETUP WITH SETUP LDA RFLG$ GET READ WRITE FLAG LDB .6 GET READ EXTENT OPEN REQUEST CODE SZA,RSS IF WRITE ADB .2 ADD TWO TO GET WRITE EXTENT OPEN REQUEST STB SET SET IT FOR CALL TO D.RTR JSB EXEC ELSE DEF *+8 CALL DEF .23 D.RTR DEF D.RTR TO DEF XEQT OPEN DEF SET THE DCB NOP EXTENT. TRACK NOP DEF TMP2 SPC 1 JSB RMPAR CALL RMPAR TO GET DEq0  F *+2 RETURN PARAMETERS DEF ERTN TO LOCAL AREA LDB AERTN LDA B,I ANY ERRORS? SSA FROM D.RTR? JMP RWND$,I YES; RETURN SPC 1 ADB .3 NO; STEP TO TRACK LDA B,I GET TRACK STA TMP,I SET IN DCB INB STEP TO SECTOR LDA B,I GET AND AND B377 MASK LDB TMP GET DCB ADDRESS INB SET STA B,I SECTOR IN DCB SETUP LDB TMP CLEAR THE WRITE FLAGS ADB .4 AND THEN SET THE LDA B,I DCB FROM THE TRACK AND MASK AND SECTOR WORDS. STA B,I ADB .3 LDA TMP,I SET JSB SET TRACK ISZ TMP AND LDA TMP,I SECTOR JSB SET WORDS. LDA B SET THE ADA .4 BUFFER JSB SET ADDRESS. LDA TMP2 GET EXTENT# ADB .2 SKIP JSB SET SET THE EXTENT # ISZ RWND$ STEP JMP RWND$,I AND RETURN SPC 3 SET NOP STA B,I SET THE WORD IN THE DCB INB STEP DCB ADDRESS JMP SET,I RETURN SPC 3 ERTN NOP NOP LOCAL STORAGE NOP RETURN PARAMETERS NOP FROM D.RTR NOP AERTN DEF ERTN .2 OCT 2 .3 OCT 3 .4 OCT 4 .6 DEC 6 .12 DEC 12 .23 DEC 23 B377 OCT 377 MASK OCT 177770 RFLG$ NOP GLOBAL READ WRITE FLAG D.RTR ASC 3,D.RTR XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END ™¡ ÿÿ ÿýIP ÿ92067-18145 1903 S C0122 &R/W$              H0101 9xþúASMB,R,L,C,Q HED R/W$ * NAME: R/W$ * SOURCE: 92067-18145 * RELOC: 92067-16125 * PGMR: G.A.A.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM R/W$,7 92067-16125 REV.1903 781214 EXT EXEC ENT R/W$ ENT D$XFR ENT D.R * * R/W$ WRITES THE CURRENT SECTOR BLOCK IF IT HAS * BEEN WRITTEN ON OR READS UNCONDITIONALLY. * * CALL SEQUENCE: * * SET E=0 FOR WRITE E=1 FOR READ * LDB DCB SET B TO DCB ADDRESS * JSB R/W$ * JMP DERR ERROR RETURN (A = -1) * NORMAL RETURN * R/W$ NOP STB RC SAVE THE DCB ADDRESS ADB .7 INDEX TO THE BLOCK SIZE LDA B,I FETCH THE BLOCK SIZE AND BLMSK MASK TO BITS 7-14 STB WOFLG SAVE ADDRESS OF THIS WORD ADB .9 INDEX TO DCB BUFFER STB BUFA SAVE IT'S ADDRESS LDB WOFLG,I GET WORD WITH WRITTEN ON FLAG SEZ,SLB,RSS CHECK READ\WRITE CODE AND WRITTEN-ON FLAG JMP EXIT JUMP IF WRITE AND WRITTEN ON FLAG NOT SET LDB RC GET THE DCB ADDRESS JSB D$XFR DO THE TRANSFER BUFA NOP JMP R/W$,I ERROR - RETURN LDB WOFLG,I GET THE WRITTEN-ON FLAG LDA RC GET WRITE OR READ REQUEST CODE CCE,SLA,RSS FOR WRITE CALL WANT TO CLEAR EOF CLE WRITTEN-ON FLAG AND IN-CORE FLAG EXIT RBR,RBR FOR READ CALL WANT TO CLEAR EOF AND RBR WRITTEN ON FLAG AND SET ELB,CLE,ELB IN CORE FLAG. CLE,ELB IF SKIPPED D$XFR (JMP EXIT) JUMP>rþúING STB WOFLG,I WITH E=0, B=WOFLG,I. WANT TO ISZ R/W$ CLEAR BOTH WRITTEN-ON AND JMP R/W$,I IN CORE FLAGS. SPC 2 .2 DEC 2 .7 DEC 7 .8 DEC 8 .9 DEC 9 * RC NOP TRACK NOP AT TRACK MUST BE TOGETHER SECT NOP AND SECTOR IN THIS ORDER LU NOP WOFLG NOP * B77 OCT 77 BLMSK OCT 77600 * * * DISC TRANSFER CALL SEQUENCE * * E=0 FOR WRITE * E=1 FOR READ * B= DCB ADDRESS * A= LENGTH (NO. OF WORDS) * JSB D$XFR CALL TO HERE * DEF BUFR BUFFER ADDRESS (MUST BE DIRECT) * JMP ERR ERROR RETURN (A=-1) * NORMAL RETURN SPC 2 D$XFR NOP ENTRY POINT STA LSAVE SAVE LENGTH CLA,SEZ,INA,RSS SET UP THE REQUEST CODE INA AND STA RC SET IT LDA B,I CONFIGURE THE CON WORD AND B77 ADA PRC STA LU ADB .8 GET THE NUMBER OF SECTORS PER TRACK STB #SC/T ADDRESS AND SAVE IT ADB .2 GET THE TRACK ADDRESS DLD B,I AND DST TRACK SAVE IT LDA D$XFR,I GET THE BUFFER ADDRESS STA BUF SAVE IT ISZ D$XFR STEP TO ERROR RETURN ADDRESS LDA B GET THE SECTOR ADDRESS TO A CMA,INA SET NEGATIVE AND NXTR ADA #SC/T,I CACULATE NUMBER OF WORDS LEFT ON THIS ASL 6 ON THIS TRACK STA #WORD SET FOR TRANSFER CMA,INA SET MAX COUNT NEGATIVE LDB LSAVE GET REMAINING COUNT ADA B AND SUBTRACT SSA IF LESS THAN REST OF TRACK STB #WORD RESET COUNT TO RIGHT NUMBER STA LSAVE SET REMAING WORDS FOR NEXT TIME JSB EXEC CALL EXEC TO DEF ERTS DEF RC WRITE/READ DEF LU FROM THE DISC BUF NOP AT THE SPECIFIED BUFFER DEF #WORD SIZE DEF TRACK TRACK AND DEF SE| CT SECTOR ERTS CCA SET UP FOR ERROR EXIT CPB #WORD ERROR? CLA,RSS NO ERROR SKIP JMP D$XFR,I ERROR RETURN ADB BUF UP DATE THE BUFFER STB BUF ADDRESS STA SECT SET THE SECTOR ADDRESS FOR NEW TRACK ISZ TRACK STEP THE TRACK ADDRESS LDB LSAVE GET THE REMAINING LENGTH CMB,SSB,INB,SZB CHECK IF ANY LEFT JMP NXTR NO CONTINUE XFER ISZ D$XFR END SO JMP D$XFR,I MAKE THE NORMAL RETURN SPC 2 LSAVE NOP #SC/T NOP #WORD NOP A EQU 0 B EQU 1 UNL PRC OCT 74000 LST D.R ASC 3,D.RTR SPC 1 END EQU * SPC 1 END ^Êÿÿ ÿýJR ÿ92067-18146 1940 S C0122 SPOPN0 SPOOL OPEN SUBROUTINES             H0101 ƒRþúASMB,R,Q,C HED SPOPN ROUTINE * NAME: SPOPN * SOURCE: 92067-18146 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SPOPN,7 92067-16125 REV.1940 790802 * * CHANGE: 780413 TO MAKE CROSS MAP ACCESS OF MP1 * IF IN A DMS ENVIRONMENT. (GL * ENT SPOPN * EXT .ENTR,EXEC,$OPSY * * THE FOLLOWING ROUTINE DOES A SETUP REQUEST * TO THE SMP AND PASSES THE BUFFER TO IT. * BUFFR BSS 1 LUNO BSS 1 * SPOPN NOP JSB .ENTR DEF BUFFR LDA BUFFR STA BUFR CLA STA CLASS JSB EXEC ALLOCATE CLASS NUMBER DEF *+8 DEF D20 DEF ZERO BUFR BSS 1 DEF D16 DEF ZERO DEF ZERO DEF CLASS LDA BUFFR,I SZA LDA B1717 STA BCHK JSB EXEC SCHEDULE SMP TO SET UP SPOOL FILE DEF *+6 DEF DS23 DEF SMPA DEF ZERO DEF CLASS DEF BCHK JMP ERM48 SMP PROGRAM NOT FOUND * LDA $OPSY FETCH OP SYS IDENT *780413* ARS POSITION DMS BIT TO BIT 0 *780413* SLA,RSS IF BIT 1 CLEAR (NOT DMS) *780413* JMP NDMS DO A STRAIGHT LOAD *780413* * XLA B,I ELSE, DO A CROSS MAP LOAD *780413* RSS TO FETCH RTN PARM *780413* NDMS LDA B,I FETCH RETURN PARM FROM SMP *780413* * SPOEX STA LUNO,I JMP SPOPN,I * ERM48 LDA M48 NO SPOOL FILES AVAILABLE JMP SPOEX EXIT * ZERO DEC 0 DS23 OCT 100027 D16 DEC 16 Aý  D20 DEC 20 M48 DEC -48 B1717 EQU 1717B CLASS BSS 1 BCHK BSS 1 SMPA ASC 3,SMP B EQU 1 * END ÖA ÿÿ ÿýKR ÿ92067-18147 1903 S C0122 &WRLG.              H0101 €þúASMB,R,L,C HED REAL-TIME, FMGR WRITE LOAD/GO DISK FILE * NAME: WRLG. * SOURCE: 92067-18147 * RELOC: 92067-16125 * PGMR: ???? * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM WRLG.,7 92067-16125 REV.1903 760622 ENT WRLG.,EFLG. EXT EXEC SPC 1 SPC 1 * PURPOSE: * THIS ROUTINE WRITES RELOCATABLE RECORDS ON DISK. SPC 1 * USES: * THIS ROUTINE IS USED BY FMGR TO WRITE THE RELOCATABLE * RECORDS ON A RTE * DISC BASED SYSTEM. * IN RTE SYSTEMS, THIS AREA IS CALLED THE * "LG" AREA. THE FORMAT ON DISC IS SAME AS PAPER TAPE FORMAT. SPC 1 * CALLED: * ASSEMBLY ONLY * JSB WRLG. (ALL INITIALIZATION DONE BY SYSTEM) * DEF *+4 * DEF BUFFR FIRST WORD ADDRESS OF WRITE BUFFER * DEF RLEN ADDRESS OF NUMBER OF WORDS TO WRITE * DEF PBUF ADDRESS OF A 128 WORD PACKING BUFFER * P+5 A = 0 IF NO ERROR ELSE ERROR * * ASSEMBLY ONLY * JSB EFLG. POST ANY PARTIAL RECORD IN MEMORY * DEF *+2 RETURN ADDRESS * P+2 A=0 IF NO ERROR ELSE ERROR SPC 1 * ERRORS: * THE PROGRAM WILL RETURN TO THE CALLING PROGRAM WITH * A,B= "IO06" ERROR IF THE "LG" AREA WAS NOT DEFINED, OR * A,B= "IO09" ERROR IF THE "LG" AREA OVERFLOWS. SPC 1 * NOTES: * "NAM" RELOCATABLE RECORDS MUST ALWAYS START ON A SECTOR BOUNDRY, * THEREFORE, WHENEVER AN "END" RELOCATABLE RECORD IS WRITTEN, THE * ENTRY POINT " EFL<%þúG. " MUST BE CALLED TO POST ANY PARTIAL RECORD * STILL IN MEMORY ONTO THE DISK. SPC 1 .WRIN NOP INIT2 STA BFWA SET THE BUFFER ADDRESS ON FIRST ENTRY CLA CLEAR FOR NEXT STA INIT2 ENTRIES LDA 1766B LGOC= CURRENT LOAD/GO CODEWORD LDB D2 SSA INB STB WLUN LUN=2 IF SIGN=0, =3 OTHERWISE ALF,ALF RAL AND O377 STA TRACK SET TRACK NO. LDA 1766B LGOC= CURRENT LOAD/GO CODE-WORD AND O177 STA B STA SECTR SET SECTOR NO. LDA DM128 SLB CHECK IF ODD SECTOR IN RTE ARS YES, DIVIDE SECTOR TO 64 WORDS STA BCOUN SECTOR-BUFFER COUNT = -64 CMA,INA SET THE SECTOR SIZE STA PSIZE MAY BE 64 OR 128 WORDS IF RTE LDA BFWA STA BFRAD SET SECTOR BUFFER ADDR = FWA BFR JMP .WRIN,I * *EFLG. OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR *ON DISK, UPDATES THE CURRENT SECTOR NO. *EFLG. IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT. SPC 1 EFLG. NOP LDA EFLG.,I GET RETURN ADD STA EFLG. AND SET IT CCA CHECK HOW MANY SECTORS TO POST ADA BCOUN ADA PSIZE A=# WORDS WRITTEN -1 IOR O77 MIRGE IN 63 SSA,INA CHECK IF ANY & BUMP JMP OKEX NONE, JUST RETURN * STA SSIZE EITHER 64 OR 128 LDB BCOUN IF NOT A WHOLE SECTOR CLA SZB STA BFRAD,I 0 FOR END OF SUBPROGRAM JSB EXEC WRITE SECTOR DEF *+7 DEF D2I CODE FOR WRITE DEF WLUN LUN BFWA NOP FWA OF BUFFER DEF SSIZE 64 OR 128 WORDS DEF TRACK TRACK NO DEF SECTR SECTOR NO JMP EFLG.,I RETURN IF ERROR * JSB .WRIN RE-INITIALIZE FOR NEXT WRITE OKEX CLA SHOW NO ERROR JMP EFLG.,I EXIT SPC 1 SSIZE NOP O77 OCT 77 O377 OCT 377 O177 OCT f_ 177 SPC 1 WRLG. NOP LDA WRLG.,I STA EXIT SET RETURN ADR ISZ WRLG. LDA WRLG. LDA A,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 STA WBFAD SOURCE-BUFFER FWA ISZ WRLG. LDA WRLG.,I LDA 0,I CMA,INA STA COUNT SET COUNT ISZ WRLG. STEP TO THE BUFFER ADDRESS LDA WRLG. GET TO A LDA A,I AND TRACK DOWN INDIRECTS RAL,CLE,SLA,ERA JMP *-2 * INIT JSB .WRIN CALL TO INIT CLA FIRST TIME ONLY STA INIT SET IT WMOVE LDA WBFAD,I STA BFRAD,I MOVE WORD ISZ BFRAD POINTERS ISZ BCOUN BUMP SECTOR-BUFFER COUNT JMP NOEND NOT END OF BUFFER * JSB EFLG. END OF BUFFER, WRITE SECTOR DEF *+1 SZA IF OK JUST CONTINUE JMP EXIT,I ELSE EXIT A,B = CODE * NOEND ISZ WBFAD BUMP ISZ COUNT BUMP COUNTER JMP WMOVE CONTINUE TRANSFER * CLA SHOW NO ERROR JMP EXIT,I READY, EXIT SPC 1 EXIT NOP RETURN ADDR PSIZE DEC 128 DM128 DEC -128 D2 DEC 2 D2I DEF 2,I WLUN NOP LUN TRACK NOP CURRENT TRACK NO SECTR NOP CURRENT SECTOR NO BFRAD NOP CURRENT ADDR IN WRITE-BUFFER WBFAD NOP CURRENT SOURCE-BUFFER ADDR COUNT NOP TRANSFER COUNT BCOUN NOP B EQU 1 A EQU 0 END * * ÆMÿÿ ÿýLT ÿ92067-18148 1903 S C0122 &J.PUT              H0101 lþúASMB,L,R,C HED J.PUT * NAME: J.PUT * SOURCE: 92067-18148 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM J.PUT,8 92067-16125 REV.1903 740801 ENT J.PUT EXT $LIBR,$LIBX EXT .ENTR * * J.PUT IS CALLED TO REQUEST A TRACK FOR THE FMGR * * THE CALL IS: * * CALL J.PUT(TAT1,CD,ER) * * W H E R E: * * TATA1 IS THE ADDRESS OF THE TAT WORD FOR THE DESIRED TRACK * CD IS THE CODE TO BE SET IN THE TAT. * ER IS 0 IF SUCCESSFUL OR NON-ZERO IF NOT. * * IF THE ERROR RETURN IS MADE NO TRACK WILL BE ASSIGNED. * * TATA1 NOP CD NOP ER NOP JPUT NOP JSB .ENTR DO ENTRY DEF TATA1 JSB $LIBR INHIBIT CHANGES NOP WHILE WE WORK LDB TATA1,I GET HIGH END OF TAT NEX LDA B,I GET CURRENT ASSIGNMENT SZA IF AVAILABLE CPA GLOBL OR GLOBAL CCA,RSS SKIP A _ -1 JMP EXIT ELSE ERROR RETURN LDA CD,I GET THE DESIRED CODE STA B,I SET IN TAT EXIT1 CLB SET B FOR GOOD ASSIGNMENT EXIT STB ER,I IT IS TRACK ON LU3 - SO SET IT JSB $LIBX EXIT DEF JPUT TO CALLER SPC 2 GLOBL OCT 77776 SPC 2 J.PUT EQU JPUT A EQU 0 B EQU 1 SPC 1 ENQ EQU * SPC 1 END ðÐ  ÿÿ ÿýMT ÿ92067-18149 1903 S C0122 &IPUT              H0101 ŽmASMB,R,B,L HED IPUT * NAME: IPUT * SOURCE: 92002-18149 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IPUT,6 92067-16125 REV.1903 740801 B EQU 1 ENT IPUT EXT $LIBR,$LIBX ADDR BSS 1 VALUE BSS 1 IPUT NOP JSB $LIBR NOP ISZ IPUT DLD IPUT,I DST ADDR ISZ IPUT ISZ IPUT LDA VALUE,I LDB ADDR,I STA B,I JSB $LIBX DEF IPUT END æÔÿÿ ÿýNT ÿ92067-18150 1903 S C0122 &FID.              H0101 XZSPL,L,O ! NAME: FID. ! SOURCE: 92067-18150 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME FID.(8) "92067-16125 REV.1903 780515" LET DR.RD BE SUBROUTINE,EXTERNAL LET READI BE CONSTANT(1) LET PK.DR,D.LT BE INTEGER,EXTERNAL ! FID.: FUNCTION (DS)GLOBAL !RETURNS FALSE IF A FILE SYSTEM !EXIST ON DISC WITH ID !DS LET NAM.. BE SUBROUTINE,EXTERNAL DR.RD(READI,DS,0)?[GO TO RETF] !READ THE DIRECTORY ! PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR3_[PDIR_@PK.DR]\ +3]+2]+1]+1]+1 DO[TX_$PDIR;$PDIR_TX AND 77777K] DO[NAM..(PK.DR);AREG_$0;$PDIR_TX]!CHECK ASC LABEL IF AREG THEN GOTO RETF !IF ILLEGAL OR FLAG IF TX>0 THEN GOTO RETF !NOT SET THEN NO FILE IF $(PDIR3 )<0 THEN GOTO RETF !IF LABEL WORD LESS THAN ZERO IF $(PDIR7 )-$(PDIR8 )-1 #$D.LT THEN GOTO RETF !LTR MAKE IF $(PDIR6 )<($(PDIR5) AND 377K) THEN GO TO RETF DO[FID.V_0; RETURN] RETF: DO[FID.V_1;RETURN] END ! END END$ óÿÿ ÿýOU ÿ92067-18151 1940 S C0122 FD.CK0 VALID DIRECTORY CHECKS             H0101 ZàþúASMB,R,L,C HED FD.CK * NAME: FD.CK * SOURCE: 92067-18151 * RELOC: 92067-16125 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FD.CK,7 92067-16125 REV.1940 790802 ENT FD.CK EXT XLUEX, .ENTR, NAM.. SUP * * * FD.CK READS THE CARTRIDGE SPECIFICATION ENTRY FROM THE * FILE DIRECTORY ON A DISC LU AND CHECKS TO SEE IF * THERE IS A REASONABLE FILE SYSTEM * * * CALLING SEQUENCE * * JSB FD.CK * DEF *+3 * DEF DS.LU WHERE DS.LU IS THE LU# OF THE DISC AND * (OPTIONAL) DEF LTR LTR IS THE TRACK ON DS.LU TO BE CHECKED * RETURN * * OR * * CALL FD.CK(DS.LU,LTR) * * IF LAST TRACK IS NOT SPECIFIED, THE LAST PHYSICAL TRACK ON * DS.LU (OBTAINED FROM AN IMPOSSIBLE WRITE) IS USED. * * * RETURNS FALSE (A=0) IF A FILE SYSTEM EXISTS ON THE DISC * RETURNS TRUE (A=1) IF THERE IS NOT A FILE SYSTEM OR IF * LAST TRACK SPECIFIED WAS OUT OF RANGE. ALSO RETURNS * FALSE IF EXEC READ ON THE LU IS REJECTED * * B-REG CONTAINS THE CRN IF THERE IS A FILE SYSTEM * * * DSLU NOP LTR DEF N1 FD.CK NOP JSB .ENTR DEF DSLU * LDA DSLU,I GET LU # CCE SET SIGN BIT ON LU FOR RAL,ERA EXTENDED EXEC CONTROL WORD STA CONWD SAVE 1ST WORD OF CONTROL WORD LDA PRC GET PRIVILEDGED BITS STA CONWD+1 AND USE AS SECOND HALF OF CONTROL WORD * LDA DSLU,I GET LU# PASSED IN CLE CP GþúA .2 CHECKING LU2? CCE,RSS YES - SET E AND GO TO SYSDS TO SET LTR CPA .3 CHECKING LU3? JMP SYSDS YES - E=0 AND GO TO SYSDS TO SET LTR * JSB XLUEX DO AN IMPOSSIBLE READ DEF *+7 ON DSLU TO GET THE DEF RDNAB NUMBER OF TRACKS ON THE DISC DEF CONWD DEF BUF DEF .1 DEF N1 DEF ZERO JMP FDCK0 ADB N1 SUBTRACT 1 DISC'S PHYSICAL SIZE LDA LTR,I GET LAST TRACK PARAMETER SSA WAS ONE SPECIFIED? LDA B NO - SO JUST USE LAST PHYSICAL TRACK CMB,INB MAKE SURE THAT LAST TRACK SPECIFIED ADB A IS NOT LARGER THAN LAST CMB,INB PHYSICAL TRACK ON DISC. SSB LAST TRACK SPECIFIED > LAST PHYSICAL TRACK? JMP FDCK0 YES - RETURN NO VALID FILE SYSTEM STA LTR NO - OK SO SAVE LAST TRACK * READ JSB XLUEX CALL EXEC TO READ 16-WORD CARTRIDGE DEF *+7 SPECIFICATION ENTRY FROM THE LAST DEF RDNAB TRACK, SECTOR 0 ON DSLU DEF CONWD ABUF DEF BUF DEF .16 DEF LTR DEF ZERO JMP FDCK0 * LDA BUF GET 1ST WORD OF SPECIF ENTRY RAL,CLE,ERA SPECIF FLAG INTO E-REG SEZ,RSS JMP FDCK0 IF FLAG WASN'T SET THEN NOT A VALID FILE SYSTEM STA BUF PUT BASK 1ST WORD LESS SIGN BIT JSB NAM.. LEGAL FMGR NAME? DEF *+2 DEF BUF SZA LEGAL? JMP FDCK0 NO LDA BUF+3 IF CRN IS NEGATIVE SSA THEN NOT A LEGAL JMP FDCK0 FILE SYSTEM LDA BUF+8 NUMBER TRACKS IN DIRECTORY CMA,INA (MADE POSITIVE) PLUS LOWEST DIRECTORY ADA BUF+7 TRACK LESS ONE MUST BE ADA N1 SAME AS LAST TRACK CPA LTR RSS ITS OK JMP FDCK0 NOT A VALID FILE SYSTEM LDA BUF+5 NEXT SECTOR CAN'T CMA,INA BE LARGER 2 THAN #SECTORS ADA BUF+6 PER TRACK SSA,RSS CLA,RSS THERE IS A FILE SYSTEM SO RETURN A=0 FDCK0 LDA .1 NO FILE SYSTEM SO RETURN A=1 LDB DEFN1 RESET OPTIONAL LAST STB LTR TRACK PARAMETER TO DEF TO ZERO LDB BUF+3 RETURN THIS DISC'S CRN JMP FD.CK,I RETURN * * SYSDS CLB,SEZ,RSS LU 3? ADB TATLG YES E=0 SO MUST BE LU 3 ADB TATSD LU 2 : LTR = C(TATSD) - 1 SEZ,RSS LU 3 : LTR = - C(TATSD) - C(TATLG) - 1 CMB,INB ADB N1 STB LTR SAVE LAST TRACK FOR EXEC CALL ADA PRC ADD PRIVILEDGED BITS TO LU STA DSLU AND SAVE FOR EXEC READ JMP READ * * * BUF BSS 16 CONWD BSS 2 * N1 DEC -1 RDNAB OCT 100001 ZERO NOP .1 DEC 1 .2 DEC 2 .3 DEC 3 .16 DEC 16 DEFN1 DEF ZERO * TATLG EQU 1755B TATSD EQU 1756B A EQU 0 B EQU 1 UNL PRC OCT 74000 LST * END ^ßÿÿ ÿýPX ÿ92067-18152 2001 S C0122 &MSC. CHECK MASTER SECURITY C             H0101 =ãSPL,L,O ! NAME: MSC. ! SOURCE: 92067-18152 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME MSC.(7) "92067-16125 REV.2001 790802" ! THIS ROUTINE CHECKS THE PASSED PARAMETER AGAINST THE ! SYSTEM MASTER SECURITY CODE ! LET D.RIO BE SUBROUTINE,EXTERNAL LET D.SDR BE INTEGER,EXTERNAL ! ! MSC.: FUNCTION(LST)GLOBAL ! ! RETURNS 1 IF GOOD 0 IF BAD ! D.RIO(1) !READ THE DIRECTORY OF DISCS IFNOT [T_$(@D.SDR+254)] THEN GO TO GOOD T_(T XOR 31178)+1 !UNMASK SYSTEM MASTER SECURITY CODE IF $(@LST+1)=T THEN [GOOD: RETURN 1] RETURN 0 END END END$ <¤ÿÿ ÿýQW ÿ92067-18153 1903 S C0122 &LOCK.              H0101 ~mSPL,L,O,T,M ! NAME: LOCK. ! SOURCE: 92067-18153 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME LOCK.(8) "92067-16125 REV.1903 781115" ! ! THIS ROUTINE OBTAINS A LOCK AND RELEASES IT ON THE ! GIVEN DISC ! LET MSS.,EXEC,RMPAR BE SUBROUTINE,EXTERNAL LET DS.DF,D.,OVRD. BE INTEGER,EXTERNAL LET BREG(5) BE INTEGER INITIALIZE A,B,XEQT TO 0,1,1717K ! ! LOCK.:SUBROUTINE(DSID,RQ,ERR)GLOBAL,FEXIT !ROUTINE TO REQUEST AND ! RELEASE DISC LOCKS LOCK: EXEC(23,D.,$XEQT,RQ+OVRD.,DSID) !CALL D.RTR TO GET THE LOCK RMPAR(BREG) IF BREG(1) THEN [ERR_BREG(1);\ !IF ERROR THEN SET ERROR RETURN FRETURN],\ ELSE ERR_0 DS.DF_0 !CORE COPY IF ANY IS WRONG NOW RETURN !ELSE GO NORMAL RETURN END END END$ €½ÿÿ ÿýRX ÿ92067-18154 1903 S C0122 &FM.UT              H0101 ‡xþúSPL,L,O,M ! NAME: FM.UT ! SOURCE: 92067-18154 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME FM.UT(8) "92067-16125 REV.1903 790515" ! LET EXEC,MSS.,RMPAR BE SUBROUTINE, EXTERNAL LET SESSN,ISMVE,FSTAT BE SUBROUTINE, EXTERNAL LET LUTRU BE FUNCTION, EXTERNAL LET D.RIO,DR.RD,DR.SU BE SUBROUTINE LET FM.AB BE LABEL,EXTERNAL LET MSC. BE FUNCTION ! CHECKS MAS SEC CODE LET IFLG. BE INTEGER,EXTERNAL ! FMGR INITIALIZATION? LET OVRD. BE INTEGER,EXTERNAL ! DISC ACCESS OVERRIDE LET PK.DR BE INTEGER(128),GLOBAL ! FILE DIRECT BUFFER LET D.SDR BE INTEGER(256),GLOBAL ! DISC DIRECT BUFFER LET DS.LU,D.LT,D.LB BE INTEGER,GLOBAL ! CUR DISC'S LU,LTR,CRN LET D. BE INTEGER,EXTERNAL ! D.RTR LET DS.DF,DS.F1 BE INTEGER,GLOBAL ! IN-CORE FLAGS LET DT(5) BE INTEGER ! RETURN PARMS ARRAY LET D.STR(2) BE INTEGER ! DATA TRACK ADDRESS LET USRID(2) BE INTEGER ! USER, GROUP IDS ! ASSEMBLE ["EXT $CL1";"EXT $CL2";"EXT $SMID"] ! INITIALIZE DS.DF,DS.F1 TO 0,0 LET READI BE CONSTANT(1 ) LET XEQT BE CONSTANT(1717K) LET TEMP BE CONSTANT(1721K) LET PRC BE CONSTANT(74000K) LET TATSD BE CONSTANT(µþú1756K) LET WRIT BE CONSTANT(2 ) LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! ! D.RIO:SUBROUTINE(RCODE) GLOBAL ! ! D.RIO READS/WRITES THE DISC DIRECTORY (256 WORDS) ! TO/FROM BUFFER D.SDR ! IF DS.DF THEN [IF RCODE = READI THEN RETURN]! CHECK IN-CORE FLAG ! ! GET TRACK AND SECTOR ADDRESS OF DISC DIRECTORY ! ASSEMBLE ["LDA $CL1";"STA CL1";"LDA $CL2";"STA CL2"] ! IFNOT IFLG. THEN[\ IF RCODE = WRIT THEN[\ ! USE D.RTR TO WRITE THE CL DR.SU(D.SDR,-65,100000K,7);\ GO TO DIR02]] ! DIRO: EXEC(RCODE,74002K,D.SDR,256,CL1,CL2)! WRITE/READ THE BLOCK BREG_$B ! IF TLOG # 256 THEN ERR IF BREG#256 THEN [MSS.(1001,2); GOTO FM.AB] ! DIR02:DS.DF_1 ! SET IN-CORE FLAG RETURN ! AND RETURN END ! ! DR.RD:SUBROUTINE(RCOD,DISID,BLK)FEXIT,GLOBAL ! ! THIS SUBROUTINE READS/WRITES THE DIRECTORY BLOCK SPECIFIED ! BY BLK FROM THE DISC IDENTIFIED BY DISID. FEXIT IS TAKEN ! IF THE DISC CANNOT BE FOUND OR IF THE END OF THE DIRECTORY ! IS REARCHED ! ! FRETURN IS TAKEN IF THE DISC IS NOT MOUNTED IN THE CL OR IF ! THE ID ON THE DISC DOES NOT MATCH THE 7777K OR THE CALLER'S ! PRIVATE OR GROUP ID OR IF THE DISC IS NOT IN CALLER'S SST. ! IF THE DISC IS NOT IN THE CALLER'S SST THE A-REG WILL BE 0 ! ON THE FRETURN. OTHERWISE THE A-REG WILL BE -1 ON THE FRETURN. ! THIS IS CHECKED BY DL.. ! ! ! ASSEMBLE ["LDA $SMID";"STA SMID"] NOABT _ 100000K ! IF DISID = DS.F1 THEN[\ ! DISC'S DL IN CORE & WRITING IF RCOD = WRIT THEN[\ ! BLOCK 0 SO SKIP READ IFNOT BLK THEN GO TO DIRR2];\ GO TO DRRD1] ! CALL SESSN($XEQT)?[USRID(1),USRID(2)_0;\ ! GET SESSION WORD GO TO DIR1] sþú BREG_$B ! IF NOT IN SESSION SKIP ISMVE CALL ISMVE(BREG,SMID,USRID,2) ! GET USER ID ! DIR1: D.RIO(READI) ! READ CARTRIDGE DIRECTORY ! ! SCAN CL AND COMPARE DISID TO LU OR CRN IN EACH ENTRY ! MAKE SURE THAT ID FOR ENTRY MATCHES EITHER PRIVATE ! GROUP OR SYSTEM ID. ! IF DISID>0 THEN GO TO DIR2 ! FOR I_0 TO 252 BY 4 DO[\ SID_($(@D.SDR+I+3));\ IF ($(@D.SDR+I) AND 377K) = -DISID THEN[\ IF ((USRID(1)=SID) OR (USRID(2)=SID) OR (7777K=SID)\ OR (USRID(1)=7777K)) THEN GO TO DIR0]] ! ! DIR2: FOR SMFLG_0 TO 1 DO[\ FOR I_0 TO 252 BY 4 DO[\ SID_($(@D.SDR+I+3));\ IF $(@D.SDR+I+2) = DISID THEN[\ IF ((USRID(1)=SID) OR (USRID(2)=SID) OR (7777K=SID)\ OR ((SMFLG=1) AND (USRID(1)=7777K))) THEN GO TO DIR0]]] ! .A._-1 GO TO EXITF ! DIR0: IF (LUTRU($(@D.SDR+I) AND 377K) # -1) THEN GO TO DIRR0 .A._0 EXITF:FRETURN ! EREX: MSS.(-1032,$DS.LU AND 377K) GOTO FM.AB ! ! THE DISID HAS BEEN FOUND SO READ IN BLK0 ! DIRR0:D.LB_[D.LT_[DS.LU_@D.SDR+I]+1]+1 ! SET POINTERS TO CRN,LTR,LU ! DIRR6:IF RCOD=WRIT THEN[\ ! IF WRITING BLK 0, SKIP IFNOT BLK THEN GO TO DIRR2] ! FURTHER READ OF DIRECTORY EXEC(NOABT+READI,($DS.LU AND 377K)+PRC,PK.DR,128,$D.LT,0) GOTO EREX ! DRIVER REJECTED CALL. BREG_$B IF BREG#128 THEN[\ MSS.(1001,$DS.LU AND 377K);\ GO TO FM.AB] ! DIRR2:DS.F1_DISID ! SET UP DISC ID, DISBL_0 ! THE CURRENT BLOCK, DISNT_$(@PK.DR+8) ! THE # OF DIRECTORY TRACKS, DS.SC_$(@PK.DR+6)AND 377K ! NUMBER OF SECTORS, ! IF (BLK=0) AND (RCOD=READI) THEN GO TO EXIT ! ! CALCULATE THgGþúE SECTOR ADDRESS ! DRRD1:TR_(BLK*14)/DS.SC T_$1 ! SAVE IN T TR_TR/7 IF (TR+DISNT)> -1 THEN[\ .A._-1;\ GO TO EXITF] TR_$D.LT-TR ! SAVE TRACK ADDRESS IN TR ! ! READ/WRITE ! IFNOT IFLG. THEN[\ ! USE D.RTR TO WRITE DL SECTOR IF RCOD = WRIT THEN [\ ! IF WRITING AND NOT FMGR DR.SU(PK.DR,DISID,BLK,9);\ ! INITIALIZATION GO TO EXIT]] ! DRRD4:EXEC(NOABT+RCOD,PRC+($DS.LU AND 377K),PK.DR,128,TR,T) GOTO EREX ! DRIVER REJECTED CALL BREG_$B ! TEST FOR ERRORS IF BREG#128 THEN[\ MSS.(1001,$DS.LU AND 377K);\ GO TO FM.AB] ! EXIT: RETURN END ! ! DR.SU:SUBROUTINE(BUF,ID,RS,CD) ! ! THIS ROUTINE WRITES ON THE DISC DIRECTORY BY: ! CALLING THE SYSTEM FOR ONE TRACK ! WRITING THE SECTOR THERE ! PASSING THE TRACK TO D.RTR ! RETURNING THE TRACK ! ! IT WRITES A SECTOR ON THE FILE DIRECTORY BY ! CALLING D.RTR PASSING THE 128 WORD SECTOR ! USING STRING PASSAGE ! IF CD#7 THEN[\ STBUF_@PK.DR;\ ! PASS BUFFER PK.DR AS A 128 L_128;\ ! WORD STRING; SKIP DATA TRACK GO TO DRSU2],\ ! STUFF ELSE[\ STBUF_@D.STR;\ ! DATA TRACK WITH ADDRESS IN L_2] ! IN D.STR EXEC(4,1,TR,LU,FLG) ! GET SYSTEM TRACK DO[D.STR(1)_LU; D.STR(2)_TR] ! SAVE ITS ADDRESS IN ARRAY ! DRSU0:EXEC(2,LU,BUF,256,TR,0) ! WRITE THE SECTOR BREG_$B IF BREG#256 THEN[\ MSS.(1001,LU);\ GO TO FM.AB] ! DRSU2:EXEC(23,D.,$XEQT,CD+OVRD.,ID,RS,0,$STBUF,L) ! CALL D.RTR TO WRITE THE SECT IF CD=7 THEN E¶XEC(5,1,TR,LU) ! RETURN THE TRACK RMPAR(DT) IF DT(1) THEN [MSS.(DT);GO TO FM.AB] ! IF ERRORS ABORT RETURN END END END$ V™ÿÿ ÿýS ] ÿ92067-18155 1903 S C0122 &OVRD.              H0101 €ASMB,R,L HED SESSION MONITOR CARTRIDGE SEARCH OVERRIDE * NAME: OVRD. * SOURCE: 92067-18155 * RELOC: 92067-16125 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OVRD.,7 92067-16125 REV.1903 780526 ENT OVRD. CARTRIDGE SEARCH OVERRIDE WORD * OVRD. NOP CARTRIDGE SEARCH OVERRIDE WORD * * * * SESSION MONITOR CARTRIDGE SEARCH OVERRIDE WORD: * * IF OVRD. = 0 SEARCH USER'S PRIVATE AND GROUP CARTRIDGES * ONLY (NO OVERRIDE) * IF BIT 13 = 1 SEARCH SYSTEM CARTRIDGES ONLY (EVEN IF BIT 14=1) * (SM,ME) * IF BIT 14 = 1 SEARCH USER'S PRIVATE AND GROUP CARTRIDGES, * THEN SEARCH SYSTEM CARTRIDGES (TR) * IF BIT 15 = 1 SEARCH ALL CARTRIDGES IN THE ORDER THEY APPEAR * IN THE SYSTEM CARTRIDGE DIRECTORY (SPOOL) * * NOTE: FOR THE SESSION MONITOR SYSTEM MANAGER, THE VALUE OF OVRD. IS * IGNORED BY THE CARTRIDGE SEARCH ALGORITHM. * * WHEN SETTING OR RESETTING THE OVERRIDE WORD, BE SURE TO KEEP THE * OTHER BITS IN THE WORD INTACT! * (E.G., SM & ME COMMANDS MUST NOT CHANGE BIT 14, WHICH TR COMMAND USES) * * END ÿÿ ÿýTZ ÿ92067-18156 1903 S C0122 &ICAPS              H0101 zþúASMB,R,L,C HED "ICAPS" ROUTINE TO GET THE CURRENT SESSION'S CAPABILITY * NAME: ICAPS * SOURCE: 92067-18156 * RELOC: 92067-16125 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ICAPS,7 92067-16125 REV.1903 781213 ENT ICAPS EXT SESSN DETERMINES IF PROGRAM IS IN SESSION EXT $SMVE MOVES DATA TO/FROM SESSION CONTROL BLOCK (SCB) EXT $SMCA CAPABILITY WORD OFFSET IN SCB SPC 1 * * ROUTINE TO OBTAIN THE CURRENT SESSION'S CAPABILITY LEVEL * * CALLING SEQUENCE: ICAP=ICAPS(DUMMY) * ICAP=SESSION'S CAPABILITY LEVEL * =0 IF CALLING PROGRAM NOT IN SESSION * * METHOD: THIS ROUTINE FIRST DETERMINES IF THE CALLING PROGRAM IS * IN SESSION MODE. IF IT IS, THE CAPABILITY WORD FROM THE * SESSION CONTROL BLOCK IS RETRIEVED AND RETURNED AS THE * VALUE OF ICAPS. * SPC 1 ICAPS NOP ENTRY JSB SESSN DETERMINE IF PROGRAM IS IN SESSION DEF *+2 DEF XEQT ID SEGMENT ADDRESS OF CURRENT PROGRAM SEZ IN SESSION? JMP NSESN NO, SET ICAPS=0 STB ISESN YES, SAVE SESSION WORD FROM SESSN JSB $SMVE MOVE CAPABILITY WORD FROM SCB DEF *+6 DEF .1 READ DEF ISESN ID SEGMENT SESSION WORD DEF $SMCA CAPABILITY WORD OFFSET IN SCB DEF ISESN RETURN CAPABILITY LEVEL HERE DEF .1 NUMBER OF WORDS TO MOVE = 1 LDA ISESN RETURN ICAPS=CAPABILITY LEVEL RSS NSESN CLA RETURN ICAPS=0 (NON-SESSION) LDB Xo  ICAPS,I GET THE RETURN ADDRESS JMP B,I RETURN SPC 1 .1 DEC 1 XEQT EQU 1717B ID SEGMENT ADDRESS OF CURRENT PROGRAM ISESN NOP A EQU 0 B EQU 1 END ”g ÿÿ ÿýU\ ÿ92067-18157 1903 S C0122 &CREA.              H0101 {fSPL,L,O,M ! NAME: CREA. ! SOURCE: 92067-18157 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! DATE: 780907 ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CREA.(8) "92067-16125 REV.1903 781102" LET CLOS.,ECREA BE SUBROUTINE,EXTERNAL LET .E.R. BE INTEGER,EXTERNAL LET ISIZE(4) BE INTEGER CREA.:SUBROUTINE(DCBR,LUR,PPLIS) GLOBAL,FEXIT CLOS.(DCBR) !CLOSE CURRENT FILE IF OPEN IF LUR <64 THEN FRETURN DCB3_[DCB2_[DCB1_@PPLIS+1]+1]+1 ISIZE(2)_$(@PPLIS+3) IF ISIZE(2) < 0 THEN ISIZE(1)_-1,\ ELSE ISIZE(1)_0 ISIZE(3)_0 ISIZE(4)_$(@PPLIS+4) ECREA(DCBR,.E.R.,LUR,ISIZE,$DCB2,PPLIS,$DCB1) IF .E.R. => 0 THEN \ $DCB3_$(@DCBR+5) RETURN END END END$ ª±ÿÿ ÿýV\ ÿ92067-18158 1903 S C0122 &CK.SM              H0101 ‡nSPL,L,O ! NAME: CK.SM ! SOURCE: 92067-18158 ! RELOC: 92067-16125 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CK.SM(7) "92067-16125 REV.1903 771205" ! CK.SM:SUBROUTINE(BF,TYP)GLOBAL,FEXIT !CHECKSUM ROUTINE ! ! A CHECKSUM IS DONE ON BUFFER BF FOR ! RECORD TYPE TYP(1=RELOCATABLES, 0=>ABS) ! FEXIT IF BAD CHECKSUM ! IF [TT_BF-<8]>377K OR TT<0 THEN GO TO RTNF DO[CSS_$(@BF+2);CS_$(@BF+1)] !INITIALIZE CHECKSUM IF TYP THEN BFBP_ -1,ELSE[\ !SET OFFSET AND IF ABS BFBP_1;CS_CSS+CS] !ADD WD THREE TO CS CLN_TT +@BF+BFBP !SET LAST WORD ADDRESS AND IFNOT TYP THEN CSS_$(CLN+1) !IF ABS. SET CHECKSUM FOR BFPT_@BF+3 TO CLN DO[CS_CS+$BFPT] !SUM IF CS=CSS THEN RETURN !CHECK & RETURN RTNF: FRETURN END END END$ !»ÿÿ ÿýW] ÿ92067-18159 1903 S C0122 &CK.ID              H0101 ~eþúASMB,R,L HED CHECK ID ROUTINE * NAME: CK.ID * SOURCE: 92067-18159 * RELOC: 92067-16125 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CK.ID,7 92067-16125 REV.1903 780403 ENT CK.ID EXT .ENTR,$OPSY * * THIS ROUTINE VALIDATES AN ID SEGMENT ADDRESS. * * CALLING SEQUENCE: JSB CK.ID * DEF *+2 * DEF ID ID SEGMENT ADDRESS * * RETURN: E=0 VALID ID SEGMENT ADDRESS * E=1 INVALID ID SEGMENT ADDRESS * ID NOP CK.ID NOP JSB .ENTR DEF ID LDA ID,I FETCH ID SEGMENT ADDRESS SZA,RSS ZERO? JMP CKID1 YES LDB $OPSY OP SYSTEM IDENTIFIER ERB,ERB GET MAPPED BIT TO E LDB KEYWD MAKE SURE THE ADDRESS POINTS STB IADDR TO A VALID ID SEGMENT NEXT SEZ MAPPED SYSTEM? JMP XLOAD YES, CROSS LOAD OF IDSEG ADDRESS LDB IADDR,I NO, DIRECT LOAD OF IDSEG ADDRESS TEST CPB 0 DOES IT MATCH THIS ONE? JMP CKID2 YES, ITS VALID ISZ IADDR NO, TRY THE NEXT ONE SZB END OF KEYWORD BLOCK? JMP NEXT NO, CONTINUE CKID1 CCE,RSS INVALID ID SEGMENT ADDRESS CKID2 CLE VALID ID SEGMENT ADDRESS JMP CK.ID,I RETURN * XLOAD XLB IADDR,I NEXT IDSEG ADDR FROM KEYWORD BLOCK JMP TEST CONTINUE * KEYWD EQU 1657B IADDR BSS 1 * END ±#  ÿÿ ÿýX_ ÿ92067-18161 1903 S C0122 &WRIS$              H0101 ‡uþúASMB,R,L,C HED WRIS$ * NAME: WRIS$ * SOURCE: 92067-18161 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM WRIS$,7 92067-16125 REV.1903 740801 ENT WRIS,IWRIS,WEOFS EXT %WRIS,%WRIN,%WEOF EXT .ENTR * THIS ROUTINE IS USED TO CALL THE WRITE SOURCE ROUTINE * FROM A FORTRAN PROGRAM * INITILIZE CALL * CALL IWRIS(IER) IER=0 IF OK -1 IF NO TRACKS * WRITE CALL * CALL WRIS(BUF,L,ER) BUFFER ,LENGTH(-CHARACTERS),ER SAME AS ABOVE * TERMINATE CALL * CALL WEOFS SPC 3 BUF NOP L NOP ER NOP WRIS NOP JSB .ENTR DEF BUF LDA BUF GET THE BUFFER ADDRESS STA BA SET IF FOR THE CALL LDA L,I GET THE LENGTH STA L SET IT JSB %WRIS CALL TO TRANSFER DEF RT BA NOP DEF L CCA,RSS NO TRACK RETURN RT CLA NORMAL RETURN STA ER,I SET ERROR CODE JMP WRIS,I RETURN SPC 2 IER NOP IWRIS NOP JSB .ENTR DEF IER JSB %WRIN MAKE INITILIZE CALL CCB,RSS NO DISC RETURN CLB OK RETURN STB IER,I SET ERROR CODE JMP IWRIS,I RETURN SPC 3 WEOFS NOP JSB %WEOF WRITE THE END OF FILE LDA WEOFS,I GET THE RETURN ADDRESS JMP A,I RETURN SPC 2 A EQU 0 B EQU 1 END bÕ  ÿÿ ÿýY` ÿ92067-18162 1940 S C0122 CNT.0 CONTROL COMAND SUBROUTINE             H0101 ¡6þúSPL,L,O ! NAME: CNT. ! SOURCE: 92067-18162 ! RELOC: 92067-16125 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CNT.(8) "92067-16125 REV.1940 790802" ! ! ! THE FOLLOWING IMPLEMENTS THE CONTROL COMMAND. ! ! :CN [[[,NAMR][,FUNCTION][,SUB-FUNCTION]]] ! LET OPEN., \OPEN FILE OR LU FCONT, \SEND CONTROL FUNCTION EXEC \SYSTEM I/O BE SUBROUTINE,EXTERNAL ! LET O.BUF, \DCB BUFFER .E.R., \GLOBAL ERROR RETURN N.OPL \SUB-PARAMETER STORAGE BE INTEGER,EXTERNAL ! LET PTR,EQWD5,NAMR,FUNC,FUNCT BE INTEGER LET SUBF,SUBFN,FTAB,FTAB1 BE INTEGER LET FTAB2 BE INTEGER (3) LET FTAB3 BE INTEGER LET FTAB4 BE INTEGER (9) LET FTAB5,FTAB6 BE INTEGER ! INITIALIZE FTAB,FTAB1,FTAB2,FTAB3,FTAB4,FTAB5,\ FTAB6 TO "RW",400K,"EO",100K,"TO",1100K, \ "FF",1300K,"BF",1400K,"FR",300K,"BR",200K, \ "LE",1000K,0 ! ! CNT.: SUBROUTINE(NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER SUBFN _ [SUBF _ [FUNCT _ [FUNC _ \SET UP POINTERS [NAMR _ @PLIST + 1] + 3] + 1] \AND, IF NECESSARY, + 3] + 1 IFNOT PLIST THEN $NAMR _ 8 !THE DEFAULT FOR NAMR. CALL OPEN.(O.BUF,$NAMR,N.OPL,10K) !OPEN THE FILE OR LU. IF .E.R. THEN GO TO ERR20 !NON TYPE-ZERO CHECK IFNOT $FUNC Tó  HEN GOTO DEFLT !WAS FUNCTION SUPPLIED? IF $FUNC = 3 THEN GOTO DCODE !FUNCTION SUPPLIED. IF FUNC _ $FUNCT <- 6 !NUMERIC, SHIFT TO GOTO SUBFU !PROPER POSITION. DCODE: NAMR _ @SUBF !IF ASCII, DECODE IT. TLOOP: IFNOT $[NAMR _ NAMR + 2] THEN [ \END OF TABLE? PRMER: ERR _ 56; RETURN] !PARAMETER ERROR. IF $FUNCT # $NAMR THEN GOTO TLOOP !MATCH? FUNC _ $(NAMR+1) !YES - GET FUNCTION CODE. SUBFU: IFNOT $SUBF THEN $SUBFN _ -2 !DEFAULT SUBFN IF NEC. CALL FCONT(O.BUF,ERR,FUNC,$SUBFN) !SEND THE CONT. FUNC. IF ERR = -12 THEN ERR _ 0 RETURN DEFLT: PTR _ @O.BUF + 3 !FUNCTION NOT SUPPLIED. CALL EXEC(100015K,$PTR,EQ5,NAMR,FUNC)!GET DEVICE TYPE. GO TO ERR20 !BAIL OUT IF ERROR ( NEVER HAPPEN) IF [EQ5 _ EQ5 AND 37400K] > 7000K THEN [ \IF TYPE > 16 RWCD: FUNC_FTAB1; GOTO SUBFU ] !USE REWIND IF EQ5 = 2400K THEN[ \IF DVR05 CHECK IF [FUNC _ FUNC AND 7] = 1 THEN GO TO RWCD; \IF CASSET USE REWIND IF FUNC = 2 THEN GO TO RWCD] !IF CASSET USE REWIND FUNC_$(PTR+1) !ELSE USE DEFAULT EOF GO TO SUBFU ! ERR20: ERR _ 20; RETURN !ILLEGAL LU ERROR. END END END$ °c ÿÿ ÿýZa ÿ92067-18163 1903 S C0122 &BUMP.              H0101 ‰nASMB,R,L HED BUMP ROUTINE * NAME: BUMP * SOURCE: 92067-18163 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM BUMP.,8 92067-16125 REV.1903 741025 ENT BUMP. EXT $BATM,.ENTR A EQU 0 * T1 NOP T2 NOP BUMP. NOP JSB .ENTR FETCH PARAM ADDRS DEF T1 * LDA T1 INA STA T3 SAVE ADDR OF SECOND WORD DLD $BATM FETCH BATCH TIME CMA,CLE,INA COMPLEMENT CMB,SEZ CLE,INB CLE SET UP FOR NEXT ADD ADA T2,I SUBTRACT FROM PREVIOUS TIME ISZ T2 TO GET ELAPSED TIME SEZ,CLE INB ADB T2,I CMA,CLE,INA COMPLEMENT CMB,SEZ A DOUBLE INTEGER CLE,INB CLE SET UP FOR NEXT ADD ADA T1,I SUBTRACT FROM TIME LIMIT SEZ TO GET TIME LIMIT LEFT. INB ADB T3,I DST T1,I RETURN NEW LIMIT TO CALLER JMP BUMP.,I * T3 NOP * BSS 0 SIZE OF BUMP. END ³»ÿÿ ÿý[a ÿ92067-18164 1903 S C0122 &SET.T              H0101 X¬ASMB,R,L HED SET.T ROUTINE * NAME: SET.T * SOURCE: 92067-18164 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SET.T,8 92067-16125 REV.1903 740801 ENT SET.T EXT $LIBR,$LIBX,.ENTP,$BATM SUP * NT NOP OT NOP SET.T NOP JSB $LIBR PRIVILEGED SUBROUTINE NOP JSB .ENTP FETCH PARAM ADDRS DEF NT LDA XEQT IF NOT IN BATCH ADA D20 THEN LDA A,I DO NOT SET UP SSA,RSS BATCH FLAG SET? JMP EX NO * DLD $BATM FETCH BATCH TIME DST OT,I RETURN IT AS OLD TIME DLD NT,I FETCH NEW TIME DST $BATM SET AS NEW BATCH TIME EX JSB $LIBX DEF SET.T RETURN. * D20 DEC 20 XEQT EQU 1717B A EQU 0 B EQU 1 BSS 0 SIZE OF SET.T END Îÿÿ ÿý\b ÿ92067-18165 1903 S C0122 &TL.              H0101 RSASMB,R,L HED TL ROUTINE * NAME: TL. * SOURCE: 92067-18165 * RELOC: 92067-16125 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM TL.,8 92067-16125 REV.1903 760322 ENT TL. EXT TL.P,$BATM A EQU 0 * TL. NOP FUNCTION FALSE IF DLD TL.P $BATM < TL.P < 0 SSB,RSS OR IF TL.P < 0 AND $BATM > 0. JMP TEXIT LDA D$BA GET DIRECT ADDRESS RAL,CLE,SLA,ERA FOR SECOND WORD LDA A,I BATCH TIMER. INA STA T2 SAVE IT. LDB T2,I IF $BATM IS > 0 THEN SSB,RSS EXIT FALSE. JMP FEXIT DLD TL.P CMA,CLE,INA DO A COMPARISON CMB,SEZ OF $BATM AND TL.P INB REMEMBERING THAT BOTH ADA $BATM ARE DOUBLE WORD SEZ INTEGERS. INB ADB T2,I SSB FEXIT CLA,RSS EXIT FALSE. TEXIT CCA EXIT TRUE (-1). JMP TL.,I * D$BA DEF $BATM T2 NOP * END ‹¦ÿÿ ÿý]c ÿ92067-18166 1903 S C0122 &ST.TM              H0101 ASMB,R,L HED ST.TM ROUTING * NAME: ST.TM * SOURCE: 92067-18166 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM ST.TM,8 92067-16125 REV.1903 741223 ENT ST.TM EXT .ENTR A EQU 0 * * THE FOLLOWING ROUTINE SETS UP THE BATCH * TIME VALUES FOR :JO. * HOUR NOP MIN NOP * ST.TM NOP JSB .ENTR DEF HOUR LDA MIN CLE,INA LDA A,I FETCH NUMBER OF 10'S OF MPY D100 MILLISECONDS AND HOLD IT. STA SEC LDA HOUR,I GET NUMBER OF MINUTES MPY D60 ADA MIN,I AND MULTIPLY TO GET 10'S OF MPY D6000 MILLISECONDS. ADA SEC ADD TO PREVIOUS VALUE. SEZ COMPENSATE FOR DOUBLE WORD INB INTEGER. CMA,CLE,INA COMPLEMENT AND INCREMENT THE CMB,SEZ,CCE DOUBLE WORD INTEGER. INB RBL,ERB SET SIGN IN ANY CASE JMP ST.TM,I RETURN TIME IN A AND B * D100 DEC 100 D60 DEC 60 D6000 DEC 6000 SEC NOP * BSS 0 SIZE OF ST.TM END ÷3ÿÿ ÿý^d ÿ92067-18167 1903 S C0122 &B.FLG              H0101 b€ASMB,R,L HED B.FLG ROUTINE * NAME: B.FLG * SOURCE: 92067-18167 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM B.FLG,8 92067-16125 REV.1903 741118 ENT B.FLG * EXT $LIBR,$LIBX,.ENTP * PARAM NOP * B.FLG NOP JSB $LIBR NOP JSB .ENTP DEF PARAM LDB XEQT IF NOT FMGR ADB D12 THEN DO NOT SET LDA B,I THE FLAG CPA "FM" FIRST WORD CHECK INB,RSS OK SKIP JMP EX BAD NEWS * LDA B,I GET NEXT WORD CPA "GR" OK? INB,RSS YES SKIP JMP EX NO EXIT * LDA B,I GET LAST WORD AND C377 MASK TO HIGH ONLY CPA BL MAKE IT? RSS YES SKIP JMP EX NO EXIT * LDB PARAM,I LDA XEQT ADA D20 STA PARAM LDA PARAM,I IOR MASK SZB,RSS XOR MASK STA PARAM,I EX JSB $LIBX DEF B.FLG * MASK OCT 100000 D12 DEC 12 C377 OCT 177400 "FM" ASC 1,FM "GR" ASC 1,GR BL OCT 20000 A EQU 0 B EQU 1 D20 DEC 20 XEQT EQU 1717B * END º6ÿÿ ÿý_e ÿ92067-18168 1903 S C0122 &LULU.              H0101 “wþúASMB,R,L HED LULU ROUTINE * NAME: LULU. * SOURCE: 92067-18168 * RELOC: 92067-16125 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LULU.,6 92067-16125 REV.1903 780915 ENT LULU. * EXT .ENTP,$LUSW,$LIBR,$LIBX,.DRCT,S.CAP * * CHANGE RECORD: * * 780915 TO DO NOTHING IF FMGR IS IN SESSION MODE (GAA) * * THE FOLLOWING ROUTINE MANIPULATES THE * BATCH LU TRANSFORM TABLE. * LU1 BSS 1 LU2 BSS 1 * LULU. NOP JSB $LIBR NOP JSB .ENTP DEF LU1 LDA S.CAP GET THE SESSION CAPABILITY FLAG SZA IF ZERO THEN NOT IN SESSION JMP OKOUT IN SESSION TAKE NORMAL RETURN * STA ADDR JSB .DRCT DEF $LUSW STA 1 LDA 1,I GET SIZE OF TABLE CMA,INA AND FORM COUNTER. STA CNTR INB LDA LU1,I SZA,RSS IS LU1 ZERO? JMP RESET YES. GO RESET THE TABLE. LOOP1 LDA 1,I SEARCH THE TABLE FOR (LU1-1). SSA KEEP TRACK OF EMPTY ENTRIES. STB ADDR SAVE ADDRESS OF EMPTY ENTRY. AND B377 INA CPA LU1,I JMP GOTIT HAVE IT. INB ISZ CNTR JMP LOOP1 LDB ADDR DO WE HAVE AN EMPTY ENTRY? SZB,RSS JMP OUT NO. NO ROOM. GOTIT LDA LU2,I WAS THIS A CLEAR REQUEST? CPA CLR IF THE CLEAR CODE '- ' CCA,RSS THEN SET TO -1 AND SKIP JMP SET NO. JMP DEP * SET LDA LU1,I ADA M1 ALF,ALF PUT THE NEW LU TRANSFORM XOR LU2,I INTO°   THE TABLE. ADA M1 ALF,ALF DEP STA 1,I OKOUT ISZ LULU. OUT JSB $LIBX DEF LULU. RESET CCA RESET LU TABLE TO STANDARD STA 1,I DEVICES BY CLEARING THE ENTRIES. INB ISZ CNTR JMP RESET JMP OUT-1 * B377 OCT 377 ADDR BSS 1 CNTR BSS 1 M1 DEC -1 CLR ASC 1,- * END ÒD ÿÿ ÿý`g ÿ92067-18169 1903 S C0122 &RANGE              H0101 r–ASMB,R,L HED RANGE ROUTINE * NAME: RANGE * SOURCE: 92067-18169 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RANGE,8 92067-16125 REV.1903 740801 ENT RANGE * EXT .ENTR * FNUM NOP BUFR NOP * RANGE NOP JSB .ENTR DEF FNUM LDB FNUM,I LDA BUFR,I ALF,ALF ADA BUFR,I AND B377 CMA,INA ADA FNUM,I ISZ BUFR SSA JMP *+3 ISZ BUFR JMP RANGE+4 LDA BUFR,I JMP RANGE,I * B377 OCT 377 * END !Èÿÿ ÿýag ÿ92067-18170 1903 S C0122 &ONOFF              H0101 u–þúASMB,R,L HED ONOFF ROUTINE * NAME: ONOFF * SOURCE: 92067-18170 * RELOC: 92067-16125 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ONOFF,8 92067-16125 REV.1903 750128 ENT ONOFF,FIT. * EXT .ENTR,CONV.,EXEC,J.NAM,.DRCT EXT OPEN.,WRITF,O.BUF,TMP.,.DFER * * JNAME BSS 1 TMVAL BSS 1 * ONOFF NOP JSB .ENTR DEF JNAME LDB JNAME,I SZB,RSS JMP OFFM JSB .DFER DEF JOBM+4 DEF JNAME,I JSB .DFER DEF J.NAM DEF JNAME,I LDA MONTH+2 STA ONOFM+1 LDA ON STA ONOFM+2 JMP CONVT OFFM JSB .DFER DEF JOBM+4 DEF J.NAM LDA OFF LDB OFF+1 STA ONOFM+1 STB ONOFM+2 CONVT LDA TMVAL ADA D3 STA SAVE JSB CONV. CONVERT HOURS. DEF *+4 DEF SAVE,I DEF TMES1 DEF D2 LDA TMVAL ADA D2 STA YEAR JSB CONV. DEF *+4 DEF YEAR,I DEF SAVE DEF D2 JSB .DRCT DEF TMES1+1 LDB SAVE JSB FIT. LDA TMVAL INA STA SAVE JSB CONV. DEF *+4 DEF SAVE,I DEF TMES2+1 DEF D2 JSB CONV. DEF *+4 DEF TMVAL,I DEF SAVE DEF D2 JSB .DRCT DEF TMES3 LDB SAVE JSB FIT. LDA TMVAL ADA D5 STA SAVE LDB 0,I CHECK FOR LEAP YEAR. CLE,ERB LDA RYTAB SEZ,SLB,RSS LDA LYTAB GET CORRECT TABLE ADDRESS. STA DAY JSB CONV. COþúNVERT YEAR TO ASCII. DEF *+4 DEF SAVE,I DEF YEAR+1 DEF D4 LDA TMVAL ADA D4 STA SAVE CLB LOOP LDA DAY,I FIGURE OUT MONTH. SZA,RSS JMP ENDLP ADA SAVE,I SSA,RSS JMP ENDLP INB ISZ DAY JMP LOOP ENDLP INA STA SAVE BLS ADB MNTAB LDA 1,I STA MONTH INB LDA 1,I STA MONTH+1 JSB CONV. CONVERT DAY AND STORE. DEF *+4 DEF SAVE DEF DAY DEF D2 JSB .DRCT DEF TMP. ADA D3 STA PAR3 JSB OPEN. OPEN THE LIST FILE. DEF *+5 DEF O.BUF DEF TMP. PAR3 BSS 1 DEF D0 JSB WRITF DEF *+5 DEF O.BUF DEF SAVE1 DEF JOBM+1 DEF JOBM JMP ONOFF,I * ADDR BSS 1 SAVE1 BSS 1 FIT. NOP STA ADDR STB SAVE1 ASR 8 LDA ADDR,I RRL 8 BLF,BLF STB ADDR,I ISZ ADDR LDA SAVE1 ASL 16 LDA ADDR,I ALF,ALF RRL 8 STB ADDR,I JMP FIT.,I * D0 DEC 0 WRITE EQU * D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 ICNW OCT 6 SAVE BSS 1 * RYTAB DEF *+1 DEC -335 DEC -305 DEC -274 DEC -244 DEC -213 DEC -182 DEC -152 DEC -121 DEC -91 DEC -60 DEC -32 DEC -1 DEC 0 * LYTAB DEF *+1 DEC -336 DEC -306 DEC -275 DEC -245 DEC -214 DEC -183 DEC -153 DEC -122 DEC -92 DEC -61 DEC -32 DEC -1 DEC 0 * MNTAB DEF *+1 ASC 2, DEC ASC 2, NOV ASC 2, OCT ASC 2, SEP ASC 2, AUG ASC 2, JUL ASC 2, JUN ASC 2, MAY ASC 2, APR ASC 2, MAR ASC 2, FEB ASC 2, JAN * JOBM DEC 25 ASC 1, ASC 2,JOB BSS 3 ONOFM ASC 1, ëŸ ASC 4, AT TMES1 BSS 1 ASC 1,: TMES2 ASC 1, : BSS 1 TMES3 ASC 1,. ASC 1, ASC 1, O ASC 1,N DAY BSS 1 MONTH BSS 2 ASC 1, YEAR BSS 2 ON ASC 1,ON OFF ASC 2, OFF * END Ùõÿÿ ÿýbj ÿ92067-18171 1903 S C0122 &EX.TM              H0101 ŽrþúASMB,R,L HED EX.TM ROUTINE * NAME: EX.TM * SOURCE: 92067-18171 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EX.TM,8 92067-16125 REV.1903 771115 ENT EX.TM * EXT $BATM,TM.VL,CONV.,IPUT,.DRCT EXT EXEC,FIT.,.ENTR,WRITF,O.BUF EXT FM.ER SUP A EQU 0 XEQT EQU 1717B * * THE FOLLOWING ROUTINE PRINT OUT TOTAL * EXECUTION TIME FOR THE CURRENT JOB. * EX.TM NOP JSB .ENTR DEF EX.TM DLD TM.VL CMA,CLE,INA CMB,SEZ INB DST SAVE1 DLD $BATM CLE ADA SAVE1 SEZ INB ADB SAVE2 DST SAVE1 CLA STA SAVE3 JSB .DRCT DEF $BATM STA HSEC INA STA SEC ** * LDA XEQT CHECK TO SEE IF BATCH FLAG SET ADA D20 LDA A,I ELA BATCH FLAG SET?? SEZ,RSS JMP NOBTH NOT SET SO DON'T TOUCH THE BATCH TIMER * JSB IPUT GO CLEAR THE FIRST WORD DEF *+3 DEF HSEC DEF SAVE3 JSB IPUT AND NOW THE SECOND WORD DEF *+3 DEF SEC DEF SAVE3 ** * NOBTH DLD SAVE1 * DIV D6000 STB SAVE3 CLB DIV D60 STA SAVE1 HOURS STB SAVE2 MINUTES LDA SAVE3 CLB DIV D100 STA SEC SECONDS STB HSEC HUNDREDTHS OF SECONDS JSB CONV. CONVERT AND STORE HOURS. DEF *+4 DEF SAVE1 DEF EXMS1 DEF D2 JSB CONV. CONVERT AND STORE MINUTES. “ß   DEF *+4 DEF SAVE2 DEF SAVE1 DEF D2 JSB .DRCT DEF EXMS1+1 LDB SAVE1 JSB FIT. JSB CONV. CONVERT AND STORE SECONDS. DEF *+4 DEF SEC DEF EXMS2+1 DEF D2 JSB CONV. CONVERT HUNDREDTHS OF SECONDS. DEF *+4 DEF HSEC DEF SAVE1 DEF D2 JSB .DRCT DEF EXMS2+2 LDB SAVE1 JSB FIT. JSB WRITF DEF *+5 DEF O.BUF DEF SAVE1 DEF EXMS+1 DEF EXMS JSB WRITF NOW DO TOP OF DEF *+5 FORM TO FINISH DEF O.BUF THE JOB DEF SAVE1 DEF EXMS+1 DEF N1 LDA SAVE1 IF ERROR ON LIST FILE SSA,RSS THEN JMP EX.TM,I * JSB FM.ER REPORT TO OPERATOR DEF EX DEF D2 DEF LISTO DEF D7 EX JMP EX.TM,I * EXMS DEC 15 ASC 9, EXECUTION TIME: EXMS1 BSS 1 ASC 1,: EXMS2 ASC 1, : BSS 1 ASC 1,. ASC 1, * N1 DEC -1 D1 DEC 1 D2 EQU * WRITE DEC 2 ICNW OCT 6 SAVE1 BSS 1 SAVE2 BSS 1 SAVE3 BSS 1 HSEC BSS 1 SEC BSS 1 D6000 DEC 6000 D100 DEC 100 D60 DEC 60 D20 DEC 20 * D7 DEC 7 LISTO ASC 7,LIST OVERFLOW! END y ÿÿ ÿýcj ÿ92067-18172 1903 S C0122 &FREE              H0101 z]ASMB,R,L HED FREES ROUTINE * NAME: FREE. * SOURCE: 92067-18172 * RELOC: 92002-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FREE.,8 92067-16125 REV.1903 740801 ENT FREE. * EXT .ENTR * * NUMBR BSS 1 ADDR BSS 1 * FREE. NOP JSB .ENTR DEF NUMBR LDA NUMBR,I AND MASKL ALF,ALF CLB ADA M60 MPY D10 STA 1 LDA NUMBR,I AND B377 ADA M60 ADA 1 CMA,INA STA NUMBR LDB ADDR,I LOOP1 LDA M16 STA CNTR CLA,INA LOOP2 ISZ NUMBR JMP *+4 XOR 1,I STA 1,I JMP FREE.,I ISZ CNTR JMP *+3 INB JMP LOOP1 RAL JMP LOOP2 * CNTR BSS 1 M16 DEC -16 M60 OCT -60 D10 DEC 10 B377 OCT 377 MASKL OCT 177400 * END ŠMÿÿ ÿýdj ÿ92067-18173 1903 S C0122 &LU.CL              H0101 |xASMB,R,L HED LU.CL ROUTINE * NAME: LU.CL * SOURCE: 92067-18173 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LU.CL,8 92067-16125 REV.1903 780915 ENT LU.CL * EXT LULU.,.ENTR,$LUSW,.DRCT,EXEC,S.CAP * * CHANGE RECORD * * 780915 CHANGED TO DO NOTHING IF IN SESSION (GAA) * * * THE FOLLOWING ROUTINE GOES THROUGH THE $LUSW * TABLE AND CLOSES ALL SPOOL LU'S. * * LU.CL NOP JSB .ENTR DEF LU.CL LDA S.CAP GET THE SESSION FLAG SZA IF IN SESSION JMP LU.CL,I JUST RETURN * JSB .DRCT DEF $LUSW STA ADDR LDB 0,I CMB,INB STB CNTR LOOP2 ISZ ADDR LDA ADDR,I SSA JMP LOOP1 * ALF,ALF GET THE DIRECT LU AND B77 INA STA LUNO JSB EXEC DEF *+5 DEF D23 DEF SMPA DEF D4 DEF LUNO LOOP1 ISZ CNTR JMP LOOP2 * JSB LULU. ALL CLOSED NOW CLEAR THE TABLE DEF *+2 DEF ZERO ZERO NOP IGNOR ERROR RETURN JMP LU.CL,I RETURN * D4 DEC 4 D23 DEC 23 B77 OCT 77 ADDR BSS 1 CNTR BSS 1 LUNO BSS 1 SMPA ASC 3,SMP * END VŒÿÿ ÿýek ÿ92067-18174 1903 S C0122 &AVAIL              H0101 „€þúASMB,R,L HED AVAIL ROUTINE * NAME: AVAIL * SOURCE: 92067-18174 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM AVAIL,8 92067-16125 REV.1903 741231 ENT AVAIL,.LUAV * EXT .ENTR,$LUAV * ADDR NOP MASK NOP FNUM NOP * AVAIL NOP JSB .ENTR DEF ADDR LDA M5 STA SAVE1 CLA,INA STA FNUM,I LOOP1 LDB M16 STB SAVE2 LOOP2 STA MASK,I AND ADDR,I SZA,RSS JMP HAVIT ISZ FNUM,I LDA MASK,I RAL ISZ SAVE2 JMP LOOP2 ISZ ADDR ISZ SAVE1 JMP LOOP1 CLA STA FNUM,I JMP AVAIL,I HAVIT LDA MASK,I IOR ADDR,I STA ADDR,I JMP AVAIL,I * SAVE1 BSS 1 SAVE2 BSS 1 M5 DEC -5 M16 DEC -16 D2 DEC 2 DLUAV DEF $LUAV * .LUAV NOP LDA $LUAV GET THE TABLE COUNT SZA,RSS IF ZERO, JMP EX JUST EXIT * STA SAVE1 SET THE COUNTER LDA .LUAV,I GET THE PRAM ADDRESS STA AVAIL AND SAVE IT LDB DLUAV GET THE TABLE ADDRESS RBL,CLE,SLB,ERB MAKE DIRECT LDB B,I GET ADDRESS INB STEP TO FIRST WORD AVLOP LDA B,I GET THE ENTRY AND B77 CPA AVAIL,I HERE? JMP EX YES GO EXIT * ADB D2 NO STEP TO NEXT ENTRY ISZ SAVE1 IS THERE ONE? JMP AVLOP YES GO TRY IT * CLA MAKE OK EXIT EX ISZ .LUAV STEP TO RETURN ADDRESS JMP .LUAV,I AND RETURN * B77 OCT 77 A EQU 0 B ‰   EQU 1 END ð™ ÿÿ ÿýfm ÿ92067-18175 1903 S C0122 &READ.              H0101 osASMB,R,L,C HED READ ROUTINE * NAME: READ * SOURCE: 92067-18175 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM READ.,7 92067-16125 REV.1903 740801 ENT READ. EXT %READ,.ENTR * * * READ. IS AN INTERFACE ROUTINE TO CALL THE * READS ROUTINE FROM FORTRAN. * * THE CALL IS: * * CALL READ.(LU,BUF,RQLN,RTNLN) * * W H E R E: * * LN IS THE LOGICAL UNIT. * BUF IS THE USER'S BUFFER * RQLN IS THE REQUEST LENGTH IN WORDS. * RTNLN IS THE RETURN LENGTH IN WORDS. * * ON END OF FILE RTNLN IS SET TO -1. * * LU NOP BUF NOP LN NOP L NOP READ. NOP JSB .ENTR GET PARAMETERS DEF LU LDA LN,I SET LENGTH CMA,INA TO NEGATIVE ALS CHARACTERS STA LN AND STORE JSB %READ CALL READS ROUTINE DEF *+5 NORMAL RETURN DEF LU,I LU DEF BUF,I BUFFER DEF LN LENGTH CCB,RSS EOF RETURN - SET TLOG TO -1 INB NORMAL RETURN ROUND UP BRS CONVERT TO WORDS STB L,I STORE IN USER AREA JMP READ.,I RETURN END ÿÿ ÿýgm ÿ92067-18176 2001 S C0122 &DCMC DISMOUNT-MOUNT SUBROUTI             H0101 SeþúASMB,R,L,C,Q * NAME: DCMC * SOURCE: 92067-18176 * RELOC: 92067-16125 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DCMC,7 92067-16125 REV.2001 791016 ENT DCMC EXT EXEC, .ENTR, RMPAR, XLUEX EXT CL.BF, SM.BF, OVRD., $CL1, $CL2, $DSCS EXT FD.CK, NAM.., CNUMD EXT GTSCB, SESSN, $SMVE, $SHED EXT $SMDL, $SMLK, $SMST, $SMID, $SMGP * SUP * * * DCMC MOUNT - DISMOUNT SUBROUTINE FOR RTE * * * CALLING SEQUENCE * * CALL DCMC(ER,CODE,DISID,P/G,SIZE,IDENT,DIRTK,LABEL,SCBCD,SECT) * * WHERE * * ER - ERROR RETURN * * CODE - INDICATES WHETHER THIS IS A CALL TO MOUNT OR DISMOUNT * A DISC. 1 = MOUNT 2 = DISMOUNT 3 = MOUNT LU AND * CHANGE CRN IN CL * * DISID - +CRN OR -LU OF DISC TO BE MOUNTED OR DISMOUNTED. * * PARAMETERS P/G THROUGH LABEL ARE USED ONLY FOR MOUNT CALLS. * * P/G - FOR MOUNT - INDICATES WHETHER DISC IS TO BE MOUNTED AS A * PRIVATE OR A GROUP DISC. 0 = PRIVATE 1 = GROUP * DEFAULT IS PRIVATE * FOR DISMOUNT - CONTAINS ASCII "RR" IF THE DISC RESOURCE IS TO * BE RELEASED. * RR WILL ALWAYS BE SET IF NOT UNDER SESSION CONTROL. * * SIZE - NUMBER OF TRACKS TO BE USED ON THE DISC. * DEFAULT WHEN DISID = -LU IS THE NUMBER OF TRACKS ON THE * SUBCHANNEL. DEFAULT WHEN DISID = +CRN IS THE SIZE OF THE * DISC POOL DISC THAT IS USED (1ST FREE DISC IN DISC POOL). * * IDENT - 6 CHAR ASCII LABzþúEL USED IN CARTRIDGE SPECIFICATION ENTRY. * DEFAULT IS DC00XX WHERE XX IS TERMINAL LU #. * * DIRTK - NEGATIVE # DIRECTORY TRACKS. DEFAULT IS 1. * * LABEL - CARTRIDGE REFERENCE NUMBER. THIS IS USED ONLY WHEN A -LU * IS BEING MOUNTED AND -LU IS A NEW DISC THAT MUST BE INIT- * IALIZED. IN THIS CASE IT IS REQUIRED. * * SCBCD - SESSION WORD (POINTER TO SST LENGTH WORD) OF THE SCB * TO/FROM WHICH THE DISC IS TO BE MOUNTED/DISMOUNTED. * * SECT - OPTIONAL # SECTORS PER TRACK NEEDED ON THE DISC. DEFAULTS * TO DON'T CARE (USED BY READT) ONLY VALID ON ALLOCATION * * * * NOTE: AN MC,-LU IGNORES ANY VALUE SUPPLIED IN IDENT, DIRTK, OR * LABEL UNLESS THERE IS NO VALID DIRECTORY ON THE "LAST TRACK" * OF LU. IN THIS CASE, LU IS INITIALIZED. * * * * * RETURNS : B-REG ON MOUNT CALL = -LU OF DISC MOUNTED * B-REG ON DISMOUNT CALL = B CONTAINS DISC LU NUMBER. * IF THAT DISC WAS ALSO RETURNED TO THE POOL, BIT * 15 IS SET. BIT 14 = 1 IF DISMOUNTED FROM THE * SYSTEM, BIT 14 = 0 IF JUST DISMOUNTED FROM SESSION. * IF RR OPTION WAS NOT SPECIFIED BIT 14 = BIT 15 = 0. * A-REG ON DISMOUNT CALL = CRN * * * NOTE : IF CODE = 3 (ONLY FROM READT), LABEL IS * PICKED UP AND PUT IN THE CL BUT THE DISC * IS NOT INITIALIZED (OR THE DL CHANGED)! * ALSO, IF A BIG ENOUGH DISC ISN'T FOUND IN THE DISC POOL * THE BIGGEST DISC AVAILABLE IS MOUNTED. * IF MOUNT AND JUST ACTIVATES - RETURNS ERROR -12 * * * * SPC 5 A EQU 0 B EQU 1 TATLG EQU 1755B TATSD EQU 1756B XEQT EQU 1717B SECT2 EQU 1757B SECT3 EQU 1760B B77 OCT 77 B377 OCT 377 B7777 OCT 7777 MSKAL OCT 177777 SIGN OCT 100000 BIT14 OCT 040000 LUTYP OCT 34000 DISTP OCT 14000 STåŽþúAT OCT 100015 RDNAB OCT 100001 D. ASC 3,D.RTR WD1 ASC 1,DC ASC0 ASC 1,00 ASCRR ASC 1,RR UNL PRC OCT 74000 LU2 OCT 74002 LST * * ASMBF DEF SM.BF ACLBF DEF CL.BF * * INIT NOP SFLAG NOP ERROR NOP IDSSW NOP MTDSC NOP DISCL NOP SESWD NOP LNGTH NOP MASK NOP OFFST NOP REM NOP ALU NOP PENLU NOP ACRN NOP FLAG NOP TMP1 NOP -\ MUST KEEP THESE TMP2 NOP -/ TWO TOGETHER TMP3 NOP PTR1 NOP COUN1 NOP COUN2 NOP ID1 NOP ID2 NOP EQT5 NOP LTR NOP FUNCT NOP TRMLU NOP NGLU NOP FLAG3 NOP FREDS NOP DCFLG NOP RTFLG NOP * * ZERO OCT 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .11 DEC 11 .12 DEC 12 .13 DEC 13 .16 DEC 16 .23 DEC 23 .50 DEC 50 .53 DEC 53 .54 DEC 54 .56 DEC 56 .62 DEC 62 .63 DEC 63 .64 DEC 64 .65 DEC 65 .66 DEC 66 .144 DEC 144 .253 DEC 253 .256 DEC 256 A.16 DEF .16 * * N1 DEC -1 N2 DEC -2 N3 DEC -3 * * SKP * * ER DEF ZERO CODE DEF ZERO DISID DEF ZERO P/G DEF ZERO SIZE DEF ZERO IDENT DEF ZERO DIRTK DEF ZERO LABEL DEF ZERO SCBCD DEF ZERO SECT DEF ZERO * DCMC NOP JSB .ENTR FETCH INCOMING DEF ER PARAMETERS * * LDA DISID,I WAS AN LU OR CRN SZA,RSS SUPPLIED? JMP EX50 NO - EXIT NOT ENOUGH PARAMETERS * LDB ASMBF RESOLVE POSSIBLE INDIRECTS JSB RESLV IN ADDRESSES OF THE BUFFER STB ASMBF USED FOR THE CL AND THE LDB ACLBF BUFFER USED FOR THE SCB. JSB RESLV STB ACLBF CLA STA DCFLG * LDA CODE,I TRANSFORM FROM ADDRESSES INTO VALUES STA CODE ALL PARAMETERS THAT MAY BE CHANGED LDB P/G,I BY USING DEFAULT VALUES OR IN CPA .2 (IF DISMOUNT CALL SKIP ROTATE) RSS RBR,RBR GET P/G FLAG TO BIT 14 STB P/G REMOUNTING LU2 OR L°þúU3. LDA SIZE,I DISID IS EXCLUDED BECAUSE IT IS STA SIZE A VARIABLE AND THE ADDRESS IS NEEDED TO RETURN LDA DIRTK,I THE -LU OF THE DISC MOUNTED. STA DIRTK * REACL CLA STA SFLAG CLEAR THE IN-SESSION FLAG AND STA INIT AND THE INITIALIZE DISC FLAG STA FLAG3 AND THE SPECIAL FLAG FOR READT CALL * JSB EXEC CALL EXEC TO READ DEF *+7 CARTRIDGE DIRECTORY INTO DEF .1 GLOBAL BUFFER D.SDR DEF LU2 DEF CL.BF DEF .256 DEF $CL1 DEF $CL2 * JSB SESSN GET CALLERS SESSION WORD IF THERE IS ONE DEF *+2 DEF XEQT SEZ,RSS UNDER SESSION CONTROL? JMP INSES YES - CALLER IS UNDER SESSION LDA SCBCD,I NO - SEE IF A SESSION WORD WAS PASSED IN CALL SZA,RSS WAS A SESSION WORD PASSED? JMP NTSES NO - THIS CALL IS NOT UNDER SESSION CONTROL LDB A GET SESSION WORD TO B-REG INSES STB SESWD SAVE SESSION WORD (POINTER TO SST LENGTH WORD) ISZ SFLAG SET IN-SESSION FLAG JSB GTSCB READ SCB DEF *+5 DEF SM.BF DEF .144 DEF ERROR DEF SESWD * LDB ASMBF SCB WAS READ IN AT THIS ADDRESS LDA B,I GET IDENTIFIER FROM SCB STA TRMLU AND SAVE IT (TERMINAL LU) CMB,INB CALCULATE POINTER TO SST LENGTH WORD ADB $SMLK IN SCB SO CAN USE SCB OFFSET GLOBALS ADB $SMST IN ACCESSING ELEMENTS OF THE SCB. CMB,INB STB IDSSW IDSSW = A.SCB - $SMLK - $SMST * LDA B,I CALCULATE ADDRESS OF 1ST ENTRY CMA,INA IN DISCS MOUNTED AREA OF ADB .2 THE SCB USING THE POINTER ADB A TO THE SST LENGTH WORD STB MTDSC MTDCS = IDSSW + 1 + C(IDSSW) * LDB IDSSW SAVE LENGTH OF DISCS ADB N1 MOUNTED AREA LDB B,I STB DISCL LDA IDSSW,I CALCULATDþúE LENGTH OF DISCS MOUNTED AREA CMA,INA + LENGTH OF SST + 2 AND SAVE FOR ADA B SCB UPDATE ROUTINES ADA .2 STA LNGTH * LDB $SMID IF DISC IS TO BE MOUNTED AS A LDA P/G PRIVATE DISC, ID1 _ USER ID CPA BIT14 AND ID2 _ PRIVATE ID. LDB $SMGP IF DISC IS TO BE MOUNTED AS A ADB IDSSW GROUP DISC. ID1 _ GROUP ID LDB B,I AND ID2 _ USER ID. STB ID1 LDB $SMID CPA BIT14 RSS LDB $SMGP ADB IDSSW LDB B,I STB ID2 * LDA B7777 JUST IN CASE THIS IS AN LU 2 OR 3 LDB DISID,I REMOUNT, FORCE THE ID TO 7777B CPB N2 STA ID1 CPB N3 STA ID1 * LDA CODE IS THIS AN AC OR A MC? CPA .2 OR DISMOUNT CALL? JMP DC DISMOUNT * * DFLTS LDB N1 LDA DIRTK IF # DIRECTORY TRACKS SZA,RSS WAS NOT SET STB DIRTK DEFAULT TO -1 LDA IDENT,I SZA,RSS 6-CHARACTER LABEL SPECIFIED? JMP CLSCH NO JSB NAM.. YES - MAKE SURE IT IS A LEGAL FMGR NAME DEF *+2 DEF IDENT,I SZA LEGAL? JMP EX53 NO - BAD PARAMETER * CLSCH LDA DISID,I WAS AN LU OR CRN SSA -LU OR CRN?? (MC OR AC) JMP MT.LU LU - GO HANDLE A MC,-LU SKP * * * * IF CRN IS TO BE MOUNTED AS A PRIVATE DISC THEN: * * 1. IF CRN, GROUP ID IS MOUNTED TO THE SYSTEM, DON'T ALLOW * THE MOUNT. ERROR 12 * 2. IF CRN, USER ID IS ALREADY MOUNTED TO THE SYSTEM AND * THE CALLER'S SCB, DON'T ALLOW THE MOUNT. ERROR 12 * 3. IF CRN, USER ID IS MOUNTED TO THE SYSTEM BUT NOT TO * THE CALLER'S SCB, JUST DO THAT PART OF THE MOUNT THAT * MOUNTS THE DISC TO THE CALLER'S SCB. * 4. IF CRN, SYSTEM ID IS MOUNTED, DON'T ALLOW THE MOUNT. * ERROR 12 * * SAME LOGIC (VICE VERSA) FOR A DISC THAT IS TO BE MOÀoþúUNTED AS * A GROUP DISC. * * * * M.CRN LDB ACLBF SEARCH FOR CRN PASSED M.CR0 LDA DISID,I START AT BEGINNING OF CARTRIDGE LIST JSB SERCH SEARCH CL FOR DISID (CRN IN THIS CASE) JMP M.CR2 CRN NOT THERE LDA B,I FOUND ONE! GET ID WORD INB STEP TO NEXT ENTRY IN CASE ID'S DON'T MATCH AND B7777 MASK TO BITS 11-0 CPA ID2 MOUNTED TO ID2? JMP EX12 AREADY ACCESSABLE BY THIS ACCOUNT STA TMP3 REMEMBER THIS ID CPA ID1 MOUNTED TO ID1? RSS YES JMP M.C05 NO - CONTINUE SEARCH AT LOCATION B IN CL JSB SCBCK IS LU MOUNTED TO THIS SESSION? JMP EX12 YES - ERROR 12. ALREADY MOUNTED TO THIS SESSION JMP M.CR1 YES - BUT IT'S INACTIVE, SO JUST REACTIVATE LDA PENLU WE'VE FOUND THE LU# OF PHYSICAL DISC BEING STA ALU MOUNTED SO SAVE IT ADB N2 POSITION TO CRN IN LDA B,I THIS ENTRY AND GET IT. JSB CKCRN MAKE SURE THIS CRN IS NOT ALREADY MOUNTED TO SCB JMP EX12 IT IS SO ERROR EXIT JSB ADD GO ADD IT TO THE SCB JMP EX65 ERROR RETURN SESSION LU CONFLICT IN SST CLA RETURN WITH NO LDB CODE IF SPECIAL CODE FOR READT CPB .3 THEN MOUNT TO SESSION AND RETURN LDA .12 WITH AN ERROR -12 ANYWAY. JMP EXIT ERRORS * M.CR1 LDA PENLU NOW HAVE THE LU # OF DISC STA ALU WE'RE WORKING WITH INTO ALU CLA SET ACTIVATE CODE JSB ACTIV GO ACTIVATE THE DISC IN DISC'S MOUNTED LIST CLA CLEAR FOR ERROR CODE LDB CODE IF SPECIAL CODE FOR READT CPB .3 THEN ACTIVATE AND RETURN LDA .12 AN ERROR -12. JMP EXIT AND RETURN * M.C05 LDA B7777 GET SYSTEM ID CPA TMP3 IS THIS A SYSTEM DISC?? JMP EX12 YES - IS ALREADY ACCESSABLE BY THIS ACCO²þúUNT CPA ID1 IS THIS PERSON THE SYSTEM MANAGER? JMP EX12 YES - CAN'T MOUNT SYSTEM DISC WITH CRN = ANY OTHER * CRN IN THE SYSTEM JMP M.CR0 NOPE - KEEP SEARCHING * M.CR2 LDA MTDSC POSITION TO ADA N1 DISCS MOUNTED LDA A,I COUNTER IN SCB. SZA,RSS IF ZERO, CAN'T MOUNT ANY MORE JMP EX63 SO RETURN ERROR 63 * LDA DISID,I WE CAN USE THIS CRN SO STA ACRN SAVE IT LDA ACLBF B-REG CONTAINS ADDRESS OF 1ST ADA .253 EMPTY ENTRY IN DISC DIRECTORY. MAKE CMA,INA SURE THIS IS NOT STOP WORD. ADA B I.E. IF B >= ADSDR + 252 OR SSA,RSS IF B - ADSDR - 252 >= 0 THEN B IS JMP EX62 STOP WORD. ALREADY 63 DISCS MOUNTED. * LDA N2 STA COUN2 M.C2 CLA GET READY FOR NEXT BEST SIZE ALGORITHM STA TMP3 FOR READT MOUNT CALL LDB ASMBF GET 1ST WORD ADDRESS OF DISC POOL STB PTR1 AND SAVE IT M.C20 JSB RDSPL READ DISC POOL INTO BUFFER SM.BF M.C21 LDB PTR1,I GET ENTRY FROM DISC POOL CPB N1 IS THIS THE END? JMP M.C23 YES - AND DIDN'T FIND ONE CCE,SSB IS THIS ONE MARKED USED? JMP M.C22 YES - GO STEP TO THE NEXT ONE RBL,ERB SET UP DOUBLE STB TMP1 WORD CONTROL WORD CLB FOR EXTENDED EXEC STB TMP2 STATUS REQUEST JSB XLUEX STATUS CHECK DEF *+4 DEF STAT DEF TMP1 DEF EQT5 JMP M.C22 IF THIS IS A LDA EQT5 BAD LU, JUST AND LUTYP SKIP IT. CPA DISTP RSS JMP M.C22 LDB PTR1,I GET DISC LU AGAIN JSB IMPRD MAKE IMPOSSIBLE READ TO LU TO GET SIZE JMP M.C22 DISC ERROR ON THIS ONE: SKIP IT * LDA SECT,I MAKE SURE THIS DISC HAS AT LEAST CMA,INA AS MANY SECTORS PER TRACK AS ADA ERôwþúROR REQUESTED BY CALLER SSA ENOUGH SECT/TRACK?? JMP M.C22 NO - SKIP TO NEXT DISC * LDA SIZE IS THIS DISC CMA,INA AT LEAST AS ADA B BIG AS SIZE SSA REQUESTED? JMP M.C2S NO - SAVE SOME SIZE DATA AND GO TRY THE NEXT ONE LDA SIZE YES - MAKE SURE # DIRECTORY TRACKS SZA,RSS SPECIFIED IS REASONABLE LDA B TEST IS: ADA DIRTK # DIR TRACKS < (TOTAL TKS - #DIR TKS) 8 + 1 ARS,ARS ARS INA ADA DIRTK SSA,RSS REASONABLE? JMP M.C24 YES - WE'VE GOT A DISC LDA SIZE IF SIZE AND DIRTK WERE BOTH SPECIFIED SZA,RSS THEN WILL NEVER FIND A DISC SO JUST JMP M.C22 RETURN AN ERROR NOW JMP EX56 * M.C2S LDA TMP3 GET SIZE OF LAST DISC CMA,INA MAKE NEGATIVE ADA B AND ADD THIS DISC'S SIZE SSA,RSS IF THIS ONE IS BIGGER STB TMP3 SAVE IT'S SIZE LDB PTR1 SSA,RSS IF THIS ONE IS BIGGER STB FREDS SAVE POINTER TO IT * M.C22 ISZ PTR1 STEP TO NEXT DISC POOL ENTRY JMP M.C21 AND GO CHECK IT * M.C23 ISZ COUN2 1ST TIME THRU? RSS YES JMP NODSC 2ND TIME THRU AND STILL NO DISCS AVAILABLE JSB POLCK 1ST TIME - CHECK DISC POOL FLAGS FOR VALIDITY JMP M.C2 AND TRY AGAIN * * NODSC LDB TMP3 GET BEST FIT SIZE LDA CODE CPA .3 IF THIS IS A READT CALL SZB,RSS AND THERE WAS A SMALLER DISC FREE JMP EX64 MOUNT IT, ELSE ERROR 64 STB SIZE SET UP SIZE PARAMETER ADB N1 AND LAST TRACK STB LTR LDA FREDS,I GET LU OF THIS DISC STA ALU AND MAKE IT THE CURRENT LU CCA SET A FLAG MAKING THIS STA FLAG3 CASE IDENTIFIABLE JMP DOMNT GO DO THE MOUNT * * M.C24 LDA SIZE œþú IF USER SPECIFIED SIZE SZA,RSS USE IT. IF NOT, USE LDA B THE # TRACKS ON THE STA SIZE ALLOCATED DISC ADA N1 STA LTR LTR = SIZE - 1 LDA PTR1,I SAVE LU # OF ISZ PTR1 STEP DISC POOL POINTER (THIS ONE COULD FAIL) STA ALU ALLOCATED DISC. * * ADD ALU TO CALLER'S SCB; TO DISCS DOMNT JSB ADD MOUNTED LIST, SST IF NECESSARY, STEP COUNTER JMP M.C20 ERROR RTN GO TRY ANOTHER DISC POOL DISC JSB ALLOC ALLOCATE ALU IN DISC POOL CCA SET NEEDS-TO-BE-INITIALIZED FLAG STA INIT * M.C25 LDA ALU GET LU NUMBER OF DISC BEING MOUNTED CMA,INA MAKE IT NEGATIVE, STA NGLU AND USE IN SCHEDULE OF D.RTR LDA ID1 GET ID TO WHICH DISC IS TO BE MOUNTED LDB INIT GET INITIALIZE FLAG CCE,SZB INITIALIZE THIS DISC? RAL,ERA YES SET BIT 15 ON PARAMETER 5 STA TMP3 TEMP SAVE FOR PARAMETER 5 JSB SPECF SET UP 16-WORD SPECIFICATION ENTRY LDA OVRD. GET ANY POSSIBLE OVERRIDE BITS ADA .13 AND THEM TO D.RTR STA FUNCT FUNCTION CODE JSB EXEC SCHEDULE D.RTR TO ADD DEF D.RTN THE ENTRY TO THE CARTRIDGE DEF .23 DIRECTORY AND INITIALIZE DEF D. THE DIRECTORY DEF XEQT DEF FUNCT DEF NGLU DEF SCBCD,I DEF TMP3 DEF SM.BF DEF .16 D.RTN JSB RMPAR FETCH RETURN PARAMETERS DEF *+2 DEF SM.BF LDA SM.BF SSA ANY D.RTR ERRORS? JMP CLNUP GO CLEAN UP AFTER D.RTR ERRORS CLA EXIT WITH NO JMP EXIT ERRORS. * * NTSES CLA NOT IN SESSION SO STA ID1 SET 1ST ID TO ZERO LDA B7777 AND 2ND TO SYSTEM DISCS STA ID2 CMB,INB SAVE THIS TERMINAL'S STB TRMLU LOGICAL UNIT # ùþúLDA CODE CPA .2 MC OR DC? JMP DC CONTINUE DISMOUNT LDA DISID,I SINCE NOT IN SESSION MUST SSA,RSS HAVE BEEN MC,-LU SO JMP EX56 IF NOT - BAD PARAMETER ERROR. JMP DFLTS CONTINUE MOUNT * * CLNUP STA TMP3 SAVE ERROR CODE FOR RETURN JSB FREE LDA SFLAG IF NOT UNDER SESSION SZA CONTROL THEN SKIP SCB REMOVE STUFF JSB REMOV LDA TMP3 GET ERROR IN CASE THERE WAS ONE LDB DISID,I FIND OUT IF WAS MC,-LU OR AN MC,+CRN SSB DISID + OR -? JMP EXIT MC,-LU SO RETURN THE ERROR AND TERMINATE LDA FLAG3 MC,CRN IS THIS SPECIAL READT CASE? CPA N1 FLAG SET? JMP EX64 YES - EVEN THIS DISC DIDN'T WORK!! JMP M.C20 NO - GO TRY ANOTHER DISC FROM THE POOL SKP * * MT.LU CMA,CCE,INA SET UP DOUBLE RAL,ERA WORD CONTROL STA TMP1 PARAMETER FOR CLA EXTENDED EXEC CALL STA TMP2 JSB XLUEX MAKE EXEC STATUS REQUEST DEF *+4 TO BE SURE DISID IS REALLY DEF STAT A DISC DEVICE DEF TMP1 DEF EQT5 JMP EX56 ERROR ON STATUS REQUEST. LU MUST BE BAD LDA EQT5 GET EQT 5 STATUS WORD AND LUTYP MASK TO DEVICE TYPE CPA DISTP TYPE 30 - 39? RSS YES JMP EX56 NO - ERROR BAD PARAMETER * LDA DISID,I SEARCH FOR -LU PASSED IN LDB ACLBF START SEARCH AT BEGINNING OF CL JSB SERCH LOOK FOR AN ENTRY FOR DISID JMP MTLU1 NOT THERE - ALL'S CLEAR FOR MOUNT LDA SFLAG IT'S MOUNTED - IS CALLER SZA,RSS UNDER SESSION CONTROL? JMP EX12 NO - MUST GIVE ALREADY MOUNTED ERROR LDA B,I GET ID WORD AND B7777 MASK TO BITS 11-0 CPA ID1 MOUNTED WITH THE RIGHT ID? RSS YES JMP EX12 NOPE - ALREADY MOUNTED ERROR Âþú JSB SCBCK YES - IS LU MOUNTED TO THIS SESSION? JMP EX12 YES - ALREADY MOUNTED ERROR JMP MTLU0 YES - BUT INACTIVE - JUST REACTIVATE LDA PENLU NO - JUST MOUNT THIS LU TO THE SESSION STA ALU AND KEEP THE LU OF THE DISC BEING MOUNTED ADB N1 POSITION TO CRN IN THIS ENTRY LDA B,I AND GET IT JSB CKCRN MAKE SURE THIS CRN IS NOT ALREADY MOUNTED TO SCB JMP EX12 IT IS SO ERROR EXIT JSB ADD ADD ALU TO THE SESSION JMP EX65 SESSION LU CONFLICT IN SST ERROR RETURN CLA AND RETURN WITH LDB CODE IF SPECIAL CODE FOR READT CPB .3 THEN JUST MOUNT TO SESSION AND LDA .12 RETURN AN ERROR -12 ANYWAY. JMP EXIT NO ERRORS * MTLU0 LDA PENLU NOW HAVE THE LU # OF STA ALU DISC INTO ALU CLA SET ACTIVATE CODE LDB SFLAG SZB JSB ACTIV MARK DISC ACTIVE CLA SET FOR ERROR CODE LDB CODE IF SPECIAL CODE FOR READT CPB .3 THEN JUST ACTIVATE AND LDA .12 SET ERROR -12 JMP EXIT AND RETURN * MTLU1 LDA SFLAG UNDER SESSION CONTROL? SZA,RSS CONTROL? JMP MTL15 NO SKIP DISCS MOUNTED CNTR CHECK LDA MTDSC POSITION TO ADA N1 DISCS MOUNTED LDA A,I COUNTER IN SCB. SZA,RSS IF ZERO CAN'T MOUNT ANY MORE JMP EX63 SO RETURN WITH ERROR 63 * MTL15 LDB DISID,I TURN DISID INTO CMB,INB A POSITIVE LU # STB ALU AND SAVE JSB IMPRD MAKE AN IMPOSSIBLE READ TO ALU TO JMP EXN1 DISC ERROR - LEAVE! LDA SIZE GET SIZE IN TRACKS PASSED INTO ROUTINE SZA,RSS WAS SIZE SPECIFIED? LDA B NO - USE PHYSICAL # TRACKS ON DISC CMB,INB PHYSICAL NUMBER OF TRACKS ADB A ON DISC - NUMBER OF TRACKS CMB,INB íuþú SPECIFIED MUST BE > OR = 0. SSB > OR = 0 JMP EX56 NO - ERROR BAD PARAMETER STA SIZE SAVE CORRECT SIZE VALUE ADA N1 GET # TRACKS LESS ONE IS LAST STA LTR TRACK ON THIS SUBCHANNEL * MTLU2 JSB FD.CK IS THERE A FILE SYSTEM ON ALU? DEF *+3 DEF ALU DEF LTR SZA,RSS VALID FILE SYSTEM? JMP OLDIS THERE IS ONE - SKIP INITIALIZATION STUFF LDA LABEL,I GET CARTRIDGE REFERENCE NUMBER SZA,RSS WAS ONE SPECIFIED? JMP EX50 NOPE - EXIT NOT ENOUGH PARAMETERS STA ACRN YES - STUFF IN ACRN FOR SEARCH LDB LTR CHECK TO MAKE SURE NUMBER INB OF DIRECTORY TRACKS ADB DIRTK SPECIFIED (OR DEFAULTED) BRS,BRS IS REASONABLE FOR THE SIZE BRS OF THIS DISC. THE TEST IS: INB #DIR TK < (TOTAL TKS - DIR TKS) 8 + 1 ADB DIRTK SSB REASONABLE?? JMP EX56 NO - EXIT BAD PARAMETER CCA SET NEEDS-TO-BE-INITIALIZED FLAG STA INIT * * MTLU3 LDB ACLBF SEARCH FOR CRN TO BE ASSIGNED TO DISC MTLU4 LDA ACRN START SEARCH AT BEGINNING OF DIRECTORY JSB SERCH LOOK THROUGH DIRECTORY FOR CRN JMP MTLU5 NOT THERE SO ALL'S CLEAR LDA B7777 IF THIS IS THE SYSTEM MANAGER AND HE IS CPA ID1 MOUNTING A PRIVATE (SYSTEM) DISC IT CAN'T JMP EX12 HAVE CRN = ANY OTHER CRN IN THE CL LDA B,I FOUND ONE. GET ID WORD INB STEP TO NEXT ENTRY IN CASE ID'S DON'T MATCH AND B7777 MASK ID WORD TO BITS 11-0 CPA ID1 SAME ID AS CALLER? JMP EX12 YES - CRN IS ALREADY MOUNTED TO CALLER CPA ID2 SAME ID AS CALLER? JMP EX12 YES - CRN IS ALREADY MOUNTED TO CALLER CPA B7777 SAME AS SYSTEM ID? JMP EX12 YES - CRN IS ACCESSIBLE TO CALLER JMP MTLU4 NO - KEEP SEARCHING * Öþú MTLU5 JSB ALLOC CHECK DISC POOL AND ALLOCATE ALU IF THERE LDA SFLAG GET IN-SESSION FLAG SZA,RSS UNDER SESSION CONTROL? JMP M.C25 NO - SO SKIP SCB STUFF JSB ADD ADD ALU TO SST AND DISCS MOUNTED LIST JMP EX65 SESSION LU CONFLICT IN SST ERROR RETURN JMP M.C25 FINISH UP WITH D.RTR CALL * * OLDIS STB ACRN SAVE CRN OF CURRENT DISC FOR CART DIRECT JMP MTLU3 SKIP INITIALIZATION STUFF. * * * SKP * * DC CCA SET DISMOUNT STA DCFLG FLAG STA FLAG3 AND # PASSES FLAG DC.0 LDB ACLBF SEARCH FOR DISID PASSED IN DC.1 LDA DISID,I START AT BEGINNING OF CL JSB SERCH SEARCH FOR LU OR CRN JMP NOTFD NOT THERE LDA B,I FOUND ONE. GET ID WORD AND B7777 AND MASK TO BITS 0-11 CPA ID1 MATCH ID1? JMP DC.2 YES CPA ID2 NO - MATCH ID2? JMP DC.2 YES LDA FLAG3 IF THIS IS THE 1ST PASS SSA THEN DON'T GIVE IT TO USER JMP DC.11 JUST BECAUSE HE'S SYSTEM MANAGER LDA B7777 ID1 IS CALLER'S PRIVATE ID (IF IN SESSION) CPA ID1 SEE IF CALLER IS SYSTEM MANAGER. IF SO JMP DC.21 GO AHEAD AND LET HIM DISMOUNT ANY DISC DC.11 INB STEP TO NEXT ENTRY JMP DC.1 AND KEEP SEARCHING THROUGH CL DC.2 LDA SFLAG GET IN SESSION FLAG SZA UNDER SESSION CONTROL? JSB SCBCK YES - IS THIS DISC MOUNTED TO CALLER'S SESSION? JMP DC.21 YES - GO AHEAD WITH DISMOUNT JMP DC.20 YES - MARKED INACTIVE - GO AHEAD WITH DISMOUNT JMP DC.11 NO - KEEP SEARCHING THROUGH CL * NOTFD LDB ID1 IF THE CALLER IS THE SYSTEM CPB B7777 MANAGER AND THIS IS THE 1ST ISZ FLAG3 TIME THROUGH THE CL THEN JMP EX54 DO ANOTHER PASS - OTHERWISE JMP DC.0 MUST EXIT NOT FOUND * DC.20 CCA SET FLžþúAG TO MAKE DISC ACTIVE SO STA FLAG D.RTR CAN FIND IT * DC.21 LDA PENLU THIS IS THE DISC WE'RE DISMOUNTING STA ALU SO KEEP LU NUMBER AROUND STA RTFLG SAVE FOR RETURN PARAMETER ADB N1 POSITION TO CRN LDA B,I GET IT STA ACRN AND SAVE FOR RETURN PARAMETER LDA P/G GET "RR" INDICATOR CPA ASCRR RELEASE RESOURCES?? RSS YES - GO AHEAD WITH DISMOUNT JMP INACT NO - JUST MARK DISC INACTIVE LDA SFLAG ARE WE UNDER SZA,RSS SESSION CONTROL? JMP DC.3 NO - SKIP SCAN OF OTHER SCB'S JSB SCAN YES - IS ALU MOUNTED TO ANY OTHER SESSION? JMP DC.4 YES - JUST DISMOUNT FROM SESSION CLA SINCE DISMOUNTING FROM SYSTEM LDB FLAG IF DISC IS INACTIVE, MUST CPB N1 MARK DISC ACTIVE FIRST JSB ACTIV (FOR D.RTR) * DC.3 LDA RTFLG GET DISC DISMOUNTED FLAG (FOR RETURN) IOR BIT14 SET FLAG THAT SAYS REALLY DISMOUNTED FROM SYSTEM STA RTFLG AND SAVE IT LDA ALU GET LU# OF DISC TO BE DISMOUNTED CMA,INA AND MAKE IT NEGATIVE STA TMP2 LDA OVRD. GET ANY POSSIBLE OVERRIDE BITS ADA .11 AND ADD THEM TO D.RTR STA FUNCT DISMOUNT FUNCTION CODE. JSB EXEC SCHEDULE D.RTR TO FIND DEF *+7 ALU AND REMOVE IT FROM DEF .23 DIRECTORY OF DISCS DEF D. DEF XEQT DEF FUNCT DEF TMP2 DEF SCBCD,I * JSB RMPAR GET RETURN PARAMETERS DEF *+2 DEF SM.BF LDA SM.BF D.RTR PASSED BACK SSA ANY ERRORS? JMP EXIT YES - RETURN WITH ERROR * LDB ALU DISMOUNTING LU 2 OR 3? CPB .2 JUST GO REMOUNT THEM JMP REMNT CPB .3 JMP REMNT * JSB FREE FREE ALU IN DISC POOL IF THERE DC.4 LDA SFLAG IN SESSION SZA œJþú MODE? JSB REMOV YES - DISMOUNT ALU FROM SCB CLA JMP EXIT RETURN * * REMNT LDA SFLAG IN SESSION SZA MODE? JSB REMOV YES - DISMOUNT ALU FROM SCB LDA ALU MAKE SURE MOUNTING -LU 2 CMA,INA OR -LU 3 STA DISID,I LDA .1 CHANGE FUNCTION CODE FROM STA CODE MOUNT TO DISMOUNT CLA SET UP PRIVATE GROUP INDICATOR STA P/G FOR A MOUNT AS A PRIVATE DISC. JMP REACL * * INACT LDB SFLAG CLA,INA SET INACTIVATE CODE SZB JSB ACTIV GO SET DISC INACTIVE CLA CLEAR FOR ERROR CODE JMP EXIT AND RETURN SKP * * * * SERCH SEARCHES CARTRIDGE DIRECTORY FOR CRN OR -LU * * ENTRY : B-REG CONTAINS STARTING ADDRESS OF SEARCH * A-REG CONTAINS CRN OR -LU TO BE SEARCHED FOR * * EXIT : PENLU CONTAINS LU # OF PENDING ENTRY * P+1 NOT FOUND * B-REG POINTS TO 1ST WORD OF 1ST EMPTY SPOT * P+2 FOUND CRN * B-REG POINTS TO ID WORD OF "FOUND" ENTRY * * SERCH NOP JSB RESLV RESOLVE INDIRECT ADDRESS IN B JUST IN CASE SSA CRN OR -LU? JMP LU.SH LU STA TMP2 SAVE CRN LDA MSKAL STA MASK DON'T NEED A MASK LDA .2 WANT 3RD WORD IN ENTRY STA OFFST JMP SER.0 * LU.SH CMA,INA MAKE LU POSITIVE STA TMP2 AND SAVE IT LDA B77 SET UP MASK FOR STA MASK BITS 0-5 CLA WANT 1ST WORD IN ENTRY STA OFFST SER.0 CMA,INA ADA .3 STA REM SER.1 LDA B,I SZA,RSS END OF DIRECTORY? JMP SERCH,I YES - RETURN, NOT FOUND AND B77 MASK TO LU# STA PENLU AND SAVE ADB OFFST LDA B,I GET DISC ID FROM ENTRY AND MASK ADB REM STEP POINT+]þúER TO ID WORD CPA TMP2 IS THIS THE ONE WE WANT? JMP SER.2 YES INB NO - STEP TO NEXT ENTRY JMP SER.1 AND GO CHECK IT OUT SER.2 ISZ SERCH STEP TO P+2 JMP SERCH,I RETURN SKP * * * * SCBCK : LU MOUNTED IN CALLERS SCB? * SCANS THE DISC'S MOUNTED LIST IN SCB FOR PENLU * * ENTRY : PENLU CONTAINS LU# TO BE SEARCHED FOR * * EXIT : P+1 - IT'S THERE AND ACTIVE * P+2 - IT'S THERE BUT MARKED INACTIVE * P+3 - NOT THERE * * * SCBCK NOP STB TMP1 LDA DISCL GET # DISCS TO BE CHECKED CMA,INA AND USE AS STA COUN1 A COUNTER. LDB MTDSC SCB.1 LDA B,I AND B377 CPA PENLU THIS DISC THE ONE WE WANT? JMP SCB.2 YES - RETURN INB ISZ COUN1 JMP SCB.1 GO LOOK AT NEXT ONE ISZ SCBCK DIDN'T FIND IT SO JMP SCB.3 GO RETURN P+3 * SCB.2 LDA B,I GET ENTRY AGAIN ALF,RAR ROTATE RIGHT 3 BITS SLA BIT 13 SET? INACTIVE? SCB.3 ISZ SCBCK YES SET RETURN TO P+2 LDB TMP1 JMP SCBCK,I RETURN * * * CKCRN : MAKES SURE THAT A CRN IS NOT ALREADY ACCESSIBLE TO CALLER * (IN HIS DISCS MOUNTED LIST OR A SYSTEM DISC) * * ENTRY - A = CRN TO BE SEARCHED FOR * * EXIT - P+1 A DISC THAT HAS THIS CRN IS ALREADY ACCESSIBLE * BY THE CALLER * P+2 ALL'S CLEAR * * CKCRN NOP STA SAVA KEEP CRN WE ARE SEARCHING FOR LDB ACLBF START SEARCHING AT BEGINNING OF CL CKCR1 LDA SAVA GET VALUE TO SEARCH FOR JSB SERCH SEARCH CL FOR VALUE IN A JMP CKCR3 NOT THERE SO EXIT AT P+2 JSB SCBCK FOUND ONE - SEE IF IT IS MOUNTED TO CALLER'S SCB JMP CKCRN,I THERE AND ACTIVE - EXIT P+1 JMP CKCRN,I THERE BUT INACTIVE - EXIT P+1 qþú LDA B7777 IF CALLER IS THE SYSTEM MANAGER CPA ID1 THEN SKIP THE SYSTEM DISC CHECK. JMP CKCR2 (BECAUSE SYSTEM DISC = PRIVATE FOR HIM) CPA B,I IS THIS A SYSTEM DISC? JMP CKCRN,I YES - EXIT P+1 CKCR2 INB INCREMENT POINTER AND JMP CKCR1 CONTINUE SEARCH * CKCR3 ISZ CKCRN STEP RETURN ADDRESS JMP CKCRN,I AND RETURN P+2 * SAVA NOP * * * * POLCK : SCAN DISC POOL AND CARTRIDGE DIRECTORY AND * FREE ANY ENTRIES IN THE DISC POOL THAT ARE MARKED * TAKEN BUT REALLY AREN'T MOUNTED. * * ENTRY : CL IS IN D.SDR * * POLCK NOP CLA CLEAR COUNTER FOR NUMBER OF STA TMP2 ENTRIES PASSED SO FAR IN POOL JSB RDSPL READ DISC POOL INTO BUFFER SM.BF LDA ASMBF FIRST WORD ADDRESS OF DISC POOL STA PTR1 POL.1 LDA PTR1,I GET DISC POOL ENTRY CPA N1 END OF DISC POOL? JMP POLCK,I YES - CHECK IS DONE SSA,RSS THIS ENTRY MARKED TAKEN? JMP POL.5 NO - GO TO THE NEXT ONE RAL,CLE,ERA YES CLEAR OFF THE SIGN BIT STA TMP1 AND KEEP IT TEMPORARILY LDB ACLBF GET ADDRESS OF DISC DIRECTORY POL.2 LDA B,I LOAD LU# FROM DISC DIRECTORY ENTRY SZA,RSS END OF DIRECTORY? JMP POL.4 YES - DIDN'T FIND LU# SO CLEAR FLAG AND B77 MASK TO LU# CPA TMP1 IS THIS IT? JMP POL.5 YES - THIS FLAG IS VALID ADB .4 POSITION TO NEXT DIRECTORY ENTRY JMP POL.2 AND GO CHECK IT * POL.4 LDA TMP1 CLEAR "TAKEN" FLAG BECAUSE THIS LU RAL,CLE,ERA ISN'T IN THE CARTRIDGE DIRECTORY STA PTR1,I CHANGE ENTRY IN COPY OF DISC POOL LDB PTR1 STUFF ADDRESS OF WORD TO BE STB BUFAD UPDATED INTO PLACE IN $SMVE CALL. JSB WDSPL UPDATE DISC POOL POL.5 ISZ PTR1 STEP TO NEXT DISC POOL ENTRY ISZ TMP2 INCREMENT POSITION COUNTER JMP POL.1 &þú AND GO CHECK IT. * * * * IMPRD MAKE AN IMPOSSIBLE READ TO A DISC UNIT TO GET * GET NUMBER OF TRACKS ON IT OR THE # SECTORS PER TRACK. * IF DISC IS LU 2 OR LU 3 THESE VALUES ARE CALCULATED * FROM BASE PAGE AND NO READ IS MADE. * * ENTRY - B-REG = LU# OF DISC * * EXIT - B-REG = # TRACKS ON THE SUBCHANNEL * ERROR = #SECTORS PER TRACK * * P+1 - DISC ERROR * P+2 - OK * * IMPRD NOP CPB .2 JMP LU.2 CPB .3 JMP LU.3 CCE SET UP FIRST WORD OF DOUBLE RBL,ERB WORD CONTROL WORD AS THE STB TMP1 DISC LU WITH THE SIGN BIT SET LDB PRC SECOND WORD OF THE CONTROL STB TMP2 WORD IS JUST FMP PRIVILEDGED BITS JSB XLUEX EXTENDED EXEC IMPOSSIBLE WRITE DEF *+7 DEF RDNAB DEF TMP1 ON LU + PRC -- NOT SWITCHED DEF ERROR BUFFER DEF .1 ONE WORD DEF N1 TRACK 10,000 DEF.0 DEF ZERO SECTOR 0 JMP IMR.2 ERROR RETURN - SKIP STEP TO P+2 JMP IMR.1 OK - STEP TO P+2 LU.2 LDA SECT2 GET SECTORS/TRACK LDB TATSD GET #TRACKS ON LU2 JMP IMR.0 LU.3 LDA SECT3 GET SECTORS/TRACK LDB TATSD #TRACKS ON LU 3 = -TATSD-TATLG ADB TATLG CMB,INB IMR.0 STA ERROR IMR.1 ISZ IMPRD IMR.2 JMP IMPRD,I RETURN * * * RESLV RESOLVES INDIRECT ADDRESS * * ENTRY : B-REG CONTAINS WORD TO BE RESOLVED * * EXIT : B-REG CONTAINS RESOLVED VALUE * * RESLV NOP SSB,RSS JMP RESLV,I RBL,CLE,ERB LDB B,I JMP *-4 SPC 4 * * * * ACTIV MARKS LU IN ALU ACTIVE OR INACTIVE IN DISCS MOUNTED LIST * * ENTRY : ALU CONTAINS LU# OF DISC TO BE MARKED ACTIVE OR * INACTIVE * * A = 0 ACTIVATE * A = 1 INACTIVATE * Þnþú MTDSC, IDSSW, DISCL ARE CALCULATED FOR CURRENT SCB * * ACTIV NOP STA TMP1 SAVE DIRECTION OF ACTIVE/INACTIVE JSB GTSCB READ IN A CLEAN COPY OF THE SCB DEF *+5 DEF SM.BF DEF .144 DEF ERROR DEF SESWD * LDA DISCL GET LENGTH OF DISCS MOUNTED LIST CMA,INA MAKE NEGATIVE AND STA COUN1 USE AS A COUNTER LDB MTDSC GET ADDRESS OF DISCS MOUNTED LIST ACT.1 LDA B,I GET ENTRY AND B377 MASK TO LU # CPA ALU THIS THE ONE WE'RE LOOKING FOR? JMP ACT.2 YES - GO MARK IT INB NO - STEP POINTER ISZ COUN1 INCREMENT THE COUNTER JMP ACT.1 LOOK AT NEXT ENTRY JMP ACTIV,I DIDN'T FIND IT SO RETURN * ACT.2 LDA TMP1 GET DIRECTION ERA GET LOWER BIT OF A INTO E-REG LDA B,I GET ENTRY AGAIN ALF,RAR PUT E-REG INTO BIT 13 OF A ERA,RAR RAR STA B,I * LDA IDSSW,I CALCULATE OFFSET PARAMETER CMA,INA FOR WRITE OF THE MODIFIED ADA .2 DISCS MOUNTED LIST STA TMP1 JSB $SMVE WRITE MODIFIED DISCS MOUNTED DEF *+6 LIST BACK TO SCB DEF .2 DEF SESWD DEF TMP1 DEF MTDSC,I DEF DISCL JMP ACTIV,I RETURN * SKP * * * * SPECF SETS UP 16-WORD SPECIFICATION ENTRY FOR PENDING DISC * * ENTRY - ALU CONTAINS LU# OF THE DISC * * NOTE: IF THERE IS A DISC ERROR ON THE IMPOSSIBLE READ, SPECF * DOES NOT RETURN, IT JUMPS INTO THE CLNUP SECTION. * * * SPECF NOP LDB .16 CLEAR OUT 16 WORDS TO BE CMB,INB FOR CARTRIDGE SPECIFICATION STB COUN1 ENTRY LDB ASMBF CLA STA B,I INB ISZ COUN1 JMP *-3 LDA IDENT,I WAS ASCII IDENTIFIER SPECIFIED? SZA JMP SPEC1 YES JSB CNUMD NO - CONVERT TERMINAL LU TO Šgþú DEF *+3 ASCII AND USE DEF TRMLU AS IDENTIFIER DEF SM.BF LDA WD1 REPLACE 1ST WORD WITH STA SM.BF CHARACTERS DC LDA SM.BF+1 CHANGE ANY ASCII IOR ASC0 BLANKS IN NEXT STA SM.BF+1 TWO WORDS TO LDA SM.BF+2 ASCII ZEROS IOR ASC0 STA SM.BF+2 JMP SPEC2 * SPEC1 DLD IDENT,I DST SM.BF LDA IDENT ADA .2 LDA A,I STA SM.BF+2 SPEC2 LDA SM.BF ADA SIGN STA SM.BF LDB CODE IF CODE = 3 AND A LABEL LDA LABEL,I WAS SPECIFIDE, CRN = LABEL,I CPB .3 OTHERWISE CRN = ACRN. SZA,RSS LDA ACRN STA SM.BF+3 LDB ALU JSB IMPRD CALL TO GET # SECTORS PER TRACK ON ALU JMP CLNUP DISC ERROR - GET THIS LU OUT OF THE SCB LDA SECT,I USE SECT\TRACK FROM IMPOSSIBLE READ IF SZA,RSS NOT SPECIFIED BY THE CALLER LDA ERROR STA SM.BF+6 LDA DIRTK - # DIRECTORY TRACKS STA SM.BF+8 ADA SIZE LAST FMP TRACK STA SM.BF+7 JMP SPECF,I * * SKP * * * * REMOV REMOVES A DISC FROM THE DISCS MOUNTED LIST * AND FROM THE SST IF NECESSARY * * ENTRY: ALU CONTAINS LU# OF DISC TO BE REMOVED * FROM SCB. * MTDSC, DISCL, IDSSW ARE CALCULATED FOR * CURRENT SESSION CONTROL BLOCK * * EXIT: ALU IS REMOVED FROM DISCS MOUNTED LIST. IF * SIGN BIT SET ON THAT ENTRY, IT IS ALSO REMOVED * FROM THE SST. DISCS MOUNTED COUNTER IS DECREMENTED. * * REMOV NOP JSB GTSCB READ CLEAN COPY OF DEF *+5 SCB IN CASE SST HAS DEF SM.BF BEEN CHANGED DEF .144 DEF ERROR DEF SESWD * LDA DISCL GET # DISCS IN DISCS MOUNTED CMA,INA LIST; MAKE NEGATIVE AND STA COUN1 USE AS A COUNTER LDB 7îþúMTDSC REM.1 LDA B,I GET ENTRY RAL,CLE,ERA BIT 15 TO E-REGND 15 AND AND B377 MASK TO LU CPA ALU IS THIS THE ONE? JMP REM.2 YES INB NO - STEP TO NEXT ENTRY ISZ COUN1 INCREMENT COUNTER JMP REM.1 AND GO TRY IT JMP REMOV,I NOT THERE SO JUST RETURN * REM.2 CLA CLEAR ENTRY IN STA B,I DISCS MOUNTED LIST SEZ,RSS FLAG WASN'T SET SO JMP REM.5 DON'T REMOVE FROM SST LDB IDSSW GET SST LENGTH WORD LDA B,I (IT'S NEGATIVE) AND STA COUN1 USE AS A COUNTER INB STEP TO SST ENTRIES * REM.3 LDA B,I GET ENTRY INA (LU'S IN SST ARE SAVED AS LU - 1) AND B377 MASK TO SYSTM LU# CPA ALU IS THIS THE ONE? JMP REM.4 YES INB NO - STEP TO NEXT ENTRY ISZ COUN1 INCREMENT COUNT JMP REM.3 AND GO TRY IT JMP REM.5 NOT THERE * REM.4 LDA N1 FREE UP ENTRY IN STA B,I SST REM.5 LDB MTDSC DECREMENT DISCS MOUNTED ADB N1 COUNTER LDA B,I ADA N1 STA B,I * JSB $SMVE CALL $SMVE TO UPDATE SCB DEF *+6 DEF .2 DEF SESWD DEF ZERO DEF IDSSW,I DEF LNGTH * JMP REMOV,I * SKP * * * * ADD ADDS A DISC TO THE DISCS MOUNTED LIST * AND ADDS AN ENTRY FOR IT IN THE SST IF ONE * IS NOT ALREADY THERE. * DECREMENTS NUMBER-OF-DISCS-MOUNTED COUNTER * * ENTRY: ALU CONTAINS LU# OF DISC TO BE ADDED TO * THE SCB * MTDSC, DISCL, IDSSW ARE CALCULATED FOR CURRENT * SESSION CONTROL BLOCK. * * EXIT: ALU IS ADDED TO THE DISCS MOUNTED LIST. IF NOT * IN THE SST, IT IS ALSO ADDED THERE. DISCS MOUNTED * COUNTER IS DECREMENTED. * * P+1 ERROR RETURN SST CONFLI¥þúCT CAN'T ADD ALU * P+2 SUCCESSFUL RETURN * * * ADD NOP CLA STA TMP1 HOLDS ADDRESS OF 1ST EMPTY ENTRY FOUND IN SST STA FLAG INDICATES IF ALU WAS ALREADY IN SST JSB GTSCB READ NEW COPY OF SCB DEF *+5 IN CASE SST HAS CHANGED DEF SM.BF DEF .144 DEF ERROR DEF SESWD * LDB IDSSW GET SST LENGTH WORD LDA B,I (IT'S NEGATIVE) AND STA COUN1 USE AS A COUNTER INB STB TMP2 KEEP AROUND ADDR OF 1ST SST ENTRY ADD.1 LDA B,I GET SST ENTRY CPA N1 EMPTY? STB TMP1 YES - KEEP ADDRESS FOR SPOT TO ADD ALF,ALF SHIFT AND MASK CLE,INA (LU'S IN SST ARE SAVED AS LU - 1) AND B377 TO SYSTEM LU CPA ALU IS THIS THE ONE? CCE YES - SET E = 1 IF SYSTEM LU MATCHES LDA B,I GET ENTRY AGAIN INA (LU'S IN SST ARE SAVED AS LU - 1) AND B377 MASK TO SESSION LU# SEZ,RSS (LU'S IN SST ARE SAVED AS LU - 1) JMP ADD.2 CPA ALU IS THIS SESSION LU SAME AS ALU? JMP ADD.3 SYS = SES = ALU DON'T ADD TO SST ADD.2 CPA ALU JMP ADD.6 SES = ALU # SYS ERROR ALU IS ANOTHER SES LU INB STEP TO NEXT ENTRY ISZ COUN1 INCREMENT COUNT JMP ADD.1 AND TRY NEXT ENTRY * LDB TMP1 GET EMPTY SPOT ADDRESS SZB,RSS DID WE FIND ONE? JMP EX66 NO - SST'S FULL LDA ALU YES - SET UP ENTRY WITH ADA N1 SUBTRACT 1 TO GET IN SST LU FORMAT ALF,ALF ALU AS SYSTEM AND SESSION ADA ALU LU #'S AND STUFF IT IN SST ADA N1 SUBTRACT 1 TO GET IN SST LU FORMAT STA B,I LDA SIGN SET UP TO SET SIGN BIT IN ENTRY STA FLAG IN DISCS MOUNTED LIST * ADD.3 LDA DISCL GET #ENTRIES IN DISCS MOUNTED CMA,INA LIST; MAKE NEGATIVE ú@þúSTA COUN1 AND USE AS A COUNTER LDB MTDSC ADD.4 LDA B,I GET ENTRY FROM DISCS MOUNTED LIST SZA,RSS EMPTY? JMP ADD.5 YES - CAN USE THIS ONE INB NO - STEP TO NEXT ENTRY ISZ COUN1 JMP ADD.4 JMP EX63 DISCS MOUNT LIST IS FULL! * ADD.5 LDA ALU GET LU# ADA FLAG ADD POSSIBLE SIGN BIT ADA P/G SET BIT 14 IF MOUNTED AS GROUP STA B,I AND STORE IN DISCS MOUNTED LIST LDB MTDSC INCREMENT # DISCS ADB N1 MOUNTED COUNTER LDA B,I INA STA B,I * JSB $SMVE CALL $SMVE TO UPDATE SCB DEF *+6 DEF .2 DEF SESWD DEF ZERO DEF IDSSW,I DEF LNGTH * ISZ ADD ADD.6 JMP ADD,I * SKP * * * * FREE CLEARS BUSY BIT ON ENTRY FOR ALU * IF NOT THERE, JUST RETURN * * ENTRY: ALU CONTAINS LU# TO BE FREED * * FREE NOP CLA CLEAR COUNTER FOR NUMBER OF STA TMP2 ENTRIES PASSED SO FAR IN POOL. JSB RDSPL READ DISC POOL INTO BUFFER SM.BF LDB ASMBF GET STARTING ADDRESS OF DISC POOL FRE.1 LDA B,I GET DISC POOL ENTRY CPA N1 END? JMP FREE,I END OF THE DISC POOL SO RETURN RAL,CLE,ERA GET RID OF POSSIBLE SIGN BIT CPA ALU IS THIS THE ONE? JMP FRE.2 YES INB NO - STEP TO NEXT ENTRY ISZ TMP2 INCREMENT POSITION COUNTER JMP FRE.1 AND GO CHECK IT * FRE.2 STA B,I UPDATE CHANGED ENTRIES IN POOL COPY STB BUFAD STUFF ADDRESS OF WORD TO BE UPDATED JSB WDSPL GO UPDATE THIS WORD IN REAL DISC POOL LDA RTFLG DISC HAS BEEN RETURNED CCE TO DISC POOL SO SET RAL,ERA SIGN BIT ON DISC LU STA RTFLG AS A FLAG. JMP FREE,I RETURN * * * * ALLOC SET BUSY BIT ON ENTRY FOR ALU * IF NOT THERE, JUST RETURN _wþú* * ENTRY: ALU CONTAINS LU# TO BE ALLOCATED * * ALLOC NOP CLA CLEAR COUNTER FOR NUMBER OF STA TMP2 ENTRIES PASSED SO FAR IN POOL JSB RDSPL READ DISC POOL INTO BUFFER SM.BF LDB ASMBF GET STARTING ADDERSS OF DISC POOL COPY ALL.1 LDA B,I GET DISC POOL ENTRY CPA N1 END? JMP ALLOC,I YES - JUST RETURN CPA ALU IS THIS THE ONE? JMP ALL.2 YES INB NO - STEP TO NEXT ENTRY ISZ TMP2 INCREMENT POSITION COUNTER JMP ALL.1 AND GO CHECK IT ALL.2 ADA SIGN ADD SIGN BIT TO LU# STA B,I STORE LU# + FLAG BACK IN DISC POOL COPY STB BUFAD STUFF ADDRESS OF WORD TO BE UPDATED JSB WDSPL UPDATE ENTRY IN REAL DISC POOL JMP ALLOC,I RETURN * * * * RDSPL READ DISC POOL INTO BUFFER SM.BF * * RDSPL NOP XLA $DSCS GET STARTING ADDRESS OF DISC POOL ADA N1 IF $DSCS IS 0 OR LESS THAN 0 SSA,RSS THEN THERE IS NO DISC POOL OR JMP RD.1 IT IS EMPTY SO SKIP READ CCB PUT A -1 IN FIRST WORD OF DISC POOL STB SM.BF BUFFER TO MAKE ROUTINES THINK IT'S THE END JMP RDSPL,I AND RETURN RD.1 JSB $SMVE DEF *+6 DEF .1 READ DEF $DSCS ADDRESS OF DISC POOL DEF ZERO NO OFFSET DEF SM.BF READ INTO BUFFER DEF .64 64 WORDS JMP RDSPL,I * * * * WDSPL UPDATE AN ENTRY IN THE DISC POOL * * WDSPL IS NEVER CALLED UNLESS THERE REALLY IS * A DISC POOL. * * * ENTRY: BUFAD CONTAINS ADDRESS OF WORD TO BE UPDATED * TMP2 CONTAINS OFFSET IN DISC POOL WHERE ENTRY IS * TO BE REPLACED * * WDSPL NOP JSB $SMVE DEF *+6 DEF .2 DEF $DSCS DEF TMP2 BUFAD NOP DEF .1 JMP WDSPL,I SKP * * * * SCAN SCANS THE DISCS MOUNTED LIÁþúSTS OF EACH ACTIVE SCB * TO MAKE SURE THE LU# TO BE DISMOUNTED IS NOT MOUNTED * TO ANYONE ELSE. * * ENTRY: ALU CONTAINS LU# TO SEARCH FOR * $SHED IS DECLARED AN EXTERNAL * * EXIT: BUF IS GARBAGE * P+1 FOUND AT LEAST ONE OTHER SCB THAT HAS * ALU MOUNTED TO IT * P+2 NONE WERE FOUND * * SCAN NOP XLA $SHED GET LIST HEADER STA PTR1 SCAN1 CPA ZERO END OF LIST? JMP SCAN4 YES - NONE WERE FOUND LDB $SMLK OFFSET FROM SST LENGTH TO LINK WORD CMB,INB MAKE POSITIVE ADA B ADD TO LINK WORD STA TMP1 HAVE EQUIVALENT TO SESSION WORD LDB SESWD IF THIS IS OUR OWN CPB A SCB THEN DON'T JMP SCAN3 SCAN IT * JSB $SMVE READ DISC LIMIT WORD DEF *+6 AND SST LENGTH WORD DEF .1 DEF TMP1 DEF $SMDL DEF SM.BF DEF .2 * LDA SM.BF SAVE DISC LIMIT STA COUN1 LDA SM.BF+1 GET SST LENGTH WORD CMA,INA MAKE POSITIVE AND ADD ADA .2 TWO (FOR 2 LENGTH WORDS) STA TMP2 HAVE OFFSET FROM SST LENGTH TO 1ST WORD * OF DISCS MOUNTED LIST JSB $SMVE READ DISCS DEF *+6 MOUNTED LIST DEF .1 DEF TMP1 DEF TMP2 DEF SM.BF DEF COUN1 * LDA COUN1 MAKE LENGTH OF DISCS CMA,INA MOUNTED LIST A STA COUN1 NEGATIVE COUNTER LDB ASMBF SCAN2 LDA B,I GET ENTRY AND B377 GET RID OF POSSIBLE SIGN BIT CPA ALU IS THIS ALU? JMP SCAN,I YES - FOUND AT LEAST ONE OTHER PLACE ALU MOUNTED INB STEP TO NEXT ENTRY ISZ COUN1 INCREMENT COUNTER AND JMP SCAN2 GO CHECK IT * SCAN3 JSB $SMVE DONE WITH THIS SCB DEF *+6 CHASE CHAIN TO DEF .1 THE NEXT׬œš– SCB DEF TMP1 DEF $SMLK DEF PTR1 DEF .1 LDA PTR1 JMP SCAN1 * SCAN4 ISZ SCAN ALL THE WAY THRU AND DIDN'T JMP SCAN,I FIND ALU MOUNTED ANYWHERE ELSE * * * EXN1 LDA N1 RSS EX12 LDA .12 RSS EX50 LDA .50 RSS EX53 LDA .53 RSS EX54 LDA .54 RSS EX56 LDA .56 RSS EX62 LDA .62 RSS EX63 LDA .63 RSS EX64 LDA .64 RSS EX65 LDA .65 RSS EX66 LDA .66 EXIT STA ER,I LDB ALU PRESET FOR MOUNT CALL CMB,INB PUT -LU# IN B-REG LDA DCFLG GET FUNCTION CODE SSA WAS THIS A DISMOUNT INSTEAD? LDB RTFLG YES - GET DISMOUNT RETURN LDA DEF.0 CLEAR OUT INCOMING PARAMETERS STA ER FOR THE NEXT CALL TO DCMC STA CODE STA DISID STA P/G STA SIZE STA IDENT STA DIRTK STA LABEL STA SCBCD STA SECT LDA ACRN JMP DCMC,I END «Óœÿÿ ÿýh‡ ÿ92067-18177 1903 S C0122 &UT.BF              H0101 ~{ASMB,R,L * NAME: UT.BF * SOURCE: 92067-18177 * RELOC: 92067-16125 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM UT.BF,7 92067-16125 REV.1903 780714 ENT UT.BF SESSION MONITOR UTILITY BUFFER * UT.BF BSS 256 SESSION MONITOR UTILITY BUFFER * END fÿÿ ÿýio ÿ92067-18178 1940 S C0122 OPENF0 OPEN FILE OR LU SUBR OUT             H0101 3UþúASMB,R,L,C HED OPEN * NAME: OPENF * SOURCE: 92067-18178 * RELOC: 92067-16125 * PGMR: M.L.K.,N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OPENF,7 92067-16125 REV.1940 790724 ENT OPENF EXT XLUEX, CLOSE EXT .ENTR, OPEN, LURQ SUP * * OPENF IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPENF(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY OR LU * TO OPEN * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF î¤þú128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * -32 CARTRIDGE NOT FOUND * * SKP OPENF NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA OP STA SC STA LU STA IBLK CLA RESET ZERO WORD STA ZERO LDA OPENF STA DPENF JMP DPENF+1 * * MIGHT NEED TO CLEAR ZERO * DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO * DPENF NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS JMP EXIT NO: ERROR - EXIT * JSB CLOSE CLOSE DEF *+2 IF DEF DCB,I OPEN SZA SKIP IF NO ERROR CPA N11 OR IF NOT OPEN CLE,RSS JMP EXIT ELSE TAKE ERR EXIT * LDA NAME,I GET FILE NAME ADA N20K IS IT LESS THAN SSA ASCII BLANK IN UPPER BYTE? JMP OPNLU YES, ASSUME ITS AN LU * JSB OPEN NO, ASSUME ITS A FILE DEF OPRTN AND OPEN IT DEF DCB,I DEF ERR,I DEF NAME,I DEF OP,I DEF SC,I DEF LU,I DEF IBLK,I OPRTN JMP DPENF,I EXIT SKP OPNLU JSB XLUEX CALL FOR STATUS AND DEF STRTN DEVICE TYPE DEF STAT Åoþú DEF NAME,I DEF DVT6 DEF EQT4 DEF SUBC STRTN JMP ER18 ILLEGAL LU ERROR RETURN * LDA DVT6 GET STATUS WORD AND TYPE ISOLATE DEVICE TYPE STA DVT6 SAVE CLB ASL 8 POSITION DEVICE TYPE TO LOWER BYTE OF B STB DEVTP * LDA MNDSC GET MINIMUM DISC TYPE ADA B IF LESS, OK SSA JMP NOTDS OK, NOT DISC * LDA MXDSC GET MAXIMUM DISC TYPE ADA B TEST VALUE SSA,RSS JMP NOTDS OK, NOT DISC * LDA N17 ERROR - DISC LU JMP EXIT * * SET UP DCB * NOTDS LDA DCB GET DCB POINTER STA DCBPT AND SAVE IT LDA DUMMY GET DUMMY DCB FLAG STA DCBPT,I AND STORE IN DCB0 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET DEVICE TYPE * LDA DVT6 GET DEVICE TYPE AND STA DCBPT,I STORE IN DCB1 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET FILE TYPE * CLA SET FILE TYPE TO 0 STA DCBPT,I AND STORE IN DCB2 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET LU AND SUBFUNCTION * STA MINCR CLEAR MINI-CARTRIDGE FLAG LDA DEVTP GET DEVICE TYPE LDB SUBC GET DEVICE SUBCHANNEL SZB,RSS SUBCHANNEL ZERO? JMP OPT.1 YES - CAN'T BE A MINI-CARTRIDGE * ADB N3 TEST WITH MAX MINI-CR SUBCHANNEL + 1 CPA .5 DEVICE TYPE 5? SSB,RSS YES - AND SUBCHANNEL 1 OR 2? JMP OPT.1 NO - NOT A MINICARTRIDGE * ISZ MINCR SET MINI-CARTRIDGE FLAG CLB CLEAR INTERACTIVE FLAG (NOT INTERACTIVE) JMP OPT.2 AND GO SET IT. * OPT.1 CLB KNOW IT'S NOT A MINI-CARTRIDGE - SEE IF SZA,RSS IT'S INTERACTIVE TYPE ZERO? CCB YES - SET INTERACTIVE FLAG ADA N8 TEST WITH MAX INTERACTIVE TYPE + 1 SSA,RSS TYPE 7 OR LESS? ŽLþú JMP OPT.2 NO - GO SET INIT FLAG WITH B = 0 * ADA .5 NOW SEE IF IT'S TYPE 3 OR GREATER SSA,RSS IS IT? CCB YES, SET INTERACTIVE FLAG B = -1 OPT.2 STB INIT SAVE INTERACTIVE FLAG LDA OP,I GET THE OPTION WORD RAR,RAR GET BIT 3 - USE SUPPLIED OPTION RAR,ERA TO THE E-REGISTER LDA OP,I GET OPTION WORD AGAIN AND FMASK ISOLATE FUNCTION BITS SEZ SUPPOSED TO USE IT? JMP ADDLU YES - GO ADD IT IN CLA NO - GET RID OF IT SZB IF DEVICE IS INTERACTIVE LDA ECHO THEN DEFAULT TO ECHO ADDLU IOR NAME,I ADD IN THE LU STA DCBPT,I AND STORE IN DCB3 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET EOF CODE * LDA LEADR PRESET TO LEADER FUNCTION CODE LDB DEVTP GET THE DEVICE TYPE CPB .2 PUNCH? JMP STEOF YES - GO SET CODE CPB .1 P T READER? JMP STEOF YES - GO SET CODE * LDA EOF GET WRITE EOF CODE LDB MINCR GET MINICR FLAG SZB MINICARTRIDGE? JMP STEOF YES - GO SET CODE * LDB DEVTP GET DEVICE TYPE AGAIN ADB M16 CHECK IF >17 OCTAL SSB,RSS JMP STEOF YES - GO SET CODE * LDA PAGE ALL OTHERS GET PAGE EJECT STEOF IOR NAME,I ADD IN THE LU STA DCBPT,I ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET SPACING * LDA BOTH SET A TO BOTH STA DCBPT,I STORE IN DCB5 ISZ DCBPT INCREMENT TO NEXT DCB WORD * * SET READ/WRITE FLAG TO BOTH * LDB BOTH PRESET BOTH READ AND WRITE FLAGS LDA EQT4 GET EQT4 FROM STATUS REQUEST AND B77 MASK TO SELECT CODE SZA,RSS IF IT'S ZERO THIS IS EQT 0 = BIT BUCKET CLB,INB SO SET READ/WRITE CODE TO WRITE ONLY STB DCBPT,I STORE IN DCB 6 ISZ DCBPT INCREMENT ¢ãþúTO NEXT DCB WORD * * SET SECURITY CODE MATCH AND OPEN MODE TO UPDATE * LDA SCOPM GET SEC CODE SET AND OPEN MODE SET STA DCBPT,I STORE IN DCB7 * * SET OPEN FLAG * LDA XEQT GET OPEN FLAG LDB DCBPT INCREMENT DCB POINTER TO ADB .2 WORD 9 STA B,I STORE OPEN FLAG IN DCB9 * * SET RECORD COUNT TO 1 * ADB .4 INCREMENT TO WORD 13 CLA SET WORD 13 AND WORD STA B,I TO A DOUBLE WORD 1 INB INA STA B,I INB POINT TO DCB15 STB DCBPT AND SAVE * * LOCK THE DEVICE IF NOT INTERACTIVE * CLA,INA SET A TO 1 STA DCBPT,I SET DEFAULT TO "DON'T UNLOCK" LDA OP,I GET OPEN OPTION SLA EXCLUSIVE OPEN? JMP EXOK INTERACTIVE SO DON'T LOCK LDA INIT TEST THE INTERACTIVE FLAG SZA INTERACTIVE? JMP EXOK INTERACTIVE - SO DON'T LOCK * LDA NAME,I SET BIT 13 ON LU WORD IOR BIT13 SO 8 BITS WILL BE USER FOR STA SUBC LU IN THE RESULTING EXEC CALL * JSB LURQ LOCK CALL DEF *+4 DEF OPTN OPTION WORD DEF SUBC LU WORD WITH BIT 13 SET DEF .1 ONE LU JMP ER18 ERROR ON LOCK SZA CHECK IF ITS NOT ZERO JMP LCKER YES, ERROR NO RN'S AVAILABLE OR ALREADY LOCKED * STA DCBPT,I STORE LOCK SUCCESSFUL IN DCB14 EXOK CLA SET NO ERROR EXIT STA ERR,I STORE IN ERROR CODE JMP DPENF,I RETURN * * ERROR RETURNS * LCKER LDA N36 LOCK NOT GRANTED JMP EXIT * ER18 LDA N18 JMP EXIT SKP * * CONSTANTS * DZERO DEF ZERO ZERO NOP N3 DEC -3 N8 DEC -8 N10 DEC -10 N11 DEC -11 N20K OCT 160000 NEGATIVE 20K OCTAL STAT OCT 100015 STATUS EXEC WITH SIGN TYPE OCT 37400 MNDSC DEC -24 NEGATIVE TYPE 30 MXDSC DEC -27 h¹$" NEGATIVE TYPE 33 DUMMY OCT 177700 DUMMY DCB FLAG ECHO OCT 400 PAGE OCT 1100 LEADR OCT 1000 EOF OCT 100 BOTH OCT 100001 M16 DEC -16 .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 OPTN OCT 140001 N36 DEC -36 N18 DEC -18 N17 DEC -17 FMASK OCT 63700 BU/UE/TR/EC/BI MASK XEQT EQU 1717B SCOPM OCT 100010 BIT13 OCT 20000 B77 OCT 77 * * VARIABLES * DVT6 NOP STORAGE FOR DVT6 DEVTP NOP DEVICE TYPE EQT4 NOP DCBPT NOP DCB POINTER INIT NOP INTERACTIVE FLAG 0=NOT INT, #0=INT SUBC NOP MINCR NOP * A EQU 0 B EQU 1 * END EQU * END ‚#$ÿÿ ÿýj u ÿ92067-18179 1903 S C0122 &FG.LU              H0101 }{þúASMB,Q,C * NAME: FG.LU * SOURCE: 92067-18179 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FG.LU,8 92067-16125 REV.1903 780926 ENT FG.LU EXT $SMVE SCB MOVE ROUTINE EXT .ENTP GUESS EXT $LIBR,$LIBX * * THE FG.LU (FUDGE LU) ROUTINE MODIFIES THE VARIABLE * PART OF THE USERS SST TO IMPLEMENT THE SL (OR LU) * COMMAND. * * CALLING SEQUENCE: * * ERR=FG.LU(SESLU,SYSLU,L3,BUF) * * WHERE: ERR IS THE RETURNED ERROR CODE =0 IMPLIES * NO ERROR - ELSE A STANDARD FMGR ERROR * SESLU IS THE SESSION LU TO SET UP OR MODIFY * SYSLU IS THE SYSTEM LU THAT IS TO BE CONNECTED * TO . IF IS ASCII "- " * THEN SESLU IS REMOVED FROM THE VARIABLE PART * OF THE SST. * IF LU IS ALREADY PRESENT AS A SYSTEM * LU IN THE USERS SST THE NEW CONNECTION IS MADE * IF IS ALREADY PRESENT IN THE VARIABLE * PART OF THE USERS SST THAT ENTRY IS CHANGED * (OR DELETED IF "- "). * L3 IF IS NOT PRESENT IN THE USERS SST * THEN MUST =0 OR A CAPABILITY FAULT WILL BE * DETECTED AND AN ERROR RETURNED. IF =0 * THE NEW CONNECTION WILL BE MADE. * BUF IS A 90 (OR SO) WORD BUFFER WHICH THE ROUTINE * USES TO HOLD THE SST WHILE STUDYING IT. * THIS ELIMINATES THE NEED FOR A LOCAL BUFFER IN * ÇÍþú THIS ROUTINE. * * SESLU NOP SYSLU NOP L3 NOP BUF NOP FG.LU NOP JSB $LIBR ROUTINE DOES NOT WANT TO BE INTERRUPTED NOP JSB .ENTP DEF SESLU FETCH THE PARAMETERS * CCA GET THE LU'S INTO WORKABLE FORM STA NGFLG SET THE NOT "- " FLAG ADA SESLU,I TABEL ENTRIES ARE -1 AND B377 KEEP ONLY 8 BITS STA SESLU SAVE THE RESULT STA B PUT IN B FOR TEST LDA NOSWT CAN NOT SWITCH LU 1 SZB,RSS IF TRYING THEN JMP EXIT EXIT WITH ERROR * LDA XEQT SET UP TO GET THE SESSION WORD ADA D32 FROM THE ID XLA A,I JUST IN CASE STA SID SAVE FOR THE CALL TO $SMVE JSB $SMVE MOVE IN THE SST DEF *+6 DEF D1 DEF SID DEF D0 ZERO OFSET FROM FRONT DEF BUF,I USE USERS BUFFER DEF D90 READ IN 90 WORDS * * FIRST WE CLASIFY SYSLU AS EITHER "- " OR IN THE SST OR NOT. * LDA BUF SET UP A POINTER STA SSTA LDA A,I GET THE LENGTH OF THE SST STA COUNT SET THE COUNTER LDA SYSLU,I GET THE DESIRED SYSLU CPA MINUS IS IT "- " JMP FGNEG YES GO SET THE FLAG TO SHOW IT IS SO. * ADA N1 NO ADJUST TO -1 NOTATION AND B377 SAVE THE RESULT ALF,ALF ROTATE TO THE HIGH HALF OF THE WORD STA SYSLU AND SAVE FOR LATER LDB L3,I GET THE CAPABILITY FLAG SZB IF HE HAS CABILITY IN ANY CASE OR CPA C377 IF HE IS SETTING A BIT BUCKET JMP FGFND LET HIM DO IT * FGSSH ISZ SSTA ELSE SEARCH FOR THE TARGET LU LDA SSTA,I IN HIS SST ALREADY AND C377 ISOLATE CPA SYSLU THIS IT? JMP FGFND YES ALL IS OK * ISZ COUNT NOPE ANY MORE TO TRY?? JMP FGSSH YES TRY THE NEXT ONE * LDA CAPER OH NO HE DID A NO NO N{þúSLAP HIS JMP EXIT HAND * B377 OCT 377 NOSWT DEC 42 D32 DEC 32 CAPER DEC 46 CAPABILITY ERROR D1 DEC 1 D0 NOP D90 DEC 90 SID NOP SSTA NOP COUNT NOP MINUS ASC 1,- N1 DEC -1 C377 OCT 177400 COMPLEMENT OF 377 TADD NOP * * WE ARE FREE TO DO WHAT NEEDS TO BE DONE SO NOW CHECK THE * USERS SIDE IN THE TEMP AREA FOR A PRIOR DEF OF THIS LU. * WE ASSUME THAT ANY IMPLICATIONS SUCH AS LOSS OF A SPOOL LU * OR AN EXISTING ENTRY OF THE SAME TYPE ARE ALREADY TAKEN * CARE OF. (CAN'T FIX HERE ANYWAY BECAUSE WE ARE PRIVILEDGED * AND PRIVILEDGED FOLKS DON'T DO ANY MORE THAN THEY WANT TO.) * FGNEG ISZ NGFLG THE "- " FLAG IS SET NGFLG OCT -1 SET TO -1 ON ENTRY * FGFND CLA SET UP TO STA TADD SCAN THE VARIABLE SST STA L3 DON'T NEED PERMISSION ANY MORE LDB BUF GET THE BUFFER ADDRESS TO B FGUSH INB STEP TO THE FIRST ENTRY LDA B,I GET IT AND B377 AND ISOLATE THE SESSION SIDE CPA B377 IF EMPTY STB L3 SAVE AS A POSSIBLE PLACE FOR THE NEW SWITCH CPA SESLU ENTRY ALREADY IN THE TABLE? STB TADD YES SAVE THE ADDRESS - WE WILL OVER WRITE SZA THIS THE END OF THE VARIABLE PART? JMP FGUSH NO CONTINUE THE SEARCH * LDA NOTHR GET THE NOT FOUND ERROR CODE LDB NGFLG IF THE NEGATIVE FLAG IS SET ADB TADD AND THE ENTRY NOT FOUND SZB,RSS THEN JMP EXIT WHINE ABOUT IT * LDA SSTFU GET THE SST FULL ERROR LDB TADD CHECK IF WE EITHER FOUND SZB,RSS AN OLD ONE OR LDB L3 AN EMPTY ONE SZB,RSS WELL? JMP EXIT SO SORRY NO ROOM NOW * * OK LETS DO IT B= ADDRESS TO MODIFY, FIGURE NEXT ENTRY * -1 IF "- " OPTION * ISZ NGFLG IF "- " FLAG SET WE DON'T SKIP CCA,RSS -1 FOR "- " OPTION LDA SESLU ELSE SqET UP THE DESIRED SWITCH IOR SYSLU STA B,I SET THE NEW ENTRY STB BUFAD SET UP TO WRITE BACK ONE SST WORD CMB,INB COMPUTE THE OFFSET ADB BUF CMB,INB SET IT POSITIVE FOR THE CALL STB OFF AND SET IT JSB $SMVE SEND THE WORD BACK TO THE SST DEF *+6 DEF D2 THIS IS A WRITE DEF SID DEF OFF BUFAD NOP DEF D1 ONE WORD CLA WOW! AN OK EXIT EXIT JSB $LIBX EXIT DEF FG.LU * SSTFU DEC 66 SST FULL ERROR NOTHR DEC 2068 LU NOT FOUND (68) +2000 (NOT A SEVERER ERROR) D2 DEC 2 OFF NOP A EQU 0 B EQU 1 XEQT EQU 1717B END 3åÿÿ ÿýkt ÿ92067-18180 1903 S C0122 &SELUR              H0101 {¤þúASMB,L,C,Q * NAME: SELUR * SOURCE: 92067-18180 * RELOC: 92067-16125 * PGMR: G.A.A.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SELUR,7 92067-16125 REV.1903 790322 ENT SELUR EXT MESSS,.ENTR,LUTRU,.DFER,PTERR * * * THE FUNCTION OF THIS SUBROUTINE IS TO FORMAT THE FOLLOWING * MESSAGE: * * SELU UUU= LU#YYY EQQ S X D * * WHERE: UUU IS A GIVEN SESSION LU * YYY IS THE RELATED SYSTEM LU * QQ IS THE RELATED EQT NUMBER * X IS THE SUBCHANNEL (IF NOT 0) * D IS THE DECICE STATUS (D=DOWN ELSE BLANK) * * THE MESSAGE BEYOND THE "=" IS FORMATED BY THE SYSTEM LU PROCESSOR * AND MAY VARY AS THE SYSTEM LU PROCESSOR CHANGES. IF THE LU IS * NOT DEFINED (AS PER LUTRU) THE RESULT IS : * SLU UUU= NOT DEFINED * * CALLING SEQUENCE: * * ILOG=SELUR(UUU,WBUF) * OR * ILOG=SELUR(UUU,WBUF,ISCB) * * WHERE: UUU IS THE LU TO BE REPORTED * WBUF IS THE BUFFER WHICH IS TO CONTAIN THE MESSAGE. * (IT IS ASSUMED THAT THIS BUFFER IS LARGE ENOUGH * I.E. NO ERROR CHECKS ARE MADE ON POSSIBLE BUFFER * OVERRUN.) * ILOG IS THE RETURN BUFFER LENGTH IN CHARACTRERS. * ILOG WILL BE NEGATIVE (I.E. IT MAYBE USED IN * THE EXEC I/O CALL). * * ISCB IS THE SCB TO SCAN. DEFAULT IS TO USE XEQT'S SCB. * LU NOP BUF NOP ISCB DEF NOP SELUR NOP JSB .ENTR GET THE PRAMS. DEF LU JSB LUTRU TRANSLATE THE LU DEF LUT.1 DEF oèþúLU,I DEF SYSLU AND SAVE THE RESULT DEF ISCB,I SCAN SPECIFIED SCB (OPTIONAL) LUT.1 EQU * * DLD "SLU" MOVE "SLU " TO THE DST BUF,I SUPPLIED BUFFER ISZ BUF STEP THE POINTER ISZ BUF STEP THE POINTER LDA LU,I GET THE NUMBER AND AND B377 ISOLATE THE BITS JSB CNUM CONVERT THE NUMBER TO ASCII RRL 8 AB = 123B (B=ASCII BLANK) ADB B35 AB = 123= DST BUF,I PUT IT IN THE BUFFER ISZ BUF STEP ALONG ISZ BUF STEP ALONG LDA "LU" BUILD A STA BUF,I LU,XXX LDA BUF COMMAND STA CALL SAVE THE ADDRESS FOR MESSS LDA SYSLU GET THE RETURN FROM LUTRU SSA IF ERROR JMP ILLU GO PROCESS THE "NOT DEFINED" * CPA B377 THIS THE MAGIC LU?? JMP IO26E YES GO REPORT IT AS SUCH * ISZ BUF STEP ALONG SZA,RSS IF RESULT IS ZERO JMP ZERO GO SET UP A ZERO RETURN (MESSS WON'T DO IT) * JSB CNUM AB=B123 CONVERT THE NUMBER ADA HCOMA AB=,123 PUT IN THE COMMA DST BUF,I PUT RESULT IN THE BUFFER LDA XEQT GET THE KEY TO PASS TO ADA D32 TO MESSS TO GET THE XLA A,I DESIRED RESULT CMA,INA SET NEG TO OVER-RIDE STA SCB SET FOR MESSS JSB MESSS DO THE CALL DEF MRTN CALL NOP USER BUFFER ADDRESS DEF D6 6 CHARS IN DEF D1 CONSOUL LU DEF SCB KEY MRTN ADA N8 ADD THE "SLU UUU= " LENGTH LDB DNOP RESET OPTIONAL SCB PARAMETER STB ISCB JMP SELUR,I AND RETURN * IO26E DLD IO26 GET THE "IO26" CODE DST BUF,I PUT IT IN THE BUFFER JSB PTERR NOW PUT IT IN THE SCB SO HE DEF *+3 CAN FIGURE IT OUT DEF IO26 DEF LU DUMMY ERROR PRAM LDA N4 GET LENGTH JMP MRTN 1ýþú AND GO EXIT * N4 DEC -4 * ILLU DLD "NOT" LU NOT DEFINED DST BUF,I SET "NOT DEFINED" ISZ BUF ISZ BUF JSB .DFER IN THE BUFFER DEF BUF,I DEF "DEF" LDA N10 JMP MRTN GO RETURN * ZERO DLD ZIP SET UP THE RETURN FOR EQ0 DST BUF,I AND LDA N6 GET ITS CHAR LENGTH JMP MRTN GO RETURN * IO26 ASC 2,IO26 PTERR REALLY PUTS "IO26 # 0" BUT HELP KNOWS ZIP ASC 2, # 0 N6 DEC -6 N10 DEC -10 HCOMA BYT 14 CONVERTS HIGH BLANK TO COMMA "NOT" ASC 2,NOT "DEF" ASC 3,DEFINED "LU" ASC 1,LU "SLU" ASC 2,SLU B377 OCT 377 B35 OCT 35 D6 DEC 6 N8 DEC -8 D1 DEC 1 D32 DEC 32 SCB NOP SYSLU NOP DNOP DEF NOP NOP NOP * CNUM NOP A 4-DIGIT LEADING ZERO SUPPRESS BINARY CLB,CLE TO ASCII NUMBER CONVERTER DIV D100 SEPERATE N INTO HIGH & LOW DIGITS STB LOWD SAVE THE LOW ONES JSB TWOD CONVERT THE HIGH ONES (E=0 => SUP 0'S) STB HIAS SAVE THE RESULTS LDA LOWD NOW LOW ONES JSB TWOD LDA HIAS SET AB TO 1234 (DIGITS) SEZ,RSS IF NO NON-ZERO THEN ADB B20 FOURCE A ZERO TO 4'TH DIGIT JMP CNUM,I RETURN * B20 OCT 20 LOWD NOP HIAS NOP D100 DEC 100 * TWOD NOP ENTRY A=#,E=0 IF NO # YET LDB BLK ASSUME NO # YET SEZ,SZA,RSS IF NO # AND STILL ZERO JMP TWOD,I RETURN TWO BLANKS (E=0) * CLB AT LEAST ON DIGIT HERE DIV D10 SEPERATE THEM ALF,ALF ROTATE HIGH TO PROPER PLACE SEZ,CCE,SZA,RSS IF NO HIGHER DIGITS AND NONE YET LDA NB20 FOURCE A BLANK HIGH DIGIT ADB A COMBINE BOTH DIGITS ADB "00" CONVERT TO ASCII #S JMP TWOD,I RETURN B=ASCII,E=1 * D10 DEC 10 NB20 BYT -20 "00" ASC 1,00 BLK ASC 1, XEQT EQU 1717B A EQU 0 B EQU 1 END _ ÿÿ ÿýlu ÿ92067-18181 1903 S C0122 &SM.BF              H0101 qzASMB,R,L HED GENERAL SESSION MONITOR BUFFER * NAME: SM.BF * SOURCE: 92067-18181 * RELOC: 92067-16125 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SM.BF,7 92067-16125 REV.1903 781229 ENT SM.BF GENERAL SESSION MONITOR BUFFER * SM.BF BSS 148 GENERAL SESSION MONITOR BUFFER * END ºWÿÿ ÿýms ÿ92067-18182 1903 S C0122 &CL.BF              H0101 qjASMB,R,L HED CARTRIDGE DIRECTORY BUFFER * NAME: CL.BF * SOURCE: 92067-18182 * RELOC: 92067-16125 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CL.BF,7 92067-16125 REV.1903 780714 ENT CL.BF CARTRIDGE DIRECTORY BUFFER * CL.BF BSS 256 CARTRIDGE DIRECTORY BUFFER * END 92ÿÿ ÿýnt ÿ92067-18183 1903 S C0122 &PGS.              H0101 YvþúASMB,R,L,C * NAME: PGS. * SOURCE: 92067-18183 * RELOC: 92067-16125 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PGS.,7 92067-16125 REV.1903 781002 ENT PGS. EXT .ENTR PARAMETER ADDRESS FETCH ROUTINE EXT READF FMP FILE READ ROUTINE * * ROUTINE TO DETERMINE WHETHER A SESSION MONITOR DISC * ID REPRESENTS A PRIVATE, GROUP OR SYSTEM DISC * NOTE: ASSUMES CALLER HAS OPENED AND WILL CLOSE ACCOUNT * FILE WITH SPECIFIED DCB * * CALLING SEQUENCE: JSB PGS. * DEF *+4 * DEF IDCB ACCOUNT FILE DCB * DEF ID SESSION MONITOR DISC ID * DEF PGS ON RETURN, = 1 IF PRIVATE ID * = 2 IF GROUP ID * = 3 IF SYSTEM ID * = 0 OTHERWISE * * METHOD: IF ID IS 0, RETURN PGS=0. IF ID IS 4095, RETURN PGS=3. * OTHERWISE, EXAMINE THE SESSION ACCOUNT FILE HEADER * RECORD, WORDS 23 AND 24. IF ID IS GREATER THAN OR EQUAL * TO THE LOWEST PRIVATE ID USED (WORD 23), RETURN PGS=1. * IF ID IS LESS THAN OR EQUAL TO THE HIGHEST GROUP ID * USED (WORD 24), RETURN PGS=2. OTHERWISE RETURN PGS=0. * IDCB NOP ACCOUNT FILE DCB ID NOP SESSION DISC ID PGS NOP RETURN WORD PGS. NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF IDCB LDA ID,I GET SESSION DISC ID SZA,RSS IF ZERO, RETURN PGS=0 JMP DONEöô   ZERO, SO RETURN CPA SYSID SYSTEM ID? JMP SYS YES JSB READF READ THE ACCOUNT FILE HEADER DEF *+7 DEF IDCB,I DCB DEF IERR ERROR RETURN DEF IBUF RETURN BUFFER DEF .24 NBR. OF WORDS TO READ DEF IDMY DEF .1 RECORD #1 LDA IERR GET ERROR WORD SSA ERROR? JMP ZERO YES, RETURN PGS=0 LDA IBUF+22 GET LOWEST PRIVATE ID USED CMA,INA CHECK IF GREATER THAN ADA ID,I ID PARAMETER SSA,RSS JMP PRIV NO, SO ID IS PRIVATE ID LDA IBUF+23 GET HIGHEST GROUP ID USED CMA CHECK IF LESS THAN ADA ID,I ID PARAMETER SSA JMP GROUP NO, SO ID IS GROUP ID ZERO CLA,RSS RETURN PGS=0 PRIV CLA,INA RETURN PGS=1 RSS GROUP LDA .2 RETURN PGS=2 RSS SYS LDA .3 RETURN PGS=3 DONE STA PGS,I SAVE IN RETURN PARAMETER JMP PGS.,I RETURN .1 DEC 1 .2 DEC 2 .3 DEC 3 .24 DEC 24 SYSID OCT 7777 IBUF BSS 24 IDMY BSS 1 IERR BSS 1 END n ÿÿ ÿýov ÿ92067-18184 1903 S C0122 &ACNAM              H0101 iþúASMB,R,L,C * NAME: ACNAM * SOURCE: 92067-18184 * RELOC: 92067-16125 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ACNAM,7 92067-16125 REV.1903 790102 ENT ACNAM EXT .ENTR PARAMETER ADDRESS FETCH ROUTINE EXT READF FMP FILE READ ROUTINE EXT POSNT FMP FILE POSITION ROUTINE * * ROUTINE TO FIND THE ACCOUNT NAME(S) ASSOCIATED WITH A * SESSION MONITOR PRIVATE OR GROUP ID * NOTE: ASSUMES CALLER HAS OPENED AND WILL CLOSE ACCOUNT * FILE WITH SPECIFIED DCB * * CALLING SEQUENCE: JSB ACNAM * DEF *+7 * DEF IDCB ACCOUNT FILE DCB * DEF ID SESSION MONITOR ACCOUNT ID * DEF PGS 1 (PRIVATE), 2 (GROUP) OR 3 (SYS) * DEF IREC DIRECTORY ENTRY # * DEF BUF 11-WORD RETURN BUFFER FOR NAME * DEF BUFL # CHARS IN ACCT NAME IN BUF * * NOTE: IREC IS SET TO 1 BY CALLER ON FIRST CALL FOR * A PARTICULAR ID. ACNAM RETURNS NEXT * DIRECTORY ENTRY NUMBER WITH MATCHING ID IN * IREC. IREC IS SET TO 0 WHEN LAST DIRECTORY * ENTRY WITH A MATCHING ID IS FOUND. * * * ERRORS: IREC = -1 FMP ERROR * = -2 NO MATCH FOUND * = -3 BAD PARAMETER * * * METHOD: IF PGS IS PRIVATE OR SYSTEM, SEARCH USER ENTRIES IN * ACCOUNT FILE DIRECTORY BEGINNING WITH DIRECTORY ENTRY * IREC. IF PGS IS GROUP, SEARCH THE ACCOUNT FILE * DIRECÏÅþúTORY FOR GROUP ENTRIES. IF A MATCHING ID * IS FOUND, WRITE USER.GROUP OR GROUP NAME TO BUF. * CONTINUE SEARCHING FOR MATCHING ID. IF FOUND, RETURN * DIRECTORY ENTRY NUMBER IN IREC, ELSE RETURN IREC=0. * * * IDCB NOP ACCOUNT FILE DCB ID NOP SESSION ACCOUNT ID PGS NOP 1 IF PRIVATE, 2 IF GROUP, 3 IF SYSTEM IREC NOP DIRECTORY ENTRY NUMBER BUF NOP RETURN BUFFER FOR ACCOUNT NAME BUFL NOP LENGTH OF NAME IN CHARACTERS ACNAM NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF IDCB LDA ID,I CHECK BOUNDS OF ID SSA,RSS POSITIVE? SZA,RSS YES, ZERO? JMP ERR3 ERROR - ID IS NEGATIVE OR ZERO CMA,INA LARGER THAN MAXIMUM ID? ADA MAXID SSA JMP ERR3 ERROR, ID IS LARGER THAN MAXIMUM ID LDA IREC,I CHECK IREC PARAMETER SSA,RSS MUST BE POSITIVE AND SZA,RSS NON-ZERO JMP ERR3 NO, SO BAD PARAMETER LDA PGS,I CHECK PGS PARAMETER CLB STB FFLAG INITIALIZE THE FOUND FLAG INB SET UP B AS COMPARE WORD CPA B PGS=1? JMP USER YES, PRIVATE ID INB CPA B PGS=2? JMP GROUP YES, GROUP ID INB CPA B PGS=3? RSS YES, SEARCH FOR A USER ACCOUNT JMP ERR3 ERROR - PGS NOT 1,2 OR 3 USER CCA,RSS A IS SET TO SEARCH FOR USER ACCOUNTS GROUP CLA A IS ZERO TO SEARCH FOR GROUP ACCOUNTS STA ACTYP SAVE TYPE OF ACCOUNT TO LOOK FOR JSB READF READ ACCOUNT FILE HEADER DEF *+7 DEF IDCB,I DCB DEF IERR ERROR WORD DEF IBUF RETURN BUFFER DEF .6 NUMBER OF WORDS TO READ DEF IDMY DEF .1 RECORD #1 LDA IERR GET ERROR WORD SSA ERROR? JMP ERR1 YES, RETURN IREC=-1 CCB ~'þú GET DIRECTORY ENTRY NUMBER - 1 ADB IREC,I CLA LSR 3 DIVIDE BY 8 TO GET RECORD OFFSET ADB IBUF+4 ADD LOCATION OF START OF DIRECTORY STB JREC SAVE IT FOR POSITION ALF,ARS GET INDEX FOR CURRENT RECORD STA INDX SAVE IT ALF COMPUTE WORD OFFSET INTO RECORD ADA DEFIB STA IPTR SAVE IT JSB POSNT POSITION FOR FIRST READ DEF *+5 DEF IDCB,I DCB DEF IERR ERROR RETURN DEF JREC RECORD NUMBER DEF .1 LDA IERR GET ERROR WORD SSA ERROR? JMP ERR1 YES, RETURN IREC=-1 JMP READ0 SKIP 1ST INCREMENT OF RECORD # READ ISZ JREC INCREMENT RECORD # CLA STA INDX RESET INDEX INTO RECORD TO 0 READ0 JSB READF READ NEXT RECORD FROM ACCOUNT FILE DEF *+4 DEF IDCB,I DCB DEF IERR ERROR RETURN DEF IBUF RETURN BUFFER LDA IERR GET ERROR WORD SSA ERROR? JMP ERR1 YES, RETURN IREC=-1 LDA IPTR JMP READ3 READ1 ISZ IREC,I INCREMENT DIRECTORY ENTRY NUMBER LDA INDX GET INDEX INTO CURRENT RECORD CPA .7 DONE WITH THIS RECORD? RSS YES JMP READ2 NO, CONTINUE LDA DEFIB STA IPTR RESET POINTER TO START OF BUFFER JMP READ READ NEXT RECORD READ2 ISZ INDX BUMP INDEX INTO THIS RECORD LDA IPTR GET POINTER INTO BUFFER ADA .16 BUMP TO NEXT ENTRY STA IPTR SAVE IT READ3 LDA A,I GET FIRST WORD OF DIRECTORY ENTRY CPA M1 FREE DIRECTORY ENTRY (MARKED AS -1)? JMP READ1 ITS FREE, SO JUST READ NEXT RECORD SZA,RSS END OF DIRECTORY? JMP EOF YES CLB ASR 8 SZA GROUP ENTRY (POSITIVE)? CCA,CLE,RSS NO, USER ENTRY - SET A FOR COMPARE CLA,CCE YES, GROUP ENTRY - CLEAR A FOR COMž9þúPARE CPA ACTYP IS IT THE TYPE WE'RE LOOKING FOR? RSS YES, SEE IF ID MATCHES JMP READ1 READ NEXT RECORD LDA IPTR GET DIRECTORY ENTRY SEZ GROUP ENTRY? JMP GRPID YES, GET GROUP ID FROM DIRECTORY ENTRY ADA .11 NO, GET USER ID FROM DIRECTORY ENTRY LDA A,I CPA ID,I COMPARE WITH ID PARAMETER JMP FOUND IT MATCHES NEXTR JMP READ1 READ NEXT RECORD GRPID ADA .12 GET GROUP ID FROM DIRECTORY ENTRY LDA A,I CPA ID,I COMPARE WITH ID PARAMETER RSS YES JMP NEXTR NO, READ NEXT RECORD FOUND LDA FFLAG GET FOUND FLAG SZA IF NOT FIRST FIND, JMP ACNAM,I RETURN DIRECTORY ENTRY NUMBER AND EXIT LDA IPTR,I GET NAME LENGTH WORD ELA,CLE,ERA STRIP OFF SIGN BIT CLB RRR 8 # CHARS IN USER NAME TO A BLF,BLF # CHARS IN GROUP NAME TO B STB GRPLN SAVE LENGTH OF GROUP NAME LDB BUF GET ADDRESS FOR DESTINATION STB PBUF SAVE FOR UNPACK-PACK ROUTINE CLB CPB ACTYP GROUP ACCOUNT? JMP GRP YES, JUST USE GROUP NAME LENGTH * STA USRLN SAVE LENGTH OF USER NAME ADA GRPLN ADD LENGTH OF GROUP NAME INA ADD 1 FOR NAME DELIMITER (".") STA BUFL,I RETURN LENGTH (CHARS) IN BUFL LDB IPTR GET ADDRESS TO TRANSFER FROM INB STB UPBUF SAVE FOR UNPACK-PACK ROUTINE LDA B,I GET USER NAME ELA,CLE,ERA STRIP SIGN BIT FROM USER NAME STA B,I REPLACE IT JSB PACKN TRANSFER USER NAME TO BUFFER DEF USRLN NUMBER OF CHARACTERS TO TRANSFER LDB PTR GET ADDRESS TO TRANSFER FROM STB UPBUF SAVE FOR UNPACK-PACK ROUTINE JSB PACKN MOVE "." TO BUFFER DEF .1 LENGTH = 1 CHARACTER MOVEG LDB IPTR ADDRESS TO TRANSFER FROM ADB .6 STB UPBUF SAVE FOR.þú UNPACK-PACK ROUTINE JSB PACKN TRANSFER GROUP NAME TO BUFFER DEF GRPLN NUMBER OF CHARACTERS TO TRANSFER * ISZ FFLAG SET THE FOUND FLAG CLA CPA ACTYP GROUP ACCOUNT? JMP EOF YES, DONE - NEED NOT SEARCH FURTHER JMP READ1 READ NEXT RECORD GRP LDB GRPLN GET GROUP NAME LENGTH (CHARS) STB BUFL,I SAVE AS NAME LENGTH JMP MOVEG MOVE GROUP NAME EOF LDA FFLAG GOT TO END OF DIRECTORY SZA WAS A MATCH FOUND? CLA,RSS YES, RETURN IREC=0 LDA M2 ERROR -2, NO MATCHES FOUND RSS ERR1 CCA ERROR -1, FMP ERROR RSS ERR3 LDA M3 ERROR -3, BAD PARAMETER STA IREC,I RETURN ERROR CODE SZA IF ERROR, SET BUFL TO 0 CLB,RSS RSS NO ERROR, SO SKIP STB BUFL,I JMP ACNAM,I RETURN * * * STRING PACK ROUTINE * * THE FOLLOWING ROUTINE PACKS A CHARACTER INTO A BUFFER * ACCORDING TO THE POINTER PBUF WITHOUT OTHERWISE ALTERING * THE BUFFER. THE ROUTINE UPDATES PBUF SO THAT A PACKED * ASCII BUFFER MAY BE WRITTEN BY SUCCESSIVE CALLS TO PAK. * PBUF CONTAINS THE ADDRESS OF THE WORD TO PACK INTO; THE * SIGN BIT, IF SET, INDICATES A PACK INTO THE LOW ORDER * BITS OF THE WORD. * CHAR BSS 1 PAK NOP ENTRY LDB PBUF LOAD CURRENT ADDRESS POINTER CLE ELB,RBR GET SIGN BIT SEZ,RSS TEST IF SIGN BIT SET ALF,ALF STA CHAR LDA B,I GET CONTENTS OF ASCII BUFFER SEZ ALF,ALF AND =B177 MASK HIGH BITS SEZ ALF,ALF XOR CHAR GET ACTUAL CHARACTER STA B,I PACK IN CURRENT PACK ADDRESS SEZ,CME TEST IF SIGN BIT SET INB,RSS YES, INCREMENT PACK ADDR ELB,RBR STB PBUF SAVE NEW ADDRESS POINTER JMP PAK,I RETURN * * * STRING UNPACK ROUTINE * * THE FOLLOWIº×þúNG ROUTINE UNPACKS A CHARACTER FROM A PACKED * ASCII BUFFER ACCORDING TO THE POINTER UPBUF. THE ROUTINE * UPDATES UPBUF SO THAT A PACKED BUFFER MAY BE SEARCHED BY * SUCCESSIVE CALLS TO UNPAK. UPBUF CONTAINS THE ADDRESS OF * THE WORD TO UNPACK FROM; THE SIGN BIT, IF SET, INDICATES * AN UNPACK FROM THE LOW ORDER BITS OF THE WORD. * UNPAK NOP ENTRY LDB UPBUF LOAD CURRENT ADDRESS POINTER CLE ELB,RBR GET SIGN BIT LDA B,I GET CONTENTS OF PACKED BUFFER SEZ,RSS TEST IF SIGN BIT SET ALF,ALF AND =B177 MASK HIGH BITS SEZ,CME TEST IF SIGN BIT SET INB,RSS YES, INCREMENT UNPACK ADDR ELB,RBR STB UPBUF SAVE NEW ADDRESS POINTER JMP UNPAK,I RETURN * * * CHARACTER UNPAK-PAK ROUTINE * * THE FOLLOWING ROUTINE PERFORMS A SERIES OF UNPACK AND * PACK OPERATIONS BASED ON THE INPUT PARAMETER N. EACH * UNPAK-PAK OPERATION TRANSFERS THE NEXT CHARACTER IN THE * BUFFER POINTED TO BY UPBUF INTO THE NEXT CHARACTER * POSITION POINTED TO BY PBUF. * * JSB PACKN * DEF N, WHERE N IS THE NUMBER OF * CHARACTERS TO BE TRANSFERRED * CHARS BSS 1 PACKN NOP LDA PACKN,I LDA A,I CMA SAVE CHARACTER COUNT - 1 STA CHARS TESTN ISZ CHARS ALL CHARACTERS TRANSFERRED? RSS JMP EXIT2 YES JSB UNPAK NO, UNPACK NEXT CHARACTER JSB PAK PACK THE CHARACTER INTO TO-BUFFER JMP TESTN EXIT2 ISZ PACKN INCREMENT RETURN ADDRESS JMP PACKN,I RETURN * A EQU 0 B EQU 1 .1 DEC 1 .6 DEC 6 .7 DEC 7 .11 DEC 11 .12 DEC 12 .16 DEC 16 M1 DEC -1 M2 DEC -2 M3 DEC -3 MAXID OCT 7777 MAXIMUM SESSION MONITOR ACCOUNT ID DOT ASC 1,. DELIMITER FOR USER.GROUP NAME PTR DEF DOT ACTYP BSS 1 ACCT TYPE, 0=GROUP, -1=USER ÿQ*($FFLAG BSS 1 FOUND FLAG, = 1 AFTER 1ST MATCH IBUF BSS 128 BUFFER FOR ACCT FILE DIRECTORY READ DEFIB DEF IBUF IDMY BSS 1 IPTR BSS 1 INDX BSS 1 PBUF BSS 1 PACK-TO BUFFER, USED BY PAK ROUTINE UPBUF BSS 1 UNPACK-FROM BUFFER, USED BY UNPAK IERR BSS 1 FMP ERROR RETURN WORD JREC BSS 1 CURRENT RECORD POSITION IN ACCT FILE GRPLN BSS 1 LENGTH OF GROUP NAME (CHARACTERS) USRLN BSS 1 LENGTH OF USER NAME (CHARACTERS) END XÔ*ÿÿ ÿýp | ÿ92067-18185 2040 S C0122 &$BMON              H0101 |fASMB,R,L * NAME: $BMON * SOURCE: 92067-18185 * RELOC: 92067-16185 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $BMON,7 92067-16185 REV.2040 800731 ENT $BMON $BMON OCT 1 * * ******************************************************** * * NOTE: $BMON = 0 FOR RTE-II,III AND IV-A * * * = 1 FOR RTE IV-B * * ******************************************************** * END p ÿÿ ÿýqw ÿ92067-18186 2026 S C0122 &FMGR              H0101 ‰ZþúASMB,R,Q,C HED FMGR - RTE FILE MANAGER MAIN * NAME: FMGR * SOURCE: 92067-18186 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * MODIFICATION RECORD: * * DATE REASON * 1) 780227 TO ADD GLOBALS 8P,9P FOR SESSION MONITOR (BL) * 2) 780302 TO ADD COMMAND STACKING CAPABILITY (DLB) * NAM FMGR,3,90 92067-16185 REV.2026 800428 EXT CLOS.,EXEC,MSS. ENT IFLG.,CAD.,FM.AB,D.,CUSE.,PARS. ENT SEG.R,P.SEG,INI1.,INI2.,I.BUF,O.BUF ENT N.OPL,P.RAM,TTY.,NO.RD,NOCM.,ACTV. ENT J.REC,J.NAM,G0..,JRN.,.IDAD ENT TL.P,TM.VL,L.SEG,GT.JB,.R.E.,SCR. ENT S.TTY,S.CAP,M3FLG,CLOPN SUP * NEW CODE ADDED 780302 (DLB) ENT TPSK.,NXTK.,EDSK.,CRSK. SPC 1 TPSK. DEF BUFFR NXTK. DEF MESS2 CRSK. DEF BUFFR EDSK. DEF ENDBF BUFFR BSS 140 ORG BUFFR DEC 1 ASC 1,** YOU MUST EXECUTE A COMMAND BEFORE A :EC COMMAND MESS2 OCT 400 ORR ENDBF EQU *-1 * END OF NEW CODE ADDED 780302 (DLB) SPC 3 O.BUF BSS 144 GENERAL OUTPUT DCB I.BUF BSS 144 GENERAL INPUT DCB ORG I.BUF PUT INITIALIZE CODE IN DCB FMGR LDA XEQT GET THE ADA .12 FIRST TWO LDA A,I CHARACTERS OF PGMS STA SEG NAME AND SET FOR SEGMENT CALLS. JMP ITCAL GO LOAD THE INITIALIZE SEGMENT INI1. JSB MSS. INIT SEGMENT COMES HERE IF DEF *+2 SYSTEM INITIALIZE IS NEEDED DEF IFLG. SEND FMGR 00X (5 OR 3) MESSAGE LDA AS1BL SET TO LOAD JMP PSEGC AND LOAD THE PARSE SEGMENT INI2. CPØ´þúB ASIN SEGMENT RETURNS HERE AFTER JMP SEGLD READING AND PARSING-EXPECTED INPUT JUMP CPB AS?? WAS ?? INPUT? JMP CAL?? YES -GO SET UP AND CALL ?? ROUTINE JSB MSS. NO! ILLEGAL RESPONSE DEF *+2 SEND FMGR 004 DEF .4 JMP INI1. TRY AGAIN CAL?? LDA .4 ?? CALL FROM INIT-SET MS TO 4 STA MS TO FORCE FMGR 004 MESSAGE JMP SEGLD GO TO GENERAL CALL ROUTINE SPC 1 INIT2 LDA MS HERE AFTER INIT CALL ON IN SZA SKIP IF OK JMP INI1. NO - TRY AGAIN SPC 1 ITCAL CLA SET UP TO CALL THE INITIALIZE STA CAD. ROUTINE LDA AS2BL FIRST ROUTINE IN SEGMENT TWO JMP PSEGC GO LOAD THE SEGMENT AND CALL IT SPC 1 GT.JB CLA STA CAD. LDA AS7BL JMP PSEGC SPC 1 AS?? ASC 1,?? ASIN ASC 1,IN AS2BL ASC 1,2 AS7BL ASC 1,7 .4 OCT 4 .12 DEC 12 TEST EQU I.BUF+128-* MAKE SURE ABOVE CODE IS IN O.BUF ORR FM.AB JSB CLOS. COMMAND LOOP - ENTRY DEF *+2 CLOSE DEF I.BUF INPUT FILE JSB CLOS. CLOSE DEF *+2 DEF O.BUF OUTPUT FILE INIT0 LDA AS1BL INITIALIZE SEGMENT CALL ENTRY POINT CPA CUSE. IF PARSE SEGMENT STILL IN JMP P.SEG CORE THEN SKIP SEGMENT CALL PSEGC STA CUSE. ELSE SET UP SEGLD JSB EXEC AND L.SEG EQU SEGLD DEF *+3 LOAD DEF .8 PARSE DEF SEG SEGMENT P.SEG LDA J.REC IF NO MORE JOBS, SSA TERMINATE. JMP TERM P.SG1 CLA NORMAL PARSE SEGMENT RETURN POINT STA MS CLEAR THE ERROR FLAG JSB PARS.,I CALL TO READ & PARSE A COMMAND DEF *+1 SEZ,RSS E=I = SEGMENT ABSENT JMP CALLR E=0 = ROUTINE IN CORE JMP SEGLD SEGMENT ABSENT SO GO LOAD SEG.R ADA CAD. ALL SE”œ GMENTS OTHER THAN PARSE LDA A,I STA CAD. RETURN HERE WITH A= DEF TABLE ADDRESS CALLR JSB CAD.,I CALL THE ROUTINE DEF *+4 PASSING DEF NOCM. THE NUMBER OF PARAMETERS DEF P.RAM THE TABLE ADDRESS DEF MS THE ERROR FLAG ADDRESS LDA MS IF THERE IS NO SZA,RSS ERROR THEN JMP IFTST JUMP JSB MSS. ELSE DEF *+2 PRINT DEF MS FMGR MS IFTST LDA IFLG. IF INITIALIZE ROUTINE SZA IN CONTROL JMP INIT2 GO CONTINUE SYSTEM INITIALIZATION JMP FM.AB ELSE READ THE NEXT COMMAND TERM JSB EXEC TERMINATE DEF *+2 DEF .6 SPC 2 .6 DEC 6 MS NOP .IDAD NOP IFLG. NOP M3FLG NOP CLOPN NOP NO.RD NOP JRN. BSS 1 ACTV. DEC 0 J.REC DEC 0 J.NAM BSS 3 SCR. BSS 1 * * DO NOT REPOSITION THE FOLLOWING FOUR * ARRAYS! THE PARSE ROUTINE DEPENDS ON IT. * TTY. OCT 1 N.OPL BSS 10 P.RAM BSS 64 NOCM. NOP CAD. NOP PARS. NOP BSS 8 0S AND 1S G0.. BSS 40 0G THROUGH 9G DEC 3 10G BSS 5 1P THROUGH 5P .R.E. BSS 2 6P AND 7P S.TTY BSS 1 8P *780227* S.CAP BSS 1 9P *780227* .8 DEC 8 ENDMS ASC 3, $END SEG ASC 2,FMGR CUSE. ASC 1, AS1BL ASC 1,1 D. ASC 3,D.RTR TL.P OCT 0,0 TM.VL OCT 0,0 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 ORG * LENGTH OF ROUTINE END FMGR ¾’ÿÿ ÿýrz ÿ92067-18187 1903 S C0122 &FMGR0              H0101 ‡pASMB,R,L HED FMGR0 * NAME: FMGR0 * SOURCE: 92067-18187 * RELOC: 92067-16185 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR0,5 92067-16185 REV.1903 790207 EXT SEG.R,CAD.,.IDAD SPC 1 FMGR0 STA .IDAD LDA TABL JMP SEG.R SPC 1 TABL DEF *+1 SPC 1 EXT PK.. DEF PK.. EXT DU..,ST..,CO.. DEF CO.. DEF ST.. DEF DU.. END FMGR0 è¼ÿÿ ÿýsy ÿ92067-18188 1903 S C0122 &FMGR1              H0101 ˆqþúASMB,R,L,C HED FMGR1 * NAME: FMGR1 * SOURCE: 92067-18188 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR1,5 92067-16185 REV.1903 760929 EXT PARS.,.PARS,REA.C,IFLG.,INI2. EXT $BATM,C.BUF,ABT..,AB.. EXT NO.RD,.ENTR,P.SEG,SEG.R,TR..,.IDAD EXT TTY.,ECHF.,ACTV.,BRKF.,MSS.,IFBRK SUP FMGR1 STA .IDAD LDA PARSE SET THE PARSE ROUTINE ADDRESS STA PARS. IN THE MAINS ADDRESS WORD LDA IFLG. IF INITILIZE SZA,RSS SKIP JMP P.SEG ELSE RETURN TO THE MAIN JSB PAR INITILIZE SO CALL DEF *+1 TO READ AND PARSE THE STATEMENT JMP INI2. RETURN TO THE INITILIZE CODE SPC 2 PAR NOP READ AND PARSE ENTRY POINT JSB .ENTR DEF PAR FETCH RETURN ADDRESS PAR0 JSB IFBRK CHECK FOR BREAK PENDING DEF *+1 SZA,RSS IF NO BREAK JMP NOBRK SKIP MESSAGE * JSB MSS. ELSE SEND THE BREAK MESSAGE DEF *+2 DEF ZERO * NOBRK LDA BRKF. IF A BREAK WAS PROCESSED SZA THEN JMP ANBRK GO ANALIZE IT * PAR1 LDA NO.RD IF NO READ FLAG SET SZA THEN JMP PAR2 BY PASS THE READ CALL * JSB REA.C CALL TO READ A COMMAND DEF *+1 CCA SET THE ECHO NOT DONE FLAG STA ECHF. JSB .PARS PARSE THE COMMAND DEF *+1 JMP PAR,I AND RETURN * PAR2 CLB CLEAR THE NO READ CALL FLAG STB NO.RD STB ECHF. DON'T ECHO INTERNAL CALLS SSA,RS{  S JMP TRLD * CLB,INB SET TO INTERACTIVE INPUT LDA TTY. SAVE THE TTY FLAG STB TTY. SET IT FOR NOW STA TMPM PARS JSB .PARS PARS THE COMMAND DEF *+1 LDA TMPM RESTORE THE TTY FLAG STA TTY. JMP PAR,I RETURN TO THE MAIN TO CALL THE SEGMENT * TRLD LDA TR JMP SEG.R * ANBRK CLA CLEAR THE BREAK FLAG STA BRKF. LDB ACTV. IF NOT ACTIVE SZB,RSS THEN JMP PAR1 JUST IGNOR THE FLAG * LDB XEQT ELSE CHECK IF WE ARE IN BATCH ADB D20 LDB B,I SSB,RSS IF NOT IN BATCH JMP PAR1 IGNOR BREAK * STA NO.RD CLEAR THE NO READ FLAG DLD $BATM GET THE BATCH TIME CLA SET A FOR OPERATOR ABORT SSB,RSS IF TIME OUT LDA N2 RESET FOR TIME OUT MESSAGE STA TMPM SET FOR CALL JSB AB.. SET UP DEF *+3 AN "AB" COMMAND DEF TMPM DEF ABTM JMP PAR0 * XEQT EQU 1717B ABTM ASC 8, ABEND JOB LIMIT N2 DEC -2 TMPM NOP TR DEF * DEF TR.. TR+1 ASAB ASC 1,AB TR+2 D20 DEC 20 TR+3 ZERO NOP TR+4 PARSE DEF PAR TR+5 DEF ABT.. TR+6 A EQU 0 B EQU 1 ORG * END FMGR1 ìL ÿÿ ÿýt{ ÿ92067-18189 1903 S C0122 &FMGR2              H0101 ‰rASMB,R,L HED FMGR2 * NAME: FMGR2 * SOURCE: 92067-18189 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR2,5 92067-16185 REV.1903 780907 EXT SEG.R,CAD.,.IDAD SPC 1 FMGR2 STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT IN.IT DEF IN.IT EXT IN.. DEF IN.. EXT PU.. DEF PU.. END FMGR2 ÐDÿÿ ÿýu{ ÿ92067-18190 1903 S C0122 &FMGR3              H0101 €tASMB,R,L HED FMGR3 * NAME: FMGR3 * SOURCE: 92067-18190 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR3,5 92067-16185 REV.1903 760720 EXT SEG.R,CAD.,.IDAD FMGR3 STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT CS.. DEF CS.. EXT DL.. DEF DL.. END FMGR3 Ò&ÿÿ ÿýv| ÿ92067-18191 1903 S C0122 &FMGR4              H0101 uASMB,R,L HED FMGR4 * NAME: FMGR4 * SOURCE: 92067-18191 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR4,5 92067-16185 REV.1903 790207 EXT SEG.R,.IDAD SPC 1 FMGR4 STA .IDAD LDA TABL JMP SEG.R SPC 1 TABL DEF *+1 SPC 1 EXT LL..,LO..,SV.. DEF LL.. DEF LO.. DEF SV.. EXT MC.. DEF MC.. EXT RC.. DEF RC.. EXT AC.. DEF AC.. EXT MS.. DEF MS.. END FMGR4 —%ÿÿ ÿýw} ÿ92067-18192 2026 S C0122 &FMGR5              H0101 …pASMB,R,L HED FMGR5 * NAME: FMGR5 * SOURCE: 92067-18192 * RELOC: 92067-16185 * PGMR: G.A.A., D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR5,5 92067-16185 REV.2026 800221 EXT SEG.R,.IDAD SPC 1 FMGR5 STA .IDAD LDA TABL JMP SEG.R SPC 1 TABL DEF *+1 SPC 1 EXT TL.. DEF TL.. EXT PA..,TE..,AN.. DEF PA.. DEF TE.. DEF AN.. EXT CNT. DEF CNT. EXT CT.. DEF CT.. END FMGR5 ½;ÿÿ ÿýx~ ÿ92067-18193 1903 S C0122 &FMGR6              H0101 ƒwASMB,R,L HED FMGR6 * NAME: FMGR6 * SOURCE: 92067-18193 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR6,5 92067-16185 REV.1903 790201 EXT SEG.R,.IDAD * FMGR6 STA .IDAD LDA TABL JMP SEG.R * TABL DEF *+1 EXT JO.. DEF JO.. EXT EO.. DEF EO.. EXT LG.. DEF LG.. EXT OF.. DEF OF.. EXT CN.. DEF CN.. EXT LU.. DEF LU.. END FMGR6 1›ÿÿ ÿýy ÿ92067-18194 1903 S C0122 &FMGR7              H0101 „xASMB,R,L HED FMGR7 * NAME: FMGR7 * SOURCE: 92067-18194 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR7,5 92067-16185 REV.1903 760702 EXT SEG.R,CAD.,.IDAD FMGR7 STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT NX.JB DEF NX.JB EXT ??.. DEF ??.. EXT SY.. DEF SY.. END FMGR7 ~Kÿÿ ÿýz€ ÿ92067-18195 1903 S C0122 &FMGR8              H0101 …yASMB,R,L HED FMGR8 * NAME: FMGR8 * SOURCE: 92067-18195 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR8,5 92067-16185 REV.1903 790207 EXT SEG.R,CAD.,.IDAD FMGR8 STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT SP.. DEF SP.. EXT CR.. DEF CR.. EXT SA.. DEF SA.. END FMGR8 ¹ÿÿ ÿý{ ÿ92067-18196 1903 S C0122 &FMGR9              H0101 †zASMB,R,L HED FMGR9 * NAME: FMGR9 * SOURCE: 92067-18196 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGR9,5 92067-16185 REV.1903 790201 EXT SEG.R,CAD.,.IDAD FMGR9 STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT CL.. DEF CL.. EXT LI.. DEF LI.. END FMGR9 ÿÿ ÿý|‚ ÿ92067-18197 1903 S C0122 &FMGRA              H0101 ‡‚ASMB,R,L HED FMGRA * NAME: FMGRA * SOURCE: 92067-18197 * RELOC: 92067-16185 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGRA,5 92067-16185 REV.1903 790201 EXT SEG.R,CAD.,.IDAD FMGRA STA .IDAD LDA TABL JMP SEG.R SPC 2 TABL DEF *+1 SPC 1 EXT SM.. DEF SM.. EXT ME.. DEF ME.. END FMGRA Üÿÿ ÿý}ƒ ÿ92067-18198 1913 S C0122 &LUTRU RTE-IV LUTRU             H0101 yµASMB,R,L HED LUTRU - DUMMY ROUTINE TO FIND TRUE LU * NAME: LUTRU * SOURCE: 92067-18198 * RELOC: PART OF 92067-16035 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LUTRU,7 92067-16035 REV.1913 790119 EXT .ENTR ENT LUTRU SESLU NOP SYSLU NOP LUTRU NOP JSB .ENTR DEF SESLU LDA SESLU,I .FETCH LU STA SYSLU,I .GIVE IT BACK NO CHANGE JMP LUTRU,I END Niÿÿ ÿý~„ ÿ92067-18199 1913 S C0122 &ENSES RTE-IV ENSES             H0101 R¡ASMB,R,L HED ENSES - ENTRY POINTS FOR SESSION SYSTEM COMPATIBILITY * NAME: ENSES * SOURCE: 92067-18199 * RELOC: PART OF 92067-16035 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ENSES,7 92067-16035 REV.1913 790119 ENT $CL1,$CL2 $CL1 NOP $CL2 EQU $CL1 END ¦—ÿÿ ÿý… ÿ92067-18200 1903 S C0122 &CA..              H0101 Q<þúASMB,R,L,C HED CA.. ROUTINE * NAME: CA.. * SOURCE: 92067-18200 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CA..,8 92067-16185 REV.1903 760513 ENT CA.. EXT N.OPL,.ENTR,.DFER,G0.. SUP * * THIS MODULE OF THE RTE FILE MANAGEMENT PACKAGE CACULATES * A VALUE AND STORES IT IN A GLOBAL LOCATION. IT IS CALLED * WHEN A STATEMENT OF THE FORM: * * :CA,#,OPERAND1,OPERATION,OPERAND2,OPERATION,OPERAND3...ETC. * * IS ENCOUNTERED. * * THE RESULT OF THE OPERATION WILL BECOME GLOBAL '#'. * * OPERATION CODES ARE: * * + ADD * - SUBTRACT (1-2) * / DIVIDE (1/2) * * MULTIPLY (1*2) * O OR (1 OR 2) * X EXCLUSIVE OR (1 XOR 2) * A AND (1 AND 2) * * THE ORDER OF THE RESULT WILL BE THE MAXIMUM OF THE ORDERS * OF THE OPERANDS. (THE ORDER IS 0=NULL,1=NUMERIC AND 3=ASCII) * IN ALL CASES EXCEPT / AND * THE CACULATION IS DONE INDEPENDTLY * ON THE THREE WORD VALUES OF THE OPERANDS. IN THE CASE OF * / AND * THE FIRST WORD OF OPERAND TWO IS USED FOR ALL * THREE WORD OF OPERAND ONE. * * EVALUATION PROCEEDS FROM LEFT TO RIGHT UNTIL A NULL OPERATION * CODE IS DETECTED. ANY OTHER PRECEDENCE MUST BE EFFECTED BY * MULTIPLE STATEMENTS. * COUNT NOP PRAM NOP ERR NOP CA.. NOP JSB .ENTR GET THE PRAMS DEF COUNT * * ISZ PRAM STEP TO GLOBAL # LDA PRAM,I GET IT LDB N.OPL GET POSSIB¤þúLE 'P' FLAG CPB "P" SET ?? JMP PTST YES GO TEST 'P' NUMBER * SSA,RSS CMA,INA,SZA,RSS IF 0 OR - JMP EREX TAKE GAS. * ADA .9 IF MORE THAN SSA 9 JMP EREX TAKE GAS. * LDB PRAM,I GET THE NUMBER BLS,BLS TIMES 4 PADD LDA DGLOB GET THE ADDRESS OF THE RAL,CLE,SLA,ERA GLOBAL ARRAY LDA A,I ADA B COMPUTE THE DESTINATION ADDRESS STA DESTT AND SET IT LDB PRAM SET UP THE TEMP ADB .3 STORE STB TDES ADDRESS STB PRAM * LOOP ADB .5 INDEX TO OP LDA B,I PICK UP OP CODE ADB .3 INDEX TO OP2 STB PRAM SET ADDRESS SZA,RSS IF NO CODE JMP EXOK THEN END OF LINE, GO EXIT * AND C377 KEEP FIRST CHARACTER CLB,CLE SET UP THE COMP LOOP STB COMP STB ADDR STB DMCD CPA MINUS SUBTRACT? CCE,RSS YES SET FLAG AND USE PLUS CPA PLUS ADD LDB ADA YES USE ADD INSTR CPA "O" OR? LDB IOR YES CPA "X" XOR? LDB XOR YES CPA "A" AND? LDB AND YES SZB ON OF THE ABOVE? JMP SETOP YES GO SET UP * CPA "/" DIVIDE? LDB DIV YES CPA TIMES *? LDB MPY YES SZB,RSS IF STILL NO GO JMP EREX THEN GO EXIT ERROR * STB DMCD SET *, / CODE LDB LDB SET A LDB BEFORE IT STB COMP AND LDB PRAM SET THE OP 2 ADDRESS CLE,INB AFTER THE DIV STB ADDR LDB ASR GET THE ASR INSTRUCTION * SETOP STB OPCD SET THE OP CODE LDA NEGAT IF - SEZ SET STA COMP A CMA,INA LDA N3 SET THE LOOP COUNT STA COUNT LDA TDES AND THE DESTINATION ADDRESS STÁþúA DES LDA A,I SET THE ORDER CODE NEGAT CMA,INA ADA PRAM,I TO THE LDB PRAM,I MAX SSA,RSS OF THE STB DES,I ORDERS PRESENT * CLOOP ISZ DES STEP DESTINATION ADDRESS ISZ PRAM AND SOURCE ADDRESS LDB DES GET ADDRESS TO B LDA PRAM,I OP2 TO A COMP CMA,INA /NOP /LDB B,I DO IT OPCD ADA B,I /ASR 16 DMCD NOP /DIV/MPY ADDR NOP /ADDR -PRAM STA DES,I SET THE RESULT AWAY ISZ COUNT DONE? JMP CLOOP NO DO NEXT WORD * LDB PRAM SET UP A FOR ADB N3 NEXT OP CODE JMP LOOP AND LOOP * PTST ADA .36 MUST BE IN RANGE -36<= X < 7 SSA,RSS IF NEGATIVE THEN < -36 CPA .36 DON'T ALLOW ZERO EITHER JMP EREX ERROR ZERO OR LESS THAN -36 * ADA N43 TEST FOR > 7 SSA,RSS OK? JMP EREX NO NUMBER TO BIG * LDB PRAM,I GET PRAM AND ADB .40 CACULATE THE ADDRESS OFFSET JMP PADD GO SET IT UP AND DO THE 'CA' * * EXOK LDA TDES,I AH - SWEET SUCCESS STA DESTT,I SET NEW PRAM IN DESTINATION ISZ TDES LDB N.OPL IF A CPB "P" P CACULATE JMP PSET GO RESET TO RIGHT THING * ISZ DESTT AND JSB .DFER THEN DESTT NOP TDES NOP EXP CLA,RSS EREX LDA BADPM ERROR EXIT STA ERR,I SET ERROR CODE JMP CA..,I EXIT * * PSET LDA TDES,I GET THE VALUE WORD STA DESTT,I AND SET FOR P JMP EXP GO EXIT * DES NOP DGLOB DEF G0.. BADPM DEC 56 ASR ASR 16 LDB LDB B,I ADA ADA B,I IOR IOR B,I AND AND B,I XOR XOR B,I DIV OCT 100400 MPY OCT 100200 "A" OCT 40400 "X" OCT 54000 "O" OCT 47400 "P" ASC 1,P P BLANK FOR P TEST MINUS OCT 26400 PLUS OCT 25400 "/" OCT 27400 TIMES OCT 25000 C377 OCT 177400 .3 DEC 3 .9 DEC 9 .5 DEC 2‹5 .36 DEC 36 .40 DEC 40 N3 DEC -3 N43 DEC -43 A EQU 0 B EQU 1 ORG * END •}ÿÿ ÿý€‰ ÿ92067-18201 2026 S C0122 &C.TAB              H0101 U~þúASMB,R,L,C * NAME: C.TAB * SOURCE: 92067-18201 * RELOC: 92067-16185 * PGMR: G.A.A., B.L., D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM C.TAB,8 92067-16185 REV.2026 800221 ENT C.TAB * * SET UP SEGMENT AND ROUTINE NUMBERS. * R0 EQU 0 R1 EQU 400B R2 EQU R1+R1 R3 EQU R2+R1 R4 EQU R3+R1 R5 EQU R4+R1 R6 EQU R5+R1 R7 EQU R6+R1 R8 EQU R7+R1 R9 EQU R8+R1 R10 EQU R9+R1 SPC 1 S0 EQU 60B S1 EQU S0+1 S2 EQU S0+2 S3 EQU S0+3 S4 EQU S0+4 S5 EQU S0+5 S6 EQU S0+6 S7 EQU S0+7 S8 EQU S0+8 S9 EQU S0+9 SA EQU 101B SB EQU SA+1 * * THIS IS THE COMMAND DISPATCH TABLE FOR THE FMGR PROGRAM. * EACH COMMAND ID IS FOLLOWED BY ITS ADDRESS. * FOR ROUTINES IN THE HOME SEGMENT THIS IS AN ADDRESS (DEF XX). * FOR ROUTINES IN OTHER SEGMENTS IT IS THE ASCII SEGMENT * SUFFIX IN THE LOW HALF OF THE WORD AND THE ROUTINE * NUMBER IN THAT SEGMENT IN THE HIGH HALF OF THE WORD. * .PARS BREAKS THESE APART BY THE ADDRESS BEING 0< ADD < 10000B * FOR SEGMENT ADDRESS. * * COMMANDS WITH THE SIGN BIT SET INDICATE THAT THE COMMAND * NEED NOT SATISFY ALL THE SYNTAX RESTRICTIONS IMPOSED ON * OTHER COMMANDS. * SPC 1 * * SESSION MONITOR COMMAND CAPABILITY LEVELS * C.TAB DEF BEGIN DEF ENDS DEF SCMD L1 DEC 1 L1A DEF LV10 L10 DEC 10 L10A DEF LV20 L20 DEC 20 L20A DEF LV30 L30 DEC 30 L30A DEF LV40 L40 DEC 40 L40A DEF LV50 L50 DEC 50 L50A DEF LV60 L60 DEC 60 L60A DEF SCMD ENDS DEF NONSM ENDT ´hþúDEF END SPC 1 * * STRUCTURE CHECKS * ORG C.TAB BSS ENDT-ENDS BSS ENDS-L60A BSS L60A-L50A BSS L50A-L40A BSS L40A-L30A BSS L30A-L20A BSS L20A-L10A BSS L10A-L1A ORR SPC 1 BEGIN EQU * NOP NULL COMMAND (TR) DEF TR.. ASC 1,TR EXT TR.. DEF TR.. ASC 1,EX EXT EE.. DEF EE.. OCT 151531 "SY" WITH SIGN BIT SET ABS S7+R2 LV10 ASC 1,?? <> ABS S7+R1 OCT 125052 "**" WITH SIGN BIT SET DEF COMM OCT 125000 "*" WITH SIGN BIT SET DEF COMM OCT 125040 "*" WITH SIGN BIT SET DEF COMM ASC 1,LI ABS S9+R1 ASC 1,CL ABS S9+R0 ASC 1,DL ABS S3+R1 ASC 1,MC ABS S4+R3 ASC 1,DC ABS S4+R4 ASC 1,WH ABS SB+R3 800221 OCT 151515 "SM" WITH SIGN BIT SET ABS SA+R0 ASC 1,ME ABS SA+R1 ASC 1,AC ABS S4+R5 LV20 ASC 1,CR <> ABS S8+R1 ASC 1,ST ABS S0+R2 ASC 1,DU ABS S0+R3 ASC 1,PU ABS S2+R2 ASC 1,RN ABS S6+R4 ASC 1,CO ABS S0+R1 ASC 1,PK ABS S0+R0 ASC 1,CN ABS S5+R4 800221 ASC 1,LL ABS S4+R0 ASC 1,SV ABS S4+R2 OCT 142120 "DP" WITH SIGN BIT SET EXT DP.. DEF DP.. OCT 140516 "AN" WITH SIGN BIT SET ABS S5+R3 800221 OCT 141524 "CT" WITH SIGN BIT SET ABS S5+R5 800221 LV30 ASC 1,SP <> ABS S8+R0 OCT 151125 "RU" WITH SIGN BIT SET ABS SB+R1 P¬ 800221 ASC 1,RP ABS SB+R0 800221 ASC 1,OF ABS S6+R3 ASC 1,RT ABS S6+R2 ASC 1,JO ABS S6+R0 ASC 1,EO ABS S6+R1 ASC 1,CS ABS S3+R0 ASC 1,AB EXT AB.. DEF AB.. ASC 1,TL ABS S5+R0 800221 LV40 ASC 1,SE <> EXT SE.. DEF SE.. ASC 1,IF EXT IF.. DEF IF.. ASC 1,CA EXT CA.. DEF CA.. OCT 150101 "PA" WITH SIGN BIT SET ABS S5+R1 800221 LV50 ASC 1,LO <> ABS S4+R1 LV60 ASC 1,IN <> ABS S2+R1 SCMD ASC 1,SL <> ABS S6+R5 OCT 144105 "HE" WITH SIGN BIT SET ABS SB+R2 800221 OCT 152105 "TE" WITH SIGN BIT SET ABS S5+R2 800221 NONSM ASC 1,LU <> ABS S6+R5 ASC 1,LS ABS S6+R2 ASC 1,LG ABS S6+R2 ASC 1,MS ABS S4+R6 ASC 1,MR EXT MR.. DEF MR.. ASC 1,SA ABS S8+R2 END NOP <> * * COMM NOP LDA COMM,I JMP 0,I END ièÿÿ ÿý‰ ÿ92067-18202 2026 S C0122 &??..              H0101 T2þúASMB,R,Q,C HED FMGR ERROR EXPANDER MODULE PART OF RTE FMP * NAME: ??.. * SOURCE: 92067-18202 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ??..,8 92067-16185 REV.2026 800313 ENT ??.. EXT EXEC,TMP.,WRITF,O.BUF,.ENTR,.R.E.,.E.R. EXT CAM.O,IER.,BUF.,IFLG. EXT FM.AB,OPEN. SUP N NOP LST NOP SPC 1 ??.. NOP ENTRY POINT JSB .ENTR GEN PRAMS DEF N SPC 1 LDB .R.E. GET ERROR PRAM ASR 16 EXTEND THE SIGN BIT DIV .1000 DIVIDE LDA B ERROR CODE TO A LDB LST,I GET FLAG ISZ LST STEP TO SZB IF NOT SUPPLIED USE .E.R. LDA LST,I ELSE USE FIRST PRAM CPA .99 IF PRAM=99 JMP ALL THEN PRINT ALL CODES ON LIST * CPA N99 CHECK FOR SPECIAL ERROR *780512* JMP PN99 GO PRINT IT *780512* * CPA N101 CHECK FOR INTERNAL JMP PN101 ERRORS, CPA N102 CODES -101 AND -102 JMP PN102 STA N SAVE CODE ADA MOSNG TEST FOR SSA DEFINED CODE JMP UDF TOO NEGATIVE LDA N ADA NHLP1 SSA JMP PRINT OK - PRINT IT ADA NHLG SSA JMP UDF IN MID CODE GAP - UNDEFINED ADA NHH SSA,RSS JMP UDF TO HIGH - UNDEFINED LDA N ADJUST N ADA NHLG FOR HIGH GROUP STA N TABLE PRINT LDA N GET N ALS $wþú DOUBLE ADA TBAD ADD TABLE ADDRESS PR LDB A,I GET MESSAGE ADDRESS STB MSAD SET AS POINTER INA GET LDB A,I MESSAGE STB A LENGTH CMA,INA SET FOR STA N MOVE ADB .2 AND STB LST OUTPUT DLD FMGR SET FMGR BF DST BUF. AT LDA BUF.D HEAD RSS LDA A,I OF RAL,CLE,SLA,ERA MESSAGE JMP *-2 GET ADA .2 BUFFER ADDRESS AND MOVE LDB MSAD,I MOVE STB A,I MESSAGE INA TO ISZ MSAD THE ISZ N BUFFER JMP MOVE JSB EXEC PRINT DEF FMRTN ON DEF .2 LOG DEF CAM.O BUF.D DEF BUF. DEVICE DEF LST FMRTN LDA IFLG. IF INIT SZA THEN JMP ??..,I RETURN LDB .R.E. IF STA .R.E. CPB .60 60 JMP FM.AB THE ABORT JMP ??..,I ELSE, RETURN SPC 3 N99 DEC -99 DN99 DEF DFN99 DN101 DEF ER101 DN102 DEF ER102 PN99 LDA DN99 FETCH ADDR OF ERROR *780512* RSS PN101 LDA DN101 RSS PN102 LDA DN102 RSS SPC 2 UDF LDA DFUDF PICK UNDEFINED JMP PR AND SEND IT. SPC 3 ALL LDA IFLG. SZA JMP FMRTN LIST ALL LDA TMP.D RSS POSSIBLE LDA A,I ERROR RAL,CLE,SLA,ERA CODES. JMP *-2 GET PARAMETER ADA .3 ADDRESS STA LST AND JSB OPEN. OPEN DEF OPRTN LIST DEF O.BUF FILE TMP.D DEF TMP. DEF LST,I DEF .0 OPRTN DLD PTRS SET THE DST CPTRS POINTERS FOR LENGTH/BUFFER AD WRIT LDA CPTRS CHECK FOR RAL,CLE,ERA UNDEFINED ERROR LDA A,I IF UNDEFINED, CPA AUDN THEN SKIP h›þúJMP NEXT PRINTING OF IT JSB WRITF WRITE DEF WRRTN THE DEF O.BUF MESSAGE DEF .E.R. ON CPTRS NOP THE NOP LIST WRRTN JSB IER. DEVICE DEF *+1 CHECK FOR ERRORS NEXT LDA CPTRS+1,I IF CURRENT LENGTH SSA NEGATIVE THEN JMP FMRTN DONE - RETURN. ISZ CPTRS ISZ CPTRS STEP THE ISZ CPTRS+1 ISZ CPTRS+1 BUFFER AND LENGTH POINTERS JMP WRIT ELSE GO WRITE NEXT MESSAGE SPC 3 .1000 DEC 1000 .99 DEC 99 N101 DEC -101 N102 DEC -102 .2 DEC 2 .3 DEC 3 .60 DEC 60 SPC 1 A EQU 0 B EQU 1 MSTN EQU 49 MOST NEGATIVE ERROR CODE HLOW EQU 23 MOST POSITIVE OF LOW GROUP LHIG EQU 38 LOWEST OF HIGH GROUP HHIG EQU 79 HIGHEST OF HIGH GROUP SPC 1 MOSNG ABS MSTN MOST NEG. CODE NHLP1 ABS -HLOW-1 NEG. OF LOW HIGH BOUND NHLG ABS HLOW+1-LHIG NEG. OF LOW HIGH GAP NHH ABS LHIG-HHIG-1 NEG. OF HIGH SIZE. SPC 1 BFPT NOP MSAD NOP DFUDF DEF *+1 DEF UDN ABS LUDN FMGR ASC 2,FMGR TBAD DEF MS00 PTRS DEF LSHED,I DEF LSHED+1 UDN ASC 9, ERROR NOT DEFINED LUDN EQU *-UDN LSHED DEF HEAD THIS LIST ABS LHEAD IS IN DEF BLNK THE ABS LBLNK ORDER DEF HD2 OF ABS LHD2 PRINTING DEF BLNK AND ABS LBLNK ALSO ER101 DEF EM101 NUMERICAL ABS L101 ORDER ER102 DEF EM102 ABS L102 DFN99 DEF ERM99 ABS LM99 DEF ERM49 ABS LM49 DEF ERM48 ABS LM48 DEF ERM47 ABS LM47 DEF ERM46 ABS LM46 AUDN DEF UDN -45 (RTE-LC) SWAP FILE TOO SMALL ABS LUDN DEF UDN -44 (RTE-LC) WRONG FILE TYPE FOR SWAP ABS LUDN DEF UDN -43 (RTE-LC) SYSTEM DOES NOT ALLOW SWAPPING î¸þúABS LUDN DEF UDN -42 (RTE-LC) SWAPPING ACTIVE ABS LUDN DEF ERM41 ABS LM41 DEF ERM40 ABS LM40 DEF ERM39 ABS LM39 DEF ERM38 ABS LM38 DEF UDN -37 (RTE-LC) ATTEMPT TO PURGE ACTIVE TYPE 6 FILE ABS LUDN DEF ERM36 -36 LOCK ERROR ON DEVICE ABS LM36 DEF ERM35 ABS LM35 DEF ERM34 ABS LM34 DEF ERM33 ABS LM33 DEF ERM32 ABS LM32 DEF UDN -31 (RTE-M) MASTER DIRECTORY LOCK CONFLICT ABS LUDN DEF ERM30 ABS LM30 DEF UDN -29 (RTE-M) ILLEGAL DIRECTORY ON CARTRIDGE TAPE ABS LUDN DEF UDN -28 (RTE-M) SEGLD DETECTED CHECKSUM ERROR ABS LUDN DEF UDN -27 (RTE-M) MEMORY BOUNDS ERROR ABS LUDN DEF ERM26 ABS LM26 DEF ERM25 ABS LM25 DEF ERM24 ABS LM24 DEF ERM23 ABS LM23 DEF ERM22 ABS LM22 DEF ERM21 ABS LM21 DEF ERM20 ABS LM20 DEF ERM19 ABS LM19 DEF ERM18 ABS LM18 DEF ERM17 ABS LM17 DEF ERM16 ABS LM16 DEF ERM15 ABS LM15 DEF ERM14 ABS LM14 DEF ERM13 ABS LM13 DEF ERM12 ABS LM12 DEF ERM11 ABS LM11 DEF ERM10 ABS LM10 DEF ERM9 ABS LM9 DEF ERM8 ABS LM8 DEF ERM7 ABS LM7 DEF ERM6 ABS LM6 DEF ERM5 ABS LM5 DEF ERM4 ABS LM4 DEF ERM3 ABS LM3 DEF ERM2 ABS LM2 DEF ERM1 ABS LM1 MS00 DEF ER0 ABS L0 DEF ER1 ABS L1 DEF ER2 ABS L2 DEF ER3 ABS L3 DEF ER4 ABS L4 DEF ER5 ABS L5 DEF ER6 ABS L6 DEF ER7 ABS L7 DEF ER8 ABS L8 DEF ER9 ABS L9 DEF ER10 Çþú ABS L10 DEF ER11 ABS L11 DEF ER12 ABS L12 DEF ER13 ABS L13 DEF ER14 ABS L14 DEF ER15 ABS L15 DEF ER16 ABS L16 DEF ER17 ABS L17 DEF ER18 ABS L18 DEF ER19 ABS L19 DEF ER20 ABS L20 DEF ER21 ABS L21 DEF ER22 ABS L22 DEF ER23 ABS L23 DEF ER38 ABS L38 DEF UDN ABS LUDN DEF UDN ABS LUDN DEF ER41 ABS L41 DEF ER42 ABS L42 DEF ER43 ABS L43 DEF ER44 ABS L44 DEF ER45 ABS L45 DEF ER46 ABS L46 DEF ER47 ABS L47 DEF ER48 ABS L48 DEF ER49 ABS L49 DEF ER50 ABS L50 DEF ER51 ABS L51 DEF ER52 ABS L52 DEF ER53 ABS L53 DEF ER54 ABS L54 DEF ER55 ABS L55 DEF ER56 ABS L56 DEF ER57 ABS L57 DEF ER58 ABS L58 DEF ER59 ABS L59 DEF ER60 ABS L60 DEF ER61 ABS L61 DEF ER62 ABS L62 DEF ER63 ABS L63 DEF ER64 ABS L64 DEF ER65 ABS L65 DEF ER66 ABS L66 DEF ER67 ABS L67 DEF ER68 ABS L68 DEF ER69 ABS L69 DEF ER70 ABS L70 DEF ER71 ABS L71 DEF ER72 ABS L72 DEF ER73 ABS L73 DEF ER74 ABS L74 DEF ER75 ABS L75 DEF ER76 ABS L76 DEF ER77 ABS L77 DEF ER78 ABS L78 DEF ER79 ABS L79 DEF ER101 EOF RECORD DEC -1 .0 NOP END OF THE LIST * ERROR TABLE -CODES ARE ENTERED IN ANY ORDER. ER0 ASC 5, 000 BREAK L0 EQU *-ER0 ERM1 ASC 8, -01 DISC ERROR LM1 EQU *-ERM1 ERM2 ASC 12, -02 DUPLICATE FILE NAME LMq®þú2 EQU *-ERM2 ERM3 ASC 11, -03 BACKSPACE ILLEGAL LM3 EQU *-ERM3 ERM4 ASC 20, -04 RECORD SIZE OF TYPE 2 FILE IS 0 OR ASC 5,UNDEFINED LM4 EQU *-ERM4 ERM5 ASC 13, -05 RECORD LENGTH ILLEGAL LM5 EQU *-ERM5 ERM6 ASC 10, -06 FILE NOT FOUND. LM6 EQU *-ERM6 ERM7 ASC 19, -07 BAD FILE SECURITY CODE OR ILLEGAL ASC 10, WRITE ON LU 2 OR 3 LM7 EQU *-ERM7 ERM8 ASC 16, -08 FILE OPEN OR LOCK REJECTED LM8 EQU *-ERM8 ERM9 ASC 19, -09 ATTEMPT TO USE APOSN OR FORCE TO ASC 8,1 A TYPE 0 FILE LM9 EQU *-ERM9 ERM10 ASC 13, -10 NOT ENOUGH PARAMETERS LM10 EQU *-ERM10 ERM11 ASC 9, -11 DCB NOT OPEN LM11 EQU *-ERM11 ERM12 ASC 11, -12 EOF OR SOF ERROR LM12 EQU *-ERM12 ERM13 ASC 8, -13 DISC LOCKED LM13 EQU *-ERM13 ERM14 ASC 10, -14 DIRECTORY FULL LM14 EQU *-ERM14 ERM15 ASC 9, -15 ILLEGAL NAME LM15 EQU *-ERM15 ERM16 ASC 14, -16 ILLEGAL TYPE OR SIZE=0 LM16 EQU *-ERM16 ERM17 ASC 19, -17 ILLEGAL READ/WRITE ON TYPE 0 FILE LM17 EQU *-ERM17 ERM18 ASC 8, -18 ILLEGAL LU LM18 EQU *-ERM18 ERM19 ASC 17, -19 ILLEGAL ACCESS TO SYSTEM DISC LM19 EQU *-ERM19 ERM20 ASC 11, -20 ILLEGAL ACCESS LU LM20 EQU *-ERM20 ERM21 ASC 14, -21 ILLEGAL DESTINATION LU LM21 EQU *-ERM21 ERM22 ASC 14, -22 NO AVAILABLE SPOOL LU'S LM22 EQU *-ERM22 ERM23 ASC 15, -23 NO AVAILABLE SPOOL FILES LM23 EQU *-ERM23 ERM24 ASC 14, -24 NO MORE BATCH SWITCHES LM24 EQU *-ERM24 ERM25 ASC 10, -25 NO SPLCON ROOM LM25 EQU *-ERM25 ERM26 ASC 23, -26 QUEUE FULL OR MAX PENDING SPOOLS EXCEEDED LM26 EQU *-ERM26 ERM30 ASC 17, -30 VALUE TOO LARGE FOR PARAMETER. LM30 EQU *-ERM30 ERM32 ASC 15, -32 DISC CARTRIDGE NOT FOUND LM32 EQU *-ERM32 ERM33 ASC 19, -33 NOT ENOUGH ROOM ON DISC CARTRIDGE LM33 EQU *-ERM33 ERM34 ASC 13, -34 DISC ALREADY MOUNTED LM34 EQU *-ERM34 ERM35 ASC 12, -35 MORE THAN 63 DISCS LM35 EQU *-ERM35 ERM36 ASC 13, -36 LOCK ERROR ON DEVICE LM36 EQU *-ERM36 ERM38 ASC 16, -38 ILLEGAL SCRATCH FILE NUMBER LM38 EQU *-ERM38 ERM39 ÛþúASC 22, -39 SPOOL LU NOT MAPPED TO THE SPOOL DRIVER LM39 EQU *-ERM39 ERM40 ASC 12, -40 LU NOT FOUND IN SST LM40 EQU *-ERM40 ERM41 ASC 10, -41 NO ROOM IN SST LM41 EQU *-ERM41 ERM46 ASC 15, -46 GREATER THAN 255 EXTENTS LM46 EQU *-ERM46 ERM47 ASC 22, -47 NO AVAILABLE SESSION LU FOR SPOOL FILE LM47 EQU *-ERM47 ERM48 ASC 17, -48 SPOOL NOT INITIALIZED OR SMP ASC 10,CANNOT BE SCHEDULED LM48 EQU *-ERM48 ERM49 ASC 12, -49 COPY VERIFY FAILED LM49 EQU *-ERM49 SPC 1 EM101 ASC 18,-101 ILLEGAL PARAMETER IN D.RTR CALL L101 EQU *-EM101 EM102 ASC 16,-102 ILLEGAL D.RTR CALL SEQUENCE L102 EQU *-EM102 ERM99 ASC 22, -99 DIRECTORY MANAGER EXEC REQUEST ABORTED LM99 EQU *-ERM99 ER1 ASC 14, 001 DISC ERROR-LU REPORTED L1 EQU *-ER1 ER2 ASC 11, 002 INITIALIZE LU 2! L2 EQU *-ER2 ER3 ASC 11, 003 INITIALIZE LU 3! L3 EQU *-ER3 ER4 ASC 18, 004 ILLEGAL RESPONSE TO 002 OR 003 L4 EQU *-ER4 ER5 ASC 18, 005 REQUIRED TRACK NOT AVAILABLE - ASC 15,RELATIVE TAT POSITION REPORTED L5 EQU *-ER5 ER6 ASC 10, 006 FMGR SUSPENDED L6 EQU *-ER6 ER7 ASC 10, 007 CHECKSUM ERROR L7 EQU *-ER7 ER8 ASC 11, 008 D.RTR NOT LOADED L8 EQU *-ER8 ER9 ASC 13, 009 ID-SEGMENT NOT FOUND L9 EQU *-ER9 ER10 ASC 8, 010 INPUT ERROR L10 EQU *-ER10 ER11 ASC 18, 011 DO OF,XXXXX,8 ON NAMED PROGRAMS L11 EQU *-ER11 ER12 ASC 16, 012 DUPLICATE DISC LABEL OR LU L12 EQU *-ER12 ER13 ASC 11, 013 TR STACK OVERFLOW L13 EQU *-ER13 ER14 ASC 20, 014 REQUIRED ID-SEGMENT OR ID-EXTENSION ASC 5, NOT FOUND L14 EQU *-ER14 ER15 ASC 10, 015 LS TRACK REPORT L15 EQU *-ER15 ER16 ASC 19, 016 INSUFFICIENT SYSTEM TRACKS FOR RP L16 EQU *-ER16 ER17 ASC 16, 017 ID SEGMENT NOT SET UP BY RP L17 EQU *-ER17 ER18 ASC 12, 018 PROGRAM NOT DORMANT L18 EQU *-ER18 ER19 ASC 19, 019 FILE NOT SET UP BY SP ON CURRENT ASC 3,SYSTEM L19 EQU *-ER19 ER20 ASC 11, 020 ILLEGAL TYPE 0 LU L20 EQU *-ER20 ER21 ASC 14, 02HYþú1 ILLEGAL DISC SPECIFIED L21 EQU *-ER21 ER22 ASC 10, 022 COPY TERMINATED L22 EQU *-ER22 ER23 ASC 14, 023 DUPLICATE PROGRAM NAME. L23 EQU *-ER23 SPC 2 ER38 ASC 18, 038 ATTEMPT TO REMOVE ACTIVE TYPE 6 ASC 3, FILE L38 EQU *-ER38 ER41 ASC 16, 041 PROGRAM CANNOT BE A SEGMENT L41 EQU *-ER41 ER42 ASC 13, 042 LU CANNOT BE SWITCHED L42 EQU *-ER42 ER43 ASC 12, 043 LU NOT FOUND IN SST L43 EQU *-ER43 ER44 ASC 12, 044 NO MESSAGES WAITING L44 EQU *-ER44 ER45 ASC 13, 045 SESSION COMMAND ONLY L45 EQU *-ER45 ER46 ASC 14, 046 INSUFFICIENT CAPABILITY L46 EQU *-ER46 ER47 ASC 12, 047 SPOOL SETUP FAILED L47 EQU *-ER47 ER48 ASC 14, 048 GLOBAL SET OUT OF RANGE L48 EQU *-ER48 ER49 ASC 20, 049 CAN'T RUN RP'ED PROG. OR PARTITION ASC 5,TOO SMALL L49 EQU *-ER49 ER50 ASC 13, 050 NOT ENOUGH PARAMETERS L50 EQU *-ER50 ER51 ASC 17, 051 ILLEGAL MASTER SECURITY CODE L51 EQU *-ER51 ER52 ASC 8, 052 ILLEGAL LU. L52 EQU *-ER52 ER53 ASC 14, 053 ILLEGAL LABEL OR ILABEL L53 EQU *-ER53 ER54 ASC 11, 054 DISC NOT MOUNTED L54 EQU *-ER54 ER55 ASC 11, 055 MISSING PARAMETER L55 EQU *-ER55 ER56 ASC 9, 056 BAD PARAMETER L56 EQU *-ER56 ER57 ASC 16, 057 BAD TRACK NOT IN FILE AREA L57 EQU *-ER57 ER58 ASC 16, 058 LG AREA EMPTY OR TOO SMALL! L58 EQU *-ER58 ER59 ASC 16, 059 REPORTED TRACK UNAVAILABLE L59 EQU *-ER59 ER60 ASC 19, 060 DO YOU REALLY WANT TO PURGE THIS ASC 9,DISC? (YES OR NO). L60 EQU *-ER60 ER61 ASC 18, 061 DO A "DC" AND A "MC" ON THIS CR L61 EQU *-ER61 ER62 ASC 12, 062 MORE THEN 63 DISCS L62 EQU *-ER62 ER63 ASC 17, 063 EXCEEDING SESSION DISC LIMIT L63 EQU *-ER63 ER64 ASC 19, 064 NO DISCS AVAILABLE FROM DISC POOL L64 EQU *-ER64 ER65 ASC 16, 065 CONFLICT IN SST DEFINITION L65 EQU *-ER65 ER66 ASC 10, 066 NO ROOM IN SST L66 EQU *-ER66 ER67 ASC 11, 067 PROGRAM NOT FOUND L67 EQU *-ER67 ER68 ASC 18, 068 LU NOT IN VARIABLE PART OF SST L68 EQU *-ER68 M»640ER69 ASC 11, 069 JOB LOGON FAILED L69 EQU *-ER69 ER70 ASC 17, 070 SECTORS/TRACK VALUE TOO LARGE L70 EQU *-ER70 ER71 ASC 19, 071 DO "EX,SP" TO SAVE OR "EX,RP" TO ASC 13,RELEASE PRIVATE CARTRIDGES L71 EQU *-ER71 ER72 ASC 12, 072 LU NOT INTERACTIVE L72 EQU *-ER72 ER73 ASC 11, 073 ACCOUNT NOT FOUND L73 EQU *-ER73 ER74 ASC 12, 074 JO COMMAND EXPECTED L74 EQU *-ER74 ER75 ASC 15, 075 CAN'T RESTORE TYPE 6 PGM ASC 8,(USER PROTECTED) L75 EQU *-ER75 ER76 ASC 15, 076 CAN'T RESTORE TYPE 6 PGM ASC 9,(GROUP PROTECTED) L76 EQU *-ER76 ER77 ASC 15, 077 CAN'T RESTORE TYPE 6 PGM ASC 13,(INSUFFICIENT CAPABILITY) L77 EQU *-ER77 ER78 ASC 15, 078 CAN'T RESTORE TYPE 6 PGM ASC 8,(INTERNAL ERROR) L78 EQU *-ER78 ER79 ASC 20, 079 WARNING - RECORDS TRUNCATED TO 128 ASC 3,WORDS L79 EQU *-ER79 SPC 2 HEAD ASC 9, FMGR ERROR CODES LHEAD EQU *-HEAD HD2 ASC 9, ERROR MEANING LHD2 EQU *-HD2 BLNK ASC 1, LBLNK EQU *-BLNK ORG * PROGRAM LENGTH END +6ÿÿ ÿý‚  ÿ92067-18203 2026 S C0122 &FM.CM              H0101 xfþúSPL,L,O,M ! NAME: FM.CM ! SOURCE: 92067-18203 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME FM.CM(8) "92067-16185 REV.2026 800311" ! ! MODIFIED: 780413 TO SAVE SECURITY CODE IN TRANSFER ! STACK. (GLM) ! 780414 TO CLEAR .E.R. IF LU PASSED TO OPEN. ! WAS OK. (GLM) ! 780421 SESSION MONITOR CARTRIDGE SEARCH OVERRIDE ! (BL) ! 780531 TO POST ERROR MNEMONIC TO SESSION CONTROL ! BLOCK (BL) ! 800304 TO USE ABSOLUTE VALUE OF REMAINDER IN ! CONV. COMPUTATION (SST #4660) ! 800311 IF OPEN. ERROR AND ABORTING JOB ! (USING RETURN OPTION ON OPEN. CALL), RETURN ! (SST #4770) ! ! LET EXEC BE SUBROUTINE,EXTERNAL LET CLOSE,OPEN BE SUBROUTINE,EXTERNAL LET PTERR BE SUBROUTINE,EXTERNAL !780531 LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET FM.ER,OPEN.,CLOS.,\ IER. BE SUBROUTINE LET CLO BE SUBROUTINE,DIRECT LET IFBRK, \CHECK BREAK FLAG LURQ, \LU LOCK-UNLOCK LUTRU \RETURN TRUE SYSTEM LU BE FUNCTION,EXTERNAL LET RQLU BE FUNCTION,DIRECT LET BRKF. BE INTEGER,GLOBAL LET LCKFL,WATMS(8),WATM BE INTEGER INITIALIZE BRKF. TO 0 INITIALIZE LCKFL,WATMS TO 0,"WAITING FOR LU " LEØþúT MSS. BE SUBROUTINE LET JER. BE SUBROUTINE,DIRECT LET EC.HO,CONV. BE SUBROUTINE LET ILOG BE FUNCTION,DIRECT LET CAMS.(60) BE INTEGER,GLOBAL !TRANSFER STACK *780413* LET C.BUX BE INTEGER LET C.BUF(40) BE INTEGER,GLOBAL LET TTY.,N.OPL,I.BUF,O.BUF BE INTEGER,EXTERNAL LET .TTY BE FUNCTION,EXTERNAL LET CAM.I BE INTEGER(144),GLOBAL LET CAM.O,ECH.,BUF.(129) BE INTEGER ,GLOBAL LET ECHF.,C.DLM BE INTEGER ,GLOBAL LET .R.E. BE INTEGER ,EXTERNAL LET .E.R. BE INTEGER,GLOBAL !DEFINE THE ERROR WORD LOCATION LET SVCOD BE INTEGER LET P.TR BE INTEGER,GLOBAL LET TMP. BE INTEGER,GLOBAL LET LST(2) BE INTEGER LET SVCO,CREF BE INTEGER LET S,LSSC,SCOD,NFA,ECH,LSDIS BE INTEGER LET FM.AB BE LABEL,EXTERNAL LET XEQT BE CONSTANT (1717K) LET FM(2),MS1,MS2 BE INTEGER INITIALIZE C.BUX TO " :" INITIALIZE FM , MS1,MS2 TO "FMGR 000" LET A BE CONSTANT(0) LET B BE CONSTANT(1) INITIALIZE P.TR TO @CAMS. LET NO.RD,ACTV.,CAD. BE INTEGER,EXTERNAL LET S.CAP, \9P - SESSION CAPABILITY OVRD. \CARTRIDGE SEARCH OVERRIDE BE INTEGER,EXTERNAL ! LET STWD BE CONSTANT (100015K) ! MSS.: SUBROUTINE(ER,NX)GLOBAL LET ER,NX BE INTEGER ! ! MESSAGE FORMAT: ! FMGR XXX ! ! MESSAGE ERROR WORD FORMAT ! THE THOUSANDS DIGIT IS USED AS FOLLOWS: ! IF ONE OR THREE THEN TWO MESSAGES ARE TO BE PRINTED ! ! IF ZERO OR TWO THEN ONLY ONE MESSAGE IS PRINTED ! ! IF ZERO OR ONE THEN SEND THE INPUT DEVICE TO THE LOG UNIT ! IF 2 OR 3 LEAVE THE LOG AND INPUT DEVICES AS IT IS ! IFNOT [NO_ER] THEN BRKF._1 !SAVE ERROR FOR ?? ApÅþúND ! IF BREAK ERROR SET FLAG S_NO/1000;.R.E._.B. MS1_" " !SET SIGN FOR PLUS IF NO<0 THEN [NO_ -NO;MS1_26400K]!IF NEG SET TO GIVE SIGN S_NO/1000;NO_.B. CONV.(NO,MS2,3) !CONVERT THE NUMBER *780531* FM.ER([IF S>1 THEN 1,ELSE 2],FM,4) IF S.CAP THEN CALL PTERR(FM,PERR) !POST TO SCB *780531* IF S AND 1 THEN [ \DO SECOND NUMBER *780531* S_S-1; \ *780531* MS1 _ 20040K; \ *780531* CONV.(NX,MS2,3); \ *780531* FM.ER([IF S>1 THEN 1,ELSE 2],FM,4)] !780531* RETURN END ! ! COMMAND OUTPUT (ERROR) SUBROUTINE ! FM.ER:SUBROUTINE(SCCOD,BFMS,LN)GLOBAL LET SCCOD,BFMS,LN BE INTEGER ! ! FM.ER PRINTS ONLY IF SCCOD IS GREATER THAN OR EQUAL TO ! THE SVCOD ENTERED AT TURN ON TIME ! ! IN ADDITION, IF THE SCCOD IS GREATER THAN 1, CONTROL IS SWITCHED ! TO THE LOG CHANNEL ! IF SCCOD > 1 THEN GO TO EC !ALWAYS PRINT IF 2 OR MORE IF SCCOD 3 THEN RETURN !IF CODE HIGH ENOUGH RETURN ! IF ACTV. THEN [ \IF IN AN ACTIVE IF SVCOD < 3 THEN [ \JOB, AND SV<3, CAD.,NO.RD _ 6; RETURN]] !ABORT THE JOB. IF ILOG() THEN RETURN !IF ON LOG ALREADY RETURN IF S.CAP THEN OVRD._OVRD. AND 137777K !CLEAR BEFORE GOING TO LOG OPEN.(CAM.I,CAM.O,0.0,410K) !OPEN THE INPUT TO THE LOG DEVICE RETURN END ! ! OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL ! ! DCBRF - DCB ARRAY ! LURF - FILE NAME ARRAY OR LU (IF NAME NOT >Ð;þú 20000K) ! PLIS - 2 WORD ARRAY, (1) = SECURITY CODE ! (2) = DISC ID ! OPLST - OPEN OPTION WORD ! (IF SIGN BIT SET AND FILE TYPE 0 WITH EOF OF ! LEADER AND IDCB REFERS TO O.BUF, THEN EOF CALL ! IS MADE) ! (IF BIT 14 SET, ERROR CAUSES RETURN FROM OPEN. ! INSTEAD OF NORMAL IER. EXIT TO COMMAND LOOP) ! LET DCBRF,LURF,PLIS,OPLST BE INTEGER DCB14_[DCB13_[DCB9_[DCB8_[DCB7_[DCB6_[DCB5_[DCB4_[DCB3_\ [DCB2_@DCBRF+2]+1]+1]+1]+1]+1]+1]+1]+4]+1 RTNOP_OPLST OPLST_OPLST AND 137777K .E.R._20 ! SET ERROR CODE FOR ILLEGAL LU IF LURF < 0 THEN [ \IF LU NEGATIVE IF S.CAP THEN OVRD._OVRD. AND 137777K; \IF SESSION,CLEAR OVRD GO TO ABEX] !LU NEGATIVE, SO ABORT IFNOT @DCBRF=@CAM.I THEN GOTO OPN3 ! NOT INPUT UNIT TTY._0 !SET TTY FLAG TO INDICATE NOT TTY $P.TR_$DCB14 !SAVE RECORD COUNT FOR FILE P.TR_P.TR+1! SET THE NEXT ADDRESS CALL .DFER($P.TR,LURF);P.TR_P.TR+3 !STACK THE NAME OPN3: CLO (DCBRF) !CLOSE THE OLD FILE IF LURF>20000K THEN [ \ IF FILE THEN IF S.CAP THEN [IF @DCBRF=@CAM.I THEN \SET FOR PGS SEARCH OVRD._OVRD. OR 40000K]; \ OPEN(DCBRF,.E.R.,LURF,OPLST,PLIS,$(@PLIS+1)); \OPEN THE FILE IF @DCBRF=@CAM.I THEN \RESET OVRD IF CAM.I AND [IFNOT ($DCB7 AND 20K) THEN \IF NOT ON SYSTEM DISC, OVRD._OVRD. AND 137777K]; \CLEAR OVERRIDE FLAG IF .E.R. < 0 THEN[ \IF ERROR OPAB: IF @DCBRF=@CAM.I THEN[ \ON COMMAND DCB THEN BP_1; \ P.TR_P.TR-ILOG()-4; \BACK PTR (10 IF FROM LOG) BP_0; \ $DCB14_$P.TR; \AND RESET«wþú THE RECORD COUNT IF SVCOD > 3 THEN[ \TR TO LOG NOT ALLOWED SO MSS.(.E.R.);RETURN] \SEND ERROR AND RETURN ] \ ]; \ ERROR: IF (RTNOP AND 40000K) THEN RETURN;\IF ABORTING, RETURN IER.; \REPORT ERRORS ON OTHERS GO TO OPN2 \SKIP THE ELSE CAUSE ] .E.R. _ -18 !IN CASE OF INVALID LU EXEC(STWD ,LURF,EQT5,NUM,BF) !GET STAT WORD TYPE CODE GO TO OPAB !IF ABORT GO SEND ERROR .E.R._0 !*780414*CLEAR ILLEGAL LU CODE ! ! SET EOF ! EOF_1100K !ASSUME TTY-PRINTER IF [EQT5_EQT5 AND 37400K] > 7000K THEN \IF DRIVER TYPE 17 OR > GO TO EOFCD !USE EOF IF EQT5 = 2400K THEN[ \IF DVR05 AND IF [BF_BF AND 7] = 1 THEN GO TO EOFCD, \SUBCHANNEL 1 OR ELSE[IF BF = 2 THEN[ \2 I.E. CTU EOF EOFCD: EOF_100K;GO TO OPN1]]] IF EQT5=1000K THEN GO TO LEADR !IF PUNCH OR IF (OPLST AND 110K) = 110K THEN[ \OR LEADR SUB FUN SUPPLIED LEADR: EOF_ 1000K] !USE LEADER FUNCTION ! ! OPN1: $DCB2,DCBRF_0 $DCB3_(OPLST AND 3700K) OR LURF $DCB4_EOF OR (LURF AND 77K) $DCB5,$DCB6_100001K $DCB7_100010K $DCB8,$DCB13_0 $DCB14_1 IFNOT 77K AND NUM THEN $DCB6_1 !READ ILLEGAL FROM LU ZERO $DCB9_$XEQT OPN2: IF @DCBRF=@CAM.I THEN[ \IF COMMAND DEVICE $P.TR_ PLIS; P.TR_P.TR+1; \SAVE SECURITY CODE *780413* $P.TR_ -(DCBRF AND 77K);P.TR_P.TR+1] !SAVE THE CR (-LU) IF $DCB2 THEN RETURN !IF NOT TYPE ZERO THEN RETURN IF .TTY($DCB3) OR @DCBRF=@CAM.I \IF INTERACTIVE OR IF THEN GO TO OPN5 !CMND INPUqþúT, SKIP LOCK IF LUTRU($DCB3 AND 77K) = -1 THEN \CHECK IF DEFINED BEFORE LOCK [.E.R._ -18;GO TO ERROR] !790424 IFNOT RQLU() THEN GO TO OPN5 !IF LOCKABLE LOCK AND CONTINUE CALL CONV.($DCB3 AND 77K,WATM,2) !PUT LU IN MESSAGE CALL EXEC(2,CAM.O,WATMS,9) !SEND WAIT MESSAGE OPN6: CALL EXEC(12,0,2,0,-5) !TRY EVERY 5 SECONDS CALL JER. !TEST FOR BREAK IF RQLU() THEN GO TO OPN6 !IF NOT NOW WAIT AGAIN OPN5: IF @DCBRF=@O.BUF THEN[\ IF($DCB4 AND 3700K)=1000K THEN[IF OPLST<0 THEN[\ CALL EXEC(100003K,$DCB4); \END FILE IF REASONABLE GO TO OPN55]]] !CATCH ABORTS OPN55:IF @DCBRF=@CAM.I THEN[\ TTY._.TTY($DCB3);GO TO OPN4] IF @DCBRF=@I.BUF THEN \ IF INPUT ON A ZERO [OPN4: EXEC(100003K,700K+($DCB3 AND 77K));\THEN SET EOT CONDITION RETURN] !EXTRA RETURN FOR ABORT CASE RETURN END ! RQLU: FUNCTION DIRECT RETURN LURQ(100001K,$DCB3,1) END ! ! CLOS.:SUBROUTINE(CLSOP) GLOBAL LET CLSOP BE INTEGER IF @CLSOP THEN[CLO(CLSOP);RETURN]! IF SPECIFIED CLOSE THE FILE CLO(I.BUF)! CLOSE INPUT CLO(O.BUF) ! CLOSE OUTPUT CLO (CAM.I) !CLOSE COMMAND RETURN! RETURN END ! CLO: SUBROUTINE(DCB)DIRECT !CLOSE SUBROUTINE FOR INTERNAL WORK LET DCB BE INTEGER DCBX9_[DCBX3_[DCBX2_@DCB+2]+1]+6 IF $DCBX9 # $XEQT THEN RETURN !IF NOT OPEN FORGET IT IFNOT $DCBX2 THEN[\ !IF THIS IS A TYPE 0 FILE IFNOT @DCB=@CAM.I THEN[\ AND NOT COMMAND INPUT CALL LURQ(40000K,$DCBX3,1) ]] !CLEAR THE LOCK !NOTE-- BIT 14 IS SET(NO-ABORT) GOTO CL1 !THIS LINE IS REQUIRED FOR ! !THE þú ABORT RETURN CL1: IF DCB AND 177700K THEN CLOSE(DCB) !IF NOT FAKE CLOSE $DCBX9 _0 !ELSE KILL THE OPEN FLAG RETURN END ! ! EC.HO:SUBROUTINE GLOBAL !TO ECHO COMMANDS IFNOT ECHF. THEN RETURN !IF ALREADY DONE THE RETURN IF ILOG() THEN GO TO ECH0 C.BUX_20072K !(BLANK : )ASSUME BATCH IF TTY. THEN C.BUX_ 20040K !(2 BLANKS ) IF BAD ASSUMPTION CHANGE IT CALL EXEC(2,CAM.O,C.BUX,ECH.+1) !ECHO THE COMMAND ECH0: ECHF._0 !SET THE ECHOED FLAG RETURN END ! ! ILOG: FUNCTION DIRECT DCB9_[DCB3_[DCB2_@CAM.I+2]+1]+6 !SET UP DCB ADDRESSES IFNOT ($DCB3 XOR CAM.O) AND 77K THEN[IFNOT $DCB2\ THEN [IF$DCB9=$XEQT OR BP=1 THEN RETURN 6]] RETURN 0 END ! IER.: SUBROUTINE GLOBAL IF .E.R. =>0 THEN RETURN ABEX: DO[MSS.(.E.R.);GO TO FM.AB] END ! ! JER.: SUBROUTINE GLOBAL,DIRECT !SUBROUTINE TO CHECK ERRORS IER. ! AND FOR BREAK CONDITION .E.R._0 !SET ERROR CODE FOR BREAK ERROR IF IFBRK THEN GO TO ABEX!IF BREAK CONDITION ,EXIT RETURN !ELSE RETURN END ! ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL LET NOO,BUF,NDIG BE INTEGER ! ROUTINE TO CONVERT NO WITH NDIG DIGITS TO ASC ! A T BUF ! ! BUF WILL CONTAIN THE LOWEST DIGITS BUF-1 THE NEXT ! LOWEST ETC. ! EV,BF_@BUF NUM_NOO FOR I_1 TO NDIG DO THRU COV DO[NUM_NUM/10; \ IF [DI_$B] < 0 THEN DI_ -DI; \ DI_DI+60K] $BF_[IF EV THEN ($BF AND 177400K)+DI,\ ELSE ($BF AND 377K)+(DI-<8)] COV: IF EV THEN EV_0, ELSE\ EV,BF_BF-1 RETURN END ! ! ! ! ! END END$ ±Ì0.**0ÿÿ ÿýƒ  ÿ92067-18204 1903 S C0122 &PK..              H0101 _IþúSPL,L,O,M ! NAME: PK.. ! SOURCE: 92067-18204 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME PK..(8) "92067-16185 REV.1903 790424" ! ! MODIFICATION RECORD: ! ! 1) 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT THE ! DESTINATION AND TO CORRECTLY HANDLE FILES TO 32K SECTORS ! 2) 780516 TO HANDLE LOCK. ERROR RETURN PARAMETER ! 3) 780516 TO CHECK FOR SESSION CARTRIDGE ACCESS ERRORS ! 4) 780516 TO CORRECTLY REPORT DISC CRN OF LOCKED DISCS ! 5) 780721 TO USE NEW D.RTR CALLING SEQUENCE ! 6) 790113 TO MASK OFF LOCK IN LU WORD FROM DS.LU ! 7) 790123 TO REMOVE EXCEPTION FOR TYPE 4 PGMS FROM TRAK. ! 8) 790127 TO HANDLE PACK OF LARGE FILES (>32K SECTORS) ! ! PK.. IS THE PACKING ROUTINE FOR THE ! RTE FMGR PROGRAM. ! ! IT PACKS RTE FILES AS FOLLOWS: ! ! 1. IF DISC IS LU2 OR 3 A CHECK IS ! MADE TO INSURE NO CURRENT ID SEGMENTS ! POINT TO FILE TRACKS. ! ! 2. EACH FILE IS MOVED DOWN (IF NECESSARY). ! AFTER EACH FILE IS MOVED, ITS DIRECTORY ! ENTRY IS UPDATED. ! (THUS NO MORE THAN ONE FILE IS ! LOST BY A CRASH.) ! ! 3. AFTER ALL FILES ARE MOVED, A NEW DIRECTORY ! IS CREATED PACKING OUT ALL THE PURGED ! ENTRIES AND THIS IS WRITTEN ON THE DISC VIA D.RTR. ! ! THIS ROUTINE IS ENTERED BY THE COMMAND: ! ! PK,CR ! ! WHERE CR IS OPTIONAL AND RESTRICTS ! THE PACK TO DISC CR. ! ! DECLARE EXTERNALS ! LET CONV., \INTEGER TO ASCII CONVEöáþúRSION D.RIO, \CARTRIDGE DIRECTORY READ DR.RD, \FILE DIRECTORY READ ROUTINE EXEC, \RTE EXEC ROUTINE FM.ER, \FMGR ERROR MESSAGE WRITE IER., \FMGR ERROR HANDLING ROUTINE LOCK., \CARTRIDGE LOCKING ROUTINE MSS., \FMGR ERROR MESSAGE ROUTINE READF, \FMP FILE READ ROUTINE RWNDF, \FMP FILE REWIND ROUTINE WRITF \FMP FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! LET .DAD, \DOUBLE INTEGER ADD .DSB, \DOUBLE INTEGER SUBTRACT .DMP, \DOUBLE INTEGER MULTIPLY JER. \FMGR ERROR HANDLING ROUTINE BE SUBROUTINE,EXTERNAL,DIRECT ! LET NAM.. \NAME CHECKING ROUTINE BE FUNCTION,EXTERNAL ! LET COR.A \ BE PSEUDO,EXTERNAL,DIRECT ! LET .E.R., \FMGR ERROR WORD .IDAD, \ .R.E., \FMGR INTERNAL ERROR WORD CUSE., \CURRENT SEGMENT D., \ASCII "D.RTR" D.SDR, \CARTRIDGE DIRECTORY BUFFER DS.LU, \DISC LOCK-LU WORD FROM CL I.BUF, \FMGR INTERNAL BUFFER O.BUF, \FMGR INTERNAL BUFFER OVRD., \SESSION CARTRIDGE OVERRIDE FLAG PK.DR \FILE DIRECTORY BUFFER BE INTEGER,EXTERNAL ! ! DECLARE INTERNAL SUBROUTINES ! LET BADTR, \ SETAD, \ TRAK. \CHECK ID'S PóþúOINTING TO TYPE 6'S BE SUBROUTINE ! ! DECLARE ARRAYS ! LET DW64(2),BLKMP(2),SECSZ(2),SIZ(2), \ SIZ2(2),TRK.A(2),XFER(2) \ BE INTEGER LET BTL(6) BE INTEGER LET MS(3),MS2,MS3,MS4 BE INTEGER ! INITIALIZE MS TO "DISC =" INITIALIZE BLKMP TO 0,256 INITIALIZE DW64 TO 0,64 ! ! DECLARE CONSTANTS ! LET READI BE CONSTANT( 1) LET WRIT BE CONSTANT( 2) LET BKLWA BE CONSTANT(1777K) LET XEQT BE CONSTANT(1717K) LET KEYWD BE CONSTANT(1657K) LET SECT2 BE CONSTANT(1757K) LET SECT3 BE CONSTANT(1756K) LET A BE CONSTANT( 3 ) LET B BE CONSTANT( 1 ) ! ! PK..: SUBROUTINE(N,LIS,ER) GLOBAL !ENTRY POINT PACK_$(@LIS+1) !GET THE PACK LUPT_@D.SDR !SET CL BUFFER ADDRESS PAKAD_@PK.DR !SET FILE DIRECTORY ADDRESS PK1: D.RIO(READI) !READ CL TO D.SDR ! AGAIN:DIS_[IF PACK THEN PACK,ELSE -($LUPT AND 377K)] IFNOT DIS THEN RETURN !END OF DISC DIRECTORY CALL JER. !CHECK FOR BREAK LOCK.(DIS,3,LKER)?[IF LKER = -32 THEN \IF ACCESS ERROR [IF PACK THEN [MSS.(LKER); \AND CRN GIVEN, WRITE ERROR GO TO NXDIS],\CONTINUE TO NEXT DISC ELSE GO TO NXDIS]; \ELSE SKIP TO NEXT DISC MSS.(LKER); \PRINT ERR OTHER THAN -32 MS2_DIS;MS3,MS4_" "; \BLANKS TO PAD ASCII NAME IF NAM..(MS2) THEN \IFNOT VALID NAMR, CONVERT DIGITS [IF DIS<0 THEN [ \IF LU NEGATIVE, DNO_-DIS;MS2_"- "], \MAKE POSITIVE, PREPARE FOR WRITE ELSE [DNO_DIS;MS2_" "]; \POSITIVE ALREADY CONV.(DNO,MS4,5)]; \CONVERT DISC NUMBER TO ASCII FM.ER(2,MS,6); \WRITE NUMBER OF LOCKED DISC GO TO NXDIS] !CONTINUEïfþú TO NEXT DISC ! DR.RD(READI,DIS,0)?[ER_54;RETURN] !READ SPECIFICATION ENTRY ! FILCO_0 SETAD LU_$$@DS.LU AND 377K !SET LU, MASKING OFF LOCK FLAG ! ! SET UP DCBS FOR PACKING ! DCB5_[NXSEC_[NXTR_[DCB2_[\ DCB_@O.BUF]+2]+1]+1]+1 DCB21_[DCB20_[DCB19_[OBUF_[DCB9_[DCB8_[DCB7_[DCB6_ \ DCB5+1]+1]+1]+1]+7]+3]+1]+1 FOR T_DCB TO [TBUF_DCB+32] DO $T_0 !CLEAR THE DCB $DCB_LU $DCB2_1 $DCB6_128 !SET RECORD SIZE $DCB7_100200K !SECURITY FLAG $DCB8_$PKD6 !SECTORS PER TRACK $DCB9_$XEQT !OPEN FLAG FOR T_DCB TO DCB9 DO[T1_T+16;$T1_$T] IF LU<4 THEN TRAK.(LU)?[GO TO PK26] !IF 2 OR 3, CHECK TYPE 6'S ! ! THE DISC IS LOCKED AND WE MAY START ! PACKING - WE MUST HAVE A BUFFER ! AND ITS SIZE. IF WE ARE IN THE ! BACKGROUND USE ALL THE REST OF ! CORE; ELSE USE 0.BUF+32 (256 WDS) ! IF ($($XEQT+14)AND 7)#3 THEN GOTO PK3 PK2: IF[LN_($BKLWA-[COR.A,BUFAD_.IDAD]+1)\BUFAD GETS VALUE FROM COR.A AND 77600K]>256 THEN GO TO PK5 ! PK3: DO[LN_256;BUFAD_TBUF] PK5: SECSZ(1)_0 SECSZ(2)_LN-<10 !NBR. OF SECTORS AVAILABLE TO USE ! ! BUFFER AND LENGTH ARE SET NOW ! START TO PACK ! ! DO[$NXTR_$PKD4; FOR\ T_@BTL TO @BTL+5 DO[\ PKD9_PKD9+1; $T_$PKD9]] $NXSEC,BLK_0 NXBLK:DR.RD(READI,DIS,BLK)?[GO TO CLEAN] ! FILCO_0 ! NXFIL:SETAD?[GO TO WRBLK] ! ! IFNOT $PKD THEN GOTO CLEAN !END ! IF $PKD<0 THEN GOTO NXFIL !PURGED IFNOT $PKD3 THEN GOTO NXFIL !TYPE0 ! ! IF THE FILE CONTAINS A BAD TRACK ! PURGE IT AND CONTINUE ! BADTR($PKD4,[$DCB20_$PKD5 AND 377K],$PKD6)?[WRFL,$PKD_ -1;\ GO TO WRBLK] ! ! ! COMPUTE NEW LOCATION ! NEWLO:BADTR($NXTR,$NXSEC,$PKD6)?[\ $NXTR_$BT+1;$NXSEC_0;GO TO NEWLO] ! +¢þú ! IF NEW LOCATION SAME AS OLD THEN ! GO TO NEXT FILE ! IF $NXTR=$PKD4 THEN [IF $NXSEC=$DCB20 THEN\ GO TO PK11] ! ! FAKE OPEN THE FILES ! WRFL,CO,$DCB5,$DCB21_$PKD6 !# OF SECTORS IF CO<0 THEN \IF SIZE NEGATIVE, [.B._-CO;.A._0; \ CALL .DMP(BLKMP); \MPY BY BLOCK MULTIPLIER * 2 SIZ(1)_.A.;SIZ(2)_.B.], \AND SAVE ELSE [SIZ(1)_0;SIZ(2)_CO] !ELSE JUST MAKE IT DOUBLE WORD $DCB19_$PKD4 !START TRACK RWNDF(O.BUF,.E.R.) !SET REST OF DCB IER. RWNDF($OBUF,.E.R.) !FOR IN AND OUT IER. PK10: .B._SIZ(2);.A._SIZ(1) !IF FILE SIZE(SECTORS) IS CALL .DSB(SECSZ) !GREATER THAN NUMBER OF IF .A. >= 0 THEN [ \AVAILABLE SECTORS TO USE, IF (.A. OR .B.) # 0 THEN [ \THEN USE 256 WORDS, ELSE XFER(1)_0;XFER(2)_LN; \USE FILE SIZE IN WORDS GOTO PK10A]] ! .B._SIZ(2);.A._SIZ(1) !GET FILE SIZE CALL .DMP(DW64) !CONVERT TO WORDS XFER(1)_.A.;XFER(2)_.B. !NUMBER OF WORDS TO TRANSFER PK10A:READF($OBUF,.E.R.,$BUFAD,XFER(2)) IER. WRITF(O.BUF,.E.R.,$BUFAD,XFER(2)) IER. XFER(2)_XFER(2) -< 10 !IF MORE WORDS, CONTINUE XFER .B._SIZ(2);.A._SIZ(1) !GET CURRENT SIZE CALL .DSB(XFER) !SUBTRACT WORDS MOVED SIZ(1)_.A.;SIZ(2)_.B.;.A._SIZ(1) !UPDATE WORDS LEFT TO MOVE IF (.A. OR .B.) THEN GOTO PK10 !CONTINUE IF NON-ZERO DO[$PKD4_$NXTR;$PKD5_$NXSEC+($PKD5 AND 177400K)] PK11: DO[$NXTR_NTR;$NXSEC_NSEC]!UPDATE FOR NEXT FILE ! ! POINTERS ARE UPDATED ! ! FILE IS MOVED - UPDATE DIRECTORY ! THEN GO DO NEXT FILE. ! WRBLK:IF WRFL THEN[DR.RD(WRIT,DIS,BLK);WRFL_0] IF FILCO=128 THEN[BLK_BLK+1;GOTO NXBLK],ELSE\ GO TO NXFIL CLEAN:BLK,CO_0 PK12: DR.RD(READI,DIS,BLK)?[GO TO PK25] DO[FILCO_0;SETAD] Ëþú IF BLK THEN GO TO PK16 DO[$PKD5_$NXSEC;$PKD9_$NXTR;$NXSEC_0] !SET NEXT SEC,TRK NSEC_$SECT2 IF $SECT3 THEN [IF $SECT3<$SECT2 THEN NSEC_$SECT3] $DCB5_-$PKD8*$PKD6+2 !TRKS IN DIR * SECTORS PER TRK NTR_$DCB5/NSEC IF $B THEN NTR_NTR+1 EXEC(4,NTR,$NXTR,$DCB,$DCB8) !GET TRACK(S) $DCB6_16 $DCB2_2 RWNDF(O.BUF,.E.R.) IER. PK16: IFNOT $PKD THEN GOTO PK25 IF $PKD+1 THEN[WRITF(O.BUF,.E.R.,$PKD);\ IER.;CO_CO+1] SETAD?[BLK_BLK+1;GOTO PK12] GOTO PK16 ! PK25: FOR T_PKD TO PKD+15 DO $T_0 FOR T_CO TO($DCB5-2)*4 DO[\ WRITF(O.BUF,.E.R.,$PKD);IER.] ! PK15: TRK.A(1)_$DCB TRK.A(2)_$NXTR RQST_OVRD. OR 7 EXEC(23,D.,$XEQT,RQST,DIS,$DCB8,0,TRK.A,2) DO[AREG_$0;BREG_$1;IF AREG THEN GOTO PK15] DO[.E.R._$BREG;IER.] !CHECK ERRORS PK26: LOCK.(DIS,5) !UNLOCK DISC EXEC(5,-1) !RETURN TRACKS NXDIS:I.BUF_0 !CLEAR I.BUF IN CASE WE EXIT IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] RETURN END ! ! SETAD SETS THE ADDRESSES FOR THE NEXT FILES ENTRY ! IN PK.DR - IF NONE THEN AN FRETURN IS MADE. ! SETAD:SUBROUTINE FEXIT ! IF FILCO=128 THEN FRETURN PKD9_[PKD8_[PKD6_[PKD5_[PKD4_[PKD3_[PKD_\ PAKAD+FILCO]+3]+1]+1]+1]\ +2]+1 FILCO_FILCO+16 RETURN END ! ! BADTR RETURNS FALSE IF THE CURRENT FILE ! AREA CONTAINS A BAD TRACK. ! BADTR:SUBROUTINE(TRAK,SECT,NOSEC)FEXIT SIZ3_$DCB8 -> 1 IF NOSEC<0 THEN \COMPUTE NEXT TRACK AND SECTOR, [.B._-NOSEC;.A._0; \AVOID 32K SECTORS SIGN PROBLEM CALL .DMP(BLKMP); \IF NEGATIVE SIZE, USE MULTIPLIER SIZ2(1)_.A.;SIZ2(2)_.B.], \SAVE ELSE [SIZ2(1)_0;SIZ2(2)_NOSEC]!ELSE JUST MAKE IT DOUBLE WORD .B._SECT;.A._0 CALL .DAD(SIZ2) ASSEMBÉ_þúLE ["CLE,SLA"; \DIVIDE DOUBLE WORD BY 2 "CCE"; \ "ARS"; \ "ERB"; \ "SWP"; \DIVIDE BY BLOCKS "JSB .DIV"; \ "DEF SIZ3"] NTR_.A.+TRAK NSEC_$B+$B !NEXT TRACK & SECTOR (32K SECTORS SIGN PROB.) ! CHECK EACH TRACK AGAINST THE BAD LIST. FOR T_TRAK TO[IF NSEC THEN 0,ELSE -1]\ + NTR DO[\ FOR BT_@BTL TO @BTL+5 DO[ \ IF $BT THEN[IF T=$BT THEN FRETURN]]] RETURN END ! ! TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE ! FILE MANAGEMENT TRACKS. IF ANY ARE FOUND, THE ! NAME OF THE PROGRAM IS PRINTED, ! AND AN FEXIT IS TAKEN. ! TRAK.:SUBROUTINE(LOGUN) FEXIT LU3_LOGUN AND 1 !SET LU 3 FLAG DO[NSEC,FILCO_0;NTR_($PKD4-<7)] !GET NEXT TRACK SETAD T_$KEYWD !SET INDEX TO KEYWD LIST NEXT: DMAN_[NAM3_[NAM2_[NAM1_$T+12]+1]+1]+12 IF $NAM3 AND 20K THEN DMAN_NAM3+5 !ADJUST FOR SHORT ID SEGS IF [T2_$NAM3 AND 7]=1 THEN GOTO OK !NO CHECK NEEDED FOR TYPE 1 IF (($DMAN-<1)AND 1)#LU3 THEN GOTO OK !COMPARE DISC LU IF ($DMAN AND 77600K)20000K THEN GO TO ILLU !LU MUST BE NON-ASCII IF $LIS5<1 THEN GO TO ILLU !NEGATIVE LU ILLEGAL IFNOT $LIS9 THEN GO TO MISPM !RE,WR OR BO MUST BE GIVEN ! ! SET R/W CODE IN DIRECTORY ENTRY BUFFER ! IF $LIS9 = RE THEN RW_100000K IF $LIS9 = WR THEN RW_1 IF $LIS9 = BO THEN RW_100001K IFNOT RW THEN GO TO ILLPM !ERROR, NOT RE,WR OR BO ! ! SET SPACING CODE ! IFNOT $LIS13 THEN GO TO EOFCD !SKIP IF NO SPACING CODE IF $LIS13 = BS THEN SPLC_100000K IF $LIS13 = FS THEN SPLC_1 IF $LIS13 = BO THEN SPLC_100001K IFNOT SPLC THEN GOTO ILLPM !BAD SPACING CODE ! ! SET EOF CODE IN DIRECTORY ENTRY BUFFER (DEFAULT=FMGR DEFAULT) ! EOFCD:IF $LIS17 = EOF THEN EFT_100K IF $LIS17 = PA THEN EFT_1100K IF $LIS17 = LE THEN EFT_1000K IF $LIS16<3 THEN EFT_($LIS17 AND 37K)-<6 !IF NUMERIC,USE AS CTL IF $LIS16 THEN GO TO EOF3 CALL EXEC(STWD,$LIS5,EQT5,EQT4,BF) !STATUS REQUEST ON LU GO TO UNDEF !ILLEGAL OR UNDEFINED LU EFCOD_1100K !ASSUME TTY-PRINTER EQT5_EQT5 AND 37400K !GET DRIVER TYPE IF EQT5 > 13400K THEN [ \IF A DISC (30-33) IF EQT5 < 16000K THEN GOTO ILLU] !THEN ILLEGAL LU IF EQT5 > 7000K THEN \IF DRIVER TYPE > 16 GO TO EOF1 !USE EOF CODE OF 100K IF EQT5=2400K THEN [ \IF DVR05 AND IF [BF_BF AND 7]=1 THEN GO TO EOF1, \SUBCHANNEL 1 OR 2 ELSE [IF BF=2 THEN [ \I.E., CTU EOF EOF1: EFCOD_1*¼00K; GO TO EOF2]]] IF EQT5=1000K THEN EFCOD_1000K !IF PUNCH, USE LEADR FN EOF2: EFT_EFCOD OR ($LIS5 AND 77K) EOF3: IFNOT EFT THEN GO TO ILLPM ! ! SET SUB FUNCTION (DEFAULT 00=ASCII) ! IFNOT $LIS20 THEN GO TO SETUP !DEFAULT DATA TYPE TO ASCII IF $LIS20<3 THEN LUC_($LIS21 AND 37K)-<6 !IF NUMERIC, USE IT IF $LIS21 = BI THEN LUC_100K IF $LIS21=AS THEN GO TO SETUP IFNOT LUC THEN GO TO ILLPM !IF GIVEN AND NOT BI,AS OR NUMERIC ! SETUP: LUC_ LUC+[T_($ LIS5 AND 77K)] EFT_EFT OR T NAM.. ($LIS1) !CHECK FOR VALID FILE NAME IF .A. THEN GO TO ILNAM !ILLEGAL NAME? DIS_$(@N.OPL+1) !LU/CRN FROM SUBPARM ARRAY T1_@NAM FOR T_LIS1 TO LIS1+2 DO [$T1_$T;T1_T1+1] !MOVE NAME TO BUFFER SC(1)_N.OPL !MOVE THE SECURITY CODE ! SCHD: EXEC (23,D.,$XEQT,1,DIS,0,0,NAM,9) !D.RTR TO CREATE DIR ENTRY RMPAR(O.BUF) !GET RETURN WORDS TO O.BUF IF O.BUF THEN [ER_O.BUF;RETURN] !RETURN ON ERROR DISAD_@O.BUF+1 !DIREC ADDR FROM D.RTR EXEC(23,D.,$XEQT,0,$DISAD,$(DISAD+1),0,0.0,2) !CLOSE FILE RMPAR(O.BUF) ER_O.BUF !SET ERROR RETURN ! ILLU: DO[ ER_ 20 ; RETURN] MISPM:DO[ ER_ 55 ; RETURN] ILLPM:DO[ ER_ 56 ; RETURN] ILNAM:DO[ ER_-15 ; RETURN] UNDEF:IF S.CAP THEN ER_43, ELSE ER_52 !IF SESSION, ERR 43 RETURN ! END END END$ µÿÿ ÿý…Ž ÿ92067-18206 1903 S C0122 &CN..              H0101 d<SPL,L,O ! NAME: CN.. ! SOURCE: 92067-18206 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CN..(8) "92067-16185 REV.1903 741118" ! ! THE CN ROUTINE ALLOWS THE OPERATOR TO ! CHANGE FILE NAMES. ! ! COMMAND: ! ! CN,NAMR,NEWNAME ! ! WHERE NAMR IS THE FILES NAME REFERENCE ! INCLUDING SECURITY CODE AND ! CARTRIDGE ID IF APPROPIATE ! ! NEWNAME IS THE NEW FILE NAME ! ! ! DEFINE EXTERNAL ! LET .E.R.,I.BUF,N.OPL BE INTEGER,EXTERNAL LET NAMF,IER.,CLOS. BE SUBROUTINE,EXTERNAL CN..: SUBROUTINE (N,LI,E) GLOBAL L5_[L1_@LI+1]+4 CLOS.(I.BUF) NAMF(I.BUF,.E.R.,$L1,$L5,N.OPL,$(@N.OPL+1)) IER. RETURN END END END$ òÞÿÿ ÿý†Œ ÿ92067-18207 2001 S C0122 &.PARS FMGR PARSE ROUTINE             H0101 ¿ýþúSPL,L,O ! NAME: .PARS ! SOURCE: 92067-18207 ! RELOC: 92067-16185 ! PGMR: G.A.A.,A.M.G.,B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME .PARS (8) "92067-16185 REV.2001 791022" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780227 TO ALLOW GLOBALS 8P,9P (BL) ! 2) 780414 SESSION MONITOR COMMAND CAPABILITY CHECKING (BL) ! 3) 790119 TO BACK UP BUFFER ON EXITE FROM PASS 1 (BL) ! 4) 790510 TO INHIBIT SESSION PASSWORD ECHO FOR JO ! 5) 790510 TO UPSHIFT LOWER CASE COMMANDS (COMMENTED FOR FUTURE) ! ! ! THE PARSE SUBROUTINE AND ITS ROUTINES SCAN AN ASCII ! STRING AND PRODUCES: ! ! A. AN ACTION ROUTINE ADDRESS (CAD.) ! B. A PARAMETER COUNT (NOCM.) ! C. A PARAMETER LIST WITH 4 WORDS FOR EACH PARAMETER: (P.RAM) ! ! 1. TYPE ! (A.) 0 - NULL ! (B.) 1 - NUMBER ! (C.) 1 - SIGNED OR OCTAL NUMBER ! (D.) 3 - ASC STRING ! ! 2. FOR TYPE 1 THE VALUE, ! ELSE FOR TYPE 3 THE FIRST TWO CHARACTERS. ! ! 3. FOR TYPE 3 CHARACTERS 3 AND 4. ! ! 4. FOR TYPE 3 CHARACTERS 5 AND 6. ! ! D. A 10 WORD OPTION LIST AT N.OPL ! OPTIONS MAY APPEAR ON THE FIRST TWO PARAMETERS ! OPTIONS ARE SEPARATED FROM EACH OTHER AND FROM ! THE PARAMETER ITSELF BY COLONS. ! EACH OPTION IS STORED IN N.OPL STARTING AT ! WORD ZERO FOR PARAMETER ONE AND WORD 5 FOR PARAMETER TWO ! THERE MAY BE ONLY FIVE PARÁþúAMETERS PER PARAMETER ! THE FIRST TWO PARAMETERS MAY BE ASCII,THE REST ! MUST BE NUMERIC. ! THE INPUT STRING IS TO BE DELIMITED BY COMMAS. ! BLANKS ARE IGNORED UNLESS THEY ARE WITHIN ASCII STRINGS. ! THE FIRST CHARACTER MUST BE ":" IF INPUT IS NOT FROM A TTY. ! ! ! LET TTY., \INTERACTIVE INPUT FLAG N.OPL, \NAMR SUBPARAMETER LIST .E.R., \ADDRESS LESS 1 OF SV CODE P.RAM, \PARAMETER LIST ARRAY NOCM., \NUMBER OF PARAMETERS FOUND G0.., \GLOBAL ARRAY CAD., \COMMAND FOUND (ADDRESS OR INDEX IF IN SEGMENT) ECH., \INPUT COMMAND LENGTH(WORDS) RESET FOR EC.HO ACTV., \ACTIVE FLAG (INDEX TO TR STACK) C.DLM, \CHARACTER ADDRESS OF FIRST DELIMITER AFTER COMMAND C.TAB, \COMMAND TABLE (SIGN SET ON COMMAND INDICATES SPECIAL) CUSE., \CURRENT SEGMENT SUFFIX CHARACTER C.BUF, \COMMAND BUFFER O.BUF, \OUTPUT DCB, USED AS A WORKING BUFFER SCR., \CHARACTERS 3 AND 4 OF COMMAND (OR 0 IF NONE) OVRD., \CARTRIDGE SEARCH OVERRIDE WORD S.CAP \GLOBAL 9P (SESSION CAPABILITY LEVEL) BE INTEGER,EXTERNAL LET CAPCK \CAPABILITY CHECK ROUTINE BE FUNCTION,EXTERNAL LET FM.ER, \PRINT ERROR MESSAGE ROUTINE EC.HO, \ECHO THE COMMAND ROUTINE CNUMD, \NUMBER TO ASCII CONVERSION ROUTINE MSS. \ERROR MESSAGE ROUTINE BE SUBROUTINE,EXTERNAL LET IN.ER, \INPUT ERROR CP.ER, \CAPABILITY ERROR JO.ER \JO MISSING ERROR BE SUBROUTINE LET COLON BE CONSTANT(72K ) LET BLANK BE CONSTANT(40K ) LET COMMA BE CONSTANT (54K ) LET CHAR0 BE CONSTANT(60K ) LET PSIGN BE CONSTANT(53K) LET MSIGN BE CONSTANT(55K) LET QUES BE CONSTANT( 77K) ! ! ! GETCR: FUNCTION DIRECT .B._PTåõþúR !CHARACTER ADDRESS TO B. ASSEMBLE["CLE,ERB"; \CORE ADDRESS TO B,E=U/L 0/1 "LDA 1,I"; \GET THE WORD "ELB"; \ADDRESS BACK TO B "SLB,INB,RSS"; \STEP THE ADDRESS SKIP IF LOW CHAR "ALF,ALF" ] !ROTATE TO LOW IF NEEDED PTR_.B. !RESTORE B TO POINTER CHAR_.A. AND 377K !ISOLATE THE CHARACTER AND SAVE ! IF PAS2 THEN [ \IF PASS 2 AND ! IF CHAR>140K THEN [ \IF A LOWER CASE CHAR ! IF CHAR<173K THEN \THEN ! CHAR_CHAR AND 737K]] !SHIFT IT TO UPPER CASE RETURN CHAR !DONE GET OUT END ! PUTCR: FUNCTION DIRECT IF [.B._BUFPT]=LIMIT THEN GO TO EXITF !EXIT IF NO ROOM .A._CHAR !CHAR TO A FOR ASSMBLY ASSEMBLE["CLE,ERB"; \WORD ADD TO B, U/L FLAG TO E "XOR 1,I"; \KEEP OLD HIGH CHAR "AND LOWM"; \IN CASE THIS IS LOW "XOR 1,I"; \NEW CHAR IN LOW A OLD IN HIGH "SEZ,RSS"; \IF UPPER "ALF,ALF"; \ROTATE "STA 1,I"; \STASH IT AWAY "ISZ BUFPT" ] !PUSH BUFFER POINTER BACK TO SPL IF CHAR=BLANK THEN[ \IF FIRST BLANK AFTER IFNOT BF THEN BUFPT_BUFPT-1; \BF SET TO ZERO RETURN 1], \RETURN TRUE FOR ALL BLANKS ELSE [ \NOT A BLANK BF,BFEND_BUFPT; \KEEP TRACK OF HIGHEST NON BLANK RETURN 0 \AND RETURN ZERO ] END ! GETCR.EQ.DELIM:FUNCTION DIRECT ! IF PTR'…þú=EOL THEN[ \IF END OF LINE STOPF,CHAR_1; \SET STOP FLAG AND GO TO DELT \EXIT TRUE ] IF GETCR=COLON THEN GO TO DELT !ELSE GET CHAR AND IF CHAR =COMMA THEN \IF ":" OR "," EXIT TRUE [PRCNT_PRCNT+1;GO TO DELT] RETURN 0 !EXIT FALSE NOT A DELIMITER ! DELT: RETURN 1 !EXIT TRUE A DELIMITER END ! DIGT: FUNCTION DIRECT IF [CRAC_CHAR-CHAR0] >= 0 THEN[ \IF GREATER THAN "0" IF CRAC < BASE THEN [ \AND LESS THAN BASE ACCUMULATE VAL_VAL*BASE+CRAC; \T NUMBER SET THE FLAG AND T_1; \ RETURN T \RETURN TRUE ] \ ] RETURN 0 !ELSE RETURN FALSE END ! ! PARSE ROUTINE BEGINS HERE. ! .PARS:SUBROUTINE GLOBAL,FEXIT ! ! THE FOLLOWING IS PASS 1 OF A 2-PASS PARSE. THE PROMPT ! CHARACTER, IF PRESENT, IS REMOVED, GLOBALS ARE TRANSLATED AND ! BLANKS BEFORE AND AFTER DELIMITERS ARE REMOVED. ! BASE_10 LOWM_377K !ESTABLISH CONSTANT FOR PUTCH PAS2,ACM,STOPF,PRCNT _ 0 !ZERO EOL FLAG AND COMMAND FLAG EF,PTR,CBUFC _[CBUFA_@C.BUF]-<1 !SET CHARACTER ADDRESSES EOL_CBUFC+ECH.+ECH. !END OF LINE FLAG BUFPT,CRONE_[C.DLM_@O.BUF]-<1 !OUT LINE CHAR ADDRESSES LIMIT_CRONE+80 !AND LIMIT JOF,O.BUF_0 !CLEAR 1ST WORD OF PARSE ! IFNOT ECH. THEN GO TO START !IF EMPTY LINE GO TO PASS TWO IFNOT TTY. THEN[ \IF NOT INTERACTIVE IF GETCR # COLON THEN GO TO EXITF] !MUST HAVE LEAD ":" INGL: SIGN _ 1; OBUFS,BFEND_BUFPT !SET UP FOR VAL,T,BF_0 !SET BLANKŒçþú STRIP FLAG PRAMS: IF GETCR.EQ.DELIM THEN GO TO ENDP !LOOP TILL DELIMITER ! IF PUTCR THEN GO TO PRAMS !PASS BLANKS IF CHAR = MSIGN THEN GO TO NGLBL !LOOK FOR NUMERICS IF CHAR = PSIGN THEN GOTO GLBL !GLOBAL PARAMETERS. IF DIGT THEN GOTO GLBL !FOUND A DIGIT. ! ! SCAN TO NEXT DELIMITER IT IS NOT A GLOBAL ! TOEND:IF JOF THEN [ \IF "JO" THEN IF PRCNT=2 THEN [ \AND IF 2ND PARAMETER IF CHAR="/" THEN [ \AND IF PASSWORD FOLLOWS UNTIL GETCR.EQ.DELIM DO []; \SKIP CHARACTERS GO TO ENDP]]] ! IFNOT GETCR.EQ.DELIM THEN \PASS TILL NEXT PRAM [PUTCR;GO TO TOEND] ! ENDP: BUFPT_BFEND !STRIP TRAILING BLANKS IF STOPF THEN GO TO START !IF EOL THEN GO TO PASS 2 PUTCR !ELSE PASS THE DELIMITER IF O.BUF="JO" THEN JOF_1 GO TO INGL !ELSE GET NEXT PRAM ! ! SIGN PART OF NUMBER DETECTED MIGHT BE GLOBAL ! NGLBL:SIGN_ -1 !IT WAS A "-" SO SET FLAG GLBL: IF GETCR.EQ.DELIM THEN GO TO ENDP !NOT GLOBAL IF DELIMITER IF PUTCR THEN GO TO GLBL !JUST PASS BLANKS IF DIGT THEN GO TO GLBL !KEEP A TOTAL OF IF CHAR = "G" THEN [ \LOOK FOR GLOBAL GV _ 0; \DESIGNATORS. SETSZ: SZ _ 4; GOTO REPL] IF CHAR = "S" THEN [ \ GV _ -8; GOTO SETSZ] IF CHAR = "P" THEN [ \ GV _ 40; SZ _ 1; \ GOTO REPL] GOTO TOEND !NOT DIGIT OR "S","G","P" ! REPL: IFNOT T THEN GOTO TOEND !CHECK IF WE HAVE UNTIL GETCR.EQ.DELIM DO[ \PASS ANY TRAILING BLANKS IFNOT PUTCR THEN GO TO TOEND] Äþú !IF OTHER THEN NOT GLOBAL ! ! HONEST TO GOODIE GLOBAL BUT IS IT IN RANGE?? ! CBUFS_PTR-1 !SAVE IN ADD (REREAD DELIMITER) ADD _ VAL * SIGN * SZ + GV !A REAL GLOBAL. IF ADD < -8 THEN GO TO EXITE !CHECK BOUNDS. IF ADD > 47 THEN [ \ IF (ADD > 49 OR SZ = 4) \ALLOW 8P,9P *780227* THEN GO TO EXITE] ADD _ ADD + @G0.. !GET TABLE OFFSET. BUFPT,BFEND_OBUFS !SET OUTBUF BACK ! ! EVALUATE GLOBAL ! IF SZ # 1 THEN [SZ _ $ADD;ADD_ADD+1] !IF NOT "P" SET SIZE IF SZ = 1 THEN[ \IF NUMERIC GLOBAL VAL_$ADD; \CONVERT THE NUMBER IF VAL < 0 THEN[ \IF NEGATIVE MUST SET VAL_ -VAL;CHAR_MSIGN; \POSITIVE AND SEND A "-" PUTCR \ SEND THE "-" ];\ CALL CNUMD(VAL,P.RAM); \CONVERT THE NUMBER ADD_ @P.RAM \SET RESULT ADDRESS ] IF SZ THEN[ \IF THERE IS A PARAMETER PTR_ADD-< 1;BF,EF_0; \SET TO MOVE IT IN REPEAT 6 TIMES DO [ \ GETCR;PUTCR \MOVE A CHARACTER ] \ ] EF,PTR_CBUFS;GETCR !RESET SOURCE POINTER CHAR GO TO ENDP !GO PROCESS THE DELIMITER ! ! THE SECOND PASS. ! ! INITIALIZE SCAN ! START:BF,CHAR_BLANK !PAD LINE IN CASE ODD CHARS PAS2_1 EOL_BUFPT-CRONE+CBUFC !SET EOL FLAG FOR PASS 2. PUTCR !SEND FINAL CHAR. ECH._(BUFPT-CRONE) >- 1 !SET LINE LENGTH IN WORDS. ASSEMBLE["LDA C.DLM"; \SET UP FOR .MVW "LDB CBUFA"; \ "EXT .M͆þúVW" ; \ "JSB .MVW"; \MOVE THE BUFFER BACK "DEF ECH."; \ "NOP" ] PTR_CBUFC !SET FOR INPUT IFNOT $(@.E.R.+1) THEN [ \ECHO IF REQUIRED IF C.BUF # "SV" THEN EC.HO \LET SV ECHO ITS OWN ] CAD._@IN.ER STOPF,C.DLM_0 FOR T_ @N.OPL TO @NOCM. DO $T_0 !ZERO THE OPTION LIST LIMIT_([PRAM_@P.RAM]+64) -< 1 !SET PUTCR LIMIT GO TO SCANS !GO START THE SCAN ! GETCH:UNTIL GETCR.EQ.DELIM DO[ PUTCR;GV_CHAR]!MOVE CHARACTERS UNTIL DELIM ! ! A DELIMITER 0 OR COMMA OR COLON - ENCOUNTERED ! VAL,T_0 ! SET UP FOR NUMERIC CONVERSION IF C.DLM THEN GO TO PRMST !IF WE HAVE A COMMAND GO TO PRAM IF ACTV. = 1 THEN [ \IF ACTIVE FLAG AND IF $PLOC # "JO" THEN \AND NOT A JO COMMAND, [CAD._@JO.ER; \ERROR, EXPECTING JO CHAR_0; \ GO TO EXIT1]] !EXIT ! ! *780414* C.DLM_PTR !SAVE FIRST DELIMITER ADDRESS SCR. _ $PLOC1 ! SAVE CHARS 3,4 IFNOT S.CAP THEN[ \IF NON-SESSION *780414* ADD_C.TAB; \COMMAND TABLE ADDR. *780414* ALWAYS DO[ \LOOK IT UP IF ($ADD AND 77777K)=$PLOC THEN \ *780414* GO TO ALLOW, \ *780414* ELSE [ADD_ADD+2; \FIND THE PROCESSOR IN TABLE IFNOT $ADD THEN GOTO EXITF \IF ZERO THEN NOT FOUND ]]] ! ! SESSION MONITOR COMMAND CAPABILITY CHECKING *780414* ! ! METHOD: 1) SEARCH LEVEL DESCRIPTION PART OF t4þúC.TAB UNTIL A LEVEL ! NUMBER GREATER THAN USER'S CAPABILITY IS FOUND. ! 2) SEARCH UNTIL COMMAND FOUND OR UNTIL THIS LEVEL NUMBER ! IS REACHED. IF COMMAND IS FOUND, ALLOW IT, ELSE ! 3) SEARCH FOR COMMAND THROUGH HIGHEST CAPABILITY LEVEL. ! IF FOUND, RETURN INSUFFICIENT CAPABILITY ERROR, ELSE ! 4) SEARCH FOR COMMAND THROUGH SPECIAL BREAK MODE COMMANDS ! SECTION. IF FOUND, LET CAPCK DO CAPABILITY CHECKING, ! ELSE RETURN UNDEFINED COMMAND. ! 5) NOTE, IF THE OVERRIDE FLAG IS SET, THE COMMAND IS ! ALLOWED, EVEN IF THE USER HAS A LOWER CAPABILITY. ! ! C.LVL INDICATES STOPPING POINT IN THE TABLE FOR THE CURRENT SEARCH ! OVRD_OVRD. AND 40000K !GET BIT 14 SET BY TR *780414* ADD_[SCMD_[ENDS_[C.LVL_@C.TAB]+1]+1]+1 !DEFINE PTRS. TO C.TAB IF ADD = $ENDS THEN C.LVL_SCMD !ALLOW ALL IF NO LEVEL PART WHILE (ADD # $ENDS AND $ADD <= S.CAP) \SCAN LEVEL PART OF COMMAND DO [ADD_[C.LVL_ADD+1]+1] !UNTIL HIGHER CAPABILITY OR ADD_C.TAB !END OF LEVEL PART REACHED WHILE (ADD # $C.LVL) \SEARCH THRU THIS CAP. LEVEL DO [IF($ADD AND 77777K)=$PLOC THEN \IF COMMAND FOUND GO TO ALLOW, \SET COMMAND ADDRESS ELSE ADD_ADD+2] !OTHERWISE CONTINUE SEARCH ! C.LVL_$SCMD !NOT FOUND BEFORE CAP. LEVEL WHILE (ADD # C.LVL) \SEARCH THRU HIGHER CAP.LEVELS DO [IF($ADD AND 77777K)=$PLOC THEN \IF COMMAND FOUND [IFNOT OVRD THEN GO TO NOCAP, \IF NO OVERRIDE, CAPAB.TOO LOW ELSE GO TO ALLOW], \OVERRIDE SET, ALLOW COMMAND ELSE ADD_ADD+2] !OTHERWISE CONTINUE SEARCH ! C.LVL_$$ENDS !NOT FOUND IN ANY CAP.LEVEL WHILE (ADD # C.LVL) ögþú \SEARCH BREAK MODE COMMANDS DO [IF($ADD AND 77777K)=$PLOC THEN[ \IF COMMAND FOUND REGA_CAPCK($CBUFA,ECH.<-1); \CAPABILITY CHECK ROUTINE REGB_.B.; \B NEGATIVE IF CAP TOO LOW IF REGA = -1 THEN GO TO EXITF; \RETURN UNDEFINED COMMAND IF(REGB < 0 AND OVRD = 0) THEN \IF CAP.TOO LOW & NO OVRD GO TO NOCAP, \INSUFFICIENT CAPABILITY ELSE GO TO ALLOW], \ALLOW THE COMMAND ELSE ADD_ADD+2] !CONTINUE SEARCH GO TO EXITF ! ALLOW:ACM_$ADD !SET COMMAND ADDRESS CAD._$(ADD+1) GO TO RPLOC ! NOCAP:CAD._@CP.ER !INSUFFICIENT CAPABILITY CHAR_0 GO TO EXIT1 ! ! NOT FIRST SO SET UP THE PARAMETER ! PRMST:CBUFS_PTR-1;POS_BUFPT !SAVE DELIMITER ADDRESS, END ADD IF BUFPT=CUPAD THEN GOTO NULLS !NULL SO ZERO IT ! ! ATTEMPT NUMERIC CONVERSION ! IF GV = "B" THEN[ \IF OCTAL SET UP BASE_8;POS_POS-1], \BASE AND END OF STRING ELSE \OTHER WISE USE BASE_10 !BASE 10 ! PTR_CUPAD;SIGN_1 !SET FOR LOOP ! ! CONVERSION LOOP ! UNTIL PTR=POS DO THRU CLOOP IF GETCR= BLANK THEN GOTO CLOOP !IGNORE IMBEDDED BLANKS IFNOT DIGT THEN [ \IF NOT DIGIT IF PTR=SZ THEN[ \IF FIRST CHAR TEST IF CHAR=MSIGN THEN[SIGN_-SIGN;GO TO CLOOP];\ IF CHAR=PSIGN THEN GO TO CLOOP \ ]; \ GO TO NOTNO \NOT DIGIT OR LEGAL SIGN ] CLOOP: !END OF CONVERSION LOOP ! ! SET TYPE AND NO. IN THE LIST ! IFNOT [$PLOC0_T] THEN GOTO NOTNO !IF NO DIGITS-NOT 6þúA NUMBER NULLS:$PLOC_VAL*SIGN !SET THE VALUE IN THE LIST $[REAL]PLOC1_0.0 !ZERO THE EXTRA WORDS ! ! SET UP FOR THE NEXT PARAMETER ! NXPRM:PTR_CBUFS;GETCR !GET THE DELIMITER IFNOT SBSCN THEN GO TO NOTSU !SKIP IF NOT SUB SCAN IF [SUBCO_SUBCO+1]<3 THEN GOTO STPM !SKIP ASC TEST IF FIRST TWO IF $PLOC0=3 THEN GO TO SKIPP !SUB PARAMETERS ELSE ASC ERROR STPM: IF NOCM.< 3 THEN$(SBSCN+SUBCO)_$PLOC !SET THE SUB PRAM IN THE OP LIST ! IF CHAR=COLON THEN[IF SUBCO=5 THEN GOTO SKIPP ,\ TOO MANY ELSE GO TO RPLOC] !GO GET NEXT SUB PRAM ! SCANS:SUBCO,SBSCN_0 !ZERO THE SUB SCAN FLAGS ! SCANC:PLOC1_[PLOC_[PLOC0_PRAM+4*NOCM.]+1]+1 !SET THE CURRENT ADDRESSES ! RPLOC:SZ_[CUPAD,BUFPT_PLOC -< 1]+1 !SET ADDRESSES FOR PUTCR IF CUPAD>LIMIT THEN GO TO EXITF !TOO MANY PRAMS? $PLOC0,$PLOC,$PLOC1_0 !SET LIST LOCATIONS TO ZERO IF STOPF THEN GO TO EXIT !IF FINAL DELIMITER EXIT GO TO GETCH !ELSE GET NEXT PRAM ! ! PARAMETER END NOT SUB PRAM ! NOTSU: IF CHAR = COLON THEN [ \CHECK FOR ILLEGAL IF NOCM. > 1 THEN [ \DELIMITER, BUT LET IF ACM > 0 THEN \IT GO THROUGH IN GOTO EXITF,ELSE \CASE OF SPECIAL CMDS [NOCM._NOCM.+1;GOTO SKIP1]],\ ELSE SBSCN _ @TTY. + NOCM.*5] !SET UP SUB-SCAN. ! NOCM._NOCM.+1 !STEP COUNT GO TO SCANC !GO SCAN IT ! ! NOT A LEGAL NUMBER - TRY FOR A NAME ! NOTNO:$PLOC0_3 !ASSUME NAME AND SET UP CHAR_BLANK !SET UP TO BLANK FILL UNTIL BUFPT=>CUPAD+6 DO PUTCR !FILL IT GO TO NXPRM !ASSUME A NAME AND CONTINUEþú ! ! NORMAL EXIT ROUTINE CLEAR END OF LIST AND CHECK FOR SEG ! EXIT: CHAR_0 UNTIL BUFPT >= LIMIT DO PUTCR !ZAP THE LIST IF CAD.<0 THEN GO TO EXIT1 !IF LOCAL GO EXIT IF CAD.>10000K THEN GO TO EXIT1 !IF LOCAL GO TO EXIT. CHAR,CUSE._(CAD. AND 377K)-<8 ! CAD._((CAD. AND 17400K)-<8) !SET ROUTINE NUMBER IN CAD. EXIT1:.B._ACM !SET ASCII COMMAND IN B FOR MAIN IFNOT CHAR THEN RETURN,ELSE FRETURN ! EXITE:PUTCR !SEND FINAL CHARACTER ECH._(BUFPT-CRONE) >- 1 !SET LINE LENGTH PTR_CBUFC+(ECH.*2) !ADJUST BACKED-UP BUFFER ASSEMBLE ["LDA C.DLM"; \SET ADDRESSES FOR .MVW "LDB CBUFA"; \ "JSB .MVW"; \BACK UP THE COMMAND BUFFER "DEF ECH."; \BUFFER LENGTH "NOP"] ! ! EXITF:IF ACM<0 THEN GO TO EXIT !IF WE HAVE A SPECIAL THEN EXIT EXITG:IFNOT EF THEN PTR_CBUFS !IF ERROR WHILE PTR WRONG RESET CAD._@IN.ER;CHAR_0;GO TO EXIT1 !ELSE ERROR EXIT ! SKIPP:IF ACM >= 0 THEN GO TO EXITG !IFNOT SPECIAL, EXIT SKIP1:IF CHAR=COLON THEN [ \FLUSH THE SUBPARMS SKIP2: IFNOT GETCR.EQ.DELIM THEN GOTO SKIP2; \SKIP TO NEXT DELIMITER IF STOPF THEN GOTO EXIT, \EXIT IF END OF LINE ELSE GOTO SKIP1] !CHECK FOR ANOTHER SUBP GOTO SCANS !CONTINUE WHEN "," FOUND END ! CP.ER:SUBROUTINE ! *780414* MSS.(46) !INSUFFICIENT CAPABILITY RETURN END ! JO.ER:SUBROUTINE MSS.(74) !JO COMMAND EXPECTED RETURN END ! IN.ER:SUBROUTINE MSS.(10) !FORCE ECHO ANÂHFBD PRINT ERROR BUFPT_PTR CHAR_QUES;PUTCR !PLANT A "?" CHAR_BLANK;PUTCR !AND A BLANK PAD FM.ER(1,C.BUF ,(BUFPT-CBUFC)>-1) !WRITE IT OUT RETURN END END END$ kHÿÿ ÿý‡˜ ÿ92067-18208 2026 S C0122 &REA.C              H0101 `{þúASMB,R,L,C HED "REA.C" FMGR INPUT ROUTINE 1-78 (DLB) * NAME: REA.C * SOURCE: 92067-18208 * RELOC: 92067-16185 * PGMR: G.A.A., D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM REA.C,8 92067-16185 REV.2026 800428 ENT REA.C EXT READF,MSS.,WRITF,$TIME,.MVW EXT .E.R.,CAM.I,TTY.,ECH.,C.BUF,IFBRK EXT REIO,PCIBF SPC 1 EXT TPSK.,NXTK.,EDSK.,CRSK.,C.TAB A EQU 0 B EQU 1 SPC 1 * PURPOSE: * THIS SUBROUTINE DOES ALL COMMAND INPUT FOR THE FMGR PROGRAM. * IF THE INPUT IS FROM A TRANSFER FILE (NON-TERMINAL) ALL COMMANDS * ARE IN THE STANDARD FMGR INPUT REQUIREMENTS. IF INPUT IS FROM * A TERMINAL (TTY. = 1) THERE ARE SEVERAL NEW FEATURES ADDED AS * TYPING AIDS. * * 1). ALL FMGR COMMANDS "EXECUTED" FROM A KEYBOARD ARE PUT INTO * INTO A "COMMAND STACK" (RESIDENT IN FMGR MODULE) SO THAT THEY * CAN BE DISPLAYED, MODIFIED AND EXECUTED LATER. THE MODIFY COMMANDS * WERE DELIBERATELY CHOSEN TO BE A SUBSET OF THE "EDITR" COMMANDS. * THE FOLLOWING IS A LIST OF THE COMMANDS THAT CAN BE USED TO * EDIT THE "COMMAND STACK". * * :Ln "n" IS NUMBER OF LINES TO LIST. IF :L THEN WHOLE COMMAND STACK. * :P DISPLAY PENDING LINE WITH SAME OPTIONS AS EDITR. (CNTL I,S,T,R,C) * :n POSITION PENDING LINE TO THE "n"TH LINE IN COMMAND STACK. * :^n OR :Rn POSITION n LINES PRECEDING PENDING LINE. * :/n POSITION n LINES PAST PENDING LINE. * :-n DELETE n LINES FROM COMMAND STACK FROM THE PENDING LINE. * * ONCE A LINE FROM THE COMMAND STACK HAS BEEN DISPLAYED AS THE * "PENDING" :!þúLINE, IT MAY BE EXECUTED BY TYPING A LONESOME CARRIAGE * RETURN (TLOG = 0 RETURN FROM EXEC). * * 2). ALL INPUT FROM A KEYBOARD THAT IS NOT A LEGAL "FMGR" COMMAND * OR A COMMAND STACK COMMAND WILL HAVE A :RU, PLACED IN FRONT OF * THE INPUT STRING AND PASSED ON AS A "RUN" COMMAND. THIS "IMPLIED * RUN" FEATURE MAKES THE SYSTEM SEEM MORE HOMOGENEOUS TO NEW USERS * WHO HAVE DIFFICULTY UNDERSTANDING THE DIFFERENCE BETWEEN A * "PROGRAM" AND A "FMGR" COMMAND. IT ALSO REDUCES THE TYPING FOR AN * EXPERIENCED RTE USER A SURPRISING AMOUNT. * * 3). AN AGING FEATURE IS PLACED ON THE "COMMAND STACK" BY ELIMINATING * DUPLICATE ENTRIES. BEFORE A NEW COMMAND IS PLACED AT THE BOTTOM * OF THE STACK, ALL THE OTHER ENTRYS ARE CHECKED FOR DUPLICATION AND * DELETED IF NECESSARY. THIS WAS DONE TO KEEP THE BOTTOM OF THE * STACK AS "FRESH" AS POSSIBLE -- REPRESENTING THE LATEST DIFFERENT * COMMANDS EXECUTED. * * 4). THE COMMAND STACK IMPLEMENTS A MECHANISM FOR DISPLAYING COMMANDS * THAT ARE PASSED TO THE "FMGR" TO BE EXECUTED FROM THE STRING BUFFER * PASSED FROM A SCHEDULE REQUEST OR RETURNED FROM A "RUN'ED PROGRAM". * THIS FEATURE MAKES IT MUCH EASIER TO UNDERSTAND THE AN ERROR * MESSAGE THAT MAY APPEAR WHEN EXECUTING A STRING BUFFER. THE * COMMAND THAT CAUSED THE ERROR MAY BE DISPLAYED BY TYPING :P . * * 5). A "NULL" COMMAND (::FILENA), I.E. THE "IMPLIED TRANSFER" * COMMAND IS NOT PLACED INTO THE COMMAND STACK BECAUSE IT WAS * NOTICED THAT "SOFT KEYS" FROM 26XX TERMINALS OFTEN USE THIS * COMMAND TO LOAD UP SOFT KEYS AND EXECUTE SOMETHING. PLACING * THESE "NULL" TRANSFER COMMANDS IN THE COMMAND STACK SIMPLY * CLUTTERS UP THE COMMAND STACK. IF IT IS DESIRED TO HAVE THESE * COMMANDS PUT INTO THE COMMAND STACK, THE FORMAL :TR,FILENA COMMAND * MAY BE PLACED IN THE SOFT KEYS. * * TEST PROGRAM: ** ASMB,R,L ** NAM TES,3 TEST PROGRAM FOR "REA.C" FMGR SUBROUTINE 780503 ** уþú ENT MSS.,.E.R.,CAM.I,TTY.,ECH.,C.BUF ** ENT TPSK.,NXTK.,EDSK.,CRSK. ** EXT T0DCB,EXEC,REA.C,RMPAR ** SPC 1 ** BEGIN JSB RMPAR ** DEF *+2 ** DEF LU ** JSB T0DCB ** DEF *+4 ** DEF CAM.I DCB ** DEF .E.R. ** DEF LU ** CLA,INA ** STA TTY. ** BEGI1 JSB REA.C GO DO INPUT ** DEF *+1 ** JSB EXEC NOW WRITE OUT THE INPUT BUFFER ** DEF *+5 ** DEF O2 ** DEF LU ** DEF C.BUF ** DEF ECH. ** JMP BEGI1 ** SPC 1 ** NXTK. DEF BUF ** CRSK. DEF *+2 ** TPSK. DEF *+1 ** OCT 1 ** ASC 1,** ** BUF OCT 400 ** BSS 170 ** EDSK. DEF *-1 ** SPC 1 ** C.BUF BSS 36 ** CAM.I BSS 144 ** .E.R. NOP ** MSS. NOP ** HLT 0 ** ECH. NOP ** O7 OCT 7 ** LU BSS 5 ** O2 OCT 2 ** TTY. NOP ** END BEGIN SPC 1 DFDSP DEF DSPLY POINTER INTO DISPLAY BUFFER DSPLN NOP CURRENT DISPLAY BUFFER LENGTH IN WORDS ASC 1, LEADING SPACES FOR DISPLAY BUFFER DSPLY BSS 36 DISPLAY BUFFER ORG DSPLY MAKE ROOM FOR INITIALIZE CODE INIT LDA CLA GET CLA INSTRUCTION STA INIT1 PREVENT ANY FUTURE CALLS TO THIS CODE LDA DFC.B GET DEF TO C.BUF RSS AND MAKE A DIRECT ADDRESS FOR SURE (RTE-III GEN BUG) LDA A,I GET NEXT LEVEL RAL,CLE,SLA,ERA ETC. JMP *-2 STA DFC.B AND PUT BACK JMP INIT1 AND CONTINUE ORR RETURN TO MAIN CODE SPC 1 MODEF NOP EDIT MODE FLAG EDITF NOP EDITED PENDING BUFFER FLAG TTYLU NOP LU OF TERMINAL REA.C NOP ENTRY INIT1 JMP INIT CLA SET LENGTH OF DISPLAY BUFFER STA EDITF CLEAR THE EDITED PENDING DISPLAY FLAG STA DSPLN ”þú CLEAR DISPLAY BUFFER LENGTH REAC1 LDA DFMES RESET THE TIMOUT BRANCH ADDRESS STA MSFLG TO 0 TIMEOUT HISTORY LDA TTY. NOW GO CHECK IF KEYBOARD DEVICE? SZA,RSS KEYBOARD DEVICE? JMP REAC5 NO, SKIP THE ":" ECHO REAC2 LDB DFCOL GET ASCII ":_" CLA,INA LENGTH = 1 WORD JSB WRITI GO PROMPT THE COLON CCA PRESET THE INPUT BUFFER TO ILLEGAL VALUE STA C.BUF FOR ACTIVE TERMINAL TEST LDA $TIME GET THE CURRENT TIME CMA,INA NEGATE STA TIMER SAVE FOR LATER USE CLA CLA SET STARTING CHAR IN C.BUF STA GTCCT INIT THE GTC.B ROUTINE STA PCONT INIT THE PUTCR ROUTINE STA GTCDE INIT THE GTCSC ROUTINE STA MODEF INIT THE EDIT MODE FLAG LDA CAM.I+3 GET THE LU OF KEYBOARD IOR O400 MAKE SURE THE ECHO BIT IS SET STA TTYLU SAVE FOR REIO REQUEST JSB REIO AND REQUEST INPUT FROM KEYBOARD DEF *+5 DEF O1 DEF TTYLU DFC.B DEF C.BUF+0 DIRECT ADDRESS OF INPUT BUFFER!! DEF DM72 36 WORDS MAX SZB,RSS CHECK IF ANY INPUT? JMP EXECU NO, GO CHECK IF EXECUTE COMMAND STB CRCNT SAVE NUMBER OF CHARS INPUT SPC 1 * BEGIN HERE TO LEFT JUSTIFY INPUT BUFFER SPC 1 LDA OM6 FIX UP COMMAND LENGTH COUNTER STA MCDLN MAX COMMAND LENGTH = 6 CHARS PACK1 JSB GTC.B GET NEXT CHARACTER FROM INPUT BUFFER JMP PACK6 DONE, CONTINUE CPA O40 IGNORE LEADING SPACES JMP PACK1 IN BUFFER JMP PACK3 NOT SPACE, GO STORE SPC 1 * BEGIN HERE TO CALCULATE THE LENGTH OF POSSIBLE FMGR COMMAND SPC 1 PACK2 JSB GTC.B GET NEXT CHARACTER JMP PACK6 OUT OF BUFFER, GO CALCULATE LENGTH CPA O40 CHECK IF SPACE OR COMMA? RSS PACK3 CPA COMMA TO CALCULATE THE "COMMAND LENGTH" RSS COMMAND TERMINATOR, CALCULATE LENGTHÒþú CPA COLON : IS ALSO A TERMINATOR JMP PACK5 COMMAND TERMINATOR, CONTINUE JSB PTEBF OK, GO PUT INTO BUFFER ISZ MCDLN MAX LENGTH COMMAND = 6 CHARS JMP PACK2 TRY NEXT CHARACTER SPC 1 PACK4 JSB GTC.B GET NEXT CHARACTER JMP PACK6 OUT OF BUFFER, GO CALCULATE LENGTH PACK5 JSB PTEBF PUT THE CHARACTER INTO THE INPUT BUFFER JMP PACK4 GOT CHARACTER AND PACK IT IN SPC 1 PACK6 LDA PCONT GET CHARACTER LENGTH OF INPUT BUFFER STA CRCNT AND SET IT TO TRUE CHAR LENGTH INA AND ALSO SET THE WORD LENGTH FOR FMGR PARSE CLE,ERA DIVIDE BY TWO FOR WORD LENGTH STA ECH. FOR FMGR PARSE LDA O40 PUT IN A TRAILING SPACE IF ODD CHAR LENGTH JSB PTEBF PUT TRAILING SPACE INTO INPUT BUFFER CLA NOW RE-SET STARTING CHARS FOR GET & PUT STA GTCCT GET CHARACTER FROM INPUT BUFFER AND STA PCONT PUT CHARACTER TO INPUT BUFFER ROUTINE SPC 1 * NOW CHECK IF INPUT IS A FMGR COMMAND SPC 1 LDA MCDLN GET COMMAND LENGTH COUNTER CMA,INA NEGATE, AND FORM COUNTER ADA OM6 IN NEGATED FORM STA MCDLN FOR MATCH CALCULATION CPA OM2 CHECK IF 2 CHARACTER COMMAND? JMP MATII YES, USE FMGR TABLE FOR MATCHING SZA,RSS CHECK IF COMMAND LENGTH = 0 CHARACTERS? JMP EXIT2 YES, LET THE FMGR PARSE HANDLE INA,SZA,RSS CHECK IF COMMAND = 1 CHARACTER? JMP NAFMC YES, SKIP FMGR COMMAND CHECK SPC 1 * COMMAND LENGTH IS = 3 OR MORE CHARACTERS, CHECK LOCAL TABLE FOR * POSSIBLE FMGR COMMAND. (ANY COMMAND NOT IN THIS TABLE MUST BE * TWO CHARACTERS IN LENGTH, EXCEPT "RU" & "SY".) SPC 1 LDA C.BUF GET 1ST 2 CHARS OF INPUT BUFFER CPA ASCRU CHECK IF :RU_____ COMMAND? RSS YES CPA ASCSY CHECK IF :SY____ COMMAND? JMP EXIT1 YES, LET FMGR PARSE LDæþúB EXLST GET STARTING ADDRESS OF EXTENDED FMGR COMMANDS MATC2 LDA B,I GET 1ST 2 CHARS SZA,RSS CHECK IF END OF LIST? JMP NAFMC YES, NOT A FMGR COMMAND CPA C.BUF CHECK IF MATCHING 2 CHARACTERS JMP MATC3 YES, NOW CHECK IF ALL CHARS OF COMMAND MATCH ADB O3 NO, BUMP TO NEXT ONE JMP MATC2 AND TRY NEXT COMMAND FROM LIST SPC 1 MATC3 RBL FORM CHARACTER ADDRESS OF COMMAND LIST STB MATCA SAVE CURRENT CHARACTER ADDRESS MATC4 LDB MATCA GET CURRENT CHARACTER ADDRESS ISZ MATCA AND BUMP TO NEXT CLE,ERB FORM WORD ADDRESS JSB GTCHR GET THE CHARACTER STA MATCB SAVE TEMP FOR LATER TEST JSB GTC.B GET NEXT CHARACTER FROM INPUT BUFFER JMP NAFMC MUST BE ZERO LENGTH COMMAND CPA MATCB CHECK IF MATCHING? RSS YES, KEEP ON TRUCKING JMP NAFMC NOT A FMGR COMMAND ISZ MCDLN CHECK IF ANY MORE CHARACTERS TO MATCH? JMP MATC4 YES, KEEP ON TRUCKING SPC 1 * MATCH WAS ACHIEVED, PUT COMMAND INTO BUFFER LIST AND EXIT. SPC 1 EXIT1 JSB PCIBF MUST BE LEGAL COMMAND>>PUT INTO BUFFER LIST DEF *+3 DEF C.BUF DEF ECH. EXIT2 LDA ECH. GET BUFFER LENGTH LDB REA.C,I GET RETURN ADDRESS JMP B,I AND EXIT TO CALLER SPC 1 MCDLN NOP NEG. NUMBERS IN COMMAND BUFFER MATCA NOP CURRENT CHAR ADDRESS FOR MATCHING BUFFER MATCB NOP CURRENT CHARACTER VALUE FROM MATCHING BUFFER SPC 1 * TWO CHARACTER COMMAND, CHECK IF "C.TAB" HAS MATCHING FMGR COMMAND. SPC 1 MATII LDB C.TAB GET STARTING ADDRESS OF C.TAB MATI1 ADB O2 SKIP 1ST ENTRY LDA B,I GET NEXT 2 CHARS SZA,RSS CHECK IF END OF LIST? JMP NAFMC YES, MUST NOT BE FMGR COMMAND RAL,CLE,ERA STRIP OFF BIT 15 CPA C.BUF CHECK IF MATCH? JMP EXIT1 YES, GO EXECUTE ê‹þúJMP MATI1 NO, TRY NEXT ONE SPC 1 * NOT A FMGR COMMAND, DO LOCAL PROCESSING SPC 1 NAFMC CLA RESET STARTING CHARACTER NUMBER FOR RE-SCAN STA GTCCT OF INPUT BUFFER JSB GTC.B YES, GET THE POSSIBLE COMMAND CHAR JMP EXIT2 CANT HAPPEN UNLESS BUG IN TTY. FLAG CPA ASCR CHECK IF RECALL COMMAND? RSS YES CPA ASCUP CHECK IF RECALL COMMAND? (^) JMP DECRM BACK UP THE CURRENT BUFFER POINTER CPA SLASH CHECK IF MOVE FORWARD COMMAND? JMP ADVNS GO MOVE THE COMMAND BUFFER POINTER CPA ASCL CHECK IF LIST COMMAND? JMP LISTC YES, GO PROCESS CPA ASCP CHECK IF EDIT COMMAND? JMP EDIT2 YES, GO PROCESS CPA MINUS CHECK IF DELETE COMMAND? JMP DELET YES, GO DELETE CURRENT LINE JSB NUMBR CHECK IF NUMERIC? SPC 1 * 1ST CHARACTER IS NUMBERIC, GO PARSE WHOLE INPUT AS NUMBER. SPC 1 CLA RESTART THE SCAN ROUTINE STA GTCCT TO THE 1ST CHARACTER JSB NMBLN YES, GO CONVERT SPC 1 * CONVERT TO NUMBER WAS SUCCESSFUL, COUNT DOWN N LINES FROM TOP. SPC 1 LDB TOPSK GET THE TOP OF THE STACK STB CURSK AND SET THE CURRENT TO TOP SSA,INA,SZA CHECK IF 0 OR -1? LINEN JSB ADVSK ADVANCE THE CURRENT BUFFER LIST POINTER JMP DECR2 BEYOND LAST, GO PRINT LAST LINE INA,SZA CHECK IF END?PRINT LAST ONE JMP LINEN NO, CONTINUE JMP DECR2 NOW, GO PRINT SPC 1 * AT THIS POINT IS MUST BE AN IMPLIED :RUN COMMAND. * STICK A ":RU," IN FRONT OF COMMAND AND EXIT. SPC 1 RUCMD CLA RESET THE STARTING CHARACTER NUMBER OF INPUT BUFFER STA GTCCT FOR INPUT BUFFER STA DSPLN FOR STORING NEW STRING WITH RU, LDA ASCR GET AN ASCII "R" JSB PUTCR AND PUT INTO DISPLAY BUFFER LDA ASCRU GET AN ASCII "U" JSB PUTCR AND á°þúPUT INTO DISPLAY BUFFER LDA COMMA GET ASCII COMMA RUCM1 JSB PUTCR AND PUT INTO DISPLAY BUFFER JSB GTC.B GET NEXT CHAR FROM INPUT BUFFER RSS DONE, GO CALCULATE BUFFER LENGTH JMP RUCM1 AND PUT INTO DISPLAY BUFFER LDA NXTSK FORCE THE BUFFER INTO BUFFER LIST STA CURSK AND FORCE THE EDIT MODE STA EDITF FLAG LDA O40 MAKE SURE THERE IS TRAILING SPACE IN BUFFER JSB PUTCR BECAUSE WE ARE GOING TO MAKE IT EVEN LDB DSPLN GET NUMBER OF CHARS STORED BRS DIVIDE BY 2 JMP REAC3 MOVE DISPLAY BUFFER INTO INPUT BUFFER SPC 1 * TLOG=0 ENTRY, EXECU CHECKS IF EXECUTE COMMAND WAS INPUT. SPC 1 EXECU LDA DSPLN GET CURRENT DISPLAY BUFFER LENGTH SZA,RSS CHECK IF THERE IS A DISPLAY BUFFER? JMP PWAIT NO, DISPLAY BUFFER >> WAITING FOR INPUTMEOUT? JSB TIMOT > 20 SECONDS ? SEZ,RSS E-REG = 1 IF > 20 SECONDS ISZ C.BUF NO, CHECK IF KEYBOARD TOUCHED? JMP PWAIT KEYBOARD TOUCHED OR > 20 SECONDS SPC 1 * EXECUTE REQUEST IS REQUIRED, MOVE DISPLAY BUFFER TO C.BUF & EXIT SPC 1 LDB DSPLN GET THE DISPLAY LENGTH REAC3 LDA DFDSP GET THE FROM BUFFER ADDRESS REAC4 STB ECH. SAVE LENGTY IN WORDS LDB DFC.B GET "TO" BUFFER ADDRESS JSB .MVW AND MOVE THE BUFFER DEF ECH. NUMBER OF WORD TO MOVE OCT 0 FUKIE-UPIE JMP EXIT1 PUT IN THE BUFFER LIST SPC 1 * SUBROUTINE TO DETERMINE IF 20 SECONDS HAS ELAPSED SINCE ":" OUTPUT. SPC 1 TIMOT NOP ENTRY A-REG IS NOT MODIFIED LDB $TIME GET CURRENT TIME ADB TIMER SUBTRACT THE PREVIOUS TIME O40 CLE DO A 16 BIT ARITHMETIC CHECK ADB DM2K 2000 TICKS OF CLOCK (20 SEC) JMP TIMOT,I E-REG = 1 IF > 20 SECONDS. SPC 1 * TIMOUT ENTRY, WRITE OUT THE CORRECT MESSAGE SPC 1 PWAIT JSB TIQ×þúMOT CHECK IF 20 SECONDS LDA DFMES GET ADDRESS OF 1ST MESSAGE CLB,SEZ ELAPSED? ISZ C.BUF CHECK IF KEYBOARD TOUCHED? STA MSFLG START OVER IF < 20 SEC OR KEYBOARD TOUCHED. STB DSPLN CLEAR THE DISPLAY BUFFER LDB MSFLG,I GET POINTER TO MESSAGE LDA B,I GET MESSAGE LENGTH INB BUMP ADDRESS TO ASCII MESSAGE JSB WRITI AND WRITE OUT THE MESSAGE ISZ MSFLG BUMP TO NEXT MESSAGE LDA MSFLG CHECK IF "GONE"? CPA DFGON ? RSS USE "EX" PROCESSING JMP REAC2 GO PROMPT ":" SPC 1 * TIMED OUT!, GO EXECUTE "EX,SP,,KILL" SPC 1 LDA DFEXS GET MESSAGE "EX,SP,,KILL" LDB O5 GET MESSAGE LENGTH IN WORDS JMP REAC4 AND GO EXECUTE SPC 1 DFEXS DEF *+1 ASC 5,EX,SP,,KILL SPC 1 * ENTRY IS NORMAL DATA FROM FILE OTHER THAN A KEYBOARD. SPC 1 REAC5 JSB READF AND GO READ THE INPUT DEF *+6 DEF CAM.I DCB DEF .E.R. GLOBAL ERROR VALUE DEF C.BUF+0 INPUT BUFFER DEF D36 72 CHARACTERS MAX INPUT DEF ECH. SAVE NUMBER OF ! WORDS ! INPUT SSA CHECK IF ANY READ ERROR JMP EREXT YES, DO A ERROR EXIT LDA ECH. GET THE TLOG VALUE SZA,RSS CHECK IF ZERO LENGTH FILE RECORD? JMP REAC5 YES, IGNORE IT, AND CONTINUE TO NEXT SSA CHECK IF END OF FILE? JMP EXIT4 YES, EXIT WITH ZERO LENGTH RECORD JMP EXIT2 EXIT TO PROCESS THE INPUT BUFFER SPC 1 EREXT JSB MSS. OUTPUT THE ERROR MESSAGE DEF *+3 DEF .E.R. ERROR NUMBER DEF DM2K -2000 EXIT4 CLA AND EXIT TLOG = 0 STA ECH. SET TRANS LOG JMP EXIT2 SPC 1 * PUTCR PUTS A CHARACTER IN A-REG INTO THE DISPLAY BUFFER SPC 1 PUTCR NOP ENTRY A-REG = CHARACTER LDB DSPLN GET CHARACTER COUNT gþú CLE,ERB FORM WORD OFFSET CPB D36 CHECK IF AT END? JMP PUTCR,I YES, JUST IGNORE ADB DFDSP INDEX INTO DISPLAY BUFFER JSB PTCHR AND PUT THE CHARACTER INTO BUFFER ISZ DSPLN BUMP CHARACTER COUNT JMP PUTCR,I AND EXIT SPC 1 PTCHR NOP ENTRY A-REG = CHAR, B=ADDRESS, E=EVEN/ODD FLAG AND O377 MASK TO JUST CHARACTER SEZ,RSS CHECK IF EVEN OR ODD? ALF,ALF EVEN, POSITION XOR B,I PUT IN OR TAKE OUT SEZ,RSS CHECK IF HI-LO CHAR ALF,ALF HI, POSITION FOR MASKING AND O377 MASK OFF UNTOUCHED CHARACTER SEZ,RSS CHECK IF NEED UNPOSITIONING? ALF,ALF YES, DO IT. XOR B,I NOW MERGE IN UNTOUCHED, & TAKE OUT REPLACED STA B,I CHARACTER AND PUT BACK INTO WORD JMP PTCHR,I AND EXIT SPC 1 DELET JSB NMBLN GET NUMBER OF LINES TO DECREMENT SSA,RSS CHECK IF POSITIVE? CCA YES, FORCE TO ONE LINE STA ACCUM SAVE NUMBER OF LINES TO DELETE DELE1 LDA CURSK GET THE CURRENT BUFFER POINTER CPA NXTSK CHECK IF DELETED LAST LINE? JMP REAC1 YES, RE-ENTER THE READ ROUTINE JSB DELIN AND DELETE FROM BUFFER LIST ISZ ACCUM CHECK IF DONE? JMP DELE1 NO, CONTINUE JMP DECR2 OUTPUT NEXT LINE & RE-ENTER READ SPC 1 TIMER NOP TIMER SPC 1 DECRM JSB NMBLN GET NUMBER OF LINES TO DECREMENT DECR1 JSB DECSK DECREMENT STACK POINTER JMP DECR3 BEYOND BEGINNING, PRINT BEGINNING SZA,RSS CHECK IF DONE BUMPING? JMP DECR2 YES, GO PRINT INA,SZA DONE? JMP DECR1 YES, KEEP ON TRUCKING DECR2 JSB MCBDB WRITE OUT THE DISPLAY BUFFER JMP REAC1 AND RE-ENTER THE READ THIS SUBROUTINE SPC 1 DECR3 SZA CHECK IF MULTI-LINE MOVE? JMP DECR2 YES, PRINT LIMIT LINE JMP REAC1 NOÍþú, IGNORE REQUEST IF BEYOND LIMIT AND ZERO LINE REQ. SPC 1 ADVNS JSB NMBLN GET NUMBER OF LINES TO ADVANCE ADVN1 JSB ADVSK MOVE POINTER FORWARD JMP DECR3 BEYOND, END, PRINT END SZA,RSS CHECK IF MULTI-LINE MOVE JMP DECR2 NO, GO PRINT LINE INA,SZA CHECK IF MOVE TO ADVANCE JMP ADVN1 YES, CONTINUE JMP DECR2 MOVE "CURSK" TO THE DISPLAY BUFFER SPC 1 * ROUTINE TO PROCESS THE "P" COMMAND SPC 1 EDIT1 STA MODEF AND SET THE MOVE FLAG STA EDITF SET THE EDIT MODE FLAG EDIT2 JSB GTC.B GET NEXT CHARACTER FROM EDIT BUFFER JMP EDIT3 MOVE C.BUF INTO DISPLAY BUFFER AND PRINT CPA CNTLR CHECK IF REPLACE MODE CHARACTER RSS YES, SET THE REPLACE MODE CPA CNTLC CHECK IF THE DELETE MODE CHARACTER RSS YES, SET THE DELETE CHARACTER MODE CPA CNTLS CHECK IF INSERT CHARACTER MODE? RSS YES, CPA CNTLI CHECK IF INSERT ETC. JMP EDIT1 MODE CHANGE, SET THE MODE AND CONTINUE CPA CNTLT CHECK IF END OF EDIT MODE? JMP EDIT4 DONE, MOVE INTO DISPLAY BUFFER LDB MODEF GET THE MODE FLAG SZB,RSS CHECK IF MODE IS DEFINED YET? JMP CKSHS NO, MUST BE 1ST CHARACTER CPB CNTLR REPLACE MODE? JMP REPMD REPLACE MODE CPB CNTLC DELETE MODE? JMP DELCR DELETE MODE, JUST IGNORE CHAR SPC 1 * MUST BE INSERT MODE, CONTINUE SPC 1 CPA SLASH IF "/" THEN MAKE A SPACE LDA O40 GET ASCII SPACE JSB PTEBF PUT THE CHARACTER INTO THE EDIT BUFFER JMP EDIT2 AND CONTINUE SPC 1 DELCR JSB GTCSC GET THE DELETE POSITION NOP JMP EDIT2 AND GO GET NEXT EDIT CHARACTER SPC 1 REPMA NOP TEMP SAVE OF EDIT BUFFER CHARACTER CKSHS CPA SLASH 1ST CHAR, MUST BE "/" RSS YES, DEFAULT TO THE REPLACE MODE JMP RUºþúCMD MUST BE FMGR IMPLIED RUN COMMAND LDB CNTLR GET REPLACE MODE REPMD STA REPMA REPLACE MODE, SAVE CHAR IF NEEDED LATER STB MODEF SET THE EDIT MODE FLAG TO REPLACE STB EDITF AND SET THE EDIT FLAG JSB GTCSC GET NEXT CHARACTER FROM DISPLAY BUFFER LDA O40 NO MORE, FAKE IT WITH SPACE LDB REPMA GET THE CHARACTER FROM EDIT BUFFER CPB SLASH WHICH CHARACTER SHOULD BE STORED? RSS IF SLASH, THEN USE DISPLAY BUFFER STB A IF NOT USE THE EDIT BUFFER CHARACTER JSB PTEBF AND PUT INTO THE EDITED BUFFER JMP EDIT2 AND GET NEXT CHARACTER SPC 1 * SETUP THE DISPLAY BUFFER IF NECESSARY, AND OUTPUT TO THE TERMINAL SPC 1 EDIT3 JSB GTCSC GET REMAINING STRING FROM DISPLAY JMP EDIT4 NO MORE, MOVE INTO DISPLAY BUFFER JSB PTEBF BUFFER AND PUT INTO C.BUF JMP EDIT3 AND CONTINUE SPC 1 EDIT4 LDA O40 MAKE SURE THERE IS TRAILING SPACE IN BUFFER JSB PTEBF BECAUSE WE ARE GOING TO MAKE IT A WORD BUFFER LDA PCONT GET NUMBER OF CHARS IN BUFFER ARS DIVIDE BY 2 STA DSPLN AND SAVE THE WORD LENGTH SZA,RSS CHECK IF ANY LENGTH? JMP DECR2 NO, GET CURRENT BUFFER LIST POINTER LDA DFC.B GET FROM BUFFER ADDRESS JSB WDSPB AND WRITE OUT THE DISPLAY BUFFER JMP REAC1 AND RE-ENTER THIS SUBROUTINE SPC 1 * ROUTINE TO LIST FROM "CURSK" FOR N LINES SPC 1 LISTC JSB IFBRK CLEAR THE BREAK FLAG DEF *+1 JSB NMBLN GET NUMBER OF LINES TO PRINT LDB TOPSK GET POINTER TO TOP OF BUFFER LIST SZA,RSS CHECK IF ZERO LINES TO LIST? STB CURSK YES, LIST WHOLE BUFFER LIST STA ACCUM SET NEG NUMBER OF LINES TO LIST LIST1 JSB MCBDB AND WRITE IT OUT JSB ADVSK ADVANCE THE CURSK POINTER JMP REAC1 DONE, RE-ENTER THIS ROUTINE JSB IFBRK »þú CHECK IF BREAK REQUESTED? DEF *+1 SSA TRYING TO STOP? JMP LIST2 YES, STOP ISZ ACCUM CHECK IF DONE? JMP LIST1 NO, CONTINUE LIST2 JSB MCBDB AND WRITE IT OUT JMP REAC1 YES, RE-ENTER THIS ROUTINE SPC 1 * WRITE BUFFER IN B-REG OUT THRU A-REG NUMBER OF WORDS TO KEYBOARD SPC 1 WRITA NOP WRITI NOP ENTRY TO WRITE A MESSAGE STA WRITA SAVE TLOG STB BUFAD SAVE MESSAGE ADDRESS JSB WRITF AND USE THE FMP WRITE ROUTINE DEF *+5 DEF CAM.I DEF .E.R. BUFAD DEF * DEF WRITA NUMBER OF WORDS JMP WRITI,I AND RETURN SPC 1 DM2K DEC -2000 DM72 DEC -72 D36 DEC 36 MSFLG ABS 0 POINTER TO ROUTINE TO HANDLE NEXT TIMEOUT DFCOL DEF ASCOL POINTER TO COLON PROMPT WORD ASCOL ASC 1,:_ PROMPT WORD ASCSY ASC 1,SY ASCII "SY" SPC 1 * DONT MOVE THE FOLLOWING 9 WORDS FOR THE EE.. ROUTINE SPC 1 ASCRU ASC 1,RU ASCII "RU" ASCP OCT 120 RIGHT JUSTIFIED ASCII "P" ASCL OCT 114 RIGHT JUSTIFIED ASCII "L" ASCUP OCT 136 RIGHT JUSTIFIED ASCII "^" ASCR OCT 122 RIGHT JUSTIFIED ASCII "R" COMMA OCT 54 RIGHT JUSTIFIED ASCII "," COLON OCT 72 RIGHT JUSTIFIED ASCII ":" SPC 1 SLASH OCT 57 RIGHT JUSTIFIED ASCII "/" CNTLR OCT 22 RIGHT JUSTIFIED ASCII (CNTL) "R" CNTLC OCT 3 RIGHT JUSTIFIED ASCII (CNTL) "C" CNTLI OCT 11 RIGHT JUSTIFIED ASCII (CNTL) "I" CNTLS OCT 23 RIGHT JUSTIFIED ASCII (CNTL) "S" MINUS OCT 55 RIGHT JUSTIFIED ASCII "-" CNTLT OCT 24 RIGHT JUSTIFIED ASCII (CNTL) "T" SPC 1 DFMES DEF *+1 DEF WAIT WAITING FOR INPUT DEF STILL STILL WAITING DEF GOING GOING DEF GOING GOING DEF GONE GONE DFGON DEF * SPC 1 WAIT DEC 11 ASC 11,WAITING FOR INPUT 5 BELLS STILL DEC 9 ASC 9,STILL WAITING 5 BELœþúLS GOING DEC 5 O5 EQU GOING ASC 5,GOING! 4 BELLS GONE DEC 5 ASC 5,GONE! 5 BELLS SPC 1 TOPSK EQU TPSK. ADDRESS OF TOP OF BUFFER LIST BUFFER NXTSK EQU NXTK. NEXT AVAILABLE WORD IN BUFFER LIST BUFFER ENDSK EQU EDSK. END + 0 WORD OF BUFFER LIST BUFFER CURSK EQU CRSK. CURRENT DISPLAY POINTER SPC 1 * IF THE FOLLOWING THREE LINES WERE ADDED TO BUFFER LIST * IT WOULD LOOK LIKE THIS: * (1) MESSAGE * (2) TWO * (3) THREE * * BIT !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0! * TOPSK ! (0) ! (4) ! * ! M ! E ! * ! S ! S ! * ! A ! G ! * ! E ! (SPACE) ! * ! (4) ! (2) ! * ! T ! W ! * ! O ! (SPACE) ! * CURSK ** ! (2) ! (3) ! * ! T ! H ! * ! R ! E ! * ! E ! (SPACE) ! * NXTSK ** ! (3) ! (0) ! * ! THIS IS BEYOND THE END OF THE BUFFER ! * ! LIST AND WILL CONTAIN GARBAGE DATA ! * ENDSK ! THIS IS LAST WORD IN BUFFER LIST BUFFER ! * * ** THESE WORDS ARE DYNAMIC POINTERS INTO LIST BUFFER SPC 1 * TAKE BUFFER POINTED TO BY A-REG OUT OF BUFFER LIST * NOTE: A-REG MUST NOT = NXTSK !!! SPC 1 DELIA NOP "FROM" POINTER DELIB NOP "TO" POINTER DELIN NOP ENTRY TO DELETE A BUFFER FROM BUFFER LIST STA DELIB SAVE POINTER TO BUFFER TO DELETE CPA NXTSK CHECK IF AT END? JMP DELIN,I YES, IGNORE DEáþúLETE REQUEST LDA DELIB,I GET THE OFFSET VALUE AND O377 MASK TO OFFSET BITS STA B SAVE IN B-REG THE DELETE BUFFER LENGTH BLF,BLF POSITION TO HIGH BITS ADB A B-REG = DELETE BUFFER LENGTH IN HI & LO-BITS ADA DELIB BUMP TO LENGTH WORD OF NEXT BUFFER-1 INA BUMP TO LENGTH WORD OF NEXT BUFFER STA DELIA SAVE "FROM" ADDRESS FOR MOVE LDA DELIA,I GET LENGTH WORD AT END-CURR/BEG-NEXT BUFFER XOR DELIB,I WITH BEG-CURR/END OF PREVIOUS BUFFER LENGTH XOR B TAKE OUT DELETE BUFFER LENGTHS LDB NXTSK GET END ADDRESS OF LAST BUFFER LENGTH WORD DELI1 STA DELIB,I AND PUT HIGHER IN BUFFER LIST CPB DELIA CHECK IF FINISHED PACKING MOVE? JMP DELI2 YES, EXIT ISZ DELIA BUMP "FROM" BUFFER ADDRESS ISZ DELIB BUMP "TO" BUFFER ADDRESS LDA DELIA,I GET NEXT WORD TO MOVE UP JMP DELI1 CONTINUE TO NEXT WORD SPC 1 DELI2 LDA DELIB MOVE THE NXTSK POINTER STA NXTSK TO ITS NEW VALUE JMP DELIN,I AND EXIT P+1 SPC 1 * ADVANCE CURRENT DISPLAY POINTER * CALLED: JSB ADVSK * * SPC 1 SAVA NOP A-REG SAVE FOR BOTTOM SUBROUTINES ADVSK NOP GET CURRENT DISPLAY BUFFER STA SAVA SAVE A-REG FOR RETURN LDA CURSK,I GET THE LENGTH AND O377 MASK TO LENGTH SZA CHECK IF AT END? INA BUMP ONE FOR GOOD MEASURE ADA CURSK SET NEW DISPLAY BUFFER POINTER CPA NXTSK CHECK IF AT END OF BUFFER LIST? JMP ADVS1 YES, SKIP ADVANCE STA CURSK FOR NEXT TIME ISZ ADVSK P+2 EXIT >> MOVED ADVS1 LDA SAVA RESTORE A-REG JMP ADVSK,I YES, EXIT SPC 1 * DECREMENT THE CURRENT DISPLAY POINTER * CALLED: JSB DECSK * * óþú SPC 1 DECSK NOP ENTRY TO DECREMENT CURRENT POINTER CURSK STA SAVA SAVE A-REG LDB CURSK GET CURRENT DISPLAY POSITION CPB TOPSK CHECK IF ALREADY AT TOP? JMP DECS1 YES, IGNORE REQUEST LDA B,I GET THE LENGTH ALF,ALF POSITION AND O377 MASK TO JUST LENGTH CMA NEGATE - 1 ADA CURSK CALCULATE NEW "CURSK" STA CURSK AND SET NEX CURSK ISZ DECSK BUMP TO P+2 RETURN DECS1 LDA SAVA RESTORE A-REG JMP DECSK,I AND EXIT SPC 1 * MOVE "CURSK" BUFFER TO DISPLAY BUFFER AND PRINT OUT IF ANY LENGTH SPC 1 MCBDB NOP ENTRY LDA CURSK,I GET LENGTH AND O377 OF THE CURSK BUFFER SZA,RSS CHECK IF ANY LENGTH? JMP MCBD1 NO, EXIT NOP STA DSPLN YES, SET THE LENGTH LDA CURSK GET THE MESSAGE ADDRESS INA JSB WDSPB AND MOVE AND DISPLAY MCBD1 JMP MCBDB,I AND EXIT DONE SPC 1 * MOVE BUFFER IN A-REG TO DISPLAY BUFFER AND PRINT OUT SPC 1 WDSPB NOP ENTRY TO WRITE OUT THE DISPLAY BUFFER LDB DFDSP GET DISPLAY BUFFER ADDRESS JSB .MVW MOVE "DSPLN" WORDS INTO DISPLAY BUFFER DEF DSPLN OCT 0 ?? CCB GET THE BUFFER OUTPUT ADDRESS - 1 ADB DFDSP FOR ADDING TWO LEADING SPACES TO LDA DSPLN THE DISPLAY MESSAGE INA BUMP FOR THE TWO ADDITIONAL SPACES JSB WRITI JMP WDSPB,I AND RETURN SPC 1 * ROUTINE TO PUT A CHARACTER INTO THE C.BUF AFTER BEING EDITED SPC 1 PCONT NOP NUMBER OF CHARS STORED IN C.BUF PTEBF NOP ENTRY TO PUT CHARACTER IN C.BUF LDB PCONT INDEX TO CHARACTOR NUMBER CLE,ERB FORM WORD ADDRESS OF CHARACTER CPB D36 CHECK IF END OF C.BUF?? JMP PTEBF,I YES, JUST IGNORE ADB DFC.B INDEX INTO WORD aþú JSB PTCHR AND STORE ISZ PCONT AND BUMP THE NUMB CHARS STORED JMP PTEBF,I AND EXIT SPC 1 * ROUTINE TO GET CHARACTER OUT OF C.BUF (EDIT BUFFER) * NOTE: THIS ROUTINE WILL EXIT P+1 IF OUT OF BUFFER. SPC 1 CRCNT NOP CURRENT NUMBER OF CHARACTERS IN C.BUF GTCCT NOP CHARACTER COUNTER OF EDIT LINE BUFFER (C.BUF) GTC.B NOP GET NEXT CHARACTER FROM C.BUF LDB GTCCT GET CHARACTER NUMBER FROM C.BUF CPB CRCNT CHECK IF AT END OF BUFFER? JMP GTC.3 YES, EXIT P+1 CLE,ERB CALCULATE WORD INDEX ISZ GTCCT BUMP TO NEXT CHAR FOR NEXT PASS ADB DFC.B INDEX TO WORD JSB GTCHR GET THE CHARACTER ISZ GTC.B CONTINUATION EXIT GTC.3 JMP GTC.B,I EXIT P+2 SPC 1 * ROUTINE TO GET A CHARACTER OUT OF DISPLAY BUFFER SPC 1 GTCDE NOP CURRENT CHAR NUMBER IN DISPLAY BUFFER GTCSC NOP GET NEXT CHARACTER IN DISPLAY BUFFER LDB GTCDE GET THE CHARACER NUMBER CLE,ERB CALCULATE WORD NUMBER CPB DSPLN CHECK IF AT END? JMP GTCS1 YES RETURN A ASCII SPACE ADB DFDSP ADD IN THE BUFFER START ADDRESS JSB GTCHR GET THE CHARACTER ISZ GTCDE BUMP THE CHARACTER ADDRESS ISZ GTCSC P+2 RETURN IF GOT CHAR GTCS1 JMP GTCSC,I AND EXIT P+1 SPC 1 * GET A CHARACTER ROUTINE * ENTRY >> B-REG = BUFFER WORD ADDRESS * E-REG = 1>> LEAST CHAR, =0 >> HI-CHAR SPC 1 GTCHR NOP ENTRY B-REG = WORD ADDRESS E-REG = EVEN/ODD LDA B,I GET WORD SEZ,CLE,RSS CHECK IF NEEDS POSITIONING? ALF,ALF YES, POSITION TO LO-BITS AND O377 MASK OFF HI-BITS STA B SAVE CHAR TEMP *790615 ADB OM173 CHECK IF > LOWER CASE Z SEZ,CLE,RSS YES >> EXIT ADB O32 NO, CHECK IF < LOWER CASE A SEZ,CLE UPPER CASE ANY LOWER CASE A..Z XOR O40 WHILE IN IO]þúNTERACTIVE MODE JMP GTCHR,I AND EXIT A-REG = CHAR SPC 1 * ROUTINE TO GET A POSSIBLE NUMBER AFTER THE 1 CHAR COMMAND SPC 1 ACCUM NOP CONVERTED NUMBER NMBLA NOP TEMP NMBLN NOP ENTRY TO GET NUMBER OF LINES CLA CLEAR THE ACCUMLATOR NMBL1 STA ACCUM BEFORE BEGINNING NMBL2 JSB GTC.B GET THE POSSIBLE NEXT CHARACTER JMP NMBL3 NONE, EXIT P+1 CPA O40 IGNORE ANY SPACES JMP NMBL2 IN THE BUFFER JSB NUMBR CHECK IF IS A NUMBER? STA NMBLA SAVE IT TEMPORARY LDA ACCUM MPY D10 SCALE UP ONE DIGIT ADA NMBLA JMP NMBL1 SPC 1 NMBL3 LDA ACCUM GET THE ACCUMULATED NUMBER CMA,INA NEGATE JMP NMBLN,I EXIT SPC 1 NUMBR NOP ENTRY ASCII CHARACTER IN A-REG CLE CHECK AND CONVERT TO A NUMBER ADA OM72 CHECK IF IN THE 0 TO 9 SEZ,CLE,RSS ASCII RANGE ADA D10 BY THE MAGIC ALGORITHM SEZ,CLE E-REG SET IF = LEGAL NUMBER DIGIT JMP NUMBR,I AND EXIT P+1 IF NUMBER JMP RUCMD NOT NUMBER, EXECUTE IMPLIED RUN SPC 1 OM2 OCT -2 OM6 OCT -6 OM72 OCT -72 O1 OCT 1 O2 OCT 2 O3 EQU CNTLC D10 DEC 10 O32 OCT 32 O377 OCT 377 O400 OCT 400 OM173 OCT -173 SPC 1 * THE FOLLOWING IS A LIST OF COMMANDS THAT ARE POSSIBLY LONGER THAN * 2 CHARACTERS AND STILL WILL QUALIFY AS LEGAL FMGR COMMANDS. * THEREFORE YOU MAY NOT HAVE "IMPLIED" RUN COMMANDS THAT MATCH OR * ARE A SUBSET OF ANY OF THE FOLLOWING STRINGS. SPC 1 EXLST DEF *+1 ASC 3,EXIT ASC 3,LOG ASC 3,TELL ASC 3,ANNOTATE ASC 3,CREATE ASC 3,PURGE ASC 3,STORE ASC 3,DUMP ASC 3,LIST *** ASC 3,SAVE *790808 ASC 3,OFF ASC 3,TRANSFER ASC 3,PAUSE ASC 3,SET ASC 3,CALCULATE ASC 3,JOB ASC 3,EOJ ASC 3,ABORT ý4rpl ASC 3,HELP ASC 3,CLALL ASC 3,COPY OCT 0 END  Arÿÿ ÿýˆ  ÿ92067-18209 1903 S C0122 &EE..              H0101 ^>þúSPL,L,O ! NAME: EE.. ! SOURCE: 92067-18209 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME EE..(8) "92067-16185 REV.1903 790206" ! ! MODIFICATION RECORD: ! ! DATE REASON ! (1) 780720 TO SCHEDULE SESSION LOG-OFF, WITH OPTIONS ! (2) 781117 TO REQUIRE SP OR RP TO BE SPECIFIED FOR SESSION EXIT ! UNLESS SYSTEM MANAGER OR NO PRIVATES MOUNTED TO SESSION ! EE..: SUBROUTINE (N,LIS,ER) GLOBAL LET FM.ER,CLOS.,EXEC BE SUBROUTINE,EXTERNAL LET GTSCB,CLOSE BE SUBROUTINE,EXTERNAL LET CONV. BE SUBROUTINE,EXTERNAL LET .SETB BE SUBROUTINE,EXTERNAL,DIRECT LET CUSE.,CAD.,I.BUF BE INTEGER,EXTERNAL LET S.TTY,S.CAP BE INTEGER,EXTERNAL LET ACTV. BE INTEGER,EXTERNAL LET SM.BF BE INTEGER,EXTERNAL LET LGOFF(3) BE INTEGER LET L.SEG,ABX.. BE LABEL,EXTERNAL LET A BE CONSTANT(0) INITIALIZE LGOFF TO "LGOFF " ! KI_[RG_[RP_@LIS+1]+4]+4 P3_[P2_[P1_$1717K+12]+1]+1 !PROGRAM NAME IN ID SEGMENT ORIG_0 ASSEMBLE ["EXT $SMLK";"EXT $SMST";"EXT $SMDL";"EXT $SMID"] ASSEMBLE ["EXT $LGOF";"LDA $LGOF";"STA LGOF"] ASSEMBLE ["LDA $SMLK";"STA SMLK";"LDA $SMST";"STA SMST"] ASSEMBLE ["LDA $SMDL";"STA SMDL";"LDA $SMID";"STA SMID"] CALL GTSCB(SM.BF,144,IERR) !READ SESSION CONTROL BLK IF IERR > 0 THEN [ \IF IN SESSION, THEN IF $P1 = "FM" THEN [ ·ˆþú \ IF ($P2 AND 177400K)=43400K THEN[\ ASCLU_(($P2 AND 377K) <- 8) OR ($P3 >-8); \ CONV.(S.TTY,ASLU2,2); \ IF ASCLU=ASLU2 THEN [ \ ORIG_1; \ EX.OP_SM.BF AND 377K; \SESSION ID TO LOW BYTE IF $RP="RP" THEN \BIT 15=DISMOUNT PRIVATES EX.OP_EX.OP OR 100000K, \ ELSE [ \ IFNOT LIS THEN [ \IF NO SP/RP PARAMETER PTR_@SM.BF-(SMLK+SMST); \ADDRESS OF SST LENGTH WORD IF $(PTR+SMID)=7777K THEN \IF SYSTEM MANAGER, THEN GO TO EE1; \ LIMIT_$(PTR+SMDL); \CONTENTS OF DISC LIMIT WORD CTRAD_PTR-$PTR+1; \ADDRESS OF DISC COUNTER WORD REPEAT LIMIT TIMES DO \CHECK EACH DISC FOR BIT 14 [IFNOT $[CTRAD_CTRAD+1] AND 40000K \(0 IF PRIVATE) THEN [IF $CTRAD THEN \IF NOT A SPARE & BIT 14=0, GO TO ER71]]], \ERROR 71 - MUST SAY SP/RP ELSE [IFNOT $RP="SP" THEN \IF NEITHER SP NOR RP, THEN [ER_56;RETURN]]]; \BAD PARAMETER ERROR EE1: IF $RG="RG" THEN \BIT 14=DISMOUNT GROUP DISCS EX.OP_EX.OP OR 40000K; \ IF $KI="KI" THEN \BIT 13=KILL PROGRAMS EX.OP_EX.OP OR 20000K]]]] ! IF ACTV. THEN GO TO ABX.. ENDMS_@CUSE.-5 FM.ER(0,$ENDMS,5) CLOS.($0) EXEC (5,-1) IF $P1 = "FM" THEN [ \IF "FMGR" IF $P2 = "GR" THEN [ \ IF ($P3 AND 177400K) = 20000K THEN \ [CAD._0;CUSE._"77";GOTO L.SEG]]] !1ST IN SEG.7 (NX.JB) CLOSE(I.BUF) IFNOT S.CAP THEN GO TO DONE IFNOT ORIG THEN GO TO DONE $A_S.TTY CALL .SETB !DISABLE TERMINAL ²„ EXEC(100012K,LGOFF) !SCHEDULE LGOFF GO TO CLSRW CLSRW:EXEC(20,0,0,0,EX.OP,$($1717K+32),LGOF) !LOG-OFF OPTIONS DONE: CALL EXEC(6) ER71: ER_71 !NOT SPECIFIED, ERROR 71 RETURN END END END$ R‹ÿÿ ÿý‰‘ ÿ92067-18210 1903 S C0122 &TR..              H0101 bNþúSPL,L,O,M ! NAME: TR.. ! SOURCE: 92067-18210 ! RELOC: 92067-16185 ! PGMR: G.A.A., A.M.G ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME TR..(8) "92067-16185 REV.1903 790403" ! ! MODIFIED: 780413 TO USE TRANS FILE SECURITY CODES (GLM) ! 780421 FOR SESSION MONITOR CARTRIDGE SEARCH OVERRIDE (BL) ! 780630 TO ALLOW TRANSFER FILE FLUSH (GAA) ! ! LE GRAND TR ROUTINE ! LET OPEN., \FILE OPEN OR FAKE OPEN READF, \READ RECORD IER., \CHECK ERROR (IN FM.CM) EE.., \FMGR EXIT ROUTINE GLOBS \SET UP GLOBALS BE SUBROUTINE,EXTERNAL ! LET P.TR, \TRANSFER STACK POINTER CAMS., \TRANSFER STACK CAM.I, \COMMAND INPUT DCB .E.R., \ERROR CODE ACTV., \ACTIVE JOB POINTER N.OPL, \SUB-PARAMETER STORAGE S.CAP, \9P - SESSION CAPABILITY OVRD. \CARTRIDGE SEARCH OVERRIDE BE INTEGER,EXTERNAL ! LET FM.AB, \IN FMGR MAIN ABX.. \ BE LABEL,EXTERNAL ! TR..: SUBROUTINE(N,LIS,ERR)GLOBAL !TRANSFER SUBROUTINE DCB14_[DCB2_@CAM.I+2]+12 !ADDRESS OF RECORD COUNT, TYÛõþúPE ! PLIST_[NFI,NFA_@LIS+1]+3 !GET PARAMETER ADDRESSES. IF S.CAP THEN \IF IN SESSION, OVRD._OVRD. AND 137777K !CLEAR OVRD IN CASE OF ERROR IFNOT $NFA THEN [$NFA_$NFA-1; \MAKE UNIFORM BACK UP IF P.TR-12 < @CAMS. THEN [ \IF UNDERFLOW, ERR_10;RETURN]] !MAKE IT AN ERROR IF $NFA < 0 THEN [ \IF WE ARE GOING BACK*780413* DECR_6*($NFA-1); \NBR OF WORDS TO POP IF DECR > 0 THEN \HANDLE OVERFLOW [PTR_@CAMS.;GO TO FLUSH]; \ BADFILE: PTR_P.TR+DECR; \PULL GOODIES FROM IF PTR < @CAMS. THEN PTR_@CAMS.; \IF TOO FAR, GO TO FIRST FLUSH: RC_$([CR_[NFI_PTR+1]+3]+2); \SET REST OF STACK IF PTR+6 < ACTV. THEN GO TO ABX..; \IF TOO FAR, ABORT JOB *780419* IF N.OPL < 0 THEN RC_RC+N.OPL; \IF BACK SPACE REQUESTED IF RC < 0 THEN RC_0; \SET IT UP RS_$[P.TR_PTR]], \LOOKS GOOD LETS BUY IT ELSE [ \GOING FORWARD RC_0; \SET POINTERS FOR RETURN CR,PTR_@N.OPL; \AND THE CALL IF P.TR-@CAMS. > 48 THEN [ \IF TOO DEEP *780413* ERR _ 13; RETURN] \TAKE GAS. ] !LOOKS GOOD , LETS DO IT CALL GLOBS(N-1,$PLIST,1) ? \SET UP GLOBALS. [ERR _ 48; RETURN] !ERROR IN GLOBAL SET. OPEN.(CAM.I,$NFI,$CR ,401K) !OPEN NEW INPUT FILE. IF .E.R.< 0 THEN[ \IF ERROR AND HERE THEN SV>3 IF S.CAP THEN \IF IN SESSION, OVRD._OVRD. AND 137777K; \BETTER RESET OVERRIDE N.OPL,$NFA_0;DECR_ -6;GO TO BADFILE] !RE-OPEN ORIGINAL FILE $PTR_RS !RESETõm RECORD COUNT IF RC THEN [ \IF NEEDED. IF $DCB2 THEN[ \(MUST NOT BE TYPE ZERO) UNTIL $DCB14 = RC DO [ \READ AS MANY RECORDS READF(CAM.I,.E.R.,C.BUF,1); \AS NECESSARY FOR IER.]]] !POSITIONING. RETURN END ! END END$ Lþÿÿ ÿýŠ’ ÿ92067-18211 2026 S C0122 &SA..              H0101 UGþúSPL,L,O,M ! NAME: SA.. ! SOURCE: 92067-18211 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SA..(8) "92067-16185 REV.2026 800304" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780427 TO MAKE IER. CALL ON RETURN FROM CREA. (BL) ! (IER. CALL REMOVED FROM CREA.) ! 2) 780920 TO USE EXTENDED FMP CALLS (ECREA,ELOCF,ECLOS) ! TO ACCEPT SIZE IN -MULTIPLE NUMBER OF BLOCKS ! 3) 800304 TO CORRECT TRUNCATION CALCULATION (SST #4732) ! ! THIS ROUTINE IS THE SAVE LS/LG ROUTINE FOR THE ! RTE FMGR PROGRAM. IT IS ENTERED BY ENTERING ! A COMMAND OF THE FORM: ! ! SA,LS/LG,NAMR !PRAM LOC 1 5 ! ! W H E R E: ! ! SA IS THE COMMAND NAME. ! ! LS/LG IS LS TO SAVE THE LS FILE, ! OR LG TO SAVE THE LOAD & GO FILE. ! ! NAMR IS TO BE THE NEW FILE'S NAME REFERENCE. ! ! ! THE FOLLOWING NAMR PARAMETERS ARE OPTIONAL: ! ! CR IS THE CARTRIDGE TO BE USED TO SAVE ! (ZERO IF NOT GIVEN). ! ! SC IS THE FILE'S SECURITY CODE ! (ZERO IF NOT GIVEN). ! ! TY IS THE FILE'S TYPE (4 FOR LS OR ! 5 FOR LG IF NOT GIVEN). ! ! SZ1 IS THE FILES SIZE ESTIMATE USED FOR LS FILES ONLY ! IF NOT GIVEN THE THE FILE IS ESTIMATED TO FILL ! LESS THAN HALF A TRACK. EXCESS THEN GENERATES AN EXTENT ! IF LESS THAN THE ESTIMATED SIZE IS USED THE ! EXCESS IS RETURNED TO THE SYSTEM ! ! CONSTANT DECLARATIONS ! LET XE|þúQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET LGOTK BE CONSTANT (1765K) LET LGOC BE CONSTANT (1766K) LET LG BE CONSTANT (46107K) LET LS BE CONSTANT (46123K) ! ! DECLARE THE ERROR WORD LOCATION ! LET .E.R.,N.OPL BE INTEGER,EXTERNAL ! ! ARRAY DECLARATIONS ! LET O.BUF,I.BUF,BUF.,CUSE. BE INTEGER,EXTERNAL LET IRBN(2),IRCN(2),ITRUN(2),ISIZ(4),JSIZ(2), \ DW1(2),DW2(2),BLKMP(2) BE INTEGER ! INITIALIZE BLKMP TO 0,128 INITIALIZE DW1 TO 0,1 INITIALIZE DW2 TO 0,2 ! ! SUBROUTINE DECLARATIONS ! LET ECREA,OPEN.,IER.,\ WRITF,ELOCF,ECLOS,CLOS.,\ READ.,READF,RWNDF,\ MSS.,EXEC,CK.SM BE SUBROUTINE,EXTERNAL LET .DDI,.DMP,.DSB BE SUBROUTINE,EXTERNAL,DIRECT ! LET LSRD,LGRD,READR,\ GET BE SUBROUTINE ! LET IFBRK BE FUNCTION,EXTERNAL LET LG.S BE FUNCTION SA..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL LET NCAM,PLIST,MSNO BE INTEGER LIS5_[LIS1_@PLIST+1]+4 !SET LIST ADDRESSES SZ_[RS _[SC_@N.OPL+5]+2]+1 !SET OPTION LIST ADDRESSES ! IF NCAM<2 THEN[MSNO_50;RETURN] IF $LIS1=LG THEN GO TO SALG IF $LIS1#LS THEN [MSNO_56; RETURN] !NOT LS OR LG SO ABORT CUSE._0 !SHOW SEGMENT NOT IN CORE FOR NEXT TIME OPFL_101000K !SET PUNCH OPTION FLAG DO[T1_4;SIZE_$SECT2/4;RD_@LSRD]!SET UP DEFAULT SIZE SA02: IFNOT $SZ THEN $SZ_SIZE !SET DEFAULT SIZE IF NOT SUPPLIED IFNOT $RS THEN $RS _T1 !SET DEFAULT TYPE TYPE_$RS !SET TYPE FOR LATER CLOS.(O.BUF) IF $LIS5 < 64 THEN \OPEN IF NOT A FILE NAME [TYPE_0; \ OPEN.(O.BUF,$LIS5,$SC,OPFL); \ GO TO CONT1] IF $SZ < 0 THEN [ \IF FILE SIZE NEGATIVE, THEN IF $SZ = -1 THEN \é`þúIF SIZE = -1, THEN ISIZ(1),ISIZ(2)_ -1, \MAKE DOUBLE WORD, ELSE ELSE [.B._ -$SZ;.A._0; \MAKE POSITIVE AND CALL .DMP(BLKMP); \MULTIPLY BY BLK MULTIPLIER ISIZ(1)_.A.;ISIZ(2)_.B.]],\SAVE FOR ECREA ELSE [ISIZ(1)_0;ISIZ(2)_$SZ] !ELSE CONVERT TO DOUBLE WORD ISIZ(3)_0 ISIZ(4)_$(@N.OPL+9) !RECORD SIZE CALL ECREA(O.BUF,.E.R.,$LIS5,ISIZ,TYPE,$SC,$(SC+1),144,JSIZ) IER. CONT1:FIRST_1 LOOP: CALL $RD !READ A RECORD IF IFBRK() THEN [MSS.(0);GO TO ABOR] L_IL IFNOT IL THEN[IFNOT TYPE THEN L_-1] WRITF(O.BUF,.E.R.,BUF.,L) !WRITE IT IF .E.R.= -6 THEN[MSS.(.E.R.);GOTO ABOR]!PURGE FILE IER. ! ANY ERRORS? IF IL=>0 THEN GO TO LOOP ! IF NOT EOF CONTINUE ! IFNOT TYPE THEN RETURN ELOCF(O.BUF,.E.R.,IRCN,IRBN) !GET CURRENT POSITION IER. TRUN: .B._JSIZ(2);.A._JSIZ(1) !ACTUAL SIZE CALL .DDI(DW2) !CONVERT SECTORS TO BLKS CALL .DSB(IRBN) CALL .DSB(DW1) ITRUN(1)_.A.;ITRUN(2)_.B. ECLOS(O.BUF,.E.R.,ITRUN) !CLOSE & TRUNCATE IER. EXIT: RETURN !DONE RETURN SALG: TY_0 !SET LOAD & GO FLAG T1_5 !SET DEFAULT TYPE OPFL_101100K !SET THE OPTION FLAG SIZE _(([T_LG.S() ?[MSNO_58;RETURN]]+3)>-1)+T/5 !SIZE ESTIMATE RD_@LGRD !SET THE READ ROUTINE ADDRESS GO TO SA02 !GO DO IT END LSRD: SUBROUTINE READ.(2,BUF.,70,IL) RETURN END ! LGRD: SUBROUTINE BUF1_[BUF_@BUF.]+1 IFNOT FIRST THEN GOTO XFER IBUF4_[IBUF3_[IBUF2_[IBUF_@I.BUF]+2]+1]+1 IBU15 _[IBUF9_[IBUF8_[IBUF7_[IBUF6_[IBUF5_ \ SET UP BUFFER ADDRESSES IBUF4+1 ]+1]+1]+1]+1]+6 $IBUF_[IF $LGOTK<0 THEN 3,ELSE 2] $(IBUF2 )_2 $(IBUF3 )_($LGOTK AND 77600K)-<9 $IBUF4,$IBU15_0 $IBUF7_200K $(IBUF5)_([MXRC_LG.S()]+3) $IBUF6_64 $(IBUF8 )_[IF $IBUF=3 THENMt $SECT3,ELSE $SECT2] $(IBUF9 )_$XEQT RWNDF(I.BUF,.E.R.) IER. DO[RC,FIRST,ENFLG_0;READR] XFER: IFNOT ENFLG THEN GOTO LGRD2 IF ENFLG=1 THEN[ENFLG_2;IL_0;RETURN] LGRD1:DO[ENFLG_0;IF ADD#@PLIST THEN READR;IL_-1;\ IF RC>MXRC THEN RETURN] LGRD2:GET(BUF.,1) IFNOT $BUF THEN GO TO LGRD1 GET ( $BUF1 ,[IL_$BUF-<8]-1) CK.SM(BUF.,1)?[GOTO ABORT] IF ( $BUF1 AND 160000K)=120000K THEN ENFLG_1 RETURN ABORT:MSS.(7) ABOR: IFNOT TYPE THEN GO TO EXIT ! IF TYPE ZERO THEN EXIT DO[$(@O.BUF+15)_0;IRBN(1),IRBN(2)_-1;GO TO TRUN] END ! ! GET: SUBROUTINE(DS,NO) ED_@DS+NO-1 FOR I_@DS TO ED DO THRU GET0 $I_$ADD ADD_ADD+1 GET0: IF ADD=ENADD THEN READR RETURN END ! READR:SUBROUTINE DO[READF(I.BUF,.E.R.,PLIST);IER.] ENADD_[ADD_@PLIST]+64 RC_RC+1 RETURN END ! LG.S: FUNCTION FEXIT LG.SV_((($LGOC AND 77600K)-($LGOTK AND 77600K))\ -<9)*[IF $LGOTK<0 THEN $SECT3,ELSE $SECT2]\ +($LGOC AND 177K) IF LG.SV THEN RETURN,ELSE FRETURN END END END$ úäÿÿ ÿý‹” ÿ92067-18212 1903 S C0122 &MR..              H0101 dGþúSPL,L,O ! NAME: MR.. ! SOURCE: 92067-18212 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME MR..(8) "92067-16185 REV.1903 760621" ! ! ! ! THIS PORTION OF THE FILE MANAGER RESTORES ! A FILE TO THE SYSTEM LOAD AND GO AREA. ! ! ! THE COMMAND IS: ! ! LG,NAMR ! ! ! W H E R E: ! ! NAMR IS THE FILE NAME WHICH MAY CONTAIN THE: ! CR IS ITS CARTRIDGE ID (OPTIONAL). ! SC IS ITS SECURITY CODE (OPTIONAL). ! ! ! ARRAY DECLARATIONS: ! LET O.BUF,I.BUF,BUF.,N.OPL BE INTEGER,EXTERNAL ! ! DECLARE THE ERROR WORD LOCATION ! LET .E.R. BE INTEGER,EXTERNAL ! LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET LGCO BE CONSTANT (1766K) LET LGOTK BE CONSTANT (1765K) ! LET LGMS,LGMS2 BE INTEGER INITIALIZE LGMS,LGMS2 TO "LG, " ! ! ! EXTERNAL SUBROUTINE DECLARATIONS: ! LET CK.SM,READF,OPEN.,\ CNUMD, \ MSS.,EXEC, \ IER. BE SUBROUTINE,EXTERNAL LET JER.,.DFER BE SUBROUTINE,EXTERNAL,DIRECT LET WRLG.,EFLG.,MESSS BE FUNCTION,EXTERNAL ! ! MR..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL IFNOT NCAM THEN[MSNO_50;RETURN] OPEN.(I.BUF,$(@PLIST+1),N.OPL,301K) !NON-EXCLUSIVE OPEN IF $LGOTK AND 177K THEN GO TO LG0 !IF LG AREA DEFINED DO IT IFNOT [SZ_$SECT3] THEN SZ_$SECT2 !SET SIZE OF LG DISC FSZ_$([TYP_ @I.BUF+2]+3) !GET FILE DATA FROM DCB IFNOT $TYP THEN [SZ_4;GO TO ASLG] 7Ô  !IF TYPE 0 USE FOUR TRACKS SZ_FSZ/SZ +2 !ELSE 2 PLUS ESTIMATE (GENEROUS) ASLG: CALL .DFER(O.BUF,LGMS) !SET UP MESSAGE CALL CNUMD(SZ,$(@O.BUF+2)) !PUT IN THE NUMBER IF MESSS(O.BUF,10) THEN[ \IF NO LG TRACKS NOTR: MSNO_58;RETURN] !RETURN AN ERROR ! LG0: FLG_0 LG1: READF(I.BUF,.E.R.,BUF.,64,L) !READ A RECORD JER. IF L<1 THEN GOTO LG2 CK.SM(BUF.,1)?[MSNO_7;RETURN] FLG_1 IF WRLG.(BUF.,(BUF.-<8),O.BUF) THEN GO TO NOTR IFNOT($(@BUF.+1) AND 160000K) = 120000K THEN\ GOTO LG1, ELSE[FLG_0;\ IF EFLG.(L) THEN GO TO NOTR; \ GO TO LG1] ! LG2: IF FLG THEN[MSS.(2006);EXEC(7);GOTO LG1] IFNOT L THEN GO TO LG1 RETURN END END END$ Xõ ÿÿ ÿýŒ“ ÿ92067-18213 1903 S C0122 &SE..              H0101 XMþúSPL,L,O ! NAME: SE.. ! SOURCE: 92067-18213 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SE..(8) "92067-16185 REV.1903 740927" ! ! LET G0.. BE INTEGER,EXTERNAL ! LET GLOBS BE SUBROUTINE ! LET PTR,PTR0,PTR1,PTR2 BE INTEGER ! ! SE..: SUBROUTINE(NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER CALL GLOBS(NUM,PLIST,0) ? [ERR _ 48] RETURN END ! GLOBS: SUBROUTINE(NUMB,GLOBL,IND) GLOBAL,FEXIT LET GLOBL,NUMB,IND BE INTEGER LET G0.. BE INTEGER,EXTERNAL PTR,PTR2 _ @GLOBL IF NUMB > 9 THEN NUMB _ 9 !TOO MANY PARAMETERS? IF NUMB THEN GOTO GLOB2 !IF THERE ARE NONE IF IND THEN GOTO GLOB2 !AND THIS IS A "SET" PTR1 _ @G0.. + 3 !THEN NULL ALL THE FOR I _ 1 TO 36 DO [ \GLOBALS. $[PTR1 _ PTR1 + 1] _ 0] RETURN GLOB2: PTR _ PTR + 2 !SET POINTERS. PTR1 _ [PTR0 _ @G0.. + 4] + 2 FOR I _ 1 TO NUMB DO [ \MOVE ALL NON-NULL IF $PTR2 = 0 THEN GOTO GLOB3; \PARAMETERS TO THE $[REAL]PTR0 _ $[REAL]PTR2; \GLOBALS IN THE MAIN. $[REAL]PTR1 _ $[REAL]PTR; \ GLOB3: PTR _ [PTR2 _ PTR2 + 4] + 2; \ PTR1 _ [PTR0 _ PTR0 + 4] + 2] RETURN END END END$   ÿÿ ÿý” ÿ92067-18214 2001 S C0122 &IF.. FMGR IF COMMAND ROUTIN             H0101 ôÛþúSPL,L,O ! NAME: IF.. ! SOURCE: 92067-18214 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME IF..(8) "92067-16185 REV.2001 791015" ! LET READF,POSNT,IER. BE SUBROUTINE,EXTERNAL LET C.BUF BE REAL,EXTERNAL LET CAM.I,NO.RD,TTY. BE INTEGER,EXTERNAL LET .E.R.,CAD. BE INTEGER,EXTERNAL ! LET ETAB BE CONSTANT (43K) LET LTAB BE CONSTANT (31K) LET GTAB BE CONSTANT (26K) LET FTR BE INTEGER (2) LET DIF,NCOM,P1,P2,MASK,RTABP,REL BE INTEGER LET RTAB BE INTEGER (7) INITIALIZE FTR TO "TR",0 INITIALIZE RTAB TO "LEGEGTLTNEEQ",0 ! ! IF..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER IF TTY. THEN [ERR _ 10; RETURN] !IF TTY, REJECT REQ. NCOM _ [P2 _ [REL _ [P1 _ \SET UP POINTERS. @PLIST - 1] + 6] + 2] + 6 FOR I _ 1 TO 4 DO [ \COMPARE P1 AND P2. IF [DIF _ $[P1 _ P1 + 1] \ - $[P2 _ P2 + 1]] THEN \ GOTO COMP] COMP: DIF _ [IF DIF < 0 THEN \GET APPROPRIATE LTAB, ELSE [IF DIF THEN GTAB, \MASK WORD. ELSE ETAB]] RTABP _ @REL; MASK _ 1 CLOOP: IFNOT $[RTABP _ RTABP + 1] \MATCH RELATION THEN [ERR _ 56; RETURN] !USED IN COMMAND. IFNOT $RTABP = $REL THEN [ \ MASK _ MASK <- 1; GOTO CLOOP] IFNOT (MASK AND DIF) THEN RETURN IF $(NCOM-1)=3 THEN [ERR_56;RETURN] !IF ASCII, ERROR IFNOT $NCOM THEN $NCOM _ 1 ‘è   !DEFAULT SKIP CALL POSNT(CAM.I,.E.R.,$NCOM) !SKIP INDICATED IF .E.R.= -12 THEN [ \ IF $NCOM<0 THEN RETURN; \ N,$(@PLIST+1)_0; \ CAD.,NO.RD _ 1 ; \ RETURN ] IER. RETURN END END END$ â· ÿÿ ÿýŽ• ÿ92067-18215 2026 S C0122 &AB..              H0101 Z5þúSPL,L,O,M ! NAME: AB.. ! SOURCE: 92067-18215 ! RELOC: 92067-16185 ! PGMR: A.M.G, G.A.A ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME AB..(8) "92067-16185 REV.2026 800305" ! ! 780221 TO CLOSE O.BUF BEFORE CALLING .PARS (O.BUF IS USED BY ! .PARS AS TEMPORARY STORAGE). ! ! 780420 TO WORK WITH SIX WORDS PER ENTRY IN TRANSFER STACK ! ! 800305 TO SET BIT 14 ON OPEN. OPTION REQUEST TO INDICATE ! ABORT (SST #4770) ! ! LET REA.C, \READS A COMMAND .PARS, \PARSE ROUTINE TR.., \LE GRAND TR ROUTINE IER., \ERROR CHECK ROUTINE OPEN., \OPEN FOR LIST FILE OPEN CLOS., \CLOSE FOR LIST FILE CLOSE WRITF \FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! LET .DFER \THREE WORD TRANSFER BE SUBROUTINE,DIRECT,EXTERNAL ! LET L.SEG BE LABEL,EXTERNAL ! LET ABX.. BE LABEL,GLOBAL ! LET ACTV., \ACTIVE JOB SWITCH CUSE., \CURRENT SEGMENT LAST CHAR. O.BUF, \OUTPUT DCB NOCM., \NUMBER OF PRAMETERS IN COMMAND J.REC, \JOBFIL RECORD OF SPOOLED JOB CAD., \TABLE OFFSET FOR FUNCTION CALL TMP., \LIST FILE LOCATION P.TR, \COMMAND UNIT STACK POINTER J.NAM, \CURRENT JOB NAME C.BUF, \COMMAND INPUT BUFFER TTY., \INTERACTIVE DEVICE FLAG .E.R., \LOCATION OF SEVER4mþúITY CODE -1. ECH., \# OF CHARACTERS IN COMMAND NO.RD \NO-READ FLAG BE INTEGER,EXTERNAL ! LET ABJOB(3),JBNAM(7),ABRT(8),COM BE INTEGER ! INITIALIZE ABJOB,JBNAM TO " JOB XXXXXX ABORTED" INITIALIZE ABRT TO " ABEND OPERATOR " ! ! AB..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER IFNOT ACTV. THEN [ERR_10;RETURN] !INPUT ERROR IF NOT IN JOB .DFER(JBNAM,J.NAM) !PUT JOB NAME IN MESSAGE COM _ @ABRT; LN _ 8 !SET UP STANDARD MESSAGE. IF N= -1 THEN [ \IF INTERNAL CALL, SET COM _ @ABJOB; LN _ 10] !UP JOB ABORT MESSAGE. IF N= -2 THEN COM_@PLIST !IF MESSAGE PASSED SET UP CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),40000K) !OPEN LIST FILE CALL WRITF(O.BUF,.E.R.,$COM,LN) !SEND THE OPERATOR ABORT CALL CLOS.(O.BUF) !CLOSE THE LIST FILE *780221 IF ACTV. = 1 THEN GO TO EOJ !IF EXPECTING JO CARD GO TO EO IF P.TR # ACTV. THEN [P.TR_ACTV.+6; \SET P.TR FOR TR *780420 N.OPL_0; \DON'T CONFUSE THE ISSUE CALL TR..(1,0.0,ER)] !SET BACK TO THE JOB FILE IF TTY. THEN [ \IF TTY THEN EOJ: NOCM.,CAD._1;CUSE._"66";GO TO L.SEG] !GO LOAD EOJ IF J.REC > 0 THEN GO TO EOJ !IF JOB IS NOT $(@.E.R.+1)_1 !SET SV CODE TO KILL ECHO RDCOM: CALL REA.C !SPOOLED AND INPUT IFNOT ECH. THEN[ \IF EOF THEN GO TO EOJ ABX..: NOCM._ -2;GO TO EOJ] CALL .PARS !IS NOT FROM A COMCK: IF [COM _ $1] = "EO" THEN GO TO ABRET!EOF,THEN READ IF COM = "JO" THEN GOTO ABRET !COMMANDS UNTIL A GOTO RDCOM !JOB CARD IS FOUND. ! ABRET: NO.RD_ -1;RETURN END ! ! INTERNAL ABORT og ROUTINE ! ABT..: SUBROUTINE GLOBAL IF ACTV. THEN CALL AB..(-1) !IF A JOB ACTIVE GO DO ABORT RETURN END END END$ é·ÿÿ ÿý— ÿ92067-18216 2026 S C0122 &IN.IT              H0101 ‚qþúSPL,L,O,M ! NAME: IN.IT ! SOURCE: 92067-18216 ! RELOC: 92067-16185 ! PGMR: G.A.A., B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME IN.IT(8) "92067-16185 REV.2026 800311" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780411 TO INITIALIZE GLOBALS 8P,9P FOR SESSION (BL) ! 2) 780512 TO USE 256-WORD CARTRIDGE DIRECTORY (BL) ! 3) 780524 TO SET UP THE INITIAL CARTRIDGE DIRECTORY AND ! ASSIGN TRACK WITH CARTRIDGE DIRECTORY TO D.RTR (BL) ! 4) 780627 TO USE $OTAT,$OPRI INSTEAD OF IDSEG TEMP WORDS IN ! PICKING UP ORIGINAL TATLG, ORIGINAL FMGR PRTY (BL) ! 5) 780627 TO ALLOW NAMR IN RUN STRING ! 6) 780630 TO POST LOGLU TO 0G IF FILE INPUT ! 7) 780911 TO SCHEDULE ACCTS FOR SESSION MONITOR INITIALIZE ! 8) 780919 TO DEFAULT LIST DEVICE TO LU 1 ! 9) 781010 TO STACK INPUT LU IF SCHEDULED W/ TRANSFER FILE ! 10) 790122 TO SAVE MASKED SECURITY CODE IN $CES ! TO ENTER INITIALIZATION LOOP ONLY IF "FMGR" ! 11) 790125 TO DEFAULT LOG TO LOGLU IF ILLEGAL OR NOT TTY ! 12) 790403 TO CLEAR LU2 OPEN FLAGS ON INITIAL BOOT AFTER SWTCH ! 13) 790725 TO RESTORE OLD CRN FOR LU 2 FROM CARTRIDGE SPECIFICATION ! ENTRY AFTER SWTCH ! 14) 790802 TO SAVE MASKED SECURITY CODE ON DISC ! 15) 800311 TO HANDLE OPEN ERRORS ON INPUT DEVICE IF SVC > 3 ! LET CLOS., \FMGR INTERNAL CLOSE ROUTINE D.RIO, \FMGR CARTRIDGE DIRECTORY READ/WRITE DR.RD, \FMGR FILE DIRECTORY READ/WRITE EE.., \FMGR EXzþúIT ROUTINE GETST, \GET RUN STRING ROUTINE LOCK., \CARTRIDGE LOCK ROUTINE MSS., \FMGR ERROR MESSAGE ROUTINE NAMR, \NAMR PARSE ROUTINE OPEN., \FMGR INTERNAL OPEN ROUTINE RMPAR \PARAMETER FETCH ROUTINE BE SUBROUTINE,EXTERNAL LET .DFER \3-WORD MOVE ROUTINE BE SUBROUTINE,EXTERNAL,DIRECT LET KEYSM, \FORM INITIALIZATION KEY SUM OPFLG, \CLEAR OPEN FLAGS SETCL, \SET UP INITIAL CARTRIDGE DIRECTORY SETM3, \TEST & SET 003 MESSAGE FLAG TATPU, \WRITE TO TRACK ASSIGNMENT TABLE TATUP \SET UP THE TRACK ASSIGNMENT TABLE BE SUBROUTINE LET TTY. BE INTEGER,EXTERNAL LET PK.DR,D.SDR BE INTEGER,EXTERNAL LET FM.AB BE LABEL,EXTERNAL LET GT.JB BE LABEL,EXTERNAL LET INI1. BE LABEL,EXTERNAL LET O.BUF,I.BUF,TMP.,.R.E.,.E.R.,G0..,NO.RD BE INTEGER,EXTERNAL LET BUF. BE INTEGER,EXTERNAL LET C.BUF,ECH. BE INTEGER,EXTERNAL LET CAM.I,CAM.O,D.LT BE INTEGER,EXTERNAL LET DS.DF BE INTEGER,EXTERNAL !CL IN-CORE FLAG LET S.TTY,S.CAP BE INTEGER,EXTERNAL !8P,9P LET CLOPN BE INTEGER,EXTERNAL LET M3FLG BE INTEGER,EXTERNAL !003 MSG FLAG LET EXEC,IPUT BE SUBROUTINE,EXTERNAL LET FD.CK BE FUNCTION,EXTERNAL LET FID. BE FUNCTION,EXTERNAL LET .OPSY BE FUNCTION,EXTERNAL,DIRECT !IDENTIFY OP-SYS LET .TTY BE FUNCTION,EXTERNAL LET ICAPS BE FUNCTION,EXTERNAL !GET SES CAPAB. LET LOGLU lþú BE FUNCTION,EXTERNAL !GET TERM. LU LET LUTRU BE FUNCTION,EXTERNAL !GET TRUE LU LET FM.AB BE LABEL,EXTERNAL LET IFLG. BE INTEGER,EXTERNAL LET D. BE INTEGER,EXTERNAL LET RUNP,LIST,SVCOD,LOG,IDMY BE INTEGER LET IPBUF,X(3),FSECU(6) BE INTEGER !NAMR BUFFER LET GASP(3),ACCTS(3) BE INTEGER INITIALIZE GASP TO "GASP " INITIALIZE IPBUF,X,FSECU TO "WELCOM",3,0,-2 INITIALIZE ACCTS TO "ACCTS " LET RT BE CONSTANT(51124K) LET RNULL BE CONSTANT(51000K) LET A BE CONSTANT(0 ) LET B BE CONSTANT(1 ) LET READI BE CONSTANT(1 ) LET TAT BE CONSTANT(1656K) LET TATLG BE CONSTANT(1755K) LET TATSD BE CONSTANT(1756K) LET SECT3 BE CONSTANT(1760K) LET XEQT BE CONSTANT(1717K) LET WRIT BE CONSTANT(2 ) LET KEYWD BE CONSTANT(1657K) LET RTCOM BE CONSTANT(1747K) LET RTDRA BE CONSTANT(1750K) LET BGDRA BE CONSTANT(1754K) LET BPA1 BE CONSTANT(1742K) LET XPRIO BE CONSTANT(1726K) LET DSCUN BE CONSTANT(1764K) LET SYSTY BE CONSTANT(1 ) LET EQTA BE CONSTANT(1650K) ASSEMBLE ["EXT $CL1";"EXT $CL2";"EXT $OTAT";"EXT $OPRI"] ASSEMBLE ["EXT $CES";"EXT IXPUT"] ADCES:ASSEMBLE ["DEF $CES"] IN.IT:SUBROUTINE GLOBAL CALL RMPAR(RUNP) !GET THE PARAMETERS P4_[P3_[P2_[T1,T_@TMP.]+1]+1]+1 ASSEMBLE ["LDA $OTAT";"STA OTAT";"LDA $OPRI";"STA OPRI"] ASSEMBLE ["LDA $CL1";"STA CL1";"LDA $CL2";"STA CL2"] IF IFLG. THEN GO TO INITL !MID LOOP JUMP ! ! IF FILE NAME AS PRAM THEN FETCH $aþúIT IN ! IF RUNP > 20000K THEN[ \ONLY IT IS THERE CALL EXEC(14,1,BUF.,-128); \READ THE STRING ILOG _ .B.; \GET THE TLOG IS _ 1; \SET CHAR START REPEAT 3 TIMES DO[ \WE WANT THE THIRD ITEM CALL NAMR(IPBUF,BUF.,ILOG,IS)]],\NAMR NOW IN IPBUF ELSE \IF NOT A NAME IPBUF _ RUNP !OTHER WISE SET LU IN IPBUF ! ! SET UP THE SEVERITY CODE AND ERROR WORD ! $@.E.R.,$@.R.E._0 $(@.E.R.+1),$(@.R.E.+1)_[IF SVCOD > 4 THEN 4, ELSE SVCOD] CAM.O_401K !SET OUT PUT LU FOR ERRORS $(T1+8)_0 INITL:PKDR_@PK.DR ! ! IS THE DIRECTORY TRACK ASSIGNED TO D.RTR? ! Y_$KEYWD !SET UP TO SEARCH THE ID SEGS NEXT: D.RTR_$Y !SET CURRENT ADDRESS IF $(D.RTR+12)=D. THEN[\ !CHECK FOR D.RTR IF $(D.RTR+13)=RT THEN[\ IF($(D.RTR+14) AND 177400K)=RNULL\ THEN GO TO FOUND ]] IF $[Y_Y+1] THEN GO TO NEXT ! CHECK FOR NEXT ID SEG IF $TATLG= -1 THEN IPUT(TATLG,OTAT) MSS.(2008) ! D.RTR NOT FOUND GIVE UP GO TO EXITA !TERMINATE ! FOUND:IF $($TAT+$TATSD-1)=D.RTR\ !TRACK ASSIGNED TO D.RTR?? THEN GO TO PLIST !YES GO TO PLIST PN3_[PN2_[PN1_$1717K+12]+1]+1 IF $PN1 = "FM" THEN [ \ENTER INITIALIZATION IF $PN2 = "GR" THEN [ \LOOP ONLY IF CURRENT IF ($PN3 AND 177400K) OR 40K = " " THEN \PGM IS "FMGR" GO TO FIRST]] ! GO TO PLIST ! ! FIRST ENTRY AFTER DISC LOAD SO ASSIGN ALL TRACKS TO ME ! FIRST: T_$TAT-[IF $TATLG= -1 THEN $@OTAT,ELSE $TATLG]-1 ! FOR ADD_$TAT TO T DO[IFNOT $ADD THEN\ ASSIGN IPUT(ADD,$XEQT)] !ALL UNASSIGNED TRACKS IPUT($TAT+CL1,$XEQT) !ASSIGN TRACK W/ CL TO ME ! ALL TRACKS ASSIGNED SOù7þú IF TATLG IS -1 ! RESET IT ! IF $TATLG= -1 THEN IPUT(TATLG,OTAT) IFNOT $$XPRIO THEN CALL IPUT($XPRIO,OPRI) !RESET PRIORITY ! ! READ THE DISC DIRECTORY ! D.RIO(READI) OPEN.(CAM.I,SYSTY,0.0,410K) !OPEN TO SYSTY CALL KEYSM !FORM THE KEY SUM CD4_[CD3_[CD2_[CD1_[CD0_@D.SDR]+1]+1]+1]+1 MS003_[MSCOD_[GENWD_[CD252_CD4+248]+1]+1]+1 IF IFLG. THEN GO TO INCH !IF MID OPERATION GO CHECK ! ! WAS A SYSTEM SET UP ON THIS DISC? ! IF KSUM=$GENWD THEN [ \INITIALIZED, GO SET UP CALL TATUP;GO TO RLTRK] !TRACK ASSIGNMENT TABLE ! ! CALL SETCL !SET UP THE CARTRIDGE DIRECTORY IF O.BUF THEN [ \IF FILES WERE SAVED, THEN CLOPN_1; \OPEN FLAGS TO BE CLEARED CALL TATUP; \UPDATE TRACK ASSIGNMENT TABLE GO TO RLTRK] !AND CONTINUE (NO LU2 INITIALIZE) ! ! FIRST ENTRY, NO FILES SAVED ! SET INITIALIZATION FLAGS ETC. ! INIT0:IFLG._2 !SET UP FOR LU 2 ! ! INIT1:GO TO INI1. ! GO TO MAIN TO CONTINUE ! INCH: IF IFLG.=2 THEN[IF $TATLG+$TATSD THEN SETM3] ! ! INITIALIZED - SET UP THE DISC DIRECTORY ! CALL TATUP !SET UP TRACK ASSIGNMENT TABLE D.RIO(READI) !READ THE DISC DIRECTORY $GENWD_KSUM !SET THE KEYSUM IF M3FLG THEN \IF SENT 003 MESSAGE $MS003_$MS003 OR 100000K !SET FLAG IN CARTRIDGE DIREC. D.RIO(WRIT) !WRITE IT OUT AGAIN ! ! ! TAT IS SET UP - ASSIGN CL TRACK TO D.RTR AND RELEASE ! ALL UNUSED TRACKS ! RLTRK:IPUT($TAT+CL1,D.RTR) !ASSIGN TRACK W/ CL TO D.RTR CALL EXEC(5,-1) !RELEASE UNUSED TRACKS IF CLOPN THEN CALL OPFLG !CLEAR OPEN FLAGS IF 1ST TIME CALL EXEC(100027K,GASP,-1) !SCHEDULE GASP GO TO GOGO GOGO: CALL EXEC(1000ìbþú27K,ACCTS,-1) !SESSION MONITOR INITIALIZE GO TO GOGO1 GOGO1:RUNP,IPBUF _ "WE" !SET UP PRAMS FOR AUTO ON IFLG.,LIST,SVCOD,LOG_0 !IFLG. HAS DONE ITS JOB ! ! PLIST: D.RIO(READI) !READ IN CARTRIDGE DIRECTORY CES_$(@D.SDR+254) !MASTER SECURITY CODE (MASKED) ASSEMBLE ["JSB IXPUT"; \SAVE IN $CES "DEF *+3"; \ "DEF ADCES"; \ADDRESS OF $CES "DEF CES"] !MASKED SECURITY CODE IFNOT RUNP THEN IPBUF,RUNP _ LOGLU(IDMY) !DEFAULT INPUT DEVICE. S.TTY,S.CAP_0 !780411 BL IF RUNP < 0 THEN [ \CHECK IF SCHEDULED TMP._6; \FROM BEM. CAM.O _ SYSTY; GO TO GT.JB] G01._@G0..+1 IF RUNP > 20000K THEN [ \FILE NAME GIVEN. G0.._1;$G01._LOGLU(IDMY)], \SET 0G (INPUT DEVICE) ELSE[ \IF NOT A FILE G0.._1;$G01._RUNP] !SET 0G (INPUT DEVICE) IF LOG THEN [ \IF LOG DEVICE SPECIFIED, IFNOT .TTY(LOG) THEN \IF INVALID OR NOT TTY, LOG_LOGLU(IDMY)] !THEN USE LOGLU IFNOT [CAM.O _ LOG ] THEN \SET LOG DEVICE (DEFAULT= CAM.O _ [IF [TTY. _ .TTY($G01.)] \INPUT DEV OR 1 IF NON-IA) THEN $G01., ELSE LOGLU(IDMY)] IF [S.CAP _ ICAPS()] THEN \9P=CAPAB. (0 IF NON-SESSION) S.TTY_LUTRU(1), \8P=TRUE TERMINAL LU ELSE S.TTY_LOGLU(IDMY) ! TMP. _ LIST !SET THE LIST DEVICE IFNOT TMP. THEN TMP. _ LOGLU(IDMY) !LIST DEVICE (DEFAULT=LOGLU) IF RUNP > 20000K THEN[ \IF SCHEDULED W/ XFER FILE, OPEN.(CAM.I,$G01.,0.0,401K); \STACK INPUT LÞ|þúU FIRST IFNOT IPBUF THEN GO TO PL1] !IF NAMR STRING FAILED SKIP OPEN.(CAM.I,IPBUF,FSECU,401K) !OPEN INPUT DEVICE. IF $@.E.R. < 0 THEN \IF OPEN ERROR, CALL OPEN.(CAM.I,CAM.O,0.0,410K) !OPEN INPUT TO LOG DEVICE ! PL1: CALL EXEC(14,1,C.BUF,40) !IF FILE CHECK FOR PASSED ECH._.B. !STRING IF ECH. THEN [ \IF A STRING AND IF (C.BUF AND 177400K)=35000K THEN[ \IT STARTS WITH A ':' C.BUF_C.BUF+[NO.RD_-15000K]]] !CLEAR THE ':' FOR GO TO FM.AB ! EXITA: CALL EXEC(5,-1) !ERROR EXIT COULD NOT INITIALIZE CALL EXEC(6) !JUST DIE QUICKLY. ! END ! TATPU:SUBROUTINE(ID) IF $ADD#ID THEN[IF $ADD#$XEQT THEN MSS.(1005,ADD-$TAT)\ , ELSE IPUT(ADD,ID)] ADD_ADD+1 !SEND ERROR MESSAGE RETURN END ! SETM3:SUBROUTINE D.RIO(READI) !READ DISC DIRECTORY IFNOT $MS003<0 THEN [ \IF 003 MSG NEVER GIVEN IFNOT M3FLG THEN [ \MS003 MIGHT NOT BE UPDATED M3FLG_1; \SET MSG 003 FLAG IFLG._3; \SET UP FOR LU 3 GO TO INIT1]] !SEND MESSAGE RETURN END ! SETCL:SUBROUTINE ! ! SET UP THE INITIAL CARTRIDGE DIRECTORY ! CALL EXEC(1,2,O.BUF,128,$TATSD-1,0) !READ LAST TRK, 1ST 128 WDS. IFNOT FD.CK(2) THEN [ \IF FILE SYSTEM EXISTS, THEN $CD0_2; \WRITE LU=2 $CD1_$TATSD-1; \LAST TRK $CD2_$(@O.BUF+3); \GET CRN FROM SPECIFICATION ENTRY $CD3_7777K; \SESSION ID = SYSTEM FOR ADD_CD4 TO CD252 DO \ZERO THE REMAINING ENTRIES [$ADD_0]; \IN THE CARTRIDGE DIRECTORY BUFFER $GENWD_KSUM; ‚>þú \WRITE INITIALIZATION SUMMING WORD $MSCOD,$MS003_0], \ZERO MASTER SECURITY CODE, MSG 3 WDS. ELSE \ [IF O.BUF THEN[ \IF OLD CL IN LAST TRACK, THEN $CD0_$(@O.BUF); \SAVE ENTRY FOR LU 2 IN WRITE BUFFER $CD1_$(@O.BUF+1); \LAST TRACK $CD2_$(@O.BUF+2); \CRN $CD3_7777K; \SESSION ID = SYSTEM FOR ADD_CD4 TO CD252 DO \ZERO REMAINING ENTRIES IN THE [$ADD_0]; \CARTRIDGE DIRECTORY BUFFER $GENWD_KSUM; \WRITE INITIALIZATION SUMMING WORD $MSCOD_$(@O.BUF+126); \COPY MSC FROM OLD CL IF $MSCOD THEN \IF MASTER SECURITY CODE EXISTS, $MSCOD_($MSCOD-1) XOR 31178; \MASK AND SAVE IN NEW CL $MS003_0; \ZERO THE MSG 003 FLAG T_@O.BUF; \PTR TO OLD CL T2_@BUF.; \PTR TO OLD SPECIFICATION ENTRY CALL EXEC(1,2,BUF.,128,$TATSD-1,14); \READ SPECIFICATION ENT. FOR ADD_T TO T+15 DO \MOVE CARTRIDGE SPECIFICATION ENTRY [$ADD_$T2;T2_T2+1]; \TO LAST TRACK, FIRST 16 WORDS FOR ADD_T+16 TO T+112 BY 16 DO \WRITE -1 OVER REST OF OLD CL [$ADD_ -1]; \ $@BUF. _ -1; \WRITE -1 OVER OLD SPECIFICATION CALL EXEC(2,2,O.BUF,128,$TATSD-1,0); \REWRITE LAST TRACK CALL EXEC(2,2,BUF.,128,$TATSD-1,14)], \WRITE OVER SP.ENTRY ELSE \ [$CD0,$CD2_2; \SET UP FOR INITIALIZE TO FOLLOW $CD1_$TATSD-1; \LAST TRACK $CD3_7777K; \SESSION ID = SYSTEM FOR ADD_CD4 TO MS003 DO \ZERO THE REMAINDER OF THE [$ADD_0]]] !CARTRIDGE DIRECTORY BUFFER CALL EXEC(2,2,D.SDR,256,CL1,CL2) !WRITE CL BUFFER TOAåþú CL TRACK DS.DF_0 !CLEAR CL IN-CORE FLAG RETURN END ! OPFLG:SUBROUTINE ! ! CLEARS OPEN FLAGS ON LU 2 ! USED AFTER FIRST SWTCH TO INSURE REMOVAL OF OLD FORMAT OPEN ! FLAGS FROM THE OLD SYSTEM ! PDIR_@PK.DR BL_0;START_25 LOCK.(-2,3,LKER) !LOCK LU 2 SIFLG_IFLG.;IFLG._0 !CLEAR IFLG. FOR DR.RD WRITE AGAIN:DR.RD(1,-2,BL)?[GO TO UNLCK] !READ NEXT DIRECTORY BLOCK FOR X1_START TO 121 BY 16 DO \FOR EACH DIR ENTRY IN THE BLOCK [FOR X2_0 TO 6 DO $(PDIR+X1+X2)_0] !ZERO LAST 7 WDS (OP FLGS) DR.RD(2,-2,BL)?[GO TO UNLCK] !WRITE THE DIRECTORY BLOCK BL_BL+1;START_9 !BUMP TO NEXT BLOCK NUMBER GO TO AGAIN !READ NEXT DIRECTORY BLOCK UNLCK:IFLG._SIFLG !RESTORE STATE OF IFLG. LOCK.(-2,5) !UNLOCK LU 2 CLOPN_0 !CLEAR "CLEAR OPEN FLAGS" FLAG RETURN END ! TATUP:SUBROUTINE ! ! SET UP THE TRACK ASSIGNMENT TABLE ! ! ! SET UP THE TAT USING THE DISC DIRECTORIES TO ! FIND WHICH TRACKS ARE TO BE ASSIGNED ! DO[LU_-2;I_0]!LU2 FIRST TATU1:IF FID.(LU)THEN [IF LU= -2 THEN GO TO INIT0,ELSE RETURN] IF $SECT3 THEN SETM3 !IF LU3, SEND 003 MESSAGE ADD_[T_$( PKDR +4)]+$TAT+I !SET TAT ADDRESS REPEAT $( PKDR +7)-T TIMES DO \SET TAT TATPU(77776K) !FMP TRACKS REPEAT -$( PKDR +8) TIMES DO \SET TAT TATPU( D.RTR) !DIRECTORY TRACKS ! IF LU= -2 THEN [LU_-3;I_$TATSD;GOTO TATU1] RETURN END ! KEYSM:SUBROUTINE ! ! FORM THE KEY SUM ! ! ! NOTE:RTE-IV KEY SUM=(1650B TO 1657B)+(1742B TO 1747B)+(1755B TO 1764B) ! :RTE-II & III KEY SUM= ABOVE LOCATIONS + (1750B TO 1754B) ! ! KSUM_0 FOR ADD_EQTA TO KEYWD DO[KSUM_KSUM+$ADD] FOR ADD_Ð]<:6BPA1 TO RTCOM DO[KSUM_KSUM+$ADD] !780106 GLM FOR ADD_TATLG TO DSCUN DO[KSUM_KSUM+$ADD] !780106 GLM ! !780106 GLM ! !780106 GLM ! !780106 GLM ! THE FOLLOWING WORK IS REQUIRED TO SUPPORT !780106 GLM ! RTE-II & III. !780106 GLM ! !780106 GLM IF .OPSY # -9 THEN [\ FOR ADD_RTDRA TO BGDRA DO[KSUM_KSUM+$ADD]] !781006 GLM ! RETURN END END END$ ê,<ÿÿ ÿýŸ ÿ92067-18217 2040 S C0122 &IN..              H0101 j7þúSPL,L,O,M ! NAME: IN.. ! SOURCE: 92067-18217 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME IN..(8) "92067-16185 REV.2040 800731" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 771229 TO CORRECTLY INITIALIZE LU3 THE FIRST TIME (GLM) ! 2) 780413 TO CORRECTLY RELEASE LOCK ON ABORT OF INIT. (GLM) ! 3) 780512 TO USE 256-WORD CARTRIDGE DIRECTORY (BL) ! 4) 780516 TO HANDLE LOCK. ERROR RETURN PARAMETER (BL) ! 5) 780630 TO GET SECTORS/TRACK VALUE FROM DRIVER (BL) ! 6) 790103 TO CORRECTLY HANDLE ?? RESPONSE TO FMGR 060 (BL) ! 7) 790113 TO MASK OFF LOCK IN LU WORD FROM DS.LU ! 8) 790122 TO SAVE MASKED MASTER SECURITY CODE IN $CES ! 9) 790403 TO CHECK FOR TYPE 6 FILES REFERENCED BY ID SEGS. ! 10) 790802 TO SAVE MASKED MASTER SECURITY CODE ON DISC ! 11) 800731 TO TREAT NEW NUMERIC MASTER SECURITY CODES ! AS NUMERIC, NOT ASCII (SST #4904) ! ! ! IN.. IS THE RTE FILE MANAGER ACTION ROUTINE ! FOR THE IN DIRECTIVE. ! ! THE IN DIRECTIVE HAS THE FORM: ! ! IN,MSC,CR,LABEL,ILAB,#FT,#DTR,#SEC/TR,BTL !PARAMETER 1 5 9 13 17 21 25 29 ! ! OR ! ! IN,MSC--NMSC ! ! W H E R E: ! ! MSC IS THE TWO CHARACTER MASTER SECURITY CODE ! ! CR IS EITHER THE CARTRIDGE LABEL(+) OR ITS ! LOGICAL UNIT(-) (MUST BE NUMERIC) ! ! LABEL NEW CARTRIDGE LABEL (NUMERIC > 0, OR 2 ASCII CHARS) ! ! ILAB IS THE CARTRIDGE INFORMATION LABEL (MUST BEÌ×þú ASCII). ! ! #FT IS THE FIRST FMP TRACK. ! ! #DTR IS THE NUMBER OF DIRECTORY TRACK ! (NULL (SET TO 1) OR NUMERIC) ! ! #SEC/TR IS THE NUMBER OF 64 WORD SECTORS ! PER TRACK (NUMERIC (MAY BE NULL )). ! ! BTL IS A BAD TRACK LIST - UP TO 6 BAD TRACK NUMBERS. ! ! NMSC IS A NEW MASTER SECURITY CODE. ! ! THE MASTER SECURITY CODE IS SET WHEN LU2 IS FIRST ! INITIALIZED AND MUST MATCH THEREAFTER. ! LET .PARS, \FMGR PARSE ROUTINE D.RIO, \FM.UT ROUTINE TO READ CL DR.RD, \FM.UT ROUTINE TO READ DIRECTORY EXEC, \RTE EXEC FM.ER, \FMGR MESSAGE OUTPUT ROUTINE IPUT, \ROUTINE TO WRITE WORD IN MEMORY ISMVE, \ROUTINE TO MOVE WORDS FROM SCB J.PUT, \ LOCK., \ROUTINE TO LOCK DISC CARTRIDGE MSS., \FMGR ERROR MESSAGE ROUTINE NAM.., \ROUTINE TO VALIDATE FILE NAME PARSE, \ASCII PARSE SUBROUTINE READC, \ READF, \FMP FILE READ ROUTINE SESSN, \ROUTINE TO DECIDE IF IN SESSION WRITF \FMP FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! ASSEMBLE ["EXT $CES";"EXT IXPUT"] ADCES:ASSEMBLE ["DEF $CES"] LET PK.DR,D.SDR,IFLG.,D.LT,D.LB,C.BUF, \ DS.DF, \ D.,DS.LU,.E.R.,ECH. BE INTEGER,EXTERNAL LET CAM.O,NO.RD BE INTEGER,EXTERNAL LET PNAM(3),IRBUF(33) BE INTEGER LET PDIRS BE SUBROUTINE LET TRAK. BE SUBROUTINE LET PTST,GT BE SUBROUTINE LET BADTR BE SUBROUTINE LET FID. BE FUNCTION,EXTERNAL LET MSC. BE }þþúFUNCTION,EXTERNAL ! ! CONSTANTS ! LET YE BE CONSTANT(54505K) LET NO BE CONSTANT(47117K) LET A BE CONSTANT(0 ) LET B BE CONSTANT(1 ) LET WRIT BE CONSTANT(2 ) LET READI BE CONSTANT(1 ) LET XEQT BE CONSTANT(1717K) LET SECT2 BE CONSTANT(1757K ) LET SECT3 BE CONSTANT(1760K ) LET TAT BE CONSTANT(1656K ) LET KEYWD BE CONSTANT(1657K ) LET TATLG BE CONSTANT(1755K ) LET TATSD BE CONSTANT(1756K ) LET DMSIN BE CONSTANT(26455K) IN..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL LET NCAM,PLIST,MSNO BE INTEGER ASSEMBLE ["EXT $SMID";"LDA $SMID";"STA SMID"] CLPTR_[DDIR_@D.SDR]+2 PDIR2_[PDIR1_[PDIR_@PK.DR]+1]+1 PDIR9_[PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR4_[PDIR3_\ PDIR2+1]+1]+1]+1]+1]+1]+1 LIS29_[LIS21_[LIS17_[LIS13_[LIST9_[LIST5_@PLIST+5]+4]+4]+4]+4]+8 MSNO_0 !INITIALIZE FOR NO ERRORS ! ! FIX FOR OLD NUMERIC MASTER SECURITY CODE ! T_@PLIST+1 CALL PARSE($T,2,IRBUF) $T_$(@IRBUF+1) ! ! TEST FOR LEGAL PARAMETERS ! IF NCAM#1 THEN GOTO IN2 !IF ONE PARAMETER, THEN IF IFLG. THEN GOTO NOPRM !IF EXPECTING REPLY TO 002 OR 003 ! THEN ERROR 50 ! ! MSC CHANGE? ! IFNOT MSC.(PLIST) THEN GOTO SCER !INCORRECT SECURITY CODE? ! NOTE: MSC. DOES THE D.RIO READ ! IF $(@PLIST+2)#DMSIN THEN GOTO NOPRM !IF NOT "--", ERROR 50 ! ! FIX FOR NEW NUMERIC MASTER SECURITY CODE ! T_@PLIST+3 !ADDR OF NEW MSC CALL PARSE($T,2,IRBUF) !PARSE NEW MSC $T_$(@IRBUF+1) !PROPERLY PARSED MSC MSCD_[IF $T = 0 THEN 0, ELSE $T] !IF NULL OR 0, USE 0 $(DDIR+254),CES_[IFNOT MSCD THEN 0, \SET $CES TO 0 IF MSC=0, ELSE ELSE (MSCD-1) XOR 311åiþú78] !MASK MASTER SECURITY CODE D.RIO(WRIT) !WRITE NEW MSC, OR 0 TO REMOVE EXISTING ASSEMBLE ["JSB IXPUT"; \SAVE SECURITY CODE IN $CES "DEF *+3"; \ "DEF ADCES"; \ "DEF CES"] RETURN !RETURN ! LABER:DO[MSNO_53;RETURN] ! NOPRM:DO[MSNO_50;RETURN] !NOT ENOUGH PRAMS - EXIT ! IN2: IFNOT IFLG. THEN GOTO IN5!NOT INITIALIZING -JMP IF IFLG.=2 THEN[\ IF PLIST THEN[IF PLIST#3 THEN GOTO SCER] ;\1ST PARM NON-ASCII? DS.DF_@PLIST+1; \SET THE MASTER SECURITY CODE $(DDIR+254)_[IFNOT $DS.DF THEN 0, \0 IF NONE, ELSE ELSE ($DS.DF-1) XOR 31178]] !MASK IT ! ! IF IFLG.# -$(LIST5 )THEN[MSNO_52;RETURN] !DOES LU MATCH IFLG.? IF IFLG.=3 THEN[IFNOT$LIST9 THEN RETURN] !NO LU 3 RETURN IN5: IFNOT MSC.(PLIST)THEN GO TO SCER !CHECK SECURITY CODE ! ! CHECK LABEL PARAMETERS (CRN AND INFORMATION LABEL) ! ! IN6: IFNOT -$LIST9<0 THEN GO TO LABER !CRN MUST BE > 0 CALL SESSN($XEQT)?[GO TO IN6A] !IF IN SESSION, THEN SESWD _ .B. !GET SCB ADDRESS CALL ISMVE(SESWD,SMID,CODE,1) !GET USER ID FROM SCB IF CODE # 7777K THEN GO TO IN6A !SKIP TEST IF NOT SYS MGR WHILE ($(CLPTR-2)#0) DO \SEARCH TO END OF CL [IF $CLPTR=$LIST9 THEN \IF FIND CRN MATCH AND [IDCOD_$(CLPTR+1) AND 7777K; \GET DISC ID FROM CL IF (IDCOD # 7777K) AND (IDCOD # 1) THEN \IF NOT SYS, THEN [MSNO_12;RETURN]]; \RETURN DUPLICATE CRN CLPTR_CLPTR+4] !ELSE TRY NEXT CL ENTRY ! IN6A: IF $(@PLIST+12)#3 THEN GO TO LABER !IF LABEL NON-ASCII,ERROR 53 NAM..($(LIS13 )) !NAME CHECKING ROUTINE DO[AREG_$A; IF AREG THEN GO TO LABER] ! ! SET UP TO TEST THE REST OF THE PRAMS. ! FOR T_4 TO 13 DO[PTST($(@PLIST+T*4))] !CHECK FOR ASCII OR NEGATIVE ! IFNOT$[(¥þúT_(LIS21 )]THEN $T_1 !DEFAULT #DIR TRACKS TO 1 IFNOT IFLG. THEN GOTO IN7 !IF NOT INIT SKIP IF IFLG.=2 THEN [FOR T_2 TO 252 DO $(DDIR+T)_0;\ $DDIR_2;$(DDIR+3)_7777K],ELSE \SET LU, LAST TRK AND ID [$(DDIR+4)_3;$(DDIR+7)_7777K] !IN DISC DIRECTORY LTR_[IF IFLG.=2 THEN [$(DDIR+1)_$TATSD-1],\ ELSE[$(DDIR+5)_ -$TATSD -$TATLG-1]] D.RIO(WRIT) !WRITE CARTRIDGE DIRECTORY ! IN7: DR.RD(READI,$LIST5 ,0)? \ [IF .A. THEN MSNO_54, ELSE MSNO_43;RETURN] ! LUNBR_$$@DS.LU AND 377K !GET LU, MASKING OFF LOCK FLAG T_@PLIST+25 !SET TO SEC/TRK PARAMETER ADDR IF LUNBR=2 THEN $T_$SECT2, \IF LU 2, USE SECT2 FOR SEC/TRK ELSE [IF LUNBR=3 THEN \IF LU 3, USE SECT3 FOR SEC/TRK $T_$SECT3, ELSE \ [CALL EXEC(1,LUNBR,SECTK,1,-1,0); \GET SEC/TRK IF $T > SECTK THEN \IF LARGER THAN ACTUAL SEC/TRK [MSNO_70;RETURN],\RETURN ERROR, ELSE DEFAULT TO ELSE [IFNOT $T THEN $T_SECTK]]] !SEC/TRK FROM DRIVER ! LTR_$$@D.LT !GET LAST TRACK NEW,TN_LTR-[FTR_$LIS17]+1 !SET FIRST TRACK,TOTAL NO. TRACKS IF TN<[ND_$LIS21 ]THEN GOTO BADPM ! IF ND>((TN-ND)>-3)+1 THEN GO TO BADPM !DISALLOW UNREASONABLE ! NUMBER OF DIRECTORY TRACKS IF LUNBR=2 THEN[IF FTR<($1761K>-7)+8 THEN GO TO BADPM] ! MUST ! LEAVE SOME TRACKS FOR THE SYSTEM ! ! CHECK THE BAD TRACKS AND ARRANGE IN ASCENDING ORDER ! LIS49_[T1_LIS29]+20 FOR T_LIS29 TO LIS49 BY 4 DO[\ IF $T THEN[$T1_$T;T1_T1+1]] FOR T_T1 TO LIS29+6 DO[$T_0] ! ZERO THE END OF THE LIST IN10: SWP,LAST_0 !INITIALIZE THE SORT FOR T_LIS29 TO T1-1 DO[\ SWAP LOOP IF $T LTR-ND THEN GO TO BTER IN13: T3_$$@DS.LU AND 377K !SET LU, MASKING OFF LOCK FLAG DLB_D.LB !SET THE LABEL ADDRESS IF IFLG.=2 THEN GOTO IN20 ! IF $LIST9=$DLB THEN GO TO IN12!IS SAME LABEL SKIP DR.RD(READI,$LIST9,0)? \ [IF .A. THEN [DR.RD(READI,$LIST5,0);GO TO IN12]] MSNO_12 !DUPLICATE LABEL ERROR ! ! (GLM) -FIX FOR INITIALIZE LU3 PROBLEM ! ! IF INIT ON 3 WE MUST CLEAR THE LU3 FLAG (SET BY IN.IT) ! SO WE WILL MAINTAIN THE FMGR 003 ERROR UNTIL A GOOD IN CMND ! COMES IN. ! IF IFLG.=3 THEN[D.RIO(READI) ;TZ_@D.SDR+255;\ CLEAR THE LU3 $TZ_ ($TZ AND 77777K);D.RIO(WRIT)]! PROMPT FLAG ! RETURN IN12: IF IFLG.=3 THEN GOTO IN20 ! FILES NOT SAVED ON LU3 IF [TX,NEW_FID. ($(LIST5 ))] THEN[ \IF NO VALID FILE SYS, THEN IFNOT IFLG. THEN[ \IF NOT FIRST CALL LOCK_($$@DS.LU -> 8) AND 377K; \IF NOT LOCKED AND NOT LOCKABLE KPTR_LOCK+$KEYWD-1; \OFFSET IN KEYWD BLOCK IFNOT LOCK THEN [MSNO_61;RETURN], ELSE \ [IF $KPTR # $XEQT THEN \ [MSNO_61;RETURN]] \RETURN ERROR (DISMOUNTED WITH ]; \OUT TELLING US) NO-NO GO TO IN20 \ELSE WE ARE OK ] ! LOCK.($LIST5,3,LKER)?[MSS.(LKER);RETURN] !REQUEST LOCK ! A DIRECTORY EXISTS - IS THE NEW PRAM SET ! COMPATIBLE? ENDBL_ -$PDIR8*$PDIR6/2+[IF T3 =2 THEN -1 ,ELSE 0] ! IF FTR>$(PDIR4 ) THEN GOTO IN35 !IF RAISING FIRST TRACK OR IF $(PDIR9 )>(LTR-ND+1)THEN GOTO IN35 !LOWERING DIR INTO A FILE IF ND+$PDIR8 <0 THEN GO TO IN35 !IF FEWER DIRECTORY TRACKS ASK IF $PDIR6 # $(@PLIST+25) THEN GO TO IN35 !IF SECóþú/TRK MISMATCH ! IN20: IF T3 =2 THEN GT($TAT) !IF LU TWO OR THREE IF T3=3 THEN GT($TAT+$TATSD)!GO SET THE TAT ! FULL SPEED AHEAD! $PDIR_$(LIS13 )+100000K $(PDIR1 )_$(@PLIST+14) $(PDIR2 )_$(@PLIST+15) $(PDIR3 )_$LIST9 $(PDIR4 )_FTR IF NEW THEN [$(PDIR5 )_0;$(PDIR9 )_FTR] $(PDIR6 )_$(@PLIST+25) !SET SECTORS/TRACK VALUE $(PDIR7 )_LTR-ND+1 $(PDIR8 )_-ND FOR T_10 TO 15 DO $(PDIR+T)_$(@PLIST+T+19) !SET BAD TRACKS IF NEW THEN[FOR T_16 TO 127 DO $(PDIR+T)_0] BL_0 ! ! NOW WRITE IT OUT IN22: DR.RD(WRIT,$LIST5 ,BL)?[GO TO IN25] ! FOR T_0 TO 127 DO $(PDIR+T)_0 IFNOT NEW THEN [BL,NEW_ENDBL;GOTO IN22]!SET TO ZERO ADDED DIRECTORY DO[BL_BL+1;GO TO IN22]!ZERO THE NEXT BLOCK ! IN25: $DLB_$LIST9 !SET THE DIRECTORY LABEL WORD IN30: D.RIO(WRIT);IFNOT IFLG. THEN LOCK.($LIST5,5) !RELEASE LOCK*780413* EXEC(5,-1) !RETURN ANY LEFT OVER TRACKS RETURN !WE DID IT - EXIT ! IN35: IFNOT IFLG. THEN \IF NOT 1ST CALL AND [IF LUNBR<4 THEN \IF LU 2 OR 3, THEN TRAK.(LUNBR)?[GO TO IN30]]!CHECK TYPE 6 FILE REFERENCES ! IN15: MSS.(60);EXEC(2,CAM.O,35137K,1) ;\ SEND COLON PROMPT EXEC(1,CAM.O OR 400K,C.BUF,36);ECH._$1 IF ECH.<1 THEN GOTO IN15 IF C.BUF=YE THEN[NEW_1; GO TO IN20], ELSE [ \ IF C.BUF=NO THEN [IF IFLG. THEN GOTO MSPRM,\ ELSE GOTO IN30],ELSE[IF C.BUF="??" THEN[\ NO.RD_-1;LOCK.($LIST5,5);\ RETURN],ELSE \ GO TO IN15]] ! BADPM:DO[MSNO_56;RETURN] ! MSPRM:DO[MSNO_55;RETURN] ! BTER: DO[MSNO_57;RETURN] SCER: MSNO_51 RETURN END PTST: SUBROUTINE(PTR) !CHECK FOR BAD PARMS (ASCII/NEG) ! IF PTR=3 THEN GOTO BADPM !MUZUþúST NOT BE ASCII ! ! IF $(@PTR+1)<0 THEN GOTO BADPM !IF <0 - BAD NEWS ! RETURN !OK !RETURN END ! TRAK.:SUBROUTINE(LOGUN) FEXIT ! ! TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE FMP TRACKS. ! IF ANY ARE FOUND, THE PROGRAM NAME IS PRINTED AND FEXIT IS TAKEN. ! LU3_LOGUN AND 1 !SET LU 3 FLAG NFLG_0 !FOUND FLAG NTR_($PDIR4 -< 7) !NEXT TRACK KPTR_$KEYWD !POINTER TO KEYWORD BLOCK NEXT: DMAN_[NAM3_[NAM2_[NAM1_$KPTR+12]+1]+1]+12 !PTRS TO ID SEGMENT IF $NAM3 AND 20K THEN DMAN_NAM3+5 !ADJUST FOR SHORT ID SEGS. IF [K2_$NAM3 AND 7]=1 THEN GO TO OK !NO CHECK NEEDED FOR TYPE1 IF (($DMAN -< 1) AND 1)#LU3 THEN GO TO OK !COMPARE DISC LU IF ($DMAN AND 77600K) < NTR THEN GO TO OK ! IFNOT NFLG THEN MSS.(11) !SEND FMGR 011 IF 1ST ONE NFLG_1 $@PNAM_$NAM1 !1ST WORD OF NAME $([PN_@PNAM+1]+1)_($NAM3 AND 77400K)+40K !3RD NAME WD, PADDED $PN_$NAM2 !2ND WORD OF NAME FM.ER(2,PNAM,3) !WRITE PROGRAM NAME OK: KPTR_KPTR+1 !BUMP KEYWD POINTER IF $KPTR THEN GO TO NEXT !CONTINUE IF NOT END IF NFLG THEN FRETURN !FEXIT IF ANY FOUND RETURN END ! GT: SUBROUTINE(TRLOC) ! SUBROUTINE TO CHECK ON TRACK ASSIGNMENTS FOR ! CHANGES TO THE SYSTEM OR AUX DISC FILE AREAS ! IF IFLG. THEN RETURN ! IF INIT THE LET MAIN DO IT IF TX THEN GO TO TRASN ! NEW SO GO GET ALL THE TRACKS IF FTR<[T_$(PDIR4 )] THEN GO TO TRASN ! IF LARGER AREA GET TR ! ! RETURN THE LEFT OVER TRACKS FOR ADD_T TO FTR-1 DO[T1_ADD+TRLOC;\ IF $T1=77776K THEN IPUT(T1,$XEQT)] EXEC(5,-1) !RETURN THE TRACKS RETURN !AND RETURN ! TRASN:T1_FTR+TRLOC Y»640!SET UP FIRST AND LAST ADDRESSES T2_[IF TX THEN LTR,ELSE T-1]+TRLOC FOR ADD_T2 TO T1 BY -1 DO[J.PUT(ADD,$XEQT,JER);\ IF JER THEN BADTR] ! FOR ADD_T1 TO T2 DO[IF $ADD=$XEQT THEN IPUT(ADD,77776K)] RETURN END BADTR:SUBROUTINE T_ADD-TRLOC !CHECK IF UNAVAILABLE TRACK IS ALSO BAD FOR X_LIS29 TO LIS49 BY 4 DO[IF $X=T THEN RETURN] MSS.(1059,T) !NOT FOUND SO BAD TRACK ERROR OR TRACK NOT AVAILABLE GO TO IN30 !GO EXIT END END END$ BÀ6ÿÿ ÿý‘ Ÿ ÿ92067-18218 1903 S C0122 &MC..              H0101 [GþúASMB,R,L,C,Q * NAME: MC.. * SOURCE: 92067-18218 * RELOC: 92067-16185 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MC..,8 92067-16185 REV.1903 790402 ENT MC.. EXT .ENTR,DCMC,LUTRU,SESSN SUP * * * MOUNT CARTRIDGE ACTION ROUTINE FOR * RTE FILE MANAGER (FMGR) * * ENTERED ON COMMAND: * * MC,LU[,P/G[,SIZE[,ID[,#DIR TRACKS[,LABEL]]]]] * * WHERE * * LU - + OR - LOGICAL UNIT NUMBER OF DISC TO BE MOUNTED * P/G - P INDICATES DISC IS TO BE MOUNTED AS PRIVATE, G AS GROUP * SIZE - # TRACKS NEEDED ON THE ALLOCATED DISC. DEFAULT WILL BE TO * FIRST AVAILABLE DISC IN DISC POOL * ID - 6-CHAR ASCII IDENTIFIER * # DIR TRACKS - # DIRECTORY TRACKS MADE NEGATIVE WHEN SENT TO DCMC * LABEL - CRN TO BE ASSIGNED TO THE DISC IN THE CASE WHERE THERE * IS NO VALID DIRECTORY ENTRY ON THE LAST TRACK * * * MC.. EXTRACTS PARAMETERS FROM PARSE LIST AND CALLS * SUBROUTINE DCMC. TO PERFORM THE MOUNT. * * N NOP LIS NOP ER NOP MC.. NOP JSB .ENTR DEF N CLA CLEAR STA P/G PARAMETERS STA SIZE TO BE STA ID PASSED TO STA ID+1 DCMC. STA ID+2 STA DIRTK STA LABEL * * + OR - LU * LDA N,I GET # OF PARAMETERS IN PARSE LIST SZA,RSS IF THERE WEREN'T ANY JMP EX50 EXIT NOT ENOUGH PARAMETERS CMA,INA MAKE NEGATIVE STA N TO USE AS A COUNTER LDB LIS LDA B,I GET LU FROM PARSE LIST (FLAG WORD) SZA,ã§þúRSS IF NOT SPECIFIED JMP EX50 EXIT NOT ENOUGH PARAMETERS CPA .3 CAN'T BE ASCII JMP EX56 IT IS, SO BAD PARAMETER EXIT INB LDA B,I GET LU SZA,RSS IF A ZERO JMP EX56 EXIT BAD PARAMETER SSA IF ALREADY POSITIVE, SKIP CMA,INA OTHERWISE MAKE LU POSITIVE STA LU AND SAVE FOR LUTRU CALL CMA,INA MAKE NEGATIVE FOR STA DISID DCMC CALL ADA .63 DISC LU PASSED IN CAN'T SSA BE 64 OR LARGER JMP EX56 IT IS, SO BAD PARAMETER EXIT STB TMP REMEMBER B = POINTER IN LIS * JSB SESSN SEE IF CALLER IS DEF *+2 UNDER SESSION CONTROL DEF XEQT SEZ IN SESSION? JMP MT.1 NO - SKIP 'IN SST' TEST * JSB LUTRU MAKE SURE THAT FOR SESSION USERS DEF *+2 THIS LU IS IN THE SST DEF LU SSA IN SESSION BUT NOT IN SST? JMP EX43 YEP - NOT IN SST ERROR MT.1 ISZ N MORE PARAMETERS RSS PASSED JMP CALL NO - GO CALL DCMC * * PRIVATE/GROUP INDICATOR * LDB TMP GET B BACK AGAIN ADB .3 LDA B,I GET PRIV/GROUP INDICATOR (FLAG WORD) CPA .1 CAN'T BE NUMBERIC JMP EX56 IT IS, SO EXIT BAD PARAMETER INB LDA B,I GET VALUE PASSED IN SZA IF DEFAULT, USE P CPA P IF PRIVATE SET TO 0 JMP PG2 CPA G IF GROUP SET TO 1 JMP PG1 JMP EX56 ELSE ERROR BAD PARAMETER PG1 ISZ P/G SET P G TO 1 PG2 ISZ N MORE PARAMETERS RSS PASSED? JMP CALL NO - GO CALL DCMC * * SIZE * ADB .3 LDA B,I GET SIZE IN TRACKS (FLAG WORD) CPA .3 CAN'T BE ASCII JMP EX56 EXIT BAD PARAMETER INB LDA B,I GET VALUE FOR SIZE IN TRACKSÃÌþú SSA CAN'T BE NEGATIVE JMP EX56 BAD PARAMETER EXIT STA SIZE ISZ N MORE PARAMETERS RSS PASSED? JMP CALL NO - GO CALL DCMC * * 6-CHAR ASCII LABEL * ADB .3 LDA B,I GET LABEL (FLAG WORD) CPA .1 CAN'T BE NUMBERIC JMP EX53 EXIT BAD PARAMETER INB LDA B,I FIRST TWO CHARACTERS OF ASCII IDENTIFIER STA ID INB LDA B,I 3RD AND 4TH CHARACTERS OF ASCII IDENTIFIER STA ID+1 INB LDA B,I 5TH AND 6TH CHARACTERS OF ASCII IDENTIFIER STA ID+2 ISZ N MORE PARAMETERS RSS PASSED? JMP CALL NO - GO CALL DCMC * * # DIRECTORY TRACKS * INB LDA B,I GET NUMBER OF DIR TRACKS (FLAG WORD CPA .3 CAN'T BE ASCII JMP EX56 EXIT BAD PARAMETER INB LDA B,I NUMBER OF DIRECTORY TRACKS SSA CAN'T BE NEGATIVE JMP EX56 EXIT BAD PARAMETER CMA,INA MAKE NEGATIVE STA DIRTK TO SEND TO DCMC ISZ N MORE PARAMETERS RSS PASSED? JMP CALL NO - GO CALL DCMC * * CRN * ADB .4 LDA B,I GET LABEL - CRN (FLAG WORD) SSA MAKE SURE A NEGATIVE VALUE ISN'T SUPPLIED JMP EX56 NEGATIVE - BAD PARAMETER ERROR STA LABEL * * CALL JSB DCMC CALL DCMC. TO MOUNT THE DISC. DEF RTN DEF ER,I DEF CODE MOUNT = 1 DEF DISID -LU DEF P/G P = 0 OR G = 1 DEF SIZE DISC SIZE IN TRACKS DEF ID 6-CHAR ASCII LABEL DEF DIRTK # DIRECTORY TRACKS DEF LABEL CRN RTN EQU * JMP EXIT * EX43 LDA .43 LU NOT IN SST RSS EX50 LDA .50 NOT ENOUGH PARAMETERS RSS EX53 LDA .53 ILLEGAL LABEL RSS EX56 LDA .56 BAD PARAMETER O STA ER,I EXIT JMP MC..,I * * B EQU 1 XEQT EQU 1717B CODE OCT 1 MOUNT CODE FOR DCMC .1 OCT 1 .3 OCT 3 .4 OCT 4 .43 DEC 43 .50 DEC 50 .53 DEC 53 .56 DEC 56 .63 DEC 63 G OCT 43440 P OCT 50040 DISID NOP P/G NOP SIZE NOP ID BSS 3 DIRTK NOP LABEL NOP LU NOP TMP NOP * END o‘ÿÿ ÿý’› ÿ92067-18219 1903 S C0122 &RC..              H0101 \LþúASMB,R,L,C,Q * NAME: RC.. * SOURCE: 92067-18219 * RELOC: 92067-16185 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RC..,8 92067-16185 REV.1903 790314 ENT RC.. EXT .ENTR,DCMC,FM.ER,CNUMD,SESSN,NAM.. SUP * * * REMOVE CARTRIDGE ROUTINE FOR RTE * FILE MANAGER (FMGR) * * ENTERED ON COMMAND: * * DC,CARTRIDGE,RR * * WHERE * * CARTRIDGE - +CRN OR -LU OF DISC TO BE DISMOUNTED * RR - IF SPECIFIED MEANS RELEASE DISC RESOURCE BY TAKING * OUT OF SYSTEM CL, SCB, AND RELEASING TO DISC POOL * IF A POOL DISC. IF NOT SPECIFIED, SIMPLY MARK * DISC IN DISCS MOUNTED LIST INACTIVE. * * * DC.. EXTRACTS PARAMETERS FROM PARSE LIST AND CALLS * SUBROUTINE DCMC TO PERFORM THE DISMOUNT. * * * N NOP LIS NOP ER NOP RC.. NOP JSB .ENTR DEF N CLA CLEAR OUT OPTIONAL PARAMETER STA RR IN CASE ITS NOT SPECIFIED LDA N,I GET NUMBER OF PARAMETERS IN LIST SZA,RSS IF NONE WERE SPECIFIED, EXIT JMP EX50 NOT ENOUGH PARAMETERS ERROR CMA,INA MAKE NEGATIVE AND STA N USE AS A COUNTER * JSB SESSN SEE IF WE'RE UNDER SESSION CONTROL DEF *+2 DEF XEQT * LDB LIS INB LDA B,I GET CARTRIDGE FROM PARSE LIST SZA,RSS IF NONE SPECIFIED JMP EX56 EXIT NOT ENOUGH PARAMETERS ERROR STA DISID * SEZ,RSS IF UNDER SESSION GO SEE IF JMP PARM2 ANOTHER PARAMETER WAS PASSED LDA ASÙOþúCRR WE'RE NOT UNDER SESSION CONTROL STA RR WANT TO FORCE AN RR WHETHER IT WAS SPECIFIED JMP CALL OR NOT. DC,CRN SHOULD REMOVE DISC FROM SYSTEM * PARM2 ISZ N INCREMENT COUNTER RSS STILL ANOTHER PARAMETER JMP CALL NO MORE PARAMETERS - CALL DCMC ADB .4 LDA B,I GET SECOND PARAMETER CPA ASCRR ASCRR?? STA RR YES - SAVE "RR" IN 2ND PARAMETER * CALL JSB DCMC CALL DCMC TO DISMOUNT THE DISC DEF RTN DEF ER,I DEF CODE DEF DISID DEF RR RTN EQU * JMP EXIT * EX50 LDA .50 NOT ENOUGH PARAMETERS RSS EX56 LDA .56 BAD PARAMETER STA ER,I * EXIT STA CRN SAVE CRN AND LU STB LU RETURNED FROM DCMC LDA ER,I SZA ERROR RETURNED? JMP EX YES * LDA CRN STUFF CRN AND BLANKS STA MESS+6 INTO THE MESSAGE DLD BLANK DST MESS+4 * JSB NAM.. IF CRN IS A LEGAL ASCII FILE DEF *+2 NAME THEN DON'T CONVERT IT DEF CRN SZA,RSS 2 ASCII CHARACTERS? JMP GETLN YES - SKIP CONVERSION * JSB CNUMD CONVERT CRN TO ASCII DEF *+3 DEF CRN DEF MESS+4 * GETLN LDA .23 SET MESSAGE LENGTH TO 23 IF NOT LDB LU RETURNED TO POOL, OTHERWISE SSB SET MESSAGE LENGTH TO 27 LDA .27 LDB RR SEE IF THIS WAS AN OPTION TO CPB ASCRR RELEASE RESOURCES RSS LDA .16 STA LNGTH * CPB ASCRR GET DIRECTION AGAIN RSS JMP INAMS JUST INACTIVATED THE DISC SO SAY SO LDB LU GET LU AGAIN RBL POSITION TO SYSTEM/SESSION INDICATOR SSB JMP SYSMG REMOVED FROM SYSTEM LDA SESN REMOVED FROM SESSION - PUT STA MESS+20 SESSION INTO MESSAGE DLD SESN+1 DST MESS+21 JMP MSü¡ G GO SEND MESSAGE * SYSMG LDA SYST PUT SYSTEM INTO MESSGE STA MESS+20 DLD SYST+1 DST MESS+21 JMP MSG * INAMS DLD INACT STUFF INACTIVE INTO MESSAGE DST MESS+11 DLD INACT+2 DST MESS+13 LDA INACT+4 STA MESS+15 * MSG LDA LU GET WORD WITH LU AND B377 MASK TO LOWER BYTE STA LU JSB CNUMD CONVERT LU TO ASCII DEF *+3 DEF LU DEF ARRY DLD ARRY+1 PUT 4 CHARACTERS OF DST MESS+9 LU INTO MESSAGE * JSB FM.ER DEF *+4 DEF ZERO DEF MESS DEF LNGTH EX JMP RC..,I * * B EQU 1 A EQU 0 XEQT EQU 1717B CODE OCT 2 DISID NOP RR NOP ZERO NOP LU NOP LNGTH NOP ARRY BSS 3 .1 DEC 1 .4 DEC 4 .8 DEC 8 .16 DEC 16 .23 DEC 23 .27 DEC 27 .50 DEC 50 .56 DEC 56 B377 OCT 377 * * CRN AND BLANK MUST STAY TOGETHER LIKE THIS CRN NOP ---\ BLANK ASC 2, ---/ * * ASCRR ASC 1,RR MESS ASC 27,DISC CRN LU DISMOUNTED FROM S (POOL) SYST ASC 3,YSTEM SESN ASC 3,ESSION INACT ASC 5, INACTIVE * END htÿÿ ÿý“› ÿ92067-18221 2001 S C0122 &LI.. FMGR LIST COMMAND             H0101 ›„þúSPL,L,O ! NAME: LI.. ! SOURCE: 92067-18221 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME LI..(8) "92067-16185 REV.2001 791023" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780531 TO USE NEW FSTAT FOR 256-WORD CARTRIDGE DIRECTORY ! 2) 780630 TO PRINT FILE SIZE IN BLKS OR BLK MULTIPLES ! 3) 780919 TO USE EXTENDED FMP CALL (ELOCF) ! 4) 780919 TO CHECK FOR REC #'S > 32767 & WRAP AROUND ! 5) 790127 TO PRINT ASCII CRNS AS 2 ASCII CHARACTERS ! 6) 791023 TO REPORT ERROR IF 1ST REQUESTED RECORD > ! #RECORDS IN FILE (SST #4629), AND TO SKIP TO ! 1ST RECORD USING READF FOR TYPE 1 AND 2 FILES ! ! LI.. IS THE RTE FMGR FILE LIST MODULE ! IT IS ENTERED ON COMMAND ! ! LI,NAMR,TY ! ! WHERE: ! ! ! NAMR IS THE NAME REFERENCE INCLUDING ! SECURITY CODE AND DISC ID ! ! TY IS THE LISTING TYPE AND IS ASCII: ! ! S OR A OR NULL SOURCE WITH LINE NUMBERS ! B BINARY DUMP ! D DIRECTORY HEAD ONLY ! ! ! EACH LISTING WILL BE PRECEEDED BY THE HEAD: ! ! NAMEL T=XXXXX IS ON CRXXXXX USING XXXX BLKS R=XXXX ! ! ! ! ! ! S FORMAT IS A BLANK FOLLOWED BY 4 DIGIT ! LINE NUMBER FOLLOWED BY TWO BLANKS FOLLOWED ! BY THE RECORD. ! ! B FORMAT IS : ! A)THE RECORD HEAD: REC# XXXXX ! B)N LINES FORMATED AS FOLLOWS ! 8 5-DIGIT OCTAL NUMBERS SEPARATED BY BLANKS ! AND FOLLOWED BY A "*" FOLLOWED BY THE ! {xþú 16 ASCII CHARACTERS THE DIGITS REP. ! NON-PRINTING CHARACTERS WILL BE FILLED ! WITH BLANKS ! ! D FORMAT IS THE HEAD ONLY ! ! ! ! DEFINE EXTERNALS ! LET .TTY, \DETERMINE IF INTERACTIVE NAM.. \NAME CHECKING ROUTINE BE FUNCTION,EXTERNAL ! LET JER. \FMGR ERROR HANDLING ROUTINE BE SUBROUTINE,EXTERNAL,DIRECT ! LET .E.R., \FMGR ERROR WORD BUF., \INTERNAL FMGR BUFFER I.BUF, \INTERNAL FMGR BUFFER N.OPL, \FMGR SUBPARAMETER ARRAY O.BUF, \INTERNAL FMGR BUFFER TMP. \LIST DEVICE BE INTEGER,EXTERNAL ! LET CONV., \FMGR INTEGER TO ASCII CONVERSION ELOCF, \EXTENDED FMP FILE LOCATION EXEC, \RTE EXEC ROUTINE FSTAT, \FMP CARTRIDGE LIST ROUTINE JER., \FMGR ERROR HANDLING ROUTINE LOCF, \FMP FILE LOCATION ROUTINE OPEN., \FMGR OPEN ROUTINE READF, \FMP FILE READ ROUTINE WRITF \FMP FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! ! DEFINE INTERNAL ROUTINES ! LET SETA, \ SPACE, \ WRIT \ BE SUBROUTINE,DIRECT ! ! DEFINE CONSTANTS ! HL LET BL.T BE CONSTANT (20124K)! T LET EQ.BL BE CONSTANT (36440K)!= LET BL.I BE CONSTANT (20111K)! I LET S.BL BE CONSTANT (51440K)!S LET O.N BE CONSTANT (47516K)!ON LET BL.C BE CONSTANT (20103K)! C LET R.BL BE CONSTANT (51040K)!R LEj…þúT BL.L BE CONSTANT (20114K)! L LET U.BL BE CONSTANT (52440K)!U LET BL.U BE CONSTANT (20125K)! U LET S.I BE CONSTANT (51511K)!SI LET N.G BE CONSTANT (47107K)!NG LET BL.B BE CONSTANT (20102K)! B LET L.K BE CONSTANT (46113K)!LK LET R.EQ BE CONSTANT (51075K)!R= LET A.BL BE CONSTANT (40440K)!A LET B.BL BE CONSTANT (41040K)!B LET D.BL BE CONSTANT (42040K)!D LET R.E BE CONSTANT (51105K)!RE LET C.NO BE CONSTANT (41443K)!C# LET DST BE CONSTANT (25052K)!** LET ST.B BE CONSTANT (25102K)!*B ! ! DEFINE BUFFER SET UP ! LET LSTBF(2),LNNO,BLWD,LBF(256) BE INTEGER LET IDM(2) BE INTEGER LI..: SUBROUTINE(NOC,LIS ,ER) GLOBAL ! OPFL_401K !SET DEFAULT OPEN OPTION NUL,WRAP_0 !PRESET NULL PRAM FLAG, WRAP-AROUND FLAG LR_$([FR_[TYPF_[LIS1_@LIS +1]+4]+4]+4)!SET ADDRESSES TYPF_($TYPF AND 177400K)+40K !GET AND ISOLATE THE TYPE IF [FR_$FR] THEN[ \SET FIRST LAST RECORD IFNOT LR THEN LR_ FR] !DEFAULTS (1 IF ONLY FIRST) IF FR<0 THEN [ER_56;RETURN] !BAD 1ST RECORD PARM? IF TYPF=A.BL THEN GO TO STYP !CHECK FOR IF TYPF=40K THEN[NUL_1;GO TO STYP] !LEGAL IF TYPF=D.BL THEN GO TO TYPOK !OPTIONS IF TYPF=B.BL THEN[OPFL_311K;GO TO TYPOK]!NULL,A,S,B,D IF TYPF#S.BL THEN [ER_56;RETURN] !NO, BAD PARAMETER ! STYP: TYPF_S.BL !FORCE NULL,ATOS ! TYPOK:OPLS_ @TMP.+3 !GET LIST UNIT OP LIST ! CALL OPEN.(O.BUF,TMP.,$OPLS, 0) !OPEN LIST FILE ! CALL OPEN.(I.BUF,$LIS1,N.OPL,OPFL) !OPEN FILE TO BE LISTED ! CALL ELOCF(I.BUF,.E.R.,IDM,IDM,LP,IDM,FLU,FTYP,RECS) IFNOT NUL THEN GO TO OK !IF NULL THEN CHOSE THE RIGHT OPTION IFNOT FTYP THEN GO TO OK !TYPE ZERO^þú DEFAULT IS ASC IF FTYP=3 THEN GO TO OK !SAME FOR TYPE 3 IF FTYP=4 THEN GO TO OK !SAME FOR TYPE 4 CTYP: TYPF_B.BL !OTHERWISE USE BINARY FORMAT ! OK: CALL LOCF(O.BUF,.E.R.,LP,LP,LP,LP,LLU) !GET LIST LU ! EXEC(13,LLU,EQT5) !GET LIST LU TYPE CODED ! P36_[P3_@LIS +4]+33 !SET UP LIST ADDRESSES LP_1 !SET LINE PRINTER FLAG IF (EQT5 AND 37400K)<5000K THEN LP_0 TTY_.TTY(LLU) FOR T_ P3 TO P36 DO[$T_20040K] ! BLANK THE BUFFER P_P3-1 SETA(BL.T) !SET BLANK T SETA(EQ.BL) !SET = BLANK P_P+2 CONV.(FTYP,$P,5) !SET TYPE SETA(BL.I) !SET BLANK I SETA(S.BL) !SET S BLANK SETA (O.N) !SET ON IF FTYP THEN[SETA(BL.C); \IF DISC FILE FIND CR # SETA(R.BL);\ CALL FSTAT(LNNO,256,1,1);\MUST BE FOUND T_@LNNO; \SO NO STOP NEEDED UNTIL ($T AND 377K)=FLU DO T_T+4; \FIND THE LU T_$( T+2);N_5; \SET IT UP P_P+1;$P_T; \MOVE CRN TO OUTPUT BUF IF NAM..($P)=0 THEN \IF PASSED NAMR TEST, [P_P+1;GOTO LI1]], \THEN SKIP CONVERSION ELSE[ \ SETA(BL.L); \SET UP A DIRECT LU SETA(U.BL);\ T_FLU;N_2] P_P+1 CONV.(T,$P,N) LI1: IFNOT FTYP THEN[N_13;GO TO WRHD] SETA(BL.U) !SET USING SETA(S.I ) SETA(N.G ) P_P+3 ! ADDR._@I.BUF+5 !DCB WORD 5 (FILE SIZE) IF $ADDR. < 0 THEN [ \IF NEGATIVE, THEN CONV.(-($ADDR.),$P,5); \CONVERT POSITIVE AND SETA(ST.B)], \REPORT AS "*BLKS" ELSE [CONV.($ADDR./2,$P,5); \CONVERT BLOCKS TO ASCII SETA(BL.B)] !SET BLKS R= ! SETA(L.K) ÓóþúSETA(S.BL) SETA(R.EQ) ! P_P+2 ! CONV.(RECS,$P,4) ! N_27 ! WRHD: TB_[BF_[IF TYPF=S.BL THEN @LSTBF,ELSE @BUF.]]+1 $BF_20040K !BLANK FIRST WD P_LIS1 FOR T_TB TO TB+N DO [$T_$P;P_P+1] !MOVE LINE IF LIS #3 THEN[$([P_TB+1]+1)_DST;\IF FAKE FILE REPLACE NAME $P_DST;$TB_DST]! WITH "******" WRIT ! WRITE THE HEAD ! IF TYPF=D.BL THEN GOTO EOF !DONE IF HEAD ONLY SPACE !SPACE A LINE IF FTYP=6 THEN FTYP,$(@I.BUF+2)_1 !FORCE TYPE 6 TO ONE RC_1 !DEFINE STARTING RECORD IF FR > 1 THEN [ \IF SKIP REQUESTED AND IF FTYP THEN [ \IF FILE IS TYPE 1 OR 2 IF FTYP < 3 THEN RC_FR]] !SET FIRST RECORD NEXT: P_BF !INITIALIZE BUFFER POINTER SETA(R.E) ! SET UP SETA(C.NO) ! REC# XXXXX SETA(20040K) P_P+2 CONV.(RC,$P,5)! SET NUMBER CALL READF(I.BUF,.E.R.,LBF,128,L,RC) ! READ RECORD IF .E.R.= -12 THEN [ \IF EOF IF RC>FR THEN GO TO EOF] !THEN EXIT JER. !CHECK FOR ERRORS IF L <0 THEN [ \SOFT EOF? IF RC>FR THEN GO TO EOF, \YES ELSE [ER_ -12;RETURN]] !NO, EOF BEFORE 1ST REQ. REC IFNOT WRAP THEN \IF LESS THAN 32768 [IF RC< FR THEN GO TO NEXTR] !SKIP TO FIRST REQUESTED REC. N_L+3 IF TYPF=S.BL THEN[CONV.(RC,LNNO,4);BLWD_20040K;\ L_0;GO TO WRTIT]!JUST LISTING - GO WRIT ! SPACE !SPACE A LINE N_5 !WRITE THE RECORD NUMBER WRIT ! SPACE !SPACE A LINE ! F_@LBF !SET BUFFER POINTER NEXTL:IFNOT L THEN [ \IF NO DATA GET NEXT NEXTR: IF RC=32767 THEN RC,WRAP_1, ELSE \RESET RECORD COUNT RC_RC+1; ŒØþú \STEP RECORD COUNT IF LR THEN[ \END OF REQUESTED DATA IF RC > LR THEN GO TO EOF]; \YES GO DO EOF GO TO NEXT] !ELSE DO NEXT RECORD P_[ST_[WP,T_TB]+27]+1 !INITIALIZE POINTERS REPEAT 36 TIMES DO[ $T_20040K; T_T+1] UP_ -1 !SET UPPER FLAG TRUE REPEAT 8 TIMES DO THRU PTSTP IF[T2_ [T_$F]AND 77400K]>57400K THEN GOTO BLANK IF T2>17777K THEN GOTO OKUP ! BLANK:T_ (T AND 177K)+20000K ! OKUP: IF [T2_($F AND 177K)]<140K THEN[IF T2> 37K THEN\ GO TO OKLOW] ! T_ (T AND 77400K) +40K ! OKLOW:DO[ $P_T AND 77577K;P_P+1] ! T2_ [T_$F-<1] AND 1 ! $WP_[IF UP THEN (T2-<8)+([T_T-<3] AND 7)+30060K,\ ELSE T2 + 20060K] ! REPEAT 2 TIMES DO[ \ $[WP_WP+1]_(([T_T-<3] AND 7)-<8)+\ ([T_T-<3] AND 7)+ 30060K] ! IF UP THEN GOTO PTSTP ! $[WP_WP+1]_(((T-<3) AND 7)-<8)+30040K ! PTSTP:DO[WP_WP+1;UP_NOT UP;F_F+1;IFNOT [L_L-1] THEN\ GO TO PREPR] ! ! PREPR:IF $[P_P-1]=20040K THEN GO TO PREPR !FIND LAST !NON BLANK N_ P-TB+1 !PRINT LENGTH ! $ST_ $ST +12K !SET THE STAR SEPERATOR ! WRTIT:WRIT !TRANSMIT THE LINE ! GOTO NEXTL !GO DO NEXT LINE ! EOF: WRITF(O.BUF,.E.R.,$BF,-1) !WRITE EOF JER. RETURN END ! ! SETA: SUBROUTINE(PRA)DIRECT !STEP P AND SET PRA IN P INDIRECT $[P_P+1]_PRA RETURN END ! ! WRIT: SUBROUTINE DIRECT!WRITE ON O.BUF BUFFER AT BF IF LP !OR TB IF NOT LP WITH LENGTH N+LP !IF TTY -LIMIT LENGTH TO 72. IF TTY THEN[IF N>36 THEN N_36] WRITF(O.BUF,.E.R.,$(TB-LP),N+LP) JER. RETURN END ! ! SPACE:SUBROUTINE DIRECT !SPACE THE LIST DEVICE N_1 !SET LENGTH TO ONE WORD DO[T_$TB;$TB_ 20040K]!SET BLANK IN BUFFER øL*($ WRIT !WRITE BLANK LINE $TB_T !RESTORE OLD CONTENTS RETURN !RETURN END END END$ K”*ÿÿ ÿý”   ÿ92067-18222 1940 S C0122 &DL.. FMGR DIRECTORY LIST             H0101 ÁÛþúSPL,L,O ! NAME: DL.. ! SOURCE: 92067-18222 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME DL..(8) "92067-16185 REV.1940 790725" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780516 TO USE FSTAT TO READ CARTRIDGE DIRECTORY ! 2) 780516 TO USE KEYWD OFFSET (NOT IDSEG ADDR) FROM OPEN FLAG ! 3) 780518 TO REPORT NEXT TRACK, LAST TRACK AND STARTING TRACK ! OF FILE AS 5-DIGIT NUMBERS ! 4) 780518 TO REPORT FILE SIZE IN BLOCKS OR BLK MULTIPLES ! 5) 781116 TO PRINT ASCII SECURITY CODES AND CRNS AS ASCII ! TO TREAT 2 ASCII CHARACTERS AS CRN BEFORE TRYING IT ! AS A MASK ! TO ALLOW SYSTEM MANAGER TO DO :DL,-LU OR DL,CRN ! IF LU IN SST, EVEN IF LU NOT IN HIS CL ! TO CALL LOCK. TO CLEAN INVALID OPEN FLAGS ! 6) 790725 IF LIST DEVICE IS A FMP FILE, IT IS OPENED ONLY ONCE ! (NOT RE-OPENED) SST #4465 ! ! RTE FMGR DIRECTORY LIST MODULE ! ! ENTERED ON COMMAND: ! ! DL,CR,MSC ! ! WHERE: ! CR IF GIVEN RESTRICTS THE LIST TO ! THE GIVEN CARTRIDGE ! ! MSC IF GIVEN MUST BE THE MASTER ! SECURITY CODE AND CAUSES THE ! EXPANDED LIST FORMAT. (SEE BELOW) ! ! FORMATS: ! ! HEAD: ! !L1 CR=XXXXX !L2 ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX ! LAST TR=XXXXX #DR TR=XX ! ! ! ! WHERE: CR IS FOLLOWED BY THE CARTRIDGE ID NUMBER ! YYYYYY IS THE CARTRIDGE LABEL ! NXTR INDICATES THE NEXòöþúT TRACK ! NXSEC THE NEXT SECTOR ! #SEC/TR THE NO. OF SECTORS/TRACK ! LAST TR THE LAST TRACK AND ! #DR TR THE NUMBER OF DIRECTORY TRACKS ! ! STANDARD (MSC NOT SUPPLIED): !L3 NAME TYPE SIZE/LU OPEN TO ! ! FOLLOWED BY THE DIRECTORY ENTRIES ! ! EXTENDED FORMAT (MSC SUPPLIED) ! NAME TYPE SIZE/LU SCODE TRACK SEC OPEN TO ! ! ! IF THE LIST DEVICE IS A TTY (TYPE 00 OR 05) ! THE EXTENDED FORMAT MAY FORCE TWO LINES ! (IF 6 OR 7 PROGRAMS HAVE THE FILE OPEN) ! IF A PROGRAM HAS A FILE OPEN EXCLUSIVELY, ! A - (MINUS SIGN) WILL FOLLOW THE PROGRAM'S NAME ! IF AN ENTRY IS FOR AN EXTENT A + (PLUS SIGN) ! WILL BE PRINTED IN THE OPEN TO FIELD ! FOLLOWED BY THE EXTENT NUMBER ! ! ! DEFINE EXTERNALS ! LET PK.DR,D.SDR,TMP.,O.BUF,.E.R.,CL.BF,\ BUF.,N.OPL BE INTEGER,EXTERNAL LET HEAD.(4),H1(2),H1.5,H2(5),H3,H4(4),H5,H6(5),H7,H8(6),H9,\ H10(4),H11 BE INTEGER LET HEA.1(17),HEA.2(26) BE INTEGER INITIALIZE HEAD.,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11 TO \ " ILAB=YYYYYY NXTR= XXXXX NXSEC=XXX #SEC/TR=XXX LAST TR=XXX"\ ,"XX #DR TR=XX" INITIALIZE HEA.1 TO " NAME TYPE SIZE/LU OPEN TO" INITIALIZE HEA.2 TO " NAME TYPE SIZE/LU SCODE TRACK SEC",\ " OPEN TO " ! LET F.TST,MSC.,.TTY,NAM.. BE FUNCTION,EXTERNAL ! LET F.SET,DR.RD,LOCF,WRITF,OPEN.,CONV.,FSTAT\ BE SUBROUTINE,EXTERNAL LET SESSN,ISMVE,LOCK. BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! ! DEFINE INTERNALS ! LET SETAD,WRIT,SPACE,CKDID BE SUBROUTINE ! ! DEFINE CONSTANTS ! LET BLKS.(3) BE INTEGER INITIALIZE BLKS. TO " BLKS " LET KEYWD BE CONSTANT (1657K) LET XEQT BE CONSTANT (1717K) LET BLANK BE CONSTANT (20040K) LET C.R çþúBE CONSTANT (41522K)!CR LET EQ.BL BE CONSTANT (36440K)!= LET MIN.B BE CONSTANT (26440K)!- LET PLS.B BE CONSTANT (25440K)!+ LET MIN BE CONSTANT ( 55K)! - ! ! DL..: SUBROUTINE(N,LIS,ER) GLOBAL ASSEMBLE ["EXT $SMID";"LDA $SMID";"STA SMID"] TFLG,EXEND,FFLAG,IOP,FOUND_0 LIS3_[LIS2_[DL_@LIS+1]+1]+1 !SET DISC SPEC DLLU_DL DL_$DL CALL SESSN($XEQT)?[GO TO DL0] !IF IN SESSION, SESWD_.B. !GET SCB ADDRESS CALL ISMVE(SESWD,SMID,CODE,1) !GET USER ID FROM SCB IF CODE=7777K THEN IOP_1 !IF SYS MGR, SEARCH ENTIRE CL DL0: LUPT_@CL.BF !SET LU/CRN POINTER CALL FSTAT(CL.BF,256,1,IOP) !READ CARTRIDGE DIRECTORY IF LIS=3 THEN[ \IF MASK OPTION (IF ASCII) IFNOT $(@N.OPL+1) THEN [ \IF CRN SUBPARM, MASK 790424 IF $LIS2=" " THEN [ \IF JUST 2 ASCII CHARACTERS IF $LIS3=" " THEN [ \ CALL CKDID? [FFLAG_1; \IF NOT A CRN CALL F.SET($DLLU); \SET UP AS A MASK DL_$(@N.OPL+1)]; \ GO TO DL1]]]; \ FFLAG_1; \SET UP THE MASKS CALL F.SET($DLLU); \AND THE NEW DL_$(@N.OPL+1)] !CRN DL1: DO[T_ @LIS+4 ;IF $T THEN[IFNOT[\ !CHECK EXEND_MSC.($T)]THEN[ER_51;RETURN]]]!SECURITY CALL FSTAT(CL.BF,256,1,IOP) !READ DISC DIRECTORY CALL CKDID?[ER_54;RETURN] !DISC IN FSTAT BUFFER? AGAIN:DIS_[IF DL THEN DL,ELSE -($LUPT AND 377K)] !GET DISC ID IFNOT DIS THEN RETURN !END OF DIREC-DONE BLK,INDEX_0 T_ @TMP.+3 IF TFLG THEN GO TO NOPEN !IF NOT TYPE 0, DON'T RE-OPEN OPEN.(O.BUF,TMP.,$T,0) !OPEN LIST FILE NOPEN:LOCF(O.BUF,.E.R.,T,T,T,T,T2,TFLG) !GET LIST LU TTY_[IF .TTY(T2) T1†þúHEN 1,ELSE 0] !SET TTY FLAG TB_[BF_@BUF.]+1 $BF_BLANK LOCK.(DIS,3,LKER) !CLEAR INVALID OPEN FLAGS LOCK.(DIS,5) !UNLOCK NXBLK:DR.RD(1, DIS,BLK)?[IFNOT BLK THEN \ [IF .A. THEN [ER_54;RETURN], \ ELSE GO TO DL4], \ ELSE GO TO CLEAN] !READ BLOCK NXFIL:SETAD?[INDEX_0;BLK_BLK+1;GO TO NXBLK] !SET ADDRESSES P_TB IF INDEX+BLK-16 THEN GO TO FILEP !NOT FIRST JUMP $P,FOUND_C.R !SET $(P+1) _EQ.BL !CR= $(P+3),$(P+4)_BLANK !BLANKS TO FILL OUT ASCII NAME $(P+2)_$PK3 IF NAM..($(P+2))#0 THEN \IF NOT VALID NAMR, THEN CONV.($PK3,$(P+3),5) !MAKE CRN 5 ASCII DIGITS DL2: WRIT($BF,4) !WRITE ON LIST UNIT CONV.($PK9,H3,5) !INSERT NEXT TRACK CONV.($PK5,H5,3) ! NEXT SECTOR CONV.($PK6,H7,3) ! #SECTORS/TRACK CONV.($PK7-$PK8-1,H9,5) ! LAST TRACK CONV.(-$PK8,H11,2) ! #DIRECTORY TRACKS FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\ PK_PK+1] WRIT(HEAD.,35) SPACE IF EXEND THEN WRIT(HEA.2,25) ,ELSE WRIT(HEA.1,17) SPACE !SPACE T6_[T5C_[T5B_[T5A_[T5_[T4_[T3_TB+2]+3]+3]+1]+1]+1]+1 GO TO NXFIL !START LIST ! FILEP:IF $PK<0 THEN GO TO NXFIL !PURGED ENTRY IFNOT $PK THEN GO TO CLEAN ! END OF DIRECTORY IF FFLAG THEN[ \IF MASK OPTION IFNOT F.TST(PK) THEN GO TO NXFIL] !REJECT IF NOT IN SET. FOR T_TB TO TB+8 DO[$T_BLANK] !BLANK BUFFER BLKA_@BLKS. FOR T_TB+9 TO TB+11 DO \WRITE "BLKS" [$T_$BLKA; \ BLKA_BLKA+1] FOR T_TB+12 TO TB+80 DO [$T_BLANK] !BLANK REST OF LINE FOR T_TB TO T3 DO [$T_$PK;PK_PK+1] !SET NAME CONV.($PK3,$T4,5) ?°þú !SET TYPE IF $PK3 THEN GO TO NOT0 !IF TYPE ZERO CONV.($PK4 AND 77K,$T5,2) !CONVERT LU $T5A_" (" !WRITE "(LU)" $T5B_"LU" $T5C_") " GO TO EXCK !ELSE NOT0: IF $PK6<0 THEN [ \IF SIZE IS NEGATIVE CONV.(-$PK6,$T5,5); \CONVERT SIZE (BLK MULTIPLES) $T5A_"*B"], \WRITE "*BLKS" ELSE CONV.($PK6/2,$T5,5) !ELSE, CONVERT SIZE (BLOCKS) ! EXCK: IFNOT EXEND THEN GO TO NAMST !NOT EXTENDED JMP ! !SET NAME LIST ORGIN ! T6_[PK_[PK6_[T2_[P_TB+12]+2]+3]+2]+2 IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8] $T2_$PK8 !CHECK SECURITY CODE IF NAM..($T2)=0 THEN GO TO DL3 !IF NOT VALID ASCII, THEN CONV.($PK8,$T2,5) !CONVERT AS NUMERIC DL3: IFNOT $PK3 THEN GO TO NAMST !IF TYPE ZERO CONV.($PK4,$PK6,5) !SKIP TRACK CONV.($PK5 AND 377K,$PK,3) !AND SECTOR NAMST:T2_T6 !SET WORKING ADDRESS ! IF $PK3 THEN [IF [T_($PK5 -<8)AND 377K] THEN[\ $T6_PLS.B ;CONV.(T,$(T6+1),3);GO TO PRT] ] ! REPEAT 7 TIMES DO THRU NAMSK NAMSK: IF $[PK8_PK8+1] THEN [ \IF OPEN FLAG, THEN P_($PK8 AND 377K)-1; \KEYWD TABLE OFFSET OF IDSEG KINDX_0; \COUNT TO CHECK FOR VALID OFFSET IDSG_$KEYWD; \GET KEYWD TABLE ADDRESS NXID: IF $IDSG THEN [ \IF NOT END OF TABLE, THEN IF KINDX # P THEN [ \IF NOT TO OFFSET YET, THEN KINDX_KINDX+1; \BUMP INDEX TO KEYWD TABLE IDSG_IDSG+1; \NEXT ENTRY IN KEYWD TABLE GO TO NXID], \CONTINUE KEYWD TABLE SEARCH ELSE [P_$IDSG+12; \GET PROGRAM NAME IF $P THEN [FOR T_P TO P+2 \ DO[ $T2_$T ;T2_T2+1];T_T2-1; \ $T_($T AND 177400K)+[IF $PK8<0 THEþúN \ MIN,ELSE 40K]]]]] PRT: P_TB+81 LNCK: IF $[P_P-1]=BLANK THEN GO TO LNCK L_P-TB+1 T_BF !SET BUFFER ADDRESS IF L>36 THEN[WRIT($BF,36);L_L-13;T_TB+14;\ FOR T6_T TO TB+35 DO $T6_BLANK] WRIT($T,L) ! WRITE THE LINE GO TO NXFIL ! CLEAN:WRITF(O.BUF,.E.R.,T,-1) !END FILE DL4: IFNOT DL THEN[LUPT_LUPT+4;GOTO AGAIN] IFNOT FOUND THEN ER_43 !ERR (NOT IN SST) RETURN END ! CKDID:SUBROUTINE FEXIT !VERIFY DISC IS IN FSTAT BUFFER IFNOT DL THEN RETURN !IF NOT GIVEN, NEEDN'T CHECK CLEND_LUPT !SET POINTER TO LU WORD OF CL IF DL < 0 THEN \IF NEGATIVE LU GIVEN, [LDIS_ -DL;CRN_0], \MAKE POSITIVE, CLEAR CRN FLAG ELSE \OTHERWISE [LDIS_DL;LUPT_LUPT+2;CRN_1] !SET PTR TO CRN WORD IN CL WHILE $CLEND DO \COMPARE UNTIL END OF CL OR FND [IFNOT CRN THEN \IF NEGATIVE LU WAS GIVEN, $LUPT_$LUPT AND 377K; \THEN MASK OFF LOCK FLAG IF LDIS=$LUPT THEN \IF FOUND A MATCH, [LUPT_@CL.BF;RETURN], \THEN RESET PTR TO CL, RETURN ELSE \OTHERWISE [LUPT_LUPT+4;CLEND_CLEND+4]] !BUMP TO NEXT CL ENTRY LUPT_@CL.BF !RESET PTR TO CL FRETURN END ! SETAD:SUBROUTINE FEXIT ! SET PACK DIRECTORY ENTRY ! ADDRESSES IF INDEX=128 THEN FRETURN !END BLOCK EXIT PK9_[PK8_[PK7_[PK6_[PK5_[PK4_[PK3_[PK_INDEX+@PK.DR]+\ 3]+1]+1]+1]+1]+1]+1 !SET THE ADDRESSES INDEX_INDEX+16 !STEP INDEX RETURN END ! WRIT: SUBROUTINE(BAD,NWORD) !WRITE N WORDS ON O.BUF !IF NOT A TTY TWO BLANKS ARE WRITF(O.BUF,.E.R.,$(@BAD+TTY),NWORD+1-TTY)!ADDED JER. !AT THE ïW*($ RETURN !FRONT END ! SPACE:SUBROUTINE $TB_BLANK !SET A 1 WORD BLANK WRIT($BF,1) !WRITE IT RETURN !RETURN END ! END END$ Ù.*ÿÿ ÿý• ¡ ÿ92067-18223 1903 S C0122 &F.SET              H0101 XšþúASMB,R,L,C * NAME: F.SET * SOURCE: 92067-18223 * RELOC: 92067-16185 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM F.SET,8 92067-16185 REV.1903 760719 EXT .ENTR EXT N.OPL ENT F.SET FILTER SET UP ENTRY ENT F.TST FILTER TEST ENTRY * * FILTER FOR DL COMMAND * * THIS ROUTINE SET UP THE FILTER MASKS AND TESTS NAMES AGAINST THEM * NAME NOP F.SET NOP ONE PARAMETER THE FILE NAME JSB .ENTR GET PRAM DEF NAME JSB NAMF GET MASK AND TEST FOR FIRST WORD STA CPA1 SET THE VALUES STB MSK1 FOR LATER JSB NAMF GET SAME FOR WORD 2 STA CPA2 AND SAVE STB MSK2 JSB NAMF SAME FOR NAME 3 STA CPA3 STB MSK3 LDA DN.OP GET ADDRESS OF SUB PRAMS RAL,CLE,SLA,ERA CLEAR INDIRECT LDA A,I GET ADDRESS STA NAME SET ADDRESS JSB SUTY GET MASK FOR SC STA CPASC SAVE SC VALUE ONE CMA,SSA,INA SET MASK 2 CMA,INA USE SAME IF POSITIVE CODE PROVIDED STA CPASM STB MSKSC ISZ NAME STEP TO JSB SUTY GET MASK FOR TYPE STB MSKTY STA CPATY JSB SUTY STB MSKSZ ADA A DOUBLE SIZE TO GET SECTORS STA CPASZ JSB SUTY NOW GET RECORD LENGTH STB MSKRL STA CPARL SET VALUES JMP F.SET,I RETURN ALL MASKS SET UP * NAMF NOP NAME DON'T CARE SET UP LDA NAME,I GET VALUE AND C377 ISOLATE THE HIGH CHAR CPA "HM" IS "× þú-"? CLB,RSS YES SET MASK LDB C377 NO, SET KEEP MASK XOR NAME,I GET OTHER CHAR. CPA "LM" IS "-"? RSS YES LEAVE ZERO MASK ADB B377 NO SET THE LOW BITS LDA NAME,I GET THE VALUE AND B MASK IT ISZ NAME STEP FOR NEXT TIME JMP NAMF,I RETURN A=VALUE, B= MASK * SUTY NOP TYPE MASK SET ROUTINE LDA NAME,I GET CURRENT PRAM SZA,RSS SET MASK BASED ON IF SUPPLIED CLB,RSS CCB B IS MASK ,A IS VALUE ISZ NAME STEP TO NEXT ENTRY JMP SUTY,I RETURN * B377 OCT 377 C377 OCT 177400 CPA1 NOP CPA2 NOP CPA3 NOP CPASC NOP CPASM NOP CPATY NOP CPASZ NOP CPARL NOP * MSK1 NOP MSK2 NOP MSK3 NOP MSKSC NOP MSKTY NOP MSKSZ NOP MSKRL NOP "HM" OCT 26400 "LM" OCT 55 DN.OP DEF N.OPL * * DADD NOP F.TST NOP MASK TEST ROUTINE PRAM IS ADDRESS OF DIRECTORY ENTRY JSB .ENTR DEF DADD LDB DADD,I GET THE ADDRESS LDA B,I GET NAME1 AND MSK1 KEEP UN MASKED CHAR CPA CPA1 IF OK CONTINUE INB,RSS ELSE JMP NO TAKE NO EXIT * LDA B,I NAME 2 AND MSK2 CPA CPA2 INB,RSS JMP NO * LDA B,I AND MSK3 CPA CPA3 INB,RSS JMP NO * LDA B,I AND MSKTY TYPE TEST CPA CPATY INB,RSS JMP NO * INB INB STEP OVER DISC ADDRESS LDA B,I GET SIZE AND MSKSZ CPA CPASZ INB,RSS JMP NO * LDA B,I AND MSKRL CPA CPARL INB,RSS RECORD LENGTH OK? JMP NO * LDA B,I SECURITY CODE AND MSKSC CPA CPASC TWO CHANCES HERE RSS CPA CPASM OK? CCA,RSS YES NO CLA NO MATCH EXIT JMP F.TST,I RETURN * A EQU 0 îë B EQU 1 END Rßÿÿ ÿý–ž ÿ92067-18224 1903 S C0122 &PU..              H0101 iKþúSPL,L,O,M ! NAME: PU.. ! SOURCE: 92067-18224 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME PU..(8) "92067-16185 REV.1903 790319" ! ! MODIFICATION RECORD: ! ! 1) 780516 TO HANDLE LOCK. ERROR RETURN PARAMETER ! 2) 790112 TO USE NEW DCB FORMAT FOR TRK,SEC,SEC OFFSET ! 3) 790127 TO HANDLE PURGE OF TYPE 0 ON ANY DISC CARTRIDGE ! ! PURGE FILE ROUTINE FOR THE RTE FILE MANAGER ! ! ENTERED AFTER A: ! ! PU,NAMR ! ! WHERE: ! ! NAMR IS THE FILE'S NAMR WHICH CAN CONTAIN: ! ! CR (OPTIONAL) IS THE CARTRIDGE ID. ! ! SC (OPTIONAL) IS THE FILE SECURITY CODE. ! ! ! DEFINE EXTERNAL ADDRESSES ! LET .E.R., \FMGR ERROR WORD I.BUF, \INTERNAL FMGR BUFFER N.OPL, \FMGR SUBPARAMETER ARRAY PK.DR \FILE DIRECTORY BUFFER BE INTEGER,EXTERNAL ! LET DR.RD, \RTE EXEC ROUTINE IER., \FMGR ERROR HANDLING ROUTINE LOCK., \CARTRIDGE LOCK ROUTINE MSS., \FMGR ERROR MESSAGE ROUTINE PURGE \FMP FILE PURGE ROUTINE BE SUBROUTINE,EXTERNAL ! LET PUIT \PURGE ROUTINE BE SUBROUTINE,DIRECT ! LET TATSD BE CONSTANT (1756K) LET SECT2 BE CONSTANT (1757K) LET WRIT BE CONSTANT (2) LET READ!xþúI BE CONSTANT (1) ! PU..: SUBROUTINE(NCAM,PLIST,ER) GLOBAL !ENTRY POINT LET NCAM,PLIST,ER BE INTEGER ! DO[T_@N.OPL+1;BLK_@PLIST+1] PUIT !CALL PURGE IF .E.R.= -6 THEN .E.R._ -2006 !SET UNDEFINED MESSAGE IF .E.R. = -16 THEN GO TO ZPURG IER. RETURN ! ZPURG:DCB2_[T_@I.BUF]+1 !ADDRESSES OF DCB WORDS 1 AND 2 DIS_$T AND 77K !LU FROM DCB WORD 1 (BITS 0-5) DR.RD(READI,-DIS,0)? \READ CARTRIDGE SPECIFICATION ENTRY [ER_54;RETURN] !DISC NOT MOUNTED ERROR DIRTR_[LSTTR_[SECTR_@PK.DR+6]+1]+1 !-#DIR TRK,LAST TRK,SEC/TRK LOCK.(-DIS,3,LKER)? \LOCK THE DISC [MSS.(LKER);RETURN] !PRINT LOCK ERROR AND RETURN PUIT !CALL PURGE IN CASE ADDRESSES CHANGED TRK_$DCB2 !DIRECTORY TRACK SEC_($T AND 17700K) >- 6 !SECTOR NUMBER OFSET_(($T AND 160000K) -< 3)*16 !SECTOR OFFSET TI,BLK_0 !COMPUTE BLOCK #, START WITH ZERO TEST: IF TI=SEC THEN GO TO FOUND !IF MATCH, FOUND BLOCK # BLK_BLK+1 !INCREMENT BLOCK # TI_(TI+14)/$SECTR !COMPUTE NEXT LOGICAL BLOCK ADDRESS TI_$1 GO TO TEST !CHECK FOR A MATCH ! FOUND:BLK_BLK+(($LSTTR-$DIRTR-1)-TRK)*($SECTR/2) !BLKTR FOR EACH DRTRK OFSET_OFSET+@PK.DR !ADDRESS OF DIRECTORY ENTRY DR.RD(READI,-DIS,BLK)? \READ BLOCK CONTAINING DIR ENTRY [ER_54;RETURN] !DISC NOT MOUNTED ERROR IF [T_$(OFSET+8)] THEN \IF SECURITY CODE AND [IF T-N.OPL THEN \IT DOESN'T MATCH, THEN [ER_-7;GOTO EXIT]] !RETURN -7 ERROR $OFSET_ -1 !MARK ENTRY AS PURGED DR.RD(WRIT,-DIS,BLK)? \WRITE BLOCK CONTAINING PURGED ENTRY [ER_54;GO TO EXIT] ! EXIT: LOCK.(-DIS,5) !UNLOCK THE CARTRIDGE RETURN END ! PUIT: SUBROUTINE DIRECT PURGE(I.BU¸ú F,.E.R.,$BLK,N.OPL,$T) !(TRY TO) PURGE THE FILE RETURN END END END$ ¤#ÿÿ ÿý—Ÿ ÿ92067-18225 1903 S C0122 &DP..              H0101 e? SPL,L,O ! NAME: DP.. ! SOURCE: 92067-18225 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME DP..(8) "92067-16185 REV.1903 760511" ! ! LET INPRS, \INVERSE PARSE ROUTINE EXEC, \SYSTEM OPEN, \FMGR OPEN READF \FMGR READ BE SUBROUTINE,EXTERNAL ! ! ! LET C.BUF, \INPUT BUFFER ECH., \ITS LENGTH CAM.O \LOG LU BE INTEGER,EXTERNAL ! ! ! DP..: SUBROUTINE GLOBAL B377_377K;UBLK_20000K !SET BLANK AND MASK ASSEMBLE["CCB"; \REPLACE THE FIRST DELIM "EXT C.DLM";\ "ADB C.DLM";\ "CLE,ERB";\ "LDA 1,I";\ "AND B377";\ "IOR UBLK";\ "STA 1,I";\ "SEZ";\ "INB"] ADD_.B. CALL EXEC(2,CAM.O,$ADD,@C.BUF-ADD+ECH.) RETURN END END END$ Ê ÿÿ ÿý˜ž ÿ92067-18226 2026 S C0122 &RU..              H0101 nGþúSPL,L,O ! NAME: RU.. ! SOURCE: 92067-18226 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME RU..(8) "92067-16185 REV.2026 800221" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780630 TO USE RTE SESSION MONITOR SESSN ROUTINE ! 2) 781006 TO CLOSE DCB FOR TYPE 6 FILE AFTER IDRPL CALL ! 3) 781117 TO NOT DO A :TR IF NEITHER THE PGM NOR TYPE 6 FOUND ! 4) 790116 TO SKIP 1ST SCHEDULE ATTEMPT & TRY FOR TYPE 6 IF ! GENERIC NAME NOT FOUND ! 5) 790123 TO RETURN "PROGRAM NOT FOUND" ERROR INSTEAD OF -6 ! AND TO SEARCH ONLY LU 2 AND LU 3 FOR TYPE 6 FILE ! 6) 790123 TO INHIBIT RENAME ON TYPE 6 RP IF DON'T COPY BIT SET ! 7) 800221 TO CALL "IDRP" INSTEAD OF "IDRPL" THUS ALLOWING ! TYPE 6 FILES TO RESIDE ON ANY CARTRIDGE. ! REMOVED CARTRIDGE DEFAULT TO LU 2 AND 3. (DCL) ! ! LET BUMP., \UPDATES JOB TIME SET.T, \RESETS JOB TIMER MSS., \PRINTS ERROR MESSAGE EXEC, \SYSTEM CALLS RMPAR, \RETRIEVE PARAMETERS FM.ER, \SEND MESSAGE TO LOG IDRP, \10-2:RP,XX PROCESSOR 800221 IDRPD, \10-2:RP,,XX PROCESSOR READF, \10-2 FMP FILE READ IER., \FMGR ERROR HANDLING OPEN, Ë þú \FMP FILE OPEN ROUTINE OPEN., \INTERNAL OPEN ROUTINE CLOS., \INTERNAL CLOSE ROUTINE .RENM, \RENAMING MOD. IN SES MODE SESSN, \TEST IF IN SESSION MODE IFMTM, \TEST IF MTM WRITF \FMP FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! LET .DFER \3-WORD TRANSFER BE SUBROUTINE,EXTERNAL,DIRECT ! !10-2 LET IFBRK BE FUNCTION,EXTERNAL !CHECK BREAK FLAG. LET ID.A BE FUNCTION,EXTERNAL !GET IDSEG ADDRESS LET TL. BE FUNCTION,EXTERNAL,DIRECT !CHECK RUN TIME LIMIT. ! LET .E.R., \FMGR ERROR WORD O.BUF, \FMGR DCB BUFFER TL.P, \RUN TIME LIMIT VALUES CAD., \COMMAND ADD. IN TABLE ACTV., \JOB ACTIVE FLAG NO.RD, \COMMAND READ FLAG G0.., \GLOBAL TABLE ADDRESS BUF., \BUFFER USED BY RP C.BUF, \TRANSLATED "RU" COMMAND ECH., \LENGTH OF COMMAND TMP., \ID SEG TEMP. STORAGE SCR., \SECOND 2 COMMAND CHARS. I.BUF, \10-2 DCB FOR :RP,XXXX N.OPL, \10-2 SC & CRN FOR OPEN ..BF., \BUFFER FOR "IDRP" 800221 ..BL. \BUFFER LENGTH 800221 BE INTEGER,EXTERNAL ! LET SREQ BE CONSTANT (100027K) LET XEQT BE CONSTANT (1717K) LET XTEMP BE CONSTANT(1721K) LET SECT3 Bu*þúE CONSTANT(1760K) ! LET PTR,PTR1,PTR2,PTR3,PTR4,PTR5,PTR6 BE INTEGER !10-2 LET PAR(4),PAR5,PARM1,PARM(7) BE INTEGER LET SAVE BE INTEGER LET ABEND(4),ABX(7) BE INTEGER LET TIME(4) BE INTEGER LET JOB BE REAL LET LM(3) BE INTEGER LET NNAM(3) BE INTEGER !10-2-76 (DLB) LET RN,BAT BE REAL LET DUM,DUX BE INTEGER LET T1,T2 BE INTEGER ! !10-2 INITIALIZE PAR,PAR5,PARM1,PARM \ !10-2 TO 4(0),3,8(0) INITIALIZE ABEND,ABX TO " ABEND XXXXX ABORTED " INITIALIZE TIME,JOB,LM TO " ABEND JOB LIMIT " INITIALIZE RN TO "RUN " ! ! ! ! ! ! RU..: SUBROUTINE(NUM,PRAMS,ERR) GLOBAL LET NUM,PRAMS,ERR BE INTEGER CRCNT,PFL,RPSW _ 0; DM_@BAT !SET DUMMY TIME LOCATION IFNOT NUM THEN [ERR_50; RETURN] !ARE THERE ENOUGH PARAMS? IF PRAMS = 3 THEN GOTO GETN !IF ASCII, CHECK NAME ! ERR _ 56; RETURN !BAD PARAMETER. GETN: PTR6 _ [PTR5 _ [PTR4 _ [PTR3 _ \ [PTS2,PTR2 _ [PTR2F _ [PTR1 _ \ @PRAMS+1] + 3] + 1] + 4] + 4] \ + 4] + 4 ! ! IF FIRST PRAM NOT SUPPLIED AND 0G IS NUMERIC USE IT INSTEAD ! IFNOT $PTR2F THEN [ \ IF G0.. = 1 THEN PTS2 _ @G0..+1] !10-2 CALL .DFER(PARM1,$PTR1) !SET NAME IN RP.. CALL CALL .DFER(NNAM,$PTR1) !10-2 SET NAME FOR DUP CALL ! CRCNT_ECH. !SET COMMAND LENGTH ! 10-2 CALL SESSN($XEQT)?[ \TEST IF IN SESSION OR CALL IFMTM($(@G0..+1))?[GOTO TSET]] !IF MTM BEFORE RENAMING IF N.OPL = "IH" THEN GO TO TSET !IF 'IH' DON'T RENAME CALL .RENM(NNAM,.E.R.,RPSW) !10-2 RENAME MODULE IF POSSIBLE IF .E.R. THEN ERR _ .E.R. !10-2 IF ERROR BRING FORWARD IF ERR THEN RETURN !10-2 CHECÄJþúK IF ANY ERRORS ! IDADR_ID.A($PTR1)?[GOTO TYPE6] !IF NO GENERIC, TRY FILE IF [NOCPY_$(IDADR+31) AND 2000K] \IF "DON'T COPY" BIT SET, THEN CALL .DFER(NNAM,$PTR1) !USE OLD NAME TSET: IF ACTV. THEN[IFNOT TL.() THEN [ \IF IN ACTIVE JOB, CALL SET.T(TL.P,BAT); \SET RUN TIME LIMIT, PFL _ 1; DM _ @DUM]] !IF NECESSARY. TRNON: CALL SET.T(T1,T1) IF SCR. = "IH" THEN CRCNT_0 !IF "IH" PASS ZERO LENGTH $1 _ -1 !MUST PASS THE CALL EXEC(SREQ,NNAM,$PTS2,$PTR3, \10-2 WHOLE COMMAND $PTR4,$PTR5,$PTR6,C.BUF,CRCNT) !BUFFER TO EXEC. GOTO REPLC !ERROR EXIT. ! CHKB: IF [SAVE _ $1] = -1 THEN \ GOTO ABCHK ! CALL RMPAR($(@G0..+41)) ABCHK: IF PFL THEN CALL BUMP.(BAT,TL.P) !UPDATE JOB TIME CALL SET.T(BAT,$DM) !RESET THE RUN TIME LIMIT .E.R._0 IF $$XTEMP # 100000K THEN GO TO EX !FIND OUT IF PROGRAM DIED ! CALL .DFER(ABX,NNAM) !10-2SET UP THE ABORT MESSAGE CALL FM.ER(2,ABEND,11) !SEND IT TO THE LOG. IFNOT ACTV. THEN GO TO EX !IF NOT IN JOB GO EXIT ! CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),0) !OPEN THE LIST FILE IF $(DM+1)> -1 THEN [ \IF TIME OUT ABORT IF T2 < 0 THEN [ \ IF PFL THEN JOB _ RN; \IF RN LIMIT USE RN WRITF(O.BUF,.E.R.,TIME,9); \SEND THE MESSAGE TO LP NO.RD,CAD._6; \TIME OUT ALWAYS ABORTS IER.]] !CHECK FOR ERRORS CALL WRITF(O.BUF,.E.R.,ABEND,11) !SEND THE ABEND MESSAGE IF .E.R.= -17 THEN .E.R._0 !SET OVERFLOW ERROR TO 0 !10-2EX: IF RPSW THEN CALL RP..(2,PAR,ERR) !PU THE ID IF RP'ED EX: IF RPSW THEN CALL IDRPD(NNAM,.E.R.); \10-2 CALL EXEC (5,-1) Ì1þú !10-2 RELEASE ANY TRACKS IF .E.R. THEN ERR _ .E.R. !10-2 IER. !REPORT ANY OTHER ERRORS IF ERR THEN RETURN !10-2 CHECK IF ANY ERRORS CALL EXEC(14,1,C.BUF,40);ECH._.B. !10-2 GET RETURNED STRNG FROM PROG IF ECH.>40 THEN RETURN !10-2 BUG IN OP-SYSTEM IFNOT ECH. THEN RETURN !10-2 CHECK IF STRING RETURNED IF (C.BUF AND 177400K)=35000K THEN[ \10-2 CHECK IF STARTING : NO.RD _ -1; C.BUF _ C.BUF-15000K] !10-2 SET RD BF FGG,CHANGE : > SPA RETURN ! REPLC: SAVE _ $1 CALL SET.T(BAT,$DM) !RESET THE JOB TIMER IF RPSW THEN GOTO PRMSG ! IF SAVE # "05" THEN GOTO PRMSG ! !10-2 CALL RP..(1,PAR5,ERR) !IF EXEC COULDN'T FIND TYPE6: DIS2_$(@N.OPL+1) !DISC FROM NAMR ! !! REMOVE CARTRIDGE DEFAULT TO LU 2 AND 3 (DCL) 800221 !! DIS_[IF DIS2 THEN DIS2, ELSE -2] !DEFAULT TO LU 2 ! DIS_DIS2 !GET CRN 800221 CALL OPEN(I.BUF,.E.R.,$PTR1,5,N.OPL,DIS)!OPEN TYPE 6 FILE ! !! REMOVE CARTRIDGE DEFAULT TO LU 2 AND 3 (DCL) 800221 !! IF .E.R. = -6 THEN \IF NOT FOUND, THEN !! [IFNOT DIS2 THEN \IF NOT SPECIFIED, THEN !! [IF $SECT3 THEN \IF LU 3, THEN !! CALL OPEN(I.BUF,.E.R.,$PTR1,5,N.OPL,-3)]]!TRY OPEN ON LU 3 ! IF .E.R. < 0 THEN [ \IF ERROR, THEN IF .E.R. = -6 THEN .E.R._67; \IF -6, MAKE 67 ERR_.E.R.; RETURN] !SET ERROR, RETURN CALL READF (I.BUF,.E.R.,BUF.,128) !10-2 FOR LATER TESTS IER. !10-2 IF [NOCPY_$(@BUF.+31) AND 2000K] \MASK DON'T COPY BIT THEN CALL .DFER(NNAM,$PTR1) !IF NO COPY, USE OLD NAME CALL IDRP (I.BUF,.E.R› $".,NNAM,..BF.,..BL.) !DO :RP, 800221 CALL CLOS.(I.BUF) !CLOSE THE TYPE 6 FILE IF .E.R. THEN ERR _ .E.R. !10-2 ! IF ERR = 19 THEN GO TO ERTS !PROGRAM, LOOK FOR A FILE. ! IF ERR = 16 THEN[ \IF NON PROGRAM FILE FILE. !ERTS: IF BUF.= -1 THEN RETURN; \IF EOF AT START OR ! IFNOT ($(@BUF.+1) AND 377K) THEN RETURN; \ A BINARY FILE ! GO TO TRANS] !DON'T TR ELSE DO TR. ! IF ERR THEN RETURN RPSW _ 1; GOTO TSET !FILE AND TRY AGAIN. ! !TRANS:CAD.,NO.RD _ 1 !CAN'T FIND PROGRAM. ! ERR _ 0; RETURN !TREAT AS A "TR" FILE. PRMSG: ERR _ 49 IF RPSW THEN CALL IDRPD(NNAM,T1); \10-2 IF CANNOT RUN :RP,X > :RP,,X CALL EXEC (5,-1) !10-2 RELEASE ANY TRACKS PICKED UP RETURN END END END$  $ÿÿ ÿý™ ¤ ÿ92067-18227 2040 S C0122 &ST.DU              H0101 †wþúSPL,L,O,M ! NAME: ST.DU ! SOURCE: 92067-18227 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME ST.DU(8) "92067-16185 REV.2040 800731" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780427 TO CALL IER. ON RETURN FROM CREA. (BL) ! (IER. CALL REMOVED FROM CREA.) ! 2) 780920 TO USE EXTENDED FMP ROUTINES (ECREA,ELOCF,ECLOS) ! 3) 790222 TO KILL DESTINATION FILE IF -5 ERROR ON READ, OR ! -33 ERROR ON WRITE ! 4) 790314 TO CHANGE TYPE 0 TEST FROM < 64 TO <= 20000K ! 5) 800311 TO REPORT WARNING ON TRUNCATION OF RECORDS TO ! 128 WORDS FOR TYPE 2 ! 6) 800731 IF REC FMT=MS, ALLOW ONLY AS,BR,BN,BA AS ! SECONDARY REC FMT (SST #4878) ! ! THIS IS THE RTE FMP FMGR ROUTINE TO STORE ! AND DUMP FILES. ! ! DU,NAME,LU,OP1,OP2,OP3 ! ! O R ! ! ST,LU,NAME,OP1,OP2,OP3,OP4 ! ! ! W H E R E: ! ! ST IS STORE. ! DU IS DUMP. ! ! NAME IS THE FILE TO BE STORED OR DUMPED. ! ! LU IS EITHER THE SOURCE OR DESTINATION ! DEVICE AND MAY BE A FILE REFERENCE. ! ! OP1 IS A MEDIUM ASC CODE AS FOLLOWS: ! AS ASCII DATA ! BR BINARY RELOCATABLE DATA ! BA BINARY ABSOLUTE DATA ! MT MAG TAPE NORMAL FORMAT ! MS MAG TAPE SIO FORMAT ! ! OP2 IS AN END OF FILE OPTION ! FLAG -- TWO ASC CHARACTERS: ! Aþú SA SAVE END OF FILES IN THE ! NEW FILE. ! IH INHIBIT ALL LEADER, TRAILER, ! END OF FILE TRANSFERS; ! DOES NOT APPLY TO FINAL ! EOF ON A DISC FILE. ! ! OP3 IS THE NUMBER OF THE FIRST FILE ! TO BE TRANSFERRED (APPLIES TO ! FILES OF TYPE ZERO) (DEFAULT=1) ! ! OP4 IS THE NUMBER OF FILES TO BE ! TRANSFERRED (APPLIES TO FILES ! OF TYPE ZERO) (DEFAULT= ) ! ! N O T E: OP3 AND OP4 ARE RELATIVE TO CURRENT POSITION. ! ! DEFINE EXTERNALS ! LET I.BUF,O.BUF,BUF. BE INTEGER,EXTERNAL ! LET N.OPL,.E.R. BE INTEGER,EXTERNAL ! LET ECREA,OPEN.,ELOCF,ECLOS,CLOS.,\ EXEC,READF,WRITF,\ MSS.,RWNDF,\ IER.,CK.SM BE SUBROUTINE,EXTERNAL LET .DDI,.DMP,.DSB BE SUBROUTINE,EXTERNAL,DIRECT ! LET IFBRK BE FUNCTION,EXTERNAL ! LET DU..,ST.. BE SUBROUTINE ! LET IDMY(2),ISZ(2),JSZ(4),RSIZ(2),ID1(2), \ BLKMP(2),DW1(2),DW2(2),DW4(2) BE INTEGER ! LET SECT2 BE CONSTANT(1757K) LET AS BE CONSTANT (40523K) LET BR BE CONSTANT (41122K) LET BN BE CONSTANT (41116K) LET BA BE CONSTANT (41101K) LET MT BE CONSTANT (46524K) LET MS BE CONSTANT (46523K) LET IH BE CONSTANT (44510K) LET SA BE CONSTANT (51501K) ! INITIALIZE BLKMP TO 0,128 INITIALIZE DW1 TO 0,1 INITIALIZE DW2 TO 0,2 INITIALIZE DW4 TO 0,4 ! ST..: SUBROUTINE(NPD,LISTO,ERD) GLOBAL ERD_ -1 !SET DUMP FLAG DU..(NPD,LISTO,ERD) RETURN END ! DU..: SUBROUTINE(NPS,LISTS,ERS) GLOBAL LI12_[LIS8_[LIS4_@LISTS+4]+4]+4 ! LIS21_[LIS17_[LIS13_[LIS9_[LIS5_[LIS1_\ @LISTS+1]+4]+4]+4]+4]+4 Kgþú ! ! PRESET DEFAULT OPTIONS ! OBUF,SPDCB_@O.BUF !SET DCB ADDRESS FOR SPACING IBUF_@I.BUF !SET INPUT DCB ADDRESS BUFF,BUFA,BF_@BUF. DO[F1,SIOI,EOFF,CK,SIO,FLG_0;LDR_100000K] DO[SUBF_400K;F2,TYP,DUMP_1] IFNOT ERS+1 THEN [ERS,DUMP_0;SPDCB_IBUF] !SET STORE OPTIONS IF NPS<2 THEN [ERS_55;RETURN] DT_3 !SET DEFAULT TYPE ! ! ANALYZE OPTIONS ! ! FIRST THE TYPE FLAG ! IFNOT $LIS8 THEN GO TO ST3 !OPTION IS NULL GO TO CHECK NEXT IF $LIS9 = MS THEN [SIO_1;BUFA_BF+1;\ LIS9_LIS9+1] IF $LIS9=" " THEN GO TO ST3 IF $LIS9 = AS THEN [SUBF_410K;GO TO ST3] IF $LIS9 = BR THEN[CK,SUBF_310K;\ DT_5; GO TO ST3] IF $LIS9 = BN THEN[SUBF_310K; \ GO TO ST3] IF $LIS9 = BA THEN[CK,SUBF_2310K;TYP_0;\ DT_7;GO TO ST3] IFNOT SIO THEN \ [IF $LIS9 = MT THEN GO TO ST3; \ IF $LIS9 = SA THEN[EOFF_1;GO TO ST2];\ IF $LIS9 = IH THEN[LDR_0;GO TO ST2]] ! STER1:DO[ERS_56; RETURN] ! ! CHECK FOR OP2 ! ST3: IF $LI12#3 THEN GO TO ST2 ! IF $LIS13 = SA THEN[EOFF_1;GO TO ST5] IF $LIS13 = IH THEN[LDR_0;GO TO ST5] ! GO TO STER1 !ILLEGAL OPTION ! OPT2 WAS FOUND IN OP1 LOCATION SO ! ADJUST ADDRESSES AND SKIP ! OPT2 CHECK. ! ! ST2: DO[LIS21_[LIS17_LIS13]+4] ST5: OPEN.(I.BUF,$LIS1,N.OPL ,SUBF+1) !OPEN SOURCE NAMR ELOCF(I.BUF,.E.R.,IDMY,IDMY,ID,ISZ,ILU,INTY,ISZ2) IER. IF INTY=2 THEN [ \IF TYPE 2 AND RECLEN > IF ISZ2 > 128 THEN MSS.(79)] !128 WDS, PRINT WARNING IF $LIS17>0 THEN F1_$LIS17-1 IF $LIS21>0 THEN F2_$LIS21, ELSE \ [IFNOT $LIS21 THEN [IF$LIS17>0 THEN GOTO ST6,ELSE[\ IF INTY THEN F2_9999]]] ùöþú! ST6: SUBF_(SUBF AND 110K)+LDR \SET OUTPUT FUNCTION OR[IF (INTY AND 177775K)=5 THEN 100K,ELSE 0] IF $LIS9=AS THEN SUBF_SUBF AND 177677K ! IF A STORE OPERATION, CREATE THE FILE ! SZ1_[SZ_[TY_[OPLS_@N.OPL+5]+2]+1]+1 ! IFNOT ERS+2 THEN[ERS_0;GO TO ST12] !COPY CALL THE FILE IS OPEN IF DUMP THEN GO TO ST10 ! ! SET DEFAULTS ! IFNOT $TY THEN $TY_[IF INTY THEN INTY,\ ELSE DT] IF $SZ THEN [ \IF SIZE SPECIFIED, THEN IF $SZ < 0 THEN \IF SIZE NEGATIVE, THEN [IF $SZ = -1 THEN \IF SIZE = -1, THEN JSZ(1),JSZ(2) _ -1, \MAKE DOUBLE WORD, ELSE ELSE [.B._ -$SZ;.A._0; \MAKE POSITIVE AND CALL .DMP(BLKMP); \MULTIPLY BY BLK MULTIPLIER JSZ(1)_.A.;JSZ(2)_.B.]], \SAVE FOR ECREA ELSE [JSZ(1)_0;JSZ(2)_$SZ]], \SZ POSITIVE, MAKE DOUBLE WD ELSE \SIZE NOT SPECIFIED, SO [IF INTY THEN \IF NOT TYPE 0, DEFAULT SIZE [.B._ISZ(2);.A._ISZ(1); \TO SIZE FROM "FROM" FILE CALL .DDI(DW2)], \CONVERTING SECTORS TO BLOCKS ELSE [.B._ $SECT2;.A._0; \TYPE 0, SO DEFAULT SIZE TO CALL .DDI(DW4)]; \SECTORS PER TRACK/4 JSZ(1)_.A.;JSZ(2)_.B.] !SAVE FOR ECREA JSZ(3)_0 IF $SZ1 THEN JSZ(4)_$SZ1, \IF RECD SIZE, USE IT ELSE [IF INTY THEN $SZ1,JSZ(4)_ISZ2] ! ! CREAT THE FILE ! CLOS.(O.BUF) IF $LIS5 <= 20000K THEN GOTO ST10 ECREA(O.BUF,.E.R.,$LIS5,JSZ,$TY,$OPLS,$(OPLS+1),144,RSIZ) IER. GO TO ST12 ST10: OPEN.(O.BUF,$LIS5,$OPLS,SUBF) ST12: ELOCF(O.BUF,.E.R.,IDMY,IDMY,ID,ISZ,OLU,OUTY) IER. IF INTY=6 THEN $(IBUF+2),INTY_1 IF OUTY=6 THEN $(OBUF+2),OUTY_1 ! ! BOTH IN AND OUT ARE OPEN -- ! LEADER HAS BEEN PUNCHED IF NOT SUPPRESSED. ! ! IF SIO STORE THEN SET IT UP ! IF SIO THEN [IFNOT DUMP THEN[\ e°þú SIO_0; SIOI_1;BUFF_[BUFA_BF]+1]] ! UNTIL F1=0 DO[READF($SPDCB,.E.R.,$BUFA,128,ALN);IER.;\ IF ALN<1 THEN[F1_F1- 1; IF IFBRK() THEN GO TO BRK]] ST15: READF(I.BUF,.E.R.,$BUFA,128,ALN) IF IFBRK() THEN[\ IF BREAK THEN BRK: MSS.(0);GO TO KILL] ! SEND BREAK ERROR AND GO FLUSH THE FILE IF .E.R.= -12 THEN [ALN_ -1;GO TO ST16] IF .E.R.= -5 THEN [MSS.(.E.R.);GO TO KILL] !PURGE DESTINATION FL IER. IF ALN>0 THEN GO TO ST20 ! DATA? ! ! NO DATA -- EITHER EOF OR ZERO REG ! ! ! END OF XFER? ! ST16: IFNOT ALN+1 THEN[IF INTY THEN[F2_0;\ GO TO ST18]]!TRUE EOF-QUIT ! IF [F2_F2-1] THEN [IF EOFF THEN[ALN_-1;\ GO TO ST22],ELSE GO TO ST25] ST18: ALN_-1 IF LDR THEN GO TO ST22 ! GO TO EXIT !DONE - NO EOF REQUIRED ! ST20: DO [IF SIOI THEN [ALN_[\ IF $BUFA<0 THEN-$BUFA,ELSE\ ($BUFA+1)>-1];ID_BUFA+1],ELSE\ ID_BUFA ;IF CK THEN[\ CK.SM($ID,TYP)?[GO TO ABO];ALN_($ID-<8)+(1-TYP)*3]] FLG_1 !SET FLAG TO SAY WE WROTE A RECORD ST22: IF ALN>0 THEN[IF SIO THEN[$BUFF_-ALN;ALN_ALN+1]],\ ELSE[IF F2 THEN[IF OUTY THEN ALN_0]] WRITF(O.BUF,.E.R.,$BUFF,ALN) IF .E.R. = -33 THEN[MSS.(.E.R.);GO TO KILL] IER. IF ALN= -1 THEN[IFNOT F2 THEN GOTO EXIT,\ ELSE GO TO ST25 ] IF ALN THEN GO TO ST15 ST25: EXEC (13, ILU,EQT5) IF(EQT5 AND 37400K)=400K THEN [MSS.(2006);\ EXEC(7)] GO TO ST15 ! ABO: MSS.(7) !SEND CHECK SUM ERROR KILL: ID1(1),ID1(2)_-1 !SET TO ABORT THE FILE ENDIT:IF DUMP THEN RETURN IFNOT OUTY THEN RETURN IF ID1(1) < 0 THEN RWNDF(O.BUF) !REWIND TO BE SURE OF PURGE .B._RSIZ(2);.A._RSIZ(1) !ACTUAL FILE SIZE CALL .DDI(DW2) !CONVERT SECTORS TO BLOCKS CALL .DSB(ID1) CALL .DSB(DW1) IDMY(1)_.A.;IDMY(2)_.B. _$" ECLOS(O.BUF,.E.R.,IDMY) !CLOSE AND TRUNCATE IER. RETURN ! EXIT: ELOCF(O.BUF,.E.R.,IDMY,ID1,IOF) IER. IF OUTY < 3 THEN[ \IF TYPE 2 OR 1 IFNOT IOF THEN \ADJUST RB FOR ZERO OFFSET [.B._ID1(2);.A._ID1(1); \ CALL .DSB(DW1); \ ID1(1)_.A.;ID1(2)_.B.]] IFNOT FLG THEN ID1(1),ID1(2)_-1 GO TO ENDIT END ! ! END END$ Yì$ÿÿ ÿýš ¥ ÿ92067-18228 1903 S C0122 &CO..              H0101 g>þúSPL,L,O,M ! NAME: CO.. ! SOURCE: 92067-18228 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CO..(8) "92067-16185 REV.1903 790302" ! ! MODIFICATION RECORD: ! ! 1) 780920 TO ALLOW COPY OF LARGE FILES USING ECREA ROUTINE ! 2) 790113 TO MASK OFF LOCK IN LU WORD FROM DS.LU ! ! CO.. IS A MODULE OF THE RTE FMGR PROGRAM ! CO.. COPIES ALL DISC FILES ON ONE DISC TO SOME OTHER DISC ! THE COMMAND IS: ! CO, CR, CR2 ! WHERE: ! CR IS THE "FROM" DISC ID ! CR2 IS THE "TO" DISC ID ! ! ! DEFINE EXTERNALS ! LET DR.RD,DU..,MSS.,FM.ER,ECREA,CLOS.,IER.\ BE SUBROUTINE,EXTERNAL LET .DMP BE SUBROUTINE,EXTERNAL,DIRECT ! LET PK.DR,N.OPL, DS.LU BE INTEGER,EXTERNAL LET O.BUF BE INTEGER ,EXTERNAL ! ! DEFINE LOCALS ! LET SETAD BE SUBROUTINE ! LET STLIS,FNAM(3),LTY,TNAM(3),ISIZ(4),BLKMP(2),\ OPLS, SACD, DM(14) BE INTEGER INITIALIZE BLKMP TO 0,128 CO..: SUBROUTINE (N, LIS,ER) GLOBAL !SET UP DU.. CALL ARRAY FOR T _ @ STLIS TO @ STLIS+23 DO $T _0 LTY,STLIS,OPLS_3 !SET TYPE FLAGS ! SACD _ 51501K ! SAVE EOF MARKS ! LIS5 _ [LIS1 _ @ LIS+1]+4 ! ! SET UP THE OPTION LIST ADDRESSES ! OPS2_ [OPS1_[OPT2 _ [OPCR2_ [OPL_ [OPT1_ [\ OPCR1_ @N.OPL+1]+1]+3] \ + 1]+1]+1]+1 ! BLK_0 FOR T _ OPCR1 TO OPS2 DO $T _ 0 ! $ OPCR1 _ $ LIS1 $ OPCR2 _ $ LIS5 ADD_128 !ãÆþúSET UP ADDRESS INCREMENT ! DRBF _ @PK.DR ! SET PACK BUFADD. ! ! CHECK FOR LEGAL DISCS. ! IF $ LIS5 THEN [DR.RD(1,$LIS5,0)?[ \ GO TO NODES];LU_$$@DS.LU AND 377K\ ;GO TO INCK] ! NODES:DO[ER_21;RETURN]! NO DISC, EXIT ! INCK: IFNOT $LIS1 THEN GO TO NODES ! SETAD ? [GO TO NODES] IF LU = $$@DS.LU AND 377K THEN GO TO NODES ! ! BOTH DISCS ARE DEFINED AND ! SEPARATE ! ! START TRANSFER ! XFER: SETAD? [RETURN ] IF $PKD<0 THEN GO TO XFER ! IFNOT $PKD3 THEN GO TO XFER IF $PKD5 AND 177400K THEN GOTO XFER !SKIP EXTENTS FM.ER(1,FNAM,3) !SEND CURRENT NAME TO LOG ECREA(O.BUF,.E.R.,$PKD,ISIZ,$PKD3,$PKD8,$LIS5,0,0,0,70707K)!CREAT FILE IF .E.R.<0 THEN [MSS.(.E.R.-2000);GO TO XFER] ERR_-2 !SET COPY CALL FLAG FOR DU ROUTINE DU..(4, STLIS,ERR) !CALL STORE TO TRANSFER ! IFNOT ERR THEN GO TO XFER ! ER _ ERR- 2000 ! BAD: MSS. (ER) !PRINT MESSAGE ! IF ER < 2000 THEN [ER_0; GO TO XFER] ! ER _ 22 RETURN END ! ! SETAD:SUBROUTINE FEXIT ! READ DIRECTORY ! AND SET UP ST CALL ! IF ADD = 128 THEN [ \ DR.RD (1,$LIS1,BLK)?[FRETURN];\ ADD_ 0; BLK_ BLK+1] ! PKD8_[PKD7_[PKD6_[PKD5_[PKD3_[PKD2_[PKD_ \ DRBF+ADD]+2]+1]+2]+1]+1]+1 ! ADD_ ADD+16 !SET ADD FOR NEXT TIME IFNOT $PKD THEN FRETURN !END OF DIR. T1_@FNAM !SET TO MOVE T2_@ TNAM !NAME TO CALL FOR T _ PKD TO PKD2 DO[$T1,$T2_ $T;\ T1_T1 +1; T2_T2+1] ! N.OPL,$OPL_$PKD8 ! SET SECURITY CODES ! $OPT1,$OPT2_$PKD3 ! SET TYPES IF $PKD6 < 0 THEN \IF NEGATIVE SIZE, THEN [.B._ -$PKD6;.A._0; \MAKE IT POSITIVE AND CALL .DMP(BLKMP); \MULTIPLY BY BLK MULTIPLž¹ IER ISIZ(1)_.A.;ISIZ(2)_.B.; \SAVE FOR ECREA $OPS1_$PKD6], \ ELSE [ISIZ(1)_0;ISIZ(2),$OPS1_$PKD6/2] ISIZ(3)_0 ISIZ(4),$OPS2_$PKD7 ! SET DEST REC. SIZE RETURN ! DONE - RETURN END END END$ Gnÿÿ ÿý›£ ÿ92067-18229 2026 S C0122 &SP..              H0101 lHþúSPL,L,O ! NAME: SP.. ! SOURCE: 92067-18229 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SP..(8) "92067-16185 REV.2026 800221" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780106 TO CLEAR WRITTEN-ON FLAG IN DCB SET-UP (GLM) ! 2) 780221 TO SET LAST PTN USED (ID22)=0 (GLM) ! 3) 780405 TO BYPASS ID EXTENSION SAVE FOR TYPE 5 (BL) ! 4) 780427 TO OVERRIDE SESSION MONITOR CARTRIDGE CHECK & ! TO CALL IER. ON RETURN FROM CREA. (BL) ! 5) 780512 TO ACCESS NEW 256-WORD CARTRIDGE DIRECTORY (BL) ! 6) 780810 TO USE NEW DCB FORMAT ! 7) 790122 TO SAVE ID SEGMENT WORD 32 ! 8) 790125 TO SAVE USER ID, SO TYPE 6 FILE CAN LATER BE PURGED ! BY THIS USER ! 9) 791016 TO ADD PROGRAM PROTECT OPTIONS FOR TYPE 6 FILES ! 10) 800221 TO REMOVE DEFAULT OF CRN TO LU 2 (DCL) ! ! THE SP ROUTINE SAVES A PROGRAM ! IN A FILE. THE FIRST TWO SECTORS ! ARE SET UP TO ALLOW THE PROGRAM ! TO BE RESTORED TO THE SYSTEM ! ! THIS PROGRAM IS INVOKED BY : ! SP,NAME[,PR/GR[,CAP]] ! WHERE: ! NAME IS THE NAME OF THE PROGRAM TO BE SAVED ! PR, IF SPECIFIED, WILL ALLOW ONLY USERS WITH THIS ! PRIVATE ID TO RP OR RUN THIS TYPE 6 PGM ! GR, IF SPECIFIED, WILL ALLOW ONLY USERS WITH THIS ! GROUP ID TO RP OR RUN THIS TYPE 6 PGM ! CAP IS THE CAPABILITY LEVEL REQUIRED TO RP OR RUN ! THIS TYPE 6 PGM ! ! DEFINE THE EXTERNALS ! LET CREA., \FMGR FILE CREATE ™DþúROUTINE EXEC, \RTE EXEC IER., \FMGR ERROR PROCESSING OPEN., \FMGR FILE OPEN ROUTINE READF, \FMP FILE READ ROUTINE RWNDF, \FMP FILE REWIND ROUTINE WRITF, \FMP FILE WRITE ROUTINE ISMVE, \MOVE WORDS FROM SCB SESSN \GET SCB ADDRESS IF SESSION BE SUBROUTINE,EXTERNAL ! LET ID.A \FETCH ID SEGMENT ADDRESS BE FUNCTION,EXTERNAL ! LET .E.R., \FMGR ERROR WORD D.SDR, \CARTRIDGE DIRECTORY BUFFER N.OPL, \SUBPARAMETER ARRAY O.BUF, \FMGR INTERNAL BUFFER I.BUF, \FMGR INTERNAL BUFFER S.CAP, \9P - SESSION CAPABILITY OVRD. \CARTRIDGE SEARCH OVERRIDE BE INTEGER,EXTERNAL ! ASSEMBLE ["EXT $OPSY";"EXT $IDEX";"EXT $CL1";"EXT $CL2"] ASSEMBLE ["EXT $SMID";"EXT $SMGP"] ! ! DEFINE INTERNAL ROUTINES ! LET ADS, SP.. BE SUBROUTINE ! LET MF BE FUNCTION ! ! DEFINE CONSTANTS ! LET XEQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) SP..: SUBROUTINE (N,LIS,ER) GLOBAL IFNOT N THEN [ER_50; RETURN] !IF NO PARAMETERS, ERROR 50 OPT2_[TYP2_[OPT1_[PAD_@ LIS+1]+4]+3]+1 !SET PARAMETER ADDRESSES ID32_[ID27_[ID_ ID.A($PAD)?[ER_14; RETURN]]+26]+5 !IDSEG ADDR ! BF,T1_@I.BUF !POINTERS TO BUFFER FOR IDSEG. FOR T_BF TO BF +127 DO $T_0 !ZERO THE ID SEGMENT BUFFER FOR T_ID TO ID+25 DO [$T1_ $T;T1_T1+1] !COPY 1ST 26 WDS OF IDSEG T1_T1+2 ïýþú !BUMP POINTER TO BUFFER FOR IDSG FOR T_ID+28 TO ID+29 DO [$T1_$T;T1_T1+1] !COPY IDSEG WDS 29,30 $(@I.BUF+31)_$ID32 !SAVE IDSEG WORD 32 ADS (BF+11) ASSEMBLE ["LDA $OPSY";"STA OPSY";"LDA $IDEX";"STA IDEX"] T_$ID15 AND 7 !GET TYPE OF PGM IF T>1 THEN [IF OPSY = -9 OR T#4 THEN GO TO SP2] !LEGAL CONTINUE ER_56 !ILLEGAL PROGRAM TYPE RETURN ! SP2: IF OPSY = -9 AND T#5 THEN [ \IF RTE-IV & NOT SEG. IF $ID22 >= 0 THEN[$ID22_ ($ID22 AND 177700K)]; \IF PTN NOT ASSIGNED \SET LAST PTN USED=0 \ FOR DISP (780221 GLM) IF $ID29 THEN [ \AND IF EMA T_$(IDEX+(($ID29 AND 176000K)-<6));\THEN INDEX TO ID EXT T1_T1+5; \AND $T1_($T AND 37K) OR 100000K; \SAVE ID EXT WORD 0 T1_T1+1; \AND T_T+1; \SAVE ID EXT WORD 1 $T1_$T AND 176000K]] ! IF $ID15 AND 20K THEN[$(BF+7)_$ID12; \ADJUST FOR SHORT ID T1_ID15 ;\ FOR T_ID23 TO ID26 DO[\ $T_$[T1_T1+1]];\ ID27_ID20] $ID16,$ID17,$(BF+8)_0 $ID18_($ID18 AND 167777K) ! ASSEMBLE ["LDA $SMID";"STA SMID"] ASSEMBLE ["LDA $SMGP";"STA SMGP"] CALL SESSN($XEQT)?[GOTO SP4] !IN SESSION? SESWD_.B. !ID SEGMENT SESSION WORD CALL ISMVE(SESWD,SMID,$ID39,1) !USER ID TO WORD 39 CALL ISMVE(SESWD,SMGP,$ID40,1) !GROUP ID TO WORD 40 IFNOT $(OPT1-1) THEN GO TO SP3 !NO PR/GR PARAMETER? IF $OPT1="PR" THEN \IF PR SPECIFIED, THEN $ID39_$ID39 OR 100000K, ELSE \SET SIGN ON USER ID WORD [IF $OPT1="GR" THEN \IF GR SPECIFIED, THEN $ID40_$ID40 OR 100000K, ELSE \S{_þúET SIGN ON GROUP ID WD [ER_56;RETURN]] !ERR, NOT PR,GR OR NULL SP3: IF $TYP2=3 THEN [ER_56;RETURN], \IF CAP OPTION ASCII, ERR ELSE $ID41_$OPT2 !SAVE MINIMUM CAP LEVEL ! SP4: SZR_[SZ_[TY_[CR_ @N.OPL+1]+1]+1]+1 $SZR_128 !SET REC LENGTH TO 128 $TY_6 !SET TYPE TO 6 ! !!! REMOVE DEFAULT OF CRN TO LU 2 (DCL) 800221 !!! IFNOT $CR THEN $CR_-2 !DEFAULT CRN TO -2 ! $SZ_[XF_MF( ID23)+ MF( ID25)]+1 ! IF S.CAP THEN [ \IF IN SESSION, THEN TEMP_OVRD.; \SAVE CURRENT STATE OF OVRD. OVRD._OVRD. OR 40000K] !SET CARTRIDGE SEARCH OVERRIDE CREA. (O.BUF,$PAD,N.OPL)?[ER_-15; \ IF S.CAP THEN OVRD._TEMP;RETURN] IF S.CAP THEN OVRD._TEMP !IF SESSION, RESET OVRD'S STATE IER. ! $(@O.BUF+2)_1 !FORCE TO TYPE 1 ASSEMBLE ["LDA $CL1";"STA CL1";"LDA $CL2";"STA CL2"] CALL EXEC(1,2,D.SDR,256,CL1,CL2) !READ THE SET UP WORD ! $ID35_$(253+@D.SDR) !MOVE TO ID BLOCK I.BUF_ -1 !SET EOF FOR THOSE WHO DON'T KNOW BETTER ! FOR T_BF TO ID33 DO[$ID34_$ID34+$T] ! WRITF(O.BUF,.E.R.,I.BUF) !WRITE ID SEG TO 1ST BLK OF FILE IER. ! ! SET UP A DUMMY DCB FOR RWNDF CALL ! ADS ( [IBUF_@O.BUF+16]+2) !SET UP POINTERS TO DUMMY DCB ! $IBUF_[IF[T_$ID27]<0 THEN 3,ELSE 2] ! SET DISC LU ! $ID12_1 !TYPE (DCB WORD 2) $ID13_(T AND 77600K)-<9 !FILE TRACK ADDR. (DCB WORD 3) $ID14_( T AND 177K) !FILE SECTOR ADDR (DCB WORD 4) $ID15_$SZ-<1 !FILE SIZE (DCB WORD 5) $ID16_128 !RECORD LENGTH (DCB WORD 6) $ID17_210K !UPDATE OPEN (DCB WORD 7) $ID18_ [IF T<0 THEN $ SECT3,ELSE $SECT2] !SEC TRK(D"XCB WORD 8) $(ID18+1)_$XEQT !OPEN INDICATOR (DCB WORD 9) $ID23,$ID25_0 !RECORD #,EXTENT (DCB 13,15) RWNDF($IBUF,.E.R.) IER. ! RDP: READF ($IBUF,.E.R.,$ID26,256) ! IER. ! WRITF(O.BUF,.E.R.,$ID26,[IF[XF_XF-2]<0 \ THEN 128, ELSE 256]) ! IER. ! IF XF>0 THEN GO TO RDP ! RETURN ! END ! MF: FUNCTION(MAD) !COMPUTE # BLOCKS OF FILE SPACE MFV_($( MAD+1)-$MAD +177K) >-7 RETURN END ! ADS: SUBROUTINE (BASE) ID18_[ID17_[ID16_[ID15_[ID14_[ID13_[ID12\ _ BASE]+1]+1]+1]+1]+1]+1 ID41_[ID40_[ID39_[ID35_[ID34_[ID33_[ID29_[ID26_[ID25_[ID24_[ID23 \ _[ID22_[ID20_ID18+2]+2]+1]+1]+1]+1]+3]+4]+1]+1]+4]+1]+1 ! RETURN END END END$ üÏÿÿ ÿýœ ¦ ÿ92067-18230 1903 S C0122 &MS..              H0101 cIþúSPL,L,O ! NAME: MS.. ! SOURCE: 92067-18230 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME MS..(8) "92067-16185 REV.1903 780907" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780907 TO DISALLOW SEGMENT (TYPE 5) AS PROGRAM ! ! THIS ROUTINE IS PART OF THE RTE ! FILE MANAGEMENT PACKAGE ! FMGR PROGRAM. ! IT MOVES A FILE INTO THE SYSTEM ! AREA AND SETS UP THE TAT ! FOR THE TRACKS USED TO ! POINT TO THE INDICATED PROGRAM. ! ENTRY IS ON A : ! LS,NAMR,PROG,IH ! 1 5 9 ! WHERE: ! LS GETS TO THIS ROUTINE ! NAMR IS THE FILE NAME REFERENCE INCLUDING SECURITY AND ! CARTRIDGE INFORMATION ! PROG IS PRESENT THE FILE IS TO ! BE ASSIGNED TO THE NAMED ! PROGRAM (IF NOT GIVEN THE ! LS AREA IS ASSIGNED TO ! THE EDITR PROGRAM) ! IH (OPTIONAL) INDICATES THE FILE ! IS NOT TO BE SET UP AS THE CURRENT ! LS FILE. ! DEFINE EXTERNALS ! SUBS. LET OPEN.,IWRIS,WEOFS,\ READF,EXEC, MSS.,\ FM.ER,CONV.,PRTM,\ WRIS, IPUT BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! ! FUNCTIONS ! LET ID.A BE FUNCTION,EXTERNAL ! ! ARRAYS AND INTEGERS ! LET BUF.,I.BUF,N.OPL,CUSE.,.E.R. BE INTEGER,EXTERNAL ! ! DEFINE CONSTANTS. ! LET TAT BE CONSTANT (1656K) LET TATLG BE CONSTANT (1755K) LET XEQT BE CONSTANT (1717K^  ) LET MS(3),MSI,MST(4),MS2 BE INTEGER INITIALIZE MS ,MSI,MST ,MS2 TO " LS LU X TRACK XXX" LET ED(3) BE INTEGER INITIALIZE ED TO "EDITR" LET A BE CONSTANT ( 0 ) ! ! MS..: SUBROUTINE(CO,LIS,ER) GLOBAL ! LIS9 _[LIS5 _[LIS1_@LIS+1]+4 ]+4 !SET PRAM ADDRESSES EXEC (5,-1) PRTM(0) ID_ ID.A ($[IF $LIS5 THEN LIS5 ,ELSE\\ @ ED ])?[ER_14;RETURN] TYPE_$(ID+14) AND 15 IF TYPE=5 THEN [ER_41;RETURN] OPEN. (I.BUF, $LIS1,N.OPL,400K) DO [IWRIS(T); TR_ $A; IF T THEN[\ ER_5; RETURN]] ! REPORT THE TRACK ! LU_(TR AND 77400K)-<8 ! SET LU ! CONV.(LU,MSI,1) ! PUT IN MESS ! CONV.(TR AND 377K,MS2,3) ! PUT TRACK ! MSS.(2015) ! TELL HIM ITS ! FM.ER(1,MS,9) ! COMMING. SEND IT ! LSRD: READF (I.BUF,.E.R., BUF.,70,L) JER. IF L<0 THEN GOTO LSEOF ! WRIS (BUF.,-(L-<1),T) ! IF T THEN [ER_5;RETURN] ! GO TO LSRD ! LSEOF:WEOFS(T) ! FOR T_ $TAT TO $TAT-$TATLG DO[\ IF $T = $XEQT THEN IPUT(T,ID)] ! TR_(TR-<7) AND 177600K IF $LIS9 # "IH" THEN IPUT (1767K, TR) ! PRTM(TR) ! RETURN THE LS WORD ! RETURN END END END$ ÿÿ ÿý¤ ÿ92067-18231 2026 S C0122 &RP..              H0101 dHþúASMB,R,L,C HED "RP.." FMGR ROUTINE TO DO :RP,X,Y,Z * SOURCE: 92067-18231 * RELOC: 92067-16185 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM RP..,8 92067-16185 REV.2026 800306 * * MODIFICATION RECORD: * DATE REASON (BY WHOM) * 1) 800306 TO CALL "IDRP" INSTEAD OF "IDRPL" THUS ALLOWING * TYPE 6 FILES TO RESIDE ON ANY CARTRIDGE. * REMOVED CARTRIDGE DEFAULT TO LU 2 AND 3. * ADDED OPTIONAL THIRD PARAMETER: PROGRAM NAME * DIFFERENT FROM FILE NAME. (DCL) * ENT RP.. EXT IDSGA,MSS.,EXEC,OPEN,IER.,.E.R. EXT IDRPD,.ENTR,I.BUF,N.OPL 800306 EXT IDRP,..BF.,..BL. 800306 * EXT BUF.,READF SPC 1 A EQU 0 SPC 1 DUMMY NOP DUMMY PARAMETER PBUF NOP PARAMETER BUFFER IERR NOP RETURNED ERROR PARAMETER RP.. NOP ENTRY JSB .ENTR DEF DUMMY LDA PBUF CALCULATE THE ADDRESS OF THE ADA O4 TWO PARAMETERS LDB A,I GET PARAMETER TYPE INA BUMP TO THE NAME STA PRAM2 SZB,RSS CHECK IF SECOND PARAMETER JMP SKPCC SKIP THE :RP,,XXXXX SPC 1 JSB IDSGA FIND IF ID FOR 2ND PARAMETER DEF *+2 PRAM2 DEF * SEZ,RSS FOUND? JMP FOUN1 YES, :RP,, IT JSB MSS. NO, OUTPUT FMGR 009 DEF *+2 DEF D2009 JMP SKPCC NOW TRY :RP, SPC 1 FOUN1 JSB IDRPD DELETE THE ID DEF *+3 DEF PRAM2,ðjþúI NAME OF ID DEF DUMMY DONOT CHANGE 6P IF GOOD RETURN SZA CHECK IF ANY ERRORS JMP EXIT YES, RETURN NOW SPC 1 JSB EXEC NO, RELEASE ANY TRACKS DEF *+3 DEF O5 DEF OM1 SPC 1 SKPCC LDA PBUF,I GET THE 1ST PARAMETER TYPE SZA,RSS CHECK IF 1ST PARAMETER JMP RP..,I NO, JUST RETURN DONE * LDA PBUF LOAD PARAMETER ARRAY ADDRESS 800306 ADA D8 POINT TO THIRD PARAMETER 800306 LDB A,I LOAD PARAMETER TYPE 800306 * SZB,RSS IF 3RD PARAMETER ABSENT 800306 LDA PBUF THEN DEFAULT PROG NAME TO FILE NAME 800306 * INA POINT TO BEGINNING OF NAME 800306 STA PRAM3 SAVE PROGRAM NAME ADDRESS 800306 * JSB IDSGA FIND IF EXISTS DEF *+2 PRAM3 DEF *-* (PROGRAM NAME) 800306 * SEZ CHECK IF FOUND? JMP FOUN2 NO, THEN PROCEED TO :RP, LDA D23 YES, DUPLICATE PROGRAM EXIT STA IERR,I RETURN FMGR 023 JMP RP..,I ERROR RETURN, WITH ERROR CHANGED!! SPC 1 FOUN2 LDA DFDIS,I GET DISC SUBPARAMETER * ** REMOVE THE CARTRIDGE DEFAULT TO LU 2 AND 3 (DCL) 800306 ** SZA,RSS IF NOT SPECIFIED, ** LDA OM2 TRY FINDING IT ON LU 2 * STA DIS SAVE IT ISZ PBUF POINT TO FILE NAME 800306 * JSB OPEN TRY OPENING THE TYPE 6 FILE DEF *+7 DEF I.BUF DCB DEF .E.R. ERROR RETURN DEF PBUF,I FILE NAME DEF O5 NON-EXCLUSIVE, FORCE TYPE 1 DEF N.OPL FILE SECURITY CODE DEF DIS DISC CRN/LU * ** REMOVE THE CARTRIDGE DEFAULT TO LU 2 AND 3 (DCL) 800306 ** LDA .E.R. GET ERROR CODE ** CPA OM6 FILE NOT FOUND? ** RSS NOT FOUND, SO CH¬ÏþúECK IF DISC WAS SPECIFIED ** JMP FOUN3 FOUND, SO CHECK FOR ANY ERROR AT ALL ** LDA DFDIS,I WAS DISC SPECIFIED AS A SUBPARAMETER? ** SZA ** JMP FOUN3 SPECIFIED, SO RETURN THE ERROR ** LDA SECT3,I NOT SPECIFIED, SO CHECK IF LU 3 EXISTS ** SZA,RSS ** JMP FOUN3 NO LU 3, SO RETURN ERROR (NOT FOUND ON LU 2) ** ** JSB OPEN LU 3 EXISTS, TRY OPEN ON LU 3 ** DEF *+7 ** DEF I.BUF DCB ** DEF .E.R. ERROR RETURN ** DEF PBUF,I FILE NAME ** DEF O5 NON-EXCLUSIVE, FORCE TYPE 1 ** DEF N.OPL FILE SECURITY CODE ** DEF OM3 LU 3 *** **FOUN3 LDA .E.R. GET ERROR CODE ** SSA CHECK FOR OPEN ERROR ** JMP FOUN4 YES, SO RETURN THE ERROR *** ** JSB READF NOW READ THE 1ST RECORD ** DEF *+5 ** DEF I.BUF ** DEF .E.R. ** DEF BUF. ** DEF D128 **FOUN4 EQU * * JSB IER. CHECK IF ANY ERROR DEF *+1 * JSB IDRP NOW DO THE :RP, 800306 DEF *+1+5 800306 DEF I.BUF (DCB FOR FILE) DEF DUMMY (GET ERROR LOCALLY) DEF PRAM3,I (PROGRAM NAME) 800306 DEF ..BF. (DISK COPY BUFFER) 800306 DEF ..BL. (BUFFER LENGTH) 800306 * SZA,RSS CHECK IF ANY ERROR? JMP RP..,I NO, RETURN DONE JMP EXIT YES, SET THE ERROR NUMBER * SPC 1 DFDIS DEF N.OPL+1 DIS NOP O4 OCT 4 O5 OCT 5 D8 DEC 8 D23 DEC 23 D2009 DEC 2009 OM1 OCT -1 * **SECT3 EQU 1760B **D128 DEC 128 **OM2 OCT -2 **OM3 OCT -3 **OM6 OCT -6 END  ÿÿ ÿýž§ ÿ92067-18234 1903 S C0122 &IDDUP              H0101 ‹þúASMB,R,L,C HED "IDDUP" FTN/SPL SUBROUTINE TO DUPLICATE ID SEGMENTS NAM IDDUP,6 92067-16185 REV.1903 790122 * SOURCE: 92067-18234 * RELOC: 92067-16185 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * MODIFICATION RECORD: * OLD DATE NEW DATE REASON BY WHOM * 1) 12-3-75 1-30-76 TO FIX BUG IF PROGRAM IS ON DISC LU=3 (DLB) * 2) 1-30-76 10-5-76 TO REMOVE DUPLICATION OF PERMANENT PROGRAMS (DLB) * 3) 10-5-76 9-2-77 TO SUPPORT EXTENDED ID SEGMENT * 4) 9-2-77 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 5) 4-3-78 9-20-78 TO ALLOW DUPLICATION OF PERMANENT PGMS (GLM) * 6) 9-20-78 1-22-79 TO SKIP ERR 23 IF DISC ADDRESSES MATCH * TO RETURN EXISTING AND NEW IDSEG ADDRESSES * ENT IDDUP EXT $LIBR,$LIBX,IDSGA,.ENTP,NAM..,$OPSY,$IDEX EXT .OWNR TAT EQU 1656B KEYWD EQU 1657B TATSD EQU 1756B *10-5SECT2 EQU 1757B *10-5SECT3 EQU SECT2+1 *10-5DSCUT EQU 1763B A EQU 0 B EQU 1 * * PURPOSE: * * TO DUPLICATE AN ID SEGMENT ALREADY IN AN RTE-II/III/IV * SYSTEM GIVING IT ANOTHER NAME AT THE SAME TIME. * * CALLED: * * CALL IDDUP (IDNAM,NWNAM,IERR,OID,NID) * -OR- * IF ( IDDUP (IDNAM,NWNAM,IERR,OID,NID) .NE.0) GO TO IERROR * * WHERE: * * IDNAM = AN EXISTING PROGRAM NAME IN THE SYSTEM. (MUST HAVE BEEN * ':RP,IDNAM' OR BE A PERMANENT PROGRAM IN THE SYSTEM. * NWNAM = THE NAME OF THE NEWLY CREATED ID SEGMENT * IERR = (OPTIONAL) RETURN ERROR CODE —þú(SAME AS ERROR CODES IN FMGR) * OID = (OPTIONAL) RETURN ADDRESS OF EXISTING ID SEGMENT * NID = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT * * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * IERR = 14 > IDNAM TYPE NOT EQUAL TO DISC RESIDENT PROGRAM. * IERR = 17 > NWNAM IS AN ILLEGAL PROGRAM TYPE (1,4 OR 5) * TYPE 4 IS ALLOWED IF SYSTEM IS RTE-IV * IERR = 23 > NWNAM IS ALREADY IN THE SYSTEM WITH DIFFERENT DISC * ADDRESS * IERR = -15 > ILLEGAL NAME (NWNAM) * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * E-REG = 1, IF ERROR, ELSE E-REG = 0 ON RETURN(FRETURN SPL) * (2) IDNAM MUST BE PROGRAM TYPE 2,3 OR 12B,13B (REVERSE COMMON?) * TYPE 4 IS ALLOWED IF THE SYSTEM IS RTE-IV * (3) IDNAM MUST BE A PROGRAM THAT WAS ':RP,IDNAM' OR BE A PERMANENT * PROGRAM * (4) THE TRACK THAT THE ID SEGMENT POINTS TO, WILL ALWAYS BE * AS A 'FMP' TRACK IN THE TAT WHEN EXIT FROM THIS SUBROUTINE. * THIS IS DONE SO THAT ON '*OF,PROG,8' DIRECTIVE DOES NOT * RELEASE THE TRACKS, BUT DOES RELEASE THE ID SEGMENT. * (DO YOU KNOW WHAT THE 'LOADR' DOES WITH A PERMANENT * PROGRAM (TM=0) WHEN THE 1ST TRACK IT IS ON IS MARKED * AS A 'FMP' TRACK? (77776B)) (DLB) * (5) NWNAM MUST BE A 3 WORD BUFFER CONTAINING A NAME THAT * COULD BE USED AS A FILE NAME. (ALL SIX CHARACTERS ARE TESTED * FOR LEGALITY. THE "FMP" NAM.. ROUTINE IS USED TO CHECK FOR * NAME CORRECTNESS.) * * TEST PROGRAM: *FTN,L * PROGRAM TYDUP(2,99) * DIMENSION NAME(3),LU(5),NUNAM(3) * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT SYS PROGRAM NAME? _") * READ (LU,12) NAME * IF (NAME.EQ.2H/E) GO TO 9999 * WRITE (LU,13) * 13 FORMAT ("INPUT NEW NAME FOR PROG? _ë«þú") * READ (LU,12) NUNAM * IF (NUNAM.EQ.2H/E) GO TO 9999 * 12 FORMAT (3A2) * IF(IDDUP(NAME,NUNAM,IERR).EQ.0) GO TO 9999 * WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 END * END$ SPC 1 IDNAM NOP NWNAM NOP IERR NOP IERR ADDRESS OID NOP ADDRESS OF EXISTING ID SEGMENT NID NOP ADDRESS OF NEW ID SEGMENT IDDUP NOP ENTRY JSB $LIBR TURN OF INTERRUPTS MCNT NOP JSB .ENTP PICK UP PARAMETER ADDRESSES DEF IDNAM SPC 1 LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE FOR LOADA,STORA,LOAD2 ROUTINES *780403* JSB IDSGA CHECK IF IDNAM EXISTS DEF *+2 DEF IDNAM,I CCE,SZA,RSS CHECK IF FOUND? JMP ERR14 NO, TELL CALLER STA B SAVE IN B-REG STA OID,I RETURN ADDR OF EXISTING ID SEGMENT ADA O6 BUMP TO ID(7) PRIORITY WORD STA ID7 SAVE FOR LATER USE ADB D14 BUMP TO ID(15) JSB LOADA GET THE PROGRAM TYPE WORD *780403* STA NAM5Y SAVE PROGRAM TYPE WORD AND O3 CHECK IF TYPE IS 2 OR 3 ARS LEAVE E-REG SET!! CPA O1 BIT 1 MUST BE SET JMP OK OK LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? RSS YES JMP ERR17 NON-RTEIV AND TYPE=1,4 OR 5 LDA NAM5Y PROGRAM TYPE AND O7 TYPE=4? CPA O4 RSS YES, TYPE 4 ALLOWED FOR RTE-IV JMP ERR17 NO, MUST BE 1 OR 5 OK ADB O7 BUMP TO ID(22) STB ID22 AND SAVE FOR LATER USE ADB O5 BUMP TO ID(27) STB ID27 SAVE FOR LATER USE ADB O2 BUMP TO ID(29) STB ID29 AND SAVE ADB O3 ADVANCE TO 2ND SESSION WORD *780920* JSB LOADA FETCH CONTENTS Òwþú *780920* ALF,RAL IF "DON'T COPY" BIT IS SET, *780920* SSA REJECT REQUEST *780920* JMP ERR17 *780920* * * COPY EVERYTHING EXCEPT TEMPORARY LOADS BY THE LOADER. * IF TL BIT IS SET, CHECK THE "I'M A COPY" BIT. IF THIS * BIT IS SET, WE CAN DO THE COPY, OTHERWISE REPORT ERROR. * NOTE: THE "I'M A COPY" BIT IS SET WHEN A PROGRAM IS RP'ED. * RAL,ELA MOVE "I'M A COPY" BIT TO E *780920* LDA NAM5Y MOVE THE TEMPORARY LOAD BIT *780920* ALF,ALF *780920* SSA IF TEMP LOAD BIT CLEAR(PERM.PGM) *0920* SEZ,CCE OR THE "I'M A COPY" BIT IS SET *780920* JMP TYPOK THEN THIS ID MAY BE COPIED *780920* * ERR17 LDA D17 ERR 17 >> ID SEGMENT NOT SET UP BY RP JMP EXIT E-REG=1 OR NOT A PERMANENT SYSGEN PROGRAM ERR23 CCE LDA D23 ERR 23 >> DUPLICATE PROGRAM NAME JMP EXIT ERR14 LDA D14 ERR 14 >> REQUIRED ID SEGMENT NOT FOUND JMP EXIT SPC 1 TYPOK JSB IDSGA SEARCH IF NEW NAME ALREADY EXISTS DEF *+2 DEF NWNAM,I CCE,SZA,RSS NOT FOUND IS OK JMP CKNAM SPC 1 STA NID,I RETURN AS NEW ID SEG ADDRESS ADA D26 OFFSET TO DISC ADDRESS WORD STA B SAVE IN B JSB LOADA GET DISC ADDRESS TO A STA TEMP SAVE TEMPORARILY LDB ID27 DISC ADDRESS IN "OLD" ID JSB LOADA CPA TEMP COMPARE THE TWO DISC ADDRESSES CLA,CLE,RSS MATCH - RETURN AS IF WE DID IT JMP ERR23 NO MATCH - ERROR JMP EXIT RETURN SPC 1 * NOW CHECK NEW NAME FOR CONTAINING PRINTABLE CHARACTERS SPC 1 CKNAM JSB NAM.. USE FMP NAME CHECKING ROUTINE DEF *+2 DEF NWNAM,I CCE,SZA CHECK IF -15 ERROR JMP EXIT YES, GET OUT -15 ERROR JMP SERCH ­/þú E-REG MUST = 1 AT THIS POINT!!!!! SPC 1 * BLANK ID'S ARE SEARCHED IN FOLLOWING PRECEDENCE * * TYPE 2 OR 3 PROG * 1)LONG BLANK WITHOUT TRACKS * 2)LONG BLANK & DON'T CARE * SPC 1 LOOP1 SEZ,CME,RSS IF DOWN TO LONG BLANK & DONT CARE JMP ERR14 THEN GET OUT FMGR ERROR 14 SPC 1 SERCH LDA KEYWD RESET FOR KEYWORD SEARCH STA TEMP1 RSS SKIP 1ST ISZ SPC 1 * E-REG=1>>SEARCH ID WITHOUT TRACKS E-REG=0>>DON'T CARE ABOUT TRACKS SPC 1 LOOP2 ISZ TEMP1 BUMP AND CHECK IF DONE WITH LDB TEMP1 KEYWORD SEARCH *780403* JSB LOADA *780403* SZA,RSS DONE? *780403* JMP LOOP1 YES, TRY NEXT TYPE OF BLANK ID STA B *780403* ADB D14 BUMP TO WORD 15 IN IDSEG (NAME/TYPE) JSB LOADA GET VALUE *780403* AND OM360 MASK TO CHAR 5 & SHORT/LONG BIT(177420B) SZA FOUND ONE BLANK & LONG JMP LOOP2 NO, TRY NEXT IDSEG ADB D12 BUMP TO WORD 27 JSB LOADA EQUAL TO 0 IF NO TRACKS *780403* SEZ,SZA CHECK IF HAS TRACKS & CARE FLAG*780403* JMP LOOP2 WELL THIS DUDE HAS TRACKS, SKIP LDB TEMP1 GET BLANK IDSEG(1) ADDRESS *780403* JSB LOADA *780403* STA B *780403* STA NID,I RETURN ADDRESS OF NEW ID SEGMENT STB MOVE1 SAVE FOR MOVE ROUTINE INB SET UP FOR XB SET STB TEMXB SPC 1 * NOW CREATE THE NEW ID SEGMENT SPC 1 JSB .OWNR FETCH OWNER FLAG *780920* IOR B1000 MERGE IN COPY FLAG *780920* STA OWID SAVE FOR ID BUILD *780920* CLA ªºþú *780403* JSB MOVE CLEAR 1ST 6 WORDS OF PROGRAMS ID O6 DEC 6 LDA ID7 GET IDNAM'S ID(7) ADDRESS JSB XMOV GET PRIORITY & ENTRY PT ADDR. *780403* OCT 2 CLA CLEAR WORDS 9-10 JSB MOVE FIX UP WORD 11 LATER (XB) OCT 2 LDA DEFXB SET XB TO POINT TO XTEMP JSB MOVE AND ZERO ID(12) OCT 2 LDA NWNAM MOVE NEW NAME CHARS 1-4 JSB MOVE INTO NEW ID SEGMENT DEC 2 LDA A,I GET 3RD WORD OF NAME AND OM400 MASK OFF 6TH CHAR XOR NAM5Y MERGE IN 6TH CHAR OF OLD ID AND OM20 OM20 = 177760B XOR NAM5Y RESTORE BITS 8-15 OF NWNAM 0-3 OF NAM5Y IOR O200 MERGE IN THE "TM" BIT STA NAM5Y SAVE IN "TIME" BUFFER LDA TIMEB GET TIME BUFFER ADDRESS JSB MOVE COPY INTO ID O7 OCT 7 LDA ID22 COPY MEMORY/DISC ADDRESS JSB XMOV *780403* OCT 6 SPC 1 *10-5* NOW CALCULATE NUMBER OF TRACKS USED BY PROGRAM *10-5* THE ASSUMPTION IS MADE THAT A PROGRAM OWNS A TRACK IF IT OWNS *10-5* THE FIRST SECTOR OF THAT TRACK. (IT IS POSSIBLE THAT A SHORT *10-5* PROGRAM OWNS NOTHING) THIS IS TO BE COMPATABLE WITH THE *10-5* SYSTEM '*OF,PROG,8' PROCESSOR. *10-5* NOW AN EXCEPTION IS MADE TO THE PREVIOUS STATEMENT: *10-5* THIS SUBROUTINE SETS THE FIRST TRACK THIS PROGRAM IS ON TO *10-5* BELONG TO 'FMP' BECAUSE THE ':RP,,PROG' FMGR DIRECTIVE WON'T *10-5* WORK IF THIS NOT SO. ('*OF,PROG,8' IS CONSIDERED TOO NOISY *10-5* A DIRECTIVE TO THE SYSTEM CONSOLE AT PRESENT) IF THE 'OF,PROG,8' *10-5* DIRECTIVE IS FIXED, THERE IS 2 LINES OF CODE MARKED '*' THAT CAN *10-5* BE INSERTED LATER. (DLB) *10-5 SPC 1 *10-5 ISZ ID22 BUMP TO ID(23) HI-MAIN ADDRESS *10-5 JSB SUM CALCULATE # SECT USED FOR MAIN MEM. *10-5 STA TEMP1 *10-5 JSB SUM CALCULATE # SECT OFˆïþú BASE PAGE *10-5 ADA TEMP1 CALCULATE TOTAL - 1 *10-5 ADA OM1 *10-5 STA TEMP1 AND SAVE FOR LATER ADDITION *10-5 LDA ID22,I GET LU/TRACK/SECTOR ADDRESS OF START *10-5 AND O177 GET SECTOR NUMBER *10-5 STA SUM SAVE TEMP *10-5 XOR ID22,I GET TRACK # *10-5 LDB ASCT2 GET DEF TO SECT2 ON BASE PAGE *10-5 STB SECPT SAVE FOR CALCULATIONS *10-5 CLE,ELA SAVE LU IN E-REG *10-5 SEZ IF LU=3 BUMP TO SECT3 WORD *10-5 ISZ SECPT ON BASE PAGE *10-5 ALF,ALF POSITION TRACK BITS 0-7 *10-5 MPY SECPT CALCULATE # SECTORS *10-5SECPT EQU *-1 SAVE SOME CORE *10-5 ADA SUM ADD IN STARTING SECTOR *10-5 ADA TEMP1 LAST USED SECTOR BY PROG *10-5 DIV SECPT,I NOW CALCULATE LAST TRACK *10-5 SEZ CHECK IF LU=2 OR LU=3 *10-5 ADA TATSD LU=3, MOVE UP TO THAT PART OF TAT *10-5 ADA TAT ADD IN BASE ADDRESS OF TAT *10-5* *10-5* SZB CHECK IF OWNS 1ST SECTOR OF TRACK *10-5* JMP *+3 NO, DON'T BUY 1ST TRACK IT IS ON. *10-5* *10-5NEXTK LDB FMPTK GET FMP TRACK OWNERSHIP WORD *10-5 STB TATAD,I AND BUY *10-5 CPA TATAD CHECK IF LAST TRACK PROG IN ON? *10-5 JMP DONE YES, CONTINUE *10-5 ISZ TATAD NO, BUMP TO NEXT TRACK AND BUY *10-5 JMP NEXTK *10-5 SPC 1 DONE CLA STA INDX JSB MOVE NOW ZERO WORD 28 O1 OCT 1 SPC 1 LDB $OPSY OP SYSTEM IDENTIFIER CPB M9 RTE-IV? RSS YES, SAVE RTE-IV WORDS JMP EXIT NO LDB ID29 GET EMA WORD *780403* JSB LOADA *780403* SZA,RSS EMA? JMP NOEMA NO, ZERO THE EMA WORD JSB GTEXT FIND FREE ID EXTENSION SZB,RSS AVAILABLE? *780403* JMP ERR14 NO, RETURN NO AVAILABLE ID EXT STB IDEXT YES,Íwþú SET UP DESTINATION ADDR. *780403* LDB ID29 GET EMA WORD *780403* JSB LOADA *780403* CLB GET READY FOR SHIFT *780503* ASL 6 GET CURRENT ID EXT # TO B XLA $IDEX GET ID EXT LIST HEAD *780503* ADB A OFFSET TO ID EXT ADDR *780503* JSB LOADA AND FETCH IT *780403* STA B *780403* STA TEMP1 *780403* JSB LOADA GET ID EXT WORD 0 *780403* AND MSKMS MASK OFF MSEG# LDB IDEXT SAVE IN ID EXTENSION WORD 0 *780403* JSB STORA *780403* ISZ IDEXT BUMP DESTINATION ADDRESS LDB TEMP1 *780403* INB BUMP TO NEXT ID EXT WORD JSB LOADA CONTENTS OF NEXT ID EXT WORD *780403* AND MSKH6 MASK OFF EMA START PAGE LDB IDEXT SAVE IN ID EXTENSION WORD 1 *780403* JSB STORA *780403* INB BUMP DESTINATION ADDRESS *780403* CLA ZERO ID EXTENSION WORD 2 JSB STORA SAVE IN ID EXTENSION WORD 2 *780403* SPC 1 LDB INDX GET NEW ID EXTENSION # ASR 6 MOVE TO HIGH 6 BITS STA TEMP1 TEMPORARY SAVE *780403* LDB ID29 GET ID SEGMENT EMA WORD *780403* JSB LOADA *780403* AND O1777 MASK OFF HIGH 6 BITS IOR TEMP1 MERGE TO CREATE NEW EMA WORD *780403* NOEMA LDB MOVE1 COPY TO NEW ID SEGMENT *780403* JSB STORA *780403* ISZ MOVE1 BUMP DESTINATION ADDRESS SPC 1 LDB ID29 *780403* INB 9¸þú *780403* JSB LOADA GET HI-ADDR+1 OF LARGEST SEG. *780403* LDB MOVE1 DESTINATION ADDRESS *780403* JSB STORA COPY TO NEW ID SEGMENT *780403* INB BUMP DESTINATION ADDRESS *780403* CLA JSB STORA ZERO ID(30) *780403* INB *780403* JSB LOADA FETCH ID(31) *780920* AND B170K ISOLATE SEQUENCE COUNTER *780920* IOR OWID MERGE IN OWNER & COPY FLAGS *780920* JSB STORA RESTORE ID(31) *780920* CLA INB *780403* JSB STORA ZERO ID(32) *780403* SPC 1 EXIT STA IERR,I TELL CALLER CLB CLEAR IERR FOR POSSIBLE NEXT USER STB IERR STB OID CLEAR OPTIONAL PARM STB NID CLEAR OPTIONAL PARM JSB $LIBX AND RETURN DEF IDDUP SPC 1 *10-5SUM NOP ROUTINE TO CALCULATE # SECTORS USED *10-5 LDA ID22,I GET LO-ADDRESS *10-5 CMA,INA MAKE NEG *10-5 IOR O177 ROUND UP TO NEAREST MOD OF 128 WORDS *10-5 ISZ ID22 BUMP TO HI-ADDRESS *10-5 ADA ID22,I SUM FOR TOTAL WORDS *10-5 ISZ ID22 *10-5 CLB NOW CALCULATE # SECTORS *10-5 LSR 7 DIVID BY 128 *10-5 RAL MPY BY 2 *10-5 JMP SUM,I RETURN A=# OF SECTORS NEEDED *10-5 SPC 1 *10-5ASCT2 DEF SECT2 *10-5 SPC 1 MOVE NOP ENTRY A=SOURCE ADDRESS, NEWID=DEST LDB MOVE,I GET COUNTER CMB,INB STB MCNT LDB MOVE1 *780403* MORE STA TEMP1 *780403* LDA A,I GET NEXT WORD OR ZERO *780403* JSB STORA AND PUT IN SYSTEM *780403* LDA TEMP1 RESTORE TEMPORARY SAVE *780403* ¾uþú CLE,SZA BUMP SOURCE ADDRESS ONLY IF NON 0 INA RETURN E-REG = 0!!!!!! INB *780403* ISZ MOVE1 ISZ MCNT JMP MORE ISZ MOVE P+2 RETURN JMP MOVE,I RETURN DONE B=NEXT ADDRESS SPC 1 MOVE1 NOP SPC 1 XMOV NOP ENTRY A=SOURCE ADDR (CROSS-MAP)*780403* LDB XMOV,I GET COUNTER OF WORDS TO MOVE *780403* CMB,INB *780403* STB MCNT *780403* LDB MOVE1 DESTINATION ADDRESS *780403* MORE2 STA TEMP1 TEMPORARY SAVE *780403* JSB LOAD2 GET NEXT WORD OR ZERO *780403* JSB STORA AND PUT IN SYSTEM *780403* LDA TEMP1 RESTORE TEMPORARY WORD *780403* CLE,SZA BUMP SOURCE ADDR ONLY IF NON-0 *780403* INA RETURN E-REG=0! *780403* INB BUMP DESTINATION ADDRESS *780403* ISZ MOVE1 *780403* ISZ MCNT *780403* JMP MORE2 *780403* ISZ XMOV P+2 RETURN *780403* JMP XMOV,I RETURN WITH B=NEXT ADDRESS *780403* SPC 1 GTEXT NOP RETURN B=ID EXTENSION ADDRESS XLB $IDEX RETURN B=0, E=1 IF NO ID EXT AVAIL. STB IDX GET & SAVE ID EXTENSION LIST HEAD RSS *780403* GTEX1 LDB IDX GET NEXT ENTRY IN ID EXT LIST *780403* XLA B,I *780403* STA B *780403* SZB,RSS END OF ID EXTENSION BLOCK? *780403* JMP GTEXT,I YES, RETURN B=0, NO AVAIL EXT. *780403* XLA B,I NO, GET WORD 0 OF ID EXTENSION *780403* SZA,RSS AVAILABLE? ˆTþú *780403* JMP GTEXT,I RETURN B=ID EXTENSION ADDRESS *780403* ISZ INDX NO, BUMP ID EXTENSION NUMBER ISZ IDX BUMP ID EXTENSION ADDRESS JMP GTEX1 TRY THE NEXT ID EXTENSION SPC 1 STYPE NOP *780403* LOADA NOP DOES XLA B,I IF MAPPED SYS *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAPSY YES *780403* LDA B,I NO, DO DIRECT LOAD *780403* JMP LOADA,I RETURN *780403* MAPSY XLA B,I DO CROSS-LOAD (2-WD INSTRUCT.) *780403* JMP LOADA,I RETURN *780403* SPC 1 STORA NOP DOES XSA B,I IF MAPPED SYS *780403* STA TEMP SAVE TEMPORARILY *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAP YES *780403* LDA TEMP RESTORE TEMP WORD *780403* STA B,I NON-MAPPED, DO DIRECT LOAD *780403* JMP STORA,I RETURN *780403* MAP LDA TEMP RESTORE TEMP WORD *780403* XSA B,I DO CROSS-STORE (2 WD INSTRUCT) *780403* JMP STORA,I RETURN *780403* SPC 1 LOAD2 NOP DOES XLA A,I IF MAPPED SYS *780403* STA TEMP SAVE A-REG *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP XLOAD YES *780403* LDA TEMP,I NO, DO DIRECT LOAD *780403* JMP LOAD2,I RETURN *780403* XLOAD XLA TEMP,I DO CROSS-LOAD (2 WD INSTRUCT.) *780403* JMP LOAD2,I RETURN HFB *780403* SPC 1 TIMEB DEF *+1 NAM5Y NOP 5TH CHAR & PROGRAM TYPE DEC 0 ID(16) DEC 0 ID(17) DEC 0 ID(18) OCT 25000 ID(19) TIME = ONE DAY OCT 177574 ID(20) DEC 0 ID(21) SPC 1 DEFXB DEF *+1 DON'T CHANG ORDER OF NEXT 3 WORDS TEMXB NOP DEC 0 SPC 1 ID7 NOP HOLDS ADDRESS IF ID(7) ID22 NOP ID27 NOP *10-5TATAD NOP ID29 NOP IDEXT NOP IDX NOP INDX NOP OWID NOP *780920* TEMP NOP *780403* TEMP1 NOP FMPTK OCT 77776 MSKH6 OCT 176000 MSKMS OCT 100037 *10-5OM1 OCT -1 O2 OCT 2 O3 OCT 3 O4 OCT 4 O5 OCT 5 M9 DEC -9 D12 DEC 12 D14 DEC 14 D17 DEC 17 D23 DEC 23 D26 DEC 26 *10-5O177 OCT 177 O200 OCT 200 O1777 OCT 1777 B1000 OCT 1000 B170K OCT 170000 OM2 OCT -2 OM20 OCT -20 OM400 OCT -400 OM360 OCT -360 END YHÿÿ ÿýŸ° ÿ92067-18235 2040 S C0122 &IDRPL              H0101 €‰þúASMB,R,L,C HED "IDRPL" FTN/SPL SUBROUTINE TO DO A FMGR ":RP,PROG" * SOURCE: 92067-18235 * RELOC: 92067-16185 * PGMR: D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IDRPL,7 92067-16185 REV.2040 800710 * * MODIFICATION RECORD: * DATE REASON BY WHOM * 1) 800710 SUBROUTINE IDRPL CHANGED TO SUBROUTINE IDRP. * THIS IS NOW AN INTERFACE INTO IDRP. (DCL) * * ENT IDRPL EXT .ENTR,IDRP * A EQU 0 B EQU 1 SKP * PURPOSE: * TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. * CALLED: * CALL IDRPL (IDCB,IERR,NAME,NID) * -OR- * IF (IDRPL (IDCB,IERR,NAME,NID).NE.0) GO TO IERROR * WHERE: * IERR = RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * IDCB = AN OPEN DCB OF THE TYPE 6 FILE * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT * NID = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT * * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR SPL FRETURN) * IERR = -1 > DISC ERROR * IERR = -11 > IDCB NOT OPEN * IERR = 14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE * IERR = -15 > ILLEGAL NAME * IERR = 16 > FILE NOT ON DISC LU = 2 OR LU = 3 * AND INSUFFICIENT SYSTEM POOL TRACKS * AVAILABLE FOR COPY * IERR = 19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY. * IERR = 23 > DUPLICATE PROGRAM NAME. * IERR = 75 > TYPE 6 PGM IS PROTECTED ON USER ID * IERR = 76 > TYPE 6 PGM IS¡G   PROTECTED ON GROUP ID * IERR = 77 > TYPE 6 PGM IS PROTECTED ON CAPABILITY LEVEL * IERR = 78 > INTERNAL CONSISTENCY CHECK IN HAVE FAILED. * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) IDRPL DOES NOT CLOSE THE FILE. * (3) RECOMMEND FILE BE NON-EXECLUSIVELY OPENED * (4) E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL) * (5) ONLY THE 1ST 10 WORDS OF THE DCB ARE USED BY THIS SUBROUTINE. * (6) THIS IS MERELY AN INTERFACE INTO THE IDRP SUBROUTINE AND IS * PROVIDED FOR BACKWARD AND FORWARD COMPATIBILITY. * YOU SHOULD CALL IDRPL BECAUSE IDRP WILL (DOES) NOT EXIST * IN ALL VERSIONS OF RTE. * SKP IDCB NOP OPEN DCB ADDRESS IERR NOP RETURNED ERROR CODE NAME NOP FIVE CHAR ASCII NAME TO GIVE PROGRAM NID DEF JUNK ADDRESS OF NEW ID SEGMENT * IDRPL NOP ENTRY JSB .ENTR DEF IDCB * JSB IDRP DEF *+1+6 DEF IDCB,I DEF IERR,I DEF NAME,I DEF IBUF DEF IBUFL DEF NID,I * STB JUNK SAVE B-REG TEMPORARILY LDB AJUNK RESET OPTIONAL PARAMETER STB NID FOR NEXT ENTRY LDB JUNK RESTORE B-REG * JMP IDRPL,I EXIT * * ISIZE EQU 128 BUFFER SIZE IBUF BSS ISIZE BUFFER FOR DISK COPY IBUFL ABS ISIZE BUFFER LENGTH * JUNK BSS 1 "NID" PARAMETER VALUE PUT HERE IF DEFAULTED AJUNK DEF JUNK * END Š- ÿÿ ÿý § ÿ92067-18236 2040 S C0122 &IDRPD              H0101 þúASMB,R,L,C HED "IDRPD" FTN SUBROUTINE TO DO A FMGR ":RP,,PROG" * SOURCE: 92067-18236 * RELOC: 92067-16185 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IDRPD,7 92067-16185 REV.2040 800909 * * MODIFICATION RECORD: * OLD DATE NEW DATE REASON BY WHOM * 1) 12-7-75 2-3-76 TO FIX BUG IF PROGRAM IS ON DISC LU=3 (DLB) * 2) 2-3-76 10-4-76 OF,PROGM CLEAN UP INCASE OF SERIAL REUSABLE(DLB) * 3) 10-4-76 11-15-77 TO SUPPORT RTE-IV PROGRAM TYPES AND ID EXTENSIONS * 4) 11-15-77 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 5) 4-3-78 9-20-78 TO CHECK THE COPY FLAG BEFORE DELETING * 6) 9-20-78 9-29-78 TO RESTORE MESSAGE BUFFER FOR MESSS CALL * TO OVERRIDE MESSS SESSION CAPABILITY CHECKS * 7) 9-29-78 2-27-80 TO ALLOW :RP,, OF DORMANT TEMPORARILY LOADED * PROGRAMS (BECAUSE OF :RP ENHANCEMENT TO ALLOW * TYPE 6 FILES ON ANY CARTRIDGE). (DCL) * 8) 2-27-80 7-31-80 TO REPLACE ABORT PROCESSING WITH * 'OF,PROG,8,NP' (SST #4857) * ENT IDRPD EXT $LIBR,$LIBX,IDSGA,.ENTP,$OPSY EXT MESSS,SESSN A EQU 0 B EQU 1 TAT EQU 1656B TAT BASE ADDRESS TATLG EQU 1755B NEGATIVE LENGTH OF TAT TATSD EQU 1756B # TRACKS ON LU#2 SECT2 EQU 1757B # SECTORS PER TRACK ON LU#2 SECT3 EQU 1760B # SECTORS PER TRACK ON LU#3 XEQT EQU 1717B ID SEGMENT ADDR OF CURRENT PROGRAM * SUP PRESS EXTRANEOUS LISTINGS SKP * PURPOSE: * TO ŽõþúACCOMPLISH THE EQUIVALENT OF A FMGR :RP,,PROG IN A SUBROUTINE. * * CALLED: * CALL IDRPD (NAME,IERR) * -OR- * IF (IDRPD (NAME,IERR).NE.0) GO TO IERROR * -OR- * IERR = IDRPD(NAME) * * WHERE: * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME DELETED FROM SYSTEM * IERR = (OPTIONAL) RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * * RETURN: * IERR = 0 > SUCCESSFUL DELETION OF ID SEGMENT FROM SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR FRETURN SPL) * IERR = 9 > ID-SEGMENT NOT FOUND * IERR = 17 > ID-SEGMENT NOT SET UP BY RP * (MEANING THAT THE PROGRAM IS NOT A TEMPORARY * LOAD OF A TYPE 2,3,4, OR 5 PROGRAM) * IERR = 18 > PROGRAM NOT DORMANT * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL) * (3) IERR IS AN OPTIONAL PARAMETER. * (4) CALLING PROGRAM MUST NOT BE PRIVILEGED. * * TEST PROGRAM: *FTN,L * PROGRAM TYRPD(2,99) * DIMENSION NAME(3),LU(5) * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT PROGRAM TO DELETE? _") * READ (LU,12) NAME * IF (NAME.EQ.2H/E) GO TO 9999 * 12 FORMAT (3A2) * IF(IDRPD(NAME,IERR).EQ.0) GO TO 9999 * 33 WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 STOP * END * END$ SKP NAME NOP PROGRAM NAME ADDRESS IERR NOP RETURNED ERROR CODE * IDRPD NOP ENTRY JSB $LIBR GO PRIVILEGED NOP JSB .ENTP DEF NAME * LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE SAVE FOR LOADA,STORA ROUTINES *780403* * JSB IDSGA FIND ID SEGMENT ADDR OF PROGRAM DEF *+2 DEF NAME,I STA IDADR SAVE ID(1) ADDRESS STA B nrþú SAVE IN B-REG LDA D9 GET SET FOR ERROR 9 SEZ FOUND? JMP ENDTA NO,FMGR ERROR 09 * ADB D8 BUMP TO XSUSP JSB LOADA GET XSUSP VALUE *780403* STA TEMP SAVE IT *780403* ADB O4 BUMP TO PROGRAM NAME WORD STB ID13 SAVE FOR LATER USE ADB O2 BUMP TO PROGRAM TYPE WORD STB ID15 SAVE FOR LATER USE * INB BUMP TO STATUS WORD (ID(16)) JSB LOADA GET STATUS WORD *780403* IOR TEMP MERGE WITH XSUSP VALUE *780403* ADB O2 BUMP TO ID(18) (CHECK NOT IN TIME LIST) STA TEMP TEMPORARY SAVE *780403* JSB LOADA GET THE T-BIT(IN TIME LIST) *780403* LDB TEMP RESTORE *780403* CCE,SZB,RSS SET E-REG IF PROG BUSY? *780403* ALF,CLE,ERA SET E=1 IF IN TIME LIST *780403* LDB ID15 GET ID(15) *780403* JSB LOADA *780403* AND O227 GET PROG TYPE & IDSEG TYPE BITS XOR O200 COMPLEMENT BIT 7 * LDB ID15 GET ID(15) ADDRESS *780403* ADB O5 MAKE ID(20) ADDRESS CPA O25 SHORT ID? JMP OKTYP YES 800227 ADB O7 BUMP TO ID(27) CPA O5 IF TYPE 5 LONG ID, THEN MAKE CLE,ARS SAME AS TYPE 2, NOT BUSY ARS CHANGE 2 & 3 TO 1 STA TEMP SAVE PGM TYPE & IDSEG TYPE BITS (SHIFTED) CPA O1 TYPE 2 OR 3? JMP TYPCK YES, TYPE 2, 3 OR 5 LONG ID LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? RSS YES, SO ALLOW TYPE 4 JMP ERR17 NO, WRONG TYPE LDA TEMP RESTORE PGM TYPE & IDSEG TYPE BITS (SHIFTED) CPA O2 TYPE 4 AND TEMPORARY? JMP TYPC2 YES, ALLOW•Dþú FOR RTE-IV *780524*GLM ERR17 CLA,CCE WRONG PROGRAM TYPE FMGR ERR 17 TYPCK INA TYPC2 ADA O20 A= 17 OR 18 SEZ,RSS CHECK IF ERR 17 OR PROG BUSY(ERR 18) JMP OKTYP NO, CONTINUE * ENDTA JSB $LIBX YES, RETURN ERROR DEF *+1 DEF EXIT * * AT THIS POINT, WE KNOW THAT WE HAVE A TEMPORARY LOAD OF A * TYPE 2, 3, 4, OR 5 PROGRAM. * * EXECUTE AN 'OF,PROG,8,NP' TO CLEAN UP ANY ID SEG OWNED RESOURCES * OKTYP DLD NAME,I NAME PASSED IN CALL DST PNAME (FIRST 2 WORDS OF NAME) LDB NAME ADDRESS OF NAME PASSED IN ADB O2 OFFSET TO 3RD WORD OF NAME LDA B,I GET 3RD WORD OF NAME AND C377 MASK OFF LOW BYTE IOR COMMA MERGE IN COMMA STA PNAM3 SAVE IN MESSAGE BUFFER * JSB SESSN TEST IF IN SESSION DEF *+2 DEF XEQT SEZ SKIP IF IN SESSION CLB,RSS NON-SESSION, ZERO THE SES PARAMETER CMB SESSION, PASS -SCB ADDRESS (IDSEG WD 32) STB SES * JSB $LIBX NOW TURN BACK ON INTERRUPT SYSTEM DEF *+1 DEF *+1 FOR CALL TO MESSS (GEORGE) * JSB OFF SEND 'OF,PROG,8,NP' NOP NOP JSB OFF ONCE MORE IN CASE ID SEG WASN'T CLEARED * CLA,CLE RETURN GOOD EXIT EXIT STA IERR,I RETURN ERROR CODE CLB CLEAR OPTIONAL PARAMETER STB IERR FOR NEXT CALLER TO DEFAULT JMP IDRPD,I RETURN * SKP * * MISC ROUTINES * * LOADA NOP DOES XLA B,I IF MAPPED SYS *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAPSY YES *780403* LDA B,I NO, DO DIRECT LOAD *780403* JMJ P LOADA,I RETURN *780403* MAPSY XLA B,I DO CROSS-LOAD (2-WD INSTRUCT.) *780403* JMP LOADA,I RETURN *780403* SPC 1 OFF NOP LDA DOFMS ADDRESS OF MESSAGE LDB DOUTM DESTINATION ADDRESS MVW O7 7 WORDS IN MESSAGE JSB MESSS SEND 'OF,PROG,8,NP' REQUEST DEF *+5 DOUTM DEF OUTMS MESSAGE BUFFER DEF D14 14 CHARACTERS DEF ZERO DEF SES SCB ADDR TO OVERRIDE CAPABILITY CHECK JMP OFF,I RETURN SKP STYPE BSS 1 OP SYSTEM IDENTIFIER (AFTER ERA) 800227 IDADR NOP ID13 NOP ID15 NOP SES NOP TEMP NOP M9 DEC -9 ZERO OCT 0 O2 OCT 2 O1 OCT 1 O4 OCT 4 O5 OCT 5 O7 OCT 7 D8 DEC 8 D9 DEC 9 D14 DEC 14 O20 OCT 20 O25 OCT 25 O227 OCT 227 O200 OCT 200 C377 OCT 177400 COMMA OCT 54 DOFMS DEF OFMSG OFMSG ASC 2,OF, DON'T REORDER THE NEXT 7 WORDS PNAME ASC 2, PNAM3 ASC 1, , PWRAB ASC 2,8,NP OUTMS BSS 7 END ­ÿÿ ÿý¡ « ÿ92067-18237 1903 S C0122 &SY..              H0101 pO SPL,L,O,M ! NAME: SY.. ! SOURCE: 92067-18237 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SY..(8) "92067-16185 REV.1903 780929" ! LET MESSS BE FUNCTION,EXTERNAL !SYSTEM MESSG PROCESSOR LET EXEC BE SUBROUTINE,EXTERNAL !ERROR PRINTING. LET O.BUF,ECH.,CAM.O BE INTEGER,EXTERNAL !TRANSLATED COMMAND. LET S.CAP, \GLOBAL 9P OVRD. BE INTEGER,EXTERNAL !CAPAB. CHECK OVERRIDE LET XEQT BE CONSTANT (1717K) ! ! SY..: SUBROUTINE GLOBAL BUF_@O.BUF+1 SES _ -$($XEQT+32) IF S.CAP THEN [IF OVRD. AND 40000K THEN \IF SESSION & CAP. OVERRIDE VAL_MESSS($BUF,ECH.+ECH.-2,CAM.O,SES), \OVERRIDE CAPAB. CHECK ELSE VAL_MESSS($BUF,ECH.+ECH.-2,CAM.O)], \NO CAPAB. OVERRIDE ELSE VAL_MESSS($BUF,ECH.+ECH.-2,CAM.O) !SEND COMMAND TO SYSTEM IF VAL THEN EXEC(2,CAM.O,$BUF,VAL) !IF ERROR PRINT IT RETURN END END END$ ièÿÿ ÿý¢¨ ÿ92067-18238 1940 S C0122 &CL.. FMGR CARTRIDGE LIST             H0101 ¸ÊþúSPL,L,O,M ! NAME: CL.. ! SOURCE: 92067-18238 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CL..(8) "92067-16185 REV.1940 790725" ! ! MODIFICATION RECORD: ! ! DATE REASON ! 1) 780427 TO USE 256-WORD BUFFER FOR DISC DIRECTORY ! 2) 780427 TO USE EXPANDED FSTAT CALL ! 3) 780427 TO ADD ALL OPTION ! 4) 780512 TO USE NEW CL FORMAT ! 5) 790116 TO HANDLE WRITE OF LOCK FLAGS FOR EMPTY ID SEGS. ! 6) 790222 TO CHECK FOR BREAK ! 7) 790725 TO USE $ACFL FOR ACCOUNT FILE DISC LU ! ! DISC DIRECTORY LIST ! ! ENTERED BY ! ! CL COMMAND ! ! DEFINE EXTERNALS ! LET OPEN.,IER.,WRITF,FSTAT,CONV.\ BE SUBROUTINE,EXTERNAL LET OPEN, \FMP OPEN ROUTINE CLOSE, \FMP CLOSE ROUTINE GTSCB, \RETRIEVE SESSION CONTROL BLOCK MSS., \FMGR ERROR MESSAGE ROUTINE PGS., \IDENTIFY SESSION DISC TYPE ACNAM \RETRIEVE ACCOUNT NAME BE SUBROUTINE,EXTERNAL ! LET IFBRK \CHECK BREAK FLAG BE FUNCTION,EXTERNAL ! LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET NAM.. BE INTEGER,FUNCTION,EXTERNAL LET .E.R., \ CL.BF, \BUFFER FOR CARTRIDGE DIRECTORY O.BUF, \ OVRD., \CARTRIDGE SEARCH OVERRIDE SM.BF, ]óþú \GENERAL BUFFER SCR., \2ND 2 COMMAND CHARACTERS S.CAP, \SESSION CAPABILITY LEVEL TMP. \ BE INTEGER,EXTERNAL ASSEMBLE ["EXT $SMGP";"EXT $SMID";"EXT $SMLK";"EXT $SMST"] ASSEMBLE ["EXT $ACFL"] LET ACTFL(3) BE INTEGER LET BLANK(3) BE INTEGER LET LINE(29) BE INTEGER INITIALIZE ACTFL TO "+@CCT!" INITIALIZE BLANK TO " " INITIALIZE LINE TO \ " LU LAST TRACK CR LOCK P/G/S USER/GROUP " LET KEYWD BE CONSTANT (1657K) ! ! CL..: SUBROUTINE GLOBAL T_@TMP.+3 ASSEMBLE ["LDA $SMGP";"STA SMGP";"LDA $SMID";"STA SMID"] ASSEMBLE ["LDA $SMLK";"STA SMLK";"LDA $SMST";"STA SMST"] ASSEMBLE ["LDA $ACFL";"STA ACFL"] OPEN.(O.BUF,TMP.,$T,0) !OPEN LIST FILE TB_@LINE+1 IF SCR. = "AL" THEN [N_24;IOP_1], \SET LENGTH OF HEADER TO PRINT ELSE [N_18;IOP_0] WRITF(O.BUF,.E.R.,LINE,N) !WRITE THE HEAD IER. WRITF(O.BUF,.E.R.,LINE,1) !SPACE A LINE IER. CALL FSTAT(CL.BF,256,1,IOP) !READ DIRECTORY OF DISCS ACN_[PGS_[PN_[PCR_[PTR_TB+5]+4]+2]+4]+2 !SET COLUMN PTRS. I_0 !INITIALIZE DIRECTORY ENTRY PTR IF S.CAP THEN [ \IF IN SESSION, THEN CALL GTSCB(SM.BF,144,IERR); \GET SCB CONTENTS GRID_@SM.BF-(SMLK+SMST); \ PRID_$(GRID+SMID); \GET PRIVATE ID GRID_$(GRID+SMGP)], \GET GROUP ID ELSE PRID,GRID_ -1 ! IF SCR. = "AL" OR S.CAP > 0 THEN \IF ALL OPTION OR IF SESSION [TEMP_OVRD.; \CARTRIDGE SEARCH OVERRIDE OVRD._OVRD. OR 100000K; \SET TO SEARCH ALL DISCS CALL OPEN(SM.BF,OER,ACTFL,1,-31178,ACFL); \OPEN ACCT FILE OVRD._TEMP] NEXT: CL4_[CL3_[CL2_[CL1_@CL.BF+I]+1]+1]+1 IF IFBRK() THEEþúN [MSS.(0);GO TO DONE] !CHECK FOR BREAK IFNOT $CL1 THEN [ \IF END OF DIRECTORY DONE: IF SCR. = "AL" OR S.CAP > 0 THEN \IF ALL OR IF SESSION CALL CLOSE(SM.BF); \CLOSE ACCOUNT FILE WRITF(O.BUF,.E.R.,T,-1);IER.; \ RETURN] ! I_I+4 !BUMP TO NEXT ENTRY FOR T_ TB TO ACN+10 DO[$T_LINE(1)] !BLANK OUT THE LINE CONV.($CL1 AND 377K,$TB,2) !CONVERT LU TO ASCII CONV.($CL2,$PTR,5) !CONVERT LAST TRACK TO ASCII $PCR_$CL3 IF NAM..($PCR)#0 THEN \IF NOT VALID NAMR, THEN CONV.($CL3,$PCR,5) !MAKE CRN 5 ASCII DIGITS IFNOT [T_$CL1 AND 177400K] THEN \IF NOT LOCKED, [N_11;GO TO WD4] !SKIP LOCK FLAG CONVERSION T_$($KEYWD+((T->8)-1))+12 !WORD 13 OF LOCKING IDSEG T2_[T1_PN+1]+1 !ADDRS OF WORDS 2,3 OF PGM NAME IFNOT $T THEN \IF ZERO IN NAME WORD, THEN CALL .DFER($PN,BLANK), ELSE \PUT BLANKS FOR LOCKING PGM [$PN_$T; \FIRST 2 CHARS OF PGM NAME $T1_$(T+1); \SECOND 2 CHARS OF PGM NAME $T2_($(T+2) AND 177400K) +40K] !LAST CHARACTER OF PGM NAME N_15 !SET LENGTH OF LINE TO PRINT ! WD4: ID_$CL4 AND 7777K !GET SESSION DISC ID IFNOT ID THEN GO TO WRT !IF NON-SESSION DISC, SKIP PGS IF ID=7777K THEN [C_3; \IF SYSTEM ID $PGS_"S ";GO TO GTNAM] ! IFNOT S.CAP THEN \IF NON-SESSION AND [IF SCR. # "AL" THEN GO TO WRT] !IFNOT "ALL", SKIP PGS WRITE IF ID=PRID THEN [C_1; \IF USER'S PRIVATE ID $PGS_"P ";GO TO GTNAM] ! IF ID=GRID THEN [C_2; \IF USER'S GROUP ID $PGS_"G ";GO TO GTNAM] ! IF OER < 0 THEN GO TO WRT, ELSE \IF OPEN ERROR, SKIP PGS WRITE CALL PGS.(SM.BF,ID,C) b_!PRIVATE,GROUP OR SYSTEM? IF C=1 THEN [$PGS_"P ";GO TO GTNAM] !IF PRIVATE, WRITE "P" IF C=2 THEN [$PGS_"G ";GO TO GTNAM] !IF GROUP, WRITE "G" IF C=3 THEN $PGS_"S " !IF SYSTEM, WRITE "S" GTNAM:IFNOT C THEN GO TO WRT !IFNOT P,G OR S, SKIP REST N_17 IF SCR. # "AL" THEN GO TO WRT !IF NOT ALL, SKIP ACCT NAME WRITE IREC_1 !SET UP FOR 1ST CALL TO ACNAM MORE: CALL ACNAM(SM.BF,ID,C,IREC,$ACN,N) !GET ACCOUNT NAME IF IREC<0 THEN [N_17;GO TO WRT] !IF ERROR, SKIP ACCT NAME WRITE N_N/2+19 !SET LINE LENGTH FOR FULL LINE IFNOT IREC THEN GO TO WRT !IF LAST NAME, JUST WRITE IT WRITF(O.BUF,.E.R.,LINE,N) !WRITE FULL LINE AND IER. !IF NO ERROR, THEN FOR T_TB TO ACN+10 DO [$T_LINE(1)] !BLANK OUT THE LINE GO TO MORE !GET NEXT NAME W/ SAME ID ! WRT: WRITF(O.BUF,.E.R.,LINE,N) IER. TL_TL+1 GO TO NEXT ! END END END$ µÿÿ ÿý£¬ ÿ92067-18239 1940 S C0122 &F.UTM FMGR LIST,LOG,SEVERITY             H0101 ?DþúSPL,L,O ! NAME: F.UTM ! SOURCE: 92067-18239 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME F.UTM(8) "92067-16185 REV.1940 790725" ! ! MODIFICATION RECORD: ! ! DATE REASON ! ! 1) 790725 TO RETURN ERROR IF :LL WITH NO PARAMETERS (SST #4510) ! LET TMP.,I.BUF,N.OPL,CAM.O BE INTEGER,EXTERNAL LET OPEN. BE SUBROUTINE,EXTERNAL LET G0..,.E.R.,.R.E.,S.CAP BE INTEGER,EXTERNAL LET .TTY,LUTRU BE FUNCTION,EXTERNAL LET EC.HO BE SUBROUTINE,EXTERNAL ! ! LL..: SUBROUTINE(N14,LIS14,ER14)GLOBAL !LIST CHANGE SUBROUTINE RC_@LIS14+1 !SET LIST ADDRESSES IFNOT N14 THEN [ER14_50;RETURN] !ERROR 50 IF NO PARAMETER IF LIS14 # 3 THEN [ \IF NOT ASCII, THEN IF S.CAP THEN [ \IF IN SESSION, THEN T2 _ LUTRU($RC); \CHECK IF LU DEFINED IN SST IF T2 = -1 THEN [ \IF NOT DEFINED, THEN ER14_43;RETURN]]] !RETURN ERROR, LU NOT DEFINED OPEN.(I.BUF,$RC,N.OPL,410K) !ATTEMPT OPEN T2_@TMP. !SET LIST DEF ADDRESS FOR T_RC TO RC+2 DO[\ $T2_$T;T2_T2+1] DO[$T2_N.OPL;$(T2+1)_ -(I.BUF AND 77K);RETURN] END ! ! LO..:SUBROUTINE(N13,LI13,ER13) GLOBAL ! NEW LOG UNIT SUBROUTINE IF .TTY([T_$(@LI13+1)]) THEN\ CAM.O_T,\ ELSE ER13_56 RETURN END ! SV..: SUBROUTINE(N15,LI15,ER15) GLOBAL RC_[T2_[T_@LI15+1]+4]+4 P7_@.R.E.+1 !SET ADDRESS OF P7 IF $RC # "IH" THEN [IFNOT $òØ  P7 THEN \ECHO IF CONDITIONS ARE RIGHT EC.HO] IF $T2 THEN[ \IF A GLOBAL PROVIDED SAVE THE IF $T2 > 0 THEN[ \MAKE SURE IT IS LEGAL IF $T2 < 10 THEN[ \1-9 ONLY T2_@G0..+($T2 -< 2); \SET BASE ADDRESS $T2_1;T2_T2+1; \SET THE TYPE $T2_$P7;T2_T2+1; \THE VALUE $[REAL]T2_0.0; \CLEAN THE OTHER WORDS GO TO SETSV \AND SKIP ERROR ] \ ]; \ ER15_56;RETURN \ILL NUMBER EXIT ] SETSV:IF $T<0 THEN $T_0 IF $T>4 THEN $T_4 $(@.E.R.+1),$P7_$T RETURN END ! END END$ Q ÿÿ ÿý¤« ÿ92067-18240 1903 S C0122 &OPMES              H0101 wžþú SPL,L,O ! NAME: OPMES ! SOURCE: 92067-18240 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME OPMES(8) "92067-16185 REV.1903 781229" ! ! MODIFICATION RECORD: ! ! DATE REASON ! (1) 780720 TO ALLOW SESSION WRITE TO LU 1 BY TE.. ! LET EXEC, \SYSTEM EXEC XLUEX, \EXTENDED LU EXEC EC.HO, \ECHO A COMMAND IF NOT DONE SO ALREADY OPEN., \OPEN OR FAKE OPEN TO DCB WRITF \FMP WRITE RECORD BE SUBROUTINE,EXTERNAL ! LET .TTY \DETERMINES IF LU IS A TTY. BE FUNCTION,EXTERNAL ! LET CAM.O, \LOG DEVICE LU C.BUF, \COMMAND INPUT BUFFER ECH., \NUMBER OF WORDS IN COMMAND NO.RD, \NO-READ FLAG CAD., \COMMAND TABLE ADDRESS TMP., \LIST FILE OR LU ARRAY O.BUF \LIST OUTPUT DCB BE INTEGER,EXTERNAL ! ! LET LU(2),LENTH,PTR,DEV,DEV1 BE INTEGER ! INITIALIZE DEV1 TO 0 INITIALIZE LU TO 0.0 ! ! ! ! PA..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER LU(1) _ @PLIST + 1 IFNOT $LU(1) THEN $LU(1) _ CAM.O !DEFAULT TO LOG. IF PLIST=3 THEN GO TO ERX !IF PRAM IS FILE ERROR IFNOT .TTY($LU(1)) THEN [ \IF DEVICE NOT ERX: ERR _ 20; RETURN] !INTERACTIVE, ERROR. IFNOT PLIST THEN PLIST _ 1 IFNOT ($LU(1) XOR CAM.O) AND 77K THEN[ \IF LOG DEVICE CALL EC.HO;GO TO EX] ul   !PRINT ONLY IF NOT ECHOED EXEC(2,$LU(1),C.BUF,ECH.) !PRINT THE COMMAND. EX: N,CAD.,NO.RD _ 1 !SET UP FOR TR. RETURN END ! ! TE..: SUBROUTINE GLOBAL LU(1)_100001K !SET FOR NO LU SWITCH XLUEX(2,LU,C.BUF,ECH.) !PRINT COMMAND ON RETURN !SYSTEM TTY END ! ! AN..: SUBROUTINE(NO,PARM,ERROR) GLOBAL LET NO,PARM,ERROR BE INTEGER DEV _ $(@TMP.+3) OPEN.(O.BUF,TMP.,DEV,212K) !OPEN LIST DEVICE. B377_377K;UBLK_20000K !DEFINE CONSTANTS ASSEMBLE["CCB"; \BLANK DELIMITER IN COMMAND "EXT C.DLM"; \ "ADB C.DLM"; \DELIMITER ADDRESS TO B "CLE,ERB"; \WORD ADDRESS NOW "LDA 1,I"; \DELIMITER TO A "AND B377"; \ISOLATE "IOR UBLK"; \REPLACE WITH BLANK "STA 1,I" ; \AND SET BACK "SEZ"; \SET UP THE B REG. "INB"] !AND EXIT ADD_.B. !SET THE ADDRESS WRITF(O.BUF,ERROR,$ADD,@C.BUF-ADD+ECH.)!PRINT COMMAND. RETURN END ! END END$ N ÿÿ ÿý¥¬ ÿ92067-18241 1903 S C0122 &JO..              H0101 `Gþú SPL,L,O ! NAME: JO.. ! SOURCE: 92067-18241 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME JO..(8) "92067-16185 REV.1903 790514" ! ! CHANGE HISTORY ! MODIFIED TO WORK WITH SIX WORDS PER ENTRY IN TRANSFER ! STACK (GLM). *780420* ! MODIFIED TO WORK WITH SESSION MONITOR (GAA) 780914 ! ! ! THE FOLLOWING ROUTINE PROCESSES THE :JOB CARD. ! LET ST.TM BE FUNCTION,REAL,EXTERNAL ! LET READF,WRITF,CLOSE,AVAIL,B.FLG, \ SET.T,EXEC,AB..,ONOFF,LULU.,EOJ, \ OPEN,EO..,SPOPN,RNRQ BE \ SUBROUTINE,EXTERNAL ! LET TL.P,TM.VL BE REAL,EXTERNAL ! LET RANGE, \FIND SPOOL FILE CR LOGLU, \FIND LOG DEVICE LU KCVT, \CONVERT BIN TO 2 DIGIT ASCII POST \POST FILE BUFFERS BE FUNCTION,EXTERNAL ! LET ACTV.,I.BUF,BUF.,CAD.,NO.RD,JRN.,\ OVRD.,N.OPL,G0..,TMP.,J.REC,P.TR BE \ INTEGER,EXTERNAL ! LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET DM BE REAL ! LET BLKS(3) BE INTEGER INITIALIZE BLKS TO " " LET SPOL.,SPOL1 BE INTEGER LET JOBFL BE INTEGER(3),GLOBAL LET PAR1,PAR2,PARM2,PAR3,PARM3,PAR4, \ NSSW,MASK,FNUM,LEN,PTR,PTR2,RSTAT,\ SETUP,SMDLU,MASK BE INTEGER ! INITIALIZE JOBFL TO "JOBFIL" INITIALIZE SPOL.,SPOL1 TO "SPOL" ! LET NMASK BE CONSTANT(10000K) 2þþú LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! JO..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER NSSW _ 0 !RESET NO-SPOOL SWITCH. PAR4 _ [PARM3 _ [PAR3 _ [PARM2 _ \SET UP POINTERS. [PAR2 _ [PAR1 _ @PLIST + 1] + 7] \ + 1] + 3] + 1] + 4 CALL EO..(-1,PLIST,ERR) !CHECK EOJ. IFNOT PLIST THEN CALL .DFER($PAR1,BLKS) !IF NO NAME USE BLANKS RSTAT,ACTV. _ P.TR !SET ACTIVE JOB SWITCH CALL EXEC(11,BUF.,$(@BUF.+5)) TL.P,TM.VL _ ST.TM(N.OPL,$(@N.OPL+1))!SET UP TIME CALL B.FLG(1) !PUT IN BATCH MODE CALL SET.T(TM.VL,DM) !FOR THE JOB. ASSEMBLE["EXT $SPCR";"LDA $SPCR";"STA SPCR"] ! GET SPOOL CR IF $PAR2 = 3 THEN[ \DEFAULT JOB PRIORITY, $PAR4_$PARM2;$PARM2,$PARM3 _ 99; \IF NECESSARY, AND CHECK GOTO OPJOB] !FOR "NS" KEYWORD. IFNOT $PARM2 THEN $PARM2 _ 99 IF ($PARM2 < 0) OR ($PARM2 > 255) THEN [\ $PARM2_255] !PRIORITY OUT OF RANGE USE 255 IF $PAR3 = 3 THEN[ \DEFAULT SPOOL PRIORITY $PAR4_$PARM3; $PARM3 _ $PARM2] !IF NECESSARY, AND CHECK IFNOT $PARM3 THEN $PARM3 _ $PARM2 !FOR "NS" KEYWORD. IF ($PARM3 < 0) OR ($PARM3 > 9999) THEN \TEST LIMITS ON SPOOL PR $PARM3_9999 !DEFAULT SPOOL PR IF OUT OF RANGE OPJOB: IF $PAR4 = "NS" THEN NSSW _ 400K DPF_412K !SET DISPOSITION FOR OUT IF $PAR4 = "NO" THEN DPF_410K !IF HOLD REQUESTED SET IT IFNOT J.REC THEN GOTO EJECT IF POST(I.BUF) = -9 THEN[ \IF JOB FILE NOT OPEN OVRD. _ [FNUM _ OVRD.] OR 100000K; \SAVE AND SET OVERRIDE FLAG CALL OPEN(I.BUF,ERR,JOBFL,IOPTN,SEC,SPCR); \OPEN UP JOBFIL. OVRD. _ FNUM] ãcþú !RESET THE OVERRIDE FLAG IF ERR < 0 THEN GOTO ABORT !STUFF. ABORT ON OTHER MASK,FNUM,ERR _ 0 !ERROR. IF "NS" KEY, SETUP _ [PTR _ @BUF.+5] + 1 !BYPASS SOME SETUP. POST(I.BUF) RNRQ(1,JRN.,RSTAT) !LOCK JOBFIL RN. IF NSSW THEN [PTR _ SETUP + 16; \ TMP._LOGLU(ID); \IF NO LIST DEFAULT IT TO LOGLU GOTO RDJOB] LULU.(6,0) !MAKE SURE WE HAVE GOTO NOMAP !$LUSW SPACE. REPEAT 16 TIMES DO \CLEAR SETUP BUFFER. [$[PTR _ PTR+1] _ 0] $(SETUP+1) _ 6 !SET THE LIST LU IN SPOPN BUFFR $[REAL](SETUP+2) _ $[REAL]@SPOL. CALL READF(I.BUF,ERR,$[PTR_PTR+1], \READ JOBFIL RECORD 17. 16,LEN,17) IF ERR THEN GOTO ABORT CALL AVAIL($(PTR+4),MASK,FNUM) !FIND AVAIL. SPOOL FILE.(SET BIT) $(SETUP+4) _ KCVT(FNUM) OR NMASK CALL READF(I.BUF,ERR,$(PTR+32)) !READ JOBFIL RECORD 18. IF ERR THEN GOTO ABORT $(SETUP+5) _ SEC !SECURITY CODE. $(SETUP+6) _ RANGE(FNUM,$(PTR+32)) !FIND CARTRIDGE ID. $(SETUP+7) _ 12K !DRIVER TYPE (LP). $(SETUP+8) _ DPF !DISPOSITION FLAGS. $(SETUP+9) _ $PARM3 !SPOOL PRIORITY $(SETUP+10) _ "W" !SPOOL STATUS. $(SETUP+11) _ J.REC + 100000K !PUT IN THE JOB REC. NO. $(SETUP+15) _ 6 !SAVE OUTSPOOL LU. WRITF(I.BUF,ERR,$PTR,16,17) POST(I.BUF) !CLEAR WAY FOR SMP. RNRQ(4,JRN.,RSTAT) SPOPN($SETUP,PAR2) !CALL SMP TO OPEN SPOOL. POST(I.BUF) RNRQ(1,JRN.,RSTAT) IF PAR2< 1 THEN GOTO SFAIL !FAILED RELEASE SPOOL FILE $[PAR4 _ @G0..-8] _ 1 !SíLþúET THE GLOBALS, $(PAR4+1) _ PAR2 !0S AND 1S WITH $(PAR4+4) _ 3 !THE NAME AND LU# CALL .DFER($(PAR4+5),$(SETUP+2)) !OF THE LIST SPOOL CALL LULU.(6,PAR2) GOTO EJECT RDJOB: CALL READF(I.BUF,ERR,$[PTR2_PTR+16], \READ JOBFIL RECORD FOR 16,LEN,J.REC) !CURRENT JOB. $PTR2 _ $PARM2 + NSSW !UPDATE THE INFORMATION. CALL .DFER($(PTR2+7),$PAR1) !SET JOB NAME IN RECORD $[PAR4 _ PTR2 + 10] _ $PARM3 !SPOOL PRIORITY LEN _ PAR4 + 1 + ((FNUM-1) >-4) $LEN _ $LEN OR MASK !SET SPOOL-IN-USE BIT. WRITF(I.BUF,ERR,$PTR2,16,J.REC) !REWRITE THE JOB RECORD IF ERR THEN GOTO RELRN EJECT: G0.. _ [IF $(P.TR-3) THEN 3,ELSE 1] !SET ASCII\NUMERIC FLAG*780420* CALL .DFER($(@G0..+1),$(P.TR-5)) !SAVE CURRENT NAMR *780420* IFNOT $PAR1 THEN $PAR1,$(PAR1+1), \ $(PAR1+2) _ 20040K IFNOT NSSW THEN [ \IF PRINTING NOT INHIBITED TMP. _ 6; \SET UP LIST LU AND CALL EXEC(3,1106K,-1); \DO TOP OF FORM AND CALL ONOFF($PAR1,BUF.); \PUT OUT THE TIME ON MESSAGE CALL EXEC(3,1106K,-1)] !AND THROW AWAY THAT PAGE TOO GOTO RELRN ! SFAIL: CALL READF(I.BUF,ERR,$PTR,16,LEN,17) !SETUP FAILED GET POOL FLAGS LEN_PTR+4+((FNUM-1) >- 4) !COMPUTE ADDRESS OF FLAG WE SET $LEN_$LEN AND (NOT MASK) !AND CLEAR IT CALL WRITF(I.BUF,ERR,$PTR,16,17) !REWRITE THE FLAGS GO TO SUSP !NOW GO REPORT THE ERROR ! ABORT: CAD. _ 6; NO.RD _ 1 !SET UP FOR AB.. GOTO RELRN NOMAP: ERR _ -24 GOTO RELRN SUSP: ERR _ PAR2 RELRN: IF RSTAT = 2 THEN [POST(I.BUF); \ RNRQ(4,JRN.,RSTAT)] RETURN ! END END END$ nÿÿ ÿý¦ ° ÿ92067-18242 1903 S C0122 &EO..              H0101 aBþúSPL,L,O ! NAME: EO.. ! SOURCE: 92067-18242 ! RELOC: 92067-16185 ! PGMR: A.M.G, G.A.A ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME EO..(8) "92067-16185 REV.1903 790514" ! ! MODIFIED TO WORK WITH SIX WORDS PER ENTRY IN TRANSFER ! STACK (GLM). *780420* ! ! ! LET ONOFF, \ON OFF MESSAGE PRINTER LULU., \LU SWITCH ROUTINE DTACH, \DETACH FROM SESSION ROUTINE READF, \FILE READ ROUTINE LU.CL, \LU SWITCH AND SPOOL CLEAR ROUTINE B.FLG, \BATCH FLAG CLEAR/SET ROUTINE IFBRK, \OPERATOR BREAK ROUTINE WRITF, \FILE WRITE ROUTINE OPEN, \FILE OPEN ROUTINE EXEC, \DARNED IF I KNOW EX.TM, \EXECUTE TIME ROUTINE OPEN., \INTERNAL OPEN ROUTINE CONV., \NUMBER TO ASCII ROUTINE FM.ER, \MESSAGE ROUTINE CLOS., \INTERNAL CLOSE ROUTINE RNRQ, \RESOURCE NUMBER ROUTINE POST \FILE POST ROUTINE BE SUBROUTINE,EXTERNAL ! ! LET L.SEG BE LABEL,EXTERNAL ! LET LUSES, \GET SCB ADDRESS FUNCTION LOGLU ^•þú \GET LOG LU FUNCTION BE FUNCTION,EXTERNAL ! LET RD,WR,JO.EO BE SUBROUTINE,DIRECT ! LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET FM.AB BE LABEL,EXTERNAL LET ACTV., \ACTIVE FLAG (INDEX TO TR STACK) P.TR, \POINTER TO CURRENT INPUT UNIT CAMS., \ADDRESS OF TR STACK CAD., \OFF SET OF NEXT SUB IN SEG. TBL. NO.RD, \NO READ FLAG I.BUF, \INPUT DCB BUF., \GENERAL UTILITY BUFFER JOBFL, \ASCII "JOBFIL" J.REC, \JOBFIL REC NO. OF JOB C.BUF, \COMMAND INPUT BUFFER D.R, \ASCII "D.RTR" S.CAP, \SESSION CAPABILITY FLAG TMP., \LIST FILE O.BUF, \OUTPUT DCB CUSE., \CURRENT SEGMENT SUFFIX G0.., \GLOBAL TABLE POINTER CAM.O, \LOG LU JRN., \JOBFIL RN NUMBER CAM.I, \COMMAND INPUT DCB OVRD., \OVERRIDE FLAG TTY. \COMMAND INPUT INTERACTIVE FLAG BE INTEGER,EXTERNAL ! LET .E.R. BE REAL,EXTERNAL ! LET PTR1,PTR2,PTR3,PTR4,PTR5,PTR6, \ TIME,YR,SWTCH,JSTAT BE INTEGER ! !*780420* LET TRENT BE CONSTANT (5) !INDEX TO TR STACK FOR CURRENT FILE LET LIST,BLIST(3) BE INTEGER LET LGOFF(3) BE INTEGER LET LG0 BE REAL LET ABRT(7),FILX,DM,LU BE INTEGER !DEFINE MESSAGE IdOþúNITIALIZE ABRT,FILX,DM,LU TO " ABEND EOJ IN SSSSSS" INITIALIZE LIST,BLIST TO 1,0,0 INITIALIZE LG0 TO "LG,0" INITIALIZE LGOFF TO "LGOFF " ! LET LEN,SAVE BE INTEGER ! LET XEQT BE CONSTANT(1717K) ! EO..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET PLIST BE REAL LET N,ERR BE INTEGER ASSEMBLE["EXT $SPCR";"LDA $SPCR";"STA SPCR"] !GET SPOOL CR ASSEMBLE["EXT $LGOF";"LDA $LGOF";"STA LGOF"] !GET LOGOFF CLASS RGOP_[SPOP_@PLIST+1]+4 !SET ADDRESSES FOR OPTIONS YR _ [TIME _ [PTR15 _[PTR14 _ [PTR6 _ [PTR5 _ [PTR4 \ _ [PTR3 _ [PTR2 _ [PTR1 _ @BUF.+1]\ + 1] + 1] + 1] + 1] + 1] + 8]+ 1]+ 1] + 5 ! IF ACTV. = 1 THEN GO TO JOCL !IF EXPECTING JOB STMT. GO DO IT IFNOT ACTV. THEN[ \IF NOT ACTV. OR IF AFTER JO CMD. JOCL: IF N < 0 THEN CALL JO.EO, \IF JO CALLING DO EO.JO ELSE[ \ IF ACTV. = 1 THEN GO TO EOOK]; \IF ABORT CALL LET IT GO RETURN] !NOW JUST EXIT NSSW_0 !SET THE LIST OK SWITCH ! IF P.TR=ACTV. THEN GO TO EOOK ! ! EOJ IN A FILE SO ABORT ! CALL .DFER(FILX,$(P.TR-TRENT)) !PUT FILE NAME IN MESSAGE IF FILX< " " THEN CALL CONV.(FILX AND 77K,LU,6) !IF LU CONVERT ! CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),0) !OPEN THE LIST FILE CALL FM.ER(2,ABRT,10) !SENT MESSAGE TO LOG CALL WRITF(O.BUF,.E.R.,ABRT,10) !AND TO THE LIST DEVICE NO.RD,CAD._6 !SET TO CALL THE ABORT ROUTINE GO TO FM.AB !GO ABORT ! EOOK: IFNOT J.REC THEN GOTO EO1 OVRD._ [NSSW _ OVRD.] OR 100000K !SAVE OVERRIDE AND SET NEW ONE OPEN(I.BUF,ERR,JOBFL,3,123456K,SPCR) !OPEN JOBFIL. OVRD. _ NSSW !RESET THE OVERRIDE FLAG POST(I.BUF) RNRQ(1,UþúJRN.,JSTAT) RD(J.REC) !CHANGE JOB STATUS. NSSW_BUF. AND 400K !GET THE NS FLAG FROM JOB REC. $PTR2 _ "CS" SWTCH_0 !IF NO SPOOLS FOR REC_ PTR1+10 TO PTR15 DO[SWTCH_ $REC OR SWTCH] !THEN IFNOT SWTCH THEN BUF._ -1 !PURGE JOB FROM SYSTEM CALL WR CALL RD(17) !GET THE GENERAL WAIT RN CALL RNRQ(4,$PTR14,JSTAT) !LET JOB GO IF NEEDED EO1: ACTV. _ 0 !RESET ACTIVE SWITCH. IFNOT NSSW THEN[ \IF LIST IS ACTIVE EXEC(11,$TIME,$YR); \GET TIME. ONOFF(0,$TIME); \PRINT ENDING CALL EX.TM; \MESSAGES. CALL CLOS.(O.BUF)] !CLOSE THE LIST FILE IFNOT J.REC THEN GOTO NOTJO REC_(J.REC-1)/16 OFF_$1 + @BUF. !COMPUTE BUFFER OFSET OF FLAG CALL RD(REC) !GET THE RECORD SWTCH_$OFF !SAVE CURRENT FLAG WORD $OFF_0 !ZAP IT IN THE QUEUE CALL WR !WRITE THE RECORD BACK OUT CALL RD(1) !NOW UPDATE THE QUEUE HEAD OFF_@BUF.+1 !ADDRESS OF THE QUEUE HEAD $OFF_($OFF XOR SWTCH) AND 377K XOR $OFF CALL WR !WRITE IT OUT POST(I.BUF) RNRQ(4,JRN.,JSTAT) CALL LU.CL !CLOSE ALL SPOOLS. EX.OP_20377K !COMPUTE SIGN OFF OPTIONS IF $RGOP = "RG" THEN EX.OP_EX.OP+40000K IF $SPOP = "RP" THEN EX.OP_EX.OP+100000K FINIS: IF S.CAP THEN CALL DTACH !IF IN SESSION THEN DTACH DO [ \ IFNOT [SID _ LUSES(255)] THEN GO TO CLCLX; \ CLNUM_0; Paþú \SET UP A RETURN CLASS CALL EXEC(20,0,0,0,0,0,CLNUM); \GET THE CLASS NUMBER CALL EXEC(20,0,CLNUM,1,EX.OP,SID,LGOF); \LOG OFF DLNUM_CLNUM+20000K; \SET DON'T DEALLOCATE BIT CALL EXEC(100012K,LGOFF); \THE JOB SESSION GO TO SESRT; \ABORT RETURN DEALLOCATE THE # CALL EXEC(21,DLNUM,0,0,I,I,I); \GET MY CLASS PUT SESRT: CALL EXEC(21,DLNUM,0,0,I,F,I); \GET LOGOFF CLASS PUT IF F > 0 THEN GO TO SESRT; \ CLRCL: CALL EXEC(100025K,CLNUM,0,0,I,I,I);\RELEASE THE CLASS NUMBER GO TO CLCLX; \DONE ON ABORT RETURN GO TO CLRCL; \ELSE DO ANOTHER GET \ CLCLX: S.CAP_0] !CLEAR THE CAPABILITY FLAG NOW NOTJO: GN8_[GN1_@G0.. -1]-7 FOR I_ GN8 TO GN1 DO[$I_0] !ZERO THE SPOOL GLOBALS CALL B.FLG(0) !RESET BATCH FLAG. CALL JO.EO !DO JO/EO CLEAN UP IFNOT J.REC THEN [IF N= -2 THEN[\ NO.RD,CAD._1;PLIST_0.0];RETURN] CAD._0;CUSE._"77";GO TO L.SEG !GO TO NEXT JOB EX: RETURN END ! ! JOB/END JOB CLEAN UP ROUTINE ! JO.EO: SUBROUTINE DIRECT LIST _ LOGLU(DUM) CALL .DFER(TMP.,LIST) !RESET THE LIST DEVICE .E.R._0.0 !SET THE SEVERITY CODE TO 0 IFNOT J.REC THEN LULU.(0,0) !CLEAR ALL LU XFORMS GO TO JO1 JO1: CAM.O_401K !SET LOG TO SYS TTY IF TTY. THEN CAM.O_$(@CAM.I+3) PTR4_[PTR3_[PTR2_[PTR1_@G0..+4]+35]+2]+6 FOR I_PTR1 TO PTR2 DO[$I_0] !CLEAR 1G - 9G FOR I_PTR3 TO PTR4 DO[$I_0] !CLEAR 1P - 7P CALL IFBRK !CLEAR ANY BRAKE FLAG RETURN !EXIT DONE END ! ! SUBROUTINE TO READ A 16 WORD JOB FILE RECORD ! RD: S‡Â$"UBROUTINE(R) DIRECT CALL READF(I.BUF,ERR,BUF.,16,LEN,R) !READ THE RECORD W_R !SET WRITE ADDRESS IF ERR THEN GO TO EX RETURN END ! ! ROUTINE TO WRITE THE ABOVE RECORD ! WR: SUBROUTINE DIRECT CALL WRITF(I.BUF,ERR,BUF.,16,W) IF ERR THEN GO TO EX RETURN END END END$ 5G$ÿÿ ÿý§ ² ÿ92067-18243 1903 S C0122 &OF..              H0101 YLþú SPL,L,O ! NAME: OF.. ! SOURCE: 92067-18243 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME OF..(8) "92067-16185 REV.1903 790209" ! ! LET MESSS BE FUNCTION,EXTERNAL !SYSTEM MESSG PROCESSOR LET FM.ER \ MESSAGE PRINT BE SUBROUTINE, EXTERNAL LET .DFER \3-WORD TRANSFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET OF1(2),OF2,OF3(2),OF4 BE INTEGER LET BUF.,S.CAP,OVRD. BE INTEGER,EXTERNAL LET XEQT BE CONSTANT (1717K) ! INITIALIZE OF1,OF2,OF3,OF4 TO " OF, ,8" ! OF..: SUBROUTINE (N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER ! .DFER(OF2,$(@PLIST+1)) !SET UP MESSAGE. J _ @BUF. FOR I _ @OF1 TO @OF4 DO [ \MOVE TO BUF. $J _ $I; J _ J + 1] IF S.CAP THEN [ \IF IN SESSION, THEN IF OVRD. AND 40000K THEN \IF OVERRIDE SET, THEN VAL_MESSS(BUF.,12,0,-$($XEQT+32)),\OVERRIDE CAP.CHECK OF "OF..." ELSE VAL_MESSS(BUF.,12)], \SEND "OF,NAME,8" TO SYSTEM ELSE VAL_MESSS(BUF.,12) ! IFNOT VAL THEN RETURN !CHECK ERRORS CALL FM.ER(1,BUF.,VAL) !PRINT ERROR MESSAGE AND RETURN !TR TO LOG. END END END$ z  ÿÿ ÿý¨¯ ÿ92067-18244 1903 S C0122 &NX.JB              H0101 ˆmþúSPL,L,O ! NAME: NX.JB ! SOURCE: 92067-18244 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME NX.JB(8) "92067-16185 REV.1903 790301" ! ! MODIFICATION RECORD: ! ! DATE REASON ! (1) 780420 TO WORK WITH 6 WORDS PER ENTRY IN THE TRANSFER ! STACK (GLM) ! (2) 780720 TO DETACH FROM SESSION FOR BATCH PROCESSING (BL) ! (3) 780913 TO HANDLE NEW JOB FILE FORMAT AND JOB/SESSION (GAA) ! (4) 790103 TO REQUEST RN LOCK WITH NO ABORT (BL) ! ! THE FOLLOWING ROUTINE SEARCHES THE JOBFIL FOR ! THE NEXT JOB TO PROCESS. ! LET J.REC, \RECORD # IN JOBFIL OF CURRENT JOB J.NAM, \JOB NAME ARRAY JRN., \JOBFIL RN # CAM.I, \COMMAND INPUT DCB I.BUF, \DCB AREA BUF., \GENERAL FILE I/O BUFFER CAMS., \COMMAND STACK P.TR, \POINTER TO CURRENT CAMS. POSITION NO.RD, \NO READ FLAG FOR PARSE SEGMENT ACTV., \JOB ACTIVE FLAG CAD., \NEXT COMMAND ADDRESS LOCATION CAM.O, \LOG DEVICE TTY., \INTERACTIVE DEVICE SWITCH TMP., \LIST LU CUSE., \CURRENT SEGMENT SUFFIX G0.., \ENTRY INTO GLOBAL STORAGE TABLE OVRD., \OVERRIDE FLAG S.TTY, \8P - SESSION TERMINAL LU S.CAP \9P - SESSION CAPABILITY BE INTàjþúEGER,EXTERNAL ! LET L.SEG BE LABEL,EXTERNAL !RETURN ADDRESS IN MAIN LET .LGON \LOGON FROM ACCT # ROUTINE BE PSEUDO,EXTERNAL,DIRECT ! LET POST, \POST FILE BUFFERS ICAPS, \CAPABILITY FETCH ROUTINE LUSES, \SESSION ID TRANSLATER FG.LU \LU SWITCHER FOR SESS. BE FUNCTION,EXTERNAL ! ! LET READF, \FMGR READ WRITF, \FMGR WRITE MSS., \ERROR MESSAGE WRITER CLOSE, \FMGR CLOSE FILE EXEC, \SYSTEM I/O FM.ER, \FMGR ERROR MESSAGE ROUTINE LU.CL, \LU SWITCH CLEAN UP LULU., \MODIFIES LU TRANSFORM TABLE OPEN, \FMGR OPEN FILE OPEN., \INTERNAL OPEN ROUTINE APOSN, \FMGR POSITION FILE SPOPN, \CALLS SMP TO OPEN UP SPOOL B.FLG, \SET BATCH FLAG IN ID SEG. RNRQ, \RESOURCE NUMBER CONTROL DTACH \DETACH FROM SESSION BE SUBROUTINE,EXTERNAL ! LET PTR,PTR1,PTR2, \BUFFER POINTERS NEXT, \SAVED INDEX INTO JOBFIL LIST JOBFL(3), \NAME OF 'JOBFIL' LGOFF(3), \NAME OF 'LGOFF ' CDEV, \COMMAND DEVICE CDEV1(2), \ FM,GR,UBL, \ASC FMGR JSTAT \STATUS OF JOBFIL RN. BE INTEGER ! INITIALIZE LGOFF TO "LGOFF " INITIALIZE CDEV,CDEV1 TO 5,0.0 INITIALIZE JOBFL TO "JOBFIL" INITIALIZE FM,GR,UBL TO "FMGR",20000K LET RD,WR BE SUBROUTINE,DIRECT ! LET .DFER BE SUBROUTINE,EXTERNAL,DIREbþúCT LET A BE CONSTANT(0) LET XEQT BE CONSTANT(1717K) ! ! ***** SUBROUTINE STARTS HERE ***** ! NX.JB: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER ! ASSEMBLE ["EXT $SPCR";"LDA $SPCR";"STA SPCR"] ASSEMBLE ["EXT $LGOF";"LDA $LGOF";"STA LGOF"] IFNOT SPCR THEN GO TO ERRET !IF SPOOL NOT SET UP: EXIT PTR4_[PTR3_[PTR2_[PTR1_$1717K+12]+1]+1]+6 IF $PTR1 = FM THEN[ \ONLY FMGR CAN RUN IF $PTR2 = GR THEN[\ IF ($PTR3 AND 177400K) = UBL THEN \ GO TO OK]] GO TO ERRET !ELSE JUST GO TERMINATE ! OK: IF ($PTR4 AND 40000K) THEN[ \IF WE ARE CURRENTLY A SON CALL EXEC(12,FM,1,0,-1); \PUT SELF IN TIME LIST FOR 10 MS CALL EXEC(6,0,0,-1)] !AND TERMINATE PASSING A -1 TO SELF ! CALL DTACH !DETACH FROM SESSION JSTAT _ 1 IF POST(I.BUF) # -11 THEN GO TO GETRN !IS JOBFIL OPEN? OVRD. _ [NEXT _ OVRD.] OR 100000K !SAVE AND SET OVERRIDE FLAG OPEN(I.BUF,ER ,JOBFL,3,123456K,SPCR) !OPEN UP JOBFIL. OVRD. _ NEXT !RESTORE THE OVERRIDE FLAG IF ER = 2 THEN GO TO GETRN !IF NO JOBFIL,RETURN. ERRET: CLOSE(I.BUF) !MAKE SURE JOBFIL CLOSED. CALL EXEC(6) !NOTHING TO DO. ! GETRN: RD(17) PTR15_[PTR10_[PTR7_[PTR6_[PTR4_[PTR3_ \SET POINTERS [PTR2_[PTR1_@BUF.+1]+1]+1]+1]+2]+1]\ +3]+5 WBF_[PTS15_[PTS11_[PTS9_[PTS8_[PTS7_ \ [PTS6_[PTS5_[PTS2_[PTS1_[PTS_ \ PTR15+1]+1] \ +1]+3]+1]+1]+1]+1]+2]+4]+1 JRN. _ BUF. !SAVE JOBFIL RN. IF $PTR15 = "D" THEN GO TO ERRET !IF SHUT DOWN THEN EXIT POST(I.BUF) RNRQ(40001K,JRN.,JSTAT) GOTO ERRET ! ! THIS SECTIO ÔþúN OF CODE PROCESSES THE JOB QUEUE. ! THE JOB QUEUE IS LOCATED IN THE FIRST 16 RECORDS OF THE JOBFIL. ! EACH POSSIBLE JOB HAS A ONE WORD ENTRY IN THIS QUEUE. THIS ! WORD, BY ITS POSITION IN THE FILE INDICATES, AN ASSOCIATED JOB ! RECORD (RECORD # = OFSET FROM 1'ST WORD + 17). ! THE FIRST WORD OF THE JOB QUEUE CONTAINS THE JOBFIL RN (SET BY GASP). ! THE SECOND WORD CONTAINS TWO 8-BIT POINTERS TO A) THE NEXT JOB ! TO RUN (LEFT BYTE) AND B) THE HEAD OF THE JOB WAITING QUEUE ! (RIGHT BYTE). THE REST OF THE 256 WORD QUEUE CONTAINS A ! LINKED LIST OF JOBS. EACH LIST ELEMENT HAS TWO 8-BIT PARTS ! A) THE JOB PRIORITY (LEFT BYTE) AND B) A POINTER TO THE NEXT ! ENTRY IN THE QUEUE (RIGHT BYTE). A POINTER OF ZERO INDICATES ! THE END OF THE LIST. ! ! WHEN A JOB IS STARTED A CHECK IS MADE TO SEE IF ! IS THE SAME AS . IF NOT THEN THE JOB POINTED TO BY ! IS TO BE ABORTED. IF THEY ARE THE SAME THEN THE ! POINTED IS UPDATED TO POINT TO THE JOB POINTED TO ! BY THE POINTED AT (I.E. THE NEXT JOB AFTER THE ONE ! INDICATED BY ). THE JOB INDICATED BY IS THEN ! SET UP AND STARTED. BY THIS CONVENTION WE DERIVE THE FOLLOWING ! BENIFITS: ! ! 1) JOB ARE LINKED IN A FIRST IN, FIRST OUT FASHION WITHIN ITS ! PRIORITY. ! 2) IF FMGR IS ABORTED WHILE RUNING A JOB THE AND ! FLAGS WILL SO INDICATE AND THE OFFENDING JOB MAY BE ABORTED ! ON THE NEXT ENTRY TO THIS ROUTINE. ! 3) THE POINTER INDICATES WHERE THE JOB LIST SEARCH MUST ! BEGIN FOR A NEW JOB TO BE INSERTED IN THE LIST. ! 4) GASP MAY SCHEDULE A JOB ABORTION BY REQUEUEING A JOB TO BE ! BE IN THE LIST BETWEEN AND . ! 5) JOB DISPATCH IS RELATIVELY EASY (JOB QUEUEING IS HARDER ! HOWEVER, BUT THAT CODE IS ELSE WHERE (GASP,JOB)). ! ! RD(1) «þú !READ THE HEAD OF THE QUEUE NEXT_($PTR1 -< 8) AND 377K !GET THE NEXT POINTER HEAD_$PTR1 AND 377K !AND THE HEAD OF THE LIST IFNOT HEAD THEN GO TO ERRET !IF HEAD IS ZERO THEN NO JOBS IF NEXT # HEAD THEN[ \IF HEAD # NEXT THE HEAD MUST BE ABORTED J.REC_HEAD+17; \SET UP THE JOB RECORD NUMBER GO TO ABRT1] !AND GO FINISH THE ABORT ! ! NO JOBS TO ABORT COMPUTE LOCATION OF THE CONTROL ENTRY FOR ! THE JOB AT THE HEAD OF THE LIST SO THAT WE MAY UP DATE THE ! POINTER. ! REC_(HEAD/16)+1 !16 WORD RECORDS BUFPT_$1+@BUF. !REMAINDER IS THE BUFFER OFFSET IF REC # 1 THEN CALL RD(REC) !IN NOT IN MEMORY GET IT NEXT_$BUFPT AND 377K !GET THE NEXT POINTER IF REC # 1 THEN CALL RD(1) !IF RECORD 1 NOT IN THEN GET IT BACK $PTR1_(NEXT -< 8)+HEAD !SET THE NEW NEXT POINTER CALL WR(1) !WRITE IT TO THE FILE ! ! NOW SET UP THE JOB WE SET NEXT = J.REC TO FLAG NOT TO ABORT ! J.REC,NEXT_HEAD+17 !COMPUTE THE JOB'S RECORD NUMBER ! ABRT1: RD(J.REC) !NEXT JOB SELECTED. $PTR2 _ "A" !MAKE JOB ACTIVE WR(J.REC) !WRITE OUT JOBFIL RECD. CALL POST(I.BUF) !POST THE FILE CALL RNRQ(4,JRN.,JSTAT) !AND RELEASE THE LOCK CALL .DFER(J.NAM,$PTR7) !SET JOB NAME IN CASE ABORT FOR I_PTS TO PTS15 DO[ $I_0] !ZERO OUT AREA WHICH WILL ! ! SET UP A SPOOL CONTROL RECORD TO INSPOOL THE JOB ! $PTS_1 !FIX UP SET UP BUFFER $PTS1_5 !SET SWITCH LU INCASE SESSION IFNOT [FL_$PTR3 AND 177400K] THEN œBþú\IF DIRECT, SET LU $PTS1 _ $PTR3 CALL .DFER($PTS2,$PTR3) !NAME OF FILE. $PTS5 _ 123456K !SECURITY CODE. $PTS6 _ $PTR6 !CARTRIDGE ID. $PTS7 _ 11K !DRIVER TYPE. I_103K IF $PTR3 = "SP" THEN[IF $PTR4 = "OL" \SET UP DISPOSITION THEN I_112K ] !FLAGS FOR SPOOL POOL $PTS8_I+40220K $PTS9 _ $PTR10 !SPOOL PRIORITY. $PTS11 _ J.REC + 100000K !JOB NUMBER. ! CALL LU.CL !RELEASE ANY OPEN SPOOLS LULU.(0,0) GO TO OP OP: .LGON($WBF),ERR_$PTR1 !LOG ON THIS USER USING ACCT# ERRF _ .B. !LOG ON ERROR FLAG S.CAP_0 !FROM THE JOB RECORD S.TTY_1 !SET LOG LU IF ERR < -1 THEN[ \IF SESSION LOG ON ERROR IF ERRF = 8 THEN[ \IF DUP.SESSION ID THEN IFNOT [SID _ LUSES(255)] THEN GO TO OP; \ CLNUM_0; \SET UP A RETURN CLASS CALL EXEC(20,0,0,0,0,0,CLNUM); \GET THE CLASS NUMBER CALL EXEC(20,0,CLNUM,1,20377K,SID,LGOF); \LOG OFF DLNUM_CLNUM+20000K; \SET DON'T DEALLOCATE BIT CALL EXEC(100012K,LGOFF); \THE JOB SESSION GO TO SESRT; \ABORT RETURN DEALLOCATE THE # CALL EXEC(21,DLNUM,0,0,I,I,I); \GET MY CLASS PUT SESRT: CALL EXEC(21,DLNUM,0,0,I,F,I); \GET LOGOFF CLASS PUT IF F > 0 THEN GO TO SESRT; \ CLRCL: CALL EXEC(100025K,CLNUM,0,0,I,I,I);\RELEASE THE CLASS NUMBER GO TO OP; \DONE ON ABORT RETURN GO TO CLRCL]; \ELSE DO ANOTHER GET \ CALL FM.ER(2,$WBF,ERR); \SEND THE PASSED BACK MESSAGE §Lþú ERR _ 69; \SET ERROR GO TO ABRT] !ABORT THE JOB IFNOT ERR THEN S.CAP_ICAPS() !IF LOGON OK THEN SET CAPABILITY IFNOT NOT ERR THEN ERR_ 0 !IF ERR = -1 SET TO 0 (NOT=> COMP) IF FL THEN SPOPN($PTS,$PTS1) !OPEN THE INPUT SPOOL. IF $PTS1 < 0 THEN [ \IF NO LU AVAILABLE, ERR _ $PTS1; GOTO ABRT] !ABORT THE JOB. LULU.(5,$PTS1) !SET UP LU TRANSFORM. GOTO NOMOR !IF ERROR GO ABORT ! IF S.CAP THEN[ \IF A DIRECT LU AND IN SESSION IFNOT FL THEN[ \THEN WE MUST SET UP A SWITCH ERR _ FG.LU(5,$PTS1,0,$WBF); \FOR LU 5 IF ERR THEN GO TO ABRT]] ! PTR5_[PTR4_[PTR1_[PTR_@G0.. -8] \GLOBALS 0S AND 1S. +1] +3] +1 $PTR1_$PTS1 $PTR4 _ 3 CALL .DFER($PTR5,$PTS2) IF NEXT # J.REC THEN GO TO ABRT !IF ABORT THEN GO DO IT ! ABT2: CALL B.FLG(1) !SET BATCH FLAG. TMP. _ 1 !SET UP A LIST LU FOR NOW P.TR_@CAMS. !ZAP THE COMMAND STACK ACTV. _ 1 !SET JOB STMT. EXPECTD FLAG IF JSTAT = 2 THEN [POST(I.BUF); \POST FILE BUFFERS CALL RNRQ(4,JRN.,JSTAT)] !AND CLEAR THE JOBFIL RN CALL OPEN.(CAM.I,CDEV,CDEV1,401K) !OPEN THE COMMAND DEVICE IF TTY. THEN CAM.O _ 5 !IF TTY SET LOG DEVICE. CUSE._ "1 " !SET UP TO CALL THE HOME SEG IF ERR THEN CALL MSS.(ERR) !IF ERR REPORT IT GO TO L.SEG !AVOID CLOSE OF JOBFIL (JO NEEDS) ! ! EITHER A UNEXPECT ACTIVE JOB OR INPROPER SYS GEN. SO ! ABORT THE JOB ! NOMOR: ERR _ -24 !IND. NO LU SWITCHES. ABRT: CAD.,NO.RD_6 J0.* !SET FLAGS TO GO TO ABORT ACTV._ @CAMS. + 6 !SET SO ABORT TAKES IT.*780420* GO TO ABT2 !GO EXIT END ! ! SUBROUTINE TO READ A RECORD TO BUF. ! RD: SUBROUTINE(R) DIRECT CALL READF(I.BUF,ERR,BUF.,16,LEN,R) !READ THE RECORD IF ERR THEN GO TO ERRET !IF ERROR EXIT RETURN !ELSE RETURN END ! ! SUBROUTINE TO WRITE A RECORD ! WR: SUBROUTINE(W) DIRECT CALL WRITF(I.BUF,ERR,BUF.,16,W) !WRITE THE RECORD IF ERR THEN GO TO ERRET !IF ERROR EXIT RETURN !ELSE RETURN END END END$ ÔN0ÿÿ ÿý© ¶ ÿ92067-18245 1903 S C0122 &LG..              H0101 \I SPL,L,O ! NAME: LG.. ! SOURCE: 92067-18245 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME LG..(8) "92067-16185 REV.1903 780929" ! LET MESSS BE FUNCTION,EXTERNAL !SYSTEM MESSG PROCESSOR LET FM.ER BE SUBROUTINE,EXTERNAL !ERROR PRINTING. LET O.BUF,ECH., \TRANSLATED COMMAND S.CAP BE INTEGER,EXTERNAL !9P - SESSION CAPABILITY LET XEQT BE CONSTANT (1717K) ! ! LG..: SUBROUTINE GLOBAL ! IF S.CAP THEN \IF SESSION, OVERRIDE CAPCK VAL_MESSS(O.BUF,ECH.+ECH.,0,-$($XEQT+32)), \SEND COMMAND TO ELSE VAL_MESSS(O.BUF,ECH.+ECH.) !SYSTEM IF VAL THEN FM.ER(2,O.BUF,VAL) !IF ERROR PRINT IT. RETURN END END END$ ù¾ÿÿ ÿýª° ÿ92067-18246 1903 S C0122 &LU..              H0101 kIþúSPL,L,O ! NAME: LU.. ! SOURCE: 92067-18246 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME LU..(8) "92067-16185 REV.1903 790514" ! ! LET .LUAV BE FUNCTION,DIRECT,EXTERNAL ! LET KCVT, \TWO-DIGIT INTEGER TO ASCII RANGE, \FINDSCR # OF SPOOL POOL FILE SELUR, \FORMAT SESSION LU MESSAGE FG.LU, \ROUTINE TO FUDGE SST CAPCK \CAPABILITY CHECK ROUTINE BE FUNCTION,EXTERNAL ! LET EXEC, \SYSTEM EXEC RNRQ, \RN # CONTROL AVAIL, \FINDSAVAILABLE SPOOL FILE. SPOPN, \SPOOLOPEN SUBROUTINE LULU., \SET UP $LUSW OPEN, \FMP OPEN FILE READF, \FMP READ RECORD WRITF, \FMP WRITE RECORD POST, \POST FILE LUTRU, \ROUTINE TO GET TRUE LU XLUEX \LONG LU EXEC CALL BE SUBROUTINE,EXTERNAL ! LET .DFER, \MOVE THREE WORDS SUB JER. \CHECK FOR ERRORS AND BREAK BE SUBROUTINE,DIRECT,EXTERNAL ! LET JRN., \JOBFIL RN # J.REC, \JOBFIL RECD. # OF ACTIVE JOB ACTV., \ACTIVE JO›öþúB FLAG G0.., \GLOBALS ENTRY POINT BUF., \FILE I/O BUFFERS CAM.O, \LOG DEVICE LU I.BUF, \DCB AREA CAD., \COMMAND ADDRESS NO.RD, \NO-READ FLAG N.OPL, \SUB-PARAMETER ARRAY OVRD., \CAPABILITY OVERRIDE FLAG S.CAP \SESSION CAPABILITY FLAG BE INTEGER,EXTERNAL ! LET RD,WR BE SUBROUTINE,DIRECT LET IFDSC BE FUNCTION,DIRECT ! LET JOBFL(3) \ASCIISTRING "JOBFIL" BE INTEGER ! LET SPOL. BE REAL ! INITIALIZE JOBFL,SPOL. TO "JOBFIL","SPOL" LET IOPTN BE CONSTANT(3) LET LUMAX BE CONSTANT(1653K) LET NMASK BE CONSTANT(10000K) LET SEC BE CONSTANT(123456K) ! LET SMP BE INTEGER(3) LET DISP,ATTAB BE INTEGER(11) ! INITIALIZE DISP TO 2K,400K,600K,402K,\ \ NO WR BU WN 0K,1K,20K,0,200K,0K,0K ! BU PU ST SA RE SH BLANK INITIALIZE ATTAB TO "NOWRBOWNBUPUSTSARESH " INITIALIZE SMP TO "SMP " ! ! LU..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER ! ! THE FOLLOWING STATEMENT GETS AROUND COMPILER BUG. ! $(@DISP+4) _ 100000K ! PRIOR _ [PAR4 _ [LU2 _ [ATT _ [PAR3 \SET UP POINTERS _ [NAMR _ [PAR2 _ [LU1 _ @PLIST \TO PARAMETER + 1] + 3] + 1] + 3] + 1] + 4] \STRING. + 3] + 1 PROG_[PAR5_PRIOR+3]+1 !ADDRESSES OF PROG PRAM. PTS15_[ \ PTS12_[PTS11_[PTS10_[PTS9_[PTS8_[PTS7_[PTS6_[PTS5_[ \SET ADDS PTS4_[PTS3_[PTS2_[PTS1_@BUF.+1]+1]+1]+1]+1]+1]+1]+ \ 1]+1]+1]+1]+1]+3 S0 _ @G0.. - 8 IFNOT PLIST THEN [ ê)þú \IF NO FIRST PRAM THEN WE FOR J _ 1 TO 255 DO[ \PRINT THE WHOLE LIST CALL LUTRU(J,SYSLU); \TRANSLATE THE LU IF SYSLU >= 0 THEN[ \IF THERE IS ONE THEN LU1 _ SELUR(J,BUF.); \FORMAT THE MESSAGE IF $PTS4 # "IN" THEN \IF IT LOOKS OK CALL EXEC(2,CAM.O,BUF.,LU1)]; \REPORT IT CALL JER.]; \CHECK FOR BREAK RETURN] !DONE WITH REPORT ! IF ($LU1 <= 0 OR $LU1 >255) THEN [ \IF LU1 OUT OF RANGE, ILLAC: ERR _ -20; RETURN] !THEN RETURN ERROR. IF N = 1 THEN[ \IF ONLY ONE PARAMETER CALL EXEC(2,CAM.O,BUF.,SELUR($LU1,BUF.));\FORMAT THE REPORT RETURN] !ALL DONE WITH ONE PRAM. ! IFNOT ACTV. OR S.CAP THEN[ \IF NOT IN SESSION OR JOB QUIT ERR56: ERR _ 56; RETURN] !WITH ERROR (BAD PRAM) ! IF $LU1 = 1 THEN GO TO ER42 !IF LU IS ONE THEN ERROR ! IF J.REC THEN [ \MAKE SURE USER DOES NOT IF $LU1 = 5 THEN GOTO ER42] !CLOBBER THE INSPOOL. ! L2,L3_0 !SET UP THE CAPABILITY FLAGS IF S.CAP THEN[ \IF IN SESSION CHECK THE LEVELS IF (OVRD. AND 40000K) THEN \IF OVERRIDING CAPABILIY GO TO CAPOK; \DON'T WORRY ABOUT IT IF CAPCK("L2",-2) > 0 THEN \SET UP LU LEVEL 2 L2_.B.; \AND IF CAPCK("L3",-2) > 0 THEN \LEVEL 3 L3_.B.] CAPOK: IF L2 THEN[ \IF NOT CAPABLE OF L2 THEN ERROR ILCAP: ERR_46;RETURN] !SO FLUSH HIM OUT ! IFNOT S.CAP THEN[ \IF NOT USEING SESSION SST IF .LUAV($LU1) THEN GO TO ILLAC] !PREVENT USER FROM ! ! Èþú DO MOST ERROR CHECKING HERE BEFORE WE FOUL THE TABLE ! IF $LU1 > 63 THEN[ \IF A LARGE LU THEN ERR52: ERR _ 52; RETURN] ! THEN IT'S A NO-NO! ! IF $NAMR # "- " THEN[ \IF NOT CLEARING AN LU THEN IF $PAR2 = 1 THEN[ \IF SECOND LU IS GIVEN IF $NAMR < 0 THEN GO TO ERR52; \IF NEGATIVE, ERROR IF $NAMR > $LUMAX THEN GO TO ERR52;\IF TOO BIG THEN A NO-NO! IF $LU1 # $NAMR THEN[ \AND IT IS DIFFERENT IF IFDSC($LU1) THEN GO TO ER42; \IT MUST NOT BE A DISC IF IFDSC($NAMR+100000K) THEN GO TO ERR52]],\MUST NOT BE DISC ELSE[ \IF SECOND PRAM IS A FILE THEN IFNOT J.REC OR S.CAP THEN GO TO ERR56]] !THEN MUST BE JOB OR SESS. ! ! CLEAR ALL SPOOLS CONNECTED TO THIS LU ! SW_ -1 !SW WILL BE 0 IF THERE WERE NONE CLSPL: CALL LUTRU($LU1,SYSLU) !GET CURRENT MAPPING SW _ SW+1 !STEP THE LOOP COUNT CALL EXEC(100027K,SMP,4,$LU1) !IF SPOOL LU THEN CLOSE IT. GO TO NOSMP !ERROR RETURN FROM SMP CALL NOSMP: CALL LUTRU($LU1,LUSYS) !GET THE MAPPING NOW IF LUSYS # SYSLU THEN GO TO CLSPL !IF SOME EFFECT THEN TRY AGAIN ! LULU.($LU1,"- ") !CLEAR TABLE ENTRY. GO TO SETSW !INDICATE NO ROOM. ! SETSW: IF $NAMR = "- " THEN[ \IF A CLEAR REQUEST IF SW THEN RETURN, \IF SMP ALREADY MADE A CHANGE ELSE GO TO CLRU] !RETURN ELSE GO CLEAR ! IF $PAR2 # 1 THEN GO TO SPLST !IF SPOOL SET UP GO DO IT ! CLRU: IF S.CAP THEN \IF SESSION THEN ERR _FG.LU($LU1,"- ",L3,BUF.) !CLEAR THE LU IF POSSIBLE IF $NAMR = "- " THEN RETURN !IF CLEAR WAS REQUESTED DONE & þú! ERR_0 !CLEAR ERROR FLAG INCASE SET CALL LUTRU($LU1,SYSLU) !GET CURRENT THE MAPPING IF ANY ! ! SWITCH: IF $NAMR =SYSLU THEN RETURN !IF ALREADY SET JUST RETURN IF S.CAP THEN[ \IF IN SESSION ERR_FG.LU($LU1,$NAMR,L3,BUF.)],\CALL THE SST FIXER ELSE[ \OTHER WISE USE THE BATCH ROUTINES LULU.($LU1,$NAMR); \SET LU SWITCH, GO TO SUSP] !BRANCH ON ERROR RETURN !RETURN IF OK. ! ER42: ERR_42;RETURN !CAN'T SWITCH ERROR ! SPLST: PTR _ @BUF.-1 REPEAT 16 TIMES DO [ \CLEAR THE SETUP $[PTR _ PTR + 1] _ 0] !BUFFER. $(PTS7) _ 11400K !PRESET TYPE TO MT. EXEC(100015K,$LU1,$(PTS7)) !GET LU1 DRIVER TYPE. GO TO NEXT NEXT: $PTS7 _ ($PTS7 AND 37400K) -< 8 !PUT TYPE INTO THE IF [LEN_ $(PTS7) AND 77K] >= 30K \FOR DISK LU'S, AND (LEN <= 34K) THEN GOTO ILLAC !WHICH ARE ILLEGAL. ASSEMBLE["EXT $SPCR";"LDA $SPCR";"STA SPCR"]!GET SPOOL CR I_0 !SET DEFAULT USER OPTION WORD IFNOT J.REC THEN[ \CHECK IF FILE NEEDS TO BE OPENED IF $PAR2 THEN GO TO REGLR] !NOT UNLESS JOB OR SPOOLPOOL OVRD. _ [FNUM _ OVRD.] OR 100000K !SAVE AND SET OVERRIDE OPEN(I.BUF,ERR,JOBFL,IOPTN,SEC,SPCR) !OPEN UP JOBFIL. OVRD. _ FNUM !RESET OVERRIDE FLAG IF ERR < 0 THEN GOTO RELRN !REPORT DISK ERROR. MASK,FNUM _ 0 IFNOT $PAR2 THEN[ \LOCK UP THE FILE ONLY IF POOL IFNOT J.REC THEN[ \ IF NOT JOB THEN CALL RD(1,$PTS15); \ MUST GET THE JOBFIL RN JRN. _ $PTS15]; \ FROM REC. 1 W„+þúORD 1. POST(I.BUF); \ RNRQ(1,JRN.,JSTAT)] !OK TO USE JOBFIL? IF J.REC THEN[ \ONLY READ JOB REC IF IN JOB CALL RD(J.REC,$[PTR1_PTR+17])] !IF NAMR IS DEFAULT, IF $PAR2 THEN GO TO REGLR !IF NO POOL FILE NEEDED SKIP CALL RD(18 ,$[PTR32_PTR+33]) !(GET SPOOL LOCATION REC. CALL RD(17 ,$[PTR _PTR+1]) ! AVAIL($(PTR+4),MASK,FNUM) !FIND AN AVAIL. ONE. IFNOT FNUM THEN [ \CHECK FOR ERRORS. NOMOR: ERR _ -23; \REPORT ERROR -  GOTO RELRN] !NO SPOOL POOLS. IF FNUM > $(PTR+2) THEN GOTO NOMOR !CONTINUE CHECKING. $(PTS4) _ KCVT(FNUM) OR NMASK !CONCOCT FILE NAME. $(PTS5) _ SEC !SECURITY CODE. $(PTS6) _ RANGE(FNUM,$PTR32) !CARTRIDGE ID. $[REAL](PTS2) _ SPOL. !SPOOL FILE NAME. $PTS8 _ 412K !SET DEFAULT FLAGS. WRSPHO IFNOT $LU2 THEN $PTS8_12K !DEFAULT TO BOSPHO (ST LATER) IF $PAR5 = 3 THEN GO TO BADPM !PROG NOT ALLOWED IF POOL GOTO SAME REGLR: CALL .DFER($(PTS2),$NAMR) !SPOOL FILE NAME. $(PTS5) _ $(@N.OPL+5) !SECURITY CODE. $(PTS6) _ $(@N.OPL+6) !CARTRIDGE ID. $PTS8 _[IF $LU2 THEN 3K ,ELSE 203K]!SET DEFAULT FLAGS. WR-REHOSA SAME: IFNOT $LU2 THEN I_20K !IF NO OUTSPOOL LU SET TO ST FILE ! ! SPOOL SET UP DEFAULTS ARE: WR = WRITE ONLY ! RE = READ ONLY ! !SPOOL POOL FILE ! USER FILE ! BO = BOTH READ AND WRITE ! !-------------------!--------------! ST = STANDARD FILE ! OUT LU ! WR HO SH SP ! WR HO SH SA ! SH = OUTSPOOL HEADERS ! !-------------------!--------------! SP = SPOOL POOL FILù¿þúE ! NO OUT LU! BO HO ST SP ! RE HO ST SA ! HO = HOLD TILL CLOSE ! !-------------------!--------------! SA = SAVE (DON'T PURGE) ! IF J.REC THEN $PTS11_J.REC+100000K !JOB #. $PTS1_$LU1 !SET LU DEFAULT FOR SESSION IFNOT $PAR3 THEN GOTO OPSPL REPEAT 3 TIMES DO [ \GET DISPOSITION PTR2 _ @ATTAB - 1; \FLAGS SET UP. PTR3 _ @DISP - 1; \ FOR J _ 1 TO 11 DO [ \PICK UP A MAXIMUM IF $ATT = "SH" THEN I_I AND 177757K;\ SH NEEDS SPECIAL ACTION IF $ATT = $[PTR2_PTR2+1] THEN \OF THREE FILE GOTO HAVIT]; \ATTRIBUTES TO BADPM: ERR _ 56; GOTO RELRN; \DISPOSITION OF THE HAVIT: I _ I OR $(PTR3+J); \FILE. ATT _ ATT + 1] OPSPL: $PTS8 _ $PTS8 XOR I IF [J _ I AND 600K] THEN[ \IF READ OR WRITE DEFALULT IF J = 600K THEN J _ 0; \CHANGED SET REWR TO BO $PTS8 _ ($PTS8 AND 177177K) OR J]!AND SET THE NEW OPTION $(PTS15) _ $LU2 IF $PAR4 THEN [ \CHECK LEGALITY OF IF $PRIOR < 1 OR $PRIOR > 9999 \PRIORITY, IF THEN GOTO BADPM], \SUPPLIED. ELSE[ \PRAM NOT SUPPLIED FIGURE DEFAULT $PRIOR_[IF J.REC THEN $(PTR1+10), \USE SPOOL PRIORITY FROM ELSE 99]] !JOB RECORD ELSE USE 99 $PTS9_$PRIOR !SET SPOOL PRIORITY $(PTS10) _ "W" !SUPPLY INITIAL STATUS. IF $PAR5=3 THEN[ \IF PROGRAM NAME SUPPLIED IFNOT L3 THEN \AND HE HAS THE CAPABILITY CALL .DFER($PTS12,$PROG), \MOVE IN THE NAME ELSE \ELSE GIVE CAP ERROR GO TO ILCAP] IF $PAR2 THEN GO TO SPCAL @þú!IF NOT SPOOL POOL GO DOIT CALL WR !WRITE OUT REC 17 (POOL BITS) POST(I.BUF) !POST AND RELEASE RN RNRQ(4,JRN.,JSTAT) !IN PREPARATION FOR SPCAL: SPOPN(BUF. ,PAR3) !THIS CALL TO SMP. IF PAR3 < 0 THEN [ \CHECK FOR ERROR IFNOT $PAR2 THEN[ \IF NOT POOL JUST EXIT RNRQ(1,JRN.,JSTAT); \LOCK IT UP CALL RD(17,$PTR); \IF ERROR THEN LEN_PTR+4+((FNUM-1) >- 4); \MUST CLEAR BIT IN POOL TBL. $LEN_$LEN AND (NOT MASK); \ CALL WR]; \WRITE THE CORRECTED RECORD ERR _ PAR3; \SET ERROR FOR RETURN GOTO RELRN] !NOW WE HAVE FIXED THE MESS LULU.($LU1,PAR3) !TRY TO SET LU SWITCH. GOTO SUSP !FAILED - LEAVE. IFNOT $PAR2 THEN [ \IF SPOOL SETUP OK IF J.REC THEN[ \AND IF A JOB RNRQ(1,JRN.,JSTAT); \LOCK UP THE FILE CALL RD(J.REC,$PTR1); \SET UP TO SET LEN_PTR1+ 11 + ((FNUM-1) >-4); \THIS OWNERSHIP IN $LEN_$LEN OR MASK; \JOB'S JOBFIL RECORD. CALL WR ]] !WRITE THE RECORD. $S0 _ 1; $(S0+1) _ PAR3 !SET UP GLOBALS 0S $(S0+4) _ 3; $(S0+5) _ $(PTS2) !AND 1S WITH THE LU $[REAL](S0+6) _ $[REAL](PTS3) !AND SPOOL FILE NAME. GOTO RELRN !NOW EXIT GRACEFULLY. ! ! SUSP: ERR _ -24 RELRN: IF JSTAT = 2 THEN [POST(I.BUF); \MAKE SURE FILE IS RNRQ(4,JRN.,JSTAT)] !POSTED AND RN UNLOCKED. RETURN END ! ! RD: SUBROUTINE (R,B) DIRECT CALL READF(I.BUF,ERR,B,16,LEN,R) !ROUTINE TO READ FROM JOB IF ERR < 06400 THEN GO TO RELRN !FILE R1_R !SAVE PRAMS FOR WRITE B1_@B RETURN END ! ! WR: SUBROUTINE DIRECT CALL WRITF(I.BUF,ERR,$B1,16,R1) !WRITE THE SAME RECORD BACK OUT IF ERR < 0 THEN GO TO RELRN !EXIT ON ERROR RETURN END IFDSC :FUNCTION(LU) DIRECT CALL XLUEX(100015K,LU,SEQ5) !GET STATUS ON THE LU GO TO IFFLS !IF ERROR TAKE FALSE EXIT ! IF (SEQ5 AND 36000K) = 14000K THEN \IF A DISC RETURN 1 !RETURN TRUE IFFLS: RETURN 0 !ELSE RETURN FALSE END END END$ ,96ÿÿ ÿý« ¹ ÿ92067-18247 1903 S C0122 &TL..              H0101 cQ SPL,L,O ! NAME: TL.. ! SOURCE: 92067-18247 ! RELOC: 92067-16185 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME TL..(8) "92067-16185 REV.1903 740801" ! ! LET ST.TM BE FUNCTION,EXTERNAL,REAL ! LET N.OPL BE INTEGER,EXTERNAL LET TL.P BE REAL,EXTERNAL ! TL..: SUBROUTINE (N,PLIST) GLOBAL TL.P_ST.TM($(@PLIST+1),N.OPL) !SET THE TIME LIMIT RETURN END END END$ +ÿÿ ÿý¬² ÿ92067-18248 1903 S C0122 &CS..              H0101 k@þúSPL,L,O ! NAME: CS.. ! SOURCE: 92067-18248 ! RELOC: 92067-16185 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CS..(8) "92067-16185 REV.1903 790406" ! ! LET SMP BE INTEGER(3) LET ATTAB BE INTEGER(9) ! INITIALIZE ATTAB TO "SAPUPAENNPBUNBRW" INITIALIZE SMP TO "SMP " ! LET EXEC, \SYSTEM I/O LULU., \SET LU SWITCHES RMPAR \GET PARAMETERS BE SUBROUTINE,EXTERNAL ! ! CS..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER LET PRIOR,PAR4,LU2,PAR3,ATT,PAR2, \MAKE DECLARATIONS LU1 BE INTEGER PRIOR _ [PAR4 _ [LU2 _ [PAR3 _ [ATT \SET UP POINTERS _ [PAR2 _ [LU1 _ @PLIST + 1] \TO PARAMETERS. + 3] + 1] + 3] + 1] + 3] + 1 IFNOT $PAR2 THEN [J _ 4; GOTO CSMP] !SUPPLY DEFAULT "EN" PTR _ @ATTAB - 1 FOR J _ 1 TO 8 DO [ \SEARCH ATTRIBUTE LIST IF $[PTR_PTR+1] = $ATT THEN \FOR A MATCH. GOTO HAVIT] BADPR: ERR _ 56; RETURN !BAD PARAMETER. HAVIT: IF J = 8 THEN [ \HAVE A REWIND EXEC(23,SMP,9,$LU1,0,0,-128); \USE POSITION REQUEST SO IT WORKS RETURN] !EVEN IF SPOOL HEADERS CSMP: IF J # 5 THEN [ \CALL SMP TO DO EXEC(23,SMP,J,$LU1); \THE FUNCTION. IF J=4 THEN [CALL LULU.($LU1,"- ");\IF END CLEAR LU GOTO RTN]; à{  \SWITCH TABLE ENTRY. RTN: RETURN] IFNOT $PAR3 THEN $LU2 _ -1 !SET UP FOR CALL. IFNOT $PAR4 THEN GOTO CSMP2 IF $PRIOR < 1 OR $PRIOR > 9999 THEN \CHECK IF NEW GOTO BADPR !PRIORITY IS LEGAL. CSMP2: EXEC(23,SMP,5,$LU1,$LU2,$PRIOR) RMPAR(PRIOR) !GET ERROR CODE. ERR _ PRIOR RETURN END END END$ SÓ ÿÿ ÿý­´ ÿ92067-18249 1903 S C0122 &HE..              H0101 ^ESPL,L,O,M ! NAME: HE.. ! SOURCE: 92067-18249 ! RELOC: 92067-16185 ! PGMR: B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME HE..(8) "92067-16185 REV.1903 781012" ! LET RU.. BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET HELP(3) BE INTEGER INITIALIZE HELP TO "HELP " ! ! HE..: SUBROUTINE (N,LIS,ER) GLOBAL LIS_3 !SET 1ST PARAMETER AS ASCII PLIS_@LIS+1 !SET "HELP " AS VALUE OF 1ST CALL .DFER($PLIS,HELP) !PARAMETER FOR RUN COMMAND CALL RU..(1,LIS,ER) !CALL RU.. TO RUN HELP PROGRAM RETURN END END END$ ã=ÿÿ ÿý®´ ÿ92067-18250 1903 S C0122 &WH..              H0101 XUSPL,L,O,M ! NAME: WH.. ! SOURCE: 92067-18250 ! RELOC: 92067-16185 ! PGMR: B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME WH..(8) "92067-16185 REV.1903 781101" ! LET RU.. BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET WHZAT(3) BE INTEGER INITIALIZE WHZAT TO "WHZAT " ! ! WH..: SUBROUTINE (N,LIS,ER) GLOBAL LIS10_[LIS9_[OPT_[LIS5_[PLIS_@LIS+1]+3]+1]+3]+1 CALL .DFER($LIS10,$OPT) !MOVE 2ND PARM (OPTION) TO 3RD $LIS9_$LIS5 CALL .DFER($OPT,$PLIS) !MOVE 1ST PARM (LU) TO 2ND $LIS5_LIS LIS_3 !SET 1ST PARM AS ASCII CALL .DFER($PLIS,WHZAT) !SET "WHZAT " AS 1ST PARM CALL RU..(N+1,LIS,ER) !CALL RU.. TO RUN WHZAT PGM RETURN END END END$ Š¼ÿÿ ÿý¯µ ÿ92067-18251 1903 S C0122 &SM..              H0101 ^Q SPL,L,O ! NAME: SM.. ! SOURCE: 92067-18251 ! RELOC: 92067-16185 ! PGMR: B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SM..(8) "92067-16185 REV.1903 790102" ! LET NAMR, \NAMR PARSE ROUTINE SM.SB \SEND MESSAGE SUBROUTINE BE SUBROUTINE,EXTERNAL LET C.BUF(40), \COMMAND INPUT BUFFER ECH. \COMMAND LENGTH BE INTEGER,EXTERNAL LET IPBUF(10) \NAMR PARSE RETURN BUFFER BE INTEGER ! ! SM..: SUBROUTINE (NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER IS_1 !STARTING CHAR FOR PARSE CALL NAMR(IPBUF,C.BUF,80,IS) !PARSE TO USER.GROUP NAME IF IS>80 THEN [ERR_55;RETURN] !IF END, MISSING PARAMETER I_IS/2 IF (I*2 # IS) THEN I_I+1, \IF ODD, ADD EXTRA WORD ELSE C.BUF(I)_(C.BUF(I) AND 377K) OR 20000K !ELSE PAD BLANK IF I>ECH. THEN [ERR_55;RETURN] CALL SM.SB(C.BUF(I),ECH.-I+1,ERR) RETURN END END END$ µ ÿÿ ÿý°¶ ÿ92067-18252 1903 S C0122 &ME..              H0101 WK SPL,L,O ! NAME: ME.. ! SOURCE: 92067-18252 ! RELOC: 92067-16185 ! PGMR: B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME ME..(8) "92067-16185 REV.1903 790109" ! ! LET ME.SB BE SUBROUTINE,EXTERNAL !LIST MESSAGES SUBROUTINE ! ME..: SUBROUTINE (N,PLIS,ERR) GLOBAL LET N,PLIS,ERR BE INTEGER PURGE_@PLIS+5 CALL ME.SB(PLIS,$PURGE,ERR) RETURN END END END$ •Ãÿÿ ÿý±· ÿ92067-18254 1903 S C0122 &CT..              H0101 hAþúSPL,L,O,M ! NAME: CT.. ! SOURCE: 92067-18254 ! RELOC: 92067-16185 ! PGMR: B.L. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME CT..(8) "92067-16185 REV.1903 790226" ! LET NAMR, \NAMR PARSE ROUTINE OPENF, \FMP TYPE 0/FILE OPEN XLUEX \EXTENDED LU EXEC BE SUBROUTINE,EXTERNAL LET .CLRB \CLEAR TERMINAL BIT MAP BE SUBROUTINE,EXTERNAL,DIRECT LET XFTTY, \EXTENDED LU TTY? ROUTINE LUTRU \FETCH TRUE (SYSTEM) LU BE FUNCTION,EXTERNAL LET C.BUF(40), \COMMAND INPUT BUFFER ECH., \COMMAND LENGTH N.OPL, \SUBPARAMETER ARRAY O.BUF \OUTPUT DCB BE INTEGER,EXTERNAL LET CNTWD(2), \LU-CONTROL WORDS IPBUF(10) \NAMR PARSE RETURN BUFFER BE INTEGER LET WRITE \WRITE MESSAGE SUBROUTINE BE SUBROUTINE LET A BE CONSTANT(0) ! ! CT..: SUBROUTINE (NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER SUBFN_[FUNCT_[FUNC_[NAMF_@PLIST+1]+3]+1]+4 IFNOT PLIST THEN [ERR_55;RETURN] !MISSING FIRST PARM TRLU_$NAMF !SAVE LU CALL OPENF(O.BUF,ERR,$NAMF,10K,N.OPL) !TYPE 0 FILE OPEN IF ERR < 0 THEN RETURN !RETURN IF OPEN ERROR IF $(@O.BUF+2) THENFþú [ERR_56;RETURN] !NOT TYPE 0 FILE CNTWD(1)_$(@O.BUF+3) !TYPE 0 LU IA_XFTTY(CNTWD(1)) !CHECK IF INTERACTIVE IFNOT IA THEN [ERR_72;RETURN] !ERROR, NON-INTERACTIVE IFNOT $FUNC THEN \DEFAULT TO ENABLE TERM [CNTWD(2)_2000K;GO TO SUBFU] IF $FUNC=3 THEN [ERR_56;RETURN] !IF ASCII, ERROR CNTWD(2)_$FUNCT<-6 !POSITION TO CORRECT BITS ! SUBFU: IF CNTWD(2)=2000K THEN \IF ENABLE REQUEST, [TRLU_LUTRU(TRLU); \GET TRUE LU IF TRLU = -1 THEN \IF NOT DEFINED, THEN [ERR_43;RETURN]; \RETURN ERROR $A_TRLU; CALL .CLRB; \CLEAR TERM. BIT MAP CALL XLUEX(100003K,CNTWD,$SUBFN); \ISSUE ENABLE BEFORE RETURN; \RETURN ON ERROR CALL WRITE], \WRITE MESSAGE ELSE [CALL WRITE; \ELSE WRITE MESSAGE 1ST, IF ERR THEN RETURN; \RETURN ON WRITE ERROR CALL XLUEX(100003K,CNTWD,$SUBFN);\ISSUE CONTROL REQUEST RETURN; \ RETURN] RETURN END ! WRITE: SUBROUTINE IS_1 !STARTING CHAR FOR PARSE REPEAT 4 TIMES DO \PARSE UNTIL MESSAGE [CALL NAMR(IPBUF,C.BUF,81-IS,IS); \PARAMETER OR UNTIL IF IS>80 THEN RETURN] !END OF COMMAND I_IS/2 IF(I*2 # IS) THEN I_I+1, \IF ODD, ADD EXTRA WORD ELSE C.BUF(I)_(C.BUF(I) AND 377K) OR 20000K !ELSE PAD BLANK IF I>ECH. THEN RETURN TEMP_CNTWD(2);CNTWD(2)_0 !SAVE CONTROL WORD CALL XLUEX(100002K,CNTWD,C.BUF(I),ECH.-I+1) !WRITE MESSAGE RETURN CNTWD(2)_TEMP !RESTORE CONTROL WORD RETUR™U N END END END$ /ÿÿ ÿý²º ÿ92067-18255 1903 S C0122 &AC..              H0101 X?þúASMB,R,L,C,Q * NAME: AC.. * SOURCE: 92067-18255 * RELOC: 92067-16185 * PGMR: N.J.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM AC..,8 92067-16185 REV.1903 790129 ENT AC.. EXT .ENTR,DCMC,SESSN SUP * * * ALLOCATE CARTRIDGE ROUTINE FOR RTE * FILE MANAGER (FMGR) * * ENTERED ON COMMAND: * * AC,CRN[,P/G[,SIZE[,ID[,#DIR TRACKS]]]] * * WHERE * * CRN - CARTRIDGE REFERENCE NUMBER TO BE ASSIGNED TO DISC THAT * IS ALLOCATED TO THE USER * P/G - P INDICATES DISC IS TO BE MOUNTED AS PRIVATE, G AS GROUP * SIZE - # TRACKS NEEDED ON THE ALLOCATED DISC. DEFAULT WILL BE TO * FIRST AVAILABLE DISC IN DISC POOL * ID - 6-CHAR ASCII IDENTIFIER * # DIR TRACKS - # DIRECTORY TRACKS MADE NEGATIVE WHEN SENT TO DCMC * * * AC.. EXTRACTS PARAMETERS FROM PARSE LIST AND CALLS * SUBROUTINE DCMC. TO PERFORM THE MOUNT. * * N NOP LIS NOP ER NOP AC.. NOP JSB .ENTR DEF N CLA CLEAR STA P/G PARAMETERS STA SIZE TO BE STA ID PASSED TO STA ID+1 DCMC. STA ID+2 STA DIRTK JSB SESSN FIND OUT IF CALLER'S UNDER SESSION CONTROL DEF *+2 DEF XEQT SEZ UNDER SESSION CONTROL? JMP EX45 NO - SHOULDN'T BE DOING AN AC COMMAND LDA N,I GET NUMBER OF PARAMETERS IN PARSE LIST SZA,RSS IF THERE WEREN'T ANY JMP EX50 EXIT NOT ENOUGH PARAMETERS CMA,INA MAKE IT NEGATIVE STA N TO USE AS A COUNTER LDB LIS ‰Ëþú LDA B,I GET CARTRIDGE FROM PARSE LIST (FLAG WORD) SZA,RSS IF NONE SPECIFIED JMP EX50 EXIT NOT ENOUGH PARAMETERS INB LDA B,I SSA,RSS SZA,RSS OR IF A ZERO SPECIFIED JMP EX56 EXIT BAD PARAMETER STA DISID ISZ N RSS JMP CALL * ADB .3 LDA B,I GET PRIVATE/GROUP INDICATOR (FLAG WORD) CPA .1 CAN'T BE NUMBERIC JMP EX56 EXIT BAD PARAMETER INB LDA B,I SZA CPA P IF PRIVATE SET TO 0 JMP PG2 CPA G IF GROUP SET TO 1 JMP PG1 JMP EX56 ELSE EXIT BAD PARAMETER PG1 ISZ P/G PG2 ISZ N RSS JMP CALL * ADB .3 LDA B,I GET SIZE IN TRACKS (FLAG WORD) CPA .3 CAN'T BE ASCII JMP EX56 EXIT BAD PARAMETER INB LDA B,I SIZE IN TRACKS SSA CAN'T BE NEGATIVE JMP EX56 BAD PARAMETER STA SIZE ISZ N RSS JMP CALL * ADB .3 LDA B,I GET LABEL (FLAG WORD) CPA .1 CAN'T BE NUMBERIC JMP EX53 EXIT BAD PARAMETER INB LDA B,I FIRST TWO CHARACTERS OF ASCII IDENTIFIER STA ID INB LDA B,I 3RD AND 4TH CHARACTERS OF ASCII IDENTIFIER STA ID+1 INB LDA B,I 5TH AND 6TH CHARACTERS OF ASCII IDENTIFIER STA ID+2 ISZ N RSS JMP CALL * INB LDA B,I GET NUMBER OF DIR TRACKS (FLAG WORD CPA .3 CAN'T BE ASCII JMP EX56 EXIT BAD PARAMETER INB LDA B,I NUMBER OF DIRECTORY TRACKS SSA CAN'T BE NEGATIVE JMP EX56 BAD PARAMETER CMA,INA STA DIRTK * * CALL JSB DCMC CALL DCMC. TO MOUNT THE DISC. DEF RTN DEF ER,I DEF CODE DEF DISID DEF P/G DEF SIZE DEF ID ká DEF DIRTK RTN EQU * JMP EXIT * EX45 LDA .45 RSS EX50 LDA .50 NOT ENOUGH PARAMETERS RSS EX53 LDA .53 RSS EX56 LDA .56 BAD PARAMETER STA ER,I EXIT JMP AC..,I * * XEQT EQU 1717B B EQU 1 CODE OCT 1 .1 OCT 1 .3 OCT 3 .4 OCT 4 .45 DEC 45 .50 DEC 50 .53 DEC 53 .56 DEC 56 G OCT 43440 P OCT 50040 DISID NOP P/G NOP SIZE NOP ID BSS 3 DIRTK NOP LABEL NOP * END E›ÿÿ ÿý³» ÿ92067-18256 1913 S C0122 &LIMEN RTE-IV LIMEN             H0101 F•ASMB,R,L,C ** LIMEM ** HED LIMEM - MEMORY LIMITS * NAME: LIMEM * SOURCE: 92067-18256 * RELOC: PART OF 92067-16035 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * LIMEM RETURNS THE FIRST WORD OF AVAILABLE MEMORY (IF SEGMENTED * PROGRAM, IT IS HIGH WORD LARGEST SEGMENT + 1) AND THE NUMBER * OF WORDS IN AVAILABLE MEMORY UPTO THE END OF PROGRAM PARTITION * * CALLING SEQUENCE: CALL LIMEM(IWHCH,IFWAM,IWRDS) * WHERE: IF IWHCH IS < 0 THEN JUST RETURN, IFWAM,IWRDS ARE * MEANINGLESS. * IF IWHCH IS >= 0 THEN LIMEM RETURNS: * IFWAM = FIRST WORD OF AVAILABLE MEMORY * IWRDS = NUMBER OF WORDS IN AVAILABLE MEMORY * * * NAM LIMEM,7 92067-16035 REV.1913 790126 ENT LIMEM * EXT EXEC,.ENTR * IWHCH NOP IFWAM NOP IWRDS NOP * LIMEM NOP JSB .ENTR GET PARAMETERS DEF IWHCH LDA IWHCH,I SSA GET MEMORY LIMITS? JMP LIMEM,I NO, RETURN * JSB EXEC DEF *+5 DEF .26 GET LIMITS DEF IFWAM,I FIRST WORD OF AVAIL MEM DEF IWRDS,I # OF WORDS DEF IWHCH # OF PAGES JMP LIMEM,I RETURN * .26 DEC 26 END _¾ÿÿ ÿý´º ÿ92067-18257 1913 S C0122 &SEGLD RTE-IV SEGLD             H0101 MƒþúASMB,R,L,C ** SEGLD ** HED SEGLD - ROUTINE TO LOAD A SEGMENT * NAME: SEGLD * SOURCE: 92067-18257 * RELOC: PART OF 92067-16035 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SEGLD CALLS EXEC TO LOAD SEGMENT. IF SEGMENT NOT FOUND, SEGLD * SCHEDULES T5IDM PROGRAM TO BUILD THE ID SEGMENT FOR THE SEGMENT * AND THEN CALLS EXEC TO LOAD SEGMENT. * * CALLING SEQUENCE: * CALL SEGLD(ISGNM,IERR,IP1,IP2,IP3,IP4,IP5) * WHERE: ISGNM = NAME OF SEGMENT * IERR = ERROR RETURNED BY SEGLD * IP1 - IP5 = OPTIONAL PARAMETERS TO BE PASSED * TO THE SEGMENT * * RETURN: * IERR = 5 IF SEGMENT NOT FOUND * = 0 IF SEGMENT LOADED * * NAM SEGLD,7 92067-16035 REV.1913 790202 ENT SEGLD * EXT .ENTP,EXEC,.DFER,$OPSY * SGNAM NOP IERR NOP PARM1 NOP PARM2 NOP PARM3 NOP PARM4 NOP PARM5 NOP * SEGLD NOP JMP CLRPM POINT THE 5 OPTIONAL .ZERO DEF ZERO PARAMETERS TO ZERO GTPRM JSB .ENTP GET THE PARAMETERS PASSED DEF SGNAM * TRY JSB EXEC LOAD SEGMENT DEF *+8 DEF .S8 =100010B -- NO ABORT BIT SET DEF SGNAM,I NAME OF SEGMENT DEF PARM1,I FIVE DEF PARM2,I DEF PARM3,I OPTIONAL DEF PARM4,I DEF PARM5,I PARAMETERS NOP * * SCHEDULE T5IDM TO SET UP ID SEGMENT FOR SEGMENT * JSB .DFER GET SEGMENT NAME DEF SGNM1 DEF SGNAM,I JSB EXEC DEF *+7 DEF .S23 =100027B SCHEDULE WITH NO ABORT DEF T5IDM Õv   DEF SGNM1 SEGMENT DEF SGNM2 NAME DEF SGNM3 DEF .1 ONE SEGMENT TO LOAD JMP SC05 T5IDM PROGRAM NOT FOUND * LDA $OPSY HOW TO GET THE RETURN PARAMETER ERA,SLA TEST THE DMS BIT JMP DMS IF DMS INSTALLED JMP * LDA B,I ELSE JUST LOAD THE DATA JMP TS GO TEST THE RESULT * DMS XLA B,I DMS DO THE DM CROSS LOAD TS SZA,RSS IF ZER THEN THE SEGMENT WAS SET UP JMP TRY GO TRY AGAIN * SC05 LDA .5 SEND ERROR 5 TO INDICATE SCO5 STA IERR,I JMP SEGLD,I RETURN * * ZERO DEC 0 .S23 OCT 100027 .1 DEC 1 .5 DEC 5 SGNM1 NOP SGNM2 NOP SGNM3 NOP T5IDM ASC 3,T5IDM * .S8 OCT 100010 * * CLRPM LDA .ZERO STA PARM1 STA PARM2 STA PARM3 STA PARM4 STA PARM5 JMP GTPRM DONE * * * A EQU 0 B EQU 1 END ¶‘ ÿÿ ÿýµ¼ ÿ92067-18258 1913 S C0122 &.ERES RTE-IV .ERES             H0101 @mþúASMB,L,C HED ".ERES" - EMA ADDRESS RESOLVER. * NAME: .ERES * SOURCE: 92067-18258 * RELOC: PART OF 92067-16035 * PGMR: B.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .ERES,7 92067-16035 REV.1913 781226 * ENT .ERES SUP * A EQU 0 SPC 1 * .ERES RESOLVES AN ADDRESS IN EMA BUT DOES NOT MAP IN THE * PAGE CONTAINING THE RESULTING ADDRESS. INSTEAD, THE * ADDRESS IS RETURNED IN (B,A). THE CALLING SEQUENCE IS * IDENTICAL TO THAT OF ".EMAP" EXCEPT THE "ARRAY ADDRESS" * IS IGNORED, SO THE ARRAY MUST ALWAYS BE IN EMA. SPC 2 * LOCALS. * EMSG ASC 2,20EM T1 BSS 1 UPPER WORD RUNNING RESULT. T2 BSS 1 LOWER. ND BSS 1 LOOP COUNTER OF # DIMENSIONS. TABLE BSS 1 ADDR OF ARRAY DESCRIPTOR. RTN BSS 1 RETURN ADDRESS. * * ERROR HANDLING AND ZERO-DIMENSION CASE. * ERROR DLD EMSG (A,B) = ASCII "20EM" JMP RTN,I TAKE ERROR EXIT. ZEROD DLD TABLE,I JUST CHECK SIGN OF OFFSET. JMP NCHK SPC 2 * COPY RETURN ADDRESS, TABLE ADDR, & # DIM. * .ERES NOP LDA .ERES,I COPY RETURN ADDR. ISZ .ERES STA RTN ISZ .ERES SKIP ARRAY ADDR LDA .ERES COPY TABLE ADDR ISZ .ERES LDA A,I (FIRST REMOVE INDIRECTS) RAL,CLE,SLA,ERA JMP *-2 LDB A,I B = # DIM. INA SKIP IT IN TABLE. STA TABLE SSB # DIM < 0 ? JMP ERROR YES. CMB,INB,SZB,RSS NEGATE. ZERO ? JMP ZEÿ¡þúROD YES. STB ND NO. KEEP AS COUNTER. CLA SET CURRENT OFFSET TO ZERO. STA T1 STA T2 SKP * LOOP THRU SUBSCRIPTS AND COMPUTE OFFSET. * LOOP LDA .ERES,I NEXT SUBSCRIPT ADDR. ISZ .ERES LDA A,I NEXT SUBSCRIPT. CLO ADD - (LOWER BOUND) CAREFULLY. ADA TABLE,I ISZ TABLE CLE,SSA,RSS RESULT NEGATIVE SOC OR OVERFLOW ? JMP ERROR YES. ADA T2 NO. ADD TO CURRENT SUM. STA T2 SEZ PROPOGATE CARRY. ISZ T1 (CAN'T SKIP) LDA TABLE,I SIZE OF PREVIOUS DIM (OR # WDS / ELEMENT) SSA NEGATIVE ? JMP ERROR YES. MPY T2 LOWER PRODUCT. STA T2 SSB IF T2<15> = 1, FIX UPPER PART OF PRODUCT. ADB TABLE,I LDA T1 UPPER PART OLD VALUE. STB T1 SAVE UPPER PART LOWER MULTIPLY. SZA,RSS ANY NEED TO DO UPPER MULTIPLY ? JMP LOOPE NO. MPY TABLE,I YES. DO IT. CLE,SZB THIRD WORD ? JMP ERROR YES. ADA T1 NO. ADD TO SUM. STA T1 SEZ,INA,RSS OFL ? (A#-1) SSA JMP ERROR YES. LOOPE ISZ TABLE ISZ ND DO ONCE FOR EACH DIMENSION. JMP LOOP * * ADD OFFSET FROM START OF EMA. * DLD TABLE,I THIS IS IT. CLE,SSB NEGATIVE ? JMP ERROR YES. ADA T2 ADD LOWERS. SEZ,CLE PROPOGATE CARRY. ISZ T1 (T1#-1) ADB T1 ADD UPPERS. SEZ,RSS CARRY OR NCHK SSB RESULT < 0 ? JMP ERROR YES. ISZ RTN NO. RETURN RESULT IN (B,A) JMP RTN,I SPC 1 END +` ÿÿ ÿý¶¾ ÿ92067-18259 1903 S C0122 &IFMTM              H0101 …“þúASMB,R,L HED "IFMTM" ROUTINE TO FIND IF IN MTM MODE * SOURCE: 92067-18259 * RELOC: 92067-16125 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IFMTM,7 92067-16125 REV.1903 780403 ENT IFMTM EXT .ENTR,$OPSY SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 * CALLED: * JSB IFMTM * DEF *+2 * DEF 0G LOGICAL UNIT OF SESSION TERMINAL * A = -1 IF NO SESSION * A = ASCII OF THE TERMINAL LOGICAL UNIT * E-REG = 1 IF NO SESSION * E-REG = 0 IF SESSION FOUND * ALGORITHM * WHEN LU IS CONVERTED TO ASCII, IT MUST MATCH THE LAST TWO * CHARACTERS OF THE CALLING PROGRAMS NAME AND THE MTM BIT * IN THE IDSEGMENT (WORD 21, BIT 13) MUST BE SET. SPC 1 LU NOP GIVEN 0G IFMTM NOP ENTRY JSB .ENTR DEF LU LDA LU,I GET POSSIBLE SESSION LU CLB CONVERT TO ASCII DIV D10 ALF,ALF IOR B IOR "00" STA LU SAVE FOR LATER LDA $OPSY OP SYSTEM IDENTIFIER ERA,ERA GET MAPPED BIT TO E LDB XEQT GET LAST TWO CHARS OF MY NAME ADB D13 INDEX INTO MY ID SEGMENT SEZ MAPPED SYSTEM? JMP XLOD1 YES DLD B,I NO, GET LAST 2 CHARS CONT1 RRR 8 GET LAST TWO IN B-REG LDA XEQT NOW CHECK IF SESSION BIT IS SET ADA D20 SEZ MAPPED SYSTEM? JMP XLOD2 YES LDA A,I GET WORD 20 FROM ID SEGMENT CONT2 AND SESBT MA¬/  SK OFF ALL EXCEPT SESSION BIT CPB LU CHECK IF LAST TWO CHARS MATCH CLE,SZA,RSS AND SESSION BIT IS SET CCA,CCE NO, RETURN WITH NO SESSION LDA B YES, RETURN A & B = ASC 0G JMP IFMTM,I DONE SPC 1 XLOD1 XLA B,I GET 2ND WORD OF NAME INB XLB B,I GET 3RD WORD OF NAME JMP CONT1 CONTINUE XLOD2 XLA A,I GET WORD 20 FROM ID SEGMENT JMP CONT2 CONTINUE SPC 1 "00" ASC 1,00 D10 DEC 10 D13 DEC 13 D20 DEC 20 SESBT OCT 20000 END Fá ÿÿ ÿý·¾ ÿ92067-18260 2026 S C0122 &LOGON SESSION LOG-ON PROCESSOR             H0101 _‚þúFTN4,L PROGRAM LOGON(131,50),92067-16260 REV.2026 800414 C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C SOURCE 92067-18260 C C IMPLICIT INTEGER (A-Z) REAL REG,CAPCK C C DIMENSION IDCB(144),IDCB2(144),IBUF(192),ISCB(140),IGBUF(53), C ICON(2),JBUF(15),SMES(5),IPASS(6),CLIST(256), C REG(2),IREG(2),IWELC(5),TIME(5),USER(11),RUFM(6), C FMGR(3),FMGXX(3),CUMTM(2),UPDEL(2) C C C ERROR AND LOG-ON MESSAGE BUFFERS C NOTE THAT ONLY THOSE MESSAGES (BUFFERS) WHICH ARE ALTERED ARE C DECLARED HERE. ALL OTHERS ARE FORMATED IN THE CALL STATEMENT. C EXCEPT THOSE CALLED FROM MORE THAN ONE PLACE. C C C C DIMENSION LG01(25),LG06(24),LG306(22),ONMS1(23), C ONMS3(29),LG09(10),LG11(23),LG13(20) C C C EQUIVALENCE (IDCB(17),IBUF,IDCB2), C (IGBUF(41),JBUF),(JBUF(3),USER), C (REG,IA,IREG),(IREG(2),IB),(RUFM(3),FMGLU), C (RUFM(4),GX), C (RUFM(5),XB) C C C THREE WORDS USED IN COMMUNICATION WITH SUBROUTINES C C IRTN1 C IRTN2 C INTER C C C C C "LGON 01 FMP ERROR - XXXXX ON ACCOUNT FILE ACCESS" C DATA LG01/2HLG,2HON,2H 0,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2H- , C 2HXX,2HXX,2HXX,2H O,2HN ,2HAC,2HCO,2HUN,2HT ,2HFI,2HLE, C 2H A,2HCC,2HES,2HS / C C "LGON 11 FMP ERROR XXXXXX ON DISC MOUNT ATTEMPT" C DATA LG11/2HLG,2HON,2H 1,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2HXX, C 2HXX,2HXX,2H O,2HN ,2HDI,2HSC,2H M,2HOU,2HNT,2H A,2HTT, C 2HEM,2HPT/ C "LGON 06 CONFLICT IN DEFINITION OF SESSION Lã þúU XX" C DATA LG06/2HLG,2HON,2H 0,2H6 ,2HCO,2HNF,2HLI,2HCT,2H I,2HN , C 2HDE,2HFI,2HNI,2HTI,2HON,2H O,2HF ,2HSE,2HSS,2HIO,2HN , C 2H L,2HU ,2HXX/ C C " SESSION LU= XX SYSTEM LU = XXX C DATA LG306/2H ,2H ,2H ,2H ,2H ,2H ,2H ,2HSE,2HSS,2HIO,2HN , C 2HLU,2H= ,2HXX,2H ,2HSY,2HST,2HEM,2H L,2HU=,2H X,2HXX/ C C C "LGON 09 SST OVERFLOW" C DATA LG09/2HLG,2HON,2H 0,2H9 ,2HSS,2HT ,2HOV,2HER,2HFL,2HOW/ C " ON " C DATA ONMS1/2HON,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , C 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / C C "PREVIOUS TOTAL SESSION TIME: XX HRS., YY MIN., ZZ SEC." C DATA ONMS3/2HPR,2HEV,2HIO,2HUS,2H T,2HOT,2HAL,2H S,2HES,2HSI, C 2HON,2H T,2HIM,2HE:,2H ,2HXX,2H H,2HRS,2H.,,2H , C 2HYY,2H M,2HIN,2H.,,2H ,2HZZ,2H S,2HEC,2H. / C C "LGON 13 CONFLICT WITH SYSTEM DISC LU XX" C DATA LG13/2HLG,2HON,2H 1,2H3 ,2HCO,2HNF,2HLI,2HCT,2H W,2HIT, C 2HH ,2HSY,2HST,2HEM,2H D,2HIS,2HC ,2HLU,2H ,2HXX/ DATA ICON/0,10000B/ DATA UPDEL/15501B,15515B/ DATA FMGR/2HFM,2HGR,2H / DATA FMGXX/2HFM,2HGX,2HX / DATA RUFM/2HRU,2H, ,2HFM,2HGL,2HU ,2H, / C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C DETACH FROM SESSION,RETURN POSSIBLE STRING, AND DEFINE SIZE C OF SECOND BUFFER FOR PASSWORD RESPONSE. C C CALL DTACH(ITMP1) SBUF=-26 CALL EXEC(14,1,I,0) C C C DEFINE ADDRESSES OF COMMUNICATION WORDS C CALL SETAA(IRTN1,IRTN2,INTER) C C C C MAKE INITIALIZATION CALL C C IF DSCS2 RETURNS NEGATIVE, THEN THE ACCOUNT PROGRAM (ACCTS) C IS BUSY WORKING ON THE ACCOUNT FILE SO WE JUST TERMINATE. C ACCTS WILL RESTART US WHEN IT HAS COMPLETED. C C C THE FOLLOWING VALUES ARE DEFINED BY THE INIT CALL: C C -LOGôAþú-ON ($LGON) CLASS NUMBER (WITH DON'T DEALLOCATE BIT SET)=LGC C C -THE FOLLOWING OFFSETS FROM THE FIRST WORD OF THE SCB BUFFER: C C IDENTIFIER(IDENT),DIRECTORY ENT#(DIRN), CAPABILITY(ICAP) C USER ID(IUID),GROUP ID (IGID), DISC LIMIT(IDLMT), SST LENGTH WORD(LSST) C C 1 CALL=INIT(LGC,IDENT,DIRN,ICAP,EROF,IUID,IGID,IDLMT,LSST,DSCS2) C C IF(DSCS2.LT.0) GOTO 158 C C MAKE A GET SO WE HAVE SOMEONE TO TALK TO IF WE HAVE PROBLEMS. C CALL EXEC(100025B,LGC+40000B,IGBUF,-106,IRTN1,IRTN2,ITMP1) GOTO 160 C C MAKE SURE IT WAS A READ OR WRITE/READ C 109 IF(ITMP1.NE.1) GOTO 156 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C OK, BEFORE CHECKING THE ACCOUNT FILE, DETERMINE WHO WE ARE TALKING C C TO. THIS IS DONE TO PERMIT LOGON TO REPORT AN ERROR TO THE CALLER C C AND THEN RE-ENABLE THE REQUESTING TERMINAL. THIS CODE IS EXECUTED C C ONLY ON THE FIRST ENTRY TO LOGON. AFTER THE ACCOUNT FILE IS FOUND C C AND OPENED, LOGON NEVER TERMINATES BUT HANGS ON A CLASS GET REQ. C C THIS CODE SHOULD BE IN A SUBROUTINE SO ALL REQUESTS TO LOGON (NOT C C JUST THE FIRST ONE) COULD USE IT. C C C C NOTE: THE REQUEST BUFFER WAS NOT RELEASED. THIS IS SETUP WORK C C ONLY. THE NORMAL PROCESSING WILL MAKE ANOTHER GET AND C C THEN DO THE REAL WORK ON THIS REQUEST. C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C INTER=0 IF(IRTN2) 10,157,20 C C C THE REQUEST CODE WAS NEGATIVE. IF IT'S NOT (SBUF) THEN THIS C IS A SPECIAL BATCH REQUEST AND THE COMMUNICATION IS VIA CLASS C CLASS I/O. THE CLASS NUMBER IS IN IRTN1. THE ON³RþúLY OTHER NEGATIVE C REQUEST IS TO SHUTDOWN (IRTN2=-1). C C 10 IF(IRTN2.EQ.-1) GOTO 156 C C CHECK FOR PASSWORD RESPONSE. C IF(IRTN2.NE.SBUF) GOTO 150 C C C THE REQUEST WAS = SBUF SO THIS IS A PASSWORD RESPONSE. MODIFY C CONTROL PARMS FROM 2ND BUFFER RETURNED IN THE "GET" REQUEST. C C IRTN1=JBUF IRTN2=JBUF(2) C C C C SEE IF THE REQUEST IS INTERACTIVE. C C 20 IF(IRTN2.GT.99) GOTO 150 INTER=XFTTY(IRTN2) C C C SESSION ENVIRONMENT HAS BEEN INITIALIZED--(OR THE CLASS "GET" C WOULD HAVE FAILED). C C OPEN ACCOUNT FILE AND DEFINE RECORD NUMBERS OF THE FOLLOWING C INFORMATION: ACTIVE SESSION TABLE(IACTV),CONFIGURATION TABLE(ICONF), C ACCOUNT DIRECTORY(IDIRC) AND DISC POOL(DSKPL). ALSO, FETCH THE C RESOURCE NUMBER FOR ACCOUNT FILE CONTROL(IRN) AND SAVE SYSTEM MESSAGE C NAMR. C C 150 CALL OPEN(IDCB,IERR,6H+@CCT!,1,-31178) IF(IERR.EQ.1) GOTO 175 C C C PROBLEM WITH ACCOUNT FILE -- ISSUE ERROR AND TERMINATE. C C IF IERR POSITIVE, BUT NOT = 1 GIVE FILE NOT FOUND ERROR. C C FILE TYPE MUST BE 1 C C 153 IF(IERR.GE.0) IERR=-6 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C FMP ERROR AND SHUT DOWN WORK C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 155 CALL CNUMD(-IERR,LG01(11)) CALL MESSP(100103B,LG01,-50) C C RELEASE POSSIBLE CLASS BUFFER C 156 CALL EXEC(21+100000B,LGC,IGBUF,0) GOTO 157 C C FAKE OUT THE COMPLIER C 98765 CONTINUE 157 CALL CLOSE(IDCB) C C IF NOT SHUTDOWN GO WAIT FOR BETTER NEWS C IF(IRTN2.NE.-1) GOTO 1 C C C 158 CALL EXEC(6) C C C 160 CALL MESSP(100003B, C 44HLGON 00 SESSION ENVIRONMENT NOT INITIALIZED ,-44) C C FORCE A TERMINATION C IRTN2=-1 GOTO 156 C C C C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Žþú C C ACCOUNT FILE OPEN - REQUEST LOCAL LOCK ON RN TO VERIFY VALIDITY C C C C READ HEADER C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 175 CALL READF(IDCB,IERR,IBUF,128,ITMP1,1) IF(IERR.LT.0) GOTO 155 C IRN=IAND(IBUF(25),377B) IRN=IBUF(25) C C IF REJECT ON LOCK OF RN, BAD ENVITONMENT ERROR C CALL RNRQ(40001B,IRN,ITMP1) GOTO 160 C C C NORMAL RETURN-- ACCOUNT FOUND AND SET-UP. C C C C C C C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C NORMAL FLOW OF CONTROL RETURNS HERE TO MAKE NEXT "GET" REQUEST.C C WE ALWAYS RELEASE THE RN BEFORE THE "GET" SO SOMEONE ELSE CAN C C GAIN ACCESS TO THE ACCOUNT FILE. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C 500 CALL RNRQ(40004B,IRN,ITMP1) C C IGNORE NOT SET ABORT RETURN C GOTO 505 C C FAKE OUT THE COMPLIER C 87654 CONTINUE C C C CLEAR NO-PARSE, NO PASSWORD AND BATCH FLAGS C 505 NOPAR=0 NOPAS=0 BFLG=0 IGBUF=0 SCBAD=0 C C C MAKE A "GET" REQUEST BUT DON'T RELEASE THE BUFFER. C C REG=EXEC(21,LGC+40000B,IGBUF,-106,IRTN1,IRTN2,ITMP1) C C C ONLY ACCEPT READ OR WRITE\READ REQUESTS C C IF(ITMP1.EQ.1) 550,525 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C THIS SECTION RELEASES THE CURRENT REQUEST BUFFER,SIGNALS COMPLETION C C FOR PROGRAMATIC¹bþú CALLS, AND CONTINUES WITH THE NEXT "GET" REQUEST. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C RETURN POSSIBLE SCB ADDRESS AND COMPLETION STATUS C 515 CALL MESSP(0,SCBAD,-2) C 525 CALL EXEC(21,LGC,IGBUF,0) GOTO 500 C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C WE HAVE A REAL REQUEST, LOCK TH RN, UPDATE MESSAGE FILE NAMR AND C C ACCOUNT FILE POINTERS. THEN DETERMINE TYPE OF CALL. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IF SHUTDOWN, GO DO IT C 550 IF(IRTN2.EQ.-1) GOTO 156 C C CALL RNRQ(1,IRN,ITMP1) C C C GET ACCOUNT FILE HEADER INTO MEMORY C CALL READF(IDCB,IERR,IBUF,128,ITMP1,1) C IF (IERR.NE.0) GOTO 155 C C C DEFINE ACCOUNT FILE POINTERS C C IACTV=IBUF ICONF=IBUF(2) DSKPL=IBUF(3) IDIRC=IBUF(5) ACENT=IBUF(6) DO 552 I=1,5 SMES(I)=IBUF(I+6) 552 CONTINUE C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CHECK THE SECOND OPTIONAL PARAMETER FROM THE "GET" REQUEST TO C C DETERMINE TYPE OF CALL. C C C C C C IF IRTN2 IS NEGATIVE, THIS IS A PASSWORD,SHUTDOWN OR BATCH LOG-ON C C PROCESS. A ZERO WILL CAUSE THE REQUEST TO BE IGNORED. IF POSITIVE,C C THEN WE HAVE A LOG-ON REQUEST. C C C 6$þúCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IF(IRTN2) 5000,525,555 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C THIS IS A LOG-ON REQUEST. SET INTERACTIVE / NON-INTERACTIVE FLAG. C C C CHECK FOR A NUMBER GREATER THAN THE MAX SESSION TERMINAL LU. C C C C NOTE: THE RESPONSE TO THE PASSWORD PROCESSING CONTINUES HERE (555)C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 555 INTER=0 IF(IRTN2.GT.99) GOTO 560 INTER=XFTTY(IRTN2) C C NOTE: IF SOMEONE ATTEMPTS TO FAKE A BATCH LOG-ON, THEY WILL C NEVER SEE A COMPLETION STATUS RETURNED (525 JUST RELEASES C THE CLASS BUFFER THEN GETS ON WITH THE NEXT REQUEST). C 560 IF(IRTN2.GT.376B) GOTO 525 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C TRANSFER LOG MUST BE GREATER THAN ZERO. IF ZERO LENGTH TRANSFER, C C ENABLE THE TERMINAL FOR ANOTHER TRY AND RETURN AN SCB ADDRESS C C OF ZERO IN CASE THIS WAS A PROGRAMMATIC LOG-ON REQUEST. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IF(IB.EQ.0) GOTO 515 C C C C C C C C CHECK THE SESSION LIMIT C C IF(IBUF(28)+IBUF(29).LT.0) GOTO 575 C C C SESSION LIMIT EXCEEDED C ISSUE ERROR MESSAGES AND CONTINUE WITH NEXT "GET" C C CALL MESSP(100303B,30HLGON 03 SESSION LIMIT EXCEEDED,-30) GOTO 525 C C C C C C C THE NUMBER OF ACTIVE SESSIONS IS OK C PARSE THE INPUT BUFFER FOR USER,GROUP AND PASSWORD (UNLESS C THE NO-PARSE FLAG IS SET) C 575 IF(NOPAR.NE.0) GOTO 579 C C C C C 576 CALL LPARS(IGBUF,IB,USER,IPASS) C C C WAS A USER NAME SPECIFIED? C IF(USER.EQ.0) GOTO 592 C $þúC C USER SPECIFIED. SCAN THE ACCOUNT FILE DIRECTORY FOR SPECIFIED C ENTRY. C C C PRESET DIRECTORY ENTRY NUMBER C 579 DENT=0 C C C SCAN ALL RECORDS CONTAINING DIRECTORY ENTRIES C DO 590 I=IDIRC,ACENT-1 CALL READF(IDCB,IERR,IBUF,128,ITMP1,I) C DO 585 J=0,112,16 C C C IF WE COMPLETE THIS LEVEL WE HAVE FOUND THE USER C C 2026 PCO CHANGE TO SCAN FULL GROUP NAME C C DO 580 K=1,11 IF(IBUF(J+K).NE.USER(K)) GOTO 585 580 CONTINUE C GOTO 595 C 585 DENT=DENT+1 CONTINUE C 590 CONTINUE C C C TO GET HERE MEANS THAT THE USER WAS NOT FOUND. C C GO ISSUE ERROR AND CONTINUE WITH THE NEXT REQUEST. C C 592 CALL MESSP(100403B,20HLGON 04 NO SUCH USER,-20) GOTO 515 C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C THE USER HAS BEEN IDENTIFIED. C C C C IF SIGN SET ON WORD 14 OF THE DIRECTORY ENTRY, THE USER ACCOUNT C C BEGINS WITH THE 64TH WORD OF THE SPECIFIED ENTRY. C C C C C C NOTE: BATCH LOG-ON REQUESTS CONTINUE AT 595 C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C 595 IOFF=0 AREC=IBUF(J+15) IF(AREC) 600,610 C C C C C C USER ENTRY FOUND. IT BEGINS AT WORD 64 OF THE SECTOR. C C 600 IOFF=64 AREC=IAND(AREC,77777B) C C C C C C READ THE SECTOR FOR THE SPECIFIED USER ENTRY. C C 610 CALL READF(IDCB,IERR,IBUF,128,ITMP1,ARI'þúEC) IF(IERR.NE.0) GOTO 155 C C IF THIS IS A BATCH LOG-ON REQUEST, SKIP THE PASSWORD C CHECK AS THAT WAS PERFORMED BY AN INDEPENDENT PROCESSOR (BATCH C ROUTINES). C IF(NOPAS.NE.0) GOTO 735 C C CHECK THE CHARACTER COUNT OF THE PASSWORD FIELD. IF ZERO, NO PASS- C WORD IS REQUIRED. C C ITMP1=IAND(IBUF(IOFF+1),377B) IF(ITMP1.EQ.0) GOTO 735 C C C PASSWWORD REQUIRED. SEE IF ONE WAS PASSED. C C IF(IPASS.EQ.0) GOTO 635 C C C PASSWORD PROVIDED. IF SAME LENGTH, COMPARE PASSWORDS. C C IF(IPASS.NE.ITMP1) GOTO 645 C DO 615 I=2,6 IF(IBUF(I+IOFF).NE.IPASS(I)) GOTO 645 615 CONTINUE C C PASSWORD MATCHES. CONTINUE LOG-ON C C C C C USER HAS BEEN IDENTIDIED -- ACCOUNT ENTRY IS IN IBUF C C C CHECK FOR SPECIAL BATCH/SPOOL REQUEST C 735 IF(BFLG.NE.-4) GOTO 740 C C WE HAVE A REQUEST FOR A DIRECTORY ENTRY NUMBER C CALL MESSP(110011B,DENT,-2) GOTO 525 C C SEE IF WE NEED ANOTHER 64 WORD BLOCK C C 2026 PCO TO CORRECTLY READ EXTENSION INTO BUFFER C C C 740 ITMP1=IBUF(IOFF+64) IF(IAND(IBUF(IOFF+1),100000B).NE.0) C CALL READF(IDCB,IERR,IBUF(IOFF+64),64,I,ITMP1) C C C CLEAR THE SCB BUFFER C C DO 750 I=1,140 ISCB(I)=0 750 CONTINUE C C C SET SESSION IDENTIFIER, DIRECTORY ENT#, USER CAPABILITY, USER \GROUP C DISC ID'S AND DISC LIMIT. C C ISCB(IDENT)=IRTN2 ISCB(DIRN) =DENT ISCB(ICAP) =IBUF(IOFF+22) ISCB(IUID) =IBUF(IOFF+29) ISCB(IGID) =IBUF(IOFF+30) ISCB(IDLMT)=IBUF(IOFF+31) UID=ISCB(IUID) GID=ISCB(IGID) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C BUILD SST -- START LENGTH AT 2+# SPARES C C C C THE SST SPARES (-1'S) ARE PLACED IN THE SST FIR;ÝþúST. THESE C C ARE THE ONLY ENTRIES WHICH MAY BE MODIFIED ON-LINE. ALL ENTRIES C C FROM THE CONSOLE DEFINITION (LU 1) TO THE END OF THE TABLE ARE C C DEFINED HERE AND ARE NOT ALTERED THEREAFTER. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C SPARE=IAND(IBUF(IOFF+32),377B)+IBUF(IOFF+31) C ITMP1=SPARE+LSST+1 C DO 760 I=1,SPARE ISCB(LSST+I)=-1 760 CONTINUE C C ISCB(LSST)=2+SPARE C C C NOTE: LU'S IN THE SST ARE STORED AS LU-1. C C C SET SESSION LU 1 = TERMINAL LU C C ISCB(ITMP1)=(IRTN2-1)*256 C C C IF NON-INTERACTIVE CALL, SET LU 1= LU 1 C C IF(INTER.EQ.0) ISCB(ITMP1)=0 C C C DEFINE STATION NUMBER (USED IN CONFIG TABLE SEARCH) C STON=ISCB(ITMP1) C C SAVE START LOCATION FOR MKSST C SOFF=ITMP1-LSST+1 C C DEFINE LU 2=LU 2 AND LU 3=LU 3 (IF LU 3 DEFINED IN SYSTEM) C C ISCB(ITMP1+1)=401B C LU3=IXGET(1760B) IF(LU3.EQ.0) GOTO 762 C C C LU 3 DEFINED IN SYSTEM-- SET UP SST ENTRY AND UPDATE LENGTH. C C ISCB(ITMP1+2)=1002B ISCB(LSST)=3+SPARE C C C C POST ALL SYSTEM DISCS TO SST C (DISCS WITH AN ID=7777) C C C NOTE: THE 256 WORD BUFFER "CLIST" IS USED ONLY TO C HOLD THE CARTRIDGE LIST. THE DECISION TO USE C A SECOND BUFFER (RATHER THAN SHARE "IBUF") WAS MADE BECAUSE C OF SPEED CONSIDERATIONS. THE SYSTEM DISCS MUST BE DEFINED C BEFORE THE USER SST AND WE DON'T WANT TO MAKE THE DISC ACCESS C UNLESS WE REALLY HAVE A USER TO LOG-ON. IF PROGRAM SIZE SHOULD C OVERRIDE SPEED REQUIRMENTS, "IBUF" COULD BE USED EITHER C BEFORE WE FIND THE USER, OR, ONCE THE USER IS FOUND, SAVE THE C POINTERS - READ THE CARTRIDGE LIST - THEN BRING THE USER C RECORD BACK INTO MEMORY. C 762 CALL FSTAA(CLIST) C C C SCAN LIST OF MOUNTED DISCS C C DO 765 I=1,252,4 C C C END OF LIST ? å—þúC C IF(CLIST(I).EQ.0) GOTO 770 C C C CHECK FOR ID=SYSTEM (7777B) C C IF(IAND(CLIST(I+3),7777B).NE.7777B) GOTO 765 C C C WE HAVE A MATCH. SEE IF IT IS LU 2 OR 3 C C DLU=IAND(CLIST(I),77B)-1 IF(DLU.EQ.1) GOTO 765 IF(DLU.EQ.2) GOTO 765 C C C NOT LU 2 OR 3. BUILD SST ENTRY. C DLU=DLU*256+DLU C C C MOVE THE ENTRY INTO THE SCB/ NOT POSSIBLE TO OVERFLOW OR COLLIDE C SO NO ERROR CONDITIONS NEED BE CHECKED. C C C CALL MKSST(ISCB,DLU,SOFF,ISTAT) C C 765 CONTINUE C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PREPARE TO SCAN THE CONFIGURATION TBL. SAVE THE FOLLOWING INFOR- C C MATION BEFORE IBUF (THE USER ACCOUNT ENTRY) IS ALTERED: #SST C C SPARES, USER WELCOME FILE NAMR AND PREVIOUS TOTAL SESSION TIME. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 770 CUMTM=IBUF(IOFF+25) CUMTM(2)=IBUF(IOFF+26) C DO 775 I=1,5 IWELC(I)=IBUF(IOFF+I+6) 775 CONTINUE C C C C C CHECK FOR PENDING MAIL BY SAVING BIT 15 OF WORD 21 OF USER ENTRY. C BIT IS SET IF MAIL IS PENDING. C C MAIL=IBUF(IOFF+21) C C PREPARE TO BRING ACCOUNT SST ENTRIES INTO SCB. C C LEN=IAND(IBUF(IOFF+33),77777B) IF(LEN.EQ.0) GOTO 880 ISST=IOFF+33 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C THE MKSST ROUTINE MOVES SST DEFINITIONS FROM ONE LOCATION C C (ACCOUNT FILE BUFFER) TO THE SCB BEING BUILT. THIS ROUTINE C C CHECKS FOR DUPLICATE ENTRIES AND FOR ROOM IN THE SST. THE C C SST LENGTH WORD IS INCREMENTED EACH TIME AN ENTRY IS ADDED C C TO THE SST. C C CCCCCCCC¡sþúCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C BRING IN THE ACCOUNT FILE SST'S. C C DO 875 I=1,LEN IF(MKSST(ISCB,IBUF(ISST+I),SOFF,ISTAT)) 800,875,790 C C SST OVERFLOW - REPORT ERROR - SKIP ANY ADDITIONAL SST ADDITIONS C 790 CALL MESSP(1101B,LG09,-20) CALL PERR(LG09,ISCB(EROF)) GOTO 1000 C C USER SST CONFLICT WITH SYSTEM DISC DEFINITION - REPORT ERROR C THEN TRY NEXT ONE. C 800 LG13(20)=KCVT(IAND(ISTAT,377B)+1) CALL MESSP(1101B,LG13,-40) CALL PERR(LG13,ISCB(EROF)) C 875 CONTINUE C C C C C C CHECK FOR A CONFIGURATION TABLE ENTRY (IF INTERACTIVE OR BATCH) C 880 IF(BFLG.EQ.-2) GOTO 900 C IF(INTER.EQ.0) GOTO 1000 C C C SCAN FOR CONFIGURATION TABLE ENTRY - FAILURE EXIT IS TO 1000 C - FOUND IS TO 935 C 900 ISEC=ICONF LEN=0 IOFF=1 C C CHECK FOR END OF CONFIGURATION TABLE SECTORS C 910 IF(ISEC.EQ.DSKPL) GOTO 1000 CALL READF(IDCB,IERR,IBUF,128,ITMP1,ISEC) IF(IERR.NE.0) GOTO 155 ISEC=ISEC+1 C C C IF THE OFFSET IS ZERO THEN THIS ENTRY BEGAN ON THE LAST C WORD OF THE PREVIOUS SECTOR. WE ALREADY HAVE THE LENGTH C WORD SO CONTINUE WITH STATION CHECK. C IF(IOFF.EQ.0) GOTO 925 C 915 LEN=IBUF(IOFF) 920 IF(LEN.EQ.0) GOTO 1000 C C IF THE NEXT ENTRY BEGINS ON THE LAST WORD OF THE SECTOR, C GO BRING IN THE NEXT 64 WORDS OF THE NEXT SECTOR (LENGTH WORD SAVED). C IF(IOFF.EQ.128) GOTO 930 C 925 IF(IBUF(IOFF+1).EQ.STON) GOTO 935 IOFF=IOFF+LEN+1 IF(IOFF.LT.129) GOTO 915 C C SET UP OFFSET FOR NEXT SECTOR AND GO GET IT C 930 IOFF=IOFF-128 GOTO 910 C C C FOUND THE ENTRY FOR THIS STATION C C IF CONFIGURATION TABLE ENTRY OVERFLOWS TO NEXT SECTOR C THEN READ NEXT SECTOR ( FIRST 64 WORDS ) C 935 IF(LEN+IOFF.GT.128) CALL READF(IDCB,IERR,IBUF(129),64) C C C C C CONFIGURATION TABLE ENTRY FOUND FOR THIS STË„þúATION. C C C SET LENGTH AND POINTERS C LEN=LEN-1 IF(LEN.EQ.0) GOTO 1000 IOFF=IOFF+1 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C NOTE: IOFF IS INCREMENTED BY 1, NOT 2 BECAUSE THE MKSST C C CALLS START FROM IOFF+1. C C C C C MOVE CONFIGURATION TABLE ENTRIES TO SST VIA MKSST. C C NOTE: IF DUPLICATE ENTRY IS DETECTED, THE ERROR DIAGNOSTIC C C PRINTED IS DEPENDENT UPON THE USER'S ABILITY TO C C PERFORM THE "SL" COMMAND. C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO 980 I=1,LEN C IF(MKSST(ISCB,IBUF(IOFF+I),SOFF,ISTAT)) 960,980,950 C C C SST OVERFLOW (MORE THAN 70 ENTRIES) C 950 CALL MESSP(1101B,LG09,-20) CALL PERR(LG09,ISCB(EROF)) GOTO 1000 C C C C C C DUPLICATE ENTRY FOUND C IF USER CAN'T PERFORM THE "SL" COMMAND, ISSUE THE SHORT DIAGNOSTIC. C OTHERWISE, REPORT ALL LU'S IN QUESTION. C C C 960 CALL CONV(ISTAT,LG306(21),LG306(14)) LG06(24)=LG306(14) CALL MESSP(601B,LG06,-48) CALL PERR(LG06,ISCB(EROF)) CALL MESSP(10601B, C 43H USER ACCOUNT DEFFINITION USED,-43) C C C CHECK ABILITY TO DO "SL" C REG=CAPCK(2HL3,-2,0,ISCB(ICAP)) C IF(IB.LT.0) GOTO 980 C C C REPORT ALL LU'S INVOLVED AS USER MIGHT WISH TO USE "SL" TO C CHANGE SOMETHING. C CALL MESSP(10601B,LG306,-44) CALL MESSP(10601B,2H ,-2) CALL MESSP(10601B, C 42H CONFIGURATION TABLE IGNORED ,-42) CALL CONV(IBUF(IOFF+I),LG306(21),LG306(14)) CALL MESSP(10601B,LG306,-44) C C C CONTINUE WITH N =þúEXT ENTRY C 980 CONTINUE C C C C C C C C C C C C C CALCULATE THE OFFSET TO THE FIRST LOCATION PAST LAST SST ENTRY C 1000 ITMP1=LSST+ISCB(LSST)+1 C C C UPDATE THE SST LENGTH WORD. NOTE THAT THIS VALUE IS SAVED IN IT'S C TWO'S COMPLEMENT FORM. C ISCB(LSST)=-ISCB(LSST) C C C C SET THE NEGATIVE DISC LIMIT BEHIND THE LAST SST ENTRY. C C ISCB(ITMP1)=-ISCB(IDLMT) C C C CALCULATE SIZE REQUIRED FOR SCB. C C IREQ=ITMP1+ISCB(IDLMT) C C C C C C C BEFORE BUILDING THE SCB-- BUILD THE SESSION PROGENITOR SO WE C DON'T GRAB MEMORY UNTIL IT IS NEEDED. C C C DUPLICATE A FMGR FOR THIS SESSION. LOOK FOR FMGXX FIRST AS IT C MIGHT BE SMALLER. IF NOT FOUND, DUPLICATE FMGR. C C C IF NON-INTERACTIVE, SKIP THE PROGENITOR BUILD C C IF(INTER.EQ.0) GOTO 1280 C ITMP1=IOR(KCVT(IRTN2),30000B) C GX=43400B+(ITMP1/256) XB=IAND(ITMP1,377B)*256+40B C C C IS OUR COPY ALREADY THERE ? C C C C C IF(IDGET(FMGLU).NE.0) GOTO 1280 C C C DUPLICATE THE REAL FMGR C C IF(IDDUP(FMGR,FMGLU,I).EQ.0) GOTO 1276 C C SEE WHAT ERROR WAS RETURNED C C C 14=NO FREE ID'S C 17=PROGRAM TO BE COPPIED IS MEM RES (CAN'T DO THAT) C 23=NEW PROG ALREADY EXISTS (SOMEONE BEAT US TO IT) C C IF(I.EQ.23) GOTO 1280 C C C NO FREE ID SEGMENTS ERROR C 1110 CALL MESSP(101203B, C 46HLGON 10 NO FREE ID SEGMENTS OR FMGR NOT FOUND ,-46) C C C GO TERMINATE THE REQUEST AND START NEXT ONE. C GOTO 515 C C C SET OWNER ID IN ID SEGMENT (PRESERVE ALL OTHER INFO) C 1276 ITMP1=IDGET(FMGLU)+31 IF(ITMP1.EQ.31) GOTO 1110 I=IAND(IXGET(ITMP1),177400B)+IRTN2 CALL IXPUT(ITMP1,I) C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C BUILD THE SCB C CCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C 1280 CALL MKSCB(ISCB,IREQ,SCBAD,IERR) C C IF(IERR.EQ.0) GOTO 1300 C IFþæþú(IERR.EQ.-3) GOTO 1250 C C C NO MEMORY ERROR - ISSUE ERROR, KILL FMGLU & GO MAKE NEXT "GET" C C CALL MESSP(100703B, C 42HLGON 07 NO ROOM FOR SESSION CONTROL BLOCK ,-42) 1225 CALL IDRPD(FMGLU) GOTO 515 C C C C DUPLICATE SESSION IDENTIFIER C C C 1250 CALL MESSP(101003B,36HLGON 08 DUPLICATE SESSION IDENTIFIER,-36) GOTO 1225 C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C C AT THIS POINT WE HAVE ACCOMPLISHED THE FOLLOWING: C C C C -IDENTIFIED AND VERIFIED THE USER C C -BUILT A PROGENITOR (FMGLU) FOR THE SESSION C C -BUILT A SESSION CONTROL BLOCK C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GET LOG-ON TIME C C 1300 CALL EXEC(11,TIME,YEAR) CALL FTIME(ONMS1(3)) C C C FORMAT THE TIME AS FOLLOWS FOR ACCOUNT FILE: C C WD1= YEAR OFFSET (BITS 15-13 ) MIN(BITS 12-7 ) SEC(BITS 6-0 ) C WD2= DAY(BITS 13-5) HR(BITS 4-0) C C LOT1=TIME(2)+(TIME(3)*64)+((YEAR-1978)*4096) LOT2=TIME(4)+(TIME(5)*32) C C C C POST LOG-ON INFORMATION TO ACCT FILE C C FIRST GET HEADER INTO MEMORY C C CALL READF(IDCB,IERR,IBUF,128,ITMP1,1) IF(IERR.NE.0) GOTO 1265 C C C UPDATE ACTIVE SESSION COUNTER C C IBUF(29)=IBUF(29)+1 CALL WRITF(IDCB,IERR,IBUF,128,1) IF(IERR.NE.0) GOTO 1265 C C C UPDATE ACTIVE SESSION TABLE C -MUST FIRST FIND A FREE SPACE C C C DO 1350 I=IACTV,ICONF-1 C CALL READF(IDCB,IERR,IBUF,128,ITMP1,I) IF(IERR.NE.0) GOTO 1265 C eéþú DO 1325 J=1,124,4 IF(IBUF(J).EQ.0) GOTO 1375 C C 1325 CONTINUE 1350 CONTINUE C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C SOMETHING IS WRONG HERE. THE SESSION LIMIT INDICATED C C THAT THERE WAS ROOM FOR THIS SESSION. HOWEVER, A SCAN C C OF THE ACTIVE SESSION TABLE INDICATES THAT A) THE ACCOUNT C C FILE HAS BEEN ALTERED, OR B) THE SESSION LIMIT LIES! C C C C C C SO DO THE FOLLOWING: C C C C -----IDRPD CALL C C -----ISSUE ERROR MESSAGE C C -----CLOSE ACCOUNT FILE C C -----TERMINATE C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CALL MESSP(101403B,28HLGON 12 ACCOUNT FILE CORRUPT,-28) C C 1265 CALL IDRPD(FMGLU) CALL RLSCB(IRTN2,ITMP1) IF(IERR.EQ.0) GOTO 156 GOTO 155 C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C FOUND A FREE SPOT IN ACTIVE LIST C 1375 IBUF(J)=IRTN2 IBUF(J+1)=LOT1 IBUF(J+2)=LOT2 IBUF(J+3)=DENT C C WRITE IT BACK OUT C C CALL WRITF(IDCB,IERR,IBUF,128,I) IF(IERR.NE.0) GOTO 1265 C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C USER SCB &FMGR ARE BUILT €uþú C C ACCOUNT FILE HAS BEEN UPDATED C C - MOVE AND LINK SCB WITH EXISTING SCB'S C C -RELEASE RN TO ALLOW POSSIBLE LOG-OFFS C C -MOUNT ALL DISCS LEFT MOUNTED C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C C RELEASE LOCK C CALL RNRQ(4,IRN,ITMP1) C C ATTEMPT TO MOUNT DISCS AVAILABLE TO THIS SESSION C THE BUFFER "CLIST" CONTAINS A COPY OF THE CARTRIDGE DIRECTORY C C ID=UID C C C SCAN LIST OF MOUNTED DISCS FOR PRIVATE OR GROUP DISCS C C DO 1500 J=1,2 IF(J.EQ.2) ID=GID C DO 1400 I=1,252,4 C IF(CLIST(I).EQ.0) GOTO 1500 C IF(IAND(CLIST(I+3),7777B).NE.ID) GOTO 1400 C C C MATCH FOUND. CALL DCMC PROCESSOR. C CALL DCMC(ITMP1,1,-(IAND(CLIST(I),77B)),J-1,CLIST(I+1),0,0,0, C SCBAD) IF(ITMP1.EQ.0) GOTO 1400 CALL CNUMD(ITMP1,LG11(10)) CALL MESSP(1301B,LG11,-46) CALL PERR(LG11,ISCB(EROF)) C C 1400 CONTINUE 1500 CONTINUE C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C BUILD, THEN ISSUE LOG-ON MESSAGES C C FIRST ISSUE SESSION # AND LOG-ON TIME TO SESSION TERMINAL C CALL MESSP(10001B,2H ,-2) CALL MESSP(1,ONMS1,-34) C C C C C MOVE USER AND GROUP NAMES INTO BUFFER (SYS CON ONLY) C (RETURNS NEGATIVE BYTE COUNT) C C ITMP1= MBT(USER,ONMS1(13)) CALL MESSP(2,ONMS1,-24+ITMP1) C CALL FCNCT(CUMTM,ISCB) C C CNV2 RETURNS 2 WORDS OF ASCII HOURS C CALL CNV2(ONMS3(15),ISCB) C ONMS3(21)=IOR(KCVT(ISCB(2)),30060B) ONMS3(26)=IOR(KCVT(ISCB(3)),30060B) CALL MESSP(10001B,ONMS3,-58) C C C C C LIST SYSTEM MESSAGE FILE C C CALL OPEN(IDCB2,IEÌÈþúRR,SMES,1,SMES(4),SMES(5)) C C IF SYSTEM MESSAGE FILE NOT FOUND-- GO CHECK FOR MAIL. C IF(IERR.LE.0) GOTO 1600 C 1550 CALL READF(IDCB2,IERR,ISCB,128,LEN) C IF(IERR.NE.0) GOTO 1600 C IF(LEN.EQ.-1) GOTO 1600 CALL MESSP(10001B,ISCB,-(LEN*2)) C GOTO 1550 C C SPACE A LINE AND CHECK FOR MAIL C C 1600 CALL CLOSE(IDCB2) IF(MAIL.LT.0) CALL MESSP(10001B,16HMESSAGES WAITING,-16) CALL MESSP(10001B,2H ,-2) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IF NON-INTERACTIVE LOG-ON, WERE ALL DONE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IF (INTER.EQ.0) GOTO 515 C C C C C MUST MAKE MESSS CALL WITH -SCB ADDR TO GET FMGR GOING C C FIRST, BUILD "RU, FMGLU ,NAME:SC:CRN C DO 1650 I=1,6 ISCB(I)=RUFM(I) 1650 CONTINUE C C ISCB(7)=IWELC(1) ISCB(8)=IWELC(2) ISCB(9)=IWELC(3) ISCB(10)=2H: CALL CNUMD(IWELC(4),ISCB(11)) ISCB(14)=2H: CALL CNUMD(IWELC(5),ISCB(15)) C C C C CALL MESSS(ISCB,34,1,-SCBAD) C C GOTO 515 C C C C C C PASSWORD REQUIRED, BUT NOT PASSED. C PROMPT THE USER FOR A PASSWORD, START A CLASS READ OF THE C THE RESPONSE. NOTE THAT THIS IS A DOUBLE BUFFERED READ. C C NOTE! STATUS CODE=77B FOR PASSWORD REQUIRED. C 635 CALL MESSP(17701B,11HPASSWORD ?_,-11) C C C SEE IF THIS IS AN INTERACTIVE CALL C C AT THIS POINT, D.S. AND BATCH REQUIRE THE PASSWORD TO BE SPECIFIED C IN THE LOG-ON REQUEST. THEREFORE, IF WE NEED A PASSWORD AND THE C REQUEST IS NOT INTERACTIVE, ABORT THE PROCESS WITH A LGON 05 ERROR. C C IF(INTER.NE.0) GOTO 680 645 CALL MESSP(100503B,22HLGON 05 ILLEGAL ACCESS,-22) GOTO 515 C C C C C C SET UP FOR INTERACTIVE RESPONSE C C C 680 JBUF=0 ICON(1)=IRTN2 ITMP1=-80 ICLAS=LGC IREQ=100021B C 685 JBUF(2)=IRTN2 C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCf/þúCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C NOTE: JBUF IS THE FINAL 13 WORDS OF IGBUF. THE FIRST 40 WORDS OF C C IGBUF ARE USED FOR THE USER INPUT. THE LAST 13 WORDS (THE C C SECOND BUFFER ON THE PASSWORD CALL) CONTAIN INFORMATION C C DESCRIBING THE USER. C C C C WD1= 0 IF INTERACTIVE C C CLASS # FOR COMMUNICATION OTHERWISE C C C C WD2= SESSION ID C C C C WD3= BYTE COUNTS OF USER & GROUP NAMES (USER IN HIGH BYTE) C C NOTE: THIS 11 WORD FIELD IS EQUATED TO "USER". C C C C WDS 4-8= USER NAME (BLANK FILL) C C C C WDS 9-13= GROUP NAME (BLANK FILL) C C C C C C C NOTE: WORD 1 CURRENTLY HAS NO USE. IT IS USED HERE ON THE CHANCE C C THAT NON-INTERACTIVE LOG-ON REQUESTS MAY WANT TO BE ABLE C C TO PROMPT FOR AND THEN RETURN A PASSWORD IF IT WAS NOT C C PROVIDED IN THE ORIGIONAL REQUEST. BY CHANGING THE ABOVE C C SET UP FOR THE CLASS WRITE-READ, THE DOUBLE BUFFERED C C REQUEST COULD BE SENT BACK TO THE REQUESTOR. C C C C C ¼Gþú C C MAKE THE CLASS REQUEST. IF ERROR, ASSUME BAD CLASS # PASSED C C IN PROGRAMATIC REQUEST. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALL XLUEX(IREQ,ICON,IGBUF,ITMP1,JBUF,SBUF,ICLAS) GOTO 645 C C GO MAKE NEXT "GET" REQUEST. C C 690 GOTO 525 C C C C C C C C C C C C C C C C CHECK TYPE OF CALL C C C -1=SHUTDOWN C -2=BATCH (JOB) LOG-ON C -3=ACCOUNT NAME REQUEST C -4=ACCOUNT DIRECTORY ENTRY REQUEST C -SBUF=PASSWORD RESPONSE C C C C CHECK FOR BATCH LOG-ON OR ACCOUNT NAME REQUEST C 5000 BFLG=IRTN2 IF(IRTN2.EQ.-2.OR.IRTN2.EQ.-3) GOTO 7000 C C CHECK FOR ACCOUNT DIRECTORY ENTRY NUMBER REQUEST C IF(IRTN2.EQ.-4) GOTO 8000 C C C C C IF IRTN2 IS NOT EQUAL TO THE NEG BYTE SIZE OF THE SECOND C BUFFER, IGNORE THIS CALL. C C IF(IRTN2.NE.SBUF) GOTO 525 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C THIS IS A PASSWORD RESPONSE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SET SOME FLAGS, PARSE THE PASSWORD (JUST FOR BYTE COUNT AND REMOVAL C OF BLANKS). C C C C IRTN1=JBUF IRTN2=JBUF(2) C C GET A CR/LF AFTER INTERACTIVE FLAG IS SET UP C IF TERMINAL IS A MULTIPOINT NODE, ISSUE UPLINE,DELETE REQUEST C C CALL XFTTY(IRTN2) CALL ABREG(INTER,ITMP1) IF(IRTN2.GT.99) INTER=0 IF(IAND(ITMP1,37400B).EQ.3400B) CALL MESSP(10001B,UPDEL,-4) CALL MESSP(10001B,2H ,-2) C CALL LPARS(IGBUF,-IB,ISCB,IPASS) C C IF PASSWORD NOT GIVEN, ISSUE "ILLEGAL ACCESS" C IF(IPASS.EQ.0) GOTO 645 C C C C CONTINUE WITH PASSWORD CHECK NOPAR=1 GOTO 555 C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCC C BATCH LOG-ON REQUEST C CCCCCCCCCCCCCCCCCCCCCCCCC çç~|x C C C DIRECTORY SECTOR IS IN IBUF AND RN IS LOCKED C C C 7000 DENT=IGBUF INTER=0 NOPAS=1 IRTN2=377B C C NOTE: ID 377B IS RESERVED FOR BATCH C C C DEFINE RECORD NUMBER C ITMP1=DENT/8+IDIRC C C VERIFY PASSED PARAMETER C IF(ITMP1.LT.IDIRC.OR.ITMP1.GE.ACENT) GOTO 7900 C C GET DIRECTORY SECTOR INTO MEMORY C CALL READF(IDCB,IERR,IBUF,128,I,ITMP1) IF(IERR.NE.0) GOTO 155 C DEFINE THE VARIABLE "J" TO BE THE OFFSET INTO THE SECTOR. C NOTE: "J" MUST BE DEFINED AS NOTED. C J=MOD(DENT,8)*16 C C PERFORM FUTHER VALIDITY CHECKS C IF(IBUF(J+15).EQ.0) GOTO 7900 IF(IBUF(J+1).EQ.0.OR.IBUF(J+1).EQ.-1) GOTO 7900 C C C CHECK FOR USER.GROUP NAME REQUEST (SPECIAL BATCH\SPOOL ENTRY) C IF(BFLG.NE.-3) GOTO 7100 C C NOTE: FORMAT = DIRECTORY FORMAT C RETURN NAME TO CALLER AND MAKE NEXT GET REQUEST C CALL MESSP(110011B,IBUF(J+1),-22) GOTO 525 C C C C C CONTINUE BATCH LOG-ON C LOOKS OK- MOVE USER.GROUP NAME INTO "USER" C 7100 DO 7200 I=1,11 USER(I)=IBUF(J+I) 7200 CONTINUE C C C CONTINUE LOG-ON WITH STANDARD PROCESSING C GOTO 595 C C 7900 CALL MESSP(101603B,30HLGON 14 BAD JOB LOG-ON REQUEST,-30) GOTO 525 C C C C C C C THIS IS A REQUEST FOR THE ACCOUNT DIRECTORY ENTRY NUMBER C CORRESPONDING TO THE LOGON STRING PASSED. C 8000 IRTN2=377B INTER=0 CALL RNRQ(1,IRN,ITMP1) GOTO 576 C C END END$ >~ÿÿ ÿý¸Ò ÿ92067-18261 1940 S C0122 &LGOF LOG-OFF PROCESSOR             H0101 ‚þúFTN4,L PROGRAM LGOFF(131,90),92067-16260 REV.1940 790726 C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE 92067-18261 C C C IMPLICIT INTEGER (A-Z) REAL REG,DCMC,DBLK C C DIMENSION IDCB(144),IBUF(128),IGBUF(13), C ICON(2),JBUF(3),NAMB(3), C REG(2),IREG(2),TIME(5),RUFM(5), C FMGR(3),FMGXX(3) C C DIMENSION OFPRG(6),PGRM(3),DSEC(2),DCPU(2) C C ERROR AND LOG-OFF MESSAGE BUFFERS C NOTE THAT ONLY THOSE MESSAGES (BUFFERS) WHICH ARE ALTERED ARE C DECLARED HERE. ALL OTHERS ARE FORMATED IN THE CALL STATEMENT. C C C DIMENSION LG01(25),OFMS1(23),OFMS3(27),OFMS4(32), C OFMS5(27),DMES(19) C C C EQUIVALENCE (IDCB(17),IBUF), C (IGBUF(11),JBUF), C (REG,IA,IREG),(IREG(2),IB),(RUFM(3),FMGLU), C (RUFM(4),GX), C (RUFM(5),XB),(OFPRG(3),PGRM),(DMES(5),DBLK) C C C FOUR WORDS USED IN COMUNICATION WITH SUBROUTINES C C CCLAS (PROGRAMATIC COMMUNICATION CLASS) C IOPN1 (SESSION ID) C INTER (INTERACTIVE FLAG) C IOPN2 (SCB ADDRESS) C C C C C "LGOF 01 FMP ERROR - XXXXX ON ACCOUNT FILE ACCESS" C DATA LG01/2HLG,2HOF,2H 0,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2H- , C 2HXX,2HXX,2HXX,2H O,2HN ,2HAC,2HCO,2HUN,2HT ,2HFI,2HLE, C 2H A,2HCC,2HES,2HS / C C C " OFF " C DATA OFMS1/2HOF,2HF ,2H ,2H ,2H ,2H ,2H ,2H ,2H , C 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , C 2H / C C "CONNECT TIME: WW HRS., ± þúXX MIN., YY SEC." C DATA OFMS3/2HCO,2HNN,2HEC,2HT ,2HTI,2HME,2H: ,2H ,2H , C 2H ,2H ,2H ,2H ,2HWW,2H H,2HRS,2H.,,2H , C 2HXX,2H M,2HIN,2H.,,2H ,2HYY,2H S,2HEC,2H. / C C "CPU USAGE: WW HRS., XX MIN., YY SEC., ZZZ MS." C DATA OFMS4/2HCP,2HU ,2HUS,2HAG,2HE:,2H ,2H ,2H ,2H , C 2H ,2H ,2H ,2H ,2HWW,2H H,2HRS,2H.,,2H , C 2HXX,2H M,2HIN,2H.,,2H ,2HYY,2H S,2HEC,2H.,, C 2HZZ,2HZZ,2HZZ,2H M,2HS./ C C "CUMULATIVE CONNECT TIME: WW HRS., XX MIN., YY SEC." C DATA OFMS5/2HCU,2HMU,2HLA,2HTI,2HVE,2H C,2HON,2HNE,2HCT, C 2H T,2HIM,2HE:,2H ,2HWW,2H H,2HRS,2H.,,2H , C 2HXX,2H M,2HIN,2H.,,2H ,2HYY,2H S,2HEC,2H. / C C C "DISC CRN XXXXX LU YY DISMOUNTED (POOL) C DATA DMES/2HDI,2HSC,2H C,2HRN,2H X,2HXX,2HXX, C 2H L,2HU ,2HYY,2H D,2HIS,2HMO,2HUN,2HTE, D 2HD ,2H(P,2HOO,2HL)/ C DATA ICON/0,10400B/ DATA FMGR/2HFM,2HGR,2H / DATA FMGXX/2HFM,2HGX,2HX / DATA RUFM/2HRU,2H, ,2HFM,2HGL,2HU / DATA NAMB/2H ,2H ,2H / C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C RELEASE POSSIBLE STRING AND DEFINE SIZE OF SECOND BUFFER FOR C PASSWORD RESPONSE. C C CALL DTACH(ITMP1) CALL EXEC(14,1,I,0) SBUF=-3 C C DEFINE ADDRESSES OF COMMUNICATION PARAMETERS C CALL SETAA(CCLAS,IOP1,INTER,IOP2) C C C C C MAKE INITIALIZATION CALL ( INIT2 CHECKS THE ENVIRONMENT AND C RETURNS THE LOG-OFF CLASS NUMBER AND CONTENTS OF $DSCS+1. C C ITMP1 IS SET UP = $DSCS+1 IF= -2 ACCTS IS BUSY WORKING ON THE ACCT C FILE SO LGOFF TERMINATES, WAITING FOR ACCTS TO RESTART IT WHEN C THE ACCOUNT FILE HAS BEEN UPDATED. C C 1 LGFC=INIT2(ITMP1) IF(ITMP1.EQ.-2) GOTO 376 C C MAKE A GET SO WE HAVE SOMEONE TO TALK TO IF PROBLEMS COME¶&þú UP. C CALL EXEC(100025B,LGFC+40000B,IGBUF,-26,IOP1,IOP2,ITMP1) GOTO 380 C C MAKE SURE IT WAS A READ OR WRITE/READ C 2 IF(ITMP1.NE.1) GOTO 350 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C OK, BEFORE CHECKING THE ACCOUNT FILE, DETERMINE WHO WE ARE TALKING C C TO. THIS IS DONE TO PERMIT LGOFF TO REPORT AN ERROR TO THE CALLER C C AND THEN RE-ENABLE THE REQUESTING TERMINAL. THIS CODE IS EXECUTED C C ONLY ON THE FIRST ENTRY TO LGOFF. AFTER THE ACCOUNT FILE IS FOUND C C AND OPENED, LGOFF NEVER TERMINATES BUT HANGS ON A CLASS GET REQ. C C THIS CODE SHOULD BE IN A SUBROUTINE SO ALL REQUESTS TO LGOFF (NOT C C JUST THE FIRST ONE) COULD USE IT. C C C C NOTE: THE REQUEST BUFFER WAS NOT RELEASED. THIS IS SETUP WORK C C ONLY. THE NORMAL PROCESSING WILL MAKE ANOTHER GET AND C C THEN DO THE REAL WORK ON THIS REQUEST. C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C INTER=0 CCLAS=IGBUF IF(IOP2) 50,350,60 C C C THE REQUEST CODE IS NEGATIVE. WE HAVE A SHUT-DOWN (-1) OR C A RESPONSE TO A KILL PROGRAMS PROMPT (=SBUF) OR AN INVALID C REQUEST. C C 50 IF(IOP2.EQ.-1) GOTO 350 IF(IOP2.NE.SBUF) GOTO 350 C C THIS IS A RESPONSE TO A KILL PROMPT. MODIFY THE CONTROL C PARAMETERS FROM THE SECOND BUFFER RETURNED ON THE CLASS GET. C C IOP1=JBUF IOP2=JBUF(2) CCLAS=JBUF(3) C C C SEE IF THE REQUEST IS INTERACTIVE C C 60 IOP1=IAND(IOP1,777B) IF(IOP1.GT.99) GOTO 200 INTER=XFTTY(IOP1) C C C C C C SESSION ENVIRONMENT HAS BEEN INITIALIZED--OR ‰(þúTHE CLASS GET ON C $LGOF (CLASS #) WOULD HAVE BEEN REJECTED. C C C OPEN ACCOUNT FILE AND DEFINE RECORD NUMBERS OF ACTIVE SESSION C TABLE AND NUMBER OF RECORDS IN THAT TABLE. ALSO, FETCH THE C RESOURCE NUMBER FOR ACCOUNT FILE CONTROL(IRN) AND SAVE IT FOR EVER C AND EVER (OR UNTIL THIS PROGRAM TERMINATES). C C 200 CALL OPEN(IDCB,IERR,6H+@CCT!,1,-31178) IF(IERR.EQ.1) GOTO 400 C C C PROBLEM WITH ACCOUNT FILE -- ISSUE ERROR AND TERMINATE. C C IF IERR POSITIVE, BUT NOT = 1 GIVE FILE NOT FOUND ERROR. C C FILE TYPE MUST BE 1 C C 250 IF(IERR.GE.0) IERR=-6 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C FMP ERROR AND SHUT DOWN WORK C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 300 CALL CNUMD(-IERR,LG01(11)) CALL MESSP(100103B,LG01,-50) C C RELEASE POSSIBLE CLASS BUFFER C 350 CALL EXEC(21+100000B,LGFC,IGBUF,0) GOTO 375 C C FAKE OUT THE COMPLIER C 98765 CONTINUE 375 CALL CLOSE(IDCB) C C IF NOT SHUTDOWN REQUEST, GO WAIT FOR BETTER NEWS. C IF(IOP2.NE.-1) GOTO 1 376 CALL EXEC(6) C C C C C C SESSION ENVIRONMENT NOT SETUP. ISSUE ERROR AND TERMINATE. C 380 CALL MESSP(100003B, C 44HLGOF 00 SESSION ENVIRONMENT NOT INITIALIZED ,44) C C FORCE A TERMINATION C IOP2=-1 GOTO 350 C C C C C C C ACCOUNT FILE OPEN - REQUEST LOCAL LOCK ON RN TO VERIFY VALIDITY C C C READ HEADER C 400 CALL READF(IDCB,IERR,IBUF,128,ITMP1,1) IF(IERR.LT.0) GOTO 300 IRN=IBUF(25) C C IF REJECT ON LOCK OF RN, GIVE BAD ENVIRONMENT ERROR. C CALL RNRQ(40001B,IRN,ITMP1) GOTO 380 C C C NORMAL RETURN-- ACCOUNT FOUND AND SET-UP. C C C DEFINE ACCOUNT FILE POINTERS TO BEGINING AND LENGTH OF ACTIVE C SESSION TABLE AND REC # OF START OF DIRECTORY. C C 410 ACTIV=IBUF EACTV=IBUF(2)-1 DIRC=IBUF(5) C C GO GET FIRST REQUEST C Q þú GOTO 500 C C C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C NORMAL FLOW OF CONTROL RETURNS HERE TO MAKE NEXT "GET" REQUEST.C C WE ALWAYS RELEASE THE RN BEFORE THE "GET" SO SOMEONE ELSE CAN C C GAIN ACCESS TO THE ACCOUNT FILE. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C SIGNAL COMPLETION TO CALLER C C 450 CALL MESSP(0,I,0) C C RELEASE POSSIBLE CLASS BUFFER C 475 CALL EXEC(21,LGFC,IGBUF,0) C C C RELEASE POSSIBLE RN LOCK C C 500 CALL RNRQ(40004B,IRN,ITMP1) C C IGNORE NOT SET ABORT RETURN C GOTO 525 C C FAKE OUT THE COMPLIER C 87654 CONTINUE C C C C MAKE A "GET" REQUEST BUT DON'T RELEASE THE BUFFER. C C 525 IGBUF=0 REG=EXEC(21,LGFC+40000B,IGBUF,-26,IOP1,IOP2,ITMP1) C C C C ONLY ACCEPT READ OR WRITE/READ REQUESTS WITH IOP2 .NE. 0 C C IF(ITMP1.NE.1.OR.IOP2.EQ.0) GOTO 475 C C C C CHECK TYPE OF REQUEST (IOP2 .LT. 0 = RESPONSE TO KILL PROMPT) C IF(IOP2.LT.0) GOTO 6000 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C VERIFY THAT THIS IS REALLY A LOG-OFF CALL C C C C IOP1 MUST CONTAIN THE SESSION ID IN THE LOW 9 BITS. C C BITS 15-13 ARE LOG-OFF OPTN FLAGS C C C C 15=DISMOUNT PRIVATE C C 14=DISMOUNT GROUP C C 13=KILL ACTIVE PROGRAMS C C ôþú C C C C IOP2 MUST = THE SCB POINTER OF THE SESSION LOGGING OFF C C C C C C C ISOLATE OPTIONS AND SESSION ID - SAVE OPTIONIAL CLASS # (PASSED C C IN THE CLASS BUFFER) - AND SET UP THE INTERACTIVE FLAG C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C OPTNS=IAND(IOP1,160000B) INTER=0 CCLAS=IGBUF C C IOP1=IAND(IOP1,777B) C C IF SESSION ID > 99 MUST NOT BE INTERACTIVE C IF(IOP1.GT.99) GOTO 535 C INTER=XFTTY(IOP1) C C C VERIFY PASSED PARAMETERS AND FETCH INFORMATION FROM SCB C C 535 IF(VALID(DCPU,PID,GID,DENT).NE.0) GOTO 600 C C C PARAMETERS ARE NOT VALID - SEND POSSIBLE TIE-OFF TO CALLING PROGRAM C AND CONTINUE WITH NEXT REQUEST. NOTE SPECIAL RETURN STATUS = 76B C 550 CALL MESSP(117601B,I,0) GOTO 475 C C C C C C C C C C C C C C C C C THE PARAMETERS MATCHED AN EXISTING SCB C PREPARE FOR SCAN OF ID SEGMENTS C C C C SET KILL FLAGS C C C C NOTE: MAY WANT TO DISABLE TERMINAL (SET BIT MAP FLAG) HERE. C C 600 OK=IAND(OPTNS,20000B) 626 FND=0 OOPS=0 IDNO=0 650 ITMP1=0 C C C C SCAN FOR ACTIVE PROGRAM RUNNING FOR THIS SESSION C C 700 IF(IDSCH(IDNO,OFPRG).EQ.0) GOTO 1000 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C ACTIVE PROGRAM FOUND C C C C SPECIAL WORK MUST BE DONE HERE. THE PROGRAMS SMP AND D.RTR C C MUST BE ALLOWED ¤þú TO CLEAN THEMSELVES UP. THEREFORE WE NEVER C C ABORT THEM. D.RTR IS CLEANED UP VIA A SESSION CLEAN-UP SCHEDULE C C REQUEST. THIS REQUEST IS CURRENTLY TREATED AS A NOP (BY D.RTR). C C IT'S FUNCTION IS TO PREVENT THE DESTRUCTION OF A SESSION CONTROL C C BLOCK WHILE D.RTR IS STILL LINKED TO IT. SMP IS CLEARED VIA IT'S C C SESSION CLEAN-UP REQUEST. THIS REQUEST WILL CAUSE ALL PENDING C C SPOOL LU'S (FILES) ASSOIATED WITH THIS SESSION TO BE OUTSPOOLED C C AND CLEANED UP. C C C C C C OOPS=1 IF D.RTR \ 2 IF SMP C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF(PGRM.EQ.2HD..AND.PGRM(2).EQ.2HRT.AND.PGRM(3).EQ.2HR ) ITMP1=1 C IF(PGRM.EQ.2HSM.AND.PGRM(2).EQ.2HP ) ITMP1=2 C IF(ITMP1.EQ.0) GOTO 750 OOPS=ITMP1 GOTO 650 C C C C C C C C ACTIVE PROGRAM FOUND AND IT'S NOT SMP OR D.RTR. CHECK KILL FLAG C TO SEE IF WE MUST PROMPT FOR PERMISSION OF IF WE CAN JUST KILL C THE PROGRAM. C C C 750 IF(OK.EQ.0) GOTO 900 C C C WE CAN KILL IT, SO MAKE THE MESSS CALL. C SET FOUND FLAG =-1 TO INDICATE THAT A PROGRAM HAS BEEN TERMINATED. C C CALL MESSS(OFPRG,12) FND=-1 GOTO 700 C C C C WE CAN'T KILL THE PROGRAM WITHOUT PERMISSION. PRINT THIS ONE'S C NAME AND SET FOUND FLAG=1 TO INDICATE THAT AN ACTIVE PROGRAM EXISTS. C C NOTE RETURN STATUS =75B C C 900 CALL MESSP(17501B,PGRM,-6) FND=1 GOTO 700 C C C C C C C C C C WE HAVE REACHED THE END OF THE ID SEGMENTS ( OR THE FIRST SHORT SEG). C C IF ANY PROGRAMS HAVE BEEN ABORTED, GO BACK AND MAKE ANOTHER PASS C TO VERIFY THAT NO ONE CAME IN BEHIND US. C C IF ANY ACTIVE PROGRAMS STILL EXIST GET PERMISSION TO KILL. C C 1000 IF(FND) «þú626,2000,1100 C C C C C C PROGRAMS TO BE ABORTED, MUST GET PERMISSION C C 1100 CALL MESSP(17501B,29HABOVE SESSION PROGRAMS ACTIVE,-29) CALL MESSP(17501B,24HOK TO ABORT ? (Y OR N)_,-24) C C C CHECK FOR NON-INTERACTIVE CALL AS SPECIAL WORK MUST BE DONE IN C THAT CASE. C C IF(INTER.NE.0) GOTO 1200 C C C THIS IS A NON-INTERACTIVE CALL, A CLASS # MUST HAVE BEEN PROVIDED C OR WE CAN GO NO FURTHER. C C IF(CCLAS.EQ.0) GOTO 475 C C C SETUP FOR CLASS WRITE/READ C ICON(1)=0 ICLAS=CCLAS IREQ=100025B ITMP1=0 GOTO 1400 C C C C C SETUP FOR AN INTERACTIVE RESPONSE C C 1200 ICON(1)=IOP1 ICLAS=LGFC IREQ=100021B ITMP1=-20 C C C C DEFINE SECOND BUFFER C C C 1400 JBUF=IOP1+OPTNS JBUF(2)=IOP2 JBUF(3)=CCLAS C C C C C MAKE THE REQUEST. IF ERROR, ASSUME BAD CLASS PASSED IN NON-INTERACTIVE C CALL. C C CALL XLUEX(IREQ,ICON,IGBUF,ITMP1,JBUF,SBUF,ICLAS) C C MAKE ERROR EXIT C GOTO 550 C C C MAKE NORMAL CONTINUATION - GO RELEASE CURRENT CLASS BUFFER AND C MAKE NEXT GET REQUEST. C C C C 1410 GOTO 475 C C C C C C C C C C C C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C AT THIS POINT, ALL PROGRAMS RUNNING FOR THIS SESSION HAVE BEEN C C ABORTED. IF D.RTR IS STILL POINTING AT THIS SESSION CONTROL C C BLOCK WE WILL ISSUE THE SESSION CLEAN-UP REQUEST TO IT. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C 2000 IF(OOPS.NE.1) GOTO 3000 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CLEAR D.RTR WITH IT'S SESSION CLEAN-UP CALL. THIS CALL CURRENTLY C C DOES NOTHING MORE THAN ¾þúALLOW LGOFF TO WAIT UNTIL THE PROBLEM C C WITH D.RTR IS CLEARED. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALL IGET(1717B,ITMP1) CALL EXEC(23,6HD.RTR ,ITMP1,30) C C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C NO ACTIVE PROGRAMS FOR THIS SESSION EXIST. RELEASE THE ID SEGMENTS C C (LONGS ONLY) ALLOCATED TO THIS SESSION. C C C C C C CLEAC COMPARES THE OWNER FLAG (IN WD 31) OF ALL LONG ID'S C C WITH THE SESSION ID OF THIS SESSION. IF THEY MATCH, AND THE C C PROGRAM USING THE ID IS DORMANT, AN OF,PROG,8 IS ISSUED. IF C C AN ID WAS BUILT FOR THIS SESSION AND SOMEONE ELSE IS USING C C THE PROGRAM ( REMEMBER, ALL PROGRAMS RELATED TO THIS SESSION C C MUST BE DORMANT OR WE WOULDN'T BE HERE ) , GIVE THE ID TO THE C C SESSION CURRENTLY RUNNING THE PROGRAM. C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C 3000 CALL CLEAC C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C THIS SECTION PERFORMS THE DISC CARTRIDGE MANAGEMENT. C C FIRST, SEE IF ANYTHING IS TO BE DISMOUNTED. C C IF(IAND(OPTNS,140000B).EQ.0) GOTO 4000 C C C A DISMOUNT HAS BEEN REQUESTED. GET A COPY OF DISCS MOUNTED C TO THIS SESSION. C C GET SST LENGTH AND DISC LIMIT C CALL ISMVE(IOP2,-1,IBUF,2) C C IF DISC LIMIT=0 DONE C IF(IBUF.EQ.0) GOTO 4000 C C GET DISC MOUNTED LIST C CALL ISMVE(IOP2,2-IBUF(2),IBUF(2),IBUF) C C C C SCAN FOR MATCHING PRIVATE OR GROUP ID (AS DIRECTED BY OPTNS) C C C G«þú DO 3700 J=1,2 C IF(J.EQ.2) GOTO 3100 C C CHECK FOR PRIVATE DISMOUNT (IF NOT PRIVATE, GO DO GROUP) C IF(IAND(100000B,OPTNS).EQ.0) GOTO 3300 C C C SCAN FOR THE PRIVATE ID C IF GLOBAL DISC (ID=7777B) DON'T DISMOUNT IT. C C C ID=0 IF(PID.EQ.7777B) GOTO 3300 C C C DISC MOUNTED LIST STARTS AT IBUF(2) C C 3100 DO 3200 I=2,IBUF+1 C C CKECK FOR BLANK ENTRY C IF(IBUF(I).EQ.0) GOTO 3200 C C CKECK FOR GROUP FLAG (BIT 14) C IF(IAND(IBUF(I),40000B).NE.ID) GOTO 3200 C C C MATCH FOUND. ATTEMPT TO DISMOUNT IT. C C REG=DCMC(TEMP1,2,-(IAND(IBUF(I),377B)),2HRR,0,0,0,0,IOP2) IF(TEMP1.NE.0) GOTO 3200 C C DCMC RETURNS THE FOLLOWING: C C (A) REG=+CRN OF DISC DISMOUNTED C (B) REG=DISC LU AND BIT 15=1 IF RETURNED TO POOL C 14=1 IF DISMOUNTED BUT NOT POOL C C C SEE IF IT WAS REALLY DISMOUNTED (AND IF IT WENT BACK TO C THE POOL). C DMLEN=-38 IF(IB) 3150,3125 C C DISC WAS NOT RETURNED TO POOL C SEE IF IT WAS DISMOUNTED FROM SYSTEM C 3125 IF(IAND(IB,40000B).EQ.0) GOTO 3200 C C IT WAS DISMOUNTED. ADJUST MESSAGE LENGTH C DMLEN=-32 C C C IT WAS DISMOUNTED AND RETURNED TO THE POOL C CONVERT CRN AND LU AND TELL THEM ABOUT IT C 3150 DBLK=4H DMES(7)=IA C C MOVE CRN IN FRONT OF ASCII BLANKS FOR NAM.. TEST C NAMB=IA IF(NAMT(NAMB).NE.0) CALL CNUMD(IA,DMES(5)) DMES(10)=KCVT(IAND(IBUF(I),77B)) C CALL MESSP(10001B,DMES,DMLEN) C C 3200 CONTINUE C C C C CHECK FOR GROUP DISMOUNTS C C 3300 IF(IAND(OPTNS,40000B).EQ.0) GOTO 4000 ID=40000B C 3700 CONTINUE C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C THIS SECTION CALLS THE SPOOL MONITOR PROGRAM (SMP) TO CLEAN-UP C C ALL SPOOL FILES ASSOCIATED WITH THIS SESSION. Ñëþú C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 4000 CALL ISMVE(IOP2,0,ITMP1,1) CALL EXEC(100027B,6HSMP ,19,DENT,IOP2,ITMP1) GOTO 4050 4001 CONTINUE C C C RELEASE THE SCB C 4050 CALL RLSCB(IOP1,ITMP1) C C C C C C C C C C C C C C C C C C C C C ACCOUNT FILE UPDATE SECTION C C LOCK THE ACCOUNT FILE RN C C FIND THE ENTRY IN THE ACTIVE SESSION TABLE FOR THIS SESSION C C CALL RNRQ(1,IRN,ITMP1) C C C DO 4200 I=ACTIV,EACTV CALL READF(IDCB,IERR,IBUF,128,ITMP1,I) IF(IERR.NE.0) GOTO 300 C DO 4100 J=1,124,4 IF(IBUF(J).EQ.IOP1) GOTO 4300 C 4100 CONTINUE 4200 CONTINUE C C C C TO GET HERE MEANS THAT THE ACCOUNT FILE IS CORRUPT. C C CALL MESSP(100103B,28HLGOF 01 ACCOUNT FILE CORRUPT,-28) GOTO 350 C C C C C 4300 LOT1=IBUF(J+1) LOT2=IBUF(J+2) DREC=IBUF(J+3)/8+DIRC DOFF=MOD(IBUF(J+3),8)*16 C C CLEAR THE ACTIVE SESSION TABLE ENTRY C IBUF(J)=0 CALL WRITF(IDCB,IERR,IBUF,128,I) C C C UPDATE ACTIVE SESSION COUNTER IN HEADER C CALL READF(IDCB,IERR,IBUF,128,ITMP1,1) IBUF(29)=IBUF(29)-1 CALL WRITF(IDCB,IERR,IBUF,128,1) C C C C C C GET LOG-OFF TIME C CALL EXEC(11,TIME,YEAR) CALL FTIME(OFMS1(3)) C C C FORMAT LOG-OFF TIME FOR ACCT FILE C OFF1=TIME(2)+(TIME(3)*64)+((YEAR-1978)*4096) OFF2=TIME(4)+(TIME(5)*32) C C C C C C CALCULATE CONNECT TIME C C C LOT1 AND LOT2 REPRESENT THE LOG-ON TIME (PACKED LIKE OFF1&2) C C THE TIME ARRAY CONTAINS THE FOLLOWING: C C TIME(2)=SEC C TIME(3)=MIN C TIME(4)=HOUR C TIME(5)=DAY C C C ISOLATE LOG-ON TIME C ONSEC=IAND(LOT1,77B) ONMIN=IAND(LOT1,7700B)/64 ONHR=IAND(LOT2,37B) ONDAY=IAND(LOT2,37740B)/32 C C C œÚþú DO CONNECT TIME NOW C C C CONNECT SECONDS C C C SEC=TIME(2)-ONSEC IF(SEC.GE.0) GOTO 5000 SEC=60+TIME(2)-ONSEC TIME(3)=TIME(3)-1 C C C C CONNECT MIN C C 5000 MIN=TIME(3)-ONMIN IF(MIN.GE.0) GOTO 5010 MIN=60+TIME(3)-ONMIN TIME(4)=TIME(4)-1 C C C CONNECT HRS C C 5010 HRS=TIME(4)-ONHR IF(HRS.GE.0) GOTO 5020 HRS=24+TIME(4)-ONHR TIME(5)=TIME(5)-1 C C C CONNECT DAYS C C 5020 DYS=TIME(5)-ONDAY IF(DYS.GE.0) GOTO 5100 C DYS=366+TIME(5)-ONDAY C IF(MOD((YEAR-1),4).NE.0) DYS=DYS-1 C C C C C CALCULATE TOTAL NUMBER OF CONNECT SECONDS C FOR ACCT FILE UPDATE. NOTE: DSEC IS A DOUBLE WORD INTEGER. C C 5100 DSEC=0 DSEC(2)=SEC+(MIN*60) CALL DCNCT(DSEC,HRS,DYS) C C C C C C C GET DIRECTORY ENTRY INTO MEMORY C C CALL READF(IDCB,IERR,IBUF,128,ITMP1,DREC) IF(IERR.LT.0) GOTO 300 C C C SPACE A LINE, THEN ISSUE "OFF" MESSAGES TO SESSION CONSOLE C CALL MESSP(10001B,2H ,-2) CALL MESSP(1,OFMS1,-34) C C MOVE USER AND GROUP NAMES INTO MESSAGE BUFFER C AND ISSUE SHORT VERSION TO SYSTEM CONSOLE. C NAML=MBT(IBUF(DOFF+1),OFMS1(13)) CALL MESSP(2,OFMS1,-24+NAML) C C C DEFINE USER AND GROUP RECORD NUMBERS C C GREC=IAND(IBUF(DOFF+14),77777B) UREC=IAND(IBUF(DOFF+15),77777B) C C DEFINE OFFSETS (MAY START AT WORD 65 OF SECTOR) C GOFF=0 IF(IBUF(DOFF+14).LT.0) GOFF=64 C UOFF=0 IF(IBUF(DOFF+15).LT.0) UOFF=64 C C C UPDATE THE USER ENTRY C CALL READF(IDCB,IERR,IBUF,128,ITMP1,UREC) C C POST LAST LOG-OFF TIME TO USER ENTRY C IBUF(UOFF+23)=OFF1 IBUF(UOFF+24)=OFF2 C CALL DADD(IBUF(25+UOFF),DSEC) CALL DADD(IBUF(27+UOFF),DCPU) C C FORMAT CUMULATIVE CONNECT TIME (DOUBLE WORD SECONDS) WHILE C DATA IS IN MEMORY. C C C CALL FCNCT(IBUF(25+UOFF),TIME) CALL CNV2(ú–þúOFMS5(13),TIME) OFMS5(19)=IOR(KCVT(TIME(2)),30060B) OFMS5(24)=IOR(KCVT(TIME(3)),30060B) C C C CALL WRITF(IDCB,IERR,IBUF,128,UREC) C C C C CC CHECK FOR PENDING MAIL C MAIL=IBUF(UOFF+21) C C C C UPDATE GROUP ENTRY C C CALL READF(IDCB,IERR,IBUF,128,ITMP1,GREC) C CALL DADD(IBUF(2+GOFF),DSEC) CALL DADD(IBUF(4+GOFF),DCPU) C CALL WRITF(IDCB,IERR,IBUF,128,GREC) C C C ACCOUNT FILE IS UPDATED. CLEAR THE LOCK C CALL RNRQ(4,IRN,ITMP1) C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C CONNECT TIME CONVERSION (THIS SESSION) C C HRS=DYS*24+HRS C CALL CNV2(OFMS3(13),HRS) OFMS3(19)=IOR(KCVT(MIN),30060B) OFMS3(24)=IOR(KCVT(SEC),30060B) C CALL MESSP(10001B,OFMS3,-54) C C C FORMAT CPU USAGE C CALL FCPU(DCPU,TIME) OFMS4(14)=IOR(KCVT(TIME),30060B) OFMS4(19)=IOR(KCVT(TIME(2)),30060B) OFMS4(24)=IOR(KCVT(TIME(3)),30060B) CALL CNUMD(TIME(4)*10,OFMS4(28)) OFMS4(30)=IOR(OFMS4(30),30060B) C C CALL MESSP(10001B,OFMS4,-64) C C C C C ISSUE CUMULATIVE CONNECT TIME C C CALL MESSP(10001B,OFMS5,-54) C C C IF MAIL PENDING, SPACE A LINE AND LET THEM KNOW ABOUT IT. CC IF(IAND(MAIL,100000B).EQ.0) GOTO 5500 CALL MESSP(10001B,2H ,-2) CALL MESSP(10001B,16HMESSAGES WAITING,-16) C C C 5500 CALL MESSP(10001B,14HEND OF SESSION,-14) C GOTO 450 C C C C C C C C C C C C C C C C C C RESPONSE TO KILL PROMPT C 6000 IF(IOP2.EQ.-1) GOTO 350 IF(IOP2.NE.SBUF) GOTO 550 C C IOP1=IAND(JBUF,777B) OPTNS=IAND(JBUF,177000B) IOP2=JBUF(2) CCLAS=JBUF(3) C C C IF SESSION ID > 255 MUST NOT BE INTERACTIVE C INTER=0 IF(IAND(IOP1,400B).NE.0) GOTO 6025 INTER=XFTTY(IOP1) C C C VERIFY CALL PARAMETERS eÄTRNC 6025 IF(VALID(DCPU,PID,GID,DENT).EQ.0) GOTO 550 C C CHECK RESPONSE TO KILL PROMPT. ANYTHING OTHER THAN "Y" OR C A ZERO LENGTH TRANSFER IS TREATED AS "NO". C IF(IB.EQ.0) GOTO 6050 C IF(SQUZ(IGBUF,IB).NE.131B) GOTO 7000 C C WE HAVE PERMISSION TO KILL, SET KILL FLAG AND CONTINUE C 6050 OK=1 GOTO 626 C C C C PERMISSION TO KILL NOT GIVEN. C IF INTERACTIVE, RESTART THE FMGR C C C 7000 IF(INTER.EQ.0) GOTO 550 C C ITMP1=IOR(KCVT(IOP1),30000B) C GX=43400B+(ITMP1/256) XB=IAND(ITMP1,377B)*256+40B C DO 7050 I=1,5 IBUF(I)=RUFM(I) 7050 CONTINUE C IBUF(6)=2H,1 C CALL MESSS(IBUF,12,1,IOP2) C C GOTO 550 C END END$ —±Tÿÿ ÿý¹Ì ÿ92067-18262 2026 S C0122 &PRMPT SESSION PROMPT PROGRAM             H0101 cbþúASMB,R,L,C,Q HED PRMPT - PART OF THE SESSION TERMINAL HANDLERS * NAME: PRMPT * SOURCE: 92067-18262 * RELOC: PART OF 92067-16260 * PGMR: G.A.A.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRMPT,129,5 92067-16260 REV.2026 800416 SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,FNDLU,$LIBR,$LIBX,IDGET EXT XLUEX,LUSES,$LGON,$DSCS,$LGOF EXT $LME$,$STH,.SETB,.CLRB * * THIS INTERRUPT ROUTINE PROVIDES FOR THE INITIATION OF SESSIONS * AND THE INITIATION OF "BREAK" PROCESSING. * IT IS SCHEDULED ON INTERRUPT BY DVR00(05,07) IF THAT TERMINAL HAS BEEN * PROPERLY ENABLED (ON,CNTRL,LU,20) * * 2026 PCO: CHANGED TO PERFORM ALL I/O VIA CLASS. THIS IS TO PREVENT * PRMPT FROM HANGING IF A DEVICE GOES DOWN AS A RESULT * OF A PRMPT I/O REQUEST (DVA05 AND MODEM PROBLEMS). * SPC 5 * * PRMPT EQU * STB EQT4 * * * JSB FNDLU FIND THE LU FOR THIS EQU DEF *+1 SZA,RSS FIND ONE? JMP EXIT NOPE * SEZ IS THE DEVICE UP? JMP EXIT NO- SO GET OUT * STA LU SAVE THE DEVICE LU * ADA MD100 SESSION LU MAX IS 99 SSA,RSS IS THIS ONE > 99 JMP ERLU YES, ISSUE ERROR MESSAGE AND EXIT * * STB ASCLU SAVE ASCII LU STX RN# SAVE POSSIBLE RN BYPASS WORD CYB GET DEVICE TYPE WHERE IT CAN BE CHECKED STB DVTYP AND SAVE FOR ERROR RECOVERY * * * * VERIFY THAT THE SESSION ENVIRONMENT HAS BEEN DEFINED. * * XLA $DSCS FETCH SESSION FLAG CPA ×£þúN1 IF =-1 THEN WE ARE NOT READY TO CONTINUE JMP NOTIN * LDA $LGON FETCH LOGON CLASS # SZA,RSS IF NOT DEFINED, JMP NOTIN ERROR STA CLASS * LDA $LGOF FETCH LGOFF CLASS # SZA,RSS IF NOT DEFINED, JMP NOTIN ERROR * LDA $STH FETCH R$PN$ CLASS # SZA,RSS IF NOT DEFINED, JMP NOTIN ERROR STA CLAS2 * * NOTE: (B) STILL CONTAINS THE DEVICE TYPE * CPB DVR07 IF MULTIPOINT RSS GO SET EDIT-MODE FLAGS JMP LUDIS GO DO LU DISABLE * LDA B2300 FETCH CONTROL PORTION STA CONWD AND SAVE FOR CONTROL REQUEST JSB XLUEX DEF ED.TF DEF DS19 CONTROL REQUEST WITH NO-ABORT DEF LU DEF IM EDIT MODE FLAGS DEF CLAS2 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# WATCH OUT FOR LU LOCKS ED.TF EQU * NOP POSSIBLE ERROR RETURN * SPC 5 * * * DISABLE TERMINAL BY SETTING BIT IN BIT MAP * LUDIS LDA LU FETCH LU JSB .SETB GO SET BIT SEZ WAS IT ALREADY SET ? JMP BSY YES,GO MAKE SURE EVERYONE IS STILL SCHEDULED * * * CLA CLEAR CON WD SO STA CONWD WE GET CRLF * JSB XLUEX RESPOND WITH DEF ZROTN ZERO LENGTH RECORD DEF DS18 DEF LU DEF BUFF DEF D0 DEF NOP DEF NOP DEF CLAS2 DEF NOP DEF RN# ZROTN NOP * SKP * * * THIS IS WHAT WE WANT TO DO: * * 1) SEE IF A SESSION IS DEFINED FOR THIS TERMINAL (NODE ?) * 2) IF YES- THIS IS A "BREAK" MODE REQUEST * 3) OTHERWISE- * A) FIND "LOGON" OR GIVE ERROR AND QUIT * B) ISSUE LOGON MESSAGE TO TERMINAL ( GET THIS FROM * SYS MAP BUFFER) * C) START CLASS READ FOR RESPONSE AND GET "LOGON" STARTED. * D) TERMINATE, SAVING RESOURCES SPC ƒ*þú5 * JSB LUSES GO SEE DEF *+2 IF A DEF LU SESSION IS DEFINED STA SESID SAVE THE SCB INFO SZA FOR THIS REQUEST JMP PROMT YES--BREAK MODE SKP * * LOG-ON REQUEST * * CHECK FOR SHUTDOWN STATUS * LDA $DSCS CPA N2 IF SHUTDOWN JMP SHDN ISSUE MESSAGE AND TERMINATE * * * LDA RN# IF THIS LU IS LOCKED SZA PUNT ! JMP LULCK * * JSB IDGET LOOK UP THE ID ADDRESS DEF *+2 OF LOGON EVERY TIME DEF LOGON TO PREVENT PROMPTING USER WHEN YOU CAN'T CONTINUE SEZ JMP LGERR NOT FOUND-- ISSUE LOGON NOT FOUND ERROR! * * MOVE IN LOG-ON PROMPT * LDA $LME$ FETCH ADDR OF LOG-ON PROMPT LDB DLGON FETCH ADDR OF LOCAL BUFFER LDX D11 MWF MOVE WORDS FROM SYSTEM MAP INTO USER MAP * JSB XLUEX PROMPT FOR LOGON STRING (USER.GROUP) DEF LG.1 DEF DS18 DEF LU DEF LOGMS+1 DEF LOGMS DEF NOP DEF NOP DEF CLASS USE LOGON'S CLASS # LG.1 NOP * * IF SHUT-DOWN IN PROGRESS, GET OUT * LDA $DSCS+1 SSA JMP ENBL * LDA B400 SET FOR ECHO STA CONWD ON READ OF USER.GROUP NAME * JSB XLUEX START CLASS READ OF USER INPUT DEF LG.2 DEF DS17 DEF LU DEF * DEF DM80 DEF NOP DEF LU DEF CLASS LG.2 NOP * * * ATTEMPT TO SCHEDULE LOGON PASSING THE COMMUNICATION CLASS# IN TEMP 1 * JSB EXEC DEF RTSCH DEF DS10 SCHEDULE NO WAIT DEF LOGON DEF LU DEF CLASS RTSCH NOP ERROR RETURN * * * * JMP EXIT * SKP * * * BREAK MODE PROCESSING * * PROMT JSB XLUEX DEF *+10 "S=LU COMMAND?_" DEF DS18 DEF LU DEF BUFF DEF D8 DEF NOP ¥ þú DEF NOP DEF CLAS2 USE R$PN$'S CLASS NUMBER DEF NOP DEF RN# NOP ERROR RETURN SPC 1 LDA B400 ALLOW ECHO ON INPUT STA CONWD * JSB XLUEX PERFORM CLASS I/O READ DEF *+10 DEF DS17 DEF LU DEF * DEF DM80 DEF SESID DEF EQT4 DEF CLAS2 DEF NOP DEF RN# NOP ERROR RETURN SSA ERROR RETURN? JMP EXIT YES-BEAT IT ! * SPC 1 JSB EXEC SCHEDULE R$PN$ W/O WAIT DEF SCRPN IGNORE SCHEDULE ERRORS SINCE DEF DS10 R$PN$ IN CLASS 'GET' SUSPEND DEF R$PN$ DEF CLAS2 SCRPN NOP ERROR RETURN * * SKP * * * TERMINATION PROCESSING * * CHECK FOR POSSIBLE STRING FROM SYS/SES CONSOLE * * * EXIT JSB EXEC TERMINATE DEF *+1+3 & SAVE DEF D6 RESOURCES DEF D0 DEF D1 JMP PRMPT RESTART HERE ON INTERRUPT * * ERLU LDA CONF TERM LU TOO BIG JMP EMES ISSUE MESSAGE * NOTIN LDA NIERR NOT-INITIALIZED ERROR JMP EMES * LULCK LDA LKERR LU LOCKED ERROR JMP EMES * LGERR LDA NFND CAN'T FIND LOGON JMP EMES * SHDN LDA SDERR SHUT-DOWN MESSAGE * * EMES STA ELEN INA ADVANCE TO BUF ADDR STA EBUF * CLA CLEAR CON WORD STA CONWD * * WRITE ERROR VIA CLASS I/O. WE MUST FIRST ALLOCATE A CLASS * AND THEN GET IT RELEASED. * JSB XLUEX DEF ERRTN DEF DS18 DEF LU EBUF DEF * ELEN DEF * DEF NOP DEF NOP DEF TCLAS DEF NOP DEF RN# ERRTN NOP ERROR RETURN * NGET JSB XLUEX DEF GRTN DEF DS21 DEF TCLAS DEF * DUMMY BUFFER DEF NOP ZERO LENGTH TRANSFER GRTN NOP THIS GET WILL RELEASE THE CLASS # * CLA STA TCLAS * 0 þú * ERROR CONDITIONS CAUSE THE DISABLE BIT TO BE CLEARED * ENBL LDA LU JSB .CLRB THIS ROUTINE CHECKS THE VALUE OF A JMP EXIT * JMP EXIT SKP * THE BUSY BIT WAS SET AND THE TERMINAL INTERRUPTED AGAIN. * MAKE SURE ALL THE MONITORS ARE SCHEDULED AND EXIT. * BSY JSB EXEC DEF SC1 DEF DS10 DEF R$PN$ SC1 NOP * JSB EXEC DEF SC2 DEF DS10 DEF LOGON SC2 NOP * JSB EXEC DEF SC3 DEF DS10 DEF LGOFF SC3 NOP JMP EXIT SKP DS3 OCT 100003 DS10 OCT 100012 DVR07 OCT 3400 IM OCT 71401 B2300 OCT 2300 EQT4 BSS 1 MD100 DEC -100 DVTYP NOP ************* LU BSS 1 * NOTE: 2 WORD PARM CONWD BSS 1 * ************* SESID NOP B400 OCT 400 DS18 OCT 100022 DS19 OCT 100023 DS21 OCT 100025 TCLAS NOP ********************************* BUFF ASC 7,S=LU COMMAND ? OCT 3537 BELL AND BACK ARROW ASCLU EQU BUFF+1 PROMPT MESSAGE ********************************** * LOGMS BSS 11 NOTE: THIS BUFFER IS LOADED FROM THE SYS MAP ********************************************* D22 DEC 22 * MCONF ASC 22,PRMPT\ TERMINAL LU > SESSION MAXIMUM OF 99 CONF DEF MCONF-1 * ********************************************* D12 DEC 12 * MFND ASC 12,PRMPT\ LOGON NOT FOUND * NFND DEF MFND-1 * ********************************************* DEC 8 * LKER ASC 8,PRMPT\ LU LOCKED * LKERR DEF LKER-1 * ********************************************* D15 DEC 15 * NIER ASC 15,PRMPT\ SESSION NOT INITIALIZED * NIERR DEF NIER-1 * ***************************************************** DEC 8 * SDER ASC 8 9É$" PRMPT\ SHUTDOWN * SDERR DEF SDER-1 * ***************************************************** * DLGON DEF LOGMS D11 DEC 11 D8 DEC 8 D6 DEC 6 D0 DEC 0 D1 DEC 1 N1 DEC -1 N2 DEC -2 CLASS NOP CLAS2 NOP NOP NOP DM80 DEC -80 R$PN$ ASC 3,R$PN$ DS17 OCT 100021 RN# NOP LOGON ASC 3,LOGON LGOFF ASC 3,LGOFF A EQU 0 B EQU 1 END PRMPT Ï#$ÿÿ ÿýº Å ÿ92067-18263 2001 S C0122 &R$PN$ COMMAND RESPONSE PROCES             H0101 >"þúASMB,R,L,C,Q HED R$PN$ SESSION TERMINAL HANDLER (RESPONSE) * NAME: R$PN$ * SOURCE: 92067-18263 * RELOC: 92067-16260 * PGMR: G.A.A.,C.M.M.,G.L.M. * DATE: AUGUST 1,1974 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM R$PN$,131,5 92067-16260 REV.2001 791107 SUP PRESS EXTRANEOUS LISTING EXT EXEC,FNDLU,XLUEX,CAPCK,MESSS,$STH,DTACH,$DSCS EXT $LIBX,$LIBR,IDGET,.CLRB,IDDUP,$CVT1 EXT VSCBA,$PARS,SELUR,LUTRU * A EQU 0 B EQU 1 EQTA EQU 1650B * * SPC 2 R$PN$ EQU * ENTRY POINT,SCHED BY PRMPT JSB DTACH GET OUT OF A POSSIBLE SESSION DEF DTRTN DEF BUFF DUMMY BUFFER TO FORCE DTACH TO SYS-CON DTRTN EQU * * XLA $DSCS IF NOT SET UP SSA JMP TERM GO TERMINATE (FOR ACCTS) SPC 2 XLA $STH GET CLASS # SZA,RSS IF NO CLASS # JMP TERM JUST GO TERMINATE * * * AND C160K MASK OFF CLASS NO ONLY STA RQCLS & SAVE IT IOR B20K SET FOR SAVE CLASS STA CLAS$ & SAVE IT ! * JSB BUFF INITILIZE ID ADDS (NOP AFTER FIRST CALL) SPC 2 WAIT JSB EXEC CLASS I/O GET DEF W.1 DEF DS21 DEF CLAS$ RELEASE BUFFER DEF BUFF DEF DM80 DEF ISCB DEF ID DEF RCLAS W.1 EQU * RETURN POINT JMP TERM GO TERMINATE IF CLASS REQUEST ABORTS * LDA RCLAS RAR,SLA WAS THIS A READ RETURN? JMP WAIT NO, WAIT * STB IB SAVE XFER LOG CHARS LDB ID FETCH EQT þUþú4 ADDRESS OR SHUTDOWN FLAG SSB IF SHUT-DOWN, (HE WANTS TO RETURN THE CLASS #) JMP TERM GO TERMINATE * * SPC 1 * SEE IF WE CAN WRITE TO THE LU W/O BEING SUSPENDED SPC 1 * * B=EQT 4 ADDRESS * JSB FNDLU FIND OUT IF DOWN,GET DEV TYPE AND RN BYPASS WORD DEF *+1 STA LU SEZ LU OR EQT DOWN? JMP ENAB2 YES SO FORGET IT * STX RN# SAVE POSSIBLE RN BYPASS WORD STY DVTYP SAVE DEVICE TYPE * LDA IB FETCH TRANS LOG SZA,RSS IF NOTHING PASSED JMP ENABL GO ENABLE TERM ( CLEAR BIT MAP ) * * * WRITES & READS TO THIS TERMINAL ARE OK . * * MAKE SURE THE SESSION STILL EXISTS * JSB VSCBA DEF V.RT DEF ISCB V.RT EQU * CPA LU MUST MATCH SESSION ID RSS IT'S OK JMP ENABL SESSION DOESN'T EXIST * * (A)= TERMINAL LU * JSB .CLRB GO CLEAR THE DISABLE BIT * SKP * * THE CAPCK ROUTINE DETERMINES IF THE SESSION MAY ISSUE THE * THE REQUESTED COMMAND. * IF OK, THE ASCII COMMAND IS RETURNED IN THE * A REG AND THE PARAMETER COUNT IS RETURNED IN B. * JSB CAPCK DEF CAP.1 DEF BUFF DEF IB DEF ISCB * CAP.1 CPA N1 IF COMMAND NOT DEFINED, RETURN "OP CODE ERR" JMP PROCS "OP CODE ERROR" LET MESSS RETURN ERROR SSB IF CAPABILITY IS INSUFFICIENT,RETURN "INSUF ERR" JMP PROCS "INSUFFICIENT CAPABILITY" LET MESSS RETURN ERROR STA CMND SAVE THE ASCII COMMAND STB PCNT SAVE PARAMETER COUNT * * * SPC 2 CPA "FL" (A)=ASCII CMND. FLUSH REQEST? JMP FL YES-FLUSH THIS LU'S BUFFER * CPA "BR" IF BREAK JMP BRPR GO DO BREAK * CPA "OF" IF ABORT JMP OFPR GO DO ABORT THING * CPA "WH" WHZAT CALL? JMP WHPR YES GO DO IT * CPA "HE" HELP*èþú REQUEST? JMP HEPR YES GO DO IT * CPA "TE" TELL OPERATOR REQUEST? JMP TECMD YES DO IT * CPA "SL" SESSION LU SWITCH REQUEST JMP SLCMD YES GO DO IT * CPA "RS" RESTART FMGR CMND ? JMP RSCMD * CPA "SS" SUSPEND REQUEST ? JMP SMART * CPA "GO" GO REQUEST ? JMP SMART * CPA "UP" UP REQUEST ? JMP SMAUP GO SEE IF WE CAN FIND AN EQT TO UP * * * * PROCS LDA BUFFR DEFINE LOCATION OF POSSIBLE ERROR STA SMES MESSAGE FROM SYSTEM * SPC 3 JSB MESSS DEF MES BUFFR DEF BUFF DEF IB DEF D1 SESSION TERM IS LU 1 DEF ISCB * * MES SZA,RSS ANY MESSAGE RETURNED ? JMP ENABL NO. * STA IA * * CLA CLEAR CON WORD STA CONWD * JSB XLUEX & DISPLAY DEF *+10 SYSTEM DEF D18 MESSAGE DEF LU SMES DEF BUFF DEF IA DEF LU DEF ID DEF RQCLS DEF NOP DEF RN# SPC 2 JMP ENABL NOW WAIT SPC 2 FL EQU * LDA DVTYP GET DEVICE TYPE CPA DVR07 IF ITS DVR07 JUST JMP WAIT? FORGET IT. * LDA B2300 SET UP CNWRD STA CONWD TO FLUSH JSB XLUEX PERFORM DEF *+10 I/O DEF D3 CONTROL DEF LU NOTE*** LU IS 2WD PARM--CONWD MUST BE WD2 DEF CONWD DEF RQCLS DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# SPC 2 ENABL EQU * WAIT? LDA LU CLEAR THE ENAB2 JSB .CLRB DISABLE BIT IN BIT MAP * * JMP WAIT * * * * TERM JSB EXEC DEF *+2 DEF D6 TERMINATE WHILE IN SHUT-DOWN MODE * SKP * * * BREAK THE CURRENT SESSION PROGRAM * BRPR SZB IF ANY PARMS SUPPLIED JMP PROCS LET SYSTEM HANDLE * JSaåþúB GETID GET THE LOWEST ID SEGMENT JMP PROCS FMGLU NOT FOUND * BRSET JSB $LIBR GO PRIV NOP ADB D5 INDEX TO BRAKE LOCATION XLA B,I GET THE WORD IOR BIT12 SET THE FLAG XSA B,I RESET THE WORD JSB $LIBX GET OUT DEF *+1 DEF ENABL RE- ENABLE THE TERMINAL * * SPC 10 * * SPECIAL PROCESSING OF THE "SS" AND "GO" * SMART SZB IF ANY PARMS SUPPLIED JMP PROCS LET THE SYSTEM HANDLE IT * STA CMDCM SAVE THE COMMAND UNTIL WE FIND FMGXX JSB GETID FIND LAST SON OF FMGXX OR FMGXX JMP PROCS NOT FOUND--LET THE SYS RETURN ERROR * JSB MNAME GO MOVE THE PROG NAME INTO COMMAND BUFFER DLD CMDCM FETCH THE COMMAND (FOLLOWED BY ", ") DST BUFF DROP THEN INTO THE CMND BUFFER LDA D10 DEFINE COMMAND LENGTH STA IB JMP PROCS GO DO IT * * CMDCM ASC 2,XX, * SPC 10 * * ABORT THE CURRENT SESSION PROGRAM * * OFPR SZB IF ANY PARMS SUPPLIED JMP PROCS LET SYSTEM HANDLE IT * JSB GETID GET LOWEST ID JMP PROCS FMGLU NOT FOUND * SEZ,RSS IF IT IS FMGR JMP BRSET GO SET BREAK * JSB MNAME GO MOVE PROG NAME INTO COMMAND BUFFER * LDA COM1 FETCH ASCII ",1" STA BUF6 AND SET IT INTO THE REQUEST BUFFER LDA D12 REQUEST LENGTH=12 STA IB DLD ROF FETCH ASCII "OF, " DST BUFF AND COMPLETE OFF MESSAGE JMP PROCS SEND THE MESSAGE * * MNAME NOP ADB N3 XLA B,I GET NAME STA BUF3 INB STEP TO NAM 2 XLA B,I GET IT STA BUF4 INB XLA B,I NOW NAM 3 AND C377 IOR B40 ADD BLANK PAD STA BUF5 SET AS THIRD WORD OF NAME JMP MNAME,I SPC 5 * * * RUN THE "HELP" PROGRAM FOR THIS SESSION * Goþú* HEPR SZB IF ANY PARAMETERS PASSED JSB NXBT GO CLEAN UP INPUT BUFFER (RTNS B=CHAR CNT) LDA DRUHE FETCH DEF TO "RU,HELP " JMP CN.1 GO COMPLETE COMMAND * * DRUHE DEF RUHE RUHE ASC 4,RU,HELP * SPC 5 * * * * RUN WHZAT FOR THIS SESSION * * WHPR SZB IF ANY PARAMETERS PASSED, GO JSB NXBT CLEAN-UP INPUT BUFFER (RTNS B=CHAR COUNT) LDA DRUWH FETCH ADDR OF "RU,WHZAT" CN.1 ADB D8 WE ADDED 8 CHARACTERS STB IB SAVE FOR MESSS CALL LDB DAB FETCH ADDRESS OF INPUT BUFFER-4 STB SMES DEFINE NEW BUFFER FOR POSSIBLE RETURN MESSAGE MVW D4 MOVE THE "RU,----" IN * CN.2 LDA ISCB FETCH SCB ADDRESS SSA,RSS SET IT CMA,INA NEGATIVE TO SKIP CAPABILITY CHECKS STA ISCB IN MESSS LDA DOF STA SMES DEFINE POSSIBLE ERROR MSG LOCATION * JSB MESSS DO IT! DEF CN.3 DOF DEF OF DEF IB DEF D1 TERMINAL LU DEF ISCB APPEND IT TO THIS SESSION CN.3 JMP MES GO CHECK FOR RETURN MESSAGE * * DRUWH DEF *+1 ASC 4,RU,WHZAT "WH" ASC 1,WH "UP" ASC 2,UP, SPC 10 * * * * ISSUE MESSAGE TO SYSTEM CONSOLE * * * TECMD LDA IB FETCH CHAR COUNT CMA,INA SET IT NEG STA IB * JSB EXEC DEF TE.1 DEF D2 DEF D1 DEF BUFF DEF IB TE.1 EQU * JMP ENABL * * SPC 10 * RS COMMAND * * ABORT THEN RESTART FMGLU * * RSCMD JSB GETID GO BUILD "FMGLU" AND SEE IF IT EXISTS JMP NOPAW DOESN'T EXIST- GO BUILD ONE * XLA B,I FETCH STATUS AND D15 ISOLATE IT SZA IF NOT DORMANT, JMP OFPAW GO GET HIM ABORTED ADB D2 ADVANCE TO TIME LIST XLA B,I IF "T" BIT IS SET ALF,SLA HE IS IN THE TIME LIST RSS SO GO ABÊþúORT HIM JMP RPAW ELSE GO TURN HIM ON * * * ISSUE AN "OF,FMGLU,1" COMMAND * OFPAW LDA DROF FETCH SOURCE ADDRESS LDB BUFFR FETCH DEST ADDR MVW D6 MOVE COMMAND INTO BUFFER LDA D12 SET COMMAND STA IB LENGTH AT 12 * JSB MESSS DEF RPAW DEF BUFF DEF IB * RPAW LDA DROF FETCH SOURCE ADDR AGAIN LDB DAB FETCH DEST ADDR MVW D6 MOVE "OF, FMGLU ,1" INTO BUF LDA D12 SET COMMAND LENGTH STA IB AT 16 LDA "RU" REPLACE "OF" STA OF WITH "RU" JMP CN.2 GO COMPLETE COMMAND * * * * ATTEMPT DUP OF REAL FMGR * * NOPAW JSB IDDUP DEF DUP1 DEF FMGR DEF PNAM DUP1 SZA ANY ERRORS ? JMP NOIDS YES, MUST BE OUT OF ID SEGMENTS * JSB GETID GO GET FMGLU'S ID ADDR JMP ENABL SHOULD NEVER GET HERE, BUT ! ADB D16 ADVANCE TO ID WD 32 (OWNER FLAG) JSB $LIBR NOP GO PRIV XLA B,I FETCH ID 32 AND NOWNR REMOVE OWNER FLAG IOR LU ADD THE CORRECT VALUE XSA B,I RESTORE THE WORD JSB $LIBX DEF *+1 DEF RPAW GO RUN THE LITTLE GUY * * NOWNR OCT 177400 * * MUST BE OUT OF ID'S * * NOIDS CLA STA CONWD CLEAR CONTROL WORD JSB XLUEX DEF DUP2 DEF D2 WRITE DEF LU NOTE: 2 WORD PARM DEF NOID MESSAGE BUF DEF D9 DUP2 JMP ENABL * * NOID ASC 9,R$PN$\ NO FREE ID * * SPC 5 * * * SUBROUTINE GETID * * RETURNS ADDRESS OF ID STATUS WORD OF LOWEST SON OF FMGXX * IN (B) REGISTER. NOTE: THIS ROUTINE WILL NOT RETURN THE * ADDRESS OF D.RTR OR SMP UNLESS THE CURRENT COMMAND IS A * "UP" COMMAND. THIS IS BECAUSE YOU SHOULD NEVER ABORT * EITHER OF THOSE PROGRAMS. * * * GETID NOP SUBROUTINE TO TRACK DOWN THE LOWEST ID Ç!þú LDA LU CONVERT THE LU INTO CLB THIS GUY'S DIV D10 FMGXX IOR "G0" FORM 'GX' PART OF FMGXX STA PNAM+1 SET IT ADB NUL0 ADJUST LOW X TO ASCII BLF,BLF ROTATE IT STB PNAM+2 SET LOW X IN HIGH PART OF WORD 3 JSB IDGET GET THE ID ADDRESS DEF *+2 DEF PNAM OF THIS FMGR SEZ GET ONE?? JMP GETID,I NO RETURN TO CALLER * ISZ GETID * NXSON STA B SET IN B AND STB IA SET IN IA ADB D15 INDEX TO THE STATUS XLA B,I GET IT TO A ALF,SLA WAITING FOR A SON?? JMP TRK YES TRACK DOWN * JMP GETID,I NO THIS IS IT * TRK ISZ IA SET TO PICK UP SON'S ID STB TMP1 SAVE ID STAT ADDR XLA IA,I GET THE SON'S ID TO (A) LDB CMND IF WE ARE PROCESSING CPB "UP" AN "UP" COMMAND JMP OKD. SKIP D.RTR & SMP CHECKS. LDB TMP1 RESTORE ID STAT ADDR * CPA D.RTR IF D.RTR OR JMP GETID,I * CPA SMP SMP THEN STOP JMP GETID,I HERE * OKD. CCE SET E TO SHOW NOT FIRST ONE LDB TMP1 RESTORE ID STAT ADDR JMP NXSON GO GET IT * * * * SPC 10 * * COMMANDS WHICH PASS PARAMETERS TO OTHER PROGRAMS (HE & WH) * COME HERE. * * * CLEAN UP INPUT BUFFER -- EATS EVERYTHING BEFORE THE FIRST "," * * NXBT NOP CLA RESET CHARACTER STA CCNT COUNT LDA IB SET CHAR CMA,INA COUNT NEGATIVE STA TMP3 * LDB BBUF FETCH BYTE ADDR OF INPUT BUFFER STB TMP1 STB TMP2 RESULT GOES INTO SAME BUFFER * NXB LBT GET CHAR CPA COMMA CHECK FOR "," JMP NXB2 ISZ TMP3 BUMP CHAR COUNT NOP SHOULD NEVER SKIP, BUT ....... JMP NXB GET NEXT ONE * NXB2 STB TMP1 UPDATE S%=þúOURCE POINTER LDB TMP2 FETCH DESTINATION POINTER SBT STORE THE BYTE ISZ CCNT BUMP FOUND CHAR COUNT STB TMP2 UPDATE DEST POINTER LDB TMP1 RESTORE SOURCE POINTER LBT FETCH NEXT POSSIBLE BYTE ISZ TMP3 BUMP CHAR COUNT JMP NXB2 GO GET NEXT CHAR * LDB CCNT FETCH COUNT OF CHARS JMP NXBT,I SPC 5 * * SL COMMAND PROCESSING * * B = PARM COUNT * SLCMD SZB,RSS IF NO PARMS JMP ALL DO ALL OF THEM CPB D1 IF MORE THAN ONE PARM JMP SL.1 DO JUST THAT ONE * INER LDA DINER FETCH ADDR OF ERROR BUFFER STA SMES LDA D6 FETCH LENGTH JMP MES GO ISSUE ERROR AND GET OUT * * * SL.1 CXA FETCH ADDRESS OF FIRST PARM LDB D6 SIX CHARS MAX JSB $PARS GO GET THE SESSION LU DEF OF * LDA FSLU FETCH PARM TYPE FLAG SLA,RSS IF NOT NUMERIC JMP INER INPUT ERROR * LDA SLU FETCH LU PARM SSA IF NEGATIVE JMP INER INPUT ERROR ! * * JSB ISSUE JMP ENABL * ALL CLA,INA SET START LU STA SLU LDA DM63 SET BOUND ON SCAN STA TMP1 NXLU JSB LUTRU SEE IF THIS ON IS DEFINED DEF NX.1 DEF SLU DEF TMP2 DUMMY DEF ISCB USE THIS SCB NX.1 EQU * SSA,RSS IF DEFINED JSB ISSUE GO ISSUE THE MESSAGE ISZ SLU BUMP LU # ISZ TMP1 SCAN COUNTER JMP NXLU GO DO THE NEXT ONE JMP ENABL ALL DONE ! * * * ISSUE NOP JSB SELUR GO FORMAT MESSAGE DEF SY.1 DEF SLU DEF BUFF PLACE MESSAGE HERE DEF ISCB SY.1 EQU * * STA IB SAVE MESSAGE LENGTH CLA STA CONWD JSB XLUEX ISSUE MESSAGE DEF SY.2 DEF D18 DEF LU DEF BUFF 'þú DEF IB DEF NOP DEF NOP DEF RQCLS DEF NOP DEF RN# SY.2 EQU * JMP ISSUE,I * * * DINER DEF INE INE ASC 6,INPUT ERROR SKP * ** UP COMMAND PROCESSING * SMAUP SZB,RSS IF ANY PARMS SUPPLIED, DO STD THING, ELSE JSB GETID GO FIND ID ADDR OF "CURRENT" PROG JMP PROCS NOT FOUND - LET SYS GIVE ERROR * XLA B,I THE PROG MUST BE IN AND D15 STATE 3 CPA D3 OR NOTHING WE CAN DO. RSS JMP PROCS LET SYSTEM RETURN ERROR * ADB DM14 BACK UP TO XTEMP1 XLA B,I AND FETCH IT. CPA D4 IF THIS GUY IS WAITING ON A DOWN DEVICE INB,RSS ADVANCE TO XTEMP2 JMP PROCS ELSE BAIL OUT. * XLA B,I FETCH EQT/LU INFO SSA IF XTMP2 < 0 THEN JMP EQT IT IS A NEG EQT ADDR * INB ELSE EQT# IS IN XTMP3 XLA B,I SO FETCH IT CONEQ CCE JSB $CVT1 GET ASCII EQT# STA BUFF+2 AND SAVE DLD "UP" GET ASCII "UP, " DST BUFF AND DROP THEM IN COMMAND BUFFER LDA D6 SET UP COMMAND LENGTH STA IB JMP PROCS GO DO IT * * * * CONVERT EQT ADDR TO EQT # FOR UP COMMAND * EQT CMA,INA SET EQT ADDR POSITIVE LDB EQTA FETCH START ADDR OF EQTS CMB,INB ADA B GET OFFSET TO OUR EQT CLB DIV D15 INA COUNTS FROM 1, NOT 0 JMP CONEQ * SKP "RU" ASC 1,RU "RS" ASC 1,RS "BR" ASC 1,BR "SL" ASC 1,SL "TE" ASC 1,TE "HE" ASC 1,HE "G0" ASC 1,G0 "GO" ASC 1,GO "SS" ASC 1,SS "OF" ASC 1,OF ****************************************** ROF ASC 2,OF, * PNAM ASC 3,FMGXX CURRENT MASTER FMGR * COM1 ASC 1,,1 * ****************************************** DROF DEF ROF BIT12 OCT 10000 D10 DEC 10 SMP NOP ADDR&EþúESS OF SMP'S ID D.RTR NOP ADDRESS OF D.RTR'S ID D5 DEC 5 B40 CLE C377 OCT 177400 COMPLEMENT OF 377B D15 DEC 15 N3 DEC -3 NUL0 ASC 1, 0 * FMGR ASC 3,FMGR CCNT NOP COMMA OCT 54 BBUF DBL BUFF IA NOP IB NOP ID NOP D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D8 DEC 8 D9 DEC 9 D12 DEC 12 D16 DEC 16 C160K OCT 17777 KEEP BITS 0-12 DM80 DEC -80 DM14 DEC -14 DM63 DEC -63 DAB DEF OF * ***********************MUST BE AT LEAST 33 WORDS LONG****** * OF BSS 2 DON'T MOVE THE NEXT 4 WORDS NAM1 NOP NAM2 NOP BUFF BSS 40 MUST FOLLOW THE OF, CODE TMP1 NOP MUST FOLLOW BUFF TMP2 NOP MUST FOLLOW BUFF TMP3 NOP MUST FOLLOW BUFF * ************************************************************* * SLU EQU OF+1 FSLU EQU OF BUF3 EQU BUFF+2 BUF4 EQU BUFF+3 BUF5 EQU BUFF+4 BUF6 EQU BUFF+5 ORG BUFF NOP INIT SUB. NEEDED ONLY ONCE JSB IDGET GET D.RTR'S ID DEF *+2 DEF D. SEZ CLA IF NONE SET TO ZERO STA D.RTR SAVE IT JSB IDGET NOW GET SMP'S DEF *+2 DEF SM SEZ IF NONE CLA USE ZERO STA SMP CCB GET THE CALL TO HERE ADB BUFF AND CLA CLEAR STA B,I IT JMP BUFF,I RETURN * SM ASC 3,SMP D. ASC 3,D.RTR * LEFT EQU BUFF+26-* ERROR IF NEGATIVE ORR OUT OF THE BUFFER D18 DEC 18 RN# NOP RCLAS NOP "FL" ASC 1,FL *************** LU NOP CONWD NOP *************** B2300 OCT 2300 DVR07 OCT 3400 NOP NOP DVTYP NOP B20K OCT 20000 RQCLS NOP CLAS$ NOP CMND NOP PCNT NOP ISCB NOP N1 DEC -1 DS21 OCT 100025 EOP EQU * SPC 2 END R$PN$ Í%B@<0 FOR GOOD RETURN JMP MESSP,I * SKP * * * DCNT NOP RBUF2 NOP FCNCT NOP JSB .ENTR DEF DCNT * DLD DCNT,I FETCH CPU USAGE SWP DIV D3600 A=HRS, B=MIN & SEC STA RBUF2,I SET HOURS ISZ RBUF2 BUMP RESULT ADDRESS STB A CLB DIV D60 NOW GET MINUTES AND SECONDS STA RBUF2,I AND RETURN THEM * ISZ RBUF2 ADVANCE TO SECONDS STB RBUF2,I SET SECONDS JMP FCNCT,I * * * D3600 DEC 3600 D60 DEC 60 SKP * * * * MOVE THE USER.GROUP NAME TO THE OUTPUT BUFFER * * * * FROM NOP TO NOP * MBT NOP JSB .ENTR DEF FROM * LDA FROM,I FETCH USER AND GROUP BYTE COUNTS CLB ASL 8 MOVE THE USER BYTE COUNT TO (B) ALF,ALF REPOSITION THE GROUP BYTE COUNT STA DCNT SAVE GROUP LENGTH IN TEMP STB RBUF2 SAVE USER LENGTH IN TEMP ADA B CALCULATE TOTAL BYTE COUNT INA ADD 1 FOR "." STA FCNCT SAVE IN TEMP * LDA FROM GET BYTE INA ADDRESS OF RAL SOURCE AND STA FROM SAVE FOR MOVE * LDB TO GET BYTE ADDRESS RBL OF DESTINATION * MBT RBUF2 MOVE USER NAME INTO BUFFER * LDA ASC. FETCH USER-GROUP SEPERATOR SBT AND SET IT INTO THE BUFFER LDA FROM FETCH BYTE ADA D10 ADDRESS OF GROUP NAME * MBT DCNT MOVE GROUP NAME IN * LDA TO,I FETCH FIRST WORD OF DESTINATION ELA,CLE,ER.zA CLEAR POSSIBLE PURGED BIT STA TO,I AND THEN RESET FIRST TWO CHARS OF NAME * LDA FCNCT FETCH TRANSFER LENGTH CMA,INA SET IT NEGATIVE JMP MBT,I * * ASC. ASC 1, . SKP * RSLT NOP VLUE NOP * CNV2 NOP JSB .ENTR DEF RSLT * LDA VLUE,I FETCH VALUE TO BE CONVERTED CCE SET FOR CONVERSION TO DECIMAL JSB $CVT3 INA ADVANCE TO LAST TWO WORDS DLD A,I FETCH THEM SWP "OR" IN ASCII IOR BZROS ZERO FOR LOW ORDER DIGITS SWP DST RSLT,I SET RESULT JMP CNV2,I GET OUT * SKP * * FRM NOP TOM NOP PERR NOP MOVE 4 WORD ERROR CODE INTO LOCATION SPECIFIED IN CALL JSB .ENTR DEF FRM * DLD FRM,I DST TOM,I ISZ FRM ISZ FRM ISZ TOM ISZ TOM DLD FRM,I DST TOM,I JMP PERR,I * BZROS OCT 30060 SKP A EQU 0 B EQU 1 END Ùlÿÿ ÿý¼ Æ ÿ92067-18265 2026 S C0122 &LSUB1 LOGON SUB #1              H0101 $VþúASMB,R,L,C,Q * NAME: LSUB1 * SOURCE: 92067-18265 * RELPC: 92067-16260 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LSUB1,8 92067-16260 REV.2026 800414 * * * EXT $LGON,$SMLK,$SMST,$SMCA,$SMID,$SMGP,$SMDL EXT .ENTR,$CVT1,$CVT3,LCLAS,VERSN,$DSCS,$SMD#,$SMER EXT CCLAS,SESID,INTER,$CL1,$CL2,EXEC ENT INIT,MKSST,CONV,LPARS,FSTAA * SUP * * A EQU 0 B EQU 1 * SKP * SPC 5 * * * * * LGON INITIALIZATION ROUTINE * * LGON NOP ID NOP DIR# NOP CAP NOP EROF NOP UID NOP GID NOP DLMT NOP SSTL NOP DSCS2 NOP * INIT NOP JSB .ENTR DEF LGON * OCT 101724 FETCH BUSY FLAG (XLA) DEF $DSCS+1 STA DSCS2,I AND RETURN IT * CCA PRESET (A) FOR POSSIBLE NOT INITIALIZED ERROR RETURN XLB $LGON FETCH GLOBAL CLASS NUMBER FOR LOGON'S SZB,RSS IF NOT DEFINED,ERROR FOR NOW ***** JMP INIT,I * LDA B * IOR B20K ADD DON'T DEALLOCATE BIT STA LGON,I TO CLASS AND RETURN IT TO CALLER STA LCLAS ALSO DEFINE THE CLASS FOR MESSP * XLA $DSCS FETCH SESSION STATUS FLAG SSA IF NOT UP AND GOING, JMP INIT,I RETURN STATUS IN (A) * * * ALL OFFSETS ARE FROM THE FIRST WORD BUILT BY THE * CALLER OF MKSCB, WHICH IS THE SESSION ID. * * CALCULATE DISTANCE FROM LENGTH WORD TO SESSION ID * LDB $SMLK FETCH -LENGTH FROM SST LENGTH WD TO LINK ADB $SMST ADD POS LENGTH (FROM LINK TO SESSION I(øþúD) CMB,INB SET RESULT POSITIVE STB OFF1 SAVE IT FOR "MKSST" * INB ARRAY ARGUMENTS COUNT FROM 1, NOT ZERO. * STB SSTL,I SAVE ELEMENT NUMBER FOR SST LENGTH WORD * * * CALCULATE THE REST OF THE OFFSETS * * LDA $SMD# OFFSET TO DIRECTORY ENTRY NUMBER ADA B STA DIR#,I * LDA $SMCA FETCH CAPABILITY OFFSET ADA B CONVERT IT TO COUNT FROM SESSION IDENTIFIER STA CAP,I RETURN IT * LDA $SMER OFFSET TO ERROR PARAMETER ADA B CONVERT IT STA EROF,I RETURN RESULT * LDA $SMID FETCH USER ID OFFSET ADA B CONVERT IT STA UID,I RETURN IT * LDA $SMGP FETCH GROUP ID OFFSET ADA B CONVERT IT STA GID,I RETURN IT * LDA $SMDL FETCH OFFSET TO DISC LIMIT ADA B CONVERT IT STA DLMT,I RETURN IT * * CLA,INA SCB WORD 1 IS IDENTIFIER STA ID,I * CLA STA VERSN ALLOW SECOND LINE TO BE ISSUED BY MESSP JMP INIT,I GET OUT * SPC 5 B20K OCT 20000 SKP * OFF1 NOP * * * * * * * MAKE AN SST ADDITION * SCBAD NOP NEWSW NOP OFFST NOP STAT NOP * MKSST NOP JSB .ENTR DEF SCBAD * LDA SCBAD FETCH SCB ADDRESS ADA OFF1 POSITION AT SST LENGTH WORD STA SSTLN SAVE THAT LOCATION ADA OFFST,I ADVANCE TO FIRST SWITCH PAST LU 1 DEFINITION STA SCBAD SAVE THAT LOCATION ALSO * LDA DM70 FETCH SIZE OF MAX SST ADA SSTLN,I CHECK CURRENT SIZE SSA,RSS IF ALREADY MAX SIZE, JMP NOROM GET OUT * LDA NEWSW,I FETCH NEW SST ENTRY AND B377 ISOLATE SESSION LU STA SYRES SAVE SESSION LU * NEXT CLA PRESET FOR OK RETURN LDB NEWSW,I FETCH NEW SST ENTRY CPB SCBAD,I COMPARE IT TO AN EXISTING ENTRY o€þú JMP MKSST,I IF COMPLETE DUPLICATE, JUST IGNORE IT * LDA SCBAD,I FETCH CURRENT SST ENTRY SZA,RSS IS THIS THE FREE AREA JMP HOLE YEP-YOU WIN * AND B377 ISOLATE SESSION LU CPA SYRES IF DUPLICATE ON SESSION SIDE JMP DUPER RETURN DUP STATUS * ISZ SCBAD BUMP SST POINTER JMP NEXT GO CHECK NEXT SWITCH * * DUPER LDA SCBAD,I RETURN SST VERSION STA STAT,I OF EXISTING DUPLICATE ENTRY CCA SET A < 0 FOR ERROR RETURN JMP MKSST,I RETURN * * HOLE STB SCBAD,I ADD NEW ENTRY ISZ SSTLN,I BUMP SST COUNT CLA,RSS A=0 FOR GOOD RETURN * NOROM CLA,INA FULL STATUS RETURN JMP MKSST,I SPC 10 B377 OCT 377 DM70 DEC -70 DBLKS DEF BLKS BLKS ASC 11, DGEN DEF GEN GEN ASC 4,GENERAL . OCT 56 / OCT 57 D10 DEC 10 D1 DEC 1 D2 DEC 2 D252 DEC 252 D11 DEC 11 D6 DEC 6 D4 DEC 4 D7 DEC 7 NULL OCT 40 * SKP * * * * CONVERT THE SYSTEM AND SESSION LU'S OF AS SST ENTRY * * * SWIT NOP SYRES NOP SERES NOP * CONV NOP TLOG EQU CONV USE ENT FOR TEMP. SSTLN EQU CONV JSB .ENTR DEF SWIT * CLB,CCE SET E FOR DECIMAL CONVERSION LDA SWIT,I FETCH SST ENTRY TO BE CONVERTED ASL 8 PUT SYSTEM LU IN B ALF,ALF REPOSITION SESSION LU INA (INTERNAL STRUCTURE IS LU-1) JSB $CVT1 GO CONVERT SESSION LU STA SERES,I STORE RESULT IN CALLER'S BUFFER LDA B FETCH SYSTEM LU INA (INTERNAL STRUCTURE IS LU-1) JSB $CVT3 INA ADVANCE TO LAST 4 DIGITS DLD A,I AND FETCH THEM DST SYRES,I THEN SET THEM IN USER'S BUFFER JMP CONV,I * * SKP * * * * * PARSE THE USER.GROUP/PASSWORD NAMES * * BUF NOP LEN NOP U/G NOP PASS NOP * LPARS NOP JSB .ENTR “þú DEF BUF * LDA BUF FETCH INPUT BUFFER ADDR RAL GET BYTE ADDRESS STA BUF SAVE FOR SCAN * LDA LEN,I FETCH BYTE COUNT STA LEN SAVE IN LOCAL TEMP SSA IF NEGATIVE, THIS IS A PASSWORD PARSE ONLY JMP PPAS SO GO PARSE THE PASSWORD * CMA,INA,SZA,RSS SET BYTE COUNT NEG AND CHECK FOR ZERO JMP LPARS,I RETURN IF NULL * STA LEN SAVE NEG BYTE COUNT * * PARSE THE USER NAME * LDB U/G FETCH ADDR OF USER/GROUP RESULT FIELD LDA DBLKS FETCH ADDR OF ASCII BLANKS MVW D11 PAD RESULT FIELD WITH BLANKS * LDA U/G FETCH U/G BUFFER ADDR INA ADVANCE PAST COUNT JSB SCAN GO PARSE IT * LDB TLOG FETCH COUNT OF BYTES IN USER NAME BLF,BLF POSITION TO HIGH BYTE STB U/G,I SAVE FOR RETURN SZB,RSS IF USER NAME NOT GIVEN JMP LPARS,I ERROR--RETURN * LDB LEN FETCH REMAINING INPUT BYTE COUNT SZB,RSS IF OUT OF INPUT, GO DEFAULT GROUP NAME JMP MGEN * CPA / FIND GROUP TERMINATOR ? JMP MGEN YES-- GO DEFAULT GROUP NAME * CPA . FIND USER TERMINATOR ? JMP GRUP YES GO SCAN FOR GROUP NAME * * * END OF LINE. DEFAULT GROUP NAME TO "GENERAL" * * * MGEN LDA DGEN FETCH ADDR OF GEN GRUP LDB U/G FETCH USER/GROUP RESULT FIELD ADB D6 ADVANCE TO GROUP LOCATION MVW D4 MOVE THE GENERAL GROUP NAME IN * LDA D7 UPLEN ADA U/G,I SET GROUP LEN AT 7 BYTES STA U/G,I * LDA LEN FETCH REMAINING INPUT COUNT SZA IF PASSWORD TO BE PARSED JMP PPAS GO DO IT * STA PASS,I SET PASSWRD LENGTH AT ZERO JMP LPARS,I GET OUT * JMP LPARS,I GET OUT * SPC 5 * * PASSWORD PARSE * PPAS LDB PASS FETCH RESULT BUFFER ·mþúLDA DBLKS FETCH ADDR OF ASCII BLANKS MVW D6 BLANK OUT RESULT BUFFER * LDA PASS FET ADDR OF RESULT FIELD INA ADVANCE PAST LENGTH JSB SCAN * LDA TLOG FETCH CHAR COUN OF PASSWORD STA PASS,I SAVE FOR RETURN JMP LPARS,I * * SPC 10 * * PARSE GROUP NAME * GRUP LDA U/G FETCH USER/GROUP RESULT BUFFER ADA D6 ADVANCE TO GROUP LOCATION JSB SCAN GO PARSE IT * CLB IF USER TERMINATOR CPA . FOUND, TERMINATE PARSE STB LEN * LDA TLOG FETCH CHAR COUNT SZA ANY THING FOUND JMP UPLEN WE HAVE A GROUP--GO UPDATE LENGTH JMP MGEN NOTHING-- GO FILL WITH "GENERAL" * * SPC 10 * * * SCAN THE INPUT BUFFER UNTIL A "." OR "/" OR END OF LINE * * * SCAN NOP RAL GET A BYTE ADDR STA SERES SAVE IT * CLA,CCE CLEAR BYTE COUNT STA TLOG NXBYT LDB BUF FETCH INPUT BUFFER BYTE ADDR (CURENT) LBT GET A BYTE STB BUF SET NEXT BYTE ADDR CPA NULL BLANK ? JMP SCAN2 GET NEXT BYTE * CPA . USER TERMINATOR ? JMP SCAN3 YEP-GET OUT * CPA / GROUP TERMINATOR ? JMP SCAN3 YEP - GET OUT * LDB TLOG FETCH CURRENT RESULT BYTE COUNT CPB D10 IS RESULT BUFFER FULL ? JMP SCAN2 YEP - GET NEXT CHARACTER * LDB SERES FETCH RESULT BYTE ADDR SBT SET THE BYTE STB SERES SAVE NEW RESULT ADDR ISZ TLOG BUMP BYTE COUNT * SCAN2 CLE FORCE ANOTHER PASS (UNLESS END OF LINE) * SCAN3 ISZ LEN BUMP INPUT CHAR COUNT SEZ,CCE IF NOT END OF LINE, TERMINATOR FOUND ? JMP SCAN,I EOL OR TERMINATOR FOUND JMP NXBYT * SKP * * BUFX NOP FSTAA NOP JSB .ENTR DEF BUFX * JSB EXp$"EC DEF STF.1 DEF D1 DEF D2 DEF BUFX,I DEF D252 LAST 4 WORDS DON'T CONCERN US DEF $CL1 DEF $CL2 STF.1 EQU * JMP FSTAA,I END ä$ÿÿ ÿý½ È ÿ92067-18266 1903 S C0122 &LSUB2              H0101 }„þúASMB,R,L,C,Q * NAME: LSUB2 * SOURCE: 92067-18266 * RELPC: 92076-16260 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LSUB2,8 92067-16260 REV.1903 790326 * * ENT INIT2,VALID,IDSCH,CLEAC,SQUZ,DADD,FCPU,DCNCT,NAMT EXT SESID,SCBAD,INTER,NAM.. EXT EXEC,IDRPD,MESSP * * EXT $LGOF,.ENTR,ISMVE,$SMCP,$SMID,$SMGP,$LIBR,$LIBX EXT MESSS,$SMII,VSCBA,.DAD,.DMP,LCLAS,$DSCS,$SMD# * * * * A EQU 0 B EQU 1 KYWRD EQU 1657B D1 DEC 1 D2 DEC 2 D5 DEC 5 B200 OCT 200 B17 OCT 17 D18 DEC 18 B20K OCT 20000 * * SPC 5 * * * * * * * * RETURNS LOG-OFF CLASS # OR 0 * * INIT2 NOP LDB INIT2,I FETCH RETURN ADDR ISZ INIT2 ADVANCE TO PARM LOC LDA INIT2,I AND FETCH ADDR OF PARM STA INIT2 OCT 101724 FETCH ACCTS BUSY FLAG (XLA **ASSEMBLER BUG) DEF $DSCS+1 STA INIT2,I AND RETURN IT * XLA $DSCS FETCH SESSION STATUS FLAG SSA IF NOT UP AND RUNNING JMP B,I RETURN STATUS IN (A) * LDA $LGOF FETCH COMMUNICATION CLASS NUMBER FOR LGOFF SZA IF NOT DEFINED, RETURN A ZERO IOR B20K ADD THE DON'T DEALLOCATE CLASS BIT STA LCLAS DEFINE THE CLASS FOR MESSP AND JMP B,I RETURN TO CALLER * * SPC 10 * * * RETURNS A= 0 IF BAD PARMS * A= 1 IF OK * SPC 5 * CPU NOP PID NOP GID NOP DENT NOP * VALID NOP JSB .ENTR FET PARM ADDRESSES DEF CPU * JSB VSCBA GO VERIF°þúY SCB ADDRESS (DEFINED IN COMMON) DEF *+2 DEF SCBAD,I RETURNS SESSION ID OR ZERO IN (A). * CPA SESID,I MUST MATCH SPECIFIED SESSION IDENTIFIER JMP VAL1 OK--GO FETCH INFO FROM SCB CLA RETURN A=0 FOR FAILURE JMP VALID,I RETURN * * VAL1 JSB ISMVE GO FETCH CPU INFORMATION FROM SCB DEF VAL2 DEF SCBAD,I READ FROM LOCATION DEFINED BY SCBAD DEF $SMCP USING THIS OFFSET DEF CPU,I PLACE THE RESULT HERE DEF D2 MOVE 2 WORDS VAL2 EQU * * JSB ISMVE DEF VAL3 DEF SCBAD,I READ DEF $SMID THE PRIVATE DISC ID FROM THE SCB DEF PID,I AND PUT IT HERE DEF D1 DO 1 WORD VAL3 EQU * * JSB ISMVE DEF VAL4 DEF SCBAD,I DEF $SMGP READ GROUP ID FROM SCB DEF GID,I AND PUT IT HERE DEF D1 DO ONE WORD VAL4 EQU * JSB ISMVE DEF VAL5 DEF SCBAD,I DEF $SMD# FETCH DIRECTORY ENTRY NUMBER DEF DENT,I FROM SCB AND PLACE IT HERE. DEF D1 VAL5 EQU * CLA,INA OK RETURN JMP VALID,I A = 1 * * SPC 10 * * * RETURNS A=0 IF END OF ID'S * A=1 AND "OF, PGNAM ,8(OR ,1)" IF ACTIVE SESSION PGRM FOUND. * * * IDNO NOP OFPRG NOP * IDSCH NOP JSB .ENTR DEF IDNO * NXID LDB IDNO,I FETCH STARTING ID # ISZ IDNO,I BUMP ID OFFSET FOR NEXT TIME * ADB KYWRD ADVANCE TO ADDRESS OF NEXT ID LDA B,I FETCH THE ID ADDRESS SZA,RSS IF END OF LIST JMP IDSCH,I RETURN A=0 * STA TEMP1 SAVE ID ADDR STA B PREPARE FOR WALK THROUGH ID SEG ADB D14 ADVANCE TO TYPE WORD LDA B,I AND FETCH IT AND B20 ISOLATE SHORT SEGMENT BIT SZA AND CHECK IT JMP DONE IF SHORT SEG, ALL DONE * ADB D18 ADVANCE TO SESSION WORD ÑþúLDA B,I AND FETCH IT CPA SCBAD,I SAME AS SESSION LOGGING OFF ? JMP ACTID YES- * JMP NXID GO TRY THE NEXT ONE * ACTID LDA OFPRG FETCH ADDRESS OF NAME BUFFER LDB TEMP1 FETCH ID ADDRESS JSB SNAM GO SET UP "OF, PROGM ,8" ((B) IS SAVED) * ADB D31 ADVANCE TO ID OWNER FLAG (LOW BYTE WD 31) LDA B,I FETCH AND B377 AND ISOLATE IT CPA SESID,I IF SESSION LOGGING OFF OWNS THE ID JMP OUT GO EXIT * LDA OFPRG THE SESSION DOESN'T OWN THIS ONE ADA D5 SO REPLACE THE "OF,PRG,8" WITH LDB C1 "OF,PRG,1" STB A,I * OUT CLA,INA,RSS ACTIVE PROGRAM FOUND, RETURN A=1 DONE CLA NO ACTIVE PROGRAMS FOUND, RETURN A=0 JMP IDSCH,I * SPC 10 TEMP0 NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP D14 DEC 14 KYPNT NOP D32 DEC 32 B20 OCT 20 N1 DEC -1 ND14 DEC -14 RE ASC 2,REMO VE ASC 2,VED WHR OCT 10001 B40 OCT 40 HBYTE OCT 177400 B377 OCT 377 D31 DEC 31 D12 DEC 12 * * * CLEAC NOP LDA CLEAC,I FETCH RETURN ADDRESS STA CLEAC AND SAVE FOR EXIT * LDB KYWRD FETCH TOP OF ID SEGMENT LIST STB TEMP0 SAVE FOR NEXT TIME LDB B,I FETCH FIRST ID * CL.2 STB KYPNT SAVE CURRENT ADDRESS SZB,RSS CHECK FOR END OF LIST JMP CLEAC,I IF DONE-- GET OUT * ADB D14 ADVANCE TO ID TYPE WORD AND LAST CHAR OF NAME LDA B,I SEE IF ANYONE IS HOME AND B200 MUST BE A TEMP LOAD SZA,RSS IF TEMP LOAD BIT NOT SET JMP NEXT DON'T BOTHER WITH THIS ID LDA B,I ISOLATE SHORT SEGMENT BIT (#4) AND B20 IF SHORT SEGMENT SZA JMP CLEAC,I WERE ALL DONE * LDA B,I ONE LAST CHECK AND B17 ISOLATE TYPE CPA D5 CHECK FOR SHORT SEG IN LONG ID JMP NEXT TRY NEXTrqþú ONE * LDB KYPNT FETCH CURRENT ID ADDRESS LDA DKBUF FETCH ADDRESS OF "OF " BUFFER JSB SNAM GO SET UP "OF, PRGRM,8" (B RETURNED UNCHANGED) * ADB D31 ADVANCE TO ID OWNER FLAG LDA B,I AND FETCH IT AND B377 NOW SEE IF IT BELONGS CPA SESID,I TO THIS SESSION INB,RSS IT BELONGS TO US -- ADVANCE TO CURRENT SESSION WORD JMP NEXT NOT OURS -- GO CHECK THE NEXT ONE * * * AT THIS POINT, NONE OF THIS SESSION'S PROGRAMS MAY BE ACTIVE (THE * ROUTINE IDSCH TOOK CARE OF THAT). THEREFORE, ID 32 MUST BE ZERO (AS * IT IS CLEARED BY THE OP-SYSTEM UPON GOING DORMAT), UNLESS ANOTHER * SESSION IS USING THE ID. IF THIS IS THE CASE, THE ID IS GIVEN TO * THE SESSION CURRENTLY USING THE ID. * * LDA B,I FETCH SESSION WORD SZA IS SOMEONE ELSE USING THIS PROGRAM ? JMP GIFT YES -- SO GIVE IT TO THEM * KILL JSB IDRPD DEF ID.1D RELEASE THE ID DEF KNAM ID.1D EQU * SZA,RSS WAS THE RELEASE OK ? JMP TRKS YES- GO GIVE UP ANY TRACKS HE MAY HAVE OWNED * * JSB MESSS GO REMOVE THE ID FROM THE SYSTEM DEF KRTN DEF KBUF KILL BUFFER DEF D12 KRTN EQU * * TELL DLD RE ISSUE DST KNAM+3 PROG REMOVED DLD VE TO SESSION DST KNAM+5 TERMINAL JSB MESSP DEF MESS1 DEF WHR DEF KNAM DEF ND14 MESS1 EQU * * NEXT ISZ TEMP0 ADVANCE KYWRD POINTER LDB TEMP0,I FETCH NEXT POSSIBLE ID ADDRESS JMP CL.2 GO TRY NEXT ONE * * TRKS JSB EXEC DEF ID.2D DEF D5 DEF N1 ID.2D EQU * JMP TELL * * SPC 5 * * * NOTE B=ID 32 ADDRESS * * GIFT JSB $LIBR GO PRIV NOP * LDA B,I MAKE SURE PROGRAM IS SZA STILL ACTIVE TO DIFFERENT SESSION JMP GIFT2 STILL ACTIVE -- MAKE A GIFT OF IT * øþúJSB $LIBX NOPE -- HE MUST HAVE JUST FINISHED DEF *+1 DEF KILL GO KILL THE ID * * GIFT2 ADB N1 BACK UP TO ID 31 STB TEMP2 SAVE FOR UPDATING * SSA CHECK FOR POSSIBLE MTM USER JMP MTM * STA TEMP1 SAVE SCB ADDRESS FOR FETCH * JSB ISMVE DEF GIFT3 DEF TEMP1 READ FROM LOCATION DEFINED HERE DEF $SMII OFFSET BACK TO SESSION IDENTIFIER DEF TEMP1 PUT IT THERE DEF D1 MOVE ONE WORD GIFT3 EQU * * LDA TEMP1 FETCH SESSION ID AND B377 ISOLATE GIFT4 STA TEMP1 AND SAVE FOR UPDATING ID SEGMENT * LDA TEMP2,I FETCH CURENT OWNER FLAG (ID 31) AND HBYTE CLEAR OWNER FLAG IOR TEMP1 THEN UPDATE WITH NEW OWNER ID STA TEMP2,I * JSB $LIBX DEF *+1 DEF NEXT * * MTM CLA ID GOES BACK TO THE SYSTEM JMP GIFT4 * * * * SPC 10 * * NOTE: (B) MUST BE RETURNED UNCHANGED * * * SNAM NOP STA TEMP2 SAVE BUFFER ADDRESS STB TEMP3 SAVE ID ADDRESS * DLD OF FETCH ASCII "OF, " DST TEMP2,I AND DUMP IT INTO USER BUFFER ISZ TEMP2 ADVANCE BUFFER POINTER ISZ TEMP2 ADVANCE BUFFER POINTER * LDA TEMP3 FETCH ID ADDRESS ADA D12 ADVANCE TO FIRST WORD OF NAME LDB A,I FETCH IT STB TEMP2,I AND DROP IT IN INA ADVANCE TO LAST TWO WORDS OF NAME ISZ TEMP2 BUMP BUFFER POINTER DLD A,I FETCH LAST TWO WORDS STA TEMP2,I SET SECOND WORD INTO BUFFER ISZ TEMP2 ADVANCE TO LAST WORD OF NAME LDA B MOVE FINAL CHARACTER TO (A) AND HBYTE SAVE THE HIGH BYTE ONLY ADA B40 ADD ASCII BLANK FOR LOW BYTE STA TEMP2,I ISZ TEMP2 BUMP TO WORD 6 OF BUFFER LDA C8 ADD ",8" TO STA TEMP2,I MESSAGE BUFFER LDB TEMP3 RESTùþúORE ID ADDRES JMP SNAM,I EXIT * DKBUF DEF KBUF OF ASC 2,OF, KBUF BSS 9 MINIMUM BUFFER SIZE C8 ASC 1,,8 C1 ASC 1,,1 * KNAM EQU KBUF+2 SKP * * * * CALL DADD( ARG1 &RESULT ADDR, ARG2 ) * RSLT NOP ARG2 NOP DADD NOP JSB .ENTR DEF RSLT * DLD RSLT,I FETCH OLD VALUE JSB .DAD GO DO DOUBLE WORD ADD DEF ARG2,I DST RSLT,I SAVE RESULT BACK JMP DADD,I RETURN * SPC 5 * * CALL DCNCT(DSEC,HRS,DYS) * * DSEC NOP HRS NOP DYS NOP DCNCT NOP JSB .ENTR DEF DSEC * CLA CLEAR HIGH BITS LDB DYS,I FETCH CONNECT DAYS OF THIS SESSION JSB .DMP DEF DYSEC NUMBER OF SECONDS IN A DAY * DST RSLT SAVE THE RESULT IN TEMPS * CLA CLEAR HIGH BITS LDB HRS,I FETCH CONNECT HOURS JSB .DMP CALULATE SECONDS DEF D3600 (NUMBER OF SECONDS IN 1 HOUR) * JSB .DAD ADD NUMBER OF DAYS (IN SECONDS) DEF RSLT * JSB .DAD ADD CONNECT SECONDS DEF DSEC,I * DST DSEC,I RETURN RESULT JMP DCNCT,I * * SPC 5 * * * CALL FCPU(DOUBLE WORD 10'S OF MS, 4 WORD BUFFER FOR RESULT) * DCPU NOP RBUF NOP FCPU NOP JSB .ENTR DEF DCPU * DLD DCPU,I FETCH CPU USAGE SWP DIV D6000 A=MIN, B=SEC & 10'S OF MS STB RSLT SAVE SEC AND MS CLB DIV D60 NOW GET # HOURS STA RBUF,I AND RETURN IT * ISZ RBUF MOVE TO MINUTES STB RBUF,I AND RETURN THEM * ISZ RBUF ADVANCE TO SECONDS CLB LDA RSLT DIV D100 GET # OF SEC AND 10'S OF MS STA RBUF,I SET SECONDS ISZ RBUF STB RBUF,I SET MS JMP FCPU,I * * D100 DEC 100 D6000 DEC 6000 D60 DEC 60 *************** DOUBLE INTEGER FORMAT D3600 NOP DEC 3600 *************** Ã*($ ******************** DYSEC OCT 1 DEC 86400 OCT 50602 ******************** * * SKP * BUF NOP CNT NOP SQUZ NOP JSB .ENTR DEF BUF * LDA CNT,I CMA,INA STA CNT * * IF NOTHING PASSED, GET OUT * SZA,RSS GOT ANYTHING ? JMP SQUZ,I NO SO GET OUT ! * LDB BUF CLE,ELB * NXT LBT CPA N JMP SQUZ,I * ISZ CNT JMP NXT JMP SQUZ,I N OCT 116 * SPC 5 * * * PROVIDES AN INTERFACE TO NAM.. FOR LGOFF * * NAMT1 NOP NAMT NOP JSB .ENTR DEF NAMT1 * JSB NAM.. DEF NAM.1 DEF NAMT1,I NAM.1 EQU * * JMP NAMT,I * END :š*ÿÿ ÿý¾ Ê ÿ92067-18267 1903 S C0122 >SCB              H0101 €þúASMB,R,L,C * NAME: GTSCB * SOURCE: 92067-18267 * RELOC: 92067-16125 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GTSCB,7 92067-16125 REV.1903 781016 ENT GTSCB EXT SESSN,$SMLN,$SMVE,.ENTR,$SMLK,$SMST IBUFA NOP IBUFL NOP IERR NOP ADSCB DEF ZERO GTSCB NOP JSB .ENTR GET PARAMETERS DEF IBUFA * CLB,CLE CHECK WHETHER OR NOT IN SESSION JSB SESSN DEF *+2 DEF XEQT SEZ,RSS ARE YOU IN SESSION? JMP INSES YES * LDA ADSCB,I ARE YOU PASSING SCB ADDR. STA ADSCB SZA IF ZERO RETURN ERROR JMP SCBLT GET SCB LENGTH LDA NEG1 RETURN IERR=-1 STA IERR,I JMP FINSH INSES LDA ADSCB,I ARE YOU IN SESS. AND PASSING DIFF. SCB ADDR? STA ADSCB SZA,RSS SKIP IF NOT USING CURRENT SCB ADDR. STB ADSCB OTHERWISE TAKE CURRENT SCB ADDR. SCBLT JSB $SMVE CALL TO GET SCB LENTGH DEF SMRTN DEF DEC1 READ DEF ADSCB SCB ADDRESS DEF $SMLN OFFSET TO LENGTH WORD DEF TMP1 PUT IT HERE DEF DEC1 BUFFER LENGTH SMRTN EQU * * LDA TMP1 ADA NEG3 STA IERR,I * LDA IERR,I DETERMINE WHICH IS LESS CMA,INA IERR OR IBUFL ADA IBUFL SSA,RSS IF SUM < 0 USE IBUFL STB TMP2 * * LDA $SMLK ADA $SMST STA TMP2 * ERR JSB $SMVE DEF RTN DEF DEC1 READ DEF ADSCB FROM HERE DEF TMP2 OFFSET FROM SESSION WORD DEF IBUFA,I PU¼*  T IT HERE DEF TMP1 RTN EQU * FINSH LDA DEF.O STA ADSCB JMP GTSCB,I * A EQU 0 B EQU 1 ZERO DEC 0 DEF.O DEF ZERO NEG3 DEC -3 TMP1 NOP TMP2 NOP XEQT EQU 1717B NEG1 DEC -1 DEC1 DEC 1 DEC3 DEC 3 NOP NOP END ˜< ÿÿ ÿý¿Æ ÿ92067-18268 2040 S C0122 &$YSLB              H0101 ”^ASMB,R,L ** RTE IVB SYSTEM LIBRARY ** * NAME: SYSLB * SOURCE: 92067-18268 * RELOC: PART OF 92067-16268 * PGMR: G.A.A.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SYSLB 92067-16268 REV.2040 800725 * * * * * * * * * * * * * * * * END Wpÿÿ ÿýÀÆ ÿ92067-18269 2013 S C0122 &RNRQ              H0101 ŒlþúASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: RNRQ * SOURCE: 92067-18269 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RNRQ,6 92067-1X269 REV.2013 780222 * 2013 EXT $ERAB,$RNTB,$IDNO,$SCD3,$DRAD EXT $ALRN,$LIBR,$PVCN,$RNSU,$RNEX ENT RNRQ * SUP A EQU 0 B EQU 1 * * * * RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER * CALLS THAT CAN ALLOCATE, DEALLOCATE * SET AND CLEAR THE RN. IF A RN REQUEST CAN NOT * BE GRANTED BECAUSE OF NONE AVAILABLE OR * CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS * SUSPENDED UNTIL THE RN BECOMES AVAILABLE * * THE EXEC CALL IS: * * EXT RNRQ * * JSB RNRQ * DEF *+4 * DEF OPTION OPTION ADDRESS * DEF RN RN NUMBER ADDRESS/RETURN * DEF STAT RN STATUS RETURN ADDRESS * * * WHERE: * OPTIN BSS 1 OPTION WORD * RN BSS 1 RN WORD * STAT BSS 1 RN STATUS * * THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE * REQUEST AS FOLLOWS: * * BIT MEANING IF SET * BIT 0 SET THE RN LOCALLY * BIT 1 SET THE RN GLOBALLY * BIT 2 CLEAR THE RN * BIT 3 ALLOCATE AN RN LOCALLY * BIT 4 ALLOCATE AN RN GLOBALLY * BIT 5 DEALLOCATE THE RN * BIT 14 DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B * BIT 15 RETURNþú EVEN IF REQUEST NOT GRANTED * * A LOCALLY ALLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR * A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER * GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY * ANY PROGRAM. * * IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING * PRESEDENCE IS FOLLOWED: * * 1) LOCAL ALLOCATE (SKIP 2 IF DONE) * 2) GLOBAL ALLOCATE * 3) DEALLOCATE * 4) LOCAL SET (SKIP 5 IF DONE) * 5) GLOBAL SET * 6) CLEAR * * THIS IMPLIES THAT RN MAY BE ALLOCATED,SET,AND CLEARED IN * THE SAME REQUEST. * A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. * THERE ARE TWO RN CODE WORDS: * A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER * REQUESTS). * B) THE RN TABLE CODE WORD. * * THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) * AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS * * THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER * IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF * THE WORD. * * GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 * AVAILABLE/UNLOCKED IS CODED AS 0. * * RN STATUS IS AS FOLLOWS: * * VALUE MEANING * 0 NORMAL DEALLOCATE RETURN * 1 RN IS CLEAR (UNLOCKED) * 2 RN IS LOCKED LOCALLY TO CALLER * 3 RN IS LOCKED GLOBALLY * 4 NO RN AVAILABLE NOW * 5 NOT DEFINED * 6 RN IS LOCKED LOCALLY TO OTHER PROGRAM * 7 RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE. * * STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED * AND THE NO WAIT BIT WAS SET * * POSSIBLE ERRORS FROM THIS CODE ARE: * * ERROR MEANING * * RN00 NO BITS SET IN THE OPTION WORD. * RN01 NO RN'S IN THE SYSTEM (EVER). * RN02 ILLEGAL RN NUMBER. * RN03 RELEASE OR U{þúNLOCK OF UNOWNED RN. * RN REQUEST PROCESSOR * SKP RNRQ NOP ENTRY JSB $LIBR PRIVILEGED NOP CLA SINCE WE DON'T PLAN TO RETURN STA $PVCN VIA $LIBR, CLEAR CNTR * CCA ADA RNRQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA RNRQ,I SET RETURN ADDR JSB $DRAD WORRY ABOUT FTN CALLS STA RQRTN IN CASE OF ABORT * ISZ RNRQ LDB RNRQ,I LDA B,I GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E IN BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES,BUMP RETRN ADDR, NO-ABORT BIT SET * ABCAL ISZ RNRQ NO LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQNO ADDR OF RN NUMBER ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQST GET ADDR OF RETURN STATUS LDB RQRTN IF RETURN ADDR CMB,INB IS LESS THAN ADB RNRQ THIS NOW, SSB,RSS THEN JMP ERN02 ABORT WITH RN02 * LDB XEQT GET THE ID SEGMENT NUMBER JSB $IDNO TO B STB IDNO SAVE FOR EVERYBODY STB TEMP6 SAVE FOR ME LDA RQOP GET THE OPTION WORD AND B77 IF NO BITS SET THEN CLB SET B FOR ERROR EXIT SZA,RSS TAKE JMP ERN00 ERROR EXIT * AND B30 MASK TO THE ALLOCATE BITS SZA,RSS IF NO ALLOCATION REQUESTED JMP DAL GO TEST FOR DEALLOCATE * AND B10 LDB B377 SZA,RSS GLOBAL ALLOCATE? (BIT 4) STB IDNO YES, SET IDNO TO 377B CCB SET TO SCAN FROM TOP JSB $ALRN ALLOC AN RN AND SET RNADR STA RQNO,I SET IN THE USER AREA SZA SKIP IF ALLOCATION FAILED ÷=þú JMP DALX ELSE GO TEST DALLOCATION * LDA D$RN GET SUSPEND FLAG JMP $RNSU CHECK IF NEED TO SUSPEND * DAL LDA RQNO,I GET THE RN USER SUPLIED WORD AND B377 ISOLATE THE RN#. XLB $RNTB TEST THE RN CMB TO SEE IF IT IS IN THE ADB A TABLE. CLE,SZA IF ZERO OR SSB,RSS BIGGER THAN LEGAL JMP ERN02 GO BOOM! * ADA D$RN INDEX INTO THE RN TABLE STA RNADR SET THE RN ADDRESS XLA A,I GET THE RN ENTRY LDB RQNO,I IS IT OWNED XOR B AND C377 BY THE SAME USER HE THINKS? CLE,SZA JMP ERN03 NO TOO BAD ABOUT THAT! * DALX LDA RQOP TEST FOR AND B40 DEALLOCATE SZA,RSS BIT SET? JMP SET NO GO DO THE SET THING * LDA RQNO,I GET THE RN AND ALF,CLE,ALF MAKE SURE HE OWNS IT AND B377 OWNER ID# TO A CPA B377 IF GLOBAL RSS OR CPA TEMP6 HE IS OWNER CLA,RSS THEN SKIP THE JMP ERN03 BAD NEWS SEND 'RN03' (WATCH E) * XSA RNADR,I CLEAR THE RN ASSIGNMENT LDA D$RN RESCHEDULE JSB $SCD3 ALLOCATION WAITERS JMP CLRN2 GO DO CLEAR SCHEDULING * SET XLA RNADR,I GET THE RN AND B377 MASK TO CURRENT LOCK LDB RQOP GET THE FLAG WORD CCE,SLB,RSS IF LOCK ERB,SLB THEN JMP LOKRN GO DO LOCK * CLRN LDB RQOP CHECK FOR CLEAR RBR,RBR FLAG. IF NOT CLE,SLB,RSS SET JUST JMP EXRN EXIT * SZA IF NEVER LOCKED, THEN OK. CPA B377 IF GLOBALLY LOCKED RSS CPA TEMP6 OR LOCKED BY CALLER RSS THEN OK, ELSE JMP ERN03 SEND 'RN03' (WATCH E) * XLB RNADR,I CLEAR THE RN. XOR B XSA RNADR,I RESTORE THE WORD * CLRN2 JSB SRNW SCHEDULE THE WAITERS EXRN CLB,gþúINB SET THE CLEAR FLAG JMP $RNEX EXIT TO DISPATCHER PROPERLY * * LOCK RN ROUTINE * LOKRN LDB B377 GET GLOBAL FLAG SEZ IF LOCAL LDB TEMP6 REPLACE WITH LOCAL SZA IF NOT LOCKED CPA TEMP6 OR LOCKED TO CALLER CMA,INA,RSS THEN OK CONTINUE JMP LKSUS ELSE SUSPEND THIS GUY. * LOKIT ADA B SET LOCK FLAG LESS CURRENT ENTRY STB TEMP1 SAVE THE B REG XLB RNADR,I SET THE LOCK FLAG ADA B XSA RNADR,I IN THE RN TABLE LDA TEMP1 SET A=ID OF NEW LOCKER JMP CLRN GO TEST FOR CLEAR OPTION * LKSUS LDA RNADR GET THE SUSPEND FLAG JMP $RNSU AND GO SUSPEND SPC 2 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (RNADR) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA RNADR GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN * * ERN02 LDB D2 RN02 ERROR RSS ERN03 LDB D3 RN03 ERROR ERN00 LDA ASRN USE RN JMP $ERAB GO BOOM!#$#$%&'" * ASRN ASC 1,RN SKP * LU UNLOCK REQUEST * * D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR D2 DEC 2 D3 DEC 3 D7 DEC 7 B377 OCT 377 C377 OCT 177400 B77 OCT 77 B10 OCT 10 B30 OCT 30 B40 OCT 40 * TEMP1 NOP TEMP6 NOP * RQRTN EQU 1677B RETURN POINT ADDRESS IDNO EQU 1704B USERS ID SEG # RNADR EQU 1705B RN ADDR IN RN TABLE XEQT EQU 1717B ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU 1730B 'POINT OF SUSPENSION' * RQOP EQU 1701B RQP2 USED FOR RN OPTION NUMBER RQNO EQU 1702B RQP3 USED FOR ADDR OF RN NUMBER RQST EQU 1703B RQP4 USED FOR ADDR OF RN STATUS ORG * PROGRAM LENGTH END ç$"$ÿÿ ÿýÁ Ì ÿ92067-18270 2013 S C0122 &LURQ              H0101 ŠgþúASMB,R,L,C,Q ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: LURQ * SOURCE: 92067-18270 * RELOC: PART OF 92067-16268 * PGMR: G.A.A.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LURQ,6 92067-1X270 REV.2013 791024 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$LUSU,$DRAD EXT $LIBR,$PVCN,$ALRN,$LUEX,$ULLU EXT LUTRU * ENT LURQ * SUP A EQU 0 B EQU 1 * * * * THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU * TO HIS PROGRAM EXCULSIVELY. ANY OTHER PROGRAM IS * PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER * A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O * ON A LOCKED LU (ASSUMING IT IS NOT LOCKED TO HIM) * * THE WAITING PROGRAM WILL BE RESTARTED WHEN THE * LU IS UNLOCKED. ALL LU'S LOCKED TO A PROGRAM WILL BE * UNLOCKED WHEN THE PROGRAM TERMINATES. LU'S MAY * ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING * CALL. * * CALL TO LOCK/UNLOCK AN LU * * EXT LURQ * * JSB LURQ * DEF *+4 * DEF IOPT ADDRESS OF OPTION FLAG WORD * DEF LUARY ADDRESS OF ARRAY OF LU'S * DEF NOLU ADDRESS OF NUMBER OF LU'S TO LOCK/UNLOCK * RETURN - - * . * . * . *LUARY DEC N1 ARRAY OF LU'S TO BE LOCKED. * DEC N2 ONLY THE LEAST 6 BITS ARE USED * . UNLESS BIT 13 OF THE OPTION WORD IS * . SET. THIS CAUSES THE LEAST 8 BITS TO BE USED. * . * . * . *IOPT DEC OPTION OPTIONS FOR THIS CALL SEE BELOW *NOLU DEC NO ¸‹þú NUMBER OF LU'S IN THE ARRAY * * OPTIONS ARE: * IOPT MEANING * 0 UNLOCK SPECIFIED LU'S * 100000B UNLOCK ALL OWNED LOCKS * 1 LOCK WITH WAIT THE SPECIFIED LU'S * 100001B LOCK WITHOUT WAIT THE SPECIFIED LU'S. * * NOTE: IF BIT 14 IS SET, NO ABORT IS IN EFFECT * NOTE: IF BIT 13 IS SET, 8 BITS ARE USED FOR THE LU DEFINITION. * NOTE: IF BIT 12 IS SET, LU SWITCHING IS NOT PERFORMED. * NOTE: IF BIT 11 IS SET, LU LOCKS ARE ALLOWED ON DISCS * IF BIT 11 IS CLEAR, LU LOCKS TO DISC CAUSE LU02 ERRORS * * TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED * IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. * IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY * HAS ONE OR MORE LU'S LOCKED HE WILL BE ABORTED 'LU01' * * ON A NO WAIT RETURN THE A REGISTER INDICATES THE * STATUS AS FOLLOWS: * * A REGISTER MEANING * -1 NO RN AVAILABLE AT THIS TIME * 0 REQUEST SUCESSFUL * 1 ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO * ANOTHER PROGRAM * * POSSIBLE ABORT ERRORS ON THIS REQUEST ARE: * ERROR MEANING * LU01 HE HAS OTHERS LOCKED AND WAIT OPTION * LU02 ILLEGAL LU * LU03 NOT ENOUGH PRAMETERS * LU04 LU NOT DEFINED FOR SESSION * RN01 SYSTEM HAS NO RN'S * RN03 HE DOESN'T OWN THE LOCK HE IS TRYING TO RELEASE * * INTERNAL FUNCTION: * * THE USER IS ASSIGNED AN RN WHICH IS LOCKED TO HIM. * THE DRT ENTRY FOR EACH LOCKED LU CONTAINS A POINTER * TO THE RN USED TO DO THE LOCK. * * ALL A PROGRAMS LU LOCKS ARE CONNECTED WITH THE SAME RN * AND THE DRT FIELD IS 5 BITS WIDE, THUS A TOTAL * OF 31 (0 IS RESERVED FOR NO LOCK) PROGRAMS * MAY HAVE LU'S LOCKED AT THE SAME TIME. * THE DRT ENTRY IS IN BITS 6-10 OF THE DRT ENTRY. * SKP LURQ NOP JSB *@þú$LIBR PRIVILEGED ENTRY NOP CLA CLEAR CNTR SINCE WE DON'T STA $PVCN PLAN TO RETURN VIA $LIBX STA RQP6 *CLEAR LU COUNTER * CCA ADA LURQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA LURQ,I SET RETURN ADDR JSB $DRAD (WORRY ABOUT FTN CALLS.) STA RQRTN IN CASE OF ABORT * ISZ LURQ LDB LURQ,I LDA B,I GET OPTION WORD RAL,CLE,ELA BIT14 TO E RAR,RAR RESTORE OPTION, LESS NO-ABORT BIT. STA RQOP SAVE CALLER'S OPTIONS. * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E INTO BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES, BUMP RTRN ADDR, NO ABORT BIT SET * ISZ LURQ NO LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQTB ADDR OF LU ARRAY STA RQP7 SAVE FOR FIRST LOOPS ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQSZ ADDR OF NUMBER OF LU'S LDA RQOP FETCH REQUEST OPTION SSA IF REQ SLA IS RELEASE RSS ALL JMP LUUL3 SKIP PARAMS CHECK (BIT 15=1,0=0) * LDB RQRTN MAKE SURE THERE ARE CMB,INB ENOUGH PARAMETERS ADB LURQ ELSE SSB,RSS REJECT JMP ELU03 WITH LU03 ERROR * LDB XEQT HERE ON LU LOCK CALL JSB $IDNO GET THE USERS ID NUMBER STB IDNO SET FOR ALLOCATE, ECT BLF,BLF PUT USER OWN/LOCK ADB IDNO FLAG IN STB TEMP6 TEMP6 LDA RQSZ,I GET THE # OF LU'S CMA,INA,SZA IF NEG OR ZERO, SSA,RSS JMP ELU03 'LU03' ERROR * STA TEMP5 SET COUNTERS STA TEMP4 FOR THE TWO LOOPS LDA LUMAX GET THE DRT SIZE CMA SET NEG OFä þú MAX LU STA TEMP3 STA TEMP9 SET FOR BOTH LOOPS LDA RQOP GET THE OPTION FLAG SLA,RSS IF THIS IS NOT LOCK REQ, JMP LUUL1 GO TO RELEASE CODE * * CHECK IF AN RN HAS ALREADY BEEN ASSIGNED * FOR THIS PROGRAMS LU LOCKS. * ISZ TEMP3 STEP LU COUNTER LDB DRT GET THE DRT ADDRESS LULK1 LDA B,I GET LU ENTRY AND B3700 MASK TO LU LOCK FLAG STA RQP8 SAVE THE LOCK FLAG ALF,ALF ROTATE TO RAL,CLE,RAL LOW AND USE TO ADA D$RN INDEX INTO THE RN TABLE XLA A,I GET RN CODE CPA TEMP6 IF OWNED AND LOCKED BY CALLER JMP LULK8 BY CALLER, JUMP * CCE,INB ELSE STEP DRT ISZ TEMP3 ADDRESS IF NOT END JMP LULK1 CONTINUE SEARCH * CLA CLEAR ALLOCATED FLAG STA RQP8 * LULK2 JSB SWITH SWITCH BATCH LU GET DRT ENTRY * * SWITH RETURNS (A)=0 AND (B)<0 IF REQUEST LU WAS ZERO. * SZA IF AVAILABLE CONTINUE CPA RQP8 OR HIS ALREADY RSS ALL OK JMP LULK5 ELSE GO SUSPEND * ISZ TEMP4 STEP THE COUNT DONE?? JMP LULK2 NO TRY NEXT LU. * LDA RQP8 GET THE ALLOCATED FLAG SZA IF AN RN ALREADY ALLOCATED JMP LULK3 GO SET UP * * MAKE SURE AT LEAST ONE NON-ZERO LU WAS SPECIFIED * LDB RQP6 FETCH VALID LU COUNTER SZB,RSS IF NONE JMP LULKS DON'T ALLOCATE AN RN (EXITS WITH OK STATUS) * * NO RN ASSIGNED SO ALLOCATE ONE * CLB,INB ASSIGN FROM LOW END OF TABLE JSB $ALRN AND B377 SET RN NUMBER IN A STA B AND B AND B37 IF RN>37B CPA B OR ZERO SZA,RSS THEN GO JMP LULK7 HANG HIM UP. * BLF,BLF MOVE NUMBER TO RBR,RBR BITS 6-10 STB RQP8 AND SET FOR LOCK LOOP LDB TEMP6 GET THEipþú LOCAL LOCK FLAG XSB RNADR,I AND SET IN RN TABLE * LULK3 LDA RQTB RESET THE ARRAY ADDRESS STA RQP7 FOR SWITH LULK4 JSB SWITH GET THE DRT ADDRESS SSB IF THIS LU WAS ZERO JMP LUL.5 SKIP DRT SETUP * LDA B,I GET DRT ENTRY IOR RQP8 SET LOCK FLAG STA B,I RESET IN THE DRT LUL.5 ISZ TEMP5 IF NOT DONE JMP LULK4 DO THE NEXT ONE * LULKS CLA SET A TO SHOW LULKF XSA XA,I SUCESSFUL COMPLETION JMP $LUEX EXIT VIA LU-RN EXIT CODE * * * LOCKED TO SOME OTHER PROGRAM * LULK5 ALF,ALF IF LOCK IS TO CALLER RAL,RAL THEN ADA D$RN THE LOCK STA RNADR IS TO BE IGNORED CLA,INA SET FAILURE FLAG LULK6 LDB RQOP IF SUSPEND OPTION SSB SUSPEND OPTION? JMP LULKF YES, EXIT LDA RNADR NO, SUSPEND PROGRAM JMP $LUSU * * * ALLOCATION FAILED - * LULK7 CLB IF BECAUSE >32B SZA,RSS THEN JMP LULK9 XSB RNADR,I RELEASE THE RN LULK9 LDB D$RN SET SUSP FLAG STB RNADR IN RNADR AND CCA SET THE COMPLETION FLAG JMP LULK6 GO EXIT * * HE HAS AT LEAST ONE LU LOCKED ALREADY * TO PREVENT DEAD LOCK HE MUST NOT CODE * WAIT ON SUBSEQUENT CALLS * LULK8 LDA RQOP GET THE OPTION FLAG ERN01 CME,SSA AND THIS CALL WITH JMP LULK2 WAIT THEN * CLB,INB,RSS SEND 'LU01' ELU02 LDB D2 LU ERROR RSS ELU03 LDB D3 LU ERROR RSS ELU04 LDB D4 LDA ASLU LU ERROR JMP $ERAB GO BOOM!#$#$%&'" * ASLU ASC 1,LU * * * LUUL1 JSB SWITH DO BATCH SWITCH GET LOCK ECT. SSB IF SPECIFIED LU WAS A ZERO JMP LUL.1 SKIP RELEASE WORK * STA TEMP3 SAVE IN CASE FOUND ALF,ALF ROTATE TO RAL,RAL LOW A AND ADA D$RN USE TO INDEX Tm þúHE RN TABLE STA RNADR SAVE THE ADDRESS XLA A,I GET THE FLAG CPA TEMP6 HIS? RSS YES SKIP ERROR EXIT JMP ELU03 NO- TOO BAD, YOU LOSE. * XLA B,I UNLOCK THE XOR TEMP3 LU XSA B,I LUL.1 ISZ TEMP4 DONE? JMP LUUL1 NO TRY NEXT ONE * LDA RNADR SCHEDULE ANY WAITING PROGRAMS JSB $SCD3 * ISZ TEMP9 TEST IF ANY LU'S LDB DRT STILL LOCKED LUUL2 LDA B,I BY CALLER AND B3700 IF SO CPA TEMP3 JUST JMP LULKS EXIT * INB STEP DRT ADDRESS ISZ TEMP9 AN COUNT / DONE? JMP LUUL2 NO TRY NEXT * CLA NO LU'S LOCKED XSA RNADR,I DEALLOCATE THE RN LDA D$RN SCHEDULE ANY ALLOCATION JSB $SCD3 WAITERS AND JMP LULKS EXIT * LUUL3 LDB XEQT RELEASE ALL JSB $ULLU LU'S LOCKED BY JMP LULKS CALLER AND RETURN * SKP * * * * SWITH RESOLVES ANY LU SWITCHING (SESSION OR BATCH) AND * CHECKS THE VALIDITY OF THE SPECIFIED LU. * * CALLING SEGUENCE: RQP7=ADDR OF LOGICAL UNIT * * JSB SWTIH * * ON RETURN : RQP7=RQP7+1 * (A)=ISOLATED LOCK FLAG * (B)=DRT ADDRESS * * OR ** IF SPECIFIED LU WAS ZERO, * * (A)=0 * (B)<0 * * POSSIBLE ERROR EXITS: IO04 = LU NOT DEFINED FOR THIS SESSION * IO02 = LU GREATER THAN MAX LU * * * * SWITH NOP DO LU SWITCH IF REQUIRED LDA RQP7,I GET THE LU LDB RQOP GET THE OPTION BLF,RBR MOVE EXT LU BIT (13) TO LSB & NO SWT TO SIGN SLB,RSS IF WE WANT TO USE 8 BITS, SKIP 6 BIT MASK AND B77 ISOLATE LU TO 6 BITS AND B377 MAKE SURE REST OF WORD IS CLEAN STA RQP9 SAVE IN TEMP ISZ RQP7wbþú STEP ADDRESS FOR NEXT TIME * SZA IF REQUEST LU IS ZERO, OR SSB IF NO-SWITCH OPTION SELECTED (BIT 12 CONWD) JMP LU.2 SKIP LU SWITCH * * CALL LUTRU TO SWITCH SESSION OR BATCH LU (MASKS TO 8 BITS). * NOTE: $PVCN MUST FIRST BE SET=1 SO THE RETURN FROM LUTRU * WILL BE PERMITTED (IF WE ARE IN THE RESIDENT LIBRARY). * $PVCN MUST THEN BE CLEARED UPON RETURN FROM LUTRU SO * LURQ MAY EXIT VIA THE OP SYS. * * ISZ $PVCN SHOW US AS A PRIV ROUTINE * JSB LUTRU GO DEF LU.1 GET THE DEF RQP9 REAL LU LU.1 CLB RESET PRIV COUNTER STB $PVCN SO LURQ MAY EXIT VIA THE SYSTEM SSA IF NOT DEFINED FOR SESSION JMP ELU04 GO ISSUE ERROR * LU.2 CCB ADJUST ADB A LU FOR INTERNAL FORMAT (LU-1) STB RQP9 FOR DRT WORK. * SZA,RSS IF SPECIFIED OR SWITCHED LU = 0 JMP SWITH,I RETURN (A)=0,(B)<0 * * A="TRUE" SYSTEM LU * ISZ RQP6 BUMP LU COUNTER ADA TEMP9 TEST FOR LEGALITY CCE,SSA,RSS SKIP IF OK JMP ELU02 ELSE BAIL OUT WITH DIAGNOSTIC * * CAN'T LOCK A DISK LU UNLESS BIT 11 OF OPTION WORD IS SET * LDB RQP9 GET THE DRT ENTRY ADB DRT ADDRESS AND SAVE STB TEMP1 IT FOR LATER LDA RQOP PICK UP THE OPTION WORD SLA,RSS IS THIS A LOCK REQUEST ? JMP LU.03 NO, UNLOCK ANY DEVICE YOU WANT * YES, ONLY LOCK DISCS IF BIT 11 IS SET ALF "DISK TOO" BIT 11 TO MSB SSA IF CLEAR MAKE SURE LU IS NOT A DISK JMP LU.03 LU LOCKS ALLOWED ON ALL DEVICES * * MAKE SURE THE DEVICE IS NOT A DISK, BIT 11 IS CLEARED * LDA B,I GET THE LU'S DRT ENTRY AND B77 ISOLATE THE EQT ENTRY NUMBER ADA N1 0 ORIGIN IT MPY D15 15 WORDS PER EQT ENT7Ý0.*RY ADA EQTA OFFSET BY BASE OF EQT ENTRIES ADA D4 THE 5TH WORD CONTAINS DEVICE TYPE LDA A,I PICK UP THE 5TH WORD AND B36K ISOLATE THE DRIVER TYPE CPA B14K IS IT DISK (DVR30, 31, 32, 33) JMP ELU02 -YES, CAN'T LET HIM LOCK DISK * LDB TEMP1 RESTORE THE DRT ENTRY ADDRESS LU.03 LDA B,I GET THE LU'S DRT ENTRY AND B3700 AND ISOLATE THE LOCK BITS JMP SWITH,I RETURN B= ADDRESS, A= ISOLATED LOCK FLAG * D$RN DEF $RNTB+0 FORCE A DIRECT ADDRESS D2 DEC 2 D3 DEC 3 D4 DEC 4 D7 DEC 7 D15 DEC 15 N1 DEC -1 B377 OCT 377 B3700 OCT 3700 B77 OCT 77 B37 OCT 37 B36K OCT 36000 DRIVER TYPE CODE MASK B14K OCT 14000 DRIVER TYPE DISKS (30,31,32,33) * TEMP1 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP9 NOP * DRT EQU 1652B EQTA EQU 1650B LUMAX EQU 1653B * RQOP EQU 1701B RQTB EQU 1702B RQSZ EQU 1703B IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS RN ADDR IN RN TABLE * RQRTN EQU 1677B RQP6 EQU 1705B RQP7 EQU 1706B RQP8 EQU 1707B RQP9 EQU 1710B XEQT EQU 1717B XSUSP EQU 1730B XA EQU 1731B ORG * PROGRAM LENGTH END .<0ÿÿ ÿý Ï ÿ92067-18271 2013 S C0122 &$ALRN              H0101 xgþúASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: $ALRN * SOURCE: 92067-18271 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALRN,6 92067-1X271 REV.2013 770715 * EXT $RNTB,$ERAB,$LIST,$XEQ ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD SUP A EQU 0 B EQU 1 * * $ALRN THIS ROUTINE ALLOCATES AN RN IF POSSIBLE * TO THE USER WHOSE ID SEGMENT ADDRESS IS * AT XEQT. * * OPTIONS/CALLING SEQUENCE: * * < IDNO MUST BE USER ID SEG # OR 377 IF GLOBAL * LDB =B1 TO ALLOCATE FROM BOTTOM OF THE RN TABLE * LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE * * JSB $ALRN * * < RETURN A=RN WORD (USER FORMAT) IF SUCESSFUL * A=0 IF NO RN'S AVAILABLE NOW * RQP6 IS SET TO RN ADDRESS IN RN TABLE * * * * $ALRN NOP STB TEMP4 SAVE THE INCREMENT XLA $RNTB GET THE LENGTH OF THE RN TABLE STA TEMP1 SAVE LENGTH OF THE RN TABLE CMA,INA SET NEGATIVE. * STA TEMP2 SET THE COUNT LDA D$RN GET THE RN TABLE ADDRESS SSB,RSS IF BOTTOM UP INA,RSS SET TO FIRST WORD ADA TEMP1 ELSE SET TO LAST WORD * ALRN1 XLB A,I SEARCH FOR SZB,RSS AN AVAILABLE JMP ALRN2 SLOT. FOUND * ADA TEMP4 STEP THE ADDRESS ISZ TEMP2 SKIP IF END JMP ALRN1 ELSE TRY NEXT ONE * CLA NO RN'SBþú AVAILABLE NOW JMP $ALRN,I SO EXIT WITH A=0 * ALRN2 STA RNADR SAVE LOCATION CMA,INA SET TO CACULATE RN NUMBER * LDB IDNO GET THE USER ID NUMBER BLF,BLF ROTATE TO HIGH HALF XSB RNADR,I SET THE ASSIGNMENT IN THE TABLE ADA D$RN COMPUTE RN NUMBER CMA,INA SET POSTIVE ADA B ADD THE USER ID FLAG JMP $ALRN,I RETURN * * $RNSU LDB RQOP GET NO-WAIT OPTION FLAG SSB IF NO WAIT JMP EXRNW THEN EXIT * $LUSU XSA XTEMP,I SET THE SUSPEND FLAG JSB $LIST AND PUT THE PROG IN LIST OCT 503 NUMBER 3. JMP $XEQ GO THE THE DISPATCHER * EXRNW LDB D5 ENTRY FOR 6/7 RETURN $RNEX LDA RNADR TEST THE RN LOCATION ADDRESS CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP LDB D4 NO RN STATUS XLA RNADR,I GET THE RN SEZ,SZA,RSS SKIP IF ALLOCATE PROBLEMS CLB ELSE SET DEALLOCATED FLAG IF RN IS ZERO AND B377 MASK TO LOCK BITS SZA IF LOCKED INB STEP B TO SO INDICATE CPA B377 IF GLOBAL INB STEP AGAIN STB RQST,I SET THE STATUS WORD $LUEX LDB XEQT SET THE RN BIT IN HIS ADB D20 ID-SEGMENT XLA B,I IOR B400 XSA B,I LDA RQRTN PUSH UP HIS XSA XSUSP,I RETURN ADDRESS JMP $XEQ ** GO TO THE DISPATCHER ** * * * $DRAD NOP ADDR IS GIVEN IN A RSS GET DIRECT ADDRESS LDA A,I IF NOT ALREADY RAL,CLE,SLA,ERA JMP *-2 JMP $DRAD,I RETURN DIRECT ADDR IN A D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR * * D5 DEC 5 D4 DEC 4 D20 DEC 20 B377 OCT 377 B400 OCT 400 TEMP1 NOP TEMP2 NOP TEMP4 NOP * RQOP EQU 1701B RQP2 IS RN/LU REQUEST CODE RQNO EQU 1702B RQP3 IS ADDR OF RN/LU NUMBER RQST EQU 1703B RQP4 IS ADDR: OF RN/LU STATUS IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS ADDR OF RN IN RN TABLE RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B * ORG * PROGRAM LENGTH END jÿÿ ÿýÃË ÿ92067-18272 2013 S C0122 &PRTN              H0101 †mþúASMB,L,C ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: PRTN * SOURCE: 92067-18272 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRTN,6 92067-1X272 REV.2013 771005 ENT PRTM ENT PRTN EXT $LIBR,$LIBX SPC 2 * THIS ROUTINE IS USED TO PASS FIVE PARAMETERS TO THE PROGRAM * THAT SCHEDULED THE CALLER WITH WAIT. IT DOES NOT HONOR THE * NO PARAMETERS BIT. * * THE SCHEDULING PROGRAM MAY RECOVER THESE PARAMETERS WITH RMPAR. * * THE WAIT FLAG IS CLEARED SO THE CALLER SHOULD HAVE HIGHER * PRIORITY THAN THE SCHEDULER TO PREVENT A SWAP. * * CALLING SEQUENCE: * * JSB PRTN * DEF *+2 STANDARD FORTRAN SEQUENCE * DEF PRAM ADDRESS OF THE FIVE RETURN PRAMATERS * JSB EXEC PROGRAM SHOULD COMPLETE * DEF *+2 * DEF SIX SPC 3 PRTN NOP ENTRY POINT JSB $LIBR GO DO PRIVLEDGE THING COUNT NOP LDA PRTN GET THE ADDRESS OF THE CALL PRAMS LDB A,I GET RETURN ADDRESS STB RTN SAVE IT INA STEP TO PRAM ADDRESS LDA A,I GET PRAM ADDRESS RAL,CLE,SLA,ERA REMOVE POSSIBLE INDIRECT JMP *-2 IF INDIRECT TRY AGAIN STA PRTN SAVE THE PRAM ADDRESS LDA KEYWD GET HEAD OF THE KEY WORD LIST STA PRTM SAVE IT LOCALLY JMP NEXT1+1 GO SCAN THE LIST SPC 1 NEXT CLB,INB ADD ONE ADB A TO IT TO GET THE WAIT ID ADDRESS STB ID3þú ALSO THE PRAM SAVE ADDRESS SAVE IT XLB B,I GET THE WORD CPB XEQT THIS THE SCHEDULING PROGRAM? JMP FOUND LOOKS GOOD GO CHECK THE STATUS NEXT1 ISZ PRTM STEP KEYWORD ADDRESS XLA PRTM,I GET NEXT ENTRY SZA IF END OF LIST EXIT JMP NEXT NOT END TRY NEXT ID SPC 1 EXIT LDA OP1 RESET THE OPTION FOR PRTN ENTRY STA OPTIN JSB $LIBX EXIT TO THE SYSTEM EXIT ROUTINE DEF RTN RETURN ADDRESS SPC 1 RTN NOP ID NOP STAT NOP SPC 2 FOUND LDB D5 CACULATE LAST PRAM ADDRESS ADB A TO B STB LAST SAVE IT FOR TESTING ADB D10 CALCULATE THE STATUS ADDRESS STB STAT SAVE IT XLB B,I GET STATUS OF SCHEDULER BLF,SLB IS HE WAITING? OPTIN CCE,RSS (OR CLE,INA,RSS FOR PRTM) JMP NEXT1 NO TRY NEXT PGM ERB,CLE,ELB CLEAR WAIT BIT(SAVE E-REG.) BLF,BLF ROTATE B THE REST BLF OF THE WAY AROUND OVER SEZ,CLE,INA,RSS ADVANCE POINTER. JMP PRSPR XSB STAT,I SAVE STATUS WITHOUT WAIT BIT IF PRTN. PRSPR LDB PRTN,I GET FIRST PRAM XSB A,I SET PRAM ISZ PRTN STEP ADDRESS CPA LAST LAST PRAMETER? CLB,INB,RSS YES B_1 AND SKIP JMP OVER NO GO DO NEXT ONE ADA D5 YES SET TO B REG ADDRESS LDB ID GET ADDRESS OF PRAM AREA XSB A,I SET BREG SAVE TO POINT TO PRAMS JMP EXIT DONE RETURN TO PGM SPC 3 OP1 CCE,RSS INARS CLE,INA,RSS PRTM ENTRY A OPTION LAST NOP D5 OCT 5 D10 DEC 10 SPC 2 PRTM NOP OPTIONAL ENTRY FOR FOUR JSB $LIBR PRAMETER PASS WITH OUT CLEARING NOP THE WAIT BIT LDA INARS GET THE OPTIONAL INSTRUCTION STA OPTIN SET IT IN THE CODE LDA PRTM GET THE RETURN ADDRESS STA PRTN SET IT IN THE MAIN ENTRY POINTiq JMP COUNT+1 GO TO MAIN LINE AND DO THE JOB SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END b\ÿÿ ÿýÄÌ ÿ92067-18273 2013 S C0122 &EQLU              H0101 ZþúASMB,R,L,C ** EQLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -EQLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: EQLU * SOURCE: 92067-18273 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EQLU,6 92067-1X273 REV.2013 770718 ENT EQLU EXT .ZPRV * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB EQLU -OR- JSB EQLU -OR- CALL EQLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP EQLU NOP ENTRY JSB .ZPRV DEF LIBX STB EQT4 SAVE B-REG FOR LATER TEST LDA EQLU,I GET ADRS OF RETURN ADDRESS ISZ EQLU BUMP TO POSSIBLE PRAM. LDB EQLU,I GET POSS. ADDRS OF PRAM. CPA EQLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STA EQLU SET RETURN POINT FOR $LIBX STB LUADR SET PASSED PRAM. ADDRESS CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 ä   MASK OF SUBCHANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER LIBX JMP EQLU,I RETURN A=BIN. VALUE, B= ASCII VALUE DEF EQLU SPC 1 EQT4 NOP LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END  ÿÿ ÿýÅÌ ÿ92067-18274 1903 S C0122 &.DRCT              H0101 m†ASMB,L HED .DRCT ROUTINE * NAME: .DRCT * SOURCE: 92067-18274 * RELOC: PART OF 92067-16268 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .DRCT,7 92067-16268 REV.1903 741120 SPC 1 ENT .DRCT * CALLING SEQUENCE * THIS ROUTINE TRACKS DOWN POSSIBLE INDIRECT ADDRESSES * * JSB .DRCT * DEF ADDR * RETURN IS TO HERE WITH A THE ADDRESS * B IS UN ALTERED E IS LOST .DRCT NOP LDA .DRCT LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ .DRCT JMP .DRCT,I A EQU 0 END è&ÿÿ ÿýÆÌ ÿ92067-18275 2013 S C0122 &REIO              H0101 }dþúASMB,L,C,Q ** REIO ** * NAME: REIO * SOURCE: 92067-18275 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM REIO,7 92067-1X275 REV.2013 790316 EXT .DFER,$LIBR,$LIBX,EXEC,.ENTR ENT REIO SUP SPC 1 * THIS ROUTINE DOES REENTRENT I/O IF THE USERS BUFFER * IS 37 OR MORE WORDS ABOVE THE PROG LOAD POINT. * THIS RESTRICTION IS ENFORCED BECAUSE THE USERS BUFFER * IS USED AS A TDB FOR THE REENTRANT PROCESSOR AND THUS * THREE WORDS(PLUS 2 FOR SAVE X AND Y REG WORDS AND 32 FOR * THE USER MAP SAVE AREA) ARE REQUIRED ABOVE IT. * * NOTE: FOR MEMORY RESIDENT PROGRAMS, THE BUFFER MUST BE 5 * OR MORE WORDS ABOVE THE PROGRAM LOAD POINT. * * * THESE THREE WORDS ARE SAVED LOCALLY AND THE TDB IS SET UP. * AFTER THE I/O HAS COMPLETED THE WORDS ARE RESTORED. * * IF THE BUFFER IS TOO CLOSE TO THE LOAD POINT THE I/O IS * PERFORMED IN THE STANDARD MANNER. THIS IS ALSO TRUE IF THE * BUFFER IS MORE THAN 129 WORDS LONG (TO CONSERVE SYSTEM MEMORY). * * CALLING SEQUENCE: * * THE SAME AS THE EXEC I/O CALL WITH OUT THE TRACK/SECTOR WORDS. * RQ BSS 4 PRAMETER ADDRESS AREA REIO NOP ENTRY POINT JSB .ENTR FETCH THE PRAMETERS DEF RQ LDA RQ+3,I PULL PRAMETERS IN LOCALLY STA RQ+3 INCASE THEY ARE LDA RQ,I ARE IN THE THREE WORD STA RQ AREA AHEAD OF LDA RQ+1,I THE BUFFER STA RQ+1 * LDA XEQT GET THE PROGRAM LOAD ADA D22 80þú POINT XLA A,I LDB RQ+2 AND THE BUFFER ADDRESS CMB,INB NOW MAKE SURE THAT THE BUFFER ADB A IS ABOVE THE LOAD POINT OF CLE,SSB,RSS PROGRAM. JMP DIRIO BUFFER BELOW PROG MUST BE IN COMMON ADB D4 BUFFER ABOVE LOAD POINT, BUT IS IT CLE,SSB,RSS WITHIN 5 WORDS ? JMP DIRIO YES, SO FORGET IT * LDA XMATA FETCH ADDRESS OF CURRENT MAT ENTRY SZA,RSS IF THIS IS A MEMORY RESIDENT JMP OK PROGRAM IT'S OK TO DO REIO. * ADB D32 DISC RESIDENT, CHECK FOR MAP SAVE AREA CLE,SSB,RSS BUFFER MUST BE 37 WORDS ABOVE LOAD POINT. JMP DIRIO TOO BAD, THE BUFFER IS TOO CLOSE * * OK LDA RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE & SET STA TDBA UP THE $LIBR & STA TDBA2 $LIBX CALLS. * JSB .DFER ELSE SAVE THE THREE WORDS DEF S1 IN LOCAL SAVE AREA DEF TDBA,I LDB RQ+3 GET THE REQUEST LENGTH SSB,RSS IF POSITIVE SKIP CONVERSION JMP RE1 * BRS CONVERT CHARACTERS TO CMB,INB WORDS AND SET POSITIVE RE1 ADB D3 ADD THREE WORDS FOR TDB LENGTH STB A AND PUT IN A FOR LENGTH TEST ADA N133 SUBTRACT 133 (129 + 3 + 1) CLE,SSA,RSS IF POSITIVE OF ZERO JMP DIRIO DO IT DIRECT * CLA,CCE SET ZERO IN WORD ONE AND DST TDBA,I LENGTH IN WORD TWO OF THE TDB JSB DOIO GO DO THE I/O S1 OCT 0,0,0 RETURN SKIPS THREE WORDS DST RQ SAVE THE REGISTERS JSB .DFER RESTORE THE THREE WORDS DEF TDBA,I DEF S1 DLD RQ RESTORE THE A AND B REGS. JMP REIO,I AND EXIT TO USER. * DOIO NOP JSB $LIBR TELL THE SYSTEM WE ARE TDBA DEF * RENT DIRIO JSB EXEC DO THE I/O CALL DEF EX RETURN ADDRESS DEF RQ DEF RQí +1 DEF RQ+2,I DEF RQ+3 EX RSS SKIP IF ERROR EXIT ISZ REIO ELSE STEP RETURN ADDRESS SEZ,RSS IF DIRECT JMP REIO,I EXIT * JSB $LIBX ELSE EXIT RENT TDBA2 DEF * SECTION D3 DEC 3 +3 WORDS * D32 DEC 32 N133 DEC -133 N3 DEC -3 N2 DEC -2 D22 DEC 22 D4 DEC 4 XMATA EQU 1646B XEQT EQU 1717B A EQU 0 ORG * END rmÿÿ ÿýÇÏ ÿ92067-18276 2013 S C0122 &IFBRK              H0101 ‚þúASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: IFBRK * SOURCE: 92067-18276 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFBRK,7 92067-1X276 REV.2013 800129 * ENT IFBRK EXT $LIBR,$LIBX SPC 2 * CALLING SEQUENCE: * * IF(IFBRK(IDMY)) 10,20 * * WHERE: 10 BRANCH WILL BE TAKEN IF SET & WILL CLEAR IT. * 20 BRANCH WILL BE TAKEN IF NOT SET * * JSB IFBRK * DEF *+1 * A-REG. = -1 IF SET, ELSE A-REG = 0 * BREAK BIT WILL ALWAYS BE CLEARED IF SET! SPC 1 IFBRK NOP ENTRY FROM FTN LDA IFBRK,I GET P+1 ADDRESS STA IFBRK SET RETURN ADDRESS LDB XEQT GET IDSEG ADDRESS OF THIS PROG ADB D20 GET ID(21) ADDRESS XLA B,I GET CONTENTS AND BIT12 MASK DOWN TO BIT 12 SZA,RSS SET? JMP IFBRK,I NO, RETURN A=0 *2013 DLS* JSB $LIBR YES, THEN TURN *2013 DLS* NOP OFF INTERRUPTS *2013 DLS* XLA B,I AND THEN CLEAR *2013 DLS* XOR BIT12 BIT 12 OF *2013 DLS* XSA B,I WORD 21. *2013 DLS* CCA RETURN A-REG. = -1 JSB $LIBX DEF IFBRK * D20 DEC 20 BIT12 OCT 10000 XEQT EQU 1717B B EQU 1 END Þ•  ÿÿ ÿýÈÏ ÿ92067-18277 2013 S C0122 &COR.A              H0101 hASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: COR.A * SOURCE: 92067-18277 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.A,6 92067-1X277 REV.2013 770621 ENT COR.A EXT .ZPRV * * ROUTINE TO FIND THE ADDRESS OF THE FIRST WORD OF AVAIL MEM. * FOR A GIVEN ID SEGMENT * * CALLING SEQUENCE: * * LDA IDSEG GET ID SEGMENT ADDRESS TO A * JSB COR.A CALL THIS ROUTINE * RETURN A= FIRST WORD OF AVAIL MEM (MEM2 FROM ID) * COR.A NOP JSB .ZPRV DEF LIBX ADA .14 INDEX TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF ROTATE THE BLF,SLB SHORT ID FLAG TO LOW B AND TEST INA,RSS SHORT SO INDEX TO MEM ADA .8 LONG SO INDEX TO MEM INA INDEX TO MEM2 XLA A,I SET IT IN A LIBX JMP COR.A,I RETURN DEF COR.A * .14 DEC 14 .8 DEC 8 A EQU 0 END æÐÿÿ ÿýÉÏ ÿ92067-18278 2013 S C0122 &COR.B              H0101 i€þúASMB,R,L,C ** COR.B ** HED COR.B ROUTINE * SOURCE: 92067-18278 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.B,6 92067-1X278 REV.2013 770816 ENT COR.B EXT .ZPRV * * * THIS ROUTINE RETURNS THE FWA OF FREE MEMORY FOR * A MAIN PROGRAM, THIS ADDRESS IS HIGH MAIN + 1 * FOR A NON-SEGMENTED PROGRAM, AND HIGH LARGEST SEGMENT * SEGMENT + 1 FOR A SEGMENTED PROGRAM * * CALLING SEQUENCE: * A REG = ID SEGMENT ADDRESS OF MAIN PROGRAM * JSB COR.B * RETURNS: * A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN, B REG IS MEANINGLESS * B REG = FWA OF FREE MEM FOR MAIN PROGRAM * * COR.B MAKES AN ERROR RETURN IF THE ID SEGMENT ADDRESS * PASSED IS THAT OF A SHORT ID SEGMENT * * COR.B NOP JSB .ZPRV DEF LIBX ADA .14 POINT TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF BLF,SLB SHORT ID SEG FLAG SET? JMP ERROR YES, THEN ERROR RETURN ADA .9 NO, POINT TO HIGH MAIN + 1 WORD XLB A,I GET CONTENTS ADA .6 POINT TO HIGH LARGEST SEG + 1 WORD XLA A,I GET CONTENTS SZA SEGMENTED PROGRAM? LDB A YES, RETURN WITH HIGH LARGEST SEG+1 ADDR CLA,RSS NORMAL RETURN * ERROR CCA ERROR RETURN LIBX JMP COR.B,I RETURN DEF COR.B * * .6 DEC 6 .9 DEC 9 .14 DEC 14 * A EQU 0 B EQU 1 END   ÿÿ ÿýÊÑ ÿ92067-18279 2013 S C0122 &KCVT              H0101 „jASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: KCVT * SOURCE: 92067-18279 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM KCVT,6 92067-1X279 REV.2013 770621 ENT KCVT * * EXT .ENTP,$CVT3,.ZPRV * NUMBR BSS 1 * KCVT NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF NUMBR LDA NUMBR,I CCE JSB $CVT3 CXA GET LEAST TWO DIGITS LIBX JMP KCVT,I RETURN DEF KCVT END 9‰ÿÿ ÿýËÑ ÿ92067-18281 2013 S C0122 &PARSE              H0101 y‘ASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: PARSE * SOURCE: 92067-18281 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PARSE,6 92067-1X281 REV.2013 770714 ENT PARSE * EXT $PARS,.ENTP,.ZPRV * CMBUF BSS 1 BFLEN BSS 1 BUFR BSS 1 * PARSE NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF CMBUF LDA BUFR STA BUFR1 LDA CMBUF LDB BFLEN,I JSB $PARS BUFR1 BSS 1 LIBX JMP PARSE,I RETURN DEF PARSE END ¹7ÿÿ ÿýÌÒ ÿ92067-18282 2013 S C0122 &$PARS              H0101 ˆbþúASMB,R,L,C HED $PARS - PARSE SUBROUTINE FOR OPERATOR MESSAGES * SOURCE: 92067-18282 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $PARS,6 92067-1X282 REV.2013 780811 ENT $PARS EXT .ZPRV * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PARS NOP JSB .ZPRV DEF LIBX CLE,ELA MAKE CHARACTER Af©þúDD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 úìþú(A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND; SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS LIBX JMP $PARS,I RETURN DEF $PARS SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP * * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TMP NOP NOP WPRIO NOP ASCI NOP ASCI1 NOP ASCI2 NOP * TEMPP NOP DM32 DEC -32 WSTAT NOP TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 COM OCT 54 SABRT NOP D10 DEC 10 D8 DEC 8 AASCI ASC 1, B377 OCT 377 LASCI OCT 40 A EQU 0 B EQU 1 END wßÿÿ ÿýÍÖ ÿ92067-18283 2013 S C0122 &TMVAL              H0101 u þúASMB,L,C ROUTINE TO CONVERT TIME HED TMVAL * NAME: TMVAL * SOURCE: 92067-18283 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TMVAL,6 92067-1X283 REV.2013 790124 ENT TMVAL EXT .ENTP,$TIME,.ZPRV * * * CALLING SEQUENCE (FORTRAN) * * CALL TMVAL(ITM,ITMAR) * * WHERE ITM IS THE TWO WORD NEGATIVE TIME IN TENS OF * MS. AND ITMAR IS A 5 WORD ARRAY TO RECIEVE THE * TIME. THE ARRAY WILL BE SET UP AS: * * 1. TENS OF MS. * 2. SECONDS * 3. MINUTES * 4. HOURS * 5. CURRENT SYSTEM DAY OF YEAR (NOT RELATED TO CALL VALUES) * ITM NOP ITM1 NOP * TMVAL NOP JSB .ZPRV GO PRIVILEGED IF IN MEM RES LIB DEF LIBX JSB .ENTP GET PRAMS DEF ITM * LDA ITM1 SET ADDRESS STA RQP2 FOR SYSTEM ROUTINE DLD ITM,I GET THE TIME JSB $TIMV CONVERT IT LIBX JMP TMVAL,I DEF TMVAL * HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTE]‘  S * ARRAY(4) = HOURS * ARRAY(5) = DAYS * * E IS SET * A IS THE YEAR * $TIMV NOP ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE OCT 101724 XLA $TIME+2 *******XLA + OFFSET IS NOT DEF $TIME+2 HANDLED CORRECTLY BY ASSEMBLER************ DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 PRS1 OCT 153000 PRS2 OCT 203 TTAB3 DEC 6000 TTAB2 DEC 100 RQP2 NOP RQP4 NOP END 7% ÿÿ ÿýÎÕ ÿ92067-18284 2013 S C0122 &CNUMD              H0101 ƒ†ASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMD * SOURCE: 92067-18284 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMD,6 92067-1X284 REV.2013 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMD * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMD SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMD NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CCE SET FOR BINARY TO DEC. CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I WHERE TO PUT IT FROM NOP LIBX JMP CNUMD,I AND RETURN DEF CNUMD END “ ÿÿ ÿýÏÕ ÿ92067-18285 2013 S C0122 &CNUMO              H0101 „‘ASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMO * SOURCE: 92067-18285 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMO,6 92067-1X285 REV.2013 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMO * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMO SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMO NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CLE SET FOR BINARY TO OCTAL CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I FROM NOP LIBX JMP CNUMO,I AND RETURN DEF CNUMO END ¾/ÿÿ ÿýÐÖ ÿ92067-18286 2013 S C0122 &INPRS              H0101 Š–þúASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: INPRS * SOURCE: 92067-18286 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM INPRS,6 92067-1X286 REV.2013 770621 SUP PRESS EXTRANEOUS LISTING ENT INPRS EXT .ENTP,$CVT3,.ZPRV SPC 1 A EQU 0 B EQU 1 HED INPRS : DESCRIPTION * CALLING EXAMPLE : * FTN,L * PROGRAM R$PN$(2,10) * INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),IC), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS) * CALL PARSE(BUFFER,IB,PARBUF) * <"ON" REQUEST - PARBUF(2)="ON" ?> * * * CALL INPRS(PARBUF,PARBUF(33)) * IC = MESSS(BUFFER,IB) * * * GO TO 1 * END SPC 2 * THE BUFFER 'PARBUF' LOOKS LIKE : SPC 2 * PARBUF(1) * PRAM(1) TYPE * (2) * VALUE(1) * (3) * (2) * (4) * (3) * (5) * PRAM(2) TYPE * (6) * VALUE(1) * (7) * (2) * (8) * (3) SPC 1 * ET CETERA SPC 1 * PARBUF(33)* NUMBER OF PARAMETERS PARSED SPC 2 * WHERE : TYPE = 0 => NULL PARAMETER * 1 => NUMERIC PARAMETER IN VQãþúALUE(1) * 2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) HED INPRS : MAIN BUF NOP #P NOP INPRS NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF BUF SPC 2 LDA #P,I SET PRAM CMA,INA,SZA,RSS COUNTER JMP EXIT NO PRAMS EXIT STA #P INIT COUNTER LDB BLANK USE LEADING BLANK SPC 2 LOOP EQU * LDA BUF GET VALUE FOR INA THIS ENTRY LDA A,I AND IF SSA NEGATIVE ADB B21 CONVERT BLANK TO 1. LDA BUF,I GET PRAM SPEC STB BUF,I STORE ", " OR " " BACK ISZ BUF STEP TO VALUE CMA,INA,SZA,RSS IF ZERO JMP NULL THEN NULL PRAM SPC 2 INA,SZA,RSS IF ONE JMP NUMBR THEN NUMERIC SPC 2 ISZ BUF MUST BE ASCII,SO LOOP2 EQU * IT'S OK ISZ BUF AS ISZ BUF IS. LDB COMMA GET ", " ISZ #P DONE ? JMP LOOP NO-GET NEXT PRAM. SPC 2 EXIT EQU * LIBX JMP INPRS,I YES-EXIT TO CALLER DEF INPRS SPC 2 NULL EQU * LDB BLANK FOR NULL STB BUF,I PRAM , REPLACE LDA B WITH STO EQU * ISZ BUF SIX DST BUF,I BLANKS JMP LOOP2 & GET NEXT PRAM. SPC 2 NUMBR EQU * NUMERIC PRAM PROC. LDA BUF,I GET NUMBER CCE,SSA VALUE IF CLE NEG,SET FOR OCTAL CONVERSION JSB $CVT3 CONVERT TO ASCII ERB SET E IF NEG. LDB A,I GET HIGH DIGIT SEZ,INA STEP & IF OCTAL ADB B104C CONVERT '1' TO 'B' STA T SAVE ADDRESS LDA A,I GET NEXT DIGIT RRL 8 ROTATE 1ST 2 DIGITS TO 'B'REG STB BUF,I STORE 1ST 2 DIGITS ISZ T STEP TO LAST 2 DIGITS ALF,ALF LDB T,I GET LAST 2 DIGITS jê RRL 8 ROTATE TO RIGHT ORDER JMP STO GO STORE IT HED INPRS : CONSTANTS B21 OCT 21 B104C OCT 10400 COMMA ASC 1,, BLANK ASC 1, T NOP HED INPRS - END END ÏÁÿÿ ÿýÑÙ ÿ92067-18287 2013 S C0122 &$CVT3              H0101 ‚WþúASMB,R,L,C HED $CVT1 AND $CVT3 ROUTINES * SOURCE: 92067-18287 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $CVT3,6 92067-1X287 REV.2013 770621 ENT $CVT3 ENT $CVT1 EXT .ZPRV HED $CVT3(BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT JSB .ZPRV DEF LIBX STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO S¶  ET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B LDX ASCI2 LOAD X WITH LEAST TWO DIGITS LIBX JMP $CVT3,I RETURN DEF $CVT3 * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 ASCI NOP ASCI1 NOP ASCI2 NOP AASCI ASC 1, TEMP6 NOP TMP NOP * * $CVT1 NOP ENTRY FOR ONE WORD JSB .ZPRV DEF CLIBX JSB $CVT3 CONVERT IT LDA ASCI2 GET THE LEAST SIG WORD CLIBX JMP $CVT1,I DEF $CVT1 END î ÿÿ ÿýÒÙ ÿ92067-18288 2013 S C0122 &.MVW              H0101 NASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92067-18288 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A * HED MOVE WORD ROUTINE TO SIMULATE 105777B MICROCODE INSTR * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .MVW,7 92067-1X288 REV.2013 751021 ENT .MVW .MVW EQU * *** MOVE NOP STA FROM MICRO CODE MOVE REPLACEMENT SUB LDA MOVE,I GET THE COUNT LDA A,I TO A ISZ MOVE STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA FROM,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ FROM FROM ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA FROM PUT NEXT LOCATION IN A FOR PURISTS JMP MOVE,I AND RETURN * * A EQU 0 B EQU 1 FROM NOP COUNT NOP END éÿÿ ÿýÓÙ ÿ92067-18289 2013 S C0122 &GETST              H0101 …™þúASMB,R,L,C HED SUBROUTINE GETST * * * NAME: GETST * SOURCE: 92067-18289 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GETST,7 92067-1X289 REV.2013 771005 ENT GETST EXT EXEC,.ENTP,.ZPRV SUP * ***************************************************************** * * SUBROUTINE GETST: * * GETST IS A FORTRAN CALLABLE SUBROUTINE WHICH MAY BE USED TO * RETRIEVE ANY PARAMETER STRING FROM A COMMAND STRING WHICH * FOLLOWS THE SECOND COMMA(THIRD IF THE SECOND PARAMETER IS * 'NO' AND 'NOW'). ONLY THE FIRST 80 CHARACTERS OF THE * COMMAND STRING ARE CHECKED. * * CALLING SEQUENCE: * * EXT GETST * JSB GETST * DEF RTN * DEF IBUFR * DEF IBUFL * DEF ILOG * RTN ... * IBUFR BSS N BUFFER TO STORE STRING IN. * IBUFL DEC N(-2N) WORD(+) OR CHARS(-) TO TRANSFER. * ILOG BSS 1 TRANSMISSION LOG. * * RETURN: * =:=POSITIVE NUMBER OR WORDS(CHARS)TRANSFERRED. * :=0 IMPLIES NO BUFFER FOUND. * ***************************************************************** * IBUFR NOP IBUFL NOP ILOG NOP * GETST NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF IBUFR * JSB EXEC GO GET ANY PARAMETER STRING. DEF *+5 DEF D14 DEF D1 DIBR DEF IBR DEF DM80 * SZB,RSS IF TRANSMISSION LOG JMP L2 IS ZERO, THEN EXIT. INB CMB,INB SET UP CHARACTZñþúER STB CNT CHARACTER COUNTER. * LDB IBUFR CONVERT DESTINATION BUFFER CLE,ELB ADDRESS TO CHARACTER STB DBADD AND SAVE. LDB DIBR CONVERT SOURCE CLE,ELB BUFFER ADDRESS ADB DM1 TO CHARACTER STB ADD ADDRESS AND SAVE. LDB DM2 SET COMMA COUNT STB TEMP TO -2. * L1 JSB GETCH GO GET A CHARACTER. CPA ASCCM IF NOT A COMMA OR THE FIRST COMMA, ISZ TEMP THEN CONTINUE SCANNING FOR JMP L1 COMMAS. * LDB ADD OTHERWIZE, SAVE STB TEMP ADDRESS. LDB CNT SAVE CHAR STB TCNT COUNT. * L31 JSB GETCH NOW SCAN FOR 'NO' OR 'NOW'. CPA ASCBK STRIP LEADING BLANKS. JMP L31 CPA ASC.N IF CHARACTER EQUALS 'N' JMP L5 THEN CHECK FOR A 'O'. * L6 LDA TEMP IF CHARACTER IS NOT 'N', THEN LDB TCNT GET SAVED ADDRESS AND CHARACTER JMP L91 COUNT AND GO MOVE BUFFER. SKP L5 JSB GETCH GET NEXT CHARACTER. CPA ASC.O CHECK IF CHARACTER RSS IS A 'O'. JMP L6 IF NOT, GO MOVE BUFFER. * JSB GETCH FOUND 'NO'. CPA ASCBK CHECK IF NEXT CHARACTER JMP L81 IS A BLANK OR CPA ASCCM A COMMA. JMP L9 * CPA ASC.W FOUND 'NO'. CHECK IF RSS NEXT CHARACTER IS A 'W'. JMP L6 IF NOT THEN MOVE BUFFER. * JSB GETCH FOUND 'NOW' SO GET NEXT CHARACTER. CPA ASCCM CHECK IF NEXT JMP L9 CHARACTER IS A CPA ASCBK BLANK OR A COMMA. RSS JMP L6 IF NOT THEN MOVE BUFFER. * L81 JSB GETCH GET NEXT CHARACTER. CPA ASCCM SKIP TO THIRD COMMA IN STRING. RSS JMP L81 * L9 LDA ADD SAVE STARTING CHAR ADDRESS LDB CNT AND CHARACTER COUNT L91 INA OF SOUUþúRCE BUFFER. INB STA SBADD LDA IBUFL,I GET REQUEST LENGTH SSA AND CONVERT TO CHARACTERS. JMP L92 RAL CMA,INA L92 STA CNT SAVE NEGATIVE CHARACTER COUNT. CMA,INA ADA B USE LESSER OF ACTUAL TRANSMISSION LOG SSA AND THE ACTUAL REQUEST LENGTH. LDB CNT STB CNT COMPUTE NUMBER OF CMB,INB CHARACTERS IN STB ILOG,I SOURCE BUFFER. SKP LL3 LDB SBADD GET CLE,ERB SOURCE LDA B,I CHARACTER. SEZ,RSS ALF,ALF AND B377 * LDB DBADD STORE CLE,ERB INTO SEZ,RSS DESTINATION JMP LL5 BUFFER. XOR B,I LL4 STA B,I ISZ SBADD INCREMENT SOURCE CHAR. ADD ISZ DBADD DESTINATION BUFFER ADD AND ISZ CNT CHARACTER COUNT. JMP LL3 * SEZ IF LAST BYTE WAS A RIGHT CHARACTER, JMP LL43 THEN JUST CONTINUE. CPA ASCB0 IF LAST BYTE WAS A LEFT BLANK, JMP LL55 THEN GO REMOVE IT. XOR ASCBK OTHERWIZE, GO PLACE A BLANK IN STA B,I LOWER BYTE. * LL43 LDB ILOG,I GET MODIFIED TRANSMISSION LOG. LDA IBUFL,I IF CHARACTERS WERE SSA SPECIFIED, THEN JMP L2 RETURN. INB IF WORDS WERE SPECIFIED, THEN BRS CHANGE TO WORDS AND RETURN. * L2 STB ILOG,I SAVE TRANSMISSION LOG LIBX JMP GETST,I AND RETURN. DEF GETST * LL5 ALF,ALF JMP LL4 * LL55 LDB ILOG,I DECREMENT ADB DM1 CHARACTER STB ILOG,I COUNT. JMP LL43 SKP * ****************************************************************** * * SUBROUTINE GETCH: * * GETCH WILL GET THE NEXT CHARACTER IN A BUFFER. * IF THE BUFFER BECOMES EMPTY, GETCH WILL * FORCE AN EXIT FROM GETST. * * CALLING SEQUENJ²CE: * :=PREVIOUS CHARACTER ADDRESS * :=PREVIOUS CHARACTER COUNT(NEGATIVE) * JSB GETCH * * RETURN: * :=CHARACTER IN LOWER BYTE. * :=CURRENT CHARACTER ADDRESS. * :=CURRENT CHARACTER COUNT. * ALL REGISTERS ARE MODIFIED EXCEPT B. * ******************************************************************** * GETCH NOP CLB SET POSSIBLE TRANSMISSION LOG TO 0. ISZ ADD INCREMENT CHARACTER ADDRESS. ISZ CNT INCREMENT CHARACTER COUNT. RSS IF COUNT GOES JMP L2 TO ZERO, LEAVE GETST. * LDA ADD GET CHARACTER ADDRESS AND CLE,ERA AND CONVERT TO WORD ADDRESS. LDA A,I E=1 MEANS LOWER BYTE. SEZ,RSS GET WORD AND ALF,ALF PLACE PROPER AND B377 CHARACTER IN JMP GETCH,I LOWER BYTE. * B377 OCT 377 SKP * * CONSTANTS * A EQU 0 B EQU 1 * CNT NOP TEMP NOP TCNT NOP ADD NOP SBADD NOP DBADD NOP * IBR BSS 40 * D1 DEC 1 D14 DEC 14 DM1 DEC -1 DM2 DEC -2 DM80 DEC -80 * ASCCM OCT 54 COMMA ASCBK OCT 40 BLANK ASC.N OCT 116 'N' ASC.O OCT 117 'O' ASC.W OCT 127 'W' ASCB0 OCT 20000 * END È ÿÿ ÿýÔÝ ÿ92067-18290 2013 S C0122 &.EMAP              H0101 jvþúASMB,R,L,C ** .EMAP ** HED .EMAP ROUTINE TO RESOLVE ELEMENT ADDRESS OF AN ARRAY * SOURCE: 92067-18290 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .EMAP,7 92067-1X290 REV.2013 771031 SUP ENT .EMAP EXT .EMAS,.EMAT * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR EMA AND NON-EMA * ARRAYS. IF THE ARRAY IS NON-EMA 16 BIT ARITHMETIC IS * PERFORMED. IF THE ARRAY IS AN EMA 32 BIT ARITHMETIC IS * PERFORMED AND THE APPROPIATE MAPPING SEGMENT CONTAINING * THE ELEMENT IS MAPPED IN THE MSEG LOG ADDRESS SPACE * * CALLING SEQUENCE: * JSB .EMAP * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF ARRAY START ADDRESS OF ARRAY * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) USED ONLY * OFFSET WORD 2 (HIGH 16 BITS) FOR EMA * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=15(ASCII), BREG=EM(ASCII) * NORMAL RETURN: AT LOC RTN+1 * AREG = MEANINGLESS * ]þú BREG = ELEMENT ADDRESS * * .EMAP NOP ROUTINE TO RESOLVE ARRAY ADDRESS LDA .EMAP,I GET RETURN ADDRESS STA RETRN SAVE IT ISZ .EMAP POINT TO ARRAY ADDRESS LDB .EMAP,I GET ARRAY ADDRESS JMP *+2 REMOVE INDIRECTS LDB B,I RBL,CLE,SLB,ERB JMP *-2 * ISZ .EMAP POINT TO THE TABLE ADDRESS LDA XIDEX DETERMINE WHETHER ARRAY ADDRESS SZA,RSS GIVEN IS THAT OF AN EMA OR NON-EMA ARRAY JMP NOEMA CALLING PROG DOES NOT HAVE EMA DECLARED INA POINT 2ND WORD OF ID SEG EXT XLA A,I GET CONTENTS OF 2ND WORD OF ID SEG EXT OF PROG CLE,ERA MOVE BITS 15-11 INTO 14-10 POSITION AND B76K GET LOGICAL START ADDR OF MSEG CMA,INA ADA B ARRAY ADDRESS SPECIFIED < START MSEG? SSA JMP NOEMA NO THEN A NON-EMA ARRAY LDA .EMAP POINTER TO TABLE ADDRESS JSB .EMAS RESOLVE ELEMENT ADDRESS FOR EMA ARRAY SSA,RSS ERROR ENCOUNTERED? JSB .EMAT MAP NECESSARY MSEG TO GET ELEM IN LOG ADDR SPACE SSA ERROR ENCOUNTERED? JMP ERROR ISZ RETRN NO, ELEMENT ADDRESS IS IN B REG JMP RETRN,I NORMAL RETURN TO RTN+1 LOCATION * * NON - EMA ARRAY - RESOLVE ELEMENT ADDRESS USING * 16 BIT ARITHMETIC * NOEMA STB ARRAY SAVE ARRAY ADDRESS LDA .EMAP,I GET TABLE ADDRESS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL ADDRESS OF PARAMETER TABLE LDA A,I # OF DIMENSIONS SSA -VE? JMP ERROR YES, ERROR SZA,RSS 0 DIMENSIONS? JMP NODIM YES CMA,INA STA NDIM -VE # OF DIMENSIONS TO USE AS COUNTER CLA STA SUM1 INITIALIZE VARIABLE TO HOLD DISPLACEMENT LOOP ISZ PTABL POINT TO -(LOWER BOUND) OF ITH DIMENSION ISZ .EMAP POINT TO SUBÀ³ SCRIPT VALUE OF ITH DIMENSION LDA .EMAP,I GET SUBSCRIPT VALUE --- A(I) LDA A,I CLO CLEAR OVERFLOW REGISTER ADA PTABL,I A(I)-L(I) SUBSCRIPT VALUE-LOWER BOUND SSA,RSS LOWER BOUND > SUBSCRIPT VALUE? SOC C OVERFLOW REG SET? JMP ERROR YES, ERROR ADA SUM1 ACCUMULATE DISPLACEMENT - IF OVERFLOW ISZ PTABL IT WILL BE DETECTED AFTER MULTIPLY LDB PTABL,I DIMENSION SIZE OF (I-1)ST DIMENSION D(I-1) SSB -VE? JMP ERROR YES, THEN ERROR MPY B (A(I) - L(I))*D(I-1) SZB,RSS OVERFLOW INTO B REG? SSA NO, OVERFLOW INTO BIT 15 OF A REG? JMP ERROR YES STA SUM1 NEW VALUE FOR DISPLACEMENT ISZ NDIM INCREMENT # DIMENSIONS COUNTER JMP LOOP ALL DIMENSIONS NOT DONE YET * NODIM LDB ARRAY ARRAY ADDRESS ADB A ADD DISPLACEMENT ISZ RETRN NORMAL RETURN AT LOC RTN+1 JMP RETRN,I * * ERROR DLD ERRCD ERROR ENCOUNTERED JMP RETRN,I RETURN AT LOC RTN * * ERRCD ASC 2,15EM ERROR CODE PTABL NOP SUM1 NOP NDIM NOP ARRAY NOP RETRN NOP * B76K OCT 76000 * XIDEX EQU 1645B A EQU 0 B EQU 1 * END * * 2»ÿÿ ÿýÕÝ ÿ92067-18291 2013 S C0122 &.EMIO              H0101 suþúASMB,R,L,C ** .EMIO ** HED .EMIO I/O BVUFFER ROUTINE FOR EXTENDED MEMORY AREAS * SOURCE: 92067-18291 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMIO,7 92067-1X291 REV.2013 771006 SUP ENT .EMIO EXT .EMAS,.EMAT,..MP,.NPGS,.IPGS,.MSG#,.MSGS,.ARRY EXT .SUM2,.EMSZ * * * ROUTINE TO RESOLVE AN ELEMENT ADDRESS FOR AN EMA ARRAY * AND TO MAP THE APPROPRIATE MAPPING SEGMENT TO CONTAIN * THE ENTIRE BUFFER STARTING AT THE ELEMENT AND HAS * LENGTH SPECIFIED IN THE CALLING SEQUENCE * A SPECIAL NON-STANDARD MAPPING SEGMENT IS MAPPED IF THE * BUFFER DOES NOT FIT INTO A STANDARD MAPPING SEGMENT * * CALLING SEQUENCE: * JSB .EMIO * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF BUFL LENGTH OF BUFFER IN # WORDS * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) * OFFSET WORD 2 (HIGH 16 BITS) * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=16(ASCII), BREG=EM(ASCII) * ESþú NORMAL RETURN: AT LOC RTN+1 * AREG = MEANINGLESS * BREG = ELEMENT ADDRESS * * .EMIO NOP LDA .EMIO RETURN ADDRESS INA POINT TO THE BUFFER LENGTH LDB .EMIO,I SAVE RETURN ADDRESS STB .EMIO LDB XIDEX EMA ROUTINE DECLARED IN CALLING PROG? SZB,RSS JMP ERROR NO, THEN ERROR LDB A,I LDB B,I BUFFER LENGTH IN B REG STB BUFL SAVE IT SSB -VE? JMP ERROR YES, ERROR INA POINT TO 'DEF TABLE' PARAMETER JSB .EMAS RESOLVE ADDRESS OF ELEMENT SSA ERROR ENCOUNTERED? JMP ERROR YES * * TEST IF SPECIAL MAPPING REQUIRED * ADB BUFL ADD BUFFER LNGTH TO DISP IN MSEG CLA RRL 6 #PAGES IN DISP + BUFL IN A REG SZB REMAINDER=0? INA NO STA TEMP SAVE THIS VALUE CMA,INA NEGATE # PAGES ADA .MSGS ADD MAPPING SEGMENT SIZE SSA MSEG SIZE > DISP + BUFL? JMP SPMAP NO THEN SPECIAL MAPPING REQUIRED LDA TEMP GET #PAGES IN DISP FROM START OF EMA UPTO MSEG ADA .IPGS ADD #PGS FROM START OF EMA UPTO ELEMENT CMA,INA NEGATE IT ADA .EMSZ EMA SZ - #PGS FROM START OF EMA TO END OF MSEG SSA EMA SIZE SMALLER? JMP ERROR YES JSB .EMAT NO, THEN MAP STANDARD MSEG SSA ERROR? JMP ERROR YES * ISZ .EMIO NORMAL RETURN TO LOC RTN + 1 JMP .EMIO,I * * SPECIAL MAPPING REQUIRED * SPMAP LDA .SUM1 DISP INTO PAGE CONTAINING ELEMENT STA TEMP SAVE IT ADA BUFL ADD #WRDS IN BUFFER SSA OVERFLOW? JMP ERROR YES, THEN ERROR CLB NO RRR 10 #PGS NEEDED TO MAP TO ACCESS ENTIRE BUFFER SZB REMAINDER=0? INA NO STA .SUM1 # PAGES TO BE MAPPED â‘ LDA .SUM2 STA .IPGS CCA SPECIAL MAPPING SEGMENT STA .MSG# JSB ..MP MAP THE SPECIAL MAPPING SEGMENT SSA ERROR RETURN? JMP ERROR YES, THEN MAKE ERROR RETURN LDB .ARRY BASE ADDRESS OF ARRAY ADB TEMP # WORDS LEFT IN DISP ISZ .EMIO NORMAL RETURN JMP .EMIO,I * * ERROR DLD ERRCD JMP .EMIO,I ERROR RETURN * * ERRCD ASC 2,16EM BUFL NOP TEMP NOP .SUM1 EQU .NPGS N1 DEC -1 B1777 OCT 1777 XIDEX EQU 1645B A EQU 0 B EQU 1 END ‚pÿÿ ÿýÖÞ ÿ92067-18292 2013 S C0122 &.EMAS              H0101 lyþúASMB,R,L,C ** .EMAS ** HED .EMAS INTERNAL ROUTINE TO RESOLVE ELEMENT ADDRESS IN EMA * SOURCE: 92067-18292 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMAS,7 92067-1X292 REV.2013 771031 SUP ENT .EMAS,.EMAT,.ARRY,.SUM2 EXT .MMAP,.MSGS,.EMSZ,.MSG#,.NPGS,.IPGS * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR AN EMA ARRAY * * CALLING SEQUENCE: JSB .EMAS * A REG = POINTER TO TABLE ADDRESS IN * THE LIST OF PARAMETERS * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF AN ERROR WAS ENCOUNTERED * B REG = TOTAL # OF WORDS DISPLACEMENT FROM * THE START OF MSEG TO THE ELEMENT * * .EMAS NOP ROUTINE TO RESOLVE ARRAY ADDRESS STA TEMP SAVE ADDRESS CLA CLEAR VARIABLES TO KEEP RUNNING SUM STA .SUM1 OF THE ELEMENT ADDRESS STA .SUM2 LDA TEMP,I ADDRESS OF THE TABLE OF PARAMETERS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL PTABL IS THE POINTER TO THE PARM TABLE LDA A,I # OF DIMENSIONS IN THE A REG SSA -VE? JMP ERROR YES, THEN ERROR ISZ PTABL INCREMENT POINTER INTO THE TABLE SZA,RSS 0? JMP NODIM YES, NO DIMENSIONS SPECIFIED CMA,INA NEGATE IT TO KEEP COUNT STA NDIM -VE # OF DIMENSIONS * LOOP ISZ TEMP GET THE NEXT SUBSCRIPT VALUE LDA TEMP,I LDA A,I CLO ×Õþú CLEAR OVERFLOW REGISTER ADA PTABL,I ADD -LI TO AI SSA,RSS IS THIS VALUE -VE? SOC C OVERFLOW REG SET? JMP ERROR YES,SUBSCRIPT VALUE < LOWER BOUND ERROR ADA .SUM1 ADD LOWER 14 BITS OF SUM ELEMENT ADDRESS SSA IS BIT 15 SET? ISZ .SUM2 YES,ADD 1 TO THE MOST SIGNIFICANT BITS OF SUM ELA,CLE,ERA CLEAR SIGN BIT IN THE A REGISTER ISZ PTABL POINT TO UPPER BOUNDS OF (I-1)TH DIMENSION LDB PTABL,I DIMENSION SIZE D(I-1) IN B REG STB DIMLN SSB -VE? JMP ERROR YES MPY B MULTIPLY .SUM1 BY DIMENSION SIZE RAL,CLE,ERA CLEAR BIT 15 IN A REG AND SAVE IN E REG ELB SHIFT BIT 15 OF AREG INTO BIT 0 POSITION OF BREG STA .SUM1 NEW VALUE OF BITS 0-14 OF ELEMENT ADDRESS STB .SUM3 LDA .SUM2 BITS 15-31 OF ELEMENT ADDRESS MPY DIMLN NO, THEN MULTIPLY BY DIMENSION SIZE .EMA3 ADA .SUM3 ADD BITS 15-31 FROM PREVIOUS MULTIPLICATION STA .SUM2 .SUM2 HAS BITS 15-31 OF ELEMENT ADDRESS SO FAR SZB,RSS OVERFLOW INTO B REG? SSA SIGN BIT SET ? JMP ERROR YES, ERROR ISZ PTABL POINT TO NEXT SET OF ARRAY PARAMETERS ISZ NDIM ALL DIMENSIONS DONE? JMP LOOP NO, THEN EVALUATE NEXT DIMENSION * NODIM XLA XIDEX,I GET FIRST WORD OF ID SEG EXT CAY SAVE IT IN Y REG AND B37 MASK MSEG SIZE STA .MSGS SAVE IT LDA XIDEX INA GET 2ND WORD OF ID SEG EXT XLA A,I CLE,ERA AND B76K GET LOGICAL START EMA ADDRESS STA .ARRY SAVE IT * DLD PTABL,I GET TWO OFFSET WORDS RAL,CLE,ERA IF BIT 15 OF AREG SET, CLEAR IT AND SAVE ELB SHIFT IT IN BIT 0 POSITION OF HIGH ORDER BITS SEZ,SSB,RSS OFFSET HAS SIGN BIT SET OR TOO LARGE? RSS JMP ERROR YES, THEN ERROR ADA .SUM1 ¢BþúOFFSET WORD 1 RAL,CLE,SLA,ERA CLEAR SIGN BIT IF SET INB INCREMENT HIGH ORDER BITS TO ACCOUNT ADB .SUM2 FOR SIGN BIT OF LOW ORDER BITS SSB OVERFLOW? JMP ERROR YES RAL MOVE BITS 0-14 IN 1-15 POSITION ASL 5 B REG HAS TOTAL # OF PAGES IN DISPLACEMENT SOC C WERE SOME SIGNIFICANT BITS LOST? JMP ERROR YES STB .SUM2 FROM BEGINNING OF EMA UPTO PAGE CONTAINING ELEMENT ALF,ALF MOVE REMAINING WORDS INTO LOW BITS RAL,RAL STA .SUM1 SAVE # OF WORDS OFFSET IN THE LAST PAGE CMB - (#PAGES DISP + 1) LDA XEQT ADA .28 WORD 29 OF ID SEGMENT XLA A,I AND B1777 MASK EMA SIZE STA .EMSZ ADB A TOTAL #PGS DISP+1(IF OFFSET INTO LAST PAGE) SSB > EMA SIZE? JMP ERROR YES, THEN ERROR LDA .SUM2 # OF PAGES DISP FROM START OF EMA CLB DIV .MSGS DIVIDE DISP BY MSEG SIZE STA .MSG# QUOTIENT IS THE MSEG # TO MAP LDA B SAVE B REG CMA,INA # PAGES DISP - # PAGES OFFSET INTO MSEG ADA .SUM2 STA .IPGS BLF,BLF CONVERT REMAINDER # PAGES INTO WORDS RBL,RBL ADB .SUM1 TOTAL # OF WORDS DISP INTO MSEG STB TEMP SAVE THIS VALUE CLA JMP .EMAS,I RETURN * * MAP THE STANDARD MAPPING SEGMENT * .EMAT NOP CYA GET THE FIRST WORD OF THE ID SEG EXT SSA BIT 15 SET? JMP MSGMP YES, THEN MSEG NEEDS TO BE MAPPED CLB LSR 5 GET MSEG# CURRENTLY MAPPED CPA .MSG# IS IT THE SAME AS THE ONE WE WANT JMP RETRN YES,NO NEED TO MAP MSEG RETURN * * MAPPING SEGMENT TO BE MAPPED * MSGMP LDA .EMSZ SIZE OF EMA CLB DIV .MSGS DIVIDE BY MSEG SIZE TO GET THE SZB,RSS HIGHEST MSEG # - REMAINDER = 0? ADA N1 î YES, THEN SUBTRACT 1 FROM QOUTIENT CPA .MSG# IS THE HIGHEST MSEG# = MSEG# WE WANT? JMP MSGM1 YES LDB .MSGS NO, ADJUST# PAGES TO BE MAPPED INB FOR OVERFLOW JMP MSGM2 MSGM1 SZB,RSS REMAINDER=0? LDB .MSGS YES,#PAGES TO BE MAPPED IS MSEG SIZE MSGM2 STB .SUM1 # OF PAGES TO BE MAPPED JSB .MMAP MAP THE MAPPING SEGMENT * RETRN LDB .ARRY LOGICAL START ADDRESS OF MSEG ADB TEMP # OF WORDS DISP INTO MSEG CLA JMP .EMAT,I RETURN * ERROR CCA ERROR RETURN JMP .EMAS,I * .SUM1 EQU .NPGS LOWER SIGNIFICANT BITS 0-14 OF DISPLACEMENT .SUM2 NOP UPPER SIGNIFICANT BITS 15-31 OF DISPLACEMENT .SUM3 NOP PTABL NOP POINTER INTO TABLE NDIM NOP DIMLN NOP TEMP NOP .ARRY EQU NDIM XIDEX EQU 1645B XEQT EQU 1717B .28 DEC 28 N1 DEC -1 B37 OCT 37 B76K OCT 76000 B1777 OCT 1777 A EQU 0 B EQU 1 END ™yÿÿ ÿý×à ÿ92067-18293 2013 S C0122 &MMAP              H0101 „YþúASMB,R,L,C ** MMAP ** HED MMAP ROUTINE TO MAP EMA PAGES IN MSEG * SOURCE: 92067-18293 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM MMAP,7 92067-1X293 REV.2013 771020 SUP ENT MMAP,..MP,.MMAP,.EMSZ,.MSG#,.MSGS,.NPGS,.IPGS EXT $DVPT,$LIBR,$LIBX * * * ROUTINE TO MAP THE REQUESTED SEQUENCE OF PHYSICAL * PAGES IN THE MAPPING SEGMENT ADDRESS SPACE * IF THE # OF PAGES SPECIFIED TO BE MAPPED IS LESS * THAN THE STANDARD MAPPING SEGMENT SIZE, MMAP WILL MAP * UPTO THE STANDARD MSEG SIZE PAGES IF THEY FIT * * CALLING SEQUENCE: JSB MMAP * DEF RTN RETURN ADDRESS * DEF IPGS # OF PAGES DISP FROM START OF EMA * UPTO THE FIRST PAGE TO MAP * DEF NPGS # OF PAGES TO BE MAPPED * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN * * * MMAP HAS TWO OTHER ENTRY POINTS .MAP. AND .MMAP * .MAP. IS ENTERED BY .EMIO WHILE DOING SPECIAL MAPPING * CALLING SEQUENCE FOR .MAP. IS: JSB .MAP. * * .MMAP IS ENTERED BY .EMAS WHILE MAPPING A STANDARD MSEG * CALLING SEQUENCE FOR .MMAP IS: JSB .MMAP * * * MMAP NOP LDA MMAP,I GET THE RETURN ADDRESS STA RETRN AND SAVE IT ISZ MMAP GET THE NEXT PARAMETER LDA MMAP,I LDA A,I A REG HAS # OF PAGES DISPLACEMENT FROM START STA .IPGS OF EMA TO START OF SEGMENT TO BE MAPPED SSA -VE? JMP ERROR YES, THEN ERROR ISZ MMAP LDB MMAP,I Z­þú GET THE NEXT PARM LDB B,I # OF PAGES TO BE MAPPED SSB -VE? JMP ERROR YES, THEN ERROR STB .NPGS LDA XIDEX ADDRESS OF ID SEG EXT SZA,RSS IS IT 0? JMP ERROR YES THEN NOT AN EMA PROG LDA XEQT GET ID SEG ADDRESS ADA .28 XLA A,I GET WORD 28 OF THE ID SEGMENT AND B1777 MASK OUT THE EMA SIZE STA .EMSZ SAVE IT XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK STANDARD MSEG SIZE STA .MSGS SAVE IT * LDA .IPGS FIND MSEG # IF STANDARD MSEG CLB DIV .MSGS RELATIVE START PAGE OF MSEG/.MSGS SZB REMAINDER=0? CCA NO, NON-STANDARD MSEG STA .MSG# SAVE MAPPING SEGMENT # JMP .MAP1 SKIP OVER FOLLOWING ENTRY POINT * ..MP NOP ENTRY POINT FOR .EMIO TO ENTER LDA ..MP GET RETURN ADDRESS STA RETRN SET UP MAIN RETURN ADDRESS .MAP1 LDA .NPGS # OF PAGES TO BE MAPPED ADA .IPGS # OF PAGES DISP FROM START OF EMA CMA,INA ADA .EMSZ EMA SIZE-(#PGS DISP+#PGS TO BE MAPPED) SSA EMA SIZE < NPGS+.IPGS? JMP ERROR YES, THEN ERROR LDB .NPGS # OF PAGES TO BE MAPPED CMB,INB ADB .MSGS MSGSZ - NPGS SSB .NPGS> MSGSZ? JMP ERROR YES, ERROR ISZ .MSGS INCREMENT MSEG SIZE TO ACCOUNT LDB .MSGS FOR OVERFLOW PAGE LDA .EMSZ EMA SIZE CMA,INA ADA .IPGS #PGS DISP FROM START EMA - EMA SIZE ADB A + MSEG SIZE + 1 CMA,INA EMA SIZE - # PGS DISP SSB .IPGS+.MSGS+1<=EMA SIZE? LDA .MSGS YES, #PAGES TO MAP IS MSEG SIZE + 1 STA .NPGS SET # OF PAGES TO BE MAPPED SZA,RSS 0? JMP ERROR YES, THEN IPGS = EMASZ JMP NOADJ SKIP OVER FOLLOWING ENTRY POINT * * CHANGE USER MAP ON BASE PAGE cþú* .MMAP NOP LDA .MMAP SET UP MAIN RETURN ADDRESS STA RETRN ISZ .MSGS ACCOUNT FOR OVERFLOW PAGE NOADJ JSB $LIBR TURN OFF INTERRUPTS AND NOP MEMORY PROTECT FENCE LDA XIDEX INA XLA A,I GET 2ND WORD OF ID SEG EXT CAY SAVE IT AND B1777 MASK PHYSICAL START PAGE OF EMA ADA .IPGS A REG = PHYSICAL START PAGE OF MAPPING SEG STA .IPGS SAVE IT LDA B40 READ THE USER BASE PAGE # FROM DMS REG 40B CCB CBX -1 IN XREG TO READ 1 REG LDB AEMSZ ADDRESS OF LOC CONTAINING MEM ADDRESS XMM READ DMS REG CLB,INB X REG = 1 TO CHANGE CONTENTS OF 1 DMS REG CBX B TO X XLA $DVPT DMS REG# POINTING TO START OF DRIVER PARTN STA MLOC ADA B40 LDB AEMSZ POINT THIS REG TO USER BASE PAGE XMM LDB MLOC START PAGE OF DRIVER PARTN BLF,BLF MULTIPLY BY 2000B RBL,RBL ADB B1740 LOC ON USER BASE PAGE AT WHICH MSEG STARTS CYA SECOND WORD ID SEG EXT FROM Y TO A ALF,RAL MOVE BITS 11-15 TO POSITION 10-14 AND B37 MASK OUT START LOGICAL PAGE OF MSEG STA MSTRT SAVE IT ADB A BREG HAS MEM LOC ON BASE PAGE STB MLOC AT WHICH USER MAP MUST BE CHANGED LDA .NPGS # OF PAGES CMA,INA COUNTER STA .EMSZ LDA .IPGS START PHYSICAL PAGE OF MSEG LOOP STA B,I STORE IT ON USER BASE PAGE INA INCREMENT PAGE # INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP STORE NEXT PAGE# * USER MAP ON BASE PAGE IS CHANGED TO SHOW THE NEW MSEG * REST OF THE LOCATIONS MUST BE MADE READ&WRITE PROTECTED * LDA .MSGS FIND # OF LOCATIONS LEFT TO BE CMA,INA READ AND WRITE PROTECTED ADA .NPGS #PAGES - (MSEG SIZE+1) SZA,RSS êÉ EQUAL? JMP STDMS YES THEN SET DMS REGISTERS STA .EMSZ #PGS TO READ-WRITE PROTECT LDA B140K LOOP1 STA B,I STORE 140000B IN LOC ON USER BASE PAGE INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP1 * STDMS LDA B40 40 OCTAL ADA MSTRT FIRST MAP REGISTER TO BE CHANGED IN A REG LDB .MSGS #DMS REG TO CHANGE IS MSEG SIZE + 1 CBX TO BE LOADED FROM LDB MLOC USER BASE PAGE XMM TRANSFER MEM INTO DMS REG * XLA XIDEX,I GET FIRST WORD OF ID SEG EXT LDB .MSG# SSB,RSS -1? JMP MMAP1 NO IOR BIT15 YES, THEN SET BIT 15 JMP MMAP2 * MMAP1 AND B37 MASK OUT BITS 0-4 BLF,RBL MOVE MSEG # TO BITS 5-14 ADA B MMAP2 XSA XIDEX,I STORE BACK WORD 0 OF THE ID SEG EXT CLA RETURN WITH A REG=0 JSB $LIBX TURN ON MEMORY PROTECT & INTERRUPTS DEF RETRN * ERROR CCA ERROR RETURN WITH A REG=-1 JMP RETRN,I * * RETRN NOP .IPGS NOP .NPGS NOP .MSGS NOP .MSG# NOP .EMSZ NOP AEMSZ DEF .EMSZ MSTRT NOP MLOC NOP B37 OCT 37 B40 OCT 40 B1777 OCT 1777 B1740 OCT 1740 B140K OCT 140000 BIT15 OCT 100000 .28 DEC 28 N1 DEC -1 A EQU 0 B EQU 1 XIDEX EQU 1645B XEQT EQU 1717B END yÿÿ ÿýØá ÿ92067-18294 2013 S C0122 &EMAST              H0101 ˆ…þúASMB,R,L,C ** EMAST ** HED EMAST ROUTINE RETURNS INFORMATION OF AN EMA * SOURCE: 92067-18294 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM EMAST,7 92067-1X294 REV.2013 770913 ENT EMAST * * * ROUTINE TO GIVE INFORMATION FOR AN EMA PROGRAM * CALLING SEQUENCE: JSB EMAST * DEF *+4 RETURN ADDRESS * DEF NEMA SIZE OF EMA * DEF NMSEG SIZE OF MSEG * DEF IMSEG START LOGICAL PAGE MSEG * RETURNS: * A REG = 0 IF NORMAL RETURN * =-1 IF ERROR RETURN * ERROR RETURN IS MADE IF CALLING PROGRAM DOES NOT * HAVE AN EMA DEFINED * * * EMAST NOP LDA EMAST,I STA RETRN SAVE RETURN ADDRESS LDA XIDEX EMA PROGRAM? SZA,RSS JMP ERROR NO THEN ERROR * LDA XEQT YES ADA .28 GET WORD 28 OF THE ID SEG XLA A,I AND B1777 MASK OUT EMA SIZE JSB PRMST STORE EMA SIZEL IN RETURN PARAMETER XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK MSEG SIZE JSB PRMST STORE IT IN RETURN PARAMETERS LDA XIDEX ID SEG EXT ADDRESS INA XLA A,I GET SECOND WORD OF ID SEG EXT ALF,RAL MOVE START LG PAGE OF MSEG TO LOW BITS AND B37 MASK IT JSB PRMST STORE IT IFN RETURN PARAMETER CLA,RSS NORMAL RETURN ERROR CCA ERROR RETURN A REG=-1 JMP RETRN,I RETURN * PRMST NOP ROUTINc¾  E TO STORE VALUES INTO PARAMETERS ISZ EMAST LDB EMAST,I STA B,I JMP PRMST,I RETURN * RETRN NOP .28 DEC 28 B1777 OCT 1777 B37 OCT 37 A EQU 0 B EQU 1 XEQT EQU 1717B XIDEX EQU 1645B END úA ÿÿ ÿýÙà ÿ92067-18295 2013 S C0122 &IFTTY              H0101 ƒ¡þúASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED -IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92067-18295 * RELOC: PART OF 92067-16268 * PGMR: C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFTTY,7 92067-1X295 REV.2013 790118 ENT IFTTY,.TTY,XFTTY EXT XLUEX * * ROUTINE TO DETERMINE IF THE SPECIFIED LU IS INTERACTIVE * CALLED AS FOLLOWS: * * IFLAG = IFTTY(LU) JSB IFTTY * DEF *+2 * DEF LU * * * IFLAG = A REG = -1 IF THE LU IS INTERACTIVE * = 0 IF THE LU IS NON-INTERACTIVE * B REG = UPPER BYTE = DEVICE TYPE * LOWER BYTE = SUBCHANNEL NUMBER * * * .TTY EQU * IFTTY NOP ENTRY DLD IFTTY,I GET RETURN ADDRESS & LU# STA XFTTY SAVE RETURN ADDRESS LDA B,I GET THE LU # AND B77 ISOLATE IT DOWN TO 6 BITS JMP INT? * * XFTTY NOP DLD XFTTY,I STA XFTTY LDA B,I INT? STA ANLU# SZA,RSS IF LU 0 JMP ITSNT RETURN NOT-INTERACTIVE * * JSB XLUEX SEE IF THE LU IS INTERACTIVE DEF *+6 DEF D13I STATUS REQUEST DEF ANLU# THE LU WE WANT THE INFO ABOUT DEF YTEMP EQT WORD 5 PLACED HERE DEF DTYPE EQT WORD 4 PLACED HERE(NOT NEEDED) DEF ZTEMP SUB CHANNEL IN LOWER 5 BIT HERE * JMP ITSNT IT AIN'T EVEN AN LU !!!! LDA YTEMP GET EQT WORD 5 AND MEQT KEEP ONLY THE EQT TYPEõè   FIELD LDB A AND SAVE IT LDA ZTEMP GET THE SUBCHANNEL BITS AND M37 STA ZTEMP ADA B CONFIGURE B REGISTER RETURN WORD STA DTYPE SZB,RSS IF DVR 00 THEN JMP ITSIN ITS INTERACTIVE CPB M2400 IF DVR 05 THEN JMP DVR05 DO ONE MORE CHECK FOR SUB CHANNEL CPB M3400 IS IT DVR07 ? JMP DVR05 THEN DO DVR05 CHECK JMP ITSNT ELSE ITS NOT INTERACTIVE * DVR05 LDA ZTEMP GET THE SUB CHANNEL # SZA,RSS IF = 0 THEN ITS ITSIN CCA,RSS SET INTERACTIVE FLAG ITSNT CLA SET NON INTERACTIVE FLAG LDB DTYPE JMP XFTTY,I RETURN TO CALLER * * D13I OCT 100015 M2400 OCT 2400 M37 OCT 37 B77 OCT 77 M3400 OCT 3400 MEQT OCT 37400 ANLU# NOP DTYPE NOP YTEMP NOP ZTEMP NOP A EQU 0 B EQU 1 END b° ÿÿ ÿýÚá ÿ92067-18296 2013 S C0122 &TRMLU              H0101 ˆ¡þúASMB,R,L,C ** TRMLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -TRMLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: TRMLU * SOURCE: 92067-18296 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TRMLU,7 92067-1X296 REV.2013 771117 ENT TRMLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB TRMLU -OR- JSB TRMLU -OR- CALL TRMLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP TRMLU NOP ENTRY STB EQT4 SAVE B-REG FOR LATER TEST LDA TRMLU,I GET ADRS OF RETURN ADDRESS ISZ TRMLU BUMP TO POSSIBLE PRAM. LDB TRMLU,I GET POSS. ADDRS OF PRAM. CPA TRMLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STB LUADR SET ADDRESS FOR PASSED PRAM STA TRMLU SET UP RETURN ADDRESS CLA SET START LU = 0 STA LUNUM * NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCHANNEL BITSÖ}   MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOND1 LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER JMP TRMLU,I SPC 1 FOUND LDA EQT4 GET THE SPECIFIED LU INA AND NOW EQT 5 LDA A,I AND MEQT GET THE TYPE SZA,RSS DVR00 ? JMP FOND1 YES, WERE DONE LDA DRT MUST BE DVR05, SO GET DRT ADA LUNUM ADD LU # ADA DM1 DO OFFSET LDA A,I GET THE DRT VALUE AND MSUB GET THE SUB CHANNEL # SZA,RSS WAS IT THE CRT ? JMP FOND1 YES, SO DO IT. JMP NEXT SPC 1 EQT4 NOP MSUB OCT 174000 MEQT OCT 37400 DM1 DEC -1 LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B A EQU 0 B EQU 1 END æ ÿÿ ÿýÛâ ÿ92067-18297 2013 S C0122 &LOGLU              H0101 †“þúASMB,R,L,C ** LOGLU - RETURNS LU FROM PROGRAM ID SEGMENT HED -LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92067-18297 * RELOC: PART OF 92067-16268 * PGMR: C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOGLU,7 92067-1X297 REV.2013 790228 ENT LOGLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * CALLED AS FOLLOWS: * * LU = LOGLU(SYSLU) JSB LOGLU * DEF *+2 * DEF SYSLU * * * LU = A REG = LU # OF LU AT WHICH 'RU' OR 'ON' WAS ENTERED. * OR IF SCHEDULED BY A FATHER, THE LU AT WHICH * THE FATHER WAS SCHEDULED. * = 1 IF PROGRAM SCHEDULED BY INTERUPT OR TIME LIST * B REG = ASCII LU # (SESSION TERMINAL LU) * SYSLU = SYSTEM LU OF SESSION TERMINAL IF IN SESSION * = -LU IF NOT IN SESSION * * LOGLU NOP ENTRY DLD LOGLU,I GET RETURN ADDRESS & DUMMY ADDRESS STB SYSLU SAVE DUMMY ADDRESS STA LOGLU &RETURN ADDRESS LDA XEQT GET MY ID ADDRESS ADA D32 ADVANCE TO SESSION WORD XLB A,I AND FETCH IT * SZB IF NON SSB SESSION GO DO JMP MTM MTM WORK * CLA,INA SET SESSION LU=1 STA LU# * * * * JSB MMAP GO MAP IN POSSIBLE TABLE PARTITION * NXT INB POINT AT LU SWITCH XLA B,I FETCH AN LU SWITCH3h   AND B377 ISOLATE SESSION LU-1 SZA IF NOT LU 1 DEFINITION JMP NXT GO GET THE NEXT ONE * * FOUND SESSION LU 1 * XLA B,I FETCH THE SWITCH AGAIN ALF,ALF POSITION SYSTEM LU-1 TO LOW BYTE INA ADJUST FOR INTERNAL FORMAT STA SYSLU,I AND RETURN IT TO CALLER CONV CLB CLEAR (B) FOR DIVIDE DIV D10 ALF,ALF ADB A ADB ASC00 B = ASCII LU # LDA LU# A = BINARY LU # JMP LOGLU,I RETURN * * MTM SZB,RSS IF SESSION WORD=0 CCB USE 1 STB SYSLU,I CMB,INB SET LU POSITIVE STB LU# SAVE FOR RETURN LDA B MOVE LU TO A FOR CONVERSION JMP CONV * * D10 DEC 10 D32 DEC 32 B377 OCT 377 SYSLU NOP LU# NOP ASC00 ASC 1,00 XEQT EQU 1717B A EQU 0 B EQU 1 END ¯ ÿÿ ÿýÜã ÿ92067-18298 2013 S C0122 &IDGET              H0101 uþúASMB,R,L,C HED "IDGET" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG * SOURCE: 92067-18298 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: D.L.B.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IDGET,6 92067-1X298 REV.2013 790314 ENT IDGET,ID.A,IDSGA EXT .ZPRV * CALLED: * IDSEG = IDGET(NAME) * WHERE: * NAME = THREE WORD ASCII (5 CHARS) BUFFER WITH NAME OF PROG * IDSEG = THE ID SEGMENT ADDRESS OF THE NAME * RETURN: * A-REG = ID SEGMENT ADDRESS OF NAME IF FOUND OR = 0 IF NOT FOUND * E-REG = 0 IF NAME FOUND OR = 1 IF NOT FOUND. * B-REG = 0 * * NOTE: IF NAME IS NULL THEN FIND BLANK IDSEG ADDRESS. SPC 1 IDGET NOP ENTRY FTN CALLING SEQUENCE IDSGA EQU IDGET ID.A EQU IDGET * JSB .ZPRV DO THE $LIBR THING DEF LIBX ISZ IDGET AVOID .ENTR,.DFER LDB IDGET GET NAME ADDRESS LDB B,I GET NEXT LEVEL RBL,CLE,SLB,ERB TRACK DOWN INDIRECTS JMP *-2 STB NAME AND SAVE FOR LATER USE INB BUMP TO 2ND WORD IN NAME STB NAME+1 SAVE ADDRESS OF NAME(2) INB BUMP TO LAST CHAR LDA B,I PICK UP AND OM400 NULL LAST CHAR STA NAME+2 SAVE VALUE OF NAME(3) LDB KEYWD GET KEYWORD POINTER ON BASE PAGE STB POINT SAVE TEMP RSS SKIP THE ISZ 1ST TIME LOOP ISZ POINT BUMP TO NEXT IDSEG ADDRESS XLB POINT,I GET IDSEG ADD OF NEXT PROG CCE,SZB,RSS CHECK IF LAST ENTRY JMP ENDTA YES, NOT FOUND PROGRAM ADB D12 POINT m@  TO PROGRAM NAME AREA XLA B,I GET CHARS 1 & 2 CPA NAME,I EQUAL ? INB,RSS YES, CHECK NEXT 2 JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET CHARS 3,4 CPA NAME+1,I EQUAL? INB,RSS YES, BUMP AGAIN JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET LAST CHAR AND OM400 MASK TO 5TH CHAR CPA NAME+2 CLB,CLE,RSS FOUND!!!! JMP LOOP TRY NEXT PROG ENDTA XLA POINT,I RETURN A= IDSEG ADDRESS ISZ IDGET SET RETURN POINT E=FOUND FLAG LIBX JMP IDGET,I P+3 DEF IDGET FOR JSB $LIBX SPC 1 NAME REP 3 NOP POINT NOP OM400 OCT -400 D12 DEC 12 KEYWD EQU 1657B B EQU 1 END 4 ÿÿ ÿýÝä ÿ92067-18299 2013 S C0122 &IXGET              H0101 ŠASMB,R,Q,C HED IXGET * NAME: IXGET * SOURCE: 92067-18299 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXGET,7 92067-1X299 REV.2013 780731 ENT IXGET * * * CALLING SEQUENCE: * *C GET IDATA FROM IADDR * IDATA=IXGET(IADDR) * * WHERE: IADDR = ADDRESS TO BE READ * IDATA = VALUE IN LOCATION "IADDR" * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * A EQU 0 B EQU 1 END å¢ÿÿ ÿýÞä ÿ92067-18300 2013 S C0122 &IXPUT              H0101 ’ASMB,R,Q,C HED IXPUT * NAME: IXPUT * SOURCE: 92067-18300 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXPUT,7 92067-1X300 REV.2013 780731 ENT IXPUT EXT $LIBR,$LIBX * * * CALLING SEQUENCE: * * *C PUT IDATA INTO IADDR * CALL IXPUT(IADDR,IDATA) * * WHERE: IADDR = ADDRESS TO BE STUFFED * IDATA = VALUE TO BE PUT INTO "IADDR" * * * IXGET NOP IXPUT NOP JSB $LIBR NOP * LDA IXPUT,I STA IXGET ISZ IXPUT DLD IXPUT,I LDA A,I LDB B,I XSB A,I JSB $LIBX DEF IXGET * * A EQU 0 B EQU 1 END ïSÿÿ ÿýßå ÿ92067-18301 2013 S C0122 &FTIME              H0101 ‡vþúASMB,R,Q,C HED TIME FORMAT SUBROUTINE * NAME: FTIME * SOURCE: 92067-18301 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FTIME,7 92067-1X301 REV.2013 780731 ENT FTIME EXT EXEC * CALLING SEQUENCE: * *C GET THE TIME IN A 15 WORD STRING * DIMENSION IBUF(15) * CALL FTIME(IBUF) * SUP * * GET TIME AND BUILD HEADER MESSAGE * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 * * P1 NOP FTIME NOP DLD FTIME,I STA FTIME RSS INDCT LDB B,I TRACK DOWN INDIRECTS RBL,CLE,SLB,ERB JMP INDCT STB P1 * JSB EXEC DEF *+4 DEF O13 GET TIME DEF ITIME DEF IYEAR LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 Fþú YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB DM15 SET WORD COUNT STB COUNT LDA TMSGA AND THE TIME ARRAY OLOOP LDB A,I MOVE IT STB P1,I INA ISZ P1 ISZ COUNT JMP OLOOP * JMP FTIME,I RETURN * * * PD00 NOP CONVERT TO 2 ASCII DIGITS CLB DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 DM15 DEC -15 COUNT BSS 1 O5 OCT 5 O7 OCT 7 D31 DEC 31 D100 DEC 100 D153 DEC 153 D366 DEC 366 * SPC 1 * ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.!E FEB. * END Ä‹ÿÿ ÿýàè ÿ92067-18302 2013 S C0122 &.IAE.              H0101 u?ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18302 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .IAE.,7 92067-1X302 REV.2013 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .IAY.,.ZAE. ENT .IAE. * DEC 1024 THIS IS THE ONE WORD .IAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 1024 DEF .IAY. * END ±Qÿÿ ÿýáç ÿ92067-18303 2013 S C0122 &.RAE.              H0101 ?ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18303 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .RAE.,7 92067-1X303 REV.2013 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .RAY.,.ZAE. ENT .RAE. * * DEC 1024 THIS IT THE TWO WORD/ELEMENT .RAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 512 DEF .RAY. * END Áÿÿ ÿýâè ÿ92067-18304 2013 S C0122 &.XAE.              H0101 †?ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18304 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .XAE.,7 92067-1X304 REV.2013 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .XAY.,.ZAE. ENT .XAE. * DEC 1023 THIS IS THE THREE WORD/ELEMENT .XAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 341 DEF .XAY. * END $íÿÿ ÿýãé ÿ92067-18305 2013 S C0122 &.ZAE.              H0101 ‰?þúASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18305 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .ZAE.,7 92067-1X305 REV.2013 781128 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .TAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * * CALLING SEQUENCE TO THIS ROUTINE IS: * * DEC #WORDS/PAGE (MUST BE WHOLE ELEMENTS) * DEF TO DEFS TO OFFSET IN EMA AND -# ELEMENTS TO XFER * JSB .ZAE. RETURN IS TO ABOVE ADDRESS POINTED TO +2 * DEC #ELEMENTS/PAGE * DEF .IAY. OR .RAY. OR .XAY. OR .TAY. AS REQUIRED * EXT .EMAP,ERR0 ENT .ZAE. * #WDS NOP RTN NOP N3 DEC -3 A EQU 0 B EQU 1 FMTR NOP HOLD FORMATER ENTRY ADDRESS XIDEX EQU 1645B ADDRESS OF THE ID EXTENSION kþú B174K OCT 174000 SKP .ZAE. NOP THIS IS WHERE IT HAPPENS CLB SET TO DEFAULT TO ZERO IF NOT AN EMA PGM. LDA XIDEX FIRST GET INA THE XLA A,I EMA LOGICAL ADDRESS AND B174K ISOLATE THE PAGE RAR PUT IN RIGHT SPOT IN WORD STA EMAAD PUT IN THE .EMAP CALL LDA .ZAE. GET THE RETURN ADDRESS AND ADA N3 USE IT TO INDEX INTO THE DLD A,I THE DATA DST #WDS SAVE THE #WORDS AND THE RETURN ADDRESS DLD B,I GET THE DEF'S FOLLOWING THE CALL ISZ RTN SET UP THE PROPER RETURN ADDRESS ISZ RTN SET UP THE PROPER RETURN ADDRESS STB T1 SAVE THE ADDRESS OF THE COUNT DLD A,I GET THE OFFSET DST EMOF AND SET IN THE .EMAP CALL DLD .ZAE.,I GET THE #WORDS/X AND THE FMTR ENTRY PT. STB FMTR SAVE IN THE FORMATER CALL STA NELM ALSO SAVE THE DEFAULT COUNT DLD T1,I GET THE TOTAL NUMBER OF WORDS IN THE ARRAY T1 EQU *-1 AGAIN DST COUNT SAVE IT ASL 1 TEST IF INB,SZB LESS THAN 32K LEFT (SETS E IF SKIP) JMP OK NO GO DO THE DEFAULT XFER * ERA YES RESTORE THE COUNT ADA NELM TEST IF LESS THAN THE DEFAULT SSA WELL? JMP OK NO GO DO THE DEFAULT * LDB COUNT YES COMPUTE HOW MANY CMB,INB AND STB NELM SET FOR THE CALL * OK JSB .EMAP CALL .EMAP TO RESOLVE THE ADDRESS DEF BOOM EMAAD NOP ADDRESS OF EMA FROM THE IDEX DEF TABLE USE DUMMY TABLE BOOM JSB ERR0 TOO BAD YOU LOSE STB CALL SET ADDRESS FOR FMTR CALL JSB FMTR,I CALL THE FORMATER CALL NOP ADDRESS NELM NOP NUMBER OF ELEMENTS * CLE COMPUTE WHAT IS LEFT LDA EMOF FIRST THE ADA #WDS THE EMA OFFSET SEZ,CLE MOST I’ S A CARRY ISZ EMOF+1 IF CHANGE STEP IT STA EMOF RESTORE THE OFFSET * DLD COUNT ADA NELM SUBTRACT FROM NUMBER LEFT SEZ,CLE MOST IS A CARRY OF 1 INB,SZB INDEX COUNT JMP AGAIN IF NO ROLL OVER THEN DO IT AGAIN * JMP RTN,I ELSE RETURN * * TABLE NOP NO DIMENSIONS EMOF NOP DOUBLE WORD EMA OFFSET NOP COUNT NOP DOUBLE WORD COUNT (NEGATIVE) NOP END réÿÿ ÿýäì ÿ92067-18306 2013 S C0122 &.STDB              H0101 ‚fASMB,L,C HED .STDB ROUTINE * SOURCE: 92067-18306 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .STDB,7 92067-1X306 REV.2013 771107 ENT .STDB,.DBSG EXT .SDBG SUP * * THIS PIECE OF CODE IS APPENDED TO EACH SEGMNET OF A SEGMENTED * PROGRAM LOADED WITH THE RTE-IV LOADER USING THE 'DB'(DEBUG) * COMMAND. THE SEGMDENT'S PRIMARY ENTRY POINT CONTAINED IN ITS * ID SEGDMENT IS SET TO *.STDB*. THE LOADER WILL STORE THE * TRUE PRIMARY ENTRY POINT OF THE SEGDMENT IN *.DBSG*. THE * DEBUG SUBROUTINE *DBUGR*, WHEN ENTRED FROM *.STDB*, WILL * EXECUTE A PSUEDO BREAK. IT WILL THEN RETURN TO THE SEGMENT'S * PRIMARY ENTRY POINT WHENEVER THE USER ENTERS THE '/P' COMMAND. * ****************************************************************** * .STDB JSB .SDBG SEGMENT ENTERED HERE. .DBSG NOP LOADER STORES TRUE ENTRY POINT HERE. END .STDB ­úÿÿ ÿýåë ÿ92067-18307 2013 S C0122 &DTACH              H0101 ƒoþúASMB,R,L,C,Q * NAME: DTACH * SOURCE: 92067-18307 * RELOC: PART OF 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DTACH,6 92067-1X307 REV.2013 800129 * ENT DTACH EXT $LIBR,$LIBX SPC 2 * PURPOSE: TO REMOVE A PROGRAM FROM SESSION. * * NOTE: IF THE CALLING PROGRAM IS NOT A SESSION PROGRAM, * THIS ROUTINE DOES NOTHING MORE THAN RETURN. * CALLINNG SEQUENCE: * * CALL DTACH \ REMOVES PROG FROM SESSION BY CHANGING * SESSION WORD TO CONTAIN -TERMINAL LU * OF IT'S SESSION. * * OR * * CALL DTACH(IDUMMY) \ REMOVES PROG FROM SESSION BY * CHANGING SESSION WORD TO CONTAIN -1 (MAKES * IT APPEAR TO HAVE BEEN RUN FROM THE SYS * CONSOLE). * * IN EITHER CASE, THE OWNER FLAG IS CHANGED TO INDICATE * THAT THE SYSTEM OWNS THIS ID. * * * SPC 2 DTACH NOP JSB $LIBR NOP * LDA XEQT DEFINE ADDR OF SESSION WORD ADA D32 STA TMP1 XLB A,I FETCH CONTENTS OF SESSION WORD * LDA DTACH,I CHECK FOR SIMPLE DTACH OR RESET TO LU 1 ISZ DTACH BUMP RETURN ADDR FOR TEST CPA DTACH IF NO PARMS PASSED JMP TRMLU GO FETCH TERMINAL LU * STA DTACH SAVE RETURN ADDR SSB IF MTM JMP OUT SZB,RSS OR NON SESSION JMP OUT DON'T CHANGE ANYTHING * CCA SET (A) TOý   INDICATE LU 1 JMP SYSCN * TRMLU SSB IF MTM, CONTINUE JMP OUT SZB,RSS JMP OUT * JSB MMAP MAP IN POSSIBLE TABLE PTN NXT INB POINT AT LU SWITCH XLA B,I AND B377 ISOLATE SESSION INFO SZA IF NOT LU 1 DEFINITION JMP NXT GO GET THE NEXT ONE * XLA B,I FETCH THE SWITCH AGAIN ALF,ALF GET SYSTEM LU TO LOW BYTE CMA SYSCN XSA TMP1,I SET NEW SESSION WORD OUT LDB TMP1 FETCH ID 33 ADDR ADB N1 BACK UP TO OWNER FLAG XLA B,I AND FETCH IT AND NOTID XSA B,I RESTORE IT WITH OWNER ID =0 JSB $LIBX DEF DTACH * * B377 OCT 377 NOTID OCT 177400 TMP1 NOP D32 DEC 32 N1 OCT -1 XEQT EQU 1717B A EQU 0 B EQU 1 END  ÿÿ ÿýæí ÿ92067-18308 2013 S C0122 &LUTRU              H0101 ”—þúASMB,R,L,C,Q HED LUTRU-FETCH "TRUE" SYSTEM LU * NAME: LUTRU * SOURCE: 92067-18308 * RELOC: PART OF 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LUTRU,6 92067-1X308 REV.2013 790223 EXT $LUSW,.ENTP,.ZPRV * ENT LUTRU * * PURPOSE: TO TRANSLATE A SESSION OR BATCH LU INTO A TRUE * SYSTEM LOGICAL UNIT. * * CALLING SEQUENCE: CALL LUTRU(LUTST,ISYS,ISCB) OR I=LUTRU(LUTST) * ---- * * WHERE: LUTST= THE LOGICAL UNIT TO BE TESTED * ISYS = LOCATION FOR RETURN OF RESULT * ISCB = IF SUPPLIED, TEST SPECIFIED LOGICAL * UNIT AGAINST THIS SESSION CONTROL BLOCK. * * RETURNS: ISYS AND/OR (A)=TRUE SYSTEM LU * OR =-1 IF LUTST NOT DEFINED FOR * THIS SESSION. * * (B)=0 * SKP * ILOG NOP ISYS NOP ISCB NOP * LUTRU NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF ILOG FETCH PARMS * * CHECK FOR LU SWITCH REQUIRMENT * -BATCH FLAG=BIT 15 ID WORD 21 * -SESSION WORD=ID WORD 33 * LDA ILOG,I FETCH LOGICAL LU ADA N1 ADJUST FOR TABLE DATA STRUCTURE (LU-1) AND B377 ISOLATE LU STA TEMP1 SAVE FOR CAPCK CPA B377 IF TEST LU IS ZERO JMP NOPE THEN NO FUTHER CHECKS REQUIRED * * CLA PRESET (A) IN CASE SCB ADDR NOT PROVIDED LDB ISCB,I FETCH POSSIBLE OVERRIDE SCB °ƒþú SZB IF DEFINED JMP SPCL USE IT * LDB XSUSP FETCH POINTER INTO ID SEG ADB .12 ADVANCE TO BATCH FLAG XLA B,I FETCH IT ADB .12 ADVANCE TO SESSION WORD XLB B,I FETCH IT * SZB IF SESSION WORD =0 SSB OR IS < 0 THEN JMP NSESS PROG IS NOT IN SESSION * * THE PROGRAM IS A SESSION PROGRAM. * MUST MAP TABLE PTN IN AT THIS POINT * -THE REQUESTED LOGICAL UNIT MUST BE DEFINED FOR * THIS SESSION'S USE (MUST BE IN IT'S SST) OR ISYS IS SET =-1 * *SPCL JSB MPTAB GO MAP IN TABLE PTN( IF DEFINED). RETURNS LOGICAL * ADDR IN (B). SPCL XLA B,I FETCH LENGTH OF SWITCH TABLE JSB SWTCK GO SEE IF THIS LU IS SWITCHED CCA P+1 LU NOT DEFINED FOR SESSION USE JMP NOPE2 P+2 SWITCH FOUND, (A) =SYSTEM LU * * * THE PROGRAM IS NOT IN SESSION * CHECK FOR BATCH SWITCH REQUIRMENT * -(A)=ID WORD 21 (BATCH FLAG = BIT 15) * NSESS SSA,RSS IS THIS A BATCH REQUEST? JMP NOPE NOPE-- USE PASSED LU * XLA $LUSW FETCH LENGTH OF BST CMA,INA SET IT NEGATIVE LDB D$LUT FETCH ADDR OF BST JSB SWTCK GO SEE IF LU SWITCHED NOPE LDA ILOG,I P+1 NO SWITCH,USE SUPPLIED LU NOPE2 STA ISYS,I P+2 SWITCH FOUND [IN (A) ] CLB RESET OPTIONAL STB ISYS PARM STB ISCB LIBX JMP LUTRU,I EXIT DEF LUTRU SKP ** * * SWTCK (SWITCH TABLE CHECK) * * SCAN THE SPECIFIED TABLE (LOW BYTE OF SESSION OR BATCH SWITCH TABLE) * FOR A MATCH, WITH THE VALUE IN TEMP1. * * CALLING SEQUENCE:LDA -LENGTH * LDB ADDRESS OF TABLE(POINTS AT LENGTH) * = TO THIS LEVEL, USE IT JMP LEV? ELSE CONTINUE SEARCH * HIGH INA ADVANCE TO START ADDR OF THIS LEVEL XLB A,I FETCH START ADDRESS OF THIS CAPABILITY STB STRT SAVE FOR SECOND PASS * SKP * * * SCAN THE COMMAND TABLE TO IDENTIFY COMMAND AND * VERIFY ITS USAGE AT THIS CAPABILITY LEVEL. * * * * B=START ADDR OF TABLE * NXT2 XLA B,I FETCH ASCII COMMAND CPA CMND COMPARE WITH REQUESTED COMMAND JMP MTCH1 -IF MATCH,CHECK PARMS * CPB END END OF COMMAND TABLE? JMP DONE? YES- MAY NEED SECOND PASS * ADB D2 NOT END SO CHECK JMP NXT2 THE NEXT ONE * DONE? CCA PRE-SET FOR CMND UNDEFINED RETURN LDB FAIL FETCH FAIL FLAG SZB IF THIS IS SECOND PASS THEN JMP EXITX EXIT, (A=-1) CMND UNDEFINED] * * WE ONLY NEED TO SEARCH THE PORTION OF THE TABLE NOT COVERED * BY THE FIRST PASS * LDB STRT FETCH BEGINNING OF USER CAPABILITY STB END SET AS STOP SEARCH POINT * LDB BEGIN FETCH ACTUAL START LOCATION OF CMND TABLE STB FAIL SET SECOND PASS FLAG JMP NXT2 GO SEE IF CMND DEFINED * * * WE HAVE REACHED THE END OF THE USER'S CAPABILITY, BUT NOT * THE END OF THE COMMAND TABLE. WE MUST SEARCH THE REMAINING * PORTION OF THE COMMAND TABLE TO DETERMINE THE TYPE OF ERROR: * OP-CODE OR INSUFFICIENT CAPABILITY. * * * * WE HAVE A MATCH - IF "FAIL" IS NOT ZERO, INSUF CAP ERR EXIT * * ELSE CHECK FOR PARAMETER RESTRICTIONS * * MTCH1 LDA FAIL FETCH FAIL FLAG SZA IF NOT = 0 JMP INSUF EXIT * SKP * COMMAND IS DEFINED FOR THIS USER * CHECK FOR PARAMETER RFGþúESTRICTIONS * * STB CHCNT SAVE TABLE ADDR IN TEMP INB ADVANCE TO PARAMETER SPECIFICATION XLA B,I AND FETCH IT * SSA BIT 15=PARM COUNT RESTRICTION JMP CK# - GO CHECK COUNT * RAL BIT 14=PROGRAM SPECIFIED BY PARM1 MUST SSA BELONG TO SPECIFIED SESSION JMP IDCK GO CHECK SESSION WORD * * EXOK LDB PCNT FETCH PARAMETER COUNT EXNO LDA CMND FETCH ASCII COMMAND EXITX STA CMND CLA STA ISCB STA CAP1 LDA CMND LDX PARMA LIBX JMP CAPCK,I DEF CAPCK (MAKE GENERATOR AND LOADER HAPPY) * * A=CMND LIMIT WORD * * CK# AND B37 LOW 5 BITS = ALLOWED COUNT CMA SET IT NEG-1 LDB PCNT FETCH # OF REQUEST PARAMETERS ADA B ADD ALLOWED NUMBER SSA IF <= TO ALLOWED COUNT JMP EXOK EVERYTHINGS OK-- EXIT * INSUF CCB -CAPABILITY ERROR JMP EXNO ERROR EXIT * * IDCK JSB IDGET FETCH ID ADDR OF DEF *+2 PROGRAM SPECIFIED BY PARMA DEF PARM PARM #1 * SZA,RSS PROG NOT FOUND OR JMP EXOK NOT SPECIFIED IS OK * LDB D14 FETCH OFFSET TO TYPE WORD ADB A XLA B,I FETCH TYPE WORD AND D15 ISOLATE IT CPA D5 IF A SEGMENT JMP EXOK LET IT THROUGH (NO SESSION WORD) * ADB D18 ADVANCE TO SESSION WORD XLA B,I AND FETCH IT * SZA NOTE:THIS ALLOWS ACCESS OF NON-SESSION PROGRAMS * * CPA ISCB MATCH CALLER'S SPECIFICATION? JMP EXOK -YES, GO EXIT OK JMP INSUF -NO, CAPABILITY ERROR EXIT * SKP * * * * THE FOLLOWING SECTIONS ARE CALLED BY THE REQUEST SCAN PROCESSOR * * * FOUND A COMMA * ITCMA ISZ CMCNT BUMP COMMA COUNT CLB LDA CHCNT FETCH CHARACTER COUNT ¦_*($STB CHCNT AND THEN RESET FOR NEXT PARM * SZA ANY NON-NULL OR NON-COMMA CHARS SEEN? ISZ PCNT YES - BUMP PARAMETER COUNT JMP CONT CONTINUE WITH NEXT BYTE * * * * WORKING ON THE REQUESTED COMMAND * CMND1 LDB CHCNT FETCH CHARACTER COUNT ADB N3 IF MORE THAN 2 CHARS FOUND SSB,RSS THEN WE HAVE ALL WE NEED SO JMP CONT CONTINUE SCAN * LDB CMAD FETCH BYTE ADDRESS OF COMMAND BUFFER SBT SAVE THE BYTE STB CMAD SAVE NEW BYTE ADDRESS JMP CONT AND CONTINUE SCAN * * * WORKING ON 1ST PARAMETER * * FST LDB CHCNT FETCH CHAR COUNT ADB N6 IF MORE THAN 5 THEN SSB,RSS WE HAVE SEEN ENOUGH JMP CONT SO CONTINUE SCAN * LDB PARAD FETCH BYTE ADDRESS OF PARAMETER BUFFER SBT STORE THE BYTE STB PARAD SAVE NEW BYTE ADDR JMP CONT CONTINUE SCAN * SKP * * D1 OCT 1 D2 OCT 2 D5 DEC 5 D14 DEC 14 D15 DEC 15 D18 DEC 18 B37 OCT 37 N3 OCT -3 N6 OCT -6 COMMA OCT 54 NULL ASC 1, B40 OCT 40 CAP1 NOP QUIT NOP STRT NOP END NOP BEGIN NOP CMCNT NOP CHCNT NOP PCNT NOP CMND NOP CMAD NOP DCMND DBL CMND PARM ASC 3, DPARM DBL PARM PARAD NOP FAIL NOP OUCH! EQU * A EQU 0 B EQU 1 END €D*ÿÿ ÿýé õ ÿ92067-18311 2013 S C0122 &$BALC              H0101 tKþúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18311 * * RELOCATABLE PART NUMBER : 92067-16268 * * PROGRAMER(S) : J.M.N. * * NAM $BALC,7 92067-1X311 REV.2013 791016 ENT $BALC,$BRTN EXT $BRTX,$OSAM,$PNTI,$MAXI EXT $LIBR,$LIBX,.ENTR * * * THIS ROUTINE ALLOCATES AND RETURNS A BLOCK OF * SAM SEMI PERMENANTLY. * THE ALGORITHM IS DESIGNED TO LEAVE THE LARGEST * CONTIGUOUS $BOCK POSIBLE IN SAM. * * ALTHOUGH THERE IS NO LIMIT TO NUMBER OF BLOCKS * THAT CAN BE ALLOCATED, $OSAM ONLY HAS ROOM FOR * 4 BLOCKS. * * * CALLING SEQUENCE: * * LDA IWRDS * STA NWRDS SET NWORDS TO NO OF WORDS REQUIRED * JSB $BALC * DEF *+4 * DEF NWRDS * DEF IADDR ADDRESS RETURNED OF START OF BLOCK * DEF MAXEV LARGEST CONTIGUIOUS BLOCK LEFT IN SAM * * * * TO RETURN MEMORY * THE CALLING SEQUENCE IS: * * JSB $BRTN * DEF *+3 * DEF IADDR * DEF NWRDS * * WHERE: NWORDS IS BUFFER SIZE IN WORDS * IADDR IS ADDRESS OF BUFFER * MAXEV IS THE LARGEST POSIBLE * $BOCK LEFT IN SAM * * P01 NOP P02 NOP P03 NOP $BALC NOP JSB .ENTR DEF P01 * XLA $PNTI+0 SET UP POINTERS TO SAM ADA DM1 STA PNTRA XLA $MAXI POINTER TO MAXEV STA $MAXE * LDA M7 SET MINIMUN BLOCK STA MINBK CLA AND LARGEST OFFSET STA SOFST LDA P01,I GET REQUEST SIZE CMA,INA ¦Ïþú STA RWRDS * JSB $LIBR MUST SHUT DOWN TO SCAN LIST NOP LDB PNTRA GET START OF FREE LIST RSS LOOP1 XBX PUT SAM POINTER IN B REG JSB NSAM GET NEXT SAM ENTRY JMP BEST SCANED THE LIST GO TAKE BEST CMA,INA SAVE THE NEGATIVE OF LAST ADDRESS+1 STA LADDR XBX SAVE LIST POINTER IN X LDB ORGPT POINTER TO ORIGINAL BLOCK DESCRIPTOR LOOP2 JSB OSAM GET ORIGINAL BLOCK JMP LOOP1 NO QUALIFIED BLOCK JMP LOOP2 EMPTY ENTRY IGNOR ADA LADDR COMPUTE BACK OFFSET SSA JMP LOOP2 IF NEGATIVE NOT IN BLOCK STA BOFST * LDA OADDR CMA,INA COMPUTE FRONT OFFSET ADA SADDR SSA JMP LOOP2 IF NEGATIVE NOT IN BLOCK STA FOFST * * SAM IS IN CURRENT BLOCK * ADB DM2 ADJUST POINTER TO CURRENT BLOCK * LDA OWRDS UPDATE MINIMUM BLOCK CMA,INA STA MINBK * LDA FOFST COMPUTE LARGEST OFFSET CMA,INA ADA BOFST CCE,SSA CLA,CLE ADA FOFST STA OFFST SAVE LARGEST OFFSET ERA SAVE WHICH SIDE STA FORB POS = FRONT,NEG = BACK ELA * ADA SOFST IS IT LARGEST SO FAR SSA JMP LOOP1 NO GO GET NEXT * * BEST FIT SO FAR * * * * TRANSFER PARAMETERS * STB SPNTR BLOCK POINTER ISZ SPNTR ADJUST SPNTR TO POINT TO BLOCK STX NLINK NEXT LINK LDA OFFST NEGATIVE OF LARGEST OFFSET CMA,INA * LDB TRPNT STA B,I INB LOOP3 CPB TREND JMP LOOP1 FINISHED GO GET NEXT LDA B,I INB STA B,I INB JMP LOOP3 * * * THIS IS THE BEST ALLOCATION * BEST LDA MINBK WAS ANY SAM FOUND? CPA M7 JMP ERROR NO GO REPORT ERROR * LDA RWRDS IF THERE IS LESS THAN éXþú ADA SWRDS+1 2 EXTRA WORDS ADA DM2 LDB SWRDS+1 CMB,INB SSA STB RWRDS THEN USE WHOLE BLOCK * LDA SWRDS+1 ADA RWRDS COMPUTE WODRS LEFT LDB FORB+1 SSB,RSS SHOULD WE USE FRONT OR BACK JMP BPART (USE BACK) LDB RWRDS COMPUTE ADDRESS OF BLOCK LEFT CMB,INB ADB NLINK XSB LLINK+1,I AND FIX LAST LINK XAX SAVE WORD COUNT IN X ISZ NLINK XLA NLINK,I GET NEXT LINK XAX FIX WORD COUNT XSA B,I XAX INB XSA B,I AND NEXT LINK CCA SET TO RESET NLINK JMP BP.1 * * BACK PART * BPART XSA NLINK,I UPDATE WORD COUNT BP.1 ADA NLINK FIX NLINK STA NLINK * * REMOVE FROM ORIGINAL DESCRIPTION * LDA OADDR+1 CMA,INA ADA NLINK XSA SPNTR,I (MAYBE FREE AN ENTRY) * CMA,INA ADA OWRDS+1 ADA RWRDS STA OWRDS+1 LDB ORGP RM.2 XLA B,I FIND FREE ENTRY SZA,RSS JMP RM.3 ADB D2 JMP RM.2 * RM.3 LDA OWRDS+1 PUT WORDS IN ENTRY XSA B,I INB LDA RWRDS SEND BACK ACTUAL WORD COUNT CMA,INA STA P01,I ADA NLINK COMPUTE START ADDRESS FREE BLOCK XSA B,I * * PASS ADDRESS AND MAXEV * BACK TO PROGRAM * LDA NLINK STA P02,I LDA RWRDS CMA,INA RM.4 STA P01,I * JSB MXEV GO UPDATE MAXEV STA P03,I MAXEV * JSB $LIBX DEF $BALC * ERROR CCA RETURN -1 WORDS JMP RM.4 * * CONSTANTS AND VARIABLES * PNTRA BSS 1 $MAXE BSS 1 ORGPT DEF $OSAM-1 ORGP DEF $OSAM+0 * A EQU 0 B EQU 1 * OFFST BSS 1 SOFST BSS 1 OWRDS BSS 2 SWRDS BSS 2 FORB BSS 2 LLINK BSS 2 OADDR BSS 2 NLINK BSS 1 SADDR BSS 1 BOFST BSS 1 FOFST BSS 1 RWRDS BSS 1 SPNTR BSS 1 LADDR BSS 1 TRPNT ôXþúDEF SOFST TREND DEF NLINK D2 DEC 2 DM1 DEC -1 DM2 DEC -2 M7 OCT 77777 MINBK OCT 77777 * * * RETURN BLOCK TO SAM * P1 NOP P2 NOP $BRTN NOP LDA $BRTN STA P1 INA STA P2 INA STA $BRTN CLA STA SPNTR CLEAR SPNTR LDA M7 SET MINBK TO MAX STA MINBK LDA P2,I GET NO OF WORDS STA RWRDS LDA P1,I GET START ADDRESS STA NLINK ADA P2,I COMPUTE LAST ADDRESS+1 STA LADDR JSB $LIBR MUST GO PRIVELEGED NOP * LDB ORGPT BR.0 JSB OSAM FIND BLOCK JMP BR.4 WE'RE DONE JMP BR.3 IGNOR EMPTY ENTRIES CPA NLINK DOES IT MATCH IN FRONT JMP BR.1 YES GO ADD IT LDA LADDR CPA OADDR NO,DOES IT MATCH IN BACK JMP BR.2 YES GO ADD IT JMP BR.0 NO GO GET NEXT BLOCK * * BR.1 LDA OADDR UPDATE STARTING STA NLINK * BR.2 LDA RWRDS UPDATE WORDS COUNT ADA OWRDS STA RWRDS * BR.3 ADB DM1 SET POINTER BACK LDA SPNTR IF SPNTR NOT SET UP SZA,RSS STB SPNTR THEN SET IT * CLA XSA B,I CLEAR ENTRY (MAY BE SET LATER) INB RESET POINTER JMP BR.0 GO GET NEXT BLOCK * * PUT NEW ENTRY IN BLOCK * BR.4 LDB SPNTR SZB,RSS IF SPNTR NOT SET UP JMP BR.5 GO TO END * LDA RWRDS XSA B,I PUT IN WORDS INB LDA NLINK XSA B,I * JSB MXEV UPDATE MAXEV LDA P1,I LDB P2,I SJS $BRTX+0 BR.5 JSB $LIBX DEF $BRTN * * * NSAM RETRIEVES NEXT * BLOCK IN SAM * * CALLING SEQUENCE * * LDB PNTRA ADDRESS OF FREE LIST * JSB NSAM * . . . END OF LIST RETURN * . . . FOUND BLOCK RETURN * NSAM NOP NS.1 CLE,INB BUMP TO LINK STB LLINK ”øþúSAVE LAST LINK XLB B,I GET NEXT LINK CPB M7 IF 77777B THEN END OF FREE LIST JMP NSAM,I * XLA B,I GET LENGTH OF BLOCK STA SWRDS ADA RWRDS IS IT BIG ENOUGH? SSA JMP NS.1 NO GO GET NEXT * STB SADDR YES, SAVE ADDRESS LDA SWRDS ADA B COMPUTE LAST ADDRESS+1 ISZ NSAM ADJUST FOR NORMAL RETURN JMP NSAM,I * * * OSAM FINDS THE NEXT BLOCK * OF ORIGINAL SAM * * CALLING SEQUENCE: * * LDB ORGPT * JSB OSAM * . . . FINISHED SCANNING ORG STRUCTURE * . . . EMPTY ENTRY * . . . FOUND NEXT BLOCK * * OSAM NOP INB XLA B,I GET # OF WORDS IN BLOCK INB SSA IF NEGATIVE JMP OSAM,I THEN END OF TABLE (DONE) ISZ OSAM SZA,RSS IF ZERO THEN EMPTY JMP OSAM,I STA TEMP ADA MINBK IS IT SMALLER THAN ACCEPTABLE SSA,RSS BLOCK JMP OSAM,I NO REJECT * ISZ OSAM LDA TEMP STA OWRDS XLA B,I GET ADDRESS STA OADDR ADA OWRDS COMPUTE LAST ADDRESS+1 JMP OSAM,I * * * MMXEV POSTS THE NEW MAXEV * * CALLING SEQUENCE: * JSB MXEV * . . . A REG =MAXEV * MXEV NOP LDB ORGP CLA CLEAR MAXEV MXEV1 STA MAXEV XLA B,I GET LENGTH OF NEXT BLOCK ADB D2 BUMP BLOCK POINTER SSA IF LENGTH IS NEGATIVE JMP MXEV2 THEN AT END OF OSAM * ADA MAXEV SUBTRACT MAXEV FROM BLOCK LENGTH CMA,SSA,INA,RSS IF MAXEV>BLOCK LENGTH A REG IS POS * IF MAXEV>BLOCK LENGTH CLA THEN RESTORE MAXEV ADA MAXEV ELSE SET MAXEV TO BLOCK LENGTH JMP MXEV1 * MXEV2 LDA MAXEV GET BIGGEST XSA $MAXE,I COMPLIMENT AND STUFF CMA,INA MAKE POSITIVE zr$" JMP MXEV,I TEMP BSS 1 MAXEV BSS 1 * END :c$ÿÿ ÿýê õ ÿ92067-18312 2026 S C0122 &SMO1N SESSION MONITOR PT #1             H0101 ·KASMB,R,L * * NAME: SMON1 * SOURCE: 92067-18312 * RELOC: 92067-16260 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SMON1,0 92067-16260 REV.2026 800416 * * * * * * * * * * * * * * * END ÿÿ ÿýëñ ÿ92067-18313 2001 S C0122 &SMO2N SMON2 HEADER             H0101 IgASMB,R,L * * NAME: SMON2 * SOURCE: 92067-18313 * RELOC: 92067-16261 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SMON2,0 92067-16261 REV.2001 791029 * * * * * * * * * * * * * * * END åÿÿ ÿýìò ÿ92067-18314 2026 S C0122 &UTLIB UTLIB HEADER              H0101 `zASMB,R,L * * NAME: UTLIB * SOURCE: 92067-18314 * RELOC: 92067-16104 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM UTLIB,0 92067-16104 REV.2026 800501 * * * * * * * * * * * * * * * END è!ÿÿ ÿýíó ÿ92067-18315 2026 S C0622 &RT4GN GEN. MAIN              H0106 #þúASMB,Q,R,C HED RT4GN ---- MAIN FOR ON-LINE GENERATOR NAM RT4GN,3,90 92067-16315 REV.2026 800423 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************************ * * NAME: RT4GN * SOURCE PART #: 92067-18315 * REL PART #: 92067-16315 * WRITTEN BY: JJC, KFH, JH, RB, GAA * ************************************************************* SPC 2 * * * DEFINE ENTRY POINTS. * * OPERATOR INPUT SUBROUTINES: * ENT \PRMT PRINT COMMAND AND ACCEPT INPUT. ENT \READ \READ INPUT. ENT \RNME SPECIAL ENTRY TO READ SUBR. ENT \YENO ANALYZE YES/NO RESPONSE. ENT \DCON ANALYZE INPUT FOR OCTAL VALUE. ENT \GETC SUPPLY CHAR FOR GETNA & GETOC. ENT \GETN MOVE LBUF TO TBUF. ENT \GET# LBUF CHAR FROM ASCII TO OCTAL. ENT \GINT INITIALIZE LBUF SCAN. * * DIAGNOSTIC SUBROUTINES: * ENT \GNER PRINT DIAGNOSTIC. ENT \INER CALL ERROR AND CONTINUE. ENT \IRER CALL ERROR AND ABORT. ENT \ABOR \ABOR THE GENERATION. * * DISC FILE I/O SUBROUTINES: * ENT \CRET CREATE A FILE. ENT \CLOS CLOSE A FILE. ENT \TRUN CLOSE RTGEN OUTPUT FILE. ENT \CFIL CHECK FOR FILE ERRORS. ENT \MESS WRITE ON INTERACTIVE DEVICE. ENT \SPAC OUTPUT BLANK LINE. ENT \RNAM FIND A NAM RECORD IN A FILE. ENT \RBIN READ RELOCATABLE FILE. ENT \TERM PURGE ALL FILES ON ABORT. ENT \EXIT FINAL FILE Cn&þúLEANUP * * CORE-IMAGE OUTPUT FILE SUBROUTINES. * ENT \DSKA INCR. DISC ADDRESS. ENT \DSKI INPUT CONTROL. ENT \DSKO OUTPUT CONTROL. ENT \DSKD I/O SUBROUTINE. * * DCB'S: * ENT \RDCB RELOCATABLE FILE DCB. ENT \NDCB NEW-NAM FILE DCB. ENT \BDCB BOOT DCB * * LST, IDENT, FIX-UP SUBS AND POINTERS. * ENT \ILST,\LSTS,\LSTX,\LSTE ENT \TLST,\PLST ENT \LST1,\LST2,\LST3,\LST4,\LST5 * ENT \INID,\IDXS,\IDX ENT \TIDN,\PIDN ENT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 ENT \ID12,\ID13,\ID14,\ID15,\ID16 * ENT \IFIX,\FIX,\PFIX,\TFIX ENT \FIX1,\FIX2,\FIX3,\FIX4 * ENT \LNKX,\LNK,\LNKS ENT \LNK1,\LNK2,\LNK3 * * LINKAGES FOR SEGMENT SUBR CALLS TO ANOTHER SEGMENT. * ENT \LODN LOADS A PROGRAM ENT \DPLD LOADS A DRIVER EXT \NLOD (RT4G4) * ENT \GNIO BUILDS I-O TABLES EXT \IOTB (RT4G5) * EXT \GENS BUILDS THE SYSTEM (RT4G3) * EXT \TB31 BUILDS $TB31 (RT4G1) EXT \TB32 BUILDS $TB32 (RT4G7) * ENT \FSEC CLEAN-UP BOOT EXTENSION AND HEADER RECORDS EXT \FSC0 (RT4G1) EXT \FSC5 (RT4G7) * ENT \SYTB BUILDS SYSTEM TABLES EXT \TBLS (RT4G5) * ENT \CLDP LOADS DRIVER PARTITIONS ENT \DDON EXT \\LDP (RT4G8) * ENT \PART PARTITION DEFINITION EXT \PDEF (RT4G6) * * POINTERS FOR CURRENT PAGE LINKAGE IMAGE AREA. * ENT \TBLK,\CPLM ENT \LRBP,\URBP,\IRBP ENT \CUBP,\UCBP,\ICBP,\CBPA * * MISCELLANEOUS SUBROUTINES: * ENT \CONV ENT \ABDO,\USER,\USRS,\SEGS,\SYS,\DSYS ENT \MTCH * * MISCELLANEOUS VARIABLES: * ENT \NAMN,\NAMB,\NAMO ENT \TRCM,\IACM,\TRCH ENT \SRET ENT \FMRR ENT \DPR2 ENT \BPAR ßþú ENT \OCTN ENT \BUFL ENT \TCHR ENT \ADSK,\PREL,\NUMP ENT \ADBF ENT \MRT2 ENT \PTYP ENT \TMSK ENT \RNT,\PRV ENT \TBCH,\PIOC,\SWPF ENT \LBUF,\TBUF ENT \CURL,\CPL2 ENT \CMFL ENT \ABCO,\MXAB ENT \OLDA ENT \ADBP,\NABP ENT \OBUF ENT \TIME,\TIM1,\MULR ENT \CPLB,\ASKY,\SSID,\SKYA ENT \SCTK ENT \MDTB,\IBI * SKP * * DEFINE EXTERNALS * EXT \PIP,LURQ,RMPAR,IFBRK EXT WRITF,EXEC,CLOSE EXT LOCF,APOSN EXT CREAT,OPEN,READF,CNUMD EXT .ENTR EXT COR.A,\DST0,\BOT0 EXT GETST EXT \DST5,\BOT5 EXT $BMON EXT $OPSY VARIABLE TO GET OP SYSTEM TYPE EXT FTIME SYSTEM ROUTINE TO GET TIME OF DAY EXT SEGLD SEGMENT SWAPPER * SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SPC 3 LST#T DEC 2 # LST TRACKS. IDT#T DEC 3 # IDENT TRACKS. FIX#T DEC 1 # FIX-UP TRACKS. SECWD DEC 128 # WORDS PER SECTOR. SKP * IDENT FORMAT * * WORD 1: \ID1 - NAME 1,2 * WORD 2: \ID2 - NAME 3,4 * WORD 3: \ID3 - (15-8) NAME 5 * (7-3) NOT USED * (2-0) USAGE FLAG * (2) MODULE WAS LOADED AS PART OF A SEGMENT * (1) MUST LOAD MODULE (EXT DEFINED BY IT) * (0) MODULE WAS LOADED * WORD 4: \ID4 - (15) MAIN PROGRAM * (14-0) COMMON LENGTH * WORD 5: \ID5 - (15) BASE/CURRENT PAGE LINKING FLAG * (14) NEW NAM RECORD FLAG * (13-4) EMA SIZE * (3-0) MAP OPTIONS * (2) LINKS * (1) MODULES * (0) GLOBALS * WORD 6: \ID6 - (15) EMA DECLARED * (14-10) MSEG SIZE * (9-8) NOT USED * oåþú (7) DON'T DUPLICATE FLAG * (6-0) PROGRAM TYPE * (4) SSGA DECLARED * (3) REVERSE COMMON DECLARED * WORD 7: \ID7 - LOWEST DBL ADDRESS * WORD 8: \ID8 - DISK LENGTH FOR UTILITY RELOCATABLES * OR MAIN IDENT INDEX FOR SEGMENTS * OR (15-8) PROGRAM PAGE REQMTS * (7-0) KEYWORD INDEX * OR (15) EQT DEFINED * (14) SDA DECLARED * (13) SDA/OWN MAPPING DECLARED * (13-0) DRIVER LENGTH * WORD 9: \ID9 - FILE NAME 1,2 * WORD 10: \ID10 - FILE NAME 3,4 * WORD 11: \ID11 - FILE NAME 5,6 * WORD 12: \ID12 - SECURITY CODE * WORD 13: \ID13 - CARTRIDGE LABEL * WORD 14: \ID14 - RECORD NUMBER * WORD 15: \ID15 - RELATIVE BLOCK * WORD 16: \ID16 - BLOCK OFFSET * SKP * * LST FORMAT * * WORD 1: \LST1 - NAME 1,2 * WORD 2: \LST2 - NAME 3,4 * WORD 3: \LST3 - NAME 5, ORDINAL * WORD 4: \LST4 - IDENT INDEX OR 2 IF COMMON * 3 IF ABSOLUTE * 4 IF REPLACE * 5 IF UNDEFINED * 6 IF EMA * WORD 5: \LST5 - SYMBOL VALUE, OR IDENT INDEX IF EMA * * * * FIXUP TABLE FORMAT * * \FIX1: CORE ADDRESS * \FIX2: (15-11) INSTRUCTION CODE * (10) BYTE INSTR * (9) UPPER BP LINK * (2-0) DBL RECORD TYPE * \FIX3: OFFSET * \FIX4: INDEX OF LST ENTRY REFERENCED, * OR 0 IF A LOCAL SYMBOL * OR -1 IF .ZRNT * * * * * PROGRAM TYPES * * * ADD 128 TO PROGRAM TYPE TO INDICATE "DON'T COPY". * * 0: SYSTEM * 1: MEMORY RESIDENT * 2: RT DISK RESIDENT * 3: BG DISK RESIDENT * 4: ENLARGED BG DISK RESIDENT * 5: BG SEGMENT * 6: LIBRARY/UTILITY * 7: UTILITY * 8: UTILITY LOAD ONLY TO SATISFY EXTERNAL REFERENCES. * 9: MEMORY RESIDENT USING BACKGROUND COMMON. ýÈþú* 10: RT DISC RESIDENT USING BACKGROUND COMMON. * 11: BG DISC RESIDENT USING FORGROUND COMMON. * 12: ENLARGED BG DISC RESIDENT USING REALTIME COMMON * 13: TABLE AREA II * 14: TYPE 6 LIBRARY/UTILITY THAT IS TO BE FOURCE LOADED TO THE LIBRARY. * 15: TABLE AREA I * 30: SUBSYSTEM GLOBAL MODULE * 17,18,19,20,25,26,27,28: TYPES 1,2,3,4,9,10,11,12 (RESP) W/SSGA ACCESS * 21-24,29,31-99:UNUSED (TYPE + 80 IS USED TO * DESIGNATE AUTO SCHEDULE AT STARTUP, BUT MAY * ONLY BE ENTERED IN PARM PHASE. +80 IS JUST * A FLAG TO PARM PHASE, NOT STORED IN ID-SEG.) SKP * * ERROR CODES * * 0/ HARDWARE/GENERATOR ERROR (SEND IN BUG REPORT) * 1: INVALID REPLY TO INITIALIZATION PARAMETERS * 2: INSUFFICIENT AMOUNT OF AVAILABLE MEMORY FOR TABLES * 3: RECORD OUT OF SEQUENCE * 4: INVALID RECORD TYPE * 5: DUPLICATE ENTRY POINTS * 6: COMMAND ERROR - PROGRAM INPUT PHASE * 7: LST,IDENT,FIXUP TABLE OVERFLOW * 8: DUPLICATE PROGRAM NAMES * 9: PARAMETER NAME ERROR * * 10: PARAMETER TYPE ERROR * 11: PARAMETER PRIORITY ERROR * 12: PARAMETER EXECUTION INTERVAL ERROR * 13: BG SEGMENT PRECEDES BG DISC RESIDENT * 14: CHECKSUM ERROR * 15: ILLEGAL CALL BY A TYPE 6 OR 14 PROGRAM TO A TYPE 7 * 16: BP LINKAGE AREA OVERFLOW * 17: TYPE 1 OUTPUT FILE OVERFLOW (ESTIMATE WAS NOT LARGE ENOUGH) * 18: MEMORY OVERFLOW * 19: TR STACK UNDERFLOW/OVERFLOW * * 20: INVALID COMMAND INPUT LU * 21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE * 22: LIST FILE ERROR * 23: INVALID S OR M OPERANDS * 24: INVALID SELECT CODE IN EQT ENTRY * 25: INVALID DRIVER NAME IN EQT ENTRY * 26: INVALID D,B,U,T,X,S,M OPERANDS IN EQT ENTRY * 27: INVALID DEVICE REFERENCE NO. * 28: INVALID INTERRUPT SELECT CODE * 29: INVALID INTERRUPT SELECT CODE ORDER * * 30: INVALID INT ENTRY MNEMONIC * 31: INVALID EQT NO. IN INT ENTRY * 32: INVALID PROGRAM NAME IN INT ENTRY * 33: INVALID ENTRY POINT IN INT ENTRY * 34: INVALID ABSOLUTE VALUE IN INT ENTRY œþú* 35: MORE THAN 63 EQT OR 255 DRT ENTRIES DEFINED * 36: INVALID TERMINATING OPERAND IN INT ENTRY * 37: INVALID COMMON LENGTH IN SYS, LIB, OR SSGA MODULE..... * 38: ID-SEGMENT OF SEGMENT 3 NOT FOUND * 39: NOT USED * * 40: INVALID EMA PROGRAM TYPE * 41: MULTIPLE EMA DECLARATIONS * 42: INVALID REFERENCE TO EMA SYMBOL * 43: INVALID MSEG SIZE * 44: SAM EXCEEDS 32K LOGICAL ADDRESS SPACE * 45: INVALID PARTITION SIZE * 46: INVALID PARTITION TYPE * 47: INVALID PARTITION RESERVATION * 48: INVALID OR UNKNOWN ASSIGNED PROGRAM NAME * 49: INVALID PARTITION NUMBER * * 50: PROGRAM TOO LARGE FOR PARTITION SPECIFIED * 51: INVALID PAGE OVERRIDE SIZE * 52: ILLEGAL REFERENCE TO SSGA ENTRY POINT * 53: SUM OF PARTITION SIZES DOESN'T EQUAL # PAGES LEFT * 54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN * 55: PAGE REQ'MTS OF EMA PROGRAM CAN'T BE OVERRIDDEN * 56: SUBPARTITION SIZE OR SUM OF SIZES > THAN MOTHER PART'N SIZE * 57: MISSING SYSTEM ENTRY POINT * 58: ILLEGAL REF TO TYPE 0 SYSTEM ENTRY POINT BY NON-TYPE 3 MODULE * 59: DRIVER PARTITION OVERFLOW * * 60: LONG ID SEGMENT LIMIT OF 254 EXCEEDED * 61: PHYSICAL MEMORY OVERFLOW * 62: INVALID INSTRUCTION REFERENCE TO AN EMA SYMBOL SKP DBP EQU * FWA DUMMY BASE PAGE. * ************************************************ * * * THE NEXT 1K IS OVERLAID FOR DUMMY BASE PAGE * * WHEN RT4G3 BEGINS EXECUTION. * * * ************************************************ SPC 5 START NOP STB PARS5 JSB RMPAR DEF *+2 DEF PARS5 * * * SET UP COMMAND LU OR FILE, AND THE ERRLU * LDA PARS5 GET PARAMETER 1 SZA,RSS IF NOT SPECIFIED, THEN ISZ PARS5 DEFAULT TO LU 1 FOR INPUT AND B1774 MASK FOR TYPE SZA,RSS NUMERIC? JMP NOPRM YES, GO SET UP CMDLU * JSB GETST RETRIEVE P þúARAMETERS DEF *+4 DLBUF DEF \LBUF DEF P48 DEF \FMRR * RBL CONVERT TO CHARACTERS LDA DLBUF GET INPTU BUFFER ADDRESS JSB \PARS GO PARSE THE PARAMETER STRING DEF PARS2 INTO THE PARSE BUFFER AT WORD 2 JMP STRT2 * NOPRM LDB PARS5 SET UP THE COMMAND LU STB PRS21 CLA,INA STA PARS2 PARAMETER TYPE 1 * STRT2 LDA RWSUB GET POTENTIAL R/W SUBFUCTION STA PARS5 SAVE FOR OPEN CALL * JSB STATE SET THE STATE FLAGS \IACM & CMDLU JMP INVLU INVALID INPUT LU SPECIFIED - GO RECOVER LDA CMDLU IF AN INTERACTIVE LU, SET THE LDB \IACM 1 MEANS INTERACTIVE SZB,RSS CLA,INA DEFAULT TO LU 1 STA ERRLU ERROR LU * JSB FOPEN GO OPEN FILE DEF *+3 DEF \IDCB DEF PARS5 LDA \FMRR SSA,RSS ANY ERRORS? JMP STRT3 NO CMA,INA SET POS. FOR CONVERT STA \FMRR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF \FMRR DEF FERMA ERROR MESSAGE ADDR LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 LDA DNAM MOVE THE FILE NAME LDB DFILE MVW P3 * JSB EXEC SEND ERROR TO OPERATOR LU DEF *+5 DEF P2 DEF ERRLU DEF FILEA+1 DEF P10 STRT4 CLB SET BACK TO LU 1 STB CMDLU STB \IACM INB STB ERRLU JMP NOPRM+1 START OVER * INVLU JSB EXEC INVALID INPUT LU SPECIFIED DEF *+5 ISSUE ERROR MESSAGE TO LU 1 (NOW DEF P2 DEFAULT ERRLU) DEF P1 DEF GNR20 DEF P5 JMP STRT4 SET UP THE INPUT LU * STRT3 CLA JSB PUSH GO PLACE ON STACK JSB \TERM ERROR RETURN - CAN'T HAPPEN! * LDA ERRLU WE'RE GOING TO OVERLAY 3 WORDS CMA,INA LDB DSTRT AT STRT3 - IN ORDER TO SETUP JSB \CONV ݘþú THE ERROR COMMAND: LDA STRT3+2 "TR,ERRLU" STA TRCOM+2 STORE THE ASCII LU * LDA \CPLM NEGATE HIGH END OF CURRENT CMA,INA PAGE LINK LIMIT IMAGE STA \CPLM AREA * * SET UP SYSTEM TYPE WORD * LDA $OPSY ERA STA STYPE SKP * ALLOCATE SPACE FOR FIX-UP,IDENT, AND LST TABLES: * * DETERMINE HOW MUCH CORE REMAINS BEYOND LONGEST * SEGMENT, DIVIDE INTO 3 BLOCKS FOR IN-CORE CHUNKS * OF TABLES, AND ALLOCATE DISC SPACE FOR TABLE STORAGE. * AVAILABLE CORE MUST BE AT LEAST 512 WORDS. * THE LST IS ALLOCATED LAST TO USE WASTED CORE FROM * FIXUP & IDENT BLOCKS. * LDA 1657B ADDR OF KEYWORD TABLE. STA TEMP1 TRY LDB TEMP1 JSB \LDAX LOAD A THRU B,I WITH XLA IF NEEDED LDB A SZB END OF TABLE IF ZERO JMP TRYY LDA ERR38 SEGMENT 3'S ID SEGMENT IS MISSING JMP NROOM+1 SEND ERROR & TERMINATE * TRYY ADB P12 GET TO NAME. JSB \LDAX LDA B,I WITH XMAP LOAD IF NEEDED * * DYNAMICALLY DETERMINE LONGEST SEGMENT * CPA AS.RT "RT4G3" = LONGEST SEGMENT. RSS MATCH. JMP NEXT INB JSB \LDAX LDA B,I WITH XMAP LOAD IF NEEDED CPA AS.GN RSS MATCH. JMP NEXT INB JSB \LDAX LDA B,I WITH XMAP LOAD IF NEEDED AND M7400 CPA AS.3 "3". JMP MATCH NEXT ISZ TEMP1 JMP TRY * MATCH LDB TEMP1 GET ADDR JSB \LDAX OF ID SEGMENT JSB COR.A GET TO LWAM OF SEGMENT. INA GET FWAM. STA FWAM SAVE AS FIRST WORD AVAIL. MEM. CMA,INA GET SIZE OF UNDECLARED CORE. ADA LWAM LWAM SET BY RTE. STA NEXT LDA N512 MAKE SURE ENOUGH CORE. ADA NEXT AT LEAST 512 WORDS WORTH SSA JMP NROOM NO ROOM. BAIL OUT. LDA NEXT CLB DIV P4 ALLOCATE AVAILABLE MEMORY: ´pþú STA TEMP1 1/4 TH FOR FIXUP TABLE, AND CMA,INA 3/8 TH'S EACH FOR IDENT AND LST ADA NEXT ARS DIVIDE BY 2 STA TEMP2 * ALLOCATE DISC SPACE FOR FIX-UP, IDENT, LST. * LDA FIX#T GET # FIX-UP TRACKS, ADA IDT#T ADD # IDENT TRACKS, ADA LST#T ADD # LST TRACKS. IOR MSIGN SET NO SUSPEND BIT STA NEXT TOTAL # TRACKS TO ALLOCATE. * GETTR JSB EXEC DEF *+6 DEF P4 DEF NEXT # TRACKS REQUESTED. DEF FTRKA RETURNED: FIRST TRACK. DEF DSKLU RETURNED: WHICH DISC. DEF SECTK RETURNED: SECTORS/TRACK. * LDA FTRKA GET FIRST TRACK # SSA,RSS REQUEST GRANTED? JMP SETUP YES JSB \SPAC JSB EXEC NO, TELL USER OF PROBLEM DEF *+5 DEF P2 DEF ERRLU DEF TRMSG DEF P14 "GENERATOR WAITING FOR TRACKS" * LDA NEXT TAKE OUT NO-SUSPEND BIT XOR MSIGN STA NEXT SUSPEND UNTIL TRACKS ARE AVAILABLE JMP GETTR * * * SET UP FIX-UP TABLE. * SETUP LDA SECTK GET SECTORS PER TRACK, SYS DISC MPY P64 CALC WORDS/TRACK STA WDTK LDA TEMP1 CLB TRUNCATE BLOCK SIZE DIV WDTK IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB WDTK TO ONE TRACK STB A SETF0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA FX.#S SAVE # SECT PER FIX-UP BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH. STA LFIX OF DISC READS AND WRITES. CLB BLOCK MULTIPLE MUST END ON A TRACK LDA WDTK BOUNDARY AS WELL DIV LFIX SZB,RSS JMP SETF1 OK LDA LFIX ADA N128 DECREMENT SIZE BY ONE SECTOR JMP SETF0 SETF1 LDA LFIX CLB GET # 4 WORD ENTRIES IN DIV P4 THE BLOCK. STA EFIX SAVE # ENTRIES IN BLOCK. * LDA FWAM INITIALIZE FIX-UP PONþúINTERS: STA BFIX FIRST ENTRY, CLA STA \PFIX # ENTRIES USED, STA \TFIX CURRENT ENTRY INDEX. STA B.F 1ST ENTRY NOW IN CORE. * * SET UP IDENT TABLE. THIS ONE HAS AN OFFSET OF +10. * LDA BFIX SET FWA IDENT AREA AT ADA LFIX STA BIDNT END OF FIX-UP AREA. LDA TEMP2 GET BLOCK CLB TRUNCATE BLOCK SIZE DIV WDTK IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB WDTK TO ONE TRACK STB A SETI0 CLB DIV SECWD SEE HOW MANY SECTORS FIT STA ID.#S MPY SECWD CONVERT TO WORDS FOR LENGTH STA LIDNT CLB BLOCK MULTIPLE MUST END ON LDA WDTK TRACK BOUNDARY AS WELL DIV LIDNT SZB,RSS JMP SETI1 OK LDA LIDNT DECREMENT BLOCK ADA N128 SIZE BY ONE SECTOR JMP SETI0 SETI1 LDA LIDNT CLB GET # 16 WORD ENTRIES IN DIV P16 THE BLOCK. STA EIDNT SAVE # ENTRIES IN BLOCK. * LDA P10 INITIALIZE IDENT POINTERS: STA \PIDN # ENTRIES USED +10, STA \TIDN CURRENT ENTRY INDEX, STA B.I 1ST ENTRY INDEX NOW IN CORE. * * SET UP LOADER SYMBOL TABLE (LST). * LDA BIDNT SET FWA LST AREA AT END ADA LIDNT STA BLST OF IDENT AREA. CMA,INA USE ALL OF REMAINING ADA LWAM AVAILABLE MEMORY. CLB TRUNCATE BLOCK SIZE DIV WDTK IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB WDTK TO ONE TRACK STB A SETL0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA LS.#S SAVE # SECT PER LST BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH STA LLST OF DISC READS AND WRITES. CLB LDA WDTK BLOCK MULTIPLE DIV LLST MUST END ON TRACK SZB,RSS BOUNDARY AS WELL JMP SETL1 LDA LLST ADA N128 ©³B@< DECREMENT BY ONE SECTOR JMP SETL0 SETL1 LDA LLST CLB GET # 5 WORD ENTRIES IN DIV P5 THE BLOCK. STA ELST SAVE # ENTRIES. * CLA INITIALIZE LST POINTERS: STA \PLST # ENTRIES USED, STA \TLST CURRENT ENTRY INDEX, STA B.L 1ST ENTRY NOW IN CORE. SKP * ALLOC LDA FX.#S GET # 128 WORD SECTORS. CLE,ELA MPY BY 2 (64 WORD SECTORS). CLB DIV SECTK FIND MULT. FACTOR PER WRITE. SZB,RSS IF A TRACK MULTIPLE LDB SECTK THEN SET IT SO STB FX.#S # 64 WORD SECTORS PER BLOCK. * LDA ID.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB SECTK STB ID.#S * LDA LS.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB SECTK STB LS.#S * LDA FTRKA STA FX.BT FIX-UP START TRACK. STA FX.LT FIX-UP TRACK LAST READ. ADA FIX#T STA FX.ET FIX-UP LAST TRACK +1. STA ID.BT IDENT START TRACK. STA ID.LT IDENT TRACK LAST READ. ADA IDT#T STA ID.ET IDENT LAST TRACK +1. STA LS.BT LST START TRACK. STA LS.LT LST TRACK LAST READ. ADA LST#T STA LS.ET LST LAST TRACK +1. CLA STA FX.LS STA ID.LS STA LS.LS ½åBÿÿþú SKP * * GET NAME, SECUR, LABEL OF LIST FILE. * RSS SKIP ERROR CALL LSTER JSB \INER BAD LIST FILE SPEC'D FNAME LDA P16 PRINT: "LIST FILE NAMR?" LDB LSTFI JSB \RNME GET LIST FILE LDB P64 DEFAULT LIST FILE SIZE. LDA PARS6+1 CHECK IF USER SPECIFIED SIZE. SZA,RSS SKIP IF SPECIFIED STB PARS6+1 ELSE STUFF DEFAULT SIZE. SSA CHECK IF SIZE < 0 JMP LSTER YES..SEND GEN ERR 01 * JSB \CRET GO CREATE THE FILE DEF *+5 DEF \LDCB DEF PARS6+1 DEF P3 DEF ZERO CLA JSB \CFIL CHECK FILE STATUS JMP FNAME ERROR ISZ LFERR 1=> ACKNOWLEDGE LIST FILE ERRORS * DLD PARS2 WAS NAME A FILE OR LU? CPA P1 RSS JMP FLNM0 FILE NAME, SO DEFAULT TO LSTLU=0 STB LSTLU SAVE THE LU - MAY NOT BE INTERACTIVE JSB EXEC DETERMINE THE DEVICE TYPE DEF *+6 DEF P13 DEF LSTLU DEF EQT5 DEF FNAME DEF ALLOC * CLB LDA FNAME IF BIT BUCKET WAS SPECIFIED, AND M77 DON'T MISTAKE IT FOR A TYPE SZA,RSS 00 DEVICE JMP SETIA * LDB LSTLU LDA EQT5 INTERACTIVE DEVICES ARE TYPE 0, OR ALF,ALF TYPE 5, SUBCHANNEL 0 AND M77 STA EQT5 CPA P7 IF A TYPE 7 DEVICE, THEN IT IS CLA AUTOMATICALLY INTERACTIVE CPA P5 LDA ALLOC GET TYPE 5 SUBCHANNEL AND M77 CLB SZA,RSS INB SET INTERACTIVE SETIA STB IALST 0=NOT INTERACTIVE, 1=IT IS * SZB IF ITS INTERACTIVE JMP EC? THEN DON'T LOCK LULOC JSB LURQ DEF *+4 DEF IOPTN DEF LSTLU DEF P1 * SZA,RSS WAS IT SUCCESSFUL? JMP EC? YES JSB \SPAC JSB EXEC DEF *+5 DEF P2 DEF ERRLU ê9þú DEF LUMSG DEF P17 "GENERATOR WAITING ON LIST LU LOCK" * LDA IOPTN SET THE WAIT BIT FOR NEXT CALL XOR MSIGN STA IOPTN JMP LULOC * * RE-OPEN THE LIST FILE WITH A NON-EXCLUSIVE OPEN SO IT CAN * BE EXAMINED CONCURRENT WITH GENERATION * FLNM0 JSB OPEN A CALL TO OPEN AN ALREADY DEF *+7 OPEN FILE WILL RESULT DLDCB DEF \LDCB IN IT BEING CLOSED AND DEF \FMRR RE-OPENED WITH THE OPTIONS DEF PARS2+1 DEF P1 DEF PARS3+1 DEF PARS4+1 LDA DLDCB GET DCB ADDRESS JSB \CFIL CHECK ERROR STATUS JMP FLNM0 * * SEND THE GENERATOR MODEL # AND THE TIME OF DAY * JSB FTIME GET THE TIME OF DAY DEF *+2 DEF HTIME PUT THE ASCII HERE * JSB \SPAC LDA P62 LDB HIMSG ADDR OF THE MESSAGE BUFFER JSB \MESS JSB \SPAC * * * ASK WHETHER ECHO IS DESIRED * AND OPEN IT IF SO * EC? LDA P5 LDB ECHOI JSB YE?NO JMP EC? INVALID REPLY STA ECHON 1 FOR YES, 0 FOR NO * CLA,INA SET UP FOR CREATION STA PARS2 OF DUMMY DCB IN TYP0 LDA ERRLU STA PARS2+1 LU ALREADY DETERMINED JSB FOPEN DEF *+3 DEF \EDCB DEF RWSUB * JSB \CFIL JSB \TERM JMP FLNAM SKIP IF NO ERROR. * * GET CORE-IMAGE RTE OUTPUT FILE NAMR (REQUIRE SIZE SUBPARAM ALSO). * SMLER LDA ERR17 ERROR: OUT FILE SIZE TOO SMALL JSB \GNER RSS * JSB \INER INPUT ERROR. FLNAM JSB \SPAC LDA P17 LDB OUTFI PRINT: "OUTPUT FILE NAMR?" .. JSB \RNME AND GET NAMR. LDA PARS2 GET TYPE OF FILE NAME PARAMETER. CPA P2 MUST BE ASCII FILE NAME (NOT A LU). RSS JMP FLNAM-1 INPUT ERROR- ASK AGAIN. LDA PARS6 GET TYPE OF SIZE SUBPARAM. CPA P1 MAKE SURE IT'S NUMERIC. RSS Rqþú OK- IT'S NUMERIC. JMP SMLER ERROR- IT WAS NULL OR ASCII. LDA PARS6+1 GET SIZE OF FILE. ADA N1000 >= THE 1000 BLOCK MINIMUM?? SSA  JMP SMLER NO- INPUT ERROR. * FLNMC JSB \CRET GO CREATE THE OUTPUT FILE DEF *+5 DEF ABDCB DEF PARS6+1 # BLOCKS. DEF P1 TYPE 1 FILE. DEF ZERO CLA JSB \CFIL CHECK FILE ERROR JMP FLNAM RETRY...ERROR * * GET SYSTEM DISK TYPE * JSB \SPAC RSS JSB \INER INPUT ERROR TO "SYSTEM DISK MODEL?" STRT0 LDA P18 TO GET THE INITIAL SEGMENT LDB MES00 DEPENDS ON THE DISK MODEL JSB \READ MES00: "SYSTEM DISK MODEL?" LDA N6 JSB \GETN GET 6 CHARS IN \TBUF * * GET DISK SPECIFICATIONS FROM MODEL TABLE * JSB \MTCH CALL TABLE SEARCH ROUTINE-MATCH MODEL # DEF *+6 DEF \MDTB ADDRESS OF TABLE DEF \TBUF KEY TO MATCH DEC 9 DEPTH OF SEARCH IN TABLE- 9 VALID DISCS DEC 3 KEY LENGTH (WORDS) DEC 5 ENTRY LENGTH (WORDS) JMP STRT0-1 RETURN PT. FOR INVALID DISK MODEL * ADA P3 NORMAL RETURN PT.-VALID DISK MODEL LDB A,I INDEX INTO TABLE ENTRY FOR SEC TRK STB \SCTK SAVE IT INA LDB A,I GET SYS DISC TYPE FROM DISC MODEL TABLE STB DTYP SAVE IT AWAY * CLA STA \IBI SET HPIB SYS DISC FLAG = 0 SSB IS THIS AN HPIB SYS DISC?? ISZ \IBI YES- SET \IBI = 1 SLB,RSS WANT SEGMENT 7?? (TYPE 32 DISC) JMP STRT5 YES * JSB SWAP SWAP IN SEGMENT 1 FOR 7900 DEC 1 DISK DEPENDENT SUBROUTINES JMP .NM * STRT5 JSB SWAP SWAP IN SEGMENT 7 FOR 7905 DEC 7 DISK DEPENDENT SUBROUTINES * * CREATE TEMPORARY FILE FOR MODIFIED NAM RECORDS. * .NM JSB CREAT CREATE @.NM.@ FILE NAME. DEF *+6 DNDCB DEF \NDCB Lãþú DEF \FMRR A\.NM DEF \.NM. DEF P64 DEF P5 * LDA \FMRR DUPLICATE NAME? CPA N2 RSS YES JMP .NMCH CHECK FOR OTHER ERRORS * ISZ NAMM BUMP TO NEXT SYMBOL JMP .NM AND TRY TO CREATE IT * .NMCH LDA A\.NM MOVE NAME TO PARSE BUFFER LDB DNAM PARSE BUFF DESTINATION MVW P3 MOVE FILE NAME CLA SIGNAL OPEN/CREATE FOR CFIL JSB \CFIL OTHER ERRORS JSB \TERM YES, SO ABORT SKP * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * * TBG SELECT CODE? ENTER 2 OCTAL DIGITS * * PRIV. INT. SELECT CODE? ENTER 2 OCTAL DIGITS * * MEM.RES. ACCESS TABLE AREA II? ENTER YES OR NO * * RT MEMORY LOCK? ENTER YES OR NO * * BG MEMORY LOCK? ENTER YES OR NO * * SWAP DELAY? ENTER <= 3 DECIMAL DIGITS * * MEM SIZE? ENTER <= 4 DECIMAL DIGITS * * JSB \SPAC GET A NEW LDA \ADBP GET ADDRSS OF DUMMY BASE PAGE CMA,INA MAKE NEG STA \NABP SAVE * LDB D$REN ENTER .ZRNT IN THE LST JSB \LSTE LDA RSS SET IT UP AS STA \LST5,I A REPLACE WITH RSS LDA P4 STA \LST4,I ENT CLA STA \RNT INDEX IS 0 * LDB D$PRV DO SAME FOR .ZPRV JSB \LSTE LDA P4 STA \LST4,I LDA RSS STA \LST5,I CLA,INA STA \PRV SET FLAG FOR LOAD PHASE * LDB D$CLS ENTER $CLAS INTO JSB \LSTE THE SYMBOL TABLE LDB D$LUS NOW ENTER $LUSW JSB \LSTE LDB D$RNT AND $RNTB JSB \LSTE LDB $LUAV AND $LUAV JSB \LSTE * LDB DTYP SET UP THE DISC SPECIFICATIONS. SLB,RS(gþúS SEGMENT #7? JMP SPEC5 ..YES JSB \DST0 ..NO - 7900 RSS RSS * SPEC5 JSB \DST5 7905 * * SET TIME BASE GENERATOR CHANNEL * JSB \SPAC NEW LINE CHNLT LDA P16 LDB MES30 MES30 = ADDR: TBG SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA \TBCH SET TBG CHANNEL NO. CLE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP CHNLT TRY AGAI N * * GET PRIV. INT. CARD ADDR. * JSB \SPAC NEW LINE DUMY LDA P23 LDB MES41 MES41 = ADDR: PRIV. INT. SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS JMP DUMY -ERROR, REPEAT INPUT. STA \PIOC SET ADDRESS OF DUMMY CARD CCE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP DUMY LDA P3 SET BOTH RT AND STA \SWPF BG SWAP FLAGS ALWAYS. SPC 1 JSB \SPAC MAPC? LDA P31 ASK: MEM. RES. ACCESS TABLE AREA II? LDB MSMP. JSB YE?NO JMP MAPC? ASK AGAIN IF BAD ANSWER STA \MRT2 SAVE 1 IF YES, 0 IF NO LDA "RT" NOW ASK JSB LOCK? 'RT MEMORY LOCK?' RAL,RAL ROTATE TO PROPER BIT POSITION IOR \SWPF COMBINE STA \SWPF AND SAVE * LDA "BG" NOW DO SAME FOR BACKGROUND JSB LOCK? ALF,RAR IOR \SWPF COMBINE STA \SWPF SAVE THE WORD. * SWPDL JSB \SPAC LDA P11 GET THE LDB MES33 SWAP DELAY JSB \READ LDA N3 CONVERT JSB \DCON TO BINARY FROM DECIMAL JMP SWPDL ERROR TRY AGAIN * AND M7400 IF > 256 SZA,RSS THEN JMP SWPOK * JSB \INER BITCH AND JMP SW°þúPDL TRY AGAIN * SWPOK LDA \OCTN COMBINE ALF,ALF WITH SWAP IOR \SWPF FLAG STA \SWPF AND SAVE * JSB \SPAC SKIP A LINE MEMSZ LDA P9 THEN ASK USER LDB MESS3 FOR NUMBER OF PAGES JSB \READ OF MAIN MEMORY LDA N4 GET 4 DECIMAL JSB \DCON DIGITS OR TRY AGAIN JMP MEMSZ IF ERROR STA \NUMP * ADA N48 CHECK FOR THE 48-PAGE MINIMUM SSA,RSS JMP BOUT OK BDSZ JSB \INER FLAG ERROR JMP MEMSZ AND ASK AGAIN * BOUT ADA N977 NOW CHECK FOR 1024 PAGE MAX SSA,RSS JMP BDSZ TOO BIG, ISSUE ERROR & RETRY LDB DTYP FINISH THE DISC SET UP. SLB,RSS SEGMENT 7 TYPE DISK? JMP SET05 ..YES JSB \BOT0 ..NO - 7900 BOOT RSS * SET05 JSB \BOT5 7905 BOOT * JMP SEGCN * SKP * * CHECK FOR VALID SELECT CODE RESPONSE TO TBG OR PI QUERY * * ON ENTRY: E-REG = 0 IF 0 RESPONSE NOT ALLOWED, IE, FOR TBG * ON ENTRY: E-REG = 1 IF 0 RESPONSE ALLOWED FOR PI QUERY * TBPI? NOP SZA,RSS ZERO RESPONSE? JMP TBG? YES, CHECK FOR VALIDITY * ADA N8 MUST BE >= 10 OCTAL SSA JMP TBRR NOPE * TBXT ISZ TBPI? JMP TBPI?,I * TBG? SEZ TBG OR PI? JMP TBXT PI IS OKAY TBRR JSB \INER SORRY! JMP TBPI?,I SPC 3 * * NOT ENOUGH CORE BEYOND LONGEST SEGMENT * FOR LST, IDENT, FIXUP TABLES. * NROOM LDA ERR02 JSB \GNER JSB \TERM * ERR02 ASC 1,02 ERR38 ASC 1,38 SEGMENT 3'S ID-SEGMENT MISSING SKP * * OVERLAID CONSTANTS. * FWAM NOP CALCULATED AT RUNTIME LWAM EQU 1777B END OF CORE * N4 DEC -4 N5 DEC -5 N6 DEC -6 N48 DEC -48 N128 DEC -128 N512 DEC -512 N1000 DEC -1000 N977 DEC -977 P1 DEC 1 P9 DEC 9 P11 DEC 11 P16 DEC 16 P23 DEC 23 P1hiþú7 DEC 17 P48 DEC 48 P62 DEC 62 B1774 OCT 177400 MSIGN OCT 100000 IOPTN OCT 1 FTRKA NOP RWSUB OCT 400 "RT" ASC 1,RT "BG" ASC 1,BG AS.RT ASC 1,RT AS.GN ASC 1,4G AS.3 OCT 31400 LONGEST SEG = RT4G3. TEMP1 NOP TEMP2 NOP DSTRT DEF STRT3 * D$REN DEF *+1 ASC 3,.ZRNT D$PRV DEF *+1 ASC 3,.ZPRV D$CLS DEF *+1 ASC 3,$CLAS D$LUS DEF *+1 ASC 3,$LUSW D$RNT DEF *+1 ASC 3,$RNTB $LUAV DEF *+1 ASC 3,$LUAV * TRMSG ASC 14,GENERATOR WAITING FOR TRACKS LUMSG ASC 17,GENERATOR WAITING ON LIST LU LOCK MES00 DEF *+1 ASC 9,SYSTEM DISC MODEL? LSTFI DEF *+1 ASC 8,LIST FILE NAMR? OUTFI DEF *+1 ASC 9,OUTPUT FILE NAMR? ECHOI DEF *+1 ASC 3,ECHO? MES30 DEF *+1 ASC 8,TBG SELECT CODE? MES41 DEF *+1 ASC 12,PRIV. INT. SELECT CODE? MES32 DEF *+1 ASC 8,RT MEMORY LOCK? MES33 DEF *+1 ASC 6,SWAP DELAY? MESS3 DEF *+1 ASC 5,MEM SIZE? MSMP. DEF *+1 ASC 16,MEM. RES. ACCESS TABLE AREA II? * P31 DEC 31 GNR20 ASC 5,GEN ERR 20 HED RTGEN SUBROUTINES. SPC 5 * * * LOCK? ASKS AND ANALIZES THE 'XX MEMORY LOCK?' QUESTION. * * CALLING SEQUENCE: * * LDA "RT" OR "BG" * JSB LOCK? * RETURN A=1 IF YES, 0 IF NO. * * LOCK? NOP STA MES32,I SET THE 'FG' OF 'BG' IN MESSAGE JSB \SPAC MAKE IT LOOK NEAT. LOCK1 LDA P15 GET THE LENGTH LDB MES32 GET MESSAGE ADDRESS JSB YE?NO GO ASK AND GET ANSWER JMP LOCK1 ERROR SO RETRY * JMP LOCK?,I RETURN P15 DEC 15 SKP * YE?NO ROUTINE SENDS A QUESTION TO THE TTY * AND READS AND ANALIZES THE RESPONSE * * CALLING SEQUENCE: * * LDA MESSAGE CHARACTER COUNT * LDB MESSAGE ADDRESS * JSB YE?NO * JMP ERROR * NORMAL RETURN A=1 FOR YES, 0 FOR NO. * YE?NO NOP JSB \READ GO PRINT MESSAGE AND GET ANSWER JSB \YENO ANALIZE THE ANSWER ™Æþú JMP YE?NO,I ERROR EXIT * CLA,RSS NO RETURN CLA,INA YES RETURN ISZ YE?NO STEP RETURN ADDRESS JMP YE?NO,I RETURN TO CALLER. SKP * \LDAX ROUTINE DOES A LDA B,I USING A CROSS MAP LOAD * TO GET IN THE SYSTEM MAP, IF NECESSARY. * * CALLING SEQUENCE: * * LDB ADDR * JSB \LDAX * * RETURN: * * A = B,I * (P+1) * \LDAX NOP LDA STYPE GET SYSTEM TYPE SLA MAPPING NEEDED?? JMP MAPSY YES - DO XMAP LOAD LDA B,I NO - STANDARD LOAD JMP \LDAX,I * MAPSY XLA B,I JMP \LDAX,I SKP * \MTCH IS A GENERAL ROUTINE WHICH SEARCHES A USER SPECIFIED * TABLE FOR THE SPECIFIED KEY, AND RETURNS THE ADDRESS OF * THE MATCHING ENTRY IN THE A REGISTER. * *CALLING SEQUENCE: * * JSB \MTCH * DEF *+6 * DEF ADTBL * DEF ADKEY * DEF TBLEN * DEF KEYLN * DEF ENTLN * *NORMAL RETURN: (P+2) KEY FOUND, A = ADDR OF ENTRY CONTAINING THE KEY *ELSE RETURN: (P+1) KEY NOT FOUND, A = ADDR OF LAST ENTRY *A REGISTER=ADDRESS OF TABLE ENTRY CONTAINING THE KEY * ADTBL NOP ADDRESS OF TABLE TO BE SEARCHED ADKEY NOP ADDRESS OF KEY TBLEN NOP DEPTH OF SEARCH-(# OF ENTRIES) KEYLN NOP LENGTH OF KEY (WORDS) ENTLN NOP ENTRY LENGTH (WORDS) \MTCH NOP JSB .ENTR GET PARAMETERS DEF ADTBL LDA TBLEN CMA,INA STA TBLEN LOOP COUNTER #1 LDA ADTBL JMP BEGN FIRST TIME NXENT ISZ TBLEN FINISHED?.. RSS NO - BEGIN COMPARE JMP NOFND YES - KEY NOT FOUND LDA ADTBL ADA ENTLN ADVANCE TO NEXT ENTRY STA ADTBL BEGINNING OF CURRENT ENTRY BEGN STA TBPTR INIT WORD POINTER LDB ADKEY RESET KEY'S WORD POINTER LDA KEYLN CMA,INA STA L2CTR -# OF WORDS TO COMPARE NXCHR LDA TBPTR,I GET A TABLE WORD øGþúCPA B,I COMPARE TO KEY WORD. EQUAL??.. RSS ..YES- COMPARE NEXT WORD JMP NXENT ..NO- TRY NEXT TABLE ENTRY ISZ TBPTR GET READY TO COMPARE.. INB ..NEXT PAIR OF WORDS. ISZ L2CTR FINISHED WITH THIS ENTRY?? JMP NXCHR ..NO- COMPARE NEXT WORD MTCH LDA ADTBL ..YES-RETURN ADDR. OF CURRENT ENTRY IN A ISZ \MTCH SET UP FOR 'FOUND' RETURN JMP \MTCH,I KEY FOUND - RETURN TO P+2 NOFND JMP \MTCH,I NOT FOUND - RETURN TO P+1 * * L2CTR NOP LOOP COUNTER 2 TBPTR NOP TEMPORARY TABLE POINTER SKP * ***** DISC MODEL TABLE ***** 790122 JJC * * \MDTB ASC 3,7900 *** MODEL TABLE ENRTY FORMAT *** DEC 96 OCT 1 WORD --------------------* ASC 3,7905 1 ! ASCII ! DISC ! DEC 96 !-------------------! OCT 0 2 ! MODEL ! ! ASC 3,7906 !-------------------! DEC 96 3 ! OR ! NAME ! OCT 0 !-------------------! ASC 3,7920 4 ! 64 WORD SEC/TRK ! DEC 96 !-------------------! OCT 0 5 !1!1! !0! ASC 3,7925 --------------------- DEC 128 HPIB--! ! !--TYPE 32 OCT 0 IB UNIT REQ'D--! ASC 3,7910H DEC 64 OCT 100000 ASC 3,7906H DEC 96 OCT 100000 ASC 3,7920H DEC 96 OCT 100000 ASC 3,7925H DEC 128 OCT 100000 ******** ALL DISCS BELOW THIS LINE ARE NOT VALID SYS OR AUX DISCS ******** ASC 3,9895 DEC 60 OCT 140000 * SPC 5 BSS 1650B+DBP-* BUF64 IS A TEMPORARY BUFFER USED BY \CFIL BUF64 BSS 2000B+DBP-* RESERVE 1K FOR DUMMY BASE PAGE. * SPC 5 ************************Îþú*********************** * * * END OF AREA OVERLAID FOR DUMMY BASE PAGE. * * * *********************************************** SKP * DBPO EQU DBP \ADBP DEF DBPO ADDR OF DUMMY BASE PAGE \NABP NOP NEG OF RT4GN START * * CURRENT PAGE LINKAGE IMAGE AREA. * \TBLK BSS 3 \LRBP BSS 1 AREA 1: CR SYSTEM BP \URBP BSS 1 \IRBP BSS 1 \CUBP BSS 1 AREA 2: CURRENT PROG BP. \UCBP BSS 1 \ICBP BSS 1 * BSS 600 CURRENT PAGE LINKAGE IMAGE AREA. * \CPLM DEF * END OF CP LINK AREA. \CBPA DEF \CUBP ADDR OF CURRENT BP SPECS. SPC 2 \TIME BSS 1 \TIM1 BSS 1 \MULR BSS 1 * \RNT BSS 1 INDEX OF \RENT ENTRY \PRV BSS 1 INDEX OF \PRIV ENTRY * \CURL NOP CURRENT \LBUF ADDRESS. \CPL2 NOP ADDR OF HIGH CURRENT PAGE LINK SPECS. * \PREL NOP CURRENT PROGRAM RELOC ADDRESS \NUMP NOP MEM SIZE(PAGES) \TBCH NOP TIME BASE GENERATOR CHANNEL \PIOC NOP ADDR OF PRIVILEGED I/0 CARD \SWPF NOP SWAPPING FLAG = 0/1 = NO/YES DTYP NOP DEST. DISC TYPE:BIT0: 1/0=7900/TYPE 32 \LBUF BSS 64 LOAD BUFFER \TBUF BSS 4 TEMP BUFFER \SCTK BSS 1 SECTORS/TRACK OF TARGET SYSTEM DISC \IBI NOP DESTINATION SYS DISC TYPE 1/0=HPIB/NOT HPIB STYPE NOP CURRENT HOST SYSTEM TYPE * HIMSG DEF *+1 ASC 16,RTE-IV GENERATOR MODEL 92068A HTIME BSS 15 FTIME ROUTINE PUTS THE TIMODAY HERE * SKP SEGCN JSB SWAP DO PROG INPUT PHASE. P2 DEC 2 ROLL IN RT4G2 JSB \PIP GO TO SEGMENT. * JSB SWAP GO GENERATE RTE! P3 DEC 3 JMP \GENS SPC 3 ******************************************************************************** * * CONTROL ROUTINES FOR INTER-SEGMENT CALLS: * ********************************************************************Dãþú********* SPC 3 * * BUILD SYSTEM TABLES * \SYTB NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G5 DEC 5 * JSB \TBLS BUILD THE TABLES * JSB SWAP BRING BBACK RT4G3 DEC 3 JMP \SYTB,I SPC 3 * * LOAD A PROGRAM * \LODN NOP IN-CORE RT4G3 ISSUED CALL. JSB SWAP ROLL IN RT4G4. P4 DEC 4 * JSB \NLOD CALL LOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \LODN,I RETURN. SPC 3 * * BUILD I/O TABLES * \GNIO NOP IN-CORE RT4G3 ISSUED CALL. * * BUILD TRACK MAP TABLE FIRST ($TB31/$TB32) * LDB DTYP DETERMINE DISC TYPE SLB,RSS TYPE 32 DISC?? JMP D05 ..YES * JSB SWAP ROLL IN RT4G1 FOR 7900 DISC DEC 1 JSB \TB31 CALL ROUTINE TO BUILD TMT JMP GET5 * D05 JSB SWAP ROLL IN RT4G7 FOR 7905/7920 DISCS DEC 7 JSB \TB32 CALL ROUTINE TO BUILD TMT * GET5 JSB SWAP ROLL IN RT4G5. P5 DEC 5 * JSB \IOTB BUILD THE TABLES IN RT4G5 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \GNIO,I RETURN. SPC 3 * * RELOCATE DRIVER PARTITIONS * \CLDP NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G8 P8 DEC 8 * JMP \\LDP CONTROL DP RELOCATION * \DDON JSB SWAP BRING BACK RT4G3 DEC 3 JMP \CLDP,I SPC 3 * * RELOCATE A PARTITION-RESIDENT DRIVER * \DPLD NOP IN-CORE RT4G8 ISSUED CALL JSB SWAP ROLL IN RT4G4 DEC 4 * JSB \NLOD CALL LOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G8 DEC 8 JMP \DPLD,I SPC 3 * * PERFORM PARTITION DEFINITION * \PART NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G6 DEC 6 * JSB \PDEF DO PARTITIONsHFB DEFINITION * JSB SWAP BRING BACK RT4G3 DEC 3 JMP \PART,I SPC 3 * * CLEAN-UP BOOT EXTENSION AND HEADER RECORDS * \FSEC NOP IN-CORE RT4G3 ISSUED CALL. LDB DTYP DETERMINE DISK TYPE SLB,RSS TYPE 32 DISC?? JMP F05 ..YES * JSB SWAP ROLL IN RT4G1 (7900) DEC 1 JSB \FSC0 CALL "\FSC0" IN RT4G1. JMP BK3 * F05 JSB SWAP ROLL IN RT4G7 (7905,7920) DEC 7 JSB \FSC5 CALL "\FSEC" IN RT4G7 * BK3 JSB SWAP BRING BACK RT4G3. DEC 3 JMP \FSEC,I RETURN. SKP * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # * A AND B REG SAVED * SWAP NOP DST ABREG SAVE REGISTERS. CCA ADA SWAP,I GET SEG NUMBER. MPY P3 ADA RTGMA STA SWAPA JSB SEGLD ROLL IN SEGMENT DEF *+3 - IT WILL COME BACK TO \SRET SWAPA NOP AFTER EXECUTING FRONT END CODE. DEF SGERR * \SRET ISZ SWAP GET RETURN ADDRESS DLD ABREG RESTORE REGISTERS. JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 SGERR NOP ERROR RET. WORD * * * THE FOLLOWING ORDER MUST NOT BE CHANGED * RTGMA DEF *+1 ASC 3,RT4G1 7900 DISC SUBR. SEGMENT ASC 3,RT4G2 PARAMETER INPUT PHASE SEGMENT ASC 3,RT4G3 LOADING CONTROL SEGMENT ASC 3,RT4G4 LOADER SEGMENT ASC 3,RT4G5 I/O TABLE GENERATION SEGMENT ASC 3,RT4G6 PARTITION DEFINITION SEGMENT ASC 3,RT4G7 7905 DISC SUBR. SEGMENT ASC 3,RT4G8 DRIVER PART. LOADING CONTROL SEGMENT pHÿÿþú SKP * CONVERT A TO ASCII AT B * * THE \CONV SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CONV NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR UBLNK ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CONV,I YES - RETURN * OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 P10 DEC 10 DEC 1 * N2 DEC -2 TCNT NOP SKP * * GET DIGIT FOR \CONV * * GETD PROVIDES THE ASCII CHARACTERS FOR \CONV. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD 4Íþú * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR M60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * M60 OCT 60 RANAD NOP SKP * * SET UP LNK AREA * * \LNK, \LNKS, AND \LNKX MANAGE THE LINK AREA. * * THIS AREA IS COMPOSED OF TRIPLETS AND LINK AREA * IMAGES AS FOLLOWS: * * WORD1 THE ACTUAL CORE ADDRESS OF THE LINK AREA * WORD2 THE ACTUAL CORE ADDRESS OF THE LAST WORD+1 OF THE AREA * WORD3 THE ADDRESS OF THE LOADRS IMAGE OF THE AREA * * THE FIRST TWO ENTRIES ARE FOR BASE PAGE AS FOLLOWS: * * AREA 1 THE CORE RESIDENT SYSTEM BASE PAGE AREA * AREA 2 THE CURRENT PROGRAMS BASE PAGE AREA * * FOR THESE AREA THE IMAGE IS IN THE DUMMY BASE PAGE * FOR ALL OTHER ENTRIES (I.E. FOR CURRENT PAGE LINK AREAS) * THE IMAGE FOLLOWS THE THREE WORD DEFINITION OF THE AREA. * * IN ALL CASES THE LAST DEFINED AREA IS THE ONE THAT HAS A * WORD1 ADDRESS OF \CPL2, WHICH IS USUALLY THE HIGH * CURRENT PAGE LINK AREA FOR THE CURRENT PROGRAM * * \LNKX INITILIZES THE SCANNING OF THE LINKAGE AREA * \LNK SETS UP \LNK1, \LNK2, \LNK3 FOR THE NEXT ENTRY * P+1 RETURN INDICATING THERE IS NO NEXT ONE. * P+2 INDICATING THAT THE SET UP WAS DONE. * * \LNKS SETS UP \LNK1, \LNK2, \LNK3 GIVEN THAT THE FIRST WORD ADDRESS * IS KNOWN (AND PASSED IN THE A REGISTER) * \LNKX NOP LDA TLNK GET INITIAL ADDRESS STA \LNK1 SET IN \LNK1 JMP \LNKX,I RETURN SPC 3 \LNK NOP LDA \LNK1 GET CURRENT ADDRESS CPA \CPL2 IF LAST ENTRY JM"¸þúP \LNK,I RETURN, END OF LST * LDA A,I GET THE ACTUAL ADDRESS AND M0760 ISOLATE THE PAGE ADDRESS SZA,RSS IF BASE PAGE DO THE BP THING JMP LNKB * LDA \LNK1,I ELSE CACULATE THE ADDRESS OF CMA,INA THE NEXT ADA \LNK2,I ENTRY ADA \LNK3,I BY SKIPPING OVER THE IMAGE LNKA JSB \LNKS SET UP THE NEW AREA ISZ \LNK SET OK RETURN ADDRESS JMP \LNK,I RETURN * LNKB LDA \LNK1 FOR BASE PAGE ADA P3 USE NEXT THREE JMP LNKA WORD AREA. SPC 3 \LNKS NOP STA \LNK1 SET THE LINK POINTERS UP INA STA \LNK2 INA STA \LNK3 JMP \LNKS,I AND RETURN SPC 3 \LNK1 NOP \LNK2 NOP \LNK3 NOP TLNK DEF \TBLK M0760 OCT 076000 SKP * * NUMERICAL INPUT CONTROL * * THE \DCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., DISK SIZES, TBG CHANNEL NO. AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB \DCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * \DCON NOP JSB \GET# GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB \GETC GET NEXT CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB \INER INVALID DIGIT ENTRY JMP \DCON,I RETURN ISZ \DCON INCR RETURN ADDRESS LDA \OCTN GET CONVERTED NUMBER JMP \DCON,I RETURN SKP * * GET u±þúCHAR FROM \LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * \GETN AND \GET#, IGNORING BLANKS. IF A COMMA IS ENCOUNTERED, * THE COMMA FLAG IS SET (\CMFL:=0) AND A BLANK IS RETURNED. * SUBSEQUENT CALLS TO \GETC WILL CONTINUE TO RETURN BLANKS UNTIL * THE COMMA FLAG IS RESET (\CMFL:= -1). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GETC * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * \GETC NOP LDA \CMFL \CMFL = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB \BUFL GET U/L FLAG IGNOR LDA \CURL,I GET CHAR FROM \LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA STAR IF STAR CLA TREAT AS END OF LINE SZA,RSS END OF BUFFER? JMP \GETC,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ \CURL INCR \LBUF ADDRESS STB \BUFL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS * CPA COMMA CHAR = COMMA? ISZ \CMFL RESET FLAG TO SHOW COMMA IN (SKIPS) JMP \GETC,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP \GETC,I RETURN WITH BLANK * COMMA OCT 54 STAR OCT 52 BLANK OCT 40 \BUFL NOP BUFFER U/L FLAG. \CMFL NOP COMMA FLAG= -1/0= NOT IN/IN. M377 OCT 377 SKP * * MOVE ALPHA FROM \LBUF TO \TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM \LBUF * TO \TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN \TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN \TBUFB¾þú. * B = IGNORED * JSB \GETN * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * \GETN NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB ATBUF,I CLEAR WORD 1 OF TBUF CCA STA \CMFL SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM \LBUF LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I YES - RETURN OCHAR JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I RETURN * CURAT NOP CURRENT TBUF ADDR. ATBUF DEF \TBUF MAXC NOP MAX. CHAR COUNT. SKP * * CONVERT OCT/DEC ASCII TO BINARY * * THE \GET# SUBROUTINE CONVERTS THE NEXT CHARACTERS IN \LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB \GET# * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * ÌÎþú B = DESTROYED * \GET# NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA \CMFL SET COMMA-IN FLAG CLA STA \OCTN \OCTN = OCTAL NUMBER GETNX JSB \GETC GET CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA \TCHR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA \OCTN GET PREVIOUS OCTAL NO. ADA A SET A = \OCTN X 2 ADA A SET A = \OCTN X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA \OCTN SET A = \OCTN X 5 ADA A SET A = \OCTN X 10/8 ADA \TCHR SET A = NEW OCTAL NO. STA \OCTN SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ \GET# INCR RETURN ADDRESS LDA \OCTN GET OCTAL EQUIVALENT DGERR JMP \GET#,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP \GET#,I RETURN - ERROR * \TCHR NOP TEMP CHAR SAVE AREA. DIFLG NOP DATA-IN FLAG= -1/0= NOT IN/IN. DRANG NOP DIGIT RANGE. \OCTN NOP OCTAL DIGIT. L60 OCT -60 N10 DEC -10 N8 DEC -8 SKP * * +pþú INITIALIZE CHAR TRANSFER * * THE \GINT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING \LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GINT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * \GINT NOP LDA ALBUF ALBUF = ADDR OF \LBUF STA \CURL SET CURRENT \LBUF ADDRESS CCB STB \BUFL \BUFL = BUFFER U/L FLAG JMP \GINT,I SPC 10 * * INVALID TTY RESPONSE * * THE \INER SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \INER NOP LDA ERR01 SET INVALID DEVICE ERROR CODE JSB \GNER PRINT \GNER MESSAGE JMP \INER,I RETURN SPC 1 ERR01 ASC 1,01 SKP * SUBROUTINE TO READ INPUT * \RNME NOP READ FILE NAME. ISZ RMODE JSB \READ CLB STB RMODE JMP \RNME,I * * \READ NOP STA READ2 SZA,RSS IF ZERO, THEN NULL PROMPT LDB ALBUF SO PUT A BOGUS ADDRESS IN READB STB READ1 READ0 JSB \PRMT DEF *+6 READ1 NOP MSG BUFR NULL IF NO PROMPT. DEF READ2 ZERO LEN IF NO PROMPT. ALBUF DEF \LBUF DEF P80 DEF PARSA * STA PARNO SAVE PARAM RECORD LENGTH LDA \TBUF STA TEMP4 SAVE IT JSB \GINT CLA,INA JSB \GETN IF FIRST CHAR IS A BLANK CPA BLANK OR A * THEN SKIP RECORD RSS JMP READ5 NOT SO CLA STA READ2 DON'T REISSUE PROMPT JMP READ0 * READ5 LDA TEMP4 STA \TBUF RESTORE LDB RMODE CHECK WHICH ENTRY. SZB JMP \READ,I LDA PARNO INA CLE,ERA CONVERT TO WORD ADDR. ADA ALBUF GET TO END OF RþúBUFFER. CLB INSERT ZERO AT END. STB A,I JSB \GINT INITIALIZE \LBUF SCAN. LDA PARNO RETURN WITH RECORD LEN. JMP \READ,I SPC 1 READ2 NOP RMODE OCT 0 PARNO NOP TEMP4 NOP P80 DEC 80 SKP * * ANALYZE YES/NO RESPONSE * RETURN: (P+1) ERROR * (P+2) NO * (P+3) YES * \YENO NOP LDA N3 JSB \GETN JSB \GETC SZA MORE THEN 3 CHAR JMP YE/ER ERROR LDB ATBUF,I GET RESPONSE CPB YCHAR YE? LDA P2 YES - SET RETURN OFFSET FOR YES CPB NCHAR WAS IT NO? CLA,INA YES - SET RETURN FOR YES SZA,RSS STILL ZERO? JMP YE/ER YES - NOT YES OR NO - ERROR ADA \YENO ADJUST RETURN JMP A,I RETURN YE/ER JSB \INER ERROR - SEND MESSAGE JMP \YENO,I AND TAKE ERROR EXIT SPC 1 YCHAR ASC 1,YE NCHAR ASC 1,NO N3 DEC -3 SPC 5 * * NEW LINE (CR,LF) ON TTY * * THE \SPAC SUBROUTINE IS USED TO \SPAC UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \SPAC * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \SPAC NOP LDB DBLNK GET ADDRESS OF A BLANK CLA,INA SET CHARACTER COUNT = ONE JSB \MESS OUTPUT CR, LF ON TTY JMP \SPAC,I RETURN * DBLNK DEF UBLNK UBLNK OCT 20000 SKP * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ASCII ERROR CODE, IF NEG THEN DON'T DO A TR,ERRLU * B = IGNORED * JSB \GNER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \GNER NOP PRINT ERROR MESSAGES CLE IF A IS NEG THEN SET IT POSITIVE SSA AND DON'T DO A TR CME SEZ CMA,INA STA AMERR+5 SET ERROR CODE INTO ME›*þúSSAGE SEZ JMP EROUT LDA \IACM IS COMMAND LU INTERACTIVE ALREADY? SZA JMP EROUT YES * LDA \TRCH SAVE RETURN ADDRESS OF \TRCH IN CASE ITS STA \ABOR CALLING ERROR LDA \TRCM SIMULATE THE "TR,ERRLU" LDB B6 JSB \TRCH GO PUSH THE STACK LDA \ABOR RESTORE \TRCH RETURN ADDRESS STA \TRCH * LDA EOFFL NO MESSAGE IF EOF-GENERATED SZA JMP \GNER,I * EROUT JSB \SPAC LDA P10 LDB AMERR AMERR = MESSAGE ADDRESS JSB \MESS PRINT ERROR MESSAGE ISZ ERCNT BUMP ERROR COUNTER JMP \GNER,I RETURN * \TRCM DEF TRCOM TRCOM ASC 3,TR, XX EOFFL NOP ERCNT NOP ERROR COUNTER SKP * * IRRECOVERABLE ERROR EXIT * \IRER NOP JSB \GNER PRINT \GNER MESSAGE JSB \TERM IRRECOVERABLE ERROR * AMERR DEF *+1 ASC 5,GEN ERR ERROR MSG = ERR + CODE SPC 5 \ABOR NOP FORMERLY "HLT 0B". CCA ADA \ABOR GET ADDR OF \ABOR CALLER. LDB DER00 JSB \CONV PUT IN MESSAGE. LDA P18 LDB ABERR JSB \MESS DISPLAY ER00 AND ADDRESS. ISZ ERCNT BUMP ERROR COUNTER JSB \TERM ABORT (NO RETURN). * ABERR DEF ERR00 ERR00 ASC 9,GEN ERR 00 DER00 DEF ERR00+6 P18 DEC 18 SKP * * THE \INID,\IDXS AND \IDX SUBROUTINES ARE USED TO SET THE CURRENT * INDICES FOR THE ENTRY IN THE PROGRAM IDENTIFICATION * BLOCK TABLE (IDENT). THE INDEX OF THE NEXT ENTRY * IN THE IDENT TABLE IS CONTAINED IN \TIDN. ON RETURN FROM * \IDX, \TIDN CONTAINS THE INDEX OF THE NEXT AVAILABLE * ENTRY IN IDENT. THE ADDRESS OF THE FIRST ENTRY IS CONTAINED * IN BIDNT AND THE # ENTRIES USED IS IN \PIDN. * * \IDXS FINDS AN ENTRY IN THE TABLE. * * IF THE NEXT IDENT ENTRY OVERFLOWS INTO THE LAST LST ENTRY, * \IDX PRINTS A DIAGNOSTIC AND EXITS TO THE IRRECOVERABLE ERROR * SUBROUTrÇþúINE. * * SET INITIAL IDENT ADDRESS * * \INID SETS THE INDEX OF THE FIRST ENTRY IN THE IDENT * TABLE AS THE CURRENT INDEX. * * NOTE. OFFSET = 10 TO AVOID PROBLEMS WITH VALUES * 1-5 IN LST WORD 4. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INID * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED * \INID NOP LDA P10 RESET CURRENT IDENT INDEX. STA \TIDN (HAS OFFSET OF 10) JMP \INID,I RETURN SKP * * \IDXS FINDS AN ID ENTRY IN THE IDENT TABLE. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE NAME TO FIND. * JSB \IDXS * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): CURRENT IDENT ADDRESSES ARE FOR THE NEXT FREE ENTRY IN * THE IDENT LIST. SYMBOL NOT FOUND. * (N+2): CURRENT IDENT ADDRESSES ARE FOR THE SPECIFIED PROGRAM. * \IDXS NOP JSB \INID INIT \TIDN TO 1ST IDENT. STB \INID SAVE POINTER TO ASCII NAME. * ** OTHER SUBS MAY WANT NAME PTR IN \INID ** * IDSX2 JSB \IDX SET IDENT ENTRY ADDRESSES. JMP \IDXS,I END OF TABLE. \ID1,\ID2,... SET. LDB \INID GET ADDR OF TARGET MATCH. LDA B,I CPA \ID1,I CHAR 1 & 2 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I CPA \ID2,I CHAR 3 & 4 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I XOR \ID3,I AND M7400 CHECK CHAR 5. SZA JMP IDSX2 NOT THIS ENTRY. ISZ \IDXS FOUND. TAKE SUCCESS RETURN. JMP \IDXS,I SKP * SET IDENT ADDRESSES FROM \TIDN * * \IDX SETS THE ADDRESSES OF THE CURRENT 11-WORD ENTRY IN THE * IDENT TABLE FROM THE INDEX OF THE CURRENT ENTRY (\TIDN). * THE \TIDN ENTRY MAY REFERENCE CURRENT/FORWARD/BACKWARD * BLOCKS. \IDX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNOREDȃþú * JSB \IDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): CURRENT IDENT ADDRESSES ARE THE ADDRESSES * OF THE NEXT AVAILABLE IDENT ENTRY, OR THE * END OF THE IDENT TABLE HAS BEEN REACHED. * (N+2): CURRENT IDENT ENTRY ADDRESSES (NOT END OF IDENT) * \IDX NOP STB \ID16 TEMP SAVE LDA B.I CHECK IF ENTRY IN CORE (DOT OK). CMA,INA ADA \TIDN SSA JMP IDX0 .LT. LOW ENTRY INDEX. * LDA B.I (NOT "B,I" - DOT OK) ADA EIDNT CMA,INA ADA \TIDN SSA JMP IDX2 IN CORE. * IDX0 LDA \TIDN .GT. HIGH ENTRY INDEX. ADA N10 CLB DIV EIDNT GET BLOCK NO. STA B.I TEMP SAVE... DOT OK. MPY ID.#S GET # SECTORS OFFSET. CLB DIV SECTK CHECK TRACK SPILL OVER. STB ID.CS REMAINDER= NEW CURR. SECTOR. ADA ID.BT STA ID.CT NEW CURRENT TRACK. * ADB ID.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK SSB,RSS JMP *+4 CLB STB ID.CS IF END NOT ON SAME TRACK, ISZ ID.CT START BLOCK ON NEXT TRACK * CPA ID.ET END OF IDENT DISK AREA? JMP LSERR YES. IDENT OVERFLOW! * JSB RDIDN WRITE/READ THE DISC. LDA B.I DOT OK. SET NEW LOW INDEX. MPY EIDNT ADA P10 ADD THE OFFSET. STA B.I DOT OK. IDX2 LDA \TIDN GET ADDR OF DESIRED ENTRY. ADA N10 ADJUST FOR OFFSET. CLB DIV EIDNT LDA B REMAINDER = OFFSET. ALF MULTIPLY BY 16 WORDS PER ENTRY ADA BIDNT STA \ID1 SET ADDRESS OF NAME 1,2 INA STA \ID2 SET ADDRESS OF NAME 3,4 INA STA \ID3 SET ADDRESS OF NAME 5, USE FLAG INA STA \ID4 SET ADDRESS OF COM/PROG LENGTH INA STA \ID5 SET ADDRESS OF LINKS-MAP OPT FLAGS. INA ‰VþúSTA \ID6 SET ADDRESS OF M/S,PRIOR/DISK,TY INA STA \ID7 SET ADDRESS OF LOWEST DBL. INA STA \ID8 SET MAIN IDENT ADDR FOR BS INA STA \ID9 SET FILE NAME ADDRESSES. INA STA \ID10 INA STA \ID11 INA STA \ID12 SET ADDRESS OF SECURITY CODE INA STA \ID13 SET ADDRESS OF CR LABEL . INA STA \ID14 SET ADDRESS OF RECORD NUMBER INA STA \ID15 SET ADDRESS OF REL. BLOCK INA LDB \ID16 RESTORE B-REG STA \ID16 SET ADDRESS OF BLK OFFSET * LDA \PIDN CHECK IF END OF IDENT. CMA,INA ADA \TIDN SSA ISZ \IDX NOT END. P+2 EXIT. ISZ \TIDN SET NEXT IDENT ENTRY. JMP \IDX,I RETURN * B.I DEC 10 1ST ENTRY INDEX OF CUR CORE BLOCK. * (OFFSET = 10) SPC 3 * POINTERS FOR IDENT TABLE. * BIDNT NOP FWA CORE BLOCK. \TIDN NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PIDN NOP # ENTRIES USED + 10. EIDNT NOP # IDENT ENTRIES PER CORE BLOCK. LIDNT NOP # WORDS PER DISC WRITE/READ. ID.BT NOP START TRACK ID.LT NOP LAST TRACK ID.LS NOP AND SECTOR READ. ID.CT NOP CURRENT TRACK ID.CS NOP AND SECTOR (OR NEXT REQUIRED). ID.ET NOP ENDING TRACK ID.#S NOP # SECTORS PER BLOCK. * \ID1 NOP \ID2 NOP \ID3 NOP \ID4 NOP \ID5 NOP \ID6 NOP \ID7 NOP \ID8 NOP \ID9 NOP \ID10 NOP \ID11 NOP \ID12 NOP \ID13 NOP \ID14 NOP \ID15 NOP \ID16 NOP SKP * * SUBROUTINE TO WRITE-READ IDENT TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDIDN * RDIDN NOP LDA ID.LS GET LAST SECTOR ADDR. LDB ID.LT GET LAST TRACK ADDR. CPA ID.CS EQUAL TO CURRENT? RSS YES. JMP RDID1 NO. WRITE AND READ. CPЦNLHB ID.CT SAME TRACK? JMP RDIDN,I YES, RETURN. * RDID1 LDA BIDNT STA WI1 STA WI2 * JSB EXEC WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WI1 NOP DEF LIDNT DEF ID.LT DEF ID.LS * JSB EXEC READ NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WI2 NOP DEF LIDNT DEF ID.CT DEF ID.CS * LDA ID.CT RESET TRACK & SECTOR ADDRS. STA ID.LT LDA ID.CS STA ID.LS JMP RDIDN,I 4ÉNÿÿþú SKP * * THE \ILST, \LSTS, \LSTE AND \LSTX SUBROUTINES ARE USED TO SET THE * CURRENT LOADER SYMBOL TABLE (LST) INDICES. THE INDEX OF THE * NEXT ENTRY IN LST IS CONTAINED IN \TLST. ON RETURN FROM \ILST, * \TLST CONTAINS THE INDEX OF THE NEXT AVAILABLE ENTRY IN LST, OR * THE INDEX OF THE END OF LST. THE ADDRESS OF THE FIRST ENTRY * IN LST IS AT BLST AND THE # ENTRIES USED IS IN \PLST. * * IF THE NEXT ENTRY IN LST OVERFLOWS CORE-DISC SPACE, * \LSTX PRINTS A DIAGNOSTIC AND EXITS * TO THE IRRECOVERABLE ERROR SUBROUTINE. * * \ILST SETS THE ADDRESS OF THE FIRST ENTRY IN LST. * \ILST NOP CLA STA \TLST RESET CURRENT LST INDEX. JMP \ILST,I RETURN SKP * * \LSTS SEARCHES THE LST FOR A SPECIFIED ENTRY. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE ASCII NAME TO BE FOUND. * JSBS\LSTS * * RETURN: CONTENTS OF A AND B DESTROYED. * (N+1): THE END OF THE LST WAS FOUND WITH OUT FINDING THE * SYMBOL. THE LST ENTRIES ARE SET TO THE NEXT AVAILABLE * ENTRY. * (N+2): THE CURRENT LST ADDRESS POINT TO THE FOUND ENTRY. * \LSTS NOP JSB \ILST INIT \TLST TO 1ST LST INDEX. STB \ILST SAVE PTR TO ASCII NAME * ** SOME SUBS EXPECT \LSTS TO STORE THIS ** * ** POINTER IN \ILST'S ENTRY POINT ** LSTS2 JSB \LSTX SET LST ENTRY ADDRESSES. JMP \LSTS,I END OF TABLE. \LST1,...,\LST5 SET. LDB \ILST GET ADDR OF TARGET MATCH. LDA B,I CPA \LST1,I CHAR 1 & 2 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I CPA \LST2,I CHAR 3 & 4 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I XOR \LST3,I AND M7400 CHECK CHAR 5. SZA JMP LSTS2 NOT THIS ENTRY. ISZ \LSTS FOUND. TAKE SUCCESS RETURN. JMP \LSTS,I SKP * SET LST ADDRESSES FRn»þúOM \TLST * * \LSTX SETS THE CURRENT LST ADDRESSES FROM \TLST. THE \TLST ENTRY * MAY REFERENCE CURRENT-FORWARD-BACKWARD BLOCKS. \LSTX ASSURES * THAT THE PROPER CORE BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \LSTX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): THE END OF LST IS REACHED AND THE CURRENT * LST ADDRESSES ARE THE ADDRESSES OF THE NEXT AVAILABLE * ENTRY IN LST. * (N+2): CURRENT LST ADDRESSES ARE SET (NOT END OF LST). * \LSTX NOP STB \LST5 TEMP SAVE LDA B.L CHECK IF ENTRY IN CORE. CMA,INA ADA \TLST SSA JMP LSTX0 .LT. LOW ENTRY INDEX. * LDA B.L ADA ELST CMA,INA ADA \TLST SSA JMP LSTX2 * LSTX0 LDA \TLST .GT. HIGH ENTRY INDEX. CLB DIV ELST GET BLOCK NUMBER. STA B.L SAVE FOR LATER. MPY LS.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB LS.CS REMAINDER= NEW CUR. SECTOR. ADA LS.BT STA LS.CT NEW CURRENT TRACK. * ADB LS.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NOT ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB LS.CS ISZ LS.CT * CPA LS.ET END OF LST DISC AREA? JMP LSERR YES. LST OVERFLOW! * JSB RDSMB WRITE/READ THE DISC. LDA B.L SET NEW LOW INDEX. MPY ELST STA B.L LSTX2 LDA \TLST GET ADDR OF DESIRED ENTRY. CLB DIV ELST LDA B REMAINDER= OFFSET. MPY P5 ADA BLST STA \LST1 SET WORD 1 ADDR. INA STA \LST2 SET WORD 2 ADDR INA STA \LST3 SET WORD 3 ADDR INA STA \LST4 SET WORD 4 ADDR INA LDB \LST5 RESTORE B-REG STA \LST5 SET WORD 5 ADDR b5þúLDA \PLST CHECK IF END OF LST. CMA,INA ADA \TLST SSA ISZ \LSTX NOT END. P+2 EXIT. ISZ \TLST SET NEXT LST INDEX. JMP \LSTX,I RETURN * B.L OCT 0 1ST ENTRY INDEX NOW IN CORE. * LSERR LDA ERR07 JSB \IRER IRRECOVERABLE ERROR EXIT * ERR07 ASC 1,07 IDENT/LST/FIX-UP OVERFLOW. SKP * ENTER A NEW SYMBOL * * \LSTE SEARCHS THE LST FOR A SYMBOL AND IF NOT FOUND ENTERS IT * IN THE LST. * * CALLING SEQUENCE: * A = IGNORED * B = SYMBOL ADDRESS * JSB \LSTE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): SYMBOL IS NEW AND WAS ENTRED, LST ADDRESS ARE SET UP * (N+2): SYMBOL WAS IN LST. LST ADDRESS ARE SET UP. * \LSTE NOP JSB \LSTS SEARCH FOR THE SYMBOL JMP LSTE2 IF NOT FOUND GO ENTER * ISZ \LSTE STEP TO ALREADY IN LST EXIT JMP \LSTE,I AND EXIT * LSTE2 LDB \ILST,I GET THE FIRST CHARACTERS OF NEW STB \LST1,I SYMBOL AND SET IN THE LIST ISZ \ILST STEP TO NEXT CHARACTERS LDA \ILST,I GET THE CHARACTERS STA \LST2,I AND SET ISZ \ILST STEP TO THE LAST CHARACTER LDA \ILST,I FETCH IT AND M7400 KEEP ONLY THE HIGH CHARACTER STA \LST3,I SET IT IN THE LST CLA CLEAR STA \LST4,I THE IDENT FLAG STA \LST5,I AND VALUE FIELDS ISZ \PLST BUMP # LST ENTRIES. JMP \LSTE,I EXIT BACK TO THE USER. SKP * * * POINTERS FOR LOADER SYMBOL TABLE (LST). * BLST NOP FWA CORE BLOCK. \TLST NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PLST NOP # ENTRIES USED. ELST NOP # LST ENTRIES PER CORE BLOCK. LLST NOP # WORDS PER DISC WRITE/READ. LS.BT NOP START TRACK LS.LT NOP LAST TRACK LS.LS NOP AND SECTOR READ. LS.CT NOP CURRENT TRACK LS.CS NOP AND ûþúSECTOR (OR NEXT REQUIRED). LS.ET NOP ENDING TRACK LS.#S NOP # SECTORS PER BLOCK. * \LST1 OCT 0 \LST2 OCT 0 \LST3 OCT 0 \LST4 OCT 0 \LST5 OCT 0 SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA LS.LS GET LAST SECTOR ADDRESS LDB LS.LT GET LAST TRACK ADDRESS CPA LS.CS IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB LS.CT HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING * WTSMT LDA BLST STA WS1 STA WS2 * JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF P2 DEF DSKLU WS1 NOP DEF LLST DEF LS.LT DEF LS.LS * JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU WS2 NOP DEF LLST DEF LS.CT DEF LS.CS * LDA LS.CT STA LS.LT LDA LS.CS STA LS.LS RESET TRACK SECTOR ADDRESS JMP RDSMB,I AND RETURN SKP * * THE \IFIX AND \FIX SUBROUTINES ARE USED TO SET THE * CURRENT FIX-UP TABLE INDICES. * * \IFIX SETS THE INDEX OF THE FIRST ENTRY IN THE FIX-UP * TABLE AS THE CURRENT ENTRY. * \IFIX NOP CLA STA \TFIX JMP \IFIX,I SPC 5 * * \FIX SETS THE CURRENT FIX-UP ADDRESSES FROM \TFIX. * THE \TFIX ENTRY MAY REFERENCE CURRENT-FORWARD-BACKWARD * BLOCKS. FIX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \FIX * * RETURN: A LOST, B SAVED. * P+1 IF BEYOND END OF DEFINED FIX-UPS * P+2 IF DEFINED ENTRY. * \FIX NOP STB \FIX4 TEMP SAVE LDA B.F CHECK IF ENTRY IS IN CORE. CMA,INA ADA \TFIX SSA JMP FIX0A .LT. LOW ENTRY INDEX. * LDA B.F ADA EFIX CMA,INA ADA \TFIX SSA JMP FIÇÎþúX0C * FIX0A LDA \TFIX .GT. HIGH ENTRY INDEX. CLB DIV EFIX GET BLOCK NUMBER. STA B.F MPY FX.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB FX.CS REMAINDER = NEW CURRENT SECTOR. ADA FX.BT STA FX.CT NEW CURRENT TRACK. * ADB FX.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NO ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB FX.CS ISZ FX.CT * CPA FX.ET END OF FIX-UP DISC AREA? JMP LSERR YES. FIX-UP OVERFLOW! * JSB RDFIX WRITE/READ THE DISC. LDA B.F SET NEW LOW INDEX. MPY EFIX STA B.F FIX0C LDA \TFIX GET ADDR OF DESIRED ENTRY. CLB DIV EFIX LDA B REMAINDER = OFFSET. MPY P4 ADA BFIX STA \FIX1 SET WORD 1 ADDR. INA STA \FIX2 SET WORD 2 ADDR. INA STA \FIX3 SET WORD 3 ADDR. INA LDB \FIX4 RESTORE B-REG STA \FIX4 SET WORD 4 ADDR. LDA \PFIX CHECK IF END OF DEFINED FIX-UPS. CMA,INA ADA \TFIX SSA ISZ \FIX NOT END. P+2 EXIT. ISZ \TFIX SET NEXT FIX-UP ENTRY. JMP \FIX,I RETURN. * B.F OCT 0 LOW INDEX OF BLOCK IN CORE SKP * * * POINTERS FOR FIX-UP TABLE. * BFIX NOP FWA CORE BLOCK. \TFIX NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PFIX NOP # ENTRIES USED. EFIX NOP # FIX-UP ENTRIES PER CORE BLOCK. LFIX NOP # WORDS PER DISC WRITE/READ. FX.BT NOP START TRACK FX.LT NOP LAST TRACK FX.LS NOP AND SECTOR READ. FX.CT NOP CURRENT TRACK FX.CS NOP AND SECTOR (OR NEXT REQUIRED). FX.ET NOP ENDING TRACK FX.#S NOP # SECTORS PER BLOCK. * \FIX1 NOP \FIX2 NOP \FIX3 NOP \FúWþúIX4 NOP SKP * * SUBROUTINE TO READ/WRITE FIX-UP TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDFIX * RDFIX NOP LDA FX.LS GET LAST SECTOR ADDRESS. LDB FX.LT GET LAST TRACK ADDRESS. CPA FX.CS IS IT EQUAL TO CURRENT? RSS YES. JMP RDFX1 NO... WRITE AND READ. CPB FX.CT HOW ABOUT TRACK ADDRESS? JMP RDFIX,I SAME THING... DON'T TO ANYTHING. * RDFX1 LDA BFIX STA WX1 SET BUFFER ADDRESS. STA WX2 * JSB EXEC GO WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WX1 NOP DEF LFIX DEF FX.LT DEF FX.LS * JSB EXEC READ IN NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WX2 NOP DEF LFIX DEF FX.CT DEF FX.CS * LDA FX.CT RESET TRACK & SECTOR ADDRESSES. STA FX.LT LDA FX.CS STA FX.LS JMP RDFIX,I RETURN. SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM IN CASE OF ABORT * * JSB \TERM * * \TERM NOP LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS STA BLKS AND SAVE IT JSB \CLOS PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS * JSB CLOSE PURGE THE BOOT FILE(IF ANY) DEF *+4 DEF \BDCB DEF \FMRR DEF B1 JMP CONTA * * ENTER HERE FOR NORMAL CLEANUP AT END OF GENERATION * \EXIT JSB \CLOS CLOSE BOOT FILE (IF ANY) DEF *+3 IGNORING ANY ERRORS DEF \BDCB DEF ZERO * LDA DFIN LDB DAB GET ADDRESS INTO MESSAGE MVW P4 AND SENT "FINISHED" * CONTA LDB DFABM GET BUFFER ADDRESS LDA P14 AND COUNT JSB \LOUT SEND THE TERMINATION MESSAGE JSB \SPAC * LDA ERCNT NOW PRINT THE # OF ERRORS CMA,INA FOR THIS GENERATION LDB ERMSG JSB \CJþúONV LDA P12 LDB ERMSG INB JSB \MESS * JSB CLOSE PURGE TEMP NEW NAM FILE. DEF *+4 DEF \NDCB DEF \FMRR DEF P64 * JSB \CLOS CLOSE LIST FILE DEF *+3 DEF \LDCB DEF ZERO * JSB \CLOS CLOSE RELOCATABLE INPUT FILE IF OPEN DEF *+3 DEF \RDCB DEF ZERO * JSB \CLOS CLOSE ANSWER FILE DEF *+3 DEF \IDCB DEF ZERO * * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * LDA IALST ABORT MESSAGE ALREADY SZA PRINTED? JMP RELTR JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF P2 DEF ERRLU DFABM DEF ABMSG "RT4GN -------" DEF B7 * RELTR JSB EXEC RELEASE TRACKS DEF *+3 DEF P5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 DAB DEF *+4 ABMSG ASC 3,RT4GN ASC 4,ABORTED B1 OCT 1 B6 OCT 6 B7 OCT 7 BLKS NOP \.NM. ASC 1,@@ ASC 1,NM NAMM ASC 1,@A * ERMSG DEF *+1 ASC 7, ERRORS DFIN DEF *+1 ASC 4,FINISHED SKP * * SUBROUTINE TO WRITE ON INTERACTIVE COMMAND INPUT DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB \MESS * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * \MESS NOP DST ABREG SAVE A AND B REG FOR \LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA IALST IS THE LIST FILE AN I.A. LU? SZA JMP PRNT1 YES, SO DONT PRINT MESSAGE TWICE LDA \IACM IS THE COMMAND DEVICE I.A.? SZA,RSS JMP PRNT1 NO, SO DONT WRITE TO IT * JSB WRITF OUTPUT MESSAGE DEF *+5 DEF \IDCB TO THE INPUT DEVICE DEF {õþú\FMRR PRNTB NOP DEF PRNTA LENGTH * PRNT1 DLD ABREG GET LENGTH AGAIN JSB \LOUT WRITE TO FILE JMP \MESS,I AND RETURN SPC 1 PRNTA NOP M1 DEC -1 SKP * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCC SAVE IN DOWN COUNTER STB BYTCD SAVE B TEMPORARILY. LDB N40 TRUNCATE TO 40 WORDS. ADA P40 SSA STB BYTCC LDB BYTCD RESTORE B. LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND M7400 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 OTBUF ASC 1, PRINT BUFFER BSS 40 * B40 OCT 40 N40 DEC -40 P40 DEC 40 SKP * * SUBROUTINE TO WRITE ONTO A LIST FILE, AND OPTIONALLY ECHO TO CONSOLE * CALLING SEQUENCE * JSB \LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS þú * \LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING * LDB LFERR IS THE LIST FILE IN ERROR MODE? SZB,RSS IE, PRE-CREATION OR POST-ERR22 JMP LF0 YES * JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF \LDCB DEF \FMRR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA * LDA \FMRR SSA,RSS JMP LF0 NO LIST FILE ERROR * CMA,INA SET POSITIVE FOR CONVERSION STA \FMRR JSB CNUMD CONVERT ERROR CODE TO ASCII DEF *+3 DEF \FMRR DEF FERMA ADDRESS OF ERROR MESSAGE LDA FERMA+2 PICK OFF CODE STA FILEA+6 LDB LDCBA NOW STORE THE FILE NAME STB PEMP JSB ADDCB IN THE MESSAGE NOP WON'T RETURN HERE LDB DFILE MOVE THE FILE NAME TO MVW P3 THE ERROR MESSAGE * JSB WRITF DEF *+5 SEND A BLANK LINE DEF \EDCB DEF \FMRR DEF C4040 DEF B1 * JSB WRITF SEND: DEF *+5 FMP ERR -XX DEF \EDCB DEF \FMRR DEF FILEA+1 (\CFIL WASN'T CALLED BECAUSE DEF P10 IT CALLS ... \LOUT) * ISZ ERCNT ISZ ERCNT LDA ERR22 STORE GEN ERROR CODE IN MESSAGE STA AMERR+5 JSB WRITF SEND: DEF *+5 GEN ERR 22 DEF \EDCB DEF \FMRR DEF AMERR+1 (\GNER WASN'T CALLED BECAUSE DEF P5 IT CALLS ... \LOUT) * ASKAG JSB WRITF ASK: DEF *+5 "OK TO CONTINUE?" DEF \EDCB DEF \FMRR DEF OKAY? DEF P8 * LDA ERRLU SET ECHO BIT IN IOR B400 EXEC CONTROL STA \FMRR WORD GETAN JSB EXEC RETRIEVE OPERATOR'S ANSWER DEF *+5 DEF B1 DEF \FMRR DEF ECBF DEF N2 SZB,RSS SKIP IF INPUT RECEIVED JMz þúP GETAN ELSE GET AGAIN * CLA SET TO IGNORE ALL FUTURE LIST STA LFERR FILE ERRORS INA TURN ECHO ON STA ECHON * LDA ECBF OKAY? CPA YCHAR "YE" JMP LF0 YES-CONTINUE CPA NCHAR "NO" JSB \TERM NO-ABORT JMP ASKAG ASK AGAIN * LF0 LDA ECHON ARE WE TO ECHO? SZA,RSS JMP \LOUT,I NO * LDA IALST IS THE LIST FILE AN SZA,RSS INTERACTIVE LU? JMP LF1 NO, GO CHECK COMMAND INPUT LDB LSTLU IS THE LIST LU SAME AS CPB ERRLU LU OF OPERATOR CONSOLE? JMP \LOUT,I YES - DON'T ECHO * LF1 LDA \IACM IS THE COMMAND INPUT SZA,RSS FROM AN INTERACTIVE LU? JMP LF2 NO - SO PERFORM ECHO LDB CMDLU IS THE COMMAND LU THE CPB ERRLU SAME AS OP CONSOLE? JMP \LOUT,I YES - SO DON'T ECHO * LF2 LDA LSBF SET BUFFER ADDRESS STA ECBF JSB WRITF AND OUTPUT IT DEF *+5 DEF \EDCB DEF \FMRR ECBF NOP DEF LOUTA JMP \LOUT,I AND RETURN * ECHON NOP ECHO FLAG, 1=ON LOUTA NOP LFERR NOP LIST FILE ERROR ACKNOWLEDGER,0=NO,1=YES ERR22 ASC 1,22 LIST FILE GEN. ERROR CODE OKAY? ASC 8,OK TO CONTINUE? SKP * SUBROUTINE TO OPEN A RELOCATABLE FILE AND ADVANCE TO THE * NAM GIVEN IN THE CURRENT IDENT ENTRY. THE FILE IS LEFT OPEN. * THE NAM DESIRED MAY BE IN THE SAME FILE AS THE PREVIOUS ONE. * * CALLING SEQUENCE: * * A = BUFFER ADDRESS FOR NAM RECORD. * B = 0, DON'T COMPARE BUFFER FILE NAMES * JSB \RNAM * ERROR RETURN * NORMAL RETURN: A = # WORDS. * \RNAM NOP STA RDNMA SAVE BUFFER ADDRESS. SZB,RSS SKIP IF CHECK WANTED JMP RDNM1 LDB \DPR2 CHECK WHETHER \RBIN'S FILE NAME INB IS THE SAME AS IN IDENT. LDA B,I CPA \ID9,I INB,RSS JMP RDNM‹¼þú1 NO MATCH. LDA B,I CPA \ID10,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA \ID11,I INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID12,I SECURITY CODE INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID13,I CR LABEL JMP RDNM3 THE NAMES MATCH. GO SEARCH. * RDNM1 JSB CLOSE NAMES DO NOT MATCH. CLOSE THIS DEF *+3 FILE AND GET THE RIGHT ONE. DEF \RDCB DEF \FMRR * LDA P2 SET TYPE = ASCII. STA PARS2 LDA \ID9 STORE FILE NAME FROM IDENT. LDB DNAM MVW P3 LDA \ID12,I GET SECURITY CODE STA PRS31 LDA \ID13,I AND CR LABEL STA PRS41 * RDNM3 LDA RDNMA RESTORE BUFFER ADDRESS. CCB SIGNAL \RBIN TO CALL APOSN. JSB \RBIN READ NEXT RECORD FROM FILE. JMP \RNAM,I ERROR. SZA,RSS JMP RDNM3 EOF. MUST HAVE BEEN PAST THE NAM. * ISZ \RNAM SET FOR NORMAL EXIT. JMP \RNAM,I * RDNMA NOP RDNMB NOP SKP * SUBROUTINE TO GET NAME * * OPEN,READ AND CLOSE A RELOCATABLE FILE. * CALLING SEQUENCE * JSB \RBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * B REG: 0 = NULL * 1 = LOCATE BEFORE READ. * -1 = POSITION BEFORE READ. * UPON RETURN * A REG=0 EOF OR A = NUMBER OF WORDS. * \RBIN NOP STA RBINA SAVE BUFFER ADDRESS STB RBINB SAVE CODE. LDA \RDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBIN2 YES...DON'T RE OPEN ISZ ZERO SIGNAL A NON-EXCLUSIVE OPEN JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF \RDCB DEF B300 CLA STA ZERO RESET ZERO TO ZERO! JSB \CFIL JMP \RBIN,I RBIN2 LDA RBINB GET CODE. SZA,RSS JMP RBOPN ZERO = NO ACTION. * CPA M1 RÎþú JMP RBIN3 -1 = PRE-POSITION THE FILE. ADA M1 1 = GET THE FILE POSITION. SZA JMP RBOPN UNDEFINED. ASSUME ZERO. * JSB LOCF GET POSITION OF NEXT DEF *+6 RECORD IN THE FILE. DEF \RDCB DEF \FMRR DEF \NAMN DEF \NAMB DEF \NAMO * JMP RBIN4 * RBIN3 JSB APOSN POSITION THE FILE. DEF *+6 DEF \RDCB DEF \FMRR DEF \ID14,I DEF \ID15,I DEF \ID16,I * RBIN4 LDA DRDCB GET DCB ADDRESS JSB \CFIL FOR ERROR CHECKING JMP \RBIN,I * RBOPN JSB READF READ THE FILE DEF *+6 DRDCB DEF \RDCB DEF \FMRR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD LDA DRDCB JSB \CFIL SEE IF ANY ERROR JMP \RBIN,I ERROR...DO ERROR RETURN LDA RLEN GET LENGTH SZA,RSS IGNORE ZERO LENGTH RECORDS. JMP RBOPN ISZ \RBIN GET NORMAL RETURN. CPA M1 EOF? RSS JMP \RBIN,I NO JSB \CLOS YES...CLOSE FILE DEF *+3 DEF \RDCB DEF ZERO CLA TELL THEM END OF FILE JMP \RBIN,I AND RETURN SPC 2 RBINA NOP RELOC. INPUT BUFFER ADDRESS RBINB NOP " FILE POSITION FLAG RLEN NOP " RECORD LENGTH \NAMN NOP \NAMB NOP \NAMO NOP SKP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB FOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * ODCBA NOP SUBF NOP FOPEN NOP JSB .ENTR DEF ODCBA LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP FOPEN,I YES EXIT JSB OPEN TRY TOÃ…NLH OPEN FILE DEF *+7 DEF ODCBA,I DEF \FMRR DEF PARS2+1 NAME DEF ZERO ALWAYS = 0 EXCEPT WHEN CALLED BY \RBIN DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT JMP FOPEN,I RETURN …åNÿÿþú SKP * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 * * TYP0 NOP STA T0DCB LDA PARS2 CMA,INA,SZA IF NULL OR NUMERIC (TYPE 0,1) INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA PARS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA PARS2+1 CLA JSB SETIT SET DIRECTORY JSB SETIT ADDRESS TO ZERO JSB SETIT ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SETIT AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+6 DEF P13 DEF PARS2+1 DEF EQT5 DEF EQT4 DEF SUB05 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND M77 AND MASK STA EQT5 SAVE CPA P5 IF TYPE 5, MUST RSS JMP NOT05 LDA SUB05 DETERMINE ITS SUBCHANNEL AND M77 STA SUB05 SAVE THE SUBCHANNEL * LDA EQT5 NOT05 LDB B100 GET EOF CONTROL SUBFUNCTION CPA P5 RSS JMP TYP2 LDA SUB05 IF SUBCHANNEL 0 SZA,RSS JMP TYP3 JMP SEOF * TYP2 ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE * TYP3 LDB B1000 LDA EQT5 CPA P2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF CPA P7 IF A TYPE 7 DEVICE JMP SEOF THEN IT IS AUTOMATICALLY INTERACTIVE CPA P5 RSS JMP TYP4 LDA SUB05 NEED TO GET SUBCH ON A TYPE 5 SZA,RSS JMP SEOF * TYP4 LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+טþú1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SETIT SET IN DCB CLA JSB SETIT SET NO SPACING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SETIT AND SECURITY CODES AGREE LDA B1030 OCTAL 100030 JSB SETIT AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SETIT SET OPEN FLAG LDA T0DCB ADA P3 STA T0DCB SET TO WORD 13 CLA,INA SET LOW WORD OF RECORD # JSB SETIT CLA SET HI WORD OF RECORD # JSB SETIT SET RECORD COUNT CLA STA \FMRR CLEAR ERROR CODE FOR TYPE 0 LDB EQT5 IF THIS IS A MT UNIT CPB P5 NO EOF IF A TYPE 5 DEVICE RSS CPB B23 THEN DON'T WRITE AN EOF JMP TYP0,I LDB T0DCB GET DCB ADDRESS ADB MD11 RESET TO WORD5, CONTROL FUNC LDB B,I GET CONTROL WORD STB SETIT SAVE IN TEMP LOCATION JSB EXEC DO AN EOF DEF *+4 DEF P3 DEF SETIT TEMP WHERE FUNCTION CODE LOCATED DEF MD17 FORCE A PAGE EJECT OR LEADER CLA JMP TYP0,I * * SETIT NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SETIT,I * * P7 DEC 7 T0DCB NOP EQT5 NOP MD17 DEC -17 MD11 DEC -11 B23 OCT 23 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 B1030 OCT 100030 SPC 2 D60 DEC 60 SUB05 NOP TYPE 5 SUBCHANNEL SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB \CRET * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP \CRET NOP nþúJSB .ENTR DEF CDCBA JSB FOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP \CRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF \FMRR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF \FMRR DNAM DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP \CRET,I SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB \CLOS * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO \CLOS NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JMP FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF \FMRR DEF COPTN,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME LDA CLDCB,I SZA JMP \CLOS,I DONE WITH FILES LDA CLDCB MAKE SURE DUMMY DCB CLOSED. ADA D9 CLB STB A,I LDA CLDCB SEE IF LIST DCB CPA LDCBA RSS YES IT IS JMP \CLOS,I NO ADA P4 STA FCLS2 SAVE FOR EXEC CALL JSB EXEC DO A PAGE EJECT DEF *+4 DEF NABP3 CONTROL REQUEST FCLS2 NOP LU DEF MD17 PAGE EJECT CODE NOP JMP \CLOS,I AND RETURN * * D9 DEC 9 NABP3 OCT 100003 NO ABORT 3 * SKP * * SUBROUTINE TO CLOSE THE ABSOLUTE CORE IMAGE FILE * * CALLING SEQUENCE * JSB \TRUN * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * \TRUN NOP ASSUMES NO EXTENTS BEC TYPE 1 CLB LDA \FMRR GET \DSKD ERROR COD+YþúE SSA IF NEGATIVE THE EXACT SIZE WAS CORRECT JMP SETBL LDA ABDCB+3 TRK CMA,INA ADA ABDCB+10 CTRK - TRK MPY ABDCB+8 (CTRK - TRK) * #SEC/TR LDB ABDCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA ABDCB+11 (CTRK - TRK) * #S/TR - SEC + CSEC ARS CONVERT TO NUMBER OF BLOCKS LDB ABDCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG ADB A # OF BLKS - CURRENT BLK SETBL STB TMP JSB \CLOS DEF *+3 DEF ABDCB DEF TMP JMP \TRUN,I * TMP NOP ABDCB BSS 144 ABS FILE DCB SKP * * SUBROUTINE TO PRINT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB \PRMT * DEF *+6 * DEF PRINT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP \PRMT NOP JSB .ENTR DEF PMEMB PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH SZA SKIP IF NO QUESTION. JSB \MESS PRINT QUESTION PRMT5 LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DIDCB DEF \IDCB FROM INPUT DEVICE DEF \FMRR DEF PRADD,I DEF PRMTA DEF PRMTB LDA DIDCB GET DCB ADDRESS AND JSB \CFIL SEE IF WE HAD A FILE ERROR JMP INPRR LDA PRMTB GET LENGTH FOR PRINT ON FILE SSA,RSS IS IT A END OF F÷OþúILE JMP PRMT2 NO LDA \IACM IF THE COMMAND INPUT IS FROM AN SZA INTERACTIVE LU, THEN JMP PRMT1 TRY AGAIN FOR RESPONSE LDA TR ELSE GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB P2 ISZ EOFFL SIGNAL NO ERROR MESSAGE JMP PRMT3 * INPRR CLA STA \IACM FORCE A TR,ERRLU LDA ERR20 BY GNER JSB \GNER JMP PRMT1 TRY AGAIN * PRMT2 SZA,RSS IF 0-LENGTH RECORD JMP PRMT5 THEN SIMPLY SKIP & RETRY CLE,ELA CONVERT TO CHARACTERS STA PRMTB LDA IALST IF LIST DEVICE A FILE SZA,RSS (NON-INTERACTIVE) JMP PRMTL THEN ECHO INPUT CPA \IACM IF BOTH COMMAND AND LIST FILE RSS ARE INTERACTIVE, JMP PRMTL LDA LSTLU THEN SEE IF THEY'RE TO THE SAME CPA CMDLU LU JMP PRMTN YES, SO DON'T ECHO INPUT * PRMTL LDB PRADD GET INPUT LDA PRMTB JSB \LOUT WRITE IT ONTO LIST FILE * PRMTN LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB \TERM YES...GET OUT AND M7400 MASK TO HIGH BYTE ONLY CPA LCOMM IF A COMMA OR COLON RSS CPA LCOLN JMP PRMT6 THEN ASSUME A TR * PRMT7 LDA PRADD GET BUFFER ADDRESS LDB PPARS SET CORRECT PARSE BUFFER ADDRESS STB PADD LDB PRMTB CHARACTER COUNT JSB \PARS PADD NOP LDB PPARS GET FIRST 2 CHARS. INB LDA B,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT * INB YES - BUT CHECK LDA B,I FURTHER FOR A AND M7400 BLANK OR A CPA LBLNK COMMA IN CHARACTER 3 JMP PRMT6 CPA LCOMM RSS JMP PRMT4 PRMT6 LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB \TRCH GO DO TR THING CLA —þú RESET IF EOF-GENERATED STA EOFFL JMP PRMT1 GO RETRY COMMAND PRMT4 LDA PRMTB GET ACTUAL REPLY LENGTH JMP \PRMT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR ASTER OCT 25000 * PRMTA NOP PRMTB NOP LBLNK OCT 20000 LCOMM OCT 26000 , LCOLN OCT 35000 : SKP * * PARSE ROUTINE (MODIFIED VERSION OF $PARS) * * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB \PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 25 WORDS LONG AND CONTAINS UP TO 6 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * WSTAT = ADDR OF 25TH WORD OF OUTPUT BUF(#PRAMS). * PEMPP = CHARACTER ADDRESS *  PEMP = PARAMETER FLAG ADDRESS * PEMP1 = TEMP BUFFER FETCH ADD. * PEMP2 = TEMP BUFFER STORE ADD. * PEMP3 = LAST INPUT CHAR.+1 ADD. * PEMP4 = PARAMETER VALUE ADDRESS. * PBUF = DEF PEMP5 (7 LOCATIONS) * PBUFS = DEF PEMP5+7 * \PARS NOP CLE,ELA MAKE CHARACTER ADD. STA PEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA PEMP3 AND SET IT. LDB N24 CLEAR PARAMETER AREA STB PEMP LDB \PARS,I GET ADDRESS OF PARAM BUFF. CLA STA COMMT CLEAR COMMENT DETECTED FLAG MES1 ST þúA B,I CLEAR INB ENTIRE ISZ PEMP OUTPUT JMP MES1 BUFFER * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA PBUF INITIALIZE PEMP BUFFER ADDRESS STA PEMP1 ADDRESS OF PEMP5 STA PEMP2 * DEC10 LDB PEMPP GET THE BUFFER CHAR ADDRESS CPB PEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ PEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COMMA SEE IF A COMMA JMP DEC60 YES CPA COLON SEE IF A COLON JMP DEC60 YES CPA STAR SEE IF AN ASTERISK (COMMENT) JMP DEC60-1 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB PEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB PBUFS IF SO JMP DEC10 SKIP STORE STA PEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ PEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATPEMPT NUMERIC CONVERSION OF PRAM. * ISZ COMMT SIGNAL COMMENT STARTED DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA \PARS,I PLUS THE OP CODE ADDRESS-1 STA PEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA PEMP2 IF NO CHARACTERS CPA PBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * LDB PEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ PEMP1 YES, INCRE TO NEXT CHAR CPA PEMP1 (A) STÔþúILL = PEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB P10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB P8 SET FOR BASE 8 STB PEMP4 SET BASE ISZ PEMP,I SET FLAG TO 1 FOR NUMBER DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB PEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB P10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ PEMP1 STEP THE BUFFER ADDRESS LDA PEMP4 GET THE BASE TO A LDB PEMP1 AND THE NEXT CHAR. LOC. TO B CPB PEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB PEMP2 AND LAST CPA P10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA PBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA COMMT WAS A COMMENT BEGUN? SZA JMP DEC90 YES, EXIT LDA WSTAT,I IF LDB PEMP3 EOL OR CPB PEMPP 6 PRAMS RSS THEN CPA P6 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ PEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB PBUF GET THE PEMP BUFFER POINTER DEC85 CPB PEMP2 END OF INPUT? JMP DEC70 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, âkþúEND PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ \PARS STEP RETURN ADDRESS JMP \PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF PEMP5+6 ASCII 6TH CHAR STOP * * PEMP NOP PEMP1 NOP PEMP2 NOP PEMP3 NOP PEMP4 NOP PEMP5 NOP NOP NOP NOP NOP ASCI NOP ASCI1 NOP ASCI2 NOP * PEMPP NOP WSTAT NOP PBUF DEF PEMP5 PBUFS DEF PEMP5+7 DM58 DEC -58 COLON OCT 72 COMMT NOP SABRT NOP AASCI ASC 1, B377 OCT 377 N24 DEC -24 LASCI OCT 40 P6 DEC 6 SKP SKP * SUBROUTINE TO DETERMIN IF STACK IS TO * * BE PUSHED OR POPPED * * IF PUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPPED, IT CLOSES THE CURRENT FILE, * OPENS THE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD * SPC 1 \TRCH NOP JSB \PARS B = LENGTH, A = ADDR DEF \BPAR LDA PARS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO PUSH * TR1 JSB \CLOS CLOSE THE CURRENT FILE DEF *+3 DEF \IDCB DFZER DEF ZERO JSB POP GO POP STACK JMP POPRR ERROR, NO MORE ENTRIES STA RC SAVE RECORD COUNT JSB FOPEN OPEN PREVIOUS FILE DEF *+3 DEF \IDCB DEF B400 CLA JSB \CFIL JMP \TRCH,I FILE ERROR - STAY AT ERRLU LDA \IDCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP \TRCH,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE s‹þúTR2 ISZ COUNT ARE WE THERE YET? RSS JMP \TRCH,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF \IDCB DEF \FMRR DEF PRADD,I DEF ZERO DEF RL LDA DIDCB GET DCB ADDRES AND SEE IF AN JSB \CFIL ERROR OCCURRED JMP \TRCH,I ERROR - STAY AT ERRLU LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND PUSH * TR3 LDA \IDCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB \CLOS GO CLOSE THE FILE DEF *+3 DEF \IDCB DEF ZERO LDA RC GET RECORD COUNT JSB PUSH GO PUSH STACK JMP PUSHR ERROR - STACK OVERFLOW JMP TR4 OPEN FILE JSB RECOV INVALID LU SPECIFIED LDA ERR20 RECOVER AND ISSUE JSB \GNER ERROR MESSAGE JMP \TRCH,I * TR4 JSB FOPEN GO OPEN NEW FILE DEF *+3 DEF \IDCB DEF B400 LDA \FMRR AN ERROR? SSA,RSS JMP \TRCH,I RETURN (MAY BE TO \CFIL ITSELF) STA PUSH SAVE ERROR VALUE LDA DNAM MUST SAVE THE FILE NAME LDB DFDIR BECAUSE RECOV/POP MAY OVERLAY MVW P3 IT IF A "TR,ERRLU" IS DONE JSB RECOV RECOVER PREVIOUS ENTRY LDA PUSH RESTORE STA \FMRR THE FMP ERROR CODE LDA DFDIR NOW MOVE THE FILE NAME LDB DNAM BACK INTO THE PARSE BUFFER MVW P3 FOR THE \CFIL CALL CLA SIGNAL FILE NAME IN PARS2+1 JSB \CFIL ISSUE ERROR & TRANSFER TO ERRLU JMP \TRCH,I AND RETURN * PUSHR CCA ADA P:TR RESET THE POINTER FOR POP STA P:TR JSB RECOV RECOVER PREVIOUS ENTRY * POPRR CLA INSURE THAT A "TR,ERRLU" IS DONE STA \IACM LDA ERR19 TRANSFER STACK UNDERFLOW OR OVERFLOW JSB \GNER è…þú JMP \TRCH,I SKP RECOV NOP RECOVERS THE PREVIOUSLY OPEN STACK ENTRY JSB POP JMP NONET NONE THERE STA RC JSB FOPEN GO OPEN THE FILE DEF *+3 DEF \IDCB DEF B400 LDA RC STA \IDCB+14 JMP RECOV,I NONET CLA "TR,ERRLU" MUST BE DONE STA \IACM JMP RECOV,I * ERR19 ASC 1,19 ERR20 ASC 1,20 COUNT NOP RC NOP RL NOP B400 OCT 400 SKP * * SUBROUTINE TO PUSH AND POP A STACK * STACK DEFINITION * WORD 6= RECORD COUNT FOR NEXT RECORD TO READ * WORD 5= CARTRIDGE REFERENCE NUMBER * WORD 4= SECURITY CODE * WORD 3= 0 ELSE CH5 & CH6 * WORD 2= 0 ELSE CH3 & CH4 * WORD 1= LU ELSE CH1 & CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * PUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 6) * ASSUMES PARS2 CONTAINS INFO NEEDED * * CALLING SEQUENCE * LDA RC OF CURRENT FILE * JSB PUSH * (P+1) ERROR RETURN STACK OVERFLOW * (P+2) NORMAL RETURN * (P+3) ERROR RETURN INVALID LU * SPC 1 PUSH NOP STA P:TR,I SAVE CURRENT RECORD COUNT ISZ P:TR INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P:TR IF = JMP PUSH,I THEN OVERFLOW DLD PARS2 SAVE TYPE DST P:TR,I ISZ P:TR ISZ P:TR DLD PARS2+2 STORE CHARS 3-6 DST P:TR,I ISZ P:TR ISZ P:TR LDA PARS3+1 GET SECURITY CODE LDB PARS4+1 AND CRN DST P:TR,I ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU ISZ PUSH INVALID LU ISZ PUSH SET FOR NORMAL RETURN JMP PUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. C]™þúOUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P:TR GET CURRENT POINTER ADA MD13 DECREMENT TO PREVIOUS ENTRY LDB STKAD GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB START OF STACK JMP POP,I NO MORE ENTRIES STA P:TR SET AS NEW POINTER DLD P:TR,I GET OLD ENTRY DST PARS2 ISZ P:TR INCREMENT TO WORDS 3 AND 4 ISZ P:TR DLD P:TR,I DST PARS2+2 ISZ P:TR ISZ P:TR DLD P:TR,I STA PARS3+1 STB PARS4+1 ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU NOP INVALID LU ERROR NOT POSSIBLE HERE LDA P:TR,I GET RECORD COUNT ISZ POP GET NORMAL RETURN JMP POP,I AND RETURN SPC 2 STKAD DEF *+2 POINT TO DEFAULT LU 1 BSS 1 DEC 1 INSERT LU 1 DEC 1 AT STACK BOTTOM BSS 5 WHERE THEY DON'T REALIZE IT STACK BSS 70 ALLOWS A NESTING LEVEL TO 10 ENDST DEF * P:TR DEF STACK-1 INITIAL POINTER AFTER HARD-CODE LU 1 MD13 DEC -13 SKP * * STATE SETS THE CURRENT "STATE" FLAGS \IACM AND CMDLU, * REFLECTING THE.NEW COMMAND INPUT DEVICE/FILE. * ASSUMES PARS2 AND PARS2+1 CONTAIN THE TYPE * AND FIRST PARAMTER, RESPECTIVELY * * CMDLU = LU #, ELSE 0 FOR ASCII FILE * \IACM = 0 IF A NON-INTERACTIVE LU, OR FILE * = 1 IF AN INTERACTIVE LU * * RETURN (P+1) ERROR - INVALID INPUT LU SPECIFIED * (P+2) NORMAL * STATE NOP DLD PARS2 GET WORD0 = PARAMETER TYPE CPA P2 & WORD1 = PARAMETER CLB A TYPE 2 IS A FILE NAME STB CMDLU SO IS 0, OR THE LU CPA P2 JMP STATF FILE NAME, GO SET \IACM TO 0 * SSB JMP STATE,I CAN'T BE < 0 ADB ñõNLHN64 CHECK IF LU > 63 SSB,RSS JMP STATE,I TOO BAD! * JSB EXEC GET LU TYPE FROM EQT DEF *+6 DEF NAB13 NO-ABORT 13 CALL DEF CMDLU DEF EQT5 DEF EQT4 DEF LUSUB JMP STATE,I EXEC ERROR RETURN LDA EQT4 CHECK FOR VALID LU AND M77 IF THE SELECT CODE IS 0 SZA,RSS THEN ITS THE BIT BUCKET JMP STATE,I WE'RE EXPECTING INUT FROM! * LDA EQT5 ALF,ALF GET TYPE TO LOW A AND M77 STA EQT5 SAVE IT CPA P7 IF TYPE 7 THEN IT IS CLA AUTOMATICALLY INTERACTIVE LDB CMDLU CPA P5 TYPE 5 ? LDA LUSUB YES, GO RETRIEVE ITS SUBCHANNEL AND M77 ???CHECK STATUS? CLB * STATF SZA,RSS TYPE 0, OR TYPE 5'S SUBCHANNEL 0? INB YES, SO AN INTERACTIVE DEVICE STB \IACM 0 = NOT IA, 1 = IA ISZ STATE JMP STATE,I * EQT4 NOP NAB13 OCT 100015 LUSUB NOP ýCNÿÿþú SKP * * FILE CHECK ROUTINE * * CALLING SEQUENCE: * A-REG = FILE'S DCB ADDRESS * = 0 IF A FILE OPEN OR CREATE CALL * \FMRR = RETURNED ERROR PARAMETER * JSB \CFIL * * (P+1) ERROR RETURN * (P+2) NORMAL RETURN * * \CFIL NOP LDB \FMRR GET FMP ERROR PARAMETER SSB,RSS ANY ERROR? JMP FNOER NO ISZ ERCNT BUMP COUNTER CMB,INB SET POS FOR CONVERT STB \FMRR STA PEMP SAVE FILE DCB ADDRESS * JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF \FMRR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 & STORE IN MESSAGE LDB PEMP WAS IT AN OPEN/CREAT CALL SZB HAVING AN INVALIC DCB ADDRESS JSB ADDCB NO - CAN GET FILE NAME/LU FROM DCB * LDA DNAM ELSE GET FILE NAME FROM PARSE BUFFER LDB DFILE GET DEST ADDRESS MVW P3 IN ERROR MESSAGE AND MOVE FILENAME/LU * LDA \IACM DETERMINE IF WE ARE TO BRANCH TO SZA THE ERROR LU JMP ROUT NO, SINCE ALREADY GET INPUT FROM IA DEVICE * LDA \TRCH SAVE ITS RETURN ADDRESS STA \DSKA IN A TEMP LDA \TRCM SIMULATE A "TR,ERRLU" LDB B6 JSB \TRCH DO THE TR LDA \DSKA RESTORE THE RETURN ADDRESS STA \TRCH * ROUT JSB \SPAC LDA P20 LDB FILEA JSB \MESS SEND ERROR TO USER RSS FNOER ISZ \CFIL GET NORMAL RETURN IF NO ERROR * JSB IFBRK BREAK REQUESTED? DEF *+1 SZA JSB \TERM YES, DO ABORTIVE CLEANUP JMP \CFIL,I NORMAL RETURN SPC 2 FILEA DEF *+1 ASC 10,FMP ERR - DFILE DEF FILEA+8 DFERM DEF *+1 FERMA ASC 3, \FMRR NOP P20 DEC 20 SPC 4 * * GET THE FILE NAME/LU FROM THE DCB * ADDCB NOP ISZ ADDCB BUMP RETURN ADDRESS BY 1 LDA B,I ×Øþú GET FIRST DCB WORD AND CHECK FOR SZA,RSS AND ACTUAL FILE DCB JMP LUERR OR A LU - TYPE 0 DUMMY DCB * ***** ***** CHECK NEW DCB FORMAT AND BRANCH APPROPRIATELY ***** * LDB $BMON GET OLD/NEW DCB FLAG SLB TEST: 0=OLD 1=NEW JMP DCNEW NEW * LDB A GET LU OF AND M77 THE FILE DIRECTORY ENTRY STA PEMP1 AND SAVE BLF,RBL NOW GET THE TRACK # BLF,RBL FROM THE SAVE DCB LDA B WORD 0 AND AND M1777 STA PEMP2 SAVE ISZ PEMP BUMP TO WORD 1 OF DCB LDA PEMP,I GET OFFSET/SECTOR LDB A AND SAVE AND M377 ISOLATE SECTOR STA PEMP3 BLF,BLF LDA B NOW ISOLATE AND M377 THE OFFSET STA PEMP4 AND SAVE JMP GETFL SKIP AROUND * DCNEW LDB A GET DCB WORD 0 AND M77 MASK OFF LU STA PEMP1 AND SAVE. LDA B ALF,RAL ALF,RAL MASK OFF SECTOR # AND M177 AND SAVE. STA PEMP3 LDA B ALF,RAR MASK OF SECTOR OFFSET AND M7 AND SAVE. ALF MULTIPLY X 16 STA PEMP4 ISZ PEMP BUMP TO WORD 1 DCB LDA PEMP,I (TRACK #) STA PEMP2 AND SAVE. * GETFL JSB EXEC READ THE PROPER SECTOR DEF *+7 THE FILE DIRECTORY DEF B1 DEF PEMP1 LU OF DIRECTORY ENTRY DFDIR DEF PEMP,I BUFFER ADDRESS IN OWN DCB DEF P128 DEF PEMP2 TRACK ADDRESS DEF PEMP3 SECTOR ADDRESS LDA PEMP GET BUFFER ADDRESS & ADA PEMP4 OFFSET INTO IT FOR THE FILE NAME JMP ADDCB,I EXIT TO MOVE THE NAME * LUERR ADB P3 POSITION TO WORD 3 LDA B,I OF DUMMY DCB AND M77 AND ISOLATE THE LU STA PEMP4 SAVE FOR CONVERSION JSB CNUMD TO ASCII DEF *+3 5þú DEF PEMP4 DEF FERMA LDA "LU" MOVE 'LU' TO PRECEDE STA FERMA # IN DISPLAY LDA DFERM GET BUFFER ADDRESS JMP ADDCB,I FOR MOVE * "LU" ASC 1,LU P128 DEC 128 SKP * * INCREMENT DISK ADDRESS * * THE \DSKA SUBROUTINE INCREMENTS THE CURRENT DISK ADDRESS * TO PROVIDE THE ADDRESS OF THE SUCCEEDING SECTOR, * WHETHER THAT SECTOR IS ON THE SAME TRACK OR THE FOLLOWING * TRACK. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ... MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = CURRENT DISK ADDRESS * B = IGNORED * JSB \DSKA * * RETURN: * A = NEXT DISK ADDRESS * B = DESTROYED * \DSKA NOP STA B SAVE CURRENT ADDRESS AND M177 ISOLATE SECTOR NUMBER INA ADD 1. CPA \SCTK IF = TO MAX NO. ON SYS. DISC, CLA SET # = 0, STA DISKT AND SAVE NEW SECTOR #. LDA B ISOLATE ALF,ALF TRACK RAL ADDRESS AND M777 IN LOW A. CLB IF NEW CPB DISKT SECTOR # = 0, INA ADD 1 TO TRACK #. * ALF,RAL RESTORE TRACK # TO 14-07, RAL,RAL AND IOR DISKT INSERT SECTOR #. JMP \DSKA,I -RETURN. * DISKT NOP -TEMPORARY STORAGE M7 OCT 7 M177 OCT 177 M777 OCT 777 M1777 OCT 1777 SKP * * DISK INPUT DRIVER * * THE \DSKI SUBROUTINE CONTROLS THE INPUT FROM THE DISK. * * THIS ROUTINE USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE * 64 WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKI * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKI NOP CLE,ERA SET EVEN SECTOR ADDRESS STB \DSKO ¬„þú SAVE CORE ADDRESS FOR MOVE LDB \OBUF+1 GET OUTBUFFER ADDRESS CPA \OBUF REQUESTED SECTOR IN OUTBUFFER? JMP DIS01 YES - GO MOVE * LDB INBUF+1 REQUESTED SECTOR IN INBUFFER? CPA INBUF ? JMP DIS01 YES GO MOVE * ELA SECTOR NOT IN CORE GO CCE TO DRIVER JSB \DSKD TO READ THE SECTOR LDA DCMND SET TO SHOW CLE,ERA SECTOR IN STA INBUF CORE LDB INBUF+1 GET BUFFER ADDRESS DIS01 LDA N64 SET COUNT FOR 64 STA DISKT WORDS SEZ IF ODD SECTOR ADB P64 ADD 64 TO LOCAL BUFFER ADDRESS DIS03 LDA B,I MOVE THE STA \DSKO,I ISZ \DSKO 64 INB WORDS ISZ DISKT TO THE JMP DIS03 USER BUFFER * JMP \DSKI,I RETURN SKP * * DISK OUTPUT DRIVER * * THE \DSKO SUBROUTINE CONTROLS ALL OUTPUT TO THE * DISC. IT USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE 64 * WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKO NOP STB \DSKI SAVE CORE ADDRESS LDB DSKA GET LAST MAX ADDRESS CMB,INB SET NEG AND ADB A SUBTRACT FROM CURRENT ACCESS SSB,RSS IF CURRENT HIGHER STA DSKA THEN RESET MAX. CLE,ERA SET TO EVEN SECTOR CPA \OBUF SAME AS CURRENT SECTOR? JMP DIS02 YES - GO MOVE * ELA,CLE NO - SET TO WRITE CURRENT SECTOR STA \DSKA SAVE REQUEST ADDRESS LDA \OBUF GET BUFFER ADDRESS FOR CORE SECTOR LDB \OBUF+1 GET CORE ADDRESS OF THE SECTOR ELA,CLE CLEAR E FOR WRITE JSB \DSKD WRITE THE SECTOR LDA \DSKA GET THE REQUESTED SECTÒUþúOR LDB \OBUF+1 AND LOCAL BUFFER ADDRESS CCE SET E FOR READ JSB \DSKD READ THE SECTOR LDA \DSKA SET TO SHOW IT IS IN CLE,ERA STA \OBUF CORE DIS02 LDB INBUF IF CURRENT WRITE BUFFER CPA B IS THE READ CCB BUFFER THEN STB INBUF SHOW READ BUFFER EMPTY LDB N64 SET COUNTER FOR STB DISKT 64 WORDS LDB \OBUF+1 GET THE LOCAL BUFFER ADDRESS SEZ IF ADDRESS IS ODD ADB P64 64 TO THE BUFFER LOCATION DIS04 LDA \DSKI,I MOVE STA B,I THE INB ISZ \DSKI TO THE ISZ DISKT LOCAL JMP DIS04 BUFFER AND * JMP \DSKO,I RETURN * DSKA NOP SPC 3 \OBUF OCT 2 DEF BUFOU OUTPUT BUFFER ADDRESS INBUF OCT -1 INBUF IN CORE FLAG (IMPOSSIBLE) DEF BUFIN INPUT BUFFER ADDRESS BUFIN BSS 128 INPUT BUFFER FOR DISC BUFOU BSS 128 OUTPUT BUFFER FOR DISC SKP * THE \DSKD SUBROUTINE PERFORMS ALL I/O TO THE CORE-IMAGE * RTE SYSTEM OUTPUT FILE. THROUGHOUT THE GENERATOR, DISC * ADDRESSES ARE USED AND MAINTAINED AS IN THE OFF-LINE * VERSION SINCE RTE REQUIRES LOCATIONS OF ITEMS ON THE DISC. * DISC ADDRESSES ARE RELATIVE TO THE START OF THE DISC, THUS * ARE RELATIVE TO THE START OF THE OUTPUT FILE. * * \DSKD CONVERTS THE DISC ADDRESS IN THE A-REG (64 WORD BASIS) * TO A RECORD NUMBER WITHIN THE TYPE 1 OUTPUT FILE. READF * AND WRITF CALLS SPECIFY THIS RECORD NUMBER IN ORDER TO * SATISFY THE RANDOM ACCESS NATURE OF I/O TO THIS FILE. * * CALLING SEQUENCE: * * A = DISC ADDR ON A 64 WORD/SECTOR BASIS. * B = CORE ADDRESS. * IF B IS NEGATIVE, AND A IS POSITIVE, THEN WRITE HEADER #1 * IF B IS NEGATIVE, AND A IS NEGATIVE, THEN WRITE HEADER #2 * E = 1 FOR READ, * = 0 FOR WRITE. * * * RETURN - ALWAYS NORMAL, REGS DESTROYED. * \DSKD NOP SSB,RSS IF NEGATIVE,THEN WE'RE ŒËþú JMP DIS0 WRITING THE HEADER RECORD STB HEADR WSET FLAG CMB,INB SSA,RSS CHECK IF A IS NEGATIVE CLA,RSS NO, HEADER RECORD #1 CLA,INA HEADER RECORD #2 INA STA NUM FOR THE WRITE * DIS0 STB BUFR1 STORE CORE ADDR IN STB BUFR2 READF AND WRITF CALLS. CLB ELB STB \FMRR TEMP SAVE READ-WRITE CODE. * * COMPUTER RECORD NUMBER FROM THE DISC ADDRESS * LDB HEADR SSB JMP DIS1 HEADER RECORD - WRITE IT STA DCMND SAVE DISC ADDR. AND M177 ISOLATE SECTOR (64 BASIS). STA SECT1 XOR DCMND ISOLATE THE TRACK. ELA,CLE,ERA ALF,ALF RAL MPY \SCTK MULT. BY # 64 WD SECT/TRACK. ADA SECT1 ADD OFFSET. CLE,ERA FORM 128 WORD SECTOR # (0,1,2,,,) ADA P3 GET RECORD NUMBER (2,3,4,,,) STA NUM SAVE FOR CALL. * DIS1 LDA \FMRR SEE IF READ OR WRITE. SZA JMP READD * JSB WRITF WRITE. DEF *+6 DEF ABDCB DEF \FMRR BUFR1 NOP DEF IL DEF NUM * LDA \FMRR CHECK FOR END OF FILE. ADA P12 SZA JMP CHK NOT END. LDA ERR17 IRRECOVERABLE ERROR! JSB \IRER * READD JSB READF READ. DEF *+7 DABDC DEF ABDCB DEF \FMRR BUFR2 NOP DEF IL DEF LEN DEF NUM * * IGNORE -12 ERROR (EOF SENSED) ON READ: THAT RECORD * HAS NOT YET BEEN WRITTEN. BUFFER WILL CONTAIN * GARBAGE BUT OK FOR PACKING PURPOSES. * LDA \FMRR CPA N12 JMP \DSKD,I RETURN * CHK LDA DABDC JSB \CFIL CHECK FOR ERRORS. JSB \TERM ERROR - ABORT. CLA STA HEADR RESET JMP \DSKD,I NO ERROR, RETURN. * DCMND NOP SECT1 NOP NUM NOP IL DEC 128 LEN NOP N12 DEC -12 P12 DEC 12 ERR17 ASC 1,17 HEADR NOP HEADER RECORl`þúD FLAG SKP * * OUTPUT ABSOLUTE PROGRAM WORD * * \ABDO PUTS OUT THE CURRENT ABSOLUTE CODE WORD FOR THE PROGRAM * BEING LOADED. IT FILLS THE GAPS WITH ZERO CODES IF THE * CURRENT WORD FALLS BEYOND THE HIGHEST PREVIOUSLY GENERATED * WORD. * * \ABDO WORKS FROM A TABLE OF THREE WORDS WHICH DEFINE * THE CURRENT CODE SEGMENT'S DISC ADDRESS. THIS TABLE IS * AS FOLLOWS: * * ABDSK,I IS THE BASE DISC ADDRESS OF THE CURRENT CODE SEGMENT * \ABCO,I IS THE BASE CORE ADDRESS OF THE CURRENT CODE SEGMENT * \MXAB,I IS THE MAX CORE ADDRESS OBTAINED SO FAR IN THE SEGMENT * * \MXAB,I SHOULD BE INITILIZED TO \ABCO,I AND WILL BE UPDATED BY * THIS ROUTINE AS THE LOAD ADVANCES. * * THIS ROUTINE HAS NO RESTRICTIONS ON BACKING UP AND OVERLAYING. * * CALLING SEQUENCE: * A = CURRENT ABSOLUTE CODE WORD * B = CORE ADDRESS OF THE WORD * JSB \ABDO * * RETURN: A-REG HAS PREVIOUS CONTENTS OF MODIFIED WORD. * B-REG HAS CORE ADDRESS PLUS ONE * \ABDO NOP SSB IF LESS THAN ZERO THEN JMP \ABDO,I OVER FLOW OF MEM SO IGNOR * STB CASAV SAVE THE CORE ADDRESS STA INSAV AND THE CODE WORD ADB L2000 IF ADDRESS SSB IS ON THE JMP LABBP BASE PAGE GO DO SPECIAL * LDA \ABCO SAVE CURRENT BASE PRAM STA LABTM IN LOCAL TEMP LDB A,I IF THE CURRENT CORE LDA P5 ADDRESS IS LESS CPA \PTYP THAN THIS BASE AND SEG. LOAD CMB,INB,RSS JMP LAB01 NOT A SEG LOAD * ADB CASAV IF BOTH CONDITIONS TRUE SSB THEN JSB \USER SET UP TO FIX MAIN. LAB01 LDB CASAV RESTORE THE CORE ADDRESS CMB,INB COMPUTE OFFSET FROM OLD ADB \MXAB,I MAX INB AND STB LABSK SET THE SKIP COUNT (-# TO SKIP) LDA \MXAB,I GET THE CURRENT MAX INA PLUS ONE SSB,RSS IF NOT S' þúKIPPING LDA CASAV USE GIVEN ADDRESS LDB \ABCO,I AND COMPUTE CORE CMB,INB ADDRESS OFSET ADA B FROM THE BASE ADDRESS SSA DIAGOSTIC HALT JSB \ABOR SHOULD NEVER BE NEGATIVE CLB PREPARE TO DIVIDE DIV P64 DIVIDE BY THE SECTOR SIZE ADB \ADBF SET DBUF OFFSET STB CURAD SET ADDRESS FOR TSTEL * STA B SAVE THE SECTOR COUNT LDA ABDSK,I GET THE BASE DISC ADDRESS CMB,INB,SZB,RSS SET THE COUNT NEGATIVE JMP FSTAD IF ZERO USE FIRST ADDRESS * STB ABCNT SET THE CALL COUNTER LABSA JSB \DSKA BUMP THE DISC ADDRESS ISZ ABCNT THE SPECIFIED NUMBER JMP LABSA OF TIMES * FSTAD STA NEWDA SET THE NEW DISC ADDRESS CPA \OLDA IF SAME AS OLD JMP LABIC SECTOR IS IN CORE * LDA \OLDA GET THE OLD ADDRESS LDB \ADBF AND BUFFER ADDRESS SSA,RSS IF REAL DISC ADDRESS JSB \DSKO WRITE THE BUFFER LDB LABSK GET THE SKIP COUNT CMB,INB SET POSITIVE LDA \ADBF IF FIRST WORD OF BUFFER CPA CURAD AND NOT BACKING SSB UP RSS JMP LABRD SKIP THE READ * LDB \ADBF READ IN THE SECTOR LDA NEWDA TO BE MODIFIED JSB \DSKI LABRD LDA NEWDA UPDATE THE DISC STA \OLDA ADDRESS LABIC LDA LABSK GET THE SKIP COUNT SSA,RSS IF NONE TO SKIP JMP LABOU JUST OPUTPUT THE WORD * LABFI CLA ELSE FILL JSB TSTEL WITH ZEROS ISZ LABSK DONE? JMP LABFI NO DO NEXT WORD * LABOU LDA INSAV GET THE WORD JSB TSTEL OUTPUT IT STB LBSAV SAVE PRIOR CONTENTS OF WORD LDA CASAV GET THE CORE ADDRESS LDB A IF NEW CMB,INB MAXIMUM ADB \MXAB,I THEN SSB SET STA \MXAB,I SET IT LDA LABTM RESET Ã(þú JSB SETDS THE PRAMETERS LDA \OLDA IF NEW MAX CMA,INA DISC ADDRESS ADA \ADSK THEN LABEX LDB CASAV INB SSA,RSS SKIP RETURN JMP LABX2 * LDA \OLDA AND STA \ADSK UP DATE THE DISC ADDRESS LABX2 LDA LBSAV SET PRIOR CONTENTS OF WORD JMP \ABDO,I AND THEN RETURN SPC 2 LABBP LDB CASAV GET THE CORE ADDRESS ADB \ADBP ADJUST FOR DUMMY BASE PAGE ADDRESS LDA B,I RETURN OLD STA LBSAV CONTENTS LDA INSAV OF WORD. STA B,I SET THE WORD CLA SET TO FOURCE EXIT JMP LABEX AND GO EXIT SPC 2 LABTM NOP NEWDA NOP \OLDA OCT -1 LABSK NOP INSAV NOP CASAV NOP ABDSK NOP \ABCO NOP \MXAB NOP LBSAV NOP USED HERE AND IN TSTEL * TO RETURN OLD VALUE OF * MODIFIED WORD. ABCNT NOP CURAD NOP L2000 OCT -2000 \ADSK NOP \PTYP NOP SKP * * SETDS SETS ABDSK,\MXAB,\ABCO TO A,A+1,A+2 * FOR USE BY \ABDO * SETDS NOP STA \ABCO SET INA THE STA \MXAB ADDRESS INA FOR STA ABDSK THE ABS OUTPUT ROUTINE JMP SETDS,I RETURN SPC 3 * \USER RESETS THE \ABDO SPECIFICATION ADDRESSES FOR * DRIVER PARTITIONS (FROM 2 ONWARD), MEMORY RESIDENT * PROGRAMS, AND DISK RESIDENT PROGRAMS * * CALLING SEQUENCE * * JSB \USER * \USER NOP LDA DUSER GET DEF TO USER ARRAY JSB SETDS AND SET IT UP JMP \USER,I RETURN SPC 3 * \USRS INITIALIZES THE \ABDO SPECIFICATION ADDRESSES FOR * \USER CODE USING THE CURRENT DISC ADDRESS,AND \PREL * FOR THE CORE ADDRESS. * * CALLING SEQUENCE: * * JSB \USRS * \USRS NOP JSB \USER SET UP THE ADDRESSES JSB SET SET UP THE ADDRESSES JMP \USRS,I RETURN SPC 2 * jâþúSET SETS THE CURRENT \PREL AND DISC ADDRESSES IN THE * CURRENT \ABDO SPECIFICATION TABLE * * CALLING SEQUENCE * * JSB SET * SET NOP LDA \ADSK GET CURRENT DISC ADDRESS STA ABDSK,I SET IT IN THE SPEC BUFFER LDA \PREL GET THE CURRENT CORE ADDRESS STA \ABCO,I AND SET STA \MXAB,I IT UP JMP SET,I RETURN SPC 2 * \SEGS SETS UP A NEW \ABDO AREA FOR SEGMENTS * THE SAME AS \USRS. * \SEGS NOP JSB \SEG GO SET THE ADDRESSES JSB SET SET THE PRAMATERS JMP \SEGS,I RETURN SPC 2 * \SEG IS THE SEGMENT VERSION OF \USER * \SEG NOP LDA DSEGS GET THE ADDRESS JSB SETDS SET IT UP JMP \SEG,I RETURN SPC 3 * * \SYS SETS UP THE \ABDO SPECIFICATION ARRAY TO POINT AT THE * SYSTEM TABLE. * * CALLING SEQUENCE: * * JSB \SYS * \SYS NOP LDA \DSYS GET THE SYSTEM SPEC. ADDRERSS JSB SETDS SET UP THE ADDRESSES JMP \SYS,I RETURN SPC 2 \DSYS DEF *+1 OCT 2000 ***TEMP****** OCT 2000 ***TEMP****** NOP DUSER DEF *+1 BSS 3 DSEGS DEF *+1 BSS 3 SKP * * TEST FOR ABSOLUTE BUFFER FULL * * TSTEL PUTS OUT THE CURRENT ABSOLUTE BUFFER WHEN IT * CONTAINS 64 WORDS OF CODE. IN ADDITION, IT CHECKS FOR * * CALLING SEQUENCE: * A = CURRENT WORD * B = IGNORED * JSB TSTEL * * RETURN: A DESTROYED, B HAS OLD CONTENTS * OF ADDRESSED WORD. * TSTEL NOP LDB CURAD IF THE ADB N64 CURRENT ADDRESS CPB \ADBF IS THE END OF THE BUFFER JMP TSTFL THEN IT IS FULL * TSTOU LDB CURAD,I SAVE OLD WORD CONTENTS STA CURAD,I SET THE WORD ISZ CURAD BUMP THE ADDRESS JMP TSTEL,I AND RETURN * TSTFL STA SCW SAVE THE CURRENT WORD LDA \OLDA GET THE DISC ADDRESS LDB \A€yB@0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISK ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISK ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * **********************************************)•þú*********** * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP BEGIN JMP \SRET SEGMENT'S ENTRY POINT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 2, MES1 DEF *+1 ASC 15,# TRKS, FIRST TRK ON SUBCHNL: * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAMR? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 7,DISC MODEL # ? "/E" ASC 1,/E "?0" ASC 1,?0 MES5 DEF MES05 MES7 DEF MES07 TTEMP NOP STEMP NOP P23 DEC 23 N8 DEC -8 * ATB30 DEF TB30 HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST TRK ON SUBCHNL: * 0? * . ENTER TWO 3 DIGIT DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 7? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT SPC 3 \DST0 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB31 PUT TB31 IN THE LST JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHN SET DISK CHNL # FOR BOOTSTRAP. STA DCHNL SET DISK CHNL # ADA N8 MUST BE >= TO 10 OCTAL SSA,RSS JMP STB3pëþú0-1 JSB \INER JMP CHNLD * JSB \SPAC SET UP TRACK MAP STB30 LDA P29 SEND MESSAGE: LDB MES1 # TRKS, FIRST TRK ON SUBCHNL: JSB \MESS PRINT MESSAGE LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT *TEMP* STA INTMP AND CLEAR LOOPS ADA P8 SET # TRACKS ADDRESS STA TTEMP * TEMP * LDB N16 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT ADB "?0" ADD CONSTANT TO GET ?X BLF,BLF AND ROTATE TO GET X? STB MS3+2 SET IN MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P4 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N3 CONVERT 3 DIGITS JSB \GET# DECIMAL JMP TB30E ERROR - * STA TTEMP,I SET # TRACKS SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB \DCON 3 DECIMAL DIGITS AND CONVERT JMP TB30E+1 ERROR * STA STEMP,I SET FIRST TRACK OF CHANNEL LDA TTEMP,I GET CHANNEL SIZE STA DSIZE SET SYSTEM LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ TTEMP ADDRESSES ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P8 IS 8 THEN JMP TB30Y DONE SO GO EXIT * AÒþú JMP TB30A NOT 8 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR CLA CLEAR STA TTEMP,I CURRENT # TRACKS JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL * ADB M7400 IF GREATER THEN 256, CMB,SSB,INB,SZB RSS THEN ERROR JMP SETEM+1 JSB \INER SEND ERROR DIAGNOSTIC JMP ISYSC * SETEM CLA LDB ATB30 EXTRACT INFO ADB A CONCERNING SYSTEM LDB B,I SUBCHANNEL STB T#AC0 AND STORE VALUES FOR BOOT STB TBASE STARTING TRACK # * LDB A CLE,ERB STB UN#IT STB U#NIT * XOR P1 SET PLATTER NUMBER. ALF,ALF RAL STA H#AD STA B#MSK * LDA S#EKC ADA B STA S#EKC SET HEAD # IN SEEK COMMAND STA SKCMD * LDA R#DCM ADA B STA R#DCM AND IN THE \READ COMMAND STA R#CMD SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TR9òþúY FOR A DECIMAL JSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF RESTORE THE SIZE TO A AND STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SPC 1 AUX2 ADB M7400 IF SIZE IS GREATER CMB,SSB,INB,SZB JMP AUX4 THAN 256, THEN ERROR * STA AUXCH SET AUX CHANNEL LDA \SCTK SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 STSCR JMP \DST0,I RETURN TO MAIN LINE CODE * M7400 OCT 177400 SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB \SPAC NEW LINE RSS INVLD JSB \INER INVALID DISC MODEL # LDA P14 LDB MES40 MES40 = ADDR: DISC MODEL # ? JSB \READ PRINT MESSAGE, GET REPLY LDA N6 GET MODEL- 6 ASCII JSB \GETN JSB \MTCH TABLE SEARCH ROUTINE DEF *+6 DEF \MDTB DISC MODEL TABLE DEF \TBUF KEY (M”­þúODEL #) DEC 9 DEPTH OF SEARCH (9 VALID DISC MODELS) DEC 3 LENGTH OF KEY (WORDS) DEC 5 LENGTH OF ENTRY (WORDS) JMP INVLD INVALID MODEL-TRY AGAIN ADA P3 OFFSET INTO MODEL ENTRY LDA A,I PICK UP SECTORS/TRACK (64 WORD SECTORS) JMP DSSIZ,I RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A TEST FOR VALID SUBCHANNEL # ADB N8 SSB,RSS JMP TSTER NO GOOD * LDB ATB30 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB P8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA \TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INŒþúSTRUCTION CODE IOR DCHN INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ \TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * SPC 2 DCHN NOP HPDSK DEF I/OTB,I ADDRESS OF I/O INSTR LIST #DATA ABS I/OTB-I/OTC # OF DATA I/O INSTR #CMND ABS I/OTC-I/OTD # OF COMMAND I/O INSTR I/OTB DEF DSKDJ DATA CHANNEL DEF DSKDK DEF DSKDL DEF DSKDM DEF DSKDN DEF DSKDO DEF DSKPP DEF DSKDQ DEF DSKDR DEF DSKDS DEF DSKDZ I/OTC DEF DSKCL COMMAND CHANNEL DEF DSKCM DEF DSKCP DEF DSKCQ DEF DSKCR DEF DSKCS DEF DSKCT DEF DSKCU DEF DSKCV I/OTD EQU * HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION \BOT0 NOP CONFIGURE PAPER TAPE BOOTSTRAP LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES ISZ DCHN STEP TO COMMAND CHANNEL LDA #CMND GET NUMBER OF COMMAND CHANNEL INSTRUCTIONS JSB STDSK SET COMMAND CHANNEL ADDRESSES * LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR M0760 ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT * * SEND BOOT EXTENSION TO OUTPUT FILE * LDB ABOOT OUTPUT THE BOOT EXT ENSION CLA,CLE TO PSEUDO TRACK 0 SECTOR 0 JSB \DSKD IN CORE IMAGE OUTPUT FILE. LDA P2 INITIALIZE SYSTEM DISC ADDR STA \ADSK WHERE SYSTEM BASE PAGE WILL BEGIN SKP BOOT0 JSB \SPAC NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB \RNME GET THE NAME. * JSB \GINT IF 0 ANSWER, THEN CLA,INA NO BOOT WANTED JSB \GETN CP›pþúA ZERO JMP \BOT0,I * JSB \CRET CREATE BOOT FILE. DEF *+5 DEF \BDCB DEF P1 DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS. JMP BOOT0 ERROR- TRY AGAIN. * LDA NBLC GET BOOT LENGTH STA \TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ \TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE. DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF BOOTL * LDA \BDCB+2 IF ITS A TYPE 0 FILE SZA THEN WRITE AN EOF JMP \BOT0,I NO JSB WRITF DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF N1 JMP \BOT0,I RETURN TO MAIN. SPC 2 MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? P3 DEC 3 P5 DEC 5 P7 DEC 7 N1 DEC -1 M2300 OCT 2300 ZERO OCT 60 P14 DEC 14 P24 DEC 24 * SKP * GENERATE $TB31 TRACK MAP TABLE. * \TB31 NOP * GENERATE TB31 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA N16 GET NUMBER OF WORDS STA \TBUF+1 SET COUNT LDB $TB31 GET THE LST ENTRY JSB \LSTS FOR $TB31 JSB \ABOR BAD NEWS NO $TB31 ????? LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE * DSTB1 LDA \TBUF,I GET WORD FROM TABLE JSB \ABDO SEND TO DISC ISZ \TBUF STEP TABLE ADDRESS ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TMÂNLHO CMB,INB WRITE HEADER RECORD #1 CLA,CLE CONTAINING THE JSB \DSKD TRACK MAP TABLE IMAGE JMP \TB31,I EXIT * $TB31 DEF *+1 ASC 3,$TB31 * vƒNÿÿþú SKP * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * * \FSC0 NOP LDB ABOOT GET THE CLA,CCE BOOT FROM JSB \DSKD THE DISC LDB LWSLB STORE HIGH ADDRESS OF SYSTEM STB HIGH IN BOOT LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB \DSKD BACK TO THE DISC CLE DLD \OBUF FLUSH THE FINAL BUFFER. ELA,CLE FROM CORE JSB \DSKD * * STORE THE SYSTEM SUBCHANNEL INFORMATION IN THE 59TH * THRU 64TH WORDS OF HEADER RECORD #2, AND WRITE IT. * * CCA STA TB30+58 SIGNAL AN RTE-IV+ SYSTEM LDA SYSCH SET SYSTEM SUNBCHANNEL STA TB30+59 LDA DRT2 AND M77 STA TB30+60 SYSTEM EQT # LDA CEQT STA TB30+61 # OF EQT'S LDA \PIOC STA TB30+62 PRIV INT CHANNEL LDA \TBCH STA TB30+63 TBG CHANNEL LDA TB30+64 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET THE # OF DEFINED SUBCHANNELS BLF,BLF ROTATE TO HIGH BYTE IOR B MERGE WITH TTY CHANNEL STA TB30+64 AND SAVE LDB ATB30 CMB,INB CCA,CLE JSB \DSKD WRITE OUT SECOND HEADER RECORD * JMP \FSC0,I RETURN HED RTGN1 CONSTANTS AND WORKING STORAGE. N2 DEC -2 N3 DEC -3 N6 DEC -6 N16 DEC -16 P1 DEC 1 P2 DEC 2 P4 DEC 4 P6 DEC 6 P8 DEC 8 P13 DEC 13 P15 DEC 15 P17 DEC 17 P25 DEC 25 P29 DEC 29 P31 DEC 31 M77 OCT 77 M0760 OCT 76000 M1777 OCT 1777 M7700 OCT 177700 M1177 OCT 101777 BLANK OCT 40 MSIGN OCT 100000 * BSS BEG00+1600B-* SKP HED RT4GN DISC DRIVE I/O INSTRUCTION ADDRESSES HED RT4GN ** TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMIT9wþúS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES, READ CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 GET DISC SC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+STIO+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+STIO+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ABS STB-O+STIO+I+I YES, THEN STORE IT BACK ABS ISZ-O+STIO MOVE ON TO THE NEXT INSTR ABS LDA-O+STIO ABS CPA-O+ENIO ALL DISC IO INSTR CONFIGURED? CLB,INB,RSS YES,SET B TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE THE NEXT ONE * ABS LDA-O+TBASE GET ABSOLUTE TRACK # ABS STA-O+T#ACK SAVE FOR ADDRESSSING ABS LDA-O+N#WDS SLOAD ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT RSS SKIP ADDRESS OF BENT ABS 2000B+BENT-OO DEFINE ADDRESS OF BENT SSA NEùþúXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDA-O+T#ACK GET THE TRACK ADDRESS DSKDA OTA 0 AND SEND DSKDB STC 0,C IT ABS LDA-O+SKCMD GET THE SEEK DSKCA CLC 1 COMMAND AND DSKCB OTA 1 SEND IT DSKCC STC 1,C START SEEK ABS ADB-O+N#SCT SUBTRACK NUMBER PER SIDE SSB,RSS IF SIDE TWO ABS ADB-O+B400 ADD HEAD BIT SSB ELSE ABS ADB-O+P#SCT ADD BACK TO GET SECTOR ABS ADB-O+B#MSK ADD THE SUBCHANNEL HEAD BIT DSKDC SFS 0 WAIT FOR TRACK ABS JMP-O+DSKDC * DSKDD OTB 0 SEND HEAD/SECTOR WORD DSKDE STC 0,C TELL THE CONTROLLER ABS LDA-O+R#CMD GET THE READ COMMAND DSKCD SFS 0 WAIT FOR SEEK ABS JMP-O+DSKCD * DSKCE OTA 1 SEND READ COMMAND DSKDF STC 0,C SET UP FOR READ DSKCF CLC 1 STC 6,C START DMA DSKCG STC 1,C START READ DSKCH SFS 1 WAIT FOR END ABS JMP-O+DSKCH * STF 6 DISABLE DMA FOR STATUS DSKDG STC 0,C DO ABS LDA-O+U#NIT STATUS DSKCI CLC 1 DSKCJ OTA 1 ON UNIT DSKCK STC 1,C DSKDH SFS 0 WAIT FOR STATUS ABS JMP-O+DSKDH * DSKDI LIA 0 GET STATUS SLA,RSS IF BAD ABS JMP-O+GDST STATUS GOOD HLT31 HLT 31B STATUS HALT ABS JMP-O+HLT31 PREVENT FOR RESTARTING * GDST CLB SET SECTOR TO ZERO FOR REST OF SEGMENT ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS CLA AND ABS JMP-O+SLOAD GO LOAD * * DATA AREA T#ACK DEC -128 MOVE COUNT FOR BBDL MOVE B400 OCT 400 P#WDS OCT 77600 N#WDS DEC -128 RECNT OCT 77600 CONFIGURED TO BBL ADDRESS #WDTK DEC 6144 SKCMD OCT 30000 P#SCT DEC 24 # OF SECTORS PER TRACK ON ONE SURFACE N#SCT DEC -24 B#MSK NOP SET BY T=MþúHE GENERATOR R#CMD OCT 20000 U#NIT NOP SET BY THE GENERATOR SPCAD ABS 2000B-OO+START ADDRESS OF BOOT BEFORE RELOCATION TBASE NOP FIRST TRACK#-MUST BE AT START+143B FOR SWTCH STIO ABS 76000B-O+DSKDA START OF IO INSTRUCTIONS ENIO ABS 76000B-O+DSKDI+1 END OF I/O INSTRUCTIONS IOMSK OCT 172076 IOG OCT 102000 B77 OCT 77 HIGH NOP SC NOP * * BSS 2 CORRECT OFFSET FOR SWTCH * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 SET IN THE SWITCH REG? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THE REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+T#ACK DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+P#WDS+I+I YES GO EXECUTE THE BOOT * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP CPA EQU 052000B CPA I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO ‹#þú EQU START-11B RELATIVE PAGE LOCATION OF START HED RT4GN PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. * SPC 3 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIMIT LIA 1 READ CONTENTS OF SWITCH REGISTER SSA,RSS RECONFIGURATION DESIRED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG ELA,CLE,ERA YES, CLEAR SIGN BIT CLB LSR 6 DISC SC IN THE A REG SZA,RSS SPECIFIED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG STA DSKSC-ADCON SAVE IT LDA DATA#-ADCON GET THE # OF DATA CHANNEL INSTRUCTIONS LDB DSKAD-ADCON GET THE ADDRESS OF I/O INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE DATA CHANNEL ISZ DSKSC-ADCON COMMAND CHANNEL LDA CMND#-ADCON GET # OF COMMAND CHANNEL INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE COMMAND CHANNEL JMP CNTNU-ADCON * SETDS LDA DSKDJ-ADCON ISOLATE CURRENT DISC SELECT CODE # AND DSKSC-ADCON ALF RAL,RAL MOVE IT TO BITS 6-11 STA DSKSC-ADCON SAVE IT LIA 1 READ SWITCH REGISTER CONTENTS AND CLRDS-ADCON CLEAR BITS 6-11 IOR DSKSC-ADCON INSERT DISC SC # IN BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA T#AC0-ADCON SEEK DSKDJ OTA 0 TO DSKDK STC 0,C FIRST SYSTEM LDA S#EKC-ADCON TRACK DSKCL OTA 1 DSKCM STC 1,C AND DSKDS SFS 0 JMP *-1-ADCON HEAD * LDA H#AD-ADCON DSKDL OTA 0 START DSKDM STC 0,C SEEK LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 aTþú LDA DM128-ADCON 128 WORDS STC 2 OTA 2 DSKDZ SFS 1 WAIT FOR JMP *-1-ADCON SEEK * LDA R#DCM-ADCON SET DSKCP CLC 1 UP DSKCQ OTA 1 THE DSKDN STC 0,C \READ STC 6,C DSKCR STC 1,C START \READ DSKCS SFS 1 WAIT JMP *-1-ADCON FOR IT * STF 6 CLEAR DMA FOR STATUS DSKDO STC 0,C DO LDA UN#IT-ADCON STATUS DSKCT CLC 1 DSKCU OTA 1 DSKCV STC 1,C DSKPP SFS 0 WAIT FOR JMP *-1-ADCON STATUS * DSKDQ LIA 0 RBL,CLE,ERB REMOVE SIGN BIT FROM ADDRESS SLA,RSS ANY ERRORS? JMP BTEXT-ADCON NO, GET READY TO GO TO THE EXTENSION * CPA JSTLD-ADCON IS THIS THE FIRST TIME? RSS YES, TRY AGAIN. HLT 11B NO HALT JMP S#ART-ADCON RETRY ON RESTART * BTEXT STB A CLEAR B REG FOR THE BOOT EXTENSION CLB JMP A,I GO EXECUTE THE BOOT EXTENSION * JSTLD OCT 040001 DM128 DEC -128 BADDD ABS START-O BADD ABS START-O+I+I THESE UN#IT NOP SEVEN H#AD NOP WORDS S#EKC OCT 30000 ARE R#DCM OCT 20000 SET BY DSKDR OCT 120000 THE T#AC0 NOP GENERATOR MASK OCT 177700 DSKSC OCT 77 CLRDS OCT 170077 I#OTB DEF DSKDJ-ADCON DATA CHANNEL DEF DSKDK-ADCON DEF DSKDL-ADCON DEF DSKDM-ADCON DEF DSKDN-ADCON DEF DSKDO-ADCON DEF DSKPP-ADCON DEF DSKDQ-ADCON DEF DSKDR-ADCON DEF DSKDS-ADCON DEF DSKDZ-ADCON I#OTC DEF DSKCL-ADCON COMMAND CHANNEL DEF DSKCM-ADCON DEF DSKCP-ADCON DEF DSKCQ-ADCON DEF DSKCR-ADCON DEF DSKCS-ADCON DEF DSKCT-ADCON DEF DSKCU-ADCON DEF DSKCV-ADCON I#OTD EQU * * DSKAD DEF I#OTB-ADCON,I ADDRESS OF IO INSTR LIST DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTR CMND# ABS I#OTC-I#OTD # OF COMMAND I/O INSTR * * CNFIG NOP STA LIMIT-ADCON µ*($ SAVE # OF INSTR CLOOP LDA B,I GET INSTR WORD AND MASK-ADCON CLEAR LOW 6 BITS IOR DSKSC-ADCON ADD NEW DISC SELECT CODE STA B,I RESTORE INSTR WORD INB ISZ LIMIT-ADCON JMP CLOOP-ADCON CONFIGURE NEXT INSTR HNDR JMP CNFIG-ADCON,I RETURN * SPC 1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION * END EQU * * END BEGIN ð#*ÿÿ ÿýõ ÿ92067-18317 2001 S C0322 &RT4G2 GEN. SEGMENT #2             H0103 pDþúASMB,Q,R,C HED RT4G2 - PROGRAM INPUT PHASE SEGMENT NAM RT4G2,5,90 92067-16317 REV.2001 790817 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G2 * SOURCE PART #: 92067-18317 * REL PART #: 92067-16317 * WRITTEN BY: KFH, JH, JC, GAA, EJW * ****************************************************************** SPC 1 ENT \PIP * * EXTERNAL REFERENCE NAMES * EXT \LST1,\LST4,\LST5 EXT \CURL,\LBUF,\TBUF EXT \BPAR,\DPR2 EXT \PRMT,\LSTS,\ILST,\LSTX,\LSTE EXT \TLST,\PLST,\TIDN,\PIDN EXT \INID,\IDXS,\IDX EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 EXT \ID12,\ID13,\ID14,\ID15,\ID16 EXT \SRET,\RBIN EXT \RDCB,\CLOS,\ABOR EXT \GNER,\MESS,\SPAC,\TERM EXT \OCTN,\BUFL,\TCHR EXT \READ,\GETN,\GETC,\GET# EXT \NDCB,\FMRR,\CFIL,\RNAM EXT READF,WRITF EXT LOCF,RWNDF,APOSN EXT \NAMN,\NAMB,\NAMO EXT \IACM,\TRCM,\TRCH * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * òøþú SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 160 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 Æþú ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 SHORT ID SEGMENT COUNT - FOR SEGMENTED PROGS * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS …þú BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINKð þú FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISK ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 Ë·þú DISK ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP LSWAP NOP * * RESOLVE ANY ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA BLINE SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ BLINE DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. SPC 1 N DEC -5 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 DNAM DEF \LBUF+3 DRDCB DEF \RDCB+0 DNDCB DEF \NDCB+0 SKP * * BEGIN PROGRAM INPUT PHASE (UNDER COMMAND CONTROL). * \PIP NOP JSB \SPAC JSB \SPAC LDA P17 LDB MESS7 JSB \MESS "PROG INPUT PHASE:" LDA \PLST SET BOTTOM OF PROGRAM STA SLST DEFINED LST (INDEX #) * JSB PRCMD PROCESS OPERATOR COMMANDS. * CLA STA SCH1 STA SCH4 * * CLEAR UNDEFINED EXTS AND SET TO TYPE 5 * LDA SLST INITIALIZE \LSTX STA \TLST IGNOR PREDEFINED ENTRIES CLST3 JSB \LSTX SET LST ADDRESSES JMP ENDLB SET USAGE FLAGS * LDA \LST4,I GET IDENT INDEX CMA,INA SSA SKIP - UNDEFINED EXT JMP CLST3 IGNORE DEFINED ENTRY POINT * LDA P5 SET UNDEFINEDS TO ZERO REPLACE ENTS STA \LST4,I SET TYPE UNDEFINED CLB -Wþú STB \LST5,I CLEAR VALUE JMP CLST3 TRY NEXT LST ENTRY * ENDLB LDB D$LIR FIND THE LIBRARY JSB \LSTS ENTRY POINTS $LIBR JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 STA $LIBR SAVE FOR THE LOADER * LDB D$LIX DO SAME THING FOR $LIBX JSB \LSTS JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 STA $LIBX * JMP PARAM GO DO PARAM INPUT PHASE. * ER57 STB ENDLB SAVE ASCII ADDRESS IN TEMP LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER LDB ENDLB GET IT BACK LDA P5 CHARACTER COUNT JSB \MESS PRINT ENTRY POINT JSB \TERM ABORT ERR57 ASC 1,57 * * D$LIR DEF *+1 ASC 3,$LIBR D$LIX DEF *+1 ASC 3,$LIBX * P17 DEC 17 MESS7 DEF *+1 ASC 9,PROG INPUT PHASE: N1 DEC -1 SKP SPC 1 ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA ALBUF STA BLINE-1 LDA MD24 LDB BLANK STB BLINE-1,I ISZ BLINE-1 INA,SZA JMP *-3 JMP BLINE,I ***** STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS OR A COMMENT TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB N2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THISÊþú A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP CCA ADA QQCNT DECREMENT CHAR COUNT STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB N1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * ** PRCMD ** MAIN ENTRY POINT - CONTROL IS PASSED TO NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS OPERATOR COMMANDS. NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN COMST JMP'S HERE VIA NXTCM+1 LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * ***** CMER LDA ERR06 JSB \GNER JMP NXTCM GET NEXT COMMAND FROM TTY * ERR06 ASC 1,06 SKP ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRL²þúIES IN * COMMAND PNEUMONIC TABLE. * ***** PTABL DEF * DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST REL STATEMENT DEF DSPST DISPLAY STATEMENT DEF EOL /E STATEMENT DEF LNKST LINKS STATEMENT ***** * * COMMAND PNEUMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE RELOCATE APPEARS BEFORE REL) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+ARELC-CMTBL REL ABS 3400B+ADISP-CMTBL DISPLAY ABS 1000B+AEND.-CMTBL /E ABS 2400B+ALINK-CMTBL LINKS CTABN EQU * LTABS ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ABS 1400B+AALL.-CMTBL ALL ITAB ABS 1000B+AIN..-CMTBL IN BTAB ABS 2000B+ABASE-CMTBL BASE CPTAB ABS 3400B+ACURN-CMTBL CURRENT TTAB ABS 1000B+ATR..-CMTBL TR ITABL DEF ITAB BTABL DEF BTAB CPTBL DEF CPTAB LTABL DEF LTABS MTABL DEF MTABS TTABL DEF TTAB ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS AOFF. ASC 2,OFF AALL. ASC 2,ALL AEND. ASC 1,/E AIN.. ASC 1,IN ACURN ASC 4,CURRENT ABASE ASC 2,BASE ATR.. ASC 1,TR * HYADD DEF *+1 Œ4þú PRPTA ASC 1,- * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP SKP * * SCANNER ROUTINE * ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND z¨þúTABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I SKP * * INPUT COMMAND LINE * ***** * ** CMDIN ** INPUT NEXT COMMAND LINE * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR JSB \PRMT SEND \PRMT,READ REPLY DEF *+6 DEF PRPTA DEF P1 DEF QIBUF DEF D72 DEF \BPAR STA QQCHC JSB NXTC KLUDGE HERE JMP CMDIN+1 IF FIRST CHARACTER A *, OR IT'S CLA A BLANK LINE, THEN GO GET NEXT LINE STA QQCNT OTHERWISE RE-INIT POINTERS LDA QBUFA STA QQPTR JMP CMDIN,I AND RETURN * MOVE3 NOP SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA Í£þúB51 RIGHT PAREN? JMP MOV02 ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I NO, BUFFER IS OK IOR B40 NO,APPEND A BLLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I SPC 1 SKP * * ****COMMAND PROCESSORS**** * ***** * ** REL COMMAND PROCESSOR. * ***** RELST CLA STA NREC CLEAR #GOOD RECORDS COUNTER STA RIC STA XNAM STA SERFG INA STA POSIN SIGNAL \RBIN TO CALL LOCF. JSB \CLOS CLOSE OPEN REL INPUT FILE...IF NOT CLOSED. DEF *+2 DEF \RDCB+0 JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 IS IT A COMMA? JMP CHFNM YES...CHECK FILENAME FURTHER CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. MOVE MODULE NAME INTO XNAM BUFFER * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? RSS YES JMP CMER NO, ERROR JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 COMMA? RSS YES JMP CMER NO,ERROR * CHFNM JSB NXTC GET THE FIRST FILENAME CHAR JMP CMER NO MORE CPA B54 COMMA? JMP CMER FILENAME PARAMETER MUST BE THERE CPA B53 PLUS? ( MINUS ALREADY SKIPPED) JMP CMER INVALID * LDB A NOW CHECK IF NUMERIC ADB L60 >= "1" ? SSB JMP LDRIN OK LDB A ADB L73 < A ":"? SSB,RSS JMP LDRIN OK JMP CMER LU CAN'T BE USED * B53 OCT 53 + L60 OCT -60 L73 ÌsNLHOCT -73 XNAMA DEF XNAM ÑNÿÿþú SKP * ** DISPLAY COMMAND PROCESSOR * ***** DSPST LDA \IACM IF COMMANDS ARE FROM AND INTERACTIVE STA TIACM DEVICE, SZA JMP DISDN THEN DISPLAY ALREADY GOES TO THEM LDA \TRCM ELSE SIMULATE A "TR,ERRLU" LDB P6 JSB \TRCH * DISDN JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA ALBUF MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA N2 LDB LTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA B2 UNDEFS? JMP OLSTU CPA P1 TABLE? JMP OLSTE JMP CMER ERROR. SPC 2 DSP10 LDB ALBUF JSB \LSTS SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB \LST5,I GET VALUE LDA \LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA \LBUF+2 LDA DNAM JSB CONV CONVERT THE VALUE TO ASCII LDA P12 DSP25 LDB ALBUF JSB \MESS PRINT THE LINE DSP27 LDA TIACM DETERMINE STATE BEFORE THE DISPLAY SZA JMP NXTCM WAS ALREADY INTERACTIVE LDA \TRCM MUST POP THE "TR,ERRLU" LDB B2 WE PUT THERE JSB \TRCH WITH A "TR" ONLY JMP NXTCM * DSP30 LDA DSP40 MOVE "UNDEFINED" TO LBUF LDB DNAM MVW P5 LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED TIACM NOP TEMPORARY STORAGE OF \IACM * OLSTE CLA,INA,RSS ENTRY POINT LIST OPTION. OLSTU CLA LIST UNDEFINED SYMBOLS OPTION. STA TEMP2 SAVE LIST TYPE CLA CLEAR 'TR' INDICATOR STA MRP# SAVE *TEMP* JSB DELIM ADVANCE PAST DELIMITERS CCA SEARCH FOR LDB TTABL A TR™Êþú AFTER THE DISPLAY JSB SCAN RSS NONE ISZ MRP# YES, A TR WAS DESIRED LDA TEMP2 GET LIST TYPE AGAIN JSB EPL DO LISTING LDB TEMP2 WERE UNDEFS SZB PRINTED JMP DSP27 NO SZA,RSS WERE THERE ANY? JMP DSP27 NO LDA MRP# DID THEY WANT A TR DONE? SZA JMP NXTCM YES, DO DON'T POP STACK JMP DSP27 NO, SEE IF WE DID A TR TO DISPLAY SKP * ** MAP COMMAND PROCESSOR * * MAPMD--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS ***** MAPST LDA N5 LDB MTABL JSB SCAN JMP CMER STA B LDA MAPMD CPB P1 MODULES? IOR B2 SET BIT 1 CPB B2 GLOBALS? IOR P1 SET BIT 0 CPB P3 LINKS? IOR P4 SET BIT 2 CPB P4 OFF? CLA RESET POINTER CPB P5 ALL? IOR B7 SET BITS 2-0 STA MAPMD JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAPST JMP NXTCM GET NEXT COMMAND SPC 1 STMP NOP SVAL NOP SKP * ** LINKS IN ** COMMAND PROCESSOR. * ***** LNKST CCA LDB ITABL JSB SCAN LOOK FOR "IN" JMP CMER CCA LDB BTABL JSB SCAN LOOK FOR "BASE" JMP *+3 NO. CLA YES. JMP LNK01 CCA LDB CPTBL JSB SCAN LOOK FOR "CURRENT" JMP CMER NEITHER. CLA,INA LNK01 STA LNKMD 0=BASE, 1=CURRENT. JMP NXTCM * SKP * ***** * ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP NXTC+1 GET ANOTHEšþúR CHARACTER ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I B55 OCT 55 SKP * * RECORD PROCESSING CONTROL * ******************************************************************** * THE TRANSFER OF CONTROL TO THE APPROPRIATE RECORD PROCESSORS IS * MADE FROM THIS SECTION. ******************************************************************** * LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA P5 JMP NXTCM GET NEXT COMMAND INCHK LDA ALBUF GET BUFFER WHERE TO PUT REL. LDB POSIN GET \RBIN FLAG. JSB \RBIN GET NEXT RELOCATABLE RECORD JMP CMER FILE ERROR ON INPUT SZA,RSS EOF? JMP NXTCM END OF FILE. * * CHECK FOR LEGAL RECORD TYPE * STA TEMP1 SAVE RECORD LENGTH CLA CLEAR \RBIN FLAG. STA POSIN LDA \LBUF+1 GET TYPE WORD ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE STA RIC SAVE FOR PROCESSING SZA IF RIC=0 ADA N7 OR GREATER THAN 6 SSA,RSS ERROR? JMP RCERR YES * * TEST CHECKSUM * LDB \LBUF GET RECORD LENGTH BLF,BLF ROTATE TO LOW B CPB TEMP1 MUST BE SAME AS RETURNED BY \RBIN RSS JMP CKERR NO - ASSUME CHECKSUM ERROR CMB,INB SET TO NEGATIVE ADB P3 ADD 3 FOR WORD COUNT IN CHECKSUM SSB,RSS TEST FOR SHORT (1,3) RECORD JMP RCERR SHORT LDA ALBUF GET BUFFER ADDRESS JSB CKSUM COMPUTE CHECKSUM CPA \LBUF+2 TEST WITH GIVEN CHECKSUM JMP LDRC OK, PROCESS RECORD * CKERR LDA ERR14 GET ERROR CODE JMP ERCOV AND SEND DIAGNOSTIC ERR14 ASC 1,14 * RCERR LDA ERR04 YES...TELL THEM ILLEGAL RECORD JMP ERCOV GO TEST & PRINT MESSAGE. * * PROCESS VALID RECORD * LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFšþúG CPA P1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. CPA P5 IF END RECORD THEN PROCESS IT JMP ENDR SSB SKIP RECORD IF NOT LOADING. JMP INCHK CPA B2 IF RIC = 2, JMP ENTR GO PROCESS ENT RECORD. CPA P3 IF RIC = 3, GO TO JMP DBLR DBL RECORD PROCESSOR. CPA P4 EXT? JMP EXTR EXT RECORD PROCESSOR. CPA P6 EMA?? JMP EMAR GO PROCESS EMA RECORD * * PROCESSING FOR END RECORD. * ENDR CLA CLEAR FLAG FOR STA NAMR. NAM RECORD EXPECTED. STA SERFG SET PROG LOAD FLAG = LOADING INA STA POSIN SIGNAL \RBIN TO CALL LOCF SSB B STILL IS OLD SERFG JMP INCHK SKIP THIS END RECORD * * PROCESS END RECORD AND \LBUF+1 ISOLATE M/S RAR MOVE M/S TO SIGN POSITION IOR \ID4,I ADD TO COMMON SIZE STA \ID4,I SET M/S * LDA LWH1 COMPILED PROGRAM? SZA,RSS SKIP IF YES. JMP END2 * * SET NEW LENGTH OF COMPILED PROGRAM. * JSB LOCF SAVE CURRENT POSITION IN FILE. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS JSB \CFIL IN CASE OF FILE ERROR JSB \TERM * LDA ACBUF READ NAM REC INTO CBUF. CCB JSB \RNAM JSB \ABOR ERROR. * LDA CBUF IF 9 WORD RECORD, MAKE ALF,ALF IT 17 WORDS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF * LDA LWH2 STORE PROGRAM LENGTH. IOR SIGN SET "COMPILED" BIT. STA CBUF+6 LDA ACBUF GET NAM BUFFER ADDRESS JSB CKSUM COMPUTE & STORE NEW CHECKSUM. STA CBUF+2 * JSB WRITF WRITE RECORD TO NEW NAM FILE. DEF *+5 DEF \NDCB+0 DEF ™"þú\FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM \ABOR IF WRITE ERROR. * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * JSB APOSN RESTORE FILE POSITION. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM * END2 LDA XNAM IF XNAM ZERO, SZA CONTINUE PROCESSING RECORDS, JMP NXTCM ELSE GET NEXT COMMAND. JMP INCHK SKP * * PRELIMINARY NAM RECORD PROCESSING * ***** * * THIS PROCESSING OF NAM RECORDS OCCURS BEFORE DECIDING * WHETHER OR NOT TO RELOCATE A MODULE * ***** LDRC3 LDB NAMR. IS NAM 1ST RECORD? SZB IS NAM 1ST RECORD? JMP NMERR NO--SEQUENCE ERROR. LDB XNAMA LDA B,I SZA,RSS WAS A MODULE NAME SPECIFIED? JMP L.DC4 NO. CPA \LBUF+3 YES--DOES THIS MODULE MATCH THE NAME? INB,RSS JMP LDRC6 NO--SKIP IT LDA B,I CPA \LBUF+4 INB,RSS JMP LDRC6 LDA B,I XOR \LBUF+5 AND UPCM SZA JMP LDRC6 L.DC4 CLA STA SERFG CLEAR LOADING FLAG. ISZ NAMR. NAM NOT EXPECTED. JMP NAMR GO PROCESS NAM RECORD. * * RESET PROCESSING - PROGRAM FROM LIBRARY IS * TO BE DISCARDED. LDRC6 CLA STA NAMR. CCA STA SERFG RECORD SKIPPING MODE. JMP INCHK * NMERR LDA ERR03 MISSING END RECORD JMP ERCOV SKP * * CONSTANTS AND STORAGE FOR MAIN CONTROL SECTION * NREC NOP #GOOD RECORDS COUNTER. RIC OCT 0 HOLDS RECORD IDENTIFICATION CODE UPCM OCT 77400 UPPER CHARACTER MASK. SERFG NOP PROG LOAD FLAG: -1/0=NL/L. NAMR. NOP "NAM REC EXPECTED" FLAG. * D72 DEC 72 * ERR04 ASC 1,04¹.þú ERR03 ASC 1,03 * XNAM BSS 3 * BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) NBUF BSS 6 POSIN OCT 0 POSITIONING CODE FOR \RBIN SUBR. SKP * NAM RECORD PROCESSOR * NAMR LDA \PIDN SAVE CURRENT IDENT AND STA BUID LST ENTRY INDICES. LDA \PLST STA BULST FOR POSSIBLE MODULE PURGE LDB DNAM GET NAME ADDRESS JSB \IDXS SEARCH FOR THE ENTRY JMP ENTNA ENTER NAME * LDA ERR08 GET ERROR CODE - DUPLICATE NAMES CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET ADDRESS OF NAME IN IDENT JSB \MESS PRINT DUPLICATE PROG. NAME * JSB FINDN DID IT HAVE A MODIFIED NAM RECORD? JMP REPNA NO CLA,INA INVALIDATE THE RECORD LDB ACBUF ADB P3 STA B,I BY OVERWRITING THE NAME JSB NEWNM AND REWRITE THE RECORD JMP REPNA REPLACE REST OF IDENT * "DV" ASC 1,DV * ENTNA LDA \LBUF+3 GET NAME 1,2 STA \ID1,I SET NAME 1,2 IN IDENT CLE CLEAR DRIVER FLAG CPA "DV" WANT TO SET \ID8,I CCE IF ONE LDA \LBUF+4 GET NAME 3,4 STA \ID2,I SET NAME 3,4 IN IDENT LDA \LBUF+5 GET NAME 5 AND M7400 SAVE UPPER CHAR STA \ID3,I SET NAME 5 IN IDENT ISZ \PIDN BUMP IDENT COUNTER. * REPNA LDA \LBUF+9 GET PROGRAM TYPE AND M377 ISOLATE TYPE STA \ID6,I SET TYPE IN IDENT SZA IF NOT A DRIVER CLE THEN DON'T SAVE LENGTH LDB \LBUF+8 GET COMMON LENGTH STB \ID4,I SAVE COMMON LENGTH * LDA LNKMD SET BASE/CURRENT LINKAGE RAR AND MAP OPTIONS. IOR MAPMD STA \ID5,I CLA,INA LDB \LBUF+6 COMPILED? SSB,RSS IF YES, SKIP & SET SWITCH CLA OTHERWISE, CLEAR SWIT7>þúCH STA LWH1 LDA M7777 INITILIZE THE FIRST DBL ADDRESS STA \ID7,I TO MAX POSSIBLE CLA AND THE PROG. LENGTH TO STA LWH2 MIN. POSSIBLE SEZ IF A DRIVER, THEN STORE LDA B *TEMP* ITS SIZE HERE STA \ID8,I CLEAR BS IDENT MAIN ADDRESS LDA \DPR2 SET FILE NAME IN IDENT. INA LDB A,I STB \ID9,I INA LDB A,I STB \ID10,I INA LDB A,I STB \ID11,I ADA B2 POSITION TO SECURITY CODE LDB A,I STB \ID12,I SAVE IT ADA P4 POSITION TO CR LABEL LDB A,I STB \ID13,I LDA \NAMN STA \ID14,I SET RECORD NUMBER. LDA \NAMB STA \ID15,I SET RELATIVE BLOCK. LDA \NAMO STA \ID16,I SET BLOCK OFFSET. JMP LDRIN GET NEXT RECORD SKP * * DBL REC PROCESSOR * DBLR LDA \LBUF+3 GET THE RELOCATION ADDRESS CMA,INA IF LESS THAN CURRENT ADA \ID7,I MIN. SSA SKIP JMP DBLR1 ELSE JUST SKIP * LDA \LBUF+3 NEW MIN. SO SET IT STA \ID7,I IN THE IDENT. * DBLR1 LDA \LBUF+1 GET THE LENGTH AND M77 OF THE RECORD (NO. OF PROGRAM WORDS) ADA \LBUF+3 COMPUTE MAX. LOAD ADDRESS LDB A SAVE IN B CMB,INB IF THIS IS A NEW ADB LWH2 MAX. THEN SSB SET THE STA LWH2 NEW MAX. JMP LDRIN GO GET NEXT RECORD. SKP * * ENT/EXT RECORD PROCESSOR * ENTR CCA,RSS ENT PROCESSOR EXTR CLA EXT PROCESSOR STA NXFLG NXFLG = ENT/EXT FLAG LDA \LBUF+1 SET NO. SYMBOLS AND M37 ISOLATE NO. SYMBOLS CMA,INA STA EXCNT SET SYMBOL COUNT LDB ALBUF ALBUF = A(LBUF) ADB P3 P3 = +3 STB SYM12 SET STARTING SYMBOL ADDR * SETNX LDB SYM12 SET B FOR C\þúLSTE JSB \LSTE ENTR SYMBOL IN THE LST JMP ENTX3 NEW ENTRY GO FINISH. * * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENT JMP ENTX4 COMPLETE EXT PROCESSING * * PROCESS ENT REC * LDA SLST IF THIS IS A FORCED CMA SYMBOL ADA \TLST THEN SSA GIVE ERROR JMP DUPEN * LDA \LST4,I GET WORD 4 OF LST ENTRY SZA,RSS SKIP IF NON-ZERO (DEFINED) JMP ENTX2 MAKE ENTRY FOR DEFINED EXT * SSA SKIP IF ENTRY MADE JMP ENTX6 MAKE ENTRY FOR BS EXT * DUPEN LDA ERR05 SET CODE - DUPLICATE ENTRY POINT CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT \GNER MESSAGE LDA P5 LDB \LST1 \LST1 = ADDR OF SYMBOL JSB \MESS PRINT DUPLICATE ENTRY SYMBOL LDA \LST4,I GET THE CURRENT DEFINING ADA N5 VALUE AND IF NOT A SELF DEFINING SSA,RSS SYMBOL JMP ENTX2 GO REDEFINE THE SYMBOL * JMP ENTX5 ELSE GO REDEFINE ONLY IF NEW SELF DEF. * * ENT HERE SATISFYING A BG SEGMENT'S EXTERNAL * ENTX6 LDA \ID6,I GET CURRENT TYPE AND M7 ISOLATE TYPE CPA B2 RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS YES - CONTINUE (ERROR) CPA P4 TYPE = BG DISK RESIDENT? RSS YES JMP ENTX2 MAKE ENTRY FOR UNDEFINED EXT * LDA ERR13 SET CODE = INVALID BG BS ORDER JMP ERCO1 ENTX2 CCA GET MAIN IDENT INDEX. ADA \TIDN STA \LST4,I ENTER IDENT INDEX IN WORD 4 JMP ENTX5 * ENTX3 LDA NXFLG GET EXT/ENT FLAG SZA SKIP IF EXT ENTRY JMP ENTX2 SET WORD 4 OF ENT ENTRY * * EXT DEFINES A NEW SYMBOL * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CCB GET MAIN IDENT INDEX ADB Iþú\TIDN CPA P5 TYPE = BS? CMB,RSS YES - SET \LST4 = BS REF, SKIP CLB NO - SET \LST4 = UNDEFINED STB \LST4,I YES - SET INDEX IN LST WORD 4 ENTX4 LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP ENTX5 NO - IGNORE BG SEG MAIN ADDR * * CHECK EXT REFERENCE BY A BG SEGMENT * CCA ADA \TIDN GET CURRENT IDENT INDEX. STA IMAIN SAVE IDENT INDEX. LDA \LST4,I GET IDENT INDEX. SZA SKIP IF UNDEFINED. SSA SKIP IF IDENT INDEX. JMP ENTX5 IGNORE UNDEFINED EXT * CPA B2 IF SPECIAL SYMBOL RSS FOR GET CPA P3 THE BS RSS BIT CPA P4 JMP ENTX5 CPA P6 IF AN EMA SYMBOL LDA \LST5,I THEN GET ITS IDENT INDEX * STA \TIDN SET IDENT INDEX FOR \IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND LDA \ID4,I GET M,S SSA,RSS SKIP IF MAIN JMP NTMAN SET FLAG FOR IGNORING BS REF * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA B2 TYPE = RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 TYPE = BG DISK RESIDENT? CCB,RSS SET FLAG FOR BS REF, SKIP NTMAN CLB SET FLAG FOR IGNORING BS REF STB \TCHR SET FLAG = 0/-1 = IGNORE/BS REF LDA IMAIN GET CURRENT IDENT INDEX. STA \TIDN SET FOR NEXT IDENT. JSB \IDX SET CURRENT IDENT ADDRESSES JSB \ABOR INDEX INVALID. ISZ \TCHR SKIP - SET IDENT ADDR FOR BS REF JMP ENTX5 IGNORE IF NOT MAIN BG DISK RES * LDA \LST4,I GET BG MAIN INDEX. CPA P6 IF AN EMA SYMBOL LDA \LST5,I THE MAIN IDENT IS HERE! STA \ID8,I SET MAIN IDENT INDEX IN BS IDENT ENTX5 ‚9þúLDA SYM12 GET SYMBOL ADDR ADA P3 ADJUST FOR BOTH ENT & EXT STA SYM12 SAVE THE ADDRESS FOR NEXT SYMBOL LDB NXFLG GET EXT/ENT FLAG SZB,RSS IF EXT SKIP THE SPECIAL SYMBOL JMP ENTX8 CODE * ADB SYM12 GET THE FLAG LDA B,I AND P15 ISOLATE THE SYMBOL TYPE LDB \LST4,I IF UNDEFINED MUST SZB,RSS BE A FOURCED JMP ENTX7 SYMBOL SO DON'T RESET * SZA IF PROGRAM CPA P1 OR BASE PAGE JMP ENTX7 THEN STANDARD SYMBOL SKIP * STA \LST4,I SET THE SPECIAL FLAG LDA SYM12,I GET THE VALUE STA \LST5,I AND SET IT ENTX7 ISZ SYM12 STEP TO THE NEXT SYMBOL ENTX8 ISZ EXCNT TEST SYMBOL COUNTER JMP SETNX PROCESS NEXT SYMBOL * JMP LDRIN GO GET NEXT RECORD. SKP * * EMA RECORD PROCESSOR * EMAR LDA \ID6,I HAS AN EMA ALREADY SSA BEEN DECLARED FOR THIS MODULE? JMP EER41 YES (ERROR+BACKUP) * AND M7 GET THE MODULE TYPE - EMA'S CPA B2 AN BE USED ONLY IN RSS REAL-TIME DR CPA P3 RSS PRIVILEGED DR CPA P4 RSS AND BACKGROUND DR JMP EER40 ELSE INVALID DECLARATION (SET TO TYPE 8) * * ENTER EMA SYMBOL INTO LST AS A TYPE 6 * ENLST LDB DNAM JSB \LSTE ENTER EMA SYMBOL INTO LST JMP NEWEM NEW ENTRY LDA \LST4,I PREVIOUSLY DEFINED? SZA,RSS JMP NEWEM NO, JUST REFERENCED * LDA ERR05 DUPLICATE ENTRY POINT CMA,INA SEND ERROR JSB \GNER DIAGNOSTIC LDA P5 AND THE LDB \LST1 NAME JSB \MESS * NEWEM LDA P6 SET SYMBOL TYPE TO STA \LST4,I THAT OF AN EMA CCB SET ITS 'VALUE' TO ADB \TIDN THE IDENT INDEX OF STB \LST5,I THE MAIN PROGRAM DECLARING IT * LDB ALBUF GEÔóþúT EMA SIZE FROM INB WORD 2 OF EMA RECORD LDA B,I AND M1777 ISOLATE IT ALF ROTATE DECLARED SIZE IOR \ID5,I TO BIT (13-4) AND SET IN STA \ID5,I MODULE'S IDENT ENTRY * ADB P5 GET MSEG SIZE FROM WORD 7 LDA B,I OF EMA RECORD AND M37 ISOLATE IT ALF,RAL AND ROTATE THE DECLARED ALF,RAL SIZE TO BITS (14-10) IOR MSIGN SET BIT 15 FOR EMA IOR \ID6,I AND SET IN IDENT STA \ID6,I ENTRY JMP LDRIN GO GET NEXT RECORD * EER40 LDA ERR40 SEND ERROR DIAGNOSTIC FOR EMA CMA,INA DECLARATION BY A NON-DISC RESIDENT JSB \GNER PROGRAM LDB \ID1 GET ADDRESS OF NAME LDA P5 AND CHARACTER COUNT JSB \MESS PRINT PROGAM NAME LDA \ID6,I NOW SET ITS TYPE AS A AND M1776 'DELETED' PROGRAM IOR P8 OF TYPE = 8 STA \ID6,I UNTIL POSSIBLY RESET JMP ENLST DURING THE PARAMETER PHASE * M377 OCT 377 M1777 OCT 1777 M1776 OCT 177600 MSIGN OCT 100000 ERR41 ASC 1,41 SKP * EER41 LDA ERR41 DUPLICATE EMA'S DECLARED * ERCOV LDB SERFG IF PROCESSING A SKIP SSB JMP INCHK THEN JUST CONTINUE * CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE ERCO1 JSB \GNER SEND ERROR MESSAGE * LDA NAMR. WAS A NAM RECORD EXPECTED? SZA,RSS SKIP IF ONE WASN'T JMP ERCO2 NEEDN'T BACK UP THE INDICES LDA SERFG WAS A SKIP BEING PROCESSED? SSA SKIP IF ONE WASN'T JMP ERCO3 NEEDN'T BACK UP INDICES * LDA BUID BACK UP THE IDENT LST STA \PIDN LDA BULST AND THE ENT LIST STA \PLST * ERCO2 CCA SET THE FLUSHING STA SERFG FLAG ERCO3 CLA STA NAMR. AND CLEAR THE NAM EXPECTED FLAG. JMP INCHK GO GET THE NEXT RECORD SKP * * SUBROUTINE TO š HFBCOMPUTE CHECKSUM OF A RELOCATABLE RECORD. * * ON ENTRY: * A-REG = BUFFER ADDRESS CONTAINING RECORD * ON EXIT: * A-REG = CHECKSUM VALUE * CKSUM NOP LDB A,I GET RECORD LENGTH BLF,BLF CMB,INB NEGATE. ADB P3 SKIP WORDS 1-3. STB WDCNT RECORD WORD COUNTER. LDB A GET BUFFER ADDRESS INA LDA A,I GET WORD 2, INIT CHECKSUM ADB P3 SET TO WORD 4 ADA B,I ADD WORD TO CHECKSUM. INB INCREMENT ADDRESS ISZ WDCNT SKIP IF END OF RECORD JMP *-3 LOOP TILL DONE. JMP CKSUM,I EXIT. SKP BUID NOP SAVED IDENT INDEX BULST NOP SAVE LST INDEX N5 DEC -5 P1 DEC 1 P3 DEC 3 P4 DEC 4 P5 DEC 5 P8 DEC 8 P9 DEC 9 P12 DEC 12 P13 DEC 13 P15 DEC 15 P30 DEC 30 M7 OCT 7 M17 OCT 17 M37 OCT 37 M77 OCT 77 M177 OCT 177 M7400 OCT 177400 M7777 OCT 77777 ERR05 ASC 1,05 ERR08 ASC 1,08 ERR13 ASC 1,13 SYM12 NOP SLST NOP SIGN OCT 100000 * MES22 DEF *+1 ASC 3,(NONE) SKP * * PROCESSOR FOR END COMMAND * ***** * ** END COMMAND PROCESSOR * ***** * * PRINT LIST OF UNDEFINEDS, IF ANY, OR "NO UNDEFS" * EOL CLA JSB EPL JMP PRCMD,I END OF COMMANDS. * * ***** CONSTANTS ***** * MD24 DEC -24 B2 OCT 2 B40 OCT 40 B51 OCT 51 B54 OCT 54 q-Hÿÿþú SKP * * SET PARAMETERS INTO IDENTS * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE TYPE, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME,TYPE * NAME,TYPE,PRIORITY * NAME,TYPE,PRIORITY,EXECUTION INTERVAL * * TYPE = 3 DECIMAL DIGITS (1-255) * PRIORITY = 5 DECIMAL DIGITS (0-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * NOTE: TYPE OF BG DISK RESIDENTS HAVING BG SEGMENTS MAY NOT * BE ALTERED WITHOUT DESTROYING RELATIONSHIP. * PARAM JSB \SPAC NEW LINE LDA P10 LDB MES24 MES24 = ADDR: PARAMETERS JSB \MESS PRINT: PARAMETERS * PARST CLA,INA LDB HYADD JSB \READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARST REPEAT PARAMETER INPUT * LDA N5 JSB \GETN MOVE CHARS FROM LBUF TO TBUF CPA "/E" CHARS = /E? JMP SETLB YES - CLOSE FILE. * CPA BLANK BLANK LINE OR COMMENT? JMP PARST YES TRY ANOTHER * JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP PANOK YES - CONTINUE * PANER LDA ERR09 PARAMETER NAME ERROR JMP PARER * PANOK LDB ATBUF FIND THE PROGRAM JSB \IDXS IN THE IDENT TABLE JMP PANER NOT FOUND- INVALID NAME * * SET TYPE LDA N3 JSB \GET# CONVERT TO OCTAL JMP PATER INVALID DIGIT ADA N256 CHECK PROG TYPE <= 255 SSA,RSS WELL? JMP PATER ERROR-PROG TYPE TOO LARGE * OK - CONTINUE `þú* JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) RSS YES - CONTIMUE CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP SET PROGRAM TYPE IN IDENT * PATER LDA ERR10 PARAMETER TYPE ERROR JMP PARER * SETYP CLB IF THIS IS THE SCHEDULED PGM CCA ADA \TIDN AGAIN CPA SCH1 THEN STB SCH1 CLEAR ITS FLAG LDB \OCTN GET CONVERTED NUMBER LDA \ID6,I GET CURRENT TYPE AND M377 TO A CPA B IF NO CHANGE JMP TYPOK SKIP CHECK * CPB P14 IF CHANGE IS TO CORE RES LIB CPA P6 MUST BE LEGAL CORE RES. LIB. MODULE RSS OK SKIP JMP PATER NOT OK, ERROR CPB P8 IF A DELETION JMP TYPOK THEN JUST CONTINUE * LDA \ID6,I EMA PROGRAM? SSA,RSS JMP TYPOK NO,NEEDN'T CHECK NEW TYPE LDA B GET NEW TYPE AND M7 ISOLATE CPA B2 RT DISK RESIDENT? JMP TYPOK YES, A VALID EMA TYPE CPA P3 PR DISK RESIDENT? JMP TYPOK OK HERE TOO CPA P4 BG DISK RESIDENT? JMP TYPOK AND HERE * LDA ERR40 NOT A VALID EMA TYPE JSB PNERR JMP PARST CONTINUE ERR40 ASC 1,40 * TYPOK LDA \OCTN IF AUTO SCHED AND P64 BIT NOT SET SZA,RSS THEN JUST GO JMP SCH SET TYPE. SPC 1 LDB \OCTN AUTO SCHED...SUBTRACT ADB N80 80 FROM TYPE TO STB \OCTN GET REAL TYPE. * LDA \ID4,I M,S BIT TO E CLE,ELA LDA \ID6,I MERGE EMA INFO AND M7600 WITH TYPE. IOR B CCB ADB \TIDN B HAS IDENT INDEX. SPC 1 SEZ,RSS IF NOT MAIN PGM JMP SCH IGNOR IT AND M7 MASK TO THE ID TYPE SZA IF ZERO OR ADA N5 MORE THA¤&þúN 4 SSA SKIP STB SCH1 ELSE SET PGM IDENT IN SCH FLAG SPC 1 SCH LDB \OCTN GET NEW TYPE LDA \ID6,I INTO IDENT 6 AND M7600 IOR B STA \ID6,I SPC 1 JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARST YES - GET NEXT PARAMETER RECORD * * SET NEW PROGRAM PRIORITY * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAPER PRIORITY ERROR * SSA IF NEGATIVE JMP PAPER THEN ERROR * JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = ZERO ? (END OF BUFFER) CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY * PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR CLB SIGNAL \RNAM TO IGNORE NAME IN PARSA LDA ACBUF GET THE NAM RECORD TO CBUF. JSB \RNAM JSB \ABOR ERROR. * JSB FINDN SEARCH FOR A MODIFIED NAM RECORD JMP SETPR DID'T HAVE ONE YE$ JMP SETPR FOUND, NOW MODIFY IT SKP * * SEARCH FOR A MODIFIED NAM RECORD BELONGING TO THE * CURRENT IDENT * * RETURN: (P+1) ONE DOES NOT EXIST YET * (P+2) FOUND ONE - POSITIONED TO IT * * BRANCHES TO PACLO ON FILE ERROR (FOR TERMINATION) * FINDN NOP CLA STA IRECW LDA \ID5,I CHECK IF NAM RECORD ALREADY HAS RAL MODIFIED VERSION (COMPILED PROG). SSA,RSS JMP FINDN,I NO. * JSB LOCF YES. SAVE CURRENT WRITE POINTERS. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB RWNDF REWIND THE FILE. DEF *+3 DEF \NDCB+0 DEF \FMRR+0 * ´ þú LDA DNDCB JSB \CFIL JMP PACLO ERROR. * END1 JSB LOCF GET LOC. OF NEXT RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB READF READ THE RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF P60 DEF LEN * LDA DNDCB JSB \CFIL JMP PACLO ERROR. * LDA LEN CPA N1 JMP PACLO ERROR IF EOF. * LDB ACBUF COMARE NAM IN CBUF ADB P3 AGAINST NAM IN IDENT. LDA B,I CPA \ID1,I INB,RSS JMP END1 NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP END1 NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP END1 NO MATCH. * JSB APOSN MATCH. POSITION NEXT WRITE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * ISZ FINDN JMP FINDN,I RETURN (P+2) SKP * SETPR LDA CBUF ADJUST RECORD LENGTH FOR THOSE ALF,ALF NOT FIXED FOR COMPILED PROGRAMS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF LDB \OCTN GET PRIORITY SZB,RSS SKIP - PRIORITY ENTERED LDB P99 REPLACE ZERO PRIORITY WITH 99 LDA \ID6,I GET THE TYPE AND M177 AND ISOLATE IT SZA,RSS IF A SYSTEM PROGRAM USE CLB PRIORITY ZERO STB CBUF+10 SET NEW PRIORITY IN THE RECORD JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARWR YES - GO REWRITE THE NAM RECORD * * GET RESOLUTION CODE * LDA N2 Œþú SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+11 SET IN THE NAM RECORD * * GET EXECUTION MULTIPLE * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M1600 ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA \OCTN GET CONVERTED NUMBER STA CBUF+12 SET IN THE NAM RECORD * * GET HOURS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+13 SET IN THE NAM RECORD * * GET MINUTES * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+14 SET IN THE NAM RECORD * * GET SECONDS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+15 SET IN THE NAM RECORD * * GET TENS OF MILLISECONDS * LDA N2 SET FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = 0? (END OF BUFFER) JMP PAIER NO - INVALID DELIMITER * LDA \OCTN GET CONVERTED NUMBER STA CBUF+16 SET IN THE NAM RECORD * PARWR JSB NEWNM BUILD NEW MODIFIED RECORD JMP PARST SKP * * COMPUTE AND STORE NEW CHECKSUM, WRITE RECORD TO * NEW NAM FILE, AND SET FLAG IN IDENT. * NEWNM NOP LDA ACBUF GET BUFFER ADDRESS CONTAINING RECORD JSB CKSUM STA CBUF+2 SAVE NEW CHECKSUM * JSB WRITF WRITE RECORD. DEF *+5 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL \ABOR IF WRITE ERROR. JYþú JMP PACLO * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * LDA IRECW WAS IT AN UPDATE WRITE? SZA,RSS JMP NEWNM,I NO. * JSB APOSN YES. GET BACK TO OLD PLACE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO * JMP NEWNM,I * IRECW NOP IRBW NOP IOFFW NOP IRECR NOP IRBR NOP IOFFR NOP P60 DEC 60 LEN NOP BIT14 OCT 40000 ACBUF DEF CBUF CBUF BSS 60 SKP * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA \OCTN GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A * PAIER LDA ERR12 PARAMETER INTERVAL ERROR PARER JSB PNERR SEND ERROR MESSAGE JMP PARST TRY AGAIN * PNERR NOP SUBROUTINE TO PRINT ERROR JSB \GNER PRINT \GNER MESSAGE JSB \SPAC NEW LINE JMP PNERR,I RETURN * * PACLO LDA \FMRR WRITE ERROR? SSA,RSS JMP PARST NO. * JSB \TERM \ABOR. SKP * * CHANGE ENTS SECTION * SETLB JSB \SPAC LDA P12 GET MESSAGE LENGTH LDB MES21 SEND MESSAGE JSB \MESS 'CHANGE ENTS?' * PENT CLA,INA LDB HYADD JSB \READ \READ THE ENT RECORD. SZA,RSS IF ZERO JMP PENT TRY AGAIN * LDA N5 TO JSB \GETN TBUF CPA "/E" IF '/E' JMP EXENT DONE GO TO NEXT SECTION * CPA BLANK IF '*' OR BLANK LINE JMP PENT TRY THE NEXT LINE * JSB \GETC GET THE NEXT CHAR CPA ÁþúB40 IF COMMA JMP ENTOK OK * ENAME LDA ERR09 ELSE ERROR JMP EARER GO REPORT IT * ENTOK LDB ATBUF FIND THE JSB \LSTE DEFINE AND OR LOCATE LST NOP (DON'T CARE IF EARLIER DEFINED) * LDA \LST4,I CAN'T CHANGE THE TYPE OF CPA P6 AN EMA SYMBOL JMP EATER * LDA N2 GET TYPE FLAG JSB \GETN CARACTER CLE CPA "AB" IF ABSOLUTE CLB,CCE SET FLAG CPA "RP" IF REPLACE CLB,CCE,INB SET OTHER FLAG SEZ IF NONE OF THE ABOVE JMP ENTNO * EATER LDA ERR10 THEN SEND ERROR EARER JSB PNERR JMP PENT * ENTNO ADB P3 ADJUST TO ENT TYPE STB \IDXS SAVE IN TEMP JSB \GETC CHECK FOR COMMA CPA B40 AS NEXT CHARACTER RSS IF NOT JMP EATER BITCH * LDA \CURL SAVE CURRENT STA \ID1 POSITION LDA \BUFL FOR BACKING STA \ID2 UP LDA B7 GET NUMBER JSB \GET# ASSUMING OCTAL RSS IF ERROR MIGHT BE DECIMAL SO SKIP JMP ENTOC IT IS OCTAL SO GO SET UP * LDA \ID1 BACK UP THE SCANNER STA \CURL POSITION LDA \ID2 STA \BUFL LDA N7 NOW TRY JSB \GET# A DECIMAL CONVERSION RSS ERROR EXPECTED ( 12345D) ON THE D JMP EATER NO ERROR SO WRONG INPUT * LDA \TCHR MAKE SURE ERROR CPA P20 WAS ON A "D" RSS YES SO FAR SO GOOD JMP EATER NO GO BITCH * ENTOC LDA \IDXS SET THE ENT TYPE STA \LST4,I AND LDA \OCTN VALUE STA \LST5,I IN THE SYMBOL TABLE JMP PENT GO GET NEXT SYMBOL. * * EXENT JSB \SPAC SEND A \SPAC SKP * * SET LIBRARY, COM, TYPE TOTALS * * THIS SECTION IS EXECUTED WHEN THE PARAMETERS HAVE * BEEN COMPLETELY READ áëþúIN. IT COMPUTES THE MAXIMUM LENGTH OF * BOTH THE REAL TIME AND BACKGROUND COMMON AREAS. * IT ALSO COMPUTES THE NUMBER OF LONG(DISC & MEM RES) AND SHORT * (SEGMENT) ID SEGMENTS NEEDED TO RELOCATE THE PRESENT SET OF * PROGRAMS SPECIFIED BY IDENTS. THE NUMBER OF EMA EXTENSIONS NEEDED * IS ALSO COMPUTED BY COUNTING THE NUMBER OF EMA PROGRAMS. * * CLA STA LICNT CLEAR LONG ID SEG COUNT STA SSCNT CLEAR SHORT ID SEG COUNT STA COMRT CLEAR RT COM LENGTH STA COMBG CLEAR BG COM LENGTH STA IXCNT CLEAR ID EXTENSION COUNT STA MRACM CLEAR MR ACCESS TO COMMON FLAG JSB \INID INITIALIZE \IDX SETIX JSB \IDX SET IDENT ADDRESSES JMP \PIP,I TERMINATE ID SEGMENT COUNT * LDA \ID6,I GET TYPE AND M17 ISOLATE TYPE AND REV COM BITS LDB \ID4,I GET COMMON LENGTH SWP AND M7777 MASK OFF M,S BIT SWP CPA P11 IF PR DISK RESIDENT USING RT COMMON RSS CPA P12 OR BG DISK RES USING RT COMMON RSS CPA P1 OR TYPE = MEMORY RESIDENT? JMP SMRRC YES, CHECK COMMON DECLARATION CPA B2 OR TYPE = RT DISK RESIDENT? JMP SETRC SET RT COMMON LENGTH * CPA P9 IF MEMORY RES. USING BG COMMON JMP SMRBC YES, CHECK COMMON DECLARATION CPA P10 LIKEWISE IF RT DSC RESIDENT RSS CPA P3 TYPE = PR DISK RESIDENT?? RSS CPA P4 TYPE = BG DISK RESIDENT? JMP SETBC SET BG COMMON LENGTH * LDA \ID6,I GET TYPE AGAIN AND M37 BUT LEAVE SSGA BIT ON CPA P14 IF CORE RES LIB. RSS CPA ZERO TYPE = SYSTEM? RSS CPA P6 TYPE = LIBRARY? RSS CPA P13 TYPE = TABLE AREA II? RSS CPA P15 TYPE = TABLE AREA I? RSS CPA P16 TYPE = SLOW BOOT? RSS CPA P30 TYPE = SSGA?®1þú? SZB,RSS SKIP - HAS INVALID COMMON JMP SETR1 PROCESS NEXT IDENT * LDA ERR37 SET CODE = INVALID COMMON CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET IDENT ADDRESS JSB \MESS PRINT PROG NAME FOR INVALID COM JMP SETIX PROCESS NEXT IDENT * SMRBC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETBC LDA COMBG GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMBG SET NEW MAX BG COMMON LENGTH JMP SETR1 CHECK TYPE * SMRRC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETRC LDA COMRT GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMRT SET NEW MAX RT COM LENGTH SETR1 LDA \ID4,I GET M/S SSA,RSS SKIP IF MAIN JMP SETIX PROCESS NEXT IDENT * LDA \ID6,I AND M7 ISOLATE TYPE CPA P1 TYPE = RT RESIDENT? RSS YES, COUNT LONG ID SEGMENT CPA B2 IF RT DISC RESIDENT RSS OR CPA P3 PRIVILEGED DISC RESIDENT RSS CPA P4 BACKGROUND DISK RESIDENT ISZ LICNT COUNT A LONG ID SEGMENT * CLE CLEAR EMA FLAG LDA \ID6,I GET TYPE,EMA BIT SSA SKIP IF NO EMA DECLARED CCE INDICATE EMA AND M17 ISOLATE TYPE TO DISTINGUISH CPA P5 BETWEEN TYPES 5 AND 13 ISZ SShjþúCNT COUNT A SHORT ID SEGMENT SEZ,RSS EMA? JMP SETIX NO, GO PROCESS NEXT IDENT AND M7 MASK TYPE SZA EXCLUDE TYPE 8'S SINCE THEY'RE EMAS ARE INVALID ISZ IXCNT INCREMENT COUNT JMP SETIX CONTINUE SCAN * * ONLY4 OCT 20 BIT 4 SET ZERO OCT 0 N3 DEC -3 N7 DEC -7 P6 DEC 6 P10 DEC 10 P11 DEC 11 P14 DEC 14 P16 DEC 16 P20 DEC 20 P64 DEC 64 P99 DEC 99 N80 DEC -80 N256 DEC -256 "/E" ASC 1,/E "AB" ASC 1,AB "RP" ASC 1,RP M1600 OCT 160000 M7600 OCT 177600 IL NOP * MES24 DEF *+1 ASC 5,PARAMETERS MES21 DEF *+1 ASC 6,CHANGE ENTS? * ERR09 ASC 1,09 ERR10 ASC 1,10 ERR11 ASC 1,11 ERR12 ASC 1,12 ERR37 ASC 1,37 SKP ***** * ** EPL * ENTRY POINT LIST ROUTINE * * CALLING SEQUENCE: * (A): =0, LIST UNDEFINED EXTERNAL SYMBOLS. * =1, LIST ENTRY POINT SYMBOLS AND * * (P) JSB EPL * (P+1) (RETURN) A AND B DESTROYED * ***** EPL NOP ENTRY/EXIT POINT STA NBUF SAVE ENTRY PARAMETER. SZA,RSS UNDEFS? JMP EPL5 YES EPL0 JSB \ILST INITIALIZE SYMBOL TABLE POINTERS. EPL1 JSB \LSTX SET LST ENTRY ADDRESSES JMP EPL3 END OF SYMBOL TABLE JSB MLBUF MOVE SYMBOL TO LBUF LDB \LST4,I (B) = ENT. ADDRESS LDA NBUF (A) = ENTRY PARAMETER SZA IF ENT LIST REQUESTED JMP EPL2 GO DISPLAY. CMB,SSB,INB,SZB SKIP IF UNDEF OR BS REF. JMP EPL1 GO CHECK NEXT ENTRY. * LDA TEMP1 HEADING PRINTED? SZA JMP EPL8 YES. ISZ TEMP1 NO. SET FLAG AND LDA UNDFS PRINT "UNDEFS". LDB UNDFS+1 JSB \MESS * EPL8 LDB ALBUF LDA P5 JSB \MESS OUTPUT SYMBOL. JMP EPL1 CONTINUE SCAN * * LIST SYMBOL TABLE * EPL2 CMB,SSB,INB,SZB,RSS ENTRY DEFINED? JMP EPL1 NO ùþú JMP EPL8 PROCESS NEXT ENTRY IN LST. * * LIST UNDEFS * EPL5 LDA SLST SET BOTTOM OF PGM LST FOR SCAN. STA \TLST CLA CLEAR HEADING FLAG. STA TEMP1 JMP EPL1 * EPL3 LDA NBUF IF NO UNDEFS, ADA TEMP1 PRINT "NO UNDEFS". SZA JMP EPL,I * LDA EPL6 NO--PRINT "NO UNDEFS" LDB EPL6+1 JSB \MESS CLA JMP EPL,I SPC 1 EPL6 DEC 9 DEF *+1 ASC 5,NO UNDEFS SPC 1 * UNDFS DEC 7 DEF *+1 ASC 4, UNDEFS * * CONSTANT AND STORAGE SECTION FOR -EPL- . * M3 OCT -3 B7 OCT 7 B60 OCT 60 * * * MOVE CURRENT SYMBOL FROM SYMBOL TABLE TO LBUF * MLBUF NOP LDA \LST1 LDB ALBUF MVW P3 LDA \LBUF+2 MAKE 6TH CHAR. A BLANK IOR B40 STA \LBUF+2 JMP MLBUF,I SKP ***** * * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHARACTER (LEADING BLANK) * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A \SPAC. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAG${HFBE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * SPC 2 ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. CPA STAR IF * THEN END OF LINE RSS ISZ QGETC SKIP EXIT JMP QGETC,I * QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP STAR OCT 52 SKP * * CONSTANTS,AND MESSAGES * * ***** CONSTANTS ***** * B50 OCT 50 D15 DEC 15 B75 OCT 75 B177 OCT 177 B377 OCT 377 N2 DEC -2 LNKMD NOP LINKS FLAG. MAPMD NOP MAP FLAG. SPC 3 SPC 1 END EQU * * END LSWAP eÐHÿÿ ÿýø+$ ÿ92067-18318 2001 S C0522 &RT4G3 GEN. SEGMENT #3             H0105 tGþúASMB,Q,R,C HED RT4G3 - LOADING CONTROL SEGMENT NAM RT4G3,5,90 92067-16318 REV.2001 790817 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************************** * * NAME: RT4G3 * SOURCE PART #: 92067-18318 * REL PART #: 92067-16318 * WRITTEN BY: JJC, KFH, JH, GAA * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \GENS * * EXTERNAL REFERENCE NAMES * EXT \PART * EXT \EXIT,\CLDP EXT \LODN,\GNIO,\FSEC,\SYTB EXT \CURL,\CPL2 EXT \TBCH,\PIOC,\SWPF,\LBUF,\TBUF EXT \CONV,\ABDO,\DSKA,\DSKO,\DSKI EXT \OCTN,\ADSK,\PTYP,\TMSK EXT \GET#,\GETC,\SPAC,\READ,\GNER,\MESS,\ABOR EXT \ADBP,\PREL,\NUMP EXT \ILST,\LSTX,\LSTS EXT \LST3,\LST4,\LST5 EXT \INID,\IDX,\TIDN,\IDXS EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID8 EXT \TBLK,\MRT2 EXT \LRBP,\URBP,\IRBP EXT \CUBP,\UCBP,\ICBP,\CBPA EXT \LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 EXT \SEGS,\SYS,\USRS,\USER,\DSYS EXT \SRET,\PFIX,\TFIX,\ADBF,\OLDA EXT \TRUN EXT \IRER,\TERM EXT \ABCO,\MXAB,\TIME,\TIM1,\MULR EXT \CPLB,\ASKY,\SSID,\SKYA EXT \INER EXT \SCTK,\IBI * * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * Ö{þú 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 160 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA Ê+þúR/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLEô#þú * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS ³qþúBSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDRÊþú OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISK ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISK ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LABS CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS N1 DEC -1 N2 DEC -2 N5 DEC -5 N7 DEC -7 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 P18 DEC 18 P20 DEC 20 P22 DEC 22 P24 DEC 24 P28 DEC 28 P30 DEC 30 P31 DEC 31 P34 DEC 34 P36 DEC 36 P38 DEC 38 P40 DEC 40 P46 DEC 46 P48 DEC 48 L2000 OCT -2000 M7 EQU P7 M37 EQU P31 M77 OCT 77 M177 OCT 177 M200B OCT 200 M777 OCT 777 M1000 OCT 1000 M1777 OCT 1777 M2000 OCT 2000 M1377 OCT 137777 M7777 OCT 77777 M3777 OCT 37777 M7400 OCT 177400 M7737 OCT 77377 * LWASM EQU M7777 LWSBP OCT 1645 * HLT0 HLT 0B MSIGN OCT 100000 UBLNK OCT 20000 D$STR DEF *+1 µrþú ASC 3,$STRT SKP * * LOAD ABSOLUTE SYSTEM * * THIS SEGMENT CONTROLS THE GENERATION OF * THE ABSOLUTE CODE FOR THE SYSTEM. EACH PROGRAM * IS LOADED BY TYPE AS FOLLOWS: * * (1) TABLE AREA I * (2) SSGA & COMMON * (3) SYSTEM DRIVER AREA * (4) TABLE AREA II * (5) SYSTEM * (6) PARTITION DRIVERS * (7) RESIDENT LIBRARY * (8) MEMORY RESIDENTS * (9) RT DISK RESIDENTS * (10) PR DISK RESIDENTS (AND BG SEGMENTS) * (11) BG DISK RESIDENTS (AND BG SEGMENTS) * * EACH TYPE OF PROGRAM IS LOADED IN THE FOLLOWING MANNER: * * THE IDENTIFICATION BLOCK FOR THE PROGRAM IS LOCATED * IN IDENT. A CALL TO LOAD IS EXECUTED TO LOAD THIS PROGRAM AND * ALL CALLED SUBROUTINES. IF THE PROGRAM IS DISK RESIDENT, * THE BASE PAGE SECTION OF CODE IS WRITTEN ON THE DISK * IMMEDIATELY AFTER THE MAIN SECTION OF CODE. IF THE * PROGRAM IS RT DISK RESIDENT, THE BOUNDARIES OF THE LARGEST * SECTION OF BASE PAGE AND PROGRAM ARE SAVED. IF THE PROGRAM IS * A USER PROGRAM (OTHER THAN SYSTEM USER PROGRAM) AN ID SEGMENT IS * GENERATED. * SKP * * INITIALIZATION * \GENS LDB P64 GET FWA BP STB FSYBP SET ADDR OF FIRST SYS LINK JSB \SPAC NEW LINE * * CLEAR LST WORD 5 (SYMBOL VALUE) * JSB \ILST INITIALIZE LST ADDRESSES CLLST JSB \LSTX SET LST ADDRESSES JMP CLRID-1 CLEAR USAGE FLAGS CLA LDB \LST4,I GET TYPE ADB N7 IF SELF SSB,RSS DEFINING SKIP CLEAR STA \LST5,I CLEAR \LST WORD 5 LDA \LST3,I GET WORD 3 OF \LST ENTRY AND M7400 ISOLATE UPPER CHARACTER STA \LST3,I SET \LST WORD 3 WITH NO ORDINAL JMP CLLST CONTINUE CLEARING LST * * CLEAR PROGRAM USAGE FLAGS * JSB \INID INITIALIZE IDENT ADDRESSES CLRID JSB \IDX SET IDENT ADDRESSES JMP IDCLR ALL IDENT FLAGS CLEAR LDA \ID3,I GET USAGE FLAG þú AND M7400 SET FLAG = ZERO STA \ID3,I SET CLEARED USAGE FLAG JMP CLRID CLEAR NEXT IDENT FLAG * * CLEAR PAGE 1 FOR INDIRECT LINKS * IDCLR LDA L2000 STA WDCNT SET WORD COUNT = 2000(8) CLA LDB \ADBP GET ADDRESS OF PSEUDO BASE PAGE CLRBP STA B,I CLEAR WORD IN BASE PAGE AREA INB INCR PAGE ADDRESS ISZ WDCNT SKIP - AREA CLEARED JMP CLRBP CONTINUE CLEARING SKP * * LOAD INITIALIZATION * SPC 1 CLA STA RBTA CLEAR THE RELOCATION BASE TABLE STA TPREL STA TPBRE STA COMAD+1 STA RELAD STA \TBLK RESET THE LNKX STARTER STA LIBFG SET "NOT LOADING RES LIB" STA KEYCT STA COMAD RESET COMMON RELOC BASE STA IDSAV STA MTYPE STA DPNUM NO DP'S YET SPC 1 * SET BOUNDS FOR BASE PAGE LINK SCANNING SPC 1 STA \LRBP SHOW NO LINKS IN RESIDENT STA \URBP BASE PAGE AREA SPC 1 STA DSKMB * * SET BP LINK PARAMETERS TO ALLOCATE TOP-DOWN * FROM THE SYSMMM COMMUNICATION AREA. * CCA STA BPINC SET INC = -1 STA DPFLG NOT DP RELOC MODE * ADA LWSBP SET FIRST LINK ADDR TO STA PBREL FIRST WORD BELOW SCOM * LDA FSYBP SET BP LINK ALLOCATION STA BPLMT LIMIT TO LOWEST WORD AVAILABLE SPC 1 STA \CUBP SET CURRENT SCAN AREA TO FIRST LINK ADDR ADA \ADBP AND SET MEMORY ADDR IN RT4GN STA \ICBP IMAGE OF THE AREA * LDA M1000 SET HIGH BASE PAG INDICATOR STA HIBP FOR FIXUP BUILDING SPC 1 LDA LWSBP CURRENT PROGS SCAN AREA ENDS AT STA \UCBP SYSTEM COMM AREA SPC 1 LDA \CBPA MARK CURRENT PAGE LINK STA \CPL2 AREA EMPTY STA CPLS SPC 1 * SET RELOCATION ADDRESSES SPC 1 LDA M2000 î‘þú STA \PREL SYSTEM RELOC BASE = 2000B CLA STA DSKMR SPC 1 * SET INITIAL DISK ADDRESSES SPC 1 LDA \ADSK GET DISC ADDR AFTER BOOT EXTENSION STA DSKBP & SAVE AS DISC LOCATION OF BASE PAGE SPC 1 * SET UP VALUES FOR LATER SYSTEM ENTRY POINTS SPC 1 AND M177 MASK OFF SECTOR WHERE SYS BEGINS STA SYSEC SAVE IT LDA \ADSK ALF,ALF RAL SHIFT TRACK INTO PLACE AND M777 MASK OFF TRACK WHERE SYS BEGINS STA SYTRK SAVE IT. SPC 1 * STORE BASE PAGE ON DISK, JUST TO SAVE SPACE FOR IT SPC 1 LDA M2000 GET UPPER ADDR+1 CLB AND LOWER ADDRESS JSB BPOUT DUMP A BASE PAGE TO DISK SPC 1 * BUMP TO NEXT EVEN SECTOR SPC 1 JSB DSKEV ALIGN AT EVEN SECTOR STA \DSYS+3 AND SAVE IN \ABDO MAP SPC 1 * SET UP LABDO CONTROL WORDS TO ACCESS SYSTEM AREA OF DISK SPC 1 JSB \SYS SPC 1 * SET PROGRAM TYPE MASK TO LOOK AT WHOLE * TYPE FIELD WHEN SCANNING THROUGH IDENT LIST SPC 1 LDA M177 LOW SEVEN BITS STA \TMSK SKP * * BUILD I/O TABLES * JSB UPAG# UPDATE VAR. PAGE# FOR MESSAGES SPC 1 JSB \GNIO BRING IN SEG 5, GO TO IT SPC 1 * * LOAD TABLE AREA I MODULES * LDA P15 SET MODULE TYPE STA \PTYP LODI JSB IDSCN SCAN IDENTS JMP PSEUD END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODI * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE AND LOAD JSB INCAD UPDATE \PREL AND PBREL JMP LODI PROCESS NEXT TA.I MODULE * PSEUD JSB NOTST TEST FOR PROGRAMS LOADED SPC 1 * * * ASK FOR OVERRIDE OF DRIVER PARTITION SIZE * LDA P16 SET MAX SIZE FOR STA TEMP2 DP LENGTH * CL:óþúB LDA P2 ASK IF THEY WANT TO CMA CHANGE THE JSB CHBND SIZE AND DEF MES32 THEN STORE DEF TEMP2 THE STA DPLN NEW SIZE * * LOAD THE SYSTEM DISK DRIVER (PLUS ANY OTHER DRIVERS * THAT WILL FIT) INTO DRIVER PARTITION #1 * CCA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD DP #1 * * LOAD SSGA MODULES * JSB \SPAC MAKE IT LOOK NICE LDA P30 STA \PTYP SET MODULE TYPE LDA FPCOM GET FIRST PAGE COMMON AREA CMA,INA CONVERT TO DEC. PAGE # LDB MS31A AND STUFF IN MESSAGE. JSB \CONV LDA P38 PRINT: SUBSYSTEM GLOBAL AREA <>: LDB MES31 JSB SETHD * SSGAL JSB IDSCN SCAN IDENTS JMP SETCM END OF IDENTS LDA \ID3,I PICK UP LOAD FLAG CLB,INB IOR B SET LOADED BIT STA \ID3,I AND RESTORE JSB \LODN LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL JMP SSGAL THEN GO FIND NEXT * SETCM JSB NOTST TEST FOR PROGRAMS LOADED * * * SET UP THE REAL TIME COMMON AREA * JSB \SPAC LDA \PREL COMPUTE MAX SIZE BY STA RTCAD SUBTRACTING CURRENT CMA LOCATION FROM ADA M3777 LAST ALLOWED (APPROX. 37777) STA TEMP2 SAVE AS THE LIMIT * CLB LDA COMRT CMA ASK IF THEN JSB CHBND WANT TO DEF MES53 CHANGE THE SIZE DEF TEMP2 OF RT COMMON STA COMRT SAVE IT * LDA RTCAD LOAD STARTING ADDRESS LDB MES14+1 OF RT COMMON JSB \CONV AND STUFF IN MESSAGE LDA P20 LDB MES14 JSB \MESS AND PRINT IT JSB \SPAC SPC 1 * * SET UP BG COMMON * LDA COMRT SAVE BASE ADA \PREL ADDRESS OF STA BGCAD BG COMMON * ADA COMBG BUMP TO END OF DECLAñþúRED ADA N1 IOR M1777 ROUND TO END OF PAGE STA TEMP2 SAVE TEMPORARILY LDB BGCAD GET FWA BG COMMON CMB,INB AND SUBTRACT ADA B IN ORDER TO GET DEFAULTED INA SIZE STA COMBG AND SAVE NEW SIZE * LDB TEMP2 GET LAST WORD ADDRES CMB,INB AND SUBTRACT FROM LAST ADB M3777 ALLOWED ADDRESS STB TEMP2 AND SAVE AS UPPER LIMIT * CMA CLB,INB ASK IF THEY JSB CHBND WANT TO DEF MES57 CHANGE THE DEF TEMP2 SIZE OF BG COMMON * ADA COMBG UPDATE BG COMMON SIZE STA COMBG BY THAT SIZE * LDA BGCAD LOAD STARTING ADDR LDB MES18+1 OF BG COMMON JSB \CONV AND STUFF IN LDA P20 MESSAGE LDB MES18 JSB \MESS PRINT IT * LDA COMBG LOAD NEW SIZE OF BG CMA,INA COMMON AND LDB MES62+1 STUFF IN MESSAGE JSB \CONV (DECIMAL) LDA P16 LDB MES62 JSB \MESS AND PRINT IT JSB \SPAC * * WRITE HALTS ON DISK FOR RT AND BG COMMON AREAS * LDA COMRT GET TOTAL ADA COMBG COMMON SIZE LDB \PREL GET RELOC BASE SZA,RSS JMP NOCOM JUMP IF NO COMMON * CMA,INA SET LOOP COUNTER STA TCNT TO -(LENGTH OF COMMON) WTCOM LDA HLT0 GET HALT 0 VALUE JSB \ABDO WRITE ONE ISZ TCNT HALT AT A TIME JMP WTCOM UNTIL DONE * STB \PREL UPDATE RELOC BASE FOR SDA NOCOM STB FWSDA SAVE START ADDRESS OF SDA * SKP * * LOAD SYSTEM DRIVER AREA * SPC 1 CLA SET TO SCAN FOR STA \PTYP TYPE 0 MODULES JSB UPAG# UPDATE PAGE#. CMA,INA CONVERT TO DECIMAL. LDB MS63A JSB \CONV CONVERT PAGE # AND LDA P36 STUFF IN MESSAGE. LDB MES63 PRINT: 3yHFB JSB SETHD "SYSTEM DRIVER AREA <>:" * * SDAL JSB SCDRV GET NEXT DRIVER JMP SYSTB END OF IDENTS JMP SDAL A PRD - GO GET NEXT DRIVER LDA \ID3,I PICK UP CLB,INB USAGE FLAG IOR B AND SET STA \ID3,I LOADED BIT * JSB \LODN LOAD THE MODULE JSB INCAD UPDATE PBREL & \PREL JMP SDAL PROCESS NEXT DRIVER SPC 1 * * RESERVE SPACE AND SET UP SYSTEM TABLES * IN TABLE AREA II. * SYSTB JSB UPAG# UPDATE PAGE # FOR SEG 5. JSB NOTST TEST FOR PROGRAMS LOADED JSB \SYTB GO DO IT IN SEG 5 SPC 1 * * LOAD TABLE AREA II MODULES * LDA P13 SET MODULE TYPE STA \PTYP LODII JSB IDSCN SCAN IDENTS JMP ENDII END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODII IGNORE LOADED PROGRAMS * STB \ID3,I UPDATE WORD 3 USAGE FLAG. JSB \LODN INITIATE AND LOAD THE PROGRAM JSB INCAD UPDATE \PREL & PBREL JMP LODII PROCESS NEXT TA.II MODULE * ENDII JSB NOTST TEST FOR PROGRAMS LOADED * CCA GET LAST WORD USED BY ADA \PREL TABLE AREA II MODULES IOR M1777 AND ROUND TO END OF PAGE INA GET FIRST WORD ADDRESS OF NEXT PAGE STA FWPRV AND SAVE AS PRIV LOAD PT ‰„Hÿÿþú SKP * INITIALIZE FOR SYSTEM LOADING * LDA PBREL SAVE LAST(LOWEST) INA BP LINK USED STA LOLNK IN TABLE AREAS, ETC STA BPLMT AND USE A UPPER LIMIT FOR SYSTEM LINKS * CLA,INA RESET THE ALLOCATION OF LINKS UPWARD STA BPINC LDA FSYBP STARTING AT STA PBREL LOCATION 100 * CLA CLEAR THE HIGH BASE PAGE LINK STA HIBP REQUEST FOR NEW FIXUP ENTRIES * LDA \CBPA RESET THE CP LINK ARE POINTERS STA \CPL2 TO 'EMPTY': LAST CP AREA=LAST BP AREA STA CPLS LAST 'SAVE' CP AREA=LAST BP AREA * * LOAD SYSTEM MODULES * JSB \SPAC LDA \PREL GET STARTING RELOCATION STA FWSYS ADDRESS AND SAVE JSB UPAG# UPDATE PAGE # FOR MESSAGE. CMA,INA CONVERT PAGE # TO DECIMAL. LDB MS12A AND STUFF ASCII HERE. JSB \CONV LDA P24 LDB MES12 PRINT: SYSTEM <>: JSB SETHD AND INITIALIZE IDX CLA STA \PTYP SET TO SCAN SYSTEM MODULES * SYLD JSB IDSCN SCAN IDENTS FOR TYPE 0 MODULES JMP SYEND END OF IDENTS LDB \ID8,I CHECK IF AN EQT WAS DEFINED SSB FOR THIS MODULE, IN WHICH CASE JMP SYLD IT'S A DRIVER SO DON'T LOAD HERE LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED JMP SYLD IGNORE USED PROGRAM * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE & LOAD PROGRAM JSB INCAD UPDATE \PREL & PBREL JMP SYLD PROCESS NEXT SYSTEM PROGRAM * SYEND JSB NOTST TEST FOR PROGRAMS LOADED * CCA SET LAST WORD ADA \PREL USED BY SYSTEM STA LWSYS CODE JSB CPAG# CONVERT TO A PAGE # AND M37 AND SET AS LAST USED BY SYSTEM STA LPSYS AND SAVE SKP * * * LOAD SLOW BOOT, AND SET LWSLB - MUST BE <= 77577 IF * MA+³þúC DISC SYSTEM OR <= 77377 FOR ICD BASED SYSTEM. * * LDB DCNFG GET BUFFER ADDRESS OF $CNFG JSB \IDXS NOW GO FIND ENTRY JMP ER57 NOT THERE - NO GOOD FOR YOU LDB \ID3,I SET USAGE FLAG INB IN WORD 3 STB \ID3,I TO INDICATE LOADED JSB \LODN NOW LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL LDB \IBI GET ICD SYSTEM FLAG LDA \PREL CHECK FOR OVERFLOW CMA,INA ADA M7737 PAST 77377 FOR ICD DISC SYSTEM SLB,RSS ADA M200B PAST 77577 FOR MAC BASED SYSTEM SSA,RSS JMP NOVF NO OVERFLOW * LDA ERR18 YES, MUST ABORT JSB \IRER ISSUE DIAGNOSTIC & ABORT * ER57 LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER INDICATING A MISSING SYSTEM MODULE LDA P5 NOW SEND THE MODULE LDB DCNFG NAME TOO JSB \MESS JSB \TERM ABORT THEM NOW ERR57 ASC 1,57 DCNFG DEF *+1 ASC 3,$CNFG * * NOVF CCA ADA \PREL STA LWSLB SAVE LAST USED ADDRESS STA B SAVE FOR CHECK IOR M1777 ROUND TO END OF CURRENT CPA B PAGE - ANY CHANGE AT ALL? CLB,RSS IF NOT, THEN DON'T ZERO-FILL STA B JSB CPAG# GET THE PAGE # AND M37 STA LPSLB AND SAVE IT TOO! CLA MIGHT AS WELL SZB SKIP IF NO EXTRA WORDS ADDED TO ZERO JSB \ABDO ZERO-FILL THE REMAINDER * * INITIALIZE LOCATIONS 2 AND 3 IN THE BASE PAGE SO $STRT * WILL BE ENTERED FROM BOOT-UP * LDB D$STR GET THE LST ENTRY FOR $STRT JSB \LSTS GO FIND IT JSB \ABOR OH-OH, TOO BAD! LDB \ADBP GET ADDRESS FOR THE JMP,I START ADB P2 LDA JMP3I GET JMP 3,I CODE STA B,I AND SET IN BP LOCATION 2 INB INCREMENT TO BP LOCATION 3 LDA \LST5,I GET ADDRES OF $STRT STA B,I AND SET IN 3’/þú * * * DUMP SYSTEM LINKS (AND TRAP CELLS) FROM THE LOW PART OF * BASE PAGE TO DISK, AND CLEAR THAT IMAGE AREA. THE PRD'S * AND ALL MEMORY AND DISK RESIDENT PROGRAMS CANNOT SHARE * (OR SEE) ANY LINKS BELOW HILNK ('HIGHEST SYSTEM LINK') * ANYHOW, SO THEY ARE NOT NEEDED IN THE GENERATER ANY LONGER. * THE AREA WILL BE USED FOR MEMORY AND DISK RESIDENT PROGRAM * LINKS. * LDA \ADSK SAVE THE CURRENT DISK ADDRESS STA TEMP4 LDA DSKBP BACK UP THE DISK ADDR TO THE STA \ADSK START OF THE SYSTEM BP * CLB START AT LOW ADDR AND LDA PBREL CONTINUE UP TO LAST SYS LINK JSB BPOUT AND WRITE THE LINKS THERE * LDA TEMP4 RESTORE THE STA \ADSK DISK ADDRESS * LDA P2 CLEAR BP IMAGE OF SYSTEM LDB PBREL LINKS, STARTING AT JSB CLRLT 2 * * * LOAD PARTITION-RESIDENT DRIVERS INTO DP'S #2 ONWARD * CLA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD 'EM ALL JSB NOTST TEST FOR PROGRAMS LOADED SKP * * INITIALIZE FOR MEMORY RESIDENT LIBRARY & PROGRAM LOADING * LDA PBREL SAVE THE LOWEST INA BP LINK USED STA LOLNK BY THE PRD'S STA BPLMT AND AS UPPER LIMIT FROM NOW ON * * SET THE SYSTEM BASE PAGE SCAN AREA TO INCLUDE ONLY THE * UPPER PORTION OF BASE PAGE CONTAINING TABLE AREA, SSGA, * AND DRIVER LINKS. * STA \LRBP SAVE LOWEST DRIVER LINK AS LOWEST ADA \ADBP SYSTEM LINK, AND STA \IRBP SAVE THE RT4GN IMAGE ADDRESS LDA LWSBP SET LAST LINK BEFORE SCOM, +1 STA \URBP AS LAST SYSTEM LINK * CLA RESET FLAGS STA SDID STA HIBP CLEAR AGAIN * * CLEAR THE FIXUP TABLE HERE * STA \PFIX ALL REMAINING UNDEFS ARE LOST * INA SET THE BP LINK ALLOCATION STA BPINC UPWARDS INA STA PBÀšþúREL FROM LOCATION 2 * * SET UP THE CURRENT PROGRAM'S BASE PAGE SCAN AREA * STA \CUBP SET LOWEST MEM RES LINK AT 2 ADA \ADBP AND SET ITS RT4GN STA \ICBP IMAGE ADDRESS LDA LOLNK SET THE LAST AVAILABLE MEM RES LINK,+1 STA \UCBP AS LOWEST (UPPER) SYSTEM LINK * LDA \CBPA CLEAR THE STA \CPL2 CURRENT PAGE STA CPLS LINK AREAS * * DETERMINE MEMORY RESIDENT LIBRARY LOAD POINT * LDB \MRT2 ARE MEMORY RESIDENTS TO SZB ACCESS TABLE AREA II? JMP MYES YES, SET LOAD ADDRESS LDA FWSDA GET FIRST WORD OF SDA LDB MRACM DID ANY MR DECLARE ACCESS TO COMMON/SSGA? SZB,RSS LDA LWDP1 NO, SET LOAD ADDRESS TO COMMON START JMP SETP YES,SET LOAD PT TO SAME AS SDA * MYES LDA FWPRV OTHERWISE GET PRIV LOAD POINT SETP STA \PREL SET RELOCATION ADDRESS STA LBCAD AND FIRST WORD OF MEMORY RES LIBRARY JSB DSKEV START MRL ON AN EVEN SECTOR BOUNDARY STA DSKMR AND SAVE THE ADDRESS JSB \USRS INITIALIZE THE \ABDO SPEC'S * CCA SET LIB FLAG TO SHOW LIB LOADING STA LIBFG SO ONLY TYPE 6 PROGRAMS WILL LOAD JSB CLRT6 GO CLEAR LOAD FLAGS FOR TYPE 6 PGMS * * LOAD LIBRARY * LDA P14 SET TO GET RESIDENT LIB. ROUTINES STA \PTYP LDA FPMBP CONVERT (MEM RES BASE PG +1) CMA TO ASCII DECIMAL. LDB MS13A JSB \CONV LDA P40 PRINT MESSAGE: MEMORY RESIDENT... LDB MES13 LIBRARY <>: JSB SETHD AND INITIALIZE IDX LDLB JSB IDSCN SCAN IDENTS JMP LBEND END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED LIBRARY ROUTINE JMP LDLB IGNORE USED PROGRAM * LDA P14 IF THIS IS A FOURCE LOAD CPA \PTYP THEN STB \ID3,I ‚„þú SET THE LOADED FLAG JSB \LODN INITIATE AND \LODN MAIN PROGRAM JSB INCAD UPDATE BP, PROG RELOC ADDR JMP LDLB PROCESS NEXT LIBRARY PROGRAM * LBEND CLA,INA DID WE FINISH LOADING LIB FOR CPA \PTYP RESIDENT?? JMP COMTS YES, CONTINUE...... STA \PTYP NO, SET UP LDA M7 THE SCAN STA \TMSK MASK LDA P10 AND RESET STA CIDNT THE LST POINTERS JMP LDLB AND RESTART SPC 1 COMTS JSB NOTST PRINT "NONE" IF NO LIB JSB \SPAC SKIP A LINE SPC 1 * CLEAN UP AFTER LOADING LIBRARY SPC 1 CLA CLEAR THE STA LIBFG "LIBRARY LOADING" FLAG * * ZERO-FILL THE LAST PAGE CONTAINING THE MEMORY RESIDENT LIBRARY * IN ORDER TO START THE MEMORY RESIDENT PROGRAM AREA ON A PAGE * BOUNDARY. * CCA GET THE LAST WORD OCCUPIED ADA \PREL BY THE MRL, AND ROUND STA LEND IOR M1777 IT UP TO A PAGE INA BOUNDARY STA \PREL SAVE AS RELOCATION ADDRESS OF STA FWMRP THE MEMORY RESIDENT PROGRAM AREA * LDB LBCAD GET THE STARTING ADDR OF THE CMB,INB MRL, AND COMPUTE ITS SIZE ADA B (INCLUDING THE ZERO-FILL) JSB CPAG# CONVERT TO # PAGES ADA FPMBP ADD TO THE MRBP PAGE # INA ADD MRBP SIZE STA FPMRP AND SET FIRST PAGE OF MEM RES PROGRAMS SPC 1 * RESET CP LINK AREA POINTERS SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA SKP * * LOAD MEMORY RESIDENT PROGRAMS * RRLDD LDA FPMRP CONVERT FIRST MEM RES PAGE # CMA,INA TO ASCII DECIMAL AND LDB MS15A STUFF MESSAGE. JSB \CONV LDA P34 LDB MES15 PRINT: MEM RESIDENTS <> JSB SETHD PRINT HEADING, INITIALIZE IDX Ãþú RRLD JSB IDSCN SCAN IDENTS JMP RREND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP RRLD IGNORE SUB LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP RRLD IGNORE LOADED PROGRAM * STB \ID3,I SET NEW USAGE FLAG JSB \USER RESET THE \ABDO MAP TO MEM RES SPEC'S JSB \LODN INITIATE AND LOAD MAIN PROGRAM * JSB \SYS RESET TO SYSTEM MAP TO CLA JSB GENID GENERATE ID SEGMENT, KEYWORD CLA NO PARTITION REQMT CCB ADB \TIDN IDENT INDEX (\TIDN POINTS TO NEXT ENTRY) JSB IDFIX GO SET MEM PROTECT INDEX NOP ERROR RTN NOT POSSIBLE HERE JSB INCAD UPDATE BP, PROG RELOC ADDR LDA TPREL GET RELOCATION PTR CMA,INA ADA LWASM TEST FOR MEM OVERFLOW SSA,INA,SZA NO OVRFLO IF POS,0,OR -1 JSB \TERM ABORT-WE'VE ALREADY SENT ERR18 JMP RRLD OK-PROCESS NEXT RT RESIDENT * RREND JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE JSB CCPLK PACK THE CURRENT PAGE LINKAGE AREA JSB BPDSA OUTPUT REMAINDER OF RECORD * * * DUMP THE MEMORY RESIDENT BASE PAGE TO DISK * STA DSKMB SAVE THE BASE PAGE DISK ADDRESS LDB P2 START AT LOW ADDRESS LDA PBREL AND DUMP ALL THE MEMORY JSB BPOUT RESIDENT LINKS ALLOCATED * * COMPUTE THE NUMBER OF PAGES OCCUPIED BY THE MEMORY RESIDENT * LIBRARY AND MEMORY RESIDENT PROGAMS. * CCA GET THE LAST WORD OCCUPIED BY ADA \PREL THE MEMORY RESIDENT PROGRAM AREA STA EMRP IOR M1777 AND ROUND IT TO A PAGE INA BOUNDARY (IE,ZERO-FILL) LDB LBCAD GET THE STARTING ADDRESS OF THE CMB,INB MEMORY RES LIBRARY, AND COMPUTE ADA B THE ENTIRE MEMORY RESIDENT SIZE JSB CPAG# CONVERT TO # PAGES STA MRP# AND ÌþúSAVE THE # PAGES OCCUPIED BY MEM RES ADA FPMBP ADD TO PAGE # OF MRBP INA ADD SIZE OF MRBP STA PAGE# AND SAVE THE NEXT PHYSICAL PAGE # * CMA,INA DETERMINE IF THERE EXISTS ADA \NUMP ENOUGH MEMORY PAGES FOR THE SSA,RSS MEMORY RESIDENT AREA JMP IRTDR INIT FOR RT DISK RESIDENTS * LDA ERR61 JSB \IRER ISSUE DIAGNOSTIC & TERMINATE ERR61 ASC 1,61 SKP * * INITIALIZE FOR REAL TIME DISK RESIDENT LOADING * IRTDR LDA P2 STA \PTYP SET TO FIND TYPE 2 PROGS STA MTYPE * JSB DEMTL DEMOTE ALL TYPE 6 AND 14 PROGS TO TYPE 7 * * SET BPLINK SCAN AREA FOR CURRENT PROGRAM AND BOUNDS * FOR BP LINK ALLOCATION. NOTE THAT THAT BP LINK ALLOCATION * REMAINS SET IN THE "UPWARD" DIRECTION FROM MEM RESIDENT * LOADING, AND LIMIT IS STILL LOLNK. SPC 1 LDA P2 SET LOWEST DISK LINK STA PBREL STARTING AT 2 STA \CUBP ADA \ADBP AND SAVE ITS IMAGE STA \ICBP ADDRESS. LDB LOLNK SET UPPER DISK LINK AS STB \UCBP BELOW SYS,LIB, AND SSGA LNKS * * CLEAR BASE PAGE IMAGE OF MEMORY RESIDENT PROGRAM LINKS SPC 1 LDA PBREL START CLEAR AT 2 & END BEFORE LOLNK JSB CLRLT AND GO DO IT SPC 1 * RESET CP LINK AREA POINTERS TO "EMPTY" SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA STA \CPLB (FOR PACK),AND FOR SEGMENT LOADING JMP RDLD SKIP RESETTING OF TYPE/HEADING FOR BG * TEMP3 NOP TEMP4 NOP SKP * * LOAD RT & BG DISK RESIDENTS * SETBG LDA P3 SET BG PROGRAM TYPE LDB "BG" AND HEADING TYPE STB MS16 SAVE BG IN HEADING STA \PTYP BG DISK RESIDENT STA MTYPE RDLD LDA P17 LDB MES16 MES20 = ADDR: XX DISK RESIDENTS JSB SETHD  þú PRINT HEADING INITIALIZE IDX BDLD JSB DSKEV LOAD DISC RESIDENTS ON EVEN SECTOR STA EMDSK SAVE IN CASE AN EMA PROG CLA KILL ANY LEFT OVER FIX UPS STA \PFIX STA SDID CLEAR SEGMENT COUNTER JSB IDSCN SCAN IDENTS JMP BDEND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP BDLD IGNORE SUBS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP BDLD IGNORE LOADED PROGRAM * * INITIALIZE FOR LOADING * STB \ID3,I SET NEW USAGE FLAG CCA STA EMLNK CLEAR EMA INDICATORS STA EMLST ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IDSAV SAVE MAIN IDENT INDEX FOR BS REF * LDA \PTYP GET CURRENT PROGRAM TYPE CPA P2 RSS CPA P3 ARE WE SETTING THE LOAD PT FOR JSB SETPV RT/BG PRIVILEGED PROGRAMS JSB SETRB OR BG PROGRAMS JSB \USRS SET UP A NEW USER JSB \LODN INITIATE AND \LODN MAIN PROGRAM * * BUILD ID SEGMENT, SEND LINKS TO DISK * JSB \SYS RESET TO SYSTEM MAP CCA JSB GENID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINDER OF RECORD LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBS SAVE DISK ADDR OF BP SECTION LDA TBREL GET UPPER BP ADDRESS LDB PBREL GET LOWER BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA TPREL GET CURRENT PROG RELOC ADDR STA BSPAD SAVE PROG RELOC ADDR FOR BS STA TPMAX SET HWM FOR MAIN JSB CCPLK PACK THE CP LINK AREA LDA \CPL2 UP DATE STA CPLS THE LOW SAVE ADDRESS * LDA TBREL GET CURRENT BP RELOC ADDR STA BSBAD SAVE BP RELOC ADDR FOR BS * * SEARCH FOR THE PROGRAM'S SEGMENTS * LDA P5 STA \PTYP SET TYPE = BG SEGMENT JSB \INID INITIALIZE IDX BSLD JSB \IDX SET IDENT ADDRESSES Áÿþú JMP BSEND END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE MAIN BS IDENT INDEX LDA \ID4,I GET M OR S SSA,RSS SKIP IF MAIN BG SEGMENT JMP BSLD IGNORE SUBS LDA \ID6,I GET TYPE AND M37 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP BSLD NO - IGNORE IDENT * LDA \ID8,I GET BS MAIN \IDENT INDEX CPA IDSAV BS CALLS THIS BG MAIN? RSS YES - CONTINUE JMP BSLD NO - IGNORE BACKGROUND SEGMENT LDA \TIDN GET NEXT IDENT INDEX STA ABSID SAVE INDX FOR NEXT BG SEG SCAN CCB STB HDFLG SET HEADING FLAG FOR BG SEGMENT JSB DSKEV SET FOR EVEN SECTOR JSB \SEGS SET UP A NEW USER AREA LDA BSPAD RESET THE LDB \ABCO STA B,I BASE CORE ADDRESSES FOR LDB \MXAB STA B,I A SEGMENT LOAD JSB \LODN LOAD BG SEGMENT * LDA CPLS RESET THE CP LINK STA \CPL2 BOTTOM JSB \SYS RESET TO SYSTEM MAP JSB \SPAC NEW LINE CCA JSB GNSID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINING OF ABS REC * LDB TPREL SUBTRACT SEG'S HIGH ADDR LDA B FROM PREV MAX CMA,INA HIGH ADDR ADA TPMAX SSA IF NEW IS HIGHER STB TPMAX THEN STORE AS MAX * ISZ SDID SET SEGMENT FLAG FOR IDFIX LDA TBREL GET UPPER BP ADDRESS LDB BSBAD GET LOWER BS BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA BSBAD GET BS BP RELOC ADDR LDB TBREL GET UPPER BOUND BP ADDRESS JSB CLRLT CLEAR BP LINKAGES LDA BSBAD GET BS BP RELOC ADDRESS STA TBREL SET BP RELOC ADDR LDA BSPAD GET BS PROG RELOC ADDRESS STA TPREL SET PROG RELOC ADDR LDA ABSID GET NEXT BG SE®þúG IDENT INDEX STA \TIDN SET IDENT INDEX FOR IDX JMP BSLD LOAD NEXT BG SEGMENT * * * FIX ID SEGMENT OF MAIN * BSEND LDA TPMAX PASS MAX HIGH ADDR LDB \PREL AND LOW ADDR, THEN JSB PGREQ SET A-REG LDB IDSAV PASS PAGE REQMT & IDENT JSB IDFIX INDEX THEN FIX iD SEG. JMP CLBPL ERROR RETURN ON EMA'S * * UPDATE BP LINKS (IE, EMA) * LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBR SAVE CURRENT DISK ADDR OF ABS LDA DSKBS GET DISK ADDR FOR MAIN BP CODE STA \ADSK SET CURRENT BP CODE ADDRESS LDA BSBAD GET UPPER ADDR OF BP CODE LDB PBREL GET LOW ADDR FOR BP CODE JSB BPOUT OUTPUT BP CODE FOR MAIN DISK RES LDA DSKBR GET CURRENT DISK ADDRESS STA \ADSK SET CURRENT ABS DISK ADDRESS CLBPL LDA PBREL GET LOW BP ADDRESS LDB BSBAD GET UPPER BOUND BP CODE JSB CLRLT CLEAR BP LINKAGES * LDA MTYPE RESET THE MAIN PROGRAM TYPE STA \PTYP SET PROG TYPE = XX DISK RESIDENT JSB CLID3 CLEAR PROGS-LOADED FLAGS LDA IDSAV GET MAIN IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX LDA \CPLB RESET THE LOW SAVE ADDRESS STA CPLS RESET FOR BG MAIN STA \CPL2 PROGRAMS JMP BDLD LOAD NEXT BG DISK RESIDENT * BDEND LDA \PTYP CPA P4 RSS JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE LDA \PTYP SET PROPER HEADING AND TYPE CPA P4 IF PRIVILEGED PROGRAMS WERE JUST JMP PD DONE, THEN MOVE ON CPA P2 IF REAL-TIMES WERE JMP SETBG JUST DONE, THEN GO SET FOR BG'S INA ELSE SET FOR TYPE 4 BG'S STA \PTYP SET CURRENT PROGRAM TYPE STA MTYPE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG TO -1 LDA P10 START IDENT TABLE SCAN STA CIDNT BACK TO BEGINNING ÉxB@ #BLOCKS. ARS GET # OF 128 WORD BLOCKS ADA TEMP6 GET TOTAL # OF 128 WD BLKS CMA,INA CONVERT TO ASCII DECIMALB¾þú LDB ATBUF JSB \CONV DO IT. LDA \TBUF STA MES39+6 LDA \TBUF+1 STA MES39+7 LDA \TBUF+2 STA MES39+8 * LDA P46 PRINT MESSAGE: " = XXXXXX BLOCKS ... LDB MES39 ...(128 WORDS/BLOCK)" JSB \MESS JSB \SPAC * * LDA DSKAV FORCE ACESS TO LAST RECORD LDB \ADBF SO TRUNCATE WILL WORK. JSB \DSKI JSB \TRUN CLOSE CORE-IMAGE FILE. * JMP \EXIT DO FINAL CLEANUP * * M4000 OCT 4000 M377 OCT 377 M72 OCT 72 P16 DEC 16 P96 DEC 96 P14 DEC 14 NLCOM OCT 177645 USCLN OCT 035000 ": " SPC 5 * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SPC 5 * * GET PRESENT CORE ADDRES AND UPDATE THE CURRENT PAGE #. * * ENTRY: A/B IGNORED * RETURN: (P+1) * A - CURRENT PAGE # OF \PREL. * B - UNALTERED. * UPAG# NOP LDA \PREL ALF,RAL RAL AND M77 MASK OFF PAGE BITS. STA PAGE# UPDATE IT. JMP UPAG#,I SKP *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * SYSTEM TABLE DEFINITION * * FWCMM DEF USRTR-133B . EQU USRTR-130B * XIDEX EQU .-3 ID EXTENSION ADDR OF CURRENT PROG XMATA EQU .-2 MAT ENTRY ADDR OF CURRENT PROG XI EQU .-1 ADDR OF I-REG SAVE AREA EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQ"0þúU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQEEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT SUSPEND' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA USER BASE PAGE LINK AREA BPA2 EQU .+59 LWA USER BASE PAGE LINK AREA BPA3 EQU .+60 %þú FWA USER BASE PAGE LINK LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME COMMON RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF RT PARTITION AVMEM EQU .+65 LWA+1 OF REAL TIME PARTITION BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BACKGROUND PARTITION * * UTILITY PARAMETERS * TATLG EQU .+69 NEGATIVE LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF USER ENTRY POINTS IN LEP LIST DSCUT EQU .+75 DISC ADDR OF RELOC DISK RES LIBR SYSLN EQU .+76 # OF SYSTEM ENTRY POINTS IN LEP LIST LGOTK EQU .+77 LOAD-N-GO: LU, ST TRACK, # OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF BACKGROUND PARTITION HED RTGN3 - LOADING CONTROL SEGMENT SUBROUTINES. * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTS * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT ?Vþú RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * IDFIX: SETS UP WORDS 21, 28 & 29 OF A LONG ID SEGMENT * AND BUILDS AN ID EXTENSION FOR EMA PROGRAMS * * WORD 21 FORMAT - BIT 15: 1=PARTITION ASSIGNED * 10-14: PARTITION SIZE REQMT. IN PAGES * NEGLECTINBBBASE PAGE (#PAGES-1) * 7-9: MEM PROTECT FENCE TBL INDEX * 6: RESERVED (0) * 0-5: ASSIGNED PARTITION NUMBER-1 * * WORD 28 - 15-10: ID EXTENSION INDEX * 9-0: EMA SIZE * * WORD 29 - HIGH MAIN ADDRESS OF LARGEST SEGMENT, ELSE 0 * * CALLING SEQUENCE: * * JSB \SYS (OR MAKE SURE \ABDO IS MAPPING SYSTEM) * A= #PAGES NEEDED BY PROGRAM INCL. BASE PAGE * B= INDEX OF IDENT ENTRY FOR PROG * JSB IDFIX * * * RETURN: * (P+1): ERROR ON MSEG SIZE OF EMA PROG * (P+"): NORMAL RETURN SPC 1 IDFIX NOP SZA DON'T INCLUDE BASE ADA M1 PAGE IN SIZE. STA IDTM1 SAVE PAGE REQMT STB \TIDN STORE DESIRED ENTRY INDEX JSB \IDX AND BRING INTO CORE JSB \ABOR NOT THERE * LDA \ID6,I WAS THIS AN EMA PROGRAM? SSA,RSS JMP SETMP NO, CONTINUE WITH MPFT INDEX * * DETERMINE PROGRAM'MMMAXIMUM MSEG SIZE AND CHECK AGAINST * THE DECLARED SIZE IN ID6 (14-10), OR SET IF DEFAULTED * CCA ROUND THE HIGH MAIN OF THE PROGRAM OR ADA TPMAX ITS LARGEST SEGMENT TO THE START IOR M1777 OF THE NEXT PAGE INA STA EHM BITS 14-10 CONTAIN THE LOG START PAGE OF MSEG * JSB CPAG# GET THE PAGE # AND USE IT TO CMA,INA DETERMINE THE MAXIMUM MSEG SIZE ADA P31 SSA,RSS IF Tû¹þúHERE DOES NOT EXIST AT SZA,RSS LEAST 2 PAGES (1 EACH FOR MSEG AND OVFLOW) JMP EER43 THEN DELETE PROG FROM SYS * STA MMSEG SAVE MAX MSEG SIZE LDA \ID6,I GET DECLARED JSB CPAG# SIZE FROM IDENT AND M37 SZA,RSS DEFAULTED? JMP MDFLT YES, USE MMSEG * STA B SAVE FOR LATER CMA,INA IS THE DECLARED MSEG SIZE GREATER ADA MMSEG THAN THE MAX? SSA,RSS JMP EMAF1 NO, ITS OK * * INVALID MSEG SIZE - BACK UP DISK ADDRESS AND GET RID OF * PROGRAM'S ID SEGMENT(S) * EER43 LDA ERR43 SEND ERROR DIAGNOSTIC CMA,INA JSB \GNER JSB \SPAC * LDA EMDSK BACKUP THE DISK ADDRESSES STA \ADSK OVER THE EMA PROGRAM CCA AND THE KEYWORD POINTER ADA CURAK STA CURAK LDB N33 NOW THE LONG ID SEGMENT ADDRESS ADB SYSAD STB SYSAD STB CURAI SET FOR ZOUT LDB N33 CLEAR THE ENTIRE JSB ZOUT ID SEGMENT USED BY MAIN LDA \ID6,I GET PROGRAM TYPE AND M1776 AND MASK IT OUT IOR P8 SET IT TO A TYPE 8 MAIN (DELETED) STA \ID6,I AND STORE * LDA SDID WERE THERE ANY SZA,RSS SEGMENTS? JMP IDFIX,I NO ALF,RAR BACK-UP THE SHORT ID-SEG ADDRESS ADA SDID BY 9 WORDS EACH CMA,INA STA B SAVE FOR ZOUT ADA \SSID AND RESET THE NEXT STA \SSID SHORT ID-SEG ADDRESS ADA P11 BUMP TO ACTUAL START STA CURAI OF ID SEG JSB ZOUT AND CLEAR ALL OF THEM * LDA SDID NOW BACK UP THE CMA,INA KEYWORD COUNTER AS WELL ADA \SKYA STA \SKYA * JMP IDFIX,I ERR43 ASC 1,43 M1776 OCT 177600 P8 DEC 8 SPC 2 MDFLT LDA MMSEG GET MAXIMUM MSEG SIZE STA B ALF,RAL AND POSITION TO BITS 14-10 ALF,RAL ˜–þúIOR \ID6,I AND STORE IN IDENT ENTRY STA \ID6,I OF PROG * EMAF1 STB MMSEG SET CURRENT PROG'S MSEG ADB IDTM1 ADD TO CODE PAGE REQ'S STB IDTM1 AND SET FOR WORD 21 * * UPDATE ID SEGMENT WORD 28 OF AN EMA PROGRAM * LDB IDEXC GET INDEX OF NEXT EXTENSION BLF,RBL AND MOVE TO (15-10) BLF,RBL LDA \ID5,I GET THE DECLARED EMA SIZE ALF,ALF FROM IDENT ALF AND M1777 STA PGREQ *TEMP* SAVE * SZA,RSS DEFAULT? INA YES, SET TO 1 ADA B MERGE INDEX STA IDTM3 AND SAVE JSB IDFND GET ID SEG ADDRESS ADB P28 POSITION TO WORD 28 LDA IDTM3 GET VALUE TO STORE JSB \ABDO AND DO IT * * BUILD THE ID EXTENSION FOR AN EMA PROGRAM: * WORD 0: (4-0) MSEG SIZE * WORD 1: (15-11) LOGICAL START PAGE OF MSEG * (10) =1 IF DEFAULT EMA SIZE * LDB IDEX GET ADDRESS OF NEXT ID ADB IDEXC EXTENSION ENTRY JSB DPRW FROM ID EXTENSION TABLE LDB A ADDRESS TO B-REG LDA MMSEG STORE MSEG SIZE JSB \ABDO IN WORD 0 STB IDTM3 SAVE ADDR LDA EHM GET LOG START PAGE AND M0760 OF MSEG IN 14-10 LDB PGREQ WAS EMA SIZE DEFULTED? SZB,RSS ADA M1000 YES, SET SO BIT 10 WILL BE SET RAL MOVE 'EM ALL LEFT 1 LDB IDTM3 GET ENTRY ADDRESS OF WORD 1 JSB \ABDO AND SEND IT * ISZ IDEXC BUMP # OF EXTENSIONS USED LDA EMLNK NOW STORE THE MSEG STARTING ADA \ADBP ADDRESS INTO THE ALREADY- LDB EHM ALLOCATED BASE PAGE LINK STB A,I SPC 2 * CHECK USE OF SSGA SPC 1 SETMP LDA \ID6,I GET PROG TYPE FROM \IDENT AND M20 AND ISOLATE THE SSGA BIT. SZA,RSS IF NOT USING SSGA, JMP NOSSC THEN GO CHECKŠ¥þú OTHER COMMONS. SPC 1 LDA P4 IF USING SSGA, THEN PICK UP ITS JMP IDSET MPFT INDEX AND GO WRITE ID-SEG. SPC 1 * NOT USING SSGA; USE COMMON SIZE FROM IDENT * (EITHER SOME OR NONE), REVERSE COMMON BIT IN TYPE, * AND LOW TWO TYPE BITS TO INDEX INTO TABLE OF * MPFT INDICES. SPC 1 NOSSC LDA \ID6,I GET TYPE AGAIN AND SAVE BITS AND M13 0,1, AND REVERSE COMMON BIT(3) LDB \ID4,I PICK UP COMMON SIZE CLE,ELB CLEAR SIGN BIT SZB IF ANY, THEN SET BIT 2 IN A. IOR P4 SPC 1 ADA IDTB. USE BIT PATTERN IN A TO INDEX LDA A,I TABLE, AND PICK UP MPFT INDEX. SPC 1 * A CONTAINS MPFT INDEX, MERGE IN SIZE REQUIREMENT * AND WRITE DISK. SPC 1 IDSET CLB PUT MPFT INDEX AND RRR 3 IOR IDTM1 PAGE REQMT IN PROPER RRL 10 POSITIONS IN A-REG SPC 1 STA IDTM3 SAVE NEW ID WORD JSB IDFND FIND ID-SEG ADDRESS ADB P21 POINT TO ID-SEG WORD 21 LDA IDTM3 AND WRITE NEW CONTENTS JSB \ABDO TO DISK. SPC 1 LDA IDTM1 MERGE PARTITION SIZE ALF,ALF REQUIREMENT LESS 1 IOR \ID8,I INTO UPPER BYTE STA \ID8,I OF \IDENT WORD 8 * * IF A SEGMENTED PROGRAM THEN SET WORD 29 * ISZ IDFIX BUMP RETURN ADDR LDA SDID GET SEGMENT-ENCOUNTERED FLAG SZA,RSS ANY FOR THIS PROGRAM JMP IDFIX,I NONE, SO RETURN ADB P7 POSITION TO WORD 29 ADDR LDA TPMAX GET HIGH MAIN OF LARGEST JSB \ABDO SEGMENT AND STORE * JMP IDFIX,I EHM NOP MMSEG NOP N33 DEC -33 P11 DEC 11 SKP * CONSTANTS, ETC. SPC 1 IDTM1 BSS 1 IDTM3 BSS 1 M20 EQU P16 * M13 OCT 13 SPC 4 * INDEX LOOKUP TABLE * * TABLE CONTAINS MPFT INÑ”þúDICES * * THE INDEX TO THIS TABLE IS 4 BITS LONG: * * BITS 0,1: 00 - LBG DISK RES * (FROM TYPE) 01 - MEM RES * 10 - RT DISK RES * 11 - BG DISK RES * BIT 2: 0 - NO COMMON USED * 1 - COMMON USED * BIT 3: 0 - USE NORMAL COMMON * 1 - USE REVERSE COMMON SPC 1 IDTB. DEF *+1 INDEX OCT 0 0000-BG W/O COMMON OCT 1 0001-MR W/O COMMON OCT 5 0010-RT DR W/O COMMON P5 OCT 5 0011-BG DR W/O COMMON P3 OCT 3 0100-BG DR W/BG COMMON P2 OCT 2 0101-MR W/RT COMMON OCT 2 0110-RT DR W/RT COMMON OCT 3 0111-BG DR W/BG COMMON OCT 0 1000-BG DR W/O COMMON (REVERSE) OCT 1 1001-MR W/O COMMON (REVERSE) OCT 5 1010-RT DR W/O COMMON (REVERSE) OCT 5 1011-BG DR W/O COMMON (REVERSE) OCT 2 1100-BG DR W/RT COMMON OCT 3 1101-MR W/BG COMMON OCT 3 1110-RT DR W/BG COMMON OCT 2 1111-BG DR W/RT COMMON * END OF TABLE SKP * * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR \ABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) B IS ID SEG ADDR * (INSURE PROG'S IDENT IS IN CORE) * JSB IDFND * SPC 1 IDFND NOP LDA M377 PICKUP KEYWD# IN IDENT AND \ID8,I WORD 8 AND ISOLATE IT ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. SPC 4 * DETERMINE PAGE REQUIREMENTS FOR A PROGRAM * * CALLING SEQUENCE: RETURN SEQUENCE: * A=HIGH M†NLHAIN ADDR+1 B,E DESTROYED * B=LOW MAIN ADDR A=PAGE REQUIREMENT * JSB PGREQ INCL. BASE PAGE. SPC 1 PGREQ NOP CMB B=-LOMAIN-1 ADA B A=NO. WORDS NEEDED-1 RRR 10 A=#PAGES-1 AND M37 CLEAN OUT BAD BITS ADA P2 A=#PAGES+1(I.E. INCL BASE PAGE) SPC 1 JMP PGREQ,I PAGE REQUIREMENTS. Ó¦Nÿÿþú SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TBREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SKP * N6 DEC -6 P4 DEC 4 P21 DEC 21 * MES14 DEF *+2 DEF *+8 ASC 10,RT COM ADD MES18 DEF *+2 DEF *+8 ASC 10,BG COM ADD MES22 DEF *+1 &§þú ASC 3,(NONE) MES12 DEF *+1 ASC 12,SYSTEM <>: MS12A DEF MES12+8 * MES38 DEF *+1 ASC 24,SYS SIZE: XX TRKS, XXX SECS (XX SECTORS/TRACK) MES39 DEF *+1 ASC 23, = XXXXXX BLOCKS (128 WORDS/BLOCK) * JMP3I JMP 3,I INITIAL JMP INSTRUCTION * MES31 DEF *+1 ASC 19,SUBSYSTEM GLOBAL AREA <>: MS31A DEF MES31+15 MES32 ASC 5,DRIVR PART MES62 DEF *+2 DEF *+6 MES57 ASC 8,BG COMMON MES63 DEF *+1 ASC 18,SYSTEM DRIVER AREA <>: MS63A DEF MES63+14 MES64 DEF *+1 ASC 9,PARTITION DRIVERS * MES53 ASC 5,RT COMMON * SPC 3 MS02 ASC 8,BP LINKAGE XXXXX MES13 DEF MS13 MS13 ASC 20,MEMORY RESIDENT LIBRARY <>: MS13A DEF MS13+15 MES15 DEF MS15 MS15 ASC 17,MEMORY RESIDENTS <>: MS15A DEF MS15+12 MES16 DEF MS16 MS16 ASC 9,RT DISC RESIDENTS MES23 DEF MS23 MS23 ASC 11,SYSTEM STORED IN FILE "BG" ASC 1,BG "PR" ASC 1,PR SKP * * FOR LBG DISK RESIDENTS, SET THE RELOCATION BASE AT * THE FIRST PAGE FOLLOWING THE DRIVER PARTITION, * OR, IF USED, COMMON. THIS ROUTINE IS CALLED BEFORE * RELOCATION OF EACH DISK RESIDENT PROGRAM SPC 1 SETRB NOP LDB LWDP1 GET LWA OF DP + 1 LDA \ID6,I GET PROG TYPE AND M20 ISOLATE SSGA BIT IN TYPE, IOR \ID4,I MERGE IN COMMON LENGTH, AND M7777 CLEAR SIGN BIT SZA AND IF HE USES EITHER LDB FWSDA SET RELOC BASE ABOVE COMMON. STB \PREL AND SAVE AS RELOCATION BASE. JMP SETRB,I RETURN SPC 3 * * SET THE RELOCATION BASE FOR PRIVILEGED PROGRAMS * AT THE PAGE BOUNDARY ABOVE TABLE AREA II. THIS * ROUTINE IS CALLED BEFORE THE RELOCATION OF EACH * RT/BG PRIVILEGED DISK RESIDENT PROGRAM. * SETPV NOP ISZ SETPV LDB FWPRV STB \PREL JMP SETPV,I SPC 3 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM tþú * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB M1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * IDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * TEST FOR SOME PROGRAMS LOADED * * THE NOTST SUBROUTINE CHECKS FOR PROGRAMS OF THE CURRENT * TYPE LOADED. IT IS EXECUTED FOLLOWING COMPLETION OF THE * LOADING SEQUENCE FOR EACH PROGRAM TYPE. IF NO PROGRAMSŠþú OF * THIS TYPE HAVE BEEN LOADED, IT PRINTS THE MESSAGE * (NONE) ON THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB NOTST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * NOTST NOP ISZ LFLAG IF NO PROGRAMS LOADED JMP NOTST,I SEND: (NONE) LDA P6 LDB MES22 MES22 = ADDR: (NONE) JSB \MESS PRINT: (NONE) JMP NOTST,I SPC 3 MES02 DEF MS02 MES03 DEF MS02+5 SKP * * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 * CLWRD NOP SKP * * OUTPUT ABSOLUTE BASE PAGE CODE * * BPOUT OUTPUTS THE BASE PAGE SECTION OF CODE FOLLOWING LOADING OF * EACH DISK RESIDENT PROGRAM, BEGINNING WITH THE DISK * ADDRESS SPECIFIED IN \ADSK. * * CALLING SEQUENCE: * A = UPPER BP ADDRESS PLUS ONE * B = LOWER BP ADDRESS * JSB BPOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * BPOUT NOP CMahþúA,INA COMPLEMENT UPPER ADDRESS ADA B ADD LOWER ADDRESS STA TCNT SAVE BP LENGTH ADB \ADBP ADJUST FOR BP ADDRESS STB CURAT SAVE CURRENT LOWER CORE ADDR SSA,RSS SKIP - SOME CODE IN BP JMP BPOUT,I RETURN - ALL CODE OUT LDA \ADSK GET CURRENT DISK ADDRESS BPSYO JSB \DSKO OUTPUT CURRENT BP SECTOR LDA \ADSK GET CURRENT DISK ADDRESS JSB \DSKA INCR DISK ADDRESS STA \ADSK SAVE NEXT DISK ADDRESS LDB TCNT GET CURRENT LENGTH ADB P64 STB TCNT SAVE COUNT FOR NEXT PASS SSB,RSS SKIP - MORE CODE TO PUT OUT JMP BPOUT,I RETURN - ALL CODE OUT LDB CURAT GET CURRENT LOW CORE ADDRESS ADB P64 STB CURAT SET NEXT CORE ADDRESS JMP BPSYO OUTPUT NEXT SECTOR TO DISK * P64 DEC 64 SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER * PROGRAMS. BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA \PTYP PROG = BG SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 LEAVE SET CPA P13 OR IF ³þúTABLE AREA II RSS CPA P15 OR TABLE AREA I JMP TRID3 THEN LEAVE SET * AND M7 NOT EVERYONE CAN REFERENCE A TYPE 6 (14,30) CPA P6 BUT USUALLY THE LIBRARY RTNS WILL BE 7'S JMP TRID3 THIS HAPPENS ONLY IN MRL AND MRP'S * CPA P7 IF A UTILITY SUBROUTINE JMP C2 THEN CLEAR IT SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT/EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA €þþú CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP M0760 OCT 076000 SKP * * GENERATE INT ENTRY,KEYWD,ID SEG * * GENID GENERATES THE CURRENT ID SEGMENT AND KEYWORD * FOR THE PROGRAM LOADED. IN ADDITION, IT GENERATES THE * LINKAGE REQUIRED IN THE INTERRUPT TABLE FOR THOSE PROGRAMS * WHICH ARE TO BE SCHEDULED UPON RECEIPT OF AN INTERRUPT. * * CALLING SEQUENCE: * A =0Xþú 0 (GENERATE MEM.RES ID SEGMENT) * -1 (GENERATE LONG ID SEGMENT) * -2 (GENERATE BLANK LONG ID SEGMENT) * B = IGNORED * JSB GENID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * * GENID NOP STA PLFLG SAVE ID SEGMENT LENGTH FLAG CPA N2 IF BLANK GEN JMP BLID GO SEND THE KEY WORD * LDB SYSAD GET START ADDR FOR ID-SEG STB SCH3 SAVE START ADDR IN A TEMP STB SYSAD AND UPDATE BASE STB CURAI UPDATE OUTID PTR TOO. * * GENERATE INT ENTRY FOR USER SYS * LDA AILST GET THE ADDRESS OF INT IMAGE STA \CURL SET CURRENT INT ADDRESS LDA M72 GET NO. OF INT ENTRIES CMA,INA STA TCNT SAVE TOTAL INT COUNT GETIT LDA \CURL,I GET CURRENT WORD IN INT CMA,INA TEST NEGATIVE ENTRIES FOR ILIST CPA IMAIN EQUAL TO MAIN IDENT INDEX? RSS YES - CONTINUE JMP NOTPN IGNORE REF IF NOT CURRENT MAIN * LDA SYSAD GET ID SEG ADDRESS CMA,INA GET 2'S COMPLEMENT FOR INT ENTRY LDB AILST COMPUTE THE INT CORE CMB,INB ADDRESS ADB \CURL = ILST OFFSET PLUS ADB AINT ACTUAL CORE ADDRESS JSB \ABDO SENT THE ENTRY TO THE DISC NOTPN ISZ \CURL STEP TO THE NEXT ENTRY ISZ TCNT SKIP - INT EXHAUSTED JMP GETIT ANALYZE NEXT INT ENTRY * * GENERATE KEYWORD STKEY LDA IMAIN GET MAIN IDENT INDEX STA \TIDN SET ADDRESS FOR IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR NO IDENT FOUND SPC 1 LDB SYSAD CCA ADA \TIDN GET IDENT POINTER CPA SCH1 SCHEDULE PGM? STB SCH4 YES - SAVE ITS ID ADDRESS BLID LDA SYSAD GET THE ID-ADDRESS TO A LDB CURAK AND THE CURRENT CORE ADDRESS JSB \ABDO TO B AND OUTPUT TO THE DISC STB CURAK SET THE NEW ADDRESS LD´þúB SYSAD GET THE ADDRESS ADB P29 ADJUST FOR NEXT ID SEGMENT ADDR ADB P4 STB SYSAD SET NEXT ID SEGMENT ADDRESS * * GENERATE ID SEGMENT * LDA PLFLG IF FLAG = -2 FOR CPA N2 BLANK OUTPUT, JMP GENID,I EXIT * LDA KEYAD SAVE KEYWORD CMA OFFSET FOR ADA CURAK LATER ACCESS TO ID-SEG. STA \ID8,I (TEMP SAVE) * LDB N6 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA CUPRI GET THE CURRENT PRIORITY JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PRENT GET PRIMARY ENTRY POINT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N2 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA SCH3 GET ADDRESS OF CURRENT ID SEG INA STEP TO PRAM LIST JSB OUTID OUTPUT B REG TO ID SEGMENT CLA SEND E/O REGS TO JSB OUTID THE ID SEGMENT LDA \ID1,I GET NAME 1,2 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID2,I GET NAME 3,4 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE STA B SAVE TYPE IN B LDA \ID3,I GET NAME 5 AND M7400 ISOLATE NAME 5 IOR B ADD TYPE TO NAME 5 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER CLA PRESET FOR DORMANT CCB ADB \TIDN IF THIS PGM TO BE CPB SCH1 SCHEDULED CLA,INA SET SCHEDULED FLAG JSB OUTID SET WORD IN ID CLA SET TIME LINK JSB OUTID TO ZERO AND OUTPUT LDA \MULR GET RESOLUTION CODE, EXEC MULT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \TIME GET LOW PART OF TIME JSB OUTID OUTPUT LS TO ID SEG LDA \TIM1 GET HIGH HALF JSB OUTID OUT MS HALF TO ID SEG LDB N2 ZEROS TO JSB ZOUT Ï|þú ID SEG 20 AND 21 * LDA \PREL GET CURRENT PROG RELOC ADDRESS ADA BSSDP ADD INITIAL PROG DISPLACEMENT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TPREL GET CURRENT RELOCATION ADDRESS CMA,INA CHECK ADA LWASM MEMORY OVERFLOW SSA,INA,SZA OK IF POS OR -1 JMP ER18 YES GO SEND THE BITCH * LDA TPREL NO SEND THE UPPER LIMIT GENI9 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PBREL GET LOW BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TBREL GET HIGH BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER ISZ PLFLG SKIP - CONTINUE WITH LONG ID SEG CLA,RSS CLEAR FOR MEM.RES ID SEGMENT LDA DSKMN GET INITIAL MAIN DISK ADDRESS JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N3 ZEROES TO JSB ZOUT WORDS 27-29 * * TURN ON BIT 10,WORD 31 FOR 'DONT COPY' INDICATOR IN ID SEG. * SMWDS CLA ZERO SESSION MONITOR WORD 30. JSB OUTID DO IT. LDA \ID6,I GET THE WORD WITH THE DON'T COPY BIT AND M200 MASK IT OFF. SZA SHOULD WE SET 'DONT COPY' IN ID SEG?? LDA M2000 YES- SET BIT 10. JSB OUTID WRITE IT TO ID SEG. CLA JSB OUTID CLEAR SESSION MONITOR WORD 32. JMP GENID,I RETURN - ID SEGMENT OUT * ER18 LDA ERR18 SEND ERROR 18 CMA,INA COMPLEMENT SO NO TR,ERRLU ON ERROR JSB \GNER MEMORY OVERFLOW LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP GENI9 GO FINISH THE ID-SEGMENT * ERR18 ASC 1,18 M200 OCT 200 M1774 OCT 177400 N3 DEC -3 M1 DEC -1 P29 DEC 29 SPC 5 * * OUTPUT ZERO TO IDBUF * * ZOUT PUTS OUT ZEROES TO THE ID SEGMENT BUFFER. * * CALLING SEQUENCE: * A = IGNORED * B = NO. OF ZEROES TO GO OUT (NEG.). * JSB ZOUT * * Nþú RETURN: CONTENTS OF A AND B ARE DESTOYED. * ZOUT NOP STB TCNT SAVE NO. OF ZEROES TO GO OUT CLA JSB OUTID OUTPUT ZERO TO IDBUF ISZ TCNT SKIP - ALL ZEROES OUT JMP *-3 CONTINUE ZERO OUTPUT TO IBUF JMP ZOUT,I RETURN SKP * * GENERATE A SHORT BG/PR SEGMENT ID SEGMENT AND ITS ASSOCIATED * KEYWORD ENTRY. NOTE THAT THE CONTENTS OF THE KEYWORD IS 11 * LOCATIONS LESS THAN THE ACTUAL START OF THE SHORT ID * SEGMENT. THIS IS TO ALLOW FOR EASY ACCESS TO THE ID * SEGMENT'S PROGRAM NAME BY ALWAYS ADDING AN OFFSET OF * 12 TO THE CONTENTS OF THE KEYWORD LOCATION. * * CALLING SEQUENCE: * A = -1 (GENERATE SHORT ID SEGMENT) * = -2 (GENERATE BLANK SHORT ID SEGMENT) * B = IGNORED * * RETURN: CONTENTS OF A & B DESTROYED * GNSID NOP GENERATE SHORT SEGMENT ID-SEGMENTS STA PLFLG SAVE THE FLAG LDB \SKYA GET THE KEYWORD LDA \SSID ADDRESS AND ITS CONTENTS JSB \ABDO SEND THE KEY WORD TO THE DISC STB \SKYA SET THE NEW KEYWORD ADDRESS LDB \SSID GET THE ID- ADDRESS ADB P9 ADDJUST FOR NEXT TIME STB \SSID AND SAVE ADB P2 ADDJUST FOR ADDRESS OF CURRENT ID LDA PLFLG THIS A CPA N2 BLANK SHORTY? JMP BLSID YES GO DO BLANK THING * LDA PRENT NO GET THE PRIMARY ENTRY POINT JSB \ABDO SEND IT TO THE DISC LDA IMAIN GET THE IDENT INDEX STA \TIDN TO CURRENT JSB \IDX B-REG MUST NOT BE DESTROYED JSB \ABOR BETTER BE ONE LDA \ID1,I GET NAME 1,2 JSB \ABDO SEND TO THE DISC LDA \ID2,I GET NAME 3,4 JSB \ABDO SEND IT LDA \ID3,I GET NAME 5 AND M7400 MASK IOR P21 SET TYPE AND SHORT FLAG JSB \ABDO SEND IT TO THE DISC LDA BSPAD GET THE MEMORY ADDRESS ADA BSSDP ADDJUSŸÎþúT FOR LEADING BSS JSB \ABDO SEND MAIN 1 LDA TPREL GET AND CMA,INA CHECK FOR MAIN MEMORY ADA LWASM OVER FLOW SSA,INA,SZA IF OVER FLOW JMP BLSI3 GO REPORT IT * LDA TPREL OK SO PUT IT OUT BLSI0 JSB \ABDO SEND MAIN 2 LDA BSBAD GET AND JSB \ABDO SEND BP 1 LDA TBREL GET AND JSB \ABDO SEND BP 2 LDA DSKMN GET DISC ADDRESS BLSI2 JSB \ABDO JMP GNSID,I RETURN * BLSID ADB P3 FOR BLANK LDA P16 SET THE SHORT BIT ONLY JMP BLSI2 GO SEND IT. * BLSI3 LDA ERR18 SEND ERROR MESSAGE STB SIDS2 SAVE POINTER TO ID SEG CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER LDB SIDS2 LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP BLSI0 GO FINISH THE ID-SEGMENT * SIDS2 BSS 1 SPC 5 * * OUTPUT ID SEGMENT WORD TO IBUF * * OUTID PACKS THE WORDS FOR THE ID SEGMENTS IN THE ID SEGMENT * BUFFER AND WRITES THE BUFFER ON THE DISK WHEN IT CONTAINS * 64 WORDS. * * CALLING SEQUENCE: * A = CURRENT ID SEGMENT WORD * B = IGNORED * JSB OUTID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTID NOP LDB CURAI GET THE CURRENT ID-SEGMENT ADDRESS JSB \ABDO SEND THE WORD TO THE DISC STB CURAI SET THE ADDRESS FOR NEXT TIME JMP OUTID,I RETURN SKP * * OUTPUT REST (IF ANY) OF ABS. REC * * REMDO PUTS OUT THE CURRENT SECTOR IF IT CONTAINS ANY WORDS OF * ABSOLUTE CODE. THIS IS NORMALLY DONE ONLY AT THE END OF THE GEN * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB REMDO * * RETURN: CONTNNTS OF A AND B ARE DESTROYED. * REMDO NOP LDA \OLDA GET THE CURRENT DISC ADDRESS LDB \ADBF AND THE BUFFER ADDRESS SSA IF A GOOD ADDRESS JSB \DSKO OUTPUT THE CODE UjNLH JMP REMDO,I RETURN SPC 5 * BPDSA ADVANCES THE DISK ADDRESS TO THE NEXT EVEN * DISC ADDRESS ASSUMING THE CURRENT DISC ADDRESS * IS NOT AVAILABLE. THIS IS NORMALLY DONE * AFTER EACH MAIN IS LOADED AND BEFORE THE BASE * PAGE IS OUTPUT. * * CALLING SEQUENCE: * * JSB BPDSA DOES NOT USE A/B RETURNS A=CURRENT DISC ADDRESS * BPDSA NOP LDA \ADSK BUMP JSB \DSKA THE DISC ADDRESS STA \ADSK AND RESET IT JSB DSKEV MAKE SURE IT IS EVEN JMP BPDSA,I RETURN š(Nÿÿþú SKP * * CHBND IS A ROUTINE TO ASK THE OPERATOR IF HE WANTS TO CHANGE * A BOUNDRY, GET HIS ANSWER AND CHECK IT FOR LEGALITY. * THE MESSAGES SENT ARE: * * XXXXXXXXXX YYYYY AND * CHANGE XXXXXXXXXX? WHERE XXXXXXXXXX IS A 10 CHARACTER * MESSAGE SUPPLIED AS PART OF THE CALL * AND YYYYY IS THE CURRENT BOUND IN OCTAL * OR DECIMAL. * LEGAL RESPONSES ARE: * * 0 NO CHANGE. * N WHERE N>YYYYY AND LESS THAN OR EQUAL TO * THE SUPPLIED LIMIT. * * CALLING SEQUENCE: * B = NON-ZERO IMPLIES DON'T CHECK LOWER BOUND * A = CURRENT YYYYY A > 0 MEANS OCTAL * JSB CHBND A < 0 MEANS DECIMAL(ONE'S COMPLEMENT) * DEF ADDRESS OF XXXXXXXXXX (5 WORD MESSAGE) * DEF UPPER LIMIT OF RESPONSE * * RETURN (ALWAYS P+3) A = NEW BOUND. * CHBND NOP STB BPDSA SAVE *TEMP* STA CBFLG SAVE DECIMAL FLAG SSA SKIP IF OCTAL REQUEST,ELSE INA MAKE DEC, REQUEST 2'S COMPLMNT STA TMPX SAVE DEFAULT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA \GNER TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ \GNER THE JMP CHNX MESSAGE * ISZ CHBND INDEX TO THE UPPER LIMIT STB TMPL SAVE THE ADDRESS FOR RETRY IN CASE CHOVR LDB TMPL OF ERROR LDA TMPX CONVERT THE NUMBER JSB \CONV TO THE BUFFER JSB \SPAC SEND A \SPAC LDB DMES GET THE ADDRESS LDA P16 AND SEND MESSAGE JSB \MESS "XXXXXXXXXX YYYYY" TO THE TTY LDA "?" PUT A "?" AFTER THE XXXXXXXXXX STA ME11S SET IT LDA P19 SEND MESSAGE AND GET LDB ADMES RESPONSE FOR JSB \READ Å`þú " CHANGE XXXXXXXXXX?" LDA P5 CONVERT RESPONSE LDB CBFLG LOAD FLAG SSB DECIMAL REQUEST?? CMA,INA YES, ASK \GET# FOR DECIMAL JSB \GET# GET BINARY EQUIVALENT JMP CBERR ERROR - REPEAT * JSB \GETC END OF BUFFER? SZA,RSS JMP CHOK YES OK- * CBERR JSB \INER SEND ERR 01 JMP CHOVR AND REPEAT * CHOK LDA \OCTN GET VALUE LDB BPDSA GET FLAG IN B-REG SZB JMP BGCCH SPECIAL TREATMENT FOR BG COMMON SZA,RSS IF ZERO USE LDA TMPX SUPPLIED VALUE SSA GET ABS VALUE OF CMA,INA CURRENT TOO LDB TMPX GET -ABS VALUE SSB,RSS OF UPPER LIMIT. CMB,INB ADB A IF LIMIT LESS THAN SSB CURRENT THEN JMP CBERR ERROR * CHHI LDB CHBND,I GET UPPER BOUND LDB B,I TO B CMB IF GREATER THAN ADB A MAX SSB,RSS THEN JMP CBERR ERROR * ISZ CHBND ELSE EXIT JMP CHBND,I RETURN VALUE IN A * BGCCH CLB CONVERT PAGES LSL 10 TO WORDS & CHECK OVERFLOW SSA RSS SZB JMP CBERR OUT OF RANGE JMP CHHI NOW CHECK HI BOUND * SPC 2 CBFLG BSS 1 DECIMAL/OCTAL FLAG TMPX NOP TMPL NOP DMES DEF .XXX ADMES DEF *+1 ASC 4, CHANGE .XXX BSS 5 ME11S NOP BSS 3 "?" ASC 1,? P19 DEC 19 SKP * * THIS ROUTINE IS CALLED AFTER THE SYSTEM AND PRD'S ARE * LOADED, BUT BEFORE THE MEMORY RESIDENT LIBRARY. SPC 1 * CLEAR LOAD FLAGS FOR TYPE 6 PGMS * CLRT6 NOP * SET LIBRARY RESIDENT FLAGS JSB \INID INITIALIZE IDX SETLX JSB \IDX SET IDENT ADDRESSES JMP CLRT6,I END OF IDENTS LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE CPA CßþúP14 IF FOURCED CORE RES. RSS PROCESS CPA P6 TYPE = LIBRARY? RSS YES - CONTINUE JMP SETLX PROCESS NEXT IDENT * LDA \ID3,I TYPE = 6 - GET LOAD FLAG RAR,CLE,ELA LOAD BIT TO E - AND CLEARED STA \ID3,I RESET CLEARED FLAG SEZ,RSS WAS IT LOADED? JMP SETLX NO - CONTINUE JSB CLEAR CLEAR THE VALUES OF ITS ENTRY POINTS JMP SETLX AND CONTINUE ID SCAN SPC 3 * * CLEAR THE LST ENTRY POINT VALUES BELONGING TO THE CURRENT IDENT * CLEAR NOP JSB \ILST INITIALIZE \LSTX CLR1 JSB \LSTX SET CURRENT LST ADDRESSES JMP CLEAR,I END - CONTINUE ID SCAN CCA ADA \TIDN GET IDENT ADDRESS CPA \LST4,I ENT BELONGS TO CURRENT PROG? CLA,RSS YES - CONTINUE JMP CLR1 NO - TRY NEXT ENT STA \LST5,I SET LINK TO ZERO. JMP CLR1 CONTINUE SEARCH SKP * * DEMOTES ALL TYPE 6 AND 14 PROGRAMS ALREADY IN THE MEMORY RESIDENT * LIBRARY TO TYPE 7 UTILITY ROUTINES, CLEARING THEIR LOAD FLAGS AND * ENTRY POINT VALUES. * * DEMTL NOP DEMOTE TO TYPE 7 JSB \INID INITIALIZE IDX SCAN DEMS JSB \IDX SET NEXT IDENT ADDRESSES JMP DEMTL,I END OF IDENTS * LDA \ID6,I GET AND AND M177 ISOLATE TYPE CPA P14 IS IT A FORCED MEM RES LIB? RSS YES CPA P6 OR LIBRARY? RSS YES JMP DEMS PROCESS NEXT IDENT * LDA \ID3,I GET LOAD FLAG WORD AND M1770 =B177770, AND CLEAR FLAGS STA \ID3,I RESTORE LDA \ID6,I GET TYPE WORD AND M1760 =B176000, AND CLEAR TYPE ADA M7 CHANGE TO TYPE 7 STA \ID6,I AND RESTORE JSB CLEAR CLEAR ANY ENTRY POINT VALUES JMP DEMS AND CONTINUE SCAN * M1770 OCT 177770 M1760 OCT 176000 * * END LABS Åÿÿ ÿýý=; ÿ92067-18319 2001 S C0322 &RT4G4 GEN. SEGMENT #4             H0103 tFþúASMB,Q,R,C HED RT4G4 - LOADER SEGMENT. NAM RT4G4,5,90 92067-16319 REV.2001 790817 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************************** * * NAME: RT4G4 * SOURCE PART #: 92067-18319 * REL PART #: 92067-16319 * WRITTEN BY: KFH, JH, GAA * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \NLOD * * EXTERNAL REFERENCE NAMES * EXT \ILST,\LSTX,\LSTS,\TLST EXT \LST1,\LST2,\LST3,\LST4,\LST5 EXT \INID,\IDX,\TIDN EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7 EXT \IFIX,\FIX,\PFIX,\TFIX EXT \FIX1,\FIX2,\FIX3,\FIX4 EXT \LNKX,\LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 EXT \FMRR,\CFIL EXT \PREL * EXT \CPLM,\ADBP EXT \LBUF,\TBUF,\CURL,\CPL2 EXT \RNT,\PRV EXT \CONV,\SPAC,\RBIN,\MESS,\GNER,\ABOR EXT \ABDO,\SRET EXT \SYS,\USER EXT READF,RWNDF,\NDCB,\RNAM EXT \PTYP,\ADSK,\ABCO,\MXAB,\TIME,\MULR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL Ú¾þú* SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 160 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 Æþú ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITðÌþúIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HID¢þúLNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISK ADDRESS WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISK ADDRESS WHE/HþúRE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 2 MRTAD DEF TPREL RBTAD DEF RBTA AMLST DEF MLIST AMEM5 DEF MLIST+5 AMEM8 DEF MLIST+8 SKP * * PROGRAM CONSTANT FACTORS N1 DEC -1 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 NDAY OCT 177574,025000 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P16 DEC 16 P34 DEC 34 P60 DEC 60 P99 DEC 99 P100 DEC 100 P6K DEC 6000 M7 EQU P7 M17 EQU P15 M20 EQU P16 M1760 OCT 176000 M1777 OCT 1777 M7400 OCT 177400 M7777 OCT 77777 * BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN SKP LODR NOP * * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I HERE WE CHASE DOWN OUR OWN RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN FOR CALL * TO \NLOD OR \LOAD. * SPC 1 N DEC -4 LSTAA DEF *+1 ATBUF DEF \TBUF+0 LBUF5 DEF \LBUF+5 ALBUF DEF \LBUF+0 DNDCB DEF \NDCB+0 SKP SKP * * INITIATE MAIN PROGRAM LOADING * * ß þú * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOAD (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \NLOD NOP LDA \PTYP GET RELOCATION TYPE CPA P5 IF A SEGMENT RSS JMP NONES JSB \LOAD THEN JUST CALL \LOAD AND RETURN JMP \NLOD,I * * INDICATE VALIDITY OF SSGA REFERENCES * NONES LDA \ID6,I TYPE AND M20 LOOK AT SSGA BIT STA SSGAF SET SSGA FLAG (0=NO SSGA USE) CCB STB HDFLG SET HEADING FLAG LDB \PREL PICK UP BASE ADDRESS LDA LIBFG IF LIB LOAD SZA JMP NOADD THEN IGNORE LDA \ID6,I GET TYPE AGAIN AND M7 JUST PRIMARY BITS CPA P1 IF MEMORY RESIDENT ADB P2 BUMP START ADDR FOR INDEX REG SAVE CPA P2 AND IF PROG IS DISK RESIDENT ADB P34 BUMP START FOR VIS + INDEX REG SAVE CPA P3 (EITHER RT OR BG) ADB P34 BUMP START FOR VIS + INDEX REG SAVE CPA P4 ADB P34 BUMP START FOR VIS + INDEX REG SAVE * NOADD STB TPREL LDA PBREL GET BP RELOCATION ADDRESS STA TBREL SET CURRENT BP RELOC ADDRESS JSB \LOAD LOAD PROGRAM LDA LIBFG IF NOT LIB LOAD SZA,RSS THEN JSB \SPAC NEW LINE JMP \NLOD,I RETURN SKP * * LOAD, LINK MAIN PROG & SUBS. * * \LOAD IS THE MAIN LOADING SUBROUTINE FOR GENERATING THE ABSOLUTE * CODE AND LINKING ALL CALLED SUBROUTINES. IT IS USED BY EACH * PROGRAM TYPE FOR LOADING. IT READS THE RELOCATABLE RECORDS FROM * THE DESIGNATED FILE, AND WRITES THE ABSOLUTE CODE * INTO THE CORE-IMAGE OUTPUT FILE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOADS (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \LOAD NOP (WAS "LOADS") JSB SFIX SET UP A FIX UP ENTRY ÃUþúCCA STA PLFLG SET FLAG = NO DBL RECS IN * LOADN LDA TPREL CLEAR THE CP LINK IMAGE JSB CCPLK AREA LDA TPREL SAVE FOR RESET STA LWH4 FOR NEXT PASS LDA TBREL STA LWH3 CLA LOADX STA L01 * LDA LWH3 BP LINK LDB TBREL ADDRESSES JSB CLRLT LDA LWH3 STA TBREL RESTORE TBREL JSB CLIST BLANK MEMORY MAP BUFFER CLA CLEAR THE LIBRARY TRAP STA ADTRP WORDS STA LIBTP LDA AMLST AMLST = ADDR OF MEM MAP BUFFER STA AMAD SET CURRENT MEMORY MAP ADDRESS LDA HDFLG GET HEADING FORMAT FLAG STA TEMP2 SSA,RSS SKIP IF NEGATIVE (MAIN) ISZ AMAD INCR CURRENT MEM MAP ADDR LDA \ID1,I GET NAME 1,2 STA AMAD,I SET NAME 1,2 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID2,I GET NAME 3 4 STA AMAD,I SET NAME 3,4 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK (OCT 40) STA AMAD,I SET NAME 5 IN MEMORY MAP LDA \ID6,I PICK UP TYPE AND M177 AND ISOLATE CPA P13 IF TABLE AREA II TYPE RSS CPA P15 OR TABLE AREA I TYPE RSS THEN DON'T MASK BITS AND M7 MASK TO ACTUAL TYPE. STA LDTYP * * READ NAM RECORD. * LDA ALBUF READ NAM RECORD FROM FILE. STA \CURL CCB JSB \RNAM JSB \ABOR ERROR ON READ. SZA,RSS JSB \ABOR END OF FILE. CMA,INA SET COUNT WORD. STA LCNT * LDA \ID5,I CHECK IF NAM RECORD HAS RAL A MODIFIED VERSION. SSA,RSS JMP LOADC NO. * JSB RWNDF YES. SEARCH NEW NAM FILE DEF *+3 FOR REPLACEMENT RECORD. DEF ðþú\NDCB+0 DEF \FMRR+0 * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \ABOR * CREAD JSB READF DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF \LBUF DEF P60 DEF LEN * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \ABOR * LDA LEN BETTER BE THERE! CPA N1 JSB \ABOR * LDB ALBUF COMPARE NAM IN \LBUF ADB P3 LDA B,I AGAINST CPA \ID1,I NAM IN IDENT. INB,RSS JMP CREAD NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP CREAD NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP CREAD NO MATCH. * LOADC JSB ZLOAD LOADING? JMP LH7 NO * LDA L01 SZA 1ST PASS? JMP LH7 YES * ISZ TEMP2 NO - TEST TEMPORARY HDFLG JMP SUBHD * JMP LH8 * LPAR OCT 50 LEFT PAREN. * LH7 ISZ HDFLG TEST REAL THING JMP SUBHD SKIP PRIORITY OUTPUT FOR SUB * LH8 LDA \ID6,I SET CURRENT LOAD TYPE AND M17 LOOK AT PRIMARY & REVERSE COMMON BITS CPA P5 DON'T CHANGE COMMON JMP COMOK FOR SEGMENTS (USE MAIN'S) LDB \ID4,I THIS IS A MAIN RBL,CLE,ERB GET RID OF M,S BIT STB COMSZ SET HIS COM SIZE AS LIMIT. LDB BGCAD GET BACKGROUND COMMON BOUND CPA P1 IF FORGROUND RSS CPA P2 RSS CPA P11 OR PRIVILEGED USING FORGROUND COMMON RSS CPA P12 OR BACKGROUND USING FOREGROUND COMMON LDB RTCAD USE FORGROUND COMMON ADDRESS STB COMAD SET THE COMMON BASE ADDRESS COMOK LDA \ADSK GET CURRENT DISK ADDRESS LDB L01 SZB,RSS IF 1ST PASS, STA DSKMN SAVE INITIAL MAIN DISK ADDRESS LDA \PTYP IF FOURCED SUBROUTINE AND M17 OR SSGA ROUTINE /mþú CPA P14 LOAD JMP SUBHD SEND SUB HEAD MAP * LDA LPAR GET LEFT PAREN (OCT 50) IOR AMAD,I CHANGE NAME 5, BLANK TO NAME 5,( STA AMAD,I SET NAME 5, LEFT PAREN IN MAP LDA \LBUF+10 GET PRIORITY FROM THE NAM RECORD SZA,RSS IF ZERO SET LDA P99 TO 99 SZB,RSS UNLESS SYSTEM WHICH CLA SET TO ZERO STA CUPRI SET FOR THE ID-SEG GENERATION CMA,INA SET TO NEGATIVE FOR DECIMAL CONV LDB ATBUF GET MESSAGE ADDRESS JSB \CONV CONVERT TO DECIMAL/OCTAL LDA \TBUF+1 GET HIGH TWO CHARACTERS STA MLIST+3 SET IN MAP LDA \TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS STA MLIST+4 SET PRIORITY IN MEMORY MAP LDA \LBUF+12 SET UP THE TIME PARAMETERS ASL 4 FIRST THE RESOLUTION LDB \LBUF+11 AND MULTIPLE BLS ASR 4 COMBINE STA \MULR SET FOR ID SEG GENERATOR LDA \LBUF+15 GET THE SECONDS MPY P100 CONVERT TO 10'S OF MS. ADA \LBUF+16 ADD 10'S OF MS. STA TEMP1 SAVE TEMP * LDA \LBUF+13 GET THE HOURS MPY P60 CONVERT TO MIN. ADA \LBUF+14 ADD MIN. MPY P6K CONVERT TO 10'MS CLE PREPARE FOR ADD ADA TEMP1 ADD 10'S MS. SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER PART ADA NDAY+1 SUBTRACT ONE DAY OF 10'S MS. SEZ,CLE IF OVER FLOW INB STEP HIGH ORDER DIGIT ADB NDAY DST \TIME SAVE DOUBLE WORD \TIME FOR ID-SEG. * SUBHD LDA TPREL GET CURRENT PROG RELOC ADDR LDB AMEM5 SET B = ADDR OF MEMORY MAP + 5 JSB \CONV CONVERT TO DECIMAL/OCTAL LDA MLIST PUT A ")" IN THE CPA BLNKS HIGH PART OF THE JMP SUBH2 ADDRESS IF NOT A SUBHEAD * LDA MLIST+5 I.E. IF MAIN ADA B4400 CONVERT BLANK TO ) STA MLIST+5 RESTORE ITXÆþú. SUBH2 LDA \LBUF+1 GET RIC ALF,RAR ROTATE TO LOW A AND M7 ISOLATE RIC CPA P1 NAM RECORD? RSS YES - CONTINUE JSB \ABOR INVALID DISK RECORD LDA \LBUF+6 GET PROGRAM LENGTH STA PLGTH SAVE PROGRAM LENGTH RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT ADA TPREL COMPUTE THE LAST WORD ADDRESS ADA N1 LDB AMEM8 AND JSB \CONV CONVERT TO THE MAP * * SET RELOCATION BASE FOR ORB STUFF SPC 1 JSB ZLOAD IGNORE IF A PSEUDO-LOAD OF AN MRP CLB,RSS LDB \LBUF+7 GET SIZE OF BASE PAGE CODE LDA BPINC AND FIGURE OUT IF WE'RE GOING SSA UP OR DOWN IN BASE JMP SUBH3 PAGE. SPC 1 LDA TBREL GOING UP, SET STA TPBRE ORB BASE AT TBREL ADB TBREL INCREMENT LINK BASE LDA BPLMT SUBTRACT LIMIT CMA,INA FROM ADA B NEXT ADDR TO CHECK FOR JMP SUBH4 BASE PAGE OVERFLOW. SPC 1 SUBH3 CMB,INB GOING DOWN...SUBTRACT ORB LENGTH ADB TBREL FROM LINK BASE INB ADD ONE STB TPBRE TO GET ORB BASE. ADB N1 GET NEXT AVAILABLE LINK ADDR. LDA B CMA,INA SUBTRACT NEW BASE FROM LIMIT ADA BPLMT TO CHECK FOR OVERFLOW. SPC 1 SUBH4 SSA,RSS IF LIMIT IS EXCEEDED, WE JMP E16RR HAVE AN ERROR. * CONLD STB TBREL BASE PAGE LDA TPBRE JSB SETBP SET PROGRAM BASE PAGE IMAGE TO -1 LDA \LBUF GET RECORD SIZE ALF,ALF LOW ORDER A STA \LBUF SAVE IN RIGHT HALF JSB ZLOAD LOADING? JMP NOLD NO, SKIP * LDA L01 FIRST PASS? SZA,RSS NO, DO MAP JMP NOMP YES, NO MAP * ISZ LFLAG BUMP THE LOADED FLAG NOP IN CASE OF LEAP LDA \ID5,I CHECK FOR "MAP MODULES". B—þúRAR SLA,RSS JMP NOMP NO. BIT 1 NOT SET. * LDB LBUF5 THE SIXTH WORD IN \LBUF LDA N11 NUMBER OF WORDS STA TCNT TO MOVE TO \LBUF LDA AMLST ADDRESS OF NAME BUFFER STA WDCNT SAVE FOR POINTER LH1 LDA WDCNT,I GET NAME WORD, AND ADDRESS STA B,I STORE IN \LBUF INB BUMP B ISZ WDCNT BUMP NAME ADDRESS ISZ TCNT ALL DONE? JMP LH1 NO, DO MORE * LDA BLNKS GET TWO BLANKS STA B,I PUT THEM IN \LBUF BEFORE THE COMMENTS LDA \LBUF GET RECORD SIZE ADA N5 REDUCE TO MAP LENGTH ALS TIMES 2 FOR CHARACTER COUNT LDB LBUF5 ADDRESS OF MAP AND COMMENTS JSB \MESS PRINT ALL * * THE FOLLOWING ROUTINES LINK A PROGRAM THROUGH CURRENT PAGE * LINKS WHEN POSSIBLE. THIS IS POSSIBLE WHEN THE LENGTH * OF THE PROGRAM IS KNOWN AND WHEN THE PROGRAM IS NOT AN * ASSEMBLED TYPE 2, 3, 4, OR 5 PROGRAM. * NOMP LDA \ID4,I COMPARE AND M7777 CMA,INA THIS MODULE'S COMMON ADA COMSZ DECLARATION TO MAIN'S SSA,RSS ERROR IF GREATER. JMP NOM2 LDA ERR54 CMA,INA JSB \GNER NOM2 LDA L01 1ST OF 2 PASSES? SSA JMP NOLD NO - 1 PASS ONLY * SZA,RSS IF PASS ONE JMP LH12 GO CHECK FOR OPTION SPC 1 LDA CPL1 PASS TWO SO SET UP THE NOW STA \CPL2 KILL THE UPPER AREA JSB \LNKS SET FOR DEFINING CODE JMP LH10 GO SET THE BOUNDRYS SPC 1 LH12 JSB GETCP SET UP A CURRENT PAGE LINK AREA STA CPL1 USE FOR BOTH CLA AREAS STA CPL1H CLEAR THE COUNT WORDS STA CPL2H LDB \ID5,I DOES OPERATOR WANT CURRENT PAGE SSB LINKS IF POSSIBLE? IF YES - JMP LH222 GO SET UP * LH2 CCA JMP LOADX RESTART SPC 1 ¤¢NLHLH222 LDA PLGTH SSA,RSS NO CURRENT PAGE LINKS LDA LDTYP IF ASSEMBLED TYPE 2, 3,4, OR 5 CPA P2 JMP LH2 CPA P3 JMP LH2 CPA P4 JMP LH2 CPA P5 JMP LH2 * LDA TPREL GET ADDR STA B OF LAST WD IOR M1777 OF PAGE SPC 1 CMB,INB COMPUTE # WDS INB REMAINING ADB A ON PAGE STB TEMP2 SPC 1 LDA PLGTH COMPUTE # WDS RAL,CLE,ERA OF PROGRAM CMB,INB THAT FALL ADB A BEYOND THIS STB TEMP1 PAGE SPC 1 SSB PROGRAM FIT ON RSS THIS PAGE? SZB,RSS NO - SKIP JMP NOLOW YES GO SET UP THE HIGH AREA SPC 1 LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # WDS OF PROG CMB,INB ON CURRENT PAGE-OR- ADB A # WDS OF PROG ON SSB,RSS NEXT PAGE SPC 1 LDA TEMP1 DIVIDE THIS öNÿÿþú CLB MINIMUM BY DIV P4 FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP NOLOW OF LOW CURRENT PG LINK BUFF RSS SPC 1 LH10 LDA CPL1H GET PASS ONE DEFINED LENGTH LDB LWH4 SET NEW STB \LNK1,I LOWER LINK ADDRESS ADB A AND UPPER LIMIT STB TPREL OF LINK BUFFER STB \LNK2,I (ALSO PROGRAM LOAD ADDRESS) JSB CLRCP CLEAR THE CURRENT PAGE IMAGE SPC 1 JSB GETCP GET ANOTHER CP LINK AREA LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA STRIP POSSIBLE SIGN BIT ADA TPREL ADD THE BASE ADDRESS STA \LNK1,I SET ORGION OF HIGH LINK AREA IOR M1777 TOP IS INA FIRST WORD OF STA \LNK2,I NEXT PAGE JSB CLRCP GO CLEAR THE ALLOCATED AREA CLA CLEAR THE UPPER COUNT WORD STA CPL2H * NOLD LDB TPREL GET PROGRAM RELOCATION BASE STB RELAD SET CURRENT RELOCATION ADDRESS * * CLASSIFY ENT, EXT, DBL, END RECS * CCA FORCE FILE READ. STA LCNT CLSR1 JSB DBSET GET FIRST WORD IN RECORD. CLSRC LDA \CURL,I SAVE THE RECORD LENGTH FOR STA \TBUF DBL SKIP ROUTINE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET SECOND WORD IN RECORD LDB A SAVE WORD IN B ALF,RAR ROTATE RIC TO LOW A AND M7 ISOLATE RIC CPA P2 ENT RECORD? JMP DENTR PROCESS ENT RECORD CPA P3 DBL RECORD? JMP DDBLR PROCESS DBL RECORD CPA P4 EXT RECORD? JMP DEXTR PROCESS EXT RECORD CPA P6 EMA RECORD? JMP EMAR PROCESS EMA DECLARATION CPA P5 END RECORD? RSS YES - PROCESS END RECORD JSB \ABOR INVALID DISK RECORD * JSB ZLOAD LOADING? JMP CLSTX NO * NOLOW LDA L01 IF FIRST OF SSA,INA Vþú IF NOT CURRENT PAGE LINKING JMP PEND JUST GO END IT * CPA P1 IF PASS ONE JMP CPRST GO DO PASS TWO * * PASS TWO OUTPUT THE CP LINK AREAS AND UPDATE. * LDA CPL1 OUTPUT THE JSB OUTCP LOW AREA LDA \CPL2 SET UP FOR THE JSB \LNKS HIGH AREA LDA CPL2H GET THE NUMBER ALLOCATED ADA \LNK1,I AND COMPUTE THE UPPER LIMIT STA \LNK2,I SET THE ACTUAL VALUE LDA \CPL2 NOW JSB OUTCP OUTPUT THE LINKS * PEND JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA TPREL GET CURRENT PROG RELOCATION BASE ADA \CURL,I ADD RELOCATION ADDRESS LDB HDFLG GET HEADING FLAG SZB,RSS SKIP UNLESS MAIN STA PRENT SAVE PRIMARY ENTRY POINT FOR ID CLSTX JSB \ILST INITIATE \LSTX CLST JSB \LSTX SET LST ADDRESSES JMP LSTCR END OF LST * LDA \LST3,I GET WORD 3 OF \LST (ORDINAL) AND M7400 ISOLATE UPPER CHAR - CLEAR ORD STA \LST3,I SET NAME 5 IN \LST JMP CLST CONTINUE CLEARING ORDINALS * LSTCR JSB ZLOAD WAS CURRENT PGM LOADED? JMP PLSCM NO SKIP ADDRESS UP DATE * LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA SET E = SIGN ADA TPREL ADD PROGRAM RELOCATION BASE ADA CPL2H REFLECT ANY CURRENT PAGE LINKS STA TPREL ALLOCATED LDB \ID5,I CHECK FOR "MAP LINKS" LDA TBREL CURRENT BP ADDRESS. RBR,RBR IF BIT 2 SLB IS SET JSB BPLNR REPORT THE BP LINKAGE * * SCAN FOR MODULES LEFT TO LOAD * PLSCM JSB \INID SCAN THE PLSCN JSB \IDX IDENTS FOR MODULES JMP CLFLG LEFT TO LOAD NONE SO GO EXIT * LDA \ID3,I GET THE FLAG WORD SLA,INA IF ALREADY LOADED JMP PLSCN TRY THE NEXT ONE * RAR,SLA,RAL IF MUST LOAD FLAG SET *eþúJMP ENTID GO LOAD IT * JMP PLSCN ELSE GO TRY NEXT IDENT. * * ENTID STA \ID3,I SET THE LOADED FLAG AND GO LOAD. JMP LOADN (\RNAM WILL CLOSE THE OLD FILE) * CLFLG CCA HANDLE ZERO LENGTH PROGRAMS. ADA TPREL FILL FINAL BSS. STA TEMP1 CMA,INA LDB \MXAB ADA B,I SSA,RSS JMP BPCNT CLA LDB TEMP1 JSB \ABDO * * DON'T CLEAR LOAD FLAGS IF POSSIBLY A SEGMENTED PROGRAM * BPCNT LDA \PTYP GET CURRENT PROGRAM TYPE CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 OR BG DISK RESIDENT RSS CPA P2 OR RT DISK RESIDENT JMP \LOAD,I YES - DO NOT CLEAR LOADED FLAGS * JSB CLID3 CLEAR PROG-LOADED FLAGS JMP \LOAD,I RETURN - ALL FLAGS CLEARED * E16RR LDA ERR16 PRINT BP OVFLOW JSB \GNER MESSAGE LDB BPINC USE LIMIT CMB,INB +1 OR -1 AS BASE ADB BPLMT PAGE BASE (DEPENDS ON WHETHER * WE'RE GOING UP OR DOWN * ALLOCATING LINKS JMP CONLD CPRST LDB CPL1H SET UP THE NEW TPREL ADB LWH4 USE SUM OF OLD AND USED LINKS STB TPREL SET NEW ADDRESS JMP LOADX GO START THE FINAL PASS SPC 1 ERR54 ASC 1,54 ERR16 ASC 1,16 LEN NOP P30 DEC 30 M37 OCT 37 M77 OCT 77 M100 OCT 100 M177 OCT 177 M377 OCT 377 M0760 OCT 076000 M2000 OCT 2000 M1177 OCT 101777 N6 DEC -6 SKP * PROCESS ENT/EXT RECORDS DENTR CCA,RSS SET ENT FLAG AND SKIP DEXTR CLA SET EXT FLAG STA NXFLG SAVE ENT/EXT FLAG LDA B GET NO. ENTRIES IN EXT/ENT AND M37 ISOLATE SYMBOL COUNT CMA,INA STA EXCNT SET SYMBOL COUNTER JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF NXSYM LDA \CURL,I GET 4þúNAME 1,2 STA \TBUF SAVE NAME 1,2 IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET NAME 3,4 STA \TBUF+1 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET NAME 5 STA \TBUF+2 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB ATBUF GET ADDRESS OF SYMBOL JSB \LSTS SET LST ADDRESSES JSB \ABOR ENT/EXT NOT FOUND IN LST * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENTRY JMP EXT1 PROCESS EXT * * PROCESS ENT * JSB ZLOAD IF NOT LOADING CURRENT PGM JMP NLENT SKIP LINK AND MAP * LDA \LST4,I IF THIS ENT IS SELF DEFINING ADA N6 SKIP IF PROGRAM * * EMA?? * SSA OR BASE PAGE RELOCATABLE JMP NLENT GO DO SELF DEFINING THING * LDA \TBUF+2 GET THE RELOCATION AND P7 INDICATOR ADA MRTAD RELOCATE THE LDB A,I SYMBOL ADB \CURL,I ADD CURRENT RELOCATION VALUE STB OPRND SAVE ABS ENTRY PT. ADDRESS STB \LST5,I SET VALUE IN THE \LST LDA L01 IF 1ST OF TWO SZA,RSS PASSES, SKIP JMP NLENT THE MAP AND FIX UP * LDA \ID5,I CHECK FOR "MAP GLOBALS". SLA,RSS SKIP - BIT 0 SET (LIST ENTS). JMP MLENT SUPPRESS PRINTING OF ENTS. * JSB CLIST CLEAR MEMORY MAP BUFFER LDA BLAST GET BLANK, ASTERISK STA MLIST+1 SET IN MAP LDA \LST1,I GET NAME 1,2 STA MLIST+2 SET IN MEMORY MAP LDA \LST2,I GET NAME 3,4 STA MLIST+3 SET IN MEMORY MAP BUFFER LDA \LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK SET LOWER CHARACTER = BLANK STA MLIST+4 SET NAME 5 IN MEM MAP LDA \LST5,I GET ABSOLUTE ENTRY PT. ADDRESS LDB AMEM5 GET ADDRESS OF MESSAGE JSB lþú\CONV CONVERT TO DECIMAL/OCTAL LDA P16 LDB AMLST GET ADDRESS OF MEM MAP BUFFER JSB \MESS PRINT ENTRY POINT * MLENT JSB DAFIX **FIX UP ALL REFERENCES TO THIS SYMBOL **** NLENT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JMP EXEND PROCESS NEXT SYMBOL * EXT1 CCA SAVE CURRENT IDENT INDEX. ADA \TIDN STA \TBUF LDA \TBUF+2 GET ORDINAL STA \LST3,I SET ORDINAL IN \LST * LDA \LST4,I GET IDENT INDEX SZA IF ENTRY NOT DEFINED CPA P2 JMP LIBTS CPA P3 OR SELF-DEFINING RSS THEN CPA P4 SKIP THE LOAD JMP LIBTS AND JUST CONTINUE CPA P5 OR UNDEFINED JMP LIBTS CPA P6 JMP EMAX CHECK PROPER REFERENCE TO EMA * REFI STA \TIDN SET ID INDEX FOR \IDX STA \TBUF+3 SAVE FOR LATER. * * GET REFERENCED IDENT JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND IN LIST LDA \ID6,I GET TYPE AND M177 ISOLATE IT STA B SAVE IT LDA \ID4,I GET M/S BIT AND MSIGN ADA B MERGE TYPE STA \TBUF+1 SAVE M/S, TYPE LDA \ID3,I GET PROGRAM USAGE FLAG STA \TBUF+2 SAVE USAGE FLAG * * RESTORE CURRENT IDENT LDA \TBUF GET CURRENT IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX. JSB \IDX SET IDENT ADDRESSES JSB \ABOR CURRENT IDENT NOT FOUND IN LIST LDA \TBUF+1 GET M/S, TYPE FOR EXT REFERENCE RAL,CLE,ERA SET E = M/S * CPA P30 JUMP IF SSGA MODULE JMP CKSSC * SZA,RSS IF SYSTEM REFERENCE JMP SYSRF GO CHECK FOR PROPER CALLER CPA P16 OR REFERENCE TO CONFIGURATOR JMP SYSRF SAME CHECKS * * CPA P14 IF REFERENCE TO LIBRARY * RSS * CPA P6 ROUTINES * JMP LIBRF CHECK FOR MRL OR MR PROG'S * ¦Ñþú EXT23 CPA P7 TYPE = UTILITY? JMP UTLRF YES - TEST FOR LEGALITY OF REFERENCE * SEZ SKIP - NOT MAIN PROGRAM JMP EXEND IGNORE PROGRAM CALL LIBUT LDA \TBUF+2 GET PROGRAM USAGE FLAG OF EXT REF SLA SKIP - PROGRAM NOT LOADED JMP EXEND OMIT PROGRAM LIST ENTRY * LDA \TIDN SAVE CURRENT IDENT INDEX. ADA N1 STA \TBUF LDA \TBUF+3 GET BACK TO REFERENCED IDENT. STA \TIDN JSB \IDX JSB \ABOR LDA \TBUF+2 LDB \PTYP IF BACK GROUND SEGMENT CPB P5 THEN IOR P4 SET THE BS FLAG IOR P2 SET THE MUST LOAD FLAG STA \ID3,I RESTORE THE FLAG TO THE IDENT LDA \TBUF RESTORE CURRENT IDENT STA \TIDN INDEX JSB \IDX AND ADDRESSES. JSB \ABOR MUST BE THERE. * EXEND ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NXSYM NO - PROCESS NEXT SYMBOL * JMP CLSRC NO - CLASSIFY NEXT RECORD * * CHECK FOR LEGALITY OF TYPE 7 UTILITY REFERENCE * UTLRF LDA \PTYP GET CURRENT LOAD TYPE CPA P30 OKAY IF SSGA JMP LIBUT AND M7 ISOLATE CPA P6 IF LIBRARY RSS THEN ERROR JMP LIBUT OTHERWISE, OKAY * * CHECK LEGALITY OF TYPE 6 OR 14 LIBRARY REFERENCE * *LIBRF LDA \PTYP GET CURRENT LOAD TYPE * CPA P30 IF SSGA - THEN ERROR * JMP CALER SINCE IT CAN'T REF MRL * AND M7 MASK TO PROG CLASS * CPA P6 IF ANOTHER LIBRARY ROUTINE * JMP EXT23 (6 OR 14), THEN OKAY * CPA P1 SO IS ANY MEMORY * JMP EXT23 RESIDENT PROG * CALER LDA ERR15 SET ERROR CODE - ILLEGAL CALL * REFRR CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT THE NO-NO LDA P5 NOW TELL 'EM THE REFERENCEE LDB \LST1 GET ASCII ADDRESDS JSB \MESS AND DISPLAY JSB \SPAC JM°nþúP EXEND TEST FOR ANOTHER * ERR15 ASC 1,15 ERR52 ASC 1,52 ERR58 ASC 1,58 * * MAKE SURE PROGRAM HAS SSGA PRIVILEGES * CKSSC LDB SSGAF GET FLAG SZB IF SET, THEN JMP EXEND JUST CONTINUE LDA ERR52 ELSE SEND ERROR MSG JMP REFRR * * CHECK LEGALITY OF SYSTEM REFERENCE * SYSRF LDA \PTYP GET CURRENT LOAD TYPE SZA IF SYSTEM CPA P30 OR SSGA RSS THEN REFERENCE IS OK CPA P16 AS IS SLOW BOOT JMP EXT23 CONTINUE CPA P15 TABLE AREA I IS JMP EXT23 OKAY CPA P13 TABLE AREA II IS JMP EXT23 OKAY LDA MTYPE GET MAIN PROGRAM TYPE AND M7 CPA P3 BG PRIVILEGED PROGRAMS ONLY JMP EXT23 HAVE VALID REFERENCES * LDA ERR58 ILLEGAL SYSTEM REFERENCE JMP REFRR SEND THE DIAGNOSTIC * LIBTS LDA LIBFG LOADING MEM. RES. LIB? CLE,SZA,RSS JMP EXEND NO SO SKIP * LDA \TLST YES,SET UP LIB REPLACE CODE. ADA N1 CLB,CLE CPA \PRV REFERENCE TO .ZPRV? CLB,CCE,INB YES SET FLAGS CPA \RNT REFERENCE TO .ZRNT? CCB,CCE YES SET FLAGS SEZ,RSS IF NEITHER JMP EXEND TREAT NORMALLY * STB LIBTP ELSE SET THE TRAP FLAG STA TRPLB AND LST INDEX JMP EXEND AND CONTINUE * * PROCESS EXTERNAL REF TO EMA SYMBOL * EMAX LDA IDSAV IS THIS A VALID RERERENCE CPA \LST5,I TO AN EMA? JMP REFI YES - IT BELONGS TO THE CURRENT PROG * LDA ERR42 NO - INVALID EMA PROGRAM TYPE, OR A JMP REFRR NON-EMA PROGRAM, OR THE WRONG EMA SYMBOL * ERR42 ASC 1,42 SKP * * SKIPR LDA \TBUF SKIP A DBL RECORD ALF,ALF GET SAVED RECORD LENGTH CMA,INA AND SET NEGATIVE INA SKIP THE LENGTH STA \TBUF SET FOR COUNTER SKIPX JSB DBSET SKIPàøþú A WORD ISZ \TBUF DONE? JMP SKIPX NO DO NEXT ONE. * JMP CLSRC YES GO GET NEXT RECORD SKP * * PROCESS DBL RECORDS * DDBLR JSB ZLOAD IF NOT LOADING JMP SKIPR SKIP TO END * LDA B GET COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA B COMPUTE THE RECORDS AND M100 RELOCATION LDB TPREL GET THE MAIN RELOCATION BASE SZA,RSS IF BASE PAGE LDB TPBRE REPLACE WITH BP BASE STB DBLAD AND SET THE RECORD BASE ADDRESS JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * LDB \CURL,I GET RELOCATION ADDRESS ADB DBLAD RELOCATE THE RECORD ADDRESS STB DBLAD SAVE RELOCATION ADDRESS LDB \ID7,I GET FIRST DBL ADDRESS ISZ PLFLG SKIP - FIRST DBL RECORD JMP DBL0 IGNORE SUBSEQUENT RECORDS * * COME HERE ON FIRST BSS OF MODULE * IF MODULE IS A SEGMENT THEN DON'T * STORE BSS ON DISK SINCE IT ONLY * INDICATES ADDRESSES SHARED WITH THE MAIN * CLA STA BSSDP ZERO LOAD POINT OFFSET LDA \ID6,I AND M17 GET PRIMARY MODULE TYPE CPA P5 RSS ADJUST LOAD PT FOR SEG JMP DBL0 START FROM REL LOC 0 * FOR ALL OTHERS STB BSSDP SAVE INITIAL PROG DISPLACEMENT LDA \ABCO ADB A,I DISC /CORE STB A,I BASE ADDRESS LDA \MXAB STB A,I AND THE MAX ADDRESS DBL0 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF DBL1 LDB \CURL,I GET RELOCATION BYTES STB REKEY SAVE FOR RELOCATION TYPE LDA N5 STA INSCN SET RELOCATION BYTE COUNT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * DBL2 LDA REKEY GET RELOCATION BYTES ALF,RAR ROTATE TO LOW A STA REKEY SAVE FOR NI¢þúEXT INSTRUCTION WORD AND M7 ISOLATE CURRENT BYTE STA LSTOS *TEMP* SAVE DBL TYPE CPA P4 EXTERNAL,EMA REFERENCE? JMP DBL4 YES - RESOLVE OR FIXUP * CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR INDIRECT LINK * CPA P6 BYTE ADDRESS? JMP DBL6 YES - GO CACULATE THE ADDRESS. * ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDB A,I GET RELOCATION BASE ADB \CURL,I ADD CURRENT INSTRUCTION WORD CLA CLEAR THE INSTRUCTION JMP DBL42 AND GO JOIN THE TYPE 4 PROCESSOR * DBL6 LDA \CURL,I GET THE INSTRUCTION WORD IOR M2000 SET THE INTERNAL BYTE FLAG BIT JMP DBL56 JOIN THE DBL 5 CODE * DBL33 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF ISZ EXCNT SKIP - LAST INSTRUCTION OUT RSS NO - CONTINUE JMP CLSRC YES - CLASSIFY NEXT RECORD ISZ DBLAD INCR DBL RELOCATION ADDRESS ISZ INSCN SKIP IF NEW RELOCATION BYTE JMP DBL2 NO - PROCESS NEXT INSTRUCTION JMP DBL1 YES - GET NEXT RELOCATION BYTE * * * PROCESS DBL EXT RECORD * DBL4 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT CLB SET OFFSET TO ZERO DBL42 STA INSTR SAVE THE INSTRUCTION WORD JMP DBL54 GO TO TYPE 5 RECORD HANDLER * DBL5 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT DBL56 STA INSTR SAVE INSTRUCTION CODE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB \CURL,I GET ADDRESS TO B LDA INSTR GET THE INSTRUCTION ALF,RAL SET E ELA IF A BYTE ADDRESS LDA INSTR GET INSTRUCTION CODE AND P3 ISOLATE THE MR FIELD ADA MRTAD INDEX INTO THE BASE TABLE ADB A,I RELOCATE THE ADDRESS SEZ IF BYTE ADDRESS THEN ADB A,I DOUBLE THE ADDRESS LDA ìœþúINSTR GET THE INSTRUCTION WORD AGAIN ARS,ARS MOVE ORDINAL TO LOW A. * * DBL TYPE 4 JOINS HERE * DBL54 AND M377 ISOLATE THE ORDINAL STA \FIX4,I SAVE ORD IN \FIX UP TBL (TEMP). STB \FIX3,I SAVE THE OFFSET/ ADDRESS LDA INSTR GET THE INSTRUCTION AGAIN AND M1760 ISOLATE THE OP CODE AND IOR HIBP MERGE BP LINK FLAG FOR FIXUP IOR LSTOS AND MERGE DBL RECORD TYPE STA \FIX2,I PUT IT IN THE \FIXUP TABLE LDA DBLAD GET THE RECORD ADDRESS STA \FIX1,I SET THE CORE ADDRESS IN THE TABLE LDA \FIX4,I GET THE ORDINAL SZA,RSS IF NONE JMP DBL57 GO OUTPUT THE INSTRUCTION * JSB LSTOS LOOK FOR ORDINAL IN LST'S JSB \ABOR HALT IF NOT THERE * LDA \TLST GET THE LST ENTRY INDEX ADA N1 LDB LIBFG GET THE LIB FLAG SZB,RSS IF NOT LOADING CORE RES LIB JMP DBL45 JUST CONTINUE * CPA TRPLB ELSE IS THIS A REFERENCE TO .ZRNT,.ZPRV ? RSS YES SKIP JMP DBL45 NO, CONTINUE * LDA $LIBR YES USE $LIBR INDEX INSTEAD STA \TLST JSB \LSTX JSB \ABOR LDA \FIX1,I GET THE CORE ADDRESS INA AND SET THE ADDRESS STA ADTRP TRAP LDA N3 STA ADTPF SET FOR FIRST ADDRESS DBL44 LDA \TLST GET NEW LST ENTRY AND CONTINUE DBL45 SZA,RSS 0 MEANS .ZRNT INDEX CCA SO SET A SPECIAL, DONT WANT 0 STA \FIX4,I \FIX UP TABLE LDA \LST4,I GET THE DEFINITION ADDRESS CPA P3 IF PREDEFINED RSS THEN GO CPA P4 SEND RSS CPA P5 OR UNDEFINED (NOP'ED) JMP DBL57 THE INSTRUCTION CPA P6 EMA? JMP DBL57 SEND INSTR CPA P2 JMP DBL58 GO ADJUST FOR COMMON * LDA \LST5,I ELSE IF SYMBOL CCE,SZA IS DEFINED JMP DBL57 ¡þú GO SEND IT * DBL60 LDA L01 IF NOT LOADING SZA SKIP THE FIX ENTRY JSB SFIX UNDEFINED SYMBOL MAKE FIX ENTRY CCA MAKE SURE FIX ENTRY IS STA \FIX1,I FLAGED PROPERLY JMP DBL33 GO GET NEXT ENTRY * DBL57 LDA \FIX1,I GET THE ADDRESS CPA ADTRP THIS A TRAP ADDRESS RSS YES SKIP JMP DBL61 NO, DO NORMAL LOAD * LDA ADTPF GET TRAP REASON FLAG INA,SZA,RSS LAST TRAP OF THREE? JMP ADDX1 YES GO DO X+1 THING * INA,SZA,RSS X ADDRESS? JMP ADDX YES GO DO X ADDRESS THING * LDA \TFIX SAVE INDEX OF ADA N1 THIS FIX-UP STA \TBUF+3 ENTRY. CLA MUST BE P+1 TRAP STA \FIX4,I SET LST \FIX INDEX TO ZERO ISZ ADTPF SET FOR X ADDRESS NEXT TRAP LDB \FIX3,I GET ADDRESS FROM \FIX LST STB ADTRP SET FOR NEXT STA \FIX3,I SET TO NOP INCASE NOT RENT LDA LIBTP GET FLAG THAT TELLS INA,SZA,RSS IF .ZRNT JMP DBL60 GO MAKE FIX ENTRY * DBL61 CCB SIGNAL CLEARING OF FIXUP ENTRY JSB DFIX SEND THE INSTRUCTION JMP DBL33 GO GET THE NEXT ENTRY * DBL58 LDA COMAD ENTRY POINT IS IN COMMON ADA \FIX3,I SO \FIX THE STA \FIX3,I THE OFFSET JMP DBL57 AND OUTPUT THE INSTRUCTION * ADDX STA \FIX3,I ZAP THE OFFSET ISZ ADTRP SET FOR NEXT TRAP ISZ ADTPF TRAP NEXT ADDRESS (X+1) LDA $LIBX REPLACE THIS ONE WITH STA \TLST $LIBX INDEX. JSB \LSTX SET IT UP JSB \ABOR LDA JSB SET INSTRUCTION IOR HIBP MERGE BP LINK BIT STA \FIX2,I TO A JSB JMP DBL44 GO SEND IT * NT2K OCT 175777 JSB JSB 0 * ADDX1 STA ADTRP CLEAR ALL TRAPS STA ADTPF LDB LIBTP GET TYPE FLAG INB,SZB IF .ZPRV JMP DBL61 JUST SEND THE WORD * <Àþú INA SET TO FORCE A FIX IN DAFIX STA \TLST WHERE FIX4,I = 0 LDA \FIX3,I GET THIS DEF STA FIXTP SAVE FOR OTHER ENTRY. LDA \TBUF+3 GET BACK TO THE STA \TFIX JSB \FIX OTHER \FIX-UP ENTRY. JSB \ABOR LDA FIXTP SET DEF IN THAT ENTRY. STA \FIX3,I JSB DAFIX GO SEND BOTH INSTRUCTIONS JMP DBL33 GET THE NEXT INSTRUCTION SKP * * PROCESS AN EMA RECORD (DECLARATION VALID) * EMAR CCE TELL ALLOC NOT TO SCAN FOR A LINK, JSB ALLOC JUST TO GO AND GET ONE STA EMLNK AND SAVE IT JSB DBSET JSB DBSET * LDB \CURL POSITION TO WORD 4 OF RECORD JSB \LSTS AND FIND EMA SYMBOL IN LST JSB \ABOR NOT THERE! CCA GET ITS LST INDEX ADA \TLST AND SAVE AS THE STA EMLST "CURRENT" EMA SYMBOL * JSB DBSET JSB DBSET POSITION TO WORD 6 LDA \CURL,I AND GET THE SYMBOL&'S STA \LST3,I ORDINAL AND SET IN LST JSB DBSET POSITION TO WORD 7 JMP CLSR1 CONTINUE WITH NEXT RECORD SKP * * ZLOAD NOP TEST FOR LOADING CURRENT PGM LDA LIBFG LIB LOADING? SZA,RSS JMP *+3 NO; THEN LOADING - GO STEP ADDRESS LDA P6 YES; CURRENT PGM TYPE=6? CPA LDTYP LDTYP CONTAINS THE LOW 3 BITS OF TYPE ISZ ZLOAD LIB AND SIX OR NOT LIB STEP ADDRESS JMP ZLOAD,I RETURN SPC 1 FIXTP NOP TRPLB NOP LIBTP NOP ADTRP NOP ADTPF NOP BLAST ASC 1, * BLANK,ASTERISK HED RTGN4 - LOADER SEGMENT SUBROUTINES. * * LSTOS - SEARCHES LST'S FOR ONE WITH ORDINAL MATCHING * \FIX4,I * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN SEQUENCE: CONTENTS OF A AND B DESTROYED. * (N+1): CURRENT LST POINTERS SET UP FOR LAST LST. * ORDINAL NOT FOUND. * (N+2): CURRENT LST POINTERS SET TO LST CO1ñNLHNTAINING * DESIRED ORDINAL. * LSTOS NOP JSB \ILST RESET TO START OF LST. LSTO2 JSB \LSTX SET ADDRS FOR NEXT ENTRY. JMP LSTOS,I IF AT END, TAKE FAILURE EXIT. * LDA \FIX4,I COMPARE ORDINALS. XOR \LST3,I AND M377 SZA JMP LSTO2 NO MATCH: TRY NEXT ENTRY. ISZ LSTOS NATCH: TAKE SUCCESS EXIT. JMP LSTOS,I åsNÿÿþú SKP * DFIX DOES THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY * AFTER THE SYMBOL (IF ANY) IS DEFINED. * * NOTE: THIS IS AN ENHANCED VERSION OF THE DFIX IN SEGMENT 5 * * CALLING SEQUENCE: * * SET UP FIX1-4 AND LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANINGLESS * DFIX NOP STB CLEAR SAVE FIXUP CLEARING FLAG CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * WILL BE -1 FOR .ZRNT INDEX * BUT NO PROBLEM SINCE IT IS * A REPLACE OPERATION * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 UNDEFINED? JMP ZFIX REPLACE WITH A NOP CPB P6 EMA? JMP EMARF CHECK TYPE FOR VALID REF * * VFIX LDB \FIX2,I GET INSTR WITH OPTIONAL BYTE, HIBP CBX BITS, AND DBL TYPE BLF,RBL IF THE BYTE SSB BIT IS SET, THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2 AGAIN AND M7 EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA NOW GET AND M1000 THE HIBP BIT STA LINKB AND SAVE LINK MODE CXA LEAVE ONLY THE AND M1740 INSTRUCTION (15-11) STA DINST LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXWþúTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA? * * CHECK FOR AN EXTERNAL WITH OFFSET * LFIX SZB,RSS JMP WFIX NOT AN EXT LDB DBLT REFERENCE WITH OFFSET? CPB P5 IE, A DBL TYPE 5 JMP CPFIX YES - GO SEE IF IT'S A DEF(FOR DIRECT LINK) * WFIX LDA DINST GET THE INSTRUCTION CLE,ELA ZAP THE INDIRECT BIT SZB IF EXT REFERENCE JMP IDEF GO USE A LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSIGN RESTORE THE SIGN BIT STA OPRND IN OPERAND(FOR LINK STORAGE) SZB IF EXTERNAL REF STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR DINST INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO OUTPUT THE WORD AFIX ISZ CLEAR SHOULD THIS FIXUP ENTRY BE CLEARED? JMP DFIX,I NOPE CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB DINST IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,“BþúI NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXT REF WITH OFFSET (NOT A DEF) * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND THEN JMP XFIX MAKE THE INSTR DIRECT CLB,INB SET B(WE KNOW IT'S AN EXT) JMP WFIX GO GET A LINK * * CONFIGURE EMA REFERENCE * EMARF CLA LDB \FIX4,I CAN THIS MODULE REFERENCE CPB EMLST THIS EMA? RSS YES - IT IS THE CURRENT EMA SYMBOL JMP ZFIX NO, SO NOP THE INSTR (EXT FLAGGED ERROR) * LDA \FIX2,I WAS THIS AN SSA INDIRECT REF TO EMA? JMP EER62 YES - CAN'T ALLOW AND M7 OR WAS IT A REF WITH OFFSET CPA P5 JMP EER62 CAN'T ALLOW IT EITHER * LDA \FIX2,I GET AND AND M1740 ISOLATE THE INSTRUCTION IOR MSIGN SET THE INDIRECT BIT IOR EMLNK MERGE THE ALLOCATED LINK JMP ZFIX AND SEND THE INSTR * EER62 LDA ERR62 SEND ERROR DIAGNOSTIC CMA,INA FOR EMA WITH OFFSET OR JSB \GNER INDIRECT CLA NOW NOP THE JMP ZFIX INSTR * ERR62 ASC 1,62 OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M1000 OCT 1000 M1740 OCT 174000 CLEAR NOP DINST NOP SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB \IFIX INITILIZE THE FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW ENTRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP K þúTHE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED FOR FIX UP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DP? RSS JMP NOCHG NO LDA DPNUM YES, DP # MUST BE >= 2 SZA,RSS JMP NOCHG MUST BE DP 1, SDA,TA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP - ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN FIRST CMA,INA IE, < DPADD ADA \FIX1,I SSA JMP CHNGM IT'S LESS * NOCHG JSB SETDM GO SET FIXUP MODE JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM FOR FIXUP * CHNGM JSB \SYS REBUILD SYSTEM MAP JSB SETDM GO SET FIXUP MODE JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET THE NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT * * SETDM NOP SET THE MODE FOR CLEARING OF FIXUPS LDB DPFLG IF WE'RE RELOCATING A DRIVER PARTITION LDA LDTYP THEN DON'T REUSE THE FIXUP ENTRY SZA OF THE DRIVER (LIBR RTNS OK) CCB JMP SETDM,I SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUB¾-þúROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER PROGRAMS. * BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA \PTYP PROG = SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S BIT RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 THEN LEAVE SET CPA P13 OR IF TABLE AREA II RSS CPA P15 OR TABLE AREA I RSS CPA P30 OR SSGA JMP TRID3 LEAVE SETT * AND M7 IF A TYPE 6 THEN CLEAR LOAD FLAGS CPA P6 UNLESS THE MRL OR MRP'S ARE BEING LOADED JMP RFMRL GO TEST CURRENT LOAD TYPE * CPA P7 IF A UTILITY PROGRAM JMP C2 THEN CLEAR IT SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT-EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP Lœ§þúINK ADDR. * RFMRL LDA \PTYP GET CURRENT LOAD TYPE CPA P1 IF MEMORY RESIDENT PROG RSS CPA P14 OR MEMORY RES LIBRARY JMP TRID3 THEN DON'T CLEAR LOAD FLAGS JMP C2 OTHERWISE, DO IT SPC 4 * THE GETCP ROUTINE SETS UP AND INITILIZES A NEW CP LINK AREA * * CALLING SEQUENCE: * * JSB GETCP * * RETURN A = \LNK1,\CPL2 ADDRESS * GETCP NOP LDA \CPL2 USE CURRENT TOP JSB \LNKS SET ADDRESSES CLA FOOL THE LINK ROUTINE STA \CPL2 JSB \LNK SET ADDRESS FOR NEXT AREA CLA SET AREA TO ZERO SIZE STA \LNK1,I STA \LNK2,I LDA \LNK3 SET THE IMAGE ADDRESS INA STA \LNK3,I LDA \LNK1 SET NEW TOP AND A FOR EXIT STA \CPL2 JMP GETCP,I RETURN SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NON LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NON FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 CLE JSB ALLOC NON ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENFmþúT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA \LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE A PROGRAM'S LINK AREA, * A DISGNOSTIC IS PRINTED. * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I WAS SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE * LINK MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS * OCCURS WHEN THE SYSTEM IS RESOLVING EXT REFERENCES FROM THE TABLE * AREAS, SSGA, OR SDA - WHERE THE LINKS MUST BE IN AL ‡þúL MAPS. * * CALLING SEQUENCE: * E = 1, DO NOT SCAN FOR AN ALREADY EXISTING LINK * E = 0, SCAN FIRST * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP SEZ SCAN? JMP NOSCN NO LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBP CURRENT LINK ALLOCATION MODE JMP NORML THEN ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM * THE TABLE AREAS, DRIVERS, OR SSGA - SO USE A LINK * IN THEIR UPPER PORTION OF BASE PAGE. * LDA LOLNK HAS LAST SYSTEM LINKE CPA TBREL ALREADY USED IT? JMP ER16 YES ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP AND UPDATE LAST UPPER BPL USED STA BPLMT AND UPPER LIMIT FOR LOWER BPL'S LDB A GET IMAGE ADDRESS ADB \ADBP OF LINK JMP ALLO1 AND GO SET UP * NOSCN CLA,INA SET SKIP FLAG = 1 STA \LNK1 NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, Æbþú100 FOR SYS, AND 1644 FOR * TABLE AREAS/SSGA/SDA/PRD'S. BPINC SET TO -1 WHEN * LOADING TABLE AREAS,SSGA,SDA,PRD'S, AND TO +1 * OTHERWISE. BPLMT SET TO LOWEST TABLE AREA/SSGA/SDA LINK * FOR SYS, LAST SYS LINK FOR PRD'S, AND LOWEST DRIVER * LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FROM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE CMA,INA DON'T DO A TR JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXITž`þú - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 \CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 \CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP SKP * * CLEAR THE CURRENT PAGE * * CLRCP CLEARS THE CURRENT PAGE LINKING IMAGE POINTED AT BY * THE CURRENT \LNK ENTRY. * CLRCP NOP LDA \LNK2,I COMPUTE CMA,INA NUMBER ADA \LNK1,I OF STA \LNK WORDS TO CLEAR SZA,RSS IF ZERO THEN JMP CLRCP,I EXIT * LDA \LNK3,I STA \LNKX GET ADDRESS OF AREA CLRC1 CLA CLEAR STA \LNKX,I A WORD ISZ \LNKX STEP TO NEXT ONE LDA \LNKX CHECK FOR ADA \CPLàiþúM OVERFLOW OF SSA,RSS IMAGE AREA JMP TRUN GO SHORTEN IF OVERFLOW * ISZ \LNK STEP COUNTER JMP CLRC1 IF NOT DONE DO NEXT ONE * JMP CLRCP,I RETURN * TRUN LDA \LNK3,I CACULATE MAX ADA \CPLM AREA SIZE CMA,SSA,INA IF NEGATIVE CLA SET TO ZERO ADA \LNK1,I ADD BASE ADDRESS STA \LNK2,I SET NEW UPPER END JMP CLRCP,I AND RETURN SKP * * OUTPUT CURRENT CURRENT PAGE * * OUTCP OUTPUTS THE AREA SPECIFIED BY \LNK1, \LNK2, AND \LNK3 * TO THE DISC. * * CALLING SEQUENCE: * * SET UP \LNK1, \LNK2, \LNK3 * JSB OUTCP * * RETURN REGISTERS MEANINGLESS * OUTCP NOP JSB \LNKS SET UP THE \LNK AREA LDA \LNK1,I GET THE CMA,INA NUMBER OF ADA \LNK2,I WORDS TO OUTPUT TO CMA,INA,SZA,RSS A AND IF ZERO JMP OUTCP,I RETURN * STA WDCNT SET THE COUNT LDA \LNK3,I GET THE ADDRESS OF THE FIRST WORD STA \TBUF AND SET IT LDB \LNK1,I GET THE CORE ADDRESS TO BE USED OUTC2 LDA \TBUF,I GET A WORD JSB \ABDO SEND IT TO THE DISC ISZ \TBUF STEP THE WORD ADDRESS ISZ WDCNT AND THE COUNT DONE? JMP OUTC2 NO DO THE NEXT WORD * JMP OUTCP,I YES RETURN SKP * * READ RELOCATABLE RECORD CONTROL * * DBSET ESTABLISHES THE ADDRESS OF THE NEXT WORD OF THE RELOCATABLE * RECORD IN \LBUF. IF \LBUF HAS BEEN PROCESSED, IT ISSUES A CALL TO * \RBIN TO READ ANOTHER RELOCATABLE RECORD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBSET * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DBSET NOP ISZ \CURL INCR CURRENT \LBUF ADDRESS ISZ LCNT SKIP - END OF \LBUF JMP DBSET,I RETURN LDA ALBUF READ NEXT RELOC RECORD. STA \CURL CLB JSB \RBIN O$þú JSB \ABOR ERROR (MSG ALREADY DISPLAYED). SZA,RSS JSB \ABOR EOF. CMA,INA SET COUNT. STA LCNT JMP DBSET,I RETURN. SPC 3 SPC 1 * SEND MESSAGE "BP LINKAGE XXXX" ROUTINE. SPC 1 BPLNR NOP LDB MES03 XXX IS IN A ON ENTRY. JSB \CONV LDA P16 LDB MES02 JSB \MESS JMP BPLNR,I * MES02 DEF MS02 MS02 ASC 8,BP LINKAGE XXXXX MES03 DEF MS02+5 SKP * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 SPC 3 * SETBP SET THE SPECIFIED BASE PAGE IMAGE WORDS TO -1 * CALLING SEQUENCE: SAME AS CLRLT. * SETBP NOP STB CLRLT SAVE THE HIGH LIMIT CCB SET THE CLEAR WORD STB CLWRD TO -1 LDB CLRLT RESTORE B JSB CLRLT GO SET THE WORDS TO -1 ISZ CLWRD RESET CLEAR WORD TO 0 NOP ALWAYS SKIPPED JMP SETBP,I RETURN SPC áNLH1 CLWRD NOP SKP * * CLEAR MEMORY MAP BUFFER * * CLIST CLEARS THE MEMORY MAP BUFFER WITH BLANKS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLIST * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CLIST NOP LDB AMLST AMLST = ADDR OF MLIST LDA N8 STA AMAD SET BUFFER LENGTH LDA BLNKS GET 2 BLANK CHARACTERS STA B,I CLEAR BUFFER WORD INB ISZ AMAD ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP CLIST,I RETURN SPC 2 B4400 OCT 4400 BLNKS ASC 1, * * END LODR QÙNÿÿ ÿý-. ÿ92067-18320 2001 S C0422 &RT4G5 GEN. SEGMENT #5             H0104 mIþúASMB,Q,R,C HED RT4G5 - I/O TABLE GENERATION SEGMENT. NAM RT4G5,5,90 92067-16320 REV.2001 790817 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************** * * NAME: RT4G5 * SOURCE PART #: 92067-18320 * REL PART #: 92067-16320 * WRITTEN BY: JJC,KFH,JH,GAA * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \IOTB,\TBLS * * EXTERNAL REFERENCE NAMES * EXT \LSTS,\TLST EXT \LST1,\LST4,\LST5 EXT \IDXS,\IDX,\TIDN EXT \ID6,\ID8 EXT \IFIX,\FIX,\PFIX EXT \FIX1,\FIX2,\FIX3,\FIX4 EXT \LNKX,\LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 * EXT \CURL,\CPL2,\TBUF EXT \SYS,\USER EXT \SRET EXT \OCTN,\CONV,\GETN,\GINT,\GET#,\GETC,\DCON EXT \ADBP,\NABP,\CMFL EXT \READ,\SPAC,\GNER,\INER,\ABOR,\MESS,\IRER EXT \ABDO,\ADSK EXT \SSID,\ASKY,\SKYA EXT \PREL * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780126 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. êÓþú * *************************************************************************** * * TB30 BSS 160 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRES"iþúS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRrþúENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -îoþú1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISC ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISC ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIYQþúABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST ATB30 DEF TB30 SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * GIO LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * SPC 1 N DEC -1 LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * THIS SECTION OF CODE GENERATES THE I/O TABLES FOR THE SYSTEM. * THESE INCLUDE THE EQUIPMENT TABLE (EQT), DEVICE REFERENCE * TABLE (DRT), INTERRUPT TABLE (INT), AND DRIVER MAP TABLE (DVMAP). * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T><,X><,S><,M> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = EQT EXTENSION SIZE TO BE ENTERED * S = SYSTEM DRIVER AREA * M = SYSTEM DRIVER AREA WITH MAPPING * * IF T IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST BE NEXT ENTERED IN RESPONSE TO: * ' T = ' * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICHþúH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * * GENERATE EQUIPMENT TABLE (EQT) * \IOTB NOP JSB \SPAC SEND A SPACE LDA PAGE# CONVERT CURRENT PAGE # CMA,INA TO DECIMAL ASCII LDB MS32A AND STUFF IN MESSAGE. JSB \CONV STUFF. LDA P30 LDB MES32 JSB \MESS PRINT: TABLE AREA I <>: * JSB \SPAC MAKE IT LOOK NICE. LDA \PREL SET STARTING ADDRESS STA AEQT OF EQT'S CLA STA CEQT CLEAR NO. OF EQT ENTRIES STA SPLCO CLEAR THE SPOOL EQT COUNT STA BPONL ?AND THE BASE PAGE ONLY FLAG CCA SET DRT2 AND STA DRT2 DRT3 STA DRT3 TO IMPOSSIBLE NUMBERS LDA ATB30 ADA P65 SET FOR HEADER RECORD STA HEADR STORAGE JSB \SPAC LDA P22 LDB MES25 MES25 = ADDR: EQT \FþúTABLE ENTRY JSB \MESS PRINT: EQUIPMENT TABLE ENTRY * JSB SFIX GET A FIXUP ENTRY IF NEEDED SEQT JSB \SPAC SEND \SPAC LDA CEQT CPA P63 OVER LAST ALLOWED DEFINITION? JMP BLEQT YES, MAX OF 63 CMA LDB ATBUF THE CURRENT EQT JSB \CONV NUMBER TO ASCII LDA \TBUF+2 SET IN THE SETNO STA MESEQ EQT MESSAGE BUFFER LDA P7 GET MESSAGE LENGTH LDB MESQE SEND MESSAGE "EQT XX?" AND JSB \READ GET EQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA "/E" CHARS = /E? JMP EQTFX YES - SET DEVICE REF TABLE (SQT) * LDA CEQT GET NUMBER OF DEFINED EQT'S CPA P63 IF OVER LIMIT JMP EQTOV THEN SEND ERROR UNTIL /E JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U * IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * BLEQT LDA BLNKS SET EQT # TO BLANKS JMP SETNO IN PROMPT * EQTOV LDA ERR35 SET CODE = OVER 63 DEFINED EQT'S CMA,INA SIGNAL NO TR TO THE OPERATOR JSB \GNER PRINT THE DIAGNOSTIC JMP SEQT CONTINUE UNTI /E ENTERED * CLDBU LDB \OCTN GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS CLA STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA IOSDM CLEAR SDA/MAPPING WORD STA XLNTH CLEAR EXTENSION LENGTH STA \FIX3,I CLEAR THE STA \FIX4,I FLAG WORDS STA \FIX2,I STA TVAL AND TIME OUT VALUE CCA STA TFLAG CLEAR TIME-OUT FLAG LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPBþúA "DV" CHAR = "DV"? CLA,INA,RSS YES - CONTINUE JMP DVERR INVALID DRIVER NAME JSB \GETN MOVE 1 CHAR TO \TBUF (CHAR 3) JMP STYPE GET DRIVER TYPE * DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * STYPE STA X. SAVE KEY CHARACTER (R FOR STD.) LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF STA .YY SAVE 2 ASCII CHARS FOR I.XX,C.XX CCA ADA \CURL ADJUST CURRENT LBUF ADDR STA \CURL RESET \CURL TO CONVERT TYPE LDA P2 JSB \GET# GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME * LDB \OCTN GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA \FIX1,I STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG STA XFLAG SET EQT EXTEND FLAG STA SFLAG SET SDA FLAG STA MFLAG SET MAPPING FLAG * INDBU CCA STA \CMFL SET COMMA FLAG = NO COMMA IN JSB \GETC GET NEXT CHAR FROM LBUF CPA "D" CHAR = D? JMP SEDMA YES - SET DMA CODE * CPA "B" CHAR = B? JMP SETBU YES - SET BUFFERING CODE * CPA "T" CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG * CPA "X" CHAR = X? JMP SETEX YES GO SET UP EQT EXTENSION * CPA "S" CHAR = S? JMP SETSD YES - SET SDA CODE FOR DVMAP * CPA "M" CHAR = M? JMP SETSM YES = SET SDA/MAPPING CODE FOR DVMAP * UNERR LDA ERR26 SET CODE = INVALID D,B,T,X JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT4øþú RECORD * SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JMP TEQU GET THE TIME OUT VALUE * * EQTST JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX * CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED * LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED * LDA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SETSD ISZ SFLAG SKIP - FIRST S ENTERED JMP UNERR DUPLICATE S'S ENTERED * LDA BIT14 SET BIT 14 = 1 JMP SETS2 IN IOSDM FOR DVMAP * SETSM ISZ MFLAG SKIP - FIRST M ENTERED JMP UNERR DUPLICATE M'S ENTERED * LDA BIT13 SET BIT 13 (MAPPING) IOR BIT14 AND BIT 14 (SDA) TO 1 SETS2 IOR IOSDM IN WORD FOR DVMAP STA IOSDM JMP EQTST TEST FOR NEXT OPERAND * SETEX ISZ \FIX1,I SKIP FIRST X ENTERED JMP UNERR NO BITCH * TEQU STA I.XX SAVE THE TYPE FLAG JSB \GETC GET THE NEXT CHARACTER CPA EQU IF NOT "=" RSS JMP UNERR BITCH * LDA N5 GET DECIMAL NUMBER JSB \GET# JMP UNERR ILLEGAL NUMBER SO BITCH * LDB I.XX GET THE TYPE FLAG CPB "X" IF EXTENSION JMP QEXT SAVE THE LENGTH OF THE EXTENSION STA TVAL SET THE TIME OUT VALUE JMP EQTST GO GET THE NEXT OPERAND * QEXT STA XLNTH SAVE EXTENSION SIZE STA \FIX3,I FOR BUILDING IT LDB \PREL SET ADDRESS OF ADB P12 EQT 13 ¶çþú STB \FIX2,I FOR LATER FIXUP JMP EQTST GET NEXT OPERAND * GENEQ LDA X. GET THE KEY CHARACTER STA SFLAG AND SAVE **TEMPORAY** CPA "R" IF R THEN USE LDA "." A PERIOD. IOR "INL" SET "I" IN UPPER HALF STA X. SET FOR LST SEARCH LDB ENT GET ADDRESS JSB \LSTS LOOK FOR SYMBOL JMP DVERR ILLEGAL DRIVER ENT NOT FOUND. * LDA \LST4,I RETRIEVE IDENT INDEX OF STA \TIDN DRIVER MAIN, AND JSB \IDX SET IT UP JSB \ABOR BETTER BE THERE! LDA \ID6,I MUST BE A TYPE 0 MODULE AND M177 SZA JMP DVERR ELSE ERROR * LDB IOADD GET CHANNEL # CPB DCHNL WAS IT THE SYSTEM DISC RSS CHANNEL? JMP COMPS NO CLA MAKE SURE SDA JMP CHSM WASN'T SPECIFIED FOR IT * COMPS LDA \ID8,I WAS AN EQT PREVIOUSLY SSA,RSS DEFINED FOR THIS DRIVER? JMP SETFX NO, SO NEEDN'T CHECK AND SMBIT THE S,M SPECIFICATIONS CHSM CPA IOSDM (OR ABSENCE OF EITHER/BOTH) JMP SETFX OK, NEW CONFORMS WITH OLD, DISC NOT SDA * LDA ERR23 SET CODE = EQT DOESN'T DEFINE JSB \GNER SAME S,M SPECS FOR DRIVER - OR THE JMP SEQT SYSTEM DISC WAS SPECIFIED AS SDA * SETFX JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR, HIBP BIT, DIRECT ADDR STA \FIX2,I CLA STA \FIX3,I CLEAR OFFSET CCA SET ADA \TLST LST INDEX OF STA \FIX4,I I.XX STA TEMP2 SAVE FOR NOCXX LDA \PREL GET EQT2 ADDRESS WHERE INA I.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR CODE, HIBP BIT, STA \FIX2,I AND DIRECT ADDRESS CLA STA \FIX3,I CLEAR OFFSET LDA \PREL SET EQT3 ADDRESS ADA P2 ,1þú WHERE C.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * LDA X. GET THE I. OR WHAT EVER XOR B5000 CHANGE IT TO C. OR WHAT EVER STA X. AND RESET LDB ENT SCAN THE LST JSB \LSTS FOR THE "C.YY" ENTRY POINT. JMP NOCXX C.XX NOT FOUND IN LST CCA SET LST ADA \TLST INDEX OF C.XX * STCXX STA \FIX4,I IN FIXUP ENTRY LDA X. IF THIS IS CPA "CS" DVS43 THEN LDA .YY COUNT CPA "43" A ISZ SPLCO SPOOL EQT * LDA IOADD SAVE THE CHANNEL AND AND M377 TYPE IN THE HEADER ALF,ALF RECORD LDB IOTYP BLF,BLF IOR B STA HEADR,I ISZ HEADR * CLA LDB \PREL GET THE ADDRESS JSB \ABDO PUT OUT I/O LIST POINTER CLA ENTRY POINT TO BE FIXED UP JSB \ABDO OUTPUT ABSOLUTE DVRXX ENT ADDR LDA C.XX GET DRIVER EXIT POINT JSB \ABDO OUTPUT ABSOLUTE DVRXX COMP. ADDR LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. JSB \ABDO OUTPUT D,B,U, CHANNEL * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,1 CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE JSB \ABDO OUTPUT EQUIPMENT TYPE, STATUS * ADB P6 INDEX TO EQT12 LDA XLNTH GET EXTENSION SIZE JSB \ABDO AND SEND IT TO THE DISC INB STEP TO EQT14 LDA TVAL GET THE TIME OUT VALUE SZA IF ZERO LEAVE IT CMA ELSE SET IT TO ONES COMPLEMENT JSB \ABDO SEND TIME OUT TO EQT INB SET THE ADDRESS STB \PREL OF THE NEXT EQT * LDB DDVMP GET DVMAP BUFFER ADDRESS ADB CEQT (NLH FOR STORAGE LDA IOSDM SET POSSIBLE S,M BITS IOR MSIGN AND EQT DEFINED BIT IOR \ID8,I STA \ID8,I IN DRIVER IDENT RAL POSITION S BIT TO 15 SSA SKIP IF NOT SDA JMP SDAEQ GO SET DVMAP ENTRY FOR SDA DRIVER * CCA GET DRIVER IDENT INDEX ADA \TIDN FOR SCAN ON RELOCATION IOR BIT14 SET TO DISTINGUISH FROM SDA,PAGE # IN ENTRY STA B,I AND STORE IN DVMAP ENTRY JMP NEXTE SET UP FOR NEXT EQT * SDAEQ STB MFLAG SAVE DVMAP ENTRY ADDR **TEMP** LDB MSIGN BIT 15 MUST BE SET FOR SDA RAL POSITION M BIT TO 15 SSA SKIP IF NO MAPPING INB SET BIT 0 IF DRIVER MAPS STB MFLAG,I AND STORE IN DVMAP * NEXTE JSB SFIX GET A NEW FIXUP TABLE ENTRY IF NEEDED ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * ‚«NÿÿþúNOCXX LDA TEMP2 C.XX NOT FOUND SO USE JMP STCXX I.XX INDEX SPC 2 MESQE DEF *+1 ASC 2,EQT DO NOT REARANGE THESE MESEQ NOP THESE THREE ASC 1,? LINES "CS" ASC 1,CS "43" ASC 1,43 D26 DEC 26 "R" OCT 122 "X" OCT 130 EQU OCT 75 ASCII "=" XFLAG NOP TVAL NOP "DV" ASC 1,DV "." OCT 56 "INL" OCT 44400 ASCII I NULL B5000 OCT 5000 BIT13 OCT 20000 HIDIR OCT 1005 HIGH BP,DIRECT LINK(DEF TO EXT) FOR FIXUPS SPC 5 EQTFX JSB \IFIX ALLOCATE AND SET UP NXEQF JSB \FIX EXTENDED EQTS JMP SDVMP END OF FIXUPS, GO BUILD DVMAP * LDA \FIX1,I GET THE TYPE FLAG SZA IF NOT ZERO THEN NOT JMP NXEQF AN EQT PATCH ENTRY * LDB \FIX2,I GET EQT13 ADDRESS LDA \PREL AND CURRENT CORE ADDRESS JSB \ABDO OUTPUT THE ADDRESS LDA \PREL RESERVE THE ADA \FIX3,I CORE STA \PREL CCA CLEAR THE FIX STA \FIX1,I ENTRY JMP NXEQF AND TRY THE NEXT ONE SPC 5 * * BUILD DRIVER MAP TABLE * SDVMP LDA CEQT SET LOOP COUNTER CMA,INA FOR NUMBER OF STA TEMP2 EQT'S DEFINED * LDB \PREL GET NEXT CORE ADDRESS SDMVL LDA DDVMP,I GET NEXT DVMAP ENTRY JSB \ABDO OUTPUT IT ISZ DDVMP BUMP BUFFER ADDRESS ISZ TEMP2 AND LOOP COUTER JMP SDMVL MORE TO GO * LDA \PREL SAVE ADDRES OF STA DVMAP DRIVER MAP TABLE ADB CEQT RESERVE SPACE FOR SECOND STB \PREL (BLANK HALF OF TABLE) * STB ASQT SET START OF DRT TABLE SKP * * SET DEVICE REFERENCE TABLE (DRT) * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CLA,INA STA CSQT SET SQT COUNT = 1 CCA STA LFLAG SET 1ST DEV REF INPUT FLAG = -1 LDA P22 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB \MESS PRINT:Lðþú * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. CPA P255 OVER MAXIMUM ALLOWED? JMP BLDRT YES, GO BLANK THE # CMA,INA SET TO NEG. FOR DECIMAL CONV LDB ATBUF GET ADDRESS OF TBUF JSB \CONV CONVERT TO DECIMAL AT TBUF LDA \TBUF+1 GET 2 MOST SIGNIF. DIGITS. AND M177 IOR UBLNK BLANK OUT LEFTMOST DIGIT. LDB \TBUF+2 GET 2 LEAST SIGNIF. DIGITS. SET# STA MES28+1 PUT DEV REF CODE IN MESSAGE (MSD'S) STB MES28+2 PUT DEV REF CODE IN MESSAGE (LSD'S) JSB \SPAC NEW LINE LDA P14 LDB MES28 MES28 = ADDR: XXXX = EQT #? * JSB \READ GET SQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP SINTT YES - SET INTERRUPT TABLE LDA CSQT WAS THIS DRT ALLOWED? CPA P255 NO MORE THAN 254 JMP DRTOV OVER LIMIT JSB \GINT RE-INITIALIZE LBUF SCAN LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP SUBCH IGNOR SUBCHANNEL JSB \GETC COMMA ENCOUNTERED? SZA,RSS YES - GO GET SUBCHANNEL JMP SUBCH NO - DEFAULT IT TO ZERO * LDA N2 JSB \GET# GET TWO DECIMAL DIGITS JMP DRERR AND M37 KEEP MAX SIZE CPA \OCTN IF NOT SAME JMP SUBCH JMP DRERR THEN ERROR * BLDRT LDA BLNKS SET DRT # TO BLANKS LDB BLNKS JMP SET# WHEN MORE THAN 256 * DRTOV LDA ERR35 SET CODE = MORE THAN 254 DRT'S CMA,INA SIGNAL NO TR TO OPERATOR JSB \GNER PRINT DIAGNOSTIC JMP DEVRE CONTINUE UNTIL /E ENTERED * SUBCH STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. ìíþú LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE CPB P2 SECOND ENTRY? RSS YES - CONTINUE JMP SESQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CPB P1 FIRST SQT ENTRY? RSS YES - CONTINUE (SET TTY CHANNEL) JMP SESQT PUT OUT DEV. REF. NO. TO SQT CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH STB TTYCH SET EQT ADDR IN TTY CHANNEL * ADB P3 RETRIEVE THE CHANNEL NO. JSB \ABDO TO INSERT IN THE HEADER RECORD STA TB30+64 PUT IN PLACE ADB N1 RESTORE THE WORD JSB \ABDO * SESQT LDB CSQT SET UP TO TEST LDA TEMPS FOR PROPER SUB CHANNEL REFERENCES CPB P2 DEV. REF = 2? CPA SYSCH YES - SYSTEM SUB CHANNEL? RSS YES - YES OR NO -X SKIP JMP DRERR YES - NO - ERROR CPB P3 DEV. REF =3? CPA AUXCH YES - AUX SUB CHANNEL? JMP SETQT YES - YES OR NO - X - GO SETUP * LDA AUXCH GET THE CHANNEL SSA IF DISC ON DIFFERENT CONTROLER JMP SETQT GO SET IT UP * LDA TEMPL YES - NO - TEST FOR AUX UNIT DEFINED LDB DAUXN SZB SKIP IF NO AUX UNIT JMP DRERR AUX DEFINED SO ERROR * SZA NO AUX-UNIT WAS REF = 0? °œþúJMP DRERR NO - SO ERROR * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB CSQT SET UP TO TEST FOR ILLEGAL DISC REF. CPA DRT2 IF SAME AS SYSTEM DISC JMP DRERR ERROR CPB P2 IF SYSTEM DISC ENTRY STA DRT2 SET FOR FUTURE TESTING CPA DRT3 IF SAME AS AUX DISC JMP DRERR ERROR SZA,RSS IF ZERO SKIP JMP *+3 TEST FOR AUX ENTRY CPB P3 IF AUX ENTRY STA DRT3 SET FOR FUTURE TESTING LDB \PREL SET CORE ADDRESS JSB \ABDO OUTPUT SQT ENTRY ISZ \PREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY * DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB \GNER PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS NOP HEADR NOP D$CIC DEF $CIC P255 DEC 255 SKP SINTT LDA DRT2 GET EQT # FOR SYSTEM DISC AND M77 CCB AND OFFSET INTO THE DRIVER MAP TABLE ADB A IN ORDER TO GET THE ADB DVMAP JSB \ABDO IDENT INDEX OF THE SYSTEM STA SDID DISC DRIVER TO FORCE IT INTO ADB N1 DP #1 AT RELOCATION TIME JSB \ABDO RE-STORE SDID VALUE * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CCB ADB CSQT SUBTRACT 1 FROM SQT COUNT STB CSQT SET SQT COUNT * ADB \PREL THE FOLLOWING ALLOWS FOR TWO WORDS STB \PREL PER DRT ENTRY CLA ZERO THEM OUT STA ENDFL JSB \ABDO * * SET INTERRUPT TABLE (INT) * LDA \PREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA \ADSK GET CURRENT ABS. CODE DISK ADDR STA DSKIN SAVE INT CODE DISK ADDR LDA DCNT GET CURRENT ABS. CODE DBUF COUNT STA INTCN SAVE INT CODE DISK RECORD COUNT Ê?þú LDA P15 LDB MES29 MES29 = ADDR. * INT TABLE JSB \MESS PRINT: * INTERRUPT TABLE LDB AILST GET ADDRESS OF ILIST STB CURIL GET CURRENT ILIST ADDRESS JSB BUFCL CLEAR ILIST * LDB D$CIC GET LST INDEX FOR JSB \LSTS SYSTEM MODULE $CIC JMP NOCIC NOT FOUNT, BAD!! CCA ADA \TLST FOR STORAGE IN STA JSCIC FIXUP ENTRIES * CLA ALLOCATE FIXUP ENTRIES FOR SETIL STA TCNT INT. LOCATIONS 0-3,5 * JSB SFIX GET A NEW FIXUP ENTRY LDA TCNT AND GO BUILD IT JSB INTFX FOR THIS LOCATION INA BUMP TO NEXT LOCATION CPA P4 SKIP LOCATION 4 INA (SET BELOW) CPA P6 DONE WITH THE LOOP? RSS YES JMP SETIL NO, CONTINUE FIXUP'S * LDB P4 INITIALIZE TRAP CELL FOUR ADB \ADBP ADJUST TO PSEUDO BASE PAGE LDA HLTB4 TO HALT(B) 4 STA B,I ADB P2 GET ADDR OF FIRST INT LOCATION, 6 STB MEM12 SET CURRENT BP ADDRESS JSB \SPAC * SETIN JSB SFIX GET A NEW FIXUP ENTRY IF NEEDED * CLA,INA NEW LINE LDB HYADD JSB \READ GET INT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP ENDIO YES - I/O TABLES COMPLETE JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR28 SET CODE = INVALID INT CHNL NO. JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I CLEAR FIXUP ENTRY JMP SETIN REPEAT INT REC INPUT * NOCIC LDA ERR21 SET CODE = CIC NOT FOUND IN LST JSB \IRER IRRECOVERABLE ERROR * SETCH LDA \OCTN Ö‰þú GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. * LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "EQ" CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD * CPA "PR" CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD * CPA "EN" CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD * CPA "AB" CHARS = AB? JMP INTAB YES - PROCESS INT ABS RECORD * IMNEM LDA ERR30 SET CODE = INVALID INT MNEMONIC JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * INTEQ LDA N2 JSB \GETN MOVE NEXT 2 CHARS TO \TBUF CPA UTCHR CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDB \OCTN GET EQT TABLE ENTRY NO. CMB,INB,SZB,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STB TCHR SAVE EQT NO. ADB CEQT ADD UPPER EQT REF. NO. SSB,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE * EQUER LDA ERR31 SET CODE = INVALID EQT NO. JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHR GET EQT REF. NO. LDA AEQT GET ADDR OF EQT INB,SZB,RSS SKIP - NOT FIRST EQT REFERENCE JMP SEQTI SET EQT ADDR IN INT TABLE * ADA P15 ADJUST FOR NEXT EQT ENTRY ADDR INB,SZB SKIP - EQT ADDRESS FOUND JMP *-2 CONTINUE EQT SEARCH * SEQTI LDB JSCIC GET $CIC INDEX JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UGCHR CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF úÞþúFIND THE PROGRAM JSB \IDXS IN THE IDENT LIST JMP PRERR INVALID PROGRAM NAME LDB JSCIC GET $CIC INDEX LDA \TIDN GET CURRENT IDENT INDEX ADA N1 CMA,INA SET NEGATIVE JMP COMIN SET INTERRUPT TABLE, LOCATION * PRERR LDA ERR32 SET CODE = INVALID PROGRAM NAME JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * * INTEN LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UTCHR CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF FIND THE ENTRY JSB \LSTS IN THE \LST JMP ENERR INVALID ENTRY POINT LDA \LST4,I GET IDENT INDEX SZA,RSS SKIP - ENT IS DEFINED JMP ENERR INVALID ENTRY POINT STA \TIDN SET IDENT INDEX OF PROGRAM JSB \IDX SET IDENT ADDRESSES JSB \ABOR END OF IDENT LIST LDA \ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE SZA SKIP IF A SYSTEM PROGRAM JMP ENERR ERROR IF NOT LDB \ID8,I CHECK IF HAS AN EQT SSB,RSS SKIP IF DOES JMP SETEN NOT,SO ALWAY PRESENT IN SYS MAP RBL MOVE SDA BIT TO 15 SSB SKIP IF NOT SDA JMP SETEN MUST BE IN SDA IF A DRIVER * ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * * ALLOCATE A FIXUP FOR THE ENT * * SETEN LDA IJSB BUILD FIXUP TABLE ENTRY IOR HIBP SET TO UPPER LINK STA \FIX2,I AND STORE JSB 0,I CODE LDB INTCH AND THE INT LOCATION STB \FIX1,I CCA ADA \TLST STORE THE LST INDEX OF STA \FIX4,I THE ENT CLA CLEAR THE STA \FIX3,I OFFSET JSB SFIX MAY NEED ANOTHER FIXUP CLA CLB SET ¦îþúINT ENTRY & LOC TO 0 JMP COMIN * INTAB LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA USCHR CHARS = U,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB \GET# GET 6 OCTAL DIGITS, CONVERT JMP ABERR INVALID ABS DIGIT CLA LDB \OCTN GET ABSOLUTE VALUE * * THE 4 FORMATS ARE NOW: * ENT: A-REG = 0 B-REG = 0 * PRG: A-REG = - IDENT INDEX B-REG = $CIC IDENT INDEX * EQT: A-REG = EQT ADDRESS B-REG = $CIC IDENT INDEX * ABS: A-REG = 0 B-REG = ABSOLUTE VALUE * COMIN STA \TBUF SAVE INT TABLE CODE STB \TBUF+1 SAVE INT LOCATION CODE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP *+4 YES - CONTINUE * LDA ERR36 SET CODE = INVALID FINAL OPRND JSB \GNER PRINT DIAGNOSTIC JMP SETIN GET NEXT INT RECORD * LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR FILLM CMA,INA ADA \NABP ADJUST FOR BP LOCATION ADDR ADA MEM12 ADD CURRENT BP ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION * SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES LDA ERR29 SET CODE = INVALID INT CHNL ORDR JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I MARK ENTRY AS FREE JMP SETIN GET NEXT INTERRUPT RECORD * PFINT LDA \TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' * LDA \ADBP ADA P4 ADJUST LDB \TBUF+1 STORE INTO STB A,I TRAP CELL FOUR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 106004 TRAP CELL DEFAULT VALUE * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED FILLJ CLA 8:þú SET INTERRUPT TABLE ENTRY = ZERO LDB \PREL GET ADDRESS JSB \ABDO OUTPUT ZERO TO INTERRUPT TABLE ISZ \PREL INCR CURRENT INT TABLE ADDRESS LDA MEM12 GO BUILD A FIXUP TO ADA \NABP JSB INTFX $CIC FOR THIS INT LOCATION JSB SFIX GET A NEW ENTRY ISZ MEM12 INCR CURRENT INT LOCATION ADDR ISZ CURIL STEP THE INT IMAGE ADDRESS ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLJ CONTINUE INT FILL-IN * STINT LDB \TBUF+1 IF THIS IS A "JSB $CIC,I" CPB JSCIC (IE, LST INDEX) JMP FXINT THEN GO BUILD A FIXUP STB MEM12,I ELSE PUT INT LOCATION CODE IN INT LOC STIN1 ISZ MEM12 INCR CURRENT BP LOCATION ADDR * LDA \TBUF GET INT TABLE CODE STA CURIL,I SET WORD IN INT IMAGE ISZ CURIL STEP IMAGE ADDRESS FOR NEXT TIME LDB \PREL GET CORE ADDRESS JSB \ABDO OUTPUT INT TABLE ENTRY ISZ \PREL INCR CURRENT RELOCATION ADDR ISZ ENDFL DONE WITH THE TABLE? JMP SETIN NO, GET NEXT LOCATION JMP ITAI YES, EXIT * FXINT LDA INTCH GO CHANNEL #(INT LOC.) JSB INTFX GO BUILD A JSB $CIC,I FIXUP FOR IT JSB SFIX AND GET A FREE ENTRY JMP STIN1 CONTINUE * ABERR LDA ERR34 SET CODE = INVALID ABS DIGIT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * ENDIO LDA M77 WERE ALL LOCATIONS CPA INTCH DEFINED? JMP ITAI YES,NEEDN'T FILL IN STA INTCH NO, MUST SiMULATE A CLB DEFINITION OF 77B STB \TBUF IN ORDER TO FILL IN ALL LDB JSCIC INTERRUPT LOCATIONS STB \TBUF+1 AND THE TABLE CCB SET FLAG STB ENDFL TO EXIT FROM FILLJ TO ITAI JMP FILLM GO SET LOOP COUNT * ITAI JSB \SPAC LDA P20 LDB MES30 JSB SETHD PRINT: TABLE AREA I MODULES JMP \IOTB,I AND ˆáþúINITIALIZE IDX * ENDFL NOP END OF TABLE FLAG = -1 ON LAST PASS P20 DEC 20 SPC 3 * BUILD A FIXUP ENTRY FOR A JSB $CIC,I * AT THE LOCATION IN A-REG * INTFX NOP STA \FIX1,I SAVE THE INSTRUCTION ADDRESS LDB IJSB GET THE INSTRUCTION ADB HIBP MERGE IN THE HIGH BP LINK FLAG STB \FIX2,I AND SAVE LDB JSCIC GET LST INDEX OF STB \FIX4,I $CIC, AND SAVE CLB STB \FIX3,I CLEAR OFFSET JMP INTFX,I SKP * IOADD BSS 1 I/O ADDR (CHANNEL NO.) IN EQT IOSDM BSS 1 I/O SDA/MAPPING FLAG IN EQT IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT IOTYP BSS 1 I/O DRIVER TYPE IN EQT (OCTAL) DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT TFLAG BSS 1 TIME-OUT ENTRY FLAG FOR EQT SFLAG BSS 1 SDA ENTRY FLAG FOR EQT MFLAG BSS 1 MAPPING FLAG FOR EQT XLNTH BSS 1 EQT EXTENSION SIZE FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. JSCIC BSS 1 JSB CIC,I CODE FOR INTERRUPT LOC I.XX BSS 1 DRIVER ENTRY POINT C.XX BSS 1 DRIVER EXIT POINT SPC 3 MES28 DEF MS28 MS28 ASC 7, = EQT #? MES29 DEF MS29 MS29 ASC 8,INTERRUPT TABLE ENT DEF *+1 X. ASC 1,I. .YY NOP ASC 1, SPC 1 MES25 DEF *+1 ASC 11,EQUIPMENT TABLE ENTRY SPC 1 MES26 DEF *+1 ASC 11,DEVICE REFERENCE TABLE SPC 1 MES30 DEF *+1 ASC 10,TABLE AREA I MODULES MES31 DEF *+1 ASC 11,TABLE AREA II MODULES MES32 DEF *+1 ASC 15,TABLE AREA I <>: MS32A DEF MES32+11 MES33 DEF *+1 ASC 15,TABLE AREA II <>: MS33A DEF MES33+11 SPC 2 ERR21 ASC 1,21 $CIC NOT FOUND IN LST ERR23 ASC 1,23 DRIVER S,M SPEC'S DON'T CONFORM ERR24 ASC 1,24 INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,25 INVALID DRIVER NAME ERR26 ASC 1,26 INVALID D,B, OR T Ö£B@64 ERR60 ASC 1,60 TOTAL # ID SEGMENTS > 255 "/E" ASC 1,/E IJSB JSB 0 JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR "D" OCT 104 ASCII CHAR D "B" OCT 102 ASCII CHAR B "T" OCT 124 ASCII CHAR T "S" OCT 123 ASCII CHAR S "M" OCT 115 ASCII CHAR M BIT14 OCT 40000 BIT 14=1 $CIC ASC 3,$CIC "EQ" ASC 1,EQ "PR" ASC 1,PR "EN" ASC 1,EN "AB" ASC 1,AB UTCHR ASC 1,T UGCHR ASC 1,G USCHR ASC 1,S SPC 2 ZERO DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P24 DEC 24 P25 DEC 25 P26 DEC 26 P28 DEC 28 P29 DEC 29 P30 DEC 30 P32 DEC 32 P63 DEC 63 P65 DEC 65 N2 DEC -2 N3 DEC -3 N5 DEC -5 N11 DEC -11 N65 DEC -65 LM100 OCT -100 M37 OCT 37 M77 OCT 77 M377 OCT 377 M177 OCT 177 M7000 OCT 177000 M7400 OCT 177400 SMBIT OCT 60000 MSIGN OCT 100000 BLANK OCT 40 BLNKS OCT 20040 HYADD DEF *+1 ASC 1,- UBLNK OCT 20000 TEMP3 NOP Æ”Bÿÿþú SKP * * GENERATE THE CLASS I/O TABLE ($CLAS) * \TBLS NOP JSB \SPAC JSB \SPAC LDA PAGE# CONVERT PAGE # TO CMA,INA DECIMAL ASCII LDB MS33A AND STUFF IN MESSAGE. JSB \CONV LDA P30 LDB MES33 JSB \MESS PRINT: TABLE AREA II <>: JSB \SPAC JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 18 CHARACTERS DEF MES04 '# OF I/O CLASSES?' DEF $CLS ADDRESS OF ENT NAME ADB \OCTN RESERVE ROOM STB \PREL FOR IT (SETS IT TO ZERO) * * GENERATE THE LU MAP TABLE ($LUSW) * JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 DEF MES05 '# OF LU MAPPINGS?' DEF $LUMP ADDRESS OF ASC ENT NAME LDA \OCTN INITILIZE THE TABLE CMA,INA TO STA \TBUF -1'S NXLUM CCA AND JSB \ABDO THEN ISZ \TBUF JMP NXLUM RESET * STB \PREL THE RELOCATION ADDRESS * * GENERATE THE RN TABLE ($RNTB) * JSB RED2 SEND MESSAGE AND GET P22 DEC 22 ANSWER DEF MES06 '# OF RESOURCE NUMBERS?' DEF $RNTB ADDRESS OF ENT POINT NAME ADB \OCTN RESERVE THE TABLE AREA STB \PREL (SETS IT TO ZERO) * * SET UP THE BUFFER LIMITS ($BLLO,$BLUP) * BLGEN LDA D26 SEND MESSAGE 'BUFFER LIMITS (LOW,HIGH)?' LDB DMES7 AND GET ANSWER JSB \READ JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLGEN IF ERROR TRY AGAIN STA BLLO SAVE THE NEGATIVE VALUE * JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLGEN IF ERROR TRY AGAIN STA BLHI SAVE THE NEGATIVE VALUE * * GENERATE THE LU AVAILABILITY TABLE ($LUAV) * LDB $LUAV MAKE THE LUAV TABEL JSB \LSTS FIRST SET UP THE ENTRY JSB \ABOR IT BETTER BE THERE LDB \PREL ÎêþúGET THE CORE ADDRESS STB \LST5,I SET THE ADDRESS LDA SPLCO GET THE NUMBER OF ENTRYS CMA,INA,SZA IF ZERO SKIP THE TABLE GEN. JSB \ABDO SEND THE TABEL HEAD (IF NONE ZERO) ADB SPLCO ADJUST FOR THE TABLE SIZE ADB SPLCO (TWO WORD ENTRYS) STB \PREL SET THE NEW ADDRESS JSB DAFIX GO FIX UP ANY REFERENCES JSB \SPAC * LDA TBREL UPDATE ANY LINKS USED BY FIXUPS STA PBREL TO $CLAS,$LUSW,$RNTB,$BLLO,$BLUP,$LUAV * * CHECK IF MAX # OF LONG ID SEGMENTS ALREADY EXCEEDED * LDA LICNT IF MORE THAN 255 MAIN PROGRAMS TO BE ADA N255 RELOCATED, THEN WE'RE GONNA ABORT SSA AND LET THEM DECIDE JMP BLONG WHICH ONES TO DELETE LDA ERR60 JSB \IRER SEND DIAGNOSTIC & ABORT * * REPORT # OF LONG ID SEGMENTS USED SO FAR. * BLONG LDA LICNT CONVERT # LONG USED CMA,INA TO ASCII DECIMAL LDB ATBUF JSB \CONV LDA \TBUF+1 STA MES46+1 LDA \TBUF+2 STA MES46+2 AND STUFF MESSAGE. LDA P26 PRINT: LDB MES46 XXXX LONG ID SEGMENTS USED JSB \MESS * * ASK THE # OF BLANK LONG ID SEGMENTS AND EXTENSIONS. * LDA P28 LDB MES42 PRINT: # OF BLANK ID SEGMENTS? JSB GETBL RETRIEVE ANSWER SZA,RSS IF ZERO, ADD 1 INA FOR BG ONLINE LOADING ADA LICNT ADD TO LONG ID SEGMENT COUNT LDB A SAVE ADA N255 IF > 254 MAXIMUM SSA THEN ERROR JMP BLON1 OK * LDA ERR60 SET ERROR CODE JSB \GNER DIAGNOSTIC JMP BLONG TRY AGAIN * N255 DEC -255 * BLON1 STB LICNT SAVE LONG ID SEGMENT COUNT * * REPORT # SHORT ID SEGMENTS USED SO FAR. * JSB \SPAC LDA SSCNT CMA,INA LDB ATBUF CONVERT # SHORT ID SEGS USED TO JSB \CONV DECIMAL ASCII. LDA \T“þúBUF+1 STA MES47+1 LDA \TBUF+2 STA MES47+2 STUFF # USED IN MESSAGE. LDA P28 LDB MES47 PRINT: JSB \MESS "XXXX SHORT ID SEGMENTS USED" * * * ASK # OF BLANK SHORT ID SEGMENTS. * BSHOR LDA P29 LDB MES43 PRINT: # OF BLANK SHORT ID SEGMENTS? JSB GETBL RETRIEVE ANSWER ADA SSCNT ADD TO SEG ID SEGMENT COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUN SZA,RSS THEN ERROR JMP BSHO1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BSHOR TRY AGAIN * BSHO1 STB SSCNT SAVE SEG ID SEGMENT COUNT ADB LICNT ADD LONG ID SEGMENT COUNT INB ADD ONE FOR STOP WORD STB KEYCN AND SAVE KEYWORD COUNT * * REPORT # ID EXTENSIONS USED SO FAR. * JSB \SPAC LDA IXCNT CMA,INA CONVERT COUNT TO DECIMAL ASCII LDB ATBUF JSB \CONV LDA \TBUF+1 AND STUFF IN MESSAGE. STA MES48+1 LDA \TBUF+2 STA MES48+2 LDA P24 LDB MES48 PRINT: JSB \MESS XXXX ID EXTENSIONS USED. * * * ASK # OF BLANK ID EXTENSIONS. * BLEXT LDA P25 LDB MES44 PRINT: # OF BLANK ID EXTENSIONS? JSB GETBL RETRIEVE ANSWER SZA,RSS IF NO BLANKS INA THE SET TO 1 EXTRA ANYWAY ADA IXCNT ADD TO CURRENT ID EXTENSION COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUM SZA,RSS THEN ERROR JMP BEXT1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BLEXT * BEXT1 LDA B MAKE SURE THAT THE # OF CMA,INA EXTENSIONS IS LESS THAN ADA LICNT THE NUMBER OF LONG SSA,RSS ID SEGMENTS JMP BEXT2 JSB \INER ELSE ASK AGAIN JMP BLEXT * BEXT2 INB ADD ONE FOR STOP WORD STB IXCNT AND SAVE COUNT * * GE!$þúT MAXIMUM # OF PARTITIONS TO BE DEFINED * JSB \SPAC GMNP LDA P24 LDB MES45 PRINT: MAXIMUM # OF PARTITIONS? JSB \READ SEND MESSAGE & GET ANSWER LDA N5 CHECK FOR 2 DECIMAL DIGITS JSB \GET# IN RESPONSE RSS ERROR JMP GMNP2 * GMNP1 JSB \INER SEND ERROR DIAGNOSTIC JMP GMNP TRY AGAIN * GMNP2 LDB N65 IF MORE THEN ADB A 64, THEN SSB,RSS JMP GMNP1 ERROR * STA MAXPT SAVE MAX # OF PARTITIONS * * RESERVE SPACE AND INITIALIZE ID EXTENSIONS * LDA \PREL GET CURRENT RELOC ADDR STA IDEX SET ADDRESS OF $IDEX TABLE ADA IXCNT ADD # OF EXTENSIONS (INCL STOP WORD) STA \PREL UPDATE CURRENT RELOC ADDR TO IDEX LIST CCB INITIALIZE ADB IXCNT LOOP COUNTER SZB,RSS SKIP IF > 0 EXTENSIONS JMP NOIDX GO SET STOP WORD ONLY * CMB,INB INITIALIZE EACH EXTENSION STB TEMP2 TO THE ENTRY ADDRESS LDB IDEX GET FIRST TABLE ADDRESS * SETX STA TEMP3 SAVE ADDRESS JSB \ABDO SET POINTER FROM TABLE TO LIST LDA TEMP3 RETRIEVE ADDRESS ADA P3 BUMP TO NEXT LIST ENTRY ISZ TEMP2 END OF LIST? JMP SETX NO CCB POSITION TO LAST WORD ADB A OF EXTENSION LIST RSS * NOIDX LDB IDEX GET STOP WORD CLA SET TO 0 STA IDEXC THE # OF EXTENSIONS USED JSB \ABDO ZERO-FILL THE ENTIRE LIST STB \PREL UPDATE RELOC ADDRESS * * SET UP THE KEYWORD AREA * STB KEYAD SET CURRENT KEYWORD ADDRESS STB CURAK SET FOR ID SEG GENERATION, TOO ADB KEYCN ADD TOTAL KEYWORD COUNT STB \PREL SET NEW RELOC ADDR FOR ID SEG STB SYSAD SET INITIAL ID SEGMENT ADDRESS STB IDSAD SET ADDRRESS OF FIRST ID SEG STB CURAI SET ADDRESS FOR OUTID LD2ëþúA KEYAD COMPUTE THE KEYWORD ADDRESS ADA LICNT FOR SHORT BACKGROUND SEGMENT ID SEGS STA \SKYA AND SET IT STA \ASKY AND ALSO FOR BLANK GENERATION LDB IDSAD GET DISK ADDR OF FIRST ID SEGMENT CLA BY SENDING FIRST WORD JSB \ABDO TO THE DISK * * SET UP ID SEGMENT AREA * CCA BACK UP TO ID SEGMENT START ADA B AND MASK TO POSITION IN AND M77 SECTOR (MOD 640)F, THEN SAVE STA IDSP FOR BASE PAGE LATER LDA \ADSK GET CURRENT DISK ADDRESS STA DSKID SET DISK ID ADDRESS STA DSKSY SET INITIAL ID SEGMENT DISK ADDR * * SAVE SPACE FOR ID SEGMENTS * LDA LICNT GET LONG ID SEGMENT COUNT MPY P33 TIME # DESIRED ADA \PREL ADD THE BASE ADDRESS STA \OCTN SAVE THE ADDRESS ADA N11 COMPUTE THE KEY ADDRESS FOR FIRST STA \SSID BG SEG ID SEGMENT & SAVE LDA SSCNT RESERVE ROOM FOR MPY P9 THE BG SEG ID SEGMENTS ADA \OCTN COMPUTE NEW MEMORY ADDRESS * * RESERVE SPACE FOR MEMORY ALLOCATION TABLE, * MEMORY RESIDENT PROGRAM MAP, AND MEMORY * PROTECT FENCE TABLE. * STA MAT. SAVE STARTING ADDRESS OF MAT STA \OCTN SAVE LDA MAXPT MULTIPLY # PARTITIONS MPY P7 BY # WORDS/ENTRY ADA \OCTN GET NEXT AVAILABLE MEMORY ADDR STA MAP. SAVE AS ADDR OF MRMP ADA P32 ADD LENGTH OF MAP STA MPFT. THEN SAVE START OF MPFT ADA P6 ADVANCE PAST MPFT * * RESERVE SPACE FOR THE DISC DICTIONARY * STA ADICT SAVE ADDR OF DISC DICTIONARY ADA DSIZE ADJUST FOR DISC DICT LENGTH ADA DAUXN PLUS AUX DISC LENGTH * STA \PREL SAVE NEW RELOCATION ADDRESS CCB RESERVE ALL THE SPACE SO FAR ADB A BY SENDING THE LAST WORD CLA THE ENTIRE SPACE WILL JSB ‰Ûþú\ABDO BE ZERO-FILLED * JSB \SPAC LDA P22 PRINT: TABLE AREA II MODULES LDB MES31 FOR NEXT STEP JSB SETHD AND INITIALIZE FOR SCANS JMP \TBLS,I RETURN * P33 DEC 33 SKP * * SETHD PRINTS THE HEADING AND INITIALIZES FOR IDENT * TABLE SCANNING. IT ALSO SET THE NO-PROGRAMS-LOADED- * YET FLAG. * SETHD NOP DST \TBUF SAVE THE MESSAGE SPECS JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT THE HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT FOR ORIGIN OF SCAN JMP SETHD,I RETURN SKP * THE BLSET ROUTINE SETS UP THE BUFFER LIMITS. * * CALLING SEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL EXIT * BLSET NOP FIRST FIND LDB BLSET,I THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB \LSTS SEARCH FOR THE ENTRY JMP \ABOR IF NOT FOUND JUST EXIT * LDA N5 CONVERT A 5 DIGIT DECIMAL JSB \GET# LIMIT JMP BLERR ERROR TAKE ERROR EXIT * CMA,INA SET THE LIMIT NEGATIVE AND ISZ BLSET STEP TO OK RETURN JMP BLSET,I AND RETURN * BLERR JSB \INER SET ERROR 01 JMP BLSET,I AND TAKE ERROR RETURN SKP * * THE RED2 SUBROUTINE IS USED TO SET UP TABLES * WHICH START WITH THERE SIZE AS THE FIRST WORD * * CALLING SEQUENCE: * * JSB RED2 * DEC XX CHARACTER COUNT OF QUESTION. * DEF MESXX ADDRESS OF ASCII MESSAGE * DEF ENT ADDRESS OF ASCII ENTRY POINT NAME * RETURN B=NEXT AVAILABLE CORE LOCATION * REERR JSB \INER SEND ERROR 01 AND RSS RETRY * RED2 NOP ENTRY POINT RERED DLD RED2,I Æþú GET THE MESSAGE PRAMETERS JSB \READ GO SEND MESSAGE AND GET RESPONCE LDA N3 CONVERT 3 ASCII DIGITS JSB \DCON AS DECIMAL JMP RERED IF ERROR RETRY * AND M7400 IF NOT LESS THAN SZA 256 JMP REERR THEN ERROR * LDA \OCTN GET THE ANSWER AGAIN SZA,RSS IF ZERO INA SET TO ONE STA \OCTN AND RESET ISZ RED2 STEP ISZ RED2 TO THE SYMBOL ADDRESS LDB RED2,I FIND JSB \LSTS THE SYMBOL IN THE \LST JSB \ABOR MUST BE THERE LDB \PREL DEFINE THE SYMBOL STB \LST5,I LDA \OCTN OUTPUT THE FIRST JSB \ABDO WORD STB \PREL UPDATE THE ADDRESS JSB DAFIX \FIX UP ALL REFERENCES JSB \SPAC MAKE IT LOOK NICE. LDB \PREL SET B FOR RETURN ISZ RED2 SET RETURN ADDRESS JMP RED2,I RETURN * SPC 2 MES04 ASC 9,# OF I/O CLASSES? MES05 ASC 9,# OF LU MAPPINGS? MES06 ASC 11,# OF RESOURCE NUMBERS? DMES7 DEF MES07 MES07 ASC 13,BUFFER LIMITS (LOW, HIGH)? $CLS ASC 3,$CLAS $RNTB ASC 3,$RNTB $LUMP ASC 3,$LUSW $BLLO ASC 3,$BLLO $BLHI ASC 3,$BLUP $LUAV DEF *+1 ASC 3,$LUAV SKP * * GETBL ASKS FOR THE # OF BLANK LONG ID SEGMENTS, SHORT * ID SEGMENTS, OR ID EXTENSIONS. AFTER RETRIEVING THE * RESPONSE, GETBL CHECKS THAT THE REPSONSE IS < 256. IF * NOT, AN ERROR DIAGNOSTIC IS GIVEN AND THE PROMPT IS RE- * ISSUED. * * ON ENTRY: A-REG = MESSAGE LENTGH * B-REG = MESSAGE ADDRESS * ON EXIT: A-REG = # OF BLANKS SPECIFIED * GETBL NOP STB TEMP1 SAVE MESSAGE ADDR STA TEMP2 AND LENGTH * GETB1 JSB \READ SEND MESSAGE & GET ANSWER LDA N3 CHECK FOR 3 DECIMAL JSB \GET# DIGITS IN REPSONSE JMP GETB2 INVALID REPLY AND M7400 CHECK FOR > 25Gþú5 SZA MAXIMUM JMP MAXER * LDA \OCTN RETRIEVE CONVERTED ANSWER JMP GETBL,I AND RETURN * GETB2 JSB \INER SEND ERROR 01 JMP GETB3 RESET MESSAGE SPECS * MAXER LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC GETB3 LDB TEMP1 GET MESSAGE ADDR LDA TEMP2 AND LENGTH JMP GETB1 RE-PROMPT * * MES42 DEF *+1 ASC 14,# OF BLANK LONG ID SEGMENTS? MES43 DEF *+1 ASC 15,# OF BLANK SHORT ID SEGMENTS? MES44 DEF *+1 ASC 13,# OF BLANK ID EXTENSIONS? MES45 DEF *+1 ASC 12,MAXIMUM # OF PARTITIONS? MES46 DEF *+1 ASC 13,XXXX LONG ID SEGMENTS USED MES47 DEF *+1 ASC 14,XXXX SHORT ID SEGMENTS USED MES48 DEF *+1 ASC 12,XXXX ID EXTENSIONS USED SKP * DFIX DOES THE FIXUP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRIES. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY AFTER THE * SYMBOL (IF ANY) IS DEFINED. * * CALLING SEQUENCE: * * SET UP \FIX1-4 AND \LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANING LESS * DFIX NOP CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 IF UNDEFINED, THEN ITS JMP ZFIX A NOP REPLACEMENT * EMA'S?? * VFIX LDB \FIX2,I GET THE INSTR, WITH OPTIONAL BYTE, CBX HIBP, AND DBL TYPE BITS BLF,RBL IF BYTE BIT SET SSB THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2,I AGAIN AND M7¦‘þú EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA AGAIN AND M1000 NOW EXTRACT THE HIBP BIT STA LINKB AND SAVE CXA AGAIN AND M1740 LEAVE ONLY THE INSTRUCTION STA \FIX2,I IN THE FIXUP ENTRY LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LIST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA??? * LFIX SZB,RSS CHECK FOR AN EXT WITH OFFSET JMP WFIX NOT AN EXT LDB DBLT GET DBL RECORD TYPE CPB P5 EXT REF WITH OFFSET? JMP CPFIX YES, GO SEE IF A DEF * WFIX LDA \FIX2,I GET THE INSTRUCTION CLE,ELA MOVE INDIRECT BIT TO E-REG SZB IF EXT REFERENCE JMP IDEF THEN MUST USE A BP LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSIGN RESTORE THE SIGN BIT STA OPRND IN THE OPERAND (FOR THE LINK ADDR) SZB IF EXTERNAL REFERENCE STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR \FIX2,I INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO æÏþúOUTPUT THE WORD AFIX CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB \FIX2,I IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXTERNAL REFERENCES WITH OFFSET - NOT A DEF * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND, THEN JMP XFIX MAKE IT DIRECT CLB,INB RESET B(WE KNOW IT'S AN EXT) JMP WFIX USE BP LINK * OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M7 EQU P7 M1000 OCT 1000 M1740 OCT 174000 SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB \IFIX INITILIZE THE \FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW ENTRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED WHEN A DRIVER * IN Aiùþú DP>=2 RESOLVES AN FIXUP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DRIVER PARTITION? RSS JMP NOCHG NO LDA DPNUM YES, (DP# MUST BE >= 2) SZA,RSS JMP NOCHG NO, MUST BE DP #1,TA,SDA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN FIRST CMA,INA WORD OF DP ADA \FIX1,I IE, < DPADD SSA JMP CHNGM ITS LESS * NOCHG JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM * FOR DOING THE FIXUP * CHNGM JSB \SYS REBUILD THE SYSTEM MAP JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NONE LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NONE FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 JSB ALLOC NONE ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * ‹HFB SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA \LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A 5 Hÿÿþú SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE THE CURRENT PROGRAM'S * ALLOCATED AREA, A DIAGNOSTIC IS PRINTED. * * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I HAD BEEN SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE LINK * MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS OCCURS WHEN * THE SYSTEM IS RESOLVING EXTERNAL REFERENCES FROM TABLE AREA I & II, * SSGA, AND SDA WHERE THE LINKS MUST BE PRESENT IN ALL MAPS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBP CURRENT BP ALLOCATION MODE, THEN JMP NORML ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM THE TABLE AREAS, * DRIVERS, OR SSGA - SO USE LINK IN UPPER BP AREA. * LDA LOLNK HAS LAST SYSTEM LINK ALREADY BEEN CPA TBREL USED? JMP ER16 YES, ERROR ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP, AND UPDATE LAST UPPER BP LINK USED STA BPLMT AND UPPER LIMIT FOR LOWER BP LINK'S LDB A Ÿ6þú GET IMAGE ADDRESS ADB \ADBP JMP ALLO1 AND GO SET IT UP * NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, AND 100 FOR SYS). BPINC * SET TO -1 WHEN LOADING THE TABLE AREAS, SSGA, AND ALL * DRIVERS, AND TO +1 OTHERWISE. BPLMT SET BELOW LOWEST * TABLE AREA/SSGA/SDA LINK FOR SYS, TO HIGHEST SYSTEM * LINK FOR PRD DRIVERS, AND TO LOWEST DRIVER LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FORM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * CLEAR BUFFER WITH OCTAL ZEROES * * THE BUFCL SUBROUTINE CLEARS A 64-WORD BUFFER WITH ZEROES. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDA N64 STA WDCNT SET BUFFER LENGTH = 64 CLA STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP BUFCL,I RETURN SPC 5 * M0760 OCT 76000 M1177 OCT 101777 M2000 OCT 2000 N1 DEC -1 N64 DEC -64 ERR16 ASC 1,16 BPD0 LINKAGE AREA FULL. * DDVMP DEF *+1 DUMMY DRIVER MAP TABLE BSS 64 * END GIO ¾Bÿÿ ÿý.3 ÿ92067-18321 2001 S C0322 &RT4G6 GEN. SEGMENT #6             H0103 nIþúASMB,Q,R,C HED RT4G6 - PARTITION DEFINITION SEGMENT. NAM RT4G6,5,90 92067-16321 REV.2001 790821 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME RT4G6 * SOURCE PART # 92067-18321 * REL PART # 92067-16321 * WRITTEN BY: JJC,KFH,RB * ****************************************************************** * * * ENTRY POINT NAMES: * ENT \PDEF * * EXTERNAL REFERENCE NAMES: * EXT \LST1,\LST2,\LST3,\LST4,\LST5,\LSTX,\LSTS,\ILST EXT \ID1,\ID2,\ID3,\ID5,\ID6,\ID8 EXT \TIDN,\INID,\IDX,\IDXS EXT \TBUF,\LBUF EXT \ADSK,\DSKO,\DSKA EXT \CURL,\RNAM,\RBIN EXT \SCTK * EXT \SRET,\INER,\GETC EXT \MESS,\GNER,\GETN,\GET#,\GINT EXT \READ,\SPAC,\ABDO,\PTYP EXT \CONV,\OCTN EXT \SYS,\USRS,\ABCO,\MXAB EXT \MRT2,\TERM,\YENO EXT \NUMP EXT \ABOR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780112 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * ************************Ôiþú*************************************************** * * TB30 BSS 160 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * ŠLþúLICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 SHORT ID SEG COUNT - FOR SEGMENTED PROGS * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBÉþúL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 FIRST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN›þú,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISC ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISC ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE 'þúSPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP BLNKS ASC 1, BLANK OCT 40 M1777 OCT 1777 M7400 OCT 177400 M7700 OCT 177700 N1 DEC -1 N2 DEC -2 N3 DEC -3 N32 DEC -32 N4 DEC -4 N5 DEC -5 P7 DEC 7 P10 DEC 10 P14 DEC 14 P18 DEC 18 P2 DEC 2 P20 DEC 20 P21 DEC 21 P22 DEC 22 P24 DEC 24 P26 DEC 26 P28 DEC 28 P30 DEC 30 P3 DEC 3 P31 DEC 31 P4 DEC 4 P32 DEC 32 P33 DEC 33 P52 DEC 52 P5 DEC 5 P6 DEC 6 M37 EQU P31 M7 EQU P7 TEMP3 NOP TEMP4 NOP * MES22 DEF *+1 ASC 3,(NONE) SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * PART LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * * N DEC -2 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 SKP * * * LIST PARTITION REQUIREMENTS FOR RT AND * BG (INCLUDING PR) DISC RESIDENTS * \PDEF NOP LDA P2 SET IDSCN TYPE TO STA \PTYP REAL TIME DISC RESIDENTS LDA "RT" STUFF 'RT' IN STA MSQ1 MESSAGE. * PQLP1 JSB \SPAC LDB MSQ1. SENT EITHER RT OR BG LDA P20 PARTITION REQMT JSB \MESS MESSAGE. * CLA SET FLAG FOR NO PROGRAMS STA PQFLs¼þúG OF TYPE FOUND. PQLP0 LDA P10 REINIT IDENT PTRS STA \TIDN FOR SCAN PQLP2 JSB \IDX FIND PROG MATCHING \PTYP JMP PQDON (NO MORE) LDA \ID6,I GET THE TYPE ELA,RAR SAVE EMA BIT AND M7 ISOLATE IT CPA \PTYP WHAT WE WANTED? RSS YES! JMP PQLP2 NO TRY ANOTHER ISZ PQFLG INCR FLAG - AT LEAST ONE PROG SEZ IF ITS AN EMA PROGRAM JMP DEMA THEN GO DETERMINE ITS PG REQMTS * LDA \ID8,I PICK UP PAGE REQMT RRR 8 AND ISOLATE AND M37 IT. PQLP3 CMA GET -(PAGES +1) LDB MSQ2X AND STUFF JSB \CONV DECIMAL EQUIV IN MSG * LDA BLNKS PUT BLANKS STA MSQ2 LDA \ID1,I THEN PROGRAM NAME STA MSQ2+1 LDA \ID2,I IN MESSAGE... STA MSQ2+2 LDA \ID3,I AND M7400 IOR P32 STA MSQ2+3 * * SET OPTIONAL EMA OR LARGE BG INDICATORS * LDA BLNKS GET BLANKS IN CASE NEITHER OPTION LDB \ID6,I EMA BIT SET? SSB ADA "E" MERGE IN AN E LDB \PTYP PRIVILEGED PROGRAM? CPB P4 ADA AST MERGE IN A * STA MSQ2+9 STORE WORD IN MESSAGE * LDA P20 LDB MSQ2. JSB \MESS SEND THE MESSAGE JMP PQLP2 THEN LOOK FOR MORE PROGS * DEMA JSB PAGES GET THE PAGE REQMTS OF AN JMP PQLP3 EMA PROGRAM * PQDON LDA P3 GET THE PRIVILEGED TYPE LDB \PTYP AND THE CURRENT TYPE CPB P4 IF BG'S WERE JUST DISPLAYED JMP PQEND THEN EXIT FROM LOOP CPB A IF PR'S WERE JUST DONE LDA P4 THEN SET TO DO BG'S STA \PTYP SET TYPE TO SCAN CPB P3 RT -> PR JMP PQLP0 NO, PR -> BG * LDA "BG" STUFF 'BG' INTO STA MSQ1 INTO THE HEADER JSB NONE SEE IF AN RT'S DISPLAYED JMP PQLP>èþú1 SEND THE NEW HEADING * * * PRINT 'NONE' IF NO PROGRAMS OF THE CURRENT PARTITION * TYPE WERE DISPLAYED * NONE NOP LDA PQFLG ANY PROGRAMS FOUND? SZA IF AT LEAST ONE JMP NONE,I LDA P6 ELSE PRINT LDB MES22 "(NONE)". JSB \MESS JMP NONE,I SKP * PQFLG BSS 1 * MSQ1. DEF *+1 MSQ1 ASC 10,XX PARTITION REQMTS: * MSQ2. DEF *+1 MSQ2 ASC 10, NNNNN XX PAGES MSQ2X DEF MSQ2+2 * MSQ3. DEF *+1 ASC 11,MAXIMUM PROGRAM SIZE:  * MSQ4. DEF *+1 MSQ4 ASC 4,W/ COM * "O" ASC 1,O AST OCT 05000 "E" OCT 45 PR. DEF *+1 ASC 4,W/ TA2 "?" ASC 1,? * MS62A DEF *+1 MES62 ASC 4, CHANGE SKP * * PQADD PRINTS THE MAXIMUM PROGRAM ADDRESS SPACE FOR PROGRAMS * WITH AND WITHOUT COMMON, AND FOR PRIVILEGED PROGRAMS. * * ON ENTRY: A-REG = PAGE # PRECEDING THE PROGRAM AREA * B-REG = ASCII WORD TO STUFF INTO MESSAGE (EG, "O") * PQADD NOP *PRINT LARGEST PART MESSAGE* STB MSQ4+1 MAKE MESSAGE W/COM OR LDB MSQ2X W/O COM, THEN PUT SIZE ADA N32 JSB \CONV IN MESSAGE LDA MSQ4. LDB MSQ2. STUFF IN MSG MVW P4 HEAD,OVERLAYING HIGH-ORDER LDB MSQ2. ZEROS OF PAGE SIZE LDA P18 JSB \MESS PRINT MESSAGE JMP PQADD,I SPC 3 * * CONVERT THE ADDRESS IN THE A-REG TO A LOGICAL PAGE NUMBER * CPAG# NOP ALF,RAL ROTATE THE PAGE BITS RAL TO THE LOW BYTE AND M37 AND GET MASK THEM JMP CPAG#,I SPC 3 * * PRINT THE CURRENT SIZE OF SAM, GIVEN IN THE A-REG. * SAMSZ NOP LDB LWTAI GET LAST WORD ADDRESS OF TABLE AREA I INB AND SET STARTING ADDRESS OF SAM#0 CMB,INB DETERMINE SIZE BY SUBTRACTING ADB DPADD FROM START OF DRIVER PARTITION ADA B GET TOTAL SAM SIZE CMA,INA @þú LDB MXSM PASS BUFFER ADDRESS JSB \CONV AND GET DECIMAL ASCII WORDS JSB \SPAC * LDB MSSM. PRINT THE MESSAGE LDA P24 JSB \MESS JMP SAMSZ,I * MSSM. DEF *+1 ASC 12,SYS AV MEM: XXXXX WORDS MXSM DEF MSSM.+7 HYADD DEF *+1 ASC 1,- SKP * * * LIST MAXIMUM PROGRAM SIZES * PQEND JSB NONE SEE IF ANY BG REQ'S WERE DISPLAYED JSB \SPAC LDA P22 LDB MSQ3. PRINT HEADER JSB \MESS LDB "O" PASS AN O (FOR W/O) CCA ADA FPCOM AND FIRST COMMON PAGE JSB PQADD AND PRINT MSG (MAX W/O COM) LDA FWSDA AND GET LAST COMMON PAGE JSB CPAG# ADA N1 LDB BLNKS PASS BLANKS IN B. JSB PQADD AND PRINT (MAX W/ COM) * LDB PR. TRICK PQADD TO STORE STB MSQ4. 'W/ TA2' IN MESSAGE CCA ADA FWPRV CALCULATE LAST PAGE JSB CPAG# CONTAINING TABLE AREA II JSB PQADD AND PRINT MAX PRIV PROG SPACE JSB \SPAC * * * COMPUTE SIZE OF SAM #1 * LDA LWSYS SET THE FIRST PAGE INA JSB CPAG# OCCUPIED BY SAM#1 STA FPSAM LDB LWSYS DETERMINE THE SIZE OF CMB,INB THE FIRST CHUNK OF SAM LDA LWSLB GET LAST WORD & ROUND IOR M1777 TO A PAGE BOUNDARY ADB A STB SAM#1 AND SAVE * LDA LPSLB COMPUTE THE MAXIMUM LOGICAL CMA,INA PAGE SIZE ALLOWABLE FOR ADA P31 SAM #2 SZA JMP SET2 GO SET THE UPPER LIMIT ADB N2 NO SAM #2: MUST DECREMENT SIZE OF STB SAM#1 SAM #1 SO LAST WORD IS 77776 * SET2 ADA PAGE# ADD TO NEXT PHYSICAL STA SAM2P PAGE AVAILABLE, AND SET AS UPPER LIMIT * LDB \NUMP IF MORE LOGICAL PAGES AVAILABLE CMA,INA THAN PHYSICAL PAGE STILL AVAILABLE ADA B THEN SET SAM #2 LIMIT TO LAST SSA þþú STB SAM2P PHYSICAL PAGE * LDA SAM#1 DISPLAY THE SIZE OF THE JSB SAMSZ FIRST CHUNK * LDA PAGE# CMA,INA CONVERT & STUFF LOWER DEFAULT VALUE LDB MS65A FOR FIRST JSB \CONV PARTITION PAGE IN THE MESSAGE. LDA SAM2P CONVERT & STUFF UPPER LIMIT VALUE CMA,INA FOR FIRST PARTITION PAGE LDB MS65B IN THE MESSAGE. JSB \CONV JSB \SPAC * * REQUEST THE SIZE OF SAM #2 * GETPP LDB MES65 NOW PRINT : LDA P52 "ENTER 1ST PARTITION PAGE: JSB \READ XXXXX(DEFAULT) TO XXXXX:" * LDA N5 GET THE DECIMAL RESPONSE JSB \GET# JMP SER44 INVALID RESPONSE, REPEAT * LDA \OCTN GET PAGE # SZA,RSS CHANGE? JMP NOSM2 NO, CLEAR SAM #2 SPECS LDB PAGE# COMPARE AGAINST CURRENT CMB,INB FIRST PAGE ADB A (MUST BE >= TO IT) SSB JMP SER44 TOO SMALL * LDB SAM2P GET PRESENT UPPER LIMIT CMB,INB ADB A CMB,SSB,INB,SZB LESS THAN OR EQUAL TO IT? JMP SER44 NO, MUST TRY AGAIN * LDB PAGE# GET NEXT AVAILABLE PHYSICAL PAGE STB SAM2P AND SET AS FIRST PAGE OF SAM #2 STA PAGE# AND RESET THE FIRST PART PAGE * CMB,INB DETERMINE THE PAGE SIZE OF ADA B SAM #2 NOSM2 STA PQFLG SAVE *TEMP* ALF,RAL AND CONVERT TO THE ALF,RAL #WORDS STA SAM#2 SZA,RSS ANYTHING ALLOCATED? JMP DISPS NO * LDA LPSLB IF SAM #2 ENDS ON THE 32K ADA PQFLG BOUNDARY (77777) CPA P31 (IE, THE NEXT LOGICAL PAGE AFTER RSS IT IS 32), THEN JMP DISPS LDB N2 MUST DECREMENT THE # OF WORDS ADB SAM#2 SO LAST WORD OF SAM #2 STB SAM#2 WILL BE 77776 * * DISPLAY TOTAL SAM SIZE * DISPS LDA SAM#1 LéþúADA SAM#2 COMBINE THE TWO CHUNKS JSB SAMSZ FOR DISPLAY * LDA FPCOM SET THE MAXIMUM ADDRESSABLE CMA,INA (LOGICALLY) PAGE SIZE FOR A ADA P32 PARTITION STA MAXPG JMP DPINT CONTINUE * MAXPG NOP * SER44 LDA ERR44 SEND ERROR DIAGNOSTIC JSB \GNER FOR INVALID SAM #2 REPLY JMP GETPP TRY AGAIN SKP * * DEFINE DISK RESIDENT PROGRAM PARTITIONS * * CLEAR M.A.T. FIRST. SET LINK WORDS TO -1 TO * SHOW PARTITIONS UNDEFINED. * DPINT JSB \SYS MAP SYSTEM AREA ON DISK LDA MAXPT SET LOOP COUNTER TO CMA -(NO. OF PARTS +1) STA DPTMP AND SAVE * CLA CLEAR THE MAXIMUM PARTITION SIZES STA $MCHN+1 FOR MOTHER STA $MBGP+1 FOR BG STA $MRTP+1 AND FOR RT STA NEXTP SET THE CURRENT PART #, -1 STA DPMOM CLEAR FLAG BIT STA SUBMD * LDB MAT. GET ADDRESS OF FIRST MAT ENTRY STB MATA AND SAVE JMP DPCN2 ENTER LOOP AT BOTTOM SINCE * MAXPT MAY BE XERO * DPLP3 CCA SET LINK TO JSB \ABDO MINUS 1 DPLP4 CLA THEN SET NEXT JSB \ABDO 6 WORDS TO ZERO ISZ DPTM2 JMP DPLP4 DPCN2 LDA N6 REPEAT THE ABOVE STA DPTM2 TILL MAT IS ISZ DPTMP EXHAUSTED JMP DPLP3 * * * TELL USER HOW MANY PAGES LEFT * LDA PAGE# COMPUTE # OF CMA,INA REMAINING ADA \NUMP PAGES. STA DPARE SAVE SIZE OF PARTITION AREA STA PLEFT ALSO # OF PAGES LEFT. CMA,INA \CONV NEEDS NEG PARM LDB MXM1 POINT TO SPOT IN MSG JSB \CONV STUFF DECIMAL INTO MSG JSB \SPAC LDB MSM1. LDA P22 JSB \MESS SEND SIZE LEFT * LDA MAXPT SZA,RSS JMP DPTHD IF NO PARTS ALLOWED...DON'T ASK JSB \SPAC LDB ¾ HFBMSM2. LDA P18 JSB \MESS PRINT "DEFINE PARTITIONS:" *RHÿÿþú SKP * * * PROMPT FOR PARTITION DEFINITION AND PARSE RESPONSE * DPRD JSB \SPAC CLA STA SUBS? CLEAR SUBPART PROMPT FLAG. STA DPMOM CLEAR MOTHER FLAG BIT. STA SUBP? SET SUBPART FLAG OFF. LDA NEXTP GET CURRENT PARTITION #, LESS 1 CPA MAXPT OVER LAST ALLOWED PARTITION? JMP BLPT YES, SKIP UNTIL A /E IS ENTERED CMA CONVERT CURRENT PARTITION # LDB ATBUF TO ASCII JSB \CONV LDA \TBUF+2 * * IS SUBPARTITION MODE ON OR OFF?? * SETP# LDB SUBMD SZB WELL?? JMP SUBON GIVE 'EM THE SUBPART MODE PROMPT * * SET UP THE MOTHER PARTITION MODE PROMPT. * SUBOF STA MES63+4 STUFF ASCII PARTITION # IN PROMPT. LDA PLEFT CMA,INA LDB ATBUF CONVERT # OF PAGES LEFT JSB \CONV LDA \TBUF+1 STA MES63+6 AND STUFF IN PROMPT. LDA \TBUF+2 STA MES63+7 LDA P22 LDB MES63 JMP DSPLA GO PRINT PROMPT. * * SET UP THE SUBPARTITION MODE PROMPT. * SUBON STA MES64+4 LDA PLEFT CMA,INA LDB ATBUF CONVERT # OF PAGES LEFT JSB \CONV LDA \TBUF+1 STA MES64+6 AND STUFF IN PROMPT. LDA \TBUF+2 STA MES64+7 LDA MLEFT CONVERT # PAGES LEFT IN CURRENT CMA,INA MOTHER PARTITION LDB ATBUF JSB \CONV LDA \TBUF+1 STA MES64+9 AND STUFF IN PROMPT. LDA \TBUF+2 STA MES64+10 LDA P28 LDB MES64 * * OUTPUT THE APPROPRIATE PROMPT AND GET THE RESPONSE. * DSPLA JSB \READ READ RESPONSE LDA N2 JSB \GETN GET FIRST TWO CHARACTERS CPA "/E" AND CONTINUE UNLESS JMP DPEND A /E WAS ENTERED * LDA NEXTP GET NUMBER OF DEFINED PARTITIONS CPA MAXPT IF OVER THE LIMIT JMP DPR49 THEN WARN THEM BEFORE TRYING FOR A /E JMP GETSZ ELSE PARSE THE·Éþú DEFINITION * BLPT LDA BLNKS GET TWO BLANKS JMP SETP# AND GO STORE AS THE PART # * * GET PARTITION SIZE, BETWEEN 1 AND (#PAGES LEFT) * GETSZ JSB \GINT REINITIALIZE PARSE LDA N4 AND ASK FOR UP TO 4 JSB \GET# DECIMAL DIGITS AS THE $# OF PAGES JMP DPR45 INVALID RESPONSE ADA N1 REDUCE BY ONE FOR BP STA DPSIZ AND SAVE * SSA CHECK IF >= 1 JMP DPR45 ..NO - ERROR. * JSB DPCHK MAKE SURE (**NOTE: NORMAL RET: P+3) JMP DPR45 JMP DPR45 WE HIT A COMMA... * * GET PARTITION TYPE: "RT","RTM","BG","BGM", OR "S" * LDA N3 GET UP TO 3 JSB \GETN CHARCTERS CPA "S" SUBPARTITION? JMP SUBOK GO CHECK IF MODE PERMITS * CLB CLEAR BIT 15 FLAG FOR WORD 3 CPA "BG" IF BG THEN JMP CLRSB FLAG STAYS AT 0 INB ELSE INCREMENT FLAG SO BIT 15 WILL BE SET CPA "RT" IF RT JMP CLRSB THEN OK JMP DPR46 THEN GO FLAG ERROR * * SUBPARTITION WAS DECLARED - CHECK FOR PROPER DEFINITION MODE * AND SUBPARTITION SIZE * SUBOK LDA SUBMD WAS SUBPARTITION MODE ENABLED BY SZA,RSS A PREVIOUSLY INDICATED MOTHER PARTITION? JMP DPR46 NO - CAN'T HAVE A SUBPART HERE * LDA DPSIZ IF THE SIZE OF THE SUBPARTITION IS CMA GREATER THAN THE # PAGES LEFT ADA MLEFT IN MOTHER PARTITION, SSA JMP DPR56 THEN DON'T ALLOW THE DEFINITION * ISZ SUBP? "WE ARE CURRENTLY DEFINING A SUBPART" FLAG LDB MOMTY GET THE MOTHER PARTITION TYPE, FOR THE SUBPART JMP DPTYP AND GO CONTINUE WITH DEF'N * * CHECK RANGE: REQUIRE (DPSIZ+1) <= PLEFT, * AND CLEAR SUBPART MODE FLAG ON A RT,BG DEF'N. * CLRSB LDA DPSIZ CMA GET -(DPSIZ+1) ADA PLEFT GET # BG,RT PAGES LEFT. SSA DID THEY ASK F55þúOR MORE THAN IS LEFT? JMP DPR45 YES - SCOLD THEM,ASK THAT PARTIT. AGAIN CLA STA SUBMD CLEAR SUBPART MODE. 0/1=NORM MODE/SUBPART MODE. * DPTYP STB DPTY SAVE TYPE INDICATOR CCA SET RESERVED FLAG = -1 STA DPRSV IN CASE PARAMETER IS OMITTED * * CHECK TO SEE IF MOTHER PART'N DECLARED.-IF SO, SET SUBS?=2 * LDA \TBUF+1 GET THE 3RD CHARACTER FROM INBUFER CPA "M" IS THIS A MOTHER?? RSS YES-SET IT,BUT NO "SUB.." PROMPT JMP CHKSZ MAYBE-GO TEST ITS SIZE * ISZ SUBS? SET SUBS?=2 TO INDICATE ISZ SUBS? MOTHER BUT SKIP PROMPT"SUBS" PROMPT JMP NOPMT CONTINUE * * CHECK SIZE FOR POSSIBLE MOTHER PARTITION * CHKSZ LDA DPSIZ GET PARTITION SIZE CMA,INA IS IT GREATER THAN THE ADA MAXPG MAXIMUM ADDRESSABLE SPACE? SSA,RSS JMP NOPMT CONTINUE LDB SUBMD YES, GET CURRENT SUBPARTITION MODE SZB,RSS IF IN REGULAR MODE (=0) ISZ SUBS? THEN CAN TURN ON SUBPART PROMPT FLAG. * NOPMT JSB DPCHK CHECK DELIMITER JMP DPR46 ERROR IF NOT A COMMA OR EOR JMP PROMT GO BUILD ENTRY IF EOR, CONTINUE IF COMMA * * * GET RESERVED FLAG * CLA,INA READ ONE JSB \GETN CHARACTER CPA "R" IF AN R ISZ DPRSV THEN SET FLG AND SKIP JMP DPR47 ELSE ERROR * JSB DPCHK CHECK DELIMITER JMP DPR47 ANY BUT "," OR EOR NOT ACCEPTED JMP PROMT EOR OK JMP DPR47 COMMA NOT WANTED * * PROMPT FOR A SUBPARTITION? * PROMT LDA SUBS? ARE WE TO PROMPT FOR POSSIBLE SZA,RSS SUBPARTITION DEFINITIONS? JMP DPSTO GO BUILD ENTRY. * SLA,RSS SKIP "SUBPART'N" PRMPT IF JMP ENABL SUBS?=2,& GO DEFINE MOTHER * JSB \SPAC LDA P14 ASK THE QUESTION LDB SUB? "SUBPARTITIONS?" JSB \READ *þú AND GET THE RESPONSE JSB \YENO TO ANALYZE JMP PROMT INVALID RESPONSE JMP DPSTO "NO" SUBPARTITIONS WANTED * * DEFINE THE MOTHER PARTITION SPECIFICATIONS * ENABL ISZ SUBMD YES, ENABLE SUBPART DEFINITION MODE LDA MATA GET ADDRESS OF MAT ENTRY FOR THIS MOTHER STA MOMAD AND SAVE FOR LINK WORD OF LAST CHAIN MEMBER LDA DPSIZ SAVE MOTHER PARTITION SIZE INA FOR SUBPARTITION CHECKING STA MLEFT INITIALIZE # PAGES LEFT IN MOTHER PART. * LDB DPTY AND THE MOTHER PARTITION'S TYPE STB MOMTY WILL BE THE TYPE FOR THE SUBS ISZ DPMOM SET FLAG FOR MOTHER BIT IN WORD 3 JMP DPSTO GO BUILD ENTRY * SKP * * BUILD A NEW MAT ENTRY OF THE FORM: * * WORD 0 - FREE LIST LINKAGE SET AT DPTHD * WORD 1 - PRIORITY OF RESIDENT SET TO 0 * WORD 2 - ID SEGMENT ADDRESS SET TO 0 * WORD 3 - (15) MOTHER PARTITION, (9-0) STARTING PG SET AT DPTHD * WORD 4 - (15) RESERVED PARTITION, (9-0) # PAGES * WORD 5 - (15) RT PARTITION * WORD 6 - SUBPARTITION LINK WORD * DPSTO LDB MATA GET MAT ADDRESS FOR THIS STB CURMT ENTRY AND SAVE CLA JSB \ABDO CLEAR FREE LIST LINK WORD * ADB P2 POSITION TO WORD 3 LDA DPMOM GET MOTHER PARTITION FLAG RAR JSB \ABDO AND SET OPTIONAL BIT 15 IN WORD LDA DPRSV GET RESERVED FLAG INA IF SET (0) THEN RAR SET BIT 15 IN MAT WORD IOR DPSIZ MERGE IN PART SIZE JSB \ABDO AND SEND WORD 4 * LDA DPTY NOW SET THE OPTIONAL TYPE BIT 15 RAR (1 IF RT) JSB \ABDO AND SEND WORD 5 * LDA SUBMD IS THIS PARTITION A CHAIN MEMBER (EITHER SZA MOTHER OR SUBPARTITION)? LDA MOMAD IF SO, GET ADDRESS OF MOTHER ENTRY JSB \ABDO AND SEND SLW, ELSE 0 STB MATA SAVE AžÚþúDDRESS OF NEXT MAT ENTRY * * FOR EACH SUBPARTITION OF A CHAIN, WE MUST LINK THE PREVIOUS * SUBPARTITION (OR MOTHER PARTITION) TO IT VIA THE SLW * LDA SUBMD IF WE'RE IN SUBPARTITION MODE, AND THE SZA,RSS "SUBPARTITIONS?" QUERY WAS ASKED ON A JMP MDONE A PREVIOUS PARTITION, THEN AT LEAST LDB SUBS? ONE SUBPARTITION HAS BEEN DEFINED SZB SO THE SLW OF THE PREVIOUS MAT ENTRY JMP MDONE MUST BE SET TO THE CURRENT ENTRY * LDA CURMT SET THE SLW OF THE PREVIOUS ENTRY CCB (LAST WORD) TO THE ADDRESS OF THE ADB A CURRENT MAT ENTRY JSB \ABDO * MDONE LDA DPSIZ CMA GET READY TO SUBTRACT SIZE OF CURR PARTITION. LDB SUBP? IS THIS A SUBPARTITION?? SZB WELL? JMP SBON YES- GO REDUCE MOTHER PAGE COUNT (#LEFT) SBOFF ADA PLEFT NO- REDUCE REGULAR PAGE COUNT STA PLEFT AND SAVE. JMP BUMP * SBON ADA MLEFT REDUCE MOTHER PAGE COUNT STA MLEFT AND SAVE. * BUMP ISZ NEXTP BUMP THE NUMBER OF SUCCESSFULLY DEFINED JMP DPRD PARTITIONS, AND GO ASK FOR MORE SKP * * ALL PARTITIONS DEFINED, SO CHECK FOR THE ALLOCATION * OF ALL THE PAGES, THEN SORT THE ENTRIES INTO RT, BG * AND MOTHER FREE LISTS. * DPEND CLA CLEAR STA DPTOT THE PAGE USAGE LDA MAXPT SET UP LOOP COUNTER CMA,INA PER MAXIMUM NUMBER OF STA DPTMP MAT ENTRIES * * SCAN ALL PARTITION DEFINITIONS, INSURING THAT THE SUM * OF THEIR SIZES TOTALS THE NUMBER OF PAGES REMAINING * LDB MAT. GET ADDRESS OF PART #1'S ENTRY DPLP1 JSB DPRW READ LINK WORD SSA LINK <0? JMP COMPR YES, DONE WITH DEFINED ENTRIES ADB P2 POINT TO M BIT WORD JSB DPRW AND READ IT STA DPTM1 SAVE FOR LATER JSB DPRW READ LENGTH-1 6.þúAND M1777 ISOLATE IT AND GET INA TRUE VALUE STA DPTM2 AND SAVE * * SKIP THE SUBPARTITION PAGES IN SUM TOTAL * INB NOW GET THE SUBPARTITION LINK WORD JSB DPRW STB DPTM3 SAVE ADDRESS OF NEXT ENTRY FOR LATER LDB DPTM1 GET POSSIBLE MOTHER BIT SZA IF SLW IS NONZERO, THEN PARTITION IS SSB IN A CHAIN. THEN IF MOTHER BIT IS RSS SET, WE MUST INCLUDE HER PAGE SIZE IN TOTAL JMP SKIPS SUBPARTITION - SKIPS ITS PAGES * * ADD CURRENT PARITITION'S PAGE SIZE(INCLUDING ITS BP) * TO THE SUM TOTAL * LDA DPTM2 GET IS PAGE SIZE AGAIN ADA DPTOT AND ADD IT TO THE CURRENT TOTAL STA DPTOT AND UPDATE SKIPS LDB DPTM3 GET ADDRESS OF NEXT MAT ENTRY ISZ DPTMP BUMP LOOP COUNTER, AND JMP DPLP1 CONTINUE * COMPR LDA DPARE UNTIL DONE - DOES THE SUM CPA DPTOT TOTAL MATCH THE # OF AVAILABLE PAGES? JMP DPTHD YES, CONTINUE TO SORT * * ERROR - PARTITIONS DON'T TOTAL TO SIZE OF AVAIL AREA * LDA ERR53 JSB \GNER SEND ERR 53 MESSAGE, AND START JMP DPINT THE PARTITION DEF'N ALL OVER AGAIN SKP * * THREAD MAT ENTRIES INTO THREE LISTS: BG FREE LIST, RT * FREE LIST, AND CHAINED (MOTHER) FREE LIST - BASED UPON * INCREASING PAGE SIZES. * DPTHD LDA MAXPT SAVE CMA -MAX PT -1 STA DPTMP AS LOOP COUNTER LDA PAGE# STA DORG SET FIRST PAGE TO GIVE AWAY LDA MAT. GET ADDRESS OF FIRST MAT ENTRY STA DPTM2 SAVE IT JMP DPEN3 ENTER LOOP AT BOTTOM (IN CASE MAXPT = 0) * * BEGIN MAIN LOOP: INSERT PART DESCRIPTORS INTO LISTS * AND SET PARTITION START ADDRS INTO DESCRIPTORS * DPLP2 LDB DPTM2 GET ABS ADDR OF NEXT MAT ENTRY JSB DPRW AND READ ITS PRESENT LINK WORD SSA IF UNDEFINED PART THEN JMP MPSRT WE'½½þúRE DONE THREADING THE MAT * ADB P2 POINT TO START PAGE WORD IN ENTRY JSB \ABDO READ AND DESTROY FIELD STA DPRSV SAVE MOTHER BIT WORD JSB DPRW GET AND SAVE POSSIBLE R BIT STA HIBP *TEMP* AND M1777 ISOLATE THE LENGTH PART STA DPSIZ AND SAVE FOR COMPARISON INB JSB DPRW GET THE SLW LDB DPRSV SET FLAG INDICATING POSSIBLE ELB MOTHER PARTITION LDB DPORG GET DEF TO CURRENT PART ORIGIN SZA IF SLW IS NONZERO SEZ AND THE MOTHER BIT ISN'T SET RSS THEN WE HAVE A SUBPARTITION LDB DMORG SO GET THE DEF TO ITS ORIGIN (OFFSET OF MOTHER'S) STB TEMP1 SAVE THE ORIGIN DEF FOR THIS PARITION * LDA DPRSV GET POSSIBLE MOTHER BIT AGAIN IOR B,I MERGE START PAGE OF PARTITION LDB DPTM2 POSITION TO WORD 3 OF ENTRY ADB P3 JSB \ABDO AND STORE ON DISC * * UPDATE THE PARTITION ORIGINS MORG AND/OR DORG * LDA DMORG GET POINTER TO MORG CPA TEMP1 IS IT THE ORIGIN FOR THE CURRET SUBP JMP UPORG YES, GO UPDATE IT BEFORE NEXT SUBPART LDA DPRSV IF THIS WAS A MOTHER PARTITION CLE,ELA THEN SET MORG FROM THE CURRENT SEZ VALUE OF DORG(BEFORE UPDATE), ELSE LDA DORG CLEAR MORG FOR A NON-CHAINED PARTITION STA MORG AND SET * UPORG LDA DPSIZ GET SIZE OF CURRENT PARTITION INA MAKE IT THE TRUE LENGTH ADA TEMP1,I UPDATE THE PROPER ORIGIN STA TEMP1,I (EITHER DORG OR MORG) * * SET UP THE FREE LIST HEADERS FOR THREADING AND UPDATING * EITHER THE RT, BG, OR CHAINED LIST. * INB JSB DPRW GET THE RT FLAG AND MSIGN LEAVE JUST SIGN BIT LDB DPRSV GET MOTHER BIT FIRST STA DPRSV THEN SAVE THE RT BIT SSB,RSS SET LIST HEADERS ACCORDING TO TYPE NþúJMP GETHD RT AND BG LDB DPC. GET CHAINED LIST HEADER POINTER LDA MCHN. AND MAXIMUM SIZE POINTER JMP SETHD GO SET CURRENT POINTERS * GETHD LDB DPBG. LOAD BG LIST HEAD IF SSA BG PARTITION LDB DPRT. ELSE RT LIST HEAD LDA MBGP. GET BG MAX POINTER CPB DPRT. LDA MRTP. OR THE RT MAX POINTER SETHD STB DPLH. SET ADDRESS OF LIST TO SCAN, AND STA MDPH. ADDRESS OF ITS MAX-SIZED PARTITION LDB B,I LOAD LIST HEAD CONTENTS * * CHASE DOWN FREE LIST TO FIND PLACE TO INSERT ENTRY * STB DPCUR SAVE FIRST AS CURRENT CLA STA DPPRV AND ZERO AS PREVIOUS * DPLL1 LDB DPCUR IF POINTER IS NULL SZB,RSS THEN JMP DPLEX WERE DONE ADB P4 ELSE POINT TO LEN OF CURRENT JSB DPRW READ/RESTORE LENGTH AND M1777 AND ISOLATE IT CMA,INA IF INSERTEE SIZE IS ADA DPSIZ LESS THAN CURRENT SSA THEN WERE JMP DPLEX DONE * LDB DPCUR ELSE SAVE CUR AS STB DPPRV PREVIOUS AND READ JSB DPRW NEXT LINK STA DPCUR AND SET AS CURRENT JMP DPLL1 THEN LOOP BACK AND CONTINUE * * FOUND POSITION TO INSERT - IF DPPRV IS STILL ZERO, * THEN INSERTEE GOES AT TOP OF LIST. * DPLEX LDA DPTM2 A POINTS TO INSERTEE LDB DPPRV IS PREVIOUS GUY HEAD?? SZB JMP DPINS NO, INSERT IN LIST STA DPLH.,I YES,JUST MAKE HEAD POINT HERE JMP DPFOR THEN FIX FOW'D PNTR * * GO MAKE MAT(DPPRV) POINT TO INSERTEE * DPINS JSB \ABDO * * MAKE INSERTEE POINT TO NEXT MAT ENTRY DPCUR * DPFOR LDB HIBP IF THIS IS A RESERVED SSB PARTITION (HIBP < 0), THEN JMP DPFO1 DON'T UPDATE MAX PARTITION SIZE. LDA MDPH.,I ELSE GET PRESENT MAX CMA,INA & COMPARE WITH CURRENT PARTITION ADA ±ºþúB SIZE. SSA,RSS IF NEW MAX STB MDPH.,I THEN UPDATE $MRTP/$MGBP/$MCHN * DPFO1 LDA DPCUR SET LINK WORD LDB DPTM2 OF INSERTEE JSB \ABDO * LDA P7 POINT TO NEXT ADA DPTM2 MAT ENTRY STA DPTM2 DPEN3 ISZ DPTMP CONTINUE UNTIL MAT JMP DPLP2 IS EXHAUSTED JMP MPSRT SKP * ERROR ROUTINES, VARIABLES, AND CONSTANTS * DPR45 LDA ERR45 JMP DPERR DPR46 LDA ERR46 JMP DPERR DPR47 LDA ERR47 JMP DPERR DPR49 LDA ERR49 DPERR JSB \GNER SEND ERROR MESSAGE JMP DPRD GO REREAD ENTRY * ERR44 ASC 1,44 ERR45 ASC 1,45 ERR46 ASC 1,46 ERR47 ASC 1,47 ERR48 ASC 1,48 ERR49 ASC 1,49 ERR50 ASC 1,50 ERR51 ASC 1,51 ERR53 ASC 1,53 ERR55 ASC 1,55 ERR56 ASC 1,56 * APER1 LDA ERR48 JSB \GNER JMP APRD2 APER2 LDA ERR49 JMP APERR APER3 LDA ERR50 APERR JSB \GNER JMP APLOP MPR55 LDA ERR55 RSS MPER1 LDA ERR51 JSB \GNER JMP MPLOP DPR56 LDA ERR56 JMP DPERR * * MES63 DEF *+1 ASC 11,PART XX, XXXX PAGES? MES64 DEF *+1 ASC 14,PART XX, XXXX,(XXXX) PAGES? MES65 DEF *+1 ASC 13,ENTER 1ST PARTITION PAGE: ASC 13, XXXXX(DEFAULT) TO XXXXX: MS65A DEF MES65+14 MS65B DEF MES65+23 SUB? DEF *+1 ASC 7,SUBPARTITIONS? * SUBS? NOP NEXTP NOP PLEFT NOP MLEFT NOP SUBP? NOP IF=1: CURRENT DEFINITION IS A SUBPARTITION. SUBMD NOP MOMTY NOP MOMAD NOP DPMOM NOP MATA NOP CURMT NOP DPTM1 EQU MOMTY DPTM3 EQU CURMT * DPORG DEF DORG DORG NOP DMORG DEF MORG MORG NOP DPLH. NOP MDPH. NOP * MCHN. DEF $MCHN+1 DPC. DEF $CFR+1 MRTP. DEF $MRTP+1 DPRT. DEF $RTFR+1 MBGP. DEF $MBGP+1 DPBG. DEF $BGFR+1 SKP * * DETERMINE THE PAGE REQUIREMENTS OF AN EMA PROGRAM * BY SUBTRACTING THE MSEG SIZE FROM THE ID-SEGMENT WORD * 21 SIZE STORED IN ID8, AND THEN ADDING THE EMA SIZE * TO IT (1 Iú¢þúF EMA DEFAULTED). * PAGES NOP LDA \ID6,I GET MSEG SIZE OF PROGRAM FROM JSB CPAG# ID8 BITS 14-10 CMA,INA STA B AND SAVE LDA \ID8,I NOW GET THE PROGRAM PAGE ALF,ALF REQUIREMENTS AS STORED IN AND M377 ID-SEGMENT WORD 21 ADB A SUBTRACT THE MSEG SIZE FROM IT LDA \ID5,I NOW GET THE DECLARED EMA SIZE AND M3776 ISOLATE IT ALF,ALF ALF SZA,RSS WAS IT DEFAULTED? CLA,INA YES, SET TO 1 ADA B ADD THE PROGRAM SIZE+EMA SIZE JMP PAGES,I EXIT * M3776 OCT 37760 SKP * CHECK NEXT CHAR IN LBUF FOR DELIMITER * * RETURNS: * (N) NOT COMMA OF EOR * (N+1) END-OF-RECORD * (N+2) COMMA * DPCHK NOP JSB \GETC GET NEXT CHAR CPA BLANK JMP DPC1 JUMP IF COMMA SZA JMP DPC3 JUMP IF NOT COMMA OR EOR JMP DPC2 JUMP IF EOR DPC1 ISZ DPCHK DPC2 ISZ DPCHK DPC3 JMP DPCHK,I SPC 3 * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL: B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD * DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN * DPRWT BSS 1 SPC 3 * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR \ABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) * IDFND NOP LDA M377 PICKUP KEYWD# AND AND \ID8,I ISOLATE IT FROM IDENT WORD 8 ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ Ô;þúKEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. * M377 OCT 377 SKP DPTMP BSS 1 DPTM2 BSS 1 * "RT" ASC 1,RT "BG" ASC 1,BG "M" OCT 46400 "S" ASC 1,S "R" OCT 122 "/E" ASC 1,/E * MSIGN OCT 100000 PNUM BSS 1 PART # (1 THRU 64)?????? DPSIZ BSS 1 PART SIZE(1 TO 1024 PAGES) DPTY BSS 1 PART TYPE (BG=0,RT=1) DPRSV BSS 1 PART RSV FLG (-1,NOT RES,0=RES) DPTOT BSS 1 DPARE BSS 1 SIZE OF DISK PART AREA IN PAGES DPCUR BSS 1 USED DURING FREE LIST BUILD DPPRV BSS 1 USED DURING FREE LIST BUILD SPC 3 MSM1 ASC 11,PAGES REMAINING: XXXXX MXM1 DEF MSM1+8 MSM1. DEF MSM1 * MSM2 ASC 9,DEFINE PARTITIONS: MSM2. DEF MSM2 SKP * * ALLOW USER TO ALTER THE PROGRAMS PAGE REQUIREMENTS * ONLY INCREASES ARE ALLOWED * * SEND MESSAGE: "MODIFY PROGRAM PAGE REQUIREMENTS?" * * USER RESPONDS WITH: PROGNAME,PARTSIZE OR /E * (PARTSIZE INCLUDES BASE PAGE) * * NOTE: THIS IS DONE BEFORE ASSIGNING PROGRAMS TO * PARTITIONS, SO WE DON'T NEED TO CHECK IF * PROGRAM WILL STILL FIT IN ITS ASSIGNED PARTITION * MPSRT LDA MAXPT DON'T PROMPT SZA,RSS IF NO PARTIIONS DEFINED JMP APEND JSB \SPAC LDA P33 LDB MSM5. JSB \MESS * * GET PROGRAM NAME, SET UP POINTERS TO IDENT * MPLOP JSB APRED USE CODE IN ASSIGN PART. ROUTINE JMP APSRT JUMP OUT IF /E WAS ENTERED LDA \ID6,I WAS THIS AN EMA PROGRAM? SSA JMP MPR55 YES, CAN'T OVERRIDE ITS PG REQMTS * * CONVERT SIZE TO BINARY AND VERIFY * LDA N2 GET 2 DECIMAL DIGITS JSB \GET# FROM LBUF AND JUMP JMP MPER1 IF BAD DIGIT ADA N1 SAVE OVERRIDE LESS 1 STA DPSIZ * LDB DPID READ LO-MAIN ADB P22 ADDRESS JSB DPRW FROM ID-SEGMENT WORD 22 LSR 10 GET PAGE NUMBER i‘þúAND M37 AND ISOLATE. ADA DPSIZ GET TOTAL PAGES CMA,INA AND COMPARE TO 32. ADA P32 SSA ERROR IF OVER 32. JMP MPER1 * LDA \ID8,I GET PAGE REQMT LSR 8 FROM IDENT. POSITION AND M37 AND ISOLATE. CMA,INA SUBTRACT REQMT ADA DPSIZ FROM REQUEST, AND SKIP IF SSA REQMT IS EQUAL OR LESS. JMP MPER1 ERROR IF OVERRIDE IS LESS * * OVERRIDE IS VALID, UPDATE SIZE REQMT IN ID-SEGMENT * (BUT NOT IN L ID8 TO ALLOW A RE-OVERRIDE) * LDB DPID DESTRUCTIVELY READ WORD21 ADB P21 (THE DMS WORD) FROM THE ID- JSB \ABDO SEGMENT. RRR 10 AND M7700 THEN MERGE IN NEW IOR DPSIZ PAGE REQUIREMENTS AND RRL 10 BACKUP THE ADDRESS TO ADB N1 WORD 21 AGAIN JSB \ABDO AND REWRITE IT JMP MPLOP GO READ NEXT SKP * * ALLOW USER TO ASSIGN A PROGRAM TO A PARTITION. * PROGRAMS THUS ASSIGNED WILL RUN IN NO OTHER * PARTITION. * * SEND MESSAGE: "ASSIGN PROGRAM PARTITIONS?" * * USER RESPONDS WITH/ PROGNAME,PART# OR /E * APSRT JSB \SPAC LDA P26 LDB MSM4. JSB \MESS * * READ RESPONSES (CALL INLINE SUBROUTINE) * APLOP JSB APRED JMP APEND END LOOP IF /E WAS ENTERED JMP APCNV ELSE CONTINUE * * APRED NOP APRD2 CLA,INA LDB HYADD JSB \READ GET RESPONSE. LDA N5 ASK FOR A 5 CHAR NAME,BUT JSB \GETN IF THE 1ST 2 CHARS ARE CPA "/E" /E THEN JMP APRED,I WE ARE DONE JSB DPCHK CHAR AFTER PROGRAM NAME JMP APER1 SHOULD BE A COMMA, OTHERWISE JMP APER1 WE HAVE AN ERROR. * * GO LOCATE PROGRAM IN IDENT TABLE * SET UP POINTERS \ID1,I THRU \ID16,I * PUT ID SEG ADDR IN 'DPID' * LDB ATBUF LOCAéØNLHTE IDENT JSB \IDXS AND SET POINTERS. JMP APER1 ERROR IF NOT FOUND LDA \ID6,I GET PROGRAM TYPE AND M7 IF BASIC TYPE-IS CPA P2 NOT 2 (RT DISK RES) RSS OR 3 (PR DISK RES) CPA P3 OR 4 (BG DISK RES) RSS CPA P4 THEN WE DONT MESS RSS AROUND WITH PARTITION JMP APER1 STUFF. ISZ APRED INCREMENT TO NORMAL RETURN POINT JSB IDFND GET THE ID-SEG ADDR STB DPID AND SAVE JMP APRED,I AND RETURN TO CALLER * DPID BSS 1 POINTER TO ID-SEG FOR NAMED PROG dNÿÿþú SKP * * CONVERT PARTITION NUMBER TO BINARY * AND VERIFY * APCNV LDA N2 GET A 2-DIGIT DECIMAL NUMBER JSB \GET# FROM LBUF AND MAKE IT BINARY JMP APER2 ERROR IF BAD DIGIT STA PNUM CMA,INA IF ENTRY IS MORE THAN MAX ADA MAXPT ESTABLISHED EARLIER OR SSA,RSS ZERO, CPA MAXPT THEN WE HAVE JMP APER2 AN ERROR. * JSB DPCHK IT'S ALSO AN ERROR IF NEXT JMP APER2 CHAR IS ANYTHING BUT RSS END OF JMP APER2 RECO~D. * * SEE IF PARTITION IS DEFINED * CCA ADA PNUM CONVERT PART. NUMBER TO MPY P7 ABS ADDRESS IN M.A.T. IN ADA MAT. STA DPTM2 TARGET SYSTEM AND SAVE IT. LDB A JSB DPRW READ LINK FIELD IN M.A.T. ENTRY SSA IF IT IS NEGATIVE JMP APER2 THAT MEANS UNDEFINED PARTITION * * GOOD PARTITION NUMBER - SEE IF PROG WILL FIT * LDB DPTM2 READ SIZE OF ADB P4 THE SPECIFIED PARTITION JSB DPRW (LOW 10 BITS OF FIELD) AND M1777 AND SAVE IT STA DPSIZ LDB DPID READ WORD 21 (DMS WORD) FROM ADB P21 ID-SEGMENT AND SAVE IT JSB DPRW STA DPTMP * LDB \ID6,I IS THIS AN EMA PROGRAM? SSB,RSS JMP NONEM NO * * EMA PROGRAM - GET ITS PROGRAM SIZE + EMA SIZE * JSB PAGES GET THE # OF PAGES REQUIRED JMP CMPPG AND GO CHECK WITH PARTITION'S SIZE * NONEM RRR 10 ISOLATE SIZE FIELD FROM AND M37 ID-SEGMENT WORD 21 * * COMPARE PROGRAM REQMTS WITH PARTITION SIZE * CMPPG CMA,INA AND COMPARE WITH ADA DPSIZ PARTITION SIZE SSA ERROR IF PARTITION JMP APER3 IS SMALLAR THAN PROGRAM * * PROGRAM WILL FIT PARTITION: FIXUP ID-SEGMENT * LDA DPTMP PICK UP OLD CONTENTS OF AND M7`üþú700 ID-SEG WORD 21 IOR PNUM AND MERGE IN PARTITION ADA N1 NUMBER LESS 1 IOR MSIGN AND ASSIGNED LDB DPID BIT. THEN ADB P21 REWRITE THAT WORD JSB \ABDO IN ID-SEGMENT JMP APLOP GO BACK AND GET NEXT USER INPUT * MSM5 ASC 17,MODIFY PROGRAM PAGE REQUIREMENTS? MSM5. DEF MSM5 * MSM4 ASC 13,ASSIGN PROGRAM PARTITIONS? MSM4. DEF MSM4 SKP * * BUILD MEMORY PROTECT FENCE TABLE * * (MPFT. CONTAINS ABS ADDR OF TABLE IN TARGET SYSTEM) * * TABLE FORMAT: WORD LOGICAL FENCE ADDR FOR: * 0 - LARGE BG DISC RES PROG W/O COMMON * 1 - MEM RES PROG W/O COMMON * 2 - ANY PROG USING RT COMMON * 3 - ANY PROG USING BG COMMON * 4 - ANY PROG USING SSGA * 5 - TYPE 2/TYPE3 (RT/BG) PROGRAM WITHOUT COMMON * APEND JSB \SYS LET \ABDO KNOW WE'RE REFERING * TO SYSTEM ADDRESSES. LDA LWDP1 GET LAST WORD OF A DRIVER PARTITION, +1 STA $DLP+1 AND SAVE LOAD ADDRESS FOR DRP'S LDB MPFT. PROGRAM AND SAVE AS WORD 0 JSB \ABDO OF MPFT. * LDA FWMRP SAVE FIRST WORD ADDR OF MEM RES JSB \ABDO PROGS IN WORD 1. * LDA RTCAD AND FIRST WORD ADDR OF RT JSB \ABDO COMMON IN WORD 2. * LDA BGCAD AND FIRST WORD ADDR OF BG JSB \ABDO COMMON IN WORD 3. * LDA SSGA. AND FIRST WORD ADDR OF SSGA JSB \ABDO IN WORD 4. * LDA FWPRV AND FIRST WORD ADDRESS OF PRIVILEGED STA $PLP+1 PROGRAMS, SAVE THEIR LOAD POINT JSB \ABDO IN WORD 5 SKP * * * BUILD THE MEMORY RESIDENT PROGRAM MAP * CLA STA HIBP CLEAR RP/WP BIT FLAG LDA FWSDA GET START ADDRESS OF SDA LDB \MRT2 DO MR'S ACCESS TABLE AREA II? SZB,RSS YES S þú LDB MRACM NO, DO THEY ACCESS COMMON? SZB,RSS LDA LWDP1 NO,GET START ADDRESS OF COMMON JSB CPAG# CONVERT TO A PAGE # STA TEMP2 AND SAVE AS LIMIT * LDB MAP. GET TABLE AREA II ADDRESS OF RESERVED LDA FPMBP MAP SPACE, AND SET THE JSB \ABDO PHYSICAL MR BASE PAGE # * CCA SET FLAG FOR SECOND PASS STA TEMP4 ( SETTING SDA & TA II PAGES) CLA CLEAR WRITE PROTECT BIT STA HIBP STA TEMP3 NOW SET FIRST PAGE TO STORE L1 ISZ TEMP3 BUMP PHYSICAL PAGE # LDA TEMP3 IF IT NOW EQUALS CPA TEMP2 THIS BLOCK'S LIMIT JMP L2 THEN DONE WITH LOOP IOR HIBP MERGE POSSIBLE WRITE PROTECT BIT JSB \ABDO AND SEND PAGE TO MAP JMP L1 CONTINUE * BIT14 OCT 40000 * * SEND THE PAGE #'S FOR SDA AND TABLE AREA II (IF INCLUDED) * L2 STA TEMP3 SAVE CURRENT PAGE LDA BIT14 SET WRITE-PROTECT BIT STA HIBP ISZ TEMP4 WAS THAT THE SECOND PASS THRU LOOP? JMP L3 SECOND, SO MOVE ON * LDA \MRT2 SHALL WE SEND THE PAGES FOR SZA,RSS SDA AND TA II? JMP L3 NO LDA LBCAD GET PAGE IMMEDIATELY FOLLOWING LAST JSB CPAG# TABLE AREA II PAGE STA TEMP2 AND SAVE AS CURRENT LIMIT JMP L1+1 GO RE-ENTER BLOCK * * SEND MRL PAGES AS WRITE-PROTECTED, THEN THE MRP PAGES * L3 LDA FPMBP GET THE PHYSICAL STARTING INA PAGE OF MRL STA TEMP3 AND SAVE ADA MRP# ADD # PAGES OCCUPIED BY STA TEMP2 MRL/MRP'S AND SAVE AS LIMIT LDA FPMRP GET FIRST PAGE OCCUPIED BY MRP'S STA TEMP4 SET A LIMIT OF WP-PAGES * L4 LDA TEMP3 GET NEXT PHYSICAL PAGE CPA TEMP2 IF END OF MEM RES ARE JMP LEFTO THEN GO FILL IN LEFTOVER REG'S * CPA TEMP4 IF THE LAST WRITE-PROTECTED RSS 0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISC ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISC ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPAR?þúE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP * BEG05 JMP \SRET SEGMENT ENTRY POINT * DC EQU 0 ABOOT DEF START ADDR OF 128 WD BOOT EXTENSION (13037 DISCS) HBOOT DEF HSTRT ADDR OF 256 WD HPIB DISC BOOT EXTENSION HBOT2 DEF HSTRT+128 ADDR OF 2ND HALF OF HPIB BOOT ATB30 DEF TB30 ADDR OF TRACK MAP TABLE IMAGE * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 3, 00? * MES1 DEF *+1 ASC 19,MODEL,#TRKS,FIRST CYL,HEAD,#SURFACES, ASC 18,UNIT,#SPARES FOR SUBCHNL: MS1A DEF MES1+20 MSIBI DEF *+1 ASC 18,ADDRESS,#SPARES(,UNIT) FOR SUBCHNL: * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAMR? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 7,DISC MODEL # ? MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? "/E" ASC 1,/E SBUF BSS 3 DSBUF DEF SBUF MES5 DEF MES05 MES7 DEF MES07 * L2000 OCT -2000 M0760 OCT 76000 M77 OCT 77 M377 OCT 377 M1177 OCT 101777 M1760 OCT 1760 M1777 OCT 1777 M74C OCT 7400 M7400 OCT 177400 M7700 OCT 177700 M2300 OCT 2300 MSIGN OCT 100000 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N8 DEC -8 N16 DEC -16 N64 DEC -64 N160 DEC -160 P1 DEC 1 P2 DEC 2 P4 DEC 4 P6 DEC 6 P7 DEC 7 P15 DEC 15 P17 DEC 17 P18 DEC 18 P23 DEC 23 P25 DEC 25 P31 DEC 31 P64 DEC 64 P74 DEC 74 P128 DEC 128 BLANK OCT 40 ZERO OCT 60 CTEMP NOP DTEMP NOP STEMP NOP TTEMP NOP HED INTERACTIVE DISC SET UP ÈÝþúSECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * 13037 TYPE SYSTEM DISC: * MODEL,#TRKS,FIRST CYL,HEAD,#SURFACES,UNIT,#SPARES FOR SUBCHNL: * OR * HPIB SYSTEM DISC: * MODEL,#TRKS,FIRST CYL,HEAD,#SURFACES,ADDRESS,#SPARES(,UNIT) FOR SUBCHNL: * * 0? * . * . * . * . * 32? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO OR #TRACKS)? ENTER YES OR NO OR #TRACKS * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT * * DISC MODEL # ? ENTER MODEL NUMBER SPC 3 \DST5 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB32 PUT $TB32 OR $TA32 IN SYM TBL LDA \IBI GET SYS DISC TYPE SLA IS IT ICD?? LDB $TA32 YES- PUT $TA32 IN SYM TBL JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHANNEL NUMBER ADA N8 TEST FOR >= 10 OCTAL SSA,RSS JMP SPRMT OK JSB \INER JMP CHNLD * SPRMT JSB \SPAC LDA \IBI SLA,RSS IS SYS DISC ICD?? JMP STB30 NO-SEND THE APPROP. PROMPT * LDA MSIBI GET THE IBI SUFFIX FOR THE MESSAGE LDB MS1A APPEND IT HERE. MVW P18 * STB30 LDA P74 SEND PROMPT: "MODEL,#TRKS,FIRST CYL,HEAD, LDB MES1 #SURFACES,(UNIT/ADDRESS),#SPARES(,UNIT) JSB \MESS FOR SUBCHNL:" LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT STA INTMP AND CLEAR LOOPS LDB N160 =-160 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP ­yþú MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT LDA B CONVERT FOR THE MESSAGE CMA,INA LDB DSBUF JSB \CONV LDA SBUF+2 STA MS3+2 SET IN THE MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P5 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N6 GET 6 ASCII - MODEL # JSB \GETN JSB \MTCH LOOK UP SECTORS/TRK IN MODEL TABLE DEF *+6 DEF \MDTB TABLE ADDR DEF \TBUF KEY ADDR DEC 10 DEPTH OF SEARCH DEC 3 KEY LENGTH DEC 5 ENTRY LENGTH JMP TB30E \MTCH ERROR-INVALID MODEL # * ADA P3 OFFSET TO GET SEC/TRK LDB A,I STB STEMP,I SAVE IT AWAY IN TMT INA * LDA A,I GET DISC TYPE WORD RAL ICD FLAG IN BIT0,88020 FLAG IN BIT15 STA DTEMP SAVE IT FOR LATER XOR \IBI MAKE SURE THIS DISC'S ICD BIT SLA IS THE SAME AS THE SYS DISC! JMP TB30E NOPE-THEY TRIED TO MIX 13037 & ICD * LDA N4 CONVERT 4 DIGITS JSB \GET# DECIMAL #TRACKS JMP TB30E ERROR - * STA TTEMP SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30E ERROR- CAN'T HAVE 0 TRK SUBCH * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA CTEMP THE CYL # FOR TRACK 0. LDA N2 GET 2 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N64 €’þú MUST BE LESS THAN 64... SSA,RSS WELL? JMP TB30E NO - BITCH * BLF PUT IN ITS PLACE STB BSHED AND SAVE LDA N2 NOW GET # SURFACES JSB GET MUST BE 1 TO 63... STA B SZA ADA N64 SSA,RSS WELL? JMP TB30E NOT GOOD! BITCH BLF,BLF SHIFT INTO PLACE RBL,RBL AND ADB BSHED COMBINE WITH HEAD STB BSHED * LDA N2 NOW GET UNIT JSB GET MUST BE 0 TO 15... STA B ADA N16 SSA,RSS WELL?? JMP TB30E NO - COMPLAIN. ADB BSHED COMBINE STB BSHED SAVE JSB \GETC TEST FOR SPARES CPA BLANK WELL? RSS YES, SO SET TO CONVERT 3 DIGITS JMP TB30E NO, ERROR -REQUIRE # SPARES NOW * LDA N3 JSB GET CONVERT THE # SPARES LDB A SET IN B TOO ADB M7400 SUBTRACT 256 SSB,RSS #SPARES <= 255?? JMP TB30E NO..GIVE AN ERROR * LDB DTEMP GET DISC TYPE AGAIN SLB,RSS TEST ICD TYPE BIT JMP EOLIN NO-13037 TYPE DISC * IOR MSIGN SET THE ICD BIT STA DTEMP * SSB,RSS TEST IF ICD UNIT# REQ'D JMP EOLIN NO UNIT REQ'D-CHECK FOR END OF LINE CLA,INA JSB GET GET UNIT# FOR ICD DISC 88020 LSL 10 SHIFT IT INTO PLACE IOR DTEMP ADD IN REST OF SPARES WORD * EOLIN STA DTEMP SAVE SPARES/(ICD UNIT) WORD JSB \GETC END OF LINE? SZA WELL? JMP TB30E NO - TOO BAD - AND YOU ALMOST * MADE IT TOO. TB30C ISZ STEMP STEP TO WORD 1- 1ST CYLINDER LDA CTEMP GET 1ST CYL STA STEMP,I SAVE IT AWAY IN TMT ISZ STEMP STEP TO HEAD/UNIT WORD. LDA BSHED AND STA STEMP,I SALT IT AWAY. ISZ STEMP NOW THE # TRACKS LDmtþúA TTEMP WORD STA STEMP,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ STEMP STEP TO SPARES/HPIB UNIT# (IF REQ'D) LDA DTEMP AND STA STEMP,I SALT THAT AWAY TOO. LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N4 DECIMAL DIGITS JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL ADB M7400 TEST FOR TOO MANY TRACKS CMB,SSB,INB,SZB OK? JMP SYSER NO GO BITCH * LDA SYSCH GET SYS SUBCHANNEL MPY P5 OFFSET INTO TMT.. ADA ATB30 TO SEC/TRK WORD LDB A,I GET SEC/TRK FROM TMT CPB \SCTK CONSISTENT W/ DISC IN "SYSTEM DISC MODEL?" RESPONSE? RSS YES - OK JMP SYSER NO - SCOLD THEM * LDA SYSCH * * SET VALUES FOR THE BOOT * RSS SETEM CLA SUBCHANNEL IN A MPY P5 CALC OFFSET LDB ATB30 POSITION WITHIN TMT FOR INFO ADB A * INB ‚±þú STEP TO 1ST CYLINDER WORD LDA B,I GET FIRST CYLINDER # STA TBASE SET FIRST CYL FOR MAC BOOT EXT STA HTBAS ALSO FOR ICD BOOT EXT. STA PT#TR SET 1ST CYL FOR MAC STRAP STA PT#T2 SET 1ST CYL " " " AND M377 GET 1ST CYL-LO BYTE STA !CYLL SET FOR ICD STRAP LDA B,I FRESH COPY ALF,ALF ROTATE AND M377 GET 1ST CYL-HI BYTE STA !CYLH SET FOR ICD STRAP * INB LDA B,I LDB A AND M1760 1760 OCTAL MASK ALF SHIFT INTO PLACE STA H#AD SET HD# FOR MAC STRAP COMMANDS STA PT#H2 " " " " " ALF,ALF STA BHD# SET BASE HD# FOR MAC BOOT EXT STA BHED# ALSO FOR ICD BOOT STA !HEAD ALSO FOR ICD STRAP * LDA B FRESH COPY ALF RAL,RAL SHIFT INTO PLACE AND M77 MASK OFF # OF SURFACES STA #HDS SET FOR ICD BOOT EXT STA #HEDS ALSO FOR ICD BOOT * LDA B AND M17 GOT THE UNIT LDB WA#KE NOW INCORPORATE IT ADB A IT INTO THE WAKEUP, STB WA#KE SEEK,AND \READ COMMANDS STB WAK * LDB PT#SK ADB A STB PT#SK STB SKCMD * LDB PT#AD ADB A STB PT#AD STB AD#RC * LDB R#DCM ADB A STB R#DCM STB R#CMD * LDB P#EN ADB A STB P#EN STB S#TAC * STA !UNIT SET ADDR. SEL. FOR ICD STRAP PPOLL * LDB AD1 GET THE ICD COMMAND ADB A ADD IN THE ADDR SELECT * STB AD1 SET UP ALL ICD OCT 440 COMMANDS STB AD2 FOR ICD BOOT EXT. ... STB AD3 STB AD5 * STB !AD1 FOR ICD BOOT STRAP ... STB !AD2 STB !AD3 STB !AD5 * LDB AD4 GET ICD 550 COMMAND ADB A ADD IN THE ADDR SELECT STB AD4 SET õ±þúUP ALL ICD 550 COMMANDS STB AD6 STB !AD4 SET EM FOR ICD STRAP TOO STB !AD6 * * LDA \SCTK LSL 6 X 64 TO GET WORDS/TRACK STA #WDTK WDS TRK OF DESTINATION SYS DISC STA WD#TK SET FOR ICD BOOT ALSO * SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# #SECT PER TRACK TO ZERO, CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF GET BACK THE SIZE STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N4 JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT AUX1 STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SYSER JSB \INER SEND ERROR MESSAGE JMP ISYSC TRY AGAIN * AUX2 ADB M7400 TOO MANY TRACKS FOR AUX CMB,SSB,INB,SZB DISC? JM÷NLHP AUX4 YES GO BITCH SPC 1 STA AUXCH SET AUX CHANNEL MPY P5 OFFSET INTO TMT ADA ATB30 LDA A,I PICK UP SEC/TRK OF AUX CHANNEL AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 * NOTE: THE FACT THAT ANY GIVEN DISC * ADDRESS IS ON A UNIT OTHER THAN * THE SYSTEM UNIT IS FLAGGED BY * ITS TRACK ADDRESS BEING GREATER THAN * 400 BY THE AMOUNT OF THE DESIRED * TRACK. STSCR JMP \DST5,I RETURN TO MAIN LINE CODE SPC 1 P3 DEC 3 P5 DEC 5 P14 DEC 14 P32 DEC 32 BSHED NOP SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB \SPAC NEW LINE RSS #SEC1 JSB \INER INVALID DISC MODEL # LDA P14 LDB MES40 MES40 = ADDR: DISC MODEL # ? JSB \READ PRINT MESSAGE, GET REPLY LDA N6 SET FOR 6 ASCII CHARS INPUT â¡Nÿÿþú JSB \GETN GET AUX DISC MODEL # JSB \MTCH SEARCH MODEL TABLE DEF *+6 DEF \MDTB TABLE ADDR DEF \TBUF KEY ADDR DEC 9 DEPTH OF SEARCH DEC 3 KEY LENGTH DEC 5 ENTRY LENGTH JMP #SEC1 \MTCH ERR RETURN- INVALID MODEL # ADA P3 OFFSET TO SEC/TRK WORD LDA A,I GET #SEC/TRK * JMP DSSIZ,I RETURN SPC 2 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA \TBUF AND GETS NEXT JSB \GETC INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP TB30E EMPTY LINE SO ERROR * LDA \TBUF GET TYPE/ # DIGITS JSB \GET# GET NUMBER JMP TB30E CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+1 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A ADB N32 TEST FOR SUBCHANNEL # >=32 SSB,RSS JMP TSTER * LDB A NUMBER TO B BLS,BLS INDEX INTO THE ADB A TMT:(SUBCH# X 5) ADB ATB30 ADB P3 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ø)þú ADJUST FOR P-1 JMP A,I AND RETURN * N32 DEC -32 HED MH RT4GN CONFIGURE AND COMPLETE INITILIZATION \BOT5 NOP * * SET THE SYSTEM DISC SELECT CODE FOR THE MAC & ICD BOOTSTRAPS * LDA DCHNL STA DSKSC SET FOR MAC STRAP STA ICDSC SET IT FOR ICD STRAP * * SEND THE BOOT EXTENSION TO ABSOLUTE OUTPUT FILE * LDA \IBI ICD SYS DISC?? SLA JMP ICDBT YES-GO OUTPUT ICD BOOT EXT. * LDB ABOOT GET ADDR OF MAC BOOT CLA,CLE SET SECTOR=0,WRITE JSB \DSKD SEND 128 WD MAC BOOT EXTENSION LDA P2 CLB,INB SET 1 BLOCK SIZE FOR BOOT FILE JMP SETSM SET FIRST SECTOR OF SYS,SIZE OF STRAP * ICDBT LDB HBOOT GET ADDR OF ICD BOOT EXT. CLA,CLE SET TO WRITE 1ST BLOCK ICD BOOT JSB \DSKD DO IT. * LDB HBOT2 GET ADDR OF 2ND BLOCK ICD BOOT LDA P2 WRITE IT TO SECTOR 2 (64 WD SECTR) CLE SIGNAL TO WRITE JSB \DSKD WRITE 2ND 128 WDS OF ICD BOOT EXT LDA P4 GET SECTOR ADDR OF BEGIN OF SYS LDB P2 SET SIZE FOR BOOT FILE CREATE * SETSM STA \ADSK SET 1ST 64 WD SECTOR OF OP SYS STB CTEMP SET SIZE OF BOOT FILE TO CREATE * 1 BLOCK FOR MAC BOOTSTRAP * 2 BLOCKS FOR ICD BOOTSTRAP * * ASK FOR BOOT FILE NAME & CREATE IT IF WANTED. * BOOT0 JSB \SPAC NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAMR? JSB \RNME GET THE NAME * JSB \GINT IF A 0 WAS ENTERED, THEN CLA,INA SKIP THE BOOT JSB \GETN CPA ZERO JMP \BOT5,I RETURN * JSB \CRET CREAT BOOT FILE DEF *+5 DEF \BDCB DEF CTEMP SIZE IN # OF BLOCKS DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS JMP BOOT0 ERROR-TRY AGAIN * LDB \IBI ICD SYS DISC?? …þúSLB JMP ICDST YES-DO THE ICD BOOT STRAP * LDA STRAP NO-WRITE THE MAC BOOT STRAP LDB NBLC NEG #WDS FOR CKSUM CALC JSB CKSUM CALC CKSUM & STUFF AFTER LAST DATA WORD * LDA STRAP LDB BOOTL LENGTH OF STRAP FOR PUNCHING JSB SWRIT WRITE THE MAC BOOT STRAP TO FILE JMP SEOF? * ICDST LDA S!RAP GET ADDR OF ICD STRAP LDB NHLN1 GET NEG #WDS FOR CKSUM CALC JSB CKSUM CALC CKSUM & STUFF AFTER LAST DATA WORD * LDA S!RP2 ADDR OF 2ND RECORD ICD STRAP LDB NHLN2 NEG #WDS FOR CKSUM CALC JSB CKSUM CALC CKSUM & STUFF * * NOW WE WRITE THE ICD BOOTSTRAP TO THE BOOT FILE IN 2 PIECES * (NEED 2 RECORDS BECAUSE FMGR DOESN'T SUPPORT RECORDS > 128 WDS) * NOTE-THERE ARE 3 WASTED WORDS BETWEEN THE END OF THE FIRST * RECORD & THE START OF THE 2ND.(CKSUM WD.,LENGTH WD.,& LOAD ADDR) * THE 2ND REC. LOAD ADDR IS SET TO WASTE THEM IN MEMORY,SO THAT THIS * ICD STRAP CODE DOESN'T NEED 2 ADDRESS ADJUSTING CONSTANTS * (LIKE "H0") TO FURTHER CONFUSE THE ISSUE. * LDA S!RAP LDB !BLN1 PUNCH LENGTH OF 1ST RECORD JSB SWRIT WRITE 1ST RECORD ICD STRAP * LDA S!RP2 ADDR OF START OF 2ND RECORD LDB !BLN2 PUNCH LENGTH OF 2ND RECORD JSB SWRIT WRITE 2ND STRAP RECORD * * NOW WRITE OUT AN EOF IF BOOT FILE IS TYPE 0 * SEOF? LDA \BDCB+2 SZA JMP \BOT5,I RETURN IF NOT TYPE 0 * LDA STRAP GET FAKE BUFFER ADDR CCB SIGNAL SWRIT TO WRITE AN EOF JSB SWRIT SEND EOF. * JMP \BOT5,I RETURN SPC 3 * SWRIT - DOES FMP WRITE: A=BUFFR ADDR B=#WORDS TO WRITE * SWRIT NOP STA ABUFR STB WLEN * JSB WRITF DEF *+5 DEF \BDCB DEF \FMRR DEF ABUFR,I DEF WLEN JMP SWRIT,I RETURN * ABUFR NOP WLEN NOP SPC 2 * CKSUM-COMPUTES A TYPE 7 FILE CHECKSUM hþú * A=ADDR OF 1ST WORD OF FILE * B=NEGATIVE #WORDS TO ADD FOR CHECKSUM (BEGINNING AT 2ND WORD(A+1)) * CKSUM NOP STB CTEMP CLB CLEAR ACCUMULATOR FOR CHECKSUM WORD INA DON'T USE 1ST WORD IN SUM * SUMNX ADB A,I ADD NEXT WORD TO SUM INA STEP TO NEXT WORD ISZ CTEMP ALL WORDS DONE?? JMP SUMNX NOPE * STB A,I YES-STUFF CHECKSUM IN LAST WD OF FILE JMP CKSUM,I RETURN * BSS BEG55+2200B-* HED RT4GN ** 13037 DISCS TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE ROM DISC LOADER WILL BRING THIS 128 WORDS BOOT EXTENSION * INTO MEMORY AT 2011 TO 2210. THE ROM LOADR THEN DOES A JSB 2055,I * AND THE BOOT EXTENSION BEGINS EXECUTION AT BENT. AT DRBOT THE * BOOT EXT. MOVES ITSELF TO HI MEMORY (77600),AND JUMPS TO 77600 * TO BEGIN AT "START" AND BRINGS IN THE OP SYSTEM TRACK BY TRACK. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES,GET CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 MASK SELECT CODE OF DISC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+HDA+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+HDA+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ¹«þú ABS STB-O+HDA+I+I YES, THEN STORE IT BACK ABS ISZ-O+HDA MOVE ON TO THE NEXT INSTR ABS LDA-O+HDA ABS CPA-O+HDA3 ALL DISC IO INSTR CONFIGURED? CLA,INA,RSS YES,SET A TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE NEXT ONE SLOAD ABS STA-O+BENT ABS LDA-O+T#ACK CLB ABS DIV+I+I OPCODE FOR DIVIDE ABS 76000B-O+#HDS ABS ADA-O+TBASE ADD TRACK ZERO TO GET ABS. TRACK ABS STA-O+CYLA1 SAVE FOR ADDRESSING ABS STA-O+CYLA3 SAVE FOR ADDRESSING ABS ADB-O+BHD# ADD THE BASE HEAD ADDRESS ABS LDA-O+BENT GET SECTOR TO A BLF,BLF PUT HEAD IN HIGH B AND ABS ADB-O+BENT ADD THE SECTOR RSS SKIP OVER ADDRESS OF BENT ABS 2000B-OO+BENT DEFINE ADDRESS OF BENT ABS STB-O+HDA SET THE HEAD/SECTOR ADDRESSES ABS STB-O+HDA3 SET THE HEAD/SECTOR ADDRESSES LSL 7 SECTOR TIMES 128 CMA,INA AND SUBTRACT FROM ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDB-O+D#PRM GET THE COMMAND SLOOP LDA 1,I GET A COMMAND RAL,CLE,SLA,ERA IF SIGN BIT SET DSK10 CLC 0 SEND COMMAND IS COMMING DSK11 OTA 0,C SEND THE COMMAND ABS CPB-O+A#DMA IF DMA STC 6,C START IT DSK12 STC 0 ALLOW ATTENTION SEZ,INB,oþúRSS IF NOT A COMMAND ABS JMP-O+STDMA DON'T WAIT FOR FLAG * DSK13 SFS 0 WAIT FOR THE FLAG ABS JMP-O+*-1 STDMA STF 6 STOP DMA IF NEEDED ABS CPB-O+A#END END OF LOOP? RSS SKIP IF END ABS JMP-O+SLOOP NOT END AROUND WE GO * DSK14 LIA 0,C GET STATUS 1 DSK15 SFS 0 WAIT FOR FLAG ABS JMP-O+*-1 DSK16 LIB 0,C GET STATUS 2 ABS AND-O+C174B ISOLATE SZA,RSS IF NO ERRORS ABS JMP-O+OK CONTINUE * SWP SWITCH A AND B REGISTER CONTENTS HLT31 HLT 31B ELSE HALT ABS JMP-O+HLT31 TRY AGAIN * OK ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS ABS JMP-O+SLOAD GO LOAD (A=0=SECTOR ADDRESS) * * DATA AREA C174B OCT 17400 P#WDS DEC -128 N#WDS OCT 77477 HIGH EQU N#WDS WAK OCT 113000 SKCMD OCT 101200 CYLA1 OCT 77600 HDA ABS 76000B-O+DSK10 AD#RC OCT 106000 CYLA3 NOP SC EQU CYLA3 HDA3 ABS 76000B-O+DSK16+1 FILM# OCT 107404 R#CMD OCT 102400 S#TAC OCT 101400 #WDTK NOP RECNT OCT 77600 CONFIGURED TO BBL ADDRESS D#PRM ABS 76000B-O+WAK TBASE NOP FIRST TRACK# - STUFFED BY RT4GN A#DMA ABS 76000B-O+R#CMD A#END ABS 76000B-O+S#TAC+1 IOG OCT 102000 #HDS DEC 2 # SURFACES BHD# NOP STARTING HEAD # IOMSK OCT 172076 SPCAD ABS 2000B-OO+START B77 OCT 77 T#ACK NOP * **** NEXT 5 WORDS MUST BE AT START+155B FOR SWTCH FILE CHECK * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 OF SWICTH REG SET? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THEÓ¸þú REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+P#WDS DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+CYLA1+I+I YES GO EXECUTE THE BOOT SKP * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) OO EQU START-11B RELATIVE PAGE LOCATION OF START * * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. SPC 2 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIA 1 READ CONTENTS OF SWITCH REG SSA,RSS RECONFIGURATION REQUIRED? JMP CNFGR-ADCON NO, CONFIG I/O TO OLD SC LSR 6 A REG HAS NEW DISC SC AND MSK77-ADCON MASK OFF SEL.CODE SZA,RSS SPECIFIED? JMP CNFGR-ADCON NO, SET UP I/O FOR OLD DISC SC STA DSKSC-ADCON YES, SAVE IT * CNFGR LDB DSKAD-ADCON CONFIGURE ALL DISC I/O INTSTRUCTIONS IOLP LDA B,I FOR NEW DISC SC AND MASK-ADCON CLEAR LOW 6 BITS OF INSTR WORD IOR DSKSC-ADCON STA B,I RESTORE DISC I/O INSTR INB ISZ DATA#-ADCON DONE? JMP IOLP-ADCON NO, CONFIGURE NEXT INSTR * LDA DSKSC-ADCON ISOLATE CURRENT DISC SC LSL 6 MOVE DISC SC TO BITS 6-11 STA B SAVE IT LIA 1 GET CONTEN¶ÄþúTS OF SWITCH REGISTER AND CLRDS-ADCON CLEAR BITS 6-11 OF SWITCH REG IOR B INSERT DISC SC INTO BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA DSKSC-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 LDB P#LST-ADCON N#XT INB STEP ADDRESS N#XT1 LDA B,I GET THE COMMAND RAL,CLE,SLA,ERA IF A CLC IS NEEDED DSK1 CLC DC DO IT DSK2 OTA DC,C SEND THE WORD CPB P#DMA-ADCON DMA NOW? STC 6,C YES DSK3 STC DC ALLOW ATTENTION SEZ,RSS IF NOT A COMMAND JMP DMAST-ADCON DON'T WAIT FOR FLAG * DSK4 SFS DC WAIT FOR FLAG JMP *-1-ADCON * DMAST STF 6 CLEAR DMA CPB P#END-ADCON END OF LOOP RSS YES SKIP OUT JMP N#XT-ADCON NO DO NEXT WORD * DSK5 LIA DC,C GET THE STATUS 1 WORD DSK6 SFS DC WAIT FOR 2 JMP *-1-ADCON * DSK7 LIB DC,C GET STATUS 2 AND B174C-ADCON ISOLATE THE IMPORTANT BITS SZA,RSS IF OK JMP BTEXT-ADCON GET READY TO EXECUTE THE BOOT * RBR,SLB,RBL TEST \READY BIT JMP ATN#-ADCON NOT \READY GO WAIT FOR ATTN. * SWP SWITCH A AND B REGISTER CONTENTS HT11 HLT 11B ELSE HALT JMP HT11-ADCON MAKE EM TRY AGAIN * BTEXT CLB CLEAR B REG FOR THE BOOT EXTENSION JMP BADDD-ADCON,I GO EXECUTE THE BOOT * ATN# LDB P#LST-ADCON GET 'END' COMMAND ADDRESS AND JMP N#XT1-ADCON GO SEND IT AND WAIT FOR ATTN. P#LST DEF *+1-ADCON ADDRESS OF COMMAND LIST OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000 PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 STATUS COMMAND BADD ABS 77600B+I+I DMA TARGET ADDRESS FOR BOO¡ÀþúT EXT. DM128 DEC -128 BADDD ABS 77600B BEGIN EXECUTE BOOT EXTENSION B174C OCT 17400 MSK77 OCT 77 P#END ABS P#EN-ADCON P#DMA ABS R#DCM-ADCON MASK OCT 177700 DSKSC NOP DISC SC - STUFFED BY GEN SEG. 7 CLRDS OCT 170077 I#OTB DEF DSK1-ADCON DEF DSK2-ADCON DEF DSK3-ADCON DEF DSK4-ADCON DEF DSK5-ADCON DEF DSK6-ADCON DEF DSK7-ADCON I#OTC EQU * DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTRUCTIONS DSKAD DEF I#OTB-ADCON,I ADDRESS OF I/O INSTRUCTION LIST SPC 1 HNDR EQU *-1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-1 BOOT LENGTH FOR CHECK SUM CACULATION * CPB EQU 056000B CPB CPA EQU 052000B CPA LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB DIV EQU 000400B DIV (LESS BIT 15) JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR IOR EQU 032000B IOR JMP EQU 026000B JMP CLF EQU 003100B CLF (LESS BIT 15) SFS EQU 002300B SFS (LESS BIT 15) OTA EQU 002600B OTA (LESS BIT 15) CLC EQU 006700B CLC (LESS BIT 15) STC EQU 002700B STC (LESS BIT 15) LIA EQU 002500B LIA (LESS BIT 15) LIB EQU 006500B LIB (LESS BIT 15) C EQU 001000B HOLD/CLEAR FLAG FOR I/O INSTRS I EQU 040000B INDIRECT BIT (CODE AS I+I) * SPC 2 BSS BEG55+2600B-* HED RT4GN ** ICD DISCS TRACK 0 SECTOR 0 BOOT EXTENSION ** * * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS¨™þú * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON TRACK 0 * SECTOR 0 AND OCCUPIES 2 SECTORS (256 WDS) OF THE SYSTEM DISC. * IT IS GENERATED BY THE SYSTEM GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISC AND CORE ADDRESSES SPECIFYING LOADING * * * THE ICD ROM DISC LOADER WILL BRING THIS 256 WORD BOOT EXTENSION * INTO MEMORY AT 2011 TO 2210. THE ROM LOADR THEN DOES A JSB 2055,I * AND THE BOOT EXTENSION BEGINS EXECUTION AT BENTR. AT HRBOT THE * BOOT EXT. MOVES ITSELF TO HI MEMORY (77400),AND JUMPS TO 77400 * TO BEGIN AT "HSTRT AND BRINGS IN THE OP SYSTEM TRACK BY TRACK. * STATUS IS CHECKED AFTER EVERY READ COMMAND-IF NON-ZERO,WE JUMP * TO THE RETRY LOOP @ 'RETRY' UP TO 9 MORE TIMES TO GET THE DATA. * *** ANYONE MODIFYING THIS CODE !BEWARE! OF OVERLAID CONSTANTS * USED TO COMPACT THE CODE (TO MAKE ROOM FOR FUTURE EXPANSION), * AND THE RSS AT LOCATION 2054 (RUNTIME) SO WE SKIP OVER THE * ADDRESS AT 2055 (FOR THE ROM WHO DOES JSB 2055,I). IF ANY CODE * IS ADDED OR DELETED, MAKE SURE THE RSS AND THE FOLLOWING WORD * ARE MOVED TO HSTRT+43B AGAIN! * HSTRT ABS LDA+HHIGH-O0 HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA+HRCNT-O0 INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA+HSC-O0 SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES,GET CONTENTS OF SWITCH REG. LSR 6 ABS AND+HB77-O0 MASK SELECT CODE OF DISC ABS STA+HSC-O0 SAVE IT ******************** CONFIGURE I/O INSTRS ******************************** CFGIO ABS LDA+ISTRC-O0+I+I GET THE FIRST I/O ISTRC IN A LDB A B GETS A COPY FOR LATER USE ABS AND+B1777-O0 ZERO OUT SELECT CODE BITS ABS ADA+HSC-O0 FILL IN THE SELECT CODE NOW ABS STA+ISTRC-O0+I+I Oë‹þúK-NOW STORE IN BACK IN LINE * SWP GET THE ORIGINAL IN A AGAIN ABS AND+HB77-O0 MASK OFF DISTANCE TO NEXT FIXUP SZA,RSS ARE WE DONE?? (DISTANCE=0)?? ABS JMP+HLOAD-O0 YES-TIME TO QUIT NOW ABS ADA+ISTRC-O0 NO -CALC ADDR OF NEXT FIXUP ABS STA+ISTRC-O0 NEXT FIXUP WILL BE HERE!! ABS JMP+CFGIO-O0 LET'S DO IT AGAIN. * HLOAD ABS IOR+BIT9-O0 SET SECTOR+BIT9 FOR EOI ABS ISZ+H#TRK-O0 STEP TRACK ADDR(ISZ SKIPS 1ST TIME) ABS STA+SECTR-O0 SKIP THIS 1ST TIME,CUZ SECTOR=2 ABS LDA+#RTRY-O0 GET RETRY COUNT AND ABS STA+ERCNT-O0 SET IT FOR RETRY LOOP ABS LDA+H#TRK-O0 CLB ABS DIV+I+I OPCODE FOR DIVIDE ABS 76000B-O0+#HEDS ADDRESS FOR THE DIVISOR ABS ADB+BHED#-O0 ADD THE BASE HEAD ABS STB+HEAD#-O0 STUFF THE SEEK COMMAND RSS SKIP OVER ADDR OF BENTR ABS 2000B-OO0+BENTR ROM BOOT JMPS HERE INDIRECT ABS ADA+HTBAS-O0 SET THE PHYSICAL CYLINDER LDB A ABS AND+B377-O0 STRIP OFF LOW BYTE ABS STA+CYLL-O0 LSR 8 REG B GETS THE HIGH BYTE ABS STB+CYLH-O0 * ABS LDA+SECTR-O0 GET THE SECTOR LSL 7 TIMES 128 WDS/SECTOR & DUMP BIT9 CMA,INA SUBTRACT FROM #WDS/TRACK ABS ADA+WD#TK-O0 ABS STA+PW#DS-O0 SET POS.#WORDS TO READ THIS TIME * CMA,INA SET NEG. # WORDS ABS STA+NW#DS-O0 TO READ THIS TIME * ABS LDA+HRCNT-O0 GET REMAINING WORD COUNT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA+PW#DS-O0 ELSE SET TO READ ABS STA+HRCNT-O0 SAVE REMANING COUNT RETRY ABS LDA+HRCNT-O0 GET IT AGAIN FOR COUNT ON RETRY SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA+NW#DS-O0 NUMBER LEFT STC 2 SET DMA FOR WORD COUNT Êþú OTA 2 AND SEND IT ********************************************************************** * * *** SEND FILE MASK FLMSK ABS JSB+$UNTK-O0 UNTALK ABS JSB+$OUT-O0 SEND THE FILE MASK COMMAND AD1 OCT 440 OCT 550 OCT 17 OCT 1004 AUTO SEEK TO SPARE + EOI BIT OCT 100677 UNLISTEN * * *** SEND SEEK COMMAND SEEK ABS JSB+$OUT-O0 SEND THE SEEK COMMAND AD2 OCT 440 OCT 550 D2 OCT 2 UNIT NOP CYLH OCT 77400 *TEMP-BOOT EXT JMPS,I HERE TO BEGIN BXGO EQU CYLH CYLL ABS 2000B-OO0+HSTRT *TEMP-SOURCE FOR 256 WORD MOVE BXSRC EQU CYLL HEAD# OCT 77400 *TEMP-DEST. PTR TO HIGH MEM. BXDST EQU HEAD# SECTR OCT 1002 * SECTOR #: SET TO 0 AFTER 1ST TIME UNLSN OCT 100677 UNLISTEN * * * *** SEND READ COMMAND READ ABS JSB+$OUT-O0 SEND THE READ COMMAND AD3 OCT 440 OCT 550 OCT 5 BIT9 OCT 1000 OCT 677 AD4 OCT 500 OCT 100740 LAST COMMAND * ABS JSB+CFIFO-O0 CLEAR FIFO ABS LDA+RCTL1-O0 ABS JSB+SETC-O0 ABS JSB+CFIFO-O0 ABS LDA+RCTL2-O0 ABS JSB+SETC-O0 * STCDC STC 6,C START DMA SFC6 SFC 6 BUSY WAIT ABS JMP+DONE-O0 IBI1 SFS IBI2-IBI1 ABS JMP+SFC6-O0 * DONE STF 6 STOP DMA ABS JSB+$UNLS-O0 UNLISTEN * ABS JSB+STAT-O0 GET A=STATUS1,B=STATUS2 SZA,RSS IF NO ERRORS ABS JMP+HLOAD-O0 THEN GET NEXT TRK (A=0=SECTOR) ABS ISZ+ERCNT-O0 ELSE CHECK ERROR COUNT ABS JMP+RETRY-O0 < 10 ERRS SO TRY OVER * 10 TRIES DIDN'T GET THE DATA, SO HALT 31B * SWP SWITCH A AND B REGISTER CONTENTS STP31 HLT 31B ELSE HALT ABS JMP+STP31-O0 MAKE THEM TRY AGAIN * * *** DATA AREA *** HRCNT NOP PW#DS ×°NLHABS 77400B+IBI1-HSTRT *OVERLAID: 1ST I\O INSTRUCTION ISTRC EQU PW#DS ADDR OF CURRENT ISTRC CONFIGURING NW#DS OCT 77377 GEN STUFFS: #WDS OF OP SYS TO GET HHIGH EQU NW#DS GEN STUFFS: # WDS OF OP SYS TO BRING IN WD#TK DEC 6144 *** DEBUG ONLY !! -GEN STUFFS IT HTBAS NOP ***GEN STUFFS: #HEDS DEC 2 ***DEBUG ONLY!! -GEN STUFFS IT BHED# NOP GEN STUFFS STARTING HEAD # #RTRY DEC -10 # OF RETRIES FOR DISC READ HB77 OCT 77 B377 OCT 377 C174H OCT 17400 PICTL OCT 10015 IRL,PK,LSN,CIC CNTL OCT 10413 IRL,ATN,PK,TLK,CIC CPUTK OCT 4003 LBO,T,CIC UNTLK OCT 737 UCTL OCT 4103 LBO,NRFD,T,CIC RCTL1 OCT 413 ATN,PK,TLK,CIC RCTL2 OCT 1015 EOI,PK,LSN,CIC NRFD OCT 4101 H#TRK DEC -1 TRACK COUNTER (-1 CAUSES SKIP 1ST TIME) * ************************ ICD SUBROUTINES ***************************** * $OUT OCT 177700 ~êNÿÿþúB1777 EQU $OUT MASK TO BLANK OUT SELECT CODE ABS JSB+CFIFO-O0 CLEAR FIFO ABS LDA+CPUTK-O0 SET CONTROL REG ABS JSB+SETC-O0 * CLOOP ABS LDA+$OUT-O0+I+I GET DATA IBI2 OTA IBI3-IBI2,C SEND IT OUT ABS ISZ+$OUT-O0 NEXT DATA SSA,RSS LAST BYTE OUT? ABS JMP+CLOOP-O0 NEXT WORD * IBI3 SFS IBI4-IBI3 WAIT FOR FLAG ABS JMP+IBI3-O0 ABS JMP+$OUT-O0+I+I RETURN * ********************************************************************** SETC NOP HSC EQU SETC *OVERLAID STORAGE IBI4 CLC IBI5-IBI4 IBI5 OTA IBI6-IBI5 IBI6 STC IBI7-IBI6 ABS JMP+SETC-O0+I+I RETURN ********************************************************************** CFIFO NOP IBI7 CLC IBI8-IBI7,C IBI8 STC IBI9-IBI8 ABS JMP+CFIFO-O0+I+I RETURN ********************************************************************** STAT DEC -256 * WORD COUNT FOR HRBOT-RET ADDR LATER B#WDS EQU STAT * TEMP (OVERLAID) STORAGE ABS JSB+$OUT-O0 OUTPUT STATUS COMMAND AD5 OCT 440 OCT 550 OCT 3 OCT 1000 OCT 677 AD6 OCT 500 OCT 100550 * ABS JSB+CFIFO-O0 CLEAR FIFO ABS LDA+CNTL-O0 ABS JSB+SETC-O0 ABS JSB+CFIFO-O0 ABS LDA+PICTL-O0 ABS JSB+SETC-O0 IBI9 SFS IBI10-IBI9 ABS JMP+IBI9-O0 IBI10 LIA IBI11-IBI10,C GET STATUS 1 IBI11 CLF IBI12-IBI11 TEMP KLUDGE FOR HARDWARE *** IBI12 SFS IBI13-IBI12 ABS JMP+IBI12-O0 BUSY WAIT IBI13 LIB IBI14-IBI13,C IBI14 CLF IBI15-IBI14 TEMP KLUDGE FOR HARDWARE *** ABS AND+C174H-O0 MASK OFF STATUS 1 BITS ABS JMP+STAT-O0+I+I RETURN ********************************************************************** $UNTK NOP $UNLS EQU $UNTK ABS LDA+NRFD-O0 ABS JSB+SETC-O0 ABS JSB+CFIFO-O0 ±0þú ABS LDA+UNTLK-O0 IBI15 STC IBI16-IBI15 IBI16 OTA IBI17-IBI16,C ABS LDA+UCTL-O0 ABS JSB+SETC-O0 ABS LDA+CPUTK-O0 ABS JSB+SETC-O0 ABS LDA+UNLSN-O0 IBI17 OTA IBI18-IBI17 IBI18 SFS 0 LAST I/O INSTR CONFIGURED:(DIST=0) ABS JMP+IBI18-O0 BUSY WAIT * CLA ABS JSB+SETC-O0 ABS JMP+$UNLS-O0+I+I RETURN ********************************************************************** * ***** NEXT 5 WORDS MUST BE AT HSTRT+277B FOR SWTCH FILE CHECK BENTR NOP JSB HERE FROM BBDL ERCNT EQU BENTR * TEMP STORAGE FOR RETRY COUNT STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO0+HSC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 OF SWICTH REG SET? ABS JMP-OO0+NRCFG NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO0+HRBOT RELOCATE THE REST OF THIS BOOT NRCFG OTB 1 CLEAR SWITCH REGISTER * HRBOT ABS LDA-OO0+BXSRC+I+I MOVE 256 WORD BOOT EXT. TO HI MEM. ABS STA-OO0+BXDST+I+I ABS ISZ-OO0+BXSRC ABS ISZ-OO0+BXDST ABS ISZ-OO0+B#WDS DONE? ABS JMP-OO0+HRBOT NO GET NEXT WORD * ABS JMP-OO0+BXGO+I+I YES GO EXECUTE THE BOOT * SPC 3 * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * O0 EQU HSTRT-1400B SET EXECUTION ADDR AT 1400 REL. * * THE FOLLOWING EQU IS USED TO SET UP BOOT EXTENSION MOVE * CODE AT HRBOT WHEN BOOTED BY THE ROM DISC LOADER. * OO0 EQU HSTRT-11B SET EXECUTION ADDR AT 2011 SPC 2 BSS BEG55+3200B-* SPARE AREA IN 256 WORD BOOT EXTENSION SPC 2 BSS BEG55+3274B-* BSS MAKING S!ART CODE ADDRS PRETTIER SKP HED RT4GN **U¬þú ICD PAPER TAPE BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND * IS USED TO LOAD THE DISC RESIDENT BOOT EXTENSION FROM LOGICAL * SYSTEM TRACK 0 SECTOR 0. (DOES NOT HAVE TO BE PHYSICAL TRACK 0 * ON UNIT/ADDR 0.) THE PAPER TAPE LOADR ROM (OR EQUIV.) BRINGS * THIS STRAP INTO LOCATION 100B FOR EXECUTION. P IS SET TO 100B * S IS SET WITH 0 OR DISC SC AND BIT 15 FOR RECONFIG. THIS STRAP * THEN LOADS THE BOOT EXT. OFF DISC INTO 77400B AND JUMPS THERE. * * THIS CODE IS USED BY RT4GN TO BUILD A 2 RECORD "BOOTFILE" * IN THE BINARY ABSOLUTE FORMAT. * S!RAP+1 IS THE LENGTH(REC'D#1) IN UPPER BYTE (1ST WORD PUNCHED) * S!RAP+2 IS THE LOAD ADDR FOR REC'D #1 (100B) * S!RAP+3 IS THE 1ST WORD EXECUTABLE CODE100B) * ERCD1 IS THE CHECKSUM OF REC'D#1 * S!RT2-2 IS THE LEN(REC'D#2) IN UPPER BYTE. * S!RT2-1 IS THE LOAD ADDR FOR REC'D#2 BYTE. * ERCD2 IS THE CHECKSUM OF REC'D#2 SPC 2 S!RP2 DEF S!RT2-2 ADDR OF REC'D #2 OF STRAP FILE SPC 1 S!RAP DEF *+1 ADDR OF THE ICD BOOTSTRAP ABS HL1UP LENGTH OF 1ST REC'D IN UPPER BYTE ABS HORG1 LOAD ADDRESS FOR STRAP REC'D1 S!ART CLC 0,C STOP EVERYTHING- RTE IS COMING! LIA 1 GET SWITCH REG. SSA,RSS DO THEY WANT RECONFIGURATION?? JMP CNFIG-H0 NO-SET UP W/ OLD ICD SC * LSR 6 SHIFT SC INTO PLACE AND C77-H0 MASK SC SZA,RSS IS IT SPECIFIED?? JMP CNFIG-H0 NO- CONFIG. TO OLD SC * STA ICDSC-H0 SAVE NEW ICD SELECT CODE * CNFIG LDB IOPTR-H0 GET ADDR OF FIRST I/O INSTR *** CONFIGURE I/O INSTRS CNFG LDA B,I AND !MASK-H0 IOR ICDSC-H0 ADD IN THE ICD SELECT CODE STA B,I PUT INSTRUCTION BACK IN LINE INB ISZ #INST-H0 SKIP IF THIS WAS THE LAST INSTR FIXUP JMP CNFG-H0 NOPE-DO THE NEXT * SETSC LDA ICDSC-H0 LSL 6 GET THE RIGHT SC STA B SAVE IT IN BITS 11-6 OF B ïþúREG. LIA 1 GET SW REG. AND CLRSC-H0 IOR B SET IN NEW SC IN 6-11 OTA 1 SAVE NEW SWITCH REG. * LDA ICDSC-H0 GET SC OF ICD DISC OTA 6 SET DMA CW1 W/ SELECT CODE CLC 2 LDB !BUFR-H0 GET DMA TARGET MEM ADDR OTB 2 SEND DMA CW2 LDA DM256-H0 DMA LENGTH STC 2 OTA 2 SEND DMA CW3 JSB !UNTK-H0 SEND UNTALK,UNLISTEN OVER BUS JSB !OUT-H0 SEND UNIVERSAL CLEAR TO CLR CONTROLLER OCT 100624 UNIVERSAL CLEAR COMMAND * **** SEND PARALLEL POLL UNTIL DISC IS READY PPOLL LDA CTPPL-H0 IRL,PPE,L,T,CIC JSB !SETC-H0 SEND PPOLL ICD0 SFS 0 WAIT FOR FLAG JMP ICD0-H0 ICD1 LIA 0 GET PPOLL RESPONSE * LSL 7 GET PPL RESPONSES IN BITS 7-14 LDB !UNIT-H0 GET SELECT ADDR OF DESIRED DISC CMB LSHFT RAL INB,SZB ARE WE AT DESIRED DISC'S RESPONSE YET? JMP LSHFT-H0 NOPE-ROTATE SOME MORE * SSA,RSS WELL,THIS IS HIM-DID HE RESPOND?? JMP PPOLL-H0 NOPE-DO ANOTHER PAR. POLL * JSB !UNTK-H0 *+++ IMPORTANT CLEAN UP FROM UNIV CLR * **** SEND FILE MASK - AUTO SEEK TO SPARE JSB !OUT-H0 SEND THE FILE MASK !AD1 OCT 440 OCT 550 OCT 17 OCT 1004 AUTO SEEK TO SPARE + EOI BIT OCT 100677 UNLISTEN **** SEND SEEK COMMAND JSB !OUT-H0 SEND THE SEEK COMMAND !AD2 OCT 440 OCT 550 OCT 2 !UNI OCT 0 !CYLH NOP !CYLL NOP !HEAD NOP !SECT OCT 1000 SECTOR 0+BIT9 (EOI) !UNL OCT 100677 UNLISTEN * * * **** SEND READ COMMAND JSB !OUT-H0 SEND THE READ !AD3 OCT 440 OCT 550 OCT 5 OCT 1000 OCT 677 !AD4 OCT 500 OCT 100740 LAST COMMAND * JSB !CFIF-H0 CLEAR FIFO LDA CTL1R-H0 ATN,PK,TLK,CIC JSmþúB !SETC-H0 JSB !CFIF-H0 LDA CTL2R-H0 EOI,PK,LSN,CIC JSB !SETC-H0 * STC 6,C START DMA WTDMA SFC 6 BUSY WAIT JMP !DONE-H0 ICD2 SFS 0 JMP WTDMA-H0 NOT DONE YET * !DONE STF 6 STOP DMA JSB !UNLS-H0 UNLISTEN * JSB !STAT-H0 GET A=STATUS1, B=STATUS2 & MASK S1 SZA,RSS IF NO ERRORS JMP !OK-H0 CONTINUE * SWP SWAP A&B FOR DISPLAY !HL11 HLT 11B HALT 11 IF ERROR. JMP !HL11-H0 MAKE EM TRY AGAIN * !OK JSB !UNTK-H0 *+++ UNTK AFTER STATUS FOR BOOT EXT. CLB CLEAR B REG FOR THE BOOT EXTENSION JMP GOBXT-H0,I GO EXECUTE THE BOOT EXT. IN HI. MEM. SPC 1 ERCD1 EQU * ADDR OF LAST WORD IN REC'D 1 NOP CHECKSUM WORD FOR REC'D #1 **************** END RECORD #1 ICD BOOT FILE ****************** ABS HL2UP LENGTH OF RECD 2 IN UPPER BYTE ABS HORG2 LOAD ADDRESS FOR REC'D 2 * * NOTE- THERE IS A 3 WORD GAP BETWEEN THE 2 RECORDS WHEN * LOADED INTO MEMORY WHICH CORRESPONDS TO THE 3 PREVIOUS * WORDS ABOVE. (DONE SO ADDRESSES IN THIS CODE WILL * CORRESPOND TO THE ACTUAL EXECUTION ADDRS MORE CLOSELY.) S!RT2 EQU * BEGIN OF CODE FOR REC'D 2 * * *** DATA AREA *** !BUFR ABS 77400B+I+I CORE ADDR FOR BOOT EXT+DMA BIT GOBXT ABS 77400B BEGIN EXECUTE BOOT EXT. HERE ICDSC NOP SELECT CODE OF ICD DISC CARD. !UNIT NOP IBI SEL. ADDR OF ICD DISC C77 OCT 77 !MASK OCT 177700 STMSK OCT 17400 CLRSC OCT 170077 !PCTL OCT 10015 IRL,PK,LSN,CIC !CNTL OCT 10413 IRL,ATN,PK,TLK,CIC TKCPU OCT 4003 LBO,T,CIC UNTK OCT 737 ATN,DIAG?,NRFD,ODD,PK,LSN,TLK,CIC !UCTL OCT 4103 LBO,NRFD,T,CIC CTL1R OCT 413 ATN,PK,TLK,CIC CTL2R OCT 1015 EOI,PK,LSN,CIC !NRFD OCT 4101 LBO,NRFD,CIC CTPPL OCT 10047 úþúIRL,PPE,LSN,TLK,CIC DM256 DEC -256 LENGTH OF BOOT EXT. FOR READ IOPTR DEF IOTBL-H0,I IOTBL DEF ICD0-H0 TABLE OF I/O INSTRS TO CONFIGURE DEF ICD1-H0 DEF ICD2-H0 DEF ICD3-H0 DEF ICD4-H0 DEF ICD5-H0 DEF ICD6-H0 DEF ICD7-H0 DEF ICD8-H0 DEF ICD9-H0 DEF ICD10-H0 DEF ICD11-H0 DEF ICD12-H0 DEF ICD13-H0 DEF ICD14-H0 DEF ICD15-H0 DEF ICD16-H0 DEF ICD17-H0 DEF ICD18-H0 DEF ICD19-H0 LSTIO EQU * #INST ABS IOTBL-LSTIO NEG # OF I/O INSTRS TO CONFIGURE *********** * ************************ ICD SUBROUTINES ***************************** * !OUT NOP JSB !CFIF-H0 CLEAR FIFO LDA TKCPU-H0 SET CONTROL REG JSB !SETC-H0 * NXWRD LDA !OUT-H0,I GET DATA ICD3 OTA 0,C SEND IT OUT ISZ !OUT-H0 NEXT DATA SSA,RSS LAST BYTE OUT? JMP NXWRD-H0 NEXT WORD * ICD4 SFS 0 WAIT FOR FLAG JMP ICD4-H0 JMP !OUT-H0,I RETURN * ********************************************************************** !SETC NOP ICD5 CLC 0 ICD6 OTA 0 ICD7 STC 0 JMP !SETC-H0,I RETURN ********************************************************************** !CFIF NOP ICD8 CLC 0,C ICD9 STC 0 JMP !CFIF-H0,I RETURN ********************************************************************** !STAT NOP JSB !OUT-H0 OUTPUT STATUS COMMAND !AD5 OCT 440 OCT 550 OCT 3 OCT 1000 OCT 677 !AD6 OCT 500 OCT 100550 * JSB !CFIF-H0 CLEAR FIFO LDA !CNTL-H0 JSB !SETC-H0 JSB !CFIF-H0 LDA !PCTL-H0 JSB !SETC-H0 ICD10 SFS 0 JMP ICD10-H0 ICD11 LIA 0,C GET STATUS 1 ICD12 CLF 0 TEMP ¾YþúKLUDGE FOR HARDWARE *** ICD13 SFS 0 JMP ICD13-H0 BUSY WAIT ICD14 LIB 0,C STATUS 2 WORD ICD15 CLF 0 TEMP KLUDGE FOR HARDWARE *** AND STMSK-H0 MASK OFF S1 FIELD JMP !STAT-H0,I RETURN ********************************************************************** !UNTK NOP !UNLS EQU !UNTK LDA !NRFD-H0 JSB !SETC-H0 JSB !CFIF-H0 LDA UNTK-H0 ICD16 STC 0 ICD17 OTA 0,C LDA !UCTL-H0 JSB !SETC-H0 LDA TKCPU-H0 JSB !SETC-H0 LDA !UNL-H0 ICD18 OTA 0 ICD19 SFS 0 LAST I/O INSTR CONFIGURED:(DIST=0) JMP ICD19-H0 BUSY WAIT * CLA JSB !SETC-H0 JMP !UNLS-H0,I RETURN * END SUBROUTINES * ********************************************************************** SPC 1 ERCD2 EQU * * NOP CKSUM WORD FOR 2ND RECORD HORG1 EQU 100B RUN TIME ORG OF ICD STRAP #1 REC'D H0 EQU S!ART-100B ADDRESS ADJUSTING CONSTANT HL1 EQU ERCD1-S!ART HL4 EQU HL1+HL1+HL1+HL1 HL16 EQU HL4+HL4+HL4+HL4 HL64 EQU HL16+HL16+HL16+HL16 HL1UP EQU HL64+HL64+HL64+HL64 * !BLN1 ABS HL1+3 REC'D #1 LENGTH FOR PUNCHING NHLN1 ABS -HL1-1 NEG. LENGTH FOR CHECK SUM CALC * HORG2 EQU 100B+S!RT2-S!ART LOAD ADDR OF REC'D #2 HL2 EQU ERCD2-S!RT2 HL04 EQU HL2+HL2+HL2+HL2 HL016 EQU HL04+HL04+HL04+HL04 HL064 EQU HL016+HL016+HL016+HL016 HL2UP EQU HL064+HL064+HL064+HL064 * !BLN2 ABS HL2+3 REC'D #2 LENGTH FOR PUNCHING NHLN2 ABS -HL2-1 NEG. LENGTH FOR CHECK SUM CALC * SKP * HED GENERATE $TB32 TRACK MAP TABLE \TB32 EQU * **ENTRY POINT FOR DSTBL** DSTBL NOP * GENERATE TB32 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA #SUBC GET NUMBER OF WORDS CMA,INA w\þúSET NEGATIVE STA \TBUF+1 SET COUNT * LDB $TB32 TRACK MAP FOR 13037 LDA \IBI IBI SYSTEM?? SLA LDB $TA32 YES-GET IBI TRACK MAP JSB \LSTS FOR $TB32 JSB \ABOR BAD NEWS NO $TB32/$TA32 !! LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE LDA \TBUF+1 SEND THE SUBCHANNEL COUNT JSB \ABDO FIRST * DSTB1 LDA \TBUF,I GET SEC/TRK WORD FROM TABLE JSB \ABDO SEND TO DISC FILE ISZ \TBUF STEP TABLE ADDRESS LDA \TBUF,I GET THE 1ST CYLINDER WORD JSB \ABDO SEND IT ISZ \TBUF STEP TO THE HEAD-UNIT WORD LDA \TBUF,I AND JSB \ABDO SEND IT ISZ \TBUF LDA \TBUF,I GET #TRACKS WORD JSB \ABDO SEND IT ISZ \TBUF LDA \TBUF,I GET #SPARES WORD JSB \ABDO SEND IT. ISZ \TBUF ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TO CMB,INB WRITE HEADER RECORD CLA,CLE #1 CONTAINING THE TRACK JSB \DSKD MAP TABLE IMAGE * LDB ATB30 MOVE LAST 32 LDA P128 WORDS OF TMT ADA B TO TOP OF TB30 MVW P32 FOR HEADER RECORD #2. JMP \TB32,I EXIT * $TB32 DEF *+1 ASC 3,$TB32 $TA32 DEF *+1 ASC 3,$TA32 * HED 7905 RTGEN SUBROUTINE SEGMENT * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * \FSC5 NOP LDB ABOOT GET THE LDA \IBI SLA IBI SYSTEM DISC?? LDB HBOOT YES - GET THE IBI BOOT STB DTEMP SAVE ADDR OF APPROP. BOOT CLA,CCE GET 1ST 128 WORDS OF THE BOOT JSB \DSKD í640 FROM THE DISC * LDB LWSLB GET THE HIGHEST SYSTEM ADDRESS STB HIGH AND STORE IN THE BOOT STB HHIGH SET IT FOR IBI BOOT * LDB DTEMP NOW WRITE 1ST 128 CLA,CLE WORDS OF THE BOOT JSB \DSKD BACK TO THE DISC * CLE DLD \OBUF FLUSH THE FINAL BUFFER ELA,CLE FROM CORE JSB \DSKD * * WRITE THE GENERATOR'S 2ND HEADER RECORD, STORED IN THE TMT BUFFER. * WORDS 59 THRU 64 MUST CONTAIN THE SYSTEM SUBCHANNEL INFORMATION. * CCA STA TB30+58 SIGNAL AN RTE-IV+ SYSTEM LDA SYSCH LDB \IBI BIT0= 1/0 = IBI SYS DISC/13037 SYS DISC ERB SAVE BIT0 IN E ALR,ERA PUT IBI BIT IN BIT15 OF A REG. STA TB30+59 THE SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+60 " " EQT # LDA CEQT STA TB30+61 # EQT'S LDA \PIOC STA TB30+62 PRIVILEGED INTERRUPT CHANNEL LDA \TBCH STA TB30+63 TBG CHANNEL LDA TB30+64 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET # OF DEFINED DISK SUBCHANNELS BLF,BLF ROTATE TO THE HIGH BYTE IOR B AND MERGE WITH THE TTY CHANNEL STA TB30+64 AND SAVE LDB ATB30 CMB,INB NEGATE IT SO \DSKD WILL KNOW CCA,CLE SIGNAL \DSKD TO WRITE HEADER REC'D #2 JSB \DSKD JMP \FSC5,I * * M17 OCT 17 * END EQU * * END BEG05 +z6ÿÿ ÿý )4 ÿ92067-18323 2001 S C0222 &RT4G8 GEN. SEGMENT #8             H0102 qJþúASMB,Q,R,C HED RT4G8 - DRIVER PARTITION LOADING CONTROL SEGMENT NAM RT4G8,5,90 92067-16323 REV.2001 790817 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G8 * SOURCE PART #: 92067-18323 * REL PART #: 92067-16323 * WRITTEN BY: KFH * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \\LDP * * EXTERNAL REFERENCE NAMES * EXT \DPLD,\PREL,\TBUF EXT \CBPA,\CPL2 EXT \CONV,\ABDO,\DSKA EXT \ADSK,\PTYP,\TMSK EXT \SPAC,\GNER,\MESS,\IRER,\ABOR EXT \ADBP,\NUMP EXT \IDX,\TIDN,\ID1,\ID3,\ID4,\ID5,\ID6,\ID8 EXT \IFIX,\FIX,\FIX1 EXT \CUBP,\UCBP,\ICBP,\CBPA EXT \SYS,\USRS,\USER EXT \LRBP,\URBP,\SRET EXT \DDON * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 160 \Ñþú TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID C&þúOUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTERѾþú INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATIONûÊþú OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * SYTRK BSS 1 DISC ADDR WHERE SYSTEM BEGINS - TRACK SYSEC BSS 1 DISC ADDR WHERE SYSTEM BEGINS - SECTOR * SSGAF BSS 1 SSGA ACCESS FLAG SPAR2 BSS 1 SPARE VARIABLE SPAR3 BSS 1 SPARE VARIABLE SPAR4 BSS 1 SPARE VARIABLE SPAR5 BSS 1 SPARE VARIABLE * ½¸þú ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * SEG8 CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 P24 DEC 24 M37 OCT 37 M177 OCT 177 M1000 OCT 1000 M1777 OCT 1777 M7777 OCT 77777 M3777 OCT 37777 M1776 OCT 177776 * LWSBP OCT 1645 * MES64 DEF *+1 ASC 9,PARTITION DRIVERS MESDP DEF *+1 ASC 2,DP DO NOT REARRANGE MESPD NOP THESE ASC 9, <>: LINES MESD1 DEF MESDP+8 SKP * * LOADING CONTROL FOR DRIVER PARTITIONS: * - CHOOSES THE NEXT PARTITION DRIVER TO RELOCATE * - ZERO-FILLS ANY REMAINING DRIVER PARTITION SPACE * - UPDATE DRIVER MAP TABLE ENTRIES WITH CORRECT * PHYSICAL DP PAGE # * * ON ENTRY: * A-REG = -1 IF DRIVER PARTITION #1 IS TO BE RELOCATED * = 0 IF DRIVER PARTITIONS #2 ONWARD ARE TO BE * RELOCATED WITH THE REMAINING PRD'S * \\LDP SSA,RSS JMP DP2ON GO LOAD DRIVER PARTITIONS #2 ... * * RELOCATE DRIVERS INTO DRIVER PARTITION #1 ONLY * ADA \PREL DETERMINE THE LAST WORD OF TA I STA LWTAI AND SAVE FOR COMPUTING SAM#0 IOR M1777 AND ROUND TO THE START OF THE INA NEXT PAG ÊþúE STA DPADD SAVE LOGICAL STARTING ADDRESS OF DP'S JSB CPAG# CONVERT IT TO A PHYSICAL PAGE # AND STA PAGE# FOR UPDATING DVMAP ENTRIES * ADA DPLN ADD # PAGES PER PARTITION STA FPCOM AND SET FIRST COMMON PAGE ALF,ALF MOVE TO CORRECT FORMAT RAL,RAL AS A MEMORY ADDRESS STA LWDP1 AND SAVE AS LAST WORD OF A DP, +1 * LDA SDID GET IDENT INDEX OF SYSTEM DISK DRIVER AND M3777 TO BE RELOCATED STA CIDNT INTO DP #1 CLA SET PROGRAM TYPE STA \PTYP FOR SCDRV/IDSCN STA DPFLG SIGNAL DP RELOCATION MODE JSB \SPAC JSB \SPAC * JMP LOADD NOW LOAD DP #1 * DP1DN LDA LWDP1 SET THE RELOCATION ADDRESS FOR SSGA STA \PREL STA SSGA. AND SAVE FOR MPFT SETTING CCA TURN OFF DP RELOCATION STA DPFLG MODE JMP \DDON RETURN TO LOADING CONTROL IN RT4G3 SKP * * RELOCATE REMAINING PARTITION-RESIDENT DRIVERS INTO DP 'S #2 ONWARD * DP2ON STA \PTYP SET IDENT SCAN TYPE STA DPFLG SIGNAL DP RELOCATION MODE INA NOW SET THE # OF DP'S ALREADY STA DPNUM RELOCATED * LDA P17 SEND LDB MES64 HEADING: JSB SETHD "PARTITION DRIVERS" * * INITIALIZE FOR PARTITION DRIVER LOADING * CCA SET FOR TOP-DOWN LINK STA BPINC ALLOCATION ADA PBREL SAVE LOWEST LINK TO STA BPLMT ALLOCATE(LESS 1) STA HILNK AND HIGHEST SYSTEM LINK ALLOCATED * INA SET BP SCAN ARE TO LOWEST LINK STA \CUBP ABOVE HIGHEST SYSTEM LINK ADA \ADBP AND SAVE ITS RT4GN STA \ICBP IMAGE AREA * LDA LWSBP SET UPPER BP LINK SCAN AREA STA \UCBP BELOW SCOM * CCA ADA LOLNK SET FIRST LINK ADDRESS TO STA PBREL FOLLOW LAST TA-II LINK * CLA CLEA΃þúR SO THE SYSTEM-ONLY LINKS STA \LRBP ON BP WILL NOT STA \URBP BE SHARED * LDA M1000 FIXUP LINKS MUST GO IN STA HIBP HIGH BASE PAGE * * JSB DSKEV FORCE EVEN SECTOR BOUNDARY FOR DP #2 STA DSKDP AND SAVE DISK ADDR OF DP #2 (FOR $SBTB) * LDA LPSLB GET PHYSICAL PAGE # FOLLOWING INA THE SLOW BOOT/SAM #1 STA PAGE# AND SET STARTING PAGE FOR DP #2 * * JMP LOADD NOW LOAD THE DRIVER PARTITIONS * DPDON LDB PAGE# NEXT AVAILABLE PAGE # STB FPMBP IS THE MEMORY RESIDENT BASE PAGE * CMB,INB DETERMINE IF THERE WERE EVEN ADB \NUMP ENOUGH PHYSICAL PAGES SSB FOR THE DRIVER PARTITIONS JMP PGOV NOPE * LDA LPSLB DETERMINE THE # OF PAGES USED CMA BY DP'S #2 ONWARD ADA FPMBP STA DPNUM AND SAVE CCA TURN OFF DP STA DPFLG RELOCATION MODE * JMP \DDON RETURN TO RT4G3 FOR MEMORY RESIDENT LOADING * * PGOV LDA ERR61 SEND ERROR DIAGNOSTIC JSB \IRER NO MORE PHYSICAL PAGES ERR61 ASC 1,61 SKP * * SUBROUTINE LOADD: * LOADS DRIVER PARTITION #1, OR DRIVER PARTITIONS #2 ONWARD * * ON ENTRY THE FOLLOWING HAVE ALREADY BEEN SET UP: * - DPNUM CONTAINS THE # OF DP'S ALREADY BUILT * - BPINC,BPLMT,\CUBP,\ICBP,\UCBP,PBREL,\LRBP,\URBP INITIALIZED * FOR LINK ALLOCATION * - HIBP SET TO ALLOCATE LINKS IN UPPER BASE PAGE * - PAGE# INITIALIZED TO THE PHYSICAL PAGE # OF THE NEXT DP * * LOADD EQU * * * SEARCH FOR A PARTITION-RESIDENT DRIVER * NEWDP JSB SCDRV SCAN IDENTS JMP DPDON NO MORE - DONE WITH DP'S RSS GOT A PRD! JMP NEWDP NO, IT WAS AN SDA DRIVER * * PRINT DP HEADING * SHEAD LDA DPNUM CONVERT CMA PARTITION NUMBER LDB ATBUF TO ASCII JSB \CONV AND ÷ÐþúLDA \TBUF+2 STORE STA MESPD IN MESSAGE LDA PAGE# CONVERT PAGE # CMA,INA TO ASCII DECIMAL LDB MESD1 AND STUFF HERE. JSB \CONV LDA P24 PRINT : LDB MESDP DP XX <>: JSB \MESS PRINT: DP XX: JSB \SPAC * LDA \CBPA RESET THE CP LINK AREA TO "EMPTY" STA \CPL2 LAST CP AREA = LAST BP AREA STA CPLS LAST "SAVE" CP AREA = LAST BP AREA LDA DPADD SET STARTING RELOCATION STA \PREL ADDRESS LDB DPNUM DON'T CHANGE SPECIFICATION SZB MAPS YET IF STILL DP #1 JSB \USRS INITIALIZE \ABDO MAP * * LOAD THE DRIVER INTO THE PARTITION * LPRD LDA \ID3,I GET USAGE WORD CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RESTORE * JSB \DPLD LOAD THE PROGRAM VIA \NLOD (RT4G4) JSB INCAD UPDATE PBREL & \PREL LDB LWDP1 GET LAST LOGICAL WORD ADDRESS CMB,INB OF A DP, AND CHECK FOR OVERFLOW ADB A OF THIS DRIVER'S RELOCATION SSB JMP SCDVM IT FIT, NOW GO UPDATE THE DVMAP ENTRIES * LDA ERR59 IRRECOVERABLE ERROR JSB \IRER SEND DIAGNOSTIC, AND THEN TERMINATE ERR59 ASC 1,59 SEND DRIVER IS TOO LARGE FOR A DP * * * SCAN THE DRIVER MAP TABLE FOR ENTRIES MATCHING * THE CURRENT DRIVER IDENT, AND UPDATE THE ENTRIES * TO THE STARTING PAGE OF ITS PARTITION. * SCDVM STB LEFTO SAVE NEGATIVE # WORDS LEFT IN DP JSB \SYS DVMAP IS IN THE SYSTEM MAP LDB DVMAP GET ITS MEMORY ADDRESS LDA CEQT AND THE NUMBER OF ENTRIES CMA SET A NEGATIVE STA TEMP1 LOOP COUNTER * SCDV1 ISZ TEMP1 BUMP ENTRY COUNTER RSS CONTINUE CHECKING FRO MATCHING IDENTS JMP MORE? DONE WITH THIS DRIVER - FIND NEXT JSB DPRW GET THE CONTENTS OF THE NEXT ENTRY RAL z¦þú CHECK FOR A NON-UPDATED ENTRY SSA,RSS FROM A PRD-DRIVER JMP SCDV1 WAS AN SDA, OR UPDATED PRD AND M7777 CLEAR THE SIGN BIT RAR AND SHIFT BACK TO CORRECT POSITION CPA IMAIN IS THIS FOR THE CURRENT DRIVER? RSS YES, A MATCH JMP SCDV1 NO, CONTINUE THE SCAN * LDA PAGE# ??? GET STARTING PAGE OF THIS PARTITION ADB N1 MOVE BACK TO ENTRY ADDRESS JSB \ABDO AND UPDATE IT JMP SCDV1 LOOK FOR MORE OF THE SAME * * * SEE IF ANOTHER DRIVER WILL FIT INTO THIS PARTITION * MORE? LDA P10 RESET SCAN TO START AT BEGINNING STA CIDNT OF IDENT TABLE MORE1 JSB SCDRV SCAN FOR A PRD JMP ZFIL NO MORE, ZERO-FILL REMAINDER OF DP RSS JMP MORE1 AN SDA - TRY AGAIN * LDA \ID8,I GET THE DRIVER'S MAIN PROGRAM SIZE AND M3777 ADA LEFTO DOES IT FIT INTO DP? SSA,RSS JMP MORE1 NO, TRY FOR ANOTHER * JSB CPL? IF CPL'S IN EFFECT, GET ESTIMATED SIZE JMP MORE1 NOW IT'S TOO BIG, TRY FOR ANOTHER * LDA DPNUM DON'T CHANGE MAPS IF STILL DP #1 SZA JSB \USER RESET CORRECT OUTPUT MAP LDA \ID3,I GET USAGE WORD OF DRIVER CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RE-STORE * LDA \ADSK GET THE CURRENT DISK ADDRESS STA EMDSK AND SAVE IN CASE OF BACKUP *TEMP* JSB \DPLD LOAD THE DRIVER AFTER PREV. ONE IN DP * * DETERMINE IF DP OVERFLOW OCCURRED - IN WHICH CASE BACKUP * MUST BE DONE * LDB LWDP1 GET LAST LOGICAL WORD ADDRESS OF A DP,+1 CMB,INB AND CHECK FOR OVERFLOW OF THIS ADB TPREL DRIVER'S RELOCATION SSB,RSS JMP DPOV TOO BAD! * STB LEFTO SAVE #WORDS STILL LEFT IN THIS DP JSB INCAD UPDATE \PREL & PBREL JMP SCDVM+1 GO FILL IN THIS DRIVER'S DVMAP ENTRIES[þú * * DRIVER PARTITION OVERFLOW * DPOV JSB \SPAC SEND THE WARNING ONLY LDA P26 THAT A DP OVERFLOWED LDB BKUPM NO OPERATOR RECOVERY JSB \MESS * LDA IMAIN MAKE SURE THAT THE STA \TIDN CORRECT IDENT ENTRY JSB \IDX IS IN CORE JSB \ABOR NOT THERE! LDA \ID3,I NOW CLEAR ITS AND M1776 LOAD BITS STA \ID3,I LDA EMDSK RESET THE DISK ADDRESS TO STA \ADSK THE VALUE BEFORE THE DRIVER WAS LOADED JSB CLFIX CLEAR ANY FIXUP ENTRIES CREATED BY IT JMP MORE1 SEE IF ANY OTHER DRIVERS WILL FIT * * * ZERO-FILL THE REMAINDER OF THE DP SINCE NO MORE WILL FIT IN IT * ZFIL LDA DPNUM RESET TO USER'S MAP SZA JSB \USER FOR DP'S #2 ... CCA POSITION TO THE LAST ADA \PREL USED ADDRESS IN THIS DP STA B AND SAVE IOR M1777 ROUND TO LAST WORD ON PAGE CPA B ANY CHANGE? JMP NEXT? NO, SO NO FILL NECESSARY LDB A GET LAST WORD ADDRESS CLA AND ZERO-FILL UP TO AND INCLUDING JSB \ABDO THAT ADDRESS * * INITIALIZE FOR LOADING THE NEXT DRIVER PARTITION * NEXT? LDA DPNUM IF THIS WAS THE FIRST DP SZA,RSS JMP DP1DN THEN WE'RE DONE FOR NOW ISZ DPNUM ELSE BUMP TO THE NEXT DP # * JSB DSKEV FORCE OUTPUT OF LAST SECTOR LDA \PREL GET # WORDS LEFT IN CURRENT CMA,INA DRIVER PARTITION ADA LWDP1 JSB CPAG# AND CONVERT TO THE NUMBER OF AND M37 UNUSED PAGES IN IT CMA,INA AND SUBTRACT FOR DP LENGTH ADA DPLN TO DETERMINE ACTUAL NUMBER ADA PAGE# USED STA PAGE# NOW SET THE STARTING PAGE OF THE NEXT DP * LDA P10 RESET IDENT INDEX FOR STA CIDNT SCAN JMP NEWDP GO START A NEW DRIVER PARTITION * LEFTO NOP BKUPM DEF *+1 ASC 13,DRIVER PAÎ<þúRTITION OVERFLOW P26 DEC 26 SPC 4 * * * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SKP * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTS * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN ä£NLHHNÿÿþú SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TBREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SPC 5 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 N1 DEC -1 SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * LÃþúIDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * CPL? DETERMINES THE SPACE NEEDED BY A DRIVER WITH CURRENT PAGE LINKS * IN EFFECT - AND CHECKS TO SEE IF IT WILL FIT IN THE REMAINDER OF A * DRIVER PARTITION, WHERE LEFTO CONTAINS THE NEGATIVE NUMBER OF WORDS * LEFT IN THE DP. * * RETURN: (P+1) CPL SIZE IS TOO LARGE FOR LEFTO * (P+2) THIS DRIVER WILL FIT IN THE DP * CPL? NOP LDB \ID5,I DOES THE USET WANT SSB,RSS CURRENT PAGE LINKS? JMP CPLX NO, TAKE SUCCESS RETURN * LDA \PREL GET ADDRESS STA B OF THE LAST WORD IOR M1777 OF THE PAGE CMB,INB COMPUTE THE INB NUMBER OF WORDS ADB A REMAINING ON STB TEMP2 THE PAGE * LDA \ID8,I COMPUTE THE # OF AND M3777 WORDS OF STA TEMP3 CMB,INB THE PROGRAM ADB A THAT FALL STB TEMP1 BEYOND THIS PAGE * SSB WILL THE PROGRAM RSS FIT ON THIS PAGE? SZB,RSS NO - SKIP JMP CPLX YES, SO NEEDN'T WORRY ABOUT CPL'S * LDA TEMP2 COÇ$ MPUTE MINIMUM OF: ARS HALF # OF WORDS OF PROG CMB,INB ON CURRENT PAGE -OR- ADB A # OF WORDS OF PROG ON SSB,RSS NEXT PAGE * LDA TEMP1 DIVIDE THIS CLB MINIMUM DIV P4 BY FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP CPLX OF LOW CURRENT PG LINK AREA * ADA TEMP3 ADD PROGRAM SIZE ADA LEFTO AND NEGATIVE # OF WORDS LEFT SSA,RSS IN DP JMP CPL?,I WON'T FIT * CPLX ISZ CPL? BUMP RETURN ADDRESS TO INDICATE JMP CPL?,I THAT DRIVER WILL FIT - EXCLUDING LIBR RTNS * TEMP3 NOP P4 DEC 4 SKP * * CLFIX CLEARS ANY FIXUP ENTRIES BUILT BY A RELOCATED * DRIVER THAT HAS OVERFLOWED THE DRIVER PARTITION * (AND WILL THEREFORE BE RELOCATED INTO ANOTHER DP). * CLFIX NOP JSB \IFIX INITIALIZE THE FIXUP TABLE CLFX1 JSB \FIX SET ADDRESSES OF NEXT ENTRY JMP CLFIX,I END OF LIST * LDA \FIX1,I IS THIS ENTRY FREE? SSA JMP CLFX1 YES * LDB \PREL SEE IF THE ENTRY WAS BUILT CMB,INB BY AN OVERFLOWD DRIVER -CHECK ADA B ITS INSTR. ADDRESS AGAINST THE LAST SSA VALID DP RELOCATION ADDRESS JMP CLFX1 NO - ENTRY IS OK TO LEAVE * CCA CLEAR ENTRY BUILT BY STA \FIX1,I OVERFLOWED DRIVER JMP CLFX1 CONTINUE UNTIL END OF LIST * * * END SEG8 —òÿÿ ÿý " ÿ92067-18324 2013 S C0122 &.OWNR              H0101 †{þúASMB,R,L,C,Q * NAME: .OWNR * SOURCE: 92067-18324 * RELPC: 92067-16268 * PGMR: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .OWNR,7 92067-1X324 REV.2013 780919 * * * ENT .OWNR * EXT ISMVE,$SMID,$SMII,.ZPRV * * SUP SKP * * * CALLING SEQUENCE: JSB .OWNR * * RETURN (A)=OWNER FLAG FOR THIS SESSION * * * .OWNR NOP JSB .ZPRV DEF LIBX LDB XEQT FETCH ID ADB D32 ADDR OF SESSION WORD XLB B,I THEN CONTENTS OF SAME SSB,RSS IF NOT SZB,RSS SESSION JMP NSES RETURN, ID=0 * STB TMP0 SAVE SESSION WORD * * * CHECK TO SEE IF THIS IS THE SYSTEM MANAGER CALLING. * * IF IT IS, RETURN AN ID OF ZERO TO INDICATE THAT THE PROGRAM * BELONGS TO THE SYSTEM, NOT THE SESSION. * * JSB ISMVE DEF ISM1 DEF TMP0 READ FROM LOCATION DEFINED BY TMP0 DEF $SMID WITH AN OFFSET BACK TO PRIVATE DISC ID DEF TMP1 PLACE THE RESULT HERE DEF D1 MOVE ONE WORD ISM1 EQU * * LDA TMP1 FETCH PRIVATE ID CPA B7777 IF SYSTEM MANAGER JMP NSES RETURN ID=0 SO LGOFF WON'T PURGE THE ID. * * * * NOT SYSTEM MANAGER SO GET SESSION ID FOR THIS SESSION * * JSB ISMVE DEF ISM2 DEF TMP0 SESSION WORD DEF $SMII SESSION ID OFFSET DEF TMP0 PLACE RESULT HERE DEF D1 ISM2 EQU * * LDA TMP0 FETCH THE ID AND B377 ISOLATE IT RSS GET OUT * * Bõ  NSES CLA ID=0 LIBX JMP .OWNR,I DEF .OWNR * * * TMP0 NOP TMP1 NOP XEQT EQU 1717B D1 DEC 1 D32 DEC 32 B7777 OCT 7777 B377 OCT 377 B EQU 1 END Í ÿÿ ÿý  ÿ92067-18325 1903 S C0122 &SWTCH              H0101 ‚œþúASMB,Q,R,C HED SWTCH - TRANSFERS FILE CONTAINING RTE-IV SYSTEM GENERATED ONLINE NAM SWTCH,3,10 92067-16325 REV.1903 790418 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWTCH * SOURCE: 92067-18325 * BINARY: 92067-16325 * WRITTEN BY: KFH * **************************************** SPC 2 * * TURN - ON SEQUENCE: * * RU,SWTCH,FLNAME:SC:LB,CHANNEL,SUBCHANNEL/UNIT,AUTO,FILES,TYPE6,INITS * * WHERE: * * FLNAME:SC:LB IS THE ABSOLUTE FILE NAME OF THE SYSTEM * CHANNEL IS THE OCTAL TARGET CHANNEL, WITH A "B" APPENDED * SUBCHANNEL IS THE TARGET 7900 SUBCHANNEL * OR * UNIT IS THE TARGET 7905/7920 UNIT * AUTO IS Y/N, FOR AUTO BOOT-UP * FILES IS Y/N, FOR SAVING THE TARGET FILE SYSTEM * TYPE6 IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET * INITS IS Y/N, FOR INITIALIZING ANY ADDITIONAL SUBCHANNELS SPC 2 * * * THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CONTAINING * A COMPLETE RTE-IV+ SYSTEM FOR A SPECIFIC CONFIGURATION. * SWTCH COPIES THE FILE ONTO THAT CHANNEL AND SUBCHANNEL(UNIT), OR * TO A USER-SPECIFIED 'TEMPORARY' CHANNEL AND SUBCHANNEL(UNIT). * AND BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, * THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION, * INCLUDING THE SYSTEM SUBCHANNEL DEFINITION. * * IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW * FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN * INTO THE FMP CARTRIDGE DIRECTORY SB—þúO THAT ON BOOTUP, FMP * WILL REMAIN INTACT (INITIALIZED). SKP * ENTRY POINTS * ENT SWTCH * ENT \SWTM ENT \DFTR,\DSHD,\DNSU,\DNSP,\DNTR,\DSUB ENT \TUNT,\TCH,\TSUB,\DUNT,\D#ST,\D#WT ENT \INIT,\LNTH ENT \BUFA,\XOUT,\SAVE ENT \TRAK,\SECT ENT \CVAS,\CLEN,\DSPL,\BLIN ENT \FFMP,\STRK ENT \BOOT,\TMT,\LU2 * * EXTERNAL ENTRY POINTS * EXT RMPAR,EXEC,$LIBR EXT OPEN,READF,LOCF,CLOSE,$BMON EXT $LIBR,$LIBX * EXT \DSK0,\DSK5 EXT \INP0,\INP5 EXT \INT0,\INT5 EXT \STD0,\STD5 EXT CNUMD,GETST EXT \FLGT,\SETD,\BADH * SPC 2 A EQU 0 B EQU 1 SUP SKP * HEADER RECORD #2 FORMAT * * . * . * . * * ------------------------------------ * ! 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ! INDICATES AN RTE-IV+ * ------------------------------------ * 59 ! SYSTEM SUBCHANNEL # ! * ------------------------------------ * 60 ! SYSTEM EQT # ! * ------------------------------------ * 61 ! NUMBER OF EQT'S ! * ------------------------------------ * 62 ! PRIV. INT. CHANNEL ! * ------------------------------------ * 63 ! TBG CHANNEL ! * ------------------------------------ * 64 ! # SUBCHANNELS ! TTY CHANNEL ! * ------------------------------------ * 65 ! CHANNEL # ! EQT TYPE ! FOR EQT #1 * ------------------------------------ * . . * . . * . . * ------------------------------------ * 127 ! CHANNEL # ! EQT TYPE ! FOR EQTÕWþú #64 * ------------------------------------ SKP * HEADER RECORD #1 FORMAT * * FOR A 7905/6/20/25 SYSTEM: * * ------------------------------------ * ! # 64-WORD SECTORS/TRACK ! * ------------------------------------ * ! FIRST CYLINDER # ! ONE 5-WORD * ------------------------------------ * ! # SUFACES ! STARTING HEAD ! UNIT ! ENTRY FOR * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNELS * ------------------------------------ * ! NUMBER OF SPARES ! 0 THRU 31 * ------------------------------------ * * FOR A 7900 SYSTEM: * * ------------------------------------ * ! FIRST TRACK # ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 SKP SPC 4 *------------------------------------------------------------------------ * * THE FOLLOWING 8192 WORDS WILL BE OVERLAID * ONCE THE TRANSFER PROCESS BEGINS. BUFR * WILL CONTAIN ONE TRACK'S WORTH OF INFO. * *------------------------------------------------------------------------ SPC 4 BUFR BSS 128 BUFFER FOR 1 FULL TRACK (6144 WORDS) * * MES1 DEF *+1 ASC 22, ****** W A R N I N G ****** MES2 DEF *+1 ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM ASC 9,TRANSFER PROCESS. SP¹ÿþúC 2 BSS 384+BUFR-* NEED TO READ IN 3 RECORDS AT VERF1 SPC 2 MES3 DEF *+1 ASC 14,FILE NAME OF NEW RTE SYSTEM? MES4 DEF *+1 ASC 9,ILLEGAL FILE NAME MES5 DEF *+1 ASC 15,NEW SYSTEM I/O CONFIGURATION: MES6 DEF *+1 ASC 18,SELECT CODE XX PRIVILEGED INTERRUPT MES6A DEF MES6+7 MES7 DEF *+1 ASC 9,SELECT CODE XX TBG MES7A DEF MES7+7 MES8 DEF *+1 ASC 11,SELECT CODE XX TYPE=XX MES8A DEF MES8+7 MES8B DEF MES8+11 MES9 DEF *+1 ASC 24,NEW SYSTEM (LU2) SELECT CODE= XX SUBCHANNEL= XX MES9A DEF MES9+16 MES9B DEF MES9+24 MES10 DEF *+1 ASC 12,PLATTER XX FIRST TRACK# MS10A ASC 9,XXXX #TRACKS XXXX MS10C DEF MS10A MS10D DEF MS10A+7 MES12 DEF *+1 ASC 25,TARGET SELECT CODE FOR NEW SYSTEM? (XX OR " "CR) MES13 DEF *+1 ASC 14,TARGET PLATTER/UNIT FOR NEW ASC 11,SYSTEM? (X OR " "CR) MES16 DEF *+1 ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN MES17 DEF *+1 ASC 21,TARGET PLATTER/UNIT. (" "CR TO CONTINUE) MES18 DEF *+1 ASC 16,SAVE FILES AT TARGET? (Y OR N) MES19 DEF *+1 ASC 19,NEW SYSTEM WILL DESTROY SOME FMP FILES MES20 DEF *+1 ASC 12,OK TO PROCEED? (Y OR N) MES22 DEF *+1 ASC 15,PURGE TYPE 6 FILES? (Y OR N) MES23 DEF *+1 ASC 19, INFORMATION STORED ON PLATTER/UNIT XX ASC 14, OF TARGET SELECT CODE XX MS23B DEF *+1 ASC 9, WILL BE DESTROYED MS23A DEF MES23+32 MES24 DEF *+1 ASC 12,AUTO BOOT-UP? (Y OR N) MES25 DEF *+1 ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. MES26 DEF *+1 ASC 22,SYSTEM WILL HALT AFTER TRANSFER COMPLETION. MES32 DEF *+1 ASC 17,READY TO TRANSFER. OK TO PROCEED? MES34 DEF *+1 ASC 18,INITIALIZE SUBCHANNELS ? (Y OR N) MS34A DEF MES34+12 "L" ASC 1,L MES35 DEF *+1 ASC 15,TARGET PLATTER? (XX OR " "CR) MES36 DEF *+1 ASC 16,TARGET UNIT XX FOR SUBCHANNELS MS36A ASC 24, ASC 20, ASC 24, árþú COMBL ASC 1,, MS36B DEF MS36A MES37 DEF *+1 ASC 16,DESTN. UNIT XX FOR SUBCHANNELS MS37A ASC 24, ASC 20, ASC 24, MS37B DEF MS37A MES38 DEF *+1 ASC 14,TARGET UNIT? (XX OR " "CR) MES40 DEF *+1 ASC 17,#TRACKS FIRST CYL MS40A DEF MES40+6 MS40B DEF MES40+16 MES41 DEF *+1 ASC 17,HEAD # #SURFACES MS41A DEF MES41+6 MS41B DEF MES41+16 MES42 DEF *+1 ASC 17,UNIT/ADD #SPARES MS42A DEF MES42+6 MS42B DEF MES42+16 MES43 DEF *+1 ASC 17,#SECTORS/TRACK MS43B DEF MES43+16 * SWAP0 DEF *+1 ASC 3,SWSG1 7900 DISK DRIVER SEGMENT SWAP5 DEF *+1 ASC 3,SWSG2 7905/7920 DISK DRIVER SEGMENT SKP * CONSTANTS * B177 OCT 177 B777 OCT 777 B1774 OCT 177400 B2060 OCT 20060 * N7 DEC -7 N31 DEC -31 N64 DEC -64 N89 DEC -89 * P12 DEC 12 P14 DEC 14 P17 DEC 17 P28 DEC 28 P98 DEC 98 P161 DEC 161 P512 DEC 512 * * #LEP EQU 1762B # OF LIBRARY ENTRY POINTS IN LIST ALEP EQU 1761B ADDR " " " LIST LEPL NOP LENGTH " " " " LCNT NOP COUNTER $T ASC 1,$T B3 ASC 1,B3 .2 ASC 1,2 TMTSF OCT 2202 SKP * * GTLEN COMPUTES LLEN FOR READING THE * LIBRARY ENTRY POINTS LIST INTO * BUFR * * CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. * JSB GTLEN * GTLEN NOP LDB P512 THE NORMAL BUFFER SIZE CMA,INA IF MORE THAN THE REMAINING ADA P512 LEP SIZE, THEN USE THE SIZE SSA,RSS IN (A) LDB LEPL STB LLEN JMP GTLEN,I SPC 5 * * READD READS LLEN WORDS AT TRACK LTRK, AND * SECTOR LSEC * READD NOP JSB EXEC DEF *+7 DEF P1 DEF P2 DEF BUFR DEF LLEN DEF LTRK DEF LSEC * JMP READD,I * * LTRK NOP LSEC NOP SKP * * VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH ®?þú* AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING * CHECKS ARE MADE: * * VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE * LAST SYSTEM TRACK (AS DEFINED BY THE NEW * SYSTEM) * OR VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY * EXISTS ON THIS TRACK * * * RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE * (P+2) CAN SAVE IT * VFYSY NOP CLA STA \INIT CLEAR INIT WORD FOR DISKD * LDA N128 STA \LNTH READ 128 WORDS CCE HOPEFULLY THEY WILL CONTAIN LDB \BUFA THE DIRECTORY AT STB BPTR TARGET SUBCHANNEL CCA ADA \DNTR DESTINATION SYSTEM LAST(LOGICAL) STA \TRAK TRACK, LESS 1 CLA STA \SECT JSB DISKD * * * VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY * LDA N31 MAX # CARTRIDGE ENTRIES STA TEMP1 CHCD0 LDA BPTR,I GET WORD 0 OF ENTRY SSA JMP NEWFD LU WORD < 0 LDB N64 ADB A SSB,RSS JMP NEWFD LU > 77(8) * CPA P0 END OF LU'S ? JMP CHCD3 YES CPA P2 LU 2 (SYSTEM) ? RSS YES JMP CHCD1 CHECK WORDS 1-3 IN ENTRY * LDB BPTR GET WORD #1 OF THE (POSSIBLY) INB SYSTEM LU 2 ENTRY LDA B,I SSA JMP NEWFD LAST FMP TRACK WORD < 0 STA D.LT SAVE FOR LATER CHECKS * CHCD1 LDA N3 STA TEMP2 * CHCD2 ISZ BPTR CHECK WORDS 1,2,&3 LDA BPTR,I OF ENTRY FOR VALUES SSA >= 0 JMP NEWFD INVALID ISZ TEMP2 JMP CHCD2 CHECK NEXT WORD ISZ BPTR NEXT ENTRY WORD 0 ISZ TEMP1 LAST ENTRY (31)? JMP CHCD0 NO,CONTINUE * * POSSIBLY A NEW FILE DIRECTORY FORMAT: CARTRIDGE DIRECTORY * IS AT END OF OP SYSTEM * NEWFD LDB \BUFA RESET BUFFER POINTER STB BPTR TO CHECK FOR FD AT IS6þúZ D.LT BEGINNING OF DIRECTORY TRACK NOP SET D.LT TO 0 TO INDICATE ISZ OLDNU A POTENTIAL NEW FORMAT JMP CHFD0 CHECK FOR FD * CHCD3 LDA D.LT (WAS INITIALLY -1) SSA JMP NEWFD NEVER SET BY A LU 2 LDA BF124 SZA JMP NEWFD WORD 124 OF CD MUST = 0 * * * LOOKED LIKE A CARTRIDGE DIRECTORY. NOW TRY FOR A * FILE DIRECTORY IN THE NEXT BLOCK. * CCA ADA \DNTR DETERMINE DISK ADDRESS OF NEXT STA \TRAK BLOCK CONTAINING THE LDA P14 FILE SPEC ENTRY STA \SECT READ 128 WORDS, HOPEFULLY THE LDB \BUFA SPEC ENTRY STB BPTR CCE JSB DISKD * CHFD0 LDA BPTR,I TESTS FOR A VALID FILE DIRECTORY ENTRY: SSA,RSS JMP NOTFS WORD 0 MUST BE < 0 * LDA N7 WORDS 1-7,9-15 IN SPEC MUST BE >= 0 STA TEMP2 CHFD1 ISZ BPTR LDA BPTR,I SSA JMP NOTFS < 0, THEREFORE INVALID ISZ TEMP2 JMP CHFD1 * ISZ BPTR WORD 8 MUST BE < 0 LDA BPTR,I SSA,RSS JMP NOTFS LDA N6 NOW CHECK WORDS 9-15 STA TEMP2 CHFD2 ISZ BPTR LDA BPTR,I SSA JMP NOTFS ISZ TEMP2 JMP CHFD2 * LDA BF6 WORD 6 (#SECTORS/TRACK) MUST BE CPA \D#ST SAME AS DESTINATION SYSTEM RSS JMP NOTFS AND LDB BF5 >= WORD 5 (NEXT AVAILABLE SECTOR) CMB,INB ADA B SSA JMP NOTFS INVALID * LDA BF7 LOWEST DIRECTORY TRACK(LOGICAL) LDB BF8 MINUS THE NEGATIVE # DIRECTORY STB D.# TRACKS, CMB MINUS 1 ADA B GIVES LAST FMP TRACK CPA D.LT MUST = LAST FMP TRACK INDICATED JMP CHFD3 IN CD FOR LU 2 LDB D.LT ELSE NONE FOUND AT ALL SZB JMP NOTFS NEITHER STA D.LT OTHERWISE UPDATE LAST FMP TRACK * CH$IþúFD3 LDB \DNTR DOES THE LOGICAL DIRECTORY TRACK # ADB N1 AT TARGET = LOGICAL DIRECTORY TRACK # CPA B FOR DESTINATION (THE LAST LOGICAL TRACK FOR RSS SYSTEM LU) ? JMP NOTFS NO LDA BF4 SAVE THE FIRST FMP TRACK FOR STA \FFMP FUTURE CHECKS * * SET UP SOME VALUES FOR SCANNING THE DIRECTORY * ENTRIES LATER - ESPECIALLY WHEN PURGING OVERLAID FILES * OR TYPE 6 FILES * LDA OLDNU GET THE FLAG TO INDICATE THE DIFFERENCES LDB \D#ST DETERMINE # OF 16-WORD RBL,RBL ENTRIES PER TRACK SZA,RSS OLD VERSION ADB N8 HAS 8 LESS CUZ OF CD CMB,INB COMPLEMENT STB FDT#E NUMBER TO SCAN ON FIRST TRACK LDB P4 NOW DETERMINE THE WORD 4 OFFSET SZA,RSS IN THE FILE SPEC'N ENTRY ADB P896 BEGINNING OF SECOND BLOCK FOR OLD ADB \BUFA ADD BUFFER ADDRESS STB FDOFF AND SAVE LDB \BUFA NOW THE OFFSET FOR THE FIRST SZA,RSS DIRECTORY ENTRY (OK TO ADB P128 SCAN THE SPEC'N ENTRY) STB FIRDE LDA \D#WT NOW SET A POINTER TO THE ADA \BUFA LAST WORD+1 IN THE DIRECTORY STA DTEND TRACK BUFFER * ISZ VFYSY LOOKS VALID JMP VFYSY,I * P896 DEC 896 SPC 2 * * ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE * TARGET FILE STRUCTURE TO BE SAVED * NOTFS LDA \TSUB LDB DEQT SLB,RSS LDA \TUNT ADA B2060 STA MES23+19 LDA P1 SET FO \CVAS STA \CLEN LDA \TCH LDB MS23A JSB \CVAS LDA P33 LDB MES23 "INFORMATION STORED ON PLATTER UNIT XX OF JSB \DSPL TARGET CHANNEL YY WILL BE DESTROYED" LDA P9 LDB MS23B JSB \DSPL * JSB OK? CHECK ANSWER * CLA STA \SAVE DON'T \SAVEFILES STA TYP6 " " PURGE TYPE 6'S ÿþú JMP VFYSY,I * P33 DEC 33 * BF4 EQU BUFR+4 BF5 EQU BUFR+5 BF6 EQU BUFR+6 BF7 EQU BUFR+7 BF8 EQU BUFR+8 BF124 EQU BUFR+124 SKP * VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP * IN HEADER RECORD #3 * * * RETURN: (P+1) NOT A BOOTSTRAP * (P+2) YES, ONE EXISTS * VT0S0 NOP * LDB BPTR ADB B155 COMPARE WORDS: LDA B,I CPA WD155 WORD 155 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD156 WORD 156 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD157 WORD 157 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD160 WORD 160 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD161 WORD 161 INB,RSS JMP VT0S0,I NO INB SKIP WORD 162 LDA B,I CPA WD163 WORD 163 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD164 WORD 164 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD165 WORD 165 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD166 WORD 166 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD167 WORD 167 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD170 WORD 170 RSS JMP VT0S0,I NO ISZ VT0S0 FOUND ONE JMP VT0S0,I SO EXIT * SPC 2 WD155 OCT 000000 " WORD 155 WD156 OCT 102106 " WORD 156 WD157 OCT 107700 " WORD 157 WD160 OCT 006400 " WORD 160 WD161 OCT 102501 " WORD 161 WD163 OCT 101045 " WORD 163 WD164 OCT 002011 " WORD 164 WD165 OCT 026201 " WORD 165 WD166 OCT 102077 " WORD 166 WD167 OCT 026202 " WORD 167 WD170 OCT 106601 " WORD 170 * B155 OCT 155 SKP * * STDSK CONTROLS THE CALL TO CONFIGURE THE * DISK DRIVER (EITHER \DSK0 FOR 7900 OR \DSK5 * FOR 7905/¤†þú7920), VIA A CALL TO \STD0 OR \STD5 * STDSK NOP LDA DEQT SLA JMP STDS1 JSB \STD5 CONFIGURE THE 7905/7920 DRIVER JMP STDSK,I * STDS1 JSB \STD0 CONFIGURE THE 7900 DRIVER JMP STDSK,I SKP * OK? QUERIES THE USER WITH: * "OK TO PROCEED? (Y OR N)" * AND TRANSFERS TO \XOUT ON A "N" RESPONSE, * DOING A SIMPLE RETURN ON A "Y" RESPONSE. * OK? NOP LDA P12 LDB MES20 JSB \DSPL JSB YE?NO DECIPHER ANSWER JMP OK?+1 INVALID REPLY JMP OK?+1 INVALID REPLY JMP \XOUT NO,TERMINATE SWTCH JMP OK?,I SPC 4 * YE?NO READS THE OPERATOR ANSWER ( Y OR N ) * RETURNS TO (P+1) IF INVALID ANSWER * (P+2) IF /E * (P+3) IF NO * (P+4) IF YES * YE?NO NOP JSB EXEC RETRIEVE ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N2 SZB,RSS JMP YE?NO+1 TRY AGAIN FOR A RESPONSE * CLE CHECK HIGH HALF FIRST LDA BUFR CPA "/E" JMP EOUT YENO ALF,ALF AND B377 CPA "N" JMP NOUT CPA "Y" JMP YOUT * SEZ CHECK THE LOW HALF? JMP YE?NO,I ALREADY DID - NEITHER MATCHES LDA BUFR SWITCH EM ALF,ALF CCE JMP YENO CHECK THE LOW HALF * YOUT ISZ YE?NO NOUT ISZ YE?NO EOUT ISZ YE?NO JMP YE?NO,I * "N" OCT 116 "Y" OCT 131 "/E" ASC 1,/E SPC 4 * * READS TARGET RESPONSES, INCLUDING RE-ISSUING EXEC CALL * IN CASE OF TIME-OUTS. * TARGT NOP JSB EXEC GET REPONSE DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N8 SZB,RSS ANYTHING ENTERED? JMP TARGT+1 NO JMP TARGT,I YES, RETURN SKP * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. (B) IS THE LENGTH OF INPUT IN CHARACTERS * qþú RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * DFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP DFLT,I NO, SO DON'T BOTHER CHECKING LDA BUFR AND B1774 CPA LBLNK ISZ DFLT GOT ONE JMP DFLT,I * LBLNK OCT 20000 SKP * * PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) * PRODUCES A PARAMETER BUFFER 12 WORDS LONG * * THE TWELVE WORDS ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 8 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR : P1 : P2 , P3 , P4 , P5 , P6 , P7 , P8 * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 14,15 * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH " * WORD 11 = 7TH " * WORD 12 = 8TH " SPC 2 * * WHERE: * DNAME = TWELVE WORD DESTINATION PARAMETER BUFFER ADDRESS * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "PARMP" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSEDÒ²þú AS A VARIABLE (NOT A CONSTANT) FROM CALLER. * SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 INBUF NOP INPUT BUFFER ADDRESS PARML NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF * PARMP NOP CCA SET TO NO COMMAS STA FRSTC CLA,INA STA ISTRC SET FIRST CHAR LDB \BUFA STB INBUF INPUT BUFFER ADDRESS LDB DNAME STB BPTR NOW CLEAR OUT DEST BUFFER LDA N12 GET DEST BUFFER LENGTH STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 STA WORD4,I INITIALIZE THE TYPE WORD STA FILEW AND THE FILE FLAG LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB PARML GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DI\DN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - PARML -1 CCA,SEZ TEST E FOR ERROR JMP PARMP,I RETURN A= -1 FOR ERROR LDA BPTR GET DESTINATION BUFFER LDB A ADB P3 SET ADDRESS OF TYPE WORD STB BPTR AND BUFFER POINTER LDB P3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER STA FILEW AND SAVE FILE TYPE(IF ANY) LDB FRSTC WAS A COMMA ENCOUNTERED SZB JMP MORE0 NO RAR,RAR YES, SKIP APPROPRIATE RAR,RAR POSITIONS IN WORD4,I STA WORD4,I FOR P1 AND P2 ISZ BPTR AND UPDATE DESTINATION ISZ BPTR POINTER JMP MORE1 MORE0 LDB N2 SET TO GET THE NEXT 2 PAž¯þúRAMETERS AFTER: STB SUBCT ISZ BPTR LDA BPTR CLB,INB JSB SCAN IOR WORD4,I SET BITS FOR SECURITY CODE (FIRST TIME THRU), RAR,RAR OR LABEL PARAMETER(SECOND TIME THRU) STA WORD4,I ISZ SUBCT RSS JMP MORE1 LDB FRSTC GOT A COMMA AFTER ONLY ONE COLON? SZB JMP MORE0+2 NO, A SECOND COLON ISZ BPTR UPDATE DESTINATION POINTER RAR,RAR AND TYPE BITS FOR NULL PARAMETER P2 STA WORD4,I MORE1 LDB N6 NOW SCAN FOR NEXT 6 SUB-PARAMS STB SUBCT MORE2 ISZ BPTR LDA BPTR GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM IOR WORD4,I MERGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL EIGHT? JMP MORE2 NO, CONTINUE JMP PARMP,I SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+PARML SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+PARML = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU PARML ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *- AD˜îþúB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA FSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINUS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR CHARACTER AMORE STB FSTCA SAVE THE 1ST CHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP INCOM CHECK FOR FIRST COMMA CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER ISZ Q0þúISTAR ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECK IT SPC 2 INCOM ISZ FRSTC FIRST COMMA? NOP NO SPC 2 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERSION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, RETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER SPC 1 MMORE MPY BASE1 TRY CONVERSION STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA P3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS CLE,S9þúELB FORM CHARACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 FRSTC DEC -1 FIRST COMMA NOT IN YET O10 OCT 10 D10 DEC 10 SUBCT NOP HOLDS SUB-PARAM. COUNTER N12 DEC -12 SPC 4 WORD4 DEF *+5 ADDRESS FOR TYPE WORD DNAME DEF *+1 NAME BSS 3 FOR FILE NAME BSS 1 TYPE WORD BSS 8 ãÜþú PARAMETERS 1-8 ISECU EQU NAME+4 ICR EQU NAME+5 PARM3 EQU NAME+6 PARM4 EQU NAME+7 PARM5 EQU NAME+8 PARM6 EQU NAME+9 PARM7 EQU NAME+10 PARM8 EQU NAME+11 APARM EQU NAME FILEW NOP SKP * PYN - CHECKS FOR A "Y" OR "N" TURN-ON PARAMTER * A-REG = THE PARAMETER * B-REG = PRESENT STATE OF WORD 4,I * * RETURN:(P+1) NEITHER, OR NOT SPECIFIED * (P+2) GOT ONE, A-REG = 0 FOR NO, =1 FOR YES * PYN NOP STA TEMP1 SAVE THE PARAMETER RBR,RBR NEXT WORD4 POSITION SLB,RSS IS THIS PARAMETER SPECIFIED? JMP PYN,I NO * LDA B AND P3 CPA P3 ASCII? RSS JMP PYN,I NO STB TEMP2 SAVE CCB LDA TEMP1 ALF,ALF SHIFT TO LOW AND B377 CPA "N" CLB CPA "Y" CLB,INB SSB,RSS ISZ PYN MATCH SSB,RSS ISZ BATCH ONE MORE FOUND NOP LDA B RESTORE LDB TEMP2 JMP PYN,I SPC 3 B400 OCT 400 N72 DEC -72 P384 DEC 384 "!!" ASC 1,!! CLER2 OCT 177773 P192 DEC 192 P160 DEC 160 SKP * * * MAINLINE CODE FOR SWTCH * * THE PRECEDING CODE AND THE CODE UP TO BFULL IS OVERLAID * WHEN THE TRANSFER IS BEGUN * SWTCH NOP STB APARM JSB RMPAR DEF *+2 DEF APARM * * * SET UP THE OPERATOR'S LU * LDA APARM GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ APARM NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? JMP *+3 NO,ASCII - USE DEFAULT LU 1 LDA APARM STA OPLU SET THE LU * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * LDA SYSTY GET I-O CHANNEL ADA P3 OF SYSTEM CONSOLE LDA A,I AND B77 STA HTTY * JSB \BLIN LDA P22 DISPLAY WARNING MESSAGES. LDB MES1 JS¹©þúB \DSPL LDA P32 LDB MES2 JSB \DSPL * * * PARSE THE TURN-ON PARAMETERS * JSB GETST GET THE PARAMETER STRING DEF *+4 DEF BUFR DEF P48 DEF ERR * PARS SZB,RSS ANY THERE? JMP GTNAM NO RBL CONVERT TO CHARACTERS STB PARML SAVE # CHARACTERS JSB PARMP GO PARSE THEM CPA N1 JMP GTNAM COUL\DN'T * * RETRIEVE CHANNEL PARAMETER * LDB WORD4,I GET THE TYPE WORD INTO B SZB,RSS LDB FILEW FILE NAME ONLY SPECIFIED? SZB,RSS JMP GTNAM NO PARAMTERS BLF,BLF SWAP HIGH AND LOW BLF SLB,RSS CHECK BITS 5-4 JMP CP2 NOT SPECIFIED LDA B AND P3 CHECK TYPE CPA P1 RSS JMP CP2 NOT AN INTEGER LDA PARM3 STA \TCH GOT ONE - CHECK IT'S RANGE LATER ISZ BATCH * * RETRIEVE THE SUBCHANNEL/UNIT CP2 RBR,RBR GET BITS 7-6 TO LOW SLB,RSS JMP CP3 NOT SPECIFIED LDA B AND P3 CPA P1 MUST BE AN INTEGER RSS JMP CP3 NOT ONE LDA PARM4 STA \TSUB SAVE IT ISZ BATCH * * RETRIEVE PARAMETERS 5, 6, 7, AND 8 CP3 LDA PARM5 JSB PYN CHECK BITS 9-8 RSS NO GOOD STA AUTO LDA PARM6 JSB PYN CHECK BITS 11-10 RSS NO GOOD STA \SAVE LDA PARM7 JSB PYN CHECK BITS 13-12 RSS NO GOOD STA TYP6 LDA PARM8 JSB PYN CHECK BITS 15-14 RSS NO GOOD STA SUBI * LDA FILEW GET FILE TYPE CPA P3 ASCII FILE NAME? ISZ BATCH YES, NOP * CPA P3 FILE NAME? JMP VERIF YES, GO VERIFY IT GTNAM JSB \BLIN NO. LDA P14 LDB MES3 JSB \DSPL ASK FOR FILE NAME, SECUR, LABEL. * READN JSB EXEC &þú READ INPUT. DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N72 * SZB,RSS JMP READN TRY AGAIN FOR RESPONSE STB PARML POSITIVE # CHARACTERS. * LDA BUFR WANT TO EXIT? CPA "!!" CHECK FOR !! JMP \XOUT YES * JSB PARMP PARSE THE STRING. SSA JMP GTNAM TRY AGAIN * VERIF JSB OPEN OPEN THE FILE. DEF *+7 DEF DCB DEF ERR DEF NAME DEF P0 DEF ISECU DEF ICR * SSA,RSS OPEN ERROR? JMP VERF1 NO. * ERRV LDA P9 YES. DISPLAY MSG AND RE-TRY. LDB MES4 JSB \DSPL JSB CLOSE DEF *+3 DEF DCB DEF ERR JMP GTNAM * VERF1 CPA P1 TYPE 1 FILE? JMP READH JMP ERRV NO * READH JSB READF READ FIRST THREE RECORDS. DEF *+5 DEF DCB DEF ERR DEF BUFR DEF P384 * SSA READ ERROR? JMP ERRV YES. * LDB \BUFA DOES THIRD RECORD LOOK LIKE ADB P256 STB BPTR A TRACK 0, SECTOR 0 BOOTSTRAP? JSB VT0S0 VERIFY IT JMP ERRV NOT ONE * * LDA DCB+5 SAVE FILE SIZE. ARS ADA N2 LESS TWO FOR HEADER RECORDS STA SIZE # 128-WORD SECTORS. * LDA DCB+9 SAVE DCB CONTENTS STA TEMP1 JSB CLOSE BEFORE CLOSING THE DEF *+3 ABSOLUTE OUTPUT FILE DEF DCB VIA FMP DEF ERR LDA TEMP1 NOW FUDGE THE DCB IN ORDER STA DCB+9 KEEP IT OPEN CLA CLEAR THE IN-BUFFER FLAGS STA DCB+13 (OLD DCB FORMAT) LDA DCB+7 AND CLER2 =177773 STA DCB+7 (NEW DCB FORMAT) SKP * * PROCESS HEADER RECORD * LDA BUFR+186 GET NEW SYSTEM INFO CPA N1 CHECK TYPE RSS JMP ERRV NOT AN RTE-IV+ SYSTEM LDA BUFR+187–Àþú STA \DSUB DESTINATION SUBCHANNEL LDA BUFR+189 STA #EQTS # EQT'S IN SYSTEM LDA BUFR+190 STA DPI DESTINATION PRIVILEGED INTERRUPT LDA BUFR+191 STA DTBG " TBG CHANNEL LDA BUFR+192 STA B AND SAVE AND B377 ISOLATE STA DTTY " TTY CHANNEL LDA B ALSO GET THE ALF,ALF AND B377 NUMBER OF STA #SUBC DEFINED SUBCHANNELS LDB \BUFA ADB BUFR+188 ADB P192 LDA B,I ALF,ALF AND B377 STA \DCH " SYSTEM DISK CHANNEL LDA B,I AND B377 STA DEQT " DISK TYPE(EQT) * LDA \BUFA MOVE THE TRACK MAP TABLE IMAGE LDB \TMT TO THE PERMANENT STORAGE AREA MVW P160 FROM HEADER RECORDS 1 AND 2 * * ROLLS IN THE CORRECT DISK DRIVER SEGMENT, DEPENDENT * UPON THE DESTINATION DISK TYPE * LDB SWAP5 ADDRESS OF 7905/7920 SEGMENT'S NAME LDA DEQT SLA LDB SWAP0 " 7900 " " STB SWAPA JSB EXEC ROLL IN THE SEGMENT - IT WILL DEF *+3 COME BACK TO \SWTM AFTER DEF P8 EXECUTING THE SEGMENT'S SWAPA NOP FRONT END CODE * * * DISPLAY DESTINATION I/O CONFIGURATION * \SWTM JSB \BLIN LDB MES5 LDA P15 JSB \DSPL "NEW SYSTEM I/O CONFIGURATION" JSB \BLIN * LDB P1 SET FOR \CVAS STB \CLEN LDA DPI SZA,RSS DEFINED? JMP OUT1 NO LDB MES6A JSB \CVAS LDA P18 LDB MES6 JSB \DSPL "SELECT CODE XX PRIVILEGED INTERRUPT" * OUT1 LDA DTBG LDB MES7A JSB \CVAS LDA P9 LDB MES7 JSB \DSPL "SELECT CODE XX TBG" * LDA #EQTS GET REMAINING EQT'S CMA,INA STA TEMP2 NEG. # EQT'S ST0 LDA #EQTS CMA,INA STA TEMP1 NEÚþúG. CURRENT EQT # LDB \BUFA ADB P192 STB TEMP4 POSITION IN EQT'S, LESS 1 * ST1 ISZ TEMP4 LDA TEMP4,I GET ENTRY ALF,ALF AND B377 AND ITS CHANNEL CPA CURCH NEXT CHANNEL? RSS JMP ST2 NOPE LDB MES8A YES,DISPLAY IT JSB \CVAS LDA TEMP4,I AND B377 LDB MES8B JSB \CVAS LDA P11 LDB MES8 JSB \DSPL "SELECT CODE XX TYPE YY" ISZ TEMP2 INCREMENT # FOUND RSS JMP ST4 ALL DONE * ST2 ISZ TEMP1 END OF EQT LIST? JMP ST1 NO ISZ CURCH CHANNEL NOT IN SYSTEM JMP ST0 SEARCH FOR NEXT * * * DISPLAY DESTINATION SYSTEM SUBCHANNEL DEFINITION * ST4 JSB \BLIN LDA \DCH GET DESTINATION SELECT CODE # LDB MES9A JSB \CVAS LDA \DSUB LDB MES9B JSB \CVAS LDA P24 LDB MES9 JSB \DSPL "NEW SYSTEM(LU 2) SELECT CODE=XX SUBCHANNEL=XX" * JSB \BLIN LDA DEQT SLA,RSS JMP D05 7905/7920 DESTINATION DISK * LDA \DSUB ADA B2060 ALF,ALF STA MES10+5 STORE PLATTER # IN MESSAGE LDA \DFTR CMA,INA LDB P2 SET FOR \CVAS STB \CLEN LDB MS10C " FIRST TRACK # " JSB \CVAS LDA \DNTR CMA,INA LDB MS10D " # TRACKS " JSB \CVAS LDA P21 LDB MES10 " LOGICAL SUBCHANNEL XX FIRST TRACK XXX JSB \DSPL # TRACKS XXX" JMP GETEM * D05 LDA P3 7905/7920 SUBCHANNEL DEFINITION STA \CLEN SET MAX CONVERSION LENGTH (WORDS) LDA \DSHD CMA,INA LDB MS41A JSB \CVAS STORE HEAD # IN MESSAGE LDA \DNTR CMA,INA LDB MS40A " # TRACKS " JSB \CVAS LDA \DUNT CMA,INA LDB MS42A JSB \CVAS " UNIT/ADD " þúLDA \DNSU CMA,INA LDB MS41B JSB \CVAS " # SURFACES " LDA \DFTR CMA,INA LDB MS40B " FIRST CYL " JSB \CVAS LDA \DNSP CMA,INA LDB MS42B JSB \CVAS " # SPARES " LDA \D#ST CMA,INA LDB MS43B JSB \CVAS " #SECTORS/TRACK " * LDA P17 LDB MES40 " #TRACKS NNNNN FIRST CYL CCCCC " JSB \DSPL LDA P17 LDB MES41 " HEAD # HHHHH #SURFACES SSSSS " JSB \DSPL LDA P17 LDB MES42 " UNIT/ADD UUUUU #SPARES PPPPP " JSB \DSPL LDA P17 LDB MES43 " #SECTORS TRACK KKKKK " JSB \DSPL * GETEM LDA SIZE GET SYSTEM LENGTH IN BLOCKS RAL CONVERT TO 64-WORD SECTORS CLB DIV \D#ST AND CONVERT TO # TRACKS SZB INA BUMP FOR PARTIAL TRACKS ADA P9 ADD THE 9 TRACK MINIMUM FREE TRACKS STA \STRK AND SAVE LDA \D#WT GET #WORDS TRACK AND CMA,INA COMPLEMENT STA ND#WT FOR DMA TRANSFER LENGTHS SKP * * CHECK TARGET CHANNEL * JSB \BLIN LDA \TCH GET TARGET CHANNEL SSA,RSS SPECIFIED? JMP CHCH YES, CHECK FOR VALIDITY ASKCH LDA P25 LDB MES12 JSB \DSPL "TARGET SELECT CODE FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB DFLT CR? JMP ASK1 NO LDA \DCH YES, DEFAULT TARGET CHANNEL STA \TCH TO DESTINATION CHANNEL JMP GTSCH * ASK1 LDA P2 JSB GETOC CONVERT ANSWER JMP ASKCH ERROR-TRY AGAIN STA \TCH * CHCH ADA N8 CHECK FOR CORRECT SSA RANGE (10-77 OCTAL) JMP ASKCH < 10, TRY AGAIN ADA N56 SSA,RSS JMP ASKCH > 77, TRY AGAIN * * CONFIGURE THE DISK DRIVER DISKD TO THE TARGET CHANNEL * þú GTSCH JSB STDSK * * CHECK TARGET SUBCHANNEL OR UNIT * LDA \TSUB GET THE TARGET SUBCHANNEL SSA,RSS SPECIFIED? JMP CHSB YES, CHECK VALIDITY ASKSB JSB \BLIN LDA P25 LDB MES13 JSB \DSPL "TARGET PLATTER/UNIT FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB DFLT CR? JMP ASK3 NO LDA DEQT SLA,RSS DEFAULT TO EITHER 7900 SUBCHANNEL OR 7905/7920 UNIT JMP ASK2 LDA \DSUB DEFAULT TARGET SUBCHANNEL TO DESTINATION SUBCHANNEL STA \TSUB JMP OKAY * ASK2 LDA \DUNT STA \TUNT DEFAULT TARGET UNIT TO DESTINATION UNIT JMP OKAY * ASK3 LDA P1 JSB GETOC CONVERT ANSWER TO OCTAL JMP ASKSB ERROR, TRY AGAIN STA \TSUB **TEMP** * CHSB ADA N8 SSA,RSS JMP ASKSB > 7, TRY AGAIN LDB \TSUB LDA DEQT FOR THE 7905/7920, SAVE THE ANSWER AS THE UNIT SLA,RSS STB \TUNT JMP OKAY SKP *CONSTANTS B37 OCT 37 B77 OCT 77 N56 DEC -56 P11 DEC 11 P18 DEC 18 P15 DEC 15 P21 DEC 21 P19 DEC 19 P23 DEC 23 P24 DEC 24 P25 DEC 25 P31 DEC 31 P256 DEC 256 * IOFF NOP IRB NOP IREC NOP JSEC NOP * SPC 2 * HOST => CURRENT SYSTEM UNDER WHICH SWTCH IS OPERATING * HSBCH NOP HOST SYSTEM DISK SUBCHANNEL HCH NOP " " " CHANNEL HEQT NOP " " " TYPE HUNIT NOP " " " UNIT (7905/6/20) HNHD NOP " " SUBCHANNEL STARTING HEAD (7905/6/20) HNSU NOP " " " # SURFACES HFTR NOP " " " STARTING TRACK/CYLINDER H#ST DEC 96 " " " SECTORS/TRACK (DEFAULT) HTTY NOP " " TTY CHANNEL SKP * * WE PASSED THE FIRST TEST!!! * * IF THE HOST AND TARGET SYSTEM'S ARE BOTH 7905/7920'S THEN WE'RE * GOING TO SEARCH $TB32 NOW BEFORE T©SþúHE USER HAS AN OPPOR\TUNTY * TO INSERT A DIFFERENT SYSTEM DISC. THE HOST SUBCHANNEL DEFINITION * MUST BE DETERMINED IN ORDER TO CHECK FOR AN OVERLAY OF THE HOST * SYSTEM. * OKAY JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+6 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 DEF HSBCH * LDA IEQT4 GET CHANNEL AND B77 STA HCH STA B LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 STA HEQT CPA DEQT SLA SAME DISC TYPE - SEE WHICH JMP OKAYY 7900, NO PROBLEM CUZ CAN USE SUBCHANNEL * CPB \TCH SAME CHANNEL? RSS YES JMP OKAYY NO PROBLEM HERE * * GET THE TRACK MAP TABLE CONTAINING THE * HOST SYSTEM SUBCHANNEL DEFINITION IN BUFR. * IF THE HOST IS AN RTE-IV+ SYSTEM THEN A * SIMPLE EXEC CALL WILL RETURN THE TABLE. * OTHERWISE, SEARCH THE RESIDENT LIBRARY * ENTRY POINT LIST FOR $TB32. * LDB $BMON IF A NEW SYSTEM THEN SLB,RSS A CALL TO THE DRIVER CAN BE DONE JMP OLDSY ELSE SCAN LEP FOR $TB32 ADDRESS * JSB EXEC DEF *+7 DEF P1 DEF TMTSF DEF BUFR DEF P161 DEF P0 DEF P5 * * * GET HOST SUBCHANNEL DEFINITION FROM NEW FORMAT * LDA HSBCH MPY P5 LDB \BUFA RETRIEVE FROM TABLE: INB ADB A LDA B,I STA H#ST HOST SUBCHANNEL'S #SECTORS/TRACK INB LDA B,I STA HFTR " " FIRST CYLINDER INB LDA B,I AND B17 STA HUNIT " " UNIT# LDA B,I ALF,RAL RAL AND B77 STA HNSU " " # SURFACES LDA B,I ALF,ALF ALF AND B77  STA HNHD " " STARTING HEAD # JMP OKAYY SKP OLDSY LDA #LEP GET # GþúOF LIBRARY ENTRY POINTS MPY P4 4 WORDS PER ENTRY STA LEPL SAVE SIZE OF L.E.P. LIST * LDA ALEP GET DISK ADDRESS OF LEP LIST LDB A ALF,ALF RAL AND B777 STA LTRK SAVE THE TRACK LDA B AND B177 F$T3 STA LSEC AND SECTOR ADA N89 DETERMINE IF THE SECTOR RESULTS IN SSA LESS THAN 512 WORDS LEFT ON TRACK JMP F$T1 <89 INA SEE HOW MANY SECTORS LESS MPY P64 CMA,INA AND SUBTRACT FROM ADA P512 512 MAX STA LLEN LENGTH OF READ JMP F$T0 F$T1 LDA LEPL JSB GTLEN GET READ LENGTH F$T0 JSB READD READ IT * CLB LDA LLEN DIV P4 GET THE # OF ENTRIES READ IN CMA,INA NEGATE STA LCNT LOOP COUNTER LDB \BUFA F$T2 STB BPTR * LDA $T CPA B,I A "$T"? INB,RSS JMP NOTIT NO LDA B3 CPA B,I A "B3"? INB,RSS JMP NOTIT NO LDA .2 XOR B,I AND B1774 A "2 "? SZA,RSS A MATCH ON $TB32? JMP F$T7 YES!! * NOTIT ISZ LCNT DONE WITH CURRENT BUFFER? RSS JMP F$T4 YES LDB BPTR ADB P4 JMP F$T2 * F$T4 LDA LLEN CMA,INA ADA LEPL STA LEPL NEW # LEFT * LDB LSEC DETERMINE IF TRACK CROSSING ADB N89 IF >= 88 THEN THERE WILL BE INB SSB JMP F$T5 NOPE * ISZ LTRK YES, INCREMENT TO NEXT TRACK CLB STB LSEC SET NEXT SECTOR TO 0 JMP F$T1 SET LENGTH OF READ * F$T5 LDA LSEC INCREMENT TO NEXT STARTING ADA P8 SECTOR JMP F$T3 SET LENGTH OF READ * F$T7 INB LDA B,I GET THE MEMORY ADDRESS LDB A,I CHECK FOR USER-DEFINED TMT INDICATED SSB,RSS IN WORD 1 - IF POSITIVE, INA THERE'Õ þúS AN EXTRA WORD LDB \BUFA STB BPTR BUFFER POINTER MVW P98 STORE ENTIRE TMT IN BUFR * * OBTAIN HOST SUBCHANNEL DEFINITION FROM OLD $TB32 * LDA HSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA HFTR HOST SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA HUNIT " " UNIT # LDA B,I ALF AND B17 STA HNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA HNHD " " STARTING HEAD # SKP * * * OPERATOR GIVEN OPPOR\TUNTY TO INSERT CORRECT CARTRIDGE * OKAYY LDA BATCH CMA,SSA,INA,SZA SKIP IF <= 0 JMP SAVE? NOT SO IN BATCH MODE JSB \BLIN CRLF LDA P23 LDB MES16 JSB \DSPL LDA P21 "NOW IS THE TIME TO INSERT CORRECT LDB MES17 CARTRIDGE IN TARGER SUBCHANNEL/UNIT" JSB \DSPL * JSB TARGT GET ANSWER JSB DFLT CHECK FOR " "CR JMP CRLF TRY AGAIN FOR ANSWER * * CHECK IF FILE STRUCTURE AT TARGET IS TO BE SAVED * SAVE? LDA \SAVE WAS IT SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SAV?? YES * SAV1 LDA P16 NO, ASK THEM LDB MES18 JSB \DSPL "SAVE FILES AT TARGET? (Y OR N) * JSB YE?NO READ ANSWER JMP SAV1 INVALID REPLY JMP SAV1 INVALID REPLY CLA,RSS NO CLA,INA YES, SAVE IT STA \SAVE * SAV?? CPA P0 DO WE SAVE THE FILES ? JMP SUBI? NOPE * * CHECK THE SYSTEM AT THE TARGET * JSB VFYSY VERIFY THE SYSTEM OUT THERE! JMP SUBI? CAN'T SAVE THE FILES * LDA \STRK SIZE OF NEW SYSTEM (INCLUDING 9 TRACKS LDB \FFMP OF AVAILABLE TRACK SPACE) MUST BE CMA,INA < FIRST FMP TRACK OF TARGET ADA B SUBCHANNEL SSA,RSS JMP SAVE6 ÚÊþú NO PROBLEM * LDA P19 WARN USER LDB MES19 JSB \DSPL "NEW SYSTEM WILL DESTROY SOME FMP FILES" JSB OK? "OK TO PROCEED?" * CCA SET TO PROCEED, BUT SAVE AS MANY FILES STA \SAVE AS POSSIBLE * * * CHECK IF TYPE 6 FILES ARE TO BE SAVED * SAVE6 LDA TYP6 SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SUBI? YES * SAV6A LDA P15 NO, ASK THEM LDB MES22 JSB \DSPL "PURGE TYPE 6 FILES? (Y OR N)" * JSB YE?NO DECIPHER ANSWER JMP SAV6A INVALID REPLY * * DETERMINE IF ANY ADDITIONAL SUBCHANNELS ARE TO BE INITIALIZED * JMP SAV6A /E AN INVALID REPLY CLA,RSS NO CLA,INA YES STA TYP6 SKP SUBI? LDA SUBI SPECIFIED AT TURN-ON TIME? SZA,RSS JMP AUTO? ONLY THAT NOT WANTED CCB ADB #SUBC GET NUMBER OF SUBCHANNELS SZB,RSS ASIDE FROM SYSTEM SUBCHANNEL JMP AUTO?-1 NONE, SO SKIP QUERY * SSA,RSS YES, OR NOT-YET-SPECIFIED? JMP SUBBR YES, SO DON'T ASK AGAIN * SUBIA LDA P18 LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNELS? (Y OR N)" JSB YE?NO DECIPHER ANSWER JMP SUBIA INVALID REPLY JMP SUBIA INVALID REPLY CLA,RSS NO CLA,INA YES STA SUBI SAVE SZA,RSS IF NO, THEN MOVE ON TO JMP AUTO? AUTO BOOT QUERY * SUBBR LDA "L" CHANGE MESSAGE STA MES34+11 LDA DEQT GET DISC TYPE SLA,RSS BRANCH TO REQUEST JMP SUBI5 7905/6/20 INITIALIZATIONS * * REQUEST INITIALIZATIONS OF ADDITIONAL 7900 SUBCHANNELS * CCB,RSS NXSUB LDB SUBIA GET LAST SUBCHANNEL DISPLAYED INB CPB \DSUB JMP NXSUB+1 CPB #SUBC JMP AUTO? DONE ASKING * STB SUBIA SAVE SUBCHANNEL # LDA \TMT POSITION INTO TRACK MAP TABLE [ÑþúADA P8 BUFFER TO GET # OF ADA B TRACKS DEFINED FOR THIS SUBCHANNEL LDA A,I SZA,RSS ANY? JMP NXSUB+1 NO,TRY NEXT SUBCH ADB B2060 CONVERT TO ASCII STB MES34+12 AND STORE IN MESSAGE NXA LDA P18 LDB MES34 NOW ASK? JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXA INVALID REPLY JMP AUTO? /E SO EXIT JMP NXSUB NO INIT * ASKTS LDA P15 LDB MES35 ASK 'EM JSB \DSPL "TARGET PLATTER?" JSB TARGT GET RESPONSE JSB DFLT CR? JMP NASK NO LDA SUBIA DEFAULT IMPLIED, SO GO TO TMT JMP CSST GO COMPARE WITH SYS SUBCH TARGET * * GET TARGET PLATTER FOR 7900 SUBCHANNEL * NASK CLA,INA GET TARGET PLATTER JSB GETOC RESPONSE JMP ASKTS INVALID REPLY CSST CPA \TSUB SAME AS SYSTEM SUBCH'S? JMP ASKTS YES - NOT ALLOWED * LDB SUBIA GET THIS SUBCHANNEL # ADB \TMT AND OFFSET INTO THE TMT BUFFER ADB P16 PAST THE DEF'NS (16 WORDS) STA B,I SAVE TARGET PLATTER FOR THIS SUBCHANNEL ADB N16 BACK UP TO FIRST TRACK ENTRY LDA B,I AND MARK THE SUBCHANNEL IOR MSIGN TO ENABLE INITIALIZATION STA B,I JMP NXSUB NOW TRY THE NEXT ONE SKP * * REQUEST INITIALIZATIONS OF ADDITIONAL 7905/6/20 SUBCHANNELS * SUBI5 LDB MS36B SET MESSAGE BUFFER ADDRESS STB TEMP2 FOR STORAGE OF SUBCH #'S CLA CLEAR HEADER STA HDFLG FLAG INA SET ASCII CONVERSION LENGTH STA \CLEN TO 1 WORD - FOR \CVAS CLB STB TEMP1 FIRST SUBCHANNEL # * * DISPLAY THOSE SUBCHANNELS ON SAME UNIT AS SYSTEM SUBCHANNEL * SUB0 CPB \DSUB SAME AS SYS SUBCH? JMP SUB1 YES, SO NEEDED ASK RBL,RBL POSITION INTO TMT FOR ADB TEMP1 ADB \TܶþúMT THIS SUBCHANNEL'S ENTRY ADB P2 LDA B,I AND GET WORD 2 OF ENTRY AND B17 ISOLATE THE UNIT # CPA \DUNT SAME UNIT AS FOR SYS SUBCH? RSS YES JMP SUB1 NO - MOVE ON TO NEXT LDA TEMP1 GET SUB # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER ADDRESS JSB \CVAS CONVERT TO ASCII AND PUT IN MESSAGE LDA COMBL GET A COMMA AND PLACE ISZ TEMP2 AFTER THE # STA TEMP2,I IN THE MESSAGE ISZ TEMP2 NEXT BUFFER POSITION ISZ HDFLG INDICATE ONE 'FOUND' FOR THIS UNIT * SUB1 ISZ TEMP1 BUMP TO NEXT SUBCH # LDB TEMP1 CPB #SUBC LAST SUBCH DONE? RSS YES JMP SUB0 * LDA HDFLG ANY FOUND MATCHING \DUNT? SZA,RSS JMP OTHER NO * LDB \TUNT STORE THE UNIT # IN THE MESSAGE ADB B2060 STB MES36+7 * RAL SET # OF WORDS TO PRINT ADA P16 LDB MES36 GET BUFFER ADDRESS JSB \DSPL "TARGET UNIT XX FOR SUBCHANNELS ..." * LDA HDFLG SET LOOP COUNTER RAL CLEAR 2 WORDS PER SUBCH IN CMA,INA THE BUFFER ("XX, " FOR EACH) STA HDFLG LDB MS36B GET BUFFER ADDRESS LDA BLNK AND 2 ASCII BLANKS STA B,I STORE IN BUFFER INB ISZ HDFLG BUMP BUFFER COUNTER (0 WHEN DONE) JMP *-3 * * ASK IF SUBCHANNELS ON \TUNT ARE TO BE INITIALIZED * CCA STA TEMP2 ALLOW ALL MATCHES IN INIT? LDA \DUNT GET UNIT FOR TMT MATCHING LDB \TUNT AND PASS TARGET UNIT FOR THOSE SUBCH'S JSB INIT? * * DISPLAY SUBCHANNELS MATCHING EACH DEFINED UNIT * CLA INITIALIZE THE UNIT # STA TEMP5 OTHER LDB MS37B AND THE BUFFER POINTER STB TEMP2 CLB STB TEMP1 CLEAR THE SUBCH # CPA \DUNT SAME UNIT AS SYSTEM SUêCþúBCH? JMP NXUNT CAN'T ALLOW (ALREADY DONE) * OT1 RBL,RBL POSITION TO SUBCH'S ENTRY ADB TEMP1 ADB \TMT IN THE TMT BUFFER ADB P2 MOVE TO WORD 2 LDA B,I AND GET IT AND B17 CPA TEMP5 IS IT THE UNIT WE WANT? RSS YUP JMP NXTSB NO, TRY THE NEXT * INB POSITION TO WORD 3 LDA B,I AND GET THE # OF TRACKS SZA,RSS JMP NXTSB SKIP IF NO TRACKS ASSIGNED SSA OR IF ALREADY SPECIFIED JMP NXTSB * LDA TEMP1 GET SUBCH # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER POSITION JSB \CVAS STORE IN MESSGE LDA COMBL NOW PLACE A COMMA ISZ TEMP2 AFTER THE NAME STA TEMP2,I ISZ TEMP2 ISZ HDFLG BUMP COUNTER * NXTSB ISZ TEMP1 BUMP TO NEXT SUBCHANNEL LDB TEMP1 RETRIEVE IT CPB #SUBC AND SEE IF DONE RSS YES JMP OT1 NO, CONTINUE SCANNING * LDA HDFLG ANY FOUND? SZA,RSS JMP NXUNT NO, TRY NEXT UNIT LDB TEMP5 STORE UNIT IN MESSAGE ADB B2060 STB MES37+7 RAL DETERMINE LENGTH OF MESSAGE ADA P16 BY # OF SUBCH'S STORED IN IT LDB MES37 DISPLAY JSB \DSPL "DESTINATION UNIT XX FOR SUBCHANNELS ..." * LDA HDFLG CLEAR BUFFER CONTAINING RAL CLEAR 2 WORDS PER SUBCH CMA,INA SUBCH #'S STA HDFLG LDB MS37B BUFFER ADDR LDA BLNK BLANKS STA B,I CLEAR INB ISZ HDFLG BUMP JMP *-3 CONTINUE * * ASK FOR TARGET UNIT FOR THIS SET OF SUBCHANNELS * ASKTU LDA P14 ASK FOR TARGET UNIT LDB MES38 JSB \DSPL "TARGET UNIT? (XX OR " "CR, OR /E) JSB YE?NO GET RESPONSE JMP TDFLT CHECK DEFAULT JMP NXUNT /E JMP hþúASKTU NO, TRY A NUMBER JMP ASKTU YES, NEED A NUMBER TDFLT JSB DFLT CR? JMP GETU NO LDA TEMP5 GET DEFAULTED UNIT JMP CSSTU AND GO CHECK AGAINST TARGET SYS UNIT * GETU CLA,INA RETRIEVE TARGET UNIT # JSB GETOC FROM RESPONSE JMP ASKTU INVALID REPLY - ASK AGAIN CSSTU CPA \TUNT SAME AS SYS SUBCH UNIT? JMP ASKTU YES - CAN'T ALLOW * * REQUEST INITIALIZATION OF EACH SUBCHANNEL OF CURRENT SET * LDB A GET TARGET UNIT # LDA \DUNT SET FOR DISALLOWING STA TEMP2 \DUNIT REPONSES LDA TEMP5 GET DEST UNIT # JSB INIT? AND ASK FOR INITIALIZATIONS * NXUNT ISZ TEMP5 BUMP UNIT COUNTER LDA TEMP5 RETRIEVE IT CPA P8 AND CHECK IF DONE JMP AUTO? YES JMP OTHER NO - START SUBCH SCAN AGAIN SKP * * SCAN TRACK MAP TABLE (IN BUFFER) FOR SUBCHANNELS THAT MAY BE * INITIALIZED, BASED UPON THE 'MATCH' UNIT IN THE A-REG. THE TARGET * UNIT FOR THESE SUBCHANNELS (IF INITIALIZED) IS IN THE B-REG. * INIT? NOP STA TEMP3 SAVE TMT MATCH UNIT STB TEMP4 AND TARGET UNIT CLB INITIALIZE STB TEMP1 NEXT SUBCHANNEL # * INIT1 CPB \DSUB SYSTEM SUBCHANNEL? JMP NXS YES, SO SKIP RBL,RBL CONVERT TO TMT ENTRY # ADB TEMP1 ADB \TMT AND OFFSET INTO BUFFER ADB P2 LDA B INA IF WORD3 IS NEGATIVE LDA A,I THEN THIS SUBCH ALREADY SSA HAS BEEN SPECIFIED JMP NXS SO SKIP THIS ENTRY SZA,RSS JMP NXS ALSO SKIP IF NO TRACKS ASSIGNED TO IT * LDA B,I ISOLATE THE AND B17 UNIT CPA TEMP2 THIS UNIT MATCH DISALLOWED? JMP NXS YES, TRY NEXT SUBCH * CPA TEMP3 ONE WE'RE LOOKING FOR? RSS YES JMP NXS TRY NEXT ONE * STB ^\þúTEMP6 SAVE BUFFER POSITION LDA TEMP1 GET SUBCH # CMA,INA LDB MS34A AND CONVERT TO ASCII JSB \CVAS AND STORE IN MESSAGE NXI LDA P18 NOW ASK 'EM LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXI INVALID REPLY JMP INIT?,I /E SO EXIT JMP NXS NO REPLY * LDB TEMP6 GET BUFFER POSITION LDA B,I AND WORD 2 OF SUBCH'S ENTRY AND B1777 MASK OFF UNIT IOR TEMP4 AND ADD IN TARGET UNIT STA B,I RE-STORE INB NOW SET THE SIGN BIT LDA B,I FOR WORD 3 TO IOR MSIGN INDICATE A SPECIFIED ENTRY STA B,I * NXS ISZ TEMP1 BUMP SUBCHANNEL # LDB TEMP1 RETRIEVE IT AND CPB #SUBC AND SEE IF DONE JMP INIT?,I YES JMP INIT1 CONTINUE SCAN * SKP * * THE FOLLOWING CONDITIONS FOR AUTO BOOT-UP ARE CHECKED: * DESTINATION CHANNEL = TARGET CHANNEL * DESTINATION SUBCHANNEL/UNIT = TARGET SUBCHANNEL/UNIT * DESTINATION TBG CHANNEL = HOST TBG CHANNEL * DESTINATION TTY CHANNEL = HOST TTY CHANNEL * DESTINATION PI CHANNEL = HOST PI CHANNEL ( IF BOTH EXIST) * STB SUBI CLEAR INIT WORD IF NO SUBCH'S AUTO? LDA AUTO SPECIFIED AT TURN-ON TIME? SZA,RSS JMP CHPNT YES, ONLY THAT THEY DON'T WANT IT * LDA \DCH COMPARE DISC CHANNELS CPA \TCH RSS JMP CANT NO MATCH LDB DEQT SLB CHECK SUBCHANNELS OR UNITS JMP AUT0 LDA \DUNT CPA \TUNT JMP AUT1 JMP CANT NO MATCH ON 7905/7920 UNIT * AUT0 LDA \DSUB CPA \TSUB RSS JMP CANT NO MATCH ON 7900 SUBCHANNEL # * AUT1 LDA TBG GET HOST TBG CHANNEL CPA DTBG RSS JMP CANT TBG'S DON'T MATCH LDA HTTY CPA DTTY ûþú RSS JMP CANT TTY CHANNELS DON'T MATCH LDA PI GET HOST PI CHANNEL CPA P0 IF EITHER THE HOST OR JMP AUT2 LDB DPI CPB P0 DESTINATION PI IS 0, JMP AUT2 THEN DON'T CHECK CPA B RSS JMP CANT PI CHANNELS DON'T MATCH * * * AUTO BOOT-UP IS POSSIBLE * AUT2 LDA AUTO HAS IT BEEN SPECIFIED YET? SSA,RSS -1=NOT SPECIFIED, 1=YES JMP CHPNT YES, AND WANT IT AUT3 LDA P12 LDB MES24 JSB \DSPL "AUTO BOOT-UP? (Y OR N)" JSB YE?NO GET ANSWER JMP AUT3 INVALID REPLY JMP AUT3 INVALID REPLY CLA,RSS NO CLA,INA YES STA AUTO JMP CHPNT * * * WON'T BE BOOTING UP NEW SYSTEM * CANT LDA P25 LDB MES25 JSB \DSPL "PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP" CLA STA AUTO * * * DETERMINE IF WE'RE OVERLAYING PART OF THE HOST SYSTEM. * ALSO, DETERMINE IF WE CAN RETURN TO HOST SYSTEM AFTER * TRANSFER, OTHERWISE HALT * * CHPNT LDA HEQT GET HOST EQT TYPE CPA DEQT SAME AS NEW? RSS JMP GO LDA HCH GET HOST CHANNEL CPA \TCH REPLACING CURRENT? RSS MAYBE JMP GO LDB DEQT SLB,RSS JMP CHPT5 CHECK 7905/7920 SUBCHANNEL DEFN LDA HSBCH GET HOST SUBCHANNEL CPA \TSUB SAME 7900 SUBCHANNELS? RSS JMP GO NO,SO NO PROBLEM * * WILL BE REPLACING CURRENT SYSTEM * REPL CLA,INA STA PONRT SET "POINT OF NO RETURN" FLAG FOR THE LDA AUTO SZA JMP GO LDA P22 ERROR MESSAGE PROCESSING LDB MES26 JSB \DSPL "SYSTEM WILL HALT AFTER TRANSFER COMPLETION" JMP GO * * GOT 7905/7920 HOST SUBCHANNEL DEFINITION (VIA $TB32) AT OKAY * * 7905/7920 CHECKS FOR OVERWRITE OF HOST SYSTEM, USING HUNIT ONLY * CHPT5 òþúLDA HUNIT CPA \TUNT SAME UNIT? JMP REPL YES - SO HALT IF NO AUTO-BOOT * * ALLOW OPERATOR ONE MORE OPPOR\TUNTY TO GET OUT * GO LDA BATCH NO MESSAGE IN BATCH MODE CMA,SSA,INA,SZA SKIP IF <= 0 JMP PURGF LDA P17 LDB MES32 JSB \DSPL "READY TO TRANSFER. OK TO PROCEED?" JSB YE?NO JMP GO INVALID REPLY JMP GO INVALID REPLY JMP \XOUT BAIL OUT JMP PURGF YES, GET WITH IT SKP * * PURGE ALL FILES FROM THE FILE DIRECTORY (AND THEIR EXTENTS) * THAT WERE OVERLAID BY THE NEW SYSTEM - LISTING THEM AT THE * SAME TIME. * PURGF JSB EXEC CORE LOCK - TO DEF *+3 PREVENT SWTCH FROM DEF P22 FROM BEING SWAPPED OUT DEF P1 * LDB \SAVE WERE THE FMP FILES TO BE \SAVED? SZB,RSS JMP XFER NO * LDA D.LT CONVERT LAST FMP LOGICAL ADDRESS STA \TRAK CLB STB \SECT LDA D.# STA TEMP4 SAVE FOR LOOP CHECKS * STB \INIT FOR DISKD LDA ND#WT STA \LNTH LDA \BUFA STA BPTR * LDA \SAVE SSA,RSS WERE ANY FMP FILES OVERLAID? JMP PUR6 NO,CHECK ON TYPE 6 FILES * LDA LWAM SET THE ADDRES OF THE ADA N3 FIRST FILE NAME ENTRY STA PENT * CLA,INA STA REWRT SET RE-WRITE FOR FD LDB \BUFA CCE SET FOR READ JMP BFULL * SPC 3 ****************************************************************************** * * THE FOLLOWING BSS ALLOWS FOR OVERLAY OF THE * PREVIOUS CODE, AND ADDS ADDITIONAL BSS'S FOR * AN AREA TOTALING 8192(DECIMAL) WORDS - MAXIMUM * WORDS PER TRACK. * BSS 8192+BUFR-* * ***************************************************************************** SPC 3 BFULL JSB DISKD FIRST FULL TRACK READ JSB \BLIN LDA P10 HEADING: Q*þú LDB MES27 JSB \DSPL "OVERLAID FMP FILES:" CCA STA CURCH SET FOR PURGT LDA FDOFF POSITION TO FILE SPEC'N WORD 4 LDB \STRK AND STORE THE NEW FIRST STB A,I FMP TRACK * LDB FIRDE POSITION TO FIRST FILE ENTRY ON TRACK LDA FDT#E LOOP0 STA TCNT SET # ENTRIES TO SEARCH LOOP1 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRB ALREADY PURGED SZA,RSS JMP INCRB NOT AN ENTRY ADB P4 POSITION TO TRACK ADDRESS LDA B,I LDB \STRK COMPARE WITH LAST SYSTEM CMB,INB TRACK ADA B SSA WAS THE FILE IN THE NEW SYSTEM AREA? JSB PURGT PURGES,LISTS ENTRY * INCRB JSB UPDAT SET TO SEARCH NEXT ENTRY JMP LOOP1 CONTINUE IN SAME TRACK JMP PUR6 PURGE TYPE 6 FILES JMP LOOP0 CONTINUE IN NEW TRACK * FDOFF NOP SPEC'N ENTRY WORD 4 OFFSET INTO TRACK BUFFER FIRDE NOP BUFFER ADDRESS OF FIRST DIRECTORY ENTRY FDT#E NOP FIRST DIR TRACK'S # OF ENTRIES TO SEARCH SKP * PURGES ANY TYPE 6 FILES OF THE TARGET FMP FILE SYSTEM * PUR6 LDA TYP6 ARE WE TO PURGE ANY? SZA,RSS JMP XFER NO * CLA CLEAR THE STA REWRT REWRITE & FILES FLAGS STA CURCH FOR PURGT STA \SECT LDA D.# STA TEMP4 SET THE # DIRECTORY TRACKS TO SEARCH LDA D.LT FIRST DIRECTORY TRACK STA \TRAK LDB \BUFA STB BPTR CCE JSB DISKD READ IT * LDB FIRDE POSITION TO FIRST FILE DIR ENTRY LDA FDT#E LOOP2 STA TCNT # ENTRIES TO SEARCH LOOP3 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRE ALREADY PURGED SZA,RSS JMP INCRE NOT AN ENTRY ADB P3 POSITION TO FILE TYPE LDA B,I CPA P6 A TYPE 6? RSS 5'þú JMP INCRE NOPE LDA HDRSW SZA JMP LOOP4 ISZ HDRSW JSB \BLIN LDA P10 PRINT HEADING: LDB MES28 JSB \DSPL "TYPE 6 FILES PURGED:" * LOOP4 JSB PURGT PURGE AND LIST ENTRY INCRE JSB UPDAT POSITION TO NEXT DIRECTORY ENTRY JMP LOOP3 CONTINUE IN SAME TRACK JMP XFER DONE WITH DIRECTORY JMP LOOP2 CONTINUE IN NEW TRACK SPC 2 B50 OCT 50 B62 OCT 62 B200 OCT 200 N6144 DEC -6144 HDRSW NOP HEADER SWITCH SKP * BEGIN THE TRANSFER, READING FROM THE ABSOLUTE FILE VIA READF * CALLS, AND WRITING OUT THE NEW SYSTEM VIA DISKD (TURNS OFF * THE INTERRUPT SYSTEM) * XFER CLA STA \TRAK SET DESTINATION TRACK 0 SECTOR 0 STA \SECT JSB IMESS "INSTALLING SYSTEM SUBCHANNEL XX" LDA MSINT NOW REPLACE THE 'INSTALLING' LDB MSINS WITH THE 'INITIALIZING' MVW P9 * * READ FROM THE NEW SYSTEM FILE * LDA \BUFA STA BPTR RESET TO BEG. OF BUFFER LDA DEQT LDB \INP0 SLA,RSS LDB \INP5 SET TO WRITE PROTECT AND INITIALIZE STB \INIT (FOR DISKD) * CLB LDA SIZE # 128-WORD SECTORS RAL CONVERT TO # 64-WORD SECTORS DIV \D#ST SIZE OF SYSTEM CMA,INA NOW MEANS THE SYSTEM SIZE IN TRACKS STA TEMP1 NEGATIVE STB TEMP2 REMAINING # OF SECTORS LDA \D#WT SET WORDS PER TRACK STA \LNTH AS TRANSFER LENGTH * JSB READF READ A TRACK STARTING WITH RECORD #3 DEF *+7 DEF DCB DEF ERR DEF BUFR DEF \LNTH DEF LLEN DEF P3 SSA READ ERROR? JMP RDERR YES * LDA PONRT SET TO INDICATE POSSIBLE OVERLAY CMA,INA RESULTING IN 0 OR -1 STA PONRT * * LDA \BUFA COMPUTE ADDRESS OF SYSTEM ADA P1024 COMMUNICATION AREA IN NEW ADA wþúB50 BASE PAGE. LDB A POSITION TO LOCATION 1650. ADB P6 GET TAT ADDRESS AT 1656 WHILE LDB B,I WE'RE THERE. STB TAT * JMP WDISK WRITE TRACK TO DISK * * READ FROM ABSOLUTE DISK FILE * RDISK LDA \D#WT ISZ TEMP1 LAST FULL TRACK'S WORTH? JMP READ NO, CONTINUE LDA TEMP2 GET # OF LEFTOVER SECTORS SZA,RSS JMP DDONE NONE! MPY P64 CONVERT TO # WORDS ISZ EOFLG SET EOF FLAG * * CLEAR REMAINDER OF TRACK * STA \LNTH SAVE # WORDS TO BE READ CMA,INA DETERMINE # REMAINING ON TRACK ADA \D#WT CMA,INA LDB \BUFA GET STARTING ADDRESS ADB \LNTH WITHIN BUFFER JSB CLRBF AND CLEAR THE AREA TO FOLLOW RSS THE LAST RECORD READ IN * * READ ANOTHER TRACK FROM ABS FILE * READ STA \LNTH # WORDS TO READ JSB READF DEF *+5 DEF DCB DEF ERR DEF BUFR DEF \LNTH SSA READ ERROR? JMP RDERR YES * * WRITE TO THE TARGET * WDISK LDA \TRAK DISPLAY DESTINATION OTA 1 * LDA ND#WT STA \LNTH # WORDS TO READ/WRITE LDB \BUFA BUFFER(CORE) ADDRES CLE SET TO WRITE JSB DISKD AND DO IT. * LDA EOFLG DONE WITH TRANSFER? SZA NO JMP DDONE ISZ \TRAK INCREMENT DESTINATION JMP RDISK ADDRESS BY ONE TRACK * * * * TRANSFER COMPLETE. INITIALIZE THE NECESSARY DISK TRACKS * DDONE LDB \INT0 GET WRITE INITIALIZE BITS LDA DEQT SLA,RSS LDB \INT5 STB \INIT SET FOR DISKD * LDA \SAVE SZA,RSS JMP WHOLE INITIALIZE WHOLE REST OF SUBCHANNEL SSA JMP INIT2-1 INITIALIZE ONLY THE 9 AVAILABLE TRACKS * * INITIALIZE ONLY UP TO TARGET(EXISTING) FIRST FMP TRACK * LDA \FFMP COMPUTE NUMBER OF TRACKS UPìïþú TO FMGR AREA JMP LESS * * INITIALIZE REST OF SYSTEM SUBCHANNEL * WHOLE LDA \DNTR COMPUTE # TRACKS LEFT ON SUBCHANNEL LESS LDB \STRK ADB N9 CMB,INB ADA B CMA,INA JMP INIT2 * * INITIALIZE THE MINIMUM 9 TRACKS SINCE WE'RE OVERLAYING * SOME FMGR FILES AS IT IS. * N9 DEC -9 * LDA N9 INIT2 STA TEMP1 NEGATIVE # * * CLEAR ENTIRE BUFFER FIRST * LDB \BUFA STARTING ADDRESS LDA ND#WT AND SIZE JSB CLRBF DO IT * * SET FIRST TRACK * LDA \STRK ADA N9 AND B377 STA \TRAK NEXT TRACK TO WRITE IN1 OTA 1 LDB \BUFA CLE JSB DISKD ISZ \TRAK INCREMENT THE TRACK NUMBER LDA \TRAK ISZ TEMP1 DONE? JMP IN1 NO SKP * * ANY ADDITIONAL SUBCHANNELS TO BE INITIALIZED? * ISUBS LDA SUBI SHOULD WE INITIALIZE ANY SZA,RSS ADDITIONAL SUBCHANNELS? JMP UPTAT NO CLA SIGNAL A NON-SYSTEM LU STA \LU2 LDA \DSUB SAVE THE DESTINATION DISK SUBCHANNEL STA TEMP1 * LDB DEQT BRANCH ON THE SLB,RSS DISK TYPE JMP INS5 7905/6/20 * * INITIALIZE SPECIFIED 7900 SUBCHANNELS * LDB N6144 STB \D#WT SET TRANSFER LENGTH LDA \TSUB SAVE THE DESTINATION TARGET SUBCHANNEL STA TEMP2 LDB \INT0 SET THE WRITE INIT STB \INIT FLAG CLB INITIALIZE THE STB \DSUB SUBCHANNEL # TO SCAN INS0 ADB \TMT OFFSET INTO THE TMT FOR ENTRY LDA B,I IS THIS SUBCHANNEL SSA,RSS TO BE INITIALIZED? JMP INS1 NO AND B7777 STA \DFTR SET THE STARTING TRACK TO BE ADB P8 INITIALIZED LDA B,I STA \DNTR AND THE NUMBER OF TRACKS ADB P8 LDA B,I STA \TSUB THE TARGET PLATTER # JSB ILOOP GO INITIALIZE THAT SUBCHANNEL  Ýþú* INS1 ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB SEE IF DONE CPB #SUBC RSS YES JMP INS0 NO, CONTINUE SCAN OF TMT * LDB TEMP1 RESTORE THE SYSTEM SUBCHANNEL'S STB \DSUB SPECIFICATIONS ADB \TMT LDA B,I STA \DFTR THE STARTING TRACK # ADB P8 LDA B,I STA \DNTR THE NUMBER OF TRACKS LDA TEMP2 STA \TSUB AND THE TARGET PLATTER JMP UPTAT EXIT SKP * * INITIALIZE SPECIFIED 7905/6/20 SUBCHANNELS * INS5 LDA \TUNT SAVE THE TARGET UNIT FOR STA TEMP2 THE SYSTEM SUBCHANNEL LDB \INT5 SET THE WRITE INITIALIZE STB \INIT FLAG LDA \DSUB SAVE DESTINATION SYSTEM SUBCHANNEL STA \TSUB FOR USE AT ISPAR(SWSG2) CLB STB \DSUB INITIALIZE SUBCH # FOR SCAN * INS6 JSB \SETD GO SET UP \DSUB'S SPECS LDA \D#WT SET TRANSFER LENGTH CMA,INA NEGATE STA \LNTH LDA \DUNT SET THE TARGET UNIT STA \TUNT FROM THE ENTRY CCA RESET THE HEADING FLAG TO STA \BADH DISPLAY SUBCHANNEL # OF BAD/SPARED TRACKS SEZ INITIALIZE IT? JSB ILOOP YES * ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB DONE YET? CPB #SUBC RSS YES JMP INS6 TRY THE NEXT SUBCHANNEL * LDB TEMP1 RE-STORE THE STB \DSUB SYSTEM SUBCHANNEL'S DESTINATION LDB TEMP2 SUBCH , AND THE TARGET STB \TUNT UNIT JSB \SETD RESET SYSTEM SUBCH SPECS JMP BOOT? * SKP * * ILOOP NOP JSB IMESS PRINT INITIALIZING MESSAGE LDA \DNTR GET THE # OF TRACKS CMA,INA FOR THIS SUBCHANNEL STA TEMP3 AND SET AS THE LOOP COUNTER CLA SET THE STARTING TRACK # STA \TRAK TO INITIALIZE STA \SECT CLEAR SECTOR # * IL1 LDA \TRAK DISPLAY - þúTRACK # OTA 1 IN SW REG LDB \BUFA GET BUFFER ADDRESS CLE SET TO WRITE JSB DISKD WRITE INIT THE TRACK ISZ \TRAK INCREMENT THE TRACK # ISZ TEMP3 AND THE LOOP COUNTER JMP IL1 CONTINUE JMP ILOOP,I DONE WITH THIS SUBCHANNEL SPC 4 IMESS NOP CLA,INA STA \CLEN SET CONVERSION LENGTH JSB \BLIN PRINT A BLANK LINE LDA \DSUB GET SUBCHANNEL TO BE INIT'D CMA,INA LDB MSIN1 JSB \CVAS CONVERT FOR MESSAGE * LDA P16 LDB MSINS PRINT: JSB \DSPL "INITIALIZING SUBCHANNEL XX" JMP IMESS,I * MSINS DEF *+1 ASC 16,INSTALLING SYSTEM SUBCHANNEL XX MSIN1 DEF MSINS+16 MSINT DEF *+1 ASC 9,INITIALIZING SKP * * UPDATE THE 7900 TAT FOR ANY BAD TRACKS ENCOUNTERED DURING * THE TRANSFER OR INITIALIZATION. * UPTAT CLA CLEAR THE WRITE STA \INIT INITIALIZE FLAG LDA N6144 STA \LNTH SET TRANSFER LENGTH LDA DEQT GET THE TARGET DISK TYPE SLA,RSS JMP BOOT? NO BAD ONES ON A 7905/7920 * LDA \FLGT GET ADDRESS OF BAD TRACK TABLE STA TEMP3 AND SAVE IT FOR RETRIEVAL LDA A,I GET THE FIRST BAD TRACK CPA N1 -1 MEANS END OF LIST JMP BOOT? NO BAD TRACKS * LDA TAT CONVERT THE TAT CORE ADDRESS ADA P128 TO TRACK # AND OFFSET CLB (ALLOW FOR T0S0 BOOTSTRAP) DIV P6144 STB TEMP1 TAT'S OFFSET INTO TRACK BUFFER STA TEMP2 TRACK CONTAINING THE TAT CMB,INB ADB P6144 SET THE # OF (POSSIBLE) TAT STB TYP6 ENTRIES ON TRACK TEMP2 * CMB,INB DETERMINE IF NEXT BAD TRACK IS ON LDA TEMP3,I THE TAT ENTRIES OF TRACK TEMP2 AND B1776 ALF,ALF ROTATE TRACK TO LOW A RAL ADB A SSB JMP RDTAT IT IS TRAK2 ISZ TEMP2 A­þú ADJUST VARIABLES FOR NEXT TRACK LDA TEMP1 CMA,INA ADA P6144 CONVERT NEW OFFSET TO NEG (BECAUSE CMA,INA OF LOGICAL BAD TRACK #'S) STA TEMP1 * RDTAT CLA STA REWRT CLEAR REWRITE FLAG STA \SECT LDA TEMP2 STA \TRAK LDB \BUFA CCE JSB DISKD GO READ IT! * SETBD LDA TEMP3,I GET THE BAD TRACK# AND B1776 INTO LOW A ALF,ALF RAL ADA TEMP1 ADD TAT OFFSET INTO TRACK BUFFER ADA \BUFA LDB MSIGN STB A,I SET THE TAT ENTRY ISZ REWRT SET TO REWRITE THE TRACK ISZ TEMP3 POINT TO NEXT BAD TRACK ENTRY * LDA TEMP3,I GET THE NEXT BAD TRACK CPA N1 END OF LIST? JMP TROUT YES AND B1776 ROTATE IT TO LOW A ALF,ALF RAL ADA TYP6 ADD # ENTRIES ON TEMP2 SSA,RSS TO SET IF ITS ON THIS TAT TRACK JMP SETBD ON TEMP2, SO GO SET IT * TROUT LDA REWRT IS TRACK TEMP2 TO BE RE-WRITTE? SZA,RSS JMP BOOT? NO LDA \INP0 STA \INIT LDB \BUFA GET THE BUFFER ADDRESS CLE CLEAR TO WRITE JSB DISKD AND DO IT * LDA TEMP3,I CPA N1 DONE NOW? RSS YES JMP TRAK2 NO,SET ENTRIES THAT ARE ON NEXT TRACK SKP * BOOT? JSB \BLIN LDA P6 INA LDB MES33 JSB \DSPL "SWTCH FINISHED" JSB \BLIN * LDB PONRT CAN WE REMOVE THE CORE LOCK? SZB JMP BOOTS NO * JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * BOOTS LDA AUTO ARE WE TO BOOT UP ? SZA JMP BOOT YES LDB PONRT CAN WE RETURN TO THE SZB,RSS CURRENT SYSTEM? JMP XOUTT YES * JSB $LIBR NOP NO HLT 77B HALT * * * BOOT THE NEW RTE! * BOOT JSB \BLIN LDA N128 Ývþú STA \LNTH CLA SET FOR TRACK 0, SECTOR 0. STA \INIT STA \TRAK STA \SECT ISZ \BOOT SET SO DISKD WILL BRANCH LDB B2011 TO THE BOOTSTRAP LOADR CCE JSB DISKD LOAD THE SYSTEM LOADER. * B2011 OCT 2011 LWAM EQU 1777B SKP * ABNORMAL TERMINATION EXIT * \XOUT LDA P20 LDB MES15 JSB \DSPL * JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * XOUTT JSB EXEC TERMINATE DEF *+2 DEF P6 SPC 2 RDERR CMA,INA ABSOLUTE FILE READ ERROR STA ERR JSB CNUMD DEF *+3 DEF ERR DEF MS31A * LDA MS31A+2 SAVE ERROR CODE ONLY STA MS31A LDA P6 LDB MES31 JSB \DSPL JMP \XOUT * MSIGN OCT 100000 BAD TRACK IN TAT HED SWTCH SUBROUTINES. ******************************** * * CONTROLS CALLS TO THE CORRECT DISK DRIVER, * DEPENDENT UPON THE DESTINATION DISK TYPE * DISKD NOP DST ABREG SAVE 'EM LDA DEQT SLA JMP DISK1 DLD ABREG JSB \DSK5 CALL TO 7905/7920 DRIVER JMP DISKD,I * DISK1 DLD ABREG JSB \DSK0 CALL TO 7900 DRIVER JMP DISKD,I * ABREG BSS 2 A & B REGISTER SAVE AREA SPC 4 * * CLEAR A-REG NUMBER OF WORDS IN A BUFFER STARTING AT B-REG * CLRBF NOP STA TEMP2 AND SAVE CLA CLEAR STA B,I INB BUMP BUFFER ADDRESS ISZ TEMP2 AND LOOP COUNTER JMP CLEAR CONTINUE JMP CLRBF,I DONE SKP * * * UPDATES THE DIRECTORY POINTERS ( AND POSSIBLY TRACK # ) * WHEN PURGING FILES * * RETURN: (P+1) CONTINUE IN SAME DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (P+2) DONE WITH THE DIRECTORY * (P+3) CONTINUE IN NEXT DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (A) IS # ENTRIES TO SEARCH ON NE³þúXT PASS * UPDAT NOP LDB BPTR SET TO SEARCH NEXT ENTRY ADB P16 DIRECTORY ENTRY ISZ TCNT DONE WITH TRACK? JMP UPDAT,I NO,CONTINUE ISZ UPDAT * LDA CURCH ARE WE PURGING EXTENTS? SZA,RSS JMP UPDTT NOPE * * SEARCH THE JUST COMPLETED DIRECTORY TRACK FOR THE EXTENTS * OF ANY OVERLAID FILES * LDA #PF ANY SO FAR? SZA,RSS JMP UPDTT NO, CONTINUE CMA,INA STA PCNT SAVE AS A COUNTER LDB LWAM GET ADDRESS OF 1ST ENTRY ADB N3 * PEXT0 LDA \BUFA AND ADDRESS OF BUFFER TO SEARCH STB TEMP3 PEXT1 STA BPTR SAV BOTH ADDRESS POINTERS * STA TEMP2 LDA TEMP2,I GET WORD 0 OF A FILE DIRECTORY ENTRY SSA JMP PEXT2 ALREADY PURGED SZA,RSS JMP PEXT2 NOT A VALID ENTRY CPA B,I CHARACTERS 1&2? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 3&4? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 5&6 RSS JMP PEXT2 NO CCA STA BPTR,I YES, SO PURGE THE EXTENT ISZ REWRT SET TO REWRITE THE DIRECTORY TRACK * PEXT2 LDA BPTR POINT TO NEXT FILE ENTRY ADA P16 LDB TEMP3 CPA DTEND DONE? RSS JMP PEXT1 NO CONTINUE WITH TRACK BUFFER ADB N3 MOVE TO NEXT LIST ENTRY ISZ PCNT DONE WITH FILE LIST? JMP PEXT0 JMP UPDTT YES * UPDTT LDA REWRT DOES THIS ONE NEED TO BE REWRITTEN? SZA,RSS JMP INCRT NO, NO ENTRIES WERE PURGED * LDB \BUFA REWRITE THE THIS DIRECTORY TRACK CLE JSB DISKD * INCRT ISZ TEMP4 DONE WITH THE DIRECTORY? RSS JMP UPDAT,I YES * CCA ADA \TRAK NO, UPDATE THE DISK ADDRESS STA \TRAK BUMP TO PREVIOUS TRACK ( THE CLxþúA NEXT DIRECTORY TRACK) STA \SECT CCE LDB \BUFA JSB DISKD READ NEXT DIRECTORY TRACK CLA STA REWRT CLEAR LDA \D#ST SET LOOP COUNTER RAL,RAL CMA,INA LDB \BUFA AND BUFFER POINTER ISZ UPDAT JMP UPDAT,I * PCNT NOP LOOP COUNTER OF PURGED FILES DTEND NOP END OF DIRECTORY TRACK BUFFER N384 DEC -384 SKP * * PURGT PURGES AND DISPLAY FILE FOR ONE OF TWO REASONS: * A FILE OVERLAID BY THE NEW SYSTEM * A TYPE 6 FILE SPECIFIED BY THE USER TO BE PURGED * PURGT NOP LDB BPTR INSERT THE FILE LDA B,I NAME INTO THE STA MS29 OUTPUT MESSAGE INB BUFFER LDA B,I STA MS29+1 INB LDA B,I STA MS29+2 LDA P6 LDB MES29 JSB \DSPL OUTPUT THE FILE NAME * ISZ REWRT FLAG TO REWRITE DIRECTORY TRACK CCA STA BPTR,I SET WORD 0 OF ENTRY TO PURGE IT LDA CURCH SZA,RSS PURGE THE EXTENTS AND CLEAR THE SIZE WORD? JMP PURGT,I NO * * ENTERS THE FILE NAME SO ITS EXTENTS CAN LATER * BE SEARCHED FOR AND PURGED * & CLEAR THE SIZE WORD TO PREVENT RECOVERY OF DISC SPACE * LDB BPTR FIRST CLEAR THE SECTOR SIZE WORD ADB P6 SINCE OVERLAID FILES' SPACE CANNOT CLA BE RECOVERED STA B,I ADB N1 SEE IF THIS IS AN EXTENT FILE ENTRY LDA B,I IF SO, DON'T RE-ENTER THE FILE ALF,ALF NAME IN THE LIST AND B377 SZA JMP PURGT,I IT WAS ISZ #PF INCREMENT # ENTRIES IN FILE LDB PENT LDA MS29 STORE FILE NAME IN LIST STA B,I UPWARDS INB LDA MS29+1 STA B,I LDA MS29+2 INB STA B,I LDA PENT ADA N3 READY FOR NEXT ENTRY STA PENT JMP PURGT,I * PENT NOP ADDRESS OF NEXT ENæùþúTRY TO USE #PF NOP # OF PURGED FILE ENTRIES SKP \BLIN NOP OUTPUT A BLANK LINE. LDB DBLNK CLA,INA JSB \DSPL JMP \BLIN,I SPC 4 \DSPL NOP DISPLAY MESSAGE ON OPERATOR CONSOLE STA DSPL STB DSPB JSB EXEC DEF *+5 DEF P2 DEF OPLU DSPB NOP DEF DSPL JSB LOOP WAIT UNTIL DEVICE AVAILABLE JMP \DSPL,I TO RETURN * DSPL NOP SPC 4 LOOP NOP LOOPS ON A STATUS CHECK UNTIL LOOPS JSB EXEC THE DEVICE IS NO LONGER DEF *+5 BUSY DEF P13 DEF OPLU DEF IEQT5 DEF IEQT4 * LDA IEQT5 AND M1400 SZA JMP LOOPS JMP LOOP,I * M1400 OCT 140000 SKP * * CONVERT A TO ASCII AT B * * THE \CVAS SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. * * CALLING SEQUENCE: * \CLEN = MAXIMUM # WORDS IN ANSWER * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB \CVAS * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CVAS NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA CTEMP PUT NUMBER IN TEMPORARY LDA \CLEN GET # WORDS CPA P1 IF ONLY 1 THEN ADB P2 ADVANCE 2 POWERS STB RANAD SET OWER RANGE ADDRESS LDB N2 ALSO SET LOOP COUNT CPA P1 INB ONCE FOR 2 WORDS STB TCNT LDB CTEMP NUMBER INTO B NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER pvþú STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CVAS,I YES - RETURN * OPWRS DEF *+1 OCT 1000 M100 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 1000 DEC 100 P10 DEC 10 P1 DEC 1 * \CLEN NOP MAXIMUM # WORDS IN ANSWER CURAT NOP BUFFER ADDRESS TCNT NOP TEMPORARY LOOP COUNTER CTEMP NOP SPC 6 * * GET DIGIT FOR \CVAS * * GETD PROVIDES THE ASCII CHARACTERS FOR \CVAS. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * RANAD NOP SKP * * CONVERT OCT ASCII TO BINARY * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN BUFR FROM * TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCB SET FOR HIGH CHAR STB BUFUL LDA \BUFA STA BPTR CLA STA OCTNO OCTNO = OCTAL NU2þúMBER GETNX LDB BUFUL GET UPPER-LOWER FLAG IGNOR LDA BPTR,I GET CHAR FROM BUFFER SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ BPTR INCR BUFFER ADDRESS STB BUFUL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR YES ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA N8 ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 ADA A SET A = OCTNO X 8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN * TCHAR NOP TEMP CHAR SAVE AREA. OCTNO NOP OCTAL DIGIT. BLANK OCT 40 BUFUL NOP UPPER/LOWER CHARACTER = -1/0 MAXC NOP MAXIMUM # DIGITS IN CONVERSION L60 OCT -60 HED SWTCH CONSTANTS AND STORAGE. * DESTINATION => GENERATION-DEFINED SYSTEM * \DCH NOP DESTINATION SYSTEM DISC CHANNEL \DSUB NOP " " " SUBCHANNEL DEQT NOP " " " EQT TYPE \DUNT NOP " " " UNIT \DFTR NOP " " " FIRST TRACK/CYLINDER \DNTR NOP " " " NUMBER TRACKS \DSHD NOP " " " STARTING HEAD (7905/7920) \DNSU NOP " " " NUMBER SURFACES " \DNSP NOP " " " " SPARES " \D#ST NOP " " " þú SECTORS/TRACK \D#WT NOP " " " WORDS/TRACK DTTY NOP " TTY CHANNEL DPI NOP " PI CHANNEL DTBG NOP " TBG CHANNEL SPC 3 * TARGET => TEMPORARY STORAGE FOR NEW SYSTEM * \TCH DEC -1 TARGET DISC CHANNEL \TSUB DEC -1 " " SUBCHANNEL \TUNT DEC -1 " " UNIT (7905/7920) SKP * MES15 DEF *+1 ASC 20,TRANSFER CANCELLED AND SWTCH TERMINATED. MES27 DEF *+1 ASC 10,OVERLAID FMP FILES: MES28 DEF *+1 ASC 10,TYPE 6 FILES PURGED: MES29 DEF *+1 MS29 ASC 6, MES31 DEF *+1 ASC 5,FILE ERR - MS31A BSS 0 MES33 DEF *+1 ASC 7,SWTCH FINISHED SPC 3 \BOOT NOP "WE'RE BOOTING" FLAG FOR DISKD (0=NOT NOW) AUTO DEC -1 AUTO BOOT-UP FLAG (0=NO, 1=YES) \SAVE DEC -1 SAVE TARGET FILES(0=NO,1=YES,-1=OVERLAYS SOME) TYP6 DEC -1 PURGE TYPE 6 FILES FLAG (0=NO, 1=YES) SUBI DEC -1 INITIALIZE SUBCHANNELS FLAG," " BATCH DEC -6 BATCH MODE ( NO<=0, YES>=1 ) #EQTS NOP NUMBER OF DESTINATION EQT'S CURCH DEC 0 CURRENT CHANNEL COUNTER PONRT NOP "POINT-OF-NO-RETURN" FLAG (0=OK,1=WILL,-1=DONE) D.LT DEC -1 LAST DIRECTORY TRACK FROM TARGET'S CD D.# NOP # DIRECTORY TRACKS FROM TARGET'S CD TAT NOP DISK ADDRESS OF TAT IN NEW SYSTEM \FFMP NOP FIRST LOGICAL FMP TRACK AT TARGET #SUBC NOP NUMBER OF DEFINED DISK SUBCHANNELS HDFLG NOP HEADER FLAG \LU2 DEC -1 LU 2 OR 3 FLAG OLDNU NOP =0 OLD FMGR FORMAT, =1 NEW FORMAT ND#WT NOP NEGATIVE DEC # WORDS/TRACK * \LNTH NOP LENGTH OF READ/WRITE \INIT NOP DISKD COMMAND MASK \TRAK NOP DESTINATION DISK ADDRESS \SECT NOP \BUFA DEF BUFR BPTR NOP BUFR POINTER EOFLG NOP REWRT NOP RE-WRITE TRACK FLAG SIZE NOP # BLOCKS IN FILE \STRK NOP # TRACKS IN FILE (PLUS 8) * TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP " TEMP4 NOP " TEMP5 NOP " TEMP6 NOP " * PI Ò"&$ EQU 1737B TBG EQU 1674B SYSTY EQU 1675B * IEQT4 NOP IEQT5 NOP SKP P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P8 DEC 8 P9 DEC 9 P13 DEC 13 P16 DEC 16 P22 DEC 22 P20 DEC 20 P32 DEC 32 P48 DEC 48 P64 DEC 64 P128 DEC 128 P1024 DEC 1024 P6144 DEC 6144 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N6 DEC -6 N8 DEC -8 N16 DEC -16 N126 DEC -126 N128 DEC -128 * B17 OCT 17 B60 OCT 60 B377 OCT 377 B1776 OCT 177600 B1777 OCT 177760 B7777 OCT 77777 * OPLU DEC 1 DEFAULT OPER CONSOLE LU (MAY * BE OVERWRITTEN) CNTR NOP DBLNK DEF BLNK BLNK OCT 20040 * * DCB BSS 144 ERR NOP LLEN NOP * \TMT DEF *+1 BSS 160 * END EQU * * * END SWTCH ª&ÿÿ ÿý5D ÿ92067-18326 1903 S C0122 &SWSG1              H0101 ‡„þúASMB,Q,R,C HED SWTCH - SWSG1, 7900 DISK DRIVER SEGMENT NAM SWSG1,5,10 92067-16326 REV.1903 790321 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWSG1 * SOURCE: 92067-18326 * BINARY: 92067-16325 * WRITTEN BY: KFH * **************************************** * * * ENTRY POINTS * ENT \DSK0,\STD0 ENT \INP0,\INT0 ENT \FLGT * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \TCH,\TSUB,\DFTR,\DNTR,\D#ST,\D#WT EXT \INIT,\LNTH EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \DSUB,\XOUT,\BUFA EXT \BOOT,\TMT,\LU2 EXT \TRAK,\SECT * * A EQU 0 B EQU 1 SUP SKP BEG0 LDA P96 SET #SECTORS/TRACK STA \D#ST MPY M100 STA \D#WT AND THE #WORDS/TRACK LDB \DSUB SEGMENT'S ENTRY POINT ADB \TMT OFFSET INTO TRACK MAP TABLE BUFFER LDA B,I GET FIRST WORD OF SUCHANNEL'S ENTRY STA \DFTR SET STARTING TRACK ADB P8 POSITION TO SECOND WORD OF SUBCH'S ENTRY LDA B,I AND GET ITS STA \DNTR # OF TRACKS JMP \SWTM RETURN SPC 3 TEMP BSS 3 TEMP FOR INTIALIZATION * M100 OCT 100 B177 OCT 177 M440 OCT 440 M0100 OCT 10000 M1776 OCT 177600 M7700 OCT 177700 * N10 DEC -10 * P10 DEC 10 P2 DEC 2 P4 DEC 4 P8 DEC 8 P9 DEC 9 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 DEC 17 P18 DEC 18 P25 DEC 25 P96 DEC 96 * \INP0 OCT 1 ¡þú01000 INITIALIZE, WRITE PROTECT COMMAND BITS \INT0 OCT 100000 " " " SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD0 NOP LDA \TCH SAVE TARGET DISK CHANNEL STA TEMP1 LDA #DATA GET # WORDS TO BE CONFIGURED LDB HPDSK GET ADDRESS OF INSTR ADDR LIST STDS1 STA TEMP2 SAVE NO. OF INSTRUCTIONS STDS2 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR TEMP1 INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP2 SKIP - DONE WITH SET JMP STDS2 CONFIGURE NEXT INSTRUCTION * LDA TEMP1 DONE WITH COMMAND CHANNEL? CPA \TCH RSS JMP STDS3 YES LDA #CMND GET # COMMAND INSTRUCTIONS ISZ TEMP1 STEP TO COMMAND CHANNEL JMP STDS1 GO CONFIGURE * STDS3 LDA N10 CLEAR THE BAD TRACK STA TEMP TABLE LDB \FLGT GET ADDRESS OF TABLE CCA STA TEMP+2 SET TO NO BAD TRACKS STDS4 STA B,I SET TO -1 FOR NO ENTRY INB STEP TABLE ADDRESS ISZ TEMP DONE? JMP STDS4 NO, DO NEXT ONE STA B,I JMP \STD0,I RETURN * * #DATA ABS I/OTB-I/OTC # DATA INSTRUCTIONS #CMND ABS I/OTC-I/OTD # COMMAND INSTRUCTIONS HPDSK DEF I/OTB,I ADDR OF I/O INSTRUCTION LIST TEMP1 NOP TEMP2 NOP * ADDRESS OF BAD TRACK TABLE \FLGT DEF \STD0+1 WHICH OVERLAYS 10 WORDS OF \STD0 SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. * INIER JSB INTON TURN INTERRUPTS BACK ON LDA STATB GET STATUS AND AND M440 MASK SEEK CHECK CHECK AND END OF CYLINDER SZA,RSS BITS - IF NOT SET CONTINUE €lþúJMP INIE0 WITH BAD TRACK ROUTINE * LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P15 ELSE SEND BAD SPECIFICATION LDB ERR43 JSB \DSPL "INVALID DISC SPECIFICATIONS" JMP \XOUT TERMINATE SWTCH * INIE0 LDA \INIT SAVE THE \INIT STA TEMP2 FLAG WORD LDA DFCYF SET COMMAND STA \INIT TO FLAG TRACK DEFECTIVE CLE AND LDB \BUFA CALL JMP DISK0+1 DRIVER * INIEH ISZ TEMP+2 BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA P10 LDB \TSUB GET SUBCHANNEL ADB BLK0 ADD ASC BLANK 0 STB EMES1-1 SET IN MESSAGE LDB EMES1 SEND THE JSB \DSPL MESSAGE * INIES LDA \TRAK GET TRACK ADDRESS CMA,INA SET NEGATIVE FOR DECIMAL CONVERSION LDB P2 STB \CLEN FOR \CVAS LDB ALBUF SET BUFFER ADDRESS JSB \CVAS CONVERT THE NUMBER LDA P4 AND LDB ALBUF SEND JSB \DSPL THE TRACK NUMBER * * TRACK IS NOW FLAGGED AND REPORTED IT IS NOW ENTERED IN THE * BAD TRACK TABLE. * LDA \LU2 SHOULD IT BE ENTERED IN TABLE? SZA,RSS JMP DISK0,I NO, RETURN NOW LDA TEMP2 STA \INIT RESTORE IT LDA \TRAK GET THE TRACK ALF,ALF RAR ADA \DSUB STA TEMP1 AND SAVE LDB \FLGT GET THE BAD TRACK TABLE ADDRESS LDA N10 ALLOW 10 ENTRIES STA TEMP+1 SET COUNTER INIE1 LDA B,I GET ENTRY SSA NEGATIVE? JMP INIET YES - USE THIS ONE * INB NO ALREADY USED ISZ TEMP+1 STEP COUNT 10 YET? JMP INIE1 NO - TRY NEXT ONE * LDB ER41A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P17 LDB ERR41 JSB \DSPL "LIMIT OF 10 BAD TRACKS EXDEEDED" JMP \XOUT AND TERMINATE SWTCH * IN¿þúIET LDA TEMP1 GET SUBCHANNEL/TRACK STA B,I SET IN TABLE JMP DISK0,I GO FINISH INITILIZATION. * DFCYF OCT 100400 ALBUF DEF *+1 BSS 2 EMES2 ASC 10,BAD TRACKS PLATTER EMES1 DEF EMES2 BLK0 ASC 1, 0 * ERR41 DEF *+1 ASC 17,LIMIT OF 10 BAD TRACKS EXCEEDED ER41A DEF ERR41+17 ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 HED DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK51 DATA CHANNEL DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK56 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSKDR I/OTC DEF DSK01 COMMAND CHANNEL DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK71 I/OTD EQU * HED 7900 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO INIER * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 \DSK0 EQU * DISK0 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK ADA \DFTR ADD FIRST TRACK TO RELATIVE TRACK STA T#AC0 SAVE ABSOLUTE TRACóþúK LDB \TSUB GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT STB UN#IT SAVE UNIT NUMBER ADB M0100 SET COMMANDS LDA \INIT ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R#DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB \SECT GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB NSEC SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND M100 CHECK READY BIT SZA IF SET JMP NRERR GO TELL THE MAN * LDA T#AC0 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R#DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSKDR GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA \LNTH SET LENGTH STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP ERRCH CHECK ERROR STATUS * LDA \BOOT ARE WE BOOTING UP? §lþú SZA,RSS JMP DISKR NO,CONTINUE CLA LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STORE IN BITS RAL 11-6 OF THE OTA 1 SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 NOW DETERMINE IF WE'RE IN CPB P2 AN RTE-II OR RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III JMP A,I GO TO RTE! CLB MUST CLEAR THE MPFT LFB DJP A,I WELL SAID! * M2055 OCT 2055 M2011 OCT 2011 M1742 EQU 1742B * DISKR JSB INTON OK, SO TURN ON INTERRUPTS LDA \INIT CHECK IF MAY HAVE BEEN ALF,ALF FLAGGING A DEFECTIVE SLA TRACK, SO RETURN JMP INIEH TO REPORT IT JMP DISK0,I ELSE RETURN * ERRCH RAL,CLE,ERA CLEAR SIGN BIT CPA P9 WRITE PROTECT ERROR? (BITS 3,0) RSS CPA M2011 DATA PROTECT SWITCH ON? (BITS 10,3,0) JMP WRPTM YES - GO TELL 'EM * CPA P25 DEFECTIVE CYLINDER? (BITS 4,3,0) JMP DISBM * AND M100 ISOLATE READY BIT (BIT 2) SZA READY? JMP NRERR NO - GO TELL USER * CLA YES, TRY TO RECOVER JSB SEEK SEEK TO CYLINDER 0 ISZ EDCNT INCREMENT # TRIES JMP DSK16 NOT TEN YET GO TRY AGAIN * LDA \INIT 10 TIMES IN INIT PHASE? CPA \INT0 JMP INIER YES GO TO INIT ERROR ROUTINE * * JSB INTON TURN THE INTERRUPTS BACK ON LDA \TRAK INSERT THE TRACK IN THE MESSAGE CMA,INA NEGATE FOR \CVAS LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXX" LDA \INIT DETERMINE ACTION TO TAKE ALF,ALF RAR SLA IF WRITE PROTECT BIT SET,THEN JMP \XÌ[þúOUT TRACKS WERE BEING WRITTEN, SO EXIT LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO TO INIT ERROR ROUTINE JMP \XOUT ELSE TERMINATE SWTCH * * DISBM JSB INTON ON INTERRUPTS! LDA \INIT IF DEFECTIVE CYLINDER ALF,ALF IS BEING FLAGGED BY SLA INIER JMP INIEH IGNORE ERROR, GO REPORT TRACK * RAL IF WRITE PROTECT SET, THEN SLA THE SYSTEM IS BEING WRITTEN JMP IRERR AND THAT'S IRRECOVERABLE! * LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO FLAG IT DEFECTIVE * IRERR LDA \TRAK INSERT TRACK # IN MESSAGE CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT AND EXIT * * NRERR JSB INTON INTERRUPTS ON JSB \BLIN DISC NOT READY LDB MS33A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA P14 LDB MES33 TELL 'EM JSB \DSPL "READY DISC AND PRESS RUN" JSB $LIBR TURN OFF NOP CLF 0 DSK56 LIA 0 GET STATUS TO A HLT 33B PAUSE JMP RTRY ON RESTART, RETRY * * WRPTM JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS ON LDB MS32A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB MES32 JSB \DSPL "TURN OFF DISC PROTECT - PRESS RUN" JSB $LIBR OFF AGAIN NOP CLF 0 HLT 32B WAIT FOR IT JMP RTRY AND DO IT AGAIN * SPC 3 * * TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK71 CLF 1 JSB $LIBX DEF INTON SPC 2 * SEEK ROUTINE SEEK NOP DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SENýñþúD ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 * * WAIT AND STATUS ROUTINE STATC NOP DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 5 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP NSEC DEC -24 W#CMD OCT 010000 UN#IT NOP H#AD NOP S#EKC OCT 030000 R#DCM OCT 020000 DSKDR OCT 120000 MUST BE CONFIGURED T#AC0 NOP SKP * ESUB NOP CLA,INA SET FOR 1 WORD STA \CLEN CONVERSION LDA \TSUB GET CURRENT SUBCHANNEL # CMA,INA NEGATIVE FOR DECIMAL CONVERSION JSB \CVAS JMP ESUB,I * SPC 5 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 * MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 * MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 * END EQU * * END BEG0 * * END EQU * END BEG0 î64006ÿÿ ÿý  ÿ92067-18327 1903 S C0122 &SWSG2              H0101 ˆ…þúASMB,Q,R,C HED SWTCH - SWSG2, 7905 DISK DRIVER SEGMENT NAM SWSG2,5,10 92067-16327 REV.1903 790321 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************************* * * NAME: SWSG2 * SOURCE: 92067-18327 * BINARY: 92067-16325 * WRITTEN BY: KFH * ******************************************************************* * * * ENTRY POINTS * ENT \DSK5,\STD5,\BADH ENT \INP5,\INT5,\SETD * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \DFTR,\DNTR,\DSHD,\DNSU,\DNSP EXT \TCH,\TUNT,\DSUB,\DUNT,\TSUB,\D#ST,\D#WT EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \LNTH,\XOUT EXT \INIT,\BOOT,\SAVE EXT \TRAK,\SECT EXT \TMT EXT \FFMP,\STRK * * A EQU 0 B EQU 1 SUP SKP BEG5 JSB \SETD SEGMENT'S ENTRY POINT JMP \SWTM RETURN TO MAIN * * \INP5 OCT 041400 INITIALIZE ,WRITE PROTECT COMMAND BITS \INT5 OCT 001400 " " " FLGPT EQU \INP5 FLGDF OCT 021400 FLGSP OCT 101400 * \BADH NOP BAD TRACKS HEADER FLAG * M17 OCT 17 M37 OCT 37 M177 OCT 177 M174C OCT 17400 M7700 OCT 177700 M1776 OCT 177600 * N10 DEC -10 * P1 DEC 1 P2 DEC 2 P4 DEC 4 P5 DEC 5 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P18 DEC 18 SKP * * DETERMINE SUBCHANNEL SPECIFICATIONS, USING INFORMATION * RETRIEVED FROM THE \TMT ENTRY FOR \DSUB. * \SETD NOP LDA \DSUB GET DESTINATION SUBCHANNÏ—þúEL MPY P5 CONVERT TO 5 WORD PER ENTRY OFFSET LDB A ADB \TMT INTO THE \TMT BUFFER LDA B,I GET WORD 0 STA \D#ST AND SET THE SECTORS/TRACK ALF,RAL RAL STA \D#WT SET # WORDS/TRACK INB LDA B,I GET WORD 1 OF ENTRY STA \DFTR AND SAVE STARTING TRACK OF SUBCH INB LDA B,I GET WORD 2 OF ENTRY AND M17 ISOLATE THE UNIT # STA \DUNT AND SAVE LDA B,I NOW GET ALF,ALF AND MASK ALF AND M77 THE STA \DSHD STARTING HEAD LDA B,I ALF,RAL NOW ISOLATE RAL AND M77 THE STA \DNSU NUMBER OF SURFACES INB LDA B,I GET WORD 3 OF ENTRY CLE SET NO-INIT FLAG SSA CCE INIT WANTED FOR THIS SUBCH AND M7777 REMOVE SIGN BIT STA \DNTR SET THE # OF TRACKS INB LDA B,I AND FINALLY STA \DNSP SET THE # OF SPARES RESERVED CLA BUT CLEAR STA UBADC THE NUMBER USED JMP \SETD,I * M7777 OCT 77777 M77 OCT 77 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE \STD5 SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD5 NOP LDB HPDSK GET ADDR OF INSTRUCTION ADDR LIST LDA #DATA GET # INSTRUCTIONS TO CONFIGURE STA TEMP1 STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR \TCH INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP1 SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION * CCA SET NO HEADER STA \BADH FOR BAD TRACKS JMP \STD5,I RETURN * #DATA ABS I/OTB-I/OTC # DATA I/O INSTRUCTIONS HPDSK DEF I/OT‡~þúB,I ADDRESS OF INSTRUCTIONS TEMP1 NOP SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO * INITIALIZE A TRACK. * SPC 2 * EOCYL ENTRY CONDITIONS: * STATUS ERRORS 11 AND 14 * SEEK CHECK ON A STATUS 2 ERROR * OUT OF SPARES * EOCYL JSB INTON LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDB ERR43 ELSE SEND BAD SPECIFICATION LDA P15 JSB \DSPL MESSAGE AND JMP \XOUT TERMINATE SPC 2 * * BAD TRACK ENCOUNTERED - MARK IT DEFECTIVE AND SPARE IT * * INIER ENTRY CONDITIONS: FROM ERRDS, STWRT, & DEFTR * INIER ISZ \BADH BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA \DSUB CONVERT THE SUBCHANNEL TO ASCII CMA,INA LDB P1 STB \CLEN LDB EMES1 JSB \CVAS LDA P12 LDB EMES2 SEND THE JSB \DSPL MESSAGE LDA P16 SEND THE SECOND LINE: LDB EMES3 " LOGICAL CYL HD UNIT" JSB \DSPL AND AWAY IT GOES. INIES LDA \TRAK GET TRACK ADDRESS STA BTRAK AND SAVE IT * INBSP LDB ABTMS ADDRSS OF BAD TRACK JSB TRKMS SEND THE BAD TRACK NUMBERS * * TRACK IS NOW REPORTED TO THE OPERATOR * FLAGD LDA \DNSP GET THE # SPARES CPA UBADC OUT OF SPARES?? JMP EOCYL+1 YES GO SEND ERROR 43 AND TERMINATE * LDA FLGDF SET TO FLAG DEFECTIVE STA \INIT LDA \DNTR GET BASE SPARE TRACK ADDRESS ADA UBADC ADD NUMBER USED SO FAR STA \TRAK SAVE FOR DISK5 JSB DADTR GO TRANSLATE TO DISC ADDRESSES LDA PT#TR PICK UP THE CYL (B= HEAD) DST CYLA2 SET THE SPARE'S ADDR IN DEFECTIVE TRACK LDB MADDR GET BUFFER ADDRESS CLE SET TO WRITE JMP DISK5 FLAG THE TRACK DEFECTIVE * * DO A STATUS-WRITE TO THE NEXT SPARE TRAC[7þúK TO SEE IF IT IS: * - AVAIABLE FOR USE * - BEING USED AS A FMGR TRACK SPARE * - DEFECTIVE * INISS DLD CYLAD SET THE ADDR OF BAD TRACK IN DST CYLBD TEMPORARY STORAGE OF INIFS CLA RESET THE INIT FLAG STA \INIT FOR THE STATUS WRITE INA AND SET SKFLG TO INDICATE THIS MODE JMP SETSK * * INIFS IS BRANCHED TO WHEN A SPARE TRACK HAS BEEN FOUND * TO BE AVAILABLE FOR USE * INIFS LDA FLGSP SET IOR CHEKS POSSIBLY THE WRITE PROTECT BIT STA \INIT THE SPARING FLAG DLD CYLBD SET THE ADDRESS OF THE BAD TRACK DST CYLA2 IN THE SPARE TRACK CLA CLEAR THE MODE FLAG * SETSK STA SKFLG SET MODE TO 0/1 LDA \DNTR COMPUTE THE TRACK ADDRESS ADA UBADC AGAIN STA \TRAK SAVE FOR DISK5 CLE SET TO WRITE LDB MADDR GET BUFFER ADDRESS JMP DISK5 FLAG THE SPARE * * TRACK NOW SPARED - REPORT WHICH SPARE USED * INIRS LDA UBADC REPORT THE ADA \DNTR LOGICAL TRACK # OF THE LDB ASPMS USED SPARE JSB TRKMS OK LDA CHEKS RESET THE INIT FLAG STA \INIT AND LDA BTRAK GET BAD TRACK # AGAIN STA \TRAK AND RESET AS CURRENT TRACK ISZ UBADC STEP THE SPARE COUNTER JMP \DSK5,I CONTINUE WRITING & INITIALIZING * * UNAVAILABLE SPARE - EITHER DEFECTIVE OR ALREADY A FMGR SPARE * SO REPORT IT AND GO TRY THE NEXT ONE * NIXSP DLD CYLBD RESET THE ORIGINAL BAD TRACK ADDRESS DST CYLAD BECAUSE IT MUST BE REFLAGGED WITH A CCB NEW SPARE ADDRESS STB SKFLG ALSO MUST RE-SEEK TO THAT BAD TRACK LDA UBADC HERE IF SPARE IS BAD ISZ UBADC BUMP SPARE COUNT ADA \DNTR COMPUTE UNIT TRACK# JMP FLAGD DON'T REPORT BAD SPARE * BTRAK NOP ORIGINAL BAD TRACK # CYLBD BSS 2 4þú & ITS CYLINDER, HEAD/SECTOR ADDRESSES SKP * * REPORT BAD TRACK/ SPARE ROUTINE * * A = LOGICAL TRACK * B = ADDRESS OF FIRST 5 WORDS OF MESSAGE * PT#TR = CYL ADDRESS * H#AD = HEAD ADDRESS * UN#IT = UNIT ADDRESS * * JSB TRKMS * RETURN A,B MEANINGLESS * TRKMS NOP STB TRK01 SAVE THE ADDRESS CMA,INA SET UP TO CONVERT THE TRACK LDB P2 STB \CLEN LDB ALBUF TO THE MESSAGE BUFFER JSB \CVAS DO IT LDA PT#TR NOW CONVERT CMA,INA THE CYL. # LDB ACYLM TO THE MESSAGE JSB \CVAS LDA H#AD CONVERT THE HEAD ALF,ALF ADA BL0 STA HEDMS SET IT IN THE MESSAGE LDA UN#IT NOW THE UNIT ADA BL0 STA UNIMS SET IN THE MESSAGE LDA N6 STA MOV6 COUNTER LDA TRK01 GET THE PREAMBLE LDB EMES4 AND STB TEMP2 MOVE LDB A,I MOVE IT TO THE STB TEMP2,I MESSAGE ISZ TEMP2 INA ISZ MOV6 JMP MOVE LDA P15 SEND LDB EMES4 "XXXXXXXXXX LLLLL CCCCCC H U" JSB \DSPL TO THE TTY JMP TRKMS,I AND RETURN * MOV6 NOP N6 DEC -6 TEMP2 NOP TRK01 NOP ASPMS DEF SPMS ABTMS DEF BTMS ALBUF DEF TKMS ACYLM DEF CYLMS EMES4 DEF EMS4 EMES2 DEF *+1 ASC 11,BAD TRACKS SUBCHANNEL XX EMSS2 NOP LOCATION FOR XX EMES1 DEF EMSS2 BL0 ASC 1, 0 EMES3 DEF *+1 ASC 5, ASC 11, LOGICAL CYL HEAD UNIT EMS4 ASC 6,BAD TRACK TKMS ASC 3, CYLMS ASC 3, HEDMS ASC 2, UNIMS ASC 1, BTMS ASC 6,BAD TRACK SPMS ASC 6,SPARED TO ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 UBADC NOP # USED SPARES SPC 7 * SWTCH DISC DRIVER I/O INSTRUCTION ADDRESSES * I/OTB DEF DSKDR DATA CHANNEL DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 aþú DEF DSK28 DEF DSK29 DEF DSK30 I/OTC EQU * HED 7905 I/O DISC DRIVER * THE DISK5 SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER. FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN * THE IRRECOVERABLE ERROR EXIT AT EOCYL IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * THEN: IF THE INIT FLAG IS SET GO TO EOCYL, * ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * * THE \DSK5 ROUTINE INTERCEPTS ALL I/O CALL TO DISK5 AND SETS THE * PROPER VALUES FOR THE FLAG WORD CHEKS AND THE FILE MASK * INSTRUCTION FILMK. THEIR VALUES DEPEND ON WHETHER A READ * OR A NORMAL WRITE VERSUS AN INITIALIZE WRITE IS BEING DONE. * FOR INITIALIZE WRITES, A REGULAR WRITE WITH SPARING DISABLED * IS DONE FIRST IN ORDER TO DETECT THE PRESENT STATUS OF THE * TRACK (IE, POSSIBLY DEFECTIVE) SO THAT THAT STATUS MAY BE * ACKNOWLEDGED. CHEKS CONTAINS THE ORIGINAL VALUE OF \INIT * AS SET BY THE CALL FROM SWTCH'S MAINLINE CODE - UNLESS IT WAS * A READ CALL IN WHICH CASE IT IS SET TO 0. \INIT IS THEREFORE * THE TEMPORARY VALUE PERTAINING TO EACH I/O CALL AND MAY BE * 0 FOR A REGULAR READ/WRITE, OR SET TO THE VALUES FOR FLAGGING * PROTECTED, DEFECTIVE, AND/OR SPARE TRACKS. * \DSK5 NOP SEZ IF A READ CALL CLA,RSS THEN ALWAYS SET TO 0 LDA \INIT ELSE GET THE INTENDED MODE STA CHEKS AND SAVE SZA IF AN INITIALIZE WRITE JMP SET5 THEN GO SET THE íþú\INIT & FILMK VALUES STA SKFLG CLEAR DEF-SEEK/SPARE-STATUS FLAG LDA FLMWS OTHERWISE ENABLE SPARING STA FILMK ON ALL ACCESSES JMP DISK5 AND GO DO IT! * SET5 CLA CLEAR THE INIT MODE FLAG STA \INIT TO SIGNAL A WRITE FOR STATUS PURPOSES STA SKFLG CLEAR DEFECTIVE-SEEK/SPARE-STATUS FLAG LDA FLMNS DISABLE SPARING SO DEFECTIVE & STA FILMK AND SPARE TRACKS CAN BE DETECTED JMP DISK5 * CHEKS NOP ORIGINAL TRANSFER MODE OF I/O CALL FLMNS OCT 107400 FILE MASK WITH NO AUTOMATIC SPARING FLMWS OCT 107404 FILE MASK WITH AUTOMATIC SPARING SKFLG NOP DEFECTIVE-SEEK = -1 / SPARE-STATUS = 1 / ELSE 0 SKP * * DISK5 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK GET TRACK ADDRESS JSB DADTR TRANSLATE THE TRACK ADDRESS LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA WRTCM GET THE WRITE COMMAND ADA \INIT ADD THE INIT CODE STA W#CMD AND SET IT LDA \INIT GET THE INIT CODE CPA FLGDF IF FLAGGING A DEFECTIVE TRACK JMP OFF THEN SKIP ADDRESS SETUP FOR SEEK LDA PT#TR GET THE CYLINDER LDB \SECT SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES * LDA \INIT IF FLAGGING A SPARE AND M137 CPA FLGSP JMP OFF THEN SKIP THE SECOND ADDRESS SET UP LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND * OFF JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 ƒ‘þúSET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB WRITE? JMP DSEEK NO, GO DO REGULAR READ SEQUENCE * LDA CHEKS GET INITIAL TRANSFER MODE SZA,RSS JMP WSEEK GO DO A REGULAR WRITE LDA \INIT IS THIS THE FIRST WRITE FOR STATUS? SZA,RSS JMP WSEEK THEN MUST SEEK LDA SKFLG MUST SEEK FOR A SECOND-TIME-AROUND DEFECTIVE SZA FLAGGING, OR STATUS-WRITE TO A SPARE JMP WSEEK GO SEEK * LDA W#CMD SINCE A WRITE WAS JUST DONE JSB XFER WITH NO END COMMAND ISSUED, A SEEK DEF ADRES-1 NEEDN'T BE DONE DEF R/WCM JMP CKSTA CHECK ERROR STATUS * WSEEK LDA W#CMD SET TO WRITE DSEEK JSB XFER STANDARD TRANSFER WITH SEEK DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JMP FAULT 01 ILLEGAL OP - PROGRAM FAULT JMP FAULT 02 UNIT AVAIL. PROGRAM FAULT JMP FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 04 " " " " JMP FAULT 05 " " " " JMP FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JMP FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JMP FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JMP FAULT 15 UNIMPLEMENTED ERROR CODE - è²þúFAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JMP ISPAR 20 ILLEGAL SPARE JMP DEFTR 21 DEFECTIVE TRACK JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JMP FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 25 " " " " JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. SKP * * ERRDS ENTRY CONDITIONS: * STATUS 10,16,17 ERRORS * VERIFY ERROR * INVALID STATUS 2 ERROR * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN * LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP DSKER NO, SO FLAG THE ERROR JSB INTON TURN THE INTERRUPTS BACK ON JSB STWRT IF STATUS WRITE, BRANCH APPROPRIATELY CPA \INT5 INIT ONLY? RSS CPA \INP5 INIT,WRITE PROTECT? JMP INIER YES, GO SPARE IT CPA FLGDF IF TRACK IS BEING SET JMP INISS DEFECTIVE - GO CHECK THE SPARES AND M137 CPA FLGSP IF TRACK IS BEING SPARED JMP NIXSP THEN MUST TRY ANOTHER RSS SKIP INTON CALL * * DSKER JSB INTON LDA \TRAK ERROR MESSAGE CONTAINING THE CMA,INA TRACK # LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXXX" JMP \XOUT SPC 2 * * IF A STATUS-WRITE FOR EITHER A REGULAR TRACK OR * FOR A SPARE TRACK, BRANCH APPROPRIATELY FOR THE ERROR * STWRT NOP LDA \INIT GET THE PRESENT MODE SZA,RSS IF STATUS THEN LDA SKFLG CHECK IF CHECKING A SPARE'S STATUS CPA P1 IN WHICH CASE A NEW JMP NIXSP SPARE MUST BEµCþú GOTTEN SZA,RSS OTHERWISE, JMP INIER THIS TRACK MUST BE MARKED DEFECTIVE JMP STWRT,I RETURN TO ERRDS OR DEFTR FOR MORE CHECKS SKP * * STATUS 21 ERROR - CHECK IF INITIALIZING OR NOT * DEFTR JSB INTON TURN INTERRUPTS BACK ON LDB CHEKS WAS THIS A WRITE WITH STATUS SZB,RSS CHECKING? JMP FAULT NO - REGULAR READ/WRITE WITH NO RECOVERY * JSB STWRT IF A STATUS-WRITE, BRANCH APPROPRIATELY CPA FLGDF WAS IT JUST MARKED DEFECTIVE? JMP INISS YES, SO GO SPARE IT NOW AND M137 MASK OFF POSSIBLE WP BIT CPA FLGSP WAS IT JUST SPARED? JMP NIXSP YES, GO TRY ANOTHER SPARE JMP INIER OTHERWISE, FLAG DEFECTIVE & SPARE IT SKP * * ILLEGAL SPARE (STATUS 20 ERROR) * - IF NOT INITIALIZING THE SYSTEM * SUBCHANNEL IN FILESAVE MODE, THEN IGNORE * ISPAR LDB CHEKS WAS THIS A WRITE INITIALIZE? SZB,RSS JMP FAULT-1 NO, SO STATUS 20 ERROR IS VALID * LDA SKFLG IF CHECKING THE STATUS OF A SPARE CPA P1 THEN CHECK FURTHER IF RSS IT IS AVAILABLE FOR USE JMP END01 OTHERWISE IGNORE ERROR & CONTINUE * * IF NOT THE SYSTEM SUBCHANNEL OR NOT SAVING FILES, * THEN RE-USE THE TRACK. * LDA \DSUB IS THE SYSTEM SUBCHANNEL CPA \TSUB BEING INITIALIZED? RSS JMP USESP NO - SO SPARE CAN BE REUSED LDB \SAVE ARE FILES BEING SAVED? SZB JMP GETBD YES, SEE IF IT LIES IN THE FMGR SPACE * USESP JSB INTON TURN INTERRUPTS BACK ON JMP INIFS GO REUSE IT * NEXTS JSB INTON TURN INTERRUPTS BACK ON JMP NIXSP AND TRY NEXT SPARE TRACK * * STILL INITIALIZING THE SYSTEM SUBCHANNEL, CHECK IF TRACK * BELONGS TO THE FMGR AREA. * GETBD LDB N3 MUST READ THE ADDRESS OF THE DEFECTIVE STB \LNTH THAT WAS STORED IN THIS SPARE LDB DPBUF #xþúGET THE 3-WORD PREAMBLE BUFFER ADDR LDA RFSCM AND THE READ FULL SECTOR COMMAND JSB XFER AND PERFORM THE READ DEF ADRES-1 ADDRESS OF COMMAND TABLE, -1 DEF R/WCM ADDRESS OF LAST COMMAND TO EXECUTE * LDA \D#WT RESET THE LENGTH OF DMA TRANSFER CMA,INA STA \LNTH TO ONE TRACK LDA HDSSP GET THE HEAD/SECTOR ADDR ALF,ALF ROTATE TO LOW BYTE AND M37 AND ISOLATE STA HDSSP SAVE ONLY THE HEAD # * LDB \SAVE LDA \FFMP GET FIRST LOGICAL FMP TRACK SSB IF SOME WERE OVERLAID LDA \STRK THEN GET NEXT TRACK AFTER SYSTEM JSB DADTR CONVERT FIRST FMP TRACK TO CYL & HEAD * * CHECK IF DEFECTIVE TRACK LIES WITHIN CURRENT SUBCHANNEL DEFINITION * LDA N9 CLEAR SURFACE BUFFER STA TEMP1 SET LOOP COUNTER CLA LDB DSBUF GET BUFFER ADDRESS STA B,I INB ISZ TEMP1 DONE? JMP *-3 NO * LDA \DNSU GET # SURFACE OCCUPIED BY SYSTEM CMA,INA SUBCHANNEL, AND SET AS A STA TEMP1 LOOP COUNTER CLB,INB GET 'OCCUPIED' INDICATOR LDA \DSHD GET STARTING HEAD # ADA DSBUF AND OFFSET INTO BUFFER SETDS CPA ESBUF END-OF-BUFFER? JMP CHEKK (ERRONEOUS DEF'N) STB A,I MARK SURFACE AS ONE OCCUPIED BY SYS SUBCH INA BUMP BUFFER ADDRESS ISZ TEMP1 DONE? JMP SETDS NO * CHEKK LDA HDSSP GET HEAD # OF DEFECTIVE TRACK ADA DSBUF AND GET CORRESPONDING ENTRY IN TABLE LDB A,I SZB,RSS POSSIBLY WITHIN THE SYS SUBCH? JMP USESP NO, SO SPARE CAN BE RESUED * * COMPARE WITH FIRST FMP CYLINDER * LDB PT#TR GET STARTING CYLINDER OF FMP CMB,INB AND COMPARE WITH DEF TRACK'S CYLINDER ADB CYLSP SSB JMP USESP DEFECTIVE TRACK CYLINDER IS LESS SZB GREATER?©ˆþú JMP CLAST YES, SO CHECK WITH LAST FMP TRACK * * SEE IF DEFECTIVE HEAD PRECEEDS STARTING HEAD OF FMP * LDA H#AD GET FIRST FMP HEAD# ALF,ALF INTO LOW BYTE AND M37 AND ISOLATE SZA,RSS IF ZERO THEN JMP NEXTS NO HEAD PRECEEDS IT - TRY NEXT SPARE CMA,INA ADA HDSSP GET DEFECTIVE HEAD# AND COMPARE WITH THAT SSA,RSS OF THE FIRST FMP - LESS? JMP NEXTS NO, THIS SPARING MUST BE PRESERVED - TRY NEXT JMP USESP GO AHEAD AND USE THIS SPARE * * SEE IF DEFECTIVE TRACK'S CYLINDER IS > LAST FMP CYLINDER * CLAST CCA CONVERT LAST TRACK ON SUBCHANNEL ADA \DNTR TO PHYSICAL CYLINDER AND HEAD JSB DADTR ADDRESSES LDB CYLSP GET DEFECTIVE TRACK CYL CMB,INB AND COMPARE WITH LAST FMP CYL ADB PT#TR JUST COMPUTED SSB GREATER? JMP USESP YES, REUSE THAT SPARE SZB LESS? JMP NEXTS YES, TRY FOR NEXT SPARE * * SEE IF DEFECTIVE HEAD# IS > LAST FMP CYL HEAD# * LDA H#AD GET LAST FMP HEAD ALF,ALF ISOLATE AND M37 LDB HDSSP COMPARE WITH HEAD# OF DEFECTIVE TRACK CMB,INB ADA B SSA,RSS JMP NEXTS TRY ANOTHER TRACK JMP USESP REUSE THAT SPARE SPC 2 DPBUF DEF *+1,I PREAMBLE BUFFER NOP CYLSP NOP CYLINDER ADDR STORED IN SPARE HDSSP NOP HEAD/SECTOR ADDR STORED IN SPARE N3 DEC -3 N9 DEC -9 RFSCM OCT 3000 * DSBUF DEF *+1 BSS 9 SUBCHANNEL SURFACE BUFFER ESBUF DEF * SKP * * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO NRERR TO WAKE 'EM UP * PROTECTED SEND TURN ON THE SWITCH MESSAGE * ST2ER SSB,RSS IF NO STATUS 2 ERROR THEN JMP ST2 TRY FOR A FORMAT PROTECT SWITCH ERROR * LDA B STfþúATUS 2 TO A AND P4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO TERMINATE JMP NRERR OTHERWISE, IT MUST NOT BE READY * ST2 LDA MADDR WAS THIS A READ OR A WRITE? SSA JMP ERRDS READ - SO NEEDN'T WORRY ABOUT SWITCHS * LDA B GET THE STATUS WORD AGAIN AND M40 KEEP FORMAT BITS SZA,RSS SET?? JMP WRPTM TURN ON FORMAT SWITCHH LDA B GET STATUS -2 AGAIN AND M100 GET PROTECTED BIT SZA,RSS JMP ERRDS JUST COUNT THE ERROR AND TRY AGAIN * * * FORMAT/PROTECT ERROR - WARN 'EM AND WAIT * WRPTM STA TEMP2 SAVE BITS OF STATUS-2 JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS LDA TEMP2 LDB MS34A SZA LDB MS32A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA TEMP2 RETRIEVE THOSE BITS LDB MES34 "TURN ON FORMAT SWITCH - PRESS RUN" SZA LDB MES32 "TURN OFF DISK PROTECT - PRESS RUN" LDA P18 JSB \DSPL * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 HLT 32B WAIT FOR TURN ON JMP RTRY TRY AGAIN. SPC 1 * * NOT READY ERROR - WARN 'EM AND WAIT * NRERR JSB INTON JSB \BLIN DISC IS NOT READY LDB MS33A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P14 LDB MES33 SEND THE WORD TO THE MAN JSB \DSPL "READY DISC AND PRESS RUN" * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 LDA STATB HLT 33B PAUSE JMP RTRY ON RESTART RETRY SPC 5 * * ENTRY CONDITIONS: * STATUS ERRORS 1,2,12 * UNIMPLEMENTED STATUS ERRORS 3,4,5,6,13,15,24,25 * FROM DEFTR ON A STATUS ERROR 21 * FROM ISPAR ON A STATUS ERROR 20 * JSB INTON TURN ON INTERRUPTS FORXaþú MESSAGE FAULT LDA \TRAK CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT TERMINATE SPC 4 ESUB NOP CLA,INA SET FOR A 1-WORD CONVERSION STA \CLEN LDA \DSUB GET CURRENT SUBCHANNEL CMA,INA JSB \CVAS JMP ESUB,I SKP SPC 1 ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 M100 OCT 100 M137 OCT 137777 UN#IT NOP * SPC 3 * * INTON TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK30 CLF 0 CLC 6 JSB $LIBX DEF INTON SPC 3 * UWAIT WAIT FOR UNIT TO BECOME AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * SPC 3 * * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL ISZ EDCNT CHECK COUNT RSS JMP DSKER LDA CALC GET COMMAND JMP UWAT1 GO SEND IT SKP * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * ALSO IF DOING INITIALIZE AND NOT FLAGGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * NOTE: AN 'END' COMMAND IS NOT ISSUED IF A WRITE FOR STATUS PURPOSES * WAS JUST DONE, ALLOWING THE SEEK TO BE SKIPPED WHEN RE-WRITING . * ENDOK LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP ENDSX NO, JUST GO SEND THE END COMMAND * END01 LDA \INIT FIRST TIME THRU FOR THE SZA STATUS ONLY? JMP END02 NO - JUST DID THO¾þúE REAL THING JSB INTON TURN INTERRUPTS BACK ON FIRST LDA SKFLG IF THE STATUS CHECK WAS TO A CPA P1 POTENTIAL SPARE TRACK JMP INIFS THEN NEEDN'T SEND THE END * STB \INIT YES, NOW THE THE CORRECT INIT FLAG LDB MADDR GET BUFFER ADDRESS CLE CLEAR FOR A WRITE JMP DISK5 NOW DO THE REAL INITIALIZE (NO END WAS DONE) * END02 RAL,SLA IF SPARING JMP STDAD THE SEEK ADDRESS IS ALREADY SET * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB \LNTH EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * SEND THE END COMMAND * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT LDA \BOOT ARE WE BOOTIN UP? SZA,RSS YES, SO GO DO IT! JMP ENDBR NO LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STORE IN BITS RAL 11-6 OTA 1 OF THE SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 DETERMINE IF WE'RE IN AN CPB P2 RTE-II OR AN RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III/IV JMP A,I GO TO RTE! CLB MUST CLEAR THE BASE PAGE FENCE SETTING LFB DJP A,I WELL SAID! * M2055 OCT 2055 M1742 EQU 1742B * ENDBR JSB INTON LDA \INIT CPA FLGDF BRANCH APPROPRIATELY, JMP INISS FLAGGING DEFECTIVE - NOW GET A SPARE AND M137 CPA FLGSP JMP INIRS FLAGGING A SPARE - RESET \TRAK & \INIT JMP \DSK5,I AND EXIT SKP * * * XFER:þú THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER. THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE DMA OTA 6 SEND CW1 CLC 2 PREPARE MEM ADDR REG FOR CW2 OTB 2 SEND CW2 STC 2 PREPARE WORD CNT REG FOR CW3 LDA \LNTH OTA 2 SEND CW3 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPB ACTCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC 0 TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA 0,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C ACTIVATE THE DMA DSK22 STC 0 START THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT SKP * * * XFER COMMAND TABLE * WAITC OCT 113000 WAKEUP COMMAND SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND õÔþú VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF SEEKC DEF VERCM DEF CALC DEF ADRES ACTCM DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF RFSCM #UNST ABS UNITC-*+1 NUMBER IN THE LIST SKP * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * UNIT AT: UN#IT ALSO RETURNED IN A. * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * JSB DADTR CALL * * DADTR NOP CLB DIVIDE # TRACKS BY DIV \DNSU NUMBER OF HEADS/CYL ADA \DFTR ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS ADB \DSHD ADD THE BASE HEAD ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE LDA B PUT INTO A TO AND M174C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT FROM LOW B LDA \TUNT STA UN#IT STORE IT AS PROMISED JMP DADTR,I RETURN A= UNIT, B=HEAD * PT#TR NOP H#AD NOP SKP * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA 0,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB 0,C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN SPC 3 * * * OUTCC OUTPUT THE COMMAND WORD IN THE A-REG * OUTCC NOP DSK26 CLC 0 SEND "HERE COME DE WORD" DSK27 OTA 0,C SEND ñ@ljfDE WORD DSK28 STC 0 SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN SPC 3 * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS 0 HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN SPC 3 * * STACC OCT 1400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP R#DCM OCT 102400 W#CMD NOP DSKDR ABS 0 DMA CONTROL WORD MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 MES34 DEF *+1 ASC 18,TURN ON FORMAT SWITCH - PRESS RUN MS34A DEF MES34+18 MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * * END EQU * END BEG5  lÿÿ ÿý' ÿ92067-18328 2013 S C0122 &.SETB              H0101 ”YþúASMB,R,L,C,Q * NAME: .SETB * SOURCE: 92067-18328 * RELPC: 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .SETB,7 92067-1X328 REV.2013 780921 * * * ENT .SETB,.CLRB * EXT $LIBR,$LIBX,!BITM * * SUP SKP * * * CALLING SEQUENCE: LDA LU * JSB .SETB * * RETURN (E)=0 IF BIT WAS CLEAR WHEN CALLED * (E)=1 IF BIT WAS SET WHEN CALLED * * * .SETB NOP CLB SET STB .CLRB ENTRY FLAG TO INDICATE "SET" CALL * .SET2 JSB $LIBR GO PRIV NOP * LDB ND100 VERIFY LU ADB A IS BETWEEN 0 SSA,RSS AND 99 SSB,RSS JMP OUTS LU IS OUT OF RANGE * CLB DIV D16 CALCULATE WORD OFFSET ADA TABL INTO BIT MAP TABLE STA TMP AND SAVE. * CLA,INA CALCULATE BIT POSITION CMB,INB,SZB,RSS SET BIT OFFSET NEGATIVE JMP GOTC IF BIT POSITION IS ZERO, CONTINUE * RAL ELSE, PLACE INB,SZB BIT IN PROPER JMP *-2 POSITION. * * GOTC LDB .CLRB FETCH ENTRY FLAG SZB IF THIS WAS A CLEAR CALL, JMP CLRIT GO DO IT * STA B SAVE BIT POSITION AND TMP,I IF BIT CLE,SZA WAS ALREADY SET, CCE RETURN E=1 * LDA B RESTORE BIT POSITION IOR TMP,I SET THE BIT STA TMP,I AND RESTORE THE WORD IN THE TABLE * OUTS JSB $LIBX DEF .SETB ½Ð   * * SPC 5 * * * CLEAR BIT SUBROUTINE * * CALLING SEQUENCE: LDA LU * JSB .CLRB * RETURN --- * * .CLRB NOP LDB .CLRB SET RETURN STB .SETB ADDRESS FOR COMMON JMP .SET2 BODY OF ROUTINE. * * * * THE "CLEAR" FUNCTION CONTINUES HERE * * CLRIT CMA AND TMP,I CLEAR THE BIT STA TMP,I THEN RESTORE THE WORD JMP OUTS RETURN * TABL DEF !BITM+0 GET A DIRECT ADDRESS TMP NOP ND100 DEC -100 D16 DEC 16 A EQU 0 B EQU 1 END 7 ÿÿ ÿý ÿ92067-18329 2013 S C0122 &KHAR              H0101 ˆPþúASMB,L,C HED CHARACTER PUSHERS * * NAME: KHAR * SOURCE: 92067-18329 * RELOC: 92067-16268 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM KHAR,7 92067-1X329 REV.2013 770525 EXT .ENTR,.DFER ENT SETSB,SETDB,KHAR,CPUT,ZPUT * * THESE ROUTINES BUILD AND TEAR APART STRINGS FOR FORTRAN * PROGRAMS * * * SETSB: SETS UP THE STRING SOURCE BUFFER AND ITS LIMITS * * CALL SETSB(IBUF,ISCH,ISLIM) * * WHERE: IBUF IS THE BUFFER ADDRESS * ISCH IS THE CURRENT CHARACTER POSITION (UPDATED BY KHAR) * YOU SHOULD INITIALIZE IT TO 1 FOR THE FIRST * CHARACTER IN IBUF (I.E. LEFT HALF OF FIRST WORD * NOTE THAT THIS IS THE SAME CONVENTION USED IN 'NAMR' * ISLIM IS THE NUMBER OF CHARACTERS IN IBUF * * SETDB: SETS UP THE DESTINATION BUFFER * * CALL SETDB(IDBUF,IDCH) * * WHERE: IDBUF IS THE DESTINATION BUFFER * IDCH IS THE DESTINATION CARACTER COUNT * YOU SHOULD INITIALIZE IDCH TO ZERO BEFOR CALLING * CPUT OR ZPUT. IDCH IS UPDATED BY CPUT AND ZPUT * AND REFLECTS THE TRUE CHARACTER COUNT IN IDBUF * NO TEST ARE DONE FOR EXCEEDING IDBUF. * IDCH MAY BE DECREMENTED TO DELETE CHARACTERS OR * EVEN SET BACK TO ZERO TO CLEAR THE BUFFER * * KHAR : GET THE NEXT SOURCE CHARACTER * * IC=KHAR(IC2) * * WHERE: IC AND IC2 ARE TO RECEIVE THE CHARACTÁ’þúER * BOTH WILL BE ZERO IF THERE ARE NO MORE CHARACTERS * THE CHARACTER WILL BE IN THE HIGH HALF OF THE WORD * WITH A BLANK PAD IN THE LOW HALF (FORTRAN 1H CONVENTION). * * CPUT : PUTS THE CHARACTER IN THE DESTINATION BUFFER * * CALL CPUT(ICR2) * * WHERE: ICR2 IS THE CHARACTER TO BE PUT OUT (IN HIGH HALF OF WORD) * * ZPUT : PUTS A STRING IN THE DESTINATION BUFFER * * CALL ZPUT(I2BUF,IFRST,NO) * * WHERE: I2BUF IS THE STRING BASE ADDRESS * IFRST IS THE FIRST CHARACTER TO BE PUT * NO IS THE NUMBER OF CHARACTERS TO BE PUT * * NOTE SETSB AND SETDB TAKE ADDRESSES ONLY. THIS MEANS THAT YOU * MAY RESET THE POINTERS ( ISCH AND IDCH) AND EVEN THE SOURCE LIMIT * (ISLIM) WITHOUT CALLING SETSB OR SETDB. * * ANY QUESTIONS SEE : GEORGE ANZINGER * ISB NOP ISCH NOP ISLM NOP SETSB NOP JSB .ENTR DEF ISB JMP SETSB,I SIMPLE ISN'T * IDB NOP IDCH NOP SETDB NOP JSB .ENTR DEF IDB JMP SETDB,I EVEN SIMPLER * KHAR NOP GET CHAR FORM SOURCE LDB KHAR,I GET RETURN ADDRESS STB RTN AND SAVE IT ISZ KHAR STEP TO THE RETURN CHAR. ADDRESS CLA PRESET A FOR END OF LINE LDB ISCH,I GET THE CHARACTER POSITION CMB,INB,SZB,RSS IF ZERO THEN JMP KEX HE DIDN'T CALL THE SET ADDRESS ROUTINE YET * ADB ISLM,I CHECK IF BEYOND THE LIMIT SSB WELL? JMP KEX YES RETURN ZERO * LDB ISB GET THE BUFFER ADDRESS CLE,ELB CHANGE TO CHAR ADB ISCH,I ADD THE POSITION ADB N1 SUBTRACT FOR 1=1'ST CHAR. CLE,ERB SHIFT BACK TO FORM ACTUAL ADDRESS LDA B,I GET THE CHAR SEZ IF IN LOW HALF ALF,ALF ROLL IT UP AND C377 ISOLATE IT IOR B40 PAD IT ISZ ISCH,Ilþú STEP THE CHARACTER COUNT KEX LDB KHAR,I GET THE ADDRESS OF THE PLACE TO STORE IT STA B,I SET THE RETURN CHAR. JMP RTN,I AND RETURN * N1 DEC -1 C377 BYT 377 B40 OCT 40 * CPUT NOP LDA CPUT,I PUT A CHAR. STA RTN SAVE THE RETURN ADDRESS ISZ CPUT STEP TO THE CHAR ADDRESS LDB IDB GET THE ADDRESS CLE,ELB SHIFT IT ADB IDCH,I ADD THE OFFSET (SHOULD START AT ZERO) CLE,ERB MAKE WORD ADDRESS LDA CPUT,I GET THE CHAR TO BE PUTR LDA A,I SEZ PUT IN THE CORRECT HALF ALF,ALF XOR B,I MIRGE IT SEZ AND B377 ISOLATE THE CORRECT SEZ,RSS HALF AND C377 AND XOR B,I FINISH THE MIRGE STA B,I SET THE NEW CHAR ISZ IDCH,I STEP THE COUNT JMP RTN,I AND RETURN * B377 OCT 377 RTN NOP * ISBUF NOP ISPO NOP ISCO NOP ZPUT NOP JSB .ENTR USE .ENTR WHERE IT ISN'T CALLED MUCH DEF ISBUF CCA CONVERT ADA ISCO,I THE COUNT AND POSITION ADA ISPO,I INTO A LIMIT STA ISCO AND SAVE IT JSB .DFER SAVE THE CURRENT SOURCE DEF ISBS BUFFER DEF ISB POINTERS LDA ISBUF SET UP NEW TEMPS STA ISB LDA ISPO,I STA ISPO DON'T WIPE HIS NUMBERS LDA DISPO SET ADDRESS STA ISCH FOR KHAR LDA DISCO STA ISLM LOOP JSB KHAR DEF *+2 DEF SETDB SZA,RSS END OF BUFFER? JMP EX3 YES * JSB CPUT PUT THE CHAR DEF *+2 DEF SETDB JMP LOOP * EX3 JSB .DFER RESTORE THE SOURCE BUFFERS DEF ISB DEF ISBS JMP ZPUT,I AND RETURN * ISBS BSS 3 DISCO DEF ISCO DISPO DEF ISPO A EQU 0 B EQU 1 END È+ÿÿ ÿý ÿ92067-18330 2013 S C0222 &DVR32 MAC DISC DRIVER             H0102 ±MþúASMB,Q,C,N HED DVR32 RTE MOVING HEAD DRIVER * NAME: DVR32 * SOURCE: 92067-18330 * RELOC: 92067-16330/92067-16508 * PGMR: G.A.A.,JSW,JJC * J.S.W. -- NEW TRACK MAP FORMAT FOR 7925 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** IFN NAM DVR32,0 92067-16330 REV.2013 800130 ENT I.32,C.32 EXT $TB32 TBXX EQU $TB32 XIF IFZ NAM DVP32,0 92067-16508 REV.2013 800130 ENT IP32,CP32 EXT $TP32 TBXX EQU $TP32 XIF EXT .MVW,$UPIO,$CGRN SUP SPC 3 * THIS DRIVER OPERATES UNDER THE CONTROL OF * THE I/O CONTROL MODULE OF THE REAL-TIME EXECUTIVE. * THIS DRIVER IS RESPONSIBLE FOR CONTROLLING DATA * TRANSMISSION WITH A MOVING HEAD TYPE DISC FILE. * * THIS DRIVER MAKES THE MOVING HEAD DISC APPEAR TO * HAVE 64 WORD SECTORS, HOWEVER SPEED IS IMPROVED * IF THE DRIVER DOES NOT HAVE TO DO THIS PROCESSING. * * THIS IS DONE BY ALWAYS STARTING A READ REQUEST ON AN * EVEN SECTOR AND BY ENDING WRITE REQUESTS WITHIN. * ODD SECTORS. * * * ALL DATA TRANSFER IS DONE UNDER DMA CONTROL. * THE USER SPECIFIES TRACK AND SECTOR AND * LENGTH OF EACH REQUEST. * * THE USER MAY SPECIFY * CYCLIC CHECKING BE DONE ON WRITE REQUESTS * BY SETING SUBFUNCTION BIT 8 IN THE WRITE REQUEST. * A FAILED CYCLIC CHECK WILL CAUSE THE WRITE TO BE * RETRIED UP TO TEN TIMES. * * * SPECIAL SYSTEM REQUESTS: A GROUP OF TRANSFERS * MAY BE SPECIFIED BY AN INTERNAL SYSTEM * REQUEST (VIA ). THIS REQUEST HAS THE * SPECIAL FORMAT: * * (EQ T7,I) 'CONTAINS A POINTEu/þúR TO A GROUP OF * 3 OR 4 WORDS CONTAINING THE BUFFER ADDRESS(WORD 1), * LENGTH(WORD 2) AND TRACK/SECTOR(WORD 3 OR IF SIGN * BIT IS SET ON WORD 3 THEN IT IS THE SECTOR (THE SIGN * IS STRIPED) AND WORD FOUR IS THE TRACK) ADDRESS FOR * EACH TRANSFER. THE GROUP OF TRANSFER VECTORS IS * OPEN-ENDED AND IS TERMINATED BY A ZERO-WORD. * ALL TRANSFERS ARE MADE BEFORE A COMPLETION * RETURN TO IS MADE. * * ******** WARNING ***************************************************** * * THIS DRIVER WILL CORRECTLY HANDLE MULTI-CPU, MULTI-DRIVE CONDITIONS * ONLY WITH THE LATEST FIRMWARE IN THE DISC CONTROLLER. IT WILL ALSO * HANDLE MULTI-DRIVE CONDITIONS WITH OLD FIRMWARE IN THE CONTROLLER. * HOWEVER, IF USED WITH OLD FIRMWARE IN A MULTI-CPU ENVIROMENT IT WILL * LIKELY PUT THE SYSTEM INTO A TIGHT INTERRUPT DRIVEN LOOP. * * THIS IS INTENDED AS THERE IS NO CORRECT ANSWER TO THE PROBLEM WITH OLD * FIRMWARE. THE TIGHT LOOP WILL OCCUR ON FIRST CONTENTION FOR THE LOCK * REQUEST AND WILL "HEAL" ON REMOVAL OF THE CONTENTION (OTHER CPU * UNLOCKS), SOLUTION: * GET NEW FIRMWARE!!! * ************************************************************************* SPC 2 ******* WARNING ******************************************************** * THIS DRIVER CONTAINS A SECTION OF CODE THAT TEMPORARILY MODIFIES * THE ALTERNATE MAP FOR THE ECC SCHEME (ERR CORRECTION) * OF THE 13037 CONTROLLER. * THE SECTION OF CODE AT LIMST SHOULD BE REVIEWED * WHEN THIS DRIVER IS PUT IN A NEW OP SYSTEM, TO VERIFY THAT * THE ASSUMPTIONS MADE IN THE CODE ARE STILL VALID. JJC ************************************************************************** SPC 2 * EQT1 -- IO REQ LIST POINTER * EQT2 -- INITIATOR ADDRESS * EQT3 -- COMPLTION (C.32) ADDRESS * EQT4 -- I/O ASSIGNMENT * EQT5 -- STATUS * EQT6 -- REQUEST CODE + SUBFUNCTION * EQT7 -- REQ BUFFER ADDRESS * EQT8 -- REQ LENGTH * EQT9 -- LOGIC½þúAL TRACK# * EQT10-- SECTOR# (64 WORD) * EQT11-- LENGTH * * XSIO CALL TRIPLET: * * 1ST WORD - REQ BUFFER ADDRESS * 2ND - LENGTH * 3 - TRACK/SECTOR (BIT 0-6) * TERMINATED BY 0 * ************************************************************************** SKP RWSUB NOP READ/WRITE ROUTINE ENTRY * E = 0 WRITE * E = 1 READ * * B = BUFFER ADDRESS * A = -LENGTH IN WORDS SPC 3 STB UBUF SAVE BUFFER ADDRESS. STA LN.N SAVE LENGTH LDB TRACK GET THE TRACK AND BLF COMBINE WITH ADB UNIT THE UNIT CPB LTRK SAME AS IN LOCAL BUFFER? LDB BM10 YES; B_-8. LDA HDSC CHECK THE HEAD/SECT CPA LHDSC SAME AS IN LOCAL BUFFER? INB YES; B_B+1 LDA LN.N UNDER 129 WORDS SEZ,RSS IF WRITE JMP WRT1 GO DO WRITE TESTS * ADA D128 REQUESTED? CPB BM7 ALL CONDITIONS MET? SSA MET? JMP RD2 NO; GO READ * LDA LBUFA YES; SET FOR MOVE CPA UBUF IF DATA IS WANTED IN LOCAL JMP CLE BUFFER CLE AND RETURN * STA LBUFP SET UP FOR LDA LN.N MOVE LDB UBUF JSB MOVE AND MOVE DATA CLE CLE SET E FOR CONTINUATION JMP RWSUB,I RETURN B40 EQU CLE SPC 3 RD2 LDB UBUF READ; TO LOCAL CPB LBUFA BUFFER? STB LTRK SHOW LOCAL SECTOR BUFFER ENPTY WRT1 SSB,RSS IF SAME TRACK JMP WRIT DIFFERENT TRACK SKIP * ADA D128 AND REQUEST TO WRITE MORE THAN 128 CLE,SSA,RSS WORDS OR CPB BM7 TO WRITE ON LOCAL SECTOR STB LTRK YES; SET TO SHOW NONE IN WRIT JSB SEEK SEEK RECORD LDA RDCM GET THE READ COMMAND SEZ,CME,RSS READ? LDA WRCM NO -ƒöþú USE WRITE COMMAND STA SEEK SAVE THE COMMAND LDA UBUF GET BUFFER ADDRESS SEZ,RSS ADA MSIGN AND SET DIRECTION BIT * * JSB STDMA * * CON LDA SEEK GET THE COMMAND JSB OUTCC AND SEND IT STCDC STC 6,C START DMA CLCD CLC 6 INHIBIT DMA INTERRUPT JSB WAITS GO WAIT FOR INTERRUPT STFD STF 6 FOURCE DMA COMPLETION LIAD2 LIA 2 GET RESIDUE FOR CORRECTION ALG. JSB STATS DO STATUS JMP WRIT ERROR; RETRY * JMP CON CONTINUE THE XFER AFTER CORRECTION * LDA UBUF WAS XFER TO LOCAL BUFFER CPA LBUFA ? RSS JMP RWSUB,I NO; RETURN * LDA TRACK UPDATE THE ALF ADA UNIT STA LTRK LOCAL BUFFER LDA HDSC GET THE CURRENT HEAD /SECTOR STA LHDSC SET HD/SECT WORD JMP RWSUB,I RETURN * TRACK NOP DMAC NOP DMA CONTROL WORD (SELECT CODE ONLY) HDSC NOP LTRK OCT -1 LHDSC NOP LN.N NOP UBUF NOP RDCM ABS READC READ COMMAND WRCM ABS WRITC WRITE COMMAND D128 DEC 128 BM7 OCT -7 MSIGN OCT 100000 * * STDMA NOP CLCD2 CLC 2 SET FOR BUFFER OTAD2 OTA 2 SEND BUFFER ADDRESS LDA DMAC OTAD OTA 6 LDA LN.N GET LENGTH STCD2 STC 2 SET FOR LENGTH OTAD3 OTA 2 SEND IT. JMP STDMA,I * SKP SPC 3 SEEK NOP SEEK ROUTINE * 1. SEEK RECORD WHOSE TRACK IS * IN TRACK, UNIT HDSC * 2. DO ADDRESS RECORD * 3. SEND THE FILE MASK SK2 JSB SEAD SEND THE SEEK COMMAND AND DATA ABS SEEKC+HOLD JSB WAITI WAIT FOR ATTENTION SK1 RAR,RAR MOVE SEEK CHECK BIT RAR,SLA,RAL TO LEAST A AND SKIP IF OK SLA IF NOT READY OR NO SEEK CHECK JMP SK3 CONTINUE THE PROþúCESS (GET NOT READY LATER) * JMP SK2 GO REISSUE THIS SEEK * SK3 JSB SEAD SEND ADDRESS RECORD XADRC ABS ADREC LDA FILM GET THE FILE MASK XOR UNIT CHEAT OUTC JSB OUTC AND SEND THE IT JMP SEEK,I RETURN * FILM OCT 7404 FILE MASK SPARING ONLY * * * SEAD NOP * SEAD SEND THE SEEK/ADDRESS RECORD * COMMANDS TO THE CONTROLLER * CALLING SEQUENCE: * * JSB SEAD * OCT COMMAND EITHER SEEK OR ADDRESS RECORD * * ASSUMES CYL = CYLINDER ADDRESS * HDSC= HEAD AND SECTOR * UNIT= UNIT ADDRESS * SEK2 LDA SEAD,I GET THE COMMAND JSB OUTC SEND IT TO THE CONTROLLER SFC1 SFC DC ACCEPTED? JMP SKOK YES CONTINUE * JMP NRERR ELSE TAKE NOT READY EXIT * * SKOK LDA TRACK GET THE CYLINDER ADDRESS OTA1 OTA DC,C AND SEND IT ISZ SEAD STEP TO RETURN ADDRESS JSB WAFLG WAIT FOR FLAG JMP NRERR IF NONE THEN NOT READY LDA HDSC NOW THE HEAD/SECTOR OTA2 OTA DC,C SEND IT JMP SEAD,I RETURN * B27 OCT 27 * * * OUTC SEND COMMAND TO THE CONTROLLER AND * WAIT FOR ACCEPTANCE * OUTC NOP JSB OUTCC SEND THE COMMAND JSB WFLS WAIT FOR THE FLAG JMP OUTC,I RETURN * * OUTCC SEND COMMAND TO INTERFACE DO NOT WAIT FOR FLAG. * OUTCC NOP CLC1 CLC DC SET 'HERE-COME-DE-WORD' XOR UNIT ADD/SUBTRACT THE UNIT OTA3 OTA DC,C SEND THE WORD JMP OUTCC,I RETURN * * * INWD WAITS FOR A FLAG AND THEN INPUTS ONE WORD TO A. * INWD NOP JSB WAFLG WAIT FOR THE FLAG JMP NRERR IF NO RESPONCE TAKE NOT READY EXIT * LIA1 LIA DC,C GET THE WORD JMP INWD,I RETURN * * * WAITI WAIT FOR INTERRUPT AND ANNALIZE REASON FOR INTERRUPT * IF NO STATUS BIT SIþúET EXIT TO CALLER * ELSE DO STATUS AND: * 1. IF UNIT 10 GO TO HOL10 (TO COMPLETE HOLD) * 2. IF CURRENT UNIT RESTORE E AND RETURN * 3. IF NOT CURRENT UNIT IGNOR THE INTERRUPT AND * POSSIBLY CALL SYSTEM UP PROCESSOR * * WAITI DEF IGNOR INTERRUPT BEFORE EXPECTED IGNOR ELB SAVE THE E REG STB MOVE IN MOVE ENTRY POINT CLA CLEAR THE RETURN ADDRESS STA RTNCD SWITCH IGNO2 ISZ C.XX TAKE CONTINUATION INTERRUPT STC1 STC DC SET FOR INTERRUPT JMP C.XX,I RETURN * C.XX NOP INTERRUPT RETURNS TO HERE ISZ STACT IF TO IGNOR STATUS RSS THEN JMP WAIER JUST GO RETURN * JSB STATW THIS CALL ASSUMES WE HAVE CONTROLLER CPB D10 UNIT 10 WAKE UP? JMP HOL10 YES GO PROCESS IT * CPB UNIT THIS THE CURRENT UNIT? RSS YES SKIP JMP IGNOR NO GO PROCESS ATTENTION INTERRUPT * WAIER LDB MOVE RESTORE ERB THE E REG. JMP WAITI,I AND RETURN * * THIS WILL PUT A SYSTEM WITH * THE OLD CONTROLLER INTO A TIGHT LOOP- * USE NEW FIRMWARE WITH MULT-CPU * HOL10 LDA S1CD IF NOT SUCCESSFUL CPA B27 THEN JMP LOKEX GO EXIT * LDA EQT13,I ELSE JSB $CGRN CLEAR THE RN CLA AND THE STA EQT13,I LOCK 10 FLAG LOKEX LDB D10 * IGNOR CLA MUST BE ATTENTION STA EQT15,I OF SOME KIND CPB D10 IF UNIT 10 JMP WAK SKIP THE CORE SECTOR CLEAR * LDB WAITI IF WE DO NOT EXPECT AN CPB DIGNO INTERRUPT STB LTRK CLEAR IN CORE FLAGS. WAK JSB WAKEN SET UP WAKE UP OR END LDA EQT# GO TO SYSTEM LDB I.XX $IOUP IF SZB WE DID A JMP IGNO2 NOT READY * STC2 STC DC SET CONTROL FIRST JMP $UPIO NOW GO UP THE DEVICE * * * WAITS |>þú DOES WAITI WITHOUT STATUS * WAITS NOP CCA SET THE NO STATUS STA STACT FLAG JSB WAITI WAIT FOR THE INTERRUPT JMP WAITS,I RETURN * * RTNCD OCT 4 STACT NOP D10 DEC 10 HLD10 ABS RECAC+HOLD+10 USE RECALABRATE COMMAND TO HOLD UNIT NOP .ERCT NOP * * * * * * WAKEN CALLED BEFORE ANY EXIT FOR COMPLETION OR * AFTER AND UNEXPECTED INTERRUPT * * WAKEN NOP STB XOR SAVE B LDA ENDC PRESET TO SEND THE END COMMAND LDB WAITI IF WAITING FOR CPB DSK1 A SEEK TO COMPLETE JMP WAKX JUST END * LDB EQT13,I GET THE WAKE UP FLAG SZB IF NOT WAITING FOR 10 LDA HLD10 SKIP ELSE LOAD WAKE 10 COMMAND XOR UNIT FOOL OUTC WAKX JSB OUTCC SEND THE COMMAND LDB XOR RESTORE B JMP WAKEN,I RETURN * * ENDC ABS ENDCC DSK1 DEF SK1 DIGNO DEF IGNOR RETURN FOR IGNOR INTERRUPT * STATUS CHECK SECTION * STATUS MAY REQUIRE AND INTERRUPT IF CONTROLLER * IS NOT CONNECTED TO THIS CPU. * THE ERROR COUNTER IS RESET FOR EACH CORRECT * STATUS. * THE STATUS WORD IN THE EQT IS SET AS FOLLOWS * 0 - ANY ERROR * 1 - DRIVE BUSY (HEADS NOT OVER A TRACK) * 2 - DRIVE NOT READY (HEADS NOT LOADED => 1 ALSO) * 3 - SEEK CHECK (BAD ADDRESS-USUALLY WIPES SYSTEM) * 4 - FIRST STATUS * 5 - DRIVE FAULT * 6 - FORMAT SWITCH IS ON * 7 - PROTECT SWITCH IS ON * * * A WRITE TO A PROTECTED CYLINDER WILL * FOURCE A PARITY ERROR RETURN * UNLESS THE FORMAT SWITCH IS ON, IN WHICH * CASE THE WRITE IS RETRIED WITH A WRITE * INITIALIZE. * NOT READY WILL FOURCE A NOT READY RETURN * * * STATS NOP uþú * * STATS CALLING SEQUENCE: * * LIA DMAWC/CLA,INA SET DMA RESIDUE IF DMA XFER ELSE 1 * JSB STATS * JMP RETRY RETRY THE TRANSFER (E= NOT E) * JMP CONT CONTINUE THE TRANSFER (E=E) * OK EXIT (E=E) * * THE FOLLOWING ACTIONS ARE TAKEN ON THE STATUS-1 WORD: * * STATS PROBLEM ACTION * * 00 NO ERROR OK - IF DMA RESIDUE = 0 EXIT ELSE RETRY * 07 CLY. COMP. ERR RECALIBRATE - RETRY EXIT * 10 DATA ERROR RETRY EXIT (UP TO 10 TIMES) * 11 HEAD/SECT COMP. RECALIBRATE - RETRY EXIT * 16 OVERRUN RETRY EXIT (UP TO 10 TIMES) * 17 CORR. DATA ERR TRY TO CORRECT THEN: * 1. IF FAIL RETRY EXIT (UP TO 10 TIMES) * 2. IF SUCCESS AND DMA RESIDUE = 0 * TAKE OK EXIT, ELSE IF RESIDUE = 1 * UPDATE VERIFY COUNTERS AND TAKE * CONTINUE EXIT, IF RESIDUE # 0 OR 1 * CONTINUE EXIT. * 20 ILLEGAL TRACK PARITY ERROR ABORT * 22 NOT READY RETRY EXIT * 23 STATUS-2 IF PROTECT THEN PARITY ERROR ABORT * ELSE NOT READY ABORT * 26 WRITE PROTECT IF FORMAT SWITCH ON RESET COMMAND * TO INITIALIZE WITH SPD BITS AND * TAKE CONTINUE EXIT, ELSE PARITY * ERROR ABORT * -- ALL OTHERS NOT READY ABORT * * STA WAKEN SAVE THE DMA RESIDUE JSB STATW DO THE STATUS REQUEST LDB S1CD GET THE STATUS-1 CODE SZB,RSS IF NO ERROR JMP OKEX THEN JUST EXIT * CPB B20 ILLEGAL TRACK? JMP PARER GO GIVE PARITY ERROR * CPB B26 WRITE PROTECT? JMP PARER GO CHECK THE SWITCH * CPB B23 STATUS-2 ERROR? JMP NR? GOˆmþú CHECK FOR NOT READY * CPB B16 RETRY OVER RUNS JMP REXIT FOR EVER * ISZ ERCTR STEP ERROR COUNT RSS STILL OK SO CONTINUE JMP PARER TOO MANY ERROR - ABORT * CPB B7 FOR CYL. ERROR RSS * CPB B11 AND HEAD/SECT. COMP JMP RECAL TRY RECALABRATE * CPB B17 LAST CHANCE RSS RSS POSSIBLY CORRECTABLE ERROR * JMP REXIT NONE OF THE ABOVE TRY IT AGAIN * * POSSIBLY CORRECTABLE DATA ERROR. GET SYNDROME FROM CONTROLER * AND GIVE IT A TRY. * ISZ .ERCT NOP LDA RQSYN SEND THE COMMAND JSB OUTCC TO THE CONTROLLER JSB WAITS WAIT FOR INTERRUPT - NO STATUS LIA2 LIA DC,C GET UPDATED STATUS ALF,ALF AND STA SU SAVE IT JSB INWD BURN THE CYL. ADDRESS JSB INWD GET THE SECTOR STA WAITS SAVE IT JSB INWD GET THE DISPLACEMENT STA STATW AND SAVE JSB INWD NOW GET STA PAT1 AND JSB INWD SAVE STA PAT2 THE JSB INWD THREE STA PAT3 CORRECTION WORDS LDA SU GET THE UPDATED STATUS SLA,RSS IF NOT CORRECTABLE JMP REXIT TAKE RETRY EXIT * * CORRECTION ROUTINE USES THE FOLLOWING: * UBUF = BUFFER ADDRESS * -LN.N = ORIGIONAL TRANSFER WORD COUNT * WAITI = REMAINING WORD COUNT * * IF WAITI = 1 THEN ENTRY IS FROM VERIFY SO CORRECTION IS * NOT NEEDED. * LDB WAKEN GET THE DMA RESIDUE CPB B1 IF ONE JMP CKCNT GO SET UP TO CONTINUE VERIFY * LDA LN.N GET ORGIONAL LENGTH CMA,INA TO A SZB,RSS IF END OF TRANSFER JMP ZRORS DO SPECIAL * * * COMPUTE LOWER AND UPPER LIMITS IN BUFFER FOR FIXUP. * ADB DMABT RESTORE THE MISSING RESIDUE BITS ADA B GET UPPER LIMIT STA B SA”þúVE IT LIMST ADA DM128 NOW LOWER LIMIT ADA UBUF ADD IN THE BUFFER ADDRESS ADB UBUF AND STA S1 SET THE LOW STB SU AND HIGH LIMITS * CLB GET LOW PAGE# OF CORRECTION LSR 10 ADDRESS. STA INWD SAVE LOW PAGE IN TEMP(SUBR ENT PT) RSB WHICH MAP ARE WE EXECUTING IN?? BLF (MEM ST REG(BIT12)=0/1=SYS/USR) SLB,RSS CURR MAP=SYS?? IOR B40 YES-SET POINTER TO USR MAP STA OUTCC SAVE MAP REG# OF ALT MAP IN TEMP(SUB ENT) SPC 1 * SAVE 2 REGS OF ALTERNATE MAP CUZ WE'RE GONNA OVERLAY 'EM SPC 1 LDB BM2 GET 2 REGS: MAPS>TO>MEM CBX SIGN OF X SAYS DIRECTION LDB ABSS1 SAVE AREA FOR 2 ALT MAP REGS. XMM MOVE 2 FROM ALT MAP TO ABSS1 SPC 1 * SAVE 2 REGS OF CURRENT PORTMAP TO ABSS2 SAVE AREA SPC 1 LDA INWD GET PAGE# OF CORRECTION ADDR IOR B100 ADD OFFSET TO PORT A MAPS LDB OTAD3 GET CNFG'D I/O INSTRUCTION SLB USING PORT B CURRENTLY?? IOR B40 YES-ADJUST OFFSET TO PORT B LDB BM2 MOVE 2 REGS: PORTMAP>TO>MEM CBX INTO SAVE AREA AT ABSS2 LDB ABSS2 XMM MOVE 'EM SPC 1 * STUFF 2 REGS. OF CURRENT PORT MAP INTO ALTERNATE MAP FOR XOR SPC 1 LDA OUTCC GET MAP REG# OF ALT MAP LDB B2 LOAD 2 MAP REGS: MEM>TO>MAPS CBX FROM PORT MAP SAVE AREA LDB ABSS2 AT ABSS2 XMM MOVE 'EM * CRECT LDB S1 ADD LOW LIMIT+DISPLACEMENT & GET ADB STATW THE CORRECTION ADDR IN B REG. JSB XOR CORRECT PAT1 NOP THE JSB XOR DATA PAT2 NOP IN THE JSB XOR BUFFER PAT3 NOP SPC 1 * RESTORE ALTERNATE MAP FROM ABSS1 SAVE AREA SPC 1 LDA OUTCC GET POINTER TO ALT MÝ£þúAP REGS. LDB B2 SET TO MOVE 2 REGS: MEM>TO>MAPS CBX FROM THE 2 WORD SAVE LDB ABSS1 AREA AT ABSS1. XMM RESTORE MAPS AS BEFORE * DONE? LDA WAKEN IF TRANSMISSION COMPLETE SZA,RSS THEN JMP OKEX TAKE OK EXIT * JMP CONEX ELSE TAKE CONTINUE EXIT * * ZRORS LDB A RESIDUE IS ZERO ADA B177 B GET UPPER LIMIT OFFSET AND DM128 ROUND A UP TO NEXT 128 WD. JMP LIMST CONTINUE CORRECTION. * * CKCNT LDA HDSC VERIFY IN PROGESS CMA,INA GET THE ORGIONAL HEAD ADDRESS ADA WAITS AND COMPUTE THE NUMBER CHECKED AND B377 INA STA HDSC SET THE NEW ORG. CMA,INA SUBTRACT ADA TVCNT FROM VERIFY COUNT JMP DONE? AND GO TEST IF DONE. * * RECAL LDA RECLC RECALABRATE JSB OUTCC THE DISC JSB WAITI WAIT FOR ATT. REXIT CME SET E TO NOT E FOR RETRY JMP STATS,I TAKE RETRY EXIT * RECLC ABS RECAC+HOLD * NR? ALF,ALF IF PROTECTED SEZ,SSA IF SWITCH OFF AND WRITE JMP PARER TAKE PARITY ERROR EXIT * JMP NRERR ELSE TAKE NOT READY EXIT * * OKEX LDA WAKEN IF DMA DISAGREES SSA JMP REXIT RETRY THE TRANSFER * LDB BM12 RESET THE ERROR STB ERCTR ON OK EXITS ISZ STATS STEP RETURN ADDRESS CONEX ISZ STATS LDB MOVE RESTORE ERB THE E REG. JMP STATS,I RETURN * * B1 OCT 1 B11 OCT 11 B5 OCT 5 B16 OCT 16 B17 OCT 17 B20 OCT 20 B22 OCT 22 B23 OCT 23 B26 OCT 26 B160K OCT 160000 BM2 OCT -2 DMABT NOP HIGH DMA WORD COUNT BITS NOT RETURNED RQSYN ABS RQSYC TVCNT NOP INIAC ABS INITC * * XOR THIS ROUTINE DOES THE CORRECTION FOR CORRECTABLE * DATA ERRORS. * * CALLING SEQUENCE: * * SET S1 TO THE LOWER LIMIT * »çþú SU TO THE UPPER LIMIT * B TO THE BUFFER ADDRESS * JSB XOR * OCT PATTERN * RETURN B_B+1 * * THE PATTERN WILL BE XORED WITH THE WORD AT AND RESTORED TO * B,I IF AND ONLY IF S1<= B < SU. B IS ALWAYS INCREMENTED. * THE FIXUP IS ALWAYS DONE THRU THE ALTERNATE MAP IN RTE-IV. * TWO REGISTERS OF THE ALTERNATE MAP ARE TEMPORARILY SET UP * FROM THE PORT MAP WHICH WAS USED FOR THE DMA XFER. TWO REGS * MUST BE SET UP INCASE THE 3 WORD XOR PATTERN CROSSES A PG BOUNDARY. * THE CURRENT MAP IS NOT USED FOR XOR BECAUSE WE MAY MAP OURSELF * OUT OF EXISTENCE WHEN THE PORT MAP IS COPIED IN. * XOR NOP LDA S1 GET LOWER LIMIT CMA,CLE,INA WATCH 'E' IT DOES ALL THE WORK ADA B SET 'E' IF S1<= B. LDA B NOW TEST UPPER LIMIT CMA,SEZ,CLE = IS BAD / SKIP IF LOW FAILED ADA SU SET 'E' IF B< SU SEZ,RSS IF OUSIDE LIMITS JMP EXXOR GO BUMP B AND EXIT * XLA B,I GET THE DATA XOR XOR,I FIX IT AND XSA B,I RESTORE IT TO DATA BUFFER. * EXXOR INB STEP ADDRESS ISZ XOR STEP RETURN ADDRESS JMP XOR,I AND RETURN * * STATW NOP CORE STATUS ROUTINE GETS THE STATUS ONLY * LEAVES STATUS IN: * S1 STATUS WORD ONE * SU AND B STATUS UNIT RETURNED * S1CD ERROR CODE FROM S1 IN LOW PART * EQT5 AND A STATUS 2 ROTATED 1 BIT * LEFT LOW 8 BITS ONLY * CCA SET THE STATUS COMMAND IN PROGESS STA STACT FLAG TO PREVENT WAITI PROBLEMS LDA STC GET THE STATUS COMMAND JSB OUTCC SEND THE COMMAND (MUST NOT USE OUTC JSB WAFLG OR WFLS HERE SINCE THEY MAY JSB WAITI BE WAITING. LIA3 LIA DC,C GET THE FIRST STATUS WOR—úNLHD STA S1 SAVE IT AND B377 GET UNIT STA SU SAVE IT XOR S1 GET BACK HIGH PART ALF,ALF ROTATE TO LOW A AND B37 KEEP THE STATUS STA S1CD JSB INWD GET STATUS-2 WORD STA S2 RAL ROTATE XOR EQT5,I PUT IN LOW EQT5 AND B377 UNDER THE RULES XOR EQT5,I OF WOO LDB S1 IF PROTECTED RBL SET SSB BIT IOR B20 4 STA EQT5,I LDB SU GET THE UNIT BACK TO B STB STACT CLEAR THE STATUS IN PROGESS FLAG JMP STATW,I AND RETURN * STC ABS STATC SU NOP S1 NOP S2 NOP S1CD NOP B37 OCT 37 * * * WAFLG WAITS FOR A FLAG FOR A TIME AND THEN RETURNS * P+1 IF NO FLAG IN TIME * P+2 IF A FLAG MADE IT IN TIME * WAFLG NOP LDB WCOUN PICK A TIME SFS1 SFS DC FLAG HERE YET? JMP WAFTB NO GO TEST TIMER * âŸNÿÿþú ISZ WAFLG YES STEP RETURN TO P+2 JMP WAFLG,I AND DO IT * WAFTB ISZ B TIME HERE YET? (ISZ FOR TO SAVE E REG.) JMP SFS1 NO TRY THE FLAG AGAIN * JMP WAFLG,I YES TAKE P+1 EXIT * * * WFLS WAIT FOR FLAG, IF NONE WAIT FOR INTERRUPT * * WFLS NOP JSB WAFLG FLAG WITHOUT INTERRUPT? JSB WAITS NO WAIT FOR INTERRUPT JMP WFLS,I RETURN * B377 OCT 377 BM12 OCT -12 WCOUN DEC -35 ERCTR OCT -12 EQT# DEC 1 SET ON FIRST ENTRY SPC 2 NRERR CLA,INA NOT READY -SET A=1 -POST INTERRUPT CLB SET BEEN HERE FLAG STB I.XX LDB RTNCD GET THE RETURN CODE SZB,RSS IF ZERO DO COMPLETION EXIT JMP COMEX GO DO COMPLETION EXIT * * * ISZ C.XX BUMP TO PROPER RETURN ADDRESS PARER LDA B3 A_3 ERROR RETURN COMEX LDB EQT9,I COMPLETION RETURN STA RTNCD B = TRACK OR TLOG. JMP NRRTN GO TAKE CENTRAL EXIT * * B140. OCT 101400 B3 OCT 3 LBUFA DEF BUF BUFA EQU LBUFA * * MOVE NOP MOVE SUBROUTINE * ENTER WITH A = -COUNT * B = DESTINATION/SOURCE * E = 1 FROM LOCAL BUF * E = 0 TO LOCAL BUF * LBUFP = LOCAL BUFFER ADD * FOR THIS MOVE CMA,INA SET COUNT POSITIVE STA COUNT SET COUNTER LDA LBUFP GET LOCAL BUFFER ADDRESS SEZ,RSS IF TO LOCAL BUFFER SWP SWAP THE ADDRESSES. JSB .MVW DO WORD MOVE ABSS1 DEF COUNT NOP * JMP MOVE,I NO; RETURN. SPC 2 ABSS2 DEF TMP2 * TEMP MAP SAVE AREA COUNT NOP * SAVE AREA FOR ALT MAPS (ECC) NOP * FOR REQUEST SYNDROME CODE. TMP2 NOP "¤þú * SAVE AREA FOR 2 REGS. OF CURRENT NOP * PORT MAP (ECC ROUTINE). * LBUFP NOP B2 OCT 2 SKP * THE TRIPLET PROCESSOR TAKE SYSTEM OR USER * GENERATED TRIPLETS AND TRANSLATES THEM * INTO READ, WRITE, AND MOVE REQUESTS * * CALLING SEQUENCE: * * EQT8 NEG REQUEST LENGTH IN WORDS * EQT9 SYSTEM TRACK NUMBER (NOT ACTUAL) * EQT10 SYSTEM SECTOR NUMBER (NOT ACTUAL) * EQT11 REQUEST BUFFER ADDRESS. (SIGN BIT SET FOR READ) * * * $TB32 IS USED TO TRANSLATE THE TRACK TO * AN ACTUAL UNIT AND CYLINDER AND HEAD NUMBER. * THE FORMAT IS A SET OF TRIPLETS AS FOLLOWS: * * WORD * 0 $TB32 -N N= NUMBER OF SUBCHANNELS * * 1 NO. OF SECTORS PER TRACK * 2 STARTING CYLINDER NO. * 3 BITS 0-3 DEVICE ADDRESS (UNIT NO.) * 4-9 STARTING HEAD NO. * 10-15 NO.OF SURFACES * 4 # OF TRACKS * 5 BITS 0-7 NO.OF SPARES * * THE WORD AT TB32A WILL BE THE NEGATIVE OF THE NUMBER OF * THE ABOVE TRIPLETS WHICH WILL START AT TB32A+1,I. * * CONSTANTS FOR TIPLT * BM10 OCT -10 TB32A DEF TBXX MXSIZ NOP MAX NO OF WORDS PER TRACK #SECT NOP SECTOR PER TRACK** 080278 .TB32 NOP ..T32 NOP TEMP STORAGE FOR $TB32 POINTER SPC 4 TIPLT EQU * * LDA SUBCH GET SUBCH DISPLACEMENT ADA TB32A INA STEP SUBCH COUNTER STA .TB32 SET UP POINTER TO FIRST WORD OF SUBCH STA ..T32 SAVE FOR TMT CALL * * NOW SEE IF SPECIALS * LDA EQT6,I GET REQ CODE AND B2300 MASK OUT SUBFUNCTION SZA IF NONZERO JSB $SPCL DO SPECIAL * * * LDB .TB32,I GET FIRST WORD- SECTR PER TRACK ISZ .TB32 STEP TO STARTING CYL STB #SECT SAVE CLA TO PREVENT OVERFLOW ASL 6 ST™•þúB MXSIZ SET UP TRACK SIZE * * DLD EQT9,I GET TRACK AND SECTOR ADDRESS * * IF TRACK=-1 RETURN TRACK# * INA,SZA,RSS * TRACK= -1? JMP CK02 * DONT REJECT LDA EQT9,I * GET TRACK # SSA,RSS IF EITHER IS NEGATIVE SSB THEN JMP REJCT GO REJECT THE CALL * CLA CLEAR A TO AVOID OVERFLOW ASL 6 SECTOR * 64 CMB,INB MAKE IT NEGATIVE ADB EQT8,I ADD THE NO OF WORDS IN XFER ADB MXSIZ SUBTRACT FROM MAX WORD COUNT SOS REJECT IF OVERFLOW SET DUE TO SECTOR TO BIG SSB TRAK WRAP AROUND? JMP REJCT YES GO REJECT THE REQUEST * CK02 LDA BM12 SET ERROR COUNTER STA TPER FOR 10 TRIES LDB .TB32,I GET THE FIRST CYL. TO B STB TRACK SAVE IT ISZ .TB32 STEP TO THE NEXT WORDS * * IF TRACK= -1 RETURN LAST TRACK * 08/02/78 * * * DLD .TB32,I *GET THE WORDS AND B17 *ISOLATE THE UNIT STA UNIT AND SET IT * LDA EQT9,I INA,SZA,RSS JMP EOT * LDA B SET LAST TRACK IN B FOR POSSIBLE REJECT CMA,INA NEGATE THE NUMBER ADA EQT9,I ADD THE ADDRESSED TRACK NUMBER SSA IF POSITIVE THEN ERROR JMP CLC2 NEGATIVE SO OK - CONTINUE * EOT LDA EQT5,I SET THE IOR B40 END OF TAPE BIT IN THE STATUS STA EQT5,I EQT STATUS WORD * * LDA EQT6,I SLA,RSS IF READ RETURN SECTOR PER TRACK JMP NRRTN IF NOT READ RETURN LDA EQT7,I GET BUFFER ADDRESS STA UBUF SAVE IT LDA #SECT STA UBUF,I RETUN SECTOR PER TRACK JMP NRRTN EXIT ERROR * TFLG JSB WFLS WAIT FOR THE FLAG CLC2 CLC DC IF CONTROLLER IS DOING SFC2 SFC DC SOMETHING FOR US JMP TFLG ALREADY GO TEST FOR A FLAG * * * * JSB STATW THROW AWAY FIRST STATS(CON…þúTROLLER BUG) JSB STATW GET STATUS AND RAR,RAR IF NOT SLA READY JMP NRERR TAKE NOT READY EXIT * * * LDA .TB32,I GET THE HEAD/ UNIT WORD ALF,RAL # HEADS TO LOW A RAL (SHIFT 6 BITS) AND B77 ISOLATE STA WAITS SAVE LDA EQT9,I GET THE TRACK NUMBER CLB SET TO DIVIDE DIV WAITS A = CYL OFFSET / B= HD OFFSET ADA TRACK A= CYL. STA TRACK SAVE IT ASR 8 PUT HEAD IN ITS PLACE LDB .TB32,I GET BASE HEAD *090178 BLF SHIFT IT TO HIGH BYTE ADA B ADD BASE HEAD # AND B374H ISOLATE HEAD# (BITS 8-13) * LDB EQT10,I GET THE SECTOR CLE,ERB TAKE 1/2 OF IT ADA B COMBINE HEAD AND SECTOR TIPRT STA HDSC SAVE FOR ADDRESS STA CHDSC AND FOR CYCLICK CHECK. LDB EQT8,I BRING IN THE STB TPLN LENGTH LDB EQT11,I AND THE STB TPBUF BUFFER ADDRESS SPC 2 LDA TPLN PRESET A FOR EVEN SECTOR LDB EQT10,I GET SECTOR CCE,SLB,RSS IF EVEN JMP TPNXT JUMP * LDB BUFA ELSE READ LDA DM128 128 WORDS TO JSB RWSUB LOCAL BUFFER LDA HLBUF SET MOVE BUFFER STA LBUFP ADDRESS LDB TPLN GET LENGTH ADB B100 LESS 64 LDA TPLN USE MIN OF REQUEST CLE,SSB AND LDA BM100 6 4 LDB TPBUF GET ADDRESS ELB,RBR CLEAR SIGN & SET READ/WRITE JSB MOVE GO MOVE THE WORDS. LDA DM128 SET TO WRITE LDB BUFA THE SECTOR SEZ,RSS WRITE REQUEST? JSB RWSUB YES; WRITE IT OUT. LDA BM100 UP DATE POINTERS TPA CMA,INA TO REFLECT STA MOVE LAST TRANSFER ADA TPBUF ADJUST BUFFER ADDRESS STA TPBUF LDA MOVE ADA B100 ‡þúROUND UP THE COUNT CLB CLEAR B FOR SHIFT LSR 7 SHIFT TO GET SECTOR COUNT ADA HDSC ADD TO THE CURRENT SECTOR STA HDSC SAVE FOR NEXT ACCESS LDA TPLN GET THE LENGTH ADA MOVE SUBTRACT THE NUMBER XFERED CLE,SSA,RSS IF NONE LEFT CHECK JMP CYCK FOR CYCLIC CHECK * STA TPLN SAVE LENGTH TPNXT LDB TPBUF GET BUFFER ADDRESS CLE,SSB READ? JMP TPRD YES; GO TRANSFER REST OF RECORD * ADA B100 NO; MORE THAN 64 WORDS LEFT CCE,SSA,RSS ? JMP TPB NO; GO TRANSFER LAST WORDS * LDA TPLN YES; TEST FOR MORE THAN LESS THAN AND B100 64 WORDS MOD 128 LEFT STA B SAVE FLAG ADA TPLN GET LENGTH TO SET FOR X-FER CLE,SZB IF LESS THAN 64 MOD 128 LEFT AND DM128 DELETE EXCELL OVER EVEN SECTORS LDB TPBUF GET BUFFER ADDRESS TPRD ELB,RBR SET READ/WRITE FLAG JSB RWSUB DO THE TRANSFER. LDA LN.N GET THE LENGTH AND JMP TPA GO UP DATE THE POINTERS SPC 2 TPB LDA DM128 WRITE OF LAST 64 WORD IN LDB BUFA FIRST HALF OF SECTOR STB LBUFP SET UP JSB RWSUB AND READ THE SECTOR LDA TPLN SET UP TO LDB TPBUF MOVE THE USER WORDS JSB MOVE GO MOVE TO THE BUFFER LDA DM128 WRITE THE BUFFER OUT AGAIN. LDB BUFA AGAIN JSB RWSUB SPC 3 CYCK LDA EQT6,I REQUEST FOR CYCLIC AND B2002 CHECK CPA B2002 AND WRITE RSS YES SKIP JMP EOXF NO- RETURN * LDA CHDSC SET THE HEAD/SECTOR FOR STA HDSC SEEK JSB SEEK LDB EQT8,I CALCULATE THE CMB,INB NUMBER LDA EQT10,I OF B10 SLA SECTORS TRANSFERED ADB B100 START ODD - ADD 64 TO COUNT ADB B177 ROUND UP TO NEXT HIGHER SECTOR LSR 7 ]‘þú SECTOR COUNT TO B LDA B MOVE TO A CONV STA TVCNT SET COUNT LDA VERFC GET THE COMMAND AND JSB OUTC SEND IT LDA TVCNT NOW SEND THE OTA4 OTA DC,C THE COUNT JSB WAITS WAIT FOR IT CLA,CLE,INA SET DMA RESIDUE FOR VERIFY JSB STATS DO FULL STATUS JMP BADV BAD NEWS * JMP CONV CORRECTABLE SO CONTINUE * JMP EOXF O-K RETURN * * BADV LDA CHDSC SET THE HEAD/SECTOR ADDRESS IN A ISZ TPER STEP COUNTER JMP TIPRT TOO MANY? - NO TRY AGAIN * JMP PARER YES; TAKE PARITY ERROR EXIT. SPC 3 HLBUF DEF BUF+64 TPLN NOP TPBUF NOP TPER NOP CHDSC NOP SUBCH NOP B100 OCT 100 DM128 DEC -128 BM100 OCT -100 B7 OCT 7 B374H OCT 37400 B77 OCT 77 VERFC ABS VERC SPC 2 REJCT CLA,INA ILLEGAL CALL SO REJECT STC3 STC DC JMP I.XX,I IT SKP * INITIATOR ENTRY POINT I.XX NOP CLC4 JMP CONFI CONFI SETS THIS WORD TO CLC DC * LDA CHAN CONFIGURE THE DMA ADA STF FIRST A STF STA STFD STA STFD9 ADA B500 NOW A OTA STA OTAD XOR B1100 NOW A STC ,C STA STCDC STA STCD9 XOR B5000 NOW A CLC STA CLCD STA CLCD9 XOR B4 NOW A CLC TO LOW SELECT CODE STA CLCD2 XOR WRCM NOW A STC TO LOW STA STCD2 XOR B100 NOW A OTA TO LOW STA OTAD2 STA OTAD3 ADA BM100 NOW A LIA TO LOW STA LIAD2 CCA ADA I.XX SET RETURN STA C.XX ADDRESS LDA B4 SET THE RETURN CODE STA RTNCD LDA EQT4,I GET THE UNIT RRR 6 FROM THE EQT AND B37 MASK TO UNIT NUMBER STA B SAVE IN B ADB TB32A,I TEST FOR ILLEGAL SSB,RSS NEGATIVE OK JMP REJCT ELSE REJECT THE REQUEST * MPY B5 8kþúSTA SUBCH * STA STACT CLEAR NO STATUS FLAG LDA EQT6,I IF CONTROL REQUEST AND B3 THEN CPA B3 GO WAIT FOR CONTROLLER JMP CLC3 * JMP OK ELSE READ,WRITE * CLRBS JSB WFLS WAIT FOR FLAG CLC3 CLC DC CLEAR BUSY FLAG SFC3 SFC DC BY CYLING MEMORY JMP CLRBS IF STILL BUSY TRY AGAIN * * LDA EQT6,I GET AND ISOLATE CPA B3 UN LOCK REQUEST? JMP ULOCK YES GO DO IT. * CPA B1503 LOCK REQUEST? JMP LOCK YES GO DO IT * CPA B3I IF SYSTEM CLEAR RSS JMP NRRTN * LDA WAITI AND WAITING CPA DREXI FOR RECAL RSS CPA DSK1 OR SEEK RSS JMP NRRTN * JSB SEAD THEN SEEK ABS SEEKC WITHOUT HOLD TO CLEAR HOLD JMP NRRTN RETURN. SPC 1 OK LDA BM12 RESET STA ERCTR THE ERROR COUNTER LDA EQT6,I GET THE REQUEST CODE SYS2 LDB EQT7,I GET BUFFER ADDRESS SSA SYSTEM REQUEST? JMP SYS YES; GO DO SYSTEM THING. * LNTS LDA EQT6,I GET THE REQUEST CODE RAR,CLE,ELA SET RBL,ERB SIGN OF BUFFER ADDRESS TO SHOW DIRECTION STB EQT11,I AND SAVE FOR TIPLT CALL LDA EQT8,I GET THE LENGTH. STA EQT12,I SAVE FOR EXIT SSA,RSS MAKE NEGATIVE CMA,INA,RSS WORDS B1100 ARS AND STA EQT8,I SAVE B2002 SZA IF ZERO SKIP CALL JMP TIPLT CALL FOR X-FER * EOXF LDA EQT6,I GET REQUEST CODE SSA SYSTEM JMP SYS2 YES; GO GET NEXT TRIPLET * DONE LDB EQT12,I NO; DONE; GET TLOG CCE,SSB SET POSITIVE CMB,INB IF NEG. NRRTN LDA DIGNO RESET THE WAITI STA WAITI RETURN ADDRESS JSB WAKEN SEND ANY NEEDED WAKE UPS .RTN. LDA RTNCD GET RETURN CODE (0 OR 4) CPA B4 IF 4 ISZ C.XX RE?0þúTURN VIA C.XX+1 (SET -1 ABOVE) JMP STC1 ELSE C.XX SPC 2 SYS STB MOVE SYSTEM TRIPLET PROCESSOR INB STEP TO THE ADDRESS OF LDA B,I LENGTH AND STORE IT IN STA EQT8,I THE EQUIPMENT TABLE INB STEP TO THE DISC ADDRESS LDA B,I GET THE ADDRESS RAL,CLE,SLA,ERA IF FOUR WORD ENTRY INB,RSS STEP TO THE TRACK AND SKIP MASK AND B177 MASK THE SECTOR AND STA EQT10,I AND SET IT IN THE EQT XOR B,I GET THE TRACK ADDRESS ALF,ALF ROTATE TO LOW A RAL SEZ IF FOUR WORD ENTRY USE LDA B,I FULL FOURTH WORD FOR TRACK STA EQT9,I AND SET IN THE EQT INB STEP TO ADDRESS OF NEXT TRIPLET STB EQT7,I AND SET IT IN THE EQT LDB MOVE,I GET THE BUFFER ADDRESS SZB IF ZERO THEN DONE JMP LNTS GO DO THE TRANSFER. SPC 2 LDA RTNCD GET THE RETURN CODE SZA,RSS IF ZERO- JMP DONE GO RETURN * LDA UNIT GET THE XOR FILM SET FILE MASK COMMAND JSB OUTCC AND SEND IT JSB WAITS GO WAIT FOR A INTERRUPT JMP DONE EXIT SPC 2 LOCK LDA EQT7,I GET THE RN NUMBER STA EQT13,I AND SAVE IT JMP NRRTN AND RETURN * * ULOCK LDA CLR10 GET THE CLEAR UNIT XOR UNIT COMMAND JSB OUTC SEND IT CLA STA EQT13,I CLEAR THE RN NUMBER IN CASE WE STILL JMP NRRTN HAVE IT AND GO EXIT. SPC 2 CLR10 ABS RECAC+10 CLEAR WITH A RECALABRATE REQUEST B4 OCT 4 B177 OCT 177 B1503 OCT 1503 B5000 OCT 5000 B500 OCT 500 STF STF 0 DREXI DEF REXIT B3I DEF 3,I SKP SPC 4 .161 DEC 161 B2300 OCT 2300 * * $SPCL NOP LDB EQT7,I GET IBUF(1) ADDRESS STB .IBUF SAVE IT FOR STATUS RETURN ADDRESS LDB B,I GET IBUF(1)- UNIT# STB XSEEK SEEKŒBþú COMMAND SETS BIT 15 RBL,CLE,ERB CLEAR SIGN BIT STA NOWAI SET NO-WAIT FLAG CPA B2300 STATUS REQ. ? JMP GETST CPA B2200 IS SUBFUNTION = 2200 RSS YES CONTINUE JMP $SPCL,I NO,RETURN TO NORMAL * * LDA EQT9,I GET TRACK# (IFC) SZA,RSS = 0? JMP $TMT GO RETURN TRACK MAP CMA,INA ADA B4 SSA IF IFC>4 ERROR JMP REJCT ISZ EQT7,I STEP TO IBUF(2)=> WORD COUNT LDA EQT7,I SET IBUF(17) ADDRESS ADA B17 SET RETURN BUFFER STA EQT11,I SET EQT11 * * * * * LDA EQT8,I GET LENGTH STA LN.N SET UP DMA STB UNIT SET UNIT # FOR COMMANDS LDB EQT9,I GET FUNCTION CODE CPB B1 =1? JMP CONCM CONTROL CMD * CPB B2 =2 JMP SENSE SENSE COMMAND * LDA EQT11,I GET BUFFER ADDRESS CPB B3 IF READ ADA MSIGN SET SIGN BIT * $WRIT JSB STDMA SET UP DMA LDA XSEEK SEE IF WAIT IS NEEDED SSA IF SIGN BIT SET JMP SEND WAIT CCA SET NOWAI TO -1 STA NOWAI FOR NO WAITING SEND JSB $OUT SEND COMMAND OUT LDA XSEEK SEE IF WAIT IS SSA,RSS NEEDED FOR READ WITH OFF SET JMP STCD9 JSB WFLS WAIT NO STATUS CLF01 CLF DC * * STCD9 STC 6,C START DMA CLCD9 CLC 6 JSB WAITS WAIT FOR FLAG STFD9 STF 6 ABORT DMA JMP GTST2 RETURN STATUS * * * * * * GETST STB UNIT SET UNIT# JSB STATW THROW AWAY 1ST STATUS GTST2 JSB STATW READ STATUS $RTN ISZ .IBUF PUT IN IBUF(2) AND 3 LDB .IBUF LDA S1 STA B,I SET IT ISZ .IBUF LDA S2 LDB .IBUF STA B,I JMP DONE * * .IBUF NOP POINTER FOR IBUF(N) NOWAI NOP XSEEK NOP CMDCT DEC -1 * * $OUT NOP LDºmþúA EQT7,I GET COMMAND BUFFER LDA A,I GET COMMAND STA CMDCT SAVE WORRD COUNT $LOOP ISZ EQT7,I STEP TO COMMAND WORD LDA EQT7,I GET CONTENT LDA A,I JSB XOUTC SEND TO CONTROLL ISZ CMDCT LAST WORD JMP $LOOP JMP $OUT,I RETURN * * CONCM JSB $OUT CONTROL REQUEST LDA XSEEK IF SEEK SSA,RSS IF SIGN BIT (XSEEK) NOT SET JMP $CTLC OTHER CONTROL COMMANDS STA STACT ELSE SEEK,WAIT WITH STATUS JSB WAITI WAIT FOR INTERRUPT,WITH STATUS JMP $RTN * $CTLC LDA COMND GET LAST COMMAND OP CODE CPA XADRC IS IT ADDRESS RECORD RSS YES, NO WAIT JSB WAITS WAIT FOR INTERRUPT NO STATUS JMP GTST2 GET STATUS * * * SENSE EQU * JSB $OUT JSB $OUT DSK24 LIA DC,C LDB EQT11,I STA B,I READ RESPONSE ISZ EQT11,I ISZ EQT8,I RSS JMP DONE RETURN STATUS JSB WAFLG JMP NRERR JMP DSK24 * * * ESAVE NOP COMND NOP * .5600 OCT 5600 XOUTC NOP LDB A PUT IN B CCE E=1 AND .5600 IS IT INIT COMMAND CPA .5600 RSS DONT MASK OUT SIGN BIT, BUT DO CLC RBL,CLE,SLB,ERB IF ACTION COMMAND DSK20 CLC DC DO A CLC DSK21 OTB DC,C LDA B RESTORE COMMAND SEZ IF COMMAND STA COMND SAVE COMMAND CPA RECLC IF RECALIBRATE COMMAND JMP XOUTC,I RETURN TO DO WAITI AND ENDC CHECK IF END COMMAND CPA ENDC IF YES NO WAIT JMP DONE END COMMAND, DONE SEZ IF ACTOPN COMMAND, WAIT JSB .WAIT WAIT HERE JMP XOUTC,I RETURN * $TMT LDA EQT8,I GET LENGTH ADA B5 = 5? SZA,RSS IF YES JMP GTSUB RETURN ONE SUBCHANNEL * LDA EQT8,I LENGTH LDB A PUT IN B CMB,INB MAKE POSITIVE ,©þú STB COUNT SET FOR MOVE ADA .161 IS IT 161 (ENTIRE TMT) SZA IF YES,GO ON JMP REJCT DONT KNOW WHAT HE WANTS * LDA TB32A BEGINNING OF $TB32 TMOVE LDB EQT7,I DESTINATION-USER BUF JSB .MVW MOVE BLOCK DEF COUNT NOP LDB EQT8,I GET XMIT LOG JMP .RTN. RETURN TO RTIOC * B2200 OCT 2200 * GTSUB LDA B5 STA COUNT LDA ..T32 JMP TMOVE * * .WAIT NOP ISZ NOWAI IF -1 NO WAIT JSB WFLS WAIT FOR FLAG NO STATUS JMP .WAIT,I SKP BUF BSS 128 LN EQU * ORG BUF CONFI STA DMAC SAVE THE SELECT CODE IOR OTAC CONFIGURE STA OTA1 ALL STA OTA2 THE I/O STA OTA3 INSTRUCTIONS STA OTA4 XOR B11C STA STC1 STA STC2 STA STC3 XOR B0400 STA SFS1 XOR B1600 STA LIA1 STA LIA2 STA LIA3 XOR B1700 STA SFC1 STA SFC2 STA SFC3 XOR B4500 STA CLC1 STA CLC2 STA CLC3 STA CLC4 LDA CHAN GET THE CURRENT DMA CHANNEL ADA LIA MAKE LIA DMA XOR B4 MAKE IT LOW DMA SELECT CODE STA LIADM SET IT ADA B100 NOW A OTA STA OTADM AND SET IT ADA B100 NOW A STC STA STCDM AND SET IT * * IOCNF LDB .IOTB,I SZB,RSS JMP STCDM-1 LDA B,I AND BM100 ADA DMAC STA B,I ISZ .IOTB JMP IOCNF * * .IOTB DEF *+1 DEF DSK20 DEF DSK21 DEF DSK24 DEF CLF01 NOP CCA SEND AN -1 TO DMA STCDM STC 2 PREPARE FOR WORD COUNT OTADM OTA 2 AND LIADM LIA 2 GET IT BACK CMA A NOW HAS THE MISSING BITS FOR DMA WORD STA DMABT COUNT RESIDUE SAVE IT CLB FIND LDA EQTA THE EQT CMA,INA NUMBER DHFBADA EQT1 FOR THE UP REQUEST DIV .15 INA AND STA EQT# SET IT LDA TB32B GET THE ADDRESS OF THE TABLE ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,SLA,ERA JMP *-2 STIL INDIRECT GO GET NEXT LEVEL STA TB32A SET THE TABLE ADDRESS JMP CLC4 * TB32B DEF TB32A ADDRESS OF THE TABLE ADDRESS OTAC OTA 0,C LIA LIA 0 B11C OCT 1100 B4500 OCT 4500 B1600 OCT 1600 B0400 OCT 0400 B1700 OCT 1700 .15 DEC 15 TEST EQU LN-* ERROR HERE MEANS THE CONFIGURE ROUTINE * IS TOO LONG. . EQU 1650B EQTA EQU . EQT1 EQU .+8 EQT4 EQU EQT1+3 EQT5 EQU EQT1+4 EQT6 EQU EQT1+5 EQT7 EQU EQT1+6 EQT8 EQU EQT1+7 EQT9 EQU EQT1+8 EQT10 EQU EQT1+9 EQT11 EQU EQT1+10 EQT12 EQU .+81 EQT13 EQU .+82 EQT15 EQU .+84 CHAN EQU .+19 IFN I.32 EQU I.XX C.32 EQU C.XX XIF IFZ IP32 EQU I.XX CP32 EQU C.XX XIF DC EQU 0 A EQU 0 B EQU 1 HOLD EQU 200B SEEKC EQU 1000B ADREC EQU 6000B STATC EQU 1400B READC EQU 2400B WRITC EQU 4000B RECAC EQU 400B WAKE EQU 13000B INITC EQU 5400B VERC EQU 3400B ENDCC EQU 12400B RQSYC EQU 6400B SECTR EQU .+71 LNPG EQU LN DRIVER LENGTH END ï÷Hÿÿ ÿý3 ÿ92067-18331 2013 S C0122 &INAMR              H0101 þúASMB,R,L,C HED "INAMR" RTE FMGR "NAMR" INVERSE PARSING ROUTINE 3-27-76 (DLB) * * NAME: INAMR * SOURCE: 92067-18331 * RELOC: 92067-16268 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM INAMR,7 92067-1X331 REV.2013 761013 * *-------------------------------------------------------- * * * D. BASKINS 13 OCT 76 REV. A * *--------------------------------------------------------- * ENT INAMR EXT .ENTR SPC 1 A EQU 0 B EQU 1 * THIS ROUTINE WILL DO A CAREFULL AND COMPLETE INVERSE PARSE OF A * BUFFER IN THE FORMAT THAT THE "NAMR" ROUTINE BUILDS IT. THE STRING * GENERATED WILL BE VOID OF TRAILING SPACES, COLONS AND LEADING * ASCII ZERO'S. THE STRING GENERATED WILL BE EQUAL OR SHORTER THAN * THE ORIGIONAL AND WILL PARSE USING THE "NAMR" ROUTINE BACK TO THE * ORIGIONAL TEN WORD BUFFER. SPC 1 * THE TEN WORDS AS INPUT TO THIS ROUTINE ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * WORD 1 = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * WORD 1 = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 7 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET. (FMGR?) * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR ,FNAME : P1 : P2 : P3 : P4 : P5 : P6 , * 0,1 2,3 4,5 6,7 8,9 10°Êþú,11 12,13 * NOTE: IF THE TYPE BITS ARE = 0 AND THE FIRST WORD IN THE PARAMETER * IS NOT = 0, THEN THE PARAMETER IS TAKEN TO BE ASCII AND * THE SUB-PARAMETERS ARE TAKEN TO BE NUMERIC. * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH SUB-PARAM. (FOR POSSIBLE FUTURES I.E. SYSTEM #) SKP * CALLED: * IF(INAMR(IPBUF,OTBUF,LENTH,NCHRS)) 10,20 * * WHERE: * IPBUF = TEN WORD INPUT PARAMETER BUFFER * OTBUF = STARTING ADDRESS OF BUFFER TO STORE OUTPUT STRING. * LENTH = CHARACTER LENGTH OF "OTBUF". (MUST BE POSITIVE) * NCHRS = THE CURRENT NUMBER OF CHARACTORS IN "OTBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "INAMR" AS THE CURRENT "TRANSMISSION LOG". * CAUTION!!!! * NCHRS SHOULD START AS A ZERO IF NO CHARACTORS ARE IN "OTBUF". * NCHRS IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER.(FTN) * * 10 BRANCH = A-REG RETURNS NEG IF PASSED A BUFFER OF IN- * SUFFICIENT LENGTH TO STORE STRING. (I.E. NCHRS => LENTH) * 20 BRANCH = THIS ROUTINE WAS PASSED A BUFFER WITH SUFFICIENT * LENGTH TO STORE INVERSE PARSED STRING. SKP * EXAMPLES THAT CAN BE INVERSED PARSED: * * STRING PASSED TO THE "NAMR" ROUTINE: * +12345, DOUG:DB:-12B:,,GEORGE: A, &PARSE:JB::4:-1:1775:123456B * * BUFFERS PRODUCED BY THE "NAMR" ROUTINE: * NAMR # W1 W2 W3 W4 W5 W6 W7 W8 W9 W10 * * 1 12345 0 0 00001B 0 0 0 0 0 * 2 DO UG 00037B DB -10 0 0 0 0 * 3 0 0 0 00000B 0 0 0 0 0 0 * 4 GE OR GE 00017B A žVþú0 0 0 0 0 * 5 &P AR SE 12517B JB 0 4 -1 1775 -22738 * * STRING PRODUCED (INPARSED) FROM THE BUFFER: * 12345,DOUG:DB:-10,,GEORGE:A,&PARSE:JB::4:-1:1775:-22738, * * TEST PROGRAM *FTN,L * PROGRAM TESTI * DIMENSION IB2(18),IB1(36),IPBUF(100) * CALL RMPAR(IB1) * LU = IB1 * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,100) * 100 FORMAT ("INPUT ASCII NAMR'S TO PARSE ?") * READ (LU,101) IB1 * 101 FORMAT (36A2) * CALL ITLOG(LEN) * IF (LEN.EQ.0) STOP 77 * ISTRC = 1 * NCHRS = 0 * 200 IFLG1 = NAMR(IPBUF,IB1,LEN,ISTRC) * IF (IFLG1.LT.0) WRITE (LU,206) * 206 FORMAT ("NAMR OUT OF DATA") * IFLG2 = INAMR(IPBUF,IB2,36,NCHRS) * IF (IFLG2.LT.0) WRITE (LU,207) * 207 FORMAT ("INAMR OUT OF BUFFER") * IF(IFLG1.LT.0.OR.IFLG2.LT.0) GO TO 1 * CALL EXEC (2,LU,IB2,-NCHRS) * GO TO 200 * END * END$ SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 IPBUF NOP TEN WORD INPUT BUFFER OTBUF NOP OUTPUT BUFFER ADDRESS LENTH NOP LENGTH OF OUTPUT BUFFER IN CHARACTERS NCHRS NOP CURRENT STARTING CHARACTER IN OTBUF INAMR NOP ENTRY POINT JSB .ENTR GET PARAMS ADDRESS DEF IPBUF LDA OTBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF OUTPUT BUFFER STA OTBUF SAVE AS CHARACTER ADDRESS. LDB LENTH,I GET CHARACTER LENGTH ADA B CHECK IF IN CORE BOUNDS LDA NCHRS,I GET START CHAR-1 IN "OTBUF" STA SAVST SAVE START CHARACTOR NUMBER CMB,SSB,INB,SZB CHECK FOR 0 & NEG. SSA CHECK NCHRS FOR ZERO OR POSITIVE ERREX CCE FORCE ERROR EXIT ADB A NCHRS MUST BE < LENTH CCA,SEZ TEST E FOR ERROR JMP INAMR,I RETURN A= -1 FOR ERROR CLA INITITIALIZE STA SPACT TRAILING SPACE COUNT STA COLCT TRAILING`“þú COLON COUNT LDA IPBUF GET INPUT BUFFER ADDRESS LDB D3 GET LENGTH OF BUFFER (WORDS) ADB A GET ADDRESS OF PARAMETER TYPE STB IPBUF SAVE ADDRESS OF WORD4 LDB B,I GET PARAMETER TYPE WORD STB WORD4 SAVE FOR FUTURE EXAMINATION LDB D3 GET LENGTH OF PARAMETER JSB SCAN GET 1ST PARAMETER LDB DM6 NOW SCAN FOR NEXT 5 SUB-PARAMS STB SUBCT MORE1 ISZ IPBUF BUMP TO NEXT PARAMETER LDA WORD4 NOW POSITION PARAMETER TYPE RAR,RAR BITS FOR NEXT PARAMETER STA WORD4 LDA IPBUF GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM ISZ SUBCT DONE WITH ALL SIX? JMP MORE1 NO, CONTINUE LDB LENTH,I CHECK IF AT END OF BUFFER BEFORE STORING CPB NCHRS,I THE COMMA IN THE BUFFER JMP *+3 SKIP COMMA STORE AND START CHARACTOR STORE LDA COMMA JSB PUTCR PUT COMMA IN BUFFER CLA,CLE RETURN A-REG = 0 JMP INAMR,I RETURN DONE SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS CMB,INB MAKE NEG. STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) LDA WORD4 GET PARAMETER TYPE AND D3 GET TYPE BITS CPA D3 IF = 3 THEN ASCII JMP ASCII SLA IF = 1 THEN NUMBERIC JMP NUMBR IOR DESTA,I MUST BE 0 OR 2, CHECK IF PARM IS NULL SZA,RSS NULL? JMP STOCL YES, GO STORE COLON INB,SZB CHECK IF LENGTH = 1 WORD JMP ASCII OR ASCII IF MORE THAN 1 WORD. SPC 1 NUMBR LDA O60 GET AN ASCII 0 IN CASE NUMB. IS = 0 STA LDFLG SET THE LEADING 0 SUPPRESS FLAG LDB DESTA,I GET NUMBER CMB,CCE,SSB,INB,SZB CHECK IF NUMBER IS 0 OR - CMB,CLE,INB POSITIVE, CLE STB CURVL SAVE ABS VALUE OF NUMBER Z þú SEZ,SZB IF + OR 0 SKIP LDA MINUS IF NEG STORE "-" IN BUFFER CLB,SEZ IF POSITIVE SKIP STORE IF - OR 0 JSB PUTCR STORE A "0" OR "-" LDA D10K INITIALIZE THE POWER WORD MORNM STA POWER LDA CURVL GET CURRENT VALUE OF NUMB. DIV POWER FROM NUMBER STB CURVL AND SAVE THE REMAINDER ADA O60 CONVERT TO ASCII NUMBER CPA LDFLG CHECK IF LEADING ZERO? JMP *+3 YES, SKIP STORE JSB PUTCR AND PUT IN STRING BUFFER STB LDFLG CLEAR LEADING ZERO SUPPRESS FLAG LDA POWER NOW DIVIDE THE POWER BY 10 CLB IN CASE OF LEADING ZERO DIV D10 SZA CHECK IF POWER IS = ZERO? JMP MORNM NO, MORE DIGITS TO CONVERT STOCL LDA COLON GET THE : JSB PUTCR AND PUT IN BUFFER JMP SCAN,I RETURN TO CALLER SPC 1 ASCII LDA DESTA,I MOVE ASCII BUFFER INTO OUTPUT STRING ALF,ALF POSITION AND ASSUME LEFT JUSTIFIED JSB PUTCR AND PUT IN DEST BUFFER LDA DESTA,I GET 2ND CHAR JSB PUTCR ISZ DESTA BUMP TO NEXT WORD ISZ DESTL CHECK IF DONE? JMP ASCII NO, MOVE MORE WORDS JMP STOCL STORE : AND EXIT SPC 1 PUTCR NOP STORE CHAR IN CALLERS BUFFER AND O177 MASK TO ONE CHAR STA SAVCR SAVE THE CHARACTOR CPA COLON CHECK IF CHAR IS ":" CLB,RSS ZERO SPACE COUNT AND BUMP : COUNT JMP *+4 STB SPACT ZERO SPACE COUNT ISZ COLCT BUMP COLON COUNTER JMP PUTEX RETURN CPA O40 CHECK IF CHAR IS ASCII SPACE CLB,RSS YES, BUMP THE SPACE COUNT JMP *+3 ISZ SPACT BUMP THE SPACE COUNT JMP PUTEX AND RETURN CPA COMMA CHECK IF CHAR IS COMMA? CLB,RSS YES, ZERO COLON & SPACE COUNT JMP *+3 SKIP ZERO SPACE & : STB COLCT ZERO COLON COUNT STB SPACT ™µþúZERO SPACE COUNT LDB COLCT GET CURRENT COLON COUNTER CMB,INB,SZB,RSS JMP NOCOL NO COLONS, LOOK FOR SPACES STB COLCT SAVE COUNTER LDA COLON NOW STORE COLONS UNTIL COUNT EXAUSTED JSB STOCR GO STORE THE COLONS ISZ COLCT DONE? JMP *-3 NO, DO ANOTHER NOCOL LDB SPACT GET THE SPACE COUNT CMB,INB,SZB,RSS CHECK IF ANY SPACES? JMP STORE NO SPACES, GO STORE CHARACTOR STB SPACT SAVE SPACE COUNT LDA O40 GET AN ASCII SPACE JSB STOCR STORE IN LEADING OR IMBEDDED SPACES ISZ SPACT DONE? JMP *-3 NO GO STORE ANOTHER ONE STORE LDA SAVCR RETRIVE THE ORIGIONAL STORE CHAR JSB STOCR GO STORE IT. PUTEX CLB JMP PUTCR,I RETURN B-REG = 0 SPC 1 STOCR NOP STORE CHARACTOR IN A-REG IN CALLERS BUFFER LDB NCHRS,I GET NUMB CHARS IN BUFFER CPB LENTH,I IF EQUAL TO BUFFER LENGTH>NO MORE STORE JMP ENDBF YES, ERROR ADB OTBUF NO, CALCULATE CHARACTOR BUFFER ADDRESS ISZ NCHRS,I BUMP THE NUMBER OF CHARS COUNTER CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS CHECK EVEN/ODD FLAG ALF,SLA,ALF AND POSITION XOR B,I MERGE IN WITH OLD WORD XOR O40 AND PUT IN/TAKE OUT SPACE STA B,I AND PUT BACK IN BUFFER JMP STOCR,I AND RETURN P+1 SPC 1 ENDBF LDA SAVST RESTORE THE START CHARACTOR STA NCHRS,I POINTER JMP ERREX AND RETURN ERROR EXIT SPC 1 SPACT NOP NUMBER OF TRAILING SPACES COLCT NOP NUMBER OF TRAILING COLONS SAVST NOP START CHARACTOR SAVE LOCATION SAVCR NOP SAVED STORE CHARACTOR LDFLG NOP LEADING ZERO SUPPRESS FLAG POWER NOP WORKING WORD CURVL NOP WORKING WORD DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 O177 OCT 177 ÿ]*($MINUS OCT 55 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 D3 DEC 3 D10 DEC 10 D10K DEC 10000 DM6 DEC -6 SUBCT NOP HOLDS SUB-PARAM. COUNTER WORD4 NOP HOLDS VALUE OF IPBUF(4) END *ÿÿ ÿý ! ÿ92067-18332 2026 S C0122 &READT READT SUBROUTINE              H0101 ¥üþúFTN4,Q,T C PROGRAM READT (3,50),92067-16332 REV.2026 800522 C C C NAME: READT C SOURCE: 92067-18332 C RELOC: 92067-16332 C PGMR: R.D. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C CALLING SEQUENCE IS: C C -LU MAG P C RU,READT, OR , TAPE , OR , SIZE (# TRACKS),IH (INHIBIT REWIND) C +CRN LU G C C READT WILL MOUNT A CARTRIDGE FROM THE DISC POOL IF A CRN OR DISC C LU ISN'T SPECIFIED. CARTRIDGE TYPE (PRIVATE OR GROUP) WILL DEFAULT C TO WHAT'S FOUND IN THE HEADER. SIZE IS THE NUMBER OF DESIRED TRACKS, C DEFAULT IS THE SIZE RETURNED FROM THE MOUNT ROUTINE. IH WILL INHIBIT C THE REWIND OF THE MAG TAPE BEFORE AND AFTER THE RESTORE. C C C C C **** NOTE **** C C IN CASES WHERE THE RATIO OF INTEGER VARIABLES ARE COMPUTED, EACH C IS FLOATED BEFORE THE OPERATION. THIS IS DONE TO AVOID THE TRUNCATION C AFTER EACH INTEGER OPERATION WHICH NORMALLY OCCURS. C C IMPLICIT INTEGER(A-Z) DOUBLE PRECISION TSEC(2) REAL T LOGICAL NAMR,IN EXTERNAL MT1OK,FESSN,DCMC,NMCHK,VVALD,REDIR,REFMT,IDSGM DIMENSION MBUFR(9),DLNTH(2),JBUF(8192) DIMENSION ILBUF(80),INAM1(10),INAM2(10),INAM3(10),INAM4(10) DIMENSION INAM5(10) DIMENSION MSCRN(21),MSDRT(23),MSBUF(3),IDENT(2),KBUFR(4) DIMENSION MS10(10),MS11(16),MS12(14) DIMENSION MDR1(24),MDR2(17),MDR3(26),MDR4(24),MR13(32) DIMENSION LUARY(2),MRR11(11),MRR12(16),MRR17(19) DIMENSION MRR1(13),MRR2(14),MRR3(11),MRR4(16),MRR5(12) DIMENSION MR15(17),MR14(24),ISTAT(256),MR16(Lþú22),MR17(26),MR18(20) DIMENSION MRR6(13),MRR7(12),MRR8(12),MRR9(27),MRR10(22) DIMENSION LU(5),IREG(2),DTYPE(3) DIMENSION IDISK(2),MESS8(7),MESLU(10),MSFMT(30) C C COMMON BLOCK FOR SUBROUTINES VVALD, RESET, AND REFMT. C COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,SIZE,IBUF(8193) C C EQUIVALENCE (IBUF(1),ITRAK),(JBUF,IBUF(2)) EQUIVALENCE (LUARY(1),MTLU),(MRR12(16),FLAG) EQUIVALENCE (IBUF(30),DTYPE) EQUIVALENCE (LU(3),INAM3(1)) C C DATA ILNTH/8192/ DATA JLNTH/8192/ DATA MSBUF/2H ,2H ,2H / DATA INSES/0/ DATA MRR1/6412B,2HRE,2HAD,2H 0,2H01,2H ,2HMA,2HG ,2HTA,2HPE, & 2H D,2HOW,2HN / DATA MRR2/6412B,2HRE,2HAD,2H 0,2H02,2H ,2HBA,2HD ,2HTA,2HPE, & 2H F,2HOR,2HMA,2HT / DATA MRR3/6412B,2HRE,2HAD,2H 0,2H03,2H ,2HLU,2H L,2HOC,2HKE,2HD / DATA MRR4/6412B,2HRE,2HAD,2H 0,2H04,2H ,2HIL,2HLE,2HGA,2HL , & 2HMA,2HG ,2HTA,2HPE,2H L,2HU / DATA MRR5/6412B,2HRE,2HAD,2H 0,2H05,2H ,2HMT,2H O,2HFF,2H L,2HIN, & 2HE / DATA MRR6/6412B,2HRE,2HAD,2H 0,2H06,2H I,2HLL,2HEG,2HAL, & 2H D,2HIS,2HC ,2HLU/ DATA MRR7/6412B,2HRE,2HAD,2H 0,2H07,2H ,2HPA,2HRI,2HTY,2H E,2HRR, & 2HOR/ DATA MRR8/6412B,2HRE,2HAD,2H 0,2H08,2H ,2HEN,2HD ,2HOF,2H T,2HAP, & 2HE / DATA MRR9/6412B,2HRE,2HAD,2H 0,2H09,2H F,2HIL,2HE ,2HOP,2HEN, & 2H O,2HR ,2HRE,2HAD,2HT',2HS ,2HDI,2HSC,2H L,2HU , & 2HLO,2HCK,2H R,2HEJ,2HEC,2HTE,2HD / DATA MRR10/6412B,2HRE,2HAD,2H 0,2H10,2H ,2HNO,2HN ,2HSE,2HSS, & 2HIO,2HN:,2H L,2HU ,2HMU,2HST,2H B,2HE ,2HNE, & 2HGA,2HTI,2HVE/ DATA MRR11/6412B,2HRE,2HAD,2H 0,2H11,2H ,2HSI,2HZE,2H E,2HRR, & 2HOR/ DATA MRR12/6412B,2HRE,2HAD,2H 0,2H12,2H ,2HMO,2HUN,2HT ,2HER, & 2HRO,2HR ,2HFM,•|þú2HGR,2H 0,2HXX/ C DATA MESS8/2H/R,2HEA,2HDT,2H: ,2H S,2HTO,2HP / DATA MESLU/2HRE,2HST,2HOR,2HED,2H T,2HO , & 2HLU,2H ,2H ,2H / DATA MDR1/2HCR,2HN ,2H ,2H ,2H ,2H W,2HAS,2H S,2HAV, & 2HED,2H F,2HRO,2HM ,2HA ,2H ,2H ,2H ,2H , & 2H T,2HRA,2HCK,2H D,2HIS,2HC / DATA MDR2/2HLA,2HST,2H T,2HRA,2HCK,2H U,2HSE,2HD ,2HIS, & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / DATA MDR3/2HRE,2HAD,2HT ,2HWO,2HUL,2HD ,2HLI,2HKE,2H T, & 2HO ,2HRE,2HST,2HOR,2HE ,2H T,2HO ,2HA , & 2H ,2H ,2H ,2H T,2HRA,2HCK,2H D,2HIS,2HC / DATA MDR4/2HIS,2H I,2HT ,2HOK,2HAY,2H T,2HO ,2HMO,2HVE, & 2H D,2HIR,2HEC,2HTO,2HRY,2H T,2HRA,2HCK, & 2HS ,2H(Y,2HES,2H O,2HR ,2HNO,2H)?/ DATA MR13/6412B,2HRE,2HAD,2H 0,2H13,2H ,2HSP,2HEC,2HIF,2HIE, & 2HD ,2HLU,2H O,2HR ,2HFR,2HEE,2H L,2HU ,2HNO, & 2HT ,2HBI,2HG ,2HEN,2HOU,2HGH,2H T,2HO ,2HMO, & 2HUN,2HT ,2HCR,2HN / DATA MSCRN/2HCR,2HN ,2H ,2H ,2H ,2H H,2HAS,2H B,2HEE, & 2HN ,2HCH,2HAN,2HGE,2HD ,2HTO,2H C,2HRN, & 2H ,2H ,2H ,2H / DATA MSDRT/6412B,2HDI,2HRE,2HCT,2HOR,2HY ,2HTR,2HAC,2HKS,2H M, & 2HOV,2HED,2H F,2HRO,2HM ,2H ,2H ,2H , & 2H T,2HO ,2H ,2H ,2H / DATA MSFMT/6412B,2HTR,2HAC,2HKS,2H R,2HEF,2HOR,2HMA,2HTT,2HED, & 2H F,2HRO,2HM ,2H ,2H ,2H ,2H S,2HEC,2H/T,2HRK,2H T, & 2HO ,2H ,2H ,2H ,2H S,2HEC,2H/T,2HRK,6412B/ DATA MR14/6412B,2HDO,2H Y,2HOU,2H W,2HAN,2HT ,2HTO,2H O, & 2HVE,2HRL,2HAY,2H C,2HRN,2H ,2H ,2H , & 2H ,2HON,2H L,2HU ,2H ,2H ,2H / DATA MR15/6412B,2HWI,2HTH,2H C,2HRN,2H ,2H ,2H ,2H ,2H , & 2H(Y,2HES,2H O,2HR ,2HNO,2H) ,20137B/ DATA MR16/6412B,2HDU,2HPL,2HIC,2$“þúHAT,2HE ,2HCR,2HN ,2HLA,2HBE, & 2HL ,2HOR,2H L,2HU ,2HAL,2HRE,2HAD,2HY ,2HMO, & 2HUN,2HTE,2HD / DATA MR17/6412B,2HRE,2HAD,2H 0,2H14,2H O,2HNL,2HY ,2HTH,2HE , & 2HSY,2HS ,2HMN,2HGR,2H M,2HAY,2H R,2HES,2HTO, & 2HRE,2H S,2HYS,2HTE,2HM ,2HDI,2HCS/ DATA MR18/6412B,2HRE,2HAD,2H 0,2H17,2H I,2HLL,2HEG,2HAL,2H R, & 2HES,2HTO,2HRE,2H T,2HO ,2HLU,2H 2,2H O,2HR ,2H3 / DATA MRR17/6412B,2H E,2HOF,2H E,2HNC,2HOU, & 2HNT,2HER,2HED,2H B,2HEF,2HOR,2HE ,2HDA,2HTA,2H T, & 2HRA,2HCK,2HS / DATA MS10/2HDI,2HSC,2H A,2HLR,2HEA,2HDY,2H M,2HOU,2HNT,2HED/ DATA MS11/2HDO,2H Y,2HOU,2H W,2HAN,2HT ,2HTO,2H O,2HVE,2HRL, & 2HAY,2H L,2HU ,2H ,2H ,2H / DATA MS12/2HWI,2HTH,2H C,2HRN,2H ,2H ,2H ,2H (,2HYE,2HS , & 2HOR,2H N,2HO),2H / C C INITIALIZE TAPE COUNT - THE NUMBER OF REELS C ITAPE=1 C C SET UP "ILU" AS TERMINAL LU C CALL EXEC(14,1,ILBUF,-80) CALL ABREG(IA,IB) IS=1 ILU=LOGLU(ISES)+400B C C PARSE FIRST 2 PARTS OF COMMAND STRING (I.E. "RU,READT") C IF(NAMR(INAM1,ILBUF,IB,IS))1,1 1 IF(NAMR(INAM1,ILBUF,IB,IS))2,2 C C NOW PARSE COMMAND STRING TO GET CRN,MTLU,.... ETC. C 2 IF(NAMR(INAM1,ILBUF,IB,IS))3,3 3 IF(NAMR(INAM2,ILBUF,IB,IS))4,4 4 IF(NAMR(INAM3,ILBUF,IB,IS))5,5 5 IF(NAMR(INAM4,ILBUF,IB,IS))6,6 6 IF(NAMR(INAM5,ILBUF,IB,IS))7,7 C 7 ILU=LOGLU(ISES)+400B C IDISC=INAM1(1) MTLU=INAM2(1) SIZE=INAM4(1) C C CHECK WHETHER TO INHIBIT REWIND, IF SO INHBT=-1,OTHERWISE INHBT>=0 C IF(INAM5.EQ.2HIH)INHBT=-1 C C PICK UP MAG TAPE LU, DEFAULT IS 8 C IF (MTLU.EQ.0)MTLU=8 MTLU=IABS(MTLU) C C SIZE PARAMETER MUST BE POSITIVE C IF(INAM4.LT.0)GO TO 885 C C SET ISYSV=-1 IF RESTORING LU 2 C IF(IABS(IDISC).EQ.2)ISYSV=-1 C C IF RESŸôþúTORING AUX DISC THEN SET ISYSV=-2 C C PICK UP CONTENTS OF BASE PAGE WORD 1760B - # SEC/TRK ON LU 3. C IAUX=IXGET(1760B) C IF((IAUX.NE.0).AND.(IABS(IDISC).EQ.3))ISYSV=-2 C C C USE IGET TO GET CURRENT EXECUTING PROGRAM ADDRESS C IXEQT=IXGET(1717B) C C DETERMINE WHETHER OR NOT IN SESSION C OUT OF SESSION, -LU MUST BE SPECIFED C ADSCB - ADDRESS OF SCB C INSES - =0 IF IN SESSION =1 IF NOT C SMID - OFFSET TO USER ID WORD OF SCB C CALL FESSN(ADSCB,INSES,SMID,SMDL) C C GET USER AND GROUP ID'S FROM SCB C USER ID IN FIRST WORD, GROUP ID IN SECOND WORD OF IDENT C CALL ISMVE(ADSCB,SMID,IDENT,2) C C C CAN'T RESTORE SYS OR AUX DISC IF NOT SYS. MNGR. (ID=7777B) C IF((IABS(IDISC).EQ.2).AND.(IDENT.NE.7777B))GO TO 208 IF(IAUX.EQ.0)GO TO 8 IF((IABS(IDISC).EQ.3).AND.(IDENT.NE.7777B))GO TO 208 C C 8 IF (INSES.EQ.0)GO TO 10 IF (IDISC.GE.0)GO TO 80 C C CHECK VALDITY OF LU - ISTAT IS EQT STATUS WORD 5. C ISTA1 IS EQT STATUS WORD 4 (NOT USED) C ISTA2 - SPECIFIES WHETHER DEVICE UP OR DOWN C 10 IF(LUARY.GT.64)GO TO 106 CALL EXEC(13+100000B,MTLU,ISTAT,ISTA1,ISTA2) GO TO 106 C C MUST BE DRIVERS 23 OR 24 C 2666 IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 14 IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 14 GO TO 106 C C CHECK TO SEE IF LU AND EQT ARE UP C 14 IF(IAND(ISTAT,040000B).EQ.040000B)GO TO 100 IF(IAND(ISTA2,100000B).EQ.100000B)GO TO 100 C C LOCK MAG TAPE LU C CALL LURQ(140001B,MTLU,1) GO TO 106 C C IF A-REGISTER = 1, THEN ALREADY LOCKED. C 2333 CALL ABREG(IA,IB) IF(IA.EQ.1)GO TO 104 C C CHECK STATUS OF MAG TAPE UNIT C FLAG=1 IF OFLINE/BUSY; =4 IF EOT C CALL MT1OK(LUARY,FLAG) IF(FLAG.EQ.1)GO TO 200 IF(FLAG.EQ.4)GO TO 206 C C IF IDISC > 0, THEN CRN ## WAS SPECIFIED C IF(IDISC.GE.0)GO TO 28 C C IF IDIS³jþúC < -63, THEN ILLEGAL DISC LU C IF(IDISC.LT.-63)GO TO 82 C C 28 IF(INHBT)30,295,295 C 295 REWIND MTLU C C C C GET HEADER FROM MAG TAPE C 30 CALL EXEC(1+100000B,MTLU,IBUF,ILNTH+1) GO TO 81 3001 CALL ABREG(IA,IB) IF(IAND(IA,2).EQ.2)GO TO 204 HEDLNT=IB IRMBR=0 C C IF HEADER LENGTH NOT WHAT WAS EXPECTED - ERROR (BAD TAPE FORMAT) C IF((HEDLNT.LT.2).OR.(HEDLNT.GT.50))GO TO 81 C C CHECK FOR TYPE OF CARTRIDGE, I.E. PRIVATE OR GROUP C IF(LU(3).EQ.0)GO TO 37 TYPE=0 IF((LU(3).EQ.2HG ).OR.(LU(3).EQ.2HGR))TYPE=1 GO TO 39 37 TYPE=0 IF(IBUF(29).EQ.2HGR)TYPE=1 C C WRITE OUT HEADER C 39 CALL EXEC(2,ILU,IBUF,31) IF(IDISC.GE.0)GO TO 44 C C SET UP DISC LU FOR EXTENDED EXEC CALL C IDISK=-IDISC C C CHECK I/O STATUS OF DISC - ISTAT EQT STATUS WORD 5 C CALL EXEC(13+100000B,IDISK,ISTAT) GO TO 82 2555 ITYPE=IAND(ISTAT,37400B)/256 C C THIS LU OK IF DVR IS 30,31,32, OR 33 C IF((ITYPE.LE.27B).OR.(ITYPE.GE.34B))GO TO 82 C C READ THE NEXT RECORD IF THE LAST WAS A HEADER (LENGTH <= 100). C 44 CALL EXEC(1,MTLU,IBUF,ILNTH+1) C C THIS SHOULD BE THE FIRST DIRECTORY TRACK C CHECK FOR END OF TAPE C A-REGISTER HAS EQT STATUS WORD FIVE C CALL ABREG(IA,IB) IF((IAND(IA,00040B).NE.40B))GO TO 141 CALL EXEC(3,MTLU+500B) CALL EXEC(2,ILU,MRR8,12) CALL PTERR(MRR8(2),FLAG) 182 CALL EXEC(2,ILU,28HPLEASE MOUNT SUBSEQUENT TAPE,-28) 183 CALL EXEC(2,ILU,25HAFTER MOUNTING ENTER "GO",-25) CALL REIO(1,ILU,INBF,1) IF(INBF.EQ.2HAB)GO TO 91 IF(INBF.NE.2HGO)GO TO 183 C C FIRST RECORD (ONE WORD) CONTAINS TAPE COUNT. MAKE SURE TAPE COUNT C IS WHAT'S EXPECTED. C ITAPE=ITAPE+1 CALL EXEC(1,MTLU,INBUF,1) CALL ABREG(IA,IB) IF(INBUF.NE.ITAPE)GO TO 190 GO TO 141 C C WRONG TAPE COUNT C HE PROBABLY MOUNTED THE WRONG REEL, TELL HIM SO. õ»þú C C 190 CALL EXEC(2,ILU,MRR2,14) CALL PTERR(MRR2(2),FLAG) ITAPE=ITAPE-1 GO TO 182 141 ISIZE=INAM4 C C JBUF(4) IS CRN FROM FILE DIRECTORY OF MAG TAPE. C IF(IDISC.EQ.JBUF(4).OR.IDISC.LE.0)GO TO 443 C C REPORT CHANGE OF CRN NUMBER C ALSO CHECK TO SEE IF NEW NUMBER IS REALLY ASCII C IF CRN IS LEGAL FILENAME THEN DON'T CONVERT C MSBUF=IDISC MSCRN(19)=IDISC CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 440 CALL CNUMD(IDISC,MSCRN(18)) 440 MSBUF=JBUF(4) MSCRN(3)=JBUF(4) CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 449 CALL CNUMD(JBUF(4),MSCRN(3)) C C "CRN XXX HAS BEEN CHANGED TO CRN YYY". C 449 CALL EXEC(2,ILU,MSCRN,21) 443 IBTRK=0 C C GET CURRENT CARTRIDGE NUMBER C IF(IDISC.GT.0)JBUF(4)=IDISC IF(IDISC.NE.0)GO TO 447 IDISC=JBUF(4) ICRN=JBUF(4) GO TO 650 447 ICRN=0 IF(IDISC.GT.0)GO TO 650 ICRN=JBUF(4) C C DISC LU SPECIFIED, MAKE SURE CRN OF MAG TAPE DOESN'T DUPLICATE A C CRN NAME CURRENTLY MOUNTED ON ANOTHER CARTRIDGE. THAT IS SEARCH C CARTRIDGE LIST. C C CALL FSTAT(ISTAT,256,1,0) I=3 C C SET IRMBR TO INDICATE DISC ALREADY MOUNTED C IRMBR=-1 624 IF(ICRN.NE.ISTAT(I))GO TO 625 IF((-IDISC).NE.IAND(ISTAT(I-2),377B))GO TO 633 625 IF(ISTAT(I+2).EQ.0)GO TO 650 I=I+4 GO TO 624 C C DISC LU IS CURRENTLY MOUNTED TO SOMEONE ELSE RETURN ERROR C 633 FLAG=12 GO TO 83 C C 650 FLAG=0 ITDSC=IDISC C C MUST BE SYS MNGR TO RESTORE CRN 2 C C IF((ICRN.EQ.2).AND.(IDENT.NE.7777B))GO TO 208 C C CHECK TO SEE IF AUX DISC EXISTS, IF IT DOES THEN CAN'T RESTORE IT. C IF(IAUX.EQ.0)GO TO 655 IF((ICRN.EQ.3).AND.(IDENT.NE.7777B))GO TO 208 C C C C C REMEMBER SECTOR/TRK VALUE AND WORD/TRK VALUE OF MAG TAPE C JBUF(7)=SECTOR/TRACK VALUE ON MAG TAPE þúC C 655 ISCTR=JBUF(7) ILNTH=JBUF(7)*64 C C CALL MOUNT ROUTINE TO GET CARTRIDGE OR DISC LU C (LAST PARAMETER IN CALL TO "DCMC" SPECIFIES SEC/TRK VALUE. BY NOT C REQUESTING A SPECIFIC SEC/TRK VALUE IT WILL DEFAULT TO THE FIRST C AVAILABLE CARTRIDGE FROM THE DISC POOL). C C CALL DCMC(FLAG,3,IDISC,TYPE,SIZE,0,0,ICRN,0,0) C C B-REGISTER CONTAINS DISC LU MOUNT OBTAINED C CALL ABREG(IA,IDISC) C C C IF(ISYSV)660,670,670 C 660 IF(ISYSV.EQ.-1)IDUM=IXGET(1757B) IF(ISYSV.EQ.-2)IDUM=IXGET(1760B) C C CHECK CONDITIONS FOR A LEGAL RESTORE C GET STARTING TRACK LOC OF FMP TRACKS C NOW COMPARE AGAINST NEW LOCATION C ALSO, NEW SEC/TRK MUST BE THE SAME C C CALL EXEC(1,-ITDSC,MBUFR,9) C IF((MBUFR(5).LT.JBUF(5)).OR.(ISCTR.NE.IDUM))CALL EXEC(2,ILU, C & 16HILLEGAL RESTORE ,-8) C C C C IF FLAG(ERROR WORD) IS ZERO THEN PROCEED WITH RESTORATION C TO THE DESCRIBED DISC LU. C IF FLAG IS 12 THEN CARTRIDGE IS ALREADY MOUNTED, FIND C CRN NUMBER AND DISC LU FROM FSTAT AND PROMPT USER ON WHETHER C TO PROCEED WITH RESTORING THE CARTRIDGE. C REPORT ALL OTHER ERRORS AND RETURN C 670 IF (FLAG.EQ.0)GO TO 434 IF(FLAG.NE.12)GO TO 83 IF(ITDSC.LT.0)GO TO 500 C C A CARTRIDGE WAS SPECIFIED, SEARCH FSTAT FOR A MATCH C SET IRMBR TO INDICATE DISC WAS ALREADY MOUNTED C J=1 IRMBR=-1 CALL FSTAT(ISTAT,256,1,0) 337 IF(JBUF(4).EQ.ISTAT(J+2))GO TO 338 IF(ISTAT(J+4).EQ.0)GO TO 83 J=J+4 GO TO 337 C C FOUND IT C 338 IF((ISTAT(J+3).EQ.7777B).AND.(IDENT.NE.7777B))GO TO 83 IDISC=IAND(ISTAT(J),00377B) C C DO IMPOSSIBLE READ OF DISC AND MAKE SURE IT HAS ENOUGH ROOM. C JBUF(7) - SEC/TRK VALUE FROM MAG TAPE C IDUM - SEC/TRK VALUE OF DISC C IBTRK = LAST TRACK OF DISC LU C IDENT = TYPE (PRIVATE OR GROUP) C C IBTRK=ISTAT(J+1) IDENT=ISTAT(J+3) C C IF RESOTRING LU 2 OR 3 GET LAST TRACK FROM CL. C 6‚þú DO NOT ALLOW MOVING THE FIRST FMP TRACK BACK. C E.G. FROM TRACK 100 TO TRACK 90. C NOR ALLOW RESTORING TO A DIFFERENT SEC/TRK CARTRIDGE. C C IF(ISYSV.GE.0)GO TO 342 IBSZE=ISTAT(J+1)+1 CALL EXEC(1,IDISC,MBUFR,9,ISTAT(J+1),0) IF(JBUF(5).LT.MBUFR(5))GO TO 210 IF(MBUFR(7).NE.IDUM)GO TO 210 GO TO 340 C 342 CALL EXEC(1,IDISC,IDUM,1,-1,0) C C ROOM ENOUGH? COMPARE # SECTORS NECESSARY (FROM MT) WITH C # SECTORS AVAILABLE (FROM DISC). C JBUF(6) - NEXT AVAILABLE SECTOR (FROM MT) C JBUF(10) - NEXT AVAILABLE TRACK " C JBUF(9) - # DIRECTORY TRACKS (NEGATIVE) C 340 IF((FLOAT(JBUF(10)-JBUF(9))*ISCTR+JBUF(6)).GT. & FLOAT(IBTRK+1)*IDUM) GO TO 84 ITDSC=IDISC C C C DON'T CONVERT IF ASCII C MSBUF=IDISC MR14(25)=IDISC CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 350 MR14(24)=KCVT(IDISC) 350 MSBUF=(JBUF(4)) MR14(16)=(JBUF(4)) MR15(8)=(JBUF(4)) CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 355 CALL CNUMD(JBUF(4),MR14(15)) CALL CNUMD(JBUF(4),MR15(6)) C C DO YOU WANT TO OVERLAY......? C 355 CALL EXEC(2,ILU,MR16,22) CALL EXEC(2,ILU,MR14,24) CALL EXEC(2,ILU,MR15,17) CALL REIO(1,ILU,INBF,1) IF(INBF.EQ.2HYE)GO TO 357 CALL EXEC(2,ILU,16HCRN NOT RESTORED,8) GO TO 91 357 IDISC=-IDISC I=J GO TO 560 C C A DISC LU WAS SPECIFIED, SEARCH FSTAT FOR A MATCH C 500 CALL FSTAT(ISTAT,256,1,0) I=1 C C SET IRMBR=-1 TO INDICATE DISC WAS MOUNTED ALREADY. C IRMBR=-1 532 IF((-ITDSC).EQ.IAND(ISTAT(I),00377B))GO TO 538 IF(ISTAT(I+4).EQ.0)GO TO 83 I=I+4 GO TO 532 C C ICRN = CARTRIDGE REFERENCE NUMBER C IBTRK= LAST TRACK C IDENT= TYPE CARTRIDGE (PRIVATE OR GROUP) C 538 IF((ISTAT(I+3).EQ.7777B).AND.(IDENT.NE.7777B))GO TO 83 ICRN=ISTAT(I+2) IBTRK=ISTAT(I+Ûmþú1) ITDSC=-ITDSC IDISC=-ITDSC C C IF RESTORING LU 2 OR 3 THEN GET LAST TRACK FROM CL C CAN'T MOVE STARTING FMP TRACKS BACK C NOR CAN YOU RESTORE TO A CARTRDIGE WITH A DIFFERENT SEC/TRK VALUE. C C C IF(ISYSV.GE.0)GO TO 542 IBSZE=ISTAT(I+1)+1 CALL EXEC(1,ITDSC,MBUFR,9,ISTAT(I+1),0) IF(JBUF(5).LT.MBUFR(5))GO TO 210 IF(MBUFR(7).NE.IDUM)GO TO 210 GO TO 539 C C C 542 CALL EXEC(1,ITDSC,IDUM,1,-1,0) CALL ABREG(IA,IBSZE) C C ROOM ENOUGH? CHECK # SECTORS NEEDED VS. # SECTORS AVAILABLE. C 539 IF((FLOAT(JBUF(10)-JBUF(9))*ISCTR+JBUF(6)).GT. & FLOAT(IBTRK+1)*IDUM) GO TO 84 IDENT=ISTAT(I+3) MS11(16)=KCVT(ITDSC) MSBUF=JBUF(4) MS12(7)=JBUF(4) CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 540 CALL CNUMD(JBUF(4),MS12(5)) C C DISC CARTRIDGE ALREADY MOUNTED, ASK USER IF O.K. TO OVERLAY WITH C WHAT'S ON TAPE. C 540 CALL EXEC(2,ILU,MS10,10) CALL EXEC(2,ILU,MS11,16) CALL EXEC(2,ILU,MS12,14) CALL REIO(1,ILU,INBF,1) IF(INBF.EQ.2HYE)GO TO 560 C CALL EXEC(2,ILU,16HCRN NOT RESTORED,8) GO TO 91 C C UPDATE SYSTEM CARTRIDGE LIST I.E. CALL D.RTR TO DO THE UPDATE C KBUFR CONTAINS 1. DISC LU 2.LAST FMP TRACK 3.CRN 4.ID C 560 CALL EXEC(2,ILU,18H/READT: CONTINUE ,9) KBUFR(1)=ITDSC KBUFR(2)=IBTRK KBUFR(3)=JBUF(4) KBUFR(4)=IDENT C C CALL D.RTR C CALL EXEC(23,6HD.RTR ,IXEQT,15,-ITDSC,0,0,KBUFR,4) C C CALL D.RTR TO LOCK DISC C CALL EXEC(23,6HD.RTR ,IXEQT,3,-ITDSC,0,0,0,0) C C CHECK TO SEE IF LOCK WAS REJECTED C CALL RMPAR(LU) C C IF THE FIRST WORD IS NEGATIVE THEN LOCK WAS REJECTED. C IF(LU.LT.0)GO TO 102 C C IF NOT RESTORING SYS OR AUX DISCS THEN SKIP THIS. C IF(ISYSV)788,434,434 C C FIND OUT IF THERE ARE ANY ID SEG. POINTING TO FMP TRACKS C ON THE CARTRIDGE BEING RESTORED. C C „öþúC JBUF(5) IS THE FIRST AVAILABLE TRACK FOR FMP FILES C C 788 DISCL=IABS(ITDSC) C IDISC=-ITDSC C C CALL IDSGM(DISCL,JBUF(5),ILU,IERR) IF(IERR)91,434,434 C C C A CARTRIDGE OR DISC HAS BEEN FOUND RE-ADJUST TRACK SIZE C IF NECESSARY C 434 IDISC=-IDISC IF(IBTRK.EQ.0)GO TO 437 C C DO AN IMPOSSIBLE READ TO GET SEC/TRACK VALUE OF DISC C AND THEN DETERMINE IF THERE'S ENOUGH ROOM ON THE DISC. C (OTHERWISE CAN'T RESTORE TO THAT LU) C C IF(ISYSV)1110,430,430 C 430 CALL EXEC(1,IDISC,IDUM,1,-1,0) CALL ABREG(IA,IBSZE) C C ROOM ENOUGH? C COMPARE # TRACKS USED ON MAG TAPE WITH # TRACKS AVAILABLE ON DISC. C (SINCE THEY MAY HAVE DIFFERENT SEC/TRK VALUES, MUST USE RATIO). C 1110 IF((JBUF(10)*FLOAT(ISCTR)/FLOAT(IDUM)).GT. & ((IBTRK+(JBUF(9)+1))*FLOAT(ISCTR)/FLOAT(IDUM))) GOTO 84 SIZE=IBTRK+1 C C DO AN IMPOSSIBLE READ TO GET TRACK AND SECTOR C SIZE OF DISC LU C C C C 437 IF(ISYSV)4350,438,438 C 438 CALL EXEC(1,IDISC,IDUM,1,-1,0) CALL ABREG(IA,IBSZE) 4350 IF((IDUM.NE.ISCTR).OR.(IBSZE.GE.SIZE)) GOTO 445 C C IF CARTRIDGE CAN BE MOUNTED TO DIFFERENT SIZE C DISC ASK USER IF IT'S OKAY TO PROCEED C IF((FLOAT(JBUF(10)-JBUF(9))*ISCTR+JBUF(6)).GT. & FLOAT(IBSZE)*IDUM)GO TO 84 MSBUF=(JBUF(4)) MDR1(3)=(JBUF(4)) CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 423 CALL CNUMD(JBUF(4),MDR1(3)) 423 ISIZE=JBUF(8)+1 CALL CNUMD(ISIZE,MDR1(15)) CALL CNUMD(JBUF(10),MDR2(15)) CALL CNUMD(IBSZE,MDR3(18)) CALL REIO(2,ILU,MDR1,24) CALL REIO(2,ILU,MDR2,17) CALL REIO(2,ILU,MDR3,26) CALL REIO(2,ILU,MDR4,24) CALL REIO(1,ILU,MBUF,1) IF(MBUF.NE.2HYE)GO TO 90 SIZE=IBSZE C C IF SIZE OF CARTRIDGE IS NOT EQ TO SIZE SPECIFIED C THEN TELL USER THE DIRECTORY TRACKS HAVE BEEN MOVED C 445 IF(SIZE.EQ.0)SIZE=IBSZE C C MAKE SURE THERE'S ENOUGH ROOM Ó§þú C IF((FLOAT(JBUF(10)-JBUF(9))*ISCTR+JBUF(6)).GT. & FLOAT(IBSZE)*IDUM) GO TO 84 IF(JBUF(8)-JBUF(9).EQ.SIZE)GO TO 446 CALL CNUMD((JBUF(8)-JBUF(9)-1),MSDRT(16)) CALL CNUMD(SIZE-1,MSDRT(21)) CALL EXEC(2,ILU,MSDRT,23) 446 JBUF(8)=SIZE+JBUF(9) C C COMPUTE WORD/TRK VALUE OF DISC. C JLNTH=IDUM*64 C C SAVE LOWEST DIRECTORY TRACK AND TOTAL NUMBER OF DIRECTORY TRACKS. C LODIR=JBUF(8) NDIR=-(JBUF(9)) C C SEC/TRK SAME? IF NOT, GO RE-FORMAT BEFORE RESTORE. C IF(ISCTR.NE.IDUM) GOTO 600 C C NOW COPY DIRECTORY TRACKS. C C INITIALIZE RELATIVE DIRECTORY SECTOR (USED ONLY FOR LU 2 OR 3) C JJ=0 C DO 47 II=1,NDIR N=9 C C GET READY TO CLEAR OPEN FLAGS (4 ENTRIES/SECTOR). C DO 46 I=1,ISCTR*4 C C IF THIS IS THE FIRST TIME THROUGH, SKIP. C IF((II.EQ.1).AND.(N.EQ.9)) GOTO 455 C C NOW CLEAR 'EM OUT (OPEN FLAGS, THAT IS). C DO 45 J=1,7 JBUF(N+J)=0 45 CONTINUE C C INCREMENT TO NEXT ENTRY (EACH ENTRY 16 WORDS). C 455 N=N+16 46 CONTINUE C C WRITE DIRECTORY TRACK TO DISC C C IF RESTORING SYS OR AUXILARY DISC HAVE D.RTR RESTORE C DIRECTORY TRACKS. C C IF(ISYSV)460,465,465 C C C THIS CODE IS USED ONLY WHEN RESTORING LU 2 OR 3. C ********************************************** C BB IS POINTER INTO JBUF ONLY 128 WORDS ARE WRITTEN AT A TIME C JJ IS THE RELATIVE DIRECTORY SECTOR E.G. 98 IS C SECTOR 2 OF THE SECOND DIR. TRACK ON A 96 SECTOR/TRK CRN. C THIS IS USED ONLY WHEN RESTORING LU 2 OR LU 3. C C 460 BB=1 462 CALL EXEC(23,6HD.RTR ,IXEQT,9,IDISC,JJ,0,JBUF(BB),128) BB=(JJ+1)*14 BB=BB-((BB/ISCTR)*ISCTR) BB=(BB*64)+1 JJ=JJ+1 IF(JJ.EQ.((ISCTR*II)/2))GO TO 470 GO TO 462 C C 464 GO TO 470 C C 465 CALL EXEC(2+100000B,IDISC+74000B,JBUF,JLNTH,SIZE-II,0) C C DO ANYTHING EXCEPT ABORT C 4666CAþú GO TO 4655 4777 GO TO 4666 C C MAKE SURE WRITE WAS O.K. C 4655 CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,JLNTH,SIZE-II,0,0,FLAG,0) C C GET NEXT TRACK FROM MAG TAPE C 470 IF(II.EQ.NDIR) GOTO 47 CALL EXEC(1,MTLU,IBUF,ILNTH+1) CALL ABREG(IA,IB) C C MAKE SURE READ WAS O.K. C IERR - = 1 EOF - TROUBLE, WHERE ARE DATA TRACKS? C =-1 ABORT C =-2 PARITY ERROR C IERR=0 CALL VVALD(IA,IB,1,JLNTH,ITRAK,0,ILNTH,FLAG,IERR) IF(IERR.EQ.1) GOTO 201 IF(IERR.EQ.-1) GOTO 91 IF(IERR.EQ.-2) GOTO 204 47 CONTINUE C C NOW DO DATA TRACKS. C 48 CALL EXEC(1,MTLU,IBUF,ILNTH+1) CALL ABREG(IA,IB) C C MAKE SURE READ WAS O.K. C IERR - = 1 EOF (NORMAL TERMINATION) C =-1 ABORT C =-2 PARITY ERROR C IERR=0 CALL VVALD(IA,IB,1,JLNTH,ITRAK,0,ILNTH,FLAG,IERR) IF(IERR.EQ.1) GOTO 203 IF(IERR.EQ.-1) GOTO 91 IF(IERR.EQ.-2) GOTO 204 C C READ WAS O.K. NOW WRITE TRACK TO DISC. C CALL EXEC(2+100000B,IDISC+74000B,JBUF,JLNTH,ITRAK,0) C 4790 GO TO 4800 4888 GO TO 4790 C MAKE SURE WRITE WAS O.K. C 4800 CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,JLNTH,ITRAK,0,0,FLAG,0) GOTO 48 C C MUST CHANGE THE FOLLOWING SO THAT FMGR WILL HAVE CORRECT INFO C AFTER THE REFORMATTING OCCURS: C 1) NEXT AVAILABLE TRACK AND SECTOR. JBUF(10),JBUF(6) C 2) SEC/TRK JBUF(7) C 3) FIRST AVIALABLE FMP TRACK JBUF(5) C 600 TSEC=FLOAT(JBUF(10))*FLOAT(ISCTR)+JBUF(6) JBUF(10)=TSEC/IDUM JBUF(6)=TSEC-FLOAT(JBUF(10))*FLOAT(IDUM) JBUF(7)=IDUM C C PICK UP STARTING TRACK LOCATION C TEMP2=JBUF(5) C C TELL USER THAT THE SEC/TRK VALUE OF THE NEW CARTRIDGE IS C DIFFERENT AND THAT MT TRACKS MUST BE RE-FORMATTED BEFORE C RESTORING. C CALL CNUMD(ISCTR,MSFMT(14)) CALL CNUMD(IDUM,MSFMT(23)) CALL Eb,þúXEC(2,ILU,MSFMT,30) C C CALL SUBROUTINE TO REFORMAT AND RESTORE DIRECTORY TRACKS TO DISC. C IERR - = 1 EOF - TROUBLE, WHERE ARE DATA TRACKS? C =-1 ABORT C =-2 PARITY ERROR C IERR=0 CALL REDIR(ISCTR,IDUM,FLAG,IERR) IF(IERR.EQ.1) GOTO 201 IF(IERR.EQ.-1) GOTO 91 IF(IERR.EQ.-2) GOTO 204 C C EVERYTHING WENT O.K. NOW DO SAME FOR THE DATA TRACKS. C IERR - = 1 EOF (NORMAL TERMINATION) C =-1 ABORT C =-2 PARITY ERROR C IERR=0 CALL REFMT(ISCTR,IDUM,FLAG,IERR,TEMP2) IF(IERR.EQ.1) GOTO 203 IF(IERR.EQ.-1) GOTO 91 IF(IERR.EQ.-2) GOTO 204 C C ERRORS C C NON-SESSION: LU MUST BE NEGATIVE C 80 CALL EXEC(2,ILU,MRR10,22) CALL PTERR(MRR10(2),FLAG) GO TO 91 C C BAD TAPE FORMAT C 81 CALL EXEC(2,ILU,MRR2,14) CALL PTERR(MRR2(2),FLAG) GO TO 91 C C ILLEGAL DISC LU C 82 CALL EXEC(2,ILU,MRR6,13) CALL PTERR(MRR6(2),FLAG) GO TO 91 C C SPECIFIED DISC LU MOUNTED TO SOMEONE ELSE OR CRN ALREADY EXISTS. C 83 IF(FLAG.GE.0)GO TO 835 FLAG=-FLAG MRR12(15)=2H-0 835 MRR12(16)=KCVT(FLAG) CALL EXEC(2,ILU,MRR12,16) CALL PTERR(MRR12(2),FLAG) IF(IRMBR) 91,90,90 C C SPECIFIED LU OR FREE LU IS NOT BIG ENOUGH TO RESTORE CRN C 84 CALL EXEC(2,ILU,MR13,32) CALL PTERR(MR13(2),FLAG) IF(IRMBR)91,90,90 C C MAG TAPE DOWN C 100 CALL EXEC(2,ILU,MRR1,13) CALL PTERR(MRR1(2),FLAG) GO TO 92 C C DISC LU LOCKED C 102 CALL EXEC(2,ILU,MRR9,27) CALL PTERR(MRR9(2),FLAG) GO TO 91 C C LU LOCKED C 104 CALL EXEC(2,ILU,MRR3,11) CALL PTERR(MRR3(2),FLAG) GO TO 95 C C ILLEGAL MAG TAPE LU C 106 CALL EXEC(2,ILU,MRR4,16) CALL PTERR(MRR4(2),FLAG) GO TO 94 C C MAG TAPE OFFLINE C 200 CALL EXEC(2,ILU,MRR5,12) CALL PTERR(MRR5(2),FLAG) GO TO 92 C C EOF FOUND BEF#´ZXTORE DATA TRACKS C 201 CALL EXEC(2,ILU,MRR17,19) C C NORMAL TERMINATION - EVERYTHING HAS BEEN RESTORED. C 203 CALL CNUMD(IDISC,MESLU(8)) CALL EXEC(2,ILU,MESLU,10) GOTO 91 C C PARITY ERROR C 204 CALL EXEC(2,ILU,MRR7,12) CALL PTERR(MRR7(2),FLAG) GO TO 91 C C END OF TAPE C 206 CALL EXEC(2,ILU,MRR8,12) CALL PTERR(MRR8(2),FLAG) GO TO 92 C C CAN'T RESTORE LU 2 C 208 CALL EXEC(2,ILU,MR17,26) CALL PTERR(MR17(2),FLAG) GO TO 91 C C ILLEGAL RESTORE TO LU 2 OR 3. C 210 CALL EXEC(2,ILU,MR18,20) CALL PTERR(MR18(2),FLAG) GO TO 91 C C SIZE ERROR (# OF TRACKS REQUESTED IS TO SMALL TO RESTORE TO ) C 885 CALL EXEC(2,ILU,MRR11,11) CALL PTERR(MRR11(2),FLAG) GO TO 91 C C UNLOCK AND DISMOUNT DISC LU. C 90 CALL DCMC(FLAG,2,-IDISC,2HRR) C C INHIBIT REWIND? IF (INHBT)YES,NO,NO C 91 IF(INHBT)92,911,911 911 CALL EXEC(3,MTLU+500B) C C UNLOCK DISC C 92 CALL EXEC(23,6HD.RTR ,IXEQT,5,-ITDSC,0,0,0,0) C C UNLOCK MAG TAPE UNIT C 94 CALL LURQ(40000B,MTLU,1) GO TO 93 95 CONTINUE C C REPORT /READT: STOP C 93 CALL EXEC(2,ILU,MESS8,7) END END$ ˜Zÿÿ ÿý* ÿ92067-18333 2026 S C0122 &WRITT WRITT SUBROUTINE              H0101 áþúFTN4,L,C C PROGRAM WRITT (3,50),92067-16333 REV.2026 800416 C C NAME: WRITT C SOURCE: 92067-18333 C RELOC: 92067-16333 C PGMR: R.D. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C -LU MAG C RU,WRITT, OR ,TAPE, IH (INHIBIT REWIND), DC (DON'T PERFORM THE C +CRN LU OVERLAY CHECK) C C RU,WRITT WILL DEFAULT TO THE FIRST PRIVATE OR GROUP C CARTRIDGE THAT'S MOUNTED TO THE SESSION C EXECUTING THE PROGRAM. C C IMPLICIT INTEGER (A-Z) LOGICAL NAMR,IN EXTERNAL MT1OK,FESSN,NMCHK DIMENSION ILBUF(80),INAM1(10),INAM2(10),INAM3(10),INAM4(10) DIMENSION MESSD(7),JTM(27),MSAVE(12),IDENT(2) DIMENSION LUARY(2),ISTAT(256) DIMENSION MRR1(13),MRR2(25),MRR3(11),MRR4(16),MRR5(12) DIMENSION MRR6(13),MRR7(12),MRR8(12),MRR9(27),MRR10(13) DIMENSION MRR14(27),MRR15(29),LU(5),IREG(2) DIMENSION IBUF(8193),JBUF(8192) DIMENSION MES10(12),MES11(20),MES16(30) DIMENSION MES12(26),MES14(9) INTEGER FIRST,LAST,FLAG,LASTTR C DIMENSION MSBUF(3) DIMENSION MESS9(8),MRR11(14),MRR12(25) DIMENSION ITM(30) DIMENSION NAMBF(4),NAMDR(4) COMPLEX ITMI(3) C EQUIVALENCE (MESSD(5),MLU) EQUIVALENCE (IBUF,ITRAK),(JBUF,IBUF(2)) EQUIVALENCE (ITME,ITM(13)),(NAMBF,ITM(6)) EQUIVALENCE (NAMDR,JBUF(1)),(ITMI,ITM) EQUIVALENCE (LUARY,MTLU),(MTYPE,ITM(29)) EQUIVALENCE (IDISC,INAM1) C DATA MSBUF/2H ,2H ,2H / DATA ITAPE/1/ DATA MBLNK/2H / `þúDATA LASTTR/0/ DATA MID1/2HPR/ DATA MID2/2HGR/ DATA LUARY(2)/2HWR/ DATA JYES/2HYE/ DATA MRR1/6412B,2HWR,2HIT,2H 0,2H01,2H ,2HMA,2HG ,2HTA,2HPE, & 2H D,2HOW,2HN / DATA MRR2/6412B,2HWR,2HIT,2H 0,2H02,2H O,2HNL,2HY ,2HTH,2HE , & 2HSY,2HS ,2HMN,2HGR,2H M,2HAY,2H S,2HAV,2HE , & 2HSY,2HST,2HEM,2H D,2HIS,2HCS/ DATA MRR3/6412B,2HWR,2HIT,2H 0,2H03,2H ,2HLU,2H L,2HOC,2HKE, & 2HD / DATA MRR4/6412B,2HWR,2HIT,2H 0,2H04,2H ,2HIL,2HLE,2HGA,2HL , & 2HMA,2HG ,2HTA,2HPE,2H L,2HU / DATA MRR5/6412B,2HWR,2HIT,2H 0,2H05,2H ,2HMT,2H O,2HFF,2H L, & 2HIN,2HE / DATA MRR6/6412B,2HWR,2HIT,2H 0,2H06,2H ,2HNO,2H W,2HRI,2HTE, & 2H R,2HIN,2HG / DATA MRR7/6412B,2HWR,2HIT,2H 0,2H07,2H P,2HAR,2HIT,2HY ,2HER, & 2HRO,2HR / DATA MRR8/6412B,2HWR,2HIT,2H 0,2H08,2H ,2HEN,2HD ,2HOF,2H T, & 2HAP,2HE / DATA MRR9/6412B,2HWR,2HIT,2H 0,2H09,2H F,2HIL,2HE ,2HOP,2HEN, & 2H O,2HR ,2HWR,2HIT,2HT',2HS ,2HDI,2HSC,2H L,2HU , & 2HLO,2HCK,2H R,2HEJ,2HEC,2HTE,2HD / DATA MRR10/6412B,2HWR,2HIT,2H 0,2H10,2H ,2HDI,2HSC,2H N,2HOT, & 2H F,2HOU,2HND/ DATA MRR11/6412B,2HWR,2HIT,2H 0,2H11,2H ,2HIL,2HLE,2HGA,2HL , & 2HDI,2HSC,2H L,2HU / DATA MRR12/6412B,2HWR,2HIT,2H 0,2H12,2H O,2HNL,2HY ,2HTH, & 2HE ,2HSY,2HS ,2HMN,2HGR,2H M,2HAY, & 2H S,2HAV,2HE ,2HLU,2H 2,2H O,2HR , & 2HLU,2H 3/ DATA MRR14/6412B,2HWR,2HIT,2H 0,2H13,2H B,2HAD,2H T,2HRA,2HNS, & 2HMI,2HSS,2HIO,2HN-,2H-D,2HIS,2HC ,2HTO,2H M,2HEM,2HOR, & 2HY ,2HTR,2HK ,2H ,2H ,2H / DATA MRR15/6412B,2HWR,2HIT,2H 0,2H14,2H B,2HAD,2H T,2HRA,2HNS, & 2HMI,2HSS,2HIO,2HN-,2H-M,2HEM,2HOR,2HY ,2HTO,2H ,~þúM,2HAG, & 2H T,2HAP,2HE ,2HRE,2HC ,2H ,2H ,2H / DATA JLNTH/8192/ C DATA MESS9/6412B,2H/W,2HRI,2HTT,2H: ,2H S,2HTO,2HP / DATA ITMI/8HCR ,8H CRNAME,8H SAVED / DATA MESSD/2HFR,2HOM,2H L,2HU ,2HXX,2HXX,2HXX/ C C DATA MES10/6412B,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2HWA, & 2HRN,2HIN,2HG / DATA MES11/2HWR,2HIT,2HT',2HS ,2HDI,2HSC,2H L,2HU ,2HLO,2HCK, & 2H W,2HAS,2H N,2HOT,2H S,2HUC,2HCE,2HSS,2HFU,2HL,/ DATA MES16/2HHO,2HWE,2HVE,2HR,,2H W,2HRI,2HTT,2H W,2HIL,2HL , & 2HPE,2HRF,2HOR,2HM ,2HTH,2HE ,2HSA,2HVE,2H. ,2HIT, & 2H'S,2H S,2HUG,2HGE,2HST,2HTE,2HD ,2HTH,2HAT,2H / DATA MES12/2HMO,2HDI,2HFI,2HCA,2HTI,2HON,2HS ,2HTO,2H D,2HIS, & 2HC ,2HLU,2H ,2H ,2H ,2HBE,2H P,2HOS,2HTP,2HON, & 2HED,2H U,2HNT,2HIL,2H T,2HHE/ DATA MES14/2HSA,2HVE,2H I,2HS ,2HCO,2HMP,2HLE,2HTE,2HD./ C C PICK UP PARAMETERS +CRN OR -LU (DISC) AND + OR - MAG TAPE LU C CALL EXEC(14,1,ILBUF,-80) CALL ABREG(IA,IB) IS=1 ILU=LOGLU(ISES)+400B C C PARSE "RU,WRITT" C IF(NAMR(INAM1,ILBUF,IB,IS))1,1 1 IF(NAMR(INAM1,ILBUF,IB,IS))2,2 C C PARSE LU OR CRN, MTLU, IH (INHIBIT REWIND), DC (DON'T CHECK) C C 2 IF(NAMR(INAM1,ILBUF,IB,IS))3,3 3 IF(NAMR(INAM2,ILBUF,IB,IS))4,4 4 IF(NAMR(INAM3,ILBUF,IB,IS))5,5 5 IF(NAMR(INAM4,ILBUF,IB,IS))6,6 6 MTLU=IABS(INAM2) IF(MTLU.EQ.0)MTLU=8 C MAG TAPE LU C SET FLAG TO KNOW WHETHER TO INHIBIT REWIND INHBT<0 DO NOT REWIND C INHBT>= REWIND C IF(INAM3.EQ.2HIH)INHBT=-1 C C SET FLAG TO NOT PERFORM THE OVERLAY FEATURE. C IF(INAM4.EQ.2HDC)IDONC=-1 IAUX=IXGET(1760B) C C SET ISYSV=-1 IF SAVING LU 2 OR 3. C IF(IABS(IDISC).EQ.2)ISYSV=-1 IF((IAUX.NE.0).AND.(IABS(IDISC).EQ.3))ISYSV=-1 C C C USE IGET TO GET CURRENT ‡þúEXECUTING PROGRAM C IXEQT=IXGET(1717B) C C CHECK VALIDITY OF MAG TAPE LU C IF(LUARY.GT.64)GO TO 106 C CALL EXEC(13+100000B,MTLU,ISTAT,ISTA1,ISTA2) GO TO 106 C C MUST BE DRIVERS 23 0R 24 C C C CHECK TO SEE IF DEVICE IS BUFFERED. C IF IT IS THEN A AND B REGS. ARE MEANINGLESS AFTER EXEC CALLS. C 2555 BUFRD=0 IF(IAND(ISTA1,040000B).EQ.040000B) BUFRD=-1 IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 113 IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 113 GO TO 106 C C CHECK TO SEE IF MAG TAPE AND EQT ARE UP C 113 IF(IAND(ISTAT,040000B).EQ.040000B)GO TO 100 IF(IAND(ISTA2,100000B).EQ.100000B)GO TO 100 C C LOCK MAG TAPE UNIT C CALL LURQ(140001B,MTLU,1) GO TO 106 2333 CALL ABREG(IA,IB) IF(IA.EQ.1)GO TO 104 C C PERFORM STATUS CHECK ON MAG TAPE UNIT C CALL EXEC(13+100000B,MTLU,ISTAT) GO TO 106 2666 ITYPE=IAND(ISTAT,37400B)/256 C C CHECK FOR CORRECT DRIVER TYPE C IF((ITYPE.EQ.23B).OR.(ITYPE.EQ.24B))GO TO 18 GO TO 106 C C CHECK STATUS OF MAG TAPE C 18 CALL MT1OK(LUARY,FLAG) IF(FLAG.EQ.0)GO TO 15 IF(FLAG.EQ.1)GO TO 200 IF(FLAG.EQ.2)GO TO 202 IF(FLAG.EQ.4)GO TO 206 C C CHECK TO SEE IF CRN (POSITIVE) OR LU (NEGATIVE) C WAS SPECIFIED. C C 15 IF(IDISC.GE.0)GO TO 20 IDISC=-IDISC C C MUST BE A LEGAL LU C IF(IDISC.LE.1)GO TO 115 IF(IDISC.GT.63)GO TO 115 C C CHECK DRIVER TYPE OF SPECIFIED LU C CALL EXEC(13+100000B,IDISC,ISTAT) GO TO 115 2444 ITYPE=IAND(ISTAT,37400B)/256 C C NOT A DISK IF DVR NOT 30,31,32, OR 33 C IF((ITYPE.GT.27B).AND.(ITYPE.LT.34B))GO TO 117 C C ILLEGAL DISC LU C 115 CALL REIO(2,ILU,MRR11,14) CALL PTERR(MRR11(2),FLAG) GO TO 90 C 117 IDISC=-IDISC C C C CHECK WHETHER IN SESSION OR NOT C RETURN ADSCB =ADDRESS OF SCB C SMID=$SMIDJrþú, OFFSET TO USER ID WORD IN SCB C INSES=DESCRIBES WHETHER OR NOT IN SESSION C C 20 IF(INHBT)2442,2440,2440 C 2440 REWIND MTLU C C 2442 CALL FESSN(ADSCB,INSES,SMID) C C MOVE USER AND GROUP ID'S INTO IDENT C CALL ISMVE(ADSCB,SMID,IDENT,2) IOP=0 C C IF SYSTEM MANAGER (7777B) HE HAS ACCESS TO ALL DISCS C IF(IDENT.EQ.7777B)IOP=1 C C CALL FSTAT TO GET ALL CARTRIDGES CURRENTLY MOUNTED C CALL FSTAT(ISTAT,256,1,IOP) C C ONLY SYSTEM MANAGER CAN SAVE LU 2 AND LU 3 C CHECK FOR NONQUALIFIED REQUESTS C IF((IABS(IDISC).EQ.2).AND.(IDENT.NE.7777B))GO TO 212 IF(IAUX.EQ.0)GO TO 2280 IF((IABS(IDISC).EQ.3).AND.(IDENT.NE.7777B))GO TO 212 C C IS CRN OR LU SPECIFED C 2280 IF(IDISC.GT.0)GO TO 23 IF(IDISC.LT.0)GO TO 36 C C NEITHER WAS SPECIFIED DEFAULT TO FIRST PRIVATE OR C GROUP CATRIDGE MOUNTED TO HIS SESSION C K=3 C C HE CAN'T DEFAULT TO SYS DISCS THOUGH C 228 IF(IDENT.EQ.7777B)GO TO 2283 IF(ISTAT(K-2).EQ.2)GO TO 212 IF((IAUX.NE.0).AND.(ISTAT(K-2).EQ.3))GO TO 212 2282 IF((ISTAT(K+1).EQ.7777B).AND.(IDENT.NE.7777B))GO TO 205 C C OTHERWISE GET DISC LU C 2283 IDISC=IAND(ISTAT(K-2),00377B) IF(IDENT.EQ.ISTAT(K+1).OR.IDENT(2).EQ.ISTAT(K+1))GO TO 230 C C IF NO MORE CARTRIDGES THEN "DISC NOT FOUND" C IF(ISTAT(K+1).EQ.0)GO TO 210 K=K+4 GO TO 228 C C A CARTRIDGE HAS BEEN FOUND C CHECK FOR PRIVATE OR GROUP TYPE C 230 TYPE=0 IF(ISTAT(K+1).EQ.IDENT(2))TYPE=1 C C SAVE LAST FMP TRACK (IT'S THE FIRST DIRECTORY TRACK) C ITRAK=ISTAT(K-1) GO TO 30 C C CHECK TO SEE IF THE DISC IS REALLY THERE C 23 I=3 24 IF(IDISC.EQ.ISTAT(I))GO TO 33 IF(ISTAT(I+2).EQ.0)GO TO 210 25 I=I+4 GO TO 24 C C GET THE LU OF THE DISC AND MAKE SURE IT WASN'T THE SYSTEM DISC C 33 IDISC=IAND(ISTAT(I-2),00377B) CALL ISMVE(Au|þúDSCB,SMID,IDENT,2) IF((ISTAT(I+1).EQ.7777B).AND.(IDENT.NE.7777B))GO TO 205 C C IS IT PRIVATE OF GROUP? C TYPE=0 IF(ISTAT(I+1).EQ.IDENT(2))TYPE=1 C C SAVE THE LAST FMP TRACK (IT'S THE FIRST DIRECTORY TRACK) C ITRAK=ISTAT(I-1) GO TO 30 36 J=1 IDISC=-IDISC C C GET THE DISC LU AND MAKE SURE IT'S REALLY THERE C 37 IF(IDISC.EQ.IAND(ISTAT(J),00377B))GO TO 38 IF(ISTAT(J+4).EQ.0)GO TO 210 39 J=J+4 GO TO 37 C C MAKE SURE IT'S NOT THE SYSTEM DISC C 38 CALL ISMVE(ADSCB,SMID,IDENT,2) IF((ISTAT(J+3).EQ.7777B).AND.(IDENT.NE.7777B))GO TO 205 C C PRIVATE OR GROUP DISC? C TYPE=0 IF(ISTAT(J+3).EQ.IDENT(2))TYPE=1 C C SAVE THAT LAST FMP TRACK (IT'S THE FIRST DIRECTORY TRACK) C ITRAK=ISTAT(J+1) C C LOCK DISC LU THROUGH D.RTR C 30 CALL EXEC(23,6HD.RTR ,IXEQT,3,-IDISC,0,0,0,0) C C IF THE FIRST WORD IS NEGATIVE THEN LOCK REQUEST IS REJECTED C CALL RMPAR(LU) C IF(LU.LT.0)GO TO 208 C C IF(LASTTR.NE.0)ITRAK=LASTTR C C GET SEC/TRK OF DISC BY DOING AN IMPOSSIBLE READ. C DON'T DO IT IF IDISC EQUALS LU 2 OR LU 3 C IF(ISYSV)2774,2775,2775 C 2774 IF(IABS(IDISC).EQ.2)IDUM=IXGET(1757B) IF(IABS(IDISC).EQ.3)IDUM=IXGET(1760B) GO TO 2777 C 2775 CALL EXEC(1+100000B,IDISC,IDUM,1,-1,0) GO TO 115 2777 CALL ABREG(IA,IB) C C CALCULATE THE WORD/TRK VALUE OF THE DISC C JLNTH=IDUM*64 C C READ FIRST DIRECTORY TRACK FROM THE DISC C CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) C C MAKE SURE THE READ WAS O.K. C CALL ABREG(IA,IB) IF((IB.EQ.JLNTH).AND.(IAND(IA,1).NE.1)) GO TO 299 C C BAD LENGTH OR BIT ZERO OF EQT STATUS WORD 5 WAS SET C CALL CNUMD(ITRAK,MRR14(25)) CALL EXEC(2,ILU,MRR14,27) CALL PTERR(MRR14(2),FLAG) 299 CALL FTIME(ITME) MSBUF=JBUF(4) ITM(4)=JBUF(4) C C CHECK °ÉþúFOR ILLEGAL FILENAME C CALL NMCHK(MSBUF) CALL ABREG(IA,IB) IF(IA.EQ.0)GO TO 300 CALL CNUMD(MSBUF,ITM(2)) 300 NAMBF=NAMDR NAMBF(2)=NAMDR(2) NAMBF(3)=NAMDR(3) ITM(28)=MBLNK MTYPE=MID1 IF(TYPE.EQ.1)MTYPE=MID2 C C REMEMBER IF TAPE IS AT LOAD POINT C CALL EXEC(13,MTLU,ISTA1) C C CHECK FOR POSSIBLE HEADER CONFLICT C C IF IDONC < 0 THEN DON'T CHECK TAPE HEADER. C IF(IDONC)190,170,170 C 170 CALL EXEC(1+100000B,MTLU,JTM,27) GO TO 214 1701 CALL ABREG(IA,IB) C C IF BLANK TAPE I.E. TRANSMISSION LOG =0 THEN SKIP CHECK C IF(IB.EQ.0)GO TO 19 C C CHECK TO SEE IF THIS CARTRIDGE PREVIOUSLY RESIDES ON THE MAG TAPE C DO 17 JJ=1,12 IF(ITM(JJ).NE.JTM(JJ))GO TO 21 17 CONTINUE GO TO 19 C C SAVING A DIFFERENT CARTRIDGE TO THIS TAPE. BETTER MAKE SURE USER C IS AWARE OF THIS. C 21 CALL EXEC(2,ILU,2H ,1) CALL EXEC(2,ILU,24H****** CAUTION *********,12) CALL EXEC(2,ILU,14HDO YOU WANT TO,7) CALL EXEC(2,ILU,10H OVERLAY ,5) IF(JTM(1).NE.2HCR) CALL EXEC(2,ILU,16H A NONWRITT TAPE ,8) CALL EXEC(2,ILU,JTM,27) CALL EXEC(2,ILU,10H WITH ,5) CALL EXEC(2,ILU,ITM,30) CALL EXEC(2,ILU,14H(YES OR NO)? ,7) CALL EXEC(1,ILU,JTM,27) CALL EXEC(2,ILU,2H ,1) IF(JTM.EQ.JYES)GO TO 19 CALL EXEC(2,ILU,22H*** DISC NOT SAVED ***,11) CALL EXEC(2,ILU,2H ,1) C C IF INHIBIT REWIND WAS SPECIFIED ONLY BACKUP ONE RECORD. C IF(INHBT.NE.-1)GO TO 90 C CALL EXEC(3,MTLU+200B) GO TO 92 C C REWIND MAG TAPE AND WRITE NEW HEADER TO IT AND TO USER C 19 IF(IAND(ISTA1,100B).EQ.1)GO TO 185 C C IF TAPE WASN'T AT LOAD POINT THEN BACKUP ONE RECORD C CALL EXEC(3,MTLU+200B) GO TO 190 185 REWIND MTLU 190 CALL EXEC(2,MTLU,ITM,30) CALL EXEC(2,ILU,ITM,30) C C SAVE FIRST FMP TRACK (FIRSf¾þúT DATA TRACK) AND LAST FMP TRACK (LAST C DATA TRACK). ALSO SAVE THE LOWEST DIRECTORY TRACK. C FIRST=JBUF(5) LAST=JBUF(10) IF(LAST.EQ.LASTTR)LAST=LAST-1 IF((IAND(JBUF(6),7777B)).EQ.0)LAST=LAST-1 LOWDIR=JBUF(8) C C CHECK THE SEC/TRK VALUE FOUND IN THE CARTRIDGE SPECIFICATION ENTRY. C (FIRST 16 WORDS OF THE FIRST DIRECTORY FILE). IF IT'S DIFFERENT C THAN WHAT'S BEEN FOUND BEFORE, RESET IT AND RECALCULATE THE C WORD/TRK VALUE OF THE DISC. C IF(JBUF(7).EQ.IDUM) GO TO 42 IDUM=JBUF(7) JLNTH=IDUM*64 C C TELL USER WHICH LU IS BEING SAVED C 42 CALL CNUMD(IDISC,MLU) CALL EXEC(2,ILU,MESSD,7) GO TO 411 C C COPY TRACKS, DIRECTORY TRACK(S) FIRST, FOLLOWED BY DATA TRACK(S) C UNUSED TRACKS WILL NOT BE COPIED. C 40 CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) C C MAKE SURE READ WAS O.K. C CALL ABREG(IA,IB) IF((IB.EQ.JLNTH).AND.(IAND(IA,1).NE.1)) GO TO 411 C C C BAD LENGTH OR ERROR EXISTS BIT OF EQT STATUS WORD 5 WAS SET. C CALL CNUMD(ITRAK,MRR14(25)) CALL EXEC(2,ILU,MRR14,27) CALL PTERR(MRR14(2),FLAG) C C CHECK FOR END OF TAPE C 411 CALL EXEC(3,MTLU+600B) CALL ABREG(IA,IB) IF((IAND(IA,00040B).NE.40B))GO TO 403 CALL EXEC(3,MTLU+500B) CALL EXEC(2,ILU,MRR8,12) CALL PTERR(MRR8(2),FLAG) CALL EXEC(2,ILU,28HPLEASE MOUNT ANOTHER TAPE ,-28) 405 CALL EXEC(2,ILU,25HAFTER MOUNTING ENTER "GO",-25) CALL REIO(1,ILU,INBF,1) IF(INBF.NE.2HGO)GO TO 407 ITAPE=ITAPE+1 CALL EXEC(2,MTLU,ITAPE,1) GO TO 41 407 IF(INBF.EQ.2HAB)GO TO 90 GO TO 405 403 IF(IFBRK(IDMY))90,41 C C NOW WRITE THAT TRACK TO MAG TAPE C 41 CALL EXEC(2,MTLU,IBUF,JLNTH+1) C C MAKE SURE WRITE WAS O.K. C IF(BUFRD.NE.0)GO TO 406 CALL ABREG(IA,IB) C C PARITY ERROR? C IF(IAND(IA,2).EQ.2) GO TO 204 C C ¨ïþúTRANSMISSION LENGTH O.K.? C IF(IB.EQ.JLNTH+1) GO TO 406 CALL CNUMD(ITRAK,MRR15(27)) CALL EXEC(2,ILU,MRR15,29) CALL PTERR(MRR15(2),FLAG) C C GO COPY DATA TRKS IF DONE WITH DIRECTORY TRACKS. C 406 IF(ITRAK.EQ.LOWDIR) GO TO 45 C C ELSE - DECREMENT TRK # TO NEXT DIRECTORY TRK. C ITRAK=ITRAK-1 GO TO 40 C C MAG TAPE DOWN C 100 CALL EXEC(2,ILU,MRR1,13) CALL PTERR(MRR1(2),FLAG) GO TO 92 C C LU LOCKED C 104 CALL EXEC(2,ILU,MRR3,11) CALL PTERR(MRR3(2),FLAG) GO TO 92 C C ILLEGAL LU C 106 CALL EXEC(2,ILU,MRR4,16) CALL PTERR(MRR4(2),FLAG) GO TO 92 C C MAG TAPE OFF LINE C 200 CALL EXEC(2,ILU,MRR5,12) CALL PTERR(MRR5(2),FLAG) GO TO 92 C C NO WRITE RING C 202 CALL EXEC(2,ILU,MRR6,13) CALL PTERR(MRR6(2),FLAG) GO TO 92 C C PARITY ERROR C 204 CALL EXEC(2,ILU,MRR7,12) CALL PTERR(MRR7(2),FLAG) GO TO 92 C C END OF TAPE C 206 CALL EXEC(2,ILU,MRR8,13) CALL EXEC(2,ILU,28HMOUNT ANOTHER TAPE, AFTER ,-28) CALL EXEC(2,ILU,28HMOUNTING "RU,WRITT,... AGAIN,-28) CALL PTERR(MRR8(2),FLAG) GO TO 92 C C DISC LU LOCKED C 208 CALL EXEC(2,ILU,MRR9,27) CALL PTERR(MRR9(2),FLAG) GO TO 90 C C C DISC NOT FOUND C 210 CALL EXEC(2,ILU,MRR10,13) CALL PTERR(MRR10(2),FLAG) GO TO 90 C C CAN`T SAVE SYSTEM DISCS C 205 CALL EXEC(2,ILU,MRR2,25) CALL PTERR(MRR2(2),FLAG) GO TO 90 C C CAN'T SAVE LU 2 0R 3 C 212 CALL EXEC(2,ILU,MRR12,25) CALL PTERR(MRR12(2),FLAG) GO TO 90 C C BAD TRANSMISSION OF DATA C 214 CALL EXEC(2,ILU,MRR14,14) CALL PTERR(MRR14(2),FLAG) GO TO 1701 C C NOW SAVE DATA TRACKS C 45 DO 49 ITRAK=FIRST,LAST C C READ DATA TRACK FROM DISC C 46 CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) C C MAKE SURE READ WAS O.K. C <:6 CALL ABREG(IA,IB) IF((IB.EQ.JLNTH).AND.(IAND(IA,1).NE.1)) GO TO 474 C C BAD LENGTH OR ERROR EXISTS BIT IN EQT STATUS WORD 5 WAS SET. C CALL CNUMD(ITRAK,MRR14(25)) CALL EXEC(2,ILU,MRR14,27) CALL PTERR(MRR14(2),ITRAK) C C CHECK FOR END OF TAPE C 474 CALL EXEC(3,MTLU+600B) CALL ABREG(IA,IB) IF((IAND(IA,00040B).NE.40B))GO TO 443 CALL EXEC(3,MTLU+500B) CALL EXEC(2,ILU,MRR8,12) CALL PTERR(MRR8(2),FLAG) 475 CALL EXEC(2,ILU,28HPLEASE MOUNT ANOTHER TAPE ,-28) CALL EXEC(2,ILU,25HAFTER MOUNTING ENTER "GO",-25) CALL REIO(1,ILU,INBF,1) IF(INBF.NE.2HGO)GO TO 477 ITAPE=ITAPE+1 CALL EXEC(2,MTLU,ITAPE,1) GO TO 47 477 IF(INBF.EQ.2HAB)GO TO 90 GO TO 475 443 IF(IFBRK(IDMY))90,47 47 CALL EXEC(2,MTLU,IBUF,JLNTH+1) C C MAKE SURE WRITE WAS O.K. IF(BUFRD.NE.0)GO TO 49 CALL ABREG(IA,IB) C C PARITY ERROR? C IF(IAND(IA,2).EQ.2) GO TO 204 C C TRANSMISSION LENGTH O.K.? C IF(IB.EQ.JLNTH+1) GO TO 49 CALL CNUMD(ITRAK,MRR15(27)) CALL EXEC(2,ILU,MRR15,29) CALL PTERR(MRR15(2),FLAG) 49 CONTINUE C C PUT 2 EOF AT THE END. C BACK OVER ONE END OF FILE C C ENDFILE MTLU ENDFILE MTLU C C CALL EXEC(3,MTLU+1400B) C C END: REWIND TAPE C C CHECK WHETHER TO REWIND OR NOT INHBT< 0 DON'T REWIND C IF(INHBT)92,90,90 C 90 CALL EXEC(3,MTLU+500B) 92 CALL EXEC(23,6HD.RTR ,IXEQT,5,-IDISC,0,0,0,0) CALL LURQ(40000B,MTLU,1) GO TO 94 93 CONTINUE C C REPORT: /WRITT: STOP C 94 CALL REIO(2,ILU,MESS9,8) C END END$ ´<ÿÿ ÿý& ÿ92067-18334 2013 S C0122 &MERGE              H0101 u‰þúFTN4,L C C NAME: MERGE C SOURCE: 92067-18334 C RELOC: 92067-16334 C PGMR: R.D. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C PROGRAM MERGE (3,90),92067-16334 REV.2013 791206 C C LOGICAL NAMR,IN DIMENSION INAMT(2),MERG(5) DIMENSION INBF(40),IDCB2(144),LBUF(144) DIMENSION INFO1(12),INFO2(10) DIMENSION NAM2(3),INAME(3) DIMENSION INAM3(10),INAM4(10),INAM5(10) DIMENSION IMG10(5),IONE(6),MERR(5) COMMON/MERG1/ IQUIT,ILU(3),IDCB(272),INAM2(10),ITEMP,INAM1(10) COMMON/MERG2/ ISIZE(2),IRB,IOFF,JSEC,IDCB1(144),RECNT C EQUIVALENCE (NAM2,INAM2) EQUIVALENCE (ICRF,INAM1(6)),(ISECF,INAM1(5)) EQUIVALENCE (ISECU,INAM2(5)),(ICR,INAM2(6)) C DATA INFO1/2HEN,2HTE,2HR ,2HDE,2HST,2HIN,2HAT,2HIO, & 2HN ,2HNA,2HMR,20137B/ DATA INFO2/2HEN,2HTE,2HR ,2HCO,2HMM,2HAN,2HD ,2HNA,2HMR,20137B/ DATA IONE/6412B,2HME,2HRG,2HE ,2HST,2HOP/ DATA IMG10/6412B,2HME,2HRG,2H 0,2H01/ DATA MERR/6412B,2HFM,2HGR,2H- ,2H / DATA MERG/6412B,2HME,2HRG,2H 0,2H02/ C C C C C C C GET THE COMMAND STRING (RU,MERGE,NAMR1,NAMR2) C CALL EXEC(14,1,INBF,-80) CALL ABREG(IA,IB) C C IS=1 ILU=LOGLU(ISES)+400B C IQUIT=0 NOTRUN=0 ITEMP=0 C C SET RECORD COUNT TO ZERO C CLEAR OUT BUFFERS C RECNT=0 DO 23 I=1,10 23 INAM2(I)=0 INAM1(I)=0 CONTINUE C PICK UP "RU" AND "MERGE" IF(NAMR(INAM1,INBF,IB,IS))10,10 10 IF(NAMR(INAM1,INBF,IB,IS))20,20 C C PARSE THE FIRST AND SECOND PÂUþúARAMETERS C IF THEY EXIST C 20 IF(NAMR(INAM1,INBF,IB,IS))35,30 30 IF(NAMR(INAM2,INBF,IB,IS))222,999 C C IF THE FIRST PARM. DOESN'T EXIST CHECK FOR SECOND C 35 IF(NAMR(INAM2,INBF,IB,IS))100,999 C C IF THE SECOND PARAMETER EXISTS AND THE FIRST DOES NOT THEN C GO INTO INTERACIVE MODE C C C CHECK FOR PASSING OF AN LU I.E. IS PARAMETER > TWO ASCII BLANKS 999 IF(INAM1.GT.2H )GO TO 98 C C IF FIRST PARAMETER WASN'T SPECIFIED THEN DEFAULT TO TERMINAL C IF(INAM1.NE.0)GO TO 993 INAM1=LOGLU(ISES)+400B GO TO 955 C C CHECK FOR VALIDITY OF LU PASSED IN (NAMR1) C 993 IF((INAM1.LT.64).AND.(INAM1.GT.0))GO TO 954 GO TO 106 C C PREPARE FOR EXTENDED EXEC CALL C 954 INAM1=INAM1+400B 955 CALL EXEC(13+100000B,INAM1,ISTAT) GO TO 106 958 ICHEK=IAND(ISTAT,37400B)/256 C C CAN'T BE A DISC LU C IF((ICHEK.LE.27B).OR.(ICHEK.GE.34B))GO TO 995 GO TO 106 C C CHECK WHETHER OR NOT FIRST PARM IS INTERACTIVE DEVIEC C 995 INT=IFTTY(INAM1) IF(INT.EQ.-1)GO TO 190 C C IF NOT INTERACTIVE THEN GO OPEN ANSWER FILE C 98 CALL OPIN GO TO 194 C C C METHOD I IS REQUESTED C SET USER'S TERMINAL AS INTERACTIVE DEVICE C 100 ILU=LOGLU(ISES)+400B C C PROMPT FOR INFORMATION (FILENAMES ETC.) C C ENTER DESTINATION NAMR C CALL REIO(2,ILU,INFO1,12) 102 CALL REIO(1,ILU,INBF,-80) CALL ABREG(IA,IB) IF(INBF.EQ.2H/E)GO TO 200 IS=1 IF(NAMR(INAM2,INBF,IB,IS))222,103 C C USER MUST SUPPLY DESTINATION PARAMETER C 103 IF(INAM2.EQ.0)GO TO 222 C C ENTER COMMAND NAMR C CALL REIO(2,ILU,INFO2,10) CALL REIO(1,ILU,INBF,-80) CALL ABREG(IA,IB) IF(INBF.EQ.2H/E)GO TO 200 IS=1 IF(NAMR(INAM1,INBF,IB,IS))222,888 6 ILU=LOGLU(ISES)+400B C C USER MUST SUPPLY COMMAND INPUT PARAMETER C 888 IF (INAM1.EQ.0)GO TO 222 C C CHœþúECK TO SEE IF NAMR1 IS A LOGICAL UNIT C IF(INAM1.GT.2H )GO TO 887 C C IF IT'S AN LU THEN CHECK LEGALITY C IF((INAM1.LT.64).AND.(INAM1.GT.0))GO TO 885 C C IF NOT THEN RETURN ERROR OF ILLEGAL LU C GO TO 106 C C PREPARE FOR EXTENED EXEC CALL C 885 CALL EXEC(13+100000B,INAM1,ISTAT) GO TO 106 886 ICHEK=IAND(ISTAT,37400B)/256 IF((ICHEK.LE.27B).OR.(ICHEK.GE.34B))GO TO 883 GO TO 106 C C CHECK NAMR1 FOR INTERACTIVE DEVICE C 883 INT=IFTTY(INAM1) IF(INT.NE.-1)GO TO 887 INAM1=INAM1+400B GO TO 190 C C IF NOT INTERACTIVE THEN GO OPEN ANSWER FILE C 887 CALL OPIN GO TO 194 C C ON RETURN FROM OPEN GO CLOSE FILES C C 106 CALL EXEC(2,ILU,MERG,5) CALL PTERR(MERG(2),IERR) GO TO 200 C 222 CALL EXEC(2,ILU,IMG10,6) CALL PTERR(IMG10(2),IERR) GO TO 200 444 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) C C PUT ERROR CODE IN SESSION CONTROL BLOCK C CALL PTERR(MERR(2),IERR) GO TO 200 190 ILU=INAM1 C C INPUT WILL BE SUPPLIED INTERACTIVELY CALL OPIN1 C CALL OPIN1 C C IF SIZE IS -1 THEN DO A CLOSE WITH TRUNCATE C OTHERWISE DONT'T TRUNCATE DESTINATION FILE C 194 IF(ISIZE.NE.-1)GO TO 195 CALL LOCF(IDCB,IERR,I,IRB,I,JSEC) ITRUN=JSEC/2-IRB-1 C C WRITE END OF FILE C 195 CALL WRITF(IDCB,IERR,IXX,-1) CALL CLOSE(IDCB,IERR,ITRUN) CALL CLOSE(IDCB1,IERR) CALL CLOSE(IDCB2,IERR) 200 ITEMP=0 C C PRINT MERGE STOP C CALL EXEC(2,ILU,IONE,6) GO TO 90 90 END C C BLOCK DATA GLOBL COMMON/MERG1/ IQUIT,ILU(3),IDCB(272),INAM2(10),ITEMP,INAM1(10) COMMON/MERG2/ ISIZE(2),IRB,IOFF,JSEC,IDCB1(144),RECNT END C C C THE OPIN SUBROUTINE OPENS THE COMMAND FILE SUPPLIED BY Tß–þúHE USER. C IT THEN READS A FILE NAME, OPEN THAT FILE AND CALLS APPND TO READ C FROM THAT FILE AND WRITE INTO THE DESTINATION NAMR. C AFTER NO MORE FILES NAMES ARE READ CONTROL IS RETURN TO THE MAIN. C C SUBROUTINE OPIN LOGICAL NAMR DIMENSION INAMT(2),MERG(5) DIMENSION MERR(5) DIMENSION INAM5(10),INBF(40),IDCB2(144) COMMON/MERG1/ IQUIT,ILU(3),IDCB(272),INAM2(10),ITEMP,INAM1(10) COMMON/MERG2/ ISIZE(2),IRB,IOFF,JSEC,IDCB1(144),RECNT EQUIVALENCE (ISECE,INAM5(5)),(ICRE,INAM5(6)),(ICRF,INAM1(6)) EQUIVALENCE (ISECU,INAM2(5)),(ICR,INAM2(6)),(ISECF,INAM1(5)) DATA MERR/6412B,2HFM,2HGR,2H- ,2H / DATA MERG/6412B,2HME,2HRG,2H 0,2H02/ 30 ITMP=0 C C CHECK TO SEE IF NAMR2 IS AN LU C IF(INAM2.GT.2H )GO TO 38 CALL EXEC(13+100000B,INAM2,ISTAT) GO TO 106 34 ICHEK=IAND(ISTAT,37400B)/256 C C NAMR2 CAN'T BE A DISC DEVICE C IF((ICHEK.LE.27B).OR.(ICHEK.GE.34B))GO TO 38 IQUIT=-1 GO TO 106 C C OPEN UP NAMR1 C 38 CALL OPENF(IDCB1,IERR,INAM1,IOP,ISECF,ICRF) IF(IERR.GE.0)GO TO 40 C C RETURN ERROR IF IT EXISTS C IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) ITEMP=1 IQUIT=-1 GO TO 70 C C BEFORE READING FILE NAME CHECK BREAK FLAG STATUS C 40 IF(IFBRK(IDMY))70,50 C C KEEP COUNT OF FILE NAMES READ C 50 ITMP=ITMP+1 C C NOW READ IN FILE NAME C 53 CALL READF(IDCB1,IERR,INBF,40,LEN) IF(LEN.GE.0)GO TO 55 C C IF NO MORE FILE NAMES THEN CLOSE COMMAND FILE C CALL CLOSE(IDCB1,IERR) GO TO 70 55 IF(IERR.NE.0)GO TO 62 IS=1 IB=2*LEN C C PARSE FILE NAME C IF(NAMR(INAM5,INBF,IB,IS))70,65 C C CHECK TO SEE IF PARAMETER IS NULL C 65 IF((INAM5.EQ.0).AND.íçþú(INAM5(4).EQ.0))GO TO 53 C C REMEMBER CURRENT POSITION IN DESTINATION FILE C CALL LOCF(IDCB,IERR,RECNT,IRB,IOFF,JSEC) C C WRITE OUT FILENAME TO TERMINAL C CALL EXEC(2,ILU,INBF,LEN) C C OPEN FILE TO BE CONCATENATED C CALL OPENF(IDCB2,IERR,INAM5,IOP,ISECE,ICRE) IF(IERR.GE.0)GO TO 64 62 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),JERR) C C IF FILE CAN'T BE FOUND THEN REPORT C ERROR AND READ ANOTHER NAME. C IF(IERR.NE.6)GO TO 70 ITMP=ITMP-1 GO TO 40 64 RECNT=0 IF(ITMP.EQ.1)GO TO 66 CALL WRITF(IDCB,IERR,ILBUF,0) C GO TO 68 66 IF(INAM2.GT.2H )GO TO 995 C C IF NAMR2 IS A FILE NAME THEN TRY TO CREATE FILE C IF CREATION NOT POSSIBLE (FMGR-002) THEN OPEN FILE C OTHERWISE NAMR2 IS AN LU, CALL OPENF TO OPEN LU C 234 CALL OPENF(IDCB,IERR,INAM2,0,0,0) IF(IERR.GE.0)GO TO 68 CALL CLOSE(IDCB1,IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 GO TO 68 C C PREPARE TO CREATE DESTINATION FILE C TYPE IS DEFAULTED TO TYPE OF FIRST FILE IN COMMAND FILE C SIZE IS DEFAULTED TO -1 C IF FILE ALREADY EXISTS THEN OPEN IT C 995 ITYPE=IERR IF(INAM2(7).NE.0)ITYPE=INAM2(7) ISIZE=-1 IF(INAM2(8).NE.0)ISIZE=INAM2(8) IF(INAM2(8).NE.-1)NOTRUN=1 CALL CREAT(IDCB,IERR,INAM2,ISIZE,ITYPE,ISECU,ICR,256) C C IF FILE ALREADY EXISTS THEN OPEN IT C IF(IERR.EQ.-2)GO TO 999 IF(IERR.GE.0)GO TO 68 JERR=IERR CALL CLOSE(IDCB1,IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 IERR=JERR GO TO 62 C C FILE ALREADY EXISTS OPEN IT C 999 CALL OPENF(IDCB,IERR,INAM2,IOP,ISECU,ICR) IF(IERR.GE.0)GO TO 68 CALL CLOSE(IDCB1,IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 GO TO 62 C ë|þúC DESTINATION NAMR IS SET UP CALL APPND TO C READ FROM SOURCE FILE AND WRITE INTO DESTINATION FILE C 68 CALL APPND(IDCB2,ITYPE) C C IF NO ERROR IN APPND THEN TRY TO READ ANOTHER FILE NAME C IF(IQUIT.EQ.-1)GO TO 70 GO TO 40 C 106 CALL EXEC(2,ILU,MERG,5) CALL PTERR(MERG(2),IERR) C 70 RETURN END C C THE OPIN1 SUBROUTINE IS THE INTERACTIVE HANDLER OF C LIBRARIAN. IT PROMPTS THE USER WITH THE C "ENTER NAMR" COMMAND. C IT OPENS THE SOURCE FILE AND CREATES OR OPENS THE C DESTINATION NAMR. WHEN NO MORE FILES ARE SUPPLIED C (ENTERING /E) THEN CONTROL IS RETURNED TO THE MAIN. C C SUBROUTINE OPIN1 LOGICAL NAMR DIMENSION MERR(5),INAMT(2),MERG(5) DIMENSION IDCB2(144),INBF(40),INFO4(7) COMMON/MERG1/ IQUIT,ILU(3),IDCB(272),INAM2(10),ITEMP,INAM1(10) COMMON/MERG2/ ISIZE(2),IRB,IOFF,JSEC,IDCB1(144),RECNT EQUIVALENCE (ICRF,INAM1(6)),(ISECF,INAM1(5)) EQUIVALENCE (ICR,INAM2(6)),(ISECU,INAM2(5)) DATA INFO4/2HEN,2HTE,2HR ,2HNA,2HMR,2H ,20137B/ DATA MERR/6412B,2HFM,2HGR,2H- ,2H / DATA MERG/6412B,2HME,2HRG,2H 0,2H01/ C OPEN FILE TO BE TRANSFERRED ITMP=0 GO TO 7 C C ON THE FIRST TIME INTO THIS SUBROUTINE GO PROMPT FOR C SOURCE NAMR C 5 ITMP=ITMP+1 IF((INAM1.EQ.0).AND.(INAM1(4).EQ.0))GO TO 690 CALL OPENF(IDCB2,IERR,INAM1,IOP,ISECF,ICRF) C C OTHERWISE OPEN NAMR1 C IF(IERR.GE.0)GO TO 6 444 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),JERR) C C IF FILE CAN'T BE FOUND THEN REPORT C ERROR AND GET ANOTHER FILE NAME C IF(IERR.NE.6)GO TO 8 ITMP=ITMP-1 GO TO 690 434 IQUIT=-1 GO TO 8 C C KEEP COUNT OF NUMBER OF FILES OPENED C 6 ITYPE=IERR CALL LOCF(IDCB,IERR,RECNT,IR­¶þúB,IOFF,JSEC) IF(ITMP.NE.1)GO TO 600 C C CHECK TO SEE IF NAMR2 IS AN LU C IF(INAM2.GT.2H )GO TO 995 C C CHECK LU AGAINST DISC DRIVER C C CHECK LU AGAINST DISC DRIVER CALL EXEC(13+100000B,INAM2,ISTAT) GO TO 106 233 ICHEK=IAND(ISTAT,37400B)/256 C C LU CAN`T HAVE DRIVERS 30,31,32,33 C IF((ICHEK.LE.27B).OR.(ICHEK.GE.34B))GO TO 234 GO TO 106 C C IT IS AN LU OPEN IT C 234 CALL OPENF(IDCB,IERR,INAM2,0,0,0) IF(IERR.GE.0)GO TO 610 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 GO TO 8 C C NAMR2 IS A FILE NAME. TRY TO CREATE IT C DEFAULT TYPE TO TYPE OF FIRST SOURCE FILE C DEFAULT SIZE TO -1 C 995 IF(INAM2(7).NE.0)ITYPE=INAM2(7) ISIZE=-1 IF(INAM2(8).NE.0)ISIZE=INAM2(8) IF(INAM2(8).NE.-1)NOTRUN=1 CALL CREAT(IDCB,IERR,INAM2,ISIZE,ITYPE,ISECU,ICR,256) C C IF FILE ALREADY EXISTS THEN OPEN IT C IF(IERR.EQ.-2)GO TO 99 IF(IERR.GE.0)GO TO 610 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 GO TO 8 C C FILE ALREADY EXISTS SO OPEN IT C 99 CALL OPENF(IDCB,IERR,INAM2,IOP,ISECU,ICR) IF(IERR.GE.O)GO TO 610 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) CALL CLOSE(IDCB2,IERR) IQUIT=-1 GO TO 8 C C WRITE ZERO LENGTH RECORD IN BETWEEN FILES C 600 CALL WRITF(IDCB,IERR,ILBUF,0) C C CALL APPND TO CONCATENATE FILES INTO THE DþúESTINATION NAMR C 610 CALL APPND(IDCB2,ITYPE) IF(IQUIT.EQ.-1)GO TO 8 C C CLEAR OUT BUFFER C 690 DO 700 I=1,10 700 INAM1(I)=2H CONTINUE 7 CALL REIO(2,ILU,INFO4,7) CALL REIO(1,ILU,INBF,-80) CALL ABREG(IA,IB) IF(INBF.EQ.2H/E)GO TO 8 IS=1 C C IF ANOTHER FILE NAME IS SUPPLIED THEN GO OPEN FILE C OTHERWISE QUIT C IF(NAMR(INAM1,INBF,IB,IS))8,5 C 106 CALL EXEC(2,ILU,MERG,5) CALL PTERR(MERG(2),IERR) C 8 RETURN END C C THE APPND SUBROUTINE READS FROM THE SOURCE NAMR C AND WRITES INTO THE DESTINATION NMAR. C C SUBROUTINE APPND(IDCB2,ITYPE) DIMENSION LBUF(257),IDCB2(144),MERR(5) COMMON/MERG1/ IQUIT,ILU(3),IDCB(272),INAM2(10),ITEMP,INAM1(10) COMMON/MERG2/ ISIZE(2),IRB,IOFF,JSEC,IDCB1(144),RECNT DATA MERR/6412B,2HFM,2HGR,2H- ,2H / C C READ FROM THE SOURCE NAMR C IL=257 IF(ITYPE.EQ.1)IL=128 20 CALL READF(IDCB2,IERR,LBUF,IL,LEN) IF(LEN.EQ.-1)GO TO 41 IF(IERR.EQ.-12)GO TO 41 IF(IERR.EQ.0)GO TO 44 IERR=-IERR IQUIT=-1 CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) GO TO 49 41 CALL CLOSE(IDCB2,IERR) GO TO 49 44 IF(LEN.NE.0)GO TO 445 C C WRITE ZERO LENGTH RECORD C CALL WRITF(IDCB,IERR,ILBUF,0) GO TO 20 C C NOW WRITE INTO THE DESTINATION NAMR C 445 IF(ITYPE.EQ.1)LEN=128 CALL WRITF(IDCB,IERR,LBUF,LEN) IF(IERR.EQ.0)GO TO 20 IF(IERR.NE.-7)GO TO 446 IQUIT=-1 GO TO 450 C C IF NO MORE ROOM OCCURS(FMGR-033) THEN C GET POSITION OF DESTINATION NAMR BEFORE C LAST FILE WAS CONCATENATED AND WRITE END OF C FILE AND THEN CLOSE WITH TRUNCATE. ISSUE A C MESSAGE DESCRIBING WHAT HAPPENED. C 446 IF(IERR.NE.-33)GO TO 450 IERR=-B640IERR CALL CNUMD(IERR,MERR(3)) CALL APOSN(IDCB,IERR,RECNT,IRB,IOFF) CALL WRITF(IDCB,IERR,IXX,-1) ITRUN=JSEC/2-IRB-1 CALL CLOSE(IDCB,IERR,ITRUN) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) CALL EXEC(2,ILU,26HNO MORE ROOM ON CARTRIDGE ,13) CALL EXEC(2,ILU,40HFILE CONCATENATION WAS SUCCESSFUL UP TO ,20) CALL EXEC(2,ILU,36HBUT NOT INCLUDING THE LAST FILE READ,18) IQUIT=-1 GO TO 49 450 IERR=-IERR CALL CNUMD(IERR,MERR(3)) MERR(3)=2HGR MERR(4)=IOR(MERR(4),26460B) MERR(5)=IOR(MERR(5),30060B) CALL EXEC(2,ILU,MERR,5) CALL PTERR(MERR(2),IERR) C C RETURN TO CALLING PROGRAM C 49 RETURN END ]¨6ÿÿ ÿý & ÿ92067-18335 2013 S C0122 &SAVE SAVE UTILITY             H0101 ntþúASMB,R,L,C * NAME: SAVE * SOURCE: 92067-18335 * RELOC: 92067-16335 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SAVE,3,99 92067-16335 REV.2013 790620 * DISC TO MAG TAPE DATA TRANSFER EXT DMT,RMPAR,COR.A,EXEC,BUFER,ITASK SAVE JSB RMPAR GET PARAMETERS DEF *+2 DEF IP CLA STA ITASK TASK=0 FOR SAVE JSB BUFER ROUTINE TO FIND FWA IN FREE MEM OF PARTITION DEF FWA AND TO DETERMINE # OF WORDS IN AVMEM DEF PLEN DEF BFLEN # OF WORDS IN AVMEM * LDA FWA INA STA ITR SET UP VERIABLE FOR TRACK # INA STA JB ADDRESS FOR READ BUFFER JSB DMT GO TO MAIN DISC TO MAG TAPE ROUTINE DEF *+8 DEF FWA,I ADDR OF WRITE BUFFER - KB DEF JB,I ADDR OF READ BUFFER - JB DEF PLEN LENGTH OF PPARTITION DEF BFLEN # OF WORDS IN AVMEM DEF IP BUFFER WITH PARAMETERS DEF ITR,I ADDR OF TRACK # - ITR DEF FWA,I ADDR OF SUBCHNL # - ISUB JSB EXEC END OF SAVE PROGRAM DEF *+2 DEF D6 * A EQU 0 B EQU 1 IP BSS 5 ITR BSS 1 JB BSS 1 FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 D6 DEC 6 END SAVE FTN4,L,C C NAME: DMT C SOURCE: 92067-18335 C RELOC: 92067-16335 C PGMR: S.P.K.,J.S.W. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRAOÁþúNSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE DMT (KB,JB,IPLEN,IBLEN,IP,ITR,ISUB X ),92067-16335 REV.2013 800103 DIMENSION IP(5),KB(1),JB(1),ILUTR(64),MSG(3), C IHDR(140),INAME(3),IREG(2),ICHAR2(2),ITITL(4) EXTERNAL MESG,MPFND,ASCDC,DCASC,SUB,CHDLU,TPPOS, C CHUTP,LUTRK,PRNTH,MEMGT,READU EQUIVALENCE (REG,IA,IREG),(IREG(2),IB),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3),(IHDR(37),ITAPE), C (IHDR(39),ITPSV),(IHDR(40),LU2),(IHDR(42),IREC), C (IHDR(43),ITB30) DATA ITITL/2HFI,2HLE,2H I,2HD?/,IHDR(41)/0/, C ISIGN/100000B/,IVERFY/0/,IQUES/2H??/ CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF(ITLU.GT.64) GO TO 920 IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) GO TO 920 INT=IFTTY(ITLU) IF(INT.EQ.0) GO TO 920 LP=IP(2) IMLU=IP(4) IF(IMLU.GE.64) GO TO 580 IDTYP=IP(5) C IDISK=IDTYP C C IF (IBLEN.LT.2050) GO TO 770 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.LT.6146) GO TO 5 C C C IF(LP.NEQ.0) GO TO 2 LU=IP(3) IDISK=7905 IF(LU.NEQ.2.AND.LU.NEQ.3) REG=EXEC(1,LU,MXSEC,1,-1,0) IF(LU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(LU.EQ.3) CALL MEMGT(1760B,MXSEC) IF(MXSEC.EQ.128)IDISK=7925 C 2 IF(IBLEN.LT.8194.AND.IDISK.EQ.7925) GO TO 5 C C IF (IPLEN.EQ.0) CALL MESG (ITLU,3) CALL MESG (ITLU,2) CALL READU (ITLU,IYES,1) IF (IYES.NEQ.2HYE) GO TO 5 ISIZE=6144 INCR=96 IF(IDISK.EQ.7925) ISIZE=8192 IF(IDISK.EQ.7925) INCR=128 C C IREC=1 IF (IPLEN.EQ.1) GO TO 8 GO TO 9 5 ISIZE=2048 INCR=32 IREC=0 IF (IPLEN.EQ.-1) GO TO 9 8 CALL MESG (ITLU,0) CALL READU (ITLU,I1þúVERFY,1) C CHECK IF LOGICAL OR PHYSICAL COPY 9 IF (LP) 10,100,10 C CHECK IF PROPER UNIT # SPECIFIED FOR PHYSICAL COPY 10 IUNIT=IP(3) ITPSV=2 CALL CHUTP(ITLU,IUNIT,IDTYP) IDISK=IDTYP IF(IDTYP.EQ.7925) IDTYP=7905 IF(IDISK.EQ.7925.AND.ISIZE.EQ.6144) ISIZE=8192 IF(IDISK.EQ.7925.AND.INCR.EQ.96) INCR=128 GO TO 110 C LOGICAL COPY TO BE DONE C CHECK IF IDLU IS FOR DISC UNITS ONLY 100 IDLU=IP(3) ITPSV=1 CALL CHDLU(ITLU,IDLU,ISUB,IDTYP) IF(IDLU.NEQ.2.AND.IDLU.NEQ.3) REG=EXEC(1,IDLU,MXSEC,1,-1,0) IF(IDLU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(IDLU.EQ.3) CALL MEMGT(1760B,MXSEC) IF(MXSEC.EQ.128.AND.ISIZE.EQ.6144) ISIZE=8192 IF(MXSEC.EQ.128.AND.INCR.EQ.96) INCR=128 IF(MXSEC.EQ.128) IDISK=7925 110 NAME3=2H1 IF (IDTYP.EQ.7905) NAME3=2H2 IF (IDTYP.EQ.7900) IDISK=7900 D WRITE(1,3333) IDTYP,IDISK D3333 FORMAT("TYP ",2I8) CALL MPFND(INAME,ITLU,IDTYP,ITB30,JB) IHDR(38)=IDISK IF (IDTYP.EQ.7905) GO TO 140 MPST=43 IF (ITB30.LT.0) MPST=44 GO TO 150 140 MPST=44 IF (IHDR(44).LT.0) MPST=45 C CHECK IF IMLU IS FOR MAG TAPE UNIT ONLY 150 IF ((IMLU.LT.0).OR.(IMLU.GT.LUMAX)) GO TO 580 IF (IMLU.EQ.0) IMLU=8 IF (IMLU.GT.64) GO TO 580 CALL EXEC (13+100000B,IMLU,IEQT5) GO TO 580 151 IF (IAND(IEQT5,37000B)-11000B) 580,155,580 C REQUEST A MAG TAPE LU LOCK W/OUT WAIT & NO-ABORT 155 CALL LURQ (140001B,IMLU,1) GO TO 158 156 CONTINUE 158 CALL ABREG(IA,IB) C C IF (IA.EQ.0) GO TO 160 C MT LU LOCK WAS NOT SUCCESSFUL, TELL USER CALL MESG (ITLU,25) C REQUEST MT LU LOCK WITH WAIT CALL LURQ (1,IMLU,1) C WRITE RING IN THE MAG TAPE? 160 REG=EXEC(3,600B+IMLU) IF (IAND(IA,4B).EQ.4B) GO TO 750 CALL EXEC (2,ITLU,ITITL,4) 165 DO 170 ITRY = 1,36 IHDR(ITRY)=2H 170 CONTINUE REG = EXEC (1,ITLUrèþú+400B,IHDR,36) IF (IB.NEQ.0) GO TO 180 CALL EXEC (2,ITLU,IQUES,1) GO TO 165 180 IF (LP.EQ.0) GO TO 250 C C BUILD LU-# OF TRACKS TABLE FOR SOURCE DISC USING TRACK MAP INFO C LUFLG=1 CALL LUTRK(ITLU,LIMIT,IUNIT,IDTYP,IHDR,MPST,ILUTR,LUFLG,IEQT) LU2=LUFLG GO TO 300 C BUILD ILUTR TABLE FOR LP=0 250 ILUTR=IDLU ILUTR(2)=IHDR(MPST+ISUB+8) IF (IDTYP.EQ.7905) ILUTR(2)=IHDR(MPST+ISUB*3+2) LIMIT=1 LU2=0 IF (IDLU.EQ.2) LU2=1 C POSITION TAPE TO DESIRED FILE # AND WRITE HEADER RECORD ON TAPE 300 IFILE=0 ITAPE=1 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC(2,IMLU,IHDR,140) C LFLAG=0 DO 320 ILU=1,LIMIT,2 IDLU=ILUTR(ILU) CALL EXEC(13+100000B,IDLU,IEQT5) GO TO 319 317 GO TO 320 319 IF(LFLAG.EQ.0) CALL EXEC(2,ITLU, X 45HPLEASE DEFINE FOLLOWING LU(S) IN THIS SESSION,-45) C LFLAG=1 CALL CNUMD(IDLU,MSG) CALL EXEC(2,ITLU,MSG,-6) 320 CONTINUE IF(LFLAG.EQ.1) STOP 66 C C START DATA TRANSFER FROM DISC TO MAG TAPE USING ILUTR TABLE C DO 410 ILU=1,LIMIT,2 IDLU=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 C C IF(IDLU.NEQ.2.AND.IDLU.NEQ.3) REG=EXEC(1,LU,MXSEC,1,-1,0) IF(IDLU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(IDLU.EQ.3) CALL MEMGT(1760B,MXSEC) MXSEC=MXSEC-1 C DO 400 ITR=0,ILT DO 390 ISEC=0,MXSEC,INCR CALL SUB (IDLU,ISUB) ITRY=1 335 CALL EXEC (1+100000B,IDLU,JB,ISIZE,ITR,ISEC) GO TO 3339 3336 CONTINUE CALL ABREG(IA,IB) 337 IF (IDTYP.EQ.7905) GO TO 340 IF (IAND(IA,10B)-10B) 350,345,350 340 IF (IAND(IA,20B).NEQ.20B) GO TO 350 345 ISUB=ISUB+ISIGN 350 REG=EXEC(3,600B+IMLU) 353 IF (IAND(IA,40B).EQ.40B) GO TO 650 354 ITRY=1 355 REG= EXEC (2,IMLU,KB,ISIZE+2) 390 CONTINUE 400 CONTINUE 410 CONTINUE 450 ENDFILE IMLU C C VERIFY WANTED? C ã=þúIF (IVERFY.NEQ.2HYE) GO TO 500 C YES, PASS ILUTR TABLE TO SAM USING CLASS I/O CALL CALL EXEC(20,0,ILUTR,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=2HY C POSITION MAG TAPE TO BEGINING OF FILE ON TAPE 1 IF (ITAPE.EQ.1) GO TO 470 JTAPE=ITAPE 460 CALL MESG (ITLU,24) CALL MESG (ITLU,11) REWIND IMLU PAUSE CALL TPPOS(ITLU,IMLU,IFILE,JTAPE) CALL PRNTH(ITLU,IMLU,KB) IF (KB.EQ.-1) GO TO 460 GO TO 480 470 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC (1,IMLU,KB,140) C UNLOCK MAG TAPE LU 480 CALL LURQ (0,IMLU,1) C SCHEDULE VERFY PROGRAM WITH WAIT C IF(ISIZE.EQ.8192) IREC=2 IF(MXSEC.EQ.127.AND.ISIZE.NEQ.8192) IREC=-1 CALL EXEC (23,INAME,ITLU,ICLAS,LIMIT,IMLU,IREC) 500 REWIND IMLU STOP 580 CALL MESG (ITLU,8) CALL READU (ITLU,ICHAR,1) CALL ASCDC (ICHAR,1,IMLU) GO TO 150 650 CALL MESG (ITLU,12) CALL MESG (ITLU,11) REWIND IMLU CALL EXEC (7) ITAPE=ITAPE+1 677 CALL EXEC(3,600B+IMLU) CALL ABREG(IA,IB) D WRITE(1,9999) IA D9999 FORMAT("IA=",@8) IF(IAND(IA,4B).EQ.4B) GO TO 711 CALL EXEC (2,IMLU,IHDR,140) GO TO 354 C C 711 CALL MESG(ITLU,10) CALL MESG(ITLU,11) CALL EXEC(7) GO TO 677 680 CALL MESG (ITLU,13) CALL DCASC (ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC(ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 695 CALL MESG (ITLU,14) STOP 750 CALL MESG(ITLU,10) CALL MESG (ITLU,11) CALL EXEC (7) GO TO 160 770 CALL MESG (ITLU,1) GO TO 695 920 CALL EXEC(2,1,18HILLEGAL CONSOLE LU,-18) STOP 3339 GO TO 3336 END END$ ÷{$"$ÿÿ ÿý $ ÿ92067-18336 1903 S C0222 &RSTOR              H0102 Œ§þúASMB,R * NAME: RSTOR * SOURCE: 92067-18336 * RELOC: 92067-16336 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RSTOR,3,99 92067-16336 REV.1903 790620 * MAG TAPE TO DISC DATA TRANSFER EXT MTD,BUFER,RMPAR,EXEC,ITASK RSTOR JSB RMPAR GET PARAMETERS PASSED BY USER DEF *+2 DEF IP CLA,INA STA ITASK TASK=1 FOR RESTORE JSB BUFER GET FWA OF AVMEM IN PARTITION & # WORDS IN AVMEM DEF FWA ADDRESS OF FWA IN AVMEM DEF PLEN DEF BFLEN # OF WORDS IN AVMEM LDA FWA INA STA ITR SET UP VARIABLES USED BY MTD ROUTINE INA STA JB BUFFER TO WRITE ON DISC ADA D98 STA ILUTR LU-#TRCKS TABLE AT KB(101) LDA FWA BUFFER FOR HEADER REC IS PLACED IN LAST 140 WORDS ADA BFLEN OF PARTITION ADA N140 FWA+BFLEN-140 STA IHDR ADA D37 IHDR(38) STA IDTP1 IDTYP1 INA STA ITPSV IHDR(39)-TYPE OF SAVE INA STA LU2 IHDR(40)-LU2 INVOLVED IN SAVE? ADA D2 IHDR(42)-REC SIZE OF SAVED DATA STA RSIZE ADA D33 STA ILUTB IHDR(75)-COPY OF LU-#TRCKS TABLE JSB MTD GO TO MAIN RESTORE ROUTINE DEF *+15 DEF FWA,I KB DEF PLEN LENGTH OF PARTITION DEF BFLEN # WORDS IN AVMEM DEF JB,I JB DEF ITR,I ITR DEF FWA,I ITB30 DEF ILUTR,I ILUTR DEF IHDR,I IHDR DEF IDTP1,I IDTYP1 DEF ITPSV,I ITPSV DEF LU2,I LU2 DEF RSIZE,:  I RECORD SIZE-IREC DEF ILUTB,I ILUTB DEF IP PARAMETER LIST JSB EXEC END RSTOR DEF *+2 DEF D6 * FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 JB BSS 1 ITR BSS 1 ILUTR BSS 1 IHDR BSS 1 IDTP1 BSS 1 ITPSV BSS 1 LU2 BSS 1 RSIZE BSS 1 ILUTB BSS 1 IP BSS 5 D2 DEC 2 D6 DEC 6 D33 DEC 33 D37 DEC 37 D98 DEC 98 N140 DEC -140 END RSTOR ½Ü ÿÿþúFTN4 C NAME: MTD C SOURCE: 92067-18336 C RELOC: 92067-16336 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE MTD(KB,IPLEN,IBLEN,JB,ITR,ITB30,ILUTR,IHDR,IDTYP1, P C ITPSV,LU2,IREC,ILUTB,IP),92067-16336 REV.1903 790706 DIMENSION IP(5),KB(1),JB(1),ILUTR(1),IHDR(1),INAME(3), C IREG(2),ICHAR2(2),ITB30(1),ILUTB(1) EXTERNAL MPFND,ASCDC,DCASC,MESG,READU,CHUTP, C CHDLU,MATCH,LUTRK,TPPOS,PRNTH,MEMGT EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3) DATA IVERFY/0/ C CHECK IF PROPER LOG DEVICE CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF(ITLU.GT.64) GO TO 910 IF ((ITLU.LE.0).OR.(ITLU.GT.64)) GO TO 910 LP=IP(2) IMLU=IP(3) C INT=IFTTY(ITLU) IF(INT.EQ.0) GO TO 910 C IF(IMLU.GE.64) GO TO 580 C IDTYP2=IP(5) IF(IDTYP2.EQ.7925) IDTYP2=7905 C CHECK IF IMLU IS FOR MAG TAPE UNIT ONLY 1 IF ((IMLU.LT.0).OR.(IMLU.GT.64)) GO TO 580 IF (IMLU.EQ.0) IMLU=8 CALL EXEC(13,ITLU,IEQT5) LOGTY=IAND(IEQT5,37000B)/377B IF(LOGTY.NEQ.0.AND.LOGTY.NEQ.5) ITLU=1 CALL EXEC (13+100000B,IMLU,IEQT5) GO TO 580 44 IF (IAND(IEQT5,37000B).NEQ.11000B) GO TO 580 C REQUEST LU LOCK FOR MT WITHOUT WAIT & WITH NO-ABORT CALL LURQ(140001B,IMLU,1) GO TO 58 56 CONTINUE 58 CALL ABREG(IA,IB) IF (IA.EQ.0) GO TO 2 C LU LOCK WAS NOT SUCCESSFUL- TELL USER CALL MESG (ITLU,25) C REQUEST LU LOCK WITH WAIT ·üþú CALL LURQ (1,IMLU,1) 2 IFILE=0 CALL TPPOS (ITLU,IMLU,IFILE,ITAPE) CALL PRNTH (ITLU,IMLU,IHDR) ISDSK=IHDR(38) IF (IHDR.EQ.-1) GO TO 2 IF (LP.NEQ.0) LP=1 IF (ITPSV.LT.0) GO TO 790 IF (ITPSV.NEQ.(LP+1)) GO TO 770 IF (IBLEN.LT.2150) GO TO 800 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) C IDISK=IDTYP1 IF(IDTYP1.EQ.7925) IDTYP1=7905 C IF(IBLEN.LE.8294.AND.IDISK.EQ.7925.AND.IREC.EQ.1) GO TO 800 IF (IBLEN.GE.6246) GO TO 4 IF (IREC.EQ.1) GO TO 800 3 ISIZE=2048 INCR=32 GO TO 5 4 IF (IREC.EQ.0) GO TO 3 ISIZE=6144 INCR=96 IF(IDISK.EQ.7925) ISIZE=8192 IF(IDISK.EQ.7925) INCR=128 C C IF (IPLEN.EQ.1) GO TO 5 IF (IPLEN.EQ.0) CALL MESG (ITLU,3) GO TO 8 5 IF (IPLEN.EQ.-1) GO TO 8 CALL MESG(ITLU,0) CALL READU(ITLU,IVERFY,1) C CHECK IF LOGICAL OR PHYSICAL COPY 8 IF (LP.EQ.0) GO TO 100 C CHECK IF PROPER DRIVE NUMBER SPECIFIED FOR PHYSICAL RESTORE 10 IUNIT2=IP(4) CALL CHUTP(ITLU,IUNIT2,IDTYP2) GO TO 120 C LOGICAL RESTORE TO BE DONE C CHECK IF IDLU IS FOR DISC UNITS ONLY 100 IDLU=IP(4) CALL CHDLU(ITLU,IDLU,ISUB2,IDTYP2) 120 NAME3=2H1 IF(IDTYP2.EQ.7925) IDTYP2=7905 IF (IDTYP2.EQ.7905) NAME3=2H2 130 CALL MPFND(INAME,ITLU,IDTYP2,ITB30,JB) IF (IDTYP2.EQ.7905) GO TO 140 MPST2=1 IF (ITB30.LT.0) MPST2=2 GO TO 150 140 MPST2=2 IF (ITB30(2).LT.0) MPST2=3 C C READ INFO FROM HEADER RECORD C 150 ITAPE=IHDR(37) IF ((LU2.EQ.1).AND.(IDTYP1.NEQ.IDTYP2)) GO TO 750 C FIND THE START ADDRESS OF TRACK MAP TABLE OF SOURCE DISC 180 IF (IDTYP1.EQ.7905) GO TO 190 MPST1=43 IF (IHDR(43).LT.0) MPST1=44 GO TO 200 190 MPST1=44 IF (IHDR(44).LT.0) MPST1=45 C READ FIRST DATA RECORD FROM TAPE TO FIND UNIT # OF SURCE DISC 200 CALL EXEC (1,IMLU,ISUB1,1) BACKSPACE ¶ÀþúIMLU C C FIND UNIT# OF SOURCE DISC C ISUB1=IAND(ISUB1,77777B) IF (IDTYP1.EQ.7905) GO TO 210 IUNIT1=ISUB1/2 GO TO 215 210 NSUB=-IHDR(MPST1-1) IUNIT1=IAND(IHDR(MPST1+ISUB1*3+1),17B) 215 IF (LP.EQ.0) GO TO 230 C C BUILD LU-#TRACKS TABLE FOR DESTINATION DISC UNIT C 220 LUFLG=1 CALL LUTRK (ITLU,LIMIT,IUNIT2,IDTYP2,ITB30,MPST2,ILUTR,LUFLG, C IEQT) GO TO 250 C BUILD ILUTR TABLE FOR LP=0 CASE (NEEDS ENTRIES FOR ONLY 1 LU) 230 ILUTR=IDLU IF (IDTYP2.EQ.7905) GO TO 240 ILUTR(2)=ITB30(MPST2+ISUB2+8) GO TO 245 240 ILUTR(2)=ITB30(MPST2+ISUB2*3+2) 245 LIMIT=1 250 IF ((LU2.EQ.0).OR.(LP.EQ.0)) GO TO 260 C MATCH THE TRACK MAP INFO. FOR DESTINATION AND SOURCE UNITS C CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST1,MPST2,IHDR, C ITB30,ILUTR) C C BUILD # TRACKS TABLE FOR SOURCE DISC C 260 IF (IDTYP1.EQ.7905) GO TO 270 IF (LP.EQ.1) GO TO 265 IHDR(43)=IHDR(MPST1+ISUB1+8) IHDR(44)=-1 GO TO 300 265 ISUBF=ISUB1 IF (IUNIT1*2.NEQ.ISUB1) ISUBF=ISUB1-1 IHDR(43)=IHDR(MPST1+ISUBF+8) IHDR(44)=IHDR(MPST1+ISUBF+9) IHDR(45)=-1 GO TO 300 C BUILD TABLE FOR SOURCE 7905 DISC 270 IF (LP.EQ.1) GO TO 280 IHDR(43)=IHDR(MPST1+ISUB1*3+2) IHDR(44)=-1 GO TO 300 C BUILD TABLE FOR SOURCE 7905 DISC WHEN LP=1 C FIND THE FIRST SUBCHANNEL FOR SOURCE 7905 DISC UNIT C BUILD THE TABLE 280 IWORD1=0 DO 285 IWORD=0,NSUB-1 IF (IAND(IHDR(MPST1+IWORD*3+1),17B).NEQ.IUNIT1) GO TO 285 IHDR(IWORD1+43)=IHDR(MPST1+IWORD*3+2) IWORD1=IWORD1+1 285 CONTINUE 290 IF (IWORD1.LT.32) IHDR(IWORD1+43) = -1 C C MATCH THE # OF TRACKS INFO. FOR DATA TRANSFER WITHOUT LU2 C 300 IF ((LU2.EQ.1).AND.(LP.EQ.1)) GO TO 350 ITEMP=1 DO 340 IWORD=43,74 IF (IHDR(IWORD).EQ.-1) GO TO 350 DO 330 ILU = ITEMP,LIMIT,2 ¢Zþú IF ((LU2.EQ.1).AND.(IHDR(IWORD).NEQ.ILUTR(ILU+1))) GO TO 750 IF (IHDR(IWORD).LE.ILUTR(ILU+1)) GO TO 310 330 CONTINUE GO TO 750 310 ITEMP1=ILUTR(ITEMP) ILUTR(ITEMP)=ILUTR(ILU) ILUTR(ILU)=ITEMP1 C* C SET LAST TRACK TO LAST TRACK IN HEADER C ILUTR(ITEMP+1)=IHDR(IWORD) ITEMP1=ILUTR(ITEMP+1) ILUTR(ITEMP+1)=ILUTR(ILU+1) ILUTR(ILU+1)=ITEMP1 ITEMP=ITEMP+2 340 CONTINUE 350 DO 355 IWORD=1,64 ILUTB(IWORD)=ILUTR(IWORD) 355 CONTINUE C C START DATA TRANSFER FROM DISC TO MAG TAPE C LFLAG=0 DO 400 IWORD = 1,32 IF (IHDR(42+IWORD).EQ.-1) GO TO 410 IDLU=ILUTB(IWORD*2-1) IF ((IDLU.EQ.2).OR.(IDLU.EQ.3)) GO TO 730 IFLAG=0 C C IF(IDLU.GE.64) GO TO 400 CALL EXEC(13+100000B,IDLU,IEQT5) GO TO 3190 3999 GO TO 3180 3190 IF(LFLAG.EQ.0)CALL EXEC(2,ITLU, X 45HPLEASE DEFINE FOLLOWING LU(S) IN THIS SESSION,-45) C IF(IDLU.GE.64) GO TO 400 LFLAG=1 CALL CNUMD(IDLU,KB) CALL EXEC(2,ITLU,KB,-6) GO TO 400 C 3180 IF (LFLAG.EQ.1) GO TO 400 C C C NOW CHECK IF SOURCE DISK IS 7925 AND DEST. IS NON 7925 C IF YE PRINT " TRACK SIZES NOT EQUAL" C REG=EXEC(1,IDLU,MXSEC,1,-1,0) IF(ISDSK.EQ.7925.AND.MXSEC.EQ.96) GO TO 950 MXSEC=95 IF(IDISK.EQ.7925) MXSEC=127 C C DO 390 ITR=0,IHDR(IWORD+42)-1 DO 380 ISEC=0,MXSEC,INCR C READ RECORDS FROM MAG TAPE 357 REG=EXEC(1,IMLU,KB,ISIZE+2) 358 ITRY=1 IF (ITR.NEQ.KB(2)) GO TO 700 360 REG=EXEC (2,IDLU+74000B,JB,ISIZE,ITR,ISEC) C WRITE RECORD ON DISC IF (IB.EQ.ISIZE) GO TO 365 IF (ITRY.GT.7) GO TO 620 ITRY=ITRY+1 GO TO 360 365 IF (IFLAG.EQ.1) GO TO 370 REG=EXEC(3,600B+IDLU) IF (IDTYP2.EQ.7905) GO TO 367 IF (IAND(IA,10B)-10B) 370,368,370 367 IF (IAND(IA,20B).NEQ.20B) GO TO 370 368 CALL MESG (ITLU,21) IFLAG=1 370 REG=EXEC(3,600b‚þúB+IMLU) IF (IAND(IA,40B).NEQ.40B) GO TO 380 375 CALL MESG (ITLU,12) CALL MESG (ITLU,11) REWIND IMLU CALL EXEC (7) 377 REWIND IMLU CALL PRNTH (ITLU,IMLU,JB) IF (JB.EQ.-1) GO TO 377 ITAPE=JB(37) 380 CONTINUE 390 CONTINUE 400 CONTINUE C C SCHEDULE VERIFY PROGRAM WITH WAIT IF VERIFY OPTION CHOSEN C 410 IF (IVERFY.NEQ.2HYE) GO TO 500 IF (LFLAG.NEQ.0) GO TO 500 IF (ITAPE.EQ.1) GO TO 430 CALL MESG(ITLU,24) CALL MESG (ITLU,11) REWIND IMLU PAUSE 1 JTAPE=ITAPE 420 CALL TPPOS(ITLU,IMLU,IFILE,JTAPE) CALL PRNTH(ITLU,IMLU,KB) IF (KB.EQ.-1) GO TO 420 GO TO 450 430 CALL TPPOS (ITLU,IMLU,IFILE,ITAPE) CALL EXEC (1,IMLU,KB,140) C PASS ILUTR TABLE TO SAM USING CLASS I/O CALL 450 CALL EXEC (20,0,ILUTB,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=2HY C UNLOCK MAG TAPE LU CALL LURQ(0,IMLU,1) IF(ISIZE.EQ.8192) IREC=2 IF(MXSEC.EQ.127.AND.ISIZE.NEQ.8192) IREC=-1 CALL EXEC(23,INAME,ITLU,ICLAS,LIMIT,IMLU,IREC) 500 REWIND IMLU STOP 580 CALL MESG (ITLU,8) CALL READU(ITLU,ICHAR,1) CALL ASCDC(ICHAR,1,IMLU) GO TO 1 620 CALL MESG (ITLU,13) 630 CALL DCASC(ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 640 CALL MESG (ITLU,14) STOP 700 CALL MESG (ITLU,26) GO TO 630 730 CALL MESG(ITLU,22) GO TO 640 750 CALL MESG (ITLU,16) GO TO 640 770 CALL MESG (ITLU,20) GO TO 640 790 CALL MESG (ITLU,23) GO TO 640 800 CALL MESG (ITLU,1) GO TO 640 910 CALL EXEC( 2,1,18HILLEGAL CONSOLE LU,-18) STOP 950 CALL EXEC(2,1,21HTRACK SIZES NOT EQUAL,-21) STOP END END$ :$"$ÿÿ ÿý ) ÿ92067-18337 1903 S C0222 &VERFY              H0102 v°ASMB,R,L,C * NAME: VERFY * SOURCE: 92067-18337 * RELOC: 92067-16337 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM VERFY,3,99 92067-16337 REV.1903 790620 * VERFIY DATA TRANSFERED BY SAVE,RSTOR OR COPY EXT EXEC,VRFSB,COR.A,RMPAR VERFY JSB RMPAR DEF *+2 FETCH PARAMETERS PASSED BY SCHEDULING PROGRAM DEF IP SUP LDA 1717B JSB COR.A ROUTINE TO FIND FWA IN FREE MEM OF PARTITION STA FWA ADA D2 SETTING UP PARMS TO PASS TO MAIN VERIFY ROUTINE STA KBUF LDB IP+4 IF IP(5)=0 BUFFER SIZE USED BY SCHEDULING PROG SZB IS 2048 WORDS OTHERWISE 6144 WORDS JMP B6144 6144 WORD RECORDS USED ADA D2048 2048 WORD REC.-SET UP BUF TO READ REC FROM DISC STA JBUF JMP GOVER * B6144 CPB D2 IF IP(2)=2 USE 8192 WORD BUFFER ADA D2048 ADA D6144 6144 WORD REC.- SET UP BUF TO READ REC FROM DISC STA JBUF * GOVER JSB VRFSB MAIN VERIFY ROUTINE DEF *+5 DEF FWA,I DEF KBUF,I DEF JBUF,I DEF IP JSB EXEC END VERIFY PROGRAM DEF *+2 DEF D6 * * A EQU 0 B EQU 1 IP BSS 5 FWA BSS 1 JBUF BSS 1 KBUF BSS 1 D2 DEC 2 D6 DEC 6 D20 DEC 20 D2048 DEC 2048 D6144 DEC 6144 END VERFY (ÜÿÿþúFTN4 C NAME: VRFSB C SOURCE: 92067-18337 C RELOC: 92067-16337 C PGMR: S.P.K. C J.S.W. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE VRFSB (KB,KBUF,JBUF,IP),92067-16337 REV.1903 790705 C PROGRAM TO VERIFY DATA BY WORD TO WORD COMPARISON C THIS PROGRAM IS SCHEDULED WITH WAIT BY A DISC BACKUP UTILITY C DIMENSION ILUTR(64),KB(1),JBUF(1),KBUF(1),IP(1),IREG(2), C IM1(5),IM2(18),IM3(14),IM4(18),ITRCK(2),ITITL(4), C ITAPE(5),IOK(6),IM5(7) EQUIVALENCE (IM2(12),ITRCK),(IM2(18),IDLU),(REG,IA,IREG), C (IB,IREG(2)) EXTERNAL DCASC,MEMGT DATA IM1,IM1(2),IM1(3),IM1(4),IM1(5)/2HVE,2HRI, C 2HFY,2HIN,2HG /,IM2/2HVE,2HRI,2HFY, C 2H E,2HRR,2HOR,2H A,2HT ,2HTR,2HAC,2HK ,2H ,2H ,2H &, C 2H L,2HU ,2H# ,2H /,IM3/2HEO,2HT ,2HRE,2HAC,2HHE, C 2HD,,2H M,2HOU,2HNT,2H N,2HEX,2HT ,2HTA,2HPE/, C IM4/2HRE,2HST,2HRT,2H V,2HER,2HFY,2H B,2HY ,2HEN, C 2HTE,2HRI,2HNG,2H ',2HGO,2H,V,2HER,2HFY,2H' /, C ITITL/2HFI,2HLE,2H I,2HD:/, C ITAPE/2HTA,2HPE,2H#:,2H /, C IOK/2HOK,2H? ,2H(Y,2HES,2H/N,2HO)/, C IFLAG/0/,IFLAG1/0/,IM5/2HVE,2HRF,2HY ,2HAB,2HOR,2HTE,2HD /, C ITYPE/0/,I77777/77777B/,IQUES/2H??/ C THE FOLLOWING PARAMETERS ARE PASSED BY THE UTILITY PROGRAM: C IP1 - TTY LU OF USER CONSOLE, IP2 - CALL NUMBER, C IP3 - 0 IF TRANSFER BET. DISC & MAG TAPE, 1 IF XFER BET 2 DISCS C IP4 - MAG TAPE LU IF IP3 IS +VE OR DEST. DISC POINTER IN ILUTR C IP5 - 0 IF BUF SIZE HAS TO BE 2048 WORDS, 1 IF 6144 WORDS C Èþú ::= -1 2048 BUF SIZE, LAST SECT# = 127 C ::= 2 8192 BUF SIZE, LAST SECT# = 95 C C CALL EXEC (22,3) ITLU=IP MXSEC=95 IF (IP(3).LT.0) ITYPE=1 LIMIT=IAND(IP(3),I77777) IMLU=IP(4) IF (IP(5).GT.0 ) GO TO 5 ISIZE=2048 INCR=32 IF (IP(5).EQ.-1) MXSEC=127 GO TO 7 5 ISIZE=6144 INCR=96 IF(IP(5).EQ.2) ISIZE=8192 IF(IP(5).EQ.2) INCR=128 IF(IP(5).EQ.2) MXSEC=127 7 CALL EXEC (2,ITLU,IM1,5) C GET THE BUFFER PASSED BY UTILITY PRAGRAM CALL EXEC (21,IP(2),ILUTR,64) C FORMAT OF ILUTR IS: WORD 1 = LU# OF SUBCHANNEL 1 ON DISC 1 C WORD 2 = # TRACKS FOR SUBCHANNEL 1 ON DISC 1 C WORD 3 = LU# OF SUBCHANNEL 2 ON DISC 1, ......... C IF XFER WAS DISC TO DISC - WORD 32 = # TRACKS ON SUB 16 DISC 1 C WORD 33 = LU# OF SUBCHNL 1 ON DISC 2, ............. C C IF XFER WAS BET DISC & MT WORD 32 = #TRACKS ON SUB 16 ON DISC 1 C WORD 33 = LU # OF SUBCHNL 17 ON DISC 1, ..... C C IF DISC HAS N SUBCHANNELS, WHERE N < 32 (16 IF TYPE = 1), C WORD 2N+1=-1 TO MARK THE END OF LIST OF LU#'S C C FIND DISC TYPE FOR IDLU1 CALL EXEC (13,ILUTR,IEQT5) IDTYP=7900 IF (IAND(IEQT5,37400B).EQ.15000B) IDTYP=7905 C C C GO THROUGH ILUTR TABLE C 20 DO 250 ILU=1,LIMIT,2 C IDLU1=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 IFT=0 IFLAG=0 IF (ITYPE.EQ.1) IDLU2=ILUTR(ILU+LIMIT+1) C C D WRITE(1,9999) IDLU1,ILT D9999 FORMAT(" DLU, LT ",3I7) C CALL EXEC(13+100000B,IDLU1,IEQT5) GO TO 250 C LOOP FOR TRACKS ON SUBCHANNEL C 50 DO 200 ITR = IFT,ILT C LOOP FOR SECTOR # FOR EACH TRACK DO 150 ISEC=0,MXSEC,INCR REG= EXEC (1,IDLU1,JBUF,ISIZE,ITR,ISEC) IF (IFLAG.EQ.1) GO TO 55 IF (IDLU1.NEQ.2) GO TO 55 IF (IDTYP.EQ.7905) GO TO 51 IF (IAND(IA,10B).EQ.10B) GO TO 55 GO TO 52 51 IF (IAND(IA,20B).EQ.20B) GO þúTO 55 52 IFLAG=1 C C C LETS SKIP THE SCRATCH TRACKS AND MOVE ON TO FMP TRACKS C FIND STARTING FMP TRACKS BY LOOKING AT LAST TRACK SECTOR 0 C 5TH WORD C CALL MEMGT(1756B,ILT) ILT=ILT-1 CALL EXEC (1,IDLU1,JBUF,128,ILT,0) IFT=JBUF(5) IF (ITYPE.EQ.0) GO TO 60 GO TO 50 55 IF (ITYPE.EQ.0) GO TO 60 C C READ RECORD FROM SECOND DISC CALL EXEC (1,IDLU2,KBUF,ISIZE,ITR,ISEC) GO TO 70 C EOT REACHED? 60 REG=EXEC(3,600B+IMLU) IF(IAND(IA,200B).EQ.200B) GO TO 250 IF (IAND(IA,40B).NEQ.40B) GO TO 62 CALL EXEC (2,ITLU,IM3,14) 63 CALL EXEC (2,ITLU,IM4,18) REWIND IMLU PAUSE CALL EXEC (1,IMLU,KB,140) CALL EXEC (2,ITLU,ITITL,4) CALL EXEC (2,ITLU,KB,36) CALL DCASC(ITAPE(5),1,KB(37)) CALL EXEC(2,ITLU,ITAPE,5) CALL EXEC (2,ITLU,IOK,6) 85 IYES=2H REG = EXEC (1,ITLU+400B,IYES,1) IF (IB.NEQ.0) GO TO 80 CALL EXEC (2,ITLU,IQUES,1) GO TO 85 80 IF (IYES.NEQ.2HAB) GO TO 61 CALL EXEC (2,ITLU,IM5,7) STOP 61 IF (IYES.NEQ.2HYE) GO TO 63 62 IF (IFLAG.EQ.0) GO TO 69 IF (IFLAG1.EQ.1) GO TO 69 CALL EXEC (1,IMLU,KB,2) 64 IF (KB(2).NEQ.IFT) GO TO 60 BACKSPACE IMLU IFLAG1=1 GO TO 50 C READ RECORD FROM MAG TAPE 69 CALL EXEC (1,IMLU,KB,ISIZE+2) CALL ABREG(IA,IB) IF(IAND(IA,200B).EQ.200B) GO TO 250 C C VERIFY BY MAKING WORD TO WORD COMPARISON C 70 DO 100 IWORD=1,ISIZE IF (JBUF(IWORD).NEQ.KBUF(IWORD)) GO TO 110 100 CONTINUE C WORDS DO NOT MATCH, INFORM USER GO TO 150 110 CALL DCASC (ITRCK,2,ITR) CALL DCASC (IDLU,1,IDLU1) CALL EXEC (2,ITLU,IM2,18) 150 CONTINUE 200 CONTINUE 250 CONTINUE STOP END END$ /®ÿÿ ÿý ( ÿ92067-18338 1903 S C0222 ©              H0102 ”bASMB,R * NAME: COPY * SOURCE: 92067-18338 * RELOC: 92067-16338 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COPY,3,99 92067-16338 REV.1903 790620 * DISC TO DISC DATA TRANSFER EXT DD,EXEC,BUFER,RMPAR,ITASK COPY JSB RMPAR DISC TO DISC COPY UTILITY DEF *+2 DEF IP LDA D2 STA ITASK TASK=2 FOR COPY JSB BUFER GET FWA & # OF WORDS IN AVMEM FOR THIS PARTITION DEF FWA DEF PLEN DEF BFLEN JSB DD MAIN ROUTINE TO DO COPY OPERATIONS DEF *+6 DEF FWA,I DEF PLEN LENGTH OF PARTITION DEF BFLEN DEF FWA,I 7905 TRACK MAP TABLE TO OVERLAY BUFFER DEF IP JSB EXEC END COPY PROGRAM DEF *+2 DEF D6 * IP BSS 5 FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 D2 DEC 2 D6 DEC 6 END COPY ‘*ÿÿþúFTN4 C NAME: DD C SOURCE: 92067-18338 C RELOC: 92067-16338 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE DD(JB,IPLEN,IBLEN,ITB32,IP),92067-16338 REV.1903 790620 DIMENSION JB(1),ITB31(17),ITB32(1),IREG(2),ILUTR(68),IP(5), C ICHAR2(2),INAME(3) EQUIVALENCE (IA,REG,IREG(1)),(IB,IREG(2)),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3) EXTERNAL MPFND,DCASC,ASCDC,MESG,CHDLU,CHUTP,MEMGT, C READU,LUTRK,MATCH DATA ISYLU/0/,IVERFY/0/,ISIGN/100000B/ CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF(ITLU.GT.64) GO TO 900 IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) GO TO 900 INT=IFTTY(ITLU) IF(INT.EQ.0) GO TO 900 LP=IP(2) IF (IBLEN.LT.2050) GO TO 770 C C IF(IPLEN.EQ.1) GO TO 12 GO TO 20 12 IF (IPLEN.EQ.-1) GO TO 20 CALL MESG (ITLU,0) CALL READU(ITLU,IVERFY,1) 20 IF (LP.EQ.0) GO TO 100 C PHYSICAL COPY TO BE MADE IUNIT1=IP(3) IUNIT2=IP(4) C ASK FOR SOURCE DISC TYPE CALL MESG(ITLU,17) CALL READU(ITLU,ICHAR2,2) CALL ASCDC(ICHAR2,2,IDTYP1) C C C C C CHECK IF DISC TYPE AND UNIT # VALID CALL CHUTP(ITLU,IUNIT1,IDTYP1) IDISK1= IDTYP1 IF(IDTYP1.EQ.7925) IDTYP1=7905 C C C ASK FOR DESTINATION DISC TYPE 70 CALL MESG(ITLU,50) CALL READU(ITLU,ICHAR2,2) CALL ASCDC (ICHAR2,2,IDTYP2) C C IDISK2=IDTYP2 IF(IDTYP2.EQ.7925) IDTYP2=7905 IF(IDISK1.EQ.7925.AND.IDISK1.NEQ.IDISK2) GO TO 770 C C CHECK IF D DþúESTINATION DISC TYPE AND UNIT VALID CALL CHUTP(ITLU,IUNIT2,IDTYP2) GO TO 10 C C CHECK FOR VALIDITY OF DISC LU'S FOR LOGICAL COPY, FIND THE C SOURCE AND DESTINATION SUBCHANNEL NUMBERS C 100 IDLU1=IP(3) IDLU2=IP(4) C C C C CALL CHDLU(ITLU,IDLU1,ISUB1,IDTYP1) CALL CHDLU (ITLU,IDLU2,ISUB2,IDTYP2) IF(IDLU1.NEQ.2.AND.IDLU1.NEQ.3) REG=EXEC(1,IDLU1,MS1,1,-1,0) IF(IDLU2.NEQ.2.AND.IDLU2.NEQ.3) REG=EXEC(1,IDLU2,MS2,1,-1,0) IF(IDLU1.EQ.2) CALL MEMGT(1757B,MS1) IF(IDLU1.EQ.3) CALL MEMGT(1760B,MS1) IF(IDLU2.EQ.2) CALL MEMGT(1757B,MS2) IF(IDLU2.EQ.3) CALL MEMGT(1760B,MS2) C IF(MS1.GT.MS2) GO TO 999 IF(MS1.EQ.128)IDISK1=7925 C C 10 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.LT.6146) GO TO 5 IF (IPLEN.EQ.0) CALL MESG (ITLU,3) CALL MESG (ITLU,2) CALL READU(ITLU,IYES,1) IF (IYES.NEQ.2HYE) GO TO 5 C C IF(IBLEN.LT.8194.AND.IDISK1.EQ.7925) GO TO 5 C ISIZE=6144 INCR=96 IF(IDISK1.EQ.7925) ISIZE=8192 IF(IDISK1.EQ.7925) INCR=128 IREC=1 GO TO 150 5 ISIZE=2048 INCR=32 IREC=0 C C FETCH TRACK MAP TABLES FOR IDTYP1 AND IDTYP2 150 IF ((IDTYP1.EQ.7900).OR.(IDTYP2.EQ.7900)) GO TO 160 155 NAME3=2H2 CALL MPFND(INAME,ITLU,7905,ITB32,JB) C FIND THE STARTING POINT IN TMT FOR 7905 MPST2=2 IF (ITB32(2).LT.0) MPST2=3 GO TO 170 C ONE OR BOTH IDTYP'S ARE 7900 160 NAME3=2H1 CALL MPFND (INAME,ITLU,7900,ITB31,JB) C FIND THE STARTING POINT IN TMT FOR 7900 MPST1=1 IF (ITB31.LT.0) MPST1=2 IF (IDTYP1.EQ.IDTYP2) GO TO 170 C C ONE DISC IS A 7900 AND THE OTHER A 7905 GO TO 155 C C FOLLOWING SECTION BUILDS LU-#TRACKS TABLE (ILUTR) USING C THE TRACK MAP TABLES AND COMPARES DESTINATION AND SOURCE C SUBCHANNEL SIZES 170 IF (LP.EQ.0) GO TO 230 IF (IDTYP1.EQ.7905) GO TO 180 å°þúCALL LUTRK(ITLU,LIMIT,IUNIT1,IDTYP1,ITB31,MPST1,ILUTR,LUFLG, C IEQT) GO TO 200 180 CALL LUTRK(ITLU,LIMIT,IUNIT1,IDTYP1,ITB32,MPST2,ILUTR,LUFLG, C IEQT) 200 LU2=LUFLG IDEST=LIMIT+2 IF (IDTYP2.EQ.7905) GO TO 220 CALL LUTRK(ITLU,LIMIT1,IUNIT2,IDTYP2,ITB31,MPST1,ILUTR(IDEST), C LUFLG,IEQT) GO TO 225 220 CALL LUTRK(ITLU,LIMIT1,IUNIT2,IDTYP2,ITB32,MPST2,ILUTR(IDEST), C LUFLG,IEQT) 225 LIMIT1=LIMIT+1+LIMIT1 GO TO 250 230 ILUTR=IDLU1 IF (IDLU1.EQ.2) LU2=1 IF (IDTYP1.EQ.7905) GO TO 235 ILUTR(2)=ITB31(MPST1+ISUB1+8) GO TO 240 235 ILUTR(2)=ITB32(MPST2+ISUB1*3+2) 240 LIMIT=1 LIMIT1=3 ILUTR(3)=IDLU2 IF (IDTYP2.EQ.7905) GO TO 245 ILUTR(4)=ITB31(MPST1+ISUB2+8) GO TO 250 245 ILUTR(4)=ITB32(MPST2+ISUB2*3+2) C MATCH TRACK MAP INFORMATION 250 IF ((LU2.EQ.1).AND.(LP.EQ.1)) GO TO 280 C IF LU2 IS NOT INVOLVED, USE ILUTR TABLE TO CHECK IF SOURCE DATA C WILL FIT ON DESTINATION UNIT C ITEMP=LIMIT+2 DO 260 ILU=1,LIMIT,2 DO 270 ILU1=ITEMP,LIMIT1,2 IF ((LU2.EQ.1).AND.(ILUTR(ILU+1).NEQ.ILUTR(ILU1+1))) GO TO 750 IF (ILUTR(ILU+1).LE.ILUTR(ILU1+1)) GO TO 275 270 CONTINUE GO TO 750 275 ITEMP1=ILUTR(ITEMP) ILUTR(ITEMP)=ILUTR(ILU1) ILUTR(ILU1)=ITEMP1 ITEMP1=ILUTR(ITEMP+1) ILUTR(ITEMP+1)=ILUTR(ILU1+1) ILUTR(ILU1+1)=ITEMP1 ITEMP=ITEMP+2 260 CONTINUE GO TO 300 280 IF (IDTYP1.NEQ.IDTYP2) GO TO 750 IF (IDTYP1.EQ.7905) GO TO 295 CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST1,MPST1,ITB31, C ITB31,ILUTR(IDEST)) GO TO 300 295 CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST2,MPST2,ITB32, C ITB32,ILUTR(IDEST)) C C C NOW CHECK IF ALL LUS ARE DEFINED IN THIS SESSION BY DOING C EXEC 13 CALL AND NO ABORT SET C IF ABORT RETURN LU NOT DEFINED C <þú300 LFLAG=0 DO 460 ILU=1,LIMIT,2 IDLU1=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 IDLU2=ILUTR(ILU+LIMIT+1) IF ((IDLU2.EQ.2).OR.(IDLU2.EQ.3)) GO TO 730 C C***** CHECK SESSION LU C C IDSKLU=IDLU1 CALL EXEC(13+100000B,IDLU1,IEQT5) GO TO 3190 3999 GO TO 3180 3190 IF (LFLAG.EQ.0) CALL EXEC(2,ITLU, X 49HPLEASE DEFINE THE FOLLOWING LU(S) IN THIS SESSION,-49) LFLAG=1 CALL CNUMD(IDSKLU,JB) CALL EXEC(2,ITLU,JB,-6) GO TO 460 3180 IDSKLU=IDLU2 CALL EXEC(13+100000B,IDLU2,IEQT5) GO TO 3190 3199 IF(LFLAG.EQ.1) GO TO 460 C C 330 IFLAG=0 C C IF(IDLU1.NEQ.2.AND.IDLU1.NEQ.3) REG=EXEC(1,IDLU1,MXSEC,1,-1,0) IF(IDLU1.EQ.2) CALL MEMGT(1757B,MXSEC) IF(IDLU1.EQ.3) CALL MEMGT(1760B,MXSEC) C MXSEC=MXSEC-1 DO 450 ITR =0,ILT DO 410 ISEC = 0,MXSEC,INCR 332 ITRY=1 335 REG=EXEC(1,IDLU1,JB,ISIZE,ITR,ISEC) IF (IB.EQ.ISIZE) GO TO 340 IF (ITRY.EQ.7) GO TO 680 ITRY=ITRY+1 GO TO 335 C WRITE BUFFER ON DESTINATION DISC 340 ITRY=1 350 REG=EXEC(2,IDLU2,JB,ISIZE,ITR,ISEC) IF (IB.EQ.ISIZE) GO TO 380 IF (ITRY.EQ.7) GO TO 700 ITRY=ITRY+1 GO TO 350 380 IF (IFLAG.EQ.1) GO TO 410 REG=EXEC (3,600B+IDLU2) IF (IDTYP2.EQ.7905) GO TO 370 IF (IAND(IA,10B)-10B)410,375,410 370 IF (IAND(IA,20B).NEQ.20B) GO TO 410 375 CALL MESG(ITLU,21) IFLAG=1 410 CONTINUE 450 CONTINUE 460 CONTINUE C C IF SESSION LU NOT DEFINED, STOP C IF(LFLAG.NEQ.0) STOP C VERIFY WANTED? C 500 IF (IVERFY.NEQ.2HYE) GO TO 550 IF (LFLAG.NEQ.0) GO TO 550 C YES, PASS ILUTR TABLE TO SAM USING CLASS I/O CALL CALL EXEC (20,0,ILUTR,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=1HY C SCHEDULE VERIFY PROGRAM WITH WAIT LIMIT=LIMIT+ISIGN IF(ISIZE.EQ.8192) IREC=2 CALL EXEC (23,INAME,ITLU,ICLAS,LIMIT,0üV,IREC) 550 STOP C C ERROR MESSAGES C 680 IDLU=IDLU1 685 CALL MESG(ITLU,13) CALL DCASC (ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 695 CALL MESG(ITLU,14) STOP 700 IDLU=IDLU2 GO TO 685 730 CALL MESG (ITLU,22) GO TO 695 750 CALL MESG(ITLU,16) GO TO 695 770 CALL MESG(ITLU,1) GO TO 695 900 CALL EXEC(2,1,18HILLEGAL CONSOLE LU,-18) STOP 999 CALL EXEC(2,ITLU,21HTRACK SIZES NOT EQUAL,-21) STOP 55 END END$ V^ÿÿ ÿý + ÿ92067-18339 2013 S C0122 &DBKLB DBKLB LIBRARY             H0101 –QþúASMB,R,L,C * NAME: DBKLB * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBKLB,7 92067-16339 REV.2013 790309 ENT DBKLB DBKLB EQU * END DBKLB ASMB,R,L,C * NAME: BUFER * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. J.S.W * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM BUFER,7 92067-16339 REV.1903 790309 ENT BUFER ROUTINE TO FIND HIGH ADDR OF MAIN AND DETERMINE EXT COR.A # OF WORDS IN PROGRAM'S PARTITION AND BUFER NOP IN FREE AVAILABLE MEM IN PARTITION LDA 1717B ADDRESS OF ID SEG OF MAIN PROG JSB COR.A SYS ROUTINE TO GET FWA OF FREE MEM IN PARTITION LDB BUFER,I STA B,I ADDRESS OF FWA RETURNED IN A REG STA FWAVM LDA 1717B ADDR OF IDSEG OF CURRENT MAIN PROG ADA D14 ADDR OF 15TH WORD OF ID SEG LDA A,I VALUE OF 15 TH WORD OF ID SEG AND .17 FIND TYPE OF PROG IE.FG OR BG CPA D3 BG DISC RESIDENT? RSS JMP FG NO FOREGROUND DISC RESIDENT LDA 1777B YES, LWA MEM IN BG PARTITION STA LWA LDB 1754B FWA OF BG PARTITION STB FWA /Õþú JMP BLEN FIND LENGTH OF AVMEM * FG LDA 1751B LWA+1 MEM IN FG PARTITION ADA N1 LWA IN FG PARTITION STA LWA LDB 1750B FWA OF FG PARTITION STB FWA * BLEN LDA NAME3 ADDRESS OF FIRST 2 CHARS OF NAME AND MASKU MASK OFF LOWER CHAR STA NAME3 LDA KEYWD TOP OF KEYWORD LIST STA KEY TN005 LDA KEY,I CHECK IF END OF LIST CCE,SZA,RSS JMP NOID END OF INSTR LIST, NO ID SEGMENT ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 & 2 CPB NAME1 COMPARE WITH CHAR 1 & 2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE, GO TO NEXT ID SEG LDB A,I ID SEG ASCII NAME 3,4 CPB NAME2 COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT ID SEG LDA A,I ID SEG ASCII NAME CHAR 5 STA B AND MASKU CPA NAME3 COMPARE CHAR 5 JMP TN040 COMPARES - SO ID SEG FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LDB KEY,I ADDRESS OF ID SEGMENT LDA BPA1 RTE II OR III ? CPA D2 RSS RTE III JMP BLEN2 RTE II FIND BUFFER LENGTH ADB D21 POINT TO WORD 22 OF ID SEGMENT LDA B,I LOAD CONTENTS OF WORD 22 AND .76K CLE ELA,ALF ROTATE # OF PAGES TO RAL LOWER 6 BITS STA NAME1 SAVE IT ADA N19 IS IT LESS THAN 15 PAGES? SSA JMP BFLN2 YES, THEN CANNOT DO VERIFY WITH 6K BUFFER CLB,INB NO, B REG = 1 - CAN VERIFY WITH 6K BUFFER JMP BUFLN SEND VALUE OF B REG BACK TO MAIN PROG BFLN2 LDA NAME1 ADA N6 IS IT LESS THAN 7 PAGES? SSA CCB,RSS YES, THEN CANNOT VERIFY AT ALL CLB NO THEN CAN VERIFY WITH 2048 WORD BUF JMP BUFLN NOID CCB B REG = -1 -b‘þú ID SEG NOT FOUND JMP BUFLN BLEN2 LDB FWA CMB,INB FIND PARTITION SIZE ADB LWA INB LWA-FWA+1 ADB N1350 ADD -13500 - -VE OF PARTITION SIZE REQD. SSB FOR VERIFY WITH 6144 WORD BUFFER CLB,RSS CANNOT VERIFY WITH 6144 WORD BUFFER CLB,INB VERIFY WITH 6K BUFFER POSSIBLE BUFLN ISZ BUFER LDA BUFER,I PASS BACK LENGTH OF PARTITION STB A,I LDA LWA FIND LENGTH OF AVMEM IN PARTITION LDB FWAVM CMB,INB B REG HAS FWA OF AVMEM ADB A INB LWA-FWAVM+1 ISZ BUFER LDA BUFER,I STB A,I # OF WORDS IN FREE AVMEM IN PARTITION ISZ BUFER JMP BUFER,I RETURN * A EQU 0 B EQU 1 FWAVM BSS 1 LWA BSS 1 FWA BSS 1 KEY BSS 1 MASKU OCT 177400 .76K OCT 76000 N1350 DEC -13500 N19 DEC -19 D21 DEC 21 BPA1 EQU 1742B KEYWD EQU 1657B VERFY ASC 6,VERFY NAME1 EQU VERFY NAME2 EQU VERFY+1 NAME3 EQU VERFY+2 D2 DEC 2 D3 DEC 3 N6 DEC -6 D12 DEC 12 D14 DEC 14 N1 DEC -1 .17 OCT 17 END FTN4,L C NAME: CHDLU C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. J.S.W C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE CHDLU(ITLU,IDLU,ISUB,IDTYP X ),92067-16339 REV.1903 790512 DIMENSION ICHAR(2) EXTERNAL SUB,READU,MESG,ASCDC,DCASC,MEMGT CALL MEMGT(1653B,LUMAX) 10 IF ((IDLU.LT.1).OR.(IDLU.GT.64)) GO TO 530 CALL EXEC (13+100000B,IDLU,IEQT5) GO TO 530 C EQUIPMENT TYPE 32? 55 IF (IAND(IEQT5,3í8þú7400B)-15000B) 115,130,530 C EQUIPMENT TYPE 31? 115 IF (IAND(IEQT5,37400B)-14400B) 530,140,530 130 IDTYP=7905 GO TO 150 140 IDTYP=7900 150 CALL SUB(IDLU,ISUB) RETURN 530 CALL MESG(ITLU,7) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 540 ICHAR=2H CALL READU(ITLU,ICHAR,2) CALL ASCDC(ICHAR,1,IDLU) GO TO 10 END END$ FTN C NAME: CHUTP C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. J.S.W C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE CHUTP(ITLU,IUNIT,IDTYP),92067-16339 REV.1903 790309 EXTERNAL MESG,ASCDC,READU,DCASC DIMENSION ICHAR2(2) 10 IF ((IDTYP.EQ.7900).OR.(IDTYP.EQ.7901)) GO TO 50 IF ((IDTYP.EQ.7905).OR.(IDTYP.EQ.7920).OR.(IDTYP.EQ.7906) X .OR.(IDTYP.EQ.7925)) GO TO 60 11 CALL MESG(ITLU,15) CALL DCASC (ICHAR2,2,IDTYP) CALL EXEC (2,ITLU,ICHAR2,2) CALL READU(ITLU,ICHAR2,2) CALL ASCDC (ICHAR2,2,IDTYP) GO TO 10 50 IDTYP=7900 IF ((IUNIT.LT.0).OR.(IUNIT.GT.3)) GO TO 505 RETURN 60 IF(IDTYP.EQ.7925) GO TO 66 IDTYP=7905 66 IF ((IUNIT.LT.0).OR.(IUNIT.GT.7)) GO TO 505 RETURN 505 CALL MESG(ITLU,6) CALL DCASC (ICHAR,1,IUNIT) CALL EXEC (2,ITLU,ICHAR,1) ICHAR=2H CALL READU(ITLU,ICHAR,1) CALL ASCDC(ICHAR,1,IUNIT) GO TO 10 END END$ FTN4,L,C C NAME: LUTRK C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K.,J.S.W. C C *************************************************************** C * (C) C0þúOPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE LUTRK(ITLU,LIMIT,IUNIT,IDTYP,ITB30,MPST,ILUTR,LUFLG, C IEQT1),92067-16339 REV.2013 800103 C ROUTINE TO DECODE TRACK MAP TABLE AND BUILD TABLE FOR LU# AND C # OF TRACKS FOR THE DISC UNIT SPECIFIED BY IUNIT C C FORMAT OF TABLE IS: WORD 1 - LU# OF SUBCHANNEL 1 ON DISC 1 C WORD 2- # OF TRACKS FOR SUBCHANNEL 1 ON DISC 1, C WORD 3- LU# OF SUBCHANNEL 2 ON DISC 1 .............. C EXTERNAL MESG DIMENSION ITB30(1),ILUTR(1) LUFLG=0 IF (IDTYP.EQ.7900) GO TO 20 C FIND FIRST SUBCHANNEL # ON 7905 DISC UNIT C NSUB=-ITB30(MPST-1) ISUB=-1 10 IF (ISUB.EQ.NSUB) GO TO 150 ISUB=ISUB+1 C ISOLATE UNIT NUMBER FOR EVERY SUBCHANNEL ON TRACK MAP TABLE C UNTIL IT MATCHES IUNIT C IF (IAND(ITB30(MPST+ISUB*3+1),17B).NEQ.IUNIT) GO TO 10 GO TO 30 C C FIRST SUBCHANNEL # ON 7900 DISC UNIT 20 ISUB=IUNIT*2 30 IDLU=1 40 IEQT=0 IFLAG=0 C CALL ROUTINE TO GO THRU DEVICE REFERENCE TABLE AND FIND LU FOR C SUBCHANNEL D WRITE(1,5555) IUNIT,ISUB D5555 FORMAT("UNIT,SUB",2I5) CALL DRT (ISUB,IDLU,IEQT) C DRT RETURNS WITH LU=-1 IF SUBCHANNEL IS NOT ASSIGNED AN LU# IF (IDLU.EQ.-1) GO TO 200 C C CHECK EQUIPMENT# IN STATUS WORD TO MAKE SURE LU RETURNED IS FOR C THE RIGHT DISC UNIT TYPE C IAEQT5=(IAND(77B,IXGET(IXGET(1652B)+IDLU-1))-1)*15 X +IXGET(1650B)+4 C IEQT5=IXGET(IAEQT5) C IF ((IAND(IEQT5,37400B).EQ.15000B).AND.(IDTYP.EQ.7905).AND. C (IFDVR(IDLU).EQ.0)) GO TO 50 IF ((IAND(IEQT5,37400B).EQ.14400B).AND.(IDTYP.EQ.7900)) C kþú GO TO 50 C THE EQUIPMENT TYPE IS NOT 31 OR 32, LU # NOT RIGHT, TRY AGAIN C IDLU=IDLU+1 GO TO 40 C FILL THE ILUTR TABLE WITH LU# AND # OF TRACKS 50 DO 90 ILU = 1,63,2 ILUTR(ILU)=IDLU IF (IDLU.EQ.2) LUFLG=1 C GET # OF TRACKS IF (IDTYP.EQ.7905) GO TO 60 ILUTR(ILU+1)=ITB30(MPST+ISUB+8) C ALL SUBCHANNELS FOR 7900 DISC UNIT DONE? IF (ISUB.EQ.IUNIT*2+1) GO TO 100 ISUB=ISUB+1 GO TO 80 60 ILUTR(ILU+1)=ITB30(MPST+ISUB*3+2) 70 IF (ISUB.EQ.NSUB-1) GO TO 100 ISUB=ISUB+1 IF (IAND(ITB30(MPST+ISUB*3+1),17B).NEQ.IUNIT) GO TO 70 80 IDLU=1 IFLAG=-1 C FIND LU# FOR GIVEN SUBCHANNEL AND EQT# CALL DRT(ISUB,IDLU,IEQT) IF (IDLU.EQ.-1) GO TO 200 90 CONTINUE C C END OF LIST OF LU #'S TO BE MARKED WITH -1 100 LIMIT=ILU IEQT1=IEQT RETURN C "IMPROPER TRACK MAP INFO. " 150 CALL MESG (ITLU,28) CALL MESG (ITLU,14) STOP C ERROR MESSAGE PRINTED - LU # NOT ASSIGNED TO FOLL. SUBCHNL 200 CALL MESG(ITLU,9) ICHAR=2H CALL DCASC(ICHAR,1,ISUB) CALL EXEC (2,ITLU,ICHAR,1) C ASSIGN LU# TO SUBCHANNEL AND RSTART UTILITY USIG RTE GO CMND CALL MESG (ITLU,11) PAUSE IF (IFLAG) 80,40 END END$ ASMB,R * NAME: MATCH * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MATCH,7 92067-16339 REV.1903 790309 ENT MATCH ROUTINE TO MATCH TRACK MAP INFO FOR 2 DISC UNITS EXT MESG,EXEC,RMOVI,DRT,DCASC,EXEC MATCH NOP Nþú LDA MATCH,I STA RETRN SAVE RETURN ADDRESS CLA STA IWORD FETCH VALUES OF FIRST 8 ARGUMENTS LDB N7 STB ITEMP ITEMP IS COUNTER LOOP ISZ MATCH LOAD THEM IN BUF LDA MATCH,I ADDRESS OF ARGUMENT IN A REG LDA A,I VALUE IN A REG LDB ABUF LOAD ADDRESS OF BUFFER ADB IWORD DISPLACEMENT STA B,I ISZ IWORD ISZ ITEMP JMP LOOP LDB N3 STB ITEMP ITEMP IS COUNTER LOOP0 ISZ MATCH FETCH THE ADDRESSES OF 2 TRACK MAP TABLES LDA MATCH,I JSB RMOVI LDB ABUF ADDRESS OF BUFFER FOR PARAMETERS ADB IWORD INDEX INTO IT STA B,I STORE TABLE ADDRESS IN BUFFER ISZ IWORD ISZ ITEMP JMP LOOP0 LDA MPST1 ADJUST MAP START ADDRESS FOR ASSEMBLY ADA N1 STA MPST1 LDA MPST2 ADA N1 STA MPST2 LDA IDTYP CHECK DISC TYPE - 7900,7905 CPA D7905 7905 DISC? JMP M7905 YES,JUMP JSB M7900 NO,MATCH INFO, FOR 7900 DISC UNITS DEF D0 MATCH FIRST SUBCHNL STARTING TRACK # JSB M7900 DEF D1 MATCH SECOND SUBCHNL(REMOVABLE) STARTING TRACK # JSB M7900 DEF D8 MATCH FIRST SUBCHNL # OF TRACKS JSB M7900 DEF D9 MATCH SECOND SUBCHNL # OF TRACKS JMP RETRN,I TM INFO FOR BOTH 7900 UNITS MATCHES, RETURN M7905 LDA MPST1 DETERMINE NUMBER OF SUBCHNLS IN TRACK MAP TABLE ADA N1 ADA MAP1 LDA A,I CMA,INA NUMBER IS -VE SO MAKE IT +VE STA NSUB1 LDA MPST2 FIND # OF SUBCHANNELS IN MAP2 ADA N1 ADA MAP2 LDA A,I CMA,INA MAKE IT +VE STA NSUB2 # OF SUBCHANNELS IN MAP2 CLA STA ISUB1 SUBCHNL #'S FOR SOURCE DISC LOOP1 LDB MAP1 MAP ADDRESS OF SOUCE UNIT JSB CMPR IS ISUB1 ON IUNIT1? DEF MPST1 MAP START ADDR OF MAP1 DEF IUNT1 ¸þú UNIT# OF SOURCE UNIT SZA A REG = 0 IF ISUB1 ON UNIT1 JMP ENDL3 NO,TRY NEXT SUBCHNL STB ITMP1 ADDR OF TRACK MAP INFO FOR ISUB1 STA ISUB2 YES, ISUB2 IS SUBCHNL FOR DEST DISC IUNIT2 LOOP2 LDB MAP2 MAP ADDRESS OF DEST DISC UNIT JSB CMPR ISUB2 ON IUNIT2? DEF MPST2 MAP START ADDR OF MAP2 DEF IUNT2 UNIT# OF SOURCE UNIT SZA A REG =0 SAYS ISUB2 IS ON IUNIT2 JMP ENDL2 NO, TRY NEXT SUBCHNL * TRACK MAP INFO FOR BOTH SUBCHANNELS MATCHES? STB ITMP2 ADDR OF TRACK MAP INFO FOR ISUB2 LDA ITMP1 BOTH SBCHNLS ARE ON DESIRED UNIT#'S LDA A,I START COMPARING - AREG HAS FIRST WORD LDB ITMP2 FIRST WORD FOR SUBCHNL ON 2ND DISC UNIT LDB B,I CPA B COMPARE RSS JMP ENDL2 DOES NOT MATCH - TRY WITH NEXT SUBCHNL LDA ITMP1 MATCH SECOND WORD FOR BOTH SUBCHANNELS INA LDA A,I BRING CONTENTS OF 2ND WORD AND .7776 MASK OUT THE UNIT# FROM WORD 2 OF SBCHNL ON UNIT1 STA ITEMP LDA ITMP2 POINTER TO BEG OF SUBCHNL INFO ON MAP 2 INA LDA A,I CONTENS OF WORD 2 AND .7776 MASK OUT UNIT# FROM WORD 2 OF SBCHNL ON UNIT2 CPA ITEMP COMPARE WORD INFO RSS JMP ENDL2 DO NOT MATCH - TRY WITH NEXT SUBCHNL LDA ITMP1 YES,COMPARE WORD 3 ADA D2 LDA A,I LDB ITMP2 FETCH CONTENTS OF WORD3 OF SUBCHNL ON UNIT2 ADB D2 LDB B,I CPA B JMP ENDL1 ENDL2 ISZ ISUB2 NO MATCH - TRY WITH NEXT SUBCHNL LDA ISUB2 INCREMENT AND TRY AGAIN CPA NSUB2 ALL SUBCHANNELS LOOKED AT? JMP ERROR YES - NO MATCH IN ENTIRE TMT - ERROR JMP LOOP2 NO - TRY AGAIN ENDL1 LDA ILUTR LU#-#TRACKS TABLE ADDR ADA ILU POINT TO NEXT ENTRY POINT IN IT INA # OF TRACKS ENTRY FOR ISUB2 STB A,I MTCH2 CLA STA ITEMP jþú JSB DRT FIND LU# OF ISUB2 DEF *+4 DEF ISUB2 DEF ITEMP LU# DEF IEQT EQT # LDB ITEMP WAS SUBCHNL ENTRY MADE IN DRT? SSB,RSS JMP MTCH1 YES JSB MESG NO, LU# NOT ASSIGNED TO SUBCHNL DEF *+3 DEF ITLU DEF D9 ASSIGN LU# TO FOLL SUBCHNL JSB DCASC CONVERT SUBCHNL# TO ASCII DEF *+4 DEF ITEMP DEF D1 DEF ISUB JSB EXEC DISPLAY SUBCHANNEL # DEF *+5 DEF D2 DEF ITLU DEF ITEMP DEF D1 JSB MESG DEF *+3 DEF ITLU DEF D11 RESTART MESSAGE JSB EXEC DEF *+2 DEF D7 PAUSE JMP MTCH2 CONTINUE * MTCH1 LDA ILUTR ADDRESS OF LU-#TRACKS TABLE ADA ILU INDEX INTO TABLE STB A,I LU# ENTRY MADE IN TABLE LDA ILU INCREMENT ILU INDEX BY 2 ADA D2 STA ILU ENDL3 ISZ ISUB1 MATCH FOUND - NOW TRY WITH NEXT SUBCHNL LDA ISUB1 ON IUNIT1 CPA NSUB1 ALL SUBCHANNELS HAVE BEEN MATCHED? JMP RETRN,I YES-RETURN JMP LOOP1 NO - FIND NEXT ONE * *ERROR - SYSTEM LU TO BE RESTORED,SOURCE AND DEST TRCK MAP INFO * DOES NOT MATCH * ERROR JSB MESG DEF *+3 DEF ITLU DEF D16 JSB MESG DEF *+3 DEF ITLU DEF D14 JSB EXEC DEF *+2 DEF D6 * *SUBROUTINE TO COMPARE 1 WORD OF TRACK MAP INFO. FOR 7900 DISC UNITS * *CALLING SEQUENCE: *JSB M7900 *DEF DN DN IS THE DISPLACEMENT WITHIN TMT * M7900 NOP LDB M7900,I GET PARAMETER ADDRESS LDB B,I VALUE OF ARGUMENT STB ITEMP LDA IUNT1 ADA A ADA MPST1 POINTER TO BEG. OF INFO. FOR UNIT1 IN MAP 1 ADA MAP1 ADA ITEMP POINTER TO REQUIRED WORD IN MAP 1 LDA A,I FETCH CONTENTS OF WORD * LDB IUNT2 REPEAT PROCEDURE FOR WORD IN MAP 2 ADB B ®þú ADB MPST2 ADB MAP2 ADB ITEMP LDB B,I CPA B COMPARE INFO RSS JMP ERROR NO MATCH - ERROR ISZ M7900 MATCH, GET RETURN ADDRESS JMP M7900,I RETURN * *SUBROUTINE TO COMPARE UNIT# FOR GIVEN SBCHNL AND GIVEN DISC UNIT# * *CALLING SEQUENCE: *JSB CMPR *DEF MPST MAP START ADDR *DEF UNIT# * A REG=ISUB SUBCHNL # WHOSE UNIT # HAS TO BE COMPARED * B REG = MAP ADDRESS * RETURNS: A REG = 0 IF SUBCHNL IS ON UNIT * 1 OTHERWISE * B REG = IF A REG = 0 THEN ADDR OF TRACK MAP INFO FOR SUB * CMPR NOP STA ISUB ALS INDEX TO THE BEG OF SUBCHANNEL ENTRY ADA ISUB ISUB*3 ADA B ADDRESS OF MAP LDB CMPR,I GET MAP START ADDR LDB B,I ADA B STA ITEMP INA LDA A,I BRING CONTENTS OF 2ND WORD FOR SBCHNL AND .17 ISOLATE UNIT # ISZ CMPR LDB CMPR,I LDB B,I BRING UNIT # CPA B COMPARE UNIT #'S JMP EQUAL MATCH,JUMP LDA D1 DO NOT MATCH RETURN WITH 1 IN A REG JMP RCMPR EQUAL CLA RETURN WITH 0 IN A REG LDB ITEMP ADDR OF TRACK MAP INFO FOR SUB RCMPR ISZ CMPR RETURN ADDRESS JMP CMPR,I RETURN * * A EQU 0 B EQU 1 ABUF DEF BUF BUF BSS 10 ITLU EQU BUF IDTYP EQU BUF+1 DISC TYPE IEQT EQU BUF+2 EQT # OF DISC IUNT1 EQU BUF+3 UNIT # 1 IUNT2 EQU BUF+4 UNIT # 2 MPST1 EQU BUF+5 STARTING WORD # ON MAP 1 MPST2 EQU BUF+6 STARTING WORD # ON MAP 2 MAP1 EQU BUF+7 ADDR OF TRACK MAP TABLE OF SOURCE DISC MAP2 EQU BUF+8 ADDR OF TRACK MAP TABLE OF DEST DISC ILUTR EQU BUF+9 ADDR OF LU#-# OF TRACKS TABLE IWORD BSS 1 ILU DEC 0 RETRN BSS 1 ITEMP BSS 1 ITMP1 BSS 1 ITMP2 BSS 1 ISUB1 BSS 1 ISUB2 BSS 1 ISUB BSS 1 NSUB1 BSS 1 NSUB2 BSS 1 D0 DEC 0 D1 DEC 1 D2 DEC 2 D6 DEC 6 D7 DEC 7 D8 DEC 8 Ayþú D9 DEC 9 D11 DEC 11 D14 DEC 14 D16 DEC 16 D96 DEC 96 D7905 DEC 7905 N1 DEC -1 N3 DEC -3 N7 DEC -7 .17 OCT 17 .7776 OCT 77760 END FTN4 C NAME: MPFND C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. J.S.W. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE MPFND(MPNAM,ITLU,IDTYP,ITMT,JB X ),92067-16339 REV.1903 790512 C FIND TRACK MAP TABLE BY LOOKING AT LIST OF ENTRY POINTS EXTERNAL DSCAD,MESG,MEMGT DIMENSION MPNAM(3),JB(1),ITMT(1) DATA ISIZE/2048/ MPNAM=2H$T MPNAM(2)=2HB3 C LOC 1762B HAS THE NO. OF ENTRY POINTS IN LIST C EACH ENTRY POINT IS FOUR WORDS LONG C IDSCLN IS NO. OF WORDS TAKEN UP BY THE ENTRY POINT LIST 140 CALL MEMGT(1762B,IDSCLN) IDSCLN=IDSCLN*4 C 1761B IS THE DISC ADRESS OF FW OF ENTRY POINT LIST CALL MEMGT(1761B,IPARM) C CONVERT DISC ADDRESS TO TRACK #, SECTOR # AND LU # CALL DSCAD (IPARM,ILU,ITRCK,ISECTR) C C MXSEC=96 IF(ILU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(ILU.EQ.3) CALL MEMGT(1760B,MXSEC) C C ITEMP=MXSEC-ISECTR IF (ITEMP.GE.32) GO TO 145 JBUFL=ITEMP*64 GO TO 150 C MAX BUFFER LENGTH 145 JBUFL=ISIZE 150 IF (IDSCLN.LT.JBUFL) JBUFL=IDSCLN C READ JBUFL WORDS FROM ENTRY POINT LIST CALL EXEC (1,ILU,JB,JBUFL,ITRCK,ISECTR) C EACH ENTRY POINT HAS 4 WORDS - FIRST 5 CHARACTERS ASSIGNED TO C ENTRY POINT NAME, IF LOWER BYTE OF WORD 3 IS 1 THEN ROUTINE IS C ON DISC AND WORD 4 CONTAINS THE DISC ADDRESS OF ROUTINE - IF C LOWER BYTE OF WORD 3 IÎþúS NOT 1 THEN ROUTINE IS IN MEMORY AND C WORD 4 IS MEMORY ADDRESS OF ROUTINE C C GO THROUGH LIST TO FIND MATCHING ENTRY POINT NAME DO 147 IWORD=1,JBUFL,4 IF (JB(IWORD).NEQ.MPNAM) GO TO 147 IF (JB(IWORD+1).NEQ.MPNAM(2)) GO TO 147 IF ((IAND(JB(IWORD+2),177400B)+40B).EQ.MPNAM(3)) GO TO 230 147 CONTINUE IDSCLN=IDSCLN-JBUFL C IF NO MORE WORDS LEFT IN LIST THEN ERROR, ELSE TRY WITH NEXT BUF IF (IDSCLN) 700,700,200 200 ISECTR=ISECTR+32 C SET UP SECTOR & TRACK ADDRESS TO READ NEXT SET OF DATA FROM DISC ITEMP=MXSEC-ISECTR IF (ITEMP.GE.32) GO TO 145 IF (ITEMP.LE.0) GO TO 210 JBUFL=ITEMP*64 GO TO 150 210 ISECTR=0 ITRCK=ITRCK+1 GO TO 145 C IF LOWER BYTE OF WORD 3 IS 1 THEN DISC ADDRESS 230 IF (IAND(JB(IWORD+2),377B).EQ.1) GO TO 250 C GET MEMORY ADDRESS OF ROUTINE MPADR=JB(IWORD+3) IF (IDTYP.EQ.7905) GO TO 232 C C C M=17 C MOVE M WORDS OF TRACK MAP INTO BUFFER 237 DO 240 IWORD=1,M CALL MEMGT(MPADR+IWORD-1,ITMT(IWORD)) 240 CONTINUE RETURN C CONVERT DISC ADRESS INTO TRACK#,SECTOR# AND LU# 250 CALL DSCAD(JB(IWORD+3),ILU,ITRCK,ISECTR) M=17 IF (IDTYP.EQ.7905) GO TO 400 C READ M WORDS OF TRACK MAP FROM DISC CALL EXEC (1,ILU,ITMT,M,ITRCK,ISECTR) RETURN C ERROR - ROUTINE NAME CANNOT BE FOUND IN ENTRY POINT LIST 700 CALL MESG (ITLU,4) CALL EXEC (2,ITLU,MPNAM,3) CALL MESG (ITLU,14) STOP C C C C C C 400 CALL EXEC(1,ILU,JB,161,ITRCK,ISECTR) GO TO 310 C C 232 DO 255 IWORD=1,161 CALL MEMGT(MPADR+IWORD-1,JB(IWORD)) 255 CONTINUE C C 310 INDEX=1 IWORD=1 IF(JB(1).GE.0.AND.JB(2).LT.0) STOP 66 C C ITMT(1)=JB(1) DO 350 IS=1,32 DO 350 IW=1,5 IWORD=IWORD+1 IF(IW.EQ.1.OR.IW.EQ.5) GO TO 350 INDEX=INDEX+1 IF(IW.EQ.3) GO TO 330 ITMT(INDEX)=JB(I¦þúWORD) GO TO 350 330 ITEMP=IAND(JB(IWORD),176000B)*4 ITEMP=ITEMP+(IAND(JB(IWORD),1760B)*16) ITMT(INDEX)=ITEMP+IAND(JB(IWORD),17B) 350 CONTINUE C RETURN C C END END$ FTN4,L C NAME: PRNTH C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. J.S.W C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE PRNTH (ITLU,IMLU,IBUF),92067-16339 REV.1903 790309 C SUBROUTINE TO READ HEADER RECORD AND PRINT TITLE AND TAPE # C DIMENSION IBUF(1),ITITL(4),ITAPE(5),IOK(7) EXTERNAL MESG,DCASC,READU DATA ITITL/2HFI,2HLE,2H I,2HD:/, C ITAPE,ITAPE(2),ITAPE(3),ITAPE(4)/2HTA,2HPE,2H#:,2H /, C IOK/2HOK,2H? ,2H (,2HYE,2HS/,2HNO,2H) / 10 CALL EXEC (1,IMLU,IBUF,140) CALL EXEC (2,ITLU,ITITL,4) CALL EXEC (2,ITLU,IBUF,36) CALL DCASC (ITAPE(5),1,IBUF(37)) CALL EXEC (2,ITLU,ITAPE,5) CALL EXEC (2,ITLU,IOK,7) CALL READU(ITLU,IYES,1) IF (IYES.EQ.2HYE) RETURN CALL MESG (ITLU,11) PAUSE IBUF=-1 RETURN END END$ FTN4 C NAME: TPPOS C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBRg˜þúOUTINE TPPOS(ITLU,IMLU,IFILE,ITAPE),92067-16339 REV.1903 790309 X9 C ROUTINE TO POSITION MAG TAPE TO A DESIRED FILE # EXTERNAL ASCDC,READU,MESG EQUIVALENCE (REG,IA) IF (IFILE.GT.0) GO TO 25 10 CALL MESG (ITLU,5) CALL READU(ITLU,NFILE,1) CALL ASCDC (NFILE,1,IFILE) C CHECK IF FILE # > 0 AND <= 8 IF (IFILE.EQ.0) IFILE=1 IF ((IFILE.LT.1).OR.(IFILE.GT.8)) GO TO 100 15 REWIND IMLU C POSITION BY MOVING TAPE IFILE-1 FILES FORWARD IF (IFILE.EQ.1) RETURN DO 20 NFILE=1,IFILE-1 C FORWARD SPACE MAG TAPE BY 1 FILE CALL EXEC (3+100000B,1300B+IMLU) GO TO 120 C EOT MARK SEEN? IF YES, ERROR - FILE NOT FOUND 17 REG=EXEC(3,600B+IMLU) IF (IAND(IA,40B).EQ.40B) GO TO 120 20 CONTINUE RETURN C 25 IF (ITAPE.NEQ.1) GO TO 15 IF (IFILE.EQ.1) GO TO 15 CALL EXEC (3,200B+IMLU) CALL EXEC (3,1400B+IMLU) CALL EXEC (3,300B+IMLU) RETURN C C ERROR MESSAGES 100 CALL MESG(ITLU,18) GO TO 10 120 CALL MESG (ITLU,19) CALL MESG(ITLU,11) REWIND IMLU PAUSE GO TO 10 END END$ ASMB,R * NAME: ASCDC * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ASCDC,7 92067-16339 REV.1903 790309 ENT ASCDC ROUTINE TO CONVERT ASCII TO DEC OR OCTAL ENT ASCOC ASCDC NOP ASCII TO DECIMAL LDA D9 STA RADIX SET UP RADIX JMP START ASCOC NOP ASCII TO OCTAL LDA ASCOC STA ASCDC Ñ+þú LDA D7 STA RADIX SET UP RADIX TO 7 START CLA STA VAL VAL IS GOING TO ACCUMULATE INTEGER VALUE STA IWORD IWORD IS COUNTER FOR WORD IN BUF BEING CONVERTED LDA ASCDC,I STA RETRN SAVE RETURN ADDRESS ISZ ASCDC LDA ASCDC,I STA INAM SAVE ADDRESS OF CHARACTER STRING ISZ ASCDC LDA ASCDC,I LDA A,I ADA N1 STA NWORD SAVE # OF WORDS TO BE CONVERTED-1 LDA IWORD LOOP ADA INAM INDEX INTO CHARACTER STRING BUFFER LDA A,I FETCH CURRENT WORD IN STRING TO BE CONVERTED STA CWORD AND .1774 SEPERATE UPPER BYTE ALF,ALF CPA SPACE IF SPACE ENCOUNTERED IN FIRST BYTE IGNORE IT JMP IGNOR CLB CLEAR FLAG TO INDICATE UPPER BYTE OF CURRENT WORD STB IFLAG IS BEING CONVERTED CNVRT ADA .N60 CONVERT CMA,SSA,INA,RSS NEGATIVE NUMBER? JMP ERR YES,ERROR ADA RADIX CMA,SSA,INA,RSS INTEGER? JMP ERR NO,ERROR ADA RADIX BACK TO ORIGINAL NUMBER LDB RADIX CMB CLO ADA VAL ADD EXISTING VALUE TO THE NEW INTEGER 10 TIMES ISZ B JMP *-2 SOC IF OVERFLOW, ERROR JMP ERR STA VAL LDA IFLAG JUST CONVERTED UPPER BYTE? SZA JMP NEXT YES, GET NEXT BYTE IGNOR LDA CWORD NO, FETCH CURRENT WORD THAT IS BEING CONVERTED AND .377 EXTRACT LOWER BYTE CPA SPACE SPACE? JMP DONE YES, DONE ISZ IFLAG SET FLAG TO INDICATE CONVERTING LOWER BYTE JMP CNVRT NEXT LDA IWORD GET ASCII STRING COUNTER CPA NWORD ALL WORDS IN STRING CONVERTED? JMP DONE YES, DONE INA NO, SET POINTER TO CONVERT THE NEXT WORD STA IWORD JMP LOOP DONE ISZ ASCDC LDA ASCDC,I LDB VAL STB A,I JMP RETRN,I RETURN WITH CONVERTED VALUE ERR ISZ ASCDC ž*þú RETURN WITH VALUE = -1 LDA ASCDC,I LDB N1 STB A,I JMP RETRN,I * A EQU 0 B EQU 1 N1 DEC -1 .N60 OCT -60 .1774 OCT 177400 .377 OCT 377 D9 DEC 9 D7 DEC 7 VAL BSS 1 RADIX BSS 1 RETRN BSS 1 IFLAG BSS 1 CWORD BSS 1 NWORD BSS 1 IWORD BSS 1 INAM BSS 1 SPACE OCT 00040 END ASMB,R * NAME: DCASC * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DCASC,7 92067-16339 REV.1903 790309 ENT DCASC ROUTINE TO CONVERT DECIMAL INTEGERS TO ASCII DCASC NOP CLA STA IFLAG STA CWORD LDA DCASC,I STA RETRN ISZ DCASC LDA DCASC,I STA INAM BUFFER ADDRESS ISZ DCASC LDA DCASC,I LDA A,I ADA N1 STA NWORD LENGTH OF BUFFER-1 LDA INAM BUFFER TO BE BLANKED LOOP0 LDB SPACE STB A,I BLANK OUT A WORD IN BUFFER LDB CWORD USE CWORD AS COUNTER TO POINT IN TO BUFFER CPB NWORD ALL WORDS IN BUFFER DONE? JMP DCAS1 YES, GO ON INA ISZ CWORD INCREMENT COUNTER JMP LOOP0 DCAS1 ISZ DCASC LDA DCASC,I LDA A,I LOAD INTEGER TO BE CONVERTED LOOP CLB DIV D10 DIVIDE INTEGER BY BASE 10 STA QOTNT QOTNT IS USED TO EXTRACT REMAINING DIGITS ADB .60 B REG CONTAINS REMAINDER WHICH IS THE LATEST DIGIT * TO BE CONVERTED BY ADDING OCTAL 60 STB BYTE ASCII INTEGER SAVED LDA IFLAG CHECK TO SEE IpfþúF THIS IS A LOW ORDER BYTE SZA LOW ORDER BYTE IF IFLAG=0, ELSE HIGH ORDER BYTE JMP HIGH LDA BYTE STA CWORD STORE BYTE IN LOWER HALF OF CWORD LDA QOTNT GET READY TO EXTRACT AND CONVERT NEXT DIGIT ISZ IFLAG SET FLAG TO INDICATE WORKING ON HIGH ORDER BYTE JMP LOOP START CONVERSION AGAIN HIGH LDA BYTE BIT 0 NOT SET IF HIGH ORDER BYTE ALF,ALF STORE BYTE IN UPPER HALF OF CWORD ADA CWORD STA CWORD LDA NWORD ADA INAM REG A POINTS TO BUFFER WHERE CWORD IS PLACED LDB CWORD STB A,I LDA NWORD SZA,RSS HAS THE BUFFER BEEN FILLED? JMP RETRN,I YES,RETURN TO CALLING ROUTINE ADA N1 NO,DECREASE NWORD TO POINT TO NEXT WORD IN BUFFER STA NWORD CLA STA IFLAG CLEAR FLAG TO INDICATE WORKING ON LOW ORDER BYTE LDA QOTNT GET READY TO EXTRACT NEXT DIGIT SZA IF QOTNT=0 THEN NO MORE DIGITS LEFT TO CONVERT JMP LOOP JMP RETRN,I * A EQU 0 B EQU 1 RETRN BSS 1 NWORD BSS 1 CWORD BSS 1 IFLAG BSS 1 QOTNT BSS 1 BYTE BSS 1 N1 DEC -1 D10 DEC 10 .60 OCT 60 INAM BSS 1 SPACE ASC 1, END ASMB,R * NAME: DRT * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DRT,7 92067-16339 REV.1903 790309 ENT DRT DEVICE REFERENCE TABLE IS SCANNED THROUGH TO FIND EXT RMOVI DRT NOP LU# FOR GIVEN SUBCHANNEL AND EQT# LDA DRT,I SAVE RETURN POINTER z6þúSTA RETRN ISZ DRT LDA DRT,I PICK UP SUBCHANNEL # TO BE FOUND IN DRT LDA A,I STA ISUB ISZ DRT LDA DRT,I PICK UP LAST PLACE (LU) LOOKED AT IN DRT LDA A,I NON-ZERO IF EQT DID NOT SHOW RIGHT DEVICE TYPE STA ILU LDA DRT INA LDA A,I PICK UP EQT# PARAMETER. IF FIRST SUBCHNL EQT# PARM. JSB RMOVI STA IEQT WILL BE 0, ELSE >0 FOR NEXT SUBCHNLS LOOP LDB IDRT ADB ILU INDEX INTO DRT ADB N1 LDA B,I AND .174 FIND SUBCHNL # OF PARTICULAR DRT ENTRY ALF,RAL CPA ISUB JMP EQT JUMP IF MATCHING SUBCHNL # FOUND CHLU LDA ILU HAVE ALL THE ENTRIES IN DRT BEEN CHECKED? CPA LUMAX JMP ERR YES, THEREFORE ERROR ISZ ILU NO, THEREFORE INCREAMENT LU# AND TRY AGAIN JMP LOOP EQT LDB IDRT FIND EQT # FOR GIVEN SUBCHNL ADB ILU ADB N1 LDA B,I AND .77 LDB IEQT,I SZB IF LOOKING FOR SUBCHNL FIRST TIME, * RETURN EQT # TO CHECK FOR DEVICE JMP CHEQT IF LOOKING FOR NEXT SUBCHNL, CHECK IF EQT # MATCHES STA IEQT,I LU LDA DRT,I LDB ILU RETURN LU # FOR GIVEN SUBCHNL STB A,I JMP RETRN,I ERR LDA DRT,I NO LU # ASSIGNED TO GIVEN SUBCHNL LDB N1 STB A,I JMP RETRN,I CHEQT CPA B CHECK IF EQT #'S MATCH JMP LU YES. RETURN WITH LU # JMP CHLU NO. TRY WITH NEXT LU # RETRN BSS 1 ISUB BSS 1 IEQT BSS 1 ILU BSS 1 IDRT EQU 1652B FWA OF DRT LUMAX EQU 1653B # OF ENTRIES IN DRT A EQU 0 B EQU 1 .77 OCT 77 .174 OCT 174000 N1 DEC -1 END ASMB,R,L,C * NAME: DSCAD * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PÎfþúHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DSCAD,7 92067-16339 REV.1903 790309 EXT EXEC ROUTINE TO FIND LU#, TRACK#, SECTOR # FROM ENT DSCAD DISC ADDRESS WORD. WHERE IF BIT 15=0 LU = 2, DSCAD NOP IF BIT 15=1, LU=3; BITS 7-14 IS TRACK NUMBER; LDA DSCAD,I BITS 0-6 IS SECTOR NUMBER STA RETRN SAVE RETURN POINTER ISZ DSCAD LDA DSCAD,I LDA A,I STA IDADR ISZ DSCAD LDB DSCAD,I STB T1 SSA JMP LU3 LDB D2 STB T1,I LU=2 JMP TRCK LU3 LDB D3 LU=3 STB T1,I TRCK AND .776 FIND TRACK # ISZ DSCAD LDB DSCAD,I ALF,ALF RAL STA B,I STA ITRCK LDA IDADR AND .177 FIND SECTOR # ISZ DSCAD LDB DSCAD,I STA B,I JMP RETRN,I RETURN TO CALLING ROUTINE IDADR BSS 1 T1 BSS 1 ITRCK BSS 1 RETRN BSS 1 MSG ASC 2,HERE D3 DEC 3 D2 DEC 2 D1 DEC 1 .776 OCT 77600 .177 OCT 177 A EQU 0 B EQU 1 END ASMB,R * NAME: MEMGT * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MEMGT,7 92067-16339 REV.1903 790309 ENT MEMGT ROUTINE TO RETURN CONTENTS OF GIVEN LOC IN MEMORY MEMGT NOP ROUTINE TO GET CONTENTS OF GIVEN MEMORY LOCATION LDA MEMGT,I |þú STA RETRN SAVE RETURN ADDRESS ISZ MEMGT LDA MEMGT,I LDA A,I A REG HAS CONTENTS ADDRESS OF LOCATION LDA A,I A REG HAS CONTENTS OF LOCATION ISZ MEMGT LDB MEMGT,I B REG HAS ADDRESS OF VARIABLE STA B,I JMP RETRN,I RETURN A EQU 0 B EQU 1 RETRN BSS 1 END ASMB,R * NAME: SUB * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SUB,7 92067-16339 REV.1903 790309 ENT SUB ROUTINE TO DETERMINE SUBCHNL# OF GIVEN LU# SUB NOP LU# ENTRY IN DRT (BITS 11-15) IS USED LDA SUB,I STA RETRN SAVE RETURN ADDRESS ISZ SUB LDB SUB,I B HAS ADDRESS OF SUBCHANNEL LU LDB B,I LU # IN B REG ADB N1 ADB DRT ADDRESS OF FIRST WORD IN DRT LDA B,I DRT ENTRY IN A REG AND .1740 MASK OFF BITS 0-10 ALF,RAL ROTATE BITS 11-15 TO 0-4 POSITION ISZ SUB LDB SUB,I ADDRESS OF ISUB STA B,I PASS BACK SUBCHANNEL # JMP RETRN,I RETURN TO CALLING ROUTINE RETRN BSS 1 A EQU 0 B EQU 1 .1740 OCT 174000 N1 DEC -1 DRT EQU 1652B FWA OF DRT END FTN4 C NAME: READU C SOURCE: 92067-18339 C RELOC: 92067-16339 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROgØþúGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE READU(ITLU,IBUF,ILEN),92067-16339 REV.1903 790309 DIMENSION IBUF(1),IREG(2) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IABRT/2HAB/,IQUES/2H??/ 5 DO 10 I=1,ILEN IBUF(I)=2H 10 CONTINUE REG = EXEC (1,ITLU+400B,IBUF,ILEN) LEN=IB IF (LEN.NEQ.0) GO TO 20 CALL EXEC (2,ITLU,IQUES,1) GO TO 5 20 IF (IBUF(1).NEQ.IABRT) RETURN CALL MESG (ITLU,14) STOP END END$ ASMB,R * NAME: RMOVI * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RMOVI,7 92067-16339 REV.1903 790309 ENT RMOVI ROUTINE TO REMOVE INDIRECTS FROM GIVEN ADDRESS RMOVI NOP ROUTINE TO REMOVE INDIRECTS FROM DEF ADDRESSES RSS MOREI LDA A,I REG A HAS INDIRECT ADDRESS RAL,CLE,SLA,ERA JMP MOREI STILL AN INDIRECT ADDRESS JMP RMOVI,I * A EQU 0 END ASMB,Q,C * NAME: MESG * SOURCE: 92067-18339 * RELOC: 92067-16339 * PGMR: S.P.K. J.S.W * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************Äoþú************************** * NAM MESG,7 92067-16339 REV.2013 800104 ENT MESG,ITASK ROUTINE TO PRINT MESSAGES FOR EXT EXEC SAVE, RSTOR AND COPY EXT PNAME GET PROGRAM NAME ROUTINE MESG NOP SUP LDA MESG,I STA RETRN SAVE RETURN ADDRESS ISZ MESG LDA MESG,I LDB A,I STB ITLU ISZ MESG LDA MESG,I LDB A,I STB TEMP MESSAGE # CPB D50 IF MSG# IS 28 CONVERT IT TO 17 LDB D17 LDA MSG ADA B LDB A,I LDA B,I STA IBUFL INB STB MADDR JSB PNAME FIND THIS PROGRAM'S NAME DEF *+2 ADDR DEF NAME LDB MADDR GET THE ADDRESS OF MESSAGE LDA TEMP MESSAGE #? CPA D11 IS IT RESTART ------ BY ENTERING........? JMP MESG1 YES CPA D14 IS IT ----- ABORTED? JMP MESG2 CPA D25 IS IT MESG # 25? JMP MESG2 YES CPA D17 IS IT MESG # 17? JMP MESG3 YES CPA D50 USE DIFFERENT NAME ADDR FOR MESG 28 RSS JMP MESG5 LDA ADDR2 RSS MESG3 LDA ADDR1 ADB D7 JSB MOVE JMP MESG5 MESG2 LDA ADDR YES, THEN A REG HAS ADDR OF NAME JSB MOVE MOVE NAME MESSAGE INTO MESSAGE 14 JMP MESG5 SEND MESSAGE OUT TO TTY MESG1 LDA ADDR MESSAGE OF NAME ADB D4 INDEX INTO IT JSB MOVE MOVE APPROPRIATE NAME IN IT LDA ADDR MESSAGE OF NAME LDB MADDR ADB D15 INDEX FURTHER INTO MSG11 JSB MOVE MOVE WORDS MESG5 JSB EXEC DEF *+5 DEF ICODE DEF ITLU DEF MADDR,I DEF IBUFL JMP RETRN,I * MOVE NOP ROUTINE TO MOVE THREE WORDS FROM STA TEMP SAVE CONTENTS OF A REG LDA N3 STA COUNT COUNTER LOOP LDA TEMP LDA A,I STA B,I INB ISZ TEMP ISZ COUNT JMvþúP LOOP JMP MOVE,I RETURN * MSG DEF MESGX MESGX DEF MSG0 DEF MSG1 DEF MSG2 DEF MSG3 DEF MSG4 DEF MSG5 DEF MSG6 DEF MSG7 DEF MSG8 DEF MSG9 DEF MSG10 DEF MSG11 DEF MSG12 DEF MSG13 DEF MSG14 DEF MSG15 DEF MSG16 DEF MSG17 DEF MSG18 DEF MSG19 DEF MSG20 DEF MSG21 DEF MSG22 DEF MSG23 DEF MSG24 DEF MSG25 DEF MSG26 DEF MSG27 DEF MSG28 * A EQU 0 B EQU 1 RETRN BSS 1 ITLU BSS 1 IBUFL BSS 1 ICODE DEC 2 MSG0 DEC 8 ASC 8,VERIFY? (YES/NO) MSG1 DEC 12 ASC 12,PARTITION SIZE TOO SMALL MSG2 DEC 17 ASC 21,TRACK SIZE BUFFER DESIRED?(YES/NO) MSG3 DEC 30 ASC 4,WARNING- ASC 26,PARTITION SIZE TOO SMALL FOR VERIFY W/ TRCK SIZE BUF MSG4 DEC 16 ASC 16,FOLLOWING TRCK MAP TBL NOT FOUND MSG5 DEC 3 ASC 3,FILE#? MSG6 DEC 21 ASC 21,FOLLOWING DISC DRIVE# IMPROPER,ENTER AGAIN MSG7 DEC 20 ASC 20,FOLLOWING DISC LU# IMPROPER, ENTER AGAIN MSG8 DEC 11 ASC 11,IMPROPER MT LU#, LU#=? MSG9 DEC 16 ASC 16,ASSIGN LU# TO FOLLOWING SUBCHNL MSG10 DEC 15 ASC 15,NO WRITE RING, WRITE ENABLE MT MSG11 DEC 19 ASC 19,RESTART BY ENTERING 'GO, ' MSG12 DEC 13 ASC 13,EOT REACHED,MOUNT NEW TAPE MSG13 DEC 17 ASC 17,DISC ERROR AT FOLLOWING TRCK & LU# MSG14 DEC 7 ASC 7, ABORTED MSG15 DEC 20 ASC 20,FOLLOWING DISC TYPE IMPROPER,ENTER AGAIN MSG16 DEC 22 ASC 22,SOURCE & DEST TRACK MAP INFO. NOT COMPATIBLE MSG17 DEC 16 ASC 16,DISC TYPE FOR DISC UNIT? MSG18 DEC 7 ASC 7,IMPROPER FILE# MSG19 DEC 7 ASC 7,FILE NOT FOUND MSG20 DEC 17 ASC 17,SAVE TYPE NOT SAME AS RESTORE TYPE MSG21 DEC 17 ASC 17,WARNING-WRITING ON PROTECTED TRCKS MSG22 DEC 13 ASC 13,DEST SUBCHNL IS LU2 OR LU3 MSG23 DEC 20 ÛŽŠ ASC 20,OFF-LINE SAVE,CANNOT BE RESTORED ON-LINE MSG24 DEC 7 ASC 7,MOUNT TAPE# 1 MSG25 DEC 14 ASC 14, WAITING FOR MT LU LOCK MSG26 DEC 18 ASC 18,MISSING REC FOR FOLLOWING TRCK & LU# MSG27 DEC 27 ASC 27,WARNING-VERFY NOT DEFINED OR PARTITION SIZE TOO SMALL MSG28 DEC 11 ASC 11,IMPROPER TRCK MAP INFO ADDR1 DEF *+1 ASC 3,SOURCE ADDR2 DEF *+1 ASC 3,DEST ITASK BSS 1 MADDR BSS 1 NAME BSS 3 D4 DEC 4 D7 EQU MSG14 D11 EQU MSG8 D14 EQU MSG25 D15 EQU MSG10 D17 EQU MSG2 D25 DEC 25 D50 DEC 50 N3 DEC -3 TEMP BSS 1 COUNT BSS 1 END gvÿÿ ÿý = ÿ92067-18340 2013 S C0122 &DSKUP OFF-LINE BACKUP UTILITY             H0101 zþúASMB,R,Q,C * NAME: DBKUP * SOURCE: 92067-18340 * RELOC: 92067-16340 * PGMR: S.P.K.,J.S.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBKUP,3,99 92067-16340 REV.2013 800109 * OFF-LINE DISC BACKUP UTILITY EXT $LIBR,$LIBX,EXEC,COR.A SUP A EQU 0 B EQU 1 * * KB BSS 8194 TRACK BUFFER * NSUB NOP # OF SUBCHANNELS ON 7905 DISC UNIT ISIZE NOP SIZE OF REC READ FROM DISC JSIZE NOP SIZE OF RECORD READ FROM OR WRITTEN TO MT INCR NOP INCREMENTS FOR SECTOR COUNT M24K NOP VRFLG NOP DOSDF NOP TEMP NOP TEMP1 NOP TEMP2 NOP SUB# NOP TRACK NOP TRCK1 NOP UN#IT NOP SUNIT NOP DUNIT NOP SVTPN NOP HEADR BSS 140 AHDR DEF HEADR TAPEN EQU HEADR+36 SVTYP EQU HEADR+38 SYSTP EQU HEADR+40 IREC EQU HEADR+41 TRKMP EQU HEADR+42 AMAP1 DEF HEADR+42 AMAP2 DEF HEADR+43 ATB31 NOP ATB32 NOP SUB1# EQU KB JB EQU KB+2 C1 EQU JB C2 EQU JB+1 C3 EQU JB+2 C4 EQU JB+3 C5 EQU JB+4 C6 EQU JB+6 C7 EQU JB+8 C8 EQU JB+9 LB EQU KB+2048 MB EQU LB+2048 NB EQU MB+2048 * * * AKB DEF KB AJB DEF JB ALB DEF LB AMB DEF MB ANB DEF NB LABEL BSS 128 LABEL BUFFER FOR DOS SUBCHNLS ALABL DEF LABEL D128 DEC 128 #SECT DEC 96 SECTOR PER TRACK * * * YE ASC 1,YE 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 D15 DEC 15 D16 DEC 16 D17 DEC 17 D19 DEC 19 D20 DEC 20 D21 DEC 21 D2zDþú2 DEC 22 D23 DEC 23 D25 DEC 25 D28 DEC 28 D30 DEC 30 D36 DEC 36 D140 DEC 140 D96 DEC 96 D410 DEC 410 D411 DEC 411 D2048 DEC 2048 D6144 DEC 6144 D8192 DEC 8192 TKSIZ DEC 6122 TRACK SIZE INIT TO 6144 * N1 DEC -1 N2 DEC -2 TST05 DEF *+1 * N411 DEC -411 # TACK SURFACE N1234 DEC -1234 MAX #TRACK DISC N4 DEC -4 # OF SURFACES N3 DEC -3 HIGHEST HEAD # * ASC 2, 410 ASC 2,1233 * ASC 1, 2 ASC 1, 3 * * * 7906 SPECIFICATION * DEC -411 DEC -1645 DEC -5 DEC -4 ASC 2, 410 ASC 2,1644 ASC 1, 3 ASC 1, 4 * * * 7920 SPEC-- 823 TACK/SURF, 5 HEADS * N823 DEC -823 N4116 DEC -4116 N6 DEC -6 N5 DEC -5 ASC 2, 822 ASC 2,4115 ASC 1, 4 ASC 1, 5 * * * 7925 SPEC-- 9 HEADS,823 TRACKS/SURFACE * DEC -823 DEC -7407 DEC -10 DEC -9 ASC 2, 822 ASC 2,7407 ASC 1, 8 ASC 1, 9 * * END OF DISC PARAMETER * SECTR NOP #SPTR NOP # OF SPARE TRACKS FOR SUBCHNL CSPAR NOP BASE ADDR OF SPARE TRACK POOL UBADC NOP # OF USED SPARES PT#TR NOP CYLINDER # H#AD NOP HEAD # ITLU EQU D1 OPERATOR CONSOLE LU MTLU EQU D8 MAG TAPE LU SORCE ASC 3,SOURCE DEST ASC 3,DEST SAVE ASC 2,SAVE COPY ASC 2,COPY CLF CLF 0 JSBCI NOP MTRCN NOP DBKUP LIA 1 READ SWTCH REGISTER CONTENT SZA,RSS 0? JMP NOCNF YES - RE-CONFIGURATION OF MT AND TTY IS NOT STA SWREG DESIRED JSB CNFIG RE-CONFIGURE RTE-M FOR MT AND TTY CHANNELS JMP STRT1 * NOCNF JSB WRITE DISC BACKUP UTILITY DEF MSG1 DEF D10 LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR05 DEVICE ADA .12 STA .12,I NOCN1 JSB QTASK TASK? TASK=0 - SAVE, 1=RESTORE LDA TASK CPA D2 IS TASK COPY? JMP STRT1 YES ^þú LDA MTRCN NO, THEN IS RECONFIGURATION OF MT CHANNEL REQRD? SZA JSB CNFIG YES * STRT1 DLD AMAP1 DST ATB31 CLA STA VFLAG STA VRFLG STA DOSDF STA RTFLG INA STA M24K LDA TASK IS TASK RESTORE? CPA D1 JMP RSTOR HANDLE RESTORE SEPARATELY CLA INITIALIZE RECORD SIZE INDICATOR STA IREC JSB QDISC QUERY DISC FEATURES JSB V6144 VERIFY POSSIBLE W/ 6144 WORD BUF? SZA JMP SACO1 YES,ASK IF LARGE BUFFER SIZE IS DESIRED? JSB WRITE DEF ERR0 DEF D5 JSB WRITE NO, GIVE WARNING MESSAGE DEF MSG25 WARNING - MEM SIZE TOO SMALL FOR VERIFY W/ DEF D23 6144 WORD BUF CLA STA M24K M24K=0 IF VERIFY W/ 6144 WORD BUF NOT POSSIBLE * = 1 OTHERWISE SACO1 JSB QUERY DEF MSG24 6144 WORD BUFFER DESIRED? DEF D13 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF WHAT IS THE RESPONSE? CPA YE JMP SAC20 NO LDA D2048 STA JSIZE SIZE OF BUFFER TO BE READ OR WRITTEN TO MT LDA D32 STA INCR JMP SACO2 SAC20 LDA TKSIZ YES STA JSIZE LDA #SECT GET SECTOR PER TRACK STA INCR INCREMENT = 96 SECTORS CLA,INA IREC=1 TO INDICATE 6144 WORD REC SIZE STA IREC LDA M24K VERFIFY POSSIBLE? SZA,RSS JMP SACO3 NO * WANT VERIFY? SACO2 JSB QUERY DEF MSG17 VERIFY? DEF D4 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF CPA YE YES? ISZ VRFLG VRFLG=1 INDICATES THAT VERIFY IS DESIRED SACO3 LDA TASK TASK? SZA SAVE? JMP SACO4 NO, COPY CLA STA FILEN FILE# INITIALIZED TO 0 JSB WRITE SET UP HEADER RECORD AND WRITE IT ON MT DEF MSG15 FILE ID? DEF D4 SACO9 LDA N36 qÒþú STA COUNT COUNTER LDA SPACE CLEAR FILE ID BUFFER LDB AHDR ADDRESS OF HEADER RECORD STA B,I INB POINT TO NEXT WORD IN FILE ID BUFFER ISZ COUNT INCREMENT COUNT JMP *-3 IF ALL 36 WORDS NOT CLEARED, CLEAR NEXT ONE JSB EXEC READ RESPONSE IN HEADER BUFFER DEF *+5 DEF D1 DEF RITLU ITLU+400B DEF HEADR DEF D36 LDA HEADR HELP NEEDED? CPA QUES ?? RSS JMP SACO8 NO JSB WRITE YES-EXPLAIN DEF EXP15 ENTER MT FILE ID OF MAX 72 CHAR DEF D17 JMP SACO9 ASK FOR FILE ID AGAIN * SACO8 JSB MTNR MT READY? JSB WRING WRITE RING IN? JSB POSN POSITION MAG TAPE CLA,INA TAPE# = 1 STA TAPEN LDA SDTYP SOURCE DISC TYPE STA HEADR+37 LDA COTYP COPY TYPE CMA,INA -VE TO INDICATE OFF-LINE SAVE STA HEADR+38 JSB EXEC WRITE HEADER RECORD ON MT DEF *+5 DEF D2 DEF MTLU DEF HEADR DEF D140 * SACO4 LDA TKSIZ 6144 WORD BUFFERS TO READ & WRITE ON DISC STA ISIZE LDA SDTYP SOURCE DISC TYPE? CPA D7900 7900 DISC? RSS YES JMP SAC05 NO, 7905 OR 7920 LDA PLATR PLATR # INDICATES SUBCHANNEL # FOR 7900 DISC STA SUB# SACO0 JSB TSTC0 FIND SIZE OF SUBCHANNEL STB NTRCK SIZE (# OF TRACKS) RETURNED IN AREG CLA STA TRACK STA KB+1 SACO5 OTA 1 OUTPUT TRACK # TO SWITCH REGISTER LDA SUNIT SOURCE UNIT FOR DISC DRIVER STA UN#IT CLA SECTOR # = 0 STA SECTR LDB AJB CORE ADDRESS OF BUFFER JSB RD00 READ A TRACK FROM 7900 DISC LDA TASK TASK IS SAVE? SZA JMP SACO6 NO,COPY JSB WRTMT YES WRITE RECORD ON MAG TAPE JMP SACO7 SACO6 LDA DUNIT SET UP UNIT Örþú# FOR DESTINATION DISC STA UN#IT LDB AJB CORE ADDRESS OF BUFFER JSB WR00 WRITE TRACK ON 7900 DEST DISC SACO7 ISZ TRACK GO TO NEXT TRACK LDA TRACK STA KB+1 CPA NTRCK ALL TRACKS IN SUB# READ? RSS JMP SACO5 NO, DO NEXT ONE LDA COTYP YES, DONE IF COPY TYPE IS FROM-TO CPA D2 UNIT COPY? RSS JMP DONE NO, SO DONE LDA SUB# YES, SUBCHNL # SZA JMP DONE SUB# = 1, THEREFORE DONE ISZ SUB# SUB#=0, SO SAVE OR COPY SUB# 1 LDA SUB# JMP SACO0 * * SOURCE DISC IS 7905 OR 7920 * SAC05 LDA ATB32 # OF SUBCHNLS IS STORED IN FIRST WORD OF TMT ADA N1 LDA A,I SSA IF -VE CONVERT IT TO A +VE # CMA,INA STA NSUB # OF DEFINED SUBCHNLS IN TRACK MAP TABLE CLA STA SUB# FIRST SUB# = 0 SAC09 JSB TSTC5 GET # TRACKS & BASE ADDR OF SPARE TRK POOL LDA ATB32 # OF SUBCHNLS ENTRY IN AREG ADA N1 LDA A,I SSA,RSS IF TRACK SPARING IS DESIRED, THIS ENTRY IS -VE JMP SAC08 ENTRY IS +VE SO NO TRACK SPARING IS DESIRED JSB NSPRS TRCK SPARING WANTED,FIND # SPARE TRACKS FOR SUB# STA #SPTR # OF SPARES RETURNED IN A REG SAC08 CLA STA UBADC # OF USED SPARES STA TRACK COUNTER FOR TRACK # STA SECTR SECTOR # STA KB+1 SAC07 OTA 1 LDB SUB# CURRENT SUBCHNL# BLS SUB#*2 ADB SUB# SUB#*3 ADB ATB32 ADD ADDR OF TRACK MAP TABLE STB DIST1 ADDR OF TRACK MAP INFO FOR SUB# LDA SUNIT STA UN#IT SET UP SOURCE UNIT # FOR DRIVER JSB RD05 READ A RECORD FROM 7905 SOURCE DISC LDA TASK TASK? SZA SAVE? JMP SAC06 NO, COPY JSB WRTMT YES, WRITE RECORD ON TAPE JMP SAC10 SAC06 LDA DOSDF WAS THE DEFECTIVE TRACK FLAG FOR SZA DOÝÞþúS DISC TURNED ON? JMP INIEW YES, GO SPARE THIS TRACK TOO LDA DUNIT WRITE DATA ON DESTINATION DISC UNIT STA UN#IT LDB AJB JSB WR05 WRITE TRACK ON 7905 DISC SAC10 ISZ TRACK INCREMENT TRACK# LDA TRACK STA KB+1 CPA NTRCK ALL TRACKS IN SUB# SAVED OR COPIED? RSS JMP SAC07 NO DO THIS TRACK LDA SYSTP YES - SYSTEM TYPE? SZA,RSS RTE? JMP SAC11 LDA COTYP DOS SYSTEM - COPY TYPE? CPA D2 UNIT? JSB LBCNG YES, UPDATE USER LABEL ON SUB# TO REFLECT # OF * BAD TRACKS AND NEXT AVAILABLE SPARE ENTRIES SAC11 ISZ SUB# GO TO NEXT SUBCHNL LDA SUB# CPA NSUB ALL SUBCHNLS DEFINED HAVE BEEN SAVED OR COPIED? JMP DONE YES JMP SAC09 NO, SAVE OR COPY THIS SUB# * * TASK IS TO RESTORE MAG TAPE * RSTOR CLA STA FILEN FILE # INITIALIZED TO 0 STA EOFLG END OF FILE FLAG INITIALIZED TO 0 JSB MTNR MT READY? JSB POSN ASK FOR FILE# AND POSITION MT TO IT JSB PRNTH READ AND PRINT HEADR INFO DEF HEADR ADDRESS OF HEADER BUFFER JMP RSTR2 CORRECT TAPE JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JSB PAUSE TAPE IS NOT OK, WAIT FOR USER TO MOUNT JMP RSTOR RIGHT TAPE, POSITION, PRINT HEADER, ETC. AGAIN * RSTR2 LDA SVTYP SSA CMA,INA IF COPY TYPE IS -VE CONVERT TO +VE STA COTYP LDA HEADR+37 STA SDTYP READ SOURCE DISC TYPE FROM HEADER STA DTYPE DEST DISC TYPE IS SAME AS SOURCE DISC TYPE * * LDB D6144 INIT TRACK SIZE TO 6144 CPA D7925 IS IT A 7925 LDB D8192 YES, SET TRACK SIZE TO 8192 CPA A7925 IS IT 7925 (ON LINE SAVE) LDB D8192 STB TKSIZ TRACK SIZE LDB D96 INIT SECTOR CPA D7925 LDB D128 SET SECTOR PER TRACK TO 128 )1þú CPA A7925 LDB D128 STB #SECT * * JSB QDISC QUERY DISC FEATURES LDA TKSIZ INITIALIZE ISIZE TO 6144 STA ISIZE LDB IREC BUFFER SIZE OF SAVE RECORDS? SZB,RSS REC=6144 WORDS? JMP RSTR8 STA JSIZE YES, SET UP SIZE AND INCR FOR MAG TAPE RECORDS LDA #SECT STA INCR INCREMENTS FOR SECTOR #'S JSB V6144 CAN VERIFY BE DONE W/ 6144 WORD BUFFER? SZA JMP RSTR3 YES, MEMORY IS >= 24K JSB WRITE DEF ERR0 WARNING-- DEF D5 JSB WRITE NO, SEND WARNING MESSAGE DEF MSG25 WARNING-MEM SIZE TOO SMALL FOR VERIFY W/ 6144 DEF D23 WORD BUFFER JMP RSTR4 RSTR8 LDB D2048 REC SIZE IS 2048 WORDS STB JSIZE LDB D32 STB INCR * WANT VERIFY? RSTR3 JSB QUERY DEF MSG17 VERIFY? DEF D4 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF CHECK RESPONSE CPA YE YES? ISZ VRFLG VERIFY WANTED, TURN FLAG ON TO INDICATE THIS * * RSTR4 LDA N1 SET SUBCHNL# TO -1 STA SUB# LDA SVTYP WAS SAVE DONE ON-LINE OR OFF-LINE? SSA JMP RSTR7 OFF-LINE SAVE LDA TRKMP LDB SDTYP ON-LINE SAVE - SOURCE DISC TYPE? CPB D7900 7900? JMP RSTR6 YES SSA,RSS IF FIRST WORD +VE THEN USER DEFINED TRACK MAP ISZ ATB32 START OF TRACK MAP INFO IS INCREMENTED BY 1 JMP RSTR9 RSTR6 SSA SOURCE DISC WAS A 7900 ISZ ATB31 USER DEFINED TRACK MAP TABLE JMP RST10 RSTR7 LDA SDTYP OFF-LINE SAVE - SOURCE DISC TYPE? CPA D7900 7900? JMP RST10 YES RSTR9 LDA ATB32 COMPUTE # OF SUBCHANNELS DEFINED ADA N1 IN TRACK MAP TABLE LDA A,I SSA # OF SUBCHNLS -VE? CMA,INA YES, CONVERT IT TO +VE STA NSUB # OF SUBCHNLS DEFINED ON 7905 SOURCE DISC RST10 JSB RD˜þúMT READ ALL RECORDS FROM MT THAT BELONG LDA EOFLG TO SAME TRACK -- GET END OF FILE FLAG SZA,RSS SET? JMP RST17 NO LDA SDTYP YES CPA D7900 7900 DISC? JMP DONE YES, THEN DONE LDA COTYP CPA D2 UNIT COPY? RSS JMP DONE NO, THEN DONE LDA SYSTP SZA,RSS DOS SYSTEM? JMP DONE NO, THEN DONE JSB LBCNG UPDATE LABELS ON DOS SUBCHNL JMP DONE RST17 LDA KB+1 WAS THIS TRACK USUCCESSFULLY SAVED? SSA,RSS JMP RST11 NO ELA,CLE,ERA CLEAR SIGN BIT STA TRACK JSB WRITE YES - PRINT WARNING MESSAGE DEF ERR0 WARNING - DEF D5 JSB WRITE DEF MSG30 TRACK AT FOLLOWING LOC WAS NOT SAVED SUCCESSFULLY DEF D25 LDA TRACK LDB SDTYP SOURCE DISC TYPE CPB D7900 7900 DISC? JMP RST12 YES JSB PTRK5 PRINT LOCTION OF TRACK JMP RST14 RST12 LDA KB FIND REAL TRACK # ELA,CLE,ERA CLEAR SIGN BIT ADA ATB31 ADD ADDRESS OF TRACK MAP TABLE LDA A,I FIRST TRACK # OF SUBCHANNEL ADA TRACK ADD RELATIVE TRACK # JSB PTRK0 PRINT LOC OF TRACK FOR 7900 DISC RSS RST11 STA TRACK RST14 LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REGISTER CLA SECTOR # = 0 STA SECTR LDA DUNIT SET UNIT # FOR DRIVER STA UN#IT LDA SDTYP SOURCE DISC TYPE? CPA D7900 7900 DISC? JMP RST15 YES LDA DOSDF NO, IS THIS A DOS DISC AND IF SO WAS THE PREVIOUS SZA TRACK DEFECTIVE? JMP INIEW YES, THEN MARK THIS ONE DEFECTIVE & SPARE IT LDA SUB# SAVE ORIGINAL VALUE OF SUB# STA SUB LDA KB IS THIS A NEW SUBCHNL? ELA,CLE,ERA CLEAR SIGN BIT CPA SUB# JMP RST16 NO, IT IS SAME AS BEFORE STA SUB# JSB TSTC5 "4þúGET #TRCKS & BASE SPARE POOL ADDR FOR SUB# LDA ATB32 TRACK MAP TABLE ADDRESS ADA N1 LDA A,I IF VALUE -VE THEN TRACK SPARING DESIRED SSA,RSS JMP RST16 TRACK SPARING NOT DESIRED LDB SYSTP SZB,RSS DOS SYSTEM? JMP RST18 NO, RTE LDA SUB WAS ORIGINAL VALUE -1? SSA JMP RST19 YES,THEN DONT CHANGE ANY LABELS LDB SUB# STB SUB SAVE NEW VALUE OF SUB# STA SUB# JSB LBCNG UPDATE LABELS ON DOS SUBCHNL JMP RST19 RST18 JSB NSPRS FIND # OF SPARE TRACKS ALLOWED FOR THIS SUB# STA #SPTR RST19 CLA STA UBADC INITIALIZE # OF USED SPARES TO 0 RST16 JSB WR05 WRITE RECORD ON 7905 DISC RSS RST15 JSB WR00 DISC IS 7900 - WRITE REC ON IT JMP RST10 READ NEXT RECORD FROM MT * * TASK IS COMPLETED, NOW CHECK IF VERIFY REQUESTED * DONE LDA TASK WAS TASK SAVE? SZA JMP DONE1 NO LDA MTLU ADA .100 SET UP CONTROL WORD FOR EOF MARK STA TEMP1 JSB EXEC YES THEN WRITE AN EOF MARK ON MT DEF *+3 DEF D3 DEF TEMP1 EOF MARK DONE1 LDA VRFLG LOAD VERIFY FLAG SZA JMP VERFY IT IS ON, SO VERIFY DATA JUST TRANSFERRED JMP EXIT TERMINATE UTILITY * * ENTER HERE WHEN UTILITY HAS TO BE ABORTED * EXITU JSB WRITE DEF MSG20 DISC BACKUP UTILITY IS ABORTED DEF D15 JMP NOCN1 ASK FOR NEXT TASK EXIT JSB WRITE TASK COMLETED DEF MSG19 DEF D7 LDA TASK TASK IS COPY? CPA D2 JMP NOCN1 YES THEN DONE JSB MTNR MAG TAPE READY? JSB REWND NO, DONT REWIND MAG TAPE JMP NOCN1 ASK FOR NEXT TASK * * * VERIFY DATA * VERFY ISZ VFLAG VFLAG=1 TO INDICATE VERIFY OPERATION JSB WRITE INFORM USER THAT DATA IS NOW BEING VERIFIED DEF MSG31 VERIFYING DEF D5 LDA JSIZE SET ªþúUP SIZE DISC BUFFER TO MATCH MT BUFFER STA ISIZE LDA TASK CPA D2 TASK IS COPY? JMP VRF10 YES, HANDLE IT SEPARATELY LDA TAPEN TAPE# STA SVTPN SAVE TAPE# INDICATING LAST TAPE USED CPA D1 TAPE# = 1? JMP VERF3 YES VERF1 JSB WRITE NO DEF MSG29 MOUNT TAPE# 1 DEF D7 JSB REWND JSB PAUSE WAIT FOR USER TO MOUNT FIRST TAPE JSB MTNR MT READY? JSB POSN POSITION IT TO FILE# IN FILEN JSB PRNTH PRINT HEADER AND ASK OK ON TAPE DEF HEADR ADDRESS OF BUFFER FOR HEADER REC JMP VERF4 TAPE OK JMP VERF1 TAPE NOT OK - TRY AGAIN * VERF3 JSB MTNR MT READY? JSB POSN POSITION MT TO FILEN JSB EXEC DEF *+5 DEF D1 DEF MTLU READ HEADER RECORD DEF HEADR DEF D140 * VERF4 LDA TASK SZA TASK WAS SAVE? JMP VERF5 NO - IT WAS RESTORE LDB SDTYP SOURCE DISC TYPE STB DSCTP LDB SUNIT SOURCE DISC UNIT # STB UN#IT JMP VLOOP VERF5 LDB DTYPE DESTINATION DISC TYPE STB DSCTP LDB DUNIT DEST UNIT# STB UN#IT LDA COTYP IS IT A FR-TO? CPA D3 RSS JMP VLOOP NO LDA DSUB# YES, THEN DEST SUB# STA SUB# LDA DPLTR DEST PLATTER # STA PLATR VLOOP CLA SECTOR # IS 0 STA SECTR INA STA VRFLG RESET VRFLG VLP1 LDA MTLU EOT REACHED? ADA .600 STA TEMP2 CONTROL WORD FOR DYNAMIC STATUS OF MT JSB EXEC FIND DYNAMIC STATUS OF MT DEF *+3 DEF D3 DEF TEMP2 AND .40 AREG HAS STATUS WORD CPA .40 IF BIT 5 IS ON, EOT HAS BEEN REACHED RSS JMP VERF6 EOT NOT REACHED LDA SVTPN EOT REACHED CPA TAPEN IS THIS EOF TOO? JMP VDONE ALL TAPES HAVE BEEN VERIFIED, DONE ã“þú JSB WRITE ASK FOR NEXT TAPE TO BE MOUNTED DEF MSG18 EOT READCHED, MOUNT NEXT TAPE DEF D14 JSB REWND REWIND MAG TAPE VERF7 JSB PAUSE WAIT FOR TAPE TO BE MOUNTED JSB MTNR MAG TAPE READY? JSB REWND REWND MAG TAPE JSB PRNTH PRINT HEADER REC INFO & ASK IF OK DEF HEADR JMP VERF6 TAPE OK JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JMP VERF7 RIGHT TAPE NOT MOUNTED, WAIT AGAIN VERF6 LDA JSIZE ADD 2 WORDS FOR HEADER INFO ADA D2 STA TEMP1 JSB MTNR MAG TAPE READY? JSB EXEC READ RECORD FROM MAG TAPE DEF *+5 DEF D1 DEF MTLU DEF KB DEF TEMP1 SZB,RSS EOF REACHED? JMP VDONE YES LDA TASK SAVE? SZA,RSS JMP VRF32 YES LDA COTYP CPA D3 FROM - TO COPY? JMP VRF30 YES VRF32 LDA KB NO ELA,CLE,ERA CLEAR SIGN BIT STA SUB# VRF30 LDA KB+1 ELA,CLE,ERA CLEAR SIGN BIT STA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG LDA JSIZE IS BUFFER SIZE 6144 WORDS? CPA TKSIZ JMP VERF2 YES THEN USE BUFFER AT END OF SUBROUTINES LDB AJB ADB JSIZE CORE BUFFER ADDRESS RSS VERF2 LDB AVBUF CCE E REG = 1 FOR READ OPERATION CLA STA INIT1 CLEAR INIT BIT FOR DISK DRIVER LDA DSCTP DISC TYPE? CPA D7900 7900 DISC? JMP VERF8 YES LDA TASK SAVE? SZA,RSS JMP VRF19 YES LDA COTYP CPA D3 FROM - TO COPY? JMP VRF12 YES VRF19 LDA SUB# SET UP TRACK MAP ADDRESS FOR SUB# ALS ADA SUB# SUB#*3 ADA ATB32 JMP VRF18 VRF12 LDA AFRMP SET UP DIST1 FOR FROM - TO COPY INA VRF18 STA DIST1 TRACK MAP FOR DISC DRIVER TO USE LDA TRACK JSB DISK5 NO,7905 OR¸èþú 7920 DISC,READ REC FROM IT JMP VERF9 VERF8 LDA COTYP CPA D3 FROM - TO COPY? JMP VRF11 YES LDA ATB31 SET UP REAL TRACK ADDRESS ADA SUB# LDA A,I A REG HAS BASE TRACK ADDR RSS VRF11 LDA FTRCK REAL TRACK ADDRESS FOR DEST DISC ADA TRACK OF FROM-TO COPY IN A REG JSB DISK0 7900 DISC, READ RECORD FROM IT VERF9 LDA VRFLG HAS A VERIFY ERROR BEEN DETECTED IN THIS TRACK? SSA,RSS JSB CMPAR NO, THEN COMPARE THE 2 BUFFERS JMP VRF22 SUCCESSFUL COMPARE CCA STA VRFLG UNSUCCESSFUL COMPARE VRF22 LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA #SECT ALL 96 SECTOR FOR TRACK VERIFIED? JMP VLOOP YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK JMP VLP1 * * TASK WAS COPY * VRF10 CLA STA TRACK INITIALIZE TRACK AND SECTOR COUNTERS STA SECTR LDA JSIZE SET SIZE OF BUF TO WHAT USER HAD SEPCIFIED STA ISIZE LDB SDTYP STB DSCTP CPB D7900 7900 DISC? JMP VRF15 YES CLA STA SUB# SUB#=0 INITIALLY VLP4 JSB TSTC5 FIND # OF TRACKS IN SUBCHNL VLP3 LDA SUB# ALS ADA SUB# MULTIPLY SUB# 3 TIMES ADA ATB32 ADDR OF TRACK MAP INFO FOR SUBCHNL STA DIST1 LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG LDA SUNIT STA UN#IT SET UNIT # FOR DISC DRIVER LDB AJB CORE ADDR OF BUFFER LDA TRACK CCE E REG =1 FOR READ JSB DISK5 READ REC FROM 7905 DISC LDA COTYP CPA D3 FROM - TO COPY? RSS JMP VRF25 NO LDA AFRMP YES INA SET UP DIST1 FOR FROM TO COPY DEST SUBCHNL STA DIST1 VRF25 LDA DUNIT SET DEST UNIT# FOR DISC DRIVER STA UN#IT DEST UNIT LDA ISIZE SIZE OF BUFFER? CPA TKSIZ 6144 WORDS? JMP VRF16 öþú YES LDB AJB NO, 2048 WORDS ADB ISIZE CORE ADDRESS OF BUFFER FOR DEST DISC RSS VRF16 LDB AVBUF USE BUFFER AT END OF SUBROUTINES LDA TRACK CCE E REG = 1 FOR READ JSB DISK5 READ FROM DEST DISC JSB CMPAR COMPARE THE TWO RECORDS RSS SUCCESSFUL COMPARE RETURN JMP VRF13 USUCCESSFUL COMPARE, VERIFY NEXT TRACK LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA #SECT ALL 96 SECTORS VERIFIED? JMP VRF13 YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK JMP VLP3 VRF13 ISZ TRACK INCREMENT TRACK COUNTER LDA TRACK CPA NTRCK ALL TRACKS VERIFIED? JMP VRF14 YES CLA NO STA SECTR SECTOR COUNT TO 0 JMP VLP3 VRF14 ISZ SUB# LDA SUB# CPA NSUB ALL SUBCHNLS VERIFIED? JMP EXIT YES CLA STA TRACK STA SECTR LDA SUB# JMP VLP4 NO THEN VERIFY NEXT SUBCHNL * * DISC IS 7900 * VRF15 LDA PLATR PLATR # SAME AS FIRST SUB# STA SUB# VLP7 JSB TSTC0 FIND # OF TRACKS IN SUB# STB NTRCK # OF TRACKS RETURNED IN A REG CLA STA TRACK INITIALIZE TRACK AND SECTOR TO 0 VLP6 STA SECTR LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG VLP5 LDA SUNIT STA UN#IT SET UP SOURCE UNIT # FOR DISC DRIVER LDB AJB CORE ADDRESS FOR BUFFER CCE E REG=1 FOR READ LDA ATB31 SET UP REAL TRACK ADDRESS ADA SUB# LDA A,I BASE TRACK ADDR FOR SUB# ADA TRACK ADD RELATIVE TRACK ADDRESS JSB DISK0 CALL DISC DRIVER SSA WAS THIS TRACK MARKED DEFECTIVE? JMP VRF20 YES, FORGET IT, VERIFY NEXT ONE LDA DUNIT SET UP DEST UNIT # FOR DRIVER STA UN#IT LDA ISIZE BUFFER SIZE? CPA TKSIZ 6144 WORDS? JMP VRF17 YES LDB AJB ±«þúADB ISIZE ADDR OF BUFF FOR DEST DISK READ RSS VRF17 LDB AVBUF USE BUFFER AT END OF SUBROUTINES CCE E REG = 1 FOR READ LDA COTYP CPA D3 FROM - TO COPY? RSS JMP VRF26 NO LDA PLATR SAVE PLATTER # STA TBUF LDA SUB# SAVE SUBCHNL # STA TBUF+1 LDA DPLTR YES, SET UP PLATR AND SUB# STA PLATR LDA DSUB# STA SUB# LDA TRACK SET UP REAL TRACK ADDRESS IN A REG ADA FTRCK ADD BASE TRACK # TO RELATIVE TRACK # RSS VRF26 LDA TRCK1 REAL TRACK ADDRESS FOR OTHER THAN FROM-TO COPY JSB DISK0 READ BUF FROM DEST DISC VRF31 JSB CMPAR COMPARE TWO BUFFERS RSS SUCCESSFUL COMPARE JMP VRF20 UNSUCCESSFUL COMPARE, VERIFY NEXT TRACK LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA #SECT ALL 96 SECTORS VERIFIED? JMP VRF20 YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK LDA COTYP IS IT A FROM-TO COPY? CPA D3 RSS JMP VLP5 DLD TBUF RESTORE STA PLATR PLATTER# STB SUB# AND SUBCHANNEL # JMP VLP5 VRF20 LDA COTYP IS IT A FROM-TO COPY? CPA D3 RSS JMP VRF33 DLD TBUF YES, RESTORE SOURCE STA PLATR PLATTER # STB SUB# SUBCHANNEL # VRF33 ISZ TRACK INCREMENT TRACK COUNTER LDA TRACK CPA NTRCK ALL TRACKS IN SUB# VERIFIED? JMP VRF21 YES CLA NO, THE SECTOR IS 0 JMP VLP6 VRF21 LDA SUB# IF SUB#=1, THEN DONE SZA JMP EXIT LDA COTYP CPA D3 FROM-TO COPY? JMP EXIT YES, THEN DONE ISZ SUB# YES - VERIFY NEXT SUBCHNL LDA SUB# JMP VLP7 * VDONE JSB REWND DONE VERIFYING JMP EXIT * VFLAG NOP DSCTP NOP * * * CNFIG NOP ROUTINE TO CONFIGURE RTE-M OP SYSTEM LDA MTRCN ONLY MAG&þú TAPE TO BE CONFIGURED? SZA JMP CNFG3 YES JSB $LIBR TURN OFF ALL INTERRUPTS NOP AND MEMORY PROTECT FENCE CLF 0 LDA .15,I SAVE JSB CIC,I INSTR IN TEMP LOC STA JSBCI LDA CLF INSERT CLF INSTR IN MT TRAP CELLS ADA .23 STA .23,I INA STA .24,I LDA INTBA ADDRESS OF INTERRUPT TABLE LDB INTAD MAKE A COPY OF INT. TABLE IN USER AREA JSB .MVW MOVE WORDS SUBROUTINE DEF INTLG LENGTH OF BUFFER TO BE MOVED NOP LDA SWREG GET CONTENTS OF SW REG ELA,CLE,ERA CLEAR SIGN BIT STA SWREG LDA CN1 CONFIGURE I O INSTR TO CONSOLE SC ADA SWREG STA CN1 LDA CN2 ADA SWREG STA CN2 LDA CN3 ADA SWREG STA CN3 LDA MRSET MASTER RESET WORD CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 FLAG IS SET ONLY IF 12966 CARD JMP CNFG0 SYSTEM CONSOLE USES DVR00 * SYSTEM CONSOLE USES DVR05 TYPE DRIVER LDA EQTA ADDRESS OF FIRST EQT ENTRY ADA D30 ADDRESS OF DVR05 (3RD) EQT ENTRY STA SYSTY CHANGE SYSTEM TTY EQT TO POINT TO EQT#3 * CHANGE DRT ENTRIES TO HAVE LU 1 POINT TO EQT #3 LDA DRT,I AND .3700 ADA D3 EQT# 3 IN IST ENTRY OF DRT STA DRT,I LDB DRT ADB D8 POINT TO LU 9 LDA B,I AND .1777 INA POINT LU 9 TO EQT # 1 STA B,I * LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR00 DEVICE ADA .15 STA .15,I JMP CNFG1 CNFG0 LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR05 DEVICE ADA .12 STA .12,I CNFG1 JSB SCHNG CHANGE SELECT CODE ENTRIES IN EQT & INT TABLE DEF SWREG DEF SYSTY,I JSB INTON TTY CONFIGURED - TURN ON ALL INTERRUPTS CNFG2 JSB WRITE DISK BACKUP UTILITY DEF MSG1 DEF D10 JSB QTASK QUESTION TASBùþúK TO BE DONE LDA TASK CPA D1 TASK=RESTOR? JMP CNFG3 YES, JUMP SZA,RSS TASK=SAVE? JMP CNFG3 YES ISZ MTRCN SET FLAG TO INDICATE MT NOT RECONFIGURED JMP CNFIG,I CONFIGURATION DONE * *TASK IS EITHER SAVE OR RESTORE *CONFIGURE MAG TAPE CHANNEL * CNFG3 JSB QCHNL DEF MSG14 MT CHANNEL #? DEF D9 LDA CHANL MT CHANNEL # STA MCHNL LDA EQTA BEGINNING OF EQT TABLES ADA D15 STA EQTAD ADDR OF EQT ENTRY FOR MT JSB $LIBR TURN OFF INTERRUPTS AND MEM PROTECT FENCE NOP CLF 0 JSB SCHNG CONFIGURE NEW MT CHANNEL BY CHANGING SC # DEF MCHNL IN EQT TABLE AND INTERRUPT TABLE ENTRIES DEF EQTAD,I JSB INTON TURN ON ALL INTERRUPTS, ETC. LDA MTRCN ONLY MT HAD TO BE CONFIGURED? SZA,RSS JMP CNFIG,I NO, THEN RETURN CLA YES, THEN CLEAR MTRCN FLAG STA MTRCN * JMP CNFIG,I RETURN * INTAD DEF INTA INTERRUPT TABLE ADDRESS INTA EQU LABEL INTERRUPT TABLE ENTRIES .15 OCT 15 PRE CONFIGURED SELECT CODE OF CONSOLE .12 OCT 12 .23 OCT 23 .24 OCT 24 MRSET OCT 150077 MASTER RESET WORD FOR CONSOLE .3700 OCT 3700 DRT EQU 1652B DEVICE REFERENCE TABLE SWREG NOP EQTAD NOP ADDRESS OF A EQT ENTRY MCHNL NOP MAG TAPE CHANNEL # INTBA EQU 1654B INTERRUPT TABLE ADDRESS IN SYSTEM INTLG EQU 1655B LENGTH OF INTERRUPT TABLE EQTA EQU 1650B ADDR OF EQT TABLE ENTRIES SYSTY EQU 1675B * * * INTON - ROUTINE TO TURN ON INTERRUPTS AND MEMORY PROTECT FENCE * CALLING SEQUENCE: JSB INTON * * INTON NOP JSB $LIBX LIBRARY ROUTINE TO TURN ON INTERRUPTS DEF INTON RETURNS TO LOCATION AFTER JSB INTON INSTRUCTION * * * INT0N - ROUTINE TO TURN ON INTERRUPTS AND CLEAR FLAG FOR * 7900 DISC CHANNEL * CALLING SEQUENCE: JSB INT0N * * INT0N NOP DSK70 CLF 1 ì˜þú CLC 6 JSB $LIBX TURN ON INTERRUPTS DEF INT0N RETURN * * INT5N - ROUTINE TO TURN ON ALL INTERRUPTS AND MEMORY PROTECT * FENCE * CALLING SEQEUNCE: JSB INT5N * * INT5N NOP DSK71 CLF 1 CLC 6 JSB $LIBX LIBRARY ROUTINE TO TURN ON INTERRUPTS DEF INT5N RETURN TO LOCATION AFTER JSB INTON * * *SCHNG - ROUTINE TO CHANGE SC# ENTRIES IN EQT & INTERRUPT TABLE *CALLING SEQUENCE - JSB SCHNG * DEF SC# NEW SELECT CODE # * DEF EQTAD ADDRESS OF EQT TABLE ENTRY * WHERE CHANGE IS TO BE MADE * SCHNG NOP LDA SCHNG,I BRING IN NEW SELECT CODE # LDA A,I STA NEWSC ISZ SCHNG LDA SCHNG,I ADDRESS OF EQT ENTRY JSB RMOVI REMOVE ANY INDIRECTS STA EQTAD STA B VALUE RETURNED IN A REG ADB D3 LDA B,I CONTENTS OF WORD 4 OF EQT TABLE AND .77 STA OLDSC PRE CONFIGURED SC FOR DEVICE LDA B,I AND .1777 ZERO OUT OLD SC ADA NEWSC INSERT NEW SC IN SLOT STA B,I REPLACE WORD 4 OF EQT TABLE CLA STA TEMP LDA INTAD CHECK IF OLD SC CONTROLLER TOOK UP 2 I/O SLOTS ADA OLDSC ADA N6 INA POINT TO OLDSC+1 ENTRY IN INTERRUPT TABLE LDA A,I GET EQTAD FROM IT CPA EQTAD ISZ TEMP OLDSC CONTROLLER DOES TAKE UP 2 I/O SLOTS LDA INTBA CLEAR ENTRY IN INT TABLE FOR OLD CHANNEL ADA OLDSC ADA N6 LDB A,I GET CONTENTS OF INTERRUPT TABLE AT OLDSC CPB EQTAD IS IT SAME AS THIS EQT ENTRY? RSS YES, THEN CLEAR IT JMP SCHN5 NO, THEN DO NOT CLEAR LDB CLF ADB OLDSC STB OLDSC,I STORE CLF INSTR IN TRAP CELL CLB CLEAR INT TABLE ENTRY CORRESPONDING TO OLDSC STB A,I SCHN5 LDB TEMP TWO ENTRIES TO BE GIVEN NEW EQTAD? SZB,RSS Ò“þúJMP SCHN1 NO INA YES LDB A,I ANY OTHER DEVICE ASSIGNED TO THIS SC? CPB EQTAD RSS NO, CLEAR CONTENTS OF OLDSC IN INTERRUPT TABLE JMP SCHN1 YES, SET UP NEW SELECT CODE ENTRIES LDB CLF INSERT CLF INSTR IN NEXT ENTRY ADB OLDSC INB ISZ OLDSC STB OLDSC,I CLB CLEAR CORRESPONDING INT TABLE ENTRY STB A,I SCHN1 LDA INTBA CHANGE NEW SC SLOT IN INT TABLE TO POINT ADA NEWSC TO EQT ENTRY ADA N6 LDB EQTAD STB A,I LDB JSBCI STORE JSB CIC,I INSTR IN TRAP CELL STB NEWSC,I CORRESPONDING TO NEWSC LDB TEMP CONTROLLER NEEDS 2 I/O CHANNELS? SZB,RSS JMP RSCHN NO RETURN INA YES CHANGE NEXT ENTRY LDB EQTAD STB A,I LDB JSBCI JSB CIC,I INSTR IN NEWSC+1 TRAP CELL ISZ NEWSC STB NEWSC,I * RSCHN ISZ SCHNG RETURN JMP SCHNG,I * OLDSC NOP NEWSC NOP DCHNL NOP SCHNL NOP .77 OCT 77 * * QCHNL - ROUTINE TO FIND CHANNEL # FOR GIVEN UNIT & TEST IF IT IS * BETWEEN 10-77 OCTAL * CALLING SEQUENCE - JSB QCHNL * DEF MSGX MESG ADDR TO ASK USER FOR CHANNEL # * DEF DN # OF WORDS IN MESSAGE * * QCHNL NOP LDA QCHNL,I STA TEMP1 ADDR OF MESSAGE ISZ QCHNL LDB QCHNL,I ADDR OF MESSAGE LENGTH LDB B,I MESS LENGTH STB TEMP2 JSB QUERY DEF TEMP1,I XXXX CHANNEL #? DEF TEMP2 LENGTH OF MESSAGE DEF EXP4 REPLY OCTAL 10 TO 77 DEF D10 LENGTH OF EXPLNAITON JSB GINIT CONVERT ASCII TO OCTAL LDA D2 2 CHARACTERS TO BE CONVERTED JSB GETOC CONVERT 2 CHARACTERS FROM RDBUF JMP EXPL ERROR RETURN STA CHANL OCTAL VALUE RETURNED IN A REG LDB CHANL ADB .N10 ADD -10B SSB LESS THAN 10B? †þúJMP EXPL YES, EXPLAIN RESPONSE AND ASK AGAIN LDB CHANL ADB .N100 SSB,RSS CHANNEL# > 77B? JMP EXPL YES, EXPLAIN AGAIN ISZ QCHNL JMP QCHNL,I RETURN * CHANL NOP .N10 OCT -10 .N100 OCT -100 * * * QDISC - ROUTINE TO QUERY DISC FEATURES AND CONFIGURE IT * CALLING SEQUENCE : JSB QDISC * QDISC NOP CLA STA IFLAG LDA TASK TASK? CPA D1 RESTORE? JMP DESTN YES DLD SORCE SET UP MESSAGE TO SAY DST MSG4 SOURCE DISC CHANNEL #? DST MSG21 SOURCE DISC DRIVE#? LDA SORCE+2 STA MSG4+2 STA MSG21+2 JSB QCHNL SOURCE DISC CHANNEL #? DEF MSG4 DEF D11 JSB QDUTP SOURCE DISC TYPE? DEF MSG5 DEF D9 DEF MSG21 AND UNIT #? DEF D10 LDA DTYPE STA SDTYP SOURCE DISC TYPE LDA DUNIT STA SUNIT SOURCE UNIT # LDA CHANL STA SCHNL SOURCE DISC CHANNEL # JSB DCNFG CONFIGURE SOURCE DISC * * FIND TYPE OF SAVE OR COPY * QDSC5 LDA TASK SZA TASK? JMP QDSC3 TASK IS COPY DLD SAVE SET UP MESG TO SAY TYPE OF SAVE? JMP QDSC4 QDSC3 DLD COPY SET UP MESSAGE TO SAY 'TYPE OF COPY?' QDSC4 DST MSG3+4 JSB QUERY DEF MSG3 TYPE OF COPY? DEF D7 DEF EXP3 REPLIES ARE: UN,FR DEF D9 LDB RBUF CPB UN JMP QDSC6 UNIT COPY CPB FR RSS JMP EXPL ERRONEOUS REPLY - EXPLAIN AND ASK AGAIN LDA D3 FROM-TO COPY RSS QDSC6 LDA D2 UNIT COPY STA COTYP LDB SDTYP SOURCE DISC TYPE? CPB D7900 7900? RSS YES JMP QDSC2 NO CPA D3 FROM-TO COPY? JMP FRMTO YES JMP TMT01 NO, UNIT COPY, BUILD 7900 TRACK MAP TABLE * * DISC IS 7905 OR 7920 QDSC2 LDB SUNIT FIND DISC TYPE BY PULLIN–þúG STATUS JSB STAT5 STA SDTYP GET DISC TYPE JSB MSINS CONFIGURE EXPL MESGS FOR DISC TYPE JSB QUERY FIND SYSTEM TYPE DEF MSG7 RTE OR DOS DISC? DEF D8 DEF EXP7 REPLIES ARE: RT,DO DEF D9 LDB RBUF CPB RT JMP QDSC1 RTE DISC CPB DO JMP DOS DOS DOSC JMP EXPL EXPLAIN AND ASK AGAIN QDSC1 CLA SYSTEM TYPE=0 FOR RTE STA SYSTP LDA COTYP COPY TYPE? CPA D3 FROM-TO COPY? JMP FRMTO YES JSB QUERY YES, RTE DISC DEF MSG6 WANT TRACK SPARING? DEF D10 DEF EXP6 REPLY YES OR NO DEF D10 LDB RBUF CPB YE JMP TRKSP YES, ASK FOR TRACK MAP INFO FOR SOURCE DISC UNIT * TRACK MAP INFO ( DEFAULT ) FOR UNIT COPY CLA,INA STA AMAP1,I # OF SUBCHANNELS IS 1 LDA AUNIT ADDR OF START OF TRCK MAP TBL LIST LDB SDTYP SOURCE DISC TYPE? CPB D7905 7905A? JMP QMOVE YES, THEN MOVE INTO ATB32 CPB D7906 7906? ADA D3 YES, TRCK MAP TBL STARTS AT AUNIT+3 CPB D7920 7920? ADA D6 YES,TRCK MAP TBL STARTS AT AUNIT+6 CPB D7925 ADA D9 QMOVE LDB ATB32 JSB .MVW MOVE 3 WORDS FOR TRCK MAP TABLE DEF D3 NOP JMP RQDSC RETURN * * TRACK MAP INFORMATION * * TRKSP CLA STA SYSTP JSB WRITE SEND MESSAGE TO TTY DEF MSG8 ENTER FOLL. TM INFO. FOR SOURCE UNIT ONLY DEF D28 JSB DSETU BUILD TRACK MAP TABLE FOR 7905 SOURCE DISC UNIT JMP RQDSC RETURN * DOS LDA D1 STA SYSTP SYSTP=1 FOR DOS SYSTEM LDA COTYP COPY TYPE? CPA D3 FROM-TO COPY? JMP FRMTO YES ****ENTER TRACK MAP INFO FOR DOS DISC JSB QUERY DEF MSG32 # OF SUBCHNLS TO BE COPIED? DEF D14 DEF EXP32 REPLY 1 TO 3 DEF D6 é!þúJSB CVTST CONVERT # OF SUBCHNLS TO DECIMAL & TEST DEF D1 ITS VALIDITY DEF NSUB DEF N4 LDA NSUB NSUB HAS # OF SUBCHNLS SZA,RSS JMP EXPL IT IS 0, EXPLAIN AND ASK AGAIN ALS MULTIPLY BY 2 ADA NSUB A REG HAS NSUB*3 INA STA TEMP TEMP HAS # WORDS TO BE MOVED IN TMT LDB NSUB CMB,INB MAKE #SBCHNLS -VE TO INDICATE LDA ADOSM TRACK SPARING IS DESIRED STB A,I # OF SUBCHNLS ENTERED IN TRCK MAP TBL LDB ATB32 ADDRESS OF BEGINNING OF $TB32 ADB N1 TRACK MAP TABLE JSB .MVW MOVE TEMP # WORDS FROM DOS MAP TO $TB32 DEF TEMP NOP JMP RQDSC RETURN * *FROM-TO COPY TO BE MADE * FRMTO LDA D3 STA COTYP COPY TYPE IS 3 LDA SDTYP CPA D7900 DISC TYPE 7900? JMP FRMT1 YES LDA IFLAG DOING DEST DISC QUERY? SZA,RSS JMP FRMT7 NO JSB QUERY YES DEF MSG9B TO CYLINDER#? DEF D7 DEF EXP9 REPLY 0 TO 410 (OR 821) DEF D7 JMP FRMT6 FRMT7 JSB QUERY DISC IS 7905 DEF MSG9 FROM CYLINDER #? DEF D8 DEF EXP9 REPLY 0 TO 410 (OR 821) DEF D7 FRMT6 JSB CVTST DEF D2 DEF FCYL CONVERT AND TEST CYLINDER # DEF C1 LDA IFLAG SZA DO NOT DO FOLLOWING IF QUERYING FOR DEST DISC JMP FRMT5 FOR FROM - TO COPY LDA SYSTP SZA RTE DISC? JMP FRDOS NO DOS DISC JSB QUERY DEF MSG10 # OF TRACKS? DEF D6 DEF EXP10 REPLY 1 TO 1233(OR 4111) DEF D8 JSB CVTST CONVERT AND TEST IF # OF TRACKS IS BET 0-1233 DEF D2 DEF NTRCK # OF TRACKS DEF C2 LDA NTRCK SZA,RSS = 0? JMP EXPL YES EXPLAIN AND ASK AGAIN JMP FRMT5 FRDOS JSB QUERY DEF MSG10 # OF TRACKS? DEF Ç‚þúD6 DEF EX10B REPLY 1 TO 200 DEF D7 JSB CVTST CONVERT AND TEST DEF D2 DEF NTRCK DEF N201 LDA NTRCK SZA,RSS # OF TRACKS = 0? JMP EXPL YES, EXPLAIN AND ASK AGAIN ALS NTRCK*2 STA NTRCK FRMT5 JSB QUERY DEF MSG11 NUMBER OF SURFACES? DEF D7 DEF EXP11 REPLY 1 TO 3(OR 5) DEF D6 JSB CVTST CONVER AND TEST DEF D1 DEF NSRFC DEF C3 LDA NSRFC SZA,RSS # OF SURFACES = 0? JMP EXPL YES, EXPLAIN AND ASK AGAIN JSB QUERY DEF MSG12 STARTING HEAD#? DEF D8 DEF EXP12 REPLY 0 TO 2(OR 4) DEF D6 JSB CVTST CONVERT AND TEST DEF D1 DEF STRTH STARTING HEAD DEF C4 * BUILD TRACK MAP TABLE FOR FROM-TO COPY LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA JMP FRM15 YES LDB ATB32 NO ADB N1 RSS FRM15 LDB AFRMP ADDRESS OF TMT FOR DEST SUBCHNL FOR FR-TO COPY LDA D1 STA B,I INB LDA FCYL STA B,I FROM CYLINDER STORED IN TMT LDA NSRFC # OF SURFACES ALF ROTATE TO BRING THEM TO BIT 3 ADA STRTH ADD STARTING HEAD# ALF,ALF NOW BITS 12-15 IS # SURFACES,BITS 8-11 HEAD# ADA DUNIT BITS 0-3 UNIT # INB STA B,I STORE INTO TRACK MAP TABLE LDA NTRCK # OF TRCKS INB STA B,I STORE IN TMT JMP RQDSC RETURN * * DISC IS 7900 FRMT1 LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP FRM20 NO JSB QUERY YES DEF MSG9C TO TRACK#? DEF D5 DEF EXP9A REPLY O TO 202 DEF D7 JMP FRM21 * FRM20 JSB QUERY DEF MSG9A FROM TRACK #? DEF D7 DEF EXP9A REPLY 0 TO 202 DEF D7 FRM21 JSB CVTST CONVERT AND TEST DEF D2 DEF FT2£þúRCK DEF N203 FRMT2 LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP FRM10 NO LDB ATB31 YES, THEN FIND # OF TRACKS READ FROM SOURCE DISC ADB D8 LDA B,I SZA IS IT 0 FOR SUBCHNL 0? JMP FRM12 NO, THEN THIS IS IT INB YES , THEN SUBHNL 1 MUST BE THE RIGHT ONE LDA B,I FRM12 STA NTRCK JMP FRM11 TEST IF LAST TRACK IS WITHIN BOUNDS FRM10 JSB QUERY DEF MSG10 # OF TRACKS DEF D6 DEF EX10A REPLY 1 TO (203-FROM TRACK#) DEF D14 JSB CVTST CONVER AND TEST IF # TRCKS IS BET 0 AND 203 DEF D2 DEF NTRCK DEF N204 LDA NTRCK SZA,RSS = 0? JMP EXPL YES EXPLAIN AND TRY AGAIN FRM11 ADA FTRCK TEST IF LAST TRACK TOO LARGE ADA N204 SSA JMP FRMT3 LST TRCK IS WITHIN BOUNDS JSB WRITE DEF ERR5 LAST TRACK TOO LARGE DEF D10 LDA IFLAG SZA JMP FRMT1 QUERYING DEST DISC FOR FROM-TO COPY JMP FRMT2 ASK QUESTION AGAIN FRMT3 JSB QUERY DEF MSG13 PLATTER #? DEF D5 DEF EXP13 REPLIES ARE: 0,1 (0-FIXED,1-REMOVABLE) DEF D19 JSB GINIT CONVERT TO DECIMAL LDA N2 -VE CHARACTER COUNT FOR CONVERSION TO DECIMAL JSB GETOC JMP EXPL ERROR RETURN LDB IFLAG SZB,RSS QUERYING DEST DISC FOR FRM-TO COPY? JMP FRM25 NO STA DPLTR DEST PLATR # FOR FROM TO COPY STA DSUB# DEST SUB# FOR FROM-TO COPY SZA TEST IT CPA D1 JMP RQDSC RETURN BECAUSE IT IS 0 OR 1 JMP EXPL ERROR TRY AGAIN FRM25 STA PLATR SZA,RSS 0? JMP TMT00 YES CPA D1 = 1? JMP TMT00 YES JMP EXPL EXPLAIN AND ASK AGAIN * CONSTRUCT TRACK MAP TABLE FOR 7900 FROM-TO OR UNIT COPY TMT01 LDA D203 # OF TRACKS FOR UNIT COPY ST½þúA NTRCK CLA FIRST TRACK FOR UNIT COPY IS 0 STA FTRCK STA SUB# FIRST SUBCHNL FOR UNIT COPY IS 0 STA PLATR JMP TMT03 TMT00 LDA PLATR SUB# FOR FROM-TO COPY STA SUB# TMT03 CLA CLEAR TMT LDB ATB31 STA B,I INB STA B,I ADB D7 STA B,I INB STA B,I TMT02 LDA ATB31 ADA SUB# POINT TO 0 OR 1 SUBCHNL PART IN TMT LDB FTRCK FIRST TRACK STB A,I STORE IN TMT ADA D8 LDB NTRCK STB A,I STORE # OF TRACKS LDA SUB# SZA SUB# = 1? JMP RQDSC YES, THEN DONE LDA COTYP NO, THEN UNIT COPY? CPA D2 RSS JMP RQDSC NO, RETURN ISZ SUB# YES, MAKE ENTRIES FOR NEXT SUBCHNL JMP TMT02 * * IF TASK IS SAVE-RETURN, IF TASK IS COPY WORK ON DEST SBCHNL * RQDSC LDA IFLAG WAS QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP RQDS1 NO CLA YES THEN CLEAR FLAG STA IFLAG JMP QDISC,I RETURN RQDS1 LDA TASK SZA,RSS SAVE? JMP QDISC,I YES - RETURN * DESTN DLD DEST SET UP MESSAGE TO SHOW DST MSG4 'DEST DISC CHANNEL#?' DST MSG21 'DEST DISC DRIVE#?' LDA DEST+2 STA MSG4+2 STA MSG21+2 LDA TASK CPA D2 TASK IS COPY? JMP DEST2 YES, THEN DONT QUERY DEST DISC CHANL # JSB QCHNL WORK ON DESTINATION DISC DEF MSG4 DEST DISC CHANNEL#? DEF D11 LDA CHANL STA DCHNL JSB DCNFG CONFIGURE DEST DISC CHANNEL DEST2 JSB QUNIT QUERY DEST DISC TYPE AND UNIT # DEF MSG21 QUERY DEST DISC UNIT # DEF D10 LDA DTYPE DISC TYPE IS 7900? CPA D7900 JMP DEST3 YES, THEN DO NOT GET STATUS LDB DUNIT DESTINATION DISC UNIT# JSB STAT5 FIND DEST DISC TYPE STA DTYPE JSB MSINS CONFIGURÎþúE EXPL MESSAGES DEST3 LDA COTYP CPA D3 FROM - TO COPY? RSS JMP QDISC,I RETURN CLA,INA YES STA IFLAG SET IFLAG TO INDICATE QUERYING DEST DISC JMP FRMTO FOR FROM TO COPY * PLATR DEC 0 DPLTR NOP DSUB# NOP NTRCK NOP FTRCK NOP FCYL NOP STRTH NOP NSRFC NOP COTYP NOP DO ASC 1,DO RT ASC 1,RT UN ASC 1,UN FR ASC 1,FR D203 DEC 203 N201 DEC -201 N203 DEC -203 N204 DEC -204 AUNIT DEF *+1 DEC 0 OCT 30000 DEC 1233 * DEC 0 .4000 OCT 40000 DEC 1644 * DEC 0 OCT 50000 DEC 4115 * DEC 0 OCT 110000 DEC 7407 * FRMAP BSS 4 AFRMP DEF FRMAP DOSMP DEC -3 DEC 0 M0100 OCT 10000 D400 DEC 400 DEC 0 OCT 10400 DEC 400 DEC 0 OCT 11000 DEC 400 ADOSM DEF DOSMP * * * STAT5 - ROUTINE TO PULL STATUS FOR SOURCE 7905,7905B OR 7920 * SOURCE UNIT & DETERMINE DISC TYPE FROM BITS 9-12 OF * STATUS WORD 2 * BITS 9-12 = 0 THEN 7905B * = 1 THEN 7920 * = 2 * = 3 7925A * CALLING SEQUENCE: JSB STAT5 * B REG = SOURCE UNIT # * RETURNS: A REG = SOURCE DISC TYPE * * STAT5 NOP LDA STACC CONFIGURE STATUS REQUEST COMMAND AND .1777 CLEAR BITS 0-5 ADA B ADD SOURCE UNIT # STA STACC ST5T2 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 JSB STATW ROUTINE TO BRING STATUS JSB INT5N CPB .1002 DISC NOT READY? JMP ST5T1 YES, THEN SEND MESSAGE LSL 3 B REG HAS STATUS WORD 2 CLA BRING BITS 9-12 OF B REG INTO A REG RRL 4 A REG HAS SOURCE DISC TYPE JMP STAT5,I RETURN ST5T1 JSB WRITE SEND 'READY DISC ' MESSAGE DEF MS4 DEF D5 JSB PAUSE JMP ST5T2 TRY AGAIN * .1002 OCT 100002 * * îYþú * MSINS - ROUTINE TO MOVE APPROPRIATE BOUNDARY PARAMETERS * INTO A COMMON BUFFER AREA FOR 7905A,7905B OR * 7920 DISCS. ROUTINE CONFIGURES EXPANATION * MESSAGES FOR THESE PARAMETERS * CALLING SEQUNCE: JSB MSINS * A REG = DISC TYPE * * MSINS NOP LDB TST05 START OF PARAMETER LIST CPA D7906 A REG HAS DISC TYPE ADB D10 7905B DISC,PARM LIST IS TST05+10 CPA D7920 7920? ADB D20 YES,PARM LIST IS TST05+20 CPA D7925 ADB D30 LDA B TRANSFER SOURCE ADDRESS INTO A REG LDB AJB DESTINATION ADDRESS JSB .MVW MOVE 10 WORD PARAMETER LIST DEF D10 NOP DLD C5 SET UP EXLANATION MESSAGES DST EXP9+5 DST EXMS3+11 DLD C6 DST EXP10+6 DST EXMS3+6 LDA C7 STA EXP12+5 STA EXMS3+16 LDA C8 STA EXP11+5 STA EXMS3+20 JMP MSINS,I RETURN * * * QDUTP - ROUTINE TO QUERY DISC TYPE & DISC DRIVE (UNIT) # * AND TEST BOTH VALUES * CALLING SEQUENCE: JSB QDUTP * DEF MSGX MESSAGE TO ASK FOR DISC TYPE * DEF DX LENGTH OF MESSAGE * DEF MSGY MESSAGE TO ASK FOR DISC DRIVE # * DEF DY LENGTH OF MESSAGE * RETURNS: DISC TYPE IN DTYPE & DISC DRIVE # IN DUNIT * * QDUTP NOP LDA D96 INIT #SECT TO 96 STA #SECT LDA D6144 STA TKSIZ LDA QDUTP,I FETCH MESG ADDR TO QUERY DISC TYPE STA TEMP1 ISZ QDUTP LDA QDUTP,I FETCH MESG LENGTH LDA A,I ACTUAL VALUE IN A REG STA TEMP2 JSB QUERY DEF TEMP1,I XXXX DISC TYPE? DEF TEMP2 DEF EXP5 REPLIES ARE:7900,7905,7906,7920,7925 DEF D19 JSB GINIT CONVERT DISC TYPE FROM ASCII TO INTEGER LDA N4 JSB GETOC CONVERT JMP EXPL ERROR RETURN STA DTYPE zþú CPA D7900 7900 DISC? JMP QDUT1 YES FIND DRIVE # CPA A7905 7905? JMP QDUT1 YES CPA A7906 7906? JMP QDUT1 YES CPA A7925 7925? JMP #7925 CPA A7920 7920? JMP QDUT1 JMP EXPL NO, EXPLAIN AND ASK AGAIN * #7925 LDA D128 STA #SECT LDA D8192 STA TKSIZ * FIND UNIT # FOR DISC QDUT1 ISZ QDUTP FETCH NEXT TWO PARAMETERS JMP QUNT1 QUNIT NOP 2ND ENTRY POINT TO FIND UNIT # ONLY LDA QUNIT SET UP RETURN ADDRESS STA QDUTP QUNT1 LDA QDUTP,I STA TEMP1 MESG ADDR TO ASK FOR DISC DRIVE# ISZ QDUTP LDA QDUTP,I LDA A,I MESG LENGTH IN A REG STA TEMP2 LDA DTYPE DISC TYPE? CPA D7900 7900? RSS JMP QUNT2 NO 7905 OR 7920 * QUERY FOR 7900 DISC UNIT# JSB QUERY DEF TEMP1,I XXXXX DISC DRIVE#? DEF TEMP2 DEF EX21A REPLY 0 TO 3 DEF D6 JSB CVTST CONVERT AND TEST FOR VALIDITY OF RESPONSE DEF D1 DEF DUNIT IS UNIT# < 4 & >= 0? DEF N4 JMP RQDUT RETURN * QUERY FOR 7905 DISC UNIT# QUNT2 JSB QUERY DEF TEMP1,I UNIT#? DEF TEMP2 DEF EXP21 REPLY 0 TO 7 DEF D6 JSB CVTST CONVERT UNIT# FROM ASCII TO DECIMAL DEF D1 AND TEST IF < 8 & >= 0 DEF DUNIT DEF N8 * RETURN RQDUT ISZ QDUTP JMP QDUTP,I RETURN * DTYPE NOP SDTYP NOP N8 DEC -8 D7900 DEC 7900 D7905 DEC 2 D7920 DEC 1 D7906 DEC 0 D7925 DEC 3 A7905 DEC 7905 A7920 DEC 7920 A7906 DEC 7906 A7925 DEC 7925 * * * QTASK - ROUTINE TO FIND TASK TO BE PERFORMED * * QTASK NOP CLA STA TASK INITIALIZE TASK TO 0 JSB QUERY DEF MSG2 TASK? DEF D3 DEF EXP2 REPLIES ARE: SAVE,RESTORE,COPY DEF D13 LDA RBUF CPA SA TASK IS SAVE? JMP QTASK,I 0þúYES, TASK=0 FOR SAVE CPA RE RESTORE? JMP QRSTR YES CPA RW JMP $REW CPA CO COPY? RSS JMP EXPL NO, EXPLAIN AND ASK AGAIN LDA D2 TASK = 2 FOR COPY STA TASK RSS QRSTR ISZ TASK TASK=1 FOR RESTORE JMP QTASK,I RETURN * $REW JSB REWND JMP QTASK+1 TASK DEC 0 SA ASC 1,SA RE ASC 1,RE CO ASC 1,CO RW ASC 1,RW * * * DCNFG - ROUTINE TO CONFIGURE DISC CHANNEL * * DCNFG NOP LDA DTYPE DISC TYPE? CPA D7900 7900? RSS JMP C7905 NO * CONFIGURE 7900 DISC LDA I#OTC END OF INSTRUCTION LIST LDB LST1 BEGINNING OF INSTRUCTION LIST JSB DCHCN CONFIGURE DATA CHANNEL ISZ CHANL CONFIGURE COMMAND CHANNEL LDA I#OTE LDB LST2 BEG OF INST LIST JSB DCHCN JMP DCNFG,I RETURN * CONFIGURE 7905 DISC C7905 LDA I/OTC END OF INST LIST LDB LST3 BEG OF INST LIST JSB DCHCN JMP DCNFG,I RETURN * * * POSN - ROUTINE TO POSITION MAG TAPE AT DESIRED FILE# BET 1-8 * CALLING SEQUENCE: JSB POSN * * POSN NOP LDA FILEN FILEN IS 0? SZA JMP POSN2 NO THEN POSITION TO FILE# IN FILEN POSN1 JSB QUERY DEF MSG16 MT FILE#? DEF D5 DEF EXP16 REPLY 1 TO 8 DEF D6 JSB CVTST DEF D1 CONVERT FILE# FROM ASCII TO DECIMAL DEF FILEN AND TEST IF 0FILEN > 0 & <= 8 DEF N9 LDA FILEN FILEN=0? SZA,RSS ISZ FILEN YES, DEFAULT = 1 * REWIND MAG TAPE POSN4 JSB MTNR MAG TAPE READY? JSB REWND REWIND MAG TAPE * POSITION MAG TAPE LDA FILEN CPA D1 IF FILEN=1, THEN ALREADY POSITIONED JMP POSN,I SO RETURN ADA N1 # OF EOF MARKS TO BE FOUND CMA,INA NEGATE VALUE STA PTEMP LOOPF LDA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQ õ$þúADA .600 STA TEMP1 JSB EXEC DEF *+3 DEF D3 DEF TEMP1 SLA IS MAG TAPE STILL REWINDING? JMP LOOPF YES, THEN WAIT FOR IT TO COMPLETE LDA D3 SET UP REQUEST CODE SO THAT ERRORS ARE RETURNED ADA MSIGN TO THE UTILITY PROGRAM STA TEMP1 LDA MTLU SET UP CONTROL WORD FOR FORWARD SPACE I FILE CMND ADA .1300 STA TEMP2 JSB EXEC DEF *+3 DEF TEMP1 DEF TEMP2 FORWARD SPACE 1 FILE JMP ERPOS ERROR RETURN LDA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQUEST ADA .600 STA TEMP1 JSB EXEC DEF *+3 DEF D3 EOT SEEN? DEF TEMP1 AND .40 EOT BIT = 1 IN STATUS WORD? CPA .40 JMP ERPOS YES ERROR - FILE NOT FOUND ISZ PTEMP NO NEXT FILE TO BE FORWARDED? JMP LOOPF YES JMP POSN,I NO - MT IS POSITIONED - RETURN * POSN2 LDA SVTPN WAS LAST TAPE# = 1? CPA D1 RSS YES, THEN BACKSPACE TO THIS FILE JMP POSN4 NO, THEN POSITION FROM BEGINING OF TAPE LDA FILEN JUST WANT TO BACKSPACE TO BEGINING OF THIS FILE CPA D1 IS FILE#=1? JMP POSN3 YES THEN JUST REWIND LDA .200 SET UP FUNCTION WORD FOR ADA MTLU BACK SPACING ONE RECORD (EOF RECORD) STA TEMP1 JSB EXEC BACK SPACE ONE RECORD DEF *+3 DEF D3 DEF TEMP1 LDA .1400 SET UP FUNCTION WORD FOR BACKSPACING 1 FILE ADA MTLU STA TEMP1 JSB EXEC BACK SPACE ONE FILE DEF *+3 DEF D3 DEF TEMP1 LDA .300 SET UP FUNCTION WORD TO FORWARD SPACE ONE RECORD ADA MTLU STA TEMP1 JSB EXEC FORWARD SPACE ONE RECORD (EOF OF PREVIOUS FILE) DEF *+3 DEF D3 DEF TEMP1 JMP POSN,I RETURN POSN3 JSB REWND FILE # = 1 JMP POSN,I RETURN * ERROR - FI£ŠþúLE NOT FOUND ERPOS JSB REWND REWIND MAG TAPE JSB WRITE DEF ERR1 FILE NOT FOUND DEF D7 JMP POSN1 ASK AGAIN * FILEN NOP PTEMP NOP N9 DEC -9 .400 OCT 400 .200 OCT 200 .300 OCT 300 .1400 OCT 1400 * * * REWND - ROUTINE TO REWIND MAG TAPE * CALLING SEQUENCE: JSB REWND * * REWND NOP LDA MTLU ADA .400 SET UP CONTROL WORD FOR REWIND STA TEMP1 JSB EXEC REWIND MAG TAPE DEF *+3 DEF D3 DEF TEMP1 JMP REWND,I RETURN * * * PRNTH - ROUTINE TO READ AND PRINT HEADER RECORD FROM MT FILE * CALLING SEQUENCE: JSB PRNTH * DEF HEADR ADDR OF BUFFER TO HOLD HEADER RECORD * RETURN: TO LOC P IF NORMAL RETURN * TO LOC P+1 OTHERWISE * * PRNTH NOP LDA PRNTH,I STA TEMP ADDR OF BUF FOR HEADER RECORD JSB EXEC DEF *+5 READ HEADER RECORD FROM MAG TAPE DEF D1 DEF MTLU DEF TEMP,I DEF D140 HEADER RECORD IS 140 WORDS LONG JSB WRITE DEF FILID FILE ID: DEF D4 JSB WRITE DEF TEMP,I PRINT TITLE FROM FIRST 36 WORDS OF HEADER DEF D36 LDA TEMP ADA D36 POINT TO TAPE# LDA A,I TAPE # IN A REG STA TEMP SAVE TAPE## JSB DCASC CONVERT TAPE# FROM DECIMAL TO ASCII DEF *+4 DEF TAPE#+4 DEF D1 DEF TEMP JSB WRITE TAPE#: XX DEF TAPE# DEF D5 JSB QUERY DEF OK OK? DEF D2 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF CPA YE IS IT OK? JMP RPRNT YES - NORMAL RETURN TO P ISZ PRNTH NO - RETURN TO P+1 RPRNT ISZ PRNTH JMP PRNTH,I RETURN * FILID ASC 4,FILE ID: TAPE# ASC 5,TAPE#: XX OK ASC 2,OK? * * * PAUSE - ROUTINE TO WAIT FOR USER TO TAKE ACTION ASKED BY * UTILITY AND RESTART UTILITY BY TYPIN 'GO' * CALLING SEQUENCE: JSB PAªþúUSE * * PAUSE NOP JSB WRITE DEF MSG27 RSTRT UTILITY BY ENTERING 'GO' DEF D16 PAUS1 JSB READ READ RESPONSE LDA RBUF CPA GO 'GO'? JMP PAUSE,I YES,RETURN JMP PAUS1 NO, WAIT FOR 'GO' RESPONSE * GO ASC 1,GO * * * QUERY - ROUTINE TO ASK QUESTION, READ RESPONSE, * EXPLAIN IF NECESSARY, AND ASK AGAIN * CALLING SEQUENCE: JSB QUERY * DEF MSG MESSAGE ADDRESS * DEF DN MESSAGE LENGTH * DEF EXP EPLANATION MESSAGE ADDRESS * DEF DN " " LENGTH * RETURNS: RESPONSE IN RBUF * * QUERY NOP QURY1 LDA QUERY LEAVE RETURN ADDRESS IN QUERY STA SAVEQ LDA A,I GET MESSAGE ADDRESS JSB RMOVI REMOVE INDIRECTS STA QTMP1 ISZ SAVEQ LDA SAVEQ,I GET MESSAGE LENGTH STA QTMP2 JSB WRITE WRITE MESSAGE ON USER TTY DEF QTMP1,I ADDR OF MESSAGE AND MESG LENGTH ADDRESSES DEF QTMP2,I ISZ SAVEQ POINT TO EXPLANATIOON MESSAGE PARM JSB READ READ USER RESPONSE FROM TTY LDA RBUF CPA QUES "??"? JMP EXPL YES - USER NEEDS HELP IN ANSWERING LDA QUERY NO - RETURN ADA D4 JMP A,I B REG HAS # OF WORDS IN RESPONSE * EXPLANATION REQUIRED EXPL LDA SAVEQ,I EXPLANATION MESSAGE ADDRESS STA QTMP1 ISZ SAVEQ LDA SAVEQ,I EXPLANATION MESSAGE LENGTH STA QTMP2 JSB WRITE DEF QTMP1,I DEF QTMP2,I JMP QURY1 ASK AGAIN AND READ RESPONSE AGAIN * QUES ASC 1,?? SAVEQ NOP QTMP1 NOP QTMP2 NOP * * * READ - ROUTINE TO READ USER RESPONSE FROM TTY * CALLING SEQUENCE: JSB READ * RETURNS: REPONSE IN RBUF, # OF WORDS IN REPONSE IN B REG * * READ NOP LDA N36 STA RCNT COUNTER LDA SPACE LDB ARBUF ADDRESS OF READ BUFFER STA B,I STORE 0  ÖþúIN RBUF INB ISZ RCNT JMP *-3 JSB EXEC DEF *+5 DEF D1 DEF RITLU ITLU+400B DEF RBUF DEF D36 READ 36 WORDS FROM TTY LDA RBUF CPA AB USER WANTS TO ABORT PROGRAM? JMP EXITU YES JMP READ,I NO - RETURN * RBUF EQU LABEL+90 ARBUF DEF RBUF RITLU OCT 401 AB ASC 1,AB SPACE ASC 1, N36 DEC -36 RCNT NOP * * * WRITE - ROUTINE TO WRITE MESSAGES ON TTY * CALLING SEQUENCE: JSB WRITE * DEF MSG MESSAGE * DEF DN LENGTH OF MESSAGE * * WRITE NOP LDA WRITE,I GET FIRST PARAMETER-MESSAGE ADDR JSB RMOVI STA WTMP1 ISZ WRITE LDA WRITE,I GET 2ND PARAMETER-MESSAGE LENGTH JSB RMOVI STA WTMP2 JSB EXEC WRITE MESSAGE ON TTY DEF *+5 DEF D2 DEF ITLU DEF WTMP1,I MESSAGE DEF WTMP2,I MESSAGE LENGTH ISZ WRITE RETURN ADDRESS JMP WRITE,I RETURN * WTMP1 NOP WTMP2 NOP * * * CVTST - ROUTINE TO CONVERT ASCII TO DECIMAL AND TEST IF VALUE * IS >= 0 & <= UPPER LIMIT SUPPLIED BY CALLING ROUTINE * CALLING SEQUENCE: JSB CVTST * DEF # OF CHARACTERS IN BUFFER TO BE CONVERTED * DEF VARIABLE HOLD CONVERTED DEC VALUE * DEF -(UPPER LIMIT+1) * * CVTST NOP LDA CVTST,I FETCH ADDR OF FIRST PARAMETER LDA A,I # OF CHAR IN BUF TO BE CONVERTED STA NCHAR JSB GINIT CONVERT ASCII TO DECIMAL LDA NCHAR ALS A REG HAS # OF CHARACTERS TO BE CONVERTED CMA,INA -VE FOR DECIMAL CONVERSION JSB GETOC CONVERT JMP EXPL ERROR RETURN STA NUMBR DECIMAL #, NOW TEST IT ISZ CVTST GET ADDRESS OF SECOND PARRAMETER LDB CVTST,I ADDR OF SECOND PARAMETER STA B,I STORE DEC VALUE IN 2ND PARAMETER SSA CONVERTED VALUE < 0? êîþú JMP EXPL YES, EXPLAIN AND ASK FOR RESPONSE AGAIN ISZ CVTST LDB CVTST,I ADDR OF 3RD PARAMETER LDB B,I -(UPPER LIMIT+1) ADA B VALUE > UPPER LIMIT? SSA,RSS JMP EXPL YES, EXPLAIN AND ASK AGAIN ISZ CVTST JMP CVTST,I RETURN * NCHAR NOP NUMBR NOP * * * V6144 - ROUTINE TO DETERMINE IF SIZE OF PHYSICAL MEMORY IS LARGE * ENOUGH TO ENABLE VERIFY WITH 6144 WORD BUFFER SIZE * CALLING SEQUENCE: JSB V6144 * RETURN: A REG = 0 IF 6144 WORD BUF VERFIFY NOT POSSIBLE * =1 OTHERWISE * * V6144 NOP JSB $LIBR TURN OFF ALL INTERRUPTS NOP AND MEMORY PROTECT FENCE CLF 0 LDA LWA24 CHANGE LWA MEM OF BG PART IN BASE PAGE STA BGLWA TO INDICATE BG PART SIZE IS 24K LDA PATRN PATTERN OF 177777 TO WRITE IN LOC 57777 LDB LWA24,I SAVE ORIGINAL CONTENTS STA LWA24,I LOC 57677 LDA LWA24,I READ THE CONTENTS OF LOC STB LWA24,I STORE BACK CONTENTS CPA PATRN COMPARE, IF AREG = PATRN THEN MEM SIZE>=24K RSS JMP V2048 MEM NOT LARGE ENOUGH TO HOLD 2 6144 WORD BUFS JSB INTON LEAVE THE BASE PAGE LOC OF BG LWA AT 57777 LDA XEQT ID SEGMENT OF THIS UTILITY JSB COR.A FIND FIRST WORD AVAILABLE OF FREE MEM STA AVBUF ADDR OF 2ND BUF FOR VERIFY IF BUF SIZE=6144 CLA,INA RETURN WITH A REG = 1 JMP V6144,I RETURN * VERIFY NOT POSSIBLE WITH BUFFER SIZE OF 6144 WORDS V2048 LDA LWA16 CHANGE LWA TO 16K STA BGLWA STORE IT IN BASE PAGE LOCATION JSB INTON TURN ON INTERRUPTS AND MEM PROTECT FENCE CLA RETURN WITH A REG = 0 JMP V6144,I RETURN * AVBUF NOP XEQT EQU 1717B LWA24 OCT 57677 LWA OF 24K MEM LWA16 OCT 37677 LWA OF 16K MEM BGLWA EQU 1777B LWA IN BG MEM PATRN OCT 177777 * * * NSPRS - ROUTINE TO FIND # OF SPARES FOR A GIVEN SUBCHANNEL(SUB#) * ÈþúCALLING SEQUENCE: JSB NSPRS * ASSUMED THAT SUB# HAS SUBCHANNEL # * RETURNS: A REG WITH # OF SPARES FOR SUB# * * NSPRS NOP CLA CLEAR IFLAG STA IFLAG LDA D411 INITIALIZE POSSIBLE # OF SPARES STA NSPTR LDA SUB# LDB ADR ADDR OF TABLE WITH HD#,CYL#,#SRFCES,HEAD BUF INFO JSB ABSAD TO BE SUPPLIED BY ABSAD ROUTINE LDA SUB# FIND ENDING CYL# AND HEAD# ALS MULTIPLY BY 2 ADA SUB# SUB#*3 ADA ATB32 7905 TRACK MAP TABLE STA DIST2 ADDR OF TM INFO FOR SUB# ADA D2 A REG POINTS TO # OF TRACKS IN SUB# LDA A,I A REG HAS # OF TRACKS ADA N1 LAST TRACK IN SUB# LDB DIST2 JSB DADTR FIND ABSOLUTE ADDR OF LAST TRACK IN SUB# LDA PT#TR CYLINDER # RETURNED IN A REG STA ECYL END CYLINDER FOR SUB# BLF,BLF MOVE HEAD# TO LOW HALF STB EHEAD HEAD# FOR LAST TRACK * * # OF SPARES IS DETERMINED BY GOING THROUGH AND COMPARING * FISRT AND LAST CYLINDERS AND # OF SURFACES COVERED BY SUB# * AND ALL SUBCHANNELS ON SAME UNIT AS SUB# * LDA NSUB IF THERE IS ONLY ONE SUBCHANNEL DEFINED CPA D1 CALCULATE # OF SPARES JMP NSPR4 CLA STA SUB FIRST SUBCHANNEL IS 0 NSPR1 CPA SUB# IS IT SUB#? JMP NSPR9 YES, THEN LOOK AT NEXT SUBCHANNEL LDB ADR1 TABLE ADDRESS FOR ABSOLUTE TRACK ADDRESS AND JSB ABSAD HEAD BUFFER FOR SUB LDA UNIT UNIT#'S FOR THE 2 SUBCHNLS SAME? CPA UNIT1 RSS JMP NSPR9 NO, THEY ARE DIFFERENT - TRY NEXT SUBCHNL LDA ECYL YES, COMPARE END CYL OF SUB# AND FIRST CPA SCYL1 CYL OF SUB - ARE THEY THE SAME? JMP NSPEQ YES CMA,INA NO THEN FIRST CYL OF SUB < ENC CYL OF SUB#? ADA SCYL1 SSA IF NEGATIVE YES JMP NSPLT YES ADA N1 STA NSPCL POSSIBLE # OF SPARE ï+þúCYLINDERS JSB SMHED BOTH SUBCHANNELS HAVE ANY SURFACE IN COMMON? SZA,RSS JMP NSPR4 NO,THEN CALCULATE # SPARE CYL AGAIN CCA YES,SET FLAG TO CALCULATE SP TRKS BET FIRST STA IFLAG HEAD OF SUB# AND SUB JMP NSP12 DO NOT RE-CALCULATE # OF SPARE CYL NSPR4 LDB ECYL NO,END CYLINDER OF SUB# CMB,INB ADB D410 410-ECYL=POSSIBLE # OF SPARE CYLINDERS LDA SDTYP SOURCE DISC TYPE? CPA D7925 = 7925? RSS CPA D7920 7920? ADB D412 YES,THEN POSSIBLE # SPARE CYL=822-ECYL STB NSPCL NSP12 CLA CALCULATE # SPARES ON ECYL BETWEEN STA TEMP EHEAD AND LAST SURFACE # LDB EHEAD NSPR6 CPB D8 IS IT THE LAST SURFACE? JMP NSPR3 YES INB NO, CHECK NEXT SURFACE LDA AHD GET VALUE OF NEXT ENTRY IN HEAD BUFFER ADA B LDA A,I SZA IS IT INCLUDED FOR THIS SUBCHNL? ISZ TEMP YES, INCREMENT EXTRA # SPARES BY 1 JMP NSPR6 TRY FOR NEXT SURFACE NSPR3 ISZ IFLAG WAS FLAG SET TO -1? JMP NSP15 NO, THEN DONE LDA AHD EVALUATE #0OF SPARES AFTER EHEAD STA TEMP1 SAVE ADDRESS OF HEAD BUFFER FOR SUB# LDB AHD1 STB TEMP2 SAVE ADDRESS OF HEAD BUFFER FOR SUB NSPR8 LDA TEMP1,I GET VALUE OF ENTRY IN HEAD BUFFER SZA,RSS JMP NSPR7 THIS SURFACE NOT INCLUDED IN SUB# LDB TEMP2,I SURFACE INCLUDED IN SUB? SZB JMP NSP15 YES, THEN NO MORE EXTRA SPARES ISZ TEMP NO, THEN THIS IS AN EXTRA SPARE NSPR7 ISZ TEMP1 TRY NEXT SURFACE ISZ TEMP2 JMP NSPR8 NSP15 CLA CLEAR IFLAG STA IFLAG LDA NSPCL #L OF POSSIBLE SPARE CYLINDERS LDB NSRF # OF SPARE CYLINDERS * # OF SURFACES CMB,INB = # OF SPARE TRACKS STB COUNT NSPR2 ISZ COUNT RSS JMP NSPR5 ALL SURFACES ACCOUNTED FOR šMþúADA NSPCL ADD # OF SPARE CYLINDERS ONE MORE TIME JMP NSPR2 NSPR5 ADA TEMP ADD ANY EXTRA SPARES LDB NSPTR # OF SPARE TRACKS EVALUATED PREVIOUSLY CMB,INB NEW-OLD ADB A NEW # SPARES > OLD # SPARE? SSB STA NSPTR NO, NSPTR=NEW # SPARES JMP NSPR9 ON TO THE NEXT SUBCHANNEL * * END CYLINDER OF SUB# = START CYLINDER OF SUB * NSPEQ JSB SMHED BOTH SUBCHANNELS HAVE ANY HEAD# 'S IN COMMON? SZA JMP NSPER YES - ERROR CONDITION JMP NSPR4 EVALUATE POSSIBLE # OF SPARE CYLINDERS * *START CYLINDER OF SUB < END CYLINDER OF SUB# * NSPLT JSB SMHED SPAN SAME HEADS? SZA,RSS JMP NSPR4 EVALUATE POSSIBLE SPARE CYLINDERS LDB SUB BLS SUB*2 ADB SUB SUB*3 ADB ATB32 MAP ADDRESS FOR SUB LDA B ADA D2 POINTER TO # OF TRACKS IN SUB LDA A,I # OF TRACKS IN SUB ADA N1 LAST TRACK # IN SUB JSB DADTR FIND ABSOLUTE ADDR OF LAST TRACK IN SUB LDA SCYL START CYL OF SUB# CMA,INA ADA PT#TR END CYL OF SUB - START CYL OF SUB# SSA,RSS END CYL OF SUB>=START CYL OF SUB#? JMP NSPER YES - ERROR CONDITION JMP NSPR4 NO EVALUATE POSSIBLE SPARE CYLINDERS * NSPR9 ISZ SUB INCREMENT SUBCHNL COUNT LDA SUB CPA NSUB DONE LOOKING AT ALL SUBCHANNELS RSS JMP NSPR1 NO, REPEAT PROCESS AGAIN NSP10 LDA NSPTR RETURN LDB NSUB IF THERE IS ONLY ONE SUBCHNL CPB D1 DEFINED, CHECK # OF SPARES RSS ONE SUCHNL DEFINED JMP NSPRS,I RETURN, MORE THAN 1 SUBCNLS DEFINED CMA,INA -VE OF # OF SPARES FOR THIS SUBCHNL ADA D10 IS IT > 10? SSA JMP NSP11 YES , THEN LIMIT THEM TO 10 LDA NSPTR NO, KEEP THEM AS NSPTR JMP NSPRS,I RETURN NSP11 LDA D10 LIMIT # OF SPRES TO 10 ST££þúA NSPTR JMP NSPRS,I RETURN * * ERROR CONTDITION * NSPER JSB WRITE DEF ERR0 WARNING -- DEF D5 JSB WRITE DEF ERR6 SUBCHANNELS OVERLAP ON SOURCE UNIT DEF D16 CLA RETURN WITH # OF SPARES AS 0 STA NSPTR JMP NSPRS,I * D412 DEC 412 ADR DEF *+1 HEAD NOP UNIT NOP SCYL NOP NSRF NOP HD BSS 9 AHD DEF HD ADR1 DEF *+1 HEAD1 NOP UNIT1 NOP SCYL1 NOP NSRF1 NOP HD1 BSS 9 AHD1 DEF HD1 ECYL NOP EHEAD NOP COUNT NOP NSPCL NOP NSPTR NOP SUB NOP * * * ABSAD - ROUTINE FINDS ABSOLUTE ADDRESS OF FIRST TRACK OF A GIVEN * SUBCHANNEL - SETS UP HEAD BUFFER FOR IT IE. IF SUBCHNL * IS DEFINED TO USE 2 SURFACES, SAY 1 & 2, THEN HDBUF=0, * HDBUF+1=1, HDBUF+2=1 * CALLING SEQUENCE: JSB ABSAD * A REG = SUBCHANNEL # * B REG = ADDR OF TABLE WITH FOLLOWING FORMAT: * ATBLE DEF *+1 ADDR OF TABLE * HEAD BSS 1 STARNG HEAD# FOR SBCHNL * UNIT BSS 1 UNIT# FOR SUBCHNL * SCYL BSS 1 STARTING CYL # * NSRFC BSS 1 # OF SURFACEES FOR SBCHNL * HDBUF BSS 5 HEAD BUFFER FOR SUBCHNL * RETURNS: TABLE FILLED UP WITH APPROPRIATE EENTRIES FOR SUBCHANNEL * * ABSAD NOP STA SUB SAVE SUBCHANNEL # STB ADDR SAVE ADDRESS OF TABLE ALS MULTIPLY SUB BY 2 ADA SUB SUB*3 ADA ATB32 ADDR POINTING TO TRACK MAP INFO FOR SUB LDB A THIS ADDR HAS TO BE IN B REG FOR DADTR ROUTINE CLA FIND ABSOLUTE ADDR OF FIRST TRACK IN SUBCHNL JSB DADTR IE. TRACK 0 BLF,BLF MOVE HEAD # TO LOW HALF STB ADDR,I HEAD# LDB ADDR INB STA B,I UNIT # INB LDA PT#TR STA B,I CYLINDER# INB ?yþú LDA NSRFC STA B,I NUMBER OF SURFACES INB STB HDBUF HEAD BUFFER CLA STA COUNT COUNTER TO INDEX INTO HDBUF ABSA1 LDA HDBUF CLEAR HEAD BUFFER ADA COUNT CLB STB A,I CLEAR AN ENTRY IN HDBUF LDB COUNT CPB D8 ALL 9 ENTRIES DONE JMP ABSA2 YES ISZ COUNT NO, CLEAR NEXT ENTRY JMP ABSA1 * ABSA2 CLA,INA COUNT IS COUNTER FOR #0OF SURFACES COVERED STA COUNT INITIALIZE IT TO 1 LDA ADDR,I GET STARTING HEAD FROM THE TABLE ADA HDBUF ABSA3 CLB,INB AND STORE 1 IN HDBUF+COUNT STB A,I LDB ADDR ADB D3 GET # OF SURFACES FOR SUBCHNL LDB B,I CPB COUNT ALL SURFACES ACCOUNTED FOR? JMP ABSAD,I YES - RETURN LDB SDTYP DISC TYPE? CPB D7905 7905 DISC? LDB D2 YES, THEN HEADS 0-2 CPB D7906 7906 DISC? LDB D3 YES THEN HEADS 0-3 CPB D7920 7920 DISC? LDB D4 YES, THEN HEADS 0-4 CPB D7925 LDB D8 ABSA4 ADB HDBUF B REG HAS LAST AVAIL HEAD # CPB A CURRENT HEAD#># HEADS AVAIL ON DISC? JMP ERROR YES,ERROR ISZ COUNT NO, DO NEXT SURFACE INA JMP ABSA3 * ERROR JSB DCASC DEF *+4 DEF ERR7+14 CONVERT SUBCHANNEL # TO ASCII DEF D1 DEF SUB JSB WRITE DEF ERR7 IMPROPERLY DEFINED SUBCHANNEL XX DEF D15 JMP EXITU ABORT UTILITY * ADDR NOP HDBUF NOP * * * SMHED - ROUTINE TO DETERMINE IF THERE IS A COMMON SURFACE * USED BY 2 SUBCHANNELS * CALLING SEQUENCE: JSB SMHED * ASSUMED THAT HD & HD1 ARE TWO HEAD BUFFERS FOR THE SUBCHNLS * RETURNS: A REG = 0 IF NO COMMON SURFACES FOUND * = 1 OTHERWISE * * SMHED NOP CLA A REG IS COUNTER SMHD1 LDB AHD ADB A LDB B,I SZB,RSS HD+A REG=1? JMP SMHD2 Æ þú NO, SUBCHNL DOES NOT USE THIS SURFACE LDB AHD1 DOES THE 2ND SUBCHNL ALSO USE THIS SURFACE? ADB A LDB B,I SZB,RSS YES, IF B REG = 1 JMP SMHD2 NO, SO TRY FOR NEXT SUBCHNL CLA,INA EQUAL SO RETURN 1 IN A REG JMP SMHED,I * SMHD2 CPA D8 ALL NINE SURFACES LOOKED AT? JMP SMHD3 YES INA NO, INCREMENT A JMP SMHD1 LOOK AT NEXT SURFACE (HEAD POSITION) * SMHD3 CLA NO COMMON SURFACE RETURN WITH A REG = 0 JMP SMHED,I RETURN * * * FLGDS - ROUTINE TO FLAG A DEFECTIVE TRACK AND SPARE IT TO * A GIVEN TRACK # * CALLING SEQUENCE: JSB FLGDS * A REG HAS TRACK# OF SPARE TO BE USED * ASSUME: ADDR OF LOC TO GO TO IF A DEFECTIVE SPARE IS FOUND * IS SET UP IN INITE LOC AND DEFECTIVE TRACK# IS IN TRACK * * FLGDS NOP STA SPTRK SAVE SPARE TRACK # LDB FLGDF SET INIT1 WORD TO FLAG TRACK DEFECTGIVE STB INIT1 LDB DIST1 TRACK MAP ADDR FOR SUB# JSB DADTR GET ABSOLUTE TRACK ADDR FOR SPARE TRACK LDA PT#TR A HAS CYLINDER #, DST CYLA2 B REG HAS HEAD# CLA,INA STA RTFLG SET RETURN FLAG LDA TRACK DEFECTIVE TRACK# LDB AJB CORE ADDR OF BUFFER CLE REG E=0 FOR WRITE JSB DISK5 SET UP DEFECTIVE TRACK DLD CYLAD SAVE THESE TWO WORDS DST TBUF FOR LATER USE CLA,INA DO A FAKE WRITE TO FIND STA IFLAG STATUS OF SPARE TRACK STA RTFLG SET RETURN FLAG LDA FLMSK CHANGE FILE MASK TO NO AUTO SPARING STA FILMK CLA STA INIT1 CLEAR INIT WORD LDA SPTRK SPARE TRACK # LDB AJB ADDRESS OF BUFFER CLE E REG=0 FOR WRITE JSB DISK5 WRITE LDA FLMSK+1 RESTORE FILE MASK TO AUTO SPARE STA FILMK LDA STATB CHECK STATUS RAL,RAL IS THE DEF§ƒþúECTIVE BIT ON THE SSA SPARE TRACK SET? JMP FLGD1 YES, THEN HONOR IT LDA D2 NO THEN MARK THE SPARE TRACK STA IFLAG WITHOUT SEEKING AGAIN DLD TBUF SET UP TO FLAG THE SPARE TRACK DST CYLA2 LDA KB PROTECT BIT ON SAVED TRACK SET? SSA,RSS JMP INIEV NO LDA FLGPS YES, SO FLAG TRACK SPARED AND PROTECTED RSS INIEV LDA FLGSP SET SPARE FLAG BUT NOT PROTECT STA INIT1 SET INIT1 WORD FOR DRIVER FLGD1 CLA,INA SET RETURN FLAG STA RTFLG LDA SPTRK CLE REG E = 0 FOR WRITE LDB AJB JSB DISK5 FLAG THE SPARED TRACK CLA CLEAR IFLAG STA IFLAG JMP FLGDS,I RETURN * SPTRK NOP RTFLG NOP * * * RDTP - IF EOT HAS NOT BEEN REACHED A REC OF LENGTH JSIZE+2 * IS READ FROM MAG TA E, IF EOT HAD BEEN REACHED ROUTINE * ASKS USER TO MOUNT NEXT TA E AND THEN READS REC * CALLING SEQUENCE: JSB RDTP * A REG CONTAINS ADDRESS OF BUFFER INTO * WHICH REC HAS TO BE READ * RETURNS: EOFLG=0 IF EOF HAS NOT BEEN REACHED * =1 IF EOF HAS BEEN REACHED * * RDTP NOP STA ABUF ADDRESS OF BUFFER JSB EOT EOT DETECTED DURING PREVIOUS READ OPERATION SZA,RSS JMP RDTP1 NO, READ REC RDTP2 JSB MTNR MAG TAPE READY? JSB REWND REWIND NEW MAG TAPE JSB PRNTH PRINT INFO. ON HEADER REC - TAPE OK? DEF HEADR JMP RDTP1 TAPE OK JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JSB PAUSE WAIT FOR RIGHT TAPE TO BE MOUNTED JMP RDTP2 PRINT HEADER INFO AGAIN RDTP1 LDA JSIZE SIZE OF BUFFER WITHOUT HEADER WORDS ADA D2 ADD HEADER WORDS STA TEMP1 SIZE OF BUFFER TO BE READ FROM MT JSB MTNR MAG TAPE READY? JSB EXEC READ RECORD DEF *+5 DEF D1týþú DEF MTLU DEF ABUF,I DEF TEMP1 SZB,RSS EOF SEEN? ISZ EOFLG YES, THEN SET EOF FLAG JMP RDTP,I B REG HAS # OF WORDS TRANSMITTED, RETURN * SIZE NOP ABUF NOP EOFLG NOP * * * WRTTP - ROUTINE TO WRITE RECORD ON MAG TAPE IF EOT HAS NOT * BEEN REACHED, IF EOT SEEN, ASK USER TO MOUNT NEW TAPE * CALLING SEQUENCE: JSB WRTTP * A REG HAS ADDRESS OF BUFFER TO BE WRITTEN * * WRTTP NOP STA ABUF SAVE ADDRESS OF BUF JSB EOT EOT HAS BEEN REACHED? SZA,RSS JMP WRTP1 NO,CONTINUE WITH WRITE ISZ TAPEN YES, INCREMENT TAPE # JSB WRING WRITE RING ON MAG TAPE? JSB EXEC WRITE HEADER RECORD ON NEW MT DEF *+5 DEF D2 DEF MTLU DEF HEADR DEF D140 * WRTP1 LDA JSIZE ADA D2 DATA WORDS + 2 WORDS OF HEADER INFO STA TEMP1 JSB MTNR MAG TAPE READY? JSB EXEC WRITE RECORD ON MT DEF *+5 DEF D2 DEF MTLU DEF ABUF,I DEF TEMP1 JMP WRTTP,I RETURN * * * RDMT - IF BUFFER SIZE SPECIFIED BY USER IS 2048 WORDS THEN * THIS ROUTINE READS 3 RECORDS FROM MT TO MAKE UP A * 6144 WORD BUFFER TO WRITE ON DISC * CALLING SEQUENCE: JSB RDMT * * RDMT NOP LDA AKB FIRST READ A JSIZE REC FROM MT JSB RDTP INTO KB BUFFER LDA EOFLG EOF DETECTED? SZA JMP RDMT,I YES, THEN RETURN LDA JSIZE NO, CHECK IF JSIZE IS 2048 WORDS CPA D2048 RSS YES,READ MORE JMP RDMT,I NO, WE HAVE 8192 OR 6144 WORD RECORD DLD KB+2048 SAVE LAST TWO WORDS OF KB, THEY WILL BE OVERLAYED DST RTEMP BY TWO HEADER WORDS OF NEXT RECORD TO BE READ LDA ALB ADDRESS OF NEXT BUFFER JSB RDTP READ JSIZE RECORD DLD RTEMP LOAD THE SAVED WORDS AND STORE THEM BACK DST KB+2048 IN THEIR ORIGINAL LOC ä!þú DLD LB+2048 SAVE LAST TWO WORDS OF LB BUF DST RTEMP LDA AMB BUFFER FOR THIRD REC JSB RDTP READ ANOTHER JSIZE REC FROM MT DLD RTEMP RESTORE BACK THE LAST TWO WORDS OF LB DST LB+2048 LDA TKSIZ CPA D8192 RSS JMP RDMT,I RETURN * DLD MB+2048 DST RTEMP LDA ANB JSB RDTP DLD RTEMP DST MB+2048 JMP RDMT,I RTEMP BSS 2 * * * WRTMT - ROUTINE TO WRITE EITHER 6144 WORD RECORD OR IF * JSIZE IS LESS THAN 6144, BREAK BUFFER INTO 3 2048 * RECORDS AND WRITE THEM ON MAG TAPE * CALLING SEQUENCE: JSB WRTMT * * WRTMT NOP LDA AKB BUFFER CONTAINING 6144 WORD DATA JSB WRTTP WRITE JSIZE WORDS FROM IT ON TAPE LDA JSIZE IS JSIZE = 6144 WORDS? CPA D2048 RSS IF JSIZE=2048,READ MORE RECORDS JMP WRTMT,I YES, THEN WHOLE BUFFER WRITTEN TO MT DLD KB NO,DO NEXT PORTION OF BUFFER DST LB STORE THE TWO HEADER WORDS FROM KB IN LB & LB+1 LDA ALB WRITE LB BUFFER TO MT JSB WRTTP DLD KB LAST PORTION OF BUFFER TO BE WRITTEN DST MB WRITE HEADER WORDS FOR MB BUFFER LDA AMB WRITE MB BUFFER TO TAPE JSB WRTTP LDA TKSIZ CPA D8192 RSS JMP WRTMT,I RETURN * * TRACK SIZE IS 8192, READ ONE MORE RECORD * DLD KB DST NB LDA ANB JSB WRTTP JMP WRTMT,I * * EOT - ROUTINE TO CHECK IF EOT HAS BEEN DETECTED, IF SO * ASK USER TO MOUNT NEXT TAPE * CALLING SEQUENCE: JSB EOT * RETURNS: 0 IN A REG IF EOT HAS NOT BEEN DETECTED * 1 IN A REG IF EOT HAS BEEN DETECTED * * EOT NOP LDA MTLU SET CONTROL WORD FOR DYNAMIC STATUS REQUEST ADA .600 STA TEMP1 CONTROL WORD JSB EXEC DEF *+3 DEF D3 DYNAMIC STATUS FOR MT DEF TEMP1 AND .40 IF BIT 5 IS ON EOT HAS By«þúEEN REACHED CPA .40 JMP EOT1 EOT REACHED CLA EOT NOT REACHED JMP EOT,I RETURN WITH A REG = 0 * EOT1 JSB WRITE INFORM USER THAT EOT HAS BEEN DETECTED DEF MSG18 EOT HAS BEEN REACHED, MOUNT NEXT TAPE DEF D14 JSB REWND JSB PAUSE ENTER 'GO' WHEN READY JSB MTNR MT READY? CLA,INA JMP EOT,I RETURN WITH A REG = 1 * .40 OCT 40 .100 OCT 100 .600 OCT 600 .1300 OCT 1300 * * * MTNR - ROUTINE TO TEST IF MAG TAPE IS READY * CALLING SEQUENCE: JSB MTNR * * MTNR NOP MTNR1 LDA .600 ADA MTLU FUNCTION CODE FOR DYNAMIC STATUS REQUEST STA TEMP JSB EXEC DYNAMIC STATUS REQUEST DEF *+3 DEF D3 DEF TEMP SLA,RSS BIT SET? JMP MTNR,I NO, RETURN JSB WRITE MAG TAPE NOT READY DEF MSG23 DEF D6 JSB PAUSE JMP MTNR1 * * * WRING - ROUTINE TO CHECK IF WRITE RING IS PRESENT ON MAG TAPE * CALLING SEQUENCE: JSB WRING * * WRING NOP WRNG1 LDA .600 ADA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQUEST STA TEMP JSB EXEC DEF *+3 DEF D3 DEF TEMP AND D4 SZA,RSS WRITE RING ON? JMP WRING,I YES JSB WRITE NO, THEN SEND MESSAGE TO USER DEF ERR2 NO WRITE RING, WRITE ENABLE MT DEF D15 JSB PAUSE JSB MTNR JMP WRNG1 DID USER REALLY WRITE ENABLE MT? * * * * .MVW - MOVES SPECIFIED # OF WORDS FROM ONE LOCATION TO NEXT * CALLING SEQUENCE: JSB .MVW * DEF #WRDS # OF WORDS TO BE MOVED * A REG = ADDRESS OF SOURCE BUFFER * B REG = ADDRESS OF DESTINATION BUFFER * * .MVW NOP STA .TMP1 SAVE ADDR OF SOURCE BUFFER STB .TMP2 SAVE ADDR OF DEST BUFFER LIA 6 FIND OUT IF THE COMPUTER IS A 2100 OR EARLIER SZA,RSS JMP NMX0 YES, IT IS NOT AþoþúN MX OR XE CCA ADA .MVW POINT A REG TO JSB .MVW INSTR STA .MVW MAKE THIS THE RETURN ADDRESS LDA MVW GET MVW INSTR STA .MVW,I REPLACE JSB .MVW WITH MVW MICRO INSTRUCTION LDA .TMP1 RESTORE CONTENTS OF A REG JMP .MVW,I RETURN AND EXECUTE MVW INSTR NMX0 LDA .MVW,I ADDR OF # OF WORDS TO BE MOVED LDA A,I # OF WORDS TO BE MOVED STA COUNT CLA STA .TEMP MLOOP LDA .TMP1 ADDR OF SOURCE BUF ADA .TEMP INDEX INTO BUF LDA A,I GET WORD TO BE MOVED LDB .TMP2 ADB .TEMP INDEX INTO DEST BUFFER STA B,I MOVE WORD INTO DEST BUFFER ISZ .TEMP LDA .TEMP CPA COUNT ALL WORDS MOVED? RSS JMP MLOOP ISZ .MVW ISZ .MVW RETURN JMP .MVW,I * .TEMP NOP .TMP1 NOP .TMP2 NOP MVW MVW 0 * * * .CMW - ROUTINE TO COMPARE TWO BUFFERS * CALLING SEQUENCE: JSB .CMW * DEF #WRDS # OF WORDS * A REG = BUFFER 1 ADDRESS * B REG = BUFFER 2 ADDRESS * RETURN: IF BUFFERS EQUAL TO P LOC * IF BUFFERS NOT EQUAL TO P+1 LOC * * .CMW NOP STA .TMP1 STB .TMP2 SAVE ADDRESSES OF THE TWO BUFFERS TO BE COMPARED LIA 6 IS IT A 2100 OR EARLIER COMPUTER? SZA,RSS JMP NMX01 YES CCA NO, REPLACE JSB INSTR WITH CMW INSTR ADA .CMW STA .CMW JSB INSTR IS RETURN ADDRESS LDA CMW STA .CMW,I REPLACE JSB .CMW INSTR WITH CMW MICRO INSTR LDA .TMP1 RESTORE A REGISTER JMP .CMW,I NMX01 LDA .CMW,I GET # OF WORDS TO BE COMPARED LDA A,I STA COUNT ISZ .CMW ISZ .CMW SUCCESSFUL COMPARE RETURN LOACATION CLA STA .TEMP INDEX FOR THE TWO BUFFERS CMWLP LDA .TMP1 ADA .TEMP LDA A,I A REG HAS WORD TO BE COMPARED LDB .TMP2 ADB .TEMP LDB B,I Þëþú B REG HAS CORRESPONDING WORD FROM 2ND BUFFER CPA B RSS JMP .CMW1 NO MATCH, RETURN TO P+1 ISZ .TEMP MATCH, THEREFORE COMPARE NEXT 2 WORDS LDA .TEMP CPA COUNT ALL WORDS COMPARED? JMP .CMW,I YES THEN RETURN JMP CMWLP NO THEN COMPARE NEXT TWO WORDS .CMW1 ISZ .CMW ISZ .CMW JMP .CMW,I RETURN * CMW CMW 0 * * * RD00 - ROUTINE TO READ RECORD FROM 7900 DISC * CALLING SEQUENCE: JSB RD00 * * RD00 NOP CLA CLEAR INIT FLAG STA INIT1 LDA TRACK SET TRACK ADDRESS TO REAL TRACK# LDB ATB31 ADDR OF TRACK MAP TABLE ADB SUB# LDB B,I BASE TRACK ADDR ADA B BASE+RELATIVE TRACK # LDB AJB ADDRESS OF BUFFER IN CORE CCE E REG = 1 FOR READ JSB DISK0 READ FROM 7900 DISC SSA,RSS IF A IS -VE, DATA ERROR OR PARITY ERROR JMP RD001 NO ERROR LDA KB+1 TURN ON SIGN BIT OF KB+1 ADA MSIGN TO INDICATE DATA WAS READ UNSUCCESSFULLY STA KB+1 SAVE IT IN HEADER INFO. FOR BUFFER * RD001 LDB SUB# LDA STATB TRACK JUST READ IS WRITE PROTECTED? ELA,CLE,ERA CLEAR SIGN BIT FROM STATUS WORD CPA .2010 DATA PROTECT SWITCH AND FLAGGED CYL BITS ON? JMP RD002 YES CPA .10 JUST FLAGGED CYL BIT ON? RD002 ADB MSIGN YES, TURN ON SIGN BIT STB KB STORE FOR HEADER INFO OF TRACK JMP RD00,I RETURN * MSIGN OCT 100000 .2010 OCT 2010 .10 OCT 10 * * * WR00 - ROUTINE TO WRITE RECORD ON 7900 DISC * CALLING SEQUENCE: JSB WR00 * * WR00 NOP LDB MSIGN LDA KB SAVE RECORD WAS WRITE PROTECTED? ELA CHECK SIGN BIT SEZ ADB M1000 YES, ADD PROTECT FLAG BIT IN INIT WORD STB INIT1 SET UP INIT1 FOR 7900 DISC DRIVER CLE,ERA CLEAR SIGN BIT STA SUB# LDA KB+1 CLEAR SIGN BIT FROM 2ND ÆðþúHEADER WORD ELA,CLE,ERA STA TRACK TRACK# LDA COTYP CPA D3 FROM - TO COPY? RSS JMP WR01 NO LDA PLATR YES, THEN SET UP PLATR & SUB# LDB SUB# FOR DEST DISC FOR FROM-TO COPY DST TBUF LDA DPLTR DESTINATION PLATR STA PLATR LDA DSUB# DESTINATION SUB# STA SUB# LDA TRACK ADA FTRCK BASE + RELATIVE TRACK ADDRESS JMP WR02 WR01 LDA TRACK LDB ATB31 ADB SUB# LDB B,I ADA B REAL TRACK ADDRESS WR02 LDB AJB ADDRESS OF CORE BUFFER CLE E REG=0 FOR WRITE JSB DISK0 ASK DRIVER TO WRITE REC LDA COTYP CPA D3 COPY TYPE FROM TO ? RSS JMP WR00,I NO DLD TBUF YES THEN RESTORE ORIGINAL SUB# AND PLATR VALUES STA PLATR FOR SOURCE DISC STB SUB# JMP WR00,I RETURN * M1000 OCT 1000 * * * RD05 - ROUTINE TO READ DATA FROM 7905 DISC * CALLING SEQUENCE: JSB RD05 * * RD05 NOP CLA SET INIT1 BIT TO 0 STA INIT1 LDA TRACK LDB AJB CORE BUFFER ADDRESS CCE SET E REG=1 FOR READ JSB DISK5 ASK DRIVER TO READ RECORD FROM 7905 DISC CPA PATRN ILLEGAL SPARE ENCOUNTERED? RSS JMP RD052 NO LDA COTYP IS IT A FROM-TO COPY? CPA D3 JMP RD051 YES, THEN GIVE ILLEGAL SPARE ERROR MESSAGE LDB ATB32 NO, TRACK SPARING REQUESTED? ADB N1 LDB B,I B REG HAS FIRST WORD OF TRACK MAP TABLE SSB,RSS JMP SAC10 NO, THEN SKIP THIS REC DO NEXT ONE RD051 JSB WRITE GIVE ERROR MESSAGE DEF ERR12 ILLEGAL SPARE AT: DEF D9 LDA TRACK PRINT TRACK LOC JSB PTRK5 JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF WHAT IS THE RESPONSE? CPA YE RS±uþúS JMP EXITU DOES NOT WISH TO CONTINUE ABORT UTILITY LDA KB+1 MARK TRACK DEFECTIVE ADA MSIGN STA KB+1 JMP RD05,I RETURN RD052 LDB SUB# LDA STATB GET STATUS WORD AND .4000 TRACK JUST READ WAS PROTECTED? CPA .4000 ADB MSIGN YES, TURN ON BIT 15 OF KB STB KB JMP RD05,I RETURN * * * * WR05 - ROUTINE TO WRITE ON 7905 DISC * CALLING SEQUENCE: JSB WR05 * * WR05 NOP LDA COTYP CPA D3 FROM - TO COPY? RSS JMP WR050 LDA AFRMP YES, THEN DEST TRACK MAP TABLE IS DIFFERENT INA STA DIST1 SET UP FOR DISC DRIVER CLA STA SUB# SUB# ALWAYS 0 FOR FROM - TO COPY JMP WR058 WR050 LDA KB ELA,CLE,ERA CLEAR SIGN BIT STA SUB# CALCULATE TRACK MAP ADDRESS FOR SUB# ALS ADA SUB# SUB#*3 ADA ATB32 STA DIST1 LDA ATB32 IS TRACK SPARING REQUIRED? ADA N1 LDA A,I SSA,RSS JMP WR058 NO LDA FLMSK YES, THEN FIRST WRITE W/OUT AUTO STA FILMK TRACK SPARING WR058 CLA,INA STA IFLAG IFLAG=1 IF THIS IS WRITE FOR STATUS PURPOSES LDB AJB CORE ADDRESS OF BUFFER CLA STA INIT1 SET UP INIT1 WORD FOR DISK DRIVER LDA DUNIT STA UN#IT UNIT # FOR DRIVER LDA KB+1 CLEAR SIGN BIT ON TRACK ADDRESS ELA,CLE,ERA STA TRACK CLE E REG=0 FOR WRITE JSB DISK5 WRITE DATA ON DISC LDB IFLAG IS THIS WRITE WITH TRACK SPARING? SSB JMP WR056 YES CPA PATRN NO,TRIED TO WRITE ON SPARED TRACK? RSS JMP WR051 NOT AN ILLEGAL SPARE JSB WRITE YES, GIVE ERROR MESSAGE DEF ERR12 ILLEGAL SPARE AT: DEF D9 LDA TRACK REPORT LOACATION OF TRACK JSB PTRK5 JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXÍþúP6 REPLY YES OR NO DEF D9 LDA RBUF WHAT IS THE RESPONSE? CPA YE RSS JMP EXITU DOES NOT WISH TO CONTINUE CLA CONTINUE, CLEAR IFLAG STA IFLAG JMP WR05,I RETURN WR051 LDA KB SSA,RSS WRITE PROTECT NEEDED? JMP WR053 LDB STATB YES LDA FLGPT WRITE PROTECT FLAG IN A SSB SPARED TRACK? LDA FLGPS YES, WRITE PROTECT + SPARED FLAG IN A JMP WR055 WR053 LDA STATB DEST TRACK WAS WRITE PROTECTED AND .4000 GET P BIT FROM STATUS CPA .4000 RSS SET THEN CLEAR IT JMP RWR05 NOT SET - RETURN LDB STATB IF DEST TRACK WAS WRITE PROTECTED LDA M1400 WIPE OUT WP STATUS-PLAIN INITIALIZE SSB SPARE BIT TURNED ON? LDA FLGSP YES, RESTORE SPARE STATUS BUT NOT PROTECT WR055 STA INIT1 LDA D2 SET IFLAG TO DO WRITE WITHOUT SEEK STA IFLAG WR057 LDB AJB CORE BUFFER ADDRESS LDA TRACK CLE REG E=0 FOR WRITE? JSB DISK5 IFLAG = 2 TO WRITE WITHOUT SEEK RWR05 CLA STA IFLAG CLEAR IFLAG JMP WR05,I * TRACK SPARING IS DESIRED WR056 LDA FLMSK+1 RESTORE FILE MASK TO AUTO TRACK SPARE STA FILMK LDA STATB IS THE DEFECTIVE BIT SET ON TRACK? RAL,RAL SSA JMP WR057 YES, THEN SPARE TRACK LDA FLGPT PROTECT FLAG + INITIALIZE LDB KB PROTECT FLAG ON ON SAVED TRACK? SSB,RSS LDA M1400 NO PLAIN INITIALIZE JMP WR055 RE-WRITE THE TRACK * IFLAG NOP FLMSK OCT 107400 FILE MASK WITHOUT AUTO SPARE OCT 107404 FILE MASK WITH AUTO SPARE * * * CMPAR - ROUTINE TO MAKE WORD TO WORD COMPARISON OF TWO BUFFERS * CALLING SEQUENCE: JSB CMPAR * AJB & AJB+JSIZE ARE ASSUMED TO BE ADDRESSES OF THE 2 BUFFERS * BUFFER LENGTH IS JSIZE * RETURNS: TO LOC P IF SUCCESSFUL COMPARE * TO LOC P+1 C<þúIF UNSUCCESSFUL COMPARE * * CMPAR NOP LDA AJB A REG HAS ADDR OF FIRST BUFFER LDB JSIZE SIZE OF EACH BUFFER CPB TKSIZ 6144 WORD BUFFER? JMP CMPR2 YES ADB A NO, ADDRESS OF 2ND BUFFER IN B REG RSS CMPR2 LDB AVBUF ADDR OF 2ND BUFFER FOR BUF OF 6144 WORDS JSB .CMW COMPARE JSIZE WORDS DEF JSIZE NOP JMP CMPAR,I SUCCESSFUL COOMPARE, RETURN * NOP JSB WRITE COMPARE ERROR DEF MSG22 VERIFY ERROR AT: DEF D8 LDA TRACK LDB DSCTP CPB D7900 JMP CMPR1 JSB PTRK5 JMP CMPR3 CMPR1 LDA TRCK1 JSB PTRK0 CMPR3 ISZ CMPAR RETURN TO P+1 JMP CMPAR,I RETURN * * * LBCNG - ROUTINE TO CHANGE # OF BAD TRACKS AND NEXT AVAILABLE * SPARE TRACK INFO ON USER LABEL OF A DOS SUBCHANNEL * CALLING SEQUENCE: JSB LBCNG * * LBCNG NOP LDA D128 STA ISIZE SIZE OF 1 BLOCK FOR DISC DRIVER CLA STA SECTR STA INIT1 LDB ALABL READ FIRST TRACK IN SUBCHNL CCE JSB DISK5 LDA ALABL ADA D3 LABEL WORD LDB ASYST SYSTEM ASCII WORDS JSB .CMW COMPARE BUFFERS WHOSE ADDRESSES ARE IN A & B REG DEF D3 NOP JMP LBCN1 SUCCESSFUL COMPARE NOP JMP USER NO MATCH SO USER SUBCHANNEL LBCN1 LDA LABEL+64 TRACK # IS IN UPPER BYTE ALF,ALF BRING IT TO LOWER BYTE ALS MULTIPLY IT BY 2 LDB ALABL CCE JSB DISK5 READ TRACK WITH USER LABEEL ON IT * USER LDA UBADC # OF USED SPARES IN A REG ARS DIVIDE BY 2 STA LABEL+65 UPDATE # OF USED SPARE TRACKS WORD IN USER LABEL LDA UBADC CMA,INA BASE SPARE POOL ADDRESS - # USED SPARES = ADA CSPAR NEXT AVAILABLE SPARE TRACK ARS DIVIDE BY 2 STA LABEL+66 UPDATE NEXT AVAIL SPARE TRCK WORD IN USER LAmDþúBEL LDA TRCK1 LDB ALABL CLE JSB DISK5 WRITE UPDATED USER LABEL BACK ON DISC LDA TKSIZ STORE BACK ORIGINAL SIZE OF BUFFER FOR DRIVER STA ISIZE JMP LBCNG,I RETURN * ASYST DEF SYSTM SYSTM ASC 3,SYSTEM * TBCHN NOP TEMP DSIZE NOP DISK SIZE - NO. OF TRACKS SDS# NOP # SECTORS/TRACK FOR SYSTEM DISC$ DERCN NOP DISK ERROR COUNTER * "/E" ASC 1,/E SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTC0 NOP LDB ATB31 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB D8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B JMP TSTC0,I RETURN B= # TRACKS * * LST1 DEF *+1 I#OTB DEF DSK51 DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSK#R I#OTC DEF * LST2 DEF *+1 I#OTD DEF DSK01 DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK70 I#OTE DEF * * S#EKC OCT 30000 R/DCM OCT 20000 DSK#R OCT 120000 T#AC0 NOP * * * * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * 128 WORD SECTORS OÚ<þúN THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET EXIT TO INITE INDIRECT * * B - ELSE NOTIFY OPERATOR AND HALT * A= DISC ADDRESS -64 WORD/SECT BASIS- * B= DISC STATUS * SPC 3 * CALLING SEQUENCE * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK0 NOP STA TRCK1 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDB SUB# GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT LDB UN#IT GET UNIT NUMBER ADB M0100 SET COMMANDS LDA INIT1 ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R/DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB SECTR GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB N24 SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS TRY00 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 RTRY0 LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND .100 CHECK READY BIT SZA IF SET JMP NR#RR GO TELL THE MAN * µ©þú LDA TRCK1 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R/DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSK#R GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA ISIZE SET LENGTH TO -ISIZE CMA,INA STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP DERRC STATUS NOT OK-CHECK FOR ERRORS JSB INT0N STATUS OK - TURN ON INTERRUPTS JMP DISK0,I RETURN * DERRC RAL,CLE,ERA CLEAR SIGN BIT CPA .11 WRITE PROTECT ERROR? JMP WRPT0 YES - GO TELL HIM * CPA .31 DEFECTIVE CYLINDER? RSS JMP DERRD NO - CHECK FOR OTHER ERRORS JSB INT0N TURN ON INTERRUPTS LDA N1 POSSIBLE ONLY DURING READ JMP DISK0,I RETURN WITH A REG = -1 * DERRD AND .100 ISOLATE READY BIT SZA READY? JMP NR#RR NO - GO TELL HIM * CLA AND JSB SEEK ZERO ISZ DERCN STEP TOTAL ERROR COUNT ISZ EDCNT TIME THIS OP COUNTER JMP DSK16 NOT TEN YET GO TRY AGAIN * JMP IN#ER BAD TRACK REPORT IT * WRPT0 JSB INT0N TURN ON INTERRUPTS JSB WRITE WRITE PROTECT SWITCH IS OFF DEF MES32 ASK USER TO TURN IT ON DEF D11 JSB PAUSE WAIT FOR TURN ON JMP TRY00 TRY AGAIN. SPC 1 NR#RR JSB INT0N TURN ON INTERRUPTS JSB WRITE DISC IS NOT READY DEF MS4 SEND THE WORD TO THE MAN DEF D5 JSB PAøþúUSE PAUSE JMP TRY00 ON RESTART RETRY SPC 1 SPC 2 SEEK NOP SEEK ROUTINE DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 STATC NOP WAIT AND STATUS ROUTINE DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 2 LASK NOP NSEC NOP * * BAD TRACK TO BE REPORTED * IN#ER JSB INT0N TURN ON INTERRUPTS LDA STATB GET STATUS AND MASK SEEK CHECK AND M440 SZA,RSS CHECK END OF CYLINDER BITS JMP IN#E0 IF NOT SET CONTINUE WITH BAD TRACK REPORTING JSB WRITE DEF ERR8 IF SET GIVE ERROR MESSAGE AND ABORT UTILITY DEF D22 UNRECOVERABLE DISC ERROR-EOC OR SEEK CHECK JMP EXITU ABORT UTILITY * IN#E0 LDA VFLAG VERIFYING? SZA YES JMP DISK0,I YES, RETURN JSB WRITE REPORT BAD TRACK DEF ERR9 DEF D7 LDA TRCK1 JSB PTRK0 PRINT LOC OF TRACK JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF CPA YE RSS JMP EXITU ABORT UTILITY LDA N1 YES THEN RETURN WI0)þúTH -1 IN A REG JMP DISK0,I * .11 OCT 11 .31 OCT 31 N10 DEC -10 N24 DEC -24 * * PTRK0 - ROUTINE TO PRINT TRACK # AND PLATTER # OF A TRACK ON * OPERATOR CONSOLE * CALLING SEQUENCE: JSB PTRK0 * A REG = TRACK# * * PTRK0 NOP STA TEMP1 SAVE TRACK# JSB DCASC CONVERT TRACK # TO ASCII DEF *+4 DEF TRKAD+3 DEF D2 DEF TEMP1 TRACK# JSB DCASC CONVERT PLATTER # TO ASCII DEF *+4 DEF TRKAD+10 DEF D1 DEF SUB# PLATTER # (SUBCHNL #) JSB DCASC CONVERT UNIT # TO ASCII DEF *+4 DEF TRKAD+15 DEF D1 DEF UN#IT UNIT# JSB WRITE SEND TRACK LOCATIONS TO TTY DEF TRKAD DEF D16 JMP PTRK0,I RETURN * TRKAD ASC 16,TRACK# , PLATTER# , UNIT# * * TBUF BSS 5 TEMP BUFFER DC EQU 0 HED MH RTGEN - CONSTANTS AND ADDRESSES * INITE DEF INIER FOR DISK ERROR INIT1 NOP INITILIZATION FLAG FOR DRIVER DIST1 NOP DIST2 NOP * INTMP NOP TEMP FOR INITILIZATION ROUTINES MS3 ASC 6,SUBCHNL 00? EXMS3 ASC 21,REPLY 1 TO 1233, 0 TO 410, 0 TO 2, 1 TO 3 MES1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES * HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * MH DISC CHANL? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST CYL#, HEAD #, # SURFACES ON SUBCHNL: * 0? * . ENTER FOUR DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 32? * DSETU NOP ENTRY POINT FOR QUESTION SECESSION. STB30 JSB WRITE DEF MES1 #TRKS, FIRST CYL#, HEAD#, #SURFACES DEF D20 LDA ATB32 SET ADDRESSES STA SDS# FOR INPUT STA INTMP AND CLEAR LOOPS LDB N96 CLEAR (¤Ìþú32 SUBCHNNL- 3 WORDS EACH) CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA INIT1 CLEAR INIT FLAG STA NSUB SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT JSB DCASC CONVERT DECIMAL SBCHNL# TO ASCII DEF *+4 DEF MS3+4 INSERT THE ASCII CHARACTERS IN MESSAGE DEF D1 DEF INTMP JSB QUERY DEF MS3 SUBCHNL XX? DEF D6 DEF EXMS3 DEF D21 LDA RBUF GET FIRST CPA "/E" /E? JMP TB30Y YES - GO CHECK FURTHER * JSB GINIT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB GETOC DECIMAL JMP EXPL ERROR - * STA TBCHN SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB GETAL NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP EXPL NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA SDS#,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N9 MUST BE LESS THAN 5. SSA,RSS WELL? JMP EXPL NO - BITCH * BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE LDA N2 NOW GET # SURFACES 2 DIGIT JSB GET MUST BE 1 TO 5. STA B SZA ADA N10 SSA,RSS WELL? JMP EXPL NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD ADB SUNIT ADD UNIT# STB BSHED TB30C ISZ SDS# STEP TO HEAD/UNIT WORD. LDA BSHED AND STA SDS#,I SALT IT AWAY. ISZ SDS# NOW THE # TRACKS LDA TBCHN WORD STA SDS#,I SAñÃþúLT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ NSUB STEP TOTAL SUBCHANNEL COUNT TB30B ISZ SDS# STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB D32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 * SPC 1 * TB30Y LDA NSUB NO - GET NUMBER OF CHANNELS SZA,RSS IS IT 0? JMP EXPL YES, THEN ASK AGAIN CMA,INA DEFINED LDB ATB32 ADB N1 STA B,I STORE -VE # OF SUBCHANNELS IN TRACK MAP TABLE JMP DSETU,I RETURN * * SPC 1 BSHED NOP N96 DEC -96 D32 DEC 32 SPC 1 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA TBUF AND GETS NEXT JSB GETAL INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP EXPL EMPTY LINE SO ERROR * LDA TBUF GET TYPE/ # DIGITS JSB GETOC GET NUMBER JMP EXPL CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTC5 * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTC5 NOP LDB COTYP CPB D2 UNIT COPY? RSS JMP TST55 NO LDB SYSTP SZB,RSS DOS DISC? JMP TST55 NO,RTE LDB D400 # OF TRACKS FO‡æþúR A DOS SUBCHNL STB NTRCK LDB D409 BASE SPARE POOL ADDR FOR DOS SUBCHNL STB CSPAR JMP TSTC5,I RETURN TST55 LDB A NUMBER TO B BLS INDEX INTO THE ADB A SUBCHNL# * 3 ADB ATB32 MAP TABLE ADDRESS ADB D2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B STB NTRCK STB CSPAR JMP TSTC5,I RETURN * D409 DEC 409 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE DCHCN SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = ADDRESS OF END OF INSTRUCTION ADDRESS LIST * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB DCHCN * * DCHCN NOP STA TBUF ADDR OF END OF INSTRUCTION ADDR LIST STB TBUF+1 ADDR OF BEGINNING OF INSTRUCTION ADDR LIST LOOPC LDB TBUF+1 CPB TBUF COMPARE ADDR OF BEG WITH END OF INST LIST JMP DCHCN,I THEY MATCH, ALL INSTRUCTIONS CONFIGURED LDB B,I GET INSTRUCTION ADDRESS LDA B,I GET INSTURCTION AND .1777 MASK OUT THE OLD CHANNEL# IOR CHANL INSERT NEW CHANNEL# STA B,I STORE IT BACK ISZ TBUF+1 MOVE DOWN TO THE NEXT INSTR JMP LOOPC REPEAT PROCEDURE * .1777 OCT 177700 * * LST3 DEF *+1 I/OTB DEF DSKDR DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 DEF DSK28 DEF DSK29 DEF DSK71 I/OTC DEF * * * FLGPT OCT 41400 FLGDF OCT 21400 FLGSP OCT 101400 FLGPS OCT 141400 PROTECT AND SPARE WA#KE OCT 113000 PT#SK OCT 101200 PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 DSKDR ABS DC DMA CON WORD HED MH RTGEN COMMON I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND RjLþúEADS OR WRITES * 128 WORD SECTORS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN SUCH AS * DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * CALLING SEQUENCE * A = TRACK # * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK5 NOP STA TRCK1 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA RTFLG IS RETURN FLAG SET? SZA JMP DISK3 YES, THEN DO NOT CHANGE ORIGINAL RETURN LOC LDA DISK5 SAVE ORIGINAL RETURN ADDRESS STA RDSK5 DISK3 CLA STA RTFLG CLEAR THE RETURN FLAG LDA ISIZE CONVERT SIZE TO -VE CMA,INA STA SIZE * DISK1 LDA TRCK1 A REG HAS TRACK # LDB DIST1 GET ADDRESS OF JSB DADTR TRANSLATE THE TRACK ADDRESS LDA UN#IT LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA IFLAG IS THIS WRITE WITH TRACK SPARING AND SSA AND TRACK HAS DEFECTIVE BIT MARKED? ISZ IFLAG YES, THEN SET IFLAG=0 RSS NO JMP INITE,I THEN HONOR IT AND SPARE TRACK * LDA WRTCM GET THE WRITE COMMAND ADA INIT1 ADD THE INIT CODE STA W#CMD AND SET IT LDA PT#TR GET THE CYLINDER LDB SECTR SECTOR BRS ADJUSTžiþú OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES LDA INIT1 GET THE INIT CODE CPA FLGSP IF SPARING OR RSS DOING A DEFECTIVE TRICK CPA FLGPS RSS CPA FLGDF THEN JMP TRY05 SKIP THE SECOND ADDRESS SET UP * LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND LDA N10 DISK ERROR COUNT INITIALIZED TO -10 STA DERCN USED FOR CYLINDER COMPARE ERRORS TRY05 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB WRITE? JMP DISK2 NO, DO STANDARD ADDRESSING LDA W#CMD YES RESET TO WRITE LDB IFLAG IF WRITING FOR 2ND TIME JUST DO ADDR REC CPB D2 JMP WPCAL YES JUST DO ADDRESS RECORD (NO SEEK) * DISK2 LDB MADDR JSB XFER STANDARD TRANSFER DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA STB STAT2 SAVE STATUS-2 WORD STA STAT1 SAVE STATUS PORTION OF STAT1 WORD LDB IFLAG COMING HERE FOR FIRST TIME WRITE WHEN CPB D1 TRACK SPARING IS NOT REQUIRED? RSS JMP CKSTB NO, CHECK FOR ERRORS LDA ATB32 IS THIS WRITE WITH TRACK SPARING? ADA N1 LDA A,I SSA,RSS JMP CKSTB NO, THEN CHECK STATUS LDB STAT2 STATUS WORD 2 LDA STAT2 SSA ERROR? JMP ST2ER YES, PROCESS IT AND .100 SZA WRITE PROTECT SWITCH ON? JMP WRPTM YES CCA YES, SET IFLAG=-1 STA IFLAG TO HAVE WR05 CHECK FOR D¹þú BIT IN STATUS JSB INT5N TURN ON INTERRUPTS JMP DISK5,I RETURN CKSTB LDA STAT1 RESTORE STATUS WORDS LDB STAT2 ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * WPCAL LDB MADDR JSB XFER WRITE PROTECT TRANSFER DEF ADRES-1 START WITH THE ADDRESS RECORD DEF R/WCM STILL END SAME PLACE JMP CKSTA GO DO STATUS CHECK * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JSB FAULT 01 ILLEGAL OP - PROGRAM FAULT JSB FAULT 02 UNIT AVAIL. PROGRAM FAULT JSB FAULT 03 CONTROLLER JSB FAULT 04 SHOULD JSB FAULT 05 NEVER JSB FAULT 06 SEND THESE ERRORS JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP CMPER 11 HEAD/SECTOR? SEND ERROR JSB FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JSB FAULT 13 UN IMPLEMENTED CODE FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK JSB FAULT 15 UN IMPLEMENTED CODE FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JMP SPARE 20 ILLEGAL SPARE JMP INERR 21 DEFECTIVE TRACK - REPORT JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JSB FAULT 24 UN IMPLEMENTED FAULT JSB FAULT 25 ERROR CODEDS JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. * * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN JSB INT5N TURN ON INTERRUPTS LDA VFLAG VERIFYING? SZA JMP DISK5,I YES, RETURN JMP INITE,I GO TO SPARING ROUTINE WHETHER READ OR WRITE * * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO KNRERR TO WAKE HIM UP * PROTECTED SEND TURN ON SWITCH MESSAGE * á)þú * * ST2ER LDA MADDR INITIALIZING? (IE.WRITING?) SSA JMP ST2 NO LDA B YES, STATUS -2 TO A AND M40 KEEP /FORMAT BITS SZA,RSS SET?? JMP FRMT IF SWITCH OFF GO BITCH LDA STAT2 NO, THEN WRITE PROTECT SWITCH ON? AND .100 SZA JMP WRPTM YES, THEN ASK USER TURN IT OFF * ST2 SSB,RSS IF NOT STATUS 2 ERROR JMP ERRDS JUST COUNT IT AND TRY AGAIN LDA B GET THE STATUS WORD AGAIN AND D4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO GO RESTART THE GEN. * JMP NRERR MUST BE NOT READY * FRMT JSB INT5N TURN ON INTERRUPTS JSB WRITE DEF MES33 TURN ON FORMAT SWITCH DEF D11 LDA STAT2 PROTECT SWITCH ON? AND .100 SZA JMP WRPT2 YES ASK USER TO TURN IT OFF JMP WRPT3 NO, THEN WAIT FOR USER TO TURN FORMAT SWITCH ON * WRPTM JSB INT5N TURN ON INTERRUPTS WRPT2 JSB WRITE WRITE PROTECT SWITCH IS OFF DEF MES32 TELL THE USER TO TURN IT ON DEF D11 WRPT3 JSB PAUSE WAIT FOR TURN ON JMP TRY05 TRY AGAIN. NRERR JSB INT5N TURN ON INTERRUPTS JSB WRITE DISC IS NOT READY DEF MS4 SEND THE WORD TO THE MAN DEF D5 JSB PAUSE JMP TRY05 ON RESTART RETRY * FAULT NOP ENTRY FOR TRACE BACK ONLY JSB INT5N TURN ON INTERRUPTS JMP EXITU SHOULD NEVE GET HERE SPARE JSB INT5N TURN ON INTERRUPTS CCA RETURN WITH ALL 1'S IN A REG JMP DISK5,I HAD TRIED TO READ OR WRTIE ON SPARED TRCK * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE THE * DISC. EOCYL JSB INT5N TURN ON INTERRUPTS JSB WRITE ELSE SEND BAD SPECIFICATION DEF ERR8 UNRECOVERABLE DISC ERROR-EOC OR SEEK CHE DEF D22 LDA TRCK1 TRACK TYRING TO SEóJþúEK JSB PTRK5 PRINT MORE INFO ON TRACK * ABRT? LDA MADDR READ OPERATION? SSA JMP INIEU YES, ASK IF WANT TO CONTINUE * LDA ATB32 WRITE, THEN TRACK SPARING? ADA N1 LDA A,I SSA JMP EXITU YES, THEN ABORT UTILITY JMP INIEU NO, ASK IF WANT TO CONTINUE * INERR JSB INT5N TURN ON INTERRUPTS * INIER CLA CLEAR IFLAG STA IFLAG LDA SYSTP TYPE OF SYSTEM OF DISC? SZA RTE DISC? JMP INIED NO, DOS INBSP JSB WRITE PRINT HEADER FOR BAD TRACK DEF ERR9 BAD TRACK AT: DEF D7 LDA TRACK RTE DISC JSB PTRK5 CONVERT BAD TRACK ADDR TO ASCII LDA MADDR CORE ADDRESS OF BUFFER SSA READ OPERATION JMP INIEU YES LDA ATB32 NO ADA N1 LDA A,I SSA TRACK SPARING WANTED? JMP INIET YES INIEU JSB QUERY NO, ENCOUNTERED BAD TRACK ON A READ OPER DEF MSG28 OR WRITE WITHOUT TRACK SPARING DEF D5 ASK OF USER WANTS TO CONTINUE WITH TASK DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF CHECK RESPONSE CPA YE RSS JMP EXITU USER DOES NOT WISH TASK TO CONTINUE,ABOR LDA KB+1 YES, MARK BIT 15 OF KB+1=1 ADA MSIGN STA KB+1 INDICATING DATA IS DEFECTIVE JMP DISK5,I RETURN * TRACK IS NOW REPORTED TO THE OPERATOR INIET LDA NSPTR # OF SPARE TRACKS FOR SUB# CPA UBADC OUT OF SPARES? RSS JMP INIEZ NO JSB DCASC YES DEF *+4 CONVERT SUBCHANNEL # TO ASCII DEF ERR4+16 DEF D1 # OF ASCII WORDS TO BE PUT IN BUFFER DEF SUB# SUBHANNEL # TO BE CONVERTED JSB WRITE SEND MESSAGE TO USER DEF ERR4 OUT OF SPARES FOR SUBCHNL XX DEF D17 JMP EXITU UTILITY IS ABORTED * INIEZ LDA AINXS SET DRIVER ABORT ADDRESS TO NEXT SPARE E ‘âþú STA INITE LDA CSPAR BASE ADDRESS OF SPARE TRACK POOL ADA UBADC ADD # USED SO FAR-INDICATES TRACK USED A JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED RESPECT JSB WRITE REPORT THE USED SPARE TRACK DEF SPMS SPARED TO: DEF D5 LDA SPTRK SPARE TRACK # JSB PTRK5 PRINT THE ADDR OF SPARE TRACK ISZ UBADC INCREMENT # OF USED SPARE TRACKS LDA AINIE RESET THE INIT ABORT ADDRESS FOR DRIVER STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * * SPARED TRACK WAS BAD * NIXSP JSB WRITE BAD TRACK AT: DEF ERR9 DEF D7 LDA UBADC ADDR OF BAD TRACK ADA CSPAR JSB PTRK5 ISZ UBADC INCREMENT # SPARES USED JMP INIET SPARE THE PREVIOUS SPARE TRACK * * DOS DISC * INIED LDA MADDR SSA READ OPERATION? JMP INIEG YES LDA TRACK NO, WRITE ERA SEZ EVEN TRACK? JMP INIEC ODD TRACK DO NOT PRINT BAD TRACK MESSAGE INIEG JSB WRITE PRINT BAD TRACK HEADER DEF ERR9 DEF D7 LDA TRACK JSB PTRK5 SEND THE BAD TRACK # LDA MADDR READ OPERATION? SSA JMP INIEU ASK IF USER WANTS UTILITY TO CONTINUE INIEC LDA UBADC WRITE OPERATION CPA D10 ALL 10 SPARE TRACKS USED UP? RSS JMP INIEE NO, THEN SPARE TRACK JMP INIET YES, OUT OF SPARES * INIEE LDA ANXSD ADDRESS OF LOC TO GO TO IN A STA INITE DEFECTIVE SPARE IS FOUND LDA TRACK ODD OR EVEN TRACK#? ERA CHECK BIT 0 SEZ BIT 0 ON? JMP INODD YES, THEN TRACK IS ODD LDA UBADC NO CMA,INA BASE SPARE TRACK ADDR - # OF USED SPARES ADA CSPAR -1 = ADDR OF NEXT TRACK TO BE USED AS SPA ADA N1 JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARES JSB WRITE DEF SPMS SPARED TO DEF D5 LDA ÙùþúSPTRK TO REPORT THE USED SPARE JSB PTRK5 CONVERT THE TRACK ADDRESS TO ASCII ISZ DOSDF TURN THE DOS DEFECTIVE TRACK FLAG ON LDA AINIE RESET THE INIT ABORT ADDRESS FOR DRIVER STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * FIRST TRACK WAS EVEN, SO 2ND TRACK HAS TO BE MARKED DEFECTIVE TOO * INIEW CLA CLEAR DOS DEFECTIVE TRACK FLAG STA DOSDF LDA UBADC # OF USED SPARES CMA,INA BASE SPARE TRACK ADDR-# OF USED SPARES ADA CSPAR A REG HAS TRACK # OF SPARE TRACK TO BE U LDB ANXSD SET INIT ABORT ADDRESS FOR DRIVER STB INITE JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED LDA UBADC BUT DO NOT REPORT IT ADA D2 INCREMENT # OF USED SPARES BY 2 STA UBADC LDA AINIE RESET INIT ABORT ADDRESS STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * FIRST TRACK WAS ODD INODD LDA UBADC # OF USED SPARE TRACKS CMA,INA CONVERT IT TO -VE # ADA CSPAR BASE ADDR OF SPARE TRACK POOL LDB ANXSD SET INIT ABORT BIT FOR DRIVER STB INITE JSB FLGDS FLAG IT DEFECTIVE AND SPARED LDA AINIE RESET INIT ABORT ADDRESS FOR DRIVER STA INITE LDA DUNIT DESTINATION UNIT # STA UN#IT SET UNIT # FOR DRIVER CLA,INA SET IFLAG SO THAT DRIVER DOES NOT PROCESS ERRORS STA IFLAG LDA TRACK TRACK # JUST FOUND DEFECTIVE ADA N1 ADD -1 TO IT STA TRACK TRACK # OF EVEN # TRACK ALREADY WRITTEN LDB AJB BUFFER ADDRESS JSB RD05 READ THE EVEN NUMBERED TRACK FROM DEST U CLA CLEAR IFLAG STA IFLAG LDA ANXSE SET INIT ABORT ADDRESS FOR DRIVER STA INITE LDA UBADC # OF USED SPARES CMA,INA ADA CSPAR A REG HAS SPARE TRACK TO BE USED ADA N1 -1 MAKES IT EVEN TRACK # JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED ¸rþúJSB WRITE DEF ERR9 PRINT BAD TRACK HEADER DEF D7 LDA TRACK JSB PTRK5 JSB WRITE DEF SPMS SPARED TO: DEF D5 LDA SPTRK DIVIDE SPARE TRACK# BY 2 JSB PTRK5 PRINT LOC OF SPARE TRACK ON TTY LDA UBADC ADA D2 UPDATE # OF SPARES USED STA UBADC ISZ TRACK SET TRACK # BACK TO ORIGINAL # LDA AINIE RESET INIT ABORT ADDRESS STA INITE JSB RDSK5,I RETURN TO ORIGINAL LOC * ENTER HERE IF A SPARE IS BAD NXSPD LDA UBADC # OF USED SPARES ADA D2 INCREMENT IT BY 2 STA UBADC JMP INIEC * ENTER HERE IF A BAD SPARE IS FOUND AND IT IS EVEN # TRACK * AND ITS CORRESPONDING ODD TRACK HAS BEEN ALREADY SPARED NXSPE LDA UBADC ADA D2 STA UBADC ISZ TRACK JSB RD05 READ THE ODD SPARED TRACK DATA BACK IN A JMP INIEC AND REDO SPARING USING NEXT TWO TRACKS * AINIE DEF INIER AINXS DEF NIXSP ANXSD DEF NXSPD ANXSE DEF NXSPE M1400 OCT 1400 M440 OCT 440 SPMS ASC 5,SPARED TO: * WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 STAT1 NOP STAT2 NOP * * * UWAIT WAIT FOR UNIT TO BECOM AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * * * RECAL RECALABLRATE THE DISC ON CYLINDER COMAPRE ERRORS * RECAL ISZ DERCN INCREMENT DISC ERROR COUNT JMP RECL1 NOT 10 YET CMPER JSB INT5N ERROR ENCOUNTERED 10 TIMES JSB WRITE DEF ERR13 CYLINDER OR HEAD/SECT COMPARE ERROR AT: DEF D20 LDA TRCK1 JSB PTRK5 PRINT TRACK ADDRESS JMP ABRT? ABORT OR CONTINUE? RECL1 LDA CALC GET COMMAND JMP UWAT1 GO SEND IT * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * EXC¹ÏþúEPT IF WE JUST READ A CHUNCK TO WRITE PROTECT IT. * ALSO IF DOING INITIALIZE AND NOT FLAGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * ENDOK LDA INIT1 GET THE INIT FLAG SZA,RSS IF CLEAR JMP ENDSX JUST GO SEND THE END * RAL,SLA IF SPARING JMP SPARA GP SET UP SPARE ADDRESS * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB SIZE EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT JSB INT5N TURN ON INTERRUPTS JMP DISK5,I AND EXIT * * SPARA SETS ADDRESSES TO VERIFY A SPARE TRACK * SPARA DLD CYLA2 USE THE REAL DST CYLAD ADDRESS FOR SEEK JMP STDAD GO TRY THE VERIFY * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER, THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE OTA 6 DMA CLC 2 OTB 2 STC 2 LDA SIZE OTA 2 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPB ACTCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC é®þú RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC DC TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA DC,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C START THE DMA DSK22 STC DC AND THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT * * XFER COMMAND TABLE * WAITC OCT 113000 SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF WA#KE DEF SEEKC DEF VERCM DEF CALC DEF ADRES ACTCM DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF PT#SK DEF PT#AD DEF P#EN #UNST ABS UNITC-*+1 NUMBER IN THE LIST * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * # HEAD/CYL AT: NSRFC * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * LDB MAPAD SET MAP ADDRESS IN B. * JSB DADTR CALL * RETURN A=UNIT#, B=HEAD * * DADTR NOP STB H#AD SAVE THE ADDRESS INB BUMP TO THE HEAD/UNIT STA DTEMP SAVE THE TRACK ADDRESS STB UNCOU SAVE UNIT ADDRESS LDA B,I GET AND ISOLATÿ<þúE ALF # HEADS PER CYL AND M17 STA PT#TR SAVE IT STA NSRFC # OF HEADS/CYLINDER CLB DIVIDE # TRACKS LDA DTEMP BY DIV PT#TR NUMBER OF HEADS/CYL ADA H#AD,I ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE ADB UNCOU,I ADD THE BASE HEAD ADDRESS LDA B PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT# FROM LOW B AND M377 ISOLATE UNIT# JMP DADTR,I RETURN B=HEAD, A=UNIT# * M377 OCT 377 DTEMP NOP * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA DC,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB DC,C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN * * * OUTCC OUTPUT A COMMAND WORD * OUTCC NOP DSK26 CLC DC SEND "HERE COME DE WORD" DSK27 OTA DC,C SEND DE WORD DSK28 STC DC SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS DC HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN * * M37 OCT 37 STACC OCT 1400 M17 OCT 17 M74C OCT 7400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP DCMND NOP DISC ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP W#CMD NOP RDSK5 NOP MES32 ASC 11,TURN OFF DISC PROTECT MES33 ASC 11,TURN ON FORMAT SWITCH MS4 ASC 5,READY DISC * * Gyþú * * PTRK5 - PRINT LOCATION OF TRACK ON TTY * CALLING SEQUENCE: JSB PTRK5 * A REG = TRACK# * * PTRK5 NOP STA TEMP1 SAVE TRACK # LDB DIST1 FIND PHYSICAL TRACK ADDRESS JSB DADTR LDA ATB32 IF TRACK SPARING IS DESIRED TEHN ADA N1 LDA A,I SSA,RSS SBCHNL #'S ARE REAL, OTHERWISE MADE UP B JMP PTR55 TRACK SPARING NOT DESIRED LDA SYSTP DOS SYSTEM? SZA,RSS JMP PTR52 NO LDA TEMP1 YES, THEN DIVIDE TRACK # BY 2 ARS FOR DOS LOGICAL TRACK # STA TEMP1 PTR52 JSB DCASC CONVERT SUBCHANNEL # TO ASCII DEF *+4 DEF TRAD1+4 DEF D1 DEF SUB# SUBCHANNEL # JSB DCASC CONVERT LOGICAL TRACK# TO ASCII DEF *+4 DEF TRAD1+10 DEF D2 DEF TEMP1 TRACK# JSB WRITE PRINT SUBCHNL AND TRACK#'S DEF TRAD1 DEF D12 * PTR55 JSB DCASC CONVERT CYLINDER # TO ASCII DEF *+4 DEF TRAD2+2 DEF D2 DEF PT#TR CYLINDER # LDA H#AD ALF,ALF STA HEAD JSB DCASC CONVERT HEAD # TO ASCII DEF *+4 DEF TRAD2+8 DEF D1 DEF HEAD HEAD # JSB DCASC CONVERT UNIT# TO ASCII DEF *+4 DEF TRAD2+13 DEF D1 DEF UN#IT UNIT# JSB WRITE PRINT ABSOLUTE ADDRESS OF TRACK DEF TRAD2 DEF D14 JMP PTRK5,I RETURN * TRAD1 ASC 12,SBCHNL# , TRACK# TRAD2 ASC 14,CYL# , HEAD# , UNIT# * * * GETAL - GET CHAR FROM RBUF, RETURN IN A * CALLING SEQUENCE: JSB GETAL * RETURNS: CURRENT CHAR IN A REG * * GETAL NOP LDA CMFLG CMFLG=COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR ‹þú CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR RBUF ADDRESS STB BUFUL SAVE U/L FLAGE CPA BLANK CHAR=BLANK? RSS JMP COMIN COMMA IN? ISZ MAXC INCREMENT MAX CHAR COUNT JMP IGNOR IGNORE BLANKS JMP BLRET RETURN WITH BLANK COMIN CPA COMMA CHAR=COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN (SKIPS) JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK * COMMA OCT 54 BLANK OCT 40 BUFUL NOP CMFLG NOP COMMA FLAG=-1/0 = NOT IN/IN * * * GETOC - CONVERT OCT/DEC ASCII TO BINARY - CONVERTS THE NEXT CHAR * IN RBUF FROM ASCII TO THEIR BINARY (DECIMAL OR OCTAL) VALUE * CALLING SEQUENCE: JSB GETOC * A REG = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * +VE, THE REQUEST IS FOR OCTAL, IF A IS -VE, THE * REQUEST IS FOR DECIMAL * RETURN: P - INVALID DIGIT OR OVERFLOW IN CONVERSION * P+1 - A = CONVERTED # * * GETOC NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO -VE STA MAXC SET MAX. NO OF DIGITS CCA STA DIFLG SET DATA-IN FLAG=NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO=OCTAL # GETNX JSB GETAL GET CHAR FROM RBUF CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES-RETURN ADA .N60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG CLE,SSA,RSS JMP DGERR ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCT NO ADA A SET A = OCT NO * 2 x þú ADA A SET A = OCTNO * 4 LDB DRANG GET DIGIT RANGE CPB N10 RENGE=DECIMAL? ADA OCTNO SET A = OCTNO * 5 ADA A SET A = OCTNO * 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR * TCHAR NOP MAXC NOP DIFLG NOP DATA-IN FLAG = -1/0 = NOT IN/IN DRANG NOP DIGIT RANGE OCTNO NOP OCTAL # * * * GINIT - INITIALIZE CHAR TRANSFER - ROUTINE SETS THE CURRENT * ADDRESS AND UPPER/LOWER FLAG FOR SCANNING RBUF * CALLING SEQUENCE: JSB GINIT * * GINIT NOP LDA ARBUF ALBUF = ADDR OF RBUF STA CURAL SET CURRENT RBUF ADDRESS CCB STB BUFUL BUFUL=BUFFER U/L FLAG JMP GINIT,I * .N60 OCT -60 CURAL NOP * * * DCASC - ROUTINE CONVERTS DECIMAL NUMBERS TO ASCII * CALLING SEQUENCE: JSB DCASC * DEF *+4 RETURN ADDRESS * DEF PARM1 PARM1 IS VARIABLE NAME TO CONTAIN * DEF PARM2 PARM2 IS MAX # OF WORDS IN PARM1 * DEF PARM3 PARM3 IS THE DEC# TO BE CONVERTED * * DCASC NOP CLA STA DFLAG STA CWORD LDA DCASC,I STA RETRN ISZ DCASC LDA DCASC,I STA INAM BUFFER ADDRESS ISZ DCASC LDA DCASC,I LDA A,I ADA N1 STA NWORD LENGTH OF BUFFER-1 LDA INAM BUFFER TO BE BLANKED LOOP0 LDB SPACE STB A,I BLANK OUT A WORD IN BUFFER LDB CWORD USE CWORD AS COUNTER TO POINT IN TO BUFFER CPB NWORD ALL WORDS IN BUFFER DONE? ³îþú JMP DCAS1 YES, GO ON INA ISZ CWORD INCREMENT COUNTER JMP LOOP0 DCAS1 ISZ DCASC LDA DCASC,I LDA A,I LOAD INTEGER TO BE CONVERTED LOOP CLB DIV D10 DIVIDE INTEGER BY BASE 10 STA QOTNT QOTNT IS USED TO EXTRACT REMAINING DIGITS ADB .60 B REG CONTAINS REMAINDER WHICH IS THE LATEST DIGIT * TO BE CONVERTED BY ADDING OCTAL 60 STB BYTE ASCII INTEGER SAVED LDA DFLAG CHECK TO SEE IF THIS IS A LOW ORDER BYTE SZA LOW ORDER BYTE IF IFLAG=0, ELSE HIGH ORDER BYTE JMP HIGH LDA BYTE STA CWORD STORE BYTE IN LOWER HALF OF CWORD LDA QOTNT GET READY TO EXTRACT AND CONVERT NEXT DIGIT ISZ DFLAG SET FLAG TO INDICATE WORKING ON HIGH ORDER BYTE JMP LOOP START CONVERSION AGAIN HIGH LDA BYTE BIT 0 NOT SET IF HIGH ORDER BYTE ALF,ALF STORE BYTE IN UPPER HALF OF CWORD ADA CWORD STA CWORD LDA NWORD ADA INAM REG A POINTS TO BUFFER WHERE CWORD IS PLACED LDB CWORD STB A,I LDA NWORD SZA,RSS HAS THE BUFFER BEEN FILLED? JMP RETRN,I YES,RETURN TO CALLING ROUTINE ADA N1 NO,DECREASE NWORD TO POINT TO NEXT WORD IN BUFFER STA NWORD CLA STA DFLAG CLEAR FLAG TO INDICATE WORKING ON LOW ORDER BYTE LDA QOTNT GET READY TO EXTRACT NEXT DIGIT SZA IF QOTNT=0 THEN NO MORE DIGITS LEFT TO CONVERT JMP LOOP JMP RETRN,I * RETRN NOP NWORD NOP CWORD NOP QOTNT NOP BYTE NOP INAM NOP DFLAG NOP ADWRD DEF CWORD .60 OCT 60 * * * RMOVI - REMOVES INDIRECTS FROM ADDRESSES PASSED AS PARAMETERS * CALLING SEQUENCE: JSB RMOVI * A REG = ADDR WHOSE INDIRECTS HAVE TO BE REMOVED * RETURNS: ADDRESS WITHOUT INDIRECTS IN A REG * * RMOVI NOP ROUTINE TO REMOVE INDIRECTS FROM DEF ADDRESSES RSS Uþú MOREI LDA A,I REG A HAS INDIRECT ADDRESS RAL,CLE,SLA,ERA JMP MOREI STILL AN INDIRECT ADDRESS JMP RMOVI,I * * * ***** MESSAGES ****** * * MSG1 ASC 10,DISC BACKUP UTILITY MSG2 ASC 3,TASK? EXP2 ASC 13,REPLIES ARE: SA,RE,CO,RW MSG3 ASC 7,TYPE OF XXXX? EXP3 ASC 9,REPLIES ARE: UN,FR MSG4 ASC 11, DISC CHANNEL#? EXP4 ASC 10,REPLY 10 TO 77 OCTAL MSG5 ASC 9,SOURCE DISC TYPE? EXP5 ASC 19,REPLIES ARE:7900,7905,7906,7920,7925 MSG6 ASC 10,WANT TRACK SPARING? EXP6 ASC 10,REPLIES ARE: YES,NO MSG7 ASC 8,RTE OR DOS DISC? EXP7 ASC 9,REPLIES ARE: RT,DO MSG8 ASC 28,ENTER TRACK MAP INFO FOR SOURCE DISC UNIT AS SHOWN BELOW MSG9 ASC 8,FROM CYLINDER#? MSG9A ASC 7,FROM TRACK #? MSG9B ASC 7,TO CYLINDER #? MSG9C ASC 5,TO TRACK#? EXP9 ASC 7,REPLY 0 TO 410 EXP9A ASC 7,REPLY 0 TO 202 MSG10 ASC 6,# OF TRACKS? EXP10 ASC 8,REPLY 1 TO 1233 EX10A ASC 14,REPLY 1 TO (203-FROM TRACK#) EX10B ASC 7,REPLY 1 TO 200 MSG11 ASC 7,# OF SURFACES? EXP11 ASC 6,REPLY 1 TO 3 MSG12 ASC 8,STARTING HEAD#? EXP12 ASC 6,REPLY 0 TO 2 MSG13 ASC 5,PLATTER #? EXP13 ASC 19,REPLIES ARE: 0,1 (0-FIXED,1-REMOVABLE) MSG14 ASC 9,MAG TAPE CHANNEL#? MSG15 ASC 4,FILE ID? EXP15 ASC 17,ENTER 72 CHAR MAX MT FILE ID MSG16 ASC 5,MT FILE#? EXP16 ASC 6,REPLY 1 TO 8 MSG17 ASC 4,VERIFY? MSG18 ASC 14,EOT REACHED, MOUNT NEXT TAPE MSG19 ASC 7,TASK COMPLETED MSG20 ASC 15,DISC BACKUP UTILITY IS ABORTED MSG21 ASC 10,SOURCE DISC DRIVE#? EXP21 ASC 6,REPLY 0 TO 7 EX21A ASC 6,REPLY 0 TO 3 MSG22 ASC 8,VERIFY ERROR AT: MSG23 ASC 6,MT NOT READY MSG24 ASC 13,TRACK SIZE BUFFER DESIRED? MSG25 ASC 23,MEM SIZE TOO SMALL FOR VERIFY W/ 6144 WORD BUF MSG26 ASC 9,MOUNT CORRECT TAPE MSG27 ASC 16,RESTART UTILITY BY ENTERING 'GO' MSG28 ASC 5,CONTINUE? MSG29 ASC 7,MOUNT TAPE# 1 MSG30 ASC 25,TRACK AT FOLLOWING LOC WAS NOT SAVED SUCCESSFULLY MSG31 ASC 5,VERIFYING MSG32 ASC 14,# OF SUBCHNLS TO BE COPIED? EXP32 ASC 6,REPLY 1 TO 3 ERR0 ASC 5,WARNING -- ERR1 ASC 7,FILE¼º¶ NOT FOUND ERR2 ASC 15,NO WRITE RING, WRITE ENABLE MT ERR4 ASC 17,OUT OF SPARE TRACKS FOR SUBCHNL ERR5 ASC 10,LAST TRACK TOO LARGE ERR6 ASC 16,SUBCHNLS ON SOURCE UNIT OVERLAP ERR7 ASC 15,IMPROPERLY DEFINED SUBCHNL: ERR8 ASC 22,UNRECOVERABLE DISC ERROR-EOC OR SEEK CHECK ERR9 ASC 7,BAD TRACK AT: ERR12 ASC 9,ILLEGAL SPARE AT: ERR13 ASC 20,CYLINDER OR HEAD/SECT COMPARE ERROR AT: END DBKUP º¼ÿÿ ÿý!Np ÿ92067-18341 2013 S C0122 &SYCON              H0101 ŽŠASMB,R,L,C * NAME: SYCON * SOURCE: 92067-18341 * RELOC: 92067-16268 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SYCON,7 92067-1X341 REV.2013 780921 ENT SYCON EXT .ENTR PARAMETER ADDRESS FETCH ROUTINE EXT XLUEX EXTENDED EXEC CALL * * ROUTINE TO WRITE A MESSAGE TO THE SYSTEM CONSOLE (LU 1) * * CALLING SEQUENCE: JSB SYCON * DEF *+3 * DEF IBUF BUFFER TO BE WRITTEN * DEF IBUFL BUFFER LENGTH * IBUF NOP BUFFER IBUFL NOP BUFFER LENGTH SYCON NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF IBUF JSB XLUEX EXTENDED EXEC WRITE DEF *+5 DEF .2 WRITE REQUEST DEF LU LU 1, WITH NO SWITCH OPTION DEF IBUF,I BUFFER TO BE WRITTEN DEF IBUFL,I BUFFER LENGTH JMP SYCON,I RETURN .2 DEC 2 LU OCT 100001 OCT 0 END Ëòÿÿ ÿý"( ÿ92067-18342 2040 S C0122 &AN4F0 7900 GFR ANSWER FILE             H0101 µ‘þú&LIST0::10 ***LIST FILE - STORED ON FIXED DISC ** ANSWER FILE &AN4F0 92067-18342 2040 RTE4B 7900 801001 YES *ECHO ON !SYST0::10 ::4000 ***SYSTEM FILE - STORED ON FIXED DISC 7900 *SYSTEM DISC TYPE 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 203,0 *SUBCHANNEL 0 203,0 *SUBCHANNEL 1 /E *TERMINATE SUBCHANNEL DEFINITION 1 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 64 *MEMORY SIZE !BOOT0::10 ***BOOT FILE STORED ON FIXED DISC MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IVB OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%DBUGR::32767 *USER DEBUG SUBROUTINE REL,%$CNFX::32767 *CONFIGURATOR EXTENSION * *********************** DRIVERS * REL,%DVR31::32767 *7900 DISC DRIVER REL,%DVR32::32767 *7905/06/20/25 DISC DRIVER REL,%$TB32::32767 *7905/06/20/25 TRACK MAP TABLE REL,%DVR00::32767 *TTY/PUNCH/PHOTOREADER DVR REL,%DVA32::32767 *7906H/20H/25H/9895 DISC DRIVER REL,%$TA32::32767 *7906H/óþú20H/25H/9895 AUX TRACK MAP REL,%4DV05::32767 *2644/45 DRIVER (WITH CTU) REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVB12::32767 *2608 LINE PRINTER DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4LDR::32767 *CURRENT PAGE LINKING LOADER REL,$LDRLB::32767 *LOADER LIBRARY REL,%WHZAT::32767 *WHZAT REL,%BMPG1::32767 *FILE MANAGER REL,%BMPG2::32767 *D.RTR DIRECTORY MGR REL,%RT4GN::32767 *GENERATOR REL,%SSTCH::32767 *SWITCH PROGRAM REL,%SAVE::32767 *7900 DISC SAVE PROGRAM REL,%RSTOR::32767 *7900 DISC RESTORE PROGRAM REL,%COPY::32767 *7900 DISC COPY PROGRAM REL,%VERFY::32767 *7900 DISC VERIFY PROGRAM REL,%HELP::32767 *HELP PROGRAM REL,%NSESN::32767 *NON-SESSION LIBRARY * ********************** LIBRARIES * REL,$DSCLB::32767 *DISC DRIVER LIBRARY REL,$DKULB::32767 *DISC BACKUP LIBRARY REL,%DBKLB::32767 *7900 DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%BMPG3::32767 *BATCH LIBRARY REL,%UTLIB::32767 *UTILITIES LIBRARY REL,$MLIB1::32767 *SYSTEM INDEPENDENT LIBRARY REL,$MLIB2::32767 *SYSTEM INDEPENDENT LIBRARY PT. 2 * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * SWTCH,4 RT4GN,4 D.RTR,3,1 WHZAT,3,1 LGTAT,1,41 LOADR,3,97 EDITR,3,50 /E b.þú *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * *.MPY,RP,100200 *.DIV,RP,100400 *.DLD,RP,104200 *.DST,RP,104400 *.MVW,RP,105777 Z$DBL,RP,3 * 3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 * EMA MICROCODE - APPLICABLE * .EMIO,RP,105240 *** ON 21MX E-SERIES ONLY * MMAP,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR31,D *EQT # 1 - 7900 DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER 25,DVB12,B,X=5 *EQT # 9 - 2608 LINE PRINTER 23,DVR32,D *EQT #10 - 7905/06/20/25 DISC 24,DVA32,D,T=200 *EQT #11 - 7906H/20H/25H/9895 DISC /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * 2,0 *LU # 1 - SYSTEM CONSOLE 1,1 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,0 Á—þú *LU # 10 - 7900 SUBCHANNEL 0 0 *LU # 11 - UNASSIGNED 0 *LU # 12 - UNASSIGNED 0 *LU # 13 - UNASSIGNED 0 *LU # 14 - UNASSIGNED 0 *LU # 15 - UNASSIGNED 0 *LU # 16 - UNASSIGNED 0 *LU # 17 - UNASSIGNED 0 *LU # 18 - UNASSIGNED 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER 9,0 *LU # 21 - 2608 LINE PRINTER 10,0 *LU # 22 - 7905/06/20/25 DISC LU * ****DISC SUBCHANNEL 00 OF $TB32 11,0 *LU # 23 - 7906H/20H/25H/9895 DISC LU * ****DISC SUBCHANNEL 00 OF $TA32 /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 12,EQT,1 13,EQT,2 14,EQT,6 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 23,EQT,10 24,EQT,11 25,EQT,9 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * **********************°ÿ********** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 20,BG 14,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,20 RT4GN,20 SAVE,16 RSTOR,16 COPY,16 VERFY,16 EDITR,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT óàÿÿ ÿý# - ÿ92067-18343 2040 S C0122 &AN4F5 7905/06/20 GFR ANSWER FILE            H0101 íÊþú&LIST5::10 ***LIST FILE NAME ** ANSWER FILE &AN4F5 92067-18343 2040 RTE4B 7905 801001 YES *ECHO ON !SYST5::10::4000 ***SYSTEM FILE NAME - STORED ON LU 10 7905 *SYSTEM DISC TYPE: 7905/06/20 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 7920,256,0,0,2,0,8 *SUBCHANNEL 0 7920,203,132,0,2,0,5 *SUBCHANNEL 1 7920,203,236,0,2,0,5 *SUBCHANNEL 2 7920,138,340,0,2,0,4 *SUBCHANNEL 3 7920,203,0,2,1,0,5 *SUBCHANNEL 4 7920,198,208,2,1,0,5 *SUBCHANNEL 5 7920,400,0,3,1,0,11 *SUBCHANNEL 6 7920,400,0,4,1,0,11 *SUBCHANNEL 7 7920,1024,411,0,5,0,26 *SUBCHANNEL 8 7920,985,621,0,5,0,25 *SUBCHANNEL 9 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 64 *MEMORY SIZE !BOOT5::10 ***BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IVB OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS ¡'þú* REL,%DVR00::32767 *TTY/PUNCH/PHOTOREADER DVR REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%4DV05::32767 *2644/45 DRIVER (WITH CTU) REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVB12::32767 *2608 LINE PRINTER DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR32::32767 *7905/06/20 DISC DRIVER REL,%DVA32::32767 *7906H/20H/25H/9895 DISC DRIVER REL,%$TA32::32767 *7906H/20H/25H/9895 AUX TRACK MAP * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *CURRENT PAGE LINKING LOADER REL,$LDRLB::32767 *LOADER LIBRARY REL,%WHZAT::32767 *WHZAT REL,%BMPG1::32767 *FILE MANAGER REL,%BMPG2::32767 *D.RTR DIRECTORY MGR REL,%RT4GN::32767 *GENERATOR REL,%SSTCH::32767 *SWITCH PROGRAM REL,%FORMT::32767 *MAC/ICD DISC INITIALIZATION PROGRAM REL,%LSAVE::32767 *MAC/ICD DISC LU SAVE PROGRAM REL,%USAVE::32767 *MAC/ICD DISC UNIT SAVE PROGRAM REL,%LCOPY::32767 *MAC/ICD DISC COPY PROGRAM REL,%RESTR::32767 *MAC/ICD DISC RESTORE PROGRAM REL,%HELP ::32767 *HELP PROGRAM REL,%SMON1::32767 *SESSION MONITOR SOFTWARE REL,%SMON2::32767 *SESSION MONITOR SOFTWARE * ********************** LIBRARIES * REL,$DSCLB::32767 *DISC DRIVER LIBRARY REL,$DKULB::32767 *DI¦gþúSC BACKUP LIBRARY REL,%DBKLB::32767 *7900 DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%BMPG3::32767 *BATCH LIBRARY REL,%UTLIB::32767 *UTILITIES LIBRARY REL,$MLIB1::32767 *SYSTEM INDEPENDENT LIBRARY PT.1 REL,$MLIB2::32767 *SYSTEM INDEPENDENT LIBRARY PT.2 * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * FORMT,4 SWTCH,4 RT4GN,4 LCOPY,4 D.RTR,3,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * *.MPY,RP,100200 *.DIV,RP,100400 *.DLD,RP,104200 *.DST,RP,104400 *.MVW,RP,105777 Z$DBL,RP,3 *3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 ***ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR32,D *EQT # 1 - 7905/06/20 DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER 25,DVB12,B,X=5 *EQT # 9 - 2608 LINE PRINTER 24,DVA32,D,T=200 *EQT Ñüþú#10 - 7906H/20H/25H/9895 DISC /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7905/06/20 SUBCHANNEL 1 1,2 *LU # 11 - 7905/06/20 SUBCHANNEL 2 1,3 *LU # 12 - 7905/06/20 SUBCHANNEL 3 1,4 *LU # 13 - 7905/06/20 SUBCHANNEL 4 1,5 *LU # 14 - 7905/05/20 SUBCHANNEL 5 1,6 *LU # 15 - 7906/20 SUBCHANNEL 6 1,7 *LU # 16 - 7920 SUBCHANNEL 7 1,8 *LU # 17 - 7920 SUBCHANNEL 8 1,9 *LU # 18 - 7920 SUBCHANNEL 9 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER 9,0 *LU # 21 - 2608 LINE PRINTER 10,0 *LU # 22 - 7906H/20H/25H/9895 DISC LU * ****DISC SUBCHANNEL 00 OF $TA32 /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,PRG,PRMPT 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 24,EQT,10 25,EQT,9 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIEà=S * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 20,BG 14,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,20 RT4GN,20 FORMT,17 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT `ƒÿÿ ÿý$ . ÿ92067-18344 2026 S C0122 &LSAVE ON LINE LU SAVE              H0101 ºjþúFTN4,Q,C PROGRAM LSAVE(4,60),92067-16344 REV.2026 800501 C C C C SOURCE PART NO.: 92067-18344 C RELOC. PART NO.: 92067-16344 C NAME : LSAVE C C C PROGRAMMER: J.S.W. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C THIS PROGRAM SAVES ALL TRACKS ON AN LU TO MAG TAPE C ACCORDING TO THE TRACK MAP TABLE DEFINITION. THE RUN FORMAT: C C RU,LSAVE,,,,[VE], C WHERE C <LOG LU> IS THE LOG DEVICE FOR ERROR MESSAGES C <DISC-LU> IS THE DISC LU WHERE DATA ARE SAVED C <MT LU> IS THE MAG TAPE LU C <VE> VE MEANS VERIFY, OTHERS MEANS NO VERIFY C <TITLE> IS A 50 CHARACTER LABEL SUPPLIED BY USER C C VERIFY CAN BE SELECTED AS OPTION. C C SEQUENCE OF OPERATIONS: C 1. GETS RUN STRING AND CHECK IF EACH PARATER IS VALID (I.E.DISK LU) C IF NO COMMAS IN RUN STRING, ASK PARATERS INTERACTIVELY C C 2 PUTS CURRENT TIME DATE AND DAY ON MT HEADER (IHDR) C C 3. GETS TRACK MAP TABLES BY MAKING SPECIAL EXEC CALL (SUBFUN=2200B) C AND PUTS IT IN MT HEADER C C 4. REQUEST MT LU LOCK AND CHECK WRITE RING ON MAG TAPE C C 5. WRITE OUT HEADRER RECORD ON MAG TAPE (247 WORDS) C C 6. COMPUTE NO. OF TRACKS IN SUBCHANNEL,SECTOR PER TRACK, AND C NO. OF WORDS PER TRACK ( MAG TAPE RECORD SIZE) C C 7. GO THRU ALL TRACKS IN SUBCHHAL, READ ONE TRACK C BY USING DISC LIBRARY ROUTINES (CALLING FROM RDATK) C WRITE THE TRACK IN MT. C C 8. IF VERIFY IS DESIRED, BACKSPACE ONE FILE AND READ ONE RECORD C THEN COMPARE DATA WITH THE TRACK C C C DIMENSION IBUF(1),IXBUF(8208),IVBUF(256), X I������þúSTR(80),IHDR(247),ITME(15),ITX32(161),ISUBC(5),ITEMP(5), X IPBUF(10),MSG1(10),IPARM(5) C C C C EQUIVALENCE X (ITME,IHDR(1)), X (ITX32,IHDR(77)), X (ISUBC(1),IHDR(239)), X (LU2,IHDR(244)), X (ISTR(1),IHDR(17)), X (LSAVEN,IHDR(245)), X (IBUF(1),IXBUF(16)), X (LUSUB,IHDR(246)), X (ITAPE,IHDR(247)) C C DATA MSG1/2H ,2H ,2H ,2H T,2HRA,2HCK,2HS ,2HSA, X 2HVE,2HD / C C**************************************************************************** C C GET PARAMETER AND CURRENT TIME C C CALLING SEQUENCE PARATER C ISTR- TITLE OR RU STRING C N=1 INDICATES LSAVE C LOG LOG LU RETURNED C IDLU DISC LU C MTLU MT LU C IVERFY =1 FOR VERFIFY NOT =1 NO VERIFY C C CALL XGTPM(ISTR,1,LOG,IDLU,MTLU,IVRFY) CALL FTIME(ITME) ITAPE=1 IPARM=2H C ITTY=LOGLU(ISES) C MT LU THE VALUE IS 23 C C C GET SUBCHANNEL NO. FROM EQT4 FOR THE DISK C C C/ CALL EXEC(13,IDLU,IEQT5,IEQT4,ISTA3) LUSUB=IAND(IEQT4,3700B)/100B C C C UNBUFFER THE MAG TAPE , REMEMBER TO PUT IT BACK LATER C IFLAG = 0 CALL XMTBU(MTLU,IFLAG) C C CALL EXEC(13,MTLU,IEQT5) IF(IAND(IEQT5,37000B)-11000B) 910,1000,910 1000 CONTINUE C C CALL EXEC(13,IDLU,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 980,1010,980 1010 CONTINUE C C GO GET TRACK MAP TABLE ,FIRST THE ENTIRE TABLE AND THEN C THE SUBCHANNEL ENTRY (5 WORDS) FOR THIS LU C C CALL EXEC(1,IDLU+2200B,ITX32, 161,0,5) CALL EXEC(1,IDLU+2200B,ISUBC, 5,0,5) C C IF(ITX32(1).GT.0) CALL EXEC(2,LOG,17HINVALID TRACK MAP,-17) C C INDICATES LSAVE AND SET LU 2 OR LU 3 FLAG IF IDLU IS 2 OR 3 C LSAVEN=1 IF(IDLU.EQ.2.OR.IDLU.EQ.3) LU2=1 C C C CHECK WRITE RING C 25 CALL EXEC(3,600B+MTLU) CALL ABREG(IA, ������þúIB) IF(IAND(IA,4B).EQ.4) GO TO 920 C C WRITE MT HEADER C CALL EXEC(2,MTLU,IHDR,247) C C NOW SET UP SECTORS PER TRACK, NO. OF TRACKS AND TRACK SIZE MXSEC=ISUBC(1) MXTRK=ISUBC(4) ISIZE=MXSEC*64+1 C C FOR TRACK NO. ZERO TO LAST TRACK, READ ONE TRACK C SET UP TRACK NO. IN IBUF(1), AND WRITE IT ON MAG TAPE C IF END OF TAPE CALL WREOT TO HANDLE IT C WHEN DONE WRITE END OF FILE MARK C C C C LOCK THE PROGRAM IN CORE TO PREVENT DEADLOCKS C CALL EXEC(22+100000B,1) GO TO 30 29 GO TO 40 30 CALL EXEC(2,LOG,33H UNABLE TO LOCK PROGRAM IN MEMORY,-33) CALL EXEC(2,LOG,32H WARNING: DEADLOCKS MAY OCCUR!,-32) 40 CONTINUE C C CLEAR END-OF-TAPE FLAG C IEOT=0 DO 100 LTRK=0,MXTRK-1 C SAVE TRK # IBUF(1)=LTRK CALL RDATK(IDLU,LTRK,0,ISIZE-1,ISUBC,IXBUF,IBT,LOG) C C IF BAD TRACK SET IPARM TO -1 FOR 10 G RETURN C IF(IBT.EQ.1) IPARM(1)=2H-1 CALL EXEC(2,MTLU,IBUF,ISIZE) CALL ABREG(IS1,LEN) IF(LEN.EQ.0) GO TO 960 IF(IAND(IS1,2).EQ.2) GO TO 970 IF(IAND(IS1,40B).EQ.40B) IEOT=1 IF(IAND(IS1,40B).EQ.40B) CALL WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE) 100 CONTINUE C ENDFILE MTLU C C PRINT MESSAGE: XXX TRACKS SAVED C CALL PRTN TO RETURN -1 OF 0 IN 10G C CALL CNUMD(MXTRK,MSG1) CALL EXEC(2,LOG+200B,MSG1,-19) C C C C C IF VERIFY, BACKSPACE FILE AND READ ONE TRACK, COMPARE DATA UNTIL C LAST TRACK C C IF(IVRFY.NEQ.1) GO TO 777 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERIFY C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK EOF FLAG, IF SET ASK TO REMOUNT TAPE ONE C C C IF(IEOT.EQ.0) GO TO 199 C C ASK USER TO RE-MOUNT TAPE 1 AND ENTER FILE # C 177 CALL EXEC(2,ITTY, X 26HRE-MOUNT TAPE #1 FOR VERFY,-26) CALL EXEC(2,ITTY, X 26HTHEN TYPE "GO" TO CONTINUE,-26) CALL EXEC(1,ITTY+400B,‚Ù������þúI,-2) IF(I.NEQ.2HGO) GO TO 177 C C CHECK IF MT IS ON LINE C CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.0) GO TO 188 CALL EXEC(2,ITTY,17HMAG TAPE OFF-LINE,-17) GO TO 177 C C C ASK FOR FILE #, PARSE INPUT AND CONVERT INTO BINARY C THEN FORWARD SPACE N FILES C 188 CALL EXEC(2,ITTY,7HFILE #?,-7) CALL EXEC(1,ITTY+400B,ITEMP,-6) CALL ABREG(IA,IB) LEN=IB IPTR=1 IF (NAMR(IPBUF,ITEMP,LEN,IPTR)) 188,190 190 IF(IAND(IPBUF(4),3).NEQ.1) GO TO 188 NFILE=IPBUF(1)-1 IF(NFILE.EQ.0) GO TO 250 DO 220 I=1,NFILE CALL EXEC(3,MTLU+1300B) 220 CONTINUE C C SKIP THE BACK SPACE FILE C GO TO 250 C C C 199 DO 200 I=1,247 200 IHDR(I)=2H C BACKSPACE 1 FILE - BF AND BR C THEN CHECK IF MT IS STILL BUSY BY DOING DYNAMIC STATUS C C CALL EXEC(3,MTLU+0200B) CALL EXEC(3,MTLU+1400B) 201 CALL EXEC(13,MTLU,IST) IF(IAND(IST,100000B).NEQ.0) GO TO 201 IF(IAND(IST,200B).NEQ.0)CALL EXEC(3,MTLU+300B) C C VERIFYING C 250 CALL EXEC(2,ITTY,9HVERIFYING,-9) C C READ HEADER FORM TAPE C CALL EXEC(1,MTLU,IHDR,247) C C PRINT HEADER C CALL EXEC(2,LOG+200B,IHDR,-75) C C SET UP SECTOR PER TRACK, TRACK SIZE C MXSEC=ISUBC(1) ISIZE=MXSEC*64+1 MXSEC=MXSEC-1 MXTRK=ISUBC(4) IERROR=0 C C C NOW VERIFY ALL TRACKS C DO 300 LTRK=0,MXTRK-1 C READ 1 BLOCK,INIT ERROR FLAG IERFG=0 K=2 CALL EXEC(1,MTLU,IBUF,ISIZE) CALL ABREG(IA,IB) IF(IAND(IA,40B).EQ.40B) CALL EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE) C C VERIFY 2 SECTORS C DO 350 ISEC=0,MXSEC,4 CALL EXEC(1+100000B,IDLU,IVBUF,256,LTRK,ISEC) GO TO 360 340 CALL COMPR(IBUF(K),IVBUF,256,IER) IF(IER.NEQ.0) IERFG=1 K=K+256 350 CONTINUE C D WRITE(1,8000) LTRK D8000 FORMAT("TRK ",I8) C C IF(IERFG.EQ.0) GO TO 300 360 IERROR=1gÔ����� CALL CNUMD(LTRK,ITEMP) CALL EXEC(2,LOG,21HVERIFY DATA ERROR-TRK,-21) CALL EXEC(2,LOG,ITEMP,-6) 300 CONTINUE C C IF(IERROR.EQ.0) CALL EXEC(2,LOG,9HVERIFY OK,-9) IF(IERROR.EQ.1) CALL EXEC(2,LOG,12HVERIFY ERROR,-12) C FORWARD SPACE 1 RECORD CALL EXEC(3,MTLU+300B) C 777 CALL LURQ(0,MTLU,1) CALL EXEC(22+100000B,0) GO TO 779 778 CALL PRTN(IPARM) 779 CALL XMTBU(MTLU,IFLAG) STOP 77 910 CALL EXEC(2,LOG,12HINVALID MTLU,-12) STOP 920 CALL EXEC(2,LOG,18HWRITE RING MISSING,-18) GO TO 990 930 CALL EXEC(2,LOG,15HINVALID DISK LU,-15) GO TO 990 960 CALL EXEC(2,LOG,14H MT XMIT ERROR,-14) GO TO 990 970 CALL EXEC(2,LOG+200B,16H MT PARITY ERROR,-16) GO TO 990 980 CALL EXEC(2,LOG+200B,17H UNSUPPORTED DISC,-17) 990 CALL XMTBU(MTLU,IFLAG) STOP 66 END ����������������������������������������������������������������������������������������������������������������������������������������������i������ÿÿ����� ���� ÿý�%� / ���������ÿ��92067-18345 2026� S C0122 �&USAVE ON LINE UNIT SAVE � � � � � � � � � � � � � �H0101 è¥�����þúFTN4,Q,C PROGRAM USAVE(4,60),92067-16345 REV.2026 800501 C C NAME: USAVE C C PART NO.: SOURCE- 92067-18345 C PART NO.: RELOC. 92067-16345 C C C PROGRAMMER: J.S.W.,JRS C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C C C THIS PROGRAM IS USED TO SAVE A DISC UNIT ACCORDING TO THE TRACK C MAP TABLE DEFINITION. THE RUN FORMAT IS: C C RU,USAVE[,<LOGLU>,<DISK LU>,<MT LU>,VE,<TITLE-LABEL> C WHERE C <LOGLU>- LOGGING DEVICE LU C <DISK-LU>- ANY DISC LU POINTING TO THE DISC UNIT C <MT LU> - MAG TAPE LU C VE- VERIFY C <TITLE>- 40 CHARACTER LABEL INFO. C C THE PROGRAM FIRST GETS ALL THE RUN STRING PARAMETERS (XGTPM) AND C THE TIME DATE AND DAY. IT THEN FINDS THE TRACK MAP TABLE FOR THE C ENTIRE DISC AND ALSO THE TMT ENTRY FOR <DISC LU>. IT FINDS ALL C THE SUBCHHANELS WITH IDENTICAL ADDRESS/UNIT # AND GO THRU EACH C ONE. FOR EACH SUBCHHANNEL, USAVE COMPUTES LAST TRACK, TRACK SIZE C AND CHECK IF THE SUBCHANNEL IS LU 2 OR 3 AND MARKS THE HEADER. C USAVE THEN READS THE TRACK, WRITES IT ON TAPE AND CHECKS EOT FOR C ALL TRACKS FORM 0 TO LAST TRACK C C C C DIMENSION IREG(2),IBUF(1),IXBUF(8208), IVBUF(128),VBUF(134), X ISTR(80),IHDR(247),ITME(15),ITX32(161),ISUBC(5),ITEMP(5), X IPBUF(10),MSG1(12),MSG2(11),IPARM(5) C INTEGER SUBNO,VBUF C C C EQUIVALENCE (REG,IA,IREG),(IB,IREG(2)), X (ITME,IHDR(1)), X (ITX32,IHDR(77)), X (ISUBC(1),IHDR(239)), X (LU2,IHDR(244)), X (ISTR(1),IHDR(16)), X (LSAVEN,IHDR(245))âô������þú, X (IBUF(1),IXBUF(16)), X (IVBUF(1),VBUF(17)), X (LUSUB,IHDR(246)), X (ITAPE,IHDR(247)) C DATA MSG1/2HSA,2HVI,2HNG,2H S,2HUB,2HCH,2HNN,2HL / DATA MSG2/2H ,2H ,2H ,2H ,2HSU,2HBC,2HHN,2HLS, X 2H S,2HAV,2HED/ C C C GET PARAMETER C CALL XGTPM(ISTR,1,LOG,IDLU,MTLU,IVRFY) CALL FTIME(ITME) C C SET TAPE NO. EQUAL TO 1 C AND SET UP INTERACTIVE DEVICE LU C C CLEAR END-OF-TAPE FLAG C CLEAR 10G RETURN C INIT TAPE # TO 1 C INIT INTERACTIVE LU TO LOGLU C C IEOT=0 IPARM(1)=2H ITAPE=1 ITTY=LOGLU(ISES) C C C UNBUFFER THE MAGTAPE, PUT IT BACK WHEN DONE C IFLAG = 0 CALL XMTBU(MTLU,IFLAG) C C CHECK FOR UNSUPPORTED DISCS C CALL EXEC(13,IDLU,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 985,1010,985 1010 CONTINUE C C GO GET TRACK MAP TABLE C REG=EXEC(1,IDLU+2200B,ITX32, 161,0,5) REG=EXEC(1,IDLU+2200B,ISUBC, 5,0,5) C C IF(ITX32(1).GT.0) STOP 7 LSUBCH=-ITX32(1)-1 IF(IDLU.EQ.2.OR.IDLU.EQ.3) LU2=1 C C LOCK THE PROGRAM IN MEMORY TO PREVENT DEADLOCKS C CALL EXEC(22+100000B,1) GO TO 30 29 GO TO 40 30 CALL EXEC(2,LOG,33H UNABLE TO LOCK PROGRAM IN MEMORY,-33) CALL EXEC(2,LOG,32H WARNING: DEADLOCKS MAY OCCUR!,-32) 40 CONTINUE C C C REQUEST MT LOCK C 10 CALL LURQ(140001B,MTLU,1) GO TO 15 11 CONTINUE 15 CALL ABREG(IA,IB) IF(IA.EQ.0) GO TO 25 CALL EXEC(2,ITTY,22HMAG TAPE BUSY (LOCKED),-22) C C C C REQ. MT LOCK WITH WAIT C CALL LURQ(1,MTLU,1) C C CHECK WRITE RING C 25 REG=EXEC(3,600B+MTLU) IF(IAND(IA,4B).EQ.4) GO TO 920 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C COUNT NO. OF SUBCHANNELS TO BE SAVED C GO THRU EACH SUBCHANNEL, IF DEVICE ADDRESS DOES NOT MATCH C SKIP THE SUBCHANNEL, ELSE C WRITE MT HEADER, COMPUTE LASTía������þú TRACK,SECTOR PER TRACK C TRACK SIZE AND SAVE ALL TRACKS FOR THIS SUBCH C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C LSAVEN=0 IUNIT=IAND(ISUBC(3),17B) C DO 5 I=0,LSUBCH CALL EXEC(1,IDLU+2200B,ISUBC,5,0,5) IF(IUNIT.EQ.IAND(ITX32(I*5+4),17B)) X LSAVEN=LSAVEN+1 5 CONTINUE C NLSAVE=LSAVEN C DO 5000 SUBNO=0,LSUBCH CALL EXEC(1,IDLU+2200B,ISUBC,5,0,5) IF(IUNIT.NEQ.IAND(ITX32(SUBNO*5+4),17B)) X GO TO 5000 C C MOVE THE 5 WORD ENTRY TO ISUBC FOR READ TRACK C DO 44 I=1,5 ISUBC(I)=ITX32(SUBNO*5+I+1) 44 CONTINUE C CHECK IF LU 2 OR 3 INCLUDED IN THIS UNIT C BY MATCHING SUBCHANNEL ENTRY WITH CURRENT SYSTEM C C CALL EXEC(13,2,IEQT5) IDTYP=IAND(IEQT5,37000B)/256 IF(IDTYP.LT.32B.OR.IDTYP.GE.34B) GO TO 50 CALL EXEC(1,2202B,ITEMP,5,0,5) CALL COMPR(ISUBC,ITEMP,5,IER) IF(IER.NEQ.0) LU2=1 C 50 CALL EXEC(13+100000B,3,IEQT5) GO TO 55 52 IDTYP=IAND(IEQT5,37000B)/256 IF (IDTYP.LT.32B.OR.IDTYP.GE.34B) GO TO 55 CALL EXEC(1,2203B,ITEMP,5,0,5) CALL COMPR(ISUBC,ITEMP,5,IER) IF(IER.NEQ.0) LU2=1 C C SET SUBCHNNAL # AND WRITE MT HEADER C C 55 LUSUB=SUBNO CALL EXEC(2,MTLU,IHDR,247) C C SET UP # OF SECTORS PER TRACK, NO. OF TRACKS AND TRACK SIZE MXSEC=ISUBC(1) MXTRK=ISUBC(4) ISIZE=MXSEC*64+1 C C CALL XDCAS(MSG1( 9),2,SUBNO) CALL EXEC(2,LOG+200B,MSG1,-20) C C DO 100 LTRK=0,MXTRK-1 IBUF(1)=LTRK CALL RDATK(IDLU,LTRK,0,ISIZE-1,ISUBC,IXBUF,IBT,LOG) IF(IBT.EQ.1) IPARM=2H-1 REG=EXEC(2,MTLU,IBUF,ISIZE) CALL ABREG(IS1,IB) IF(IB.EQ.0) GO TO 970 IF(IAND(IA,2).EQ.2) GO TO 980 IF(IAND(IS1,40B).EQ.40B) IEOT=1 IF(IAND(IS1,40B).EQ.40B) CALL WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE) 100 CONTINUE C LSAVEN=LSAVEN-1 êx������þú5000 CONTINUE ENDFILE MTLU C C CALL CNUMD(NLSAVE,MSG2) CALL EXEC(2,LOG+200B,MSG2,-22) C C C C C IF(IVRFY.EQ.0) GO TO 777 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C VERIFY C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C CHECK EOF FLAG, IF SET ,ASK TO RE-MOUNT C TAPE #1 AND FILE # C THE CHECK TAPE ON-LINE AND FORWARD SPACE TO FILE# C C IF(IEOT.EQ.0) GO TO 199 C 177 CALL EXEC(2,ITTY,26HRE-MOUNT TAPE #1 FOR VERFY,-26) CALL EXEC(2,ITTY,26HTHEN TYPE "GO" TO CONTINUE,-26) CALL EXEC(1,ITTY+400B,I,-2) IF(I.NEQ.2HGO) GO TO 177 C C CHECK MT ON-LINE C CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.0) GO TO 188 CALL EXEC(2,ITTY,17HMAG TAPE OFF-LINE,-17) GO TO 177 C C C ASK FOR FILE#, PARSE IPUT AND CONVERT INTO BINARY C THEN FORWARD SPACE IF NEEDED C 188 CALL EXEC(2,ITTY,7HFILE #?,-7) CALL EXEC(1,ITTY+400B,ITEMP,-6) CALL ABREG(IA,IB) LEN=IB IPTR=1 IF(NAMR(IPBUF,ITEMP,LEN,IPTR)) 188,190 190 IF(IAND(IPBUF(4),3).NEQ.1) GO TO 188 NFILE=IPBUF(1)-1 IF(NFILE.EQ.0) GO TO 250 C C NOW FORWARD SPACE TO THE DESIRED FILE C DO 220 I=1,NFILE CALL EXEC(3,MTLU+1300B) 220 CONTINUE C C SKIP THE BACKSPACE FILE C GO TO 250 C C BACKSPACE 1 FILE C C 199 DO 200 I=1,247 200 IHDR(I)=2H C BACKSPACE 1 RECORD CALL EXEC(3,MTLU+0200B) CALL EXEC(3,MTLU+1400B) 201 CALL EXEC(13,MTLU,IST) IF(IAND(IST,100000B).NEQ.0) GO TO 201 IF(IAND(IST,200B).NEQ.0)CALL EXEC(3,MTLU+300B) C C C VERIFYING C 250 CALL EXEC(2,ITTY,9HVERIFYING,-9) C IERROR=0 DO 6000 SUBNO=1,NLSAVE CALL EXEC(1,MTLU,IHDR,247) C PRINT HEADER IF(SUBNO.EQ.1)CALL EXEC(2,LOG+200B,IHDR,-75) MXSEC=ISUBC(1) ISIZE=MXSEC*64+1 MXSEC=MXSEC-1 MXTRK=ISçÐ�����UBC(4) C C C NOW VERIFY ALL TRACKS C DO 300 LTRK=0,MXTRK-1 C READ 1 BLOCK,INIT ERROR FLAG IERFG=0 K=2 CALL EXEC(1,MTLU,IBUF,ISIZE) CALL ABREG(IA,IB) IF(IAND(IA,40B).EQ.40B) CALL EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE) C C VERIFY 2 SECTRS C DO 350 ISEC=0,MXSEC,4 CALL RDATK (IDLU,LTRK,ISEC,256,ISUBC,VBUF,IER,LOG) CALL COMPR(IBUF(K),IVBUF,256,IER) IF(IER.NEQ.0) IERFG=1 K=K+256 350 CONTINUE C IF(IERFLG.EQ.1) IERROR=1 IF(IERFG.EQ.0) GO TO 300 CALL CNUMD(LTRK,ITEMP) CALL EXEC(2,LOG,21HVERIFY DATA ERROR-TRK,-21) CALL EXEC(2,LOG,ITEMP,-6) 300 CONTINUE C 6000 CONTINUE C IF(IERROR.EQ.0) CALL EXEC(2,LOG,9HVERIFY OK,-9) IF(IERROR.EQ.1) CALL EXEC(2,LOG,12HVERIFY ERROR,-12) C FORWARD SPACE 1 RECORD CALL EXEC(3,MTLU+300B) C 777 CALL LURQ(0,MTLU,1) CALL PRTN(IPARM) C C RETURN MAGTAPE TO ITS PREVIOUS STATE C CALL XMTBU(MTLU,IFLAG) C C UNLOCK PROGRAM C CALL EXEC(22+100000B,0) GO TO 779 778 STOP 77 779 STOP 77 920 CALL EXEC(2,LOG,18HWRITE RING MISSING,-18) GO TO 990 970 CALL EXEC(2,LOG,14H MT XMIT ERROR,-14) GO TO 990 980 CALL EXEC(2,LOG,16H MT PARITY ERROR,-16) GO TO 990 985 CALL EXEC(2,LOG,17H UNSUPPORTED DISC,-17) 990 CALL XMTBU(MTLU,IFLAG) STOP 66 END ����������������������������������������������������������������������������������������������������������������������¤_������ÿÿ����� ���� ÿý�&� 0 ���������ÿ��92067-18346 2026� S C0122 �&RESTR ON LINE RESTORE � � � � � � � � � � � � � �H0101 ™Ö�����þúFTN4,Q,C PROGRAM RESTR(4,60),92067-16346,REV.2026 800501 C C C SOURCE PART NO.: 92067-18346 C RELCO. PART NO.: 92067-16346 C NAME: RESTR - ON LINE RESTORE PROGRAM C C C FILE NAME: %RESTR C C C PROGRAMMER: J.S.W.,JRS C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C C THIS PROGRAM RESTORES A TAPE FILE WHICH WAS SAVED BY C LSAVE OR USAVE UTILITY PROGRAMS. C THE MAG TAPE MUST HAVE BEEN POSITIONED TO THE CORRECT FILE C NO SPARING IS DONE DURING ON-LINE RESTORE C C RU FORMAT: C RU,RESTR,[<LOG LU>], <DISC LU>, [<MT LU>], [DE] C WHERE: C <LOG LU>::= LU OF LOG DEVICE C < DISC LU>::= DESTINATION DISC LU TO RESTORE TO, OR DISC C DRIVE UNIT ASSOCIATED WITH THIS LU C <MT LU>::= MAG TAPE LU C DE ::= DEFAULT, NO CONFIRMATION OF HEADER C C SEQUENCE OF OPERATIONS: C C 1. GET PARAMETERS FROM RUN STRING OR INTERACTIVELY AND CHECK C EACH LU TO SEE IF VALID C 2. REQUEST MT LOCK C 3. READ HEDER RECORD FROM MT AND PRINT TIME,DATE AND RUN STRING C 4. CHECK HEADER TO SEE IF LSAVE (LSAVEN=1) OF USAVE (NOT=1) TAPE C 5. SEE IF OPTION = DEFAULT OR NOT C IF YE, GO ON, IF NOT ASK "OK?". C IF OK TO PROCEED NEXT STEP, ELSE FORWARD SPACE NEXT FILE AND ASK C "OK?" AGAIN. REPEAT UNTIL "/E,EX OR EN" C 6. REPEAT THE FOLLOWING FOR "LSAVEN" SUBCHANNELS C 7. IF USAVE, COMPARE TRACK MAP TABLES (FROM THE TAPE AND CURRENT SYSTEM C BY IDLU) C IF NOT EQUAL CANNOT RESTORE. C IF NOT USAVE(MUST BE LSAVE), SEE IF DEST. LU IS LU 2 OR 3. IF YES C CANNOT RESTOR. C IF USAVE TAPE AND LU 2 OR 3 INCLUDED, GET TRACK MAP TABLE (TMT) y¿������þú C ENTRY FOR LU 2 OR 3 AND COMPARE WITH CURRENT TMT ENTRY FROM C MAG TAPE HEADER. IF EQUAL SKIP THIS SUBCHANNEL. IF NOT NEXT STEP C 8. COMPUTE TRACK SIZE, LAST TRACK, SECTOR PER TRACK AND CHECK C IF SOURCE AND DEST. SUBCHANNEL HAS SAME NO. OF TRACKS. C IF NOT THE SAME, ASK IF OK TO PROCEED. IF YES, SET TRACK COUNT C EQUAL TO SMALLER OF THE TWO SUBCHNNELS. C 9. FOR TRACK# FROM 0 TO LAST TRACK, READ ONE TRACK FORM TAPE, CHECK C STATUS AND WRITE IT ONTO DISC. C 10. READ HEADER FOR NEXT SUBCHANNEL, REPEAT STEPS 6 TO 10 AND STOP. C C C C C DIMENSION IREG(2),IBUF(1),IXBUF(8208),ISTR(80),IVBUF(128), X IHDR(247),ITME(15),ITX32(161),ISUBMP(5),ITEMP(5), X LU2MP(5),LU3MP(5),MSGTAP(5),MSG2(20),MSG3(11) X ,MSG4(15),IPARM(5) C C EQUIVALENCE (REG,IA,IREG),(IB,IREG(2)), X (ITME,IHDR(1)), X (ISUBMP(1),IHDR(239)), X (LU2,IHDR(244)), X (ISTR(1),IHDR(16)), X (ITX32,IHDR(77)), X (LSAVEN,IHDR(245)), X (IBUF(1),IXBUF(16)), X (LUSUB,IHDR(246)), X (ITAPE,IHDR(247)) C DATA MSGTAP/2HTA,2HPE,2H #,2H / DATA MSG2/2HNO,2H. ,2HOF,2H S,2HUB,2HCH,2HAN,2HNE,2HLS, X 2H B,2HEI,2HNG,2H R,2HES,2HTO,2HRE,2HD / DATA MSG3/2HRE,2HST,2HOR,2HIN,2HG ,2HSU,2HBC,2HHN,2HL / DATA MSG4/2HNO,2H. ,2HOF,2H T,2HRA,2HCK,2HS ,2HRE,2HST, X 2HOR,2HED,2H / CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ON LINE RESTORE UTILITY C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ISTR- RUN STRING C N=0 INDICATES RESTORE C LOG - LOG LU C IDLU- DEST. DISC LU C MTLU- MAG TAPE LU C IVRFY- 1 FOR DEFAULT 0 FOR NO C C C N=0 CALL XGTPM(ISTR,N,LOG,IDLU,MTLU,IVRFY) C C CLEAR 10G RETURN VALUE C IPARM(1)=2H C C LOCK PROGRAM IN MEMORY������þú TO PREVENT DEADLOCK C CALL EXEC(22+100000B,1) GO TO 3 2 GO TO 4 3 CALL EXEC(2,LOG,33H UNABLE TO LOCK PROGRAM IN MEMORY,-33) CALL EXEC(2,LOG,32H WARNING: DEADLOCKS MAY OCCUR!,-32) 4 CONTINUE C C UNBUFFER THE MAGTAPE,RESTORE IT WHEN DONE C IFLAG = 0 CALL XMTBU(MTLU,IFLAG) C C REQUEST MT LOCK C 1000 CALL LURQ(140001B,MTLU,1) GO TO 1500 1100 CONTINUE 1500 CALL ABREG(IA,IB) IF(IA.EQ.0) GO TO 2500 CALL EXEC(2,LOG+200B,19HWAITING FOR MT LOCK,-19) CALL LURQ(1,MTLU,1) 2500 CONTINUE C IUSAVE=0 FOR LSAVE, ELSE LSAVE C INIT TO LSAVE C IUSAVE=0 C C C INTERACTIVE DEVICE LU C ITTY=LOGLU(ISESS) C C READ HEADER AND PRINT TIME,DATE,DAY AND TITLE C 10 CALL EXEC(1,MTLU,IHDR,247) CALL ABREG(IA,IB) IF(IAND(IA,2).EQ.2) GO TO 960 D WRITE(1,999) IA,IB D999 FORMAT(2@8) DO 11 I=1,75 11 IHDR(77-I) = IHDR(76-I) IHDR(1) = 2H CALL EXEC(2,LOG+200B,IHDR,-76) CALL XDCAS(MSGTAP(5),1,ITAPE) CALL EXEC(2,LOG+200B,MSGTAP,-10) C C IF(ITTY.EQ.LOG) GO TO 15 CALL EXEC(2,ITTY,IHDR,-76) CALL EXEC(2,ITTY,MSGTAP,-10) 15 IF(LSAVEN.GT.1) IUSAVE=1 C C C IF DE OPTION IS MISSING ASK IF OK, C IF YES CONTINUE C IF NO FORWARD SPACE NXT FILE C IF NON OF ABOVE ASK AGAIN C IF(IVRFY.EQ.1)GO TO 30 20 CALL EXEC(2,ITTY,3HOK?,-3) CALL EXEC(1,ITTY+400B,ITEMP,-2) IF(ITEMP.EQ.2HYE) GO TO 30 IF(ITEMP.EQ.2H/E.OR.ITEMP.EQ.2HEX.OR.ITEMP.EQ.2HEN)STOP 77 IF(ITEMP.NEQ.2HNO) GO TO 20 CALL EXEC(3,MTLU+1300B) GO TO 10 C C C************************************************************************* C C NOW WE HAVE THE HEADER INFO ,TMT. GET TMT FOR LU 2 OR 3 C C********************************************************************** C C C C CLEAR OUT LU2 AND 3 TRACK MAPS IN CASE SYSTEM IS A 7900 C 30 DO 25 I=1,5 LU2MP(I) = 0 Ù®������þú 25 LU3MP(I) = 0 C C CHECK TYPE OF SYSTEM DISCS C CALL EXEC(13,2,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 32,31,32 31 CALL EXEC(1,2202B,LU2MP,5,0,5) 32 CALL EXEC(13,3,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 35,34,35 34 CALL EXEC(1,2203B,LU3MP,5,0,5) C C C COMPARE WHOLE TMT FORM TAPE WITH CURRENT SYSTEM C IF NOT EQUAL AND USAVE FILE, CANNOT RESTORE C C C SET UP # OF SUBCHANNELS TO BE COMPARED C 35 ICNT=-ITX32 CALL EXEC(13,IDLU,IEQT5) IF (IAND(IEQT5,37400B)-15000B) 980,36,980 36 CALL EXEC(1,IDLU+2200B,IBUF, 161,0,5) CALL COMPR(IBUF,ITX32,ICNT,IER) IF(IER.NEQ.0.AND.IUSAVE.EQ.1) GO TO 950 C C C LSAVEN = NO. OF LSAVE'S IN THE FILE BEFORE EOF MARK C LASTSB=LSAVEN CALL XDCAS(MSG2(18),3,LASTSB) CALL EXEC(2,LOG+200B,MSG2,-40) C C********************************************************************* C C RESTORING ALL SUBCHANNELS (1 TO LASTSB) C C********************************************************************* C DO 6000 LSUBN=1,LASTSB MXTRK=ISUBMP(4) MXSEC=ISUBMP(1) C C CHECK IF DESTINATION SUBCHNNEL IS LU 2 OR 3 BY COMPARING C TMT ENTRY OF LU 2 OR 3 WITH THAT OF THE TAPE. C IF USAVE FILE AND EQUAL (IER=0) SKIP RESTORING THIS SUBCHNNL C IF LSAVE FILE AND EQUAL (IER=0) ERROR- CANNOT RESTORE. STOP. C C ISKIP=0 CALL COMPR(ISUBMP,LU2MP,5,IER1) CALL COMPR(ISUBMP,LU3MP,5,IER2) IER=IER1+IER2 IF(IER.EQ.0.AND.IUSAVE.EQ.0) GO TO 900 IF(IER.EQ.0.AND.IUSAVE.EQ.1) ISKIP=1 IF(ISKIP.EQ.1) CALL EXEC(2,LOG, X 25H SKIP RESTORING LU 2 OR 3,-25) C C C C IF LSAVE TAPE CHECK IF # OF TRACKS IN DEST LU THE SAME C IF NOT THE SAME, PRINT # OF TRACKS IN SOURCE AND DEST. LU C AND ASK IF OK TO PROCEED. C IF(IUSAVE.EQ.1) GO TO 50 IF(IDLU.EQ.2.OR.IDLU.EQ.3) GO TO 900 CALL EXEC(1,IDLU+2200B,ISUBMP,5,0,5) IF(MXSEC.NEQ.ISUBMP(1)) GO TO 970 IF(MXTRK.EQ.ISUBMP(4)) G<š������þúO TO 50 C C 40 CALL XDCAS(IBUF(1),3,MXTRK) IBUF(4)=20137B CALL EXEC(2,ITTY,IBUF,-8) CALL EXEC(2,ITTY,20H TRACKS IN SOURCE LU,-20) CALL XDCAS(IBUF(1),3,ISUBMP(4)) CALL EXEC(2,ITTY,IBUF,-8) CALL EXEC(2,ITTY,20H TRACKS IN DEST. LU ,-20) CALL EXEC(2,ITTY,15HOK TO PROCEED?_,-15) C CALL EXEC(1,ITTY+400B,I,-2) IF(I.EQ.2HNO) STOP IF(I.EQ.2HYE) GO TO 50 GO TO 40 C C COMPUTE TRACK SIZE AND SET LAST TRACK TO THE SMALLER OF TWO IN C SOURCE OR DEST. SUBCHANNELS. C 50 ISIZE=ISUBMP(1)*64+1 MXSEC=ISUBMP(1) IF(MXTRK.GT.ISUBMP(4)) MXTRK=ISUBMP(4) C C FOR TRACK# = 0 TO LAST TRACK READ ONE RECORD FROM MT, WRITE IT TO DISC C PRINT SUBCHNNL # BEING RESTORED C IF(ISKIP.EQ.1.OR.IUSAVE.EQ.0) GO TO 80 C C PRINT "RESTORING SUBCNL XX" C CALL XDCAS(MSG3(10),2,LUSUB) CALL EXEC(2,LOG+200B,MSG3,-22) C 80 DO 100 LTRK=0,MXTRK-1 CALL EXEC(1,MTLU,IBUF,ISIZE) CALL ABREG(IS1,IB) IF(IB.EQ.0) GO TO 960 IF(IAND(IS1,2).EQ.2) GO TO 960 IF(IAND(IS1,40B).EQ.40B) CALL EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE) IF(IAND(IS1,200B).EQ.200B) GO TO 850 IF(IAND(IBUF(1),37777B).NEQ.LTRK) GO TO 800 C C IF ISKIP=1 SKIP RESTORING LU 2 OR 3 FOR USAVE FILE C IF(ISKIP.EQ.1) GO TO 100 CALL WRTRK(IDLU,LTRK,ISUBMP,IXBUF,LOG,IBT) C C IF BAD TRACK EXIST (IBT=1) SET 10G TO -1 C IF(IBT.EQ.1) IPARM(1)=2H-1 100 CONTINUE C C PRINT # OF TRACKS RESTORED C IF(ISKIP.EQ.1.) MXTRK=0 CALL XDCAS(MSG4(13),3,MXTRK) CALL EXEC(2,LOG+200B,MSG4,-30) CC C C C READ NEXT HEADER, DO RESTORING FOR NEXT SUBCHANNEL C CALL EXEC(1,MTLU,IHDR,247) C 6000 CONTINUE C C DONE RESTORING C C********************************************************************* C C UNLOCK MT LU CALL LURQ(0,MTLU,1) C C RETURN 10G VALUE C CALL PRTN(IPARM) C C RESTORE MAGTAPE BUFFERING TO PRE-PROGRAM STATE C Dp���$��" CALL XMTBU(MTLU,IFLAG) C UNLOCK PROGRAM C CALL EXEC(22+100000B,0) GO TO 750 700 STOP 77 750 STOP 77 900 CALL EXEC(2,LOG+200B,27HCANNOT RESTORE TO LU 2 OR 3,-27) GO TO 990 800 CALL EXEC(2,LOG+200B,17HTAPE FORMAT ERROR,-17) GO TO 990 C C 850 CALL EXEC(2,LOG+200B,16HTAPE EOF ILLEGAL,-16) GO TO 990 950 CALL EXEC(2,LOG+200B,29HTRACK MAP TABLES DO NOT MATCH,-29) GO TO 990 960 CALL EXEC(2,LOG+200B,15HMT PARITY ERROR,-15) GO TO 990 970 CALL EXEC(2,LOG+200B,21HTRACK SIZES NOT EQUAL,-21) GO TO 990 980 CALL EXEC(2,LOG+200B,17H UNSUPPORTED DISC,-17) 990 CALL XMTBU(MTLU,IFLAG) STOP 66 END ����������������������������������������������������������������������������������������~¡$������ÿÿ����� ���� ÿý�'� 2 ���������ÿ��92067-18348 2026� S C0122 �&DISK �!DISK SOURCE � � � � � � � � � � � � �H0101 c=�����þúFTN4,Q,C PROGRAM DISK(3,90),92067-16348 REV.2026 800502 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: DISK C SOURCE: 92067-18348 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C C DIMENSION IXBUF(8209),IHDR(247),IREG(2), X IBUF(8192),ITX32(161),ISUBC(5), X ICMD(10),IPBUF(10),ITASK(3) C C EQUIVALENCE (IBUF(1),IXBUF(17)), X (REG,IA,IREG),(IB,IREG(2)), X (ITX32,IHDR(77)), X (ISUBC(1),IHDR(239)), X (LU2,IHDR(244)), X (LSAVEN,IHDR(245)) C C COMMON IXBUF,IHDR,ICMD DATA ITASK/2HTA,2HSK,2H? / C C GET S REGISTER, FIND OUT IF DVR05 OR DVR00 AND FIX EQT1 C ISR=0 CALL BOOTC(ISR) IF(ISR.EQ.-1) GO TO 40 MTSC=IAND(ISR,7700B)/100B IF(MTSC.NEQ.0) CALL FXTBL(8,MTSC) C ITSC=IAND(ISR,77B) IF(ITSC.NEQ.0) CALL FXTBL(1,ITSC) C CALL EXEC(2,1,36HDISK BACK UP UTILITY REV.2026 800502,-36) C C CALL LISIO ITBG=IXGET(1674B) CALL CNUMO(ITBG,IBUF) CALL EXEC(2,1,18HSEL. CODE OF TBG=_,-18) CALL EXEC(2,1,IBUF,-6) C C C GET S.C. FOR DVR32,DVA32 C 20 CALL EXEC(2,1,34HENTER SELECT CODE FOR DVR32,DVA32:,-34) C CALL EXEC(1,401B,ICMD,-20) CALL ABREG(IA,IB) IF(ICMD(1).EQ.2H/E.OR.ICMD.EQ.2HEN.OR.ICMD.EQ.2HEX) GO TO 40 LEN=IB IPTR=1 CA ������þúLL ASCOC(ICMD,IPTR,LEN,ISC1) CALL ASCOC(ICMD,IPTR,LEN,ISC2) IF(ISC1.LT.77B.AND.ISC2.LT.77B) GO TO 30 C CALL EXEC(2,1,17HERROR- S.C. GT 77,-17) GO TO 20 C 30 IF(ISC1.LE.-1.OR.ISC2.LE.-1) GO TO 999 C C LU 5 FOR 13037 DISCS C LU 4 FOR HPIB DISCS C IF(ISC1.NEQ.0) CALL FXTBL(5,ISC1) IF(ISC2.NEQ.0) CALL FXTBL(4,ISC2) C C C 40 MTLU=8 ITTY=1 ICMD(1)=2H ICMD(2)=2H ICMD(3)=2H CALL EXEC(2,ITTY,ITASK,-5) REG=EXEC(1,ITTY+400B,ICMD,-10) LEN=IB IF(ICMD(1).EQ.2HIO) CALL IOCON IF(ICMD(1).EQ.2HCO) CALL COPY IF(ICMD(1).EQ.2HRE) GO TO 70 IF(ICMD(1).EQ.2HRW) GO TO 100 IF(ICMD(1).EQ.2HAB) STOP IF(ICMD(1).EQ.2HFF.OR.ICMD(1).EQ.2HBF) GO TO 200 IF(ICMD(1).NEQ.2HIO.AND.ICMD(1).NEQ.2HCO.AND.ICMD(1).NEQ.2HRE) X GO TO 50 GO TO 40 50 CALL EXEC(2,ITTY,19HVALID COMMANDS ARE:,-19) CALL EXEC(2,ITTY,20HIO,CO,RE,RW,FF,BF,EN,-20) GO TO 40 C 70 CONTINUE CALL RESTR(IPBUF,LEN) GO TO 40 C C C CHECK MT STATUS C 100 CALL MTOK(MTLU,IER) IF(IER.NEQ.0) GO TO 40 C C REWIND MT C 105 CALL EXEC( 3,MTLU+400B) GO TO 40 C C C FORWARD SPACE C 200 CALL MTOK(MTLU,IER) IF(IER.EQ.0) GO TO 250 GO TO 40 C C 250 IPTR=1 IF(NAMR(IPBUF,ICMD,LEN,IPTR))40,252 252 NFILE=1 IF(NAMR(IPBUF,ICMD,LEN,IPTR)) 255,251 251 IF(IAND(IPBUF(4),3).EQ.1) NFILE=IPBUF 255 CALL EXEC(2,ITTY,31HFORWARD/BACKWARD N FILE(S): N=_,-31) CALL CNUMD(NFILE,IHDR) CALL EXEC(2,ITTY,IHDR,-6) DO 260 I=1,NFILE IF(ICMD(1).EQ.2HFF) CALL EXEC(3,MTLU+1300B) IF(ICMD(1).EQ.2HBF) CALL EXEC(3,MTLU+1400B) C C GET STATUS C CALL ABREG(ISTAT1,IB) 260 CONTINUE C C D WRITE(1,9999) ISTAT1 D9999 FORMAT("STAT=",@8) C C IF COMMAND IS BF, CHECK IF BOT IS DETECTED C IF NOT DO A BF AND FR TO PUT THE TAPE IN FRONT OF EO®>������þúF C IF(IAND(ISTAT1,100B).EQ.100B) GO TO 40 IF(ICMD(1).EQ.2HFF) GO TO 40 C C BACKSPACE FILE, THEN FORWORD SPACE RECORD C CALL EXEC(3,MTLU+1400B) C C IF BOT NO FR C CALL ABREG(ISTAT1,IB) D WRITE(1,9999)ISTAT1 IF(IAND(ISTAT1,100B).EQ.100B) GO TO 40 CALL EXEC(3,MTLU+300B) GO TO 40 C C 999 CALL EXEC(2,1,17HINVALID SEL. CODE,-17) GO TO 20 END END$ ASMB,R,L NAM DISKB,7 92067-18348 REV.2001 791018 EXT .ENTR,$LIBR,$LIBX ENT BOOTC * * A EQU 0 B EQU 1 DRT EQU 1652B * SREG NOP BOOTC NOP JSB .ENTR DEF SREG * CCA INIT SREG TO -1 STA SREG,I ISZ FLAG IF FLAG IS NOT -1 JMP BOOTC,I NOT FIRST TIME, RETURN JSB $LIBR NOP CLF 0 TURN INTERRUPT OFF * LDA DRT,I CLB,INB SET LU 1 TO EQT 1 IOR B STA DRT,I * LIA 1 GET S REGISTER SZA,RSS IF ZERO JMP OUT GET OUT AND .7777 MASK OUT TBG S.C. STA SREG,I AND B77 MASK OUT CONSOLE S.C. STA CONSO LDA CN1 ADA CONSO STA CN1 LDA CN2 ADA CONSO STA CN2 LDA CN3 ADA CONSO STA CN3 LDA CN4 ADA CONSO STA CN4 LDA CN5 ADA CONSO STA CN5 LDA MRSET CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 JMP OUT DVR05 LDA DRT,I GET DRT AND .3700 MASK OUT EQT# OF LU 1 ADA D3 SET LU 1 TO EQT 3 STA DRT,I RESET LU 1 LDA 1650B GET EQT ADDRESS ADA D30 MAKE EQT3 ADDRESS STA 1675B OUT CLA OTA 1 LDA C120K CN4 OTA 0,C CN5 STC 0,C JSB $LIBX DEF BOOTC * * D30 DEC 30 .7777 OCT 7777 FLAG DEC -1 CONSO NOP B77 OCT 77 MRSET OCT 150077 .3700 OCT 3700 C120K OCT 120001 D3 OCT 3 .1777 OCT 177700 LU K������þú DEC 1 * NAME: ASCOC * SOURCE: 92060-18348 * RELOC: 92060-16348 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * ENT ASCOC ROUTINE TO CONVERT ASCII TO DEC OR OCTAL EXT .ENTR * ICHAR NOP IPTR NOP LEN NOP NUMB NOP * * ASCOC NOP JSB .ENTR DEF ICHAR * LDA D7 GET RADIX STA RADIX START CLA STA VAL LDA ICHAR STA INAM CCA STA NUMB,I SET NUMB TO -1 FOR ERROR LOOP LDA IPTR,I GET POINTER CMA,INA LEN > IPTR? ADA LEN,I SSA JMP ASCOC,I YES ERROR RETURN LDA IPTR,I CLB CLE,ERA SEZ INB SZB,RSS ADA N1 ADA INAM LDA A,I STA CWORD SZB ALF,ALF AND .377 CPA SPACE JMP IGNOR CPA COMMA JMP FINI CNVRT ADA .N60 CONVERT CMA,SSA,INA,RSS NEGATIVE NUMBER? JMP ERR YES,ERROR ADA RADIX CMA,SSA,INA,RSS INTEGER? JMP ERR NO,ERROR ADA RADIX BACK TO ORIGINAL NUMBER LDB RADIX CMB CLO ADA VAL ADD EXISTING VALUE TO THE NEW INTEGER 10 TIMES ISZ B JMP *-2 SOC IF OVERFLOW, ERROR JMP ERR STA VAL IGNOR ISZ IPTR,I LDA IPTR,I CMA,INA LEN-IPTR ADA LEN,I <0 ? SSA,RSS JMP LOOP JMP DONE LEN<IPTR * * FINI ISZ IPTR,I DONE LDB VAL STB NUMB,I JMP ASCOC,I COMMA OCT 54 ERR LDB N1 STB NUMB,I JMP ASCOC,I * N1 ‚������þúDEC -1 .N60 OCT -60 .1774 OCT 177400 .377 OCT 377 D9 DEC 9 D7 DEC 7 VAL BSS 1 RADIX BSS 1 IFLAG BSS 1 CWORD BSS 1 NWORD BSS 1 IWORD BSS 1 INAM BSS 1 SPACE OCT 00040 ENT IGET,IXGET * * IXGET EQU * IGET NOP DLD IGET,I SWP LDA 0,I LDA 0,I JMP 1,I EXT .ENTR ENT IPUT * * ADDR NOP DATA NOP * * IPUT NOP JSB .ENTR DEF ADDR * LDB ADDR,I GET ADDRESS LDA DATA,I GET DATA STA 1,I PUT DATA INTO ADDRESS JMP IPUT,I END FTN4 SUBROUTINE IOCON,92067-16348 REV.1940 790727 DIMENSION IREG(2),IBUF(10),IPBUF(10),LUTBL(4) C EQUIVALENCE (REG,IA,IREG),(IB,IREG(2)) C DATA LUTBL/1,4,5,8/ C C ASK FOR NEW CONFIGURATION CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALL LISIO C 10 CALL EXEC(2,1,17HTO EXIT TYPE "/E",-17) CALL EXEC(2,1,18HENTER LU,NEW S.C.?,-18) REG= EXEC(1,1+400B,IBUF,-20) LEN=IB IF(IBUF(1).EQ.2HEX.OR.IBUF(1).EQ.2H/E.OR.IBUF(1).EQ.2HEN) RETURN IPTR=1 IF(NAMR(IPBUF,IBUF,LEN,IPTR)) 10,20 20 IF(IAND(IPBUF(4),3).NEQ.1) GO TO 10 LU=IPBUF(1) C CALL ASCOC(IBUF,IPTR,LEN,NEWSC) C IF(NEWSC.LT.10B.OR.NEWSC.GE.77B) GO TO 88 C C C 40 IF(LU.GT.0.OR.LU.LE.77B) GO TO 50 CALL EXEC(2,1,12HINVALID LU ,-12) GO TO 10 C C C 50 IF(LU.EQ.1) GO TO 99 DO 60 I=1,4 IF(LU.EQ.LUTBL(I)) GO TO 80 60 CONTINUE CALL EXEC(2,1,14HLU NOT DEFINED,-14) RETURN 80 CALL FXTBL(LU,NEWSC) RETURN C C 88 CALL EXEC(2,1,12HINVALID S.C.,-12) GO TO 10 99 CALL EXEC(2,1,39HRECONFIGURE CONSOLE DURING BOOT UP ONLY,-39) RETURN END END$ FTN4 SUBROUTINE LISIO,92067-16348 REV.1940 790706 DIMENSION LINE(70),ITEM1(1),ITEM2(1),ITEM3(1),ITEM4(1),ITEM5(1) X ,ITEM6(1),IDVTB(28) C EQ1������þúUIVALENCE (ITEM1(1),LINE(1)), X (ITEM2(1),LINE(4)), X (ITEM3(1),LINE( 7)), X (ITEM4(1),LINE(10)), X (ITEM5(1),LINE(16)), X (ITEM6(1),LINE(22)), X (IDB,ITEM5(1)), X (IPS,ITEM5(2)), X (IT,ITEM5(3)) C C DATA IDVTB/2HCO,2HNS,2HOL,2HE ,2H ,2H ,2H , X 2H13,2H03,2H7 ,2HDI,2HSC,2HS ,2H , X 2HI.,2HC.,2H D,2HIS,2HCS,2H ,2H , X 2HMA,2HG ,2HTA,2HPE,2H ,2H ,2H / C C NOW DISPLAY CURRENT IO CONFIGURATION C C ITTY=1 C C CALL EXEC(2,ITTY,55H LU EQT S.C. S.CHNL X DRIVER,-55) LUMAX=IXGET(1653B) IDRT=IXGET(1652B) IEQTB=IXGET(1650B) C DO 505 I=1,LUMAX C C DO 444 K=1,70 444 LINE(K)=2H C C IVAL=IXGET(IDRT) IF(IVAL.NE.0) GO TO 501 GO TO 505 501 ISCC=IAND(IVAL,174000B) ISC=IAND(ISCC,74000B)/4000B IF(ISCC.LT.0) ISC=ISC+20B IEQT=IAND(IVAL,77B) IEQTA=(IEQT-1)*15+IEQTB C C ISTAT=IXGET(IEQTA+3) C C ISCDE=IAND(IXGET(IEQTA+3),77B) IDVR=IAND(IXGET(IEQTA+4),37400B)/256 C CALL CNUMO(IDVR,ITEM6) IF(IDVR.EQ.5) ITEM6(3)=2H05 ITEM6(1)=2H D ITEM6(2)=2HVR IF(IEQT.EQ.4) ITEM6(2)=2HVA IF(IEQT.EQ.1.OR.IEQT.EQ.3) INDEX=1 IF(IEQT.EQ.2) INDEX=8 IF(IEQT.EQ.4) INDEX=15 IF(IEQT.EQ.5) INDEX=22 C C J=26 DO 550 K=1,14 LINE(J)=IDVTB(INDEX) INDEX=INDEX+1 550 J=J+1 C WRITE INFO C CALL CNUMD(I,ITEM1) CALL CNUMD(IEQT,ITEM2) CALL CNUMO(ISCDE,ITEM3) CALL CNUMD(ISC,ITEM4) CALL EXEC(2,ITTY,LINE,-63) C 505 IDRT=IDRT+1 C RETURN END END$ FTN4 SUBROUTINE FXTBL(LU,NEWSC) C C C 50 IEQT2=(IAND(77B,IGET(IGET(1652B)+LU-1))-1)*15 X +IGET(1650B)+1 C C SAVE OLD S.C. AND GET EQT4 VALUEÐå������þú C IOLDSC=IAND(IGET(IEQT2+2),77B) C C C NOW SEARCH ALL EQTS FOR MATCHING NEWSC AND SET EQT4 S.C. C TO ZERO TO AVOID DUPLICATE EQT POINTING TO SAME S.C. C MXEQT=IGET(1651B) IEQT4=IGET(1650B)+3 DO 10 I=1,MXEQT IF(IAND(IGET(IEQT4),77B).NEQ.NEWSC) GO TO 15 IVEQ4=IAND(IGET(IEQT4),177700B) CALL IPUT(IEQT4,IVEQ4) 15 IEQT4=IEQT4+15 10 CONTINUE C C C IVEQ4=IOR (NEWSC,IAND(IGET(IEQT2+2),177700B)) CALL IPUT(IEQT2+2,IVEQ4) C C GET DVR TYPE C IDVRTP=IAND(IGET(IEQT2+3),37400B)/256 C C NOW FIX OLD SELECT IN INT TABLE C CALL IPUT(IGET(1654B)+IOLDSC-6,0) C C IF DRIVER TYPE IS 23 FIX OLD S.C. C IF(IDVRTP.EQ.23B) CALL IPUT(IGET(1654B)+IOLDSC-5,0) C C FIX NEW SEL CODE IN INT TABLE C CALL IPUT(IGET(1654B)+NEWSC-6,IEQT2-1) C C IF DRIVER TYPE IS 23 FIX NEW SELECT CODE C IF (IDVRTP.EQ.23B) CALL IPUT(IGET(1654B)+NEWSC-5,IEQT2-1) RETURN END END$ FTN4 SUBROUTINE RESTR(IPBUF,LEN),92067-16348 REV.2001 790802 C C NAME: RESTR- OFF LINE RESTR C PART #: 92067-18348 (SOURCE) C PART# RELC: 92067-16348 C CREATED BY: J.S.W. C C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C CALLING SEQUENCE: C RE,[TM],[A/H] C C WHERE: C TM- CHANGE TRACK MAP ENTRY DEFINITION FOR LSAVE TAPE C (NOT ALLOWED FOR USAVE TAPE C A/H- A FOR RESTORING TO 13037 C H FOR RESTORING TO HPIB DISC USING SAME TMT IN TAPE C C DIMENSION IREG(2),IBUF(8193),ISTR(80), IPBUF(1), X IHDR(247),ITME(15),ITX32(161),ITMT(5),ITEMP(5)28������þú X ,IXBUF(8209),ISUBC(5),ICMD(1) C C EQUIVALENCE (REG,IA,IREG),(IB,IREG(2)), X (IBUF(1),IXBUF(16)), X (ITME,IHDR(1)), X (ITMT(1),IHDR(239)), X (LU2,IHDR(244)), X (ISTR(1),IHDR(16)), X (ITX32,IHDR(77)), X (LSAVEN,IHDR(245)), X (LUSUB,IHDR(246)), X (ITAPE,IHDR(247)) C COMMON IXBUF,IHDR,ICMD C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C OFF-LINE RESTOR SUBROUTINE C C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM DISK TO RESTORE C A TAPE SAVE ON-LINE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IUSAVE=0 ISUBC(1)=-1 ITTY=1 MTLU=8 C C C CHECK IF MT IS ON-LINE AND UP C CALL MTOK(MTLU,IER) IF(IER.NEQ.0)RETURN C C C CHECK PARAMETERS, COMMAND FORMAT: C C RE,[OPTION[,MODEL]] C C WHERE OPTION=DE FOR DEFAULT RESTORE C =TM CHANGE TMT C MODEL = A RESTORE TO 13037 C = H RESTORE TO HPIB C C ISUBC CONTAINS INPUT SUBCHNNL DEFINITION (NEW) C C READ MT HEADER WITH NO ABORT BIT SET C IF ABORT THEN PARITY ERROR, RETURN C THEN CHECK IF MT LU IS DOWN, IF YES ASK TO UP IT AND RESTART C C 10 CALL EXEC(1+100000B,MTLU,IHDR,247) GO TO 950 11 CALL ABREG(IA,IB) IF(IB.EQ.0) GO TO 900 CALL MTOK(MTLU,IER) IF(IER.NEQ.0)RETURN C C PRINT HEADRAND TAPE # ON CONSOLE C CALL EXEC(2,ITTY,IHDR,-76) WRITE(1,13) ITAPE 13 FORMAT("TAPE #",I3) C C FIND OUT IF USAVE OR NOT AND INIT POINTERS C IF(LSAVEN.GT.1) IUSAVE=1 IPTR=1 MODEL=2H IOPT=2H C C PARSE THE COMMAND BUFFER (ICMD) TO SEE IF [TM] OR C [A/H] OPTION EXISTS C C IF(NAMR(IPBUF,ICMD,LEN,IPTR))15,15 15 IF(NAMR(IPBUF,ICMD,LEN,IPTR))50,16 16 IOPT=IPBUF(1) IF(NAMR(IPBUF,ICMDŠj������þú,LEN,IPTR))25,20 20 MODEL=IPBUF(1) 25 IF(IOPT.NEQ.2HTM) GO TO 50 C C IF USAVE TAPE, NOT ALLOWED TO CHANGE TMT C IF(IOPT.EQ.2HTM.AND.IUSAVE.EQ.1) GO TO 28 GO TO 30 28 CALL EXEC(2,ITTY, X 47HNOT ALLOWED TO CHANGE TRACK MAP TABLE FOR USAVE,-47) GO TO 50 C C [TM] OPTION IS ENTERED, ASK FOR SUBCHHANNEL DEFINITION C AND CHECK IF SAME TRACK SIZE, THEN MOVE THE 5 WORD TO ITMT C IF EXIT FROM PROMTS, IGNORE RESTORE AND RETURN C IF [A/H] OPTION COEXIST WITH [TM], IGNORE [A/H] C 30 CALL GTSUB(32HFOR DEST. SUBCHNNL (LSAVE TAPE):,-32,ISUBC) IF(ISUBC(1).EQ.-1) RETURN MODEL=2H C C CHECK TRACK SIZES EQUAL C IF(ISUBC(1).NEQ.ITMT(1)) GO TO 920 DO 40 I=1,5 40 ITMT(I)=ISUBC(I) C C IF OPTION NOT = DE ,ASK IF HEADER IS OK C 50 IF(IOPT .EQ.2HDE) GO TO 80 60 CALL EXEC(2,ITTY,3HOK?,-3) CALL EXEC(1,ITTY+400B,ITEMP,-2) IF(ITEMP.EQ.2HYE) GO TO 80 IF(ITEMP.EQ.2H/E.OR.ITEMP.EQ.2HEN.OR.ITEMP.EQ.2HEX) RETURN IF(ITEMP.NEQ.2HNO) GO TO 60 C C IF THE ANSWER IS NO, CHECK MT OK AND FORWORD ON FILE C THEN TRY AGAIN C CALL MTOK(MTLU,IER) IF(IER.NEQ.0) RETURN CALL EXEC(3,MTLU+1300B) GO TO 10 C C C # OF LSAVES C C 80 LSUBN=LSAVEN C C C C LU 5= 13037 DISCS C LU 4 =HPIB C IF UPPER OF WORD 5 OF TMT NOT 0, IT IS AN HPIB DISC C C IF MODEL =A OVERRIDE TMT INFO AND RESTORE TO 13037 C =H RESTORE TO HPIB C C IDLU=4 IF(IAND(ITMT(5),177400B).EQ.0) IDLU=5 IF(MODEL.EQ.2HA ) IDLU=5 IF(MODEL.EQ.2HH ) IDLU=4 C IUNIT=IAND(ITMT(3),7) IF(IDLU.EQ.4) WRITE(ITTY,67) IUNIT 67 FORMAT("RESTORE TO I.C. DISC ADDR ",I1) IF(IDLU.EQ.5) WRITE(ITTY,68) IUNIT 68 FORMAT("RESTORE TO 13037 DISC UNIT ",I1) C C C NOW GO THRU ALL THE SUBCHANNELS (LSUBN) AND RESTORE THEM C DO 500 ISUB=1,LSUBN IF(IUSAVE.EQ.1)WRITE(1,70) LUSUB 70 FORMAT(" RESTORING SUBCHNL #",I3·������þú) C 90 ISIZE=ITMT(1)*64+1 MXTRK=ITMT(4) C C DO A DUMMY WRITE TO TEST FORMAT SWITCH ETC AND THEN C CALL CLRSP TO CLEAR ALL SPARE TRACKS IN POOL C ISTRK=-1 CALL MWRTK(IDLU,0,ITMT,IBUF,ISTRK) CALL CLRSP(IDLU,ITMT) C C INIT SPARE TRACK # ISTRK=MXTRK C C C READ TAPE, CHECK TO SEE IF MT IS DOWN (DUE TO PARITY ERROR ETC) C GET STATUS AND SEE IF EOT OR PARITY ERROR C IF EVERTHING OK, DISPLAY TRACK# TO SW. REG. C AND WRITE THE TRACK WITH SPARING C C DO 100 LTRK=0,MXTRK-1 CALL MTOK(MTLU,IER) IF(IER.NEQ.0) RETURN CALL EXEC(1+100000B,MTLU,IBUF,ISIZE) GO TO 950 111 CALL ABREG(IS1,IB) CALL MTOK(MTLU,IER) IF(IER.NEQ.0) RETURN C IF(IAND(IS1, 40B).EQ.40B) CALL EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE) IF(IAND(IS1,200B).EQ.200B) GO TO 850 IF(IAND(IBUF(1),3777B).NEQ.LTRK) GO TO 800 CALL ISSR(LTRK) CALL MWRTK(IDLU,LTRK,ITMT,IBUF,ISTRK) 100 CONTINUE C C CALL EXEC(1,MTLU,IHDR,247) 500 CONTINUE C CALL EXEC(2,ITTY,4HDONE,-4) RETURN C C C IF /E IS THE REPLY FOR "OK?", DO A BF AND FR TO GET C TO BEGINNING OF THIS FILE C IF START-OF-TAPE MARK IS DETECTED, RETURN C C 700 CALL EXEC(3,MTLU+600B) CALL ABREG(IA,IB) IF(IAND(IA,100B).EQ.100B) RETURN CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+300B) RETURN 800 CALL EXEC(2,ITTY,19HTAPE FORMAT ERROR ,-19) RETURN C C 850 CALL EXEC(2,ITTY,16HTAPE EOF ILLEGAL,-16) RETURN 900 CALL EXEC(2,ITTY,11HMT TIME OUT,-11) RETURN 920 CALL EXEC(2,ITTY,21HTRACK SIZES NOT EQUAL,-21) RETURN 950 CALL EXEC(2,ITTY,28HMT PARITY ERROR ,-28) RETURN END END$ FTN4 SUBROUTINE MWRTK(LU,LTRK,ISUBC,IBUF,STRAK),REV.2026 800502 IMPLICIT INTEGER(A-Z) DIMENSION ISUBC(1),IBUF(1),ITEMP(6),SBUF(144),IHDR(1),IXBUF(1) COMMON IXBUF,IHDR C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCk«������þúCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C OFF LINE WRITE TRACK SUBROUTINE C WITH SPARING IF NEEDED C C CALLING PARAMETERS: C LU - DISC LU POINTER TO DVR32 OR DVA32 C LTRK - LOGICAL TRACK # FOR THIS SUBCHANNEL C ISUBC - 5 WORD ARRAY CONTAIN TRACK MAP TABLE ENTRY FOR THIS SUBCHHAL C IBUF - TRACK BUFFER FOR WRITING ON DISC (8192 WORDS MAX) C STRAK - CURRRENT SPARE TRACK # (LOGICAL) FOR THIS SUBCHANNEL C C COMMON PARATERS: C IXBUF - IBUF PLUS 16 WORDS HEADER FOR DISC LIBRARY C IHDR - MAG TAPE HEADER RECORD: 237 WORDS C C THIS PROGRAM WRITES ONE TRACK ONTO THE DISC SETTING P BIT C ACCORDING TO THE SOURCE. SPARING IS DONE IF THE DESTINATION TRACK C IS MARKED DEFECTIVE OR DATA ERROR REPORTED AFTER VERIFY COMMAND C THE SUBROUTINE MAKES USE OF DISC LIBRARY SUBROUTINES EXCLUSIVELY. C (SEE ERS #2256-1138 FOR DISC LIBRARY) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC LOG=1 RETRY=0 C C CONVERT LOGICAL TO PHYSICAL TRK ADDRESS C CHECK STATUS AND LOOK AT STATUS 2, C IF STATUS 2 < 0 (BIT 15 SET) DISC IS NOT READY C IF NOT EQUAL TO 40 OCTAL FORMAT SWITCH OFF, TELL USER C IF EQUAL TO 100 OCTAL PROCTECT SWITCH ON, TELL USER C IF IER= 4 TIMED OUT BY DVA32 C C LSEC=0 CALL MXGTA(LU,IDVID,LTRK,LSEC,ICYL,IHD,ISEC,ISUBC) IUNIT=IAND(IDVID,77B) MSK = 4 100 CALL XFMSK(LU,IDVID,MSK,IER) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) IF(IER.EQ.4) GO TO 950 IF(IER.EQ.2) GO TO 100 IF((ISTAT2.LT.0).AND.(IAND(ISTAT2,4B).EQ.4)) GO TO 900 IF(ISTAT2.LT.0) GO TO 950 IF(IAND(ISTAT2,40B).EQ.0) GO TO 910 IF(IAND(ISTAT2,100B).EQ.100B) GO TO 920 C C SEE IF SPARE TRACK# IS -1 , IF YES NO ACTION YET C IF(STRAK.EQ.-1) RETURN C C FILE MASK, SEEK, WRITE C AFTER SEEK, LOOK AT STATUS 2. C IF < 0 NOT READY. IF D BIT SET DO SPARING (7910 ONLY) C THEN DO VERIFY TO SEE IF D BIT SET C C ÕÅ������þú ISIZE=ISUBC(1)*64 NSECTS=ISUBC(1)/2 C C IF BIT 14 IBUF(1) IS SET THE TRACK IS PROTECTED, SET PBIT TO 2 C PBIT=0 IF(IXBUF(16).LT.0) PBIT=2 C D WRITE(1,9999) IXBUF(16) D9999 FORMAT("IXBUF(16)=",@8) C C C FOR 7910 LOOK AT P BIT AFTER SEEK C IF (IAND(ISTAT1,20000B).NEQ.0) GO TO 850 C C DO A READ FULL SECTOR TO SEE IF D BIT IS SET C BY LOOKING AT THE 3RD WORD OF THE PREAMBLE (SBUF(19)) C IF YES, RE-SPARE THE TRACK C IF NO IGNORE ALL OTHER BITS (S AND P) AND INITIALIZE THE TRACK C CALL XRDFS(LU,IDVID,SBUF,128,ISTAT1,ISTAT2,IER) IF(IER.EQ.2) GO TO 100 IF(IER.EQ.4) GO TO 950 C C IF (IAND(SBUF(19),20000B).NEQ.0) GO TO 850 C C SEEK BACK TO TARGET TRACK (XRDFS WILL MOVE THE HEAD) C AND INIT THE TRACK WITH P BIT SET APPROPRIATELY C C CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) IF (ISTAT2.LT.0) GO TO 900 CALL XINIT(LU,IDVID,IXBUF,ISIZE,PBIT,ISTAT1,ISTAT2,IER) 500 CALL XEND(LU,IDVID) RETURN C C************************************************************************ C C ERROR HANDLING C C************************************************************************* C C SEE IF ERROR IS CORRECTALBLE BY RETRY C 800 IF(IS1.GT.16B.AND.IS1.LT.20B) GO TO 850 RETRY=RETRY+1 IF(RETRY.GE.10) GO TO 850 GO TO 100 C C SEEK CHECK, DO RECALIBRATE AND RETRY UP TO 10 TIMES C 900 CALL EXEC(2,1,10HSEEK CHECK,-10) RETRY=RETRY+1 IF(RETRY.GT.10) GO TO 950 CALL XRCAL(LU,IDVID,IER) GO TO 100 C 910 WRITE(1,911) IUNIT 911 FORMAT(" TURN FORMAT SWITCH ON FOR UNIT/ADDRESS:",I2, X /," TYPE 'GO' TO CONTINUE") CALL EXEC(1,401B,IXX,-2) IF(IXX.EQ.2HGO) GO TO 100 IF(IXX.EQ.2H/E.OR.IXX.EQ.2HEN.OR.IXX.EQ.2HEX) GO TO 8800 GO TO 910 C C 920 WRITE(1,922) IUNIT 922 FORMAT(" TURN DISC PROTECT SWITCH OFF FOR UNIT/ADDRESS:" X ,I2/," TYPE 'GO' TO CONTINUE") CALLÉ���N��LH EXEC(1,401B,IXX,-2) IF(IXX.EQ.2HGO) GO TO 100 IF(IXX.EQ.2H/E.OR.IXX.EQ.2HEN.OR.IXX.EQ.2HEX) GO TO 8800 GO TO 920 C 950 WRITE(1,951) IUNIT 951 FORMAT("DISC UNIT/ADDRESS",I2," NOT READY") CALL EXEC(2,1,37HREADY DISC AND ENTER "GO" TO CONTINUE,-37) CALL EXEC(1,401B,IXX,-2) IF(IXX.EQ.2HGO) GO TO 100 IF(IXX.EQ.2H/E.OR.IXX.EQ.2HEN.OR.IXX.EQ.2HEX) GO TO 8800 GO TO 950 C C 850 WRITE(1,880) LTRK,ICYL,IHD,IUNIT 880 FORMAT("DEST. SUBCHANNEL"/ X "BAD TRACK AT: TRACK #",I5," CYL ",I3," HEAD",I3, X " UNIT/ADDRESS ",I2) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C SPARING C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C COMPUTE LAST AVAILABLE SPARE TRACK # C = # OF TRACKS + # OF SPARES C C CHAECK IF CURRENT SPARE TRACK # = LAST SPARE TRACK # C 300 LSPARE=ISUBC(4)+IAND(ISUBC(5),377B) IF(STRAK.GE.LSPARE) GO TO 7000 C C 1. SET FILE MASK TO 0 => AUTO SEEK TO SPARE C 2. SEEK TO SPARE TRACK C 3. ADDRESS RECORD WITH SPARE TRACK ADDRESS C 4. INIT SPARE WITH DATA BUFFER FROM TAPE AND SETTING S, P BITS C ACCORDINGLY C MSK=0 SECTR=0 CALL XFMSK(LU,IDVID,MSK,IER) C CALL MXGTA (LU,IDVID,STRAK,SECTR,SCYL,SHED,SECT2,ISUBC) CALL XSEEK (LU,IDVID,SCYL,SHED,SECTR,S1,S2,IER) C ��������������������������������������������������������������������������������������������������������������������������������������������������ŽN������ÿÿ����� ���� ÿý�(�: ���������ÿ��92067-18349 2026� S C0122 �&DKULB BACKUP UTILITY �SUBR. � � � � � � � � � � � � �H0101 &ù�����ASMB,Q NAM DKULB,0 92067-12003 REV.2026 800501 ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: DKULB * SOURCE: 92067-18349 * RELOC: PART OF 92067-12003 * PGMR: J.S.W * END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ä±������ÿÿ����� ���� ÿý�)�/ ���������ÿ��92067-18350 2013� S C0122 �&SPOLH �SPOOL HEADER � � � � � � � � � � � � �H0101 ~k�����ASMB,R,L * NAME: SPOLH * SOURCE: 92067-18350 * RELOC: 92067-16350 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SPOLH,7 92067-16350 REV.2013 800114 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ôð������ÿÿ����� ���� ÿý�*�0 ���������ÿ��92067-18351 1940� S C0122 �&SMP �SMP PROGRAM � � � � � � � � � � � � �H0101 w�����þúASMB,Q,C * HED SMP ROUTINE * NAME: SMP * SOURCE: 92067-18351 * RELOC: 92067-16350 * PGMR: A.M.G.,S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SMP,130,30 92067-16350 REV.1940 790802 * * * * SSTAT STATES * * 0 NORMAL * 1 SPOUT IS WORKING ON A MENU * * * IFN EXT DBUGR XIF EXT .DFER THREE WORD MOVE ROUTINE EXT REIO I-O ROUTINE EXT .MVW MOVE WORDS ROUTINE EXT $CVT3 CONVERT NUMBER TO ASCII EXT RMPAR RETRIEVE PARAMETERS EXT $SPCL SPOUT CLASS ID EXT $SPCR JOBFIL, SPLCON DISC CR EXT $LUAV SPOOL LU TABLE EXT $IS43 IN $SPCL HAS ADDR OF IS43 IN DVS43 EXT .DRCT PICK UP DIRECT ADDRESS EXT $LIBR GO PRIVILEGED EXT $LIBX SUSPEND PRIVILEGED OPERATION EXT READF FMGR READ EXT WRITF FMGR WRITE EXT EXEC SYSTEM CALLS EXT XLUEX EXTENDED SYSTEM CALLS EXT PRTN PASS PARAMETERS TO CALLER EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFERS * EXT SESSN CHECK IF UNDER SESSION EXT $SMVE MOVE SESSION SWITCH TABLE EXT LUTRU FIND CORRESP LU IN BATCH OR SESS SW TABLE EXT .CACT GET DIRECTORY # OF CURRENT SESSION EXT DTACH DETACH PROGRAM FROM SESSION A EQU 0 B EQU 1 XEQT EQU 1717B DRT EQU 1652B SUP HED SMP CALL PRAMS * PRAMS P1 THRU P5 DESCRIBE THE FUNCTION TO PREFORM * AS FOLLOWS: * * P1 =0 SET UP CALL REQUIRES A 16 WORD CŽG������þúLASS BUFFER * P2 =CLASS NUMBER * P3 =BATCH CHECK FLAG (ID ADDRESS OF PRIV. PROGRAM OR ZERO) * * P1 =1 CHANGE PURGE TO SAVE ON AN EXISTING FILE * P2 =LU ASSIGNED LU OR IF BATCH THE SWITCHED LU MAY BE USED * * P1 =2 CHANGE SAVE TO PURGE * P2 =LU ASSIGNED LU OR IF BATCH THE SWITCHED LU * * * P1 =3 PASS THE FILE TO OUT SPOOL * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =4 CLOSE AND PASS THE FILE * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =5 CHANGE LU AND OR PRIORITY OF OUT SPOOL * P2 =LU ASSIGNED OR SWITCHED IF IN BATCH * P3 =NEW OUT LU * P4 =NEW PRIORITY * * * P1 =6 SET BUFFERED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =7 CLEAR BUFFERRED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =8 GET CURRENT POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * * * P1 =9 CHANGE POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * P3 =POSITION PRAMETER 1 * P4 =POSITION PRAMETER 2 * P5 =POSITION PRAMETER 3 * * * P1 =10 SPOUT CAN NOT OUT SPOOL BECAUSE OF FAILURE * OF LULOCK REQUEST * * * * P1 =11 SPOUT CAN BEGIN OUT SPOOL * P2 =LU SELECTED FOR OUT PUT * * * P1 =12 DEQUEUE OUT SPOOL (SPOUT IS DONE) * P2 =LU ASSIGNED LU OF FILE * P3 = #0 IF A BAD EOF FOUND ELSE 0 * * * P1 =13 KILL SPOOL * P2 =SPLCON RECORD NUMBER OF FILE TO KILL * P3 =LU ASSIGNED FROM WORD 1 OF RECORD * P4 =0 * P5 =CURRENT STATUS OF FILE * * * P1 =14 HOLD A OUTSPOOL FILE * P2 =SPLCON RECORD NUMBER OF FILE * P3 =OUTSPOOL LU (CURRENT) * P4 =0 * P5 =CURRENT STATUS SPLCON RECORD WILL SHOW 'H' * * * P1 =15 RELEASE A HOLD * P2 =SPLCON RECORD NUMBER OF FILE * ¯������þúP3 =CURRENT OUT SPOOL LU * P4 =NEW LU OR 0 CAN CHANGE LU ON RELEASE * P5 =CURRENT STATUS OF FILE * * * P1 =16 SHUT DOWN OUTSPOOLING * * * P1 =17 START UP OUT SPOOLING * * * P1 =18 CALL FROM SPOUT A LU IS DOWN * P2 =LU CURRENT ASSIGNED LU * * * P1 =19 CLOSE ALL SPOOL FILES FOR A SESSION * P2 =DIRECTORY # OF SESSION * P3 =ADDRESS OF SESSION SWITCH TABLE * P4 =# WORDS IN SESSION SWITCH TABLE * * * P1 =20 OUTSPOOL RECORD LENGTH TOO LONG * P2 =LU CURRENT ASSIGNED LU HED SMP COMMANDS SKP DTAB DEF CPTS 1 CHANGE PURGE TO SAVE. DEF CSTP 2 CHANGE SAVE TO PURGE. DEF PASS 3 PASS NOW DEF CSAP 4 CLOSE SPOOL AND PASS DEF MPI 5 MODIFY PASS INFORMATION DEF SBF 6 SET BUFFER FLAG DEF CBF 7 CLEAR BUFFER FLAG DEF GCDP 8 GET CURRENT DISK POSITION DEF CSRP 9 CHANGE STARTING RECORD POSITION DEF LULOK 10 LU LOCK CONDITION IN SPOUT DEF SPSEL 11 SPOOL SELECTION BY SPOUT DEF DEQUX 12 DEQUEUE OUTSPOOL. DEF KILL 13 KILL SPOOL DEF HOLD 14 HOLD A SPOOL FILE DEF RELSE 15 RELEASE A HOLD. DEF SHUT 16 SHUT DOWN OUTSPOOLING. DEF STUP 17 START UP OUTSPOOLING. DEF DVCDN 18 I/O DEVICE DOWN SET HOLD DEF CSPAL 19 CLOSE & PASS ALL SPOOLS FOR SESSION DEF LONG 20 OUTSPOOL RECORD TOO LONG * * JOBFL BSS 2 HOLDS FIRST 16 WORDS OF JOBFIL DCB OCT 2 BSS 3 DEC 16 OCT 100210 BSS 5 OCT 0,200,0 SPLFL BSS 2 HOLDS FIRST 16 WORDS OF SPLCON DCB OCT 2 BSS 3 DEC 16 OCT 100210 UP DATE WRITE OK 128 WORD DCB BSS 5 OCT 0,200,0 * DCB1 BSS 144 BUF21 BSS 16 HOLDS SPLCON #1 MOSTLY BUF22 BSS 16 HOLDS SPLCON #2 AND #3 MOSTLY BUF2{ˆ������þú3 BSS 16 HOLDS CURRENT SPLCON FILE RECORD MOSTLY BUF24 BSS 16 HOLDS JOB RECORD #17 AND USED TO CHECK Q BLOCKS BUF25 BSS 62 HOLDS JOB RECORD FROM JOBFIL ALSO MENU MOSTLY LIMIT BSS 2 * * ALL BUFFERS ARE USED TO HOLD THE LU Q AT TIMES * * ORG DCB1 INITIALIZE CODE IS IN THE BUFFERS HED SMP INITIALIZE (IN BUFFER CODE) * SMP JSB RMPAR DEF *+2 DEF PARM1 LDA $SPCR GET DISC CR FOR JOBFIL & SPLCON SZA,RSS SPOOL INITIALIZED? JMP NOSPL NO, EXIT * STA SPCR LDA MSIGN SET OVERRIDE BIT TO SEARCH LDA XEQT GET MY ID ADDRESS STA JOBFL+9 SET THE OPEN FLAGS STA SPLFL+9 IN THE DCB SAVE AREAS CCE SET THE SIGN BIT RAL,ERA AND STA IID,I AND SAVE FOR NOW AND LATER JSB EXEC CALL D.RTR TO OPEN UP JOB FILE DEF *+10 DEF D23 DEF D.RTR IID DEF ID DEF MSIGN OVERRIDE OPTION -- SEARCH ALL DISCS DEF SPCR CARTRIDGE # FOR JOBFIL DEF SECCD SECURITY CODE DEF ZERO DEF JOBNA FILE NAME (NON-EXCLUSIVE) DEF D3 LENGTH OF FILE NAME BUFFER LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA JOBFL INB LDA B,I IN STA JOBFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA JOBFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA JOBFL+4 XOR B,I ALF,ALF STA JOBFL+8 SET THE SEC/TRACK WORD JSB EXEC GET STRING PASSED BY D.RTR DEF *+5 DEF D14 REQUEST CODE DEF D1 RETRIEVE STRING DEF SST USE AS TEMPORARY BUFFER DEF D4 LENGTH OF BUFFER NEEDED LDA SST+3 FILE SIZE ‹%������þú STA JOBFL+5 SAVE IN DCB IMAGE * JSB EXEC CALL D.RTR TO OPEN UP SPOL FILE DEF *+10 DEF D23 DEF D.RTR DEF ID DEF MSIGN OVERRIDE OPTION -- SEARCH ALL DISCS DEF SPCR CARTRIDGE # FOR SPLCON DEF SECCD DEF ZERO DEF SPLNA FILE NAME (NON-EXCLUSIVE) DEF D3 LENGTH OF FILE NAME BUFFER LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA SPLFL INB LDA B,I IN STA SPLFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA SPLFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA SPLFL+4 XOR B,I ALF,ALF STA SPLFL+8 SET THE SEC/TRACK WORD JSB EXEC GET STRING PASSED BY D.RTR DEF *+5 DEF D14 REQ. CODE DEF D1 RETRIEVE STRING DEF SST USE AS TEMPORARY BUFFER DEF D4 # WORDS TO RETRIEVE LDA SST+3 FILE SIZE STA SPLFL+5 SET IN DCB IMAGE FOR SPOOL FILE JMP SMP0 GO CONTINUE THE SET UP * BAIL JSB FILER REPORT THE ERROR AND JMP RETN4 EXIT * NOSPL LDA M48 SPOOL SYSTEM NOT INITIALIZED STA TEMP1 SAVE FOR PARAMETER RETURN JMP RETN5 * X377 OCT 377 M48 DEC -48 * TS EQU BUF21-* IF ERROR WE RAN OUT OF THE DCB * ORG BUF21 GET OUT OF THE DCB SO IT CAN BE USED * * SMP0 LDB DDCB1 LDA PTRJ SET UP TO ACCESS THE JOB FILE JSB .MVW DEF D16 NOP LDB X17 GET THE JOB FILE RN LDA PTX21 JMP SMP00 BAIL OUT OF THIS BUFFER * ORG BUF22 SAFE GROUND * SMP00 JSB RDREC READ JOBFILE RECORD 17 JMP RETN4 IF ERROR GET OUT * LDA BUF21 GET THE RN STA DJRN,I SAVE IT Ð=������þúJSB .DRCT GET IS43 ADDRESS FOR DEF $IS43 FOR FUTURE EQT CHECKING. LDA A,I STA IS43A SAVE THE ADDRESS. JSB .DRCT GET ADDRESS OF DEF $LUAV $LUAV TABLE AND SAVE. STA LUAVA LDB DDCB1 SET UP TO ACCESS THE SPOOL CONTROL FILE LDA PTRS JSB .MVW DEF D16 NOP * LDA PTX21 GET FIRST SPLCON RECORD. CLB,INB TS1 EQU *-BUF21-16 IF ERROR THEN CODE WILL BE OVERLAYED JSB RDREC JMP RETN4 ERROR EXIT * LDA PTX23 LDB X3 JMP SMP01 GET TO HIGH GROUND * ORG BUF24 GET OUT OF THE BUFFER * SMP01 JSB RDREC READ SHUT DOWN WORD. JMP RETN4 EXIT IF ERROR * LDA BUF21 STA SRN SAVE SPLCON RESOURCE #. LDA BUF23 SAVE CURRENT SHUT DOWN CONDITION. STA SHUTX,I LDA BUF23+1 SAVE HOLD RN. STA WRN JSB .DRCT INITIALIZE THE MENU. DEF BUF21+6 POINTER TO LU AREA STA TEMX1 LDA MPTRX POINTER TO MENU STA TEMX2 CONTAINS LU-#FILES ON QUE LDA X9 SMP2 STA TEMX3 LDA TEMX2,I SZA,RSS MUST GO THROUGH ALL THE OUTSPOOL JMP SMP4 QUEUES PICKING UP THE NUMBER * LDB TEMX1,I OF OUTSPOOLS WAITING ON EACH STB TEMX2,I ONE. THIS WILL ENABLE A SZB,RSS START-UP TO PICK THEM UP JMP SMP5 OUTSPOOL LU IS 0 * LDA PTX23 LDB TEMX3 READ IN THE BEGINNING JSB RDREC OF A QUEUE BLOCK. JMP RETN4 * LDB BUF23+1 GET COUNT OF OUTSPOOLS. SZB,RSS ANY IN QUEUE? JMP SMP5 NO * LDA BUF23+3 GET PRIORITY OF FIRST SPOOL IN QUEUE SZA IF 0 SPOUT MAY BE WORKING ON IT JMP SMP5 SPOUT NOT WORKING ON THIS SPOOL FILE * STB TEMP1 SAVE THE # OF OUTSPOOLS IN QUEUE LDB BUF23+2 GET THE SPLCON REC # OF FIRST FILE IN QUEUE LDA PTX23 ADDRESS OF BUFFER JSé������þúB RDREC READ SPLCON RECORD JMP RETN4 ERROR * CLE LDA BUF23+10 GET THE STATUS OF SPOOL FILE CPA "A" ACTIVE? CCE YES CPA "AH" CCE LDB TEMP1 GET THE SAVE # OF OUTSPOOLS IN QUEUE RBL,ERB SET SIGN BIT IF SPOUT ALREADY WORKING ON IT SMP5 ISZ TEMX2 STB TEMX2,I ISZ TEMX2 STEP MENU ADDRESS ISZ TEMX1 STEP LU LIST ADDRESS LDA TEMX3 STEP RECORD ADDRESS ADA X8 BY 8 JMP SMP2 AROUND WE GO * SMP4 LDA $SPCL CHECK IF CLASS HAS BEEN AND B377 SZA ALLOCATED FOR SPOUT. IF SO, JMP SETCL DON'T DO IT AGAIN. * JSB EXEC ALLOCATE CLASS FOR DEF *+5 SPOUT REQUESTS. DEF X19 DEF ZERO DEF ZERO DEF SP.CL LDA SP.CL GET THE CLASS AND IOR B20K SET THE DON'T RELEASE JSB $LIBR NOP STA $SPCL BIT JSB $LIBX DEF *+1 DEF *+1 SETCL LDA $SPCL GET THE SPOOL CLASS # STA SP.CL AND SAVE IT LOCALLY JMP SMP1 * X3 DEC 3 DDCB1 DEF DCB1 B20K OCT 20000 SHUTX DEF SHUTD X8 DEC 8 X19 DEC 19 X17 DEC 17 X9 DEC 9 JOBNA ASC 3,JOBFIL SPLNA ASC 3,SPLCON PTRJ DEF JOBFL PTRS DEF SPLFL PTX21 DEF BUF21 PTX23 DEF BUF23 MPTRX DEF .MENU TEMX1 NOP TEMX2 NOP TEMX3 NOP DJRN DEF JRN HED SMP COMMAND DECODE SMP1 JSB POST MAKE SURE WE'RE SET DEF *+2 FOR NEW RECORDS TO BE DEF DCB1 READ CLEAN FROM DISK. JSB LOCK LOCK THE SPLCON RN. DEF SRN LDA PTR21 CLB,INB JSB RDREC NOP ********************************************** LDA BUF21+3 GET START OF SPOOL CONTROL RECORDS STA SPREC SAVE IT JSB SESSN UNDER SESSION? DEF *+2 DEF XEQT PROGRAM ID SEGMENT ADDRESS CLA ERA STA SESNF ü8������þúSESSION FLAG--UNDER SESSN IF BIT15 ZERO STB SESID SESSION ID LDA PARM1 WHAT TYPE OF REQUEST? SZA,RSS JMP SETUP NEW SETUP. * CPA D18 IF DOWN DEVICE JMP USEOR GO GET THE RECORD * CPA D20 IF OUTSPOOL RECORD TOO LONG JMP USEOR GO GET THE SPLCON RECORD * CPA D12 JMP USEOR DEQUEUE. * ADA M10 SSA,RSS JMP CJUMP REQ.PARM. >=10 -- GASP OR SPOUT REQUEST. * JSB LUTRU TRANSLATE SPOOL LU THRU DEF *+3 BATCH SWITCH TABLE DEF PARM2 OR THRU SESSION SWITCH TABLE DEF TEMP2 LDA TEMP2 IF SESSION INSTALLED, SSA,RSS LU IN SESSION SWITCH TABLE? JMP USERL YES ERM40 LDA M40 NO, SEND ERROR BACK STA TEMP1 JMP MENU LU NOT DEFINED * USERL LDB PARM2 SAVE ORIGINAL LU# ADB M1 STB SESLU SESSION LU - 1 FOR SST SCAN STA PARM2 USEOR JSB FLU SEARCH LU AVAILABILITY JMP ERM22 * * LDB TEMP1,I SAVE CORRESPONDING RECORD SZB JMP STREC RECORD ASSIGNED, SET REC # LDA SESLU SESSION SPOOL LU - 1 JSB FSELU NO RECORD, FREE SPOOL LU FROM SST JMP MENU SKIP OUT * STREC STB RECNO # OF SPLCON RECORD. LDA PTR23 JSB RDREC READ THE APPROPRIATE RECORD. JMP RETRN READ ERROR. * CJUMP CCA IS THE REQUEST ADA PARM1 PARAMETER VALID? SSA JMP MENU ILLEGAL REQUEST PARAMETER. * STA B ADB M20 SSB,RSS JMP MENU ILLEGAL REQUEST PARAMETER. * ADA RTAB BRANCH TO APPROPRIATE JMP A,I SERVICE ROUTINE * FLU NOP ROUTINE TO FIND LU IN LUAV LDB LUAVA SEARCH LU AVAILABILITY LDA B,I SZA,RSS JMP FLU,I CAN'T FIND. * STA TEMP2 LOOP5 INB LDA B,I AND B377 INB CPA PARM2 DOES THE}Ý������þú LU MATCH JMP FOUND THE ONE GIVEN? * ISZ TEMP2 JMP LOOP5 * JMP FLU,I NOT FOUND * FOUND ISZ FLU FOUND STEP ADDRESS STB TEMP1 SET ADDRESS FOR LATER JMP FLU,I AND EXIT * SP.CL NOP SPCR NOP SESNF NOP SESID NOP SESLU NOP M40 DEC -40 RTAB DEF DTAB,I REQUEST TABLE. LUAVA BSS 1 D14 DEC 14 D20 DEC 20 M10 DEC -10 D18 DEC 18 D70 DEC 70 D71 DEC 71 M70 DEC -70 S24 OCT 100030 HED SMP SA TO PU TO SA & PASS CSTP CLE,RSS CHANGE SAVE TO PURGE. * CPTS CCE CHANGE PURGE TO SAVE. LDA BUF23+8 ERA,RAL STA BUF23+8 WRTRC JSB WRT23 WRITE OUT SPOOL CONTROL JMP MENU * * PASS LDB BUF23+8 BATCH INPUT? RBL SSB JMP MENU YES - ILLEGAL REQUEST. * LDA BUF23+15 IF NO LU SZA,RSS THEN JMP MENU IGNOR * LDB BUF23+8 WAS THE FILE BEING RBR,SLB HELD UNTIL CLOSE. RSS JMP MENU NO - FILE WILL HAVE BEEN PASSED. * LDA BUF23+8 REMOVE HOLD BIT IOR D2 SET JUST IN CASE XOR D2 STA BUF23+8 JSB QUEUE QUEUE THE FILE JMP MENU * HED SMP CLOSE AND PASS ALL CSPAL LDA PARM2 CLOSE ALL SPOOL FILES FOR STA TEMPC GIVEN ACCOUNT # LDA PARM3 SESSION ID STA SESID JSB $SMVE GET SESSION SWITCH TABLE DEF *+6 DEF D1 READ SST DEF SESID ADDRESS OF SST DEF D1 ONE WORD OFFSET INTO SST DEF SST DEF D70 MAX SIZE OF SST * LDA M70 STA TEMPD LDA ASST ADDRESS OF SST STA TEMPE CLSLP LDA TEMPE,I GET SST ENTRY AND B377 MASK SESSION LU CPA ZERO SESSION TERMINAL LU? JMP MENU YES, THEN NO MORE FILES LEFT LDA TEMPE,I GET SST ENTRY ALF,ALF INA AND B377 GET SYSTEM LU ûÀ������þú STA PARM2 SAVE IT JSB FLU FIND LU IN $LUAV TABLE? JMP CLSEN CANNOT FIND -- SHOULD NOT HAPPEN JMP SPLLU YES CLSEN ISZ TEMPE ISZ TEMPD INCREMENT COUNTER JMP CLSLP NOT DONE YET JMP MENU NO MORE SPOOL FILES LEFT TO CLOSE * SPLLU LDA TEMPE,I GET SST ENTRY AND B377 GET SESSION LU# STA SESLU SAVE IT LDB TEMP1,I GET RECORD # SZB,RSS IF NOT ASSIGNED SKIP JMP CLSEN STB RECNO SAVE RECORD # LDA PTR23 JSB RDREC READ SPLCON RECORD JMP RETRN FILE NOT FOUND LDA BUF23+11 CLOSE THE FILE SSA IN BATCH? JMP CLSPS YES, SKIP CHECK ELA,CLE,ERA CLEAR SIGN BIT CPA TEMPC DIRECTORY # MATCHING? CLSPS JSB CSPAS YES, THEN CLOSE AND PASS FILE JMP CLSEN NO, LOOK AT NEXT SST ENTRY HED SMP CLOSE AND PASS GIVEN FILE * * CLOSE AND PASS THE SPOOL FILE * CSAP JSB CSPAS JMP MENU * * * CSPAS NOP LDA BUF23+12 SZA,RSS JMP CKSES WORD 12 NOT SPECIFIED JSB EXEC SCHEDULE PROG IN WORDS 12-14 OF BUFFER DEF *+10 DEF S24 =100030B DEF BUF23+12 DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF BUF23 DEF D16 JMP CKSES LDA BUF23+8 CCE RAR,ELA SET BIT TO SAVE FILE STA BUF23+8 AFTER OUTSPOOL * CKSES LDB SESNF GET SESSION FLAG LDA SESLU SESSION LU - 1 SSB,RSS IN SESSION? JSB FSELU YES, FREE SPOOL LU FROM SST * LDA BUF23+15 IS FILE TO BE PASSED?? SZA WELL? JMP PCHK YES GO PASS IT * JSB PRGEX CLOSE THE FILE JMP CSPAS,I RETURN * * PCHK LDB TEMP1 GET LUAV ADDRESS JSB FRELU FREE THE LU AND EQT LDA BUF23+8 WAS IT PASSED BEFORE? RAR,SLA IS HOLD BIT SET? Šç������þú RSS JMP CSPAS,I NO, DO NOT PASS NOW (DONE ALREADY) * LDA BUF23+8 REMOVE HOLD BIT. IOR D2 SET JUST IN CASE XOR D2 NOW CLEAR IT STA BUF23+8 JSB QUEUE GO SET IT UP JMP CSPAS,I * * * "W" OCT 127 HED SMP MODIFY PASS INFO MPI LDA PARM4 SAVE NEW PRIORITY IF SZA,RSS IF GIVEN. JMP MPI1 * SSA,RSS STA BUF23+9 MPI1 LDA BUF23+15 SAVE OLD LU. STA TEMP2 LDA PARM3 GET NEW LU STA PARM4 IF GIVEN. SZA,RSS SKIP IF NOT GIVEN JMP CKVAL STA BUF23+15 AND B77 ISOLATE NEW LU# STA TEMP6 LDB SESNF GET SESSION FLAG SSB,RSS IN SESSION? JSB TROLU YES,GET THE TRUE OUTSPOOL LU JSB STOLU SET OUTSPOOL LU IN BUF23+15 STA PARM4 SAVE FOR USE LATER LDB "W" SET STATUS TO WAIT LDA BUF23+10 IF NONE WAS DEFINED SZA,RSS PREVIOUSLY STB BUF23+10 CKVAL JSB SMENU CHECK VALIDITY. JMP MPIER NEW LU NOT GOOD. * LDB BUF23+10 IF SPOOL IS ACTIVE, CPB "A" WE CAN PERFORM JMP MPIER THIS OPERATION. * CLB STB TEMP1 LDA TEMP2 IF NO OLD LU, SZA,RSS WRITE RECORD AND JMP MI4 QUEUE IF NEEDED NOW. * LDB BUF23+8 REQUEUE UNLESS THE RBR,SLB FILE IS BEING HELD JMP MI4 FROM THE QUEUE * STA BUF23+15 JSB WRT23 WRITE THE CURRENT RECORD CCE SET TO SHOW NOT ACTIVE JMP DEQ18 UNTIL IT IS CLOSED. * MI4 JSB QUEUE WRITE RECORD AND Q IF NEEDED JMP MENU GO OUT THE STANDARD WAY * MPIER LDA TEMP2 STA BUF23+15 LDA M21 STA TEMP1 JMP WRTRC * SBF JSB FEQT SET BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD JSB PUTM JMP MENU * PTR21 DEF BUF21 PTR23 DEF BUF23 D3 DEC 3 $b������þú D12 DEC 12 BUFRD OCT 40000 * CBF JSB FEQT CLEAR BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD SET BIT TO BE CLEARED CLE SET THE CLEAR FLAG JSB PUTM CLEAR THE BIT JMP MENU * SETEQ NOP SUB TO SET EQT ADDRESSES JSB FEQT GET CURRENT DISK POSITION. ADA D2 ADDRESS OF EQT18 (CURRENT TRACK) STA TEMP5 SAVE IT ADA D2 STEP TO EQT20 (EXTENSION NUMBER) STA TEMP2 AND SAVE IT INA NOW EQT21 (CURRENT SECTOR) STA TEMP1 SAVE IT ADA D3 EQT24 (FIRST TRACK OF EXTENT) STA TEMP3 SAVE IT INA EQT25 (FIRST SECTOR OF EXTENT) STA TEMP4 SAVE IT INA EQT26 (FILE SIZE) STA DFSIZ SAVE ADDRESS OF FILE SIZE ADA D4 EQT30 (# SECTORS/TRACK) STA D#PTR SAVE IT JMP SETEQ,I RETURN HED SMP GET CURRENT DISC POSITION GCDP JSB SETEQ SET THE EQT ADDRESSES LDA TEMP3,I GET THE BASE TRACK CMA,INA SUBTRACT FROM ADA TEMP5,I CURRENT TRACK MPY D#PTR,I TIMES #/TRACK D#PTR EQU *-1 LDB TEMP4,I GET BASE SECTOR CMB,INB AND SUBTRACT ADA B IT THEN ADA TEMP1,I ADD CURRENT SECTOR A=SECTOR OFFSET STA TEMP1 IN CURRENT EXTENT LDA TEMP2,I GET EXTENT MPY DFSIZ,I TIMES EXTENT SIZE = SECTOR OFFSET OF DFSIZ EQU *-1 THIS EXTENT CLE NOW ADD THE TWO ADA TEMP1 DO DOUBLE WORD SEZ,CLE INB ADD STA TEMP1 SET FOR STB TEMP2 RETURN ISZ TEMP5 GET THE OFFSET LDA TEMP5,I AND STA TEMP3 SET IT FOR RETURN JMP SRSEX EXIT SMP (SST #4236) * CSRP JSB SETEQ SET UP THE EQT ADDRESSES ADB D10 ADDRESS OF EQT11 STB SETEQ SAVE IT FOR LATER LDA DFSIZ SET ADDRESSES INA SET UP TO GEž•������þúT THE EXTENT STA DIRCT IN ALL CASES INA STA DIRCT+1 LDA PARM3 GET THE DOUBLE WORD LDB PARM4 SECTOR OFFSET DIV DFSIZ,I DIVIDE BY FILE SIZE STA PARM1 SET EXTENT NUMBER FOR D.RTR CALL STB PARM2 SAVE THE REST * JSB EXEC SCHEDULE D.RTR TO OPEN DEF *+8 THE EXTENT. DEF D23 DEF D.RTR DEF XEQT ID SEGMENT ADDRESS. DEF D6 READ DIRCT BSS 2 DEF PARM1 EXTENSION # JSB RMPAR DEF *+2 DEF D.1 LDA D.1 SSA JMP RETRN * LDA D.5 AND B377 JSB $LIBR GO PRIV TO SET THE EQT NOP STA TEMP4,I STORE BEGINNING SECTOR (EQT25). CLB,CLE SET UP THE ADA PARM2 OFFSET SEZ INB NOW DIV D#PTR,I GET TRACK OFFSET AND SECTOR ADDRESS STB TEMP1,I SET CURRENT SECTOR ADA D.4 SET CURRENT TRACK STA TEMP5,I IN EQT 18 LDA D.4 STA TEMP3,I STORE BEGINNING TRACK (EQT24). LDA PARM5 IOR DM128 MAKE SURE RANGE IS RIGHT ISZ TEMP5 STEP TO EQT19 STA TEMP5,I STORE CURRENT OFFSET (EQT19). LDA PARM1 STA TEMP2,I STORE CURRENT EXTENT (EQT20). LDA SETEQ,I GET EQT11 AND AND NTEOF CLEAR THE EOF FLAGS STA SETEQ,I RESTORE IT JSB $LIBX GO TEST MENU DEF *+1 DEF MENU * "A" OCT 101 C377 OCT 177400 NTEOF OCT 117777 MASK TO CLEAR EOF FLAGS M26 DEC -26 M22 DEC -22 D4 DEC 4 B3700 OCT 3700 B377 OCT 377 B77 OCT 77 BMASK OCT 137777 BPAT NOP ADDR1 NOP RECNO NOP D2 DEC 2 M1 DEC -1 M2 DEC -2 M4 DEC -4 M16 DEC -16 PARM1 BSS 1 PARM2 BSS 1 PARM3 BSS 1 PARM4 BSS 1 PARM5 BSS 1 SECCD OCT 123456 RRR OCT 101100 ROTATE RIGHT INSTRUCTION RRL OCT 100100 ROTATE LEFT INSTRUCTION * ERM26 LDA M26 JMP NOGO1 HED SUJ������þúMP SET UP INITIAL FILE SETUP CLA SET FLAG TO INDICATE FIRST TIME STA TEMPC THRU CLASS READ FOR SETUP BUFFER STUP1 LDA PTR22 HAVE RECORD 1. STA ADDR1 SAVE FOR LATER LDB D2 GET RECORD 2. JSB RDREC JMP NOGO1 READ ERROR. * * FIND IF THERE IS AN AVAILABLE SPLCON RECORD. * LDA M16 SET UP STA TEMP1 COUNTER LDA BUF21+3 GET REC. # OF FIRST REC STA RECNO SAVE IT LDA BUF21+1 GET NUMBER OF RECORDS CMA,INA SET FOR COUNTER STA TEMP3 IN TEMP3 LOOP1 LDA M16 SET UP STA TEMP2 COUNTER TWO CLB,INB SET INITIAL BIT MASK LOOP2 LDA ADDR1,I TRY AND B ONE SZA,RSS AVAILABLE?? JMP HAVIT YES USE IT * ISZ TEMP3 ANY RECORDS LEFT? RSS YES SKIP JMP NOGO NO SO SORRY! * RBL NO ADVANCE BIT MASK ISZ RECNO SEP RECORD NUMBER ISZ TEMP2 AND COUNT WORD EXHAUSTED?? JMP LOOP2 NO TRY NEXT BIT * ISZ ADDR1 YES TRY NEXT WORD ISZ TEMP1 IS THERE A NEXT WORD?? JMP LOOP1 YES TRY IT. * JMP NOGO NO AVAILABLE RECORD. * HAVIT LDA ADDR1,I SAVE NEW BIT PATTERN XOR B IN A TEMPORARY. STA BPAT LDA BUF21+4 CMA,INA SET NEGATIVE STA PARM5 SAVE MAX. # PENDING OUTSPOOLS. * * FIND OUT WHETHER ANY OUTPUT QUEUES ARE FULL * OR TOTAL PENDING OUTSPOOLS MATCH THE MAXIMUM. * LDB MPTR GET THE MENU ADDRESS LOOP3 LDA B,I GET ENTRY SZA,RSS END OF LIST? JMP SMP3 YES * INB NO STEP TO COUNT LDA B,I GET COUNT RAL,CLE,ERA CLEAR THE SIGN CPA D63 FULL?? JMP ERM26 YES SENT BACK ERROR * ADA PARM5 ADD TO TOTAL STA PARM5 RESET TOTAL SSA,RSS IF NEG. THEN JMP ERM26 TOO MANY * ø¢������þú INB NEXT JMP LOOP3 AROUND AGAIN * * * FIND AN AVAILABLE LU #. * * SMP3 CLA,RSS CLEAR TEMP1 FOR NOW NOGO LDA M22 * NOGO1 STA TEMP1 LDA PARM2 SET OPTION TO NOT RELEASE JSB EXEC DO A CLASS GET TO RETRIEVE DEF *+5 THE SETUP BUFFER. DEF D21 DEF PARM2 DEF BUF23 DEF D16 CHKER LDA TEMP1 SSA ERROR SET? JMP SRSEX YES,THEN DON'T LOOK FOR SPOOL LU * * LOOK FOR SPOOL LU * LDA BUF23+15 GET OUTSPOOL LU AND B77 ISOLATE LU # LDB SESNF GET SESSION FLAG SSB IN SESSION? JMP NOSES NO STA TEMP5 SZA JSB TROLU GET TRUE OUTSPOOL LU JSB STOLU SET OUTSPOOL LU IN SETUP BUFFER * LDA BUF23+1 GET WORD ONE OF SETUP BUFFER CPA M1 DIRECT MAPPING REQUESTED? JMP SMP7 YES * SZA,RSS LU GIVEN? JMP NOLU SESSION LU FOR SPOOL FILE NOT GIVEN * CPA D1 LU SPECIFIED IS LU 1? JMP ERM20 YES, THEN ERROR * ADA M64 GREATER THAN 63? SSA,RSS JMP ERM20 YES, ERROR * JSB EXEC GET STATUS WORD OF LU DEF *+4 DEF S13 =100015B NO ABORT RETURN DEF BUF23+1 LU SPECIFIED IN SETUP BUFFER DEF TEMP4 GET EQT WORD 5 JMP LUOK LU NOT IN SST, THEN OK * LDA TEMP4 EQT WORD 5 AND B36K =36000B CPA B14K EQUIPMENT TYPE CODE > 30B? JMP ERM20 YES, DISC LU -- ERROR * LUOK LDA BUF23+1 LU IS OK, SET IT UP IN SST JMP SETLU * * ERM20 LDA M20 NO, THEN ERROR STA TEMP1 ILLEGAL ACCESS LU JMP SRSEX EXIT * NOLU CLA CLEAR THE LU TABLE USED TO LDB LUTBL REMEMBER THE SESSION LU #'S CLRLU STA B,I ENCOUNTERED IN THE SST CPB LUTBE DONE? JMP SCNST YES INB NEXT WORD IN LU TABLE Oà������þú JMP CLRLU * SCNST JSB $SMVE READ THE SST DEF *+6 DEF D1 DEF SESID SESSION WORD DEF ZERO DEF SST DEF D71 LDA SST GET THE NEGATIVE LENGTH WORD FOR SST STA TEMP3 SAVE FOR COUNTER LDA ASST INA STA TEMP4 POINTER FOR THE SST SRCHL LDA TEMP4,I GET AN ENTRY FROM SST AND B377 ISOLATE SESSION LU INA STA TEMP6 SAVE FOR NOW ADA M64 > 63? SSA,RSS JMP NXTLU YES,THEN IGNORE THIS ENTRY * LDA TEMP6 SESSION LU FROM SST ENTRY CLB RRR 4 DIVIDE LU # BY 16 ADA LUTBL QUOTIENT GIVES THE WORD INDEX IN LUTBL STA TEMP6 SAVE THIS ADDRESS BLF GET THE REMAINDER STB TEMP5 REMAINDER INDICATES BIT POSITION TO SET ADB RRR CONFIGURE THE RRR INSTRUCTION WITH STB RRRIN THE NUMBER OF ROTATES TO PERFORM LDB RRL CONFIGURE ROTATE LEFT INSTR ADB TEMP5 TO RESTORE THE LUTBL WORD STB RRLIN LDA A,I GET CONTENTS OF LUTBL WORD RRRIN NOP RRR INSTRUCTION SETUP ONLINE IOR D1 SET THE BIT RRLIN NOP RRL INSTRUCTION SETUP ONLINE STA TEMP6,I RESTORE THE WORD IN LUTBL NXTLU ISZ TEMP4 POINT TO NEXT ENTRY IN SST ISZ TEMP3 INCREMENT NEGATIVE COUNT JMP SRCHL SET THE BITS FOR THE NEXT SESSION LU * * LDB LUTBE GET THE ADDR OF LAST WORD IN LUTBL STB TEMP3 SAVE ADDRESS LDB D63 LARGEST POSSIBLE SESSION LU# WRDLP LDA M16 COUNTER FOR # OF BITS IN ONE WORD STA TEMP4 LDA TEMP3,I GET A WORD FROM LUTBL BITLP SSA,RSS HIGH BIT SET? JMP SESPL NO, SESSION LU # FOR SPOOL IS FOUND * RAL MOVE THE NEXT BIT IN HIGH POSITION ADB M1 NEXT LU# SZB,RSS ALL LU #'S USED UP? JMP ERM47 NO AVAILABLE SESSION LU FOR SPOOL FILE * ISZ TEMP¡$������þú4 INCREMENT BIT COUNTER JMP BITLP CHECK NEXT BIT * LDA TEMP3 POINT TO NEXT WORD ADA M1 STA TEMP3 JMP WRDLP * SESPL SWP SESSION LU # FOR SPOOL SETLU STA TEMP4 SESSION LU JSB HIGHL FIND AVAIL LU FROM BOTTOM OF $LUAV JMP ERM22 NO AVAILABLE LU - ERROR STA TEMP3 SYSTEM SPOOL LU * LDA TEMP4 SET TEMP1 FOR RETURNING SPOOL LU JMP SMP11 * SMP7 JSB FINDU FIND AVAIL LU TO AVOID CONFLICT IN SST JMP ERM22 NO LU FOUND STA TEMP3 SET SYSTEM LU SMP11 STA TEMP1 USE THIS LU AS SESSION LU LDA BUF23+11 SSA,RSS IN BATCH? JSB .CACT NO, FIND DIRECTORY ENTRY # OF SESSION STA BUF23+11 JMP SMP9 * * NOSES STA TEMP6 SAVE LU # IF NOT IN SESSION JSB STOLU SET OTSPOOL LU IN SETUP BUFFER JSB FINDL FIND AVAILABLE LU IN $LUAV JMP ERM22 LU NOT FOUND, SEND ERROR STA TEMP3 SAVE LU STA TEMP1 SPOOL LU TO PASS BACK ADA M64 LU > 63(10)? SSA,RSS JMP ERM22 YES, ERROR * SMP9 JSB SMENU JMP ERM21 * LDA TEMP3 STA BUF23+1 SAVE LU# IN SETUP BUFFER. SSA IF NO LU THEN TAKE GAS! JMP ERMES * LDA BUF23+5 GET THE SECURITY CODE CPA SECCD 123456B? JMP SETOV YES, COMING FROM JOB, SET OVVERRIDE BIT * LDB BUF23+8 IS THIS A SPOOL POOL FILE? LSR 3 CLA DO NOT USE ANY OVERRIDE OPTIONS IF NOT SLB A SPOOL POOL FILE SETOV LDA MSIGN SPOOL POOL FILE - SEARCH ALL CARTRIDGES JSB OPNSP TRY TO OPEN THE SPOOL FILE. SSA JMP ERMES COULDN'T OPEN THE FILE? LDA S.1 GET THE FILE TYPE ELA,CLE,ERA CLEAR SIGN BIT SZA,RSS TYPE 0 FILE? JMP ERM16 TYPE 0 FILE ILLEGAL * LDA D.2 GET DISC CARTRIDGE OF FILE AND B77 CMA,INA ST϶������þúA BUF23+6 NEGATIVE LU# * *********** CHECK SECURITY FLAG AGAINST W/R FLAGS ************ LDA SESNF UNDER SESSION? SSA JMP SMP8 NO * * INSERT LU IN SESSION SWITCH TABLE * CLA STA TEMP5 INITIALIZE SST OFFSET WORD CCA ADA TEMP3 LU'S IN SST ARE LU#-1 STA TEMP3 CCB ADB TEMP1 STB TEMP1 ALF,ALF SYSTEM LU IN UPPER BYTE IOR B SESSION LU IN LOWER BYTE STA TEMP SAVE FOR NOW JSB $LIBR TURN OFF INTERRUPTS TO NOP MODIFY SESSION SWITCH TABLE JSB $SMVE READ SPARE ENTRIES IN SST DEF *+6 DEF D1 READ DEF SESID SESSION ID DEF D1 OFFSET FROM SST LENGTH WORD DEF SST BUFFER TO HOLD THESE SST ENTRIES DEF D70 MAX SIZE OF SST IS 70 WORDS LDB ASST ADDRESS OF BUFFER #SPRS LDA B,I FIND THE ADDRESS OF LAST SPARE ENTRY AND B377 MASK SESSION LU CPA ZERO SESSION TERMINAL? JMP PKSST YES, THEN PACK SST * CPA TEMP1 SESSION SPOOL LU? RSS YES JMP INC#S NO, INCREMENT COUNTER * LDA B,I GET THE SST ENTRY ALF,ALF AND B377 SYSTEM SPOOL LU CPA D254 IS IT 254? CCA,RSS YES, SPOOL FILE USING THIS LU WAS KILLED JMP INC#S NO * STA B,I RELEASE ENTRY FROM SST INC#S ISZ TEMP5 INCREMENT COUNTER FOR # OF SPARES INB NO, LOOK MORE JMP #SPRS * PKSST CPB ASST ARE THERE ANY SPARE ENTRIES? JMP NOSPC NO, THEN ERROR * ADB M1 YES, THEN ADDRESS OF LAST SPARE ENTRY STB TEMP4 POINTER POINTS TO FIRST AVAILABLE SPARE ENTRY PCKLP LDA B,I GET CONTENTS OF SPARE ENTRY IN SST CPA M1 IS IT EMPTY? JMP EMPTY YES * CPB TEMP4 NO, ALL SPARE ENTRIES PACKED SO FAR? JMP NOMV YES LDA B,I NO®ù������þú, MOVE CURRENT SPARE ENTRY STA TEMP4,I TO THE FIRST AVAILABLE EMPTY SLOT CCA MAKE CURRENT SPARE ENTRY EMPTY STA B,I NOMV LDA TEMP4 POINT TO NEXT SPARE ENTRY IN THE PACKED LIST ADA M1 STA TEMP4 EMPTY CPB ASST REACHED THE TOP OF SPARE ENTRY LIST? JMP SSTDN YES * ADB M1 NO, POINT TO NEXT ENTRY JMP PCKLP * SSTDN CMB,INB IF CURRENT SPARE POINTER IS ADB TEMP4 LOWER THAN START OF SST THEN NO MORES SPARES SSB ARE AVAILABLE JMP NOSPC NO EMPTY SLOTS LEFT IN SST, ERROR LDA TEMP SET UP THE NEW SST ENTRY STA TEMP4,I FOR SPOOL LU JSB $SMVE INSERT SYS & SESS LU WORD IN SST DEF *+6 DEF D2 WRITE DEF SESID SESSION ID DEF D1 START OF SST DEF SST WRITE ALL SPARE ENTRIES DEF TEMP5 # OF SPARE ENTRIES ISZ TEMP1 JSB $LIBX TURN ON INTERRUPTS DEF *+1 DEF *+1 * SMP8 LDA BUF23+8 IF BATCH INPUT RAL,ELA THEN CLA,SEZ CLEAR STA BUF23+15 OUTSPOOL LU. LDA BUF23+9 IF PRIORITY IS NEG SSA THEN CLA SET ZERO STA BUF23+9 TO AVOID Q PROBLEMS * LDB BUF23+15 GET OUTSPOOL LU SZB,RSS DEFINED? JMP SETST NO, THEN SET STATUS TO 0 * LDB BUF23+10 GET STATUS CPB "H" IF NOT HOLD JMP SSEQ * LDB "W" SET TO WAIT SETST STB BUF23+10 SSEQ JSB SSEQT SET UP THE EQT LDA BUF23+8 IF A WRITE ONLY ALF,ALF ACCESS CCE,SLA,RSS JMP SS5 NOT WRIT ONLY * LDA BUF23+1 GET THE LU RAL,ERA SET SIGN BIT TO USE TRUE LU. STA TEMP5 LDA B100 SET UP A EOF REQUEST STA TEMP6 JSB XLUEX DO EOF DEF *+3 DEF D3 DEF TEMP5 LDA B200 STA TEMP6 JSB XLUEX NOW BACKSPACE DEF æ¬������þú*+3 DEF D3 DEF TEMP5 * SS5 LDA BUF23+8 FIX THE STD. FLAG CMA AS REQUIRED AND D16 ISOLATE THE BIT XOR CLSPT,I CLEAR IT IF NEED BE LDB CLSPT JSB PUT SET THE WORD BACK IN EQT11 JSB QUEUE QUEUE THE FILE IF NEEDED JMP MENU * S13 OCT 100015 B36K OCT 36000 B14K OCT 14000 M20 DEC -20 HED SMP SET UP EQT ROUTINE * SET UP SPOOL EQT ENTRY. * SSEQT NOP EQT SET UP SUB ROUTINE JSB FEQT FIND ADDRESS OF EQT. INB MAKE SURE THAT THIS IS LDA B,I REALLY A SPOOL EQT. CPA IS43A DO THIS BY CHECKING JMP SS3 EQT2 AGAINST THE INIT. * JMP ERM39 ENTRY POINT OF DVS43. * SS3 ADB D2 HAVE EQT ADDRESS. STB TEMP3 GET EQT4 ADDRESS. JSB $LIBR GO PRIVILEGED TO BE ABLE NOP TO STUFF THE EQT. LDA TEMP3,I SET OR CLEAR BUFFERING AND BMASK FLAG. LDB BUF23+8 SSB XOR BUFRD STA TEMP3,I ISZ TEMP3 LDA BUF23+7 GET DRIVER TYPE AND PUT ALF,ALF AND POSITION CORRECTLY STA TEMP3,I IN EQT5. LDB TEMP3 ADB D6 SET UP REMAINDER OF STB CLSPT SAVE ADDRESS OF EQT 11 LDA PARM1 IF THIS CMA,CLE,INA IS A SET UP FOR SPOUT CLEAR E LDA D16 SET THE STANDARD BIT AT ALL TIMES SEZ IF SPOUT USE ONLY THE STD. BIT IOR BUF23+8 DISPOSITION FLAGS. AND DMASK EQT11. STA B,I ADB D2 INDEX TO EQT EXTENSION. LDB B,I ADB D2 SAVE ADDRESS OF CURRENT STB TEMP3 TRACK/SECTOR. ADB D8 LDA S.4 SAVE FILE SIZE IN EQT26. STA B,I SAVE MASTER DIRECTORY ENTRY INB IN EQT27 AND EQT28. LDA D.2 STA B,I INB LDA D.3 STA B,I ADB M4 LDA D.4 STA B,I SAVE BEG¶������þúINNING TRACK (EQT24). STA TEMP3,I SAVE CURRENT TRACK (EQT18). ISZ TEMP3 LDA DM128 SET STA TEMP3,I OFFSET ISZ TEMP3 CLA CLEAR THE STA TEMP3,I EXTENT #. ISZ TEMP3 LDA D.5 SAVE CURRENT SECTOR. AND B377 STA TEMP3,I INB STA B,I SAVE BEGINNING SECTOR. ADB D4 LDA BUF23+8 SET BATCH CHECK FLAG RAL,ELA IN E LDA PARM1 SETUP FOR SPOUT? SEZ IF NOT BATCH IN CHECK USE ZERO SZA ALSO FOR SPOUT CLA,RSS BATCH CHECKING DOESN'T APPLY. LDA PARM3 PUT BATCH CHECKING INFO. STA B,I INTO EQT29. INB LDA D.5 ALF,ALF AND B377 STA B,I SAVE # SECTORS TRACK. INB CLA INITIALIZE RECORD COUNT. STA B,I INB STA B,I INITIALIZE CLASS PARAMETER INB WORDS. STA B,I JSB $LIBX DEF SSEQT RETURN * NOSPC JSB $LIBX TURN ON INTERRUPTS DEF *+1 DEF *+1 LDA M41 NO FREE SPACE IN SST JMP CLNUP * ERM39 LDA TEMP1 SESSION SPOOL LU ADA M1 MINUS 1 JSB FSELU FREE LU FROM SST LDA M39 SPOOL LU NOT MAPPED TO DVS43 JMP CLNUP CLOSE SPOOL FILE * ERM16 LDA M16 TYPE 0 FILE ILLEGAL RSS ERM47 LDA M47 NO AVAILABLE SESSION LU FOR SPOOL FILE CLNUP STA TEMP1 JSB CLSFL CLOSE THE SPOOL POOL FILE JMP MENU * MSIGN OCT 100000 M41 DEC -41 M47 DEC -47 M39 DEC -39 IS43A BSS 1 DVS43 ENTRY POINT SAVE. DM128 DEC -128 M64 DEC -64 D6 DEC 6 D63 DEC 63 D8 DEC 8 D254 DEC 254 D.1 NOP D.2 NOP D.3 NOP D.4 NOP D.5 NOP S.1 NOP S.2 NOP S.3 NOP S.4 NOP S.5 NOP PTR22 DEF BUF22 PTR24 DEF BUF24 RECRD NOP DMASK OCT 630 "H" OCT 110 B200 OCT 200 LUTBL DEF *+1 BSS 4 LUTBE ¤|������þúDEF *-1 * HED SMP QUEUE FILE FOR OUTSPOOL * THE FOLLOWING QUEUES A FILE FOR OUTSPOOLING. * QUEUE NOP JSB WRT23 WRITE OUT THE CONTROL RECORD LDA BUF23+15 IS THIS FILE TO SZA,RSS OUTSPOOLED? JMP SET10 NO. * AND B377 STA TEMP6 SAVE OUTSPOOL LU #. LDA BUF23+9 SAVE SPOOL PRIORITY. STA TEMP5 JSB SMENU GET SET TO PASS THIS JMP QUE1 SPOOL FOR OUTSPOOLING. * INB SAVE THE ADDRESS OF THE COUNT WORD STB SMENU FOR LATER LDB BUF23+8 CHECK IF THERE IS RBR,SLB A HOLD ON THIS FILE. JMP SET10 YES. * LDB BUF23+10 MUST ALSO BE IN "W" STATUS CPB "W" WELL RSS YES CONTINUE JMP SET10 NO DO NOT QUEUE * JSB RDLUQ GET THE LU QUEUE TO CORE JSB .DRCT SETTING UP HERE TO SEARCH DEF BUF21+3 THE QUEUE AND FIND OUT STA TEMP4 WHERE THE NEW ENTRY ADA M1 SET A FOR SCAN SET2 LDB A,I CAN BE PUT. INA STEP TO PRIORITY SZB,RSS END OF QUEUE? JMP SET1 YES. * LDB A,I GET PRIORITY CMB,INB WE HAVE A PRIORITY. ADB TEMP5 COMPARE WITH PRIORITY SSB OF NEW ENTRY. JMP SET1 NEW ENTRY IS LESS. * INA KEEP LOOKING FOR A JMP SET2 SPOT TO PUT NEW ENTRY. * SET1 ADA M1 HAVE A PLACE. STA TEMP3 SAVE A POINTER. LDA BUF21+1 FIND THE END OF ALS THE LIST. THE LIST FROM ADA TEMP4 POINT OF NEW ENTRY INA WILL BE SHIFTED TO MAKE SET4 STA TEMP6 ROOM FOR NEW ENTRY. ADA M2 SET UP SHIFT POINTERS. STA TEMP4 DLD TEMP4,I DO A SHIFT ON A DST TEMP6,I TWO-WORD ENTRY. LDA TEMP4 DECREMENT POINTERS. CPA TEMP3 JUST MOVED LAST ONE? RSS YES SKIP JMP SET4 ¾������þúNO - BACK THROUGH LOOP. * LDA RECNO PUT THE NEW ENTRY LDB TEMP5 IN THE VACATED SPACE. DST TEMP4,I ISZ BUF21+1 INCREMENT THE ENTRY COUNT. JSB WRLUQ WRITE OUT THE LU QUEUE LDA SMENU,I UPDATE THE MENU. ELA SAVE THE SIGN BIT LDA BUF21+1 GET THE NEW COUNT RAL,ERA SET SIGN IF NEEDED STA SMENU,I RESET THE COUNT SET10 LDA PARM1 SETUP PROCESSING? SZA IF NOT, BYPASS BIT SETTING. JMP QUEUE,I * LDA PTR22 READ AVAILABILITY BITS. LDB D2 JSB RDREC NOP *********************************************** LDB BPAT RESET AVAILABILITY BITS. STB ADDR1,I LDA PTR22 WRITE OUT AVAILABILITY RECORD. LDB D2 JSB WTREC LDB TEMP2 LDA B,I FIX UP $LUAV. CCE MAKE THE LU UNAVAILABLE. ELA,RAR JSB PUT INB LDA RECNO JSB PUT JMP QUEUE,I RETURN HED SMP MENU SET UP AND PASS TO SPOUT MENU LDA SHUTD IS THERE A SHUT DOWN SZA IN EFFECT? JMP RETRN * LDA SSTAT IS SPOUT ALREADY WORKING CPA D1 ON A MENU? JMP SRSEX YES - RETURN. * JSB HIGHL IS THERE AN AVAILABLE LU JMP SRSEX NO LU FOUND --- FOR SPOUT? * STA RESLU MENU1 LDA PTR25 MAKE UP A NEW MENU TO SEND STA TEMP3 TO SPOUT. PUT ONLY LU'S CLB SET TO CLEAR THE BUFFER STB A,I SET SEED LDB A INB JSB .MVW MAKE IT GROW DEF D15 NOP LDA MPTR IN THE MENU THAT ARE NOT STA TEMP4 IN USE AND ALSO HAVE A QUEUE MENU2 LDB TEMP4,I OF FILES TO BE OUTSPOOLED. STB TEMP3,I SZB,RSS END OF .MENU? JMP MENU3 YES. * ISZ TEMP4 NO - GO AHEAD AND CHECK IF LDB TEMP4,I IF THE LU IS IN USE BY ISZ TEMP4 SPOUT. ;…������þú SSB JMP MENU2 SPOUT IS ALREADY USING THE LU. * SZB IS ANYTHING ON THIS QUEUE. ISZ TEMP3 YES - SAVE THE ENTRY JUST MADE. JMP MENU2 * MENU3 LDA BUF25 SZA,RSS IS THERE ANYTHING TO SEND SPOUT? JMP SRSEX NO. * CLB,INB SET STATUS TO SHOW STB SSTAT SPOUT WORKING ON MENU LDA D2 SEND CLASS REQUEST STA TEMP5 TO SPOUT WITH A MENU. CLA,CCE STA TEMP6 LDA RESLU RESERVE THE LU ELA,RAR FOR SPOUT LDB TEMP2 JSB PUT MENU4 JSB CLSPT JMP MENU GIVE SPOUT ALL IT CAN TAKE. * CLSPT NOP JSB EXEC DEF *+8 DEF D20 WRITE-READ REQUEST DEF ZERO LU #. PTR25 DEF BUF25 MENU BUFFER. DEF D12 DEF TEMP5 CLASS PARAMETER 1. DEF TEMP6 CLASS PARAMETER 2. DEF SP.CL CLASS ID. JMP CLSPT,I * * D1 DEC 1 D11 DEC 11 M21 DEC -21 SST BSS 71 TEMP BSS 1 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP4 BSS 1 TEMP5 BSS 1 TEMP6 BSS 1 MPTR DEF .MENU SHUTD NOP RESLU NOP SSTAT NOP HED SMP ERROR AND EXIT ROUTINES NTRDY CLA ERMES STA TEMP1 JMP MENU * QUE1 CCA OUTSPOOL LU NOT LEGAL. STA BUF23 JSB PTR23 CLEAR THE RECORD ERM21 LDA M21 JMP ERMES * ERM22 LDA M22 JMP ERMES * RETRN LDA MPTR THEN DO A COMPLETE RETN3 LDB A,I TERMINATION SO AS TO SZB,RSS ALLOW ACCESS TO THE JMP RETN2 SPLCON FILE FOR A * INA USER PACK, ETC. LDB A,I IF SPOUT IS NOT ACTIVE SSB AND THERE IS A SHUTDOWN JMP SRSEX IN EFFECT. * INA JMP RETN3 * RETN2 CLA,RSS OK TO SHUT DOWN SRSEX CLA,INA SAVE RESOURCES SHUT DOWN STA EXIT,I SAVE FOR EXIT * JSB POST MAKE SURE SPLCON BUFFERS DEF *+2 ARE POSTED. DEF DCB1 ¢l������þú JSB UNLOK CLEAR SPLCON RN #. DEF SRN JSB DTACH IF UNDER SESSION - DETACH DEF *+2 NOP ****** DUMMY PARAMETER ********* JSB EXEC SCHEDULE SPOUT WITH QUEUE DEF *+3 DEF D10 DEF SPOUT RETN5 JSB PRTN PASS BACK PARAMETERS DEF *+2 TO THE CALLER. DEF TEMP1 CCB SET B AS INDICATOR RETN4 JSB EXEC COMPLETION RETURN. DEF *+4 DEF D6 DEF ZERO INDICATE CALLER. EXIT DEF WRLUQ SAVE RESOURCES TERMINATION. SSB IF TIME ENTRY JMP TRYAG GO TRY THE MENU AGAIN * JSB RMPAR THIS ENABLES US TO SAVE DEF *+2 INDICATORS AND KEEP SPLCON DEF PARM1 OPEN ALL THE TIME. JMP SMP1 * LULOK CLB SPOUT HAS LU LOCK CONDITION. STB SSTAT JSB SPS RELEASE THE RESERVED LU SWP JSB PUT JSB EXEC SCHEDULE SMP WITH OFFSET DEF *+6 AND CHECK THE HOW WE GOT TO THIS DEF D12 POINT OF SUSPENSION WHEN WE DEF SMPNA ARRIVE. IF ORDINARY SCHEDULE DEF D2 DEF ZERO DEF M8 REQUEST, PROCESS NORMALLY. JMP SRSEX GO EXIT HED SMP SUBS (RDLUQ,WRLUQ,UNLOK,LOCK,BITFX,FEQT) RDLUQ NOP ROUTINE TO READ THE LU QUEUE LDA PTR21 SET UP TO READ 8 RECORDS. LDB M8 THIS IS ONE LU QUEUE. STB TEMP3 LDB LUREC READ THE APPROPRIATE SET6 JSB RDREC BLOCK. JMP ERMES READ ERROR. * LDB RECRD CLB SET FOR AUTO REC. INCREMENT LDA BUFSP FOR NEXT RECORD. ADA D16 ISZ TEMP3 FINISHED READING BLOCK? JMP SET6 * JMP RDLUQ,I YES RETURN * LUREC NOP M8 DEC -8 * WRLUQ NOP WRITE OUT THE LU Q LDA PTR21 SET UP TO WRITE LDB M8 OUT THE LU QUEUE. STB TEMP3 8 - 16 WORD RECORDS. LDB LUREC SET7 JSB WTõõ������þúREC WRITE A 16 WORD RECORD. LDA BFSP1 UPDATE BUFFER POINTER ADA D16 TO NEXT RECORD. CLB ISZ TEMP3 JMP SET7 * JMP WRLUQ,I DONE SO EXIT * * TRYAG JSB LOCK DEF SRN JMP MENU GO TRY THE MENU * UNLOK NOP LDA UNLOK,I STA RESNO ISZ UNLOK JSB RNRQ DEF *+4 DEF D4 RESNO BSS 1 DEF IERR JMP UNLOK,I * LOCK NOP LDA LOCK,I STA RESNU ISZ LOCK JSB RNRQ DEF *+4 DEF D1 RESNU BSS 1 DEF IERR JMP LOCK,I * * BITFX NOP STB A AND D15 CMA STA FEQT CLA,INA ISZ FEQT JMP *+4 * BRS,BRS BRS,BRS JMP BITFX,I * RAL JMP *-6 * * * SUBROUTINE TO FIND EQT ADDRESS CORRESPONDING * TO A GIVEN LU #. * FEQT NOP CCA,CCE FIND ADDRESS OF EQT CORRESPONDING ADA DRT TO THE AVAILABLE LU #. ADA BUF23+1 LDA A,I AND B77 GET EQT NUMBER AND INDEX ADA M1 TO THE PROPER ENTRY. MPY D15 ADA EQTA STA B ADA D12 SET EXTENSION LDA A,I ADDRESS IN A JMP FEQT,I HED SMP SUBS (CLSFL,FINDU,HIGHL,TROLU,STOLU,SPS) * CLSFL - ROUTINE TO CLOSE THE SPOOL FILE DUE TO ERROR IN SETUP PROCESS * CALLING SEQUENCE: JSB CLSFL * CLSFL NOP CLA CLB DST WTREB SIMPLE CLOSE JSB EXEC SCHEDULE D.RTR TO CLOSE SPOOL FILE DEF *+10 DEF D23 DEF D.RTR DEF XEQT DEF ZERO DEF D.2 DEF D.3 DEF ZERO DEF WTREB DEF D2 * JMP CLSFL,I RETURN * * * FINDU - ROUTINE FINDS AN AVAILABLE LU IN $LUAV TABLE * SUCH THAT LU < 64, LU IN NOT DEFINED ON THE SESSION * SIDE IN SST * * FINDL - FINDS AN AVAILABLE LU IN $LUAV TABLE STARTING FROM TOP * END OF THE TABLE * FINDU R������þúNOP LDA FINDU STA FINDL SET UP RETURN ADDRESS CCA SET FLAG TO INDICATE COMING FROM FINDU JMP FIND0 * FINDL NOP FIND AVAILABLE LU. CLA FIND0 STA TEMPA LDA LUAVA STA TEMP2 LDA TEMP2,I STA FEQT FIND1 ISZ TEMP2 LDA TEMP2,I SSA,RSS JMP FIND2 * ISZ TEMP2 ISZ FEQT JMP FIND1 * JMP FINDL,I RETURN TO P * FIND2 LDB TEMPA COMING FROM FINDU? SSB,RSS JMP FIND3 NO, RETURN TO P+1 STA TEMP3 YES ADA M64 >63? SSA,RSS JMP FIND1 YES, THEN TRY NEXT ONE * JSB LUTRU DEF *+3 DEF TEMP3 IS THIS LU DEFINED DEF TEMP1 ON SESSION SIDE IN SST? LDA TEMP1 SSA,RSS JMP FIND1 LU IS DEFINED, LOOK FOR ANOTHER LU LDA TEMP3 LU# FIND3 ISZ FINDL LU NOT DEFINED JMP FINDL,I * * HIGHL - ROUTINE FINDS AN AVAILABLE LU IN $LUAV STARTING * FROM THE BOTTOM END OF THE TABLE * HIGHL NOP LDB LUAVA,I -VE LENGTH OF $LUAV STB FEQT SAVE CMB BLS GET (#WORDS-2) IN TABLE INB ADB LUAVA ADDRESS OF LAST LU # IN $LUAV HIGH1 LDA B,I GET CONTENTS OF ENTRY IN $LUAV SSA,RSS BUSY BIT SET? JMP HIGH2 NO, THEN FOUND IT ADB M2 POINT TO LOWER ADDRESS IN $LUAV ISZ FEQT JMP HIGH1 * JMP HIGHL,I NO LU IS AVAILABLE HIGH2 STB TEMP2 ISZ HIGHL JMP HIGHL,I RETURN * * * TROLU - ROUTINE TO FIND TRUE SYSTEM LU CORRESPONDING * TO SESSION OUTSPOOL LU * CALLING SEQUENCE: A REG = SESSION OUTSPOOL LU * JSB TROLU * RETURNS: JMPS TO ERM40 IF NO LU FOUND * TEMP5 IS SESSION LU * TEMP6 IS SYSTEM LU * * TROLU NOP ADA M1 DECREASE BY 1 TO MATCH LU IN SST STA TEMP5 SAVE SESSION L Ù������þúU# JSB $SMVE GET SST DEF *+6 DEF D1 DEF SESID DEF ZERO NO OFFSET DEF SST DEF D71 71 WORDS MAX IN SST LDA SST GET -VE LENGTH WORD STA TEMP LDA ASST INA POINT TO FIRST ENTRY IN SST STA TEMPA SPLLP LDA TEMPA,I GET CONTENTS OF ENTRY IN SST AND B377 IS IT THE SAME AS SESSION CPA TEMP5 OUTSPOOL LU? JMP FNDLU YES,CHECK IF CORRESP SYS LU IS A SPOOL LU ENLP ISZ TEMPA ISZ TEMP INCREMENT -VE LENGTH JMP SPLLP JMP ERM40 ERROR * FNDLU LDA TEMPA,I GET SST ENTRY ALF,ALF GET UPPER BYTE INA AND B377 SYSTEM LU CPA B377 IS IT 255? RSS JMP CKSPL NO, CHECK IF SPOOL LU LDA TEMP5 GET SESSION OUTSPOOL LU - 1 JSB FSELU FREE LU FROM SST JMP ENLP LOOK FOR ANOTHER ENTRY OF OUTSPOOL LU * CKSPL LDB PARM2 SAVE PARM2 STB TEMPB STA PARM2 SYSTEM LU IS SPOOL LU? JSB FLU RSS LU NOT SPOOL LU, THEN TRUE LU FOR OUTSPOOL JMP ENLP SPOOL LU, LOOK FOR NEXT ONE ISZ TEMP5 LDA PARM2 STA TEMP6 SYSTEM LU LDA TEMPB STA PARM2 JMP TROLU,I RETURN * * * STOLU - SET TRUE OUTSPOOL LU IN BITS 0-7 OF BUF23+15 * STOLU NOP LDA BUF23+15 SZA,RSS OUTSPOOL LU SPECIFIED? JMP STOLU,I NO, RETURN AND B3700 ISOLATE FUNCTION CODE ALS,ALS MOVE TO BITS 8-12 IOR TEMP6 MERGE WITH OUTSPOOL LU STA BUF23+15 SAVE JMP STOLU,I RETURN * * * SPS NOP LDA LUAVA GET ADDRESS OF $LUAV. SPS0 INA STEP TO FIRST ENTRY LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER SSB IF BUSY, LDB A,I GET THE RECORD NUMBER SZB IF ZERO THEN THIS IS IT JMP SPS0 ELSE TRY NEXT ONJ2������þúE * STA TEMP2 SAVE THE RECORD NO. ADDRESS ADA M1 AND THE LU ADDRESS LDB A,I GET THE LU RBL,CLE,ERB CLEAR THE BUSY BIT STB RESLU AND SAVE THE LU JMP SPS,I HED SMP SPOUT SELECT A FILE ROUTINE SPSEL CLA CLEAR WORK (SPOUT HAS SELECTED) STA SSTAT IN PROGRESS FLAG LDA PARM2 GET THE LU AND SET IN CASE WE NEED TO STA BUF23+15 CALL OFF SPOUT JSB SPS SEARCH $LUAV FOR A RESERVED LU. JSB SMENU GET THE MENU ENTRY JMP KILL3 CAN'T FIND?? SHOULD NEVER HAPPEN * INB STB TEMP6 SAVE THE POINTER LDB A RECORD NUMBER TO B LDA PTR24 READ THE TOP OF THE JSB RDREC LU QUEUE AND PICK NOP ******************************************* CLA SET THE Q ENTRY PRIORITY TO STA BUF24+3 TO ZERO TO INDICATE LDA PTR24 IT AS ACTIVE (PREVENTS LDB LUREC INSERTS AHEAD OF IT) JSB WTREC WRITE IT BACK OUT LDB BUF24+2 UP THE FIRST ENTRY. STB RECNO SAVE SPLCON RECORD # OF FILE. LDA PTR23 READ SPLCON RECORD. JSB RDREC NOP ********************************************** LDA RECNO SET THE RECORD NUMBER LDB TEMP2 IN THE LUAV TABLE JSB PUT LDA RESLU AND THE LU STA BUF23+1 IN THE RECORD LDA MSIGN OVERRIDE OPTION TO SEARCH ALL CARTRIDGES JSB OPNSP TRY TO OPEN THE FILE. SSA,RSS JMP SPS1 NO. JSB FILER YES - SEND ERROR MESSAGE JMP KILL3 KILL SPOOL * SPS1 LDB "A" SET FILE TO ACTIVE - STB BUF23+10 IT WILL BE OUTSPOOLED. JSB WRT23 UPDATE THE FILE JSB SSEQT SET UP EQT ENTRY. CLA,CCE,INA COME HERE AFTER SETTING STA TEMP5 UP SPOOL EQT. LDA TEMP6,I GET POSITION OF LU IN ELA,RAR MENU AND MARK IT TO STA TE3ƒ������þúMP6,I SHOW THAT SPOUT IS SPS7 LDB BUF23+8 IS BUSY WITH THAT LU. CCE POTENTIAL OVERLAP PROBLEM? RBR,SLB IF SO, SET SIGN BIT IN CME CLASS PARAMETER TO BE PASSED LDA BUF23+15 TO SPOUT. ELA,RAR STA TEMP6 RBR,CLE,RBR RBR,SLB CCE LDA BUF24 GET # QUEUED LINES. AND C377 ISOLATE IOR RESLU INDICATE LU AND FILE TYPE. ELA,RAR STA BUF25 JMP MENU4 HED SMP SUBS (SMENU) * SMENU NOP LDA BUF23+15 IF NO LU AND B377 SZA,RSS THEN JMP SM2 JUST EXIT * STA FINDL SAVE THE REQUESTED LU LDB MPTR SEARCH MENU FOR DEQ4 LDA B,I OUTSPOOL LU. CPA FINDL THIS IT?? JMP SM1 YES GO EXIT FOUND * SZA,RSS IF END OF TABLE JMP SMENU,I TAKE NOT FOUND EXIT * ADB D2 JMP DEQ4 * SM1 LDA MPTR COMPUTE THE LU QUEUE CMA,INA RECORD NUMBER ADA B FOR THIS LU ALS,ALS ADA D9 STA LUREC AND SAVE IT FOR RDLUQ SM2 ISZ SMENU STEP TO FOUND EXIT JMP SMENU,I AND RETURN * D9 DEC 9 P21.2 DEF BUF21+2 HED SMP DEQUEUE ROUTINES (SUP DQ) DEQUX LDA PARM3 IF NO ERROR CMA,INA,SZA,RSS JUST D Q JMP DEQUE * JSB MSFIX FIX UP THE MESSAGE ASC 3,EOF ER STRING FOR MESSAGE DEC 13 * DEQUE JSB PRGEX RELEASE THE SPLCON RECORD JSB DQ DEQUE THE FILE JMP NTRDY EXIT * DQ NOP DEQUE SUBROUTINE ENTER WITH E=0 IF JSB SMENU FIND THE LU FOR THIS FILE JMP ERM21 DIDN'T FIND - ERROR. * INB SAVE THE ADDRESS FOR UPDATE STB PRGEX JSB RDLUQ GET THE LU QUEUE TO CORE LDA PTR21 DEQ11 ADA D2 FIND THE POSITION IN LDB A,I THE QUEUE. CPB RECNO JMP DEQ10 FOUND IT * Š ������þúCPA LIM END OF QUEUE? JMP DQ,I YES - LEAVE. * JMP DEQ11 KEEP LOOKING * DEQ10 LDB PRGEX,I GET THE # OF ENTRIES FLAG ADB M1 DECREMENT IT CPA P21.2 IF FIRST ENTRY RBL,CLE,ERB CLEAR THE BUSY FLAG STB PRGEX,I SET IT BACK DEQ12 STA TEMP2 HAVE IT. ADA D2 STA TEMP3 CMA,INA ADA PTR21 ADA D127 SSA END OF BLOCK? JMP DEQ13 YES. * DLD TEMP3,I NO - MOVE UP NEXT ENTRY. DST TEMP2,I LDA TEMP3 JMP DEQ12 * DEQ13 CLA CLB DST TEMP2,I CCA ADA BUF21+1 DECREASE # OF ENTRIES. STA BUF21+1 JSB WRLUQ WRITE OUT THE LU QUEUE JMP DQ,I ELEMENT DEQUED SO EXIT * * CLRAV NOP CLEAR THE LUAVA ENTRY USING RECNO LDB LUAVA FIND THE SPOOL LU LDA B,I SET THE COUNT STA PUT INCASE NOT FOUND DEQ16 ADB D2 INDEX TO THE NEXT RECORD ENTRY LDA B,I CPA RECNO THIS THE ONE?? JMP DEQ15 YES GO DO IT * ISZ PUT MORE?? JMP DEQ16 YES TRY NEXT ONE * CCE INDICATE NOT FOUND JMP CLRAV,I RETURN * DEQ15 JSB FRELU FREE THE LU JMP CLRAV,I RETURN HED SMP SUBS (FRELU,FSELU) * FRELU - CALLING SEQUENCE: B REG = ENTRY # IN $LUAV * JSB FRELU * FRELU NOP FREE LU AND ITS EQT IF ONE CLA CLEAR THE RECORD # SLOT JSB PUT IN THE LUAV ADB M1 BACK TO THE LU NUMBER LDA B,I GET THE NUMBER STA TEMPA RAL,CLE,ERA CLEAR THE SIGN STA BUF23+1 SET FOR POSSIBLE FURTURE USE JSB PUT RESET WORD SEZ,CME,RSS IF NOT BUSY OR NOT FOUND JMP FRELU,I EXIT WITH E = 1 * LDA B3700 STA TEMPB JSB XLUEX CALL SMD TO POST ANY REMAINING BUFFERS DEF *+5 DEF S1 =100001B ¯ƒ������þú DEF TEMPA DEF BUF21 DEF D16 NOP IGNORE ERROR RETURN * JSB FEQT GET THE EQT ADDRESS STA B SET TO ADB D11 CLEAR EQT27 TO STOP LDA B,I SAVE IT FOR CLOSE STA D.2 FIRST CLA,CLE ANY ACCESSES JSB PUT DO IT JSB UNLOK CLEAR THE HOLD RN DEF WRN CLE CLEAR E TO INDICATE FOUND JMP FRELU,I RETURN * S1 OCT 100001 TEMPA NOP TEMPB NOP TEMPC NOP TEMPD NOP TEMPE NOP * * * FSELU - ROUTINE TO FREE SPOOL LU FROM THE SST * CALLING SEQUENCE: A REG = SESSION SPOOL LU - 1 * = -(SYSTEM SPOOL LU -1) * * FSELU NOP STA FSTMP SAVE FOR NOW SSA IS IT A SYSTEM SPOOL LU? CMA,INA YES, MAKE IT POSITIVE STA FSTM1 CLA,INA STA TEMP4 OFFSET TO POINT TO LU IN SST JSB $LIBR TURN OFF INTERRUPTS TO MODIFY SST NOP JSB $SMVE MOVE SST INTO SMP'S BUFFER DEF *+6 DEF D1 READ DEF SESID SESSION WORD DEF ZERO ASST DEF SST BUFFER TO READ IN SST DEF D71 MAX SIZE OF SST * LDB FSTMP SESSION LU OR -(SYSTEM LU) LDA M70 USE AS COUNTER STA FSTMP LDA ASST ADDRESS OF SESSION SWITCH TABLE STA SST SAVE SST ADDRESS LULP ISZ SST POINT TO NEXT SST ENTRY LDA SST,I GET SST ENTRY SSB SYSTEM SPOOL LU? ALF,ALF YES, MOVE SYSTEM LU IN SST TO LOW BYTE AND B377 MASK SPOOL LU CPA FSTM1 MATCHES SPOOL LU? JMP LUFND YES * LDA SST,I GET SST ENTRY AND B377 GET SESSION LU CPA ZERO LU 1? JMP LUEX YES, LU NOT IN SST * ISZ TEMP4 INCREMENT OFFSET ISZ FSTMP INCREMENT COUNTER JMP LULP NOT DONE YET, GET NEXT SST ENTRY JMP LUEX LU NOT DEFINED IN SST - Šh������þúERROR * LUFND JSB $SMVE WRITE BACK MODIFIED SST DEF *+6 DEF D2 WRITE DEF SESID SESSION ID DEF TEMP4 OFFSET INTO SST DEF M1 BUFFER ADDRESS DEF D1 MODIFY ONE WORD IN SST * LUEX JSB $LIBX TURN ON INTERRUPTS DEF FSELU RETURN * FSTMP NOP FSTM1 NOP HED SMP RELEASE A HOLD ROUTINE * RELSE LDA PTR23 LDB PARM2 STB RECNO JSB RDREC NOP ********************************************** LDA BUF23+1 NEED TO SAVE IN CASE STA PARM2 OF RESTART. LDB PARM4 LOOK AT REL/RES FLAG. LDA PARM5 CPA "AH" ACTIVE FILE? JMP RELS1 YES. * SSB RELEASE? JMP REQUE YES - REQUEUE. * SZB POSSIBLE LU CHANGE. STB BUF23+15 SAVE NEW LU. REQUE JSB QUEUE JMP MENU * RELS1 SSB,RSS A RELEASE? JMP RELS2 NO MUST RESTART. * JSB FEQT ADB D10 CLE SET TO CLEAR THE BIT LDA HMASK SET THE BIT TO BE CLEARED JSB PUTM GO CLEAR IT LDA BUF23+1 STA RESLU JSB SMENU JMP KILL3 INB STB TEMP6 SAVE SPLCON REC# FOR LU LDB A LDA PTR24 JSB RDREC NOP LDA PARM3 STA PARM2 CLA,INA STA TEMP5 JMP SPS7 * RELS2 JSB SPTUN JSB FLU FIND THE LU RSS IF NONE SKIP JSB FRELU FREE IT DEQ18 JSB DQ DEQUE THE FILE LDA PTR23 RELEASING AN ACTIVE LDB RECNO FILE AND RESTARTING IT - JSB RDREC MUST QUEUE IT UP. NOP ********************************************** LDA PARM4 NEW LU? SZA WELL?? STA BUF23+15 YES - SAVE IT. LDA PTR21 READ IN 1ST RECORD CLB,INB FOR QUEUE. JSB RDREC NOP ******************************************wR������þú**** JMP REQUE * LIM DEF LIMIT D127 DEC 127 D15 DEC 15 HED SMP KILL SPOOL ROUTINE KILL LDB PARM2 STB RECNO SAVE SPLCON RECORD #. LDA PTR23 READ THE SPLCON RECORD JSB RDREC FOR THIS FILE. NOP *********************************************** LDA PARM5 IS THIS AN ACTIVE CPA "A" FILE (BEING OUTSPOOLED)? RSS YES TREAT AS IF ACTIVE HOLD * CPA "AH" ACTIVE HOLD? KILL3 JSB SPTUN YES. JSB DTACH DETACH FROM SESSION SO THAT A SPOOL DEF *+2 FILE OUTSIDE YOUR SESSION CAN BE CLOSED NOP *****DUMMY PARAMETER******** JMP DEQUE GO DO IT. * B100 OCT 100 "AH" ASC 1,AH HED SMP SUBS (PUTM,SPUTN) SHUT DOWN/ START UP HED SMP SUBS (PUT,OPNSP,PRGEX) PUTM NOP ROUTINE TO SET OR CLEAR BIT SET IN A JSB $LIBR AND ADDRESSED BY 'B' 'E'=1 TO SET NOP 'E'=0 TO CLEAR THE BIT STA FEQT SAVE THE BIT(S) IOR B,I SET THE BIT IN ANY CASE SEZ,RSS IF CLEAR REQUEST XOR FEQT CLEAR THE BIT STA B,I RESET AND JSB $LIBX DEF PUTM EXIT * * SPTUN NOP JSB FEQT SET HOLD BIT TO STOP SPOUT ADB D10 LDA HMASK HOLD BIT TO EQT11 JSB PUTM GO SET IT CLA MAKE SURE AND CALL STA BUF25 SPOUT SO THAT IT LDA D3 WILL UNLOCK THE LU STA TEMP5 BEING USED TO LDA BUF23+15 DUMP THIS FILE AND B377 STA TEMP6 JSB CLSPT JMP SPTUN,I * "D" OCT 104 * SHUT LDA "D" STA SHUTD JMP RETRN * STUP EQU * IFN JSB DBUGR DEF *+1 XIF CLA STA SHUTD JSB UNLOK RELEASE JOB HOLD JUST IN CASE DEF WRN JMP MENU HED SMP DEVICE DOWN & HOLD ROUTINES DVCDN JSB MSFIX Íé������þú DEVICE WENT DOWN WHILE ASC 3,DOWN OUT SPOOLING D16 DEC 16 LENGTH OF MESSAGE (WORDS) JMP HOLD1 GO HOLD THE FILE * HOLD LDB PARM2 PICK UP AND SAVE RECORD STB RECNO NUMBER OF FILE IN SPLCON. LDA PTR23 READ IN APPROPRIATE FILE JSB RDREC RECORD IN SPLCON. NOP *********************************************** LDA PARM5 HOLDING AN ACTIVE FILE? CPA "A" JMP HOLD1 * JSB DQ NO - DEQUEUE THE FILE. JMP NTRDY AND EXIT * HOLD1 JSB FEQT SET A BIT IN SPOOL EQT ADB D10 FOR SMD. LDA HMASK JSB PUTM GO SET THE HOLD BIT LDA "AH" SET HOLD FLAG STA BUF23+10 JSB WRT23 WRITE THE RECORD JMP NTRDY * WRT23 NOP WRITE REC RECNO FROM BUF23 LDA PTR23 SET BUFFER ADDRESS LDB RECNO AND RECORD NUMBER JSB WTREC WRITE THE RECORD JMP WRT23,I AND RETURN * D10 DEC 10 HMASK OCT 10000 OPTN NOP HED SMP OUTSPOOL RECORD TOO LONG ROUTINE LONG LDA BUF23+15 GET OUSPOOL LU AND B377 CCE JSB $CVT3 CONVERT TO ASCII DECIMAL INA GET THE LAST 3 DIGITS DLD A,I DST LUNO SET UP THE MESSAGE JSB .DFER MOVE FILE NAME INTO MESSAGE DEF FILNM DEF BUF23+2 SOURCE BUFFER WITH FILE NAME JSB PRINT PRINT MESSAGE DEF RECMS ADDRESS OF BUFFER DEF D26 JMP MENU RETURN * RECMS ASC 3,SMP:LU LUNO ASC 3, 3 DIGIT LU PLUS 2 BLANKS FILNM ASC 3, OUTSPOOL FILE NAME ASC 17, RECORD(S) TRUNCATED TO 128 WORDS D26 DEC 26 HED SMP SUBS (PUT,OPNSP,PRGEX) PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * * OPNSP NOP STA OPTN SET OPEN OPTION LDA BUF23+2 SET SIGN BIT ON 1ST CCE WORD OF FILE NAME. ELA,RAR wï������þú STA BUF23+2 SAVE IT. JSB EXEC TRY TO OPEN THE FILE. DEF *+10 DEF D23 SCHEDULE WITH WAIT. DEF D.RTR D.RTR. DEF ID ID SEGMENT ADDRESS. DEF OPTN OPEN OPTION DEF BUF23+6 CARTRIDGE ID. DEF BUF23+5 SECURITY CODE DEF ZERO DEF BUF23+2 DEF D3 NAME STRING LENGTH JSB RMPAR DEF *+2 GET PARAMETERS BACK DD.1 DEF D.1 FROM D.RTR. JSB EXEC GET STRING PASSED BY D.RTR DEF *+5 DEF D14 DEF D1 DEF S.1 DEF D5 GET ALL 5 WORDS PASSED LDA BUF23+2 CLEAR SIGN BIT ELA,CLE,ERA STA BUF23+2 LDA D.1 SUCCESSFUL OPEN? JMP OPNSP,I * D5 DEC 5 * SPREC NOP * PRGEX NOP LDA PTR22 LDB D2 READ SPLCON AVAILABILITY BITS. JSB RDREC NOP ************************************************ LDB SPREC GET SPLCON RECORD # CMB,INB RELATIVE TO THE BEGINNING ADB RECNO OF THE FILE DESCRIPTOR JSB BITFX RECORDS. ADB PTR22 STA BITFX IOR B,I CLEAR THE BIT. XOR BITFX STA B,I LDA PTR22 LDB D2 JSB WTREC WRITE AVAILABILITY RECORD. CCA STA BUF23 JSB WRT23 WRITE FILE DESCRIPTOR RECORD. JSB CLRAV CLEAR ANY LU ASSOCIATED WITH THIS FILE SEZ WAS THERE A CURRENT ONE? JMP PRNLU NO, MUST OPEN TO CLOSE * JSB FEQT YES LU WAS SET FOR FEQT ADA D10 GET ADDRESS OF FILE PRAMS PRPU LDB A,I GET THE FILE SIZE PRPU1 CMB,INB SET NEGATIVE FOR PURGE ADA D2 STEP TO THE DIR. ADDRESS WORD STA TEMP4 LDA BUF23+8 GET THE OPTION WORD SLA IF SAVE IN EFFECT CLB CHANGE TO SIMPLE CLOSE AND D8 ISOLATE SPOOL POOL FILE BIT SZA IF POOL FILE LDB A CHÎ1������þúANGE TO PURGE EXTENTS STB WTREC SET THE PRAMETER CLA SET HIGH BITS OF DOUBLE WORD SSB CCA STA WTREB JSB EXEC SCHEDULE D.RTR DEF *+10 DEF D23 WITH WAIT TO DEF D.RTR CLOSE A FILE DEF XEQT AND PURGE EXTENTS. DEF ZERO DEF D.2 DEF TEMP4,I DEF ZERO DEF WTREB DEF D2 PRNFL LDA BUF23+8 GET SPOOL POOL FLAG AND D8 CPA D8 IF SPOOL POOL JMP PRG0 GO SET UP * JMP PREX ELSE JUST RETURN * PRNLU LDA MSIGN OVERRIDE OPTION TO SEARCH ALL DISCS JSB OPNSP OPEN THE FILE SO CAN PURGE SSA WAS IT FOUND?? JMP PRNFL NO * LDA DD.1 YES SET THE ADDRESSES LDB S.4 FILE SIZE JMP PRPU1 AND GO PURGE THE FILE * PRG0 JSB POST MUST ACCESS JOB FILE DEF *+2 DDCB DEF DCB1 LDA PTRJF SET UP THE JOB FILE LDB DDCB JSB .MVW DEF D16 BY MOVING IN THE DCB NOP JSB LOCK DEF JRN LDA PTR24 READ IN SPOOL POOL FILE LDB D17 AVAILABILITY BITS. JSB RDREC NOP ********************************************* LDA BUF23+4 CONVERT POOL FILE # AND D15 STA TEMP4 LDA BUF23+4 ALF,ALF AND D15 MPY D10 ADA TEMP4 CCB SET NUMBER LESS 1 ADB A IN B JSB BITFX FIND AVAILABILITY BIT. STB TEMP4 SET OFFSET ADDRESS ADB PTR24 ADB D4 CMA MAKE AN ANDING MASK STA TEMP5 AND SAVE IT IN CASE A JOB AND B,I CLEAR THE BIT AND STORE. STA B,I LDA PTR24 WRITE OUT JOBFIL RECORD 17. LDB D17 JSB WTREC SPOOL FILE IS RETURNED TO POOL LDA PTR25 LDB BUF23+11 IF SPOOL NOT CONNECTED SSB,RSS WITH A JOB, FORGET THIS STUFF. JMP DEQ7 ELB,CLE,{¾������þúERB REMOVE SIGN BIT * JSB RDREC ELSE READ IN THE JOB RECORD NOP *************************************** LDB P2511 GET ADDRESS OF POOL BITS STB TEMP6 SAVE FOR RELEASE CHECK ADB TEMP4 INDEX INTO AND LDA TEMP5 CLEAR AND B,I THE FREEDED BIT STA B,I FIX OWNED SPOOL BITS OF THE JOB. LDA BUF25+2 GET THE JOB STATUS CPA "CS" IF NOT CS RSS THEN JMP DEQ6 DO NOT CLEAR THE ENTRY * LDB M5 CHECK IF ALL OWNED FILES ARE CLOSED? DEQ8 LDA TEMP6,I SZA ANY HERE? JMP DEQ6 YES DO NOT FREE THE RECORD * ISZ TEMP6 STEP THE COUNT INB,SZB ALL TESTED? JMP DEQ8 NO TRY NEXT ONE * CCA ALL OWNED SPOOLS ARE CLEAR. STA BUF25 DEALLOCATE THE RECORD. DEQ6 LDA PTR25 LDB BUF23+11 WRITE OUT THE RECORD. ELB,CLE,ERB REMOVE SIGN BIT JSB WTREC DEQ7 JSB POST DEF *+2 PDCB DEF DCB1 JSB UNLOK DEF JRN JSB UNLOK DEF WRN LDA PTRSF RESET UP THE SPOLCON FILE LDB PDCB JSB .MVW DEF D16 NOP PREX JSB CLRAV CLEAR ANY ADDITIONAL SEZ,RSS LU'S ASSIGNED TO THIS JMP PREX FILE * JMP PRGEX,I EXIT TO CALLER * JRN NOP SRN NOP WRN NOP D17 DEC 17 M5 DEC -5 P2511 DEF BUF25+11 "CS" ASC 1,CS HED SMP SUBS (WTREC,RDRED,FILER,CVTNO,PRINT,MSFIX) WTREB NOP THESE TWO WORDS WTREC NOP MUST BE SEQUENTIAL STA BFSP1 STB RECRD JSB WRITF DEF *+6 DEF DCB1 DEF IERR BFSP1 BSS 1 DEF D16 DEF RECRD JSB FILER REPORT FILE ERROR IF ANY JMP WTREC,I * RDREC NOP STA BUFSP STB RECRD JSB READF DEF *+7 DEF DCB1 DEF IERR BUFSP BSS 1 DEF D16 DEF FILER DUMMY eÈ������þúPLACE HOLDER DEF RECRD SSA,RSS IF NO ERROR ISZ RDREC TAKE OK EXIT ELSE P+1 JSB FILER REPORT FILE ERROR IF ANY JMP RDREC,I * FILER NOP TEST FOR ERROR AND PRINT IF ONE CMA,SSA,INA SET NEGATIVE ERROR + JMP FILER,I IF NONE JUST EXIT * JSB CVTNO CONVERT THE NUMBER STA MESS SET IN THE MESSAGE JSB PRINT PRINT IT DEF SMPER DEF D6 JMP FILER,I RETURN TO CALLER * CVTNO NOP TWO DIGIT NUMBER CONVERTER CLB SET FOR DIVIDE DIV D10 A HAS HIGH DIGIT, B LOW ALF,ALF ROTATE TO HIGH ADA B PUT TOGETHER ADA "00" ADD THE ASCII OFFSETS JMP CVTNO,I RETURN NUMBER IN A * "00" ASC 1,00 * PRINT NOP PRINT TO LU 1 DLD PRINT,I GET THE BUFFER AND COUNT ADDRESSES DST BUFAD SET IN CALL ISZ PRINT ADVANCE THE RETURN ADDRESS ISZ PRINT ADVANCE THE RETURN ADDRESS JSB REIO SENT THE WORD TO THE SYSTEM TTY DEF RTN DEF D2 DEF D1 BUFAD NOP SET TO THE BUFFER ADDRESSES NOP ALSO SET RTN JMP PRINT,I EXIT BACK TO CALLER * MSFIX NOP FIX UP THE MESSAGE LDA BUF23+15 FIRST GET THE AND B377 CCE LU AND CONVERT TO ASCII DECIMAL JSB $CVT3 INA POINT TO LAST 3 DIGITS DLD A,I DST LUXX SET IN THE MESSAGE JSB .DFER NOW MOVE IN THE STRING DEF DNEOF DEF MSFIX,I RETURNS A POINTS TO NEXT SOURCE SO STA MSFIX SAVE AS LENGTH ADDRESS JSB .DFER MOVE IN THE DEF FILEN FILE DEF BUF23+2 NAME JSB PRINT NOW PRINT THE MESSAGE DEF SVERF DEF MSFIX,I POINT TO LENGTH ISZ MSFIX STEP TO RETURN ADDRESS JMP MSFIX,I AND RETURN * PTRSF DEF SPLFL PTRJF DEF JOBFL SMPER ASC 5,SMP: FMP -XX ERORR MESSAGE MESS NOP ¼H���ð��îê HOLDS XX FROM MESSAGE SVERF ASC 3,SMP:LU LU DOWN AND BAD EOF TEMPLATE LUXX ASC 3, LU PLUS 2 BLANKS DNEOF ASC 4,EOR ER OR DOWN PLUS 2 BLANKS FILEN ASC 6,XXXXXX HELD. SMPNA ASC 3,SMP .MENU DEC 1 SUP REP 19 DEC 1 DEC 0 D21 DEC 21 D23 DEC 23 SPOUT ASC 3,SPOUT D.RTR ASC 3,D.RTR IERR NOP EQTA EQU 1650B ZERO DEC 0 ID NOP * END SMP ����������������������������������������������������������Oøð������ÿÿ����� ���� ÿý�+�,X ���������ÿ��92067-18352 2013� S C0122 �&DVS43 �SPOOL DRIVER � � � � � � � � � � � � �H0101 rj�����þúASMB,R,Q,C ASSEMBLE STATEMENT FOR RTE IV * HED SPOOL MONITOR DRIVER FOR RTE IV * NAME: DVS43 * SOURCE: 92067-18352 (RTE IVB) * RELOC: 92067-16350 (RTE IVB) * PGMR: A.M.G.,G.A.A.,C.M.M.,J.M.N.,G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVS43 92067-16350 REV.2013 800114 * ENT IS43,CS43,N.SEQ SUP * * * *** SPOOL EQT ENTRIES *** * * EQT1 SAME AS STANDARD * . * . * . * EQT7 SAME AS STANDARD (READ WRITE), BUFFER MASK (POST) * EQT8 TRANSFER AMOUNT IN WORDS * EQT9 USED TO SAVE TLOG WHILE WAKING SPOUT. * EQT10 RECORD LENGTH * EQT11 FLAGS: BIT 15 - 1 IF WRITE CALL TO INCOR * BIT 14 - BATCH CHECK FAILED ONCE * BIT 13 - EOF SENT BACK ONCE (OR BATCH * CHECK FAILED) * BIT 12 - HOLDING I/O ON THIS LU. * BIT 9,10,11- TRANSFER VECTOR FOR EXTND/TO * RETURNS: * 0= POST WAIT FOR XSIO CALL * 1= WAIT FOR EXTND TO START SPOUT * 2= WAIT FOR BUFFER ECT. IN INCOR * 3= WAIT FOR READ/WRITE EXTND * 4= WAIT FOR BACKSPACE EXTENT * 5= WAIT IN RWIND FOR EXTND * 6= NOT USED * 7= NOT USED * BIT 7,8- 00 READ AND WRITE * 01 READ ONLY * 10 WRITE ONLY * BIT 6 - NOT USED * BIT 5 - NOT USED * BIT Ó>������þú 4 - ORDINARY FILE * BIT 3 - SPOOL POOL FILE * BIT 2 - REQUEST LENGTH IN CHARACTERS * BIT 1 - NOT USED * BIT 0 - TEMP EOF FLAG * EQT12 # OF EXTENSION WORDS - BSREC OR PUSH/GETRD RETURN POINT SAVE * EQT13 POINTER TO EXTENSION * EQT14 SAME AS STANDARD * EQT15 SAME AS STANDARD * * *** EQT EXTENSION *** * * EQT16 EQT18 SAVE * EQT17 EQT19/EQT21 SAVE * EQT18 CURRENT TRACK * EQT19 CURRENT OFFSET * EQT20 FILE EXTENSION # * EQT21 CURRENT SECTOR # * EQT22 TRANSFER COUNTER * EQT23 CURRENT PACKING BUFFER ADDRESS * EQT24 BEGINNING TRACK IN THIS EXTENT * EQT25 BEGINNING SECTOR IN THIS EXTENT * EQT26 # OF SECTORS IN THE FILE (AND EACH EXTENT) * EQT27 TR/LU DIRECTORY ADDRESS OF * EQT28 OFFSET/SECTOR MASTER ENTRY. * EQT29 ID SEGMENT ADDRESS OF PGM REQUESTING INPUT CHECK * FILE COUNTER FOR SPOUT (ALWAYS NEGATIVE) * EQT30 # OF SECTORS PER TRACK * EQT31 RECORD COUNT * EQT32 SPOUT CLASS PARAMETER 1 * EQT33 SPOUT CLASS PARAMETER 2 * * * EXT $LIST RTE PROGRAM SCHEDULING EXT $XSIO RTE SYSTEM I/O EXT $XEQ SYSTEM IDLE LOOP EXT $ETEQ RTE - SETUP UP EQT ON BASE PAGE EXT $DRVM IN RTE IV TO SETUP USER MAP EXT $RSM IN RTE IV TO RESTORE PREVIOUS MAP EXT $UPIO IN RTE IV FOR CLEAR IO RETURN ******************** * ERROR EXITS * ******************** * * REJECT REQUEST ERROR CODES (CAUSE IOXX ERROR REPORTS) * * XX = 20 ATTEMPT TO READ A WRITE ONLY FILE * = 21 ATTEMPT TO READ PAST EOF * = 22 SECOND ATTEMPT TO READ A JCL RECORD (FIRST RETURNS EOF) * = 23 ATTEMPT TO WRITE ON A READ ONLY FILE * = 24 ATTEMPT TO WRITE PAST EOF (OR SPOOL FILE OVERFLOW) * = 25 REQUEST ON A EQT THAT HAS NOT BEEN SET UP WITH A FILE. * * EOF EXITS MADE ON READ OR WRITE REQUESTS (SEE BELOW) * * TLOG = 0 STANDARD Eª`������þúOF ALL OK IF READ, IF WRITE OF # 0 RECORD * IMPLIES FILE IS FULL. NEXT ATTEMPT TO WRITE WILL * CAUSE IO24 (SEE ABOVE) * = -1 EOF WAS A -2, MEANS FILE WAS TERMINATED FOR OVERFLOW * = -5 SAME AS FMGR -5 ERROR I.E. NO EXTENT ON READ OR LENGTHS * AT THE ENDS OF THE RECORD DON'T MATCH. HED SPOOL MONITOR DRIVER REQUEST DECODE SECTION N.SEQ NOP IS43 NOP LDA IS43 SRTNI STA RTNI SAVE FIRST RETURN ADDRESS CLA STA SRTNI * LDB EQT6,I TEST FOR CLEAR IO RQ CPB BSN3 BSN3=100003B JMP IS43,I SYSTEM CLEAR ACCEPT IT. * JSB EXEQT LDA EQT27,I IS THIS SPOOL SZA,RSS EQT INITIALIZED? JMP ABORT NO - REJECT THE CALL. * LDA EQT8,I STA EQT10,I CLB SSA,RSS JMP WDS * CMA,INA SLA,ARS INA STA EQT8,I LDB D4 WDS CMA SAVE NEG. OF # OF WORDS TO STA EQT22,I WORDS TO TRANSFER LDA EQT5,I CLEAR EOF BIT. IOR D128 XOR D128 STA EQT5,I LDA EQT11,I AND DISPM IOR B LDB A IF LAST EXIT WAS WITH BATCH CHECK RBL,ELB SEZ,RSS WELL WAS IT? JMP ST11 NO PROCEED * LDB EQT1,I YES IS THIS THE KEEPER OF THE CPB EQT29,I KEYS?? AND CLEOF YES CLEAR THE EOF FLAGS ST11 STA EQT11,I INITIALIZE EQT11 ALF,SLA HOLDING I/O TO THIS LU. JMP ABORT YES. AN ABORTING ERROR (SPOUT KNOWS) * LDA EQT18,I SAVE CURRENT FILE LOCATION STA EQT16,I IN CASE AN EXTENT IS NEEDED LDA EQT19,I AND NOT AVAILABLE AND B377 KEEP LOW BITS OF LENGTH (ITS <0) ALF,ALF IOR EQT21,I STA EQT17,I * LDA EQT6,I AND B77 LDB D20 SET UP THE ERROR CODE RBR,ELB 20 NORMAL, 21 IF POSSIBLE BATCH CHECK CPA D1 JMP RR READ REQUEST * LDB D23 xæ������þú SET FOR WRITE ERRORS CPA D2 JMP WR WRITE REQUEST * * COME HERE FOR CONTROL REQUEST * LDA EQT11,I ALF,ALF READ ONLY FILE? SSA JMP CR1 YES. * AND TFLAG DOES FILE HAVE HEADERS? SZA JMP CR1 NO. INTERPRET REQUEST. * STA EQT8,I SET UP TO PUT THE CONTROL CMA INFORMATION IN THE BUFFER STA EQT22,I TO BE WRITTEN OUT. JMP WR * CR1 LDA EQT6,I GET THE CONWD. RRR 6 AND B77 ISOLATE CONTROL FUNCTION CMA,INA,SZA,RSS DECODE THE REQUEST JMP ILL ZERO IS A BAD GUY. * LDB D23 INA,SZA,RSS 1 IS EOF JMP WREOF SO OFF TO THE EOF WRITER * INA,SZA,RSS 2 IS BACK SPACE RECORD JMP BSREC SO OFF THE THE BACK SPACE ROUTINE * INA,SZA,RSS 3 IS FORWARD SPACE RECORD JMP FSREC SO GO DO THAT * INA,SZA,RSS 4 IS REWIND JMP RWIND SO OFF TO DO IT * INA,SZA 5 IS ALSO REWIND CPA N7 14 IS BACKSPACE FILE BUT ONLY ONE SO REWIND RWIND CCA,RSS OFF TO IT. * JMP ILL NONE OF THE ABOVE CAN NOT DO IT * STA EQT20,I REWIND SPOOL FILE BY CALLING THE LDA B5000 EXTND PROGRAM TO GET JMP GTEXT EXTENT 0 (MASTER ENTRY). * * * RETURN TO RW2 AFTER EXTND CALL OR FROM BACKSPACE. * RW2 LDA DM128 MAKE SURE ALL POINTERS STA EQT19,I ARE CONSISTENT WITH * CLA CLEAR THE RECORD COUNT RW3 STA EQT31,I LDA EQT11,I CLEAR EOF BIT IF SET. AND CLEOF STA EQT11,I CLB RETURN A CLEAR TLOG JMP POST1 * ILL LDA D2 NONE OF THE ABOVE JMP RTRN REJECT REQUEST * ABORT LDA D25 SEND ABORT ERROR IO25 * * COMMON RETURN POINT * RTRN STA XA SAVE A REG LDA EQT1,I IS CLEAR IO IN PROGRESS RAL,CLE,SLA,ERA CLEAR SIGN BIT IN CASE ç ������þúCLB,RSS YES SET B TO CLEAR TIME OUT JMP RTRN2 NO GO EXIT * STA EQT1,I SET EQT1 WITH CLEARED FLAG BIT STB EQT15,I CLEAR THE TIME OUT WORD LDA EQT5,I CLEAR THE BUSY BIT ALR,RAL AND STA EQT5,I SET IT BACK JMP $UPIO NOW GO TO UPIO * RTRN2 LDA XA NO RESTORE A AND RETURN JMP RTNI,I * XA BSS 1 RTNI BSS 1 DISPM OCT 70630 D23 DEC 23 D25 DEC 25 D20 DEC 20 TFLAG OCT 10000 N7 DEC -7 B4000 OCT 4000 CLEOF OCT 117777 B5000 OCT 5000 B77 OCT 77 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 B3701 OCT 3701 BSN3 OCT 100003 * * * * BSREC LDA EQT11,I IF AT A REAL EOF RAL,RAL THEN SSA JMP BSR0 JUST SET UP THE POINTERS * CCA BACKSPACE ROUTINE JSB BSPTO BACK UP THE POINTER LDA SAVE,I GET THE TRAILING LENGTH WORD CMA SET TO BACK OVER THE RECORD JSB BSPTO DO IT BSR0 CCA BACK UP THE RECORD POINTER ADA EQT31,I BY ONE JMP RW3 GO SET AND EXIT HED SPOOL MONITOR DRIVER BACKSPACE POINTER ROUTINE BSPTO NOP BACKSPACE 'A' WORDS IN THE FILE LDB BSPTO SAVE ENTRY POINT IN CASE STB EQT12,I WE ARE INTERRUPTED. ADA EQT19,I DECREMENT THE BUFFER OFFSET CMA SET FOR DIVIDE CLB SET FOR DIVIDE DIV D128 A IS BLOCK OFFSET, B NEW BUFFER OFFSET CMB SET BUFFER OFFSET NEGATIVE STB EQT19,I SET THE BUFFER OFFSET CMA,INA,SZA,RSS SET BLOCKS NEGATIVE JMP BSP1 IF ZERO THEN IN SAME BUFFER * STA SAVE SAVE THE BLOCK OFFSET JSB SUBT GET CURRENT SECTOR POSITION ADA SAVE ADJUST TO NEW ADA SAVE (IT WAS BLOCKS REMEMBER) CLB SET FOR DIVIDE CMA,SSA,INA SET POS. NUMBER TO GO BACK JMP BSP2 SAME EXTENT GO SET UP * DIV EQT26,I A= # EXTENTS@������þú BACK, B= SECTOR OFFSET IN THAT EXTENT SZB ADJUST IF ZERO REMAINDER INA SET UP TO GO CMA ADA EQT20,I BACK AND GET STA EQT20,I THE EXTENT. INA IF LESS THAN SSA -1 THEN JMP RWIND JUST REWIND * CMB,INB,SZB ADB EQT26,I SAVE INDEX INTO STB EQT17,I THE EXTENT. BS13 LDA B4000 GET THE RETURN VECTOR JMP GTEXT GO GET THE EXTENT * BSP2 CMA,INA,RSS SET POSITIVE OFFSET BS10 LDA EQT17,I RETURN FROM EXTENT TO HERE B40 CLE CLEAR E FOR OVERFLOW TEST ADA EQT25,I TAKE INDEX FROM BEGINNING CLB,SEZ,CLE OF TRACK WHERE THE INB STEP B IF OVERFLOW DIV EQT30,I CURRENT EXTENT BEGINS. ADA EQT24,I FIND OUT HOW MANY STA EQT18,I TRACKS TO ADVANCE. STB EQT21,I SAVE CURRENT TRACK AND SECTOR. BSP1 CLE SET FOR READ ACCESS JMP BSCOR MAKE PRESENT AND RETURN HED SPOOL MONITOR DRIVER READ ROUTINE FSREC CLA FAKE OUT THE READ STA EQT8,I ROUTINES SO THAT INA THEY WILL FORWARD STA EQT6,I SPACE ONE RECORD. CMA,INA STA EQT22,I * RR LDA EQT6,I CPA B3701 IS THIS REALLY A POST REQUEST? JMP POST YES. * LDA EQT11,I CHECK IF FILE IS WRITE ONLY. ALF,ALF SLA JMP EOFRT SEND BACK IO20. * AND B40 ALREADY DONE AN EOF ON INB SET FOR EOF # 2 ERROR SZA THIS FILE? JMP EOFRT * JSB GETRD GET READY TO ACCESS THE BUFFER * LDA SAVE,I NO,GET AND SAVE LENGTH OF STA EQT10,I DISK RECORD. STA B SET IN B IN CASE EOF SSA EOF I.E. LESS THAN 0 JMP EORET YES EOF RETURN. * ADA EQT22,I # OF WORDS LEFT IN RECORD SSA,RSS IF BUFFER PROVIDED IS TOO SHORT JMP STFLG THEN JUST USE IT * STB EQT8,I)Ç������þú ELSE SAVE TOTAL # WORDS TO BE CMB TRANSFERRED. STB EQT22,I SET TRANSFER COUNTER. STFLG JSB PUSH PUSH THE BUFFER ADDRESSES LDB EQT29,I GET THE BATCH CHECK FLAG SZB IF ZERO OR CPB EQT1,I CURRENT USER RSS SSB OR NEGATIVE JMP EORT ALL OK GOT TEST FOR END OF RECORD * LDA SAVE,I IF THIS IS A ":" HE IS AND MASKL IN DEEP CPA COLON JMP BINF SHIT, HE BLEW IT * EORT ISZ EQT22,I ALL WORDS MOVED?? JMP TRWD NO GO MOVE A WORD * LDA EQT10,I SET UP TO SKIP ANY RESIDUE CMA AND TO GET THE LAST WORD ADA EQT8,I STA EQT22,I SET COUNT RCONT LDA SAVE,I HANG ONTO THIS WORD. AT END STA EQT7,I OF RECORD, IT WILL CONTAIN LENGTH. JSB PUSH ADVANCE TO END OF RECORD. ISZ EQT22,I FINISHED? JMP RCONT NO GET THE NEXT ONE * LDA EQT7,I YES DO LINE LENGTHS SURROUNDING CPA EQT10,I THIS RECORD MATCH? JMP NORML YES - EVERYTHING NORMAL. * ERN5 LDB N6 SET UP FOR EOF WITH PREJUDICE (-5) JMP EORET NO MATCH - SEND EOF STATUS. * * N6 DEC -6 * TRWD LDB EQT7,I GET THE WORD ADDRESS LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WHICH MAP ? JMP SMAP1 SYSTEM MAP * LDA SAVE,I GET THE WORD XSA B,I SEND IT INTO THE USER MAP JMP IDON * SMAP1 LDA SAVE,I GET THE WORD STA B,I PUT IT INTO BUFFER OF BUFFERED REQUEST IDON ISZ EQT7,I STEP THE USER BUFFER ADDRESS JSB PUSH PUSH MY ADDRESSES JMP EORT GO TEST FOR END HED SPOOL MONITOR DRIVER POSITION TO NEXT WORD ROUTINES PUSH NOP ROUTINE TO PUSH THE BUFFER ADDRESS ISZ SAVE PUSH THE BUFFER ADDRESS ISZ EQT19,I CHECK THE BUFFER COUNT JMP PUSH,I ALL OK SO CONTINUE * LDA PUSH NEED A NEW SECTOR SO SAVE º¸������þúSTA EQT12,I THE RETURN ADDRESS LDA D2 ADD 2 TO THE ADA EQT21,I SECTOR ADDRESS CPA EQT30,I END OF TRACK?? CLA YES SET TO ZERO STA EQT21,I RESET THE SECTOR SZA,RSS IF FIRST SECTOR ISZ EQT18,I BUMP THE TRACK LDA DM128 SET THE BUFFER POINTER BACK STA EQT19,I TO THE FIRST WORD JSB SUBT CHECK IF END OF EXTENT CPA EQT26,I WELL JMP RDEXT YES GET NEXT EXTENT * JMP XCOR STILL IN FILE GO GET THE BUFFER * RDEXT LDA B3000 NOT IN FILE, SO GET AND EXTENT GTEXT CLB,INB SET UP THE TEMP WORDS FOR EXTND STB PRM1 LDB EQT1 STB PRM2 LDB A SAVE A LDA EQT6,I CHECK IF WRITE AND D2 ISOLATE READ BIT (0 IF READ) ADA D6 USE 8 FOR WRITE 6 FOR READ STA PRM3 PUT IN THIRD EXTND PRAM LDA B RESTORE A & CALL FOR EXTND JSB LIST JMP WTOUT GO AWAY FOR A WHILE. * GETRD NOP THIS ROUTINE MAKES SURE THE BUFFER IS LDB GETRD IN CORE AND ADDRESSABLE STB EQT12,I SET RETURN ADDRESS XCOR LDB EQT6,I WSET E FOR THE INCOR CALL RBR,ERB 0= READ, 1= WRITE,CONTROL BSCOR JSB INCOR GO GET THE SECTOR * LDA EQT19,I SET UP THE BUFFER POINTER ADA D132 EQT19 STARTS AT -128 AND ADA EQT23,I BUFFER IS 4 WORDS BEYOND EQT23 STA SAVE SET THE POINTER LDA EQT1,I GET THE CLEAR IN PROGRESS FLAG SSA THEN JMP ERN5 GO EXIT * LDB EQT12,I GET THE RETURN ADDRESS JMP B,I AND CONTINUE HED SPOOL MONITOR DRIVER TIME DELAY EXIT / CONSTANTS B3000 OCT 3000 DM128 DEC -128 * NTRDY LDA N4 SET TIME OUT SO THAT WE STA EQT15,I CAN GET BACK IN HERE. LDA EQT4,I IOR TFLAG SET THE HANDLE-OWN-TO FLAG STA EQT4,I * WTOUT LDA EQT5,I SET AVAIL = 2 CCE RAL,ERA STA EQT5,Iƒ ������þú * JSB $RSM IN RTE IV, RESTORE PREVIOUS JMP $XEQ MAP AND GO TO SYSTEM IDLE LOOP. * MASKL OCT 177400 COLON OCT 35000 N4 DEC -4 B20K OCT 20000 D6 DEC 6 * EQT1 EQU 1660B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B EQT13 EQU 1772B EQT15 EQU 1774B EQT16 NOP EQT17 NOP EQT18 NOP EQT19 NOP EQT20 NOP EQT21 NOP EQT22 NOP EQT23 NOP EQT24 NOP EQT25 NOP EQT26 NOP EQT27 NOP EQT28 NOP EQT29 NOP EQT30 NOP EQT31 NOP EQT32 NOP EQT33 NOP * * * EOFLG NOP LDA EQT5,I SET EOF FLAG IN EQT5. IOR D128 STA EQT5,I LDA EQT11,I SET FLAG TO INDICATE IOR B20K EOF ALREADY SENT ONCE. STA EQT11,I JMP EOFLG,I * EOFRT LDA EQT5,I SET THE IOR D128 EOF FLAG STA EQT5,I * LDA B GET THE RETURN CODE JMP RTRN * * THE FOLLOWING ROUTINE FINDS OUT THE DIFFERENCE * IN SECTORS BETWEEN THE CURRENT POSITION AND * THE BEGINNING OF THIS EXTENT. * RETURNS THE RLEATIVE SECTOR OF CURRENT ADDRESS SECTOR * SUBT NOP LDA EQT24,I HOW MANY TRACKS READ WRITTEN? CMA,INA ADA EQT18,I GET RESULT IN SECTORS. MPY EQT30,I LDB EQT25,I ADD NUMBER OF SECTORS TO CMB,INB GET TOTAL. ADA B ACCUMULATE ADA EQT21,I JMP SUBT,I HED SPOOL MONITOR DRIVER POST ROUTINES * COME HERE TO POST BUFFERS BEFORE SPOOL CLOSE. * POST6 LDB EQT23,I SHOW BUFFER EMPTY AS IT MAY NOT CLA BE THE SAME AS THE INB DISC ANY MORE STA B,I SET LU TO ZERO TO CLEAR POST4 LDB EQT7,I ADVANCE TO THE NEXT BUFFER RBL FIRST THE BIT MAP LDA EQT23,I NOW THE ADDRESS ADA D132 JMP POST2 CONTINUE THE FLUSH * D132 DEC 132 * POST LDA PKBUF MUST FIND ALL BUFFERS CLB,INB d,������þúTHAT NEED TO BE WRITTEN. POST2 STB EQT7,I LDB A,I MAKE SURE WE DON'T STA EQT23,I CPB D5 POST A BUFFER THAT IS JMP POST4 BEING READ OR WRITTEN. * SSB JMP POST1 ALL FINISHED. * LDA WRBUF DOES THIS NEED TO AND EQT7,I BE WRITTEN OUT. CCE,SZA JMP POST6 NO. GO CLEAR THE INCORE FLAG IN CASE * JSB SXSIO YES - DO IT. JMP NTRDY * LDB EQT23,I INDICATE THAT THE BUFFER LDA D5 IS UNAVAILABLE BY SETTING STA B,I THE AGE WORD. JSB IOCAL,I LDB EQT23,I FREE UP THE BUFFER CLA,INA FOR USE. STA B,I LDA EQT7,I INDICATE BUFFER NEED NOT IOR WRBUF BE WRITTEN. STA WRBUF JMP POST6 CLEAR THE LU SO WON'T BE FAKED OUT HED SPOOL MONITOR DRIVER CLEAN UP AND EXIT CODE BINF CCA BATCH CHECK ':' FOUND SO JSB BSPTO BACK SPACE TO LENGTH WORD FOR NEXT TIME LDA EQT11,I AND SET THE IOR B40K BATCH CHECK FAILED BIT STA EQT11,I IN THE EQT CCB SET TLOG FOR A 0 RETURN EORET JSB EOFLG SET EOF FLAGS INB SET B FOR TLOG POST1 STB EQT9,I SAVE B REGISTER. LDA EQT32,I NEED WE CALL BACK SPOUT? ALF,SLA RSS JMP POST5 * CSPT CCA SET UP ENTND TEMP WORDS STA PRM1 LDA EQT32,I STA PRM2 LDA EQT33,I STA PRM3 LDA B1000 GET THE RETURN VECTOR JSB LIST CALL FOR EXTND * LDA EQT32,I SUCCESS, SO XOR TFLAG CLEAR BIT WHICH INDICATES NEED STA EQT32,I TO CALL SPOUT. LDB EQT9,I RESTORE THE TLOG. POST5 LDA D4 NO - DO IMMEDIATE COMPLETION. JMP RTRN * B1000 OCT 1000 B40K OCT 40000 PKBUF DEF BUFS B377 OCT 377 D5 DEC 5 IOCAL NOP N1 DEC -1 SAVE NOP SAVE1 NOP TRSEC NOP FLU NOP WRBUF DEC -1 HED SPOOL MONITOR DRIVER GET CURRENTq±������þú BLOCK ROUTINES * THE FOLLOWING CHECKS AND MAKES SURE THE DESIRED * SECTOR IS IN CORE. THIS ROUTINE MAY CAUSE ONE OR MORE * EXITS TO WAIT FOR RESOURCES. * * ON ENTRY E = 1 INDICATES A WRITE, E = 0 A READ * ON EXIT THE REQUESTED SECTOR IS IN CORE * * THE RETURN ADDRESS MAY BE SAVED IN EQT9 IF INCOR IS EVER CALLED * FROM MORE THAN ONE LOCATION. * * THE RETURN VECTOR IS 2000. * * INCOR NOP LDA EQT11,I SAVE THE DIRECTION BIT RAL,ERA IN EQT11 BIT 15 STA EQT11,I INC0 LDA EQT27,I GET THE LU AND AND B77 ISOLATE IT STA FLU CLA,INA SET BEGINING BUFFER READ/WRITE FLAG LDB PKBUF GET BEGINNING ADDRESS OF BUFFERS. INC1 STB EQT23,I STB TRSEC LDB B,I LOOK AT 1ST WORD OF BUFFER. INB,SZB,RSS FINISHED? JMP INC4 YES. * ISZ TRSEC LOOK AT BUFFER PTR. TO LU. LDB TRSEC,I DOES IT MATCH THIS ONE? CPB FLU RSS YES TRY THE NEXT ONE JMP INC3 NO. * ISZ TRSEC LOOK AT TRACK #. LDB TRSEC,I CPB EQT18,I IS IT EQUAL TO THE JMP INC2 TRACK DESIRED? * INC3 RAL MOVE THE WRITE FLAG TO NEXT BUFFER LDB EQT23,I INDEX THE ADDRESS ADB D132 ALSO JMP INC1 TRY THE NEXT BUFFER * INC2 ISZ TRSEC LOOK ALSO AT LDB EQT21,I SECTOR POINTER. CPB TRSEC,I MATCH THE ONE DESIRED? RSS YES. JMP INC3 NO. * LDB EQT23,I GET THE AGE FLAG LDB B,I TO B CPB D5 BUFFER - IS BUFFER AVAILABLE? JMP INC5 NO - MUST WAIT UNTIL IT'S POSTED. * LDB EQT11,I BUFFER IS IN CORE CMA IF TO BE WRITTEN ON AND WRBUF SET THE PROPER FLAG SSB SKIP IF READ ACCESS STA WRBUF JMP OKRET GO EXIT WE ARE READY NOW * * * * THE FOLLOWING GRABS UP AN AVAILABLE BUFFER AND * CHECKS IF IT NEEDS TO BE WRIT5’������þúTEN OUT. * INC4 STB SAVE1 LDB PKBUF CLA,INA OK4 STA SAVE FIND LEAST RECENTLY USED BUFFR. LDA B,I ARE WE AT THE END OF SSA THE BUFFERS? JMP OK2 YES. PICK LEAST RECENTLY USED. * CPA D5 IS THE BUFFER AVAILABLE? JMP OK1 NO. * CMA,INA YES. KEEP LOOKING THROUGH. ADA SAVE1,I CHECK AGE AGAINST CURRENT SSA,RSS IS THIS BUFFER A POSSIBLE? JMP OK3 NO. AGE IT. * STB SAVE1 YES. SAVE THIS BUFFER'S ADDRESS. LDA SAVE SAVE BUFFER POSITION. STA FLU AND WRITE FLAG LOCATION JMP OK3 * OK2 LDB SAVE1 DID WE FIND A BUFFER? SZB,RSS JMP INC5 NO - WAIT FOR TIME OUT * LDA D5 YES - MARK BUFFER AS UNAVAILABLE. STA B,I STB EQT23,I SAVE CURRENT SMD BUFFER ADDRESS. LDA FLU GET THE BUFFER # BIT AND WRBUF ISOLATE MUST BE WRITTEN FLAG CMA,CLE,INA SET E IF MUST BE WRITTEN LDA WRBUF GET THE MUST WRITE FLAG WORD IOR FLU SET THE NO WRITE FLAG LDB EQT11,I READ OR WRITE? SSB SKIP IF READ ELSE XOR FLU CLEAR TO INDICATE MUST WRITE STA WRBUF PUT THE FLAG WORD BACK SEZ,RSS MUST WE WRITE THIS ONE OUT FIRST? JMP OKOUT NO. BYPASS THIS STUFF. * JSB SXSIO WRITE OUT THE BUFFER. JMP NOK NO AVAILABLE $XSIO CALL. * OKOUT LDB EQT23,I MARK BUFFER WITH NEW INFO. INB LDA EQT27,I PUT AND B77 LU STA B,I INB TRACK LDA EQT18,I STA B,I INB LDA EQT21,I AND SECTOR STA B,I IN BUFFER HEAD SEZ IF MUST WRITE THEN JSB IOCAL,I DO IT NOW LDA EQT11,I READ OR WRITE REQUEST? LDB EQT19,I IF READ OR WRITE FROM CPB DM128 OTHER THAN BEGINING OFBLOCK SSA,RSS THEN MUST READ (ò������þúCLE,RSS MUST READ JMP OKRET NEED NOT READ GO EXIT * JSB SXSIO READ IN THE DESIRED SECTOR. JMP OK5 * JSB IOCAL,I DO THE READ OKRET CLA,INA SET AGE BACK ON BUFFER LDB EQT23,I THAT IS BEING USED. STA B,I JMP INCOR,I * NOK LDA FLU COULD NOT WRITE OUT A SELECTED BUFFER CMA SET AND WRBUF THE MUST BE WRITTEN FLAG JMP OK8 GO FREE THE BUFFER AND WAIT * OK3 LDA B,I IF AGE # 4 CPA D4 RSS ISZ B,I BUMP IT THEN OK1 ADB D132 INDEX TO THE NEXT BUFFER LDA B,I IS THER ONE?? SSA WELL? JMP OK2 NO GO SEE IF ONE WAS FOUND * LDA SAVE YES MOVE RAL THE FLAG AROUND JMP OK4 AND GO TEST THIS ONE * OK5 LDB EQT23,I NO XSIO CALL AVAILABLE INB FOR READ CLA CLEAR THE LU STA B,I AND MUST WRITE FLAGS LDA FLU AND IOR WRBUF OK8 STA WRBUF LDA D4 SET THE FREE FLAG LDB EQT23,I IN THE BUFFER STA B,I AND THEN INC5 LDA EQT11,I SET UP TO TIME OUT IOR B2000 SET RETURN VECTOR STA EQT11,I (RETURNS TO INC0) JMP NTRDY GO TAKE WAIT EXIT * B2000 OCT 2000 HED SPOOL MONITOR DRIVER XSIO CALLS AND SETUP ROUTINES * * THE FOLLOWING SUBROUTINE SETS UP ONE OF THE * CALLS TO $XSIO. SXSIO USES INFORMATION FROM THE * CURRENT PACKING BUFFER. * * CALLING SEQUENCE: * E=0 FOR READ, E=1 FOR WRITE * JSB SXSIO * RETURN NO AVAILABLE CALL * RETURN+1 CALL READY AND SET UP - E=1. * * SXSIO NOP CLA,SEZ,INA INA STA DFUNC SET UP FUNCTION BITS. LDA AVXSI IS THERE AN AVAILABLE $XSIO CALL? SZA,RSS JMP SXSIO,I NO - GO AWAY. * LDB XSI1 CLE,SLA,RSS GET AN AVAILABLE CALLING SEQUENCE. LDB XSI2 STB IOCAL CLåÂ������þúE,SLA,RSS BIT 0= CALL ONE, BIT 1= CALL TWO CLA,RSS IF USING CALL TWO THEN BOTH IN USE RAR,ELA USING CALL ONE CLEAR BIT 0 STA AVXSI RESET AVAILABLE-CALL SWITCH. ADB DOFF ADD THE OFFSET TO CALL PRAMS AREA LDA EQT23,I INA STA BUFR LDA A,I STA B,I PUT LU # IN CALLING SEQUENCE. ADB D3 LDA DFUNC STA B,I CCE,INB LDA B,I GET ADDRESS OF DISK CONTROL WDS. LDB BUFR ADB D3 STB A,I STORE BUFFER ADDRESS. ADA D2 STA BUFR ADB N1 LDA B,I GET SECTOR # AND STA BUFR,I PUT IT INTO QUADRUPLET. ADB N1 LDA B,I GET TRACK #. AND B377 IS IT LARGER THAN CPA B,I 256? ALF,SLA,ALF NO ROTATE AND SKIP JMP SXSI1 YES. * RAR FINISH THE ROTATE XOR BUFR,I NO - PUT TRACK AND STA BUFR,I #'S TOGETHER IN ONE CLA,RSS WORD. SXSI2 LDA B,I ISZ BUFR STA BUFR,I PUT IT INTO QUADRUPLET. ISZ SXSIO CCE SET E FOR RETURN JMP SXSIO,I * SXSI1 LDA BUFR,I MAKE A QUADRUPLE INSTEAD OF A TRIPLE. ELA,RAR SEPARATE TRACK AND STA BUFR,I SECTOR. JMP SXSI2 * DOFF ABS XSI12-XSIO1 OFFSET TO LU WORD OF XSIO CALL BUFR NOP DFUNC NOP XSI1 DEF XSIO1 XSI2 DEF XSIO2 AVXSI OCT 3 EQSV1 NOP EQSV2 NOP * COMP1 LDA EQSV1 HERE ON COMPLETION OF CALL 1 ISZ AVXSI SET CALL AVAILABLE AGAIN JSB SIOEX GO TO COMMON EXIT * XSIO1 NOP MUST FOLLOW (PASSES THE RETURN ADDRESS) LDA EQT1 SAVE THE CURRENT STA EQSV1 EQT ADDRESSBE CHANGED TO COMPENSATE. JSB $RSM IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI12 NOP LOGICAL UNIT #. DEF COMP1 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO.,REQUEST CODE. DEF DS9f������þúCC1 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV1 RESTORE THE EQT ADDRESSES EXSIO JSB $ETEQ AND THEN JMP WTOUT GO AWAY FOR A WHILE. * SIOEX NOP COMMON XSIO COMPLETION ROUTINE JSB $ETEQ RESTOR THE EQT ADDRESSES CPB D128 TRANMISSION ERROR?? RSS NO ALL OK JSB EOFLG YES SET EOF FLAGS JSB EXEQT SET THE REST OF THE EQT UP(GET WTMAP TO A) CMA,SSA,SLA,RSS USER REQUEST ? RSS NO JSB $DRVM IN RTE IV, SET UP USER MAP. LDB SIOEX,I GET THE RETURN ADDRESS JMP B,I AND RETURN * DSCC1 NOP BUFFER ADDRESS. D128 DEC 128 LENGTH OF BUFFER. NOP SECTOR. NOP TRACK. DEC 0 TERMINATES THE QUADRUPLET. * COMP2 LDA EQSV2 GET THE EQT ADDRESS ISZ AVXSI SET CALL 2 ISZ AVXSI AVAILABLE JSB SIOEX CALL THE COMMON EXIT * XSIO2 NOP LDA EQT1 SAVE THE STA EQSV2 EQT ADDRESS JSB $RSM IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI22 NOP LOGICAL UNIT #. DEF COMP2 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO., REQUEST CODE. DEF DSCC2 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV2 JMP EXSIO GO SET EQT AND EXIT * TST1 EQU XSI12-XSIO1-XSI22+XSIO2 MUST BE EXACTLY ZERO TST2 EQU -TST1 OR CALL OFFSETS ARE NOT EQUAL * DSCC2 NOP BUFFER ADDRESS DEC 128 LENGTH NOP SECTOR. NOP TRACK. DEC 0 TERMINATES QUADRUPLET. * * THE FOLLOWING ROUTINE SETS UP POINTERS TO THE EQT EXTENSION. * IN ADDITION, IT DETERMINES WHETHER THE I/O REQUEST IS SET UP * VIA THE USER MAP OR IF IT WAS BUFFERED AND THUS SET UP VIA ������þú * THE SYSTEM MAP. IT SETS UP THE MSB AND LSB BITS OF 'WTMAP' * AS A FLAG. LATER READ AND WRITE ROUTINES CHECK THIS TO SEE * WHETHER TO DO CROSS MAP OR SAME MAP READS AND WRITES. * * ON RETURN A = WTMAP * EXEQT NOP LDA EQT13,I LDB N18 STB SAVE LDB ADR16 STA B,I INA INB ISZ SAVE JMP *-4 * LDB EQT1,I GET OUR LINK WORD RBL,CLE,SLB,ERB CLEAR SIGN BIT TO BE SAFE JMP EXEXE EXIT IF A CLEAR REQUEST * INB GET TO THE T-FIELD LDA B,I AND PULL IT IN RAL SET T-FIELD INTO MSB & LSB INB SEE IF BUFFER HAS BEEN MOVED (VIA REIO ?) LDB B,I PULL IN MOVED TO SAM WORD SSB HAS IT BEEN MOVED ? EXEXE CCA YES, SO SET A FLAG STMAP STA WTMAP FOR ALL DATA MOVES JMP EXEQT,I RETURN TO THE CALLER * WTMAP NOP * * *THE LIST SUBROUTINE CALL $LIST IN THE RTE OPERATING SYSTEM *TO SCHEDULE EXTND. THE VERY FIRST SCHEDULE IS BY PROGRAM *NAME, THERE AFTER ALL SCHEDULES ARE BY ID ADDRESS. * * LIST NOP IOR EQT11,I SAVE THE RETURN VECTOR STA EQT11,I JSB $LIST CALL LIST PROCESSOR CALL OCT 701 BY NAME 1ST TIME DEF *+5 NAME DEF PNAME DEF PRM1 DEF PRM2 DEF PRM3 * SZA WAS IT SUCCESSFUL ? JMP NTRDY NO, SO TRY LATER CLA,INA YES, SO SET UP CALL BY ID ADDR STA CALL STB NAME B = ID ADDR FROM $LIST JMP LIST,I * * PNAME ASC 3,EXTND PRM1 NOP PRM2 NOP PRM3 NOP * * * * HED SPOOL MONITOR DRIVER WRITE ROUTINES ADR16 DEF EQT16 N18 DEC -18 * * COME HERE FOR WRITE EOF REQUEST * WREOF ISZ EQT11,I SET EOF TO BE DONE FLAG * * HERE FOR WRITE REQUEST * WR LDA EQT11,I IF FILE IS READ-ONLY, ALF,ALF REJECT CALL. SSA JMP EOFRT * AND B40 ALREADY SENT AN EOF INò������þúB SET B FOR POSSIBLE ERROR SZA ON THIS FILE? JMP EOFRT * JSB GETRD GET READY TO WRITE THE RECORD LDA EQT11,I ARE LENGTHS TO BE WRITTEN? SLA IF JUST A WRITE EOF JMP WR1 GO WRITE IT * AND B20 ISOLATE THE STD. FILE BIT LDB EQT8,I GET LENGTH SZA IF STANDARD JMP STDFL SKIP THIS NONSENSE * ADB D2 BUMP BY TWO STB EQT8,I SAVE FOR THE SOUTH END OF STB SAVE,I THE RECORD AND SET IN FILE JSB PUSH PUSH THE RECORD POINTERS LDA EQT6,I GET THE CON WORD STA SAVE,I AND SET IT JSB PUSH PUSH THE RECORD POINTERS LDB EQT10,I GET THE LENGTH LDA EQT6,I IS CONTROL REQUEST? SLA NO SKIP LDB EQT7,I YES SET CONTROL EXTRA WORD STDFL STB SAVE,I IN TO THE BUFFER IT GOES JSB PUSH PUSH THE BUFFER POINTERS ISZ EQT22,I DONE?? JMP WR0 NO GO GET NEXT WORD * LDA EQT8,I END OF RECORD - WRITE LENGTH. STA SAVE,I JSB PUSH WR1 CCA WRITE AN EOF AFTER STA SAVE,I LAST LINE. LDA EQT11,I IF THIS WAS A EOF ONLY SLA THEN WR2 JSB EOFLG SET THE EOF FLAGS * NORML ISZ EQT31,I INCREMENT RECORD COUNT. LDB EQT8,I LDA EQT11,I RAR,RAR SLA MAKE SURE LENGTH IS CORRECTLY BLS RETURNED. JMP POST1 * WR0 LDB EQT7,I MOVE USER'S WORD TO SMD BUFFER. ISZ EQT7,I LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WELL, WHICH MAP ? JMP SMAP2 SYS MAP * XLB B,I GET THE DATA JMP STDFL AND GO WRITE IT * SMAP2 LDB B,I JMP STDFL GO WRITE IT * B20 OCT 20 B7000 OCT 7000 HED SPOOL MONITOR DRIVER COMPLETION SECTION CS43 NOP JSB EXEQT LDA EQT11,I AND B7000 ISOLATE THE RETURN VECTOR STA B ˜ ������þú STASH IT IN B XOR EQT11,I CLEAR IT IN EQT 11 STA EQT11,I AND RESET IT ASR 9 PUT VECTOR IN LOW B LDA EQT4,I WHERE DID WE COME FROM? ALF RAL,CLE,SLA,ERA JMP TMOUT TIME OUT INTERRUPT. * LDA EQT1,I CHECK IF PROCESSING A SYSTEM CLEAR SSA IF SO THEN CLB SET UP TO FOURCE A COMPLETION RETURN LDA EQT21,I RETURN FROM EXTND. ADB XTAB INDEX INTO TRANSFER TABLE JMP B,I RETURN TO CALLING FUNCTION * * XTAB DEF *+1,I EXTEND RETURN TRANSFER TABLE DEF CS43,I 0 INITIALIZE DEF CS43,I 1 SHOULD NEVER HAPPEN DEF CS43,I 2 SHOULD NEVER HAPPEN DEF RLP1 3 CHECK AND RETURN TO READ DEF BS10 4 CONTINUE BACKSPACE DEF RW2 5 CONTINUE RWIND. * RLP1 CPA N1 EXTEND ERROR? CCB,RSS YES - FAKE EOF. JMP XCOR NO - NORMAL CONTINUE. * LDA EQT17,I RESTORE THE ORGIONAL ASL 8 FILE POSITION STB EQT19,I ALF,ALF STA EQT21,I LDA EQT16,I STA EQT18,I LDB EQT6,I GET THE REQUEST CODE RBR,SLB IF WRITE OR CONTROL CLB,RSS SKIP JMP ERN5 READ SEND ERROR -5 * STB EQT8,I SET LENGTH TO ZERO JSB GETRD SET TO WRITE LDA N2 SET A -2 EOF MARK STA SAVE,I IN THE FILE JMP WR2 GO COMPLETE IT * * N2 DEC -2 * * TMOUT ALF,ALF ALF STA EQT4,I RESTORE EQT4 WITH TIME OUT BIT CLEARED ADB XTTAB INDEX INTO TIME OUT TRANSFER TABLE JMP B,I AND DISPATCH THE TIME OUT * * XTTAB DEF *+1,I TIME OUT VECTOR TABLE DEF POST 0 POST WAIT FOR XSIO CALL DEF CSPT 1 WAKE UP SPOUT RETURN DEF INC0 2 INCOR ROUTINE WAIT DEF RDEXT 3 READ EXTENT DEF BS13 4 BACKSPACE PROCESSOR DEF RWIND 5 REWIND * * * * BUFFERS FORug���r��pl PACKING. * * NOTE: THE BUFFER PUSHING ALGORITHMS WILL * HANDLE A LARGER NUMBER OF BUFFERS. * BUFS OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT # OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTR #. BSS 128 BUFFER AREA DEC -1 MARKS END OF BUFFERS. A EQU 0 B EQU 1 END IS43 ����������������������������������������������������������������������������������������������������������������º¢r������ÿÿ����� ���� ÿý�,�D ���������ÿ��92067-18353 1903� S C0122 �&EXTND � � � � � � � � � � � � � �H0101 Œ�����þúASMB,R,Q,C ASSEMBLE STATEMENT FOR RTE IV-B *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II HED EXTND ROUTINE * NAME: EXTND * SOURCE: 92067-18353 * RELOC: 92067-16350 * PGMR: A.M.G. * RTE 4: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EXTND,129,10 92067-16350 REV.1903 781030 * SUP EXT $SPCL * EXT EXEC,RMPAR,$LIBR,$LIBX EXT $PVCN,$CIC,$YCIC * FUNC BSS 1 EQTAD BSS 1 ETYPE BSS 5 SP.CL NOP * EXTND JSB RMPAR DEF *+2 DEF FUNC LDA FUNC SZA INITIALIZE CALL FROM GASP? JMP EXTN2 NO. * TERM JSB EXEC TERMINATE EXECUTION. DEF *+2 DEF D6 * EXTN2 SSA JMP EXTN3 MUST CALL UP SPOUT. * * GET A FILE EXTENSION * LDA EQTAD GET EQT ADDRESS AND ADA D12 INDEX TO EQT EXTENSION. LDA 0,I ADA D4 GET CURRENT EXTENSION # (EQT20) LDB 0,I AND INCREMENT IT. INB STB TEMP6 ADA D7 PICK UP DIRECTORY ADDRESS STA DIRCT OF MASTER ENTRY. INA (EQT27 AND EQT28) STA DIRCT+1 CCA,CCE IS NEW EXTENT NUMBER CPB D256 GREATER THAN 256? JMP EXTN4 YES - TAKE ERROR PATH. * LDA ETYPE SET OVERRIDE BIT RAL,ERA STA ETYPE AND SET IT DOWN JSB EXEC CALL D.RTR TO GET DEF *+8 AN EXTENSION. DEF D23 DEF FMDR DEF 1717B DEF ETYPE EXTENSION TYPE --- READ OR WRITE DIRCT BSS 2 DEF TEMP6 EXTENSION # JSB RMPAR GET PARAMETERS•������þú BACK DEF *+2 FROM D.RTR. DEF TEMP1 LDA TEMP1 EXTN4 JSB $LIBR NOP LDB DIRCT ADB M6 SSA,RSS ERRORS? JMP OK NO. CCA YES - PUT NEGATIVE # IN EQT21. STA 1,I JMP EXTNO GET OUT OF HERE. OK LDA TEMP5 PUT BEGINNING SECTOR AND B377 IN EQT21. STA 1,I ADB D4 ALSO IN EQT25. STA 1,I ADB M1 PUT BEGINNING TRACK # LDA TEMP4 IN EQT24. STA 1,I ADB M6 ALSO IN EQT18. STA 1,I INB INB LDA TEMP6 SAVE NEW STA 1,I EXTENSION # (EQT20). * * SET UP TO INTERRUPT DVS43. * EXTNO LDA RETPT SAVE RETURN POINT. STA $CIC CLA STA $PVCN CLEAR PRIVILEGED COUNTER. LDB EQTAD INDEX THROUGH EQT TO THE ADB D3 SELECT CODE AND LOAD IT. LDA 1,I AND B77 FAKE THE INTERRUPT TO THE SJP $YCIC DRIVER TO TELL IT WE ARE RETPT DEF TERM DONE. * EXTN3 LDA $SPCL GET CLASS ID FOR SPOUT STA SP.CL SAVE TO USE IN EXEC CALL JSB EXEC HAVE A REQUEST FROM SMD DEF *+8 TO CALL SPOUT BACK AND DEF D18 PASS IT THE SAVE CLASS DEF ZERO PARAMETERS. DEF ZERO DEF ZERO DEF EQTAD CLASS PARAMETERS PASSED DEF ETYPE FROM SPOUT TO SMD EQT. DEF SP.CL SPOUT CLASS ID. JMP TERM RETURN. * * STORAGE * XEQT EQU 1720B D6 DEC 6 TEMP1 EQU ETYPE TEMP2 EQU ETYPE+1 TEMP3 EQU ETYPE+2 TEMP4 EQU ETYPE+3 TEMP5 EQU ETYPE+4 TEMP6 EQU FUNC ZERO DEC 0 B77 OCT 77 B377 OCT 377 D3 DEC 3 D4 DEC 4 D7 DEC 7 D12 DEC 12 D18 DEC 18 D23 DEC 23 D256 DEC 256 M1 DEC -1 M4 DEC -4 M5 DEC -5 M6 DEC -6 FMDR ASC 3,D.RTR * END EXTND ����������������������������������������������������������������������������������������������������������������¸›�������� ������������� �������ÿÿ����� ���� ÿý�-�5 ���������ÿ��92067-18354 1903� S C0122 �&JOB � � � � � � � � � � � � � �H0101 V\�����þúASMB,Q,C HED JOB ROUTINE * NAME: JOB * SOURCE: 92067-18354 * RELOC: 92067-16350 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM JOB,130,30 92067-16350 REV. 1903 790529 SUP * EXT EXEC SYSTEM CALLS EXT RMPAR PARAMETER RETRIEVAL EXT OPEN FILE MANAGER OPEN EXT READF FILE MANAGER READ EXT WRITF FILE MANAGER WRITE EXT CLOSE FILE MANAGER CLOSE FILE EXT REIO REENTRANT I/O ROUTINE EXT .DRCT PICK UP DIRECT ADDRESS EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFER EXT .DFER MOVE THREE WORDS ROUTINE EXT LURQ LOCK LU ROUTINE EXT SPOPN SPOOL OPEN ROUTINE EXT $LUAV SPOOL LU TABLE EXT NAMR PARSE ROUTINE FOR NAMERS EXT IFTTY INTERACTIVE TEST FUNCTION EXT .UACT ROUTINE TO CONVERT USER NAME TO ACCT# EXT OVRD. OVERRIDE FLAG EXT .CACT ROUTINE TO GET CURRENT USER ACCT# EXT $SPCR JOBFIL DISC CR (-LU) EXT LOGLU LOG LU FINDER EXT KHAR CHARACTER PUSHERS-GET EXT SETDB CHARACTER PUSHERS-SET DESTINATION EXT SETSB CHARACTER PUSHERS-SET SOURCE EXT CPUT CHARACTER PUSHERS-PUT CHAR. * IDCB BSS 144 ONBF BSS 4 DO NOT REARRANGE THESE BUFFERS COMND BSS 16 BUFR BSS 41 BUFR2 BSS 17 SAVE BSS 1 SAVE1 BSS 1 RECNO BSS 1 RECNT BSS 1 FILNO BSS 1 SPLU BSS 1 IBUFL BSS 1 BUFL1 BSS 1 OLU OCT 401 * ORG IDCB PUT INIT CODE IN BUFFERS * BEM JSB RMPAR RETRIEVE PAR‚������þúAMETERS. DEF *+2 DEF COMND+5 JSB LOGLU FETCH THE LOG LU DEF *+2 DEF OLU STA OLU SET THE DEFAULT LOG LU LDA COMND+5 IS FIRST PARAMETER ASCII? SSA OR NEGATIVE JMP BEN2 FORGET INTERACTIVE SET UP * ADA CCOMP SSA,RSS JMP BEN2 YES. * LDA COMND+5 GET INPUT DEVICE LU. SZA,RSS MAKE DEVICE 5 THE DEFAULT. LDA D5 IOR CNWD STA CONWD ADA B200 FORM DYNAMIC STATUS COMMAND WORD STA DYSTA SAVE IT JSB IFTTY CHECK IF INTERACTIVE DEF INTYS DEVICE DEF CONWD INTYS LDB CONWD PRESET B FOR INTERACTIVE INTY0 SSA,RSS IF NEGATIVE THEN INTERACTIVE JMP BEM1 NOT INTERACTIVE CONTINUE * INT STB OLU SET AS OUTPUT LU TOO CLA STA RDREC SET TO PROMPT JMP BEN2 SKIP THE LU LOCK IF INTERACTIVE * BEM1 JSB LURQ LOCK THE LU IF NOT INTERACTIVE DEF BEN2 DEF D1 LOCK WITH WAIT DEF CONWD THIS LU DEF D1 ONLY ONE OF THEM BEN2 CLA STA EOJSW CLEAR EOJ SWITCH. JSB EXEC FETCH THE TURN ON STRING DEF SRTN DEF D14 DEF D1 READ IT DEF BUFR TO THE INPUT BUFFER DEF BUFLN SRTN STB IBUFL IBUFL IS THE INPUT LENGTH IN + CHAR. CMB,CCE,INB AND STB BUFL1 BUFL1 IS THE INPUT LENGTH IN - CHAR. LDA OVRD. SAVE THE OLD OVERRIDE FLAG STA OVRD AND RAL,ERA SET THE SIGN BIT ON IT STA OVRD. SET THE NEW FLAG FOR CLEAN UP JMP OPFL3 GET OUT OF DCB FOR OPEN * TST0 EQU COMND+10-* ERROR MEANS WE ARE ABOUT TO OVERLAY * ORG BUFR2 SKIP OVER THE RU PRAMS * OPFL3 XLA $SPCR GET THE JOB FILE CR SPCR STA SPCR SAVE IT HERE OPFL4 JSB OPEN OPEN JOBFIL DEF *+7 DEF IDCB DEF IERR DEF JOBFL DEF IOPTN DEF ISECU ˆŸ������þú DEF SPCR SPOOL DISC CPA N8 DID WE SUCCEED? JMP OPFL4 KEEP TRYING. * JSB JOBFE OPEN ERROR. RING BELLS. * LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA BUFR2 SAVE JOBFIL RN. STA JRN LDA BUFR2+14 SAVE RN FOR HOLDING INSPOOLING. STA WRN LDA BUFR2+1 STA RECNT SAVE RECORD COUNT. JMP CLEAN SKIP OUT OF BUFFERS ORR BACK TO STD. CORE * * THE FOLLOWING CODE CLEANS UP AFTER THIS PROGRAM IF IT WAS * ABORTED WHILE DOING AN INSPOOL. * * TO CLEAN UP WE MUST: * * 1. CALL SMP TO KILL THE SPOOL POOL FILE (CLEANS UP SMP'S RECORDS) * 2. OPEN AND CLOSE THE POOL FILE PURGING EXTENTS (GET BACK DISC) * 3. CLEAR THE BIT MAP BIT THAT SAYS THE FILE IS ASSIGNED * 4. CLEAR THE JOBFILE RECORD(RETURN IT TO POOL) * 5. CLEAR THE FLAGS IN JOBFIL RECORD 17 THAT SAY THESE THINGS * MUST BE DONE * * THIS CODE IS DONE IN SUCH AN ORDER THAT NO MORE HARM IS DONE * IF IT IS ABORTED AT ANY TIME SO WATCH OUT DON'T REARRANGE IT. * * YES I KNOW IT WOULD BE FASTER AND TAKE LESS CODE BUT WE NEED * FAIL SAFE OPERATION HERE. * * FLAGS KEPT IN REC 17 TO HELP: * * WORD 10 SPLCON REC # OF SPOOL CON ENTRY (SAFE EVEN AFTER REBOOT) * WORD 11 WORD ADDRESS OF BIT MAP BIT TO CLEAR * WORD 12 BIT TO CLEAR IN SPOOL POOL BIT MAP * WORD 13 JOBFIL RECORD NUMBER OF RECORD TO CLEAR * CLEAN JSB LKRNP POST AND LOCK THE RN LDA D17 GET A CLEAN JSB GTREC RECORD 17 LDB BUFR2+10 GET THE SPLCON RECORD NUMBER IF ONE SZB,RSS IS THEIR? JMP NOSP NO SKIP SMP CALL * JSB CLRN CLEAR RN FOR SMP JSB EXEC CALL SMP TO CLEAN UP ITS RECORDS DEF *+5 DEF D23 DEF SMPA DEF D13 KILL CODE DEF BUFR2+10 RECORD NUMBER JSB LKRNP POST AND LOCK THE RN LDA D17 GET THE RECORD AGAINÊ������þú JSB GTREC CLB CLEAR FLAG TO SHOW STB BUFR2+10 WE HAVE CALLED JSB WRTRC WRITE IT AND JSB POST1 MAKE SURE IT GETS TO THE DISC NOSP LDA BUFR2+13 NOW GO GET THE SZA,RSS JOB RECORD IF ONE JMP NJREC NO JOB RECORD SKIP RELEASE * JSB GTREC GET THE RECORD JSB OPEN OPEN THE SPOOL FILE DEF *+7 DEF JDCB DEF IERR DEF BUFR2+3 NAM FROM JOBREC DEF ZERO EXCLUSIVE OPEN DEF ISECU SAME SECURITY CODE DEF BUFR2+6 CARTRIDGE JSB CLOSE CLOSE IT AND TRUNCATE EXTENTS DEF *+4 DEF JDCB DEF IERR DEF N8 NEGATIVE NO TO PURGE EXTENTS * CCA STILL HAVE JOB RECORD AND RN LOCK STA BUFR2 CLEAR USAGE FLAG JSB WRTRC WRITE IT OUT LDA D17 NOW RETRIEVE JSB GTREC RECORD 17 CLA CLEAR THE RECORD FLAG STA BUFR2+13 NJREC LDB BUFR2+11 GET THE OFFSET TO SZB,RSS THE BIT MAP JMP NBITS NONE * ADB DBUF INDEX TO THE WORD LDA BUFR2+12 GET THE BIT TO BE CLEARED CMA CHANGE TO AND MASK AND B,I CLEAR THE BIT STA B,I SET IT BACK CLA STA BUFR2+11 CLEAR THE PRESENTS FLAG NBITS JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN * * END OF CLEAN UP CODE * LDA COMND+5 IS THE FIRST PARAMETER SSA NEGATIVE?? JMP TERM YES CALL WAS TO CLEAN UP ONLY * ADA CCOMP AN ASCII PARAMETER? SSA IF SO, TREAT AS A JMP RDREC SIMULATED XEQ. * LDB IBUFL RESTORE THE TLOG STRTN SZB,RSS IF NO STRING JMP TERM JUST EXIT * CLA,INA SET UP THE INITIAL CHAR. POS FOR NAMR STA CHPOS AND JSB IN SKIP OVER THE RU, JSB IN AND THE JOB, JSB IN AND GET THE FILE NAME ;������þúJSB XEQQ DO XEQ THING JMP TERM GO EXIT * * RDREC JMP NACT IF NOT INTERACTIVE JUMP * JSB EXEC ELSE SEND A DEF NACT ";" DEF NWWC WRITE REQUEST DEF OLU AS A PROMPT DEF SCOL DEF N2 NACT NOP IGNORE ERRORS. JSB REIO READ A CARD (OR TAPE LINE). DEF *+5 DEF RCODE DEF CONWD DBUFR DEF BUFR DEF BUFLN STB IBUFL CMB,INB STB BUFL1 STA STAT SAVE STATUS WORD. STA LASTH CLEAR LAST HOLD FLAG RAL,CLE,ELA MOVE DOWN BIT TO E REG. ALF,RAL MOVE EOF BIT TO SIGN RAL POSITION. SSA JMP EOF EOF CONDITION. * SZB ZERO LENGTH? JMP PRS NO - NORMAL RECORD. * AND B70 IF DEVICE TYPE < 10 OR SEZ,CCE,SZA DEVICE NOT DOWN, THEN EOF. JMP NACT ELSE RETRY THE READ. * JMP EOF * WRIT NOP WRITE A RECORD ROUTINE JSB REIO WRITE THE CARD TO CURRENT SPOOL FILE. DEF *+5 DEF NWWC DEF ICNWD DEF BUFR DEF BUFL1 JMP IOER ERROR CONDITION - FLUSH THE JOB. * JSB TSTEX TEST EXTENT OVERFLOW JMP WRIT,I OK EXIT * JMP WRIT+1 TRY AGAIN IF NEEDED * IOER JSB ERMS ERROR ON WRITE TO THE SPOOL FILE DEF WRITE SO REPORT IT JSB JERR JERR DOES NOT RETURN ON ERROR WRITE ASC 3,WRITE DYSTA NOP N8 DEC -8 CHPOS NOP OPPS ASC 2,OOPS * PRS LDA BUFR AND C377 CPA COLON IS THIS A BM COMMAND CARD? JMP PRCOM YES. PARSE IT. * OTHER CLA CPA EOJSW ARE WE READING IN A JOB? JMP RDREC NO. IGNORE THE CARD. * WRREC JSB WRIT WRITE THE CARD TO CURRENT SPOOL FILE. * LDA STAT HAVE WE AN EOF ALF,ALF CONDITION? SSA,RSS JMP RDREC NO - GO READ NEXT CARD. * AND B77 YES - IS THIS ‹›������þúA PT READER? CPA RCODE RSS YES - DO AN EOF. JMP RDREC * JSB WAITM WRITE OUT A MESSAGE ASC 3,PT D7 DEC 7 MESSAGE LENGTH JSB EXEC NOW PAUSE UNTIL DEF CONT THE OPERATOR PUTS DEF D7 THE NEXT TAPE IN THE DEF ZERO AND SETS JOB GOING DEF RCODE AGAIN. CONT JMP RDREC LOOK FOR MORE INPUT. * TSTEX NOP TEST FOR EXTENT OVERFLOW ALF,ALF GET EOF BIT TO SIGN SSA,RSS EOF SET? JMP TSTEX,I NO RETURN OK * JSB EXEC CAN USE EXEC CALL BECAUSE DEF *+3 THIS CALL JUST REMOVES THE EOF STATUS DEF D3 DEF BSCWD BACK SPACE TO BE READY TO RETRY * LDA LASTH HAVE WE ALREADY SENT THE MESSAGE? SZA,RSS JMP WEXT YES JUST WAIT * CLA SET FLAG TO SHOW ALREADY SENDT STA LASTH JSB WAITM SEND THE EXTENT WAIT MESSAGE ASC 3,EXTENT B11 OCT 11 9 WORDS * WEXT JSB WAIT WAIT FOR THE RN ISZ TSTEX TRY AGAIN JMP TSTEX,I EXIT IS P+2 * EOF LDA EOJSW HOPPER EMPTY OR EOT. SZA,RSS JMP TERM TERMINATE IF NOT READING A JOB. * CLA * STA BUFL1 WRITE 0 LENGTH RECORD. JMP WRREC * TERM JSB CLOSE DEF *+4 DEF IDCB DEF IERR DEF ZERO CLA,INA CLEAR JOBFIL RN IF NECESSARY. CPA JSTAT RSS JSB CLRN JSB EXEC TERMINATE THE BEM. DEF *+2 DEF D6 * * PRCOM LDA DBUFR LDA D2 SKIP ":" STA CHPOS IN THE INPUT LINE JSB IN PARSE FIRST PRAM SSA IF END OF LINE FOUND JMP OTHER FORGET THE WHOLE THING * LDA COMND GET THE COMAND CPA "EO" SO WHAT DO WE HAVE?? JMP EOJCD :EOJ * CPA "XE" JMP XEQ :XEQ * CPA "JO" RSS JMP OTHER * CLA ‚������þú :JOB CPA EOJSW JMP OPFIL *+2 * JSB EOJ CLOSE LAST SPOOLFILE. OPFIL JSB LKRNP JSB JSRCH FIND A JOB RECORD LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA N5 STA BUFR2+9 TRY TO FIND AN AVAILABLE LDA WD4AD STA CLRN CLA,INA SPOOL FILE STA FILNO CLB,INB CCA STA CLEAR OLOOP LDA N16 STA BUFR2+11 ILOOP LDA CLRN,I AND B SZA,RSS JMP HAVIT * NOT1 RBL ISZ FILNO ISZ BUFR2+11 JMP ILOOP * ISZ CLRN ISZ BUFR2+9 JMP OLOOP * JSB POST1 NOHAV JSB CLRN WAIT UNTIL THERE IS AN JSB HLDIN AVAILABLE SPOOL FILE. JMP OPFIL * D10 DEC 10 "00" ASC 1,00 D3 DEC 3 SVBIT NOP * HAVIT ISZ CLEAR TEST IF FIRST AVAILABLE FILE RSS IF SECOND SKIP TO USE IT JMP NOT1 DO NOT USE FIRST ONE (LEAVE FOR OUT SPOOL) * LDA FILNO SET UP THE SPOOL USAGE FLAG CMA,INA DIVISION OF FILE # BY 16. ADA BUFR2+2 IS FILNO > # OF SPOOL SSA POOL FILES? JMP NOHAV YES - NO GOOD. * LDA CLRN,I NO - OK. XOR B FIX AVAILABILITY BITS. STB SVBIT SAVE BIT FOR REC 17 STA SAVFL SAVE THE NEW WORD LDA D18 HAVE AN AVAILABLE SPOOL FILE. JSB GTREC GET JOBFIL RECORD 18. CLB SET UP FOR DIVIDE LDA FILNO CONVERT THE FILE NUMBER TO ASCII DIV D10 ALF,ALF A HAS HIGH ORDER, B LOW ADA B ADA "00" ADD THE ASC '00' STA SAVE1 LDA BUFAD FIND THE LOCATION INFORMATION STA SAVE FOR THE FILE. RANGE LDA SAVE,I ALF,ALF ADA SAVE,I AND B377 CMA,INA ADA FILNO ISZ SAVE SSA JMP *+3 * ISZ SAVE JMP RANGE * LDA SAVE,I STA SAVE LDA DBUF2 JSB CLEAR È\������þú LDA SAVE STA BUFR2+6 SAVE DISC LABEL. LDA SAVE1 STA BUFR2+5 LDA SPOL STA BUFR2+3 SAVE FIRST PART OF FILE NAME. LDA SPOL+1 STA BUFR2+4 LDB "I" FINISH SETTING UP THE JOBFIL JSB FJOBF ENTRY. JMP RDREC ERROR FLUSH THE JOB JSB .DRCT DEF COMND JSB CLEAR JSB .DFER FORM THE BUFFER TO PASS DEF COMND+2 TO THE SMP. DEF BUFR2+3 MOVE JOB LOCATION. LDA BUFR2+6 STA COMND+6 CARTRIDGE ID. LDA ISECU STA COMND+5 SECURITY CODE. LDA DFLAG STA COMND+8 DISPOSITION FLAGS. CCE SET UP E FOR RECNO LDA RECNO JOBFIL RECD. # OF JOB. STA NUM SET THE RECORD NUMBER FOR WRITE RAL,ERA SET SIGN BIT TO FLAG AS A JOB SPOOL STA COMND+11 JSB WRTRC SET UP TO UPDATE LDA D17 RECORD 17 JSB GTREC AND LDA RECNO SET THE IN STA BUFR2+13 PROCESS FLAG LDA SAVFL SET THE SPOOL FILE STA CLRN,I IN USE FLAG LDA SVBIT GET THE BIT POSITION STA BUFR2+12 SET IT LDA DBUF COMPUTE THE BUFFER OFFSET CMA,INA TO THE BIT ADA CLRN AND STA BUFR2+11 SET THAT JSB WRTRC AND WRITE THE RECORD JSB CLRNP POST AND UNLOCK THE FILE * STUP2 CLA STA COMND+7 DRIVER TYPE. JSB SPOPN CALL TO OPEN THE SPOOL FILE DEF *+3 RETURN DEF COMND SET UP BUFFER DEF SPLU THE LU LDA SPLU GET THE LU THAT IS PASSED BACK SSA,RSS WAS SETUP SUCCESSFUL? JMP STUP1 YES, GO DO IT * JSB HLDIN NO WAIT UNTIL AN LU OR SUCH JMP STUP2 FREES UP. SMP WILL CALL BACK. * STUP1 STA EOJSW STA ICNWD SET CONTROL WORD FOR WRITES. ADA B200 SET UP A BACKSPACE STA BSCWD FOR EXTENT PROBLEMS JSB LKRNP LOCK UP THE JOB FILE LDA D17 n;������þú AND GET THE JOB RECORD JSB GTREC AGAIN JSB .DRCT GET THE LU FROM DEF $LUAV THE LU TABLE LDB A,I GET LENGTH STB CLRN SET FOR COUNT NXTLU INA STEP TO LU LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER RBL,CLE,ERB CLEAR SIGN IF SET CPB SPLU THIS THE LU? JMP FSPLU YES GO SET UP * ISZ CLRN STEP COUNT JMP NXTLU TRY NEXT ONE * DLD OOPS SET UP THE MESSAGE JSB FMPER DEF INCK INCK ASC 3,CHECK OOPS ASC 2,OOPS * FSPLU LDA A,I GET THE RECORD NUMBER STA BUFR2+10 SET IN THE JOB FILE REC 17 JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN JMP WRREC GO WRITE OUT THE JOB CARD. * SAVFL NOP BSCWD NOP B200 OCT 200 * WAIT NOP JSB RNRQ LOCK THE WAIT RN GLOBALLY. DEF *+4 WHEN A CONDITION IN SMP DEF D2 FREES AN LU OR A FILE OR DEF WRN A FULL OUTSPOOL QUEUE, SMP DEF SAVE CLEARS THIS RN SO THAT OTHER JSB RNRQ PROGRAMS CAN CONTINUE. DEF *+4 DEF D6 DEF WRN LOCK THE RN. DEF SAVE JMP WAIT,I * HLDIN NOP LDA HLDIN GET ADDRESS OF LAST CALL CPA LASTH SAME?? JMP HLD1 YES DON'T RESEND THE MESSAGE * STA LASTH NO SET NEW ADDRESS AND SEND THE MESSAGE JSB WAITM SEND WAIT ON SPOOL RESOURCE MESSAGE ASC 3,SPOOL D13 DEC 13 HLD1 JSB WAIT WAIT FOR IT JMP HLDIN,I RETURN * WAITM NOP MESSAGE FIXER AND SENDER JSB .DFER FIX UP THE MESSAGE DEF MES MOVE IN THE 3 WORDS DEF WAITM,I STA WAITM SET THE ADDRESS OF THE LENGTH JSB EXEC DEF *+5 DEF D2 DEF OLU DEF RESWT DEF WAITM,I ISZ WAITM ADVANCE THE RETURN ADDRESS AND JMP WAITM,I RETURN * LASTH NOP ADDRESh™������þúS OF LAST HOLD * XEQ CLA CPA EOJSW IF THERE IS A JOB SPOOL RSS NOT COMPLETED, THEN END IT. JSB EOJ JSB IN PARSE THE JOB FILE NAME JSB XEQQ DO XEQ THING JMP RDREC GO GET NEXT RECORD * COMN2 BSS 10 XEPR NOP OVRD NOP SPACE TO SAVE THE OVERRIDE FLAG * * XEQQ SUBROUTINE * * THIS SUBROUTINE FINISHES THE ENTRY OF XE COMMANDS EITHER FROM * ':XE,NAMR,PRIORITY' OR FROM 'RU,JOB,NAMR,PRIORITY' * * ASSUMPTIONS: * * 1. FILE NAMR IS PARSED IN COMND BUFFER * 2. NEXT CALL TO NAMR WILL GET THE JOB PRIORITY. * * ACTION: * *1. THE JOB FILE NAME IS ENTERED IN THE JOB RECORD THEN *2. THE JOB FILE IS OPENED AND THE DISC ADDRESS IS TAKEN FROM THE DCB *3. THE JOB CARD (MUST BE FIRST CARD) IS READ AND THE USER ID IS * USED BY THE ROUTINE FJOBF TO FINISH THE JOB RECORD *4. THE JOB RECORD IS ENTERED IN THE JOB FILE AND QUEUED FOR EXECUTION * XEQQ NOP XEQ SUBROUTINE - ENTER AFTER PARSE OF FILE LDA DBUF2 CLEAR THE JOB SET UP BUFFER JSB CLEAR JSB IN2 INPUT THE PRIORITY INFO LDA COMN2 AND STA XEPR SET IT IN THE TEMP JSB .DFER MOVE IN THE JOB'S FILE NAME DEF BUFR2+3 DEF COMND FROM THE COMAND BUFFER LDA COMND+3 CHECK IF THE NAME AND D3 IS REALLY AND LU CPA D1 IF SO JMP XELU GO HANDLE IT * LDA OVRD RESTORE THE OVERRIDE FLAG FOR STA OVRD. USER ACCESS JSB OPEN ELSE OPEN THE JOB FILE DEF XEOPN DEF JDCB DEF IERR DEF COMND DEF D1 DEF COMND+4 DEF COMND+5 XEOPN LDB OVRD SET UP THE OVERRIDE FLAG FOR JOBFIL AGAIN CCE RBL,ERB STB OVRD. JSB FMPER CHECK FOR ERRORS DEF COMND (NO RETURN IF ERROR) LDA JDCB PICK UP THE DISC LU FROM THE DCB ********************** AND B77 ISs������þúOLATE IT AND CMA,INA SET UP AS THE CR FOR STA BUFR2+6 THE JOB FILE JSB READF READ THE JOB CARD TO DEF *+6 A LOCAL BUFFER DEF JDCB DEF IERR DEF BUFR DEF D40 DEF IBUFL LDB IBUFL SET UP THE CHAR. COUNTERS RBL FOR NAMR AND STB IBUFL AND ECHO ROUTINES CMB,INB STB BUFL1 JSB FMPER TEST FOR READ ERRORS DEF COMND ADDRESS OF THE FILE NAME JSB CLOSE WE HAVE ALL WE WANT FROM THE FILE SO DEF *+2 CLOSE IT DJDCB DEF JDCB LDA BUFR CHECK TO BE SURE THE LINE STARTS WITH A ':' AND C377 CPA COLON WELL?? CLA,INA,RSS YES OK JMP JO? NO GO TELL IT ON THE MOUNTAIN * INA SET TO SKIP THE ':' STA CHPOS SET UP THE CHAR POINTER FOR NAMR JSB IN2 AND PARSE THE JOB CARD SSA END OF LINE? JMP JO? TO BAD GO FLUSH OUT AN ERROR * LDA COMN2 IF A JOB CPA "JO" CARD RSS WAS READ JMP JO? NO - REPORT ERROR * XELUS LDB "R" SET THE JOB STATUS IN B AND JSB FJOBF GO FINISH THE JOB ENTRY RECORD JMP XEQQ,I ERROR - EXIT WITH OUT Q * JSB JSRCH SEARCH FOR A PLACE TO PUT THIS. JSB QUEUE PUT THE JOB IN THE QUEUE JMP XEQQ,I RETURN * * XELU JSB .CACT HERE IF XE COMMAND TO AN LU SZA,RSS IF NOT IN SESSION AND JMP XELUE SESSION MONITOR INSTALLED ERROR * CLA SET UP TO FOURCE STA IBUFL NAMR TO RETURN INA STA CHPOS *** ZIP*** JMP XELUS AND GO ENTER THE JOB * XELUE JSB BGMS SEND MESSAGE DEF "ESS" '/JOB: ERROR NOT IN SESSION' ASC 4,IN SNOT (THIS IS SORTED BY MS) JMP XEQQ,I RETURN * "ESS" ASC 3,ESSION * JO? DLD "JO?" SEND MESSAGE JSB ERMS '/JOB: EROR :JO? ON FILE XXXXX' DEF CO(+������þúMND ADDRESS OF FILE NAME JMP XEQQ,I RETURN * "JO?" ASC 2,:JO? * EOJCD CLA CPA EOJSW JMP RDREC * JSB WRIT WRITE THE EOJ RECORD JSB EOJP PROCESS THE EOJ JSB EXEC DO DYNAMIC STATUS DEF RTNST DEF D3I DEF DYSTA JMP RDREC IGNOR REJECT * RTNST ALF,ALF RAL,RAL HOPPER EMPTY? SSA,RSS JMP RDREC NO CONTINUE * RAR,RAR ISOLATE DRIVER TYPE AND B73 CPA B11 CARD READER? (CHECKS 11 OR 15) JMP TERM YES - TERMINATE. * JMP RDREC NO CONTINUE * B73 OCT 73 N5 DEC -5 D3I OCT 100003 * EOJ NOP JSB REIO PUT AN ":EOJ" IN THE BUFFER TO BE DEF *+5 DEF WCODE DEF ICNWD DEF EOJC DEF D2 JSB TSTEX TEST FOR EXTENT OVERFLOW RSS NO CONTINUE JMP EOJ+1 YES TRY AGAIN * JSB EOJP PROCESS THE EOJ JMP EOJ,I RETURN * EOJP NOP EOJ COMMON PROCESSOR JSB EXEC SCHEDULE THE SMP TO CLOSE THE DEF *+5 SPOOL FILE. PASS IT THE CLOSE DEF D23 CODE AND THE LU# OF THE SPOOL DEF SMPA DEF D4 DEF SPLU JSB LKRNP MAKE SURE BUFFER IS CLEAR LDA RECNO JSB GTREC GET APPROPRIATE JOBFIL RECORD. LDA BUFR2+2 GET THE STATUS AND B377 IN CASE GASP HAS BEEN HERE CPA "H" NOW IN HOLD? LDA "RH" YES MAKE "RH" CPA "I" WHAT IT SHOULD BE? LDA "R" YES SET "R" STA BUFR2+2 JSB QUEUE WRITE OUT AND Q THE JOBFIL RECORD. JSB LKRNP POST AND LOCK LDA D17 CLEAR THE INPUT IN PROGRESS JSB GTREC FLAG IN CLA RECORD STA BUFR2+10 STA BUFR2+11 STA BUFR2+12 17. STA BUFR2+13 JSB WRTRC SEND IT BACK TO THE DISC. JSB CLRNP UNLOCK THE FILE JMP EOJP,I RETURN Và������þú * * THE JOB Q IS KEPT IN THE FIRST 256 WORDS OF THE JOBFIL * THE FIRST WORD IS THE RN NUMBER TO LOCK THE SECOND WORD * IS A POINTER THE THE HEAD OF THE JOB Q BY PRIORITY * AND A POINTER THE THE NEXT JOB TO EXECUTE. THESE WILL * BE THE SAME WHEN NO JOBS ARE RUNING AND NONE ARE TO BE * PURGED. IF A JOB IS RUNING THE NEXT JOB POINTER WILL BE * ONE DOWN THE Q. IF JOBS ARE TO BE PURGED THEY WILL BE * IN THE Q BEFOR THE NEXT JOB. IF THE NEXT JOB POINTER IS * 0 THEN ALL JOBS IN THE Q ARE TO BE PURGED (OR THERE ARE * NO JOBS IN THE Q). * THIS WORD HAS THE NEXT JOB POINTER IN THE HIGH 8 BITS * AND THE HEAD OF THE Q IN THE LOW 8 BITS * * THESE POINTERS ARE OFFSETS INTO THE 256 WORDS OF JOB Q. * * THE JOB Q WORDS ALSO HAVE POINTERS IN THE LOW 8 BITS * TO THE NEXT JOB IN THE LIST AND THE JOBS PRIORITY IN THE * HIGH 8 BITS OF THE WORD. * QUEUE NOP WRITE OUT JOB RECORD AND QUEUE IT JSB WRTRC WRITE IT OUT LDA BUFR2+2 GET STATUS CPA "RH" IF HELD JMP QUEX JUST RETURN * LDA BUFR2 GET THE JOB'S PRIORITY ALF,ALF MOVE IT TO THE HIGH BYTE STA SAVE AND SAVE IT (NOTE LOW BYTE IS ZERO) LDA RECNO USE RECORD # TO CACULATE ADA N17 THE BUFFER ADDRESS OF THE JOB'S ADA DJDCB ENTRY IN THE JOB QUEUE STA PTRJB AND SAVE IT JSB QUSET SET UP TO READ THE JOB QUEUE QURD JSB READF READ THE JOB Q DEF *+7 DEF IDCB DEF IERR RDAD NOP DEF D16 DEF LEN DEF NUM JSB QUCHK TEST FOR ERRORS SET FOR NEXT READ JMP QURD READ 16 RECORDS (QUCHK SKIPS AFTER 16) * * WHOLE JOB Q IS NOW IN JDCB * LDA DJDCB SET POINTER TO INA HEAD OF THE LIST STA QUCUR QUCUR IS THE CURRENT HEAD LDA A,I GET THE HEAD OF THE LIST AND C377 GET THE NEXT POINTER ALF,ALF ROTATE T5R������þúO LOW AND STA QUNXT SAVE IT QUPUS LDA QUCUR,I START WITH THE HEAD AND B377 ISOLATE THE POINTER CPA QUNXT SKIP OVER ACTIVE OR TO BE PURGED ENTRIES JMP QUSHR FOUND END SO GO DO PRIORITY SEARCH * ADA DJDCB ELSE UP DATE THE POINTER STA QUCUR JMP QUPUS AROUND WE GO * QUSHR LDB BUFR2+2 GET JOB STATUS SZA IF ZERO THEN END OF LIST CPB "A" ALSO IF ACTIVE JMP QUHER SO QUEUE IT HERE * ADA DJDCB ELSE LOOK AT THE ENTRY LDB A,I GET THE CURRENT ENTRIES PRIORITY CMB,CLE NEGATE THE HIGH END ADB B400 ADD ONE IN HIGH HALF ADB SAVE COMPAIR PRIORITIES OF THE JOBS SEZ,RSS THIS THE SPOT?? JMP QUHER YES GO Q IT * STA QUCUR NO RUN DOWN ONE LEVEL LDA A,I GET THE NEXT ONE AND B377 ISOLATE IT JMP QUSHR GO TEST THIS ONE * QUHER CMA,INA,SZA GET OFFSET OF THE JOB (IF ZERO IT IS ZERO) ADA DJDCB SKIPS THIS IF END OF LIST CMA,INA A IS NOW THE OFFSET ADA SAVE ADD IN THE JOBS PRIORITY STA PTRJB,I SET THIS ENTRY IN THE Q LDA RECNO COMPUTE A POINTER ADA N17 TO THE NEW JOB XOR QUCUR,I AND FIX UP THE ENTRY AND B377 FOR THE JOB JUST XOR QUCUR,I BEFOR THE NEW ONE STA QUCUR,I UNDER THE RULES OF WOO. LDA PTRJB,I IF THE NEW ENTRY POINTS AT THE AND B377 SAME JOB AS THE NEXT FLAG LDB BUFR2+2 GET JOB STATUS CPA QUNXT THEN IT IS AT THE HEAD OF THE Q CPB "A" AND THE NEXT FLAG MUST BE UPDATED JMP QUFIN NO WE ARE OK AS IS (ALSO FOR "A") * LDA QUCUR,I GET THE POINTER FROM THE ENTRY ALF,ALF PUT IT IN THE RIGHT PART OF THE WORD XOR JDCB+1 MIRGE IT IN UNDER THE RULES OF WOO AND C377 DONT TRUST QUHED AS IT MAY HAVE CHANGED XOR JDCB+1 STA JDCB+1 SET Þ`������þúTHE NEW HEAD * QUFIN JSB QUSET SETUP TO WRITE IT OUT QUWRL JSB WRITF WRITE OUT A RECORD DEF *+6 DEF IDCB DEF IERR DEF RDAD,I DEF D16 DEF NUM JSB QUCHK CECK FOR ERRORS AND IF 16 DONE YET JMP QUWRL MORE TO DO * QUEX JSB POST1 POST THE FILE BUFFER. JSB CLRN CLA STA EOJSW JSB EXEC DEF *+4 SCHEDULE THE FILE MANAGER. DEF NWAIT DEF FLMAN DEF N5 JMP QUEUE,I * JMP QUEUE,I * B400 OCT 400 QUCUR NOP QUNXT NOP QUSET NOP ROUTINE TO SET UP TO READ THE JOB Q LDA N16 SET UP TO READ 16 RECORDS STA COUNT LDA DJDCB SET THE STARTING RECORD ADDRESS STA RDAD CLA,INA AND THE STARTING RECORD NUMBER STA NUM AND JMP QUSET,I RETURN * * QUCHK NOP ROUTINE TO CHECK FOR Q I/O COMPLETION LDA RDAD UPDATE THE RECORD ADDRESS ADA D16 BY THE RECORD SIZE STA RDAD ISZ NUM STEP THE RECORD NUMBER ISZ COUNT IF NOT YET DONE JMP QUCHK,I RETURN P+1 * ISZ QUCHK ELSE RETURN P+2 JMP QUCHK,I * * N17 DEC -17 PTRJB NOP OUCUR NOP OUNEX NOP N16 DEC -16 COUNT NOP "RH" ASC 1,RH "H" OCT 110 "I" OCT 111 "R" OCT 122 "A" OCT 101 * WRTRC NOP JSB WRITF DEF *+6 DEF IDCB DEF IERR DBUF2 DEF BUFR2 DEF D16 DEF NUM JSB JOBFE * JMP WRTRC,I * GTREC NOP STA NUM JSB READF DEF *+7 DEF IDCB DEF IERR DBUF DEF BUFR2 DEF D16 DEF LEN DEF NUM JSB JOBFE * JMP GTREC,I * LEN BSS 1 NUM BSS 1 * POST1 NOP JSB POST DEF *+2 DEF IDCB JMP POST1,I * CLRNP NOP JSB POST1 JSB CLRN JMP CLRNP,I * LKRNP NOP JSB POST1 JSB LKRN JMP LKRNP,I * CLa������þúRN NOP JSB RNRQ DEF *+4 DEF D4 DEF JRN DEF JSTAT JMP CLRN,I * LKRN NOP JSB RNRQ DEF *+4 DEF RCODE DEF JRN DEF JSTAT JMP LKRN,I * JSRCH NOP JSR1 JSB POST1 JSB LKRN LDA D18 SEARCH FOR FREE JOBFIL RECORD. JSR2 INA JSB GTRC2 LDA BUFR3 SSA,RSS JMP NOTYT * LDA NUM STA RECNO JMP JSRCH,I * NOTYT LDA NUM CPA RECNT RSS JMP JSR2 * JSB POST1 JSB CLRN NONE AVAILABLE. WAIT UNTIL JSB HLDIN THERE IS. JMP JSR1 * GTRC2 NOP READ TO BUFR3 ROUTINE LDB DBUF3 SET BUFFER ADDRESS STB DBUF IN GETREC CALL JSB GTREC USE GTREC TO DO THE READ LDB D2BUF RESTORE THE ADDRESS STB DBUF AND JMP GTRC2,I RETURN * D2BUF DEF BUFR2 DBUF3 DEF BUFR3 CLEAR NOP LDB N16 STB FJOBF CLB STB A,I INA ISZ FJOBF JMP *-3 * JMP CLEAR,I * * THE ROUTINE FJOBF WILL FILL OUT THE FOLLOWING JOB RECORD * FIELDS: * * PRORITY WORDS 0 AND 10 * ACCOUNT# WORD 1 * STATUS WORD 2 * NAME WORDS 7,8 AND 9 * * THE JOB LOCATION IS FILLED IN OUTSIDE OF THIS ROUTINE * * ASSUMPTIONS: * * 1. THE JOB RECORD IS SET UP SO THAT A CALL TO IN (OR IN2) * WILL PARSE THE JOB NAME NEXT * OR * 2. THE JOB IS DIRECT WHICH IMPLIES THAT THE NAME IS BLANK, * AND THE ACCOUNT IS THE CURRENT USERS. IN THIS CASE CALLS * TO PARSE SHOULD RETURN 'ZIP'. * * * FJOBF NOP STB BUFR2+2 SAVE THE STATUS IN THE JOB RECORD JSB IN PARSE THE JOB NAME LDA COMND+3 IF THERE IS NO NAME LDB DBLK THEN AND D3 SET UP TO USE BLANKS CPA D3 WELL IS THERE A NAME? LDB DCOMN YES SET UP TO MOVE IT STB FJSOR SET NAÈÉ������þúME SOURCE JSB .DFER MOVE IN THE JOB NAME DEF BUFR2+7 ADDRESS OF THE NAME FJSOR NOP ADDRESS OF THE SOURCE OF THE JOB NAME * JSB SETSB SET UP THE SOURCE BUFFER DEF *+4 DEF BUFR SAME AS THE 'IN' BUFFER DEF CHPOS EVEN TO CHAR POSITION DEF IBUFL JSB SETDB NOW SET THE DESTINATION DEF *+3 DEF ERMS2 USE ERROR MESSAGE BUFFER DEF CCOUN CHAR. COUNTER FOR DESTINATION CLA CLEAR STA CCOUN THE DESTINATION COUNT LPUSR LDA CCOUN PROTECT AGAINST GROSS CPA D40 ERRORS (MAX LEGAL IS 32 BUT WE HAVE BUFFER) JMP CSESS OVER FLOW PASS WHAT WE HAVE * NXCH JSB KHAR FETCH THE NEXT CHAR FROM THE STRING DEF *+2 DEF CH KEEP COPY FOR CPUT CPA BLANK IF BLANK JMP NXCH IGNOR IT * SZA IF END OF LINE OR CPA COMMA END OF PRAM THEN JMP CSESS GO CALL THE SESSION ROUTINE * JSB CPUT NONE OF THE ABOVE SO PUT IN DEF *+2 DESTINATION BUFFER DEF CH JMP LPUSR GO GET NEXT CHAR. * CSESS LDA CCOUN GET THE CHAR. COUNT SZA,RSS IF NONE THEN JMP FJNON USE DEFAULT * NOUSR JSB CPUT PAD WITH A BLANK IN CASE ODD DEF *+2 DEF BLANK LDA CCOUN RESTORE THE CHAR COUNT LDB DERM2 IN A AND THE CHAR. ADDRESS IN B JSB .UACT CALL THE SESSION MON. INTERFACE TO GET ACCT #. DERM2 DEF ERMS2 PASS ADDRESS OF THE ERROR BUFFER FJUAC SSA SEE IF IT RINGS TRUE CPA N1 IF POSITIVE OR SESSION NOT INSTALLED JMP FJUOK THEN USER IS OK. * * CPB B77 IF WE NEED A PASS WORD THEN INA LEAVE OFF THE TRAILINE LEFT ARROW ADA N12 ERROR IS IN BUFFER ADD LENGTH JSB WER OF PREAMBLE AND PRINT IT JMP FJOBE NOW TAKE ERROR EXIT * * FJNON JSB .CACT USER ID NOT SUPPLIED7h������þú USE SZA,RSS IF NOT IN SESSION THEN JMP NOUSR GO FOURCE A NO SUCH USER MESSAGE * JMP FJUAC THE CURRENT USERS ACCOUNT * DBLK DEF BLANK * FJUOK CPA N1 IF SESSION IS NOT THEN CLA SET ACCOUNT FLAG TO ZERO STA BUFR2+1 SET ACCOUNT # IN JOB REC. LDB XEPR IF PRIORITY IN XE COMMAND SZB THEN JMP FJPR GO USE IT * LDB DEFPR ELSE GET THE DEFAULT PRIORITY LDA COMND+3 AND D3 CHECK FOR A PRIORITY CPA D1 SUPPLIED WELL? LDB COMND YES PICK IT UP SZB,RSS IF IT IS ZERO INB SET IT TO 1 FJPR STB BUFR2 SET PRIORITY IN THE JOB RECORD CPA D3 IF CURRENT PRAM IS ASCII THEN GO NO FURTHER JMP FJSPR AND USE SAME PRIORITY FOR SPOOL * JSB IN ELSE TRY AGAIN LDA COMND+3 GET THE FLAG WORD AND D3 AND TEST FOR ASC LDB BUFR2 DEFAULT TO SAME AS JOB CPA D1 A NUMBER SUPPLIED? LDB COMND YES PICK IT SZB,RSS IF ZERO INB SET IT TO 1 FJSPR STB BUFR2+10 SET THE SPOOL PRIORITY LDA BUFR2 GET THE SUPPLIED JOB PRIORITY AND B377 ISOLATE THE LOW BITS SZA,RSS IF RESULT IS ZERO LDA B377 USE 255 STA BUFR2 AND SET THE PRIORITY ISZ FJOBF SET TO TAKE OK EXIT FJOBE DLD "ON" RESTORE THE ERROR MESSAGE DST ERMYY BUFFER JMP FJOBF,I RETURN * IN NOP ROUTINE TO CALL NAMR JSB NAMR DEF INEX INDEF DEF COMND DBF DEF BUFR DEF IBUFL DEF CHPOS INEX JMP IN,I RETURN * IN2 NOP ROUTINE TO CALL NAMR USING COMD2 BUFFER LDA DCOM2 SET THE DEF STA INDEF IN IN JSB IN DO IT LDB DCOMN STB INDEF RESTORE THE DEF JMP IN2,I RETURN * DCOM2 DEF COMN2 DCOMN DEF COMND N1 DEC -1 B77 OCT 77 ›:������þúN12 DEC -12 COMMA ASC 1,, CH NOP CCOUN NOP * * JERR NOP JSB EXEC SEND ERROR MESSAGE DEF EXMS DEF D2 DEF OLU DEF TERMM DEF D7 EXMS JMP TERM * * BGMS SEND A MESSAGE OF THE FORMAT: * * /JOB: ERROR YYYYZZZZXXXXXX * * THE CALLING SEQUENCE IS: * * JSB BGMS * DEF XXXXXX POINTER TO XXXXXX * ASC 4,ZZZZYYYY * * (THIS SEQUENCE IS USED BECAUSE IT IS CONVIENT TO USE ERMS) * BGMS NOP SEND A BIG MESSAGE LDA BGMS,I GET THE DEF STA BGCL SAVE IT IN THE CALL ISZ BGMS STEP TO THE ASCII DATA DLD BGMS,I GET THE YYYY INFO DST ERMYY SET IT IN THE MESSAGE ISZ BGMS ADVANCE THE POINTER ISZ BGMS ADVANCE THE POINTER DLD BGMS,I GET THE ZZZZ DATA ISZ BGMS ADVANCE THE POINTER ISZ BGMS ADVANCE THE POINTER JSB ERMS SEND THE MESSAGE BGCL NOP POINTER THE THE XXXXXX DATA DLD "ON" RESTORE THE ' ON ' TO THE DST ERMYY YYYY FIELD JMP BGMS,I AND RETURN * "ON" ASC 2, ON * * * FMPER CHECKS FOR ERRORS ON A FILE ACCESS AND IF ONE * ABORTS JOB AFTER PRINTING THE FOLLOWING MESSAGES: * * '/JOB: ERROR -NNN ON XXXXXX' * 'END JOB ABNORM' * * WHERE -NNN IS THE FMP ERROR CODE AND * XXXXXX IS THE FILE NAME AS PASSED IN THE CALL * * CALLING SEQUENCE: * * JSB FMPER * DEF XXXXXX DEF TO THE SIX CHAR. FILE NAME * * FMPER RETURNS ONLY IF A > -1 ON ENTRY * FMPER NOP LDB FMPER,I STB FMMS SET UP TO MOVE THE FILE NAME ISZ FMPER SET THE RETURN ADDRESS CMA,SSA,INA IF A > -1 JMP FMPER,I RETURN * CLB SET UP TO CONVERT THE FMP ERROR CODE DIV D10 SEPERATE THE DIGITS ALF,ALF NOW MIRGE THEM BACK ADB A AND ADB "00" CONVERT TO ASCII LDA BLMIN PICK U¬Ò������þúP A " -" JSB ERMS PRINT THE ERROR MESSAGE FMMS NOP POINTER TO XXXXXX JSB JERR NOW TERMINATE * BLMIN ASC 1, - * JOBFE NOP SEND ERROR MESSAGES ON JOBFIL ACCESSES JSB FMPER DEF JOBFL JMP JOBFE,I RETURN * * * ERMS IS A ROUTINE TO PRINT THE FOLLOWING MESSAGE: * * '/JOB: ERROR ZZZZ ON XXXXXX' * * THE CALLING SEQUENCE IS: * * DLD ZZZZ PUT ZZZZ IN A,B * JSB ERMS CALL HERE * DEF XXXXXX DEF TO THE ASCII XXXXXX FIELD * * RETURN * ERMS NOP DST ERMS2 SET THE ZZZZ FIELD DOWN LDA ERMS,I GET THE DEF STA ERADD SET IT IN THE CALL JSB .DFER MOVE IN THE XXXXXX FIELD DEF ERMS3 ADDRESS OF THE XXXXXX FIELD ERADD NOP ADDRESS OF THE SOURCE LDA LERMS USE STANDARD LENGTH JSB WER SEND THE MESSAGE ISZ ERMS SET PROPER RETURN JMP ERMS,I RETURN * * WER NOP ROUTINE TO ECHO BAD LINE AND ERROR STA LWER PASS IN ERROR MESSAGE SIZE JSB REIO ECHO THE OFFENDING COMMAND DEF *+5 DEF WCODE DEF OLU DEF BUFR DEF BUFL1 * JSB REIO SEND THE ERROR MESSAGE DEF *+5 DEF WCODE DEF OLU DEF ERMS0 DEF LWER JMP WER,I AND RETURN * LWER NOP ERMS0 ASC 6,/JOB: ERROR ERMS2 ASC 2,IO07 DUMMY ERMYY ASC 2, ON ERMS3 ASC 3,XXXXXX BSS 30 BUFFER FOR ERRORS FROM .UACT LERMS DEC -26 A EQU 0 B EQU 1 DEFPR DEC 99 NSPRM ASC 1,NS NWAIT OCT 100012 FLMAN ASC 3,FMGR D5 DEC 5 SPOL ASC 2,SPOL TERMM ASC 7,END JOB ABNORM DCOM5 DEF COMND+5 CCOMP OCT -20000 BLANK ASC 3, RCOLN OCT 72 N2 DEC -2 SCOL ASC 1,;_ PROMPT RCODE DEC 1 IOPTN OCT 3 WCODE DEC 2 D2 EQU WCODE DFLAG OCT 40021 B70 OCT 70 B377 OCT 377 BUFAD DEF BUFR2 BUFLN DEC -80 EOJSW BSS 1 JRN BSS 1 WRN BSS 1 JSTAT BSS 1 NWWC OCT *���~��|x100002 C377 OCT 177400 COLON OCT 35000 CNWD OCT 400 CONWD BSS 1 ICNWD BSS 1 STAT BSS 1 D6 DEC 6 D23 DEC 23 D4 DEC 4 ZERO DEC 0 D16 DEC 16 D17 DEC 17 D18 DEC 18 WD4AD DEF BUFR2+4 IERR BSS 1 SMPA ASC 3,SMP JOBFL ASC 3,JOBFIL ISECU OCT 123456 "JO" ASC 1,JO "EO" ASC 1,EO EOJC ASC 1,:E ASC 1,OJ "XE" ASC 1,XE D1 DEC 1 D14 DEC 14 RESWT ASC 6,JOB WAIT ON SPOOL RESOURCE MES ASC 3,SPOOL ASC 4,RESOURCE. JDCB BSS 256 USED FOR XEQ FILE AND JOB Q BUFR3 EQU JDCB+144 D40 DEC 40 * ORG * END BEM ������������������������������ÊÍ~������ÿÿ����� ���� ÿý�.�H ���������ÿ��92067-18355 1903� S C0122 �&SPOUT � � � � � � � � � � � � � �H0101 ¦�����þúASMB,R,Q,C ASSEMBQE STATEMENT FOR RTE IV HED OUTSPOOL ROUTINE FOR RTE IV-B * NAME: SPOUT * SOURCE: 92067-18355 * RELOC: 92067-16350 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SPOUT,1,11 92067-16350 REV.1903 790706 * * *** THE GREAT SPOOL OUT ROUTINE *** * * * *** SMP REQUESTS TO SPOUT *** * * (1) NEW MENU TO SEARCH * STAT1 = 2 * STAT2 = 0 * IOBUF CONTAINS MENU * * (2) UNLOCK LU AND SEARCH NEW MENU * STAT1 = 3 * STAT2 = LU TO UNLOCK * IOBUF CONTAINS MENU * * (3) START UP A NEW SPOOL * STAT1 = 1 * STAT2 = NEW STAT2 CLASS PARAMETER * IOBUF CONTAINS NEW STAT1 * * * *** FORM OF CLASS PARAMETERS *** * * STAT1 SIGN BIT SET = STANDARD FILE * SIGN BIT CLEAR = OUTSPOOL WITH HEADERS * BIT 12 SET = CAME FROM DVS43 * BITS 11-8 = LINE COUNT * BITS 7-0 = LU # TO READ * * STAT2 SIGN BIT SET = CHECK OVERLAP CONDITION * SIGN BIT CLEAR = NO OVERLAP CHECK NEEDED * BIT 14 SET = RECORD TRUNCATED MESSAGE ALREADY SENT BY SMP * BITS 13-8 = FUNCTION BITS FOR STANDARD FILE * BITS 7-0 = OUTSPOOL LU # * * STD. I/O REQUEST: * * OPT. PRAM #1 STAT1 * OPT. PRAM #2 SET UP COUNT WORD (FLCNT) * * EQT 32/33 * 32 STAT1 * 33 STAT2 * 29 FLCNT * EXT $LIBR TURN OFF INTERRUPTS EXT $LIBX TURN ON INTERRUPTS EXT LURQ LU LOCK/UNLOCK REQUEST EXT $LUAV LU AVAILABILITY TABLE EXT EXEC SYSTEM CALLS qÉ������þúEXT XLUEX EXTENDED SYSTEM CALLS EXT $SPCL SPOOL CLASS ID EXT .DRCT * * IOBUF BSS 131 * ORG IOBUF * * SPX CLA STA SPOUT LDA $SPCL IOR DONT JSB $LIBR NOP STA $SPCL JSB $LIBX DEF *+1 DEF SPT2 * ORR * SPOUT JMP SPX * SPT2 LDA $SPCL STA SP.CL SAVE FOR INTERNAL USE JSB EXEC CLASS GET LOOP STARTS HERE. DEF *+8 FLOW OF CONTROL DIRECTED DEF D21 FROM THIS POINT. DEF SP.CL BUFAD DEF IOBUF DEF D131 DEF STAT1 DEF STAT2 DEF ICNWD LDB ICNWD WHAT TYPE ORIGINAL REQUEST? CPB D2 JMP WRREQ ORDINARY WRITE. * CPB D3 JMP SPT2 CONTROL - BACK THROUGH LOOP. * LDA STAT1 WRITE-READ. CPA D2 HAVE AN SMP REQUEST JMP MENU * CPA D1 JMP FILAT * JSB LURQ MUST UNLOCK LU OF FILE DEF *+4 WHICH SMP FAILED TO OPEN DEF B60K DEF STAT2 DEF D1 NOP IGNORE ERROR JMP SPT2 GET THE NEXT CHORE * MENU LDA BUFAD HAVE A MENU TO SEARCH. STA TEMP1 MENU5 LDA TEMP1,I GO THROUGH LU'S IN MENU SZA,RSS TRYING TO LOCK EACH ONE. JMP MENU4 * * JSB LURQ TRY TO LOCK. DEF *+4 DEF NOABT WITHOUT ABORT. DEF TEMP1,I DEF D1 JMP MENU6 ERROR JUST IGNORE THIS ONE SZA,RSS JMP MENU3 SUCCESSFUL LOCK. * SSA UNSUCCESSFUL. JMP MENU4 NO RN'S AVAILABLE. QUIT. * MENU6 ISZ TEMP1 LU ALREADY LOCKED. TRY JMP MENU5 SEARCHING MORE OF MENU. * MENU4 CLB CPB STAT2 JMP MENU2 * STB STAT2 JMP MENU * MENU2 CPB IOBUF NULL MENU? JMP SPT2 YES - BACK TO GET. * LDA D10 TELL SMP ABOUT THE LOCK PROBLEM JMP SMPC * MENU3 LDA D11 SUCCESS TELL SMP ‚˜������þú LDB TEMP1,I FIRST MOVE UP THE PRAM STB TEMP1 JMP SMPC * FILAT LDA IOBUF HAVE A SET OF FILE STA STAT1 ATTRIBUTES. AND B377 READ LU # STA ICNWD START UP THE SPOOL. JSB GETEQ GET EQT ADDRESS OF ADB M2 STARTING NEW FILE. LDA FILNO INCREMENT AND SET CCE,INA,SZA,RSS ERA FILE COUNTER INTO EQT29. STA FLCNT STA FILNO JSB PUT STUFF THE EQT. ADB D3 STB LCNT SAVE EQT32 ADDRESS. JSB SLCNT STAT2 IN EQT32 AND EQT33. CCA SET FLAG IN STA GETEQ GETEQ TO INDICATE SET UP JMP WRR10 * WRREQ LDA STAT2 STA FLCNT LDA STAT1 NORMAL READ-WRITE LOOP AND B377 STARTS HERE. STA ICNWD JSB GETEQ GET ADDRESS OF EQT32. ADB M2 BACK UP AND GET LDA B,I THE SET UP COUNT CPA FLCNT IS IT GOOD? INB,RSS YES SKIP JMP SPT2 NO OLD NEWS IGNOR IT * ADB D2 SET B TO EQT32 ADDRESS STB LCNT SAVE EQT32 ADDRESS. INB LDA B,I PICK UP STAT2 FROM THE EQT AND STA STAT2 SAVE IT LDB STAT1 PICK UP STORED STAT1 VALUE. LDA LCNT,I AND SAVE VERSION BLF,SLB IF FROM EXTEND RSS SKIP THE INCREMENT ADA B400 ELSE STEP THE COUNTER STA STAT1 SET STAT1 FOR LOCAL USE AND B7400 ISOLATE THE COUNTER SZA,RSS IF COUNT IS ALREADY TO ZERO JMP SPT2 IGNOR THE EXTEND WAKE UP. * JSB SLCNT UPDATE THE EQT WRR10 LDA STAT2 NEED WE CHECK THE SSA,RSS OVERLAP CONDITION? JMP WRR6 NO NEED. * JSB .DRCT WE MUST CHECK OVERLAP DEF $LUAV CONDITIONS BEFORE CONTINUING. LDB A,I STB TEMP1 INA STA TEMP2 SAVE ADDRESS OF TABLE. WRR LDB A,I SEARCH THE $LUAV TABLE INA FOGŒ������þúR THE READ LU. BLR,BRS CPB ICNWD JMP WRR3 WE HAVE IT. * INA JMP WRR * B400 OCT 400 SP.CL NOP * WRR3 LDB A,I SAVE SPLCON RECORD # STB TEMP5 CORRESPONDING TO THIS LDA TEMP2 SPOOL LU. WILL FIND IF WRR5 INA WE HAVE A POTENTIAL OVERLAP LDB A,I CONDITION BY FINDING CPB TEMP5 ANOTHER ENTRY OF SAME JMP WRR4 RECORD #. * WRR7 INA ISZ TEMP1 JMP WRR5 * LDB STAT2 CLEAR OVERLAP CHECK BIT. BLR,BRS STB STAT2 WRR6 CLA STA CNWD2 INITIALIZE SECOND CONTROL WORD JSB XLUEX READ THROUGH SMD. DEF *+5 DEF LOKOP WITH NO ABORT BIT SET. DEF ICNWD DEF IOBUF DEF D131 JMP SPT2 HOLD I.O. * ALF,ALF CHECK STATUS WORD. SSA JMP EOF END OF FILE. * STB TEMP2 SAVE THE TRANSMITTED LENGTH LDA STAT1 CCE,SSA,RSS WHAT TYPE OF FILE? CPB D1 FIRST REASONABLE NESS TEST ONE WORD JMP RSTAN STANDARD. * LDA IOBUF OUTSPOOL WITH HEADERS. AND B3700 FORM THE CON WORD STA TEMP6 LDA STAT2 LU# AND B377 STA TEMP5 SALT IT AWAY LDA IOBUF GET THE REQUEST CODE AND OKBIT (=B24077) ALL BUT LEAST 2 SHOULD BE 0 CCE,SZB FORCE ZERO LENGTH READS TO FAIL CPA D3 IF CONTROL JMP CNTST GO TRY IT * CPA D2 BETTER BE A WRITE RSS GOOD SHOW GO DO IT JMP RSTAN WRONGLY FLAGGED * LDA IOBUF+1 FIGURE FINAL LENGTH OF LINE CCE,SSA IF CHAR ARS CONVERT TO WORDS SSA CMA,INA ADA D2 SHOULD MATCH THE READ LENGTH IN B CPA B DOES IT?? JMP OK YES STILL OK * CPB D131 COULD BE TOO LONG A LINE IF SO RSS USE IT * JMP REFLG WRONGLY FL~ò������þúAGGED AS NON STANDARD FILE * JSB TRUNC SEND THE RECORD TRUNCATED MESSAGE LDA D128 SET LENGTH TO 128 RSS * OK LDA IOBUF+1 STA TEMP2 SET THE LENGTH LDA TEMP6 SAVE THE CONFIGURED STAT WORD FOR EOF RAL,RAL RECONFIGURE STAT2 XOR STAT2 TO SAVE STAT AND B374C UNDER THE RULES XOR STAT2 OF WOO STA STAT2 LDB BUFR2 GET THE BUFFER ADDRESS JMP SEND1 * B374C OCT 37400 HIGH FUNCTION BIT MASK * RSTAN LDB TEMP2 GET TRANSMISSION LOG CPB D131 TOO LONG A RECORD? RSS SEND RECORD TRUNCATED MESSAGE JMP REFLG * LDB D128 SET LENGTH TO MAX OF 128 WORDS STB TEMP2 JSB TRUNC SEND RECORD TRUNCATED MESSAGE * REFLG LDA STAT2 GET LU WORD AND B374C MASK FUNCTION BITS 8-13 RAR,RAR SET FUNCTION CODE IN BITS 6-11 STA TEMP6 SET FOR XLUEX CALL LDA STAT1 REFLAG IT ELA,RAR SET THE STANDARD BIT STA STAT1 AND LDB BUFAD GET THE BUFFER ADDRESS LDA STAT2 AND THE CON WORD SEND1 AND B377 GET THE OUTSPOOL LU STA TEMP5 SET THE CON WORD STB BUFFR AND THE BUFFER ADDRESS * JSB DOWN? MAKE SURE NOT DOWN (NO RETN IF SO) JSB XLUEX WRITE A LINE TO DEF *+8 A DEVICE. DEF D18 DEF TEMP5 BUFFR BSS 1 BUFFER ADDRESS DEF TEMP2 BUFFER LENGTH DEF STAT1 CLASS PARAMETER. DEF FLCNT CLASS PARAMETER. DEF SP.CL LDA STAT1 FIRST TIME THROUGH ADA C377 DECREASE COUNT OF LINES STA STAT1 SET IT BACK JSB SLCNT LDA STAT1 NEED TO DO ANOTHER AND B7400 ISZ GETEQ IF FIRST LINE WAIT FOR COME BACK SZA,RSS IF COUNT DOWN TO ZERO WAIT JMP SPT2 YES- BACK TO GET LOOP. * JMP WRR10 COUNT NOT ZERO AND NOT FIRST LINE * D8 DEC 8 f������þúD20 DEC 20 D128 DEC 128 D130 DEC 130 D131 DEC 131 ERRMS ASC 8,RECORD TRUNCATED C377 OCT 177400 B377 OCT 377 OKBIT OCT 24077 B7400 OCT 7400 CNTST CPB D2 BETTER BE A TWO WORD RECORD RSS GOOD SHOW JMP RSTAN NO GOOD GO RETYPE IT * JSB DOWN? NO RETURN IF DOWN DEVICE JSB XLUEX SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF TEMP5 DEF IOBUF+1 DEF SP.CL JMP WRR10 * WRR4 ADA M1 LDB A,I FOUND A RECORD MATCH. BLR,BRS IS THIS THE SAME ENTRY INA CPB ICNWD WE PICKED UP BEFORE. JMP WRR7 YES. * LDA B GET THE LU TO A FOR GETEQ JSB GETEQ NO. CHECK FURTHER. CCA GET CURRENT LINE COUNT ADA LCNT FROM THE READ EQT LDA A,I TO A CMA AND COMPARE ADA B,I WITH THE WRITE EQT SSA,RSS JMP WRR6 WE ARE OK. * INB SET UP WRITE EQT STB LCNT LDA STAT1 OVERLAP FAILED - SET EQT32 IOR DVCHK AND EQT33 IN LU OF FILE LDB FLCNT BEING WRITTEN SO THAT SMD STA STAT1 STB STAT2 JSB SLCNT WILL CALL US BACK WHEN IT JMP SPT2 HAS WRITTEN ANOTHER RECORD. * GETEQ NOP THIS ROUTINE FINDS US THE ADA M1 EQT ADDRESS CORRESPONDING ADA DRT TO A GIVEN LU #. LDA A,I AND B77 ADA M1 MPY D15 ADA EQTA ADA D12 LDB A,I ADB D15 JMP GETEQ,I * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * EOF STB GETEQ SAVE THE EOF STATUS FLAG LDB LCNT ADB M3 CLA JSB PUT CLEAR THE FLAG SO WILL NOT BELIEVE FURTHER GETS LDA STAT2 END OF FILE. AND B377 ISOLATE OUTSPOOL LU. STA TEMP1 AND SAVE IT. LDB GETEQ GET THE EOF FLAG LDA STAT2 ANõÊ������þúD THE LAST USED MODE AND B400 ISOLATE THE MODE BIT SZB IF GOOD EOF SZA OR BINARY FILE JMP EOF0 SKIP MESSAGE * JSB DOWN? DO THE DOWN CHECK JSB XLUEX SEND THE BAD EOF MESSAGE DEF *+8 DEF D18 DEF TEMP1 DEF EOFER DEF D4 DEF STAT1 DEF STAT2 DEF SP.CL JMP EOF1 NOW SEND ALL POSSIBLE EOFS * EOF0 SSB IF BAD EOF JMP EOF1 SEND ALL POSSIBLE EOF'S FOR ALL FILES * LDA STAT1 SSA,RSS STANDARD FILE? JMP EOF2 NO - HAVE HEADERS.. * EOF1 LDA B100 JSB CNTRL SEND EOF LDA B1000 JSB CNTRL SEND LEADER REQUEST LDA B1100 JSB CNTRL SEND TOP OF FORM REQUEST EOF2 JSB LURQ UNLOCK THE LU DEF *+4 OF THE OUTSPOOL DEF B60K JUST COMPLETED. DEF TEMP1 DEF D1 NOP IGNORE ERROR RETURN LDA STAT1 TELL SMP WE ARE GOOD AND B377 AND FINISHED WITH THIS FILE. STA TEMP1 LDA D12 SEND DEQUE TO SMP SMPC STA SLCNT SET CALL CODE JSB EXEC DEF *+6 DEF D24 DEF SMP DEF SLCNT RQ PRAM DEF TEMP1 CURRENT LU DEF GETEQ EOF STATUS JMP SPT2 * SLCNT NOP JSB $LIBR NOP LDA STAT1 LDB STAT2 DST LCNT,I LCNT EQU *-1 JSB $LIBX DEF SLCNT * CNTRL NOP STA CNWD2 SET THE FUNCTION CODE LDA TEMP1 PICK UP STA ICNWD AND SET THE LU# IN CONTROL WORD 1 JSB DOWN? CHECK IF DOWN JSB XLUEX SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF ICNWD TWO WORD CONTROL WORD DEF M1 DEF SP.CL JMP CNTRL,I * DOWN? NOP TEST FOR DOWN DEVICE CCA ADA STAT2 THAN THE LU AND B377 ISOLATE ADA DRT INDEX INTO THE DRT STA B ‹Ó������þú SAVE FOR LU TEST CCA SET TO GET THE EQT JSB $LIBR GO PRIV TO STOP RACES NOP ADA B,I EQT NO-1 AND B77 ISOLATE THE EQ NO. CPA B77 IF NO EQT THEN JMP DWNEX GO SENT THE LINE * ADB LUMAX INDEX TO LU FLAG LDB B,I IF SIGN SET THEN DOWN SSB ELSE UP JMP DOWN * MPY D15 GET EQT ADDRESS ADA EQTA ADA D4 TO A LDA A,I GET THE WORD RAL,SLA IF DOWN JMP DWNEX NOT DOWN EXIT * SSA,RSS SKIP JMP DWNEX ELSE GO EXIT * DOWN JSB $LIBX DEVICE IS DOWN DEF *+1 DEF *+1 LDA ICNWD SET UP TO CALL SMP AND STA TEMP1 LDA B200 BACK SPACE ON RECORD STA TEMP2 JSB XLUEX BACK SPACE IN FILE DEF *+3 DEF D3 DEF TEMP1 TWO WORD CONTROL REQUEST LDA D18 JMP SMPC GO NOTIFY SMP TO PUT IN HOLD * DWNEX JSB $LIBX UP SO DEF DOWN? GO DO THE CALL * * TRUNC NOP SEND RECORD TRUNCATD MESSAGE LDB LCNT INB ADDRESS OF EQT WORD 33 LDA STAT2 RAL,CLE,ELA BIT 14 IN E REG SEZ,CCE SET? JMP RECER YES, THEN DO NOT CALL SMP * ERA,RAR SET BIT 14 TO INDICATE SMP CALLED ONCE STA STAT2 LDA STAT1 AND B377 GET THE CURRENT SPOOL LU STA TEMP1 * JSB EXEC CALL SMP TO SEND RECORD DEF *+5 TRUNCATED MESSAGE DEF D24 DEF SMP DEF D20 PARAMETER FOR SMP DEF TEMP1 CURRENT SPOOL LU # * RECER LDA STAT2 AND B400 ISOLATE THE MODE BIT SZA IF BINARY SKIP JMP TRUNC,I WRITTING THE MESSAGE * LDA STAT2 AND B377 GET THE OUTSPOOL LU STA TEMP1 JSB DOWN? CHECK IF DEVICE IS DOWN * JSB XLUEX WRITE THE RECORD TRUNCATED DEF *+8 {¥���6��40 MESSAGE TO THE OUTSPOOL DEVICE DEF D18 DEF TEMP1 DEF ERRMS RECORD TRUNCATED DEF D8 DEF STAT1 DEF STAT2 DEF SP.CL * JMP TRUNC,I RETURN * * STORAGE * D4 DEC 4 B200 OCT 200 A EQU 0 B EQU 1 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B SMP ASC 3,SMP EOFER ASC 4, BAD EOF TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP5 BSS 1 TEMP6 BSS 1 FILNO OCT 100000 FLCNT BSS 1 STAT1 BSS 1 STAT2 BSS 1 LOKOP OCT 100001 NOABT OCT 160001 ICNWD BSS 1 CNWD2 NOP BUFR2 DEF IOBUF+2 B60K OCT 60000 D1 DEC 1 D2 DEC 2 D3 DEC 3 D10 DEC 10 D11 DEC 11 D12 DEC 12 D15 DEC 15 D18 DEC 18 D19 DEC 19 D21 DEC 21 D24 DEC 24 M1 DEC -1 M2 DEC -2 M3 DEC -3 B77 OCT 77 B100 OCT 100 B1000 OCT 1000 B1100 OCT 1100 B3700 OCT 3700 DVCHK OCT 10000 DONT OCT 20000 * END SPOUT ����������������������������������������������������������������������������������������������������������������������������������—a6������ÿÿ����� ���� ÿý�/� = ���������ÿ��92067-18356 1903� S C0122 �&$SPCL � � � � � � � � � � � � � �H0101 p�����ASMB,R,L,C ** SPOOL TABLE AREA 2 MODULE ** * DATE: 9/08/78 * NAME: SP.CL * SOURCE: 92067-18356 * RELOC: 92067-16350 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $SPCL,13 92067-16350 REV.1903 780921 * ENT $SPCL ENT $SPOK ENT $IS43 * EXT IS43 * * $SPOK DEC 1 $IS43 DEF IS43+0 $SPCL NOP END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������€ñ������ÿÿ����� ���� ÿý�0�6 ���������ÿ��92067-18357 1903� S C0122 �&MT1OK � � � � � � � � � � � � � �H0101 y�����þúASMB,R,L * * NAME: MT1OK * SOURCE: 92067-18357 * RELOC: 92067-16104 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MT1OK,7 92067-16104 REV.1903 790203 * EXT EXEC ENT MT1OK * * * * THE LU UP ROUTINE CHECKS TO SEE IF THE MAG TAPE TO BE * ACCESSED IS ON LINE, BUSY, OR NEEDS A WRITE RING. * * * CALLING SEQUENCE: JSB MT1OK * DEF RETRN * DEF LUARY * DEF FLAG * * * WHERE LUARY IS AN ARRAY LUARY(1) = LU # * LUARY(2) = 'RE' (READ) OR * 'WR' (WRITE) * * * FLAG IS RETURNED AS FOLLOWS. THE ITEMS ARE LISTED IN * THE ORDER THAT THEY ARE CHECKED. * * * * FLAG = 0 ALLS WELL * = 1 MT OFF LINE * (OR BUSY) * = 2 NO WRITE RING * (CHECKED ONLY IF * A WRITE REQUEST) * = 3 PARITY ERROR * = 4 END OF TAPE * = 5 I/O REJECT * * * * * MT1OK NOP ENTRY LDA MT1OK,I GET RETURN STA RETRN & SAVE * ISZ MT1OK DLD MT1OK,I GET THE PARAMETER ADDRESSES DST PRAMS * * * * ú-��� ��  WE ASSUME THAT MT IS OK IE * LU # OK , EQ & LU UP, LU NOT LOCKED. * HOWEVER THIS REQUEST IS NEVER LEFT I/O SUSPENDED * LDA PRAMS,I YES, SO DO DYNAMIC STATUS REQUEST ADA B600 CONFIGURE THE CONTROL WORD(LU# + 600B) STA CNWRD * JSB EXEC SEND REQUEST DEF *+3 DEF D3 DEF CNWRD * SLA,RAR DEVICE BUSY OR OF LINE ? JMP EXIT1 YES, SO SEND ERROR * LDB PRAMS NOW SEE IF THIS IS A WRITE REQUEST INB LDB B,I GET THE 'RE' OR 'WR' CPB WR THIS A WRITE REQUEST ? RSS YES JMP OK2GO NO, READ REQUEST. RAR,SLA,RAL YES, IS WRITE RING SET JMP EXIT2 WRITE RING MISSING * * OK2GO SLA,ALF PARITY ERROR ? JMP EXIT3 YES * ALF,ALF SLA,RAL END OF TAPE ? JMP EXIT4 YES * RAL,SLA I/O REJECT ? JMP EXIT5 * * CLA ALLS WELL !!!! JMP BYE * * EXIT1 CLA,INA,RSS SET FLAG = 1 EXIT2 LDA D2 BYE STA PRAMS+1,I GIVE FLAG TO USER JMP RETRN,I & RETURN EXIT3 LDA D3 JMP BYE EXIT4 LDA D4 JMP BYE EXIT5 LDA D5 JMP BYE A EQU 0 B EQU 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 B600 OCT 600 WR ASC 2,WR RETRN NOP PRAMS NOP NOP CNWRD NOP END ������������������������������������������������������������������������������������������������������������������������������‹ ������ÿÿ����� ���� ÿý�1�8 ���������ÿ��92067-18358 1903� S C0122 �&CLOAD � � � � � � � � � � � � � �H0101 x†�����þúFTN4 C C C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C NAME: CLOAD C SOURCE: 92067-18358 C RELOC: 92067-16358 C PGMR: C.M.M. C C C THE CLOAD PROGRAM IS A FRIENDLY INTERFACE TO ALL SUPPORTED C HP-1000 SYSTEM LANGUAGES. C IT PROVIDES THE FUNCTIONS OF ID SEGMENT MANAGEMENT, SPOOL C LU MANAGEMENT, SCHEDULING OF THE DESIRED LANGUAGE, AND C INVOCATION OF THE LOADR TO LINK THE PROGRAM TO WHATEVER C OTHER MODULES IT REQUIRES. C C C C C PROGRAM CLOAD (3,90),92067-16358 REV.1903 790503 DIMENSION IBUF(60),IXBF(60),IPROG(3,11),IREG(2),IWARN1(22) DIMENSION IDCB1(144),SPMSG(10),ISPOOL(16),IPROCD(21) DIMENSION IPBUF(120),IPRMT(16),INAME(3),IRTN(5),ISMP(3) DIMENSION IMOUNT(28),IFULL(17),IFMERR(23),ISPCN(3) DIMENSION IM5010(18),IM5040(16),IM5070(15),IM5080(17) DIMENSION IM5090(20),IM5110(20),IM5130(16),IM5230(18) DIMENSION IM5240(17),IM5250(18),IFMGR(12),IDONE(6) DIMENSION ILOADR(20),ILOAD(3),ILOAD4(3),IPRLD(16) DIMENSION IXREF(3),IM6260(19),IM5260(10),INFORM(15) C LOGICAL IFTTY INTEGER GETSP,SPMSG DOUBLE PRECISION XPROG(9) EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) EQUIVALENCE (IPROG,XPROG) C C THE FOLLOWING ARE THE PROGRAMS THAT WE CAN TALK TO C IF YOU WANT ANOTHER PROGRAM JUST ADD IT TO THE LIST C AND INCREASE THE LENGTH OF THE IPROG DIMENSION. C DATA ISPOOL/0,0,2HCO,2HMP,2H00,0,0,0,400B,99,0,0,0,0,0,0/ C DATA INFORM/2H/C,2HLO,2HAD,2H: , & 2HIN,2HFO,2HRM,2H S,2HYS,2HTE,2HM ,2HMA,2HNA, & 2HGE,2HR./ C C ò_������þú DATA ISMP/2HSM,2HP ,2H / DATA IXREF/2HXR,2HEF,2H / DATA ISPCN/2HSP,2HLC,2HON/ C DATA IWARN1/2H/C,2HLO,2HAD,2H: , &2HWA,2HRN,2HIN,2HG,,2H ,2HSP,2HOO,2HL ,2HDI,2HSC,2H I,2HS , &2HGE,2HTT,2HIN,2HG ,2HFU,2HLL/ C DATA IPROCD/2H/C,2HLO,2HAD,2H: , &2HCO,2HMP,2HIL,2HAT,2HIO,2HN ,2HIS,2H P,2HRO,2HCE,2HED,2HIN,2HG , &2HNO,2HRM,2HAL,2HLY/ C DATA IPRLD/2H/C,2HLO,2HAD,2H: , &2HLO,2HAD,2H P,2HRO,2HCE,2HED,2HIN,2HG ,2HNO,2HRM,2HAL,2HLY/ DATA IMOUNT/2H/C,2HLO,2HAD,2H: ,2HWA,2HRN,2HIN,2HG,,2H , &2HSP,2HOO,2HL ,2HDI,2HSC,2H N,2HOT,2H M,2HOU,2HNT,2HED , &2H T,2HO ,2HTH,2HIS,2H S,2HES,2HSI,2HON/ C DATA IFULL /2H/C,2HLO,2HAD,2H: ,2HWA,2HRN,2HIN,2HG,,2H , &2HSP,2HOO,2HL ,2HDI,2HSC,2H F,2HUL,2HL / C DATA IFMERR/2H/C,2HLO,2HAD,2H: , &2HFM,2HGR,2H-0,2HXX,2H ,2H ,2HER,2HRO,2HR ,2HON,2H S,2HPO, &2HOL,2H F,2HIL,2HE ,2HCR,2HEA,2HT / C DATA IM5010/2H/C,2HLO,2HAD,2H: , &2HSO,2HUR,2HCE,2H I,2HNP,2HUT,2H M,2HUS,2HT ,2HBE,2H A,2H F, &2HIL,2HE / C DATA IM5040/2H/C,2HLO,2HAD,2H: , &2HSO,2HUR,2HCE,2H F,2HIL,2HE ,2HOP,2HEN,2H ,2HER,2HRO,2HR / C DATA IM5070/2H/C,2HLO,2HAD,2H: , &2HUN,2HRE,2HCO,2HGN,2HIZ,2HED,2H L,2HAN,2HGU,2HAG,2HE / C DATA IM5080/2H/C,2HLO,2HAD,2H: , &2HLA,2HNG,2HUA,2HGE,2H S,2HCH,2HED,2HUL,2HIN,2HG ,2HER,2HRO,2HR / C DATA IM5090/2H/C,2HLO,2HAD,2H: , &2H ,2H ,2H ,2HNO,2HT ,2HLO,2HAD,2HED,2H O,2HN ,2HTH,2HIS, &2H S,2HYS,2HTE,2HM / C DATA IM5110/2H/C,2HLO,2HAD,2H: , &2HCL,2HOS,2HE ,2HER,2HRO,2HR ,2HON,2H ',2HRP,2H' ,2HOF,2H L, &2HAN,2HGU,2HAG,2HE / C DATA IM5130/2H/C,2HLO,2HAD,2H: , &2HMO,2HRE,2H T,2HHA,2HN ,2H80,2H S,2HPO,2HOL,2H F,2HIL,2HES/ C DATA IFMGR/2H/C,2HLO,2HAD,2H: ,2HFM,2HGR,2H-0,2HXX,2H , &2HER,2HRO,2HR / C DATA IM5230/2H/C,2HLO,2HAD,2H: , &2HCO,2HMP,2HIL,2HER,2H A,2HBO,2HRT,2HED,2H A,2HBN,2HOR,2HMA,2HLL, &2HY / š������þú C DATA IM5240/2H/C,2HLO,2HAD,2H: , &2HSY,2HST,2HEM,2H O,2HUT,2H O,2HF ,2HID,2H S,2HEG,2HME,2HNT,2HS / C DATA IM5250/2H/C,2HLO,2HAD,2H: , &2HCO,2HMP,2HIL,2HER,2H P,2HAS,2HSE,2HD ,2HBA,2HCK,2H E,2HRR,2HOR, &2HS / C DATA IM5260/2H/C,2HLO,2HAD,2H: , &2HIN,2HPU,2HT ,2HER,2HRO,2HR./ C DATA IM6260/2H/C,2HLO,2HAD,2H: , &2HLI,2HST,2H D,2HEV,2HIC,2HE ,2HMU,2HST,2H N,2HOT,2H B,2HE , &2HA ,2HFI,2HLE/ C DATA IDONE/2H/C,2HLO,2HAD,2H: ,2HEN,2HD / DATA ISIZE/24/ DATA MLEN/20/ C DATA IOPT/2HR / C DATA SPMSG/2HSP,2HOO,2HL ,2HFI,2HLE,2H =,2H ,2H ,2H ,2H / C DATA IPROG/2HFT,2HN4,2H , & 2H$P,2HAS,2HCA, & 2HAS,2HMB,2H , & 2HCO,2HBO,2HL , & 2HMI,2HCR,2HO , & 2HRP,2HG ,2H , & 2HSP,2HL ,2H , & 2HHP,2HAL,2H , & 2HAL,2HGO,2HL , & 2HPA,2HSC,2HL , & 2HSN,2HOB,2HL / C C DATA IBUF/2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / C C DATA IXBF/2H,,,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / C DATA IPRMT/ 2HNA,2HMR,2H(S,2H),, & 2HNA,2HMR,2H(L,2H),, & 2HNA,2HMR,2H(R,2H),, & 2H<Cäé������þú,2H.S,2H.>/ C DATA ILOADR/2H ,,2H,,,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , &2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / DATA ILOAD/2HLO,40400B/ DATA ILOAD4/2HLO,2HAD,2HR / C C IKVT(IERR) = 2H00 + (IERR/10*256) + MOD(IERR,10) C C C C C C C GET THE LU OF OUR TERMINAL & PICK UP THE SCHEDULING STRING C LU = LOGLU(LU) CALL LUTRU(LU,LUX) ISPOOL(4) = IKVT(LUX) LU = LU + 400B REG= EXEC(14,1,IBUF,-120) IF(IA.EQ.1) GO TO 175 LENGTH = IB ISTRC = 1 C C PARSE TWICE & THROW AWAY (DON'T NEED THE ' RU,CLOAD ' ) C CALL NAMR(IPBUF,IBUF,LENGTH,ISTRC) CALL NAMR(IPBUF,IBUF,LENGTH,ISTRC) C C PARSE AS MANY TIMES AS REQUIRED C 25 DO 100 KOUNT = 0,9 IPBUF(11+KOUNT*11) = ISTRC IA = NAMR(IPBUF(1 + 11*KOUNT),IBUF,LENGTH,ISTRC) IF (IA .LT. 0) GO TO 150 100 CONTINUE C C KOUNT = 0 IF RU,CLOAD C KOUNT = 1 IF RU,CLOAD,SORC C KOUNT = 2 IF RU,CLOAD,SORC,LIST C KOUNT = 3 IF RU,CLOAD,SORC,LIST,RELO C KOUNT = 4 IF RU,CLOAD,SORC,LIST,RELO,LANG C KOUNT = 5 IF RU,CLOAD,SORC,LIST,RELO,LANG,A C KOUNT = 6 IF RU,CLOAD,SORC,LIST,RELO,LANG,A,B C KOUNT = 7 IF RU,CLOAD,SORC,LIST,RELO,LANG,A,B,C C KOUNT = 8 IF RU,CLOAD,SORC,LIST,RELO,LANG,A,B,C,D C KOUNT = 9 IF RU,CLOAD,SORC,LIST,RELO,LANG,A,B,C,D,E C KOUNT = 10 IF RU,CLOAD,SORC,LIST,RELO,LANG,A,B,C,D,E,F C C C SOURCE IN IPBUF( 1) - IPBUF( 11) C LIST IN IPBUF( 12) - IPBUF( 22) C RELO IN IPBUF( 23) - IPBUF( 33) C LANG IN IPBUF( 34) - IPBUF( 44) C OPT PR IN IPBUF( 45) - IPBUF( 55) C OPT PR IN IPBUF( 56) - IPBUF( 66) C OPT PR IN IPBUF( 67) - IPBUF( 77) C OPT PR IN IPBUF( 78) - IPBUF( 88) C OPT PR IN IPBUF( 89) - IPBUF( 99) C OPT PR IN IPBUF(100) - IPBUF(110) C NULL IN IPBUF(111) - IPBUF(120) C C C AT THIS POINT THE ENTIRE INPUT BUFFER HAS BEEN PARSED. C IPBUF UÊ������þúBUFFER IS SET UP AS 11 WORDS FOR EACH ENTRY C WORDS 1-10 ARE THE OUTPUT OF NAMR. THE 11 WORD IS C THE CHAR # OF WHERE THE STRING STARTS. C C C NOW CHECK 1ST PARAMETER TO SEE IF NULL OR AN LU C IF A NAMR THEN NO PROMPT IS REQUIRED C 150 IF(IAND(IPBUF(4),3).EQ.3) GO TO 200 C C FIRST PARAMETER IS AN LU OR NOT SUPPLIED SO PROMPT C FOR ADDITIONAL INPUT. BUT MAKE SURE WE DO THIS ONLY ONCE. C IF (IPBUF(11) .EQ. 1) GO TO 5005 175 CALL EXEC(2,LU,IPRMT,16) REG = REIO(1,LU,IBUF,-120) ISTRC = 1 LENGTH = IB GO TO 25 C C C OK SO NOW WE HAVE A NAMR. INITIALIZE THE STRING PUSHERS AND C PUSH THE NAMR INTO THE DESTINATION BUFFER. C LENGTH IS THE LENGTH OF THE SOURCE STRING AND EVERY 11TH WORD C IN THE IPBUF BUFFER HAS THE START CHAR COUNT FOR THAT NAMR. C C 200 NCHRS = 2 CALL SETSB(IBUF,ISCH,-120) CALL SETDB(IXBF,NCHRS) C CALL INAMR(IPBUF,IXBF,120,NCHRS) C C************************************************************************** C* FINISHED WITH SOURCE NAMR NOW GET LIST NAMR * C************************************************************************** C C C CHECK FOR COMPILER LIBRARY DEFAULT C IF(IOR(IAND(IPBUF(12),77600B),40B).EQ.2H- ) GO TO 320 LTYPE = IAND(IPBUF(15),3) IF (LTYPE .EQ. 3) GO TO 6260 C C LIST NAMR IS AN LU OR NULL C IF (LTYPE .EQ. 1) GO TO 350 C C NO LU OR NULL LU C 320 IPBUF(15) = 1 IPBUF(12) = LU - 400B C C PUSH LIST LU INTO STRING C GO TO 399 C C IF NO SPOOLING IN SYSTEM OR C IF HE DOESN'T WANT SPOOLING OR C IF SPECIFIED LU = A TTY , THEN DON'T SPOOL ANYTHING ! C 350 ISPOOL(7) = GETSP(IDUMY) IF (ISPOOL(7) .GE. 0) GO TO 399 IF (IFTTY(IPBUF(12))) GO TO 399 IF(IPBUF(12) .EQ. 0) GO TO 399 IF (IPBUF(16).EQ.2HNS) GO TO 399 C C OK SO SPOOLING EXISTS IN THE SYSTEM C AND AN LU ¹������þúWAS SPECIFIED . SO CREATE A FILE & CALL SMP C TO USE IT AS A SPOOL FILE. SMP WILL TELL US WHETHER C THE SPECIFIED LU IS OK FOR SPOOLING. IF IT TURNS OUT C THAT THE LU IS NOT FOR SPOOLING THEN WE WILL HAVE TO C PURGE THAT FILE AND JUST SEND THE OUTPUT TO THE LU C NORMALLY. C C ISPOOL(16) = IPBUF(12) C IF((IPBUF(12).GT.64) .OR. (IPBUF(12) .LT. 0)) GO TO 5260 IF(LUTRU(IPBUF(12),IA) .LT. 0) GO TO 5260 CALL EXEC(13,IPBUF(12),ISTATS) 360 ISPOOL(8) = IAND(ISTATS,37400B)/256 C C NOW SEE IF THE SPOOL DISC IS MOUNTED C CALL FSTAT(IDCB1) DO 365 I = 1,120,4 IF(ISPOOL(7) .EQ. - IDCB1(I)) GO TO 370 365 CONTINUE 366 CALL EXEC(2,LU,IMOUNT,MLEN) 367 CALL EXEC(2,LU,IPROCD,21) GO TO 399 C C OK, ITS MOUNTED BUT IS IT GETTING TO BE FULL. IF HE ONLY C HAS A FEW MORE TRACKS LEFT WE'LL WARN HIM. BOY THIS IS C IS SO FRIENDLY IT'S PATERNALISTIC. C 370 MLEN = 28 IFMP = IDCB1(I+1) CALL EXEC(1,IDCB1(I),IDCB1,128,IFMP,0) IF(IDCB1(8) - IDCB1(10) .GT. 40) GO TO 372 C C ONLY A FEW MORE TRACKS LEFT ON THE SPOOL DISC C SO WARN HIM TO CLEAN UP HIS ACT C 7000 CALL EXEC(2,LU,IWARN1,22) CALL EXEC(2,LU,INFORM,15) CALL EXEC(2,LU,IPROCD,21) C C OK, EITHOR ITS FULL OR THERE IS ROOM SO LETS CREATE C A FILE & SEE. C 372 DO 375 I = 1,80 ISPOOL(5) = IKVT(I) CALL CREAT(IDCB1,IER,ISPOOL(3),ISIZE,3,ISPOOL(6),ISPOOL(7)) IF(IER .EQ. -2) GO TO 375 IF(IER .EQ. -18) GO TO 366 IF((IER .NE. -6).AND.(IER .NE. -19)) GO TO 373 7001 CALL EXEC(2,LU,IFULL,17) GO TO 367 C 373 IF(IER .LT. 0) GO TO 5020 CALL CLOSE(IDCB1,IER) GO TO 389 375 CONTINUE GO TO 5130 C C C **************************** C * GET THE SPOOL LU !!!! * C **************************** C C 389 CALL SPOPN(ISPOOL,ISLU) IF (ISLU .GT. 0) GO TO 390 C C UNSUCCESSFUL SPOOL OPEml������þúN MUST NOT HAVE BEEN A SPOOL LU C SO CLEAN UP THE MESS WE JUST CAUSED C CALL PURGE(IDCB1,IERR,ISPOOL(3),ISPOOL(6),ISPOOL(7)) GO TO 399 C 390 IPBUF(12) = ISLU C SPMSG(8) = ISPOOL(3) SPMSG(9) = ISPOOL(4) SPMSG(10) = ISPOOL(5) CALL REIO(2,LU,SPMSG,10) C 399 CALL INAMR(IPBUF(12),IXBF,120,NCHRS) C C C C C************************************************************************ C* NOW CHECK OUT THE RELO NAMR * C************************************************************************ C C 400 IRELO = IAND(IPBUF(26),3) IF((IRELO.EQ.3).OR.(IRELO .EQ. 1)) GO TO 425 IF (IOR(IAND(IPBUF,77400B),40B).NE.2H& ) GO TO 425 IPBUF(23) = 2H- IPBUF(26) = 3 425 CALL INAMR(IPBUF(23),IXBF,120,NCHRS) C C PUSH A NULL FOR # OF LINES PER PAGE C CALL INAMR(IPBUF(111),IXBF,120,NCHRS) C C C************************************************************************** C* NOW LOOK FOR THE LANGUAGE TO SCHEDULE * C************************************************************************** C C IF (IAND(IPBUF(37),3) .NE. 3 ) GO TO 600 C C WE HAVE A LANGUAGE, SEE IF IT MAKES SENSE. C ILANG = 1 IF((IPBUF(34).EQ.2HFT).AND.(IOR(IAND(IPBUF(35),177400B),40B) & .EQ. 2HN )) GO TO 475 C ILANG = 5 IF((IPBUF(34).EQ. 2HMI) .AND. (IPBUF(35) .EQ. 2HCM)) GO TO 475 C C DO 450 ILANG = 1,11 IF(IPROG(1,ILANG) .NE. IPBUF(34)) GO TO 450 IF(IPROG(2,ILANG) .NE. IPBUF(35)) GO TO 450 IF(IPROG(3,ILANG) .NE. IPBUF(36)) GO TO 450 GO TO 475 450 CONTINUE C C IF WE FELL THRU COULDN'T FIND A LANGUAGE C C C C AT THIS POINT WE DON'T HAVE A LANG OR THE LANG SUPPLIED C DIDN'T MAKE ANY SENSE. HOWEVER, WE DO HAVE THE SOURCE C FILE NAME. SO LETS GO OUT AND READ ,SAY, THE FIRST 10 C RECORDS. IF WE FIND A CONTROL STATEMENT THAT MAKE[ü������þúS C SENSE WE WILL INVOKE THAT LANGUAGE. C C 600 CALL OPEN(IDCB1,IER,IPBUF,0,IPBUF(5),IPBUF(6)) IF (IER .LT. 0) GO TO 5035 C DO 650 I = 1,10 IPRMT(2) = 2H IPRMT(3) = 2H CALL READF(IDCB1,IER,IPRMT,3,LEN) IF (LEN .EQ. -1) GO TO 660 IF (IER .LT. 0) GO TO 5050 IONE = 1 CALL NAMR(IPBUF(111),IPRMT,5,IONE) C C ILANG = 1 IF((IPBUF(111).EQ.IPROG).AND.(IOR(IAND(IPBUF(112),177400B),40B) & .EQ. 2HN )) GO TO 690 C ILANG = 5 IF((IPBUF(111).EQ. 2HMI) .AND. (IPBUF(112) .EQ. 2HCM)) GO TO 690 C DO 640 ILANG = 1,11 IF ( IPROG(1,ILANG) .NE. IPBUF(111)) GO TO 640 IF ( IPROG(2,ILANG) .NE. IPBUF(112)) GO TO 640 IF ( IPROG(3,ILANG) .NE. IPBUF(113)) GO TO 640 GO TO 690 640 CONTINUE 650 CONTINUE C C OK I GIVE UP ! YOU TELL ME WHICH LANGUAGE YOU WANT. I CAN'T C FIGURE IT OUT. C 660 CALL CLOSE(IDCB1,IER) IF (IER .LT. 0) GO TO 5060 GO TO 5070 C 690 CALL CLOSE(IDCB1,IER) IF (IER .LT. 0 ) GO TO 5060 C C C FOUND A LANGUAGE & IT MAKES SENSE. SO SEE IF THERE ARE ANY C EXTRA PARAMETERS C C C TAKE INTO ACCOUNT CONTROL STATEMENTS THAT DON'T MATCH C PROGRAM NAME. C 475 IF(ILANG .EQ. 8) ILANG = 9 IF(ILANG .EQ. 2) ILANG = 10 C IFLAG = 0 DO 500 I = 45,100,11 ITYPE = IAND(IPBUF(I+3),3) IF(ITYPE .EQ. 3) GO TO 480 IF(ITYPE .EQ. 0) GO TO 500 IF((IPBUF(I) .LT.0) .OR. (IPBUF(I) .GT.9)) GO TO 500 IPBUF(I) = (IPBUF(I) +60B) * 256 + 40B 480 IF (IPBUF(I) .EQ. 20040B) GO TO 500 C C PUSH THE CHARACTER INTO THE BUFFER C CALL CPUT(IPBUF(I)) IFLAG = 1 500 CONTINUE C IF((IFLAG .EQ. 0) .AND. (KOUNT .GT. 3)) CALL CPUT(IOPT) C C C*********************************************************************** C* NOW DO THE ID MANAGEMENT FOR THE LANGUAGE * C*****************************ù������þú****************************************** C C C THE LANGUAGE TO INVOKE IS IPROG(1,ILANG) AND OUR TERMINAL C ASCII LU IS IN ISPOOL(4). SO GET THE NAME NEED FOR IDDUP,IDRPD, C AND IDRPL. C D CALL REIO(2,1,IXBF,-NCHRS) C CALL XQPRG(IDCB1,23,IPROG(1,ILANG),INOP,IXBF,-NCHRS,IRTN,IERROR) IF(IRTN .EQ. 100000B) GO TO 5225 IF(IERROR .NE. 0) GO TO 850 IF(IRTN .NE.0) GO TO 5245 GO TO 899 C 850 GO TO (5080,5240,5090,5155,5105,5140,5080,5225,5225) IERROR C C C************************************************************************* C* SET UP THE LOADR * C************************************************************************* C C FIRST CHECK FOR THE - OPTION. IE &XXXXX GOES TO %XXXXX. C 899 NCHRS = 4 IF(IPBUF(23) .EQ. 0) GO TO 9000 IF(IRELO .EQ. 1) CALL EXEC(3,IPBUF(23)+400B) IF (IPBUF(23) .NE. 2H- ) GO TO 900 IPBUF = IAND(IPBUF,377B) + 22400B CALL INAMR(IPBUF,ILOADR,34,NCHRS) GO TO 925 C 900 CALL INAMR(IPBUF(23),ILOADR,34,NCHRS) C 925 ILOAD(2) = ILOAD(2) + ISPOOL(4)/256 ILOAD(3) = INAME(3) CALL INAMR(IPBUF(12),ILOADR,34,NCHRS) C CALL XQPRG(IDCB1,23,ILOAD4,INOP,ILOADR,-NCHRS,IRTN,IERROR) C C OK, SO NOW CHECK FOR ERRORS. C IF(IRTN .EQ. 100000B) GO TO 6230 IF(IERROR .NE. 0) GO TO 950 IF(IOR(IAND(IRTN(4),177400B),40B) .EQ.2HL ) GO TO 6250 GO TO 9000 C 950 GO TO (5079,5240,6090,6155,6105,6140,5079,6230,6230)IERROR C C OK SO YOU MADE IT. NOW LETS CLEAN UP THE MESS WE MADE. C FIRST GET LETS RETURN THE SPOOL LU. THEN WE'LL GET RID OF THE C ID SEGMENT. C C C C C C*************************************************************************** C* ERRORS * C*************************************************************************** C C 5005 CALL CLERR(1,0,Lí[������þúU) 5010 CALL EXEC(2,LU,IM5010,18) GO TO 9000 C 5020 IFMERR(8) = IKVT( - IER) CALL EXEC(2,LU,IFMERR,23) CALL EXEC(2,LU,IPROCD,21) GO TO 399 C 5035 CALL CLERR(2,0,LU) 5040 IFMGR(8) = IKVT( - IER) IFMGR(7) = 2H-0 CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5040,16) CALL CLOSE(IDCB1,IER) GO TO 9000 C 5050 CALL CLERR(3,0,LU) IM5040(11) = 2HRE IM5040(12) = 2HAD GO TO 5040 5060 CALL CLERR(4,0,LU) IM5040(11) = 2HCL IM5040(12) = 2HOS IM5040(13) = 2HE GO TO 5040 C 5070 CALL CLERR(5,0,LU) CALL EXEC(2,LU,IM5070,15) GO TO 9000 C 5079 IM5080(5) = 2H IM5080(6) = 2HLO IM5080(7) = 2HAD IM5080(8) = 2HR CALL CLERR(36,0,LU) GO TO 5085 5080 CALL CLERR(6,0,LU) 5085 CALL EXEC(2,LU,IM5080,17) GO TO 9000 C 5090 CALL CLERR(7,0,LU) IM5090(5) = IPROG(1,ILANG) IM5090(6) = IPROG(2,ILANG) IM5090(7) = IPROG(3,ILANG) 5095 CALL EXEC(2,LU,IM5090,20) GO TO 9000 C 5105 CALL CLERR( 8,0,LU) IER = IRTN 5110 IFMGR(8) = IKVT(IABS(IER)) IFMGR(7) = 2H 0 IF(IER .LT.0) IFMGR(7) = 2H-0 CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5110,20) GO TO 9000 C 5130 CALL CLERR(11,0,LU) CALL EXEC(2,LU,IM5130,16) GO TO 9000 C 5140 IM5110(5) = 2HCK IM5110(6) = 2HSU IM5110(7) = 2HM IER = 19 CALL CLERR(9,0,LU) GO TO 5110 5155 IM5110(5) = 2HOP IM5110(6) = 2HEN IM5110(7) = 2H CALL CLERR(10,0,LU) IER = IRTN GO TO 5110 5225 CALL CLERR(12,0,LU) 5230 CALL EXEC(2,LU,IM5230,18) GO TO 9000 C 5240 IFMGR(7) = 2H 0 IFMGR(8) = 2H14 CALL CLERR(14,0,LU) CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5240,17) GO TO 9000 C 5245 CALL CLERR(13,0,LU) 5250 CALL EXEC(2,LU,IM5250,18) IRTN = 100000B GO TO 9000 C 5260 CALL CLERRW���B��@<(15,0,LU) CALL EXEC(2,LU,IM5260,10) GO TO 9000 6090 IM5090(5) = 2HLO IM5090(6) = 2HAD IM5090(7) = 2HR CALL CLERR(33,0,LU) GO TO 5095 C 6105 CALL CLERR(30,0,LU) IER = IRTN 6110 IM5110(16) = 2H L IM5110(17) = 2HOA IM5110(18) = 2HDR IM5110(19) = 2H IM5110(20) = 2H GO TO 5110 C 6140 IM5110(5) = 2HCK IM5110(6) = 2HSU IM5110(7) = 2HM IER = 19 CALL CLERR(31,0,LU) GO TO 6110 6155 IM5110(5) = 2HOP IM5110(6) = 2HEN IM5110(7) = 2H CALL CLERR(32,0,LU) IER = IRTN GO TO 6110 C 6230 IM5230(5) = 2H IM5230(6) = 2HLO IM5230(7) = 2HAD IM5230(8) = 2HR CALL CLERR(34,0,LU) GO TO 5230 C 6250 IM5250(5) = 2H IM5250(6) = 2HLO IM5250(7) = 2HAD IM5250(8) = 2HR CALL CLERR(35,0,LU) GO TO 5250 6260 CALL CLERR(37,0,LU) CALL EXEC(2,LU,IM6260,19) C 9000 IF(ISLU .GT. 0) CALL EXEC(23,ISMP,4,ISLU) 9999 CALL EXEC(2,LU,IDONE,6) CALL PRTN(IRTN) CALL EXEC(6,0) END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÚqB������ÿÿ����� ���� ÿý�2�B ���������ÿ��92067-18359 1903� S C0122 �&COMPL � � � � � � � � � � � � � �H0101 ‹Œ�����þúFTN4 C C C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C NAME: COMPL C SOURCE: 92067-18359 C RELOC: 92067-16359 C PGMR: C.M.M. C C C THE COMPL PROGRAM IS A FRIENDLY INTERFACE TO ALL SUPPORTED C HP-1000 SYSTEM LANGUAGES. C IT PROVIDES THE FUNCTIONS OF ID SEGMENT MANAGEMENT, SPOOL C LU MANAGEMENT, SCHEDULING OF THE DESIRED LANGUAGE, AND C REQUIRED CLEAM UP. C C C C C PROGRAM COMPL (3,90),92067-16359 REV.1903 790503 DIMENSION IBUF(60),IXBF(60),IPROG(3,11),IREG(2),IWARN1(22) DIMENSION IDCB1(144),SPMSG(10),ISPOOL(16),IPROCD(21) DIMENSION IPBUF(120),IPRMT(16),INAME(3),IRTN(5),ISMP(3) DIMENSION IMOUNT(28),IFULL(17),IFMERR(23),ISPCN(3) DIMENSION IM5010(18),IM5040(16),IM5070(15),IM5080(17) DIMENSION IM5090(20),IM5110(20),IM5130(16),IM5230(18) DIMENSION IM5240(17),IM5250(18),IFMGR(12),IDONE(6) DIMENSION IXREF(3),INOP(5),IM5260(10),INFORM(15) C LOGICAL IFTTY INTEGER GETSP,SPMSG DOUBLE PRECISION XPROG(9) EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) EQUIVALENCE (IPROG,XPROG) C C THE FOLLOWING ARE THE PROGRAMS THAT WE CAN TALK TO C IF YOU WANT ANOTHER PROGRAM JUST ADD IT TO THE LIST C AND INCREASE THE LENGTH OF THE IPROG DIMENSION. C DATA ISPOOL/0,0,2HCO,2HMP,2H00,0,0,0,400B,99,0,0,0,0,0,0/ C DATA INFORM/2H/C,2HOM,2HPL,2H: , & 2HIN,2HFO,2HRM,2H S,2HYS,2HTE,2HM , & 2HMA,2HNA,2HGE,2HR./ C DATA ISMP/2HSM,2HP ,2H / DATA IXREF/2HXR,2HEF,2H / DATA ISPCN/2HSP,2HLC,2HON/ C DATA IWARN1/2H/C,2HOM,2HPL.”������þú,2H: , &2HWA,2HRN,2HIN,2HG,,2H ,2HSP,2HOO,2HL ,2HDI,2HSC,2H I,2HS , &2HGE,2HTT,2HIN,2HG ,2HFU,2HLL/ C DATA IPROCD/2H/C,2HOM,2HPL,2H: , &2HCO,2HMP,2HIL,2HAT,2HIO,2HN ,2HIS,2H P,2HRO,2HCE,2HED,2HIN,2HG , &2HNO,2HRM,2HAL,2HLY/ C DATA IMOUNT/2H/C,2HOM,2HPL,2H: ,2HWA,2HRN,2HIN,2HG,,2H , &2HSP,2HOO,2HL ,2HDI,2HSC,2H N,2HOT,2H M,2HOU,2HNT,2HED , &2H T,2HO ,2HTH,2HIS,2H S,2HES,2HSI,2HON/ C DATA IFULL /2H/C,2HOM,2HPL,2H: ,2HWA,2HRN,2HIN,2HG,,2H , &2HSP,2HOO,2HL ,2HDI,2HSC,2H F,2HUL,2HL / C DATA IFMERR/2H/C,2HOM,2HPL,2H: , &2HFM,2HGR,2H-0,2HXX,2H ,2H ,2HER,2HRO,2HR ,2HON,2H S,2HPO, &2HOL,2H F,2HIL,2HE ,2HCR,2HEA,2HT / C DATA IM5010/2H/C,2HOM,2HPL,2H: , &2HSO,2HUR,2HCE,2H I,2HNP,2HUT,2H M,2HUS,2HT ,2HBE,2H A,2H F, &2HIL,2HE / C DATA IM5040/2H/C,2HOM,2HPL,2H: , &2HSO,2HUR,2HCE,2H F,2HIL,2HE ,2HOP,2HEN,2H ,2HER,2HRO,2HR / C DATA IM5070/2H/C,2HOM,2HPL,2H: , &2HUN,2HRE,2HCO,2HGN,2HIZ,2HED,2H L,2HAN,2HGU,2HAG,2HE / C DATA IM5080/2H/C,2HOM,2HPL,2H: , &2HLA,2HNG,2HUA,2HGE,2H S,2HCH,2HED,2HUL,2HIN,2HG ,2HER,2HRO,2HR / C DATA IM5090/2H/C,2HOM,2HPL,2H: , &2H ,2H ,2H ,2HNO,2HT ,2HLO,2HAD,2HED,2H O,2HN ,2HTH,2HIS, &2H S,2HYS,2HTE,2HM / C DATA IM5110/2H/C,2HOM,2HPL,2H: , &2HCL,2HOS,2HE ,2HER,2HRO,2HR ,2HON,2H ',2HRP,2H' ,2HOF,2H L, &2HAN,2HGU,2HAG,2HE / C DATA IM5130/2H/C,2HOM,2HPL,2H: , &2HMO,2HRE,2H T,2HHA,2HN ,2H80,2H S,2HPO,2HOL,2H F,2HIL,2HES/ C DATA IFMGR/2H/C,2HOM,2HPL,2H: ,2HFM,2HGR,2H-0,2HXX,2H , &2HER,2HRO,2HR / C DATA IM5230/2H/C,2HOM,2HPL,2H: , &2HCO,2HMP,2HIL,2HER,2H A,2HBO,2HRT,2HED,2H A,2HBN,2HOR,2HMA,2HLL, &2HY / C DATA IM5240/2H/C,2HOM,2HPL,2H: , &2HSY,2HST,2HEM,2H O,2HUT,2H O,2HF ,2HID,2H S,2HEG,2HME,2HNT,2HS / C DATA IM5250/2H/C,2HOM,2HPL,2H: , &2HCO,2HMP,2HIL,2HER,2H P,2HAS,2HSE,2HD ,2HBA,2HCK,2H E,2HRR,2HOR, ¡A������þú &2HS / C DATA IM5260/2H/C,2HOM,2HPL,2H: , &2HIN,2HPU,2HT ,2HER,2HRO,2HR./ C DATA IDONE/2H/C,2HOM,2HPL,2H: ,2HEN,2HD / DATA ISIZE/24/ DATA MLEN/20/ C DATA IOPT/2HR / C DATA SPMSG/2HSP,2HOO,2HL ,2HFI,2HLE,2H =,2H ,2H ,2H ,2H / C DATA IPROG/2HFT,2HN4,2H , & 2H$P,2HAS,2HC , & 2HAS,2HMB,2H , & 2HCO,2HBO,2HL , & 2HMI,2HCR,2HO , & 2HRP,2HG ,2H , & 2HSP,2HL ,2H , & 2HHP,2HAL,2H , & 2HAL,2HGO,2HL , & 2HPA,2HSC,2HL , & 2HSN,2HOB,2HL / C C DATA IBUF/2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / C C DATA IXBF/2H,,,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , & 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / C DATA IPRMT/ 2HNA,2HMR,2H(S,2H),, & 2HNA,2HMR,2H(L,2H),, & 2HNA,2HMR,2H(R,2H),, & 2H<C,2H.S,2H.>/ C C C IKVT(IERR) = 2H00 + (IERR/10*256) + MOD(IERR,10) C C C C C C C GET THE LU OF OUR TERMINAL & PICK UP THE SCHEDULING STRING C LU = LOGLU(LU) CALL LUTRU(LU,LUX) ISPOOL(4) = IKVT(LUX) LU = LU + 400B REG= EXEC(14,1,IBUF,-120) IF(IA.EQ.1) GO TO 175 LENGTH = IB ISTRC = 1 ¹������þúC C PARSE TWICE & THROW AWAY (DON'T NEED THE ' RU,COMPL ' ) C CALL NAMR(IPBUF,IBUF,LENGTH,ISTRC) CALL NAMR(IPBUF,IBUF,LENGTH,ISTRC) C C PARSE AS MANY TIMES AS REQUIRED C 25 DO 100 KOUNT = 0,9 IPBUF(11+KOUNT*11) = ISTRC IA = NAMR(IPBUF(1 + 11*KOUNT),IBUF,LENGTH,ISTRC) IF (IA .LT. 0) GO TO 150 100 CONTINUE C C KOUNT = 0 IF RU,COMPL C KOUNT = 1 IF RU,COMPL,SORC C KOUNT = 2 IF RU,COMPL,SORC,LIST C KOUNT = 3 IF RU,COMPL,SORC,LIST,RELO C KOUNT = 4 IF RU,COMPL,SORC,LIST,RELO,LANG C KOUNT = 5 IF RU,COMPL,SORC,LIST,RELO,LANG,A C KOUNT = 6 IF RU,COMPL,SORC,LIST,RELO,LANG,A,B C KOUNT = 7 IF RU,COMPL,SORC,LIST,RELO,LANG,A,B,C C KOUNT = 8 IF RU,COMPL,SORC,LIST,RELO,LANG,A,B,C,D C KOUNT = 9 IF RU,COMPL,SORC,LIST,RELO,LANG,A,B,C,D,E C KOUNT = 10 IF RU,COMPL,SORC,LIST,RELO,LANG,A,B,C,D,E,F C C C SOURCE IN IPBUF( 1) - IPBUF( 11) C LIST IN IPBUF( 12) - IPBUF( 22) C RELO IN IPBUF( 23) - IPBUF( 33) C LANG IN IPBUF( 34) - IPBUF( 44) C OPT PR IN IPBUF( 45) - IPBUF( 55) C OPT PR IN IPBUF( 56) - IPBUF( 66) C OPT PR IN IPBUF( 67) - IPBUF( 77) C OPT PR IN IPBUF( 78) - IPBUF( 88) C OPT PR IN IPBUF( 89) - IPBUF( 99) C OPT PR IN IPBUF(100) - IPBUF(110) C NULL IN IPBUF(111) - IPBUF(120) C C C AT THIS POINT THE ENTIRE INPUT BUFFER HAS BEEN PARSED. C IPBUF BUFFER IS SET UP AS 11 WORDS FOR EACH ENTRY C WORDS 1-10 ARE THE OUTPUT OF NAMR. THE 11 WORD IS C THE CHAR # OF WHERE THE STRING STARTS. C C C NOW CHECK 1ST PARAMETER TO SEE IF NULL OR AN LU C IF A NAMR THEN NO PROMPT IS REQUIRED C 150 IF(IAND(IPBUF(4),3).EQ.3) GO TO 200 C C FIRST PARAMETER IS AN LU OR NOT SUPPLIED SO PROMPT C FOR ADDITIONAL INPUT. BUT MAKE SURE WE DO THIS ONLY ONCE. C IF (IPBUF(11) .EQ. 1) GO TO 5005 175 CALL EXEC(2,LU,IPRMT,16) REG = REIO(1,LU,IBUF,-120) ISTRC = 1 LENGTH…â������þú = IB GO TO 25 C C C OK SO NOW WE HAVE A NAMR. INITIALIZE THE STRING PUSHERS AND C PUSH THE NAMR INTO THE DESTINATION BUFFER. C LENGTH IS THE LENGTH OF THE SOURCE STRING AND EVERY 11TH WORD C IN THE IPBUF BUFFER HAS THE START CHAR COUNT FOR THAT NAMR. C C 200 NCHRS = 2 CALL SETSB(IBUF,ISCH,-120) CALL SETDB(IXBF,NCHRS) C CALL INAMR(IPBUF,IXBF,120,NCHRS) C C************************************************************************** C* FINISHED WITH SOURCE NAMR NOW GET LIST NAMR * C************************************************************************** C C C CHECK FOR COMPILER LIBRARY DEFAULT C IF(IOR(IAND(IPBUF(12),77600B),40B).EQ.2H- ) GO TO 399 LTYPE = IAND(IPBUF(15),3) IF (LTYPE .EQ. 3) GO TO 399 C C LIST NAMR IS AN LU OR NULL C IF (LTYPE .EQ. 1) GO TO 350 C C NO LU OR NULL LU C 320 IPBUF(15) = 1 IPBUF(12) = LU - 400B C C PUSH LIST LU INTO STRING C GO TO 399 C C IF NO SPOOLING IN SYSTEM OR C IF HE DOESN'T WANT SPOOLING OR C IF SPECIFIED LU = A TTY , THEN DON'T SPOOL ANYTHING ! C 350 ISPOOL(7) = GETSP(IDUMY) IF (ISPOOL(7) .GE. 0) GO TO 399 IF (IFTTY(IPBUF(12))) GO TO 399 IF(IPBUF(12) .EQ. 0) GO TO 399 IF (IPBUF(16).EQ.2HNS) GO TO 399 C C OK SO SPOOLING EXISTS IN THE SYSTEM C AND AN LU WAS SPECIFIED . SO CREATE A FILE & CALL SMP C TO USE IT AS A SPOOL FILE. SMP WILL TELL US WHETHER C THE SPECIFIED LU IS OK FOR SPOOLING. IF IT TURNS OUT C THAT THE LU IS NOT FOR SPOOLING THEN WE WILL HAVE TO C PURGE THAT FILE AND JUST SEND THE OUTPUT TO THE LU C NORMALLY. C C ISPOOL(16) = IPBUF(12) * IF((IPBUF(12).GT. 63) .OR.( IPBUF(12).LT.0)) GO TO 5260 IF(LUTRU(IPBUF(12),IA).LT.0) GO TO 5260 CALL EXEC(13,IPBUF(12),ISTATS) 360 ISPOOL(8) = IAND(ISTATS,37400B)/256 C C NOW SEE IF THE SPOOL DIS•”������þúC IS MOUNTED C CALL FSTAT(IDCB1) DO 365 I = 1,120,4 IF(ISPOOL(7) .EQ. - IDCB1(I)) GO TO 370 365 CONTINUE 366 CALL EXEC(2,LU,IMOUNT,MLEN) 367 CALL EXEC(2,LU,IPROCD,21) GO TO 399 C C OK, ITS MOUNTED BUT IS IT GETTING TO BE FULL. IF HE ONLY C HAS A FEW MORE TRACKS LEFT WE'LL WARN HIM. BOY THIS IS C IS SO FRIENDLY IT'S PATERNALISTIC. C 370 MLEN = 28 IFMP = IDCB1(I+1) CALL EXEC(1,IDCB1(I),IDCB1,128,IFMP,0) IF(IDCB1(8) - IDCB1(10) .GT. 40) GO TO 372 C C ONLY A FEW MORE TRACKS LEFT ON THE SPOOL DISC C SO WARN HIM TO CLEAN UP HIS ACT C 7000 CALL EXEC(2,LU,IWARN1,22) CALL EXEC(2,LU,INFORM,15) CALL EXEC(2,LU,IPROCD,21) C C OK, EITHOR ITS FULL OR THERE IS ROOM SO LETS CREATE C A FILE & SEE. C 372 DO 375 I = 1,80 ISPOOL(5) = IKVT(I) CALL CREAT(IDCB1,IER,ISPOOL(3),ISIZE,3,ISPOOL(6),ISPOOL(7)) IF(IER .EQ. -2) GO TO 375 IF(IER .EQ. -18) GO TO 366 IF((IER .NE. -6).AND.(IER .NE. -19)) GO TO 373 7001 CALL EXEC(2,LU,IFULL,17) GO TO 367 C 373 IF(IER .LT. 0) GO TO 5020 CALL CLOSE(IDCB1,IER) GO TO 389 375 CONTINUE GO TO 5130 C C C **************************** C * GET THE SPOOL LU !!!! * C **************************** C C 389 CALL SPOPN(ISPOOL,ISLU) IF (ISLU .GT. 0) GO TO 390 C C UNSUCCESSFUL SPOOL OPEN MUST NOT HAVE BEEN A SPOOL LU C SO CLEAN UP THE MESS WE JUST CAUSED C CALL PURGE(IDCB1,IERR,ISPOOL(3),ISPOOL(6),ISPOOL(7)) GO TO 399 C 390 IPBUF(12) = ISLU C SPMSG(8) = ISPOOL(3) SPMSG(9) = ISPOOL(4) SPMSG(10) = ISPOOL(5) CALL REIO(2,LU,SPMSG,10) C 399 CALL INAMR(IPBUF(12),IXBF,120,NCHRS) C C C C C************************************************************************ C* NOW CHECK OUT THE RELO NAMR * C*************************************************æW������þú*********************** C C 400 IRELO = IAND(IPBUF(26),3) IF((IRELO.EQ.3).OR.(IRELO .EQ. 1)) GO TO 425 IF (IOR(IAND(IPBUF,77400B),40B).NE.2H& ) GO TO 425 IPBUF(23) = 2H- IPBUF(26) = 3 425 CALL INAMR(IPBUF(23),IXBF,120,NCHRS) C C PUSH A NULL FOR # OF LINES PER PAGE C CALL INAMR(IPBUF(111),IXBF,120,NCHRS) C C C************************************************************************** C* NOW LOOK FOR THE LANGUAGE TO SCHEDULE * C************************************************************************** C C IF (IAND(IPBUF(37),3) .NE. 3 ) GO TO 600 C C WE HAVE A LANGUAGE, SEE IF IT MAKES SENSE. C ILANG = 1 IF((IPBUF(34).EQ.2HFT).AND.(IOR(IAND(IPBUF(35),177400B),40B) & .EQ. 2HN )) GO TO 475 C ILANG = 5 IF((IPBUF(34).EQ. 2HMI) .AND. (IPBUF(35) .EQ. 2HCM)) GO TO 475 C DO 450 ILANG = 1,11 IF(IPROG(1,ILANG) .NE. IPBUF(34)) GO TO 450 IF(IPROG(2,ILANG) .NE. IPBUF(35)) GO TO 450 IF(IPROG(3,ILANG) .NE. IPBUF(36)) GO TO 450 GO TO 475 450 CONTINUE C C IF WE FELL THRU COULDN'T FIND A LANGUAGE C C C C AT THIS POINT WE DON'T HAVE A LANG OR THE LANG SUPPLIED C DIDN'T MAKE ANY SENSE. HOWEVER, WE DO HAVE THE SOURCE C FILE NAME. SO LETS GO OUT AND READ ,SAY, THE FIRST 10 C RECORDS. IF WE FIND A CONTROL STATEMENT THAT MAKES C SENSE WE WILL INVOKE THAT LANGUAGE. C C 600 CALL OPEN(IDCB1,IER,IPBUF,0,IPBUF(5),IPBUF(6)) IF (IER .LT. 0) GO TO 5035 C DO 650 I = 1,10 IPRMT(2) = 2H IPRMT(3) = 2H CALL READF(IDCB1,IER,IPRMT,3,LEN) IF (LEN .EQ. -1) GO TO 660 IF (IER .LT. 0) GO TO 5050 IONE = 1 CALL NAMR(IPBUF(111),IPRMT,5,IONE) C ILANG = 1 IF((IPBUF(111).EQ.2HFT).AND.(IOR(IAND(IPBUF(112),177400B),40B) & .EQ. 2HN )) GO TO 690 C ILANG = 5 IF((IPBUF(111).EQ. 2HMI) .AND. (IPBUF(112) .EQlå������þú. 2HCM)) GO TO 690 C DO 640 ILANG = 1,11 IF ( IPROG(1,ILANG) .NE. IPBUF(111)) GO TO 640 IF ( IPROG(2,ILANG) .NE. IPBUF(112)) GO TO 640 IF ( IPROG(3,ILANG) .NE. IPBUF(113)) GO TO 640 GO TO 690 640 CONTINUE 650 CONTINUE C C OK I GIVE UP ! YOU TELL ME WHICH LANGUAGE YOU WANT. I CAN'T C FIGURE IT OUT. C 660 CALL CLOSE(IDCB1,IER) IF (IER .LT. 0) GO TO 5060 GO TO 5070 C 690 CALL CLOSE(IDCB1,IER) IF (IER .LT. 0 ) GO TO 5060 C C C FOUND A LANGUAGE & IT MAKES SENSE. SO SEE IF THERE ARE ANY C EXTRA PARAMETERS C C C TAKE INTO ACCOUNT CONTROL STATEMENTS THAT DON'T MATCH PROGRAM C NAMES. C 475 IF(ILANG .EQ.8) ILANG = 9 IF(ILANG .EQ.2) ILANG = 10 C IFLAG = 0 DO 500 I = 45,100,11 ITYPE = IAND(IPBUF(I+3),3) IF(ITYPE .EQ. 3) GO TO 480 IF(ITYPE .EQ. 0) GO TO 500 IF((IPBUF(I) .LT.0) .OR. (IPBUF(I) .GT.9)) GO TO 500 IPBUF(I) = (IPBUF(I) +60B) * 256 + 40B 480 IF (IPBUF(I) .EQ. 20040B) GO TO 500 C C PUSH THE CHARACTER INTO THE BUFFER C CALL CPUT(IPBUF(I)) IFLAG = 1 500 CONTINUE C IF((IFLAG .EQ. 0) .AND. (KOUNT .GT. 3)) CALL CPUT(IOPT) C C C*********************************************************************** C* NOW DO THE ID MANAGEMENT FOR THE LANGUAGE * C*********************************************************************** C C C THE LANGUAGE TO INVOKE IS IPROG(1,ILANG) AND OUR TERMINAL C ASCII LU IS IN ISPOOL(4). SO GET THE NAME NEED FOR IDDUP,IDRPD, C AND IDRPL. C C D CALL REIO(2,1,IXBF,-NCHRS) C CALL XQPRG(IDCB1,23,IPROG(1,ILANG),INOP,IXBF,-NCHRS,IRTN,IERROR) IF(IRTN .EQ. 100000B) GO TO 5225 IF(IERROR .NE. 0) GO TO 850 IF(IRTN .NE.0) GO TO 5245 GO TO 9000 C 850 GO TO (5080,5240,5090,5155,5105,5140,5080,5225,5225) IERROR C C*********************************************************Ž������þú****************** C* ERRORS * C*************************************************************************** C C 5005 CALL CLERR(1,1,LU) 5010 CALL EXEC(2,LU,IM5010,18) GO TO 9000 C 5020 IFMERR(8) = IKVT( - IER) CALL EXEC(2,LU,IFMERR,23) CALL EXEC(2,LU,IPROCD,21) GO TO 399 C 5035 CALL CLERR(2,1,LU) 5040 IFMGR(8) = IKVT( - IER) IFMGR(7) = 2H-0 CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5040,16) CALL CLOSE(IDCB1,IER) GO TO 9000 C 5050 CALL CLERR(3,1,LU) IM5040(11) = 2HRE IM5040(12) = 2HAD GO TO 5040 5060 CALL CLERR(4,1,LU) IM5040(11) = 2HCL IM5040(12) = 2HOS IM5040(13) = 2HE GO TO 5040 C 5070 CALL CLERR(5,1,LU) CALL EXEC(2,LU,IM5070,15) GO TO 9000 C 5080 CALL CLERR(6,1,LU) 5085 CALL EXEC(2,LU,IM5080,17) GO TO 9000 C 5090 CALL CLERR(7,1,LU) IM5090(5) = IPROG(1,ILANG) IM5090(6) = IPROG(2,ILANG) IM5090(7) = IPROG(3,ILANG) 5095 CALL EXEC(2,LU,IM5090,20) GO TO 9000 C 5105 CALL CLERR( 8,1,LU) IER = IRTN 5110 IFMGR(8) = IKVT(IABS(IER)) IFMGR(7) = 2H 0 IF(IER .LT. 0) IFMGR(7) = 2H-0 CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5110,20) GO TO 9000 C 5130 CALL CLERR(11,1,LU) CALL EXEC(2,LU,IM5130,16) GO TO 9000 C 5140 IM5110(5) = 2HCK IM5110(6) = 2HSU IM5110(7) = 2HM IER = 19 CALL CLERR(9,1,LU) GO TO 5110 5155 IM5110(5) = 2HOP IM5110(6) = 2HEN IM5110(7) = 2H CALL CLERR(11,1,LU) IER = IRTN GO TO 5110 5225 CALL CLERR(12,1,LU) 5230 CALL EXEC(2,LU,IM5230,18) GO TO 9000 C 5240 IFMGR(7) = 2H 0 IFMGR(8) = 2H14 CALL CLERR(14,1,LU) CALL EXEC(2,LU,IFMGR,12) CALL EXEC(2,LU,IM5240,17) GO TO 9000 C 5245 CALL CLERR(13,1,LU) IRTN = 100000B 5250 CAR���<��:6LL EXEC(2,LU,IM5250,18) GO TO 9000 C 5260 CALL CLERR(15,1,LU) CALL EXEC(2,LU,IM5260,10) C 9000 IF(ISLU .GT. 0) CALL EXEC(23,ISMP,4,ISLU) 9999 CALL EXEC(2,LU,IDONE,6) CALL PRTN(IRTN) CALL EXEC(6,0) END END$ ��������������������������������������������X<������ÿÿ����� ���� ÿý�3�B ���������ÿ��92067-18360 2013� S C0122 �&ACCT1 �ACCTS MAIN AND SEGMENTS � � � � � � � � � � � � �H0101 +û�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C SOURCE PART NUMBER : 92067-18360 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C PROGRAM ACCTS(20,90),92067-16361 REV.2013 800131 C C C C C C DESCRIPTION: C C C C C ACCOUNT FILE STRUCTURE: C C C ACERR CODES: C 12 LU NOT IN SESSION SWITCH TABLE C 13 TRANSFER STACK OVERFLOW C -07 NOT LOGGED ON AS SYSTEM MANAGER C -200 ACCOUNT NOT FOUND C -201 NO FREE ACCOUNTS C -202 ACCOUNT WITH THIS NAME ALREADY EXISTS C -203 INVALID ACCOUNT NAME C -204 INVALID PASSWORD C -205 INVALID COMMAND C -206 INVALID FILE NAME C -207 INVALID CAPABILITY C -208 INVALID DISC LIMIT C -209 INVALID SST ENTRY C -210 CONFLICT IN SST DEFINITION C -211 USER OR GROUP ID NOT AVAILABLE C -212 INVALID NUMBER OF SST SPARES C -215 LIST NAMR IN TRANSFER STACK C -218 SESSION NOT SHUT DOWN C -219 NOT ENOUGH ROOM IN FILE FOR NEW TABLE C -220 CORRUPT STATION TABLE SPARES C -221 NOT AN ACTIVE SESSION C -222 ILLEGAL SYSTEM LU C -223 ILLEGAL SHUT DOWN PARAMETER C -225 SESSION MEMORY CAN NOT BE C RETURNED TO SYSTEM (REBOOT) C C C C LOGICAL XFTTY,LOFLG DIMENSION IAB(2),LUX(2),IPARM(5) COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(12) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40),NAMPR(3),ICLFG,NMPR3 COMMON /ACOM5/LOWUS,IHIGR COF¨������þúMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH,ISR1,ISR2 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA IERR / 0 / DATA LUX / 0,0 / DATA IPARM / -1,0,0,0,0 / CALL RMPAR(IPBUF) CALL PNAME(JBUF) NAMSG(1)=JBUF(1) NAMPR(1)=JBUF(1) NMPR3=JBUF(3) ITYPE=IPBUF(1)-1 ITTY=0 IF(ITYPE.GE.0) ITTY=ITYPE+1 IF(ITYPE.NE.-2) GO TO 4 C C IF CLEAN UP OR INITIALIZE THEN DETACH C CALL DTACH GO TO 5 C C ELSE SET TYPE TO 0 C 4 ITYPE=0 C C SET ORIGINAL INPUT TO LOGLU C 5 LULOG=LOGLU(LULOG) IF(ITTY.LE.0.OR.ITTY.GE.255) ITTY=LULOG IF(XFTTY(ITTY)) LULOG=ITTY ITTY=LUTRU(ITTY) LULOG=LUTRU(LULOG) ISTK(1)=ITTY C C SET UP INPUT FILE C C C GO GET RUN STRING C CALL EXEC(14,1,ICMND,40) CALL ABREG(IA,IB) DO 10 I=IB+1,40 10 ICMND(I)=2H ISTRC=1 CALL NAMR(IPBUF,ICMND,80,ISTRC) CALL NAMR(IPBUF,ICMND,80,ISTRC) IERR=0 CALL ACXFR(ICMND,ISTRC,IERR) IF(IERR.EQ.0) GO TO 20 IF(IERR.EQ.10) IERR=00 CALL ACERR(IERR) C C GO INITIALIZE C 20 LOFLG=.TRUE. KPB=0 ASSIGN 30 TO LRTRN ASSIGN 60 TO LRTR2 CALL ACLNK (2H1 ,1) 30 IF(KPB.NE.-31178) GO TO 40 CALL ACHLP(IPBUF,ISTRC) GO TO 20 C 40 LOFLG=.FALSE. IF(ITYPE.EQ.-4) GO TO 55 C C CREAT ACCOUNTS C IEXIT=0 50 CALL ACMND(IEXIT) IF(IEXIT.EQ.0) GO TO 50 C C FINISH MEMORY INITIALIZATION C 55 ASSIGN 60 TO LRTR2 CALL ACLNK (2H1 ,2) 60 IEXIT=-1 IF(ITYPE.LT.0) GO TO 110 C C VERIFY THE USER'S PASSWORD C IF(LOFLG.AND.IDSES.EQ.0) CALL ACPAS C C ENTEIú������þúR THE COMMAND LOOP C IPCNT=0 IEXIT=0 100 CALL ACMND(IEXIT) C C GO CLEAN UP FILE C 110 ASSIGN 120 TO LRTRN IF(IPFLG.EQ.0) GO TO 120 IF(IPFLG.GT.1) GO TO 115 CALL ACLNK(2H1 ,3) C 115 IPFLG=IPFLG-1 C C CLEAN UP CLASS BUFFERS C 120 ICLFG=-1 CALL EXEC(100025B,ICLASS,JBUF,1) GO TO 150 130 CALL ABREG(ICLFG,IB) IF(0.LE.ICLFG) GO TO 120 150 IF(IEXIT.EQ.0) GO TO 100 CALL ACTRM C C THIS INSTRUCTION IS REQUIRED C SO THAT ACOM5 WILL BE INCLUDED C INTHE MAIN WHEN ACCTS IS RELOCATED C AT GENERATION TIME. WE LUCKED OUT ON C OTHER NAMED COMMONS. C 250 IH=IHIGR END BLOCK DATA GLOBL LOGICAL ISRCH INTEGER SETBUF(128) COMPLEX SNAME(3) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(12) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40),NAMPR(3),ICLFG,NMPR3 COMMON /ACOM5/LOWUS,IHIGR,ITRN COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG,KERRB(8),LLST(4) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID,ICRN EQUIVALENCE (LDCB(17),SETBUF) EQUIVALENCE (NAMSG,SNAME) DATA ISRCH/.FALSE./ DATA IPFLG,ICLFG /0,-1/ DATA KERRB / 2HHE,2H, ,2HAC,2HCT,2H00,2H00,2H , ,2H / DATA IECHO/ 0 / DATA SNAME / 8H ,8HSEGMENT ,8HMISSING / DATA KECHO/ 400B / DATA IPT / 0 / DATA LIST(1) / -1 / DATA NAMSG /2HAC,2HCT,2HS / DATA NAMPR /2HAC,2HCT,2HS / DATA SETBUF /2HNE,2H,G,2HR ,0 ,2HSY,2HS ,0 ,2H/E,0 ,2HNE, * 2H,G,2HR ,0,2HSU, 1 2HPP,2HOR,2HT ,0 ”@������þú ,2H/E,0 ,2HNE,2H,G,2HR ,0 ,2HGE,2HNE, 2 2HRA,2HL ,0 ,2H/E,0 ,2HNE,2H,U,2HS ,0 ,2HMA,2HNA,2HGE, 3 2HR ,0 ,2HSY,2HS ,0,2HY ,0,2HPA,2HSS,2HWO,2HRD,2H ,0,2H , 4 0 ,2H63,0 ,2H10,0 ,2H/E,0 ,2H10,0 ,2H ,0 ,2H/E, 5 0 ,2HNE,2H,U,2HS ,0 ,2HEN,2HGI,2HNE,2HER,0 ,2HSU,2HPP, 6 2HOR,2HT ,0 ,2HY ,0 ,2HHP,2H31,2H17,2H8 ,0 ,2H ,0 , 7 2H63,0 ,2H10,0 ,2H/E,0 ,2H10,0 ,2H ,0 ,2H/E,0 , 8 2HEX,0 ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , 9 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , A 2H ,2H ,2H ,2H / END C C ACCT1 - ROUTINE TO PERFORM SESSION MONITOR INITIALIZATION C C CALLING SEQUENCE: CALL ACLNK (2H1 ,1) C FOR FILE INITIALIZATION C CALLING SEQUENCE: CALL ACLNK (2H1 ,2) C FOR MEMORY INITIALIZATION C CALLING SEQUENCE: CALL ACLNK (2H1 ,3) C FOR MEMORY RELEASE C C IF ITYPE < 0 THEN BOOTUP C C C ACERRS: FMP ACERR (ACOPN,READF,WRITF) C C SEQUENCE OF OPERATIONS: C 1. OPEN THE ACCOUNT FILE C 2. ALLOCATE GLOBAL RESOURCE NUMBER IF NOT YET ALLOCATED C 3. READ LOCATION WORDS FROM HEADER TO COMMON C 4. READ LOWEST USER ID, HIGHEST GROUP ID TO COMMON C C PROGRAM ACCT1(5),92067-16361 REV.2001 791020 COMPLEX BUF13(2),MESG1(3),MESG2(3) DIMENSION IBF12(8) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM4/ICMND(40) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE COMMON /ACOMC/ IECHO,LULOG,ITLOG COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID,ICRN COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) EQUIVALENCE (BUF13îJ������þú,IBF12(2)),(IPBUF,IPB) C DATA BUF13,IBF12 /8HPLEASE L ,8HOG-ON: _ ,-16 / C DATA MESG1 / 8H ,8HWORDS RE,8HQUESTED / DATA MESG2 / 8H ,8HWORDS AV,8HAILABLE / ASSIGN 10 TO LTOSEG 10 GO TO (50,4995,8000,5000),LGOTO C C OPEN ACCOUNT FILE C 50 IDSES=0 CALL ACOPN(IERR,IDSES) ITTYT=ITTY IF(IERR.GE.0) GO TO 5000 IF(IERR.EQ.-6) GO TO 100 CALL ACERR(IERR) CALL ACTRM C C SET IDSES TO SYSTEM MANAGER TO CREATE C ACCOUNTS FILE C 100 IDSES=7777B CALL ACWRI(24HSESSION NOT INITIALIZED ,12) IF(ITYPE.LT.0) CALL ACTRM C C PROMPT FOR LOAD OR INITIALIZE C 125 CALL ACNVS(24HENTER IN,LO,HE OR /TR _ ,12,0) IF(IPB.NE.2HHE) GO TO 127 KPB=-31178 GO TO LRTRN C 127 IF(IPB.EQ.2HIN) GO TO 150 IF(IPB.EQ.2H/E.OR.IPB.EQ.2H/A) GO TO 200 IF(IPB.NE.2HLO) GO TO 125 CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) IF(LIST(1).EQ.0.AND.LIST(4).EQ.1) GO TO 135 CALL ACOPL(IERR,1,0) IF(IERR.EQ.0) GO TO 140 130 CALL ACERR(IERR) GO TO 125 135 IERR=12 GO TO 130 C C ALLOCATE RESOURCE NUMBERS C 140 CALL RNRQ(24B,IRN,ISTAT) CALL RNRQ(24B,IRN2,ISTAT) C C SET OLD SIZE OF DISC POOL TO 0 C IDSZE=0 C C SET ITYPE TO LOAD C ITYPE=-4 C C GO LOAD THE ACCOUNTS FILE C CALL ACLNK (2H2 ,3) C C C GO INTERACTIVE TO INITIALIZE SESSION'S FILE C PROMPT FOR CRN C 150 CALL ACNVS(32HENTER DISC LU FOR ACCTS FILE : _ ,16,0) ICRN=IPBUF(1) IF(ICRN.EQ.2H/A ) GO TO 200 IF(ICRN.GT.0) ICRN=-ICRN C C PROMPT FOR SESSION LIMIT C CALL ACNVS(16HSESSION LIMIT? _,8,0) IF(IPBUF(1).NE.2H/A) GO TO 300 200 ITYPE=-1 GO TO LRTR2 300 ISL=IPBUF(1) IF(IPBUF(4).NE.1) ISL=16 C C PROMPT FOR SESSION MEMORY ALLOCATION C 400 CALL ACNVS(38HSESSION MEMORY ALLOCATl¦������þúION? (Y OR N) _,19,0) IF(IPBUF(1).EQ.2H/A) GO TO 200 IF(IPBUF(1)/256.EQ.116B) GO TO 500 450 MEM=70-ISL IF(MEM.LT.50) MEM=50 MEM=-MEM*ISL GO TO 600 500 CALL ACNVS(28HNO. OF WORDS TO ALLOCATE? _,14,0) IF(IPBUF(1).EQ.2H/A) GO TO 200 MEM=IPBUF(1) C C IF MEMORY TO SMALL FOR 1 SESSION USE SESSION ALLOCATION C IF(MEM.LT.50) GO TO 450 C C PROMPT FOR NUMBER OF ACCOUNTS C 600 CALL ACNVS(26HNUMBER OF USER ACCOUNTS? _,13,0) IF(IPBUF(1).EQ.2H/A ) GO TO 200 IACCTS=IPBUF(1)+IPBUF(1)/5 CALL ACNVS(28HNUMBER OF GROUP ACCOUNTS? _,14,0) IF(IPBUF(1).EQ.2H/A) GO TO 200 IACCTS=(((IACCTS+IPBUF(1))/8)+1)*8-1 IAST=(ISL-1)/32+2 IF(IAST.LT.3) IAST=3 ICNGT=ISL/2+1 ISIZE=IACCTS/2+1+IACCTS/8+IAST+ISL+5 CALL ACCRE(NDCB,2H+@,ISIZE,IERR) IF(IERR.GE.0) GO TO 700 CALL ACWRI(8HCREAT _,4) CALL ACERR(IERR) CALL ACTRM C C C PROMPT FOR MESSAGE FILE NAMR C 700 CALL ACNVS(22HSYSTEM MESSAGE FILE? _,11,0) IF(IPBUF(1).EQ.2H/A) GO TO 7000 J=6 DO 800 I=1,6 IF(I.NE.5) J=J+1 800 NBUF(J)=IPBUF(I) C IPBU4=IAND(IPBUF(4),3) IF(IPBU4.EQ.3) GO TO 820 IF(IPBU4.EQ.0) GO TO 810 CALL ACERR(-206) GO TO 700 C C SET DEFAULT C 810 NBUF(6)=2H NBUF(7)=2H NBUF(8)=2H C C PROMPT FOR NAME OF PROMPT STRING C 820 CALL ACPRM(14HPROMPT STRING? ,7) CALL ACREI(NBUF(13),IERR) IF(NBUF(13).EQ.2H/A) GO TO 7000 IF(NBUF(13).EQ.2H .AND.ITLOG.LE.2) GO TO 850 IWRD=ITLOG/2 LAROW=77B IF(MOD(ITLOG,2).EQ.0) LAROW=37400B NBUF(13+IWRD)=NBUF(13+IWRD)+LAROW IF(ITLOG.GT.19) ITLOG=19 NBUF(12)=-ITLOG-1 GO TO 1000 C C PUT IN DEFAULT PROMPT STRING C 850 J=12 DO 900 I=1,11 NBUF(J)=IBF12(I) 900 J=J+1 C C SET UP PROMPT STRING C 1000 CALL LMES(NBUF(12),NBUF(13),0) C C C —‰������þú PROMPT FOR LOCATION OF MESSAGE FILES C CALL ACNVS(28HLOCATION OF MESSAGE FILES? _,14,0) IF(IPBUF(1).EQ.2H/A) GO TO 7000 NBUF(28)=-ISL NBUF(31)=-ISL NBUF(29)=0 NBUF(30)=0 NBUF(26)=IPBUF(1) NBUF(23)=4095 NBUF(24)=0 NBUF(25)=0 NBUF(27)=MEM C C CLEAR REST OF BUFFER C DO 1100 I=32,128 1100 NBUF(I)=0 C LOC(1)=2 LOC(2)=IAST+2 LOC(3)=LOC(2)+ICNGT C C C WRITE MOST OF HEADER C CALL WRITF(NDCB,IERR,NBUF,128,1) C C CHECK FOR ACERR C IF(IERR.LT.0) GO TO 6000 C C DEFINE STATION CONFIGURATION C 1200 CALL ACNVS(34HSTATION CONFIGURATION (Y OR N)? _,16,0) IF(IPBUF(1).EQ.2H/A ) GO TO 7000 I=1 IREC=LOC(2) IF(IPBUF(1)/256.NE.131B) GO TO 2350 1300 J=2 CALL ACNVS(14HSTATION LU? _,7,0) IF(IPBUF(1).EQ.2H/E) GO TO 2300 IF(IPBUF(1).EQ.2H/A ) GO TO 1200 LU=IPBUF(1)-1 IF(LU.GE.0.AND.LU.LT.99) GO TO 1400 CALL ACERR(-209) GO TO 1300 1400 JBUF(J)=256*LU J=J+1 1500 CALL ACNVS(22HSESSION LU,SYSTEM LU? ,11,0) IF(IPBUF(1).EQ.2H/A ) GO TO 1300 IF(IPBUF(1).EQ.2H/E) GO TO 2100 LU2=IPBUF(1)-1 CALL NAMR(IPBUF,ICMND,80,ISTRC) LU=IPBUF(1)-1 IF(LU.LT.254.AND.LU.GE.-1) GO TO 1600 CALL ACERR(-209) GO TO 1500 1600 LU=IAND(255,LU) IF(LU2.GE.3.AND.LU2.LT.63) GO TO 1700 CALL ACERR(-209) GO TO 1500 C C TEST FOR CONFLICT C 1700 IF(J.LE.2) GO TO 1900 DO 1800 JJ=2,J-1 IF(LU2.EQ.IAND(JBUF(JJ),377B)) GO TO 2000 1800 CONTINUE 1900 JBUF(J)=256*LU+LU2 J=J+1 GO TO 1500 C C TELL ABOUT CONFLICT C 2000 CALL ACPRM(22HDUPLICATE SESSION LU ,11) CALL ACNVS(38HOVERRIDE PRIOR DEFINITION (Y OR N)? _ ,19,0) IF(IPBUF(1)/256.EQ.131B) JBUF(JJ)=256*LU+LU2 GO TO 1500 2100 JBUF(1)=J-2 C C C PUT IN FILE C DO 2200 J1=1,J-1 í*������þú NBUF(I)=JBUF(J1) I=I+1 IF(I.LE.128) GO TO 2200 CALL WRITF(NDCB,IERR,NBUF,128,IREC) IREC=IREC+1 I=1 2200 CONTINUE GO TO 1300 C C C POST LAST OF CONFIGURATION TABLE C 2300 IF(I.LE.1.AND.IREC.NE.LOC(2)) GO TO 2500 2350 DO 2400 J=I,128 2400 NBUF(J)=0 CALL WRITF(NDCB,IERR,NBUF,128,IREC) IREC=IREC+1 2500 LNGCO=IREC-LOC(2) IF(IREC.LT.LOC(3)) IREC=LOC(3) LOC(3)=IREC 2600 J=1 GO TO 2700 2650 CALL ACWRI(20HDISC ALREADY DEFINED ,10) 2700 CALL ACNVS( 16HDISC POOL LU? _,8,0) IF(IPBUF(1).NE.2H/A ) GO TO 2750 CALL ACNVS(30HREDEFINE DISC POOL (Y OR N)? _ ,15,0) IF(IPBUF(1)/256.EQ.131B) GO TO 2600 GO TO 7000 2750 LU=IPBUF(1) IF(LU.EQ.2H/E) GO TO 2800 IF(LU.GE.4.AND.LU.LE.63) GO TO 2775 CALLACERR(-209) GO TO 2700 C 2775 DO 2780 JJ=1,J-1 IF(NBUF(JJ).EQ.LU) GO TO 2650 2780 CONTINUE C NBUF(J)=LU J=J+1 IF(J.EQ.129) GO TO 3000 GO TO 2700 2800 DO 2900 J1=J,128 2900 NBUF(J1)=0 C C C WRITE DISC POOL C 3000 CALL WRITF(NDCB,IERR,NBUF,128,IREC) IREC=IREC+1 IF(LU.NE.2H/E) GO TO 2600 LOC(4)=IREC C C C CLEAR ID TABLE C DO 3100 J1=2,256 3100 NBUF(J1)=0 C C ID=0 IS NOT ALLOWED C NBUF(1)=1 CALL WRITF(NDCB,IERR,NBUF,256,IREC) IREC=IREC+2 LOC(5)=IREC LOC(6)=IREC+IACCTS/8+1 C C C INITIALIZE THE ACCOUNT DIRECTORY C DO 3200 J1=1,113,16 3200 NBUF(J1)=-1 C 3300 IF(IREC.GE.LOC(6)-1) GO TO 3400 CALL WRITF(NDCB,IERR,NBUF,128,IREC) IREC=IREC+1 GO TO 3300 C C WRITE FINAL DIRECTORY RECORD C 3400 NBUF(113)=0 CALL WRITF(NDCB,IERR,NBUF,128,IREC) IREC=IREC+1 LOC(6)=IREC C C C UPDATE LOCATIONS IN HEADER C CALL READF(NDCB,IERR,NBUF,128,LEN,1) DO 3500 I=1,6 3500 NBUF(I)=LOC(I) CALL RNRQ(24B,IRN,ISTAT)"ä������þú CALL RNRQ(24B,IRN2,ISTAT) NBUF(25)=IRN NBUF(34)=IRN2 NBUF(33)=LNGCO CALL WRITF(NDCB,IERR,NBUF,128,1) C C COMPUTE AMOUNT TO TRUNCATE C ITRN=ISIZE-5*NBUF(6)+4*NBUF(5) C C PROMPT FOR PASSWORD FOR MANAGER.SYS C CALL ACPSN(28HPASSWORD FOR MANAGER.SYS? _,14,IPBUF,IERR) IF(IERR.NE.0) GO TO 7000 JJ=62 DO 3600 I=2,6 LDCB(JJ)=IPBUF(I) 3600 JJ=JJ+1 C INITIALIZE ACCOUNTS: C (1) SYS C (2) SUPPORT C (3) GENERAL C (4) MANAGER.SYS C (5) ENGINEER.SUPPORT C C ITTY=-1 C LOWUS=4095 IHIGR=0 3700 GO TO LRTRN 4995 ITTY=ITTYT IF(ITYPE.EQ.-4) GO TO 4996 C C TRUNCATE FILE AND RENAME C CALL CLOSE(NDCB,IERR,ITRN) CALL NAMF(MBUF,IERR,6H++CCT!,6H+@CCT!,-31178,-2,IDUM,70707B) CALL ACOPN(IERR,IDSES) C C RELAESE RESOURCE NUMBER C GO TO 4997 4996 ITYPE=0 C C IF $DSCS NOT -1 RN'S WONT BE REASSIGNED C 4997 CALL ACINT(ISTAT) IF(ISTAT.NE.-1) GO TO 5000 CALL RNRQ(44B,IRN,ISTAT) CALL RNRQ(44B,IRN2,ISTAT) C C READ ACCOUNT FILE HEADER RECORD C 5000 CALL READF(NDCB,IERR,NBUF,128,LEN,1) C C IF RN'S ALLOCATED THEN SET IRN C AND REREAD HEADER C IRN=NBUF(25) CALL ACINT(ISTAT,JSTAT) IF(ISTAT.EQ.-1) GO TO 5010 CALL RNRQ(1,IRN,ISTT) CALL READF(NDCB,IERR,NBUF,128,LEN,1) C 5010 IF(LGOTO.NE.4) GO TO 5020 NBUF(30)=1 NBUF(28)=NBUF(31) JSTAT=0 C C SET NO WAIT AND DON'T RELEASE CLASS# BITS C 5020 CALL WRITF(NDCB,IERR,NBUF,128,1) C C MOVE LOCATION WORDS, LOWEST USER ID,HIGHEST GROUP ID, C AND RESOURCE NUMBER FROM HEADER TO COMMON C DO 5050 I=1,6 LOC(I)=NBUF(I) 5050 CONTINUE LOWUS=NBUF(23) IHIGR=NBUF(24) IRN2=NBUF(34) MEM=NBUF(27) IPFLG=NBUF(30) ICLASS=NBUF(32) ISL=-NBUF(31) IDSZE=NBUF(35) C C v������þúIF SHUT DOWN DONT CHANGE PROMPT STRING C IF(JSTAT.LT.0) GO TO 5051 C C SET PROMPT STRING C CALL LMES(NBUF(12),NBUF(13),0) IF(IPFLG.LT.0) CALL LMES(-17,18HSESSION SHUT DOWN ,-2) C C ALLOCATE GLOBAL RESOURCE NUMBER IF NOT YET ALLOCATED C 5051 IF(ISTAT.GE.0) GO TO 5800 C C CLEAR NUMBER OF ACTIVE SESSIONS C NBUF(29)=0 IF(ISTAT.EQ.-2) GO TO 5060 CALL RNRQ(21B,NBUF(25),ISTT) CALL RNRQ(24B,NBUF(34),ISTT) C C GET CLASS NUMBER FOR TERMINAL WRITES C ICLASS=0 5055 CALL EXEC(18,0,JBUF,1,JBUF,JBUF,ICLASS) ICLASS=IOR(120000B,ICLASS) NBUF(32)=ICLASS 5060 CALL WRITF(NDCB,IERR,NBUF,128,1) IF(IERR.LT.0) CALL ACERR(IERR) IRN=NBUF(25) IRN2=NBUF(34) C C CLEAR ACTIVE SESSION TABLE 5070 DO 5080 I=1,128 5080 NBUF(I)=0 I1=LOC(1) I2=LOC(2)-1 DO 5090 I=I1,I2 5090 CALL WRITF(NDCB,IERR,NBUF,128,I) C C C FIND MOUNTED POOL DISCS C CALL ACFST(MBUF) CALL READF(NDCB,IERR,NBUF,128,LEN,LOC(3)) DO 5300 I=1,128 IF(NBUF(I).EQ.0) GO TO 5400 DO 5100 J=1,125,4 LUD=LBYTE(MBUF(J)) IF(LUD.EQ.0) GO TO 5300 IF(LUD.EQ.NBUF(I)) GO TO 5200 5100 CONTINUE C C C FOUND A MATCH SO MARK IT C 5200 NBUF(I)=IOR(NBUF(I),100000B) 5300 CONTINUE C C C GO INITIALIZE MEMORY C 5400 IF(MEM.GE.0) GO TO 5450 MEM=-MEM MEMRY=70-ISL IF(MEMRY.LT.50) MEMRY=50 MEMRY=ISL*MEMRY IF(MEMRY.GT.MEM) MEM=MEMRY 5450 ISIZE=MEM+I NBUF(I)=-1 5500 CONTINUE IF(I.EQ.1) I=0 JSIZE=ISIZE IDSZE=0 IF(IPFLG.GE.0) CALL ACINM(ISIZE,MAXEV,NBUF,I,IDSZE) IF(ISIZE.NE.-1) GO TO 5700 CALL ACITA(JSIZE,MESG1,3) CALL ACWRI(MESG1,12) CALL ACITA(MAXEV,MESG2,3) CALL ACWRI(MESG2,12) IF(ITYPE.EQ.-1) GO TO 5600 CALL ACNVS(26HENTER NO. OF WORDS OR /E _,13,0) IF(IPBUF(1).EQ.2H/E) GO TO 5600 ISIZé������þúE=IPBUF(1) GO TO 5500 5600 CALL RNRQ(4,IRN,ISTAT) CALL ACTRM 5700 CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(35)=IDSZE CALL WRITF(NDCB,IERR,NBUF,128,1) 5800 CALL RNRQ(4,IRN,ISTAT) C C IF NON-SESSION BYPASS CAPABILTY C TESTS C IF(IDSES.EQ.0) GO TO 5950 C C FIND MY CAPABILTY C MYSES=LUTRU(1) DO 5850 IREC=LOC(1),LOC(2)-1 CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) DO 5850 J=1,128,4 IF(MYSES.EQ.NBUF(J)) GO TO 5900 5850 CONTINUE GO TO 5950 C C FOUND SESSION NOW LOOK UP C GROUP ID C 5900 MYDIR=NBUF(J+3)+1 CALL ACDIR(1,MYDIR,IBUF,IERR) MYGID=IBUF(13) C C NOW GET CAPABILTY C IOFST=0 IREC=IBUF(15) IF(0.GT.IREC) IOFST=64 IREC=IAND(IREC,77777B) CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) MYCAP=NBUF(22+IOFST) C C C RESTART SESSION C 5950 IF(ITYPE.GE.0) CALL ACSES(JSTAT) GO TO LRTR2 C C POST FMP ACERR C 6000 CALL ACERR(IERR) C C PURGE FILE AND RETURN C 7000 CALL ACCRE(NDCB,2H+@,0,IERR) ITYPE=-1 GO TO LRTR2 C C GO CLEAN UP PURGED ACCOUNTS C 8000 CALL ACACP GO TO LRTRN C C DUMMY MAIN CALL C 9999 CALL ACCTS END PROGRAM ACCT2(5),92067-16361 REV.1940 790725 COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID ASSIGN 100 TO LTOSEG C C CALL THE APPROPRIATE COMMAND ROUTINE C 100 GO TO (200,300,300),LGOTO 200 CALL NAMR(IPBUF,ICMND,80,ISTRC) IF(IAND(IPBUF(4),3).NE.3) GO TO LRTR2 ITEMP=IPBUF(1)/256 IF(ITEMP.EQ.125B) GO TO 210 IF(IDSES.EQ.7777B) GO TO 205 CALL ACERR(46) GO TO LRTRN C 205 IF(ITEMP.EQ.107B) GO TO 220 GO TO LRTRr£������þú2 210 CALL ACNWU GO TO LRTRN 220 CALL ACNWG GO TO LRTRN 300 CALL ACLOA(LGOTO) GO TO LRTRN C C DUMMY MAIN CALL C 9999 CALL ACCTS END PROGRAM ACCT3(5),92067-16361 REV.1940 790724 COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) ASSIGN 300 TO LTOSEG 300 GO TO (400,400,400,400,310,320,500),LGOTO 310 CALL ACALU(1) GO TO LRTRN 320 CALL ACALU(2) GO TO LRTRN 400 CALL ACPUU(LGOTO) GO TO LRTRN C C CALL ALTER PASSWORD C 500 CALL ACAPA GO TO LRTRN C C DUMMY MAIN CALL C 9999 CALL ACCTS END PROGRAM ACCT4(5),92067-16361 REV.1940 790725 COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) ASSIGN 300 TO LTOSEG 300 GO TO (400,450,450,450,440),LGOTO 400 CALL NAMR(IPBUF,ICMND,80,ISTRC) ITEMP=IAND(IPBUF(4),3) IF(ITEMP.EQ.0) GO TO 410 IF(ITEMP.NE.3) GO TO LRTR2 ITEMP=IPBUF(1)/256 IF(ITEMP.EQ.125B) GO TO 410 IF(ITEMP.EQ.107B) GO TO 420 IF(ITEMP.EQ.101B) GO TO 430 GO TO LRTR2 410 CALL ACLIU(1) GO TO LRTRN 420 CALL ACLIU(2) GO TO LRTRN 430 CALL ACLIA(1) GO TO LRTRN 440 CALL ACLIA(2) GO TO LRTRN 450 CALL ACPUA(LGOTO-1,IERR) IF(LGOTO.NE.4) GO TO LRTRN IF(IERR.NE.0) GO TO LRTR2 GO TO LRTRN 9999 CALL ACCTS END PROGRAM ACCT5(5),92067-16361 REV.1940 781213 COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMÜ���N��LHON /ACOMD/ICLASS,KPB,KRR,KRRR ASSIGN 400 TO LTOSEG 400 GO TO (500,600,900,1000),LGOTO 500 CALL ACALT GO TO LRTRN 600 CALL ACTEL GO TO LRTRN 900 CALL ACUNL GO TO LRTRN C 1000 CALL ACWRH(KPB,KRR,KRRR) GO TO LRTRN C C DUMMY MAIN CALL C 9999 CALL ACCTS END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ŠeN������ÿÿ����� ���� ÿý�4�F ���������ÿ��92067-18362 2013� S C0122 �&ACMND �ACCTS COMMAND INTERPRETER � � � � � � � � � � � � �H0101 ­(�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C SOURCE PART NUMBER : 92067-18362 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C ACMND - COMMAND DISPATCH ROUTINE C C CALLING SEQUENCE: CALL ACMND(IEXIT) C WHERE C IEXIT = 1 IF COMMAND IS EXIT (RETURNED) C C ACERRS: -205 INVALID COMMAND C C SUBROUTINE ACMND(IEXIT) ,92067-16361 REV.2013 800131 DIMENSION NEXT(3) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2 COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOMA /ISRCH,ISR1,ISR2 COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID LOGICAL ISRCH EQUIVALENCE (IPB1,IPBUF) DATA NEXT/2HNE,2HXT,2H? / C C RESET SEARCH FLAG C 50 ISRCH=.FALSE. C C IF SHUT DOWN PRINT "SHUT DOWN" IF(IPFLG.GE.0) GO TO 70 IF(IPFLG.EQ.-2) GO TO 60 CALL ACWRI(10H SHUT DOWN ,5 ) GO TO 70 60 CALL ACWRI(14H ACCTS PURGED ,7 ) C C PROMPT WITH "NEXT?" C 70 CALL ACPRM(NEXT,3) C C READ AND PARSE THE COMMAND C CALL ACREI(ICMND,IERR) ISTRC=1 CALL NAMR(IPBUF,ICMND,80,ISTRC) C C CHECK IF COMMAND IS ASCII C IF(IAND(IPBUF(4),3).NE.3) GO TO 100 ASSIGN 100 TO LRTR2 ASSIGN 1300 TO LRTRN C C SAVE THE COMMAND C ICNMD=IPB1 C C CHECK FOR A VALID ACCTS COMMAND C tÓ������þúIF(IPB1.EQ.2HNE) GO TO 150 IF(IPB1.EQ.2HAL) GO TO 150 IF(IPB1.EQ.2HLI) CALL ACLNK (2H4 ,1) IF(IPB1.EQ.2HPU) GO TO 150 IF(IPB1.EQ.2HSD) GO TO 200 IF(IPB1.EQ.2HSU) GO TO 200 IF(IPB1.EQ.2HTE) CALL ACLNK (2H5 ,2) IF(IPB1.EQ.2HRE) GO TO 200 IF(IPB1.EQ.2HEX) GO TO 800 IF(IPB1.EQ.2H/E) GO TO 800 IF(IPB1.EQ.2H/A) GO TO 800 IF(IPB1.EQ.2HUN) CALL ACLNK (2H5 ,3) IF(IPB1.EQ.2HLO) GO TO 200 IF(IPB1.EQ.2HHE) GO TO 700 IF(IPB1.EQ.2HTR) GO TO 1200 IF(IPB1.EQ.2HPA) CALL ACLNK(2H3 ,7) C C PROCESS INVALID COMMAND C 100 IERR=-205 105 CALL RNRQ(140004B,IRN2,ISTAT) GO TO 120 110 CONTINUE 120 CALL ACERR(IERR) GO TO 50 C C CHECK IF HE IS A GROUP MANAGER C 150 IF(MYCAP.EQ.63) GO TO 300 C C CHECK IF HE IS SYSTEM MANAGER C 200 IF(IDSES.EQ.7777B) GO TO 300 250 CALL ACERR(46) GO TO 50 300 CALL RNRQ(1,IRN2,ISTAT) IF(IPB1.EQ.2HNE) CALL ACLNK (2H2 ,1) IF(IPB1.EQ.2HAL) GO TO 2300 ITT=0 IF(IPB1.EQ.2HPU) GO TO 900 ITT=2 IF(IPB1.EQ.2HRE) GO TO 900 IF(IPB1.EQ.2HLO) GO TO 1500 IF(IPB1.EQ.2HSD) GO TO 1100 IF(IPB1.NE.2HSU.OR.IPFLG.GE.0) RETURN 400 IPFLG=1 ASSIGN 1300 TO LRTR2 CALL ACLNK (2H1 ,4) 700 CALL ACHLP (ICMND,ISTRC) RETURN 800 IEXIT=1 RETURN 900 CALL NAMR(IPBUF,ICMND,80,ISTRC) IF(IAND(IPBUF(4),3).NE.3) GO TO 100 ITEMP=IPB1/256 IF(IDSES.EQ.7777B) GO TO 950 IF(ICNMD.NE.2HPU.OR.ITEMP.NE.125B) GO TO 250 950 IF(ITEMP.EQ.101B.AND.ICMND.EQ.2HPU) GO TO 1000 IF(ITEMP.NE.125B.AND.ITEMP.NE.107B) GO TO 100 IF(ITEMP.EQ.125B) IT=1+ITT IF(ITEMP.EQ.107B) IT=2+ITT CALL ACLNK (2H3 ,IT) C C PURGE ACCOUNTS C 1000 CALL ACLNK (2H4 ,3) 1100 CALL ACLNK (2H4 ,2) 1200 IERR=0 CALL ACXFR(ICMND,ISTRC,IERR) IF(IERR.EQ.0) GO TO 1300 IF(IERR.EQ.10) IERR=0 CALL ACERR(IER€a����� R) 1300 CALL RNRQ(140004B,IRN2,ISTAT) GO TO 1320 1310 CONTINUE 1320 RETURN C C LOAD CALL MUST SHUT DOWN FIRST C 1500 CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) CALL NAMR(IPBUF,ICMND,80,ISTRC) JP=2 IF(IPB1.EQ.2HAL) JP=3 IF(LIST(4).EQ.1.AND.LIST(1).EQ.0) GO TO 1600 C C OPEN SOURCE FILE C CALL ACOPL(IERR,1,0) IF(IERR.NE.0) GO TO 105 1550 ASSIGN 1600 TO LRTRN ASSIGN 1700 TO LRTR2 CALL ACLNK (2H4 ,4) 1600 ASSIGN 1650 TO LRTRN ASSIGN 100 TO LRTR2 CALL ACLNK (2H2 ,JP) 1650 ASSIGN 1300 TO LRTRN GO TO 400 1700 GO TO 50 2300 CALL NAMR(IPBUF,ICMND,80,ISTRC) IF(IAND(IPBUF(4),3).NE.3) GO TO 100 ITEMP=IPB1/256 IF(ITEMP.EQ.125B) CALL ACLNK(2H3 ,5) IF(ITEMP.EQ.107B) CALL ACLNK(2H3 ,6) IF(IDSES.NE.7777B) GO TO 250 IF(ITEMP.EQ.101B) CALL ACLNK(2H5 ,1) GO TO 100 END ��������������������������������������������������������������������a”������ÿÿ����� ���� ÿý�5�= ���������ÿ��92067-18363 1940� S C0122 �&ACALT �ACCTS ALTER ACCOUNT WID � � � � � � � � � � � � �H0101 O�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18363 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACALT ALTERS ACCOUNT WIDE INFORMATION C SUBROUTINE ACALT ,92067-16361 REV.1940 790404 COMPLEX BUF13(2),MESG(4) DIMENSION IBF12(8) C COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMC/IECHO,LULOG,ITLOG C EQUIVALENCE (IPBUF,IPB),(JPBUF,JPB) EQUIVALENCE (BUF13,IBF12(2)) DATA BUF13,IBF12 /8HPLEASE L ,8HOG-ON: _ ,-16/ DATA MESG /8H W,8HORDS CUR,8HRENTLY A,8HLLOCATED / C C TELL DEFAULT AN NO CHANGE ANSWERS C CALL ACWRI(42HENTER " " FOR DEFAULT OR / FOR NO CHANGE ,21) C C READ ACCOUNTS HEADER C 50 CALL ACNVS(16HSESSION LIMIT? _,8,0) ISL=9999 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IPB.EQ.2H/ .OR.IAND(IPBUF(4),3).EQ.0) GO TO 55 IF(IAND(IPBUF(4),3).NE.1) GO TO 50 ISL=-IPB IF(ISL.GT.0) GO TO 50 55 CALL READF(NDCB,IERR,NBUF,128,LEN,1) MEM=NBUF(27) IF(MEM.LT.0) MEM=-MEM 60 CALL ACNVS(36HCHANGE MEMORY ALLOCATION (Y OR N)? _,18,0) IF(IPB.EQ.2H/E.OR.IPB.EQ.2H/A) GO TO 7000 IF(IPB.EQ.2H/ ) GO TO 100 IPB=IAND(IPB,177400B)+40B IF(IPB.EQ.2HN ) GO TO 100 IF(IPB.EQ.2H ã������þúY ) GO TO 70 CALL ACERR(-205) GO TO 60 65 CALL ACERR(-213) 70 CALL ACITA(MEM,MESG,3) CALL ACWRI(MESG,16) CALL ACNVS(28HNO. OF WORDS TO ALLOCATE? _,14,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IPB.EQ.2H/ ) GO TO 100 IF(IPB.LT.70.OR.IPB.GT.7000) GO TO 65 MEM=IPB CALL ACWRI(34HFOR NEW ALLOCATION TO BE EFFECTIVE ,17) CALL ACWRI(18H REBOOT OR ENTER ,9) CALL ACWRI(8H SD,RE ,4) CALL ACWRI(6H SU ,3) 100 CALL ACNVS(22HSYSTEM MESSAGE FILE? _,11,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IAND(IPBUF(4),3).NE.1) GO TO 125 CALL ACERR(-206) GO TO 100 C 125 DO 150 I=1,6 150 JPBUF(I)=IPBUF(I) C C C PROMPT FOR NAME OF PROMPT STRING C CALL ACPRM(14HPROMPT STRING? ,7) CALL ACREI(NBUF(130),IERR) IF(NBUF(130).EQ.2H/A.OR.NBUF(130).EQ.2H/E) GO TO 7000 ITLG=ITLOG C C PROMPT FOR LOCATION OF MESSAGE FILES C CALL ACNVS(28HLOCATION OF MESSAGE FILES? _ ,14,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,NBUF,128,LEN,1) IF(ISL.GT.0) GO TO 211 C C UPDATE SESSION LIMIT C NBUF(31)=ISL IF(NBUF(30).GE.0) NBUF(28)=ISL C C UPDATE MEMORY ALLOCATION C 211 NBUF(27)=MEM IF(JPB.EQ.2H/ ) GO TO 213 C C UPDATE SYSTEM MESSAGE FILE NAME C J=6 DO 212 I=1,6 IF(I.NE.5) J=J+1 212 NBUF(J)=JPBUF(I) IF(IAND(JPBUF(4),3).NE.0) GO TO 213 NBUF(7)=2H NBUF(8)=2H NBUF(9)=2H 213 IF(IPB.EQ.2H/ ) GO TO 214 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 NBUF(26)=IPB 214 IF(NBUF(130).EQ.2H/ ) GO TO 300 J=12 IF(NBUF(130).EQ.2H .AND.ITLG.LE.2) GO TO 215 C C UPDATE PROMPT STRING C IWRD=ITLG/2 LAROW=77B IF(MOD(ITLG,2).EQ.0) LAROW=37400B NBUF(130+IWRD)=NBUF(130+IWRD)+LAROW IF(ITLG.GT.19) ITLG=19 NBUF–P������þú(129)=-ITLG-1 GO TO 230 C C PUT IN DEFAULT PROMPT STRING C 215 DO 220 I=1,11 NBUF(J)=IBF12(I) 220 J=J+1 GO TO 300 C C PUT STRING IN HEADER C 230 DO 240 I=129,139 NBUF(J)=NBUF(I) 240 J=J+1 C C POST HEADER C 300 CALL WRITF(NDCB,IERR,NBUF,128,1) CALL RNRQ(4,IRN,ISTAT) C C PUT PROMPT STRING IN MEMORY C CALL LMES(NBUF(12),NBUF(13),NBUF(30)) C C UPDATE DISC POOL C LENG=128*(LOC(4)-LOC(3)) CALL READF(NDCB,IERR,NBUF,LENG,LEN,LOC(3)) C C PROMPT TO ADD DISC LU C 350 CALL ACNVS(22HADD DISC LU(Y OR N)? _ ,11,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IAND(IPB,177400B)+40B.NE.2HY ) GO TO 800 C C PROMPT FOR DISC LU TO ADD C 400 CALL ACNVS(10HDISC LU? _ ,5,0) IF(IPB.EQ.2H/E) GO TO 800 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IPB.GT.3.AND.IPB.LE.254) GO TO 500 CALL ACERR(-209) GO TO 400 C C SEARCH FOR LU OR END C 500 DO 600 I=1,LEN-1 NBF=NBUF(I) IF(NBF.EQ.0) GO TO 650 IF(NBF.EQ.IPB) GO TO 700 600 CONTINUE C C MUST EXPAND THE FILE C CALL ACERR(-219) GO TO 7000 C C PUT DISC LU IN BUFF C 650 NBUF(I+1)=0 NBUF(I)=IPB GO TO 400 C C REPORT ACERR C 700 CALL ACWRI(20HDISC ALREADY IN POOL ,10) GO TO 400 C C PROMPT TO PURGE DISC LU C 800 CALL ACNVS(24HPURGE DISC LU(Y OR N)? _ ,12,0) IF(IPB.EQ.2H/E.OR.IPB.EQ.2H/ ) GO TO 950 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IAND(IPB,177400B)+40B.NE.2HY ) GO TO 950 850 CALL ACNVS(10HDISC LU? _ ,5,0) IF(IPB.EQ.2H/E.OR.IPB.EQ.2H/ ) GO TO 950 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 7000 IF(IPB.GT.3.AND.IPB.LE.254) GO TO 900 CALL ACERR(-209) GO TO 850 C C SEARCH FOR LU TO BE DELETED C 900 DO 910 I=1,LEN-1 IF(NBUF(I).EQ.IPB) GO TO 920 910 CONTINUE C C REPORT ACERR C áR������þú CALL ACWRI(14HDISC NOT FOUND ,7) GO TO 850 C C DELETE LU C 920 DO 930 J=I,LEN-1 NBUF(J)=NBUF(J+1) IF(NBUF(J).EQ.0) GO TO 850 930 CONTINUE C C POST DISC POOL C 950 CALL WRITF(NDCB,IERR,NBUF,LEN,LOC(3)) C C GET LENGTH OF DISC POOL C DO 960 LNGTH=1,LEN IF(NBUF(LNGTH).EQ.0) GO TO 970 960 CONTINUE C C C C FIND MOUNTED POOL DISCS C 970 CALL ACFST(MBUF) DO 990 I=1,LEN IF(NBUF(I).EQ.0) GO TO 995 DO 975 J=1,125,4 LUD=LBYTE(MBUF(J)) IF(LUD.EQ.0) GO TO 990 IF(LUD.EQ.NBUF(I)) GO TO 980 975 CONTINUE C C C FOUND A MATCH SO MARK IT C 980 NBUF(I)=IOR(NBUF(I),100000B) 990 CONTINUE C C RESET DISC POOL IN MEMORY C 995 NBUF(I)=-1 ISIZE=0 CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,MBUF,128,LEN,1) IF(IPFLG.GE.0) CALL ACINM(ISIZE,MAXEV,NBUF,LNGTH,MBUF(35)) IDSZE=MBUF(35) CALL WRITF(NDCB,IERR,MBUF,128,1) CALL RNRQ(4,IRN,ISTAT) C C PROMPT FOR STATION CONFIGURATION C 1000 CALL ACWRI(22HSTATION CONFIGURATION ,11) 1100 CALL ACNVS(44H(A[DD],D[ELETE],M[ODIFY] OR N[O CHANGE])? _,22,1) ITMP=IPBUF(2) IF(ITMP.EQ.2H/E.OR.ITMP.EQ.2H/A) GO TO 7000 IF(ITMP.EQ.2H/ ) GO TO 7000 ITMP=IAND(ITMP,177400B)+40B IF(ITMP.EQ.2HN ) GO TO 7000 IF(ITMP.EQ.2HD ) GO TO 1200 IF(ITMP.EQ.2HA ) GO TO 1200 IF(ITMP.EQ.2HM ) GO TO 1200 CALL ACERR(-205) GO TO 1100 C C FETCH CURRENT STATION CONFIGURATION C 1200 LC=LOC(2) 1300 CALL ACNVS(14HSTATION LU? _,7,0) IF(IPB.EQ.2H/E) GO TO 1000 IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E ) GO TO 7000 LU=IPB-1 IF(LU.GE.-1.AND.LU.LT.254) GO TO 1400 CALL ACERR(-209) GO TO 1300 C C GO FIND IT C 1400 I=1 LU=256*IAND(255,LU) LENG=128*(LOC(3)-LC) 1410 IVAL=IVBUF(I,LC) IF(IVAL.EQ.0) GO TO 1430 IF(IVBUF(I+1,LC).EQ.LU) GO TO 1440 a������þú I=I+IVAL+1 IF(I.LT.LENG) GO TO 1410 GO TO 6900 C C PUT IN DUMMY WHEN NOT FOUND C 1430 IF(ITMP.EQ.2HM .OR.ITMP.EQ.2HD ) 1 CALL ACWRI(18HSTATION NOT FOUND ,9) I1=I JBUF(1)=1 JBUF(2)=LU C C SET I2 FOR FLAG TO NOT DELEATE C I2=-1 GO TO 1490 C C TRANSFER TO JBUF C 1440 IF(ITMP.EQ.2HA ) CALL ACWRI(22HMODIFYING OLD STATION ,11) 1445 I1=I DO 1450 J=1,IVAL+1 JBUF(J)=IVBUF(I,LC) 1450 I=I+1 I2=I C C IF DELETE BYPASS UPDATE C 1490 IF(ITMP.EQ.2HD ) GO TO 3000 J=JBUF(1)+2 1500 CALL ACNVS(22HSESSION LU,SYSTEM LU? ,11,0) IF(IPB.EQ.2H/A ) GO TO 7000 IF(IPB.EQ.2H/E) GO TO 3000 LU2=IPB-1 CALL NAMR(IPBUF,ICMND,80,ISTRC) LU=IPB-1 IF(IPB.EQ.2H- ) GO TO 1610 IF(LU.LT.254.AND.LU.GE.-1) GO TO 1600 CALL ACERR(-209) GO TO 1500 1600 LU=IAND(LU,255) 1610 IF(LU2.GE.3.AND.LU2.LT.63) GO TO 1700 CALL ACERR(-209) GO TO 1500 C C SEARCH FOR SESSION LU ALREADY DEFINED C 1700 IF(J.LE.2) GO TO 1900 DO 1800 JJ=2,J-1 IF(LU2.EQ.IAND(JBUF(JJ),377B)) GO TO 2000 1800 CONTINUE 1900 IF(LU+1.NE.2H- ) GO TO 1950 CALL ACWRI(12HLU NOT FOUND ,6) GO TO 1500 1950 JBUF(J)=256*LU+LU2 J=J+1 GO TO 1500 C 2000 IF(LU+1.EQ.2H- ) GO TO 2100 JBUF(JJ)=256*LU+LU2 GO TO 1500 2100 DO 2200 JJJ=JJ,J-2 2200 JBUF(JJJ)=JBUF(JJJ+1) J=J-1 GO TO 1500 C C PACK STATION TABLE C 3000 CALL RNRQ(1,IRN,ISTAT) C C IF STATION WAS NOT THERE BEFORE BYPASS PACK C IF(I1+1.GE.I2) GO TO 3080 3060 I3=I2+1+IVBUF(I2,LC) IF(I2+1.GE.I3) GO TO 3080 DO 3070 I=I2,I3-1 IVAL=IVBUF(I,LC) CALL IVBUF(I1,LC,IVAL) 3070 I1=I1+1 C I2=I3 GO TO 3060 C C BUFFER IS NOW PACKED C C C IF DELETE BYPASS UPDATE C 3080 IF(ITMP.EQ.2HD ) GO TO 4150 C C PUT STATION BACK INTO STATION TABLE ß���$��" C J=J-1 JBUF(1)=J-1 IF(I1+J.LE.LENG) GO TO 4050 CALL ACERR(-219) CALL RNRQ(4,IRN,ISTAT) GO TO 7000 C C DO IT C 4050 DO 4100 I=1,J CALL IVBUF(I1,LC,JBUF(I)) 4100 I1=I1+1 4150 CALL IVBUF(I1,LC,0) CALL IVBUF CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(33)=I1/128+1 CALL WRITF(NDCB,IERR,NBUF,128,1) CALL RNRQ(4,IRN,ISTAT) C C GO GET NEXT STATION ENTRY C GO TO 1000 C C CORRUPT STATION TABLE C 6900 CALL ACERR(-220) C C FINISHID C C C CLOSE VIRTUAL MEMORY ROUTINE C 7000 CALL IVBUF RETURN C END ������������������������������������������������������������������������������������������������������������������������������������¦$������ÿÿ����� ���� ÿý�6� A ���������ÿ��92067-18364 1940� S C0122 �&ACALU �ACCTS ALTER USER OR GRO � � � � � � � � � � � � �H0101 8�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18364 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C C ALTER,USER C ALTER,GROUP C CALLING SEQUENCE: C CALL ACALU(ITYPE) C C WHERE: ITYPE=1 FOR USER C ITYPE=2 FOR GROUP C C ALTER,USER C C ACCOUNT NAME FUNCTION C C C USER.GROUP ALTER ONE ENTRY FOR ACCOUNT C C USER.@ ALTER ALL ENTRIES IN ALL GROUPS C WITH NAME USER C C @.GROUP ALTER ALL USERS OF GROUP C C C @.@ ALTER ALL USERS (DEFAULT) C C ALTER,GROUP C C GROUP ALTER "GROUP" C C @ ALTER ALL GROUPS C C C ACERRS: -200 ACCOUNT NOT FOUND C -201 NO FREE ACCOUNTS C -202 ACCOUNT WITH THIS NAME ALREADY EXISTS C -203 INVALID ACCOUNT NAME C -204 INVALID PASSWORD C -206 INVALID FILE NAME C -207 INVALID CAPABILITY C -208 INVALID DISC LIMIT C -209 INVALID SST ENTRY C -210 CONFLICT IN SST DEFINITION C -211 USER OR GROUP ID NOT AVAILABLE C -212 INVALID NUMBER OF SST SPARES C FMP ACERR (READF,WRITF) C C SUBROUTINE ACALU(ITYPE) ,92067-16361 REV.1940 790726 LOGICAL ISRCH,INUG ü˜������þú DIMENSION MSNAM(5),MSGNM(6),MSGST(12),MSUPW(7),MSHFL(8) DIMENSION MSCAP(8),MSMXD(12),MSSST(29),MSSPR(11) DIMENSION MSGNX(6),LUMS1(27),LUMS2(32) DIMENSION IUSER(5),IDMY(2),IRECG(2),IRECU(2),IRENG(2) DIMENSION NAME(11),NAMEU(11),NAMEG(11) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH COMMON /ACOM4/ ICMND(40) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA IAT/2H@ / DATA LPPG,I0,I6 /54,2HI0,2HI6 / DATA MSNAM/2HUS,2HER,2H N,2HAM,2HE?/ DATA MSGNM/2HGR,2HOU,2HP ,2HNA,2HME,2H? / DATA MSGST/2HUS,2HE ,2HGR,2HOU,2HP ,2HSS,2HT ,2H(Y,2H O, 1 2HR ,2HN),2H? / DATA MSUPW/2HUS,2HER,2H P,2HAS,2HSW,2HOR,2HD?/ DATA MSHFL/2HUS,2HER,2H H,2HEL,2HLO,2H F,2HIL,2HE?/ DATA MSCAP/2HUS,2HER,2H C,2HAP,2HAB,2HIL,2HIT,2HY?/ DATA MSMXD/2HMA,2HXI,2HMU,2HM ,2HDI,2HSC,2H C,2HAR,2HTR, 1 2HID,2HGE,2HS?/ DATA MSSST/2HSS,2HT ,2HDE,2HFI,2HNI,2HTI,2HON,2H? ,2H(E, 1 2HNT,2HER,2H S,2HES,2HSI,2HON,2H L,2HU,,2H S,2HYS, 2 2HTE,2HM ,2HLU,2H, ,2HOR,2H E,2HNT,2HER,2H /,2HE)/ DATA MSSPR/2HNU,2HMB,2HER,2H O,2HF ,2HSS,2HT ,2HSP,2HAR, 1 2HES,2H? / DATA MSGNX/2HNE,2HXT,2H G,2HRO,2HUP,2H? / DATA LUMS1/2HCO,2HNF,2HLI,2HCT,2H I,2HN ,2HSS,2HT ,2HDE, 1 2HFI,2HNI,2HTI,2HON,2H -,2H A,2HSS,2HUM,2HIN,2HG , 2 2HUS,2HER,2H D,2HEF,2HIN,2HIT,2HIO,2HN / DATA LUMS2/2HUS,2HER,2H: ,2HSE,2HS ,2HLU,2H ,2H ,2H, , 1 2HSY,2HS ,2HLU,2H ,2H ,2H ,2H ,2H G,2HRO,2HUP, 2 2H: ,2HSE,2HS ,2HLU,2H ,2H ,2H, ,2HSY,2HS ,2HLU, 3 2H ,2H ,2H / C C SET IDG TO NO CHANGE C IDG=-1 NAMEG(2)=2H/ C C PARSE ACCOUNT NAME C JERR=0 CALL PARSN(NAME,ICMND,80,ISTDŸ������þúRC,JERR) IF(JERR.NE.0) GO TO 2800 C C TEST FOR USER.GROUP FORMAT C IF(LBYTE(NAME(1)).NE.0) GO TO 90 NAME(7 )=2HGE NAME(8 )=2HNE NAME(9 )=2HRA NAME(10)=2HL NAME(11)=2H C C IF GROUP MOVE NAME(2) TO NAME(7) C 90 GO TO (110,100),ITYPE 100 DO 101 I=2,6 101 NAME(I+5)=NAME(I) NAME(2)=0 C C SAVE RESET VALUES FOR LOOP C 110 IU=NAME(2) IG=NAME(7) C C CHECK TO SEE IF ACCOUNT EXISTS C CALL ACFDA(NAME(2),NAME(7),IDIRN,IDMY,IDMY,JERR) NAME(2)=IU NAME(7)=IG IF(JERR.NE.0) GO TO 2900 C C MAKE SURE HE IS DOING HIS GROUP C CALL ACDIR(1,IDIRN,IBUF,IERR) C C SET MAXIMUM CAPABILITY C MAXCAP=63 IF(IDSES.EQ.7777B) GO TO 120 MAXCAP=62 IF(IG.NE.IAT.AND.MYGID.EQ.IBUF(13)) GO TO 120 JERR=46 GO TO 2900 C C C TELL NO CHANGE AND DEFAULT ANSWERS C 120 CALL ACWRI(42HENTER " " FOR DEFAULT OR / FOR NO CHANGE ,21) INUG=.TRUE. IRENG(1)=-1 NAMEU(2)=2H/ IF(IU.EQ.IAT.OR.IG.EQ.IAT) GO TO 1000 C C IF GROUP "GENERAL" CANT CHANGE NAME C IF(IBUF(12).EQ.0.AND.IBUF(13).EQ.3) GO TO 1000 C C SAVE USER ID C C INUG=.FALSE. IDOLD=IBUF(12) GO TO (400,420),ITYPE C C PROMPT FOR USER NAME C 390 CALL ACERR(-202) 400 CALL ACPRM(20HNEW USER NAME OR / ? ,10) CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(NAMEU,IBUF,80,ICHAR,IERR) IF(NAMEU(2).EQ.2H/A.OR.NAMEU(2).EQ.2H/E) RETURN IF(NAMEU(1).EQ.0) NAMEU(2)=2H/ IF((IERR.EQ.0.OR.NAMEU(2).EQ.2H/ ).AND.NAMEU(2).NE.2H@ ) 1 GO TO 410 CALL ACERR(-203) GO TO 400 C C PROMPT FOR NEW GROUP C 405 CALL ACERR(IERR) 410 IDG=-1 IF(IDOLD.EQ.7777B.OR.IDSES.NE.7777B) GO TO 465 CALL ACPRM(16HNEW GROUP OR / ? ,8) GO TO 430 C C PROMPT FOR NEW GROUP NAME C 415 CALL ACERR(-202) 420 CALL ACPRM(22HNEW GROU~ì������þúP NAME OR / ? ,11) 430 CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(NAMEG,IBUF,80,ICHAR,IERR) IF(NAMEG(2).EQ.2H/A.OR.NAMEG(2).EQ.2H/E) RETURN IF(NAMEG(1).NE.0) GO TO 435 NAMEG(1)=3400B NAMEG(2)=2HGE NAMEG(3)=2HNE NAMEG(4)=2HRA NAMEG(5)=2HL 435 IF((IERR.EQ.0.OR.NAMEG(2).EQ.2H/ ).AND.NAMEG(2).NE.2H@ ) 1 GO TO 440 CALL ACERR(-203) GO TO (410,420),ITYPE C C GET ADDRESS OF NEW GROUP ACCOUNT C 440 IUSER(1)=0 IF(NAMEG(2).EQ.2H/ ) GO TO 465 CALL ACFDA(IUSER,NAMEG(2),IDGR,IDMY,IRENG,IERR) IF(IERR.NE.0) GO TO (405,1000),ITYPE GO TO (450,415),ITYPE C C SEE IF ACCOUNT ALREADY EXISTS C 450 IF(NAMEU(2).EQ.2H/ ) GO TO 460 CALL ACFDA(NAMEU(2),NAMEG(2),IDMY,IDMY,IDMY,IERR) GO TO 470 465 IF(NAMEU(2).EQ.2H/ ) GO TO 1000 CALL ACFDA(NAMEU(2),NAME(7),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.-200) GO TO 1000 GO TO 390 460 CALL ACFDA(NAME(2),NAMEG(2),IDMY,IDMY,IDMY,IERR) 470 IF(IERR.NE.-200) GO TO 390 CALL ACDIR(1,IDGR,IBUF,IERR) IDG=IBUF(13) IRG=IBUF(14) C 1000 IGSST=1 ID=0 GO TO (1105,1450),ITYPE C C ALTER USER PROMPTS C C C PROMPT FOR WHETHER TO USE GROUP SST C 1105 CALL ACPRM(MSGST,12) C C READ AND PARSE FOR Y OR N C CALL ACREI(IBUF,JERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,JERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A) RETURN C C SET IGSST TO: C 0 FOR NO GROUP SST C 100000B FOR GROUP SST C 1 FOR SAME AS PREVIOUS C ITEMP=JPBUF(2)/256 IF(ITEMP.EQ.131B) IGSST=100000B IF(ITEMP.EQ.116B) IGSST=0 C C ALTER,USER PROMPTS C CALL ACPRM(MSUPW,7) CALL ACREI(IBUF,JERR) ICHAR=1 CALL PARSN(LDCB,IBUF,80,ICHAR,JERR) IF(JERR.EQ.0) GO TO 1140 C C CHECK FOR REQUEST TO€ø������þú ABORT COMMAND C IF(LDCB(2).EQ.2H/A) RETURN IF(LDCB(2).EQ.2H/ ) GO TO 1180 1110 CALL ACERR(-204) GO TO 110 C C PASSWORD CAN'T BE IN USER.GROUP FORMAT C 1140 IF(IAND(LDCB(1),255).NE.0) GO TO 1110 1170 LDCB(1)=LDCB(1)/256 IF(ITLOG.EQ.0.OR.LDCB(1).GT.0) GO TO 1200 1180 LDCB(1)=-1 C C PROMPT FOR USER HELLO FILE C 1200 CALL ACPRM(MSHFL,8) CALL ACREI(IBUF,JERR) ICHAR=1 CALL NAMR(LDCB(7),IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(LDCB(7).EQ.2H/A) RETURN C CHECK IF NULL OR BLANK (DEFAULT TO NO HELLO FILE) C ITEMP=IAND(LDCB(10),3) C LDCB(10)=LDCB(11) LDCB(11)=LDCB(12) IF(ITEMP.NE.0) GO TO 1208 LDCB(7)=2H LDCB(8)=2H LDCB(9)=2H C C CHECK IF ASCII C 1208 IF(ITEMP.NE.1) GO TO 1300 CALL ACERR(-206) GO TO 1200 C C PROMPT FOR USER CAPABILITY C 1300 CALL ACPRM(MSCAP,8) CALL ACREI(IBUF,JERR) ICHAR=1 CALL NAMR(LDCB(12),IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(LDCB(12).EQ.2H/A) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT CAPABILITY TO 30) C ITEMP=IAND(LDCB(15),3) IF(LDCB(12).NE.2H/ ) GO TO 1305 LDCB(12)=-1 GO TO 1400 C C CHECK IF INTEGER, 1-63 C 1305 IF(ITEMP.LE.1) GO TO 1320 1310 CALL ACERR(-207) GO TO 1300 1320 IF(ITEMP.EQ.0) LDCB(12)=30 IF(LDCB(12).LE.0) GO TO 1310 IF(LDCB(12).GT.MAXCAP) GO TO 1310 C C PROMPT FOR MAXIMUM DISC CARTRIDGES C 1400 CALL ACPRM(MSMXD,12) CALL ACREI(IBUF,JERR) ICHAR=1 CALL NAMR(LDCB(13),IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(LDCB(13).EQ.2H/A) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT LIMIT TO 2) C ITEMP=IAND(LDCB(16),3) IF(LDCB(13).NE.2H/ ) GO TO 1405 LDCB(13)=-1 GO TO 1450 C C CHECK FOR INTEGER BETWEEN 0 AND 60 C 1405 IF(ITEMP.LÅ������þúE.1) GO TO 1420 1410 CALL ACERR(-208) GO TO 1400 1420 IF(ITEMP.EQ.0) LDCB(13)=2 IF((LDCB(13).GT.60).OR.(LDCB(13).LT.0)) GO TO 1410 C C PROMPT FOR USER SST DEFINITION C 1450 ICL=29 KNDX=14 1500 CALL ACPRM(MSSST,ICL) CALL ACREI(IBUF,JERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO END SST DEFINITION C IF(JPBUF(1).EQ.2H/E.OR.JPBUF(1).EQ.2H/ ) GO TO 1600 C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT TO NO USER SST) C ITEMP=IAND(JPBUF(4),3) IF(KNDX.NE.33) GO TO 1510 IF(ITEMP.EQ.0) GO TO 1600 C C READ, PARSE AND VALIDATE SST ENTRY C SYSTEM LU MUST BE NUMERIC, 0-254 C SESSION LU MUST BE NUMERIC, 4-63 C 1510 ISES=JPBUF(1)-1 CALL NAMR(JPBUF,IBUF,80,ICHAR) ISYS=JPBUF(1) IF(ISYS.EQ.2H- ) GO TO 1525 IF(ITEMP.NE.1) GO TO 1540 IF((ISYS.LT.0).OR.(ISYS.GT.254)) GO TO 1540 ISYS=2*IAND(ISYS-1,255) 1520 IF(IAND(JPBUF(4),3).NE.1) GO TO 1540 1525 IF((ISES.LT.3).OR.(ISES.GT.62)) GO TO 1540 1530 KNDX=KNDX+1 IF(ISYS.EQ.2H- ) ISYS=1 LDCB(KNDX)=(ISYS*128)+ISES ICL=8 GO TO 1500 1540 CALL ACERR(-209) ICL=8 GO TO 1500 C C PROMPT FOR SST SPARES C 1600 LDCB(14)=KNDX ISPAR=-1 GO TO (1605,1630),ITYPE C C ALTER,USER PROMPTS C 1605 CALL ACPRM(MSSPR,11) CALL ACREI(IBUF,JERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT TO 0) C ITEMP=IAND(JPBUF(4),3) IF(ITEMP.LE.1) GO TO 1620 IF(JPBUF(1).EQ.2H/ ) GO TO 1900 1610 CALL ACERR(-212) GO TO 1605 1620 IF(ITEMP.EQ.0) JPBUF(1)=5 IF((JPBUF(1).LT.0).OR.(JPBUF(1).GT.60)) GO TO 1610 ISPAR=JPBUF(1) 1900 IF(INUG.OR.IDOLD.EQ.7777B) GO TO 1630 ¹������þúC C PROMPT FOR LINK TO EXISTING ACCOUNT C 1901 CALL ACWRI(30HLINK TO AN EXISTING ACCOUNT ? ,15) CALL ACWRI(30H(ANY MOUNTED DISCS WILL NOT BE ,15) CALL ACWRI(30H TRANSFERED WITH THE ACCOUNT) ,15) CALL ACPRM(30HENTER / OR USER.GROUP/PASSWORD ,15) CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN C C CHECK FOR NO CHANGE C IF(JPBUF(2).EQ.2H/ ) GO TO 1630 C C CHECK FOR ACERR C IF(IERR.EQ.0) GO TO 1904 CALL ACERR(-203) GO TO 1901 C C CHECK FOR NULL OR BLANK (DEFAULT TO N), OR N C 1904 IF(JPBUF(1).EQ.0) GO TO 1630 C C SET IPFLG TO RESET ID BIT MAP C IF(IPFLG.EQ.0) IPFLG=1 C C NAME MUST BE IN USER.GROUP FORMAT C IF(IAND(JPBUF(1),255).NE.0) GO TO 1920 1910 CALL ACERR(-203) GO TO 1901 C C CHECK IF USER.GROUP ACCOUNT EXISTS C 1920 CALL ACGTU(JPBUF(2),JPBUF(7),NBUF,IOFST,IERR) IF(IERR.EQ.0) GO TO 1925 CALL ACERR(-200) GO TO 1901 C C CHECK THE PASSWORD (SKIP IF NO PASSWORD) 1925 ITEMP=IAND(NBUF(IOFST+1),77777B) IF(ITEMP.EQ.0) GO TO 1950 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) DO 1930 I=2,6 IF(JPBUF(I).NE.NBUF(IOFST+I)) GO TO 1940 1930 CONTINUE GO TO 1950 1940 CALL ACERR(-204) GO TO 1901 C C GET THE USER ID FROM THE ACCOUNT ENTRY C 1950 IDD=NBUF(IOFST+29) IF(IDD.GE.7776B) GO TO 1910 ID=IDD C C GET GROUP ACCOUNT C 1630 CALL RNRQ(1,IRN,ISTAT) 1640 IUSER(1)=0 CALL ACFDA(IUSER,NAME(7),IDIRN,IRECU,IRECG,JERR) IF(JERR.NE.0) GO TO 2600 GO TO (1690,1645),ITYPE 1645 IF(INUG.OR.NAMEG(2).EQ.2H/ ) GO TO 1650 C C UPDATE DIRECTORY C CALL ACDIR(1,IDIRN,IBUF,IERR) IBUF(1)=MBYTE(NAMEG(1)) DO 1646 I=2,6 IBUF(I+5)=NAMEG(I) 1646 CONTINUE CALL ACDIR(2,IDIRN,IBUF,Cþ������þúIERR) 1650 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECG) IOFST=IRECG(2) NBU6=NBUF(IOFST+6)-1 IF(NBU6.GE.0.OR.NBU6.LT.-63) NBU6=-1 NBUF(IOFST+6)=NBU6 CALL ACAST(NBUF(IOFST+6)) CALL WRITF(NDCB,JERR,NBUF,128,IRECG) C C SET TO SEARCH ALL USERS OF GROUP C NAME(2)=IAT IU=IAT C C GET USER ACCOUNT C 1690 ISRCH=.FALSE. 1700 CALL ACFDA(NAME(2),NAME(7),IDIRN,IRECU,IRECG,JERR) IF(JERR.NE.0) GO TO 2500 C C UPDATE DIRECTORY IF REQUIRED C IF(INUG)GO TO 4740 CALL ACDIR(1,IDIRN,IBUF,IERR) IF(NAMEU(2).EQ.2H/ ) GO TO 4710 C C UPDATE USER NAME C IBUF(1)=IAND(NAMEU(1),177400B)+LBYTE(IBUF(1)) DO 4700 I=2,6 IBUF(I)=NAMEU(I) 4700 CONTINUE C C UPDATE GROUP NAME C 4710 IF(NAMEG(2).EQ.2H/ ) GO TO 4730 IBUF(1)=IOR(IAND(IBUF(1),177400B),MBYTE(NAMEG(1))) DO 4720 I=2,6 IBUF(I+5)=NAMEG(I) 4720 CONTINUE C C UPDATE ID'S C 4730 IF(IBUF(12).LT.7776B.AND.ID.NE.0) IBUF(12)=ID IF(IDG.LT.0) GO TO 4735 IBUF(13)=IDG IBUF(14)=IRG 4735 CALL ACDIR(2,IDIRN,IBUF,IERR) 4740 IOFST=IRECU(2) CALL READF(NDCB,JERR,NBUF,128,LEN,IRECU) DO 1705 I=1,64 1705 JBUF(I)=NBUF(I+IOFST) IF(0.LE.JBUF(1))GO TO 1715 IRECC=IAND(JBUF(64),77777B) JOFST=0 IF(JBUF(64).LT.0) JOFST=64 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECC) C C RELEASE ENTRY FOR 2ND PART C JJDIR=(IRECC-LOC(6))*2+1 IF(JOFST.NE.0) JJDIR=JJDIR+1 C C MOVE TO JBUF C 1709 DO 1710 I=1,33 1710 JBUF(63+I)=NBUF(I+JOFST) C C CLEAR BIT FOR 2ND HALF C JBUF(1)=IAND(JBUF(1),77777B) C C IF GROUP BYPASS USER UPDATES C 1715 IGSSTS=IAND(JBUF(33),100000B) ISPARS=IAND(JBUF(32),255) GO TO (1720,1760),ITYPE C C UPDATE PASSWORD C 1720 IF(LDCB(1).LT.0) GO TO 1730 DO 1725 J=1,6 1725 JBUF(J)=LDCB(J) C C UPDATE HELLO FILE C 1730 IF(LDCB(7).EQ.2H/ ) UU������þúGO TO 1750 DO 1740 J=7,11 1740 JBUF(J)=LDCB(J) C C UPDATE CAPABILITY C 1750 IF(JBUF(29).GE.7776B) GO TO 1755 IF(LDCB(12).GE.0) JBUF(22)=LDCB(12) C C UPDATE NUMBER OF DISCS C 1755 IF(LDCB(13).GE.0) JBUF(31)=LDCB(13) C C UPDATE ID'S C IF(JBUF(29).LT.7776B.AND.ID.NE.0) JBUF(29)=ID IF(IDG.GE.0) JBUF(30)=IDG C C UPDATE USER SST C IF(IGSST.NE.1) IGSSTS=IGSST IF(ISPAR.GE.0) ISPARS=ISPAR JBU33=IAND(JBUF(33),77777B)-MBYTE(JBUF(32)) JBUF(32)=0 IF(JBU33.LT.0.OR.JBU33.GT.63) JBU33=0 JBUF(33)=JBU33 CALL ACAST(JBUF(33)) C C GET GROUP C 1760 KNDX=IAND(JBUF(33),77777B)+33-MBYTE(JBUF(32)) IOFST=IRECG(2) IF(IRENG(1).EQ.-1) GO TO 1770 IOFST=IRENG(2) IRECG(1)=IRENG(1) 1770 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECG) C C MERGE IN THE GROUP SST C IGLEN=0 C C CHECK IF GROUP SST IS TO BE USED C IF(IGSSTS.EQ.0) GO TO 1890 ICNT=IABS(NBUF(IOFST+6)) C C CHECK FOR EMPTY GROUP SST C IF(ICNT.LE.0.OR.ICNT.GT.64) GO TO 1890 K=IOFST+6 C C VALIDATE EACH GROUP SST ENTRY C DO 1880 I=1,ICNT ITEMP=IAND(NBUF(I+K),255) C C CHECK FOR CONFLICTS OR DUPLICATE SST DEFINITIONS C IF(KNDX.LT.34) GO TO 1865 DO 1860 J=34,KNDX ISES=IAND(JBUF(J),255) IF(ITEMP.NE.ISES) GO TO 1860 C C FOUND MATCHING SESSION LU - IF DUPLICATE DEFINITION C IGNORE IT, ELSE REPORT SST CONFLICT C IF(JBUF(J).EQ.NBUF(I+K)) GO TO 1880 GO TO 1870 1860 CONTINUE C C MOVE GROUP SST ENTRY TO USER C 1865 KNDX=KNDX+1 JBUF(KNDX)=NBUF(I+K) IGLEN=IGLEN+1 GO TO 1880 C C CONFLICT BETWEEN USER AND GROUP SST DEFINITION C C C PRINT THE CONFLICTING LU DEFINITIONS C 1870 CALL ACWRI(NAME(2),5) CALL ACWRI(NAME(7),5) ISYSG=(NBUF(I+K)/256)+1 ISYSU=(JBUF(J)/256)+1 CALL ACITA(ISES+1,LUMS2(7),2) <»���<��:6 CALL ACITA(ISYSU,LUMS2(13),3) CALL ACITA(ISYSG,LUMS2(30),3) LUMS2(24)=LUMS2(7) LUMS2(25)=LUMS2(8) CALL ACWRI(LUMS1,27) CALL ACWRI(LUMS2,32) 1880 CONTINUE C C WRITE SST LENGTH WORDS C 1890 IF(ISPARS+JBUF(31).LE.67) GO TO 1891 ISPARS=67-JBUF(31) CALL ACERR(-212) 1891 JBUF(32)=(IGLEN*256)+ISPARS JBUF(33)=IOR(IGSSTS,KNDX-33) C C UPDATE ACCOUNT C IF(JJDIR.GE.0) CALL ACPGA(-1,JJDIR,0) IF(KNDX.LT.64) GO TO 2100 CALL ACFDF(IDIRN,IRECN,JOFST,JERR,2) IF(JERR.NE.0) GO TO 2900 C C RESERVE DIRECTORY ENTRY FO 2ND PART C CALL ACPGA(-2,IDIRN,0) C C BUILD LAST PART OF SST C CALL READF(NDCB,JERR,NBUF,128,LEN,IRECN) DO 2000 I=1,33 2000 NBUF(I+JOFST)=JBUF(I+63) CALL WRITF(NDCB,JERR,NBUF,128,IRECN) C C SET UP POINTER TO 2ND PART C IF(JOFST.NE.0) IRECN=100000B+IRECN JBUF(64)=IRECN C C SET BIT FOR 2ND PART C JBUF(1)=IOR(JBUF(1),100000B) C C UPDATE FIRST PART C 2100 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECU) IOFST=IRECU(2) DO 2200 I=1,64 2200 NBUF(I+IOFST)=JBUF(I) CALL WRITF(NDCB,JERR,NBUF,128,IRECU) C C GO BACK AND SEARCH REST OF DIRECTORY C ISRCH=.TRUE. NAME(2)=IU IF(IU.EQ.IAT) GO TO 1700 2500 NAME(7)=IG ISRCH=.TRUE. IF(IG.EQ.IAT) GO TO 1640 2600 IF(ID.NE.0) CALL ACSID CALL RNRQ(4,IRN,ISTAT) ISRCH=.FALSE. RETURN C C ACERR RETURN C 2800 JERR=-203 2900 CALL ACERR(JERR) C C UNLOCK RN C CALL RNRQ(40004B,IRN,ISTAT) GO TO 3000 2999 CONTINUE C C FINISHED C SO CLEAN UP C 3000 ISRCH=.FALSE. RETURN END ��������������������������������������������������������������ÏW<������ÿÿ����� ���� ÿý�7�F ���������ÿ��92067-18365 1940� S C0122 �&ACCRE �ACCTS CREATE ACCOUNT FI � � � � � � � � � � � � �H0101 �����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18365 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * * ACCRE - ROUTINE TO CREATE THE ACCOUNT FILE * * CALLING SEQUENCE: CALL ACCRE(ISIZE,IERR) * WHERE * ISIZE = SIZE IN BLOCKS REQUIRED * IERR = ACERR RETURN WORD * * ACERRS: FMP ACERR (CREAT) * * NAM ACCRE,7 92067-16361 REV.1940 790801 ENT ACCRE EXT OVRD.,.ENTR,CREAT,PURGE EXT $ACFL,ACOMD,$LIBR,$LIBX * A EQU 0 * NDCB NOP NAME NOP ISIZE NOP IERR NOP * ACCRE NOP JSB .ENTR GET PARAMETERS DEF NDCB * * SET FILE NAME * LDA NAME,I GET FIRST 2 CHARACTERS STA FNAME THE REST ARE THE SAME * * SET DISC LU IN $ACFL * LDA ACOMD+8 JSB $LIBR GO PRIVILEGED TO DO IT NOP XSA $ACFL+0 JSB $LIBX AND COME OUT DEF *+1 DEF *+1 * * * GO PURGE FILE WITH OVERIDE SET * LDA OVRD. SET OVERIDE BIT FOR OPEN IOR SIGN STA OVRD. * PURG JSB PURGE PURGE +@CCT!:-31178 DEF RTRN1 DEF NDCB,I DEF IERR,I DEF FNAME DEF SC * RTRN1 LDA IERR,I SSA,RSS IF SUCCESSFUL TRY AGAIN JMP PURG * CPA M6 IF MINUS SIX THEN WE CAN CREAT NEW FILE RSS JMP ACCRE,I ELSE RETURN * LDA ISIZE,I SZA,RSS IF SIZE "0" THIS WAS A PURGE JMP ACCRE,I SO RETURN * * CREA ó��� �� T FILE WITH OVERIDE BIT SET * JSB CREAT CREAT +@CCT!:-31178:($ACFL) DEF RTRN2 DEF NDCB,I DEF IERR,I DEF FNAME DEF ISIZE,I DEF D1 DEF SC DEF ACOMD+8 DEF D256 DEF D0 DEF D0 DEF B707 * RTRN2 LDA OVRD. CLEAR OVERIDE BIT AND B7... STA OVRD. * JMP ACCRE,I AND RETURN * * D0 DEC 0 D1 DEC 1 D256 DEC 256 M6 DEC -6 SC DEC -31178 SIGN OCT 100000 B7... OCT 77777 B707 OCT 70707 * FNAME ASC 3,+@CCT! * * END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������´Ì ������ÿÿ����� ���� ÿý�8�? ���������ÿ��92067-18366 2001� S C0122 �&ACOPN �ACCTS OPEN ACCOUNT FILE � � � � � � � � � � � � �H0101 8�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18366 * * RELOCATABLE PART NUMBER : 92067-16362 * * PROGRAMER(S) : J.M.N. * * * * ACOPN - ROUTINE TO OPEN THE ACCOUNT FILE * * CALLING SEQUENCE: CALL ACOPN(IERR) * WHERE * IERR = ACERR RETURN WORD * * ACERRS: FMP ACERR (OPEN) * * NAM ACOPN,7 92067-16362 REV.2001 791018 ENT ACOPN EXT $SMID,OVRD.,.ENTR,ACOM1,OPEN,ISMVE EXT $ACFL,$LIBR,$LIBX,ACOMD,LOCF * A EQU 0 * IERR NOP IDSES NOP * ACOPN NOP JSB .ENTR GET PARAMETERS DEF IERR * LDA 1717B GET SESSION WORD IN ID SEG ADA D32 XLA A,I STA SESWD * CMA,INA IF SESWD IS <= 0 THEN NON-SESSION SSA,RSS JMP RTRN1 SO DONT CALL ISMVE * JSB ISMVE GET SESSION ID DEF RTRN1 DEF SESWD DEF $SMID DEF IDSES,I DEF D1 * RTRN1 LDA OVRD. SET OVERIDE BIT FOR OPEN IOR SIGN STA OVRD. * XLA $ACFL+0 GET DISC LU FOR ACCOUNTS FILE STA ACOMD+8 * JSB OPEN OPEN +@CCT!:-31178 DEF RTRN2 DEF ACOM1 DCB DEF IERR,I ERROR CODE RETURN DEF FNAME FILE NAME DEF D1 FILE TYPE DEF SC SECURITY CODE DEF ACOMD+8 DISC LU DEF D256 DCB SIZE * RTRN2 LDA OVRD. CLEAR OVERIDE BIT AND B7... STA OVRD. * LDA $ACFL IF DICSC LU SET UP RETURN SZA JMP ACOPN,I * JSB LOCF<Þ��� ��  ELSE FIND LU OF ACCOUNTS FILE DEF RTRN3 WITH LOCF CALL DEF ACOM1 DCB OF FILE DEF IDUM DEF IDUM SPACING TO DISC LU DEF IDUM DEF IDUM DEF IDUM DEF ACOMD+8 DISC LU IS RETURNED HERE * RTRN3 LDA ACOMD+8 PUT -LU IN $ACFL SSA,RSS MAKE SURE IT IS NEGATIVE CMA,INA JSB $LIBR MUST GO PRIVILEGED NOP XSA $ACFL+0 JSB $LIBX DEF ACOPN AND RETURN * * D1 DEC 1 D32 DEC 32 D256 DEC 256 SC DEC -31178 IDUM BSS 1 SIGN OCT 100000 B7... OCT 77777 * FNAME ASC 3,+@CCT! * SESWD BSS 1 * END ��������������������������������������������������������������������������������������������������°+ ������ÿÿ����� ���� ÿý�9�@ ���������ÿ��92067-18367 1940� S C0122 �&ACWRH �ACCTS LISTS COMMAND SYN � � � � � � � � � � � � �H0101 \-�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18367 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * ACWRH WRITES ACHLPMESSAGES * * CALLING SEQUENCE: * CALL ACWRH(KEYWD,IERR) * * WHERE KEYWD IS THE FIRST 2 CHARACTERS OF COMMAND * AND IERR IS A FMP ACERR FROM ACWRL * NAM ACWRH,7 92067-16361 REV.1940 790801 ENT ACWRH EXT ACWRL,.ENTR * KEYWD NOP IERR NOP JERR NOP ACWRH NOP JSB .ENTR GET PARAMATER ADDRESSES DEF KEYWD * LDB TABAD FETCH ADDRESS OF TABLE STB JERR,I LOOP STB CNTAD SAVE ADDRESS OF WORD COUNT INB BUMP TO POINT TO FIRST 2 CHARS STB BUF PUT ADDRESS IN CALL TO ACWRL INB BUMP POINTER TO 2ND TWO CHARS FOR COMPARE LDA KEYWD,I SZA IF KEYWORD IS ZERO CPA B,I THEN PRINT ALL JMP PRINT * LDB BUF ADB CNTAD,I NOT FOUND GO LOOK CPB TEND FOR NEXT ENTRY JMP ACWRH,I FINISHED RETURN STB CNTAD SKIP EXPLANATION INB CONT ADB CNTAD,I CPB TEND JMP ACWRH,I JMP LOOP * * FOUND ENTRY * PRINT CLA CLEAR ERROR STA JERR,I JSB ACWRL GO PRINT IT DEF *+4 BUF NOP CNTAD NOP DEF IERR,I * LDB BUF GET EXPLANATION PART ADB CNTAD,I STB CNTAD INB STB BUF LDA KEYWD,I IF PRINT ALL SKIP EXPLANATION SZA,RSS JMP CONT * LDA D1 JSB PBLNK «������þú PRINT BLANK LINE LDA CNTAD,I GET WORD COUNT CMA,INA STA CNT SET WORD COUNT LDB BLIAD LOOP2 LDA BUF,I MOVE MESSAGE TO OUPUT BUFFER STA B,I ISZ BUF INB ISZ CNT JMP LOOP2 * LDA CNTAD,I SET WORD COUNT FOR CALL ADA D6 STA CNT JSB ACWRL DEF *+4 DEF BLINE DEF CNT DEF IERR,I * LDA D1 PRINT BLANK LINE JSB PBLNK * LDB BUF JMP CONT+1 GO LOOK FOR NEXT MATCH * * PBLNK NOP STA CNT SET WORD COUNT JSB ACWRL GO WRITE IT DEF *+4 DEF BLINE DEF CNT DEF IERR,I JMP PBLNK,I RETURN * B EQU 1 A EQU 0 * CNT BSS 1 SUP BLIAD DEF BLINE+6 BLINE ASC 6, - * BSS 30 D1 DEC 1 D6 DEC 6 * TABAD DEF *+1 DEC 8 ASC 8, AL[TER],A[CCT] DEC 20 ASC 20,ALTERS GLOBAL SESSION MONITOR PARAMETERS DEC 12 ASC 12, AL[TER],G[ROUP],<NAME> DEC 10 ASC 10,ALTERS GROUP ACCOUNT DEC 15 ASC 15, AL[TER],U[SER],<USER.GROUP> DEC 23 ASC 23,ALTERS ONE OR MORE ATTRIBUTES DEFINED FOR USER DEF 4 ASC 4, EX[IT] DEC 18 ASC 18,TERMINATES THE ACCOUNT SETUP PROGRAM DEC 25 ASC 25, LI[ST],A[CCT][,[<LIST NAMR>][,<AC,PO,CO OR AL>]] DEC 15 ASC 15,LISTS SESSION WIDE INFORMATION DEC 22 ASC 22, LI[ST],G[ROUP],<NAME>[,[<LIST NAMR>][,ID]] DEC 20 ASC 20,LISTS ONE OR MORE GROUP ACCOUNT ENTRIES DEC 28 ASC 28, LI[ST],[U[SER]],<USER.GROUP>[,[<LIST NAMR>][,PA][,ID]] DEC 19 ASC 19,LISTS ONE OR MORE USER ACCOUNT ENTRIES DEC 12 ASC 12, LO[AD],<NAMR>[,ACCTS] DEC 27 ASC 27,REBUILDS THE ACCOUNTS ONLY FROM AN UNLOADED ACCT FILE DEC 11 ASC 11, LO[AD],<NAMR>[,ALL] DEC 27 ASC 27,REBUILDS THE ACCOUNT SYSTEM FROM h������þúAN UNLOADED ACCT FILE DEC 5 ASC 5, LO[AD],0 DEC 19 ASC 19,ALLOWS EXPANSION OF THE ACCOUNTS FILE DEC 8 ASC 8, NE[W],G[ROUP] DEC 20 ASC 20,CREATES AN ACCOUNT ENTRY FOR A NEW GROUP DEC 7 ASC 7, NE[W],U[SER] DEC 20 ASC 20,CREATES AN ACCOUNT ENTRY FOR A NEW USER DEC 6 ASC 6, PA[SSWORD] DEC 15 ASC 15,ALTERS CURRENT USERS PASSWORD DEC 8 ASC 8, PU[RGE],A[CCT] DEC 18 ASC 18,PURGES THE ENTIRE ACCOUNT STRUCTURE DEC 12 ASC 12, PU[RGE],G[ROUP],<NAME> DEC 19 ASC 19,REMOVES A GROUP FROM THE ACCOUNT FILE DEC 15 ASC 15, PU[RGE],U[SER],<USER.GROUP> DEC 18 ASC 18,REMOVES A USER FROM THE ACCOUNT FILE DEC 22 ASC 22, RE[SET],G[ROUP],<NAME>[,(CPU OR CONNECT)] DEC 13 ASC 13,CLEARS GROUP LOGON CLOCKS DEC 24 ASC 24, RE[SET],U[SER],<USER.GROUP>[,(CPU OR CONNECT)] DEC 12 ASC 12,CLEARS USER LOGON CLOCKS DEC 22 ASC 22, SD[,LU[,RP][,RG]] OR SD,RE[LEASE MEMORY] DEC 29 ASC 21,SHUTS DOWN AN ACTIVE SESSION OR THE ENTIRE ASC 8, SESSION SYSTEM DEC 2 ASC 2, SU DEC 14 ASC 14,RESTARTS THE SESSION SYSTEM DEC 23 ASC 23, TE[LL],<USER.GROUP>,<MESSAGE FILE>,<MESSAGE> DEC 23 ASC 23,SENDS A MESSAGE TO ONE OR MORE ACTIVE SESSIONS DEC 34 ASC 22, TR[[[[ANSFER],<CONTROL NAMR>],<LIST NAMR>] ASC 12,,(EC[HO] OR NO[ ECHO)]] DEC 25 ASC 25,TRANSFERS CONTROL OF ACCTS PROGRAM TO A FILE OR LU DEC 35 ASC 23, /TR[[[[ANSFER],<CONTROL NAMR>],<LIST NAMR>], ASC 12,(EC[HO] OR NO[ ECHO)]] DEC 25 ASC 25,TRANSFERS CONTROL OF ACCTS PROGRAM TO A FILE OR LU DEC 9 ASC 9, UN[LOAD],<NAMR> DEC 16 ASC 16,DUMPS A COPY OF THE ACCOUNT FILE DEC 2 ASC 2, DEC 1 ASC 1, Œ�����DEC 7 ASC 7, USER.GROUP DEC 1 ASC 1, DEC 19 ASC 19, @."GROUP" - ALL USERS IN "GROUP" DEC 1 ASC 1, DEC 20 ASC 20, "USER".@ - ALL USERS NAMED "USER" DEC 1 ASC 1, DEC 14 ASC 14, @.@ - ALL USERS DEC 1 ASC 1, DEC 2 ASC 2, DEC 1 ASC 1, DEC 15 ASC 15, NAMR -FILENAME:SC:CR OR LU DEC 1 ASC 1, DEC 15 ASC 15, /A -ABORT CURRRENT COMMAND DEC 1 ASC 1, DEC 13 ASC 13, /E -END CURRRENT PHASE DEC 1 ASC 1, DEC 18 ASC 18, HE[LP][,[<KEYWORD>][,<LIST NAMR>]] DEC 13 ASC 13,LISTS SYNTAX OF COMMAND[S] DEC 15 ASC 15, HE[LP],<ERROR NUMBER>[,<LU>] DEC 14 ASC 14,GETS HELP MESSAGE FOR ERROR DEC 16 ASC 16, /HE[LP],<ERROR NUMBER>[,<LU>] DEC 14 ASC 14,GETS HELP MESSAGE FOR ERROR TEND DEF * END ����������®í������ÿÿ����� ���� ÿý�:�C ���������ÿ��92067-18368 1940� S C0122 �&ACINT �ACCTS CHECKS STATUS OF � � � � � � � � � � � � �H0101 -�����ASMB,R,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18368 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * NAM ACINT,8 92067-16361 REV.1940 790515 * * * ACINT IS A ROUTINE TO DEACTRM INE IF THE SESSION MONITOR HAS * BEEN INITIALIZED ($DSCS NON-ZERO). IF INITIALIZED, ISTAT * IS SET TO 1, OTHERWISE ISTAT IS SET TO 0. * * CALLING SEQUENCE: CALL ACINT (ISTAT,JSTAT) * WHERE * ISTAT >= 0 IF INITIALIZED * =-1 IF NOT INITIALIZED * =-2 IF NOT INITIALIZED * AND RN'S ALLOCATED * JSTAT >= 0 SESSION IS UP * =-1 SOFT SHUT DOWN * =-2 SHORT TERM SHUT DOWN * FOR LOAD ACCOUNTS * ENT ACINT EXT .ENTR EXT $DSCS * ISTAT NOP JSTAT NOP ACINT NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF ISTAT XLA $DSCS HEAD OF SESSION MONITOR DISC POOL STA ISTAT,I XLA $DSCS+1 RESOURCE FLAG STA JSTAT,I SET IF NEGATIVE JMP ACINT,I RETURN END ����������������������������������������������������������������������������������������������������������´¢������ÿÿ����� ���� ÿý�;�A ���������ÿ��92067-18369 1940� S C0122 �&ACLIU �ACCTS LISTS USER AND GR � � � � � � � � � � � � �H0101 6 �����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18369 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C C LIST,USER C LIST,GROUP C CALLING SEQUENCE: C CALL ACLIU(ITYPE) C C WHERE: ITYPE=1 FOR USER C ITYPE=2 FOR GROUP C C LIST,USER C C ACCOUNT NAME FUNCTION C C C USER.GROUP LIST ONE ENTRY FOR ACCOUNT C C USER.@ LIST ALL ENTRIES IN ALL GROUPS C WITH NAME USER C C @.GROUP LIST ALL USERS OF GROUP C C @ LIST ALL USERS (DEFAULT) C C @.@ LIST ALL USERS AND GROUPS C SUBROUTINE ACLIU(ITYPE) ,92067-16361 REV.1940 790724 LOGICAL NOGRPS,ISRCH DIMENSION NAME(11),ITBUF(17) COMMON /ACOM1/NDCB(272),NBUF(256),IBUF(256) COMMON /ACOM2/ IDQQ1,IDQQ2,IDQQ3,JTYPE COMMON /ACOMA /ISRCH COMMON /ACOM4/ ICMND(40) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM7/ IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA IAT/2H@ / DATA LPPG,I0,I4,I6 /54,2HI0,2HI4,2HI6 / DATA ICR / 2HCR / C C PARSE ACCOUNT NAME C IERR=0 CALL PARSN(NAME,ICMND,80,ISTRC,IERR) IF(IERR.NE.0) IERR=-203 IF(IERR.NE.0) GO TO 950 C C PARSE LIST DEVICE C CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) CALL ACOPL(IERR,3,24) IF(IERR.NE.0) GO TO 900 –������þúC C PARSE FOR PASS C CALL NAMR(IPBUF,ICMND,80,ISTRC) C C PARSE FOR ID C CALL NAMR(JPBUF,ICMND,80,ISTRC) C C SET ALL GROUPS FLAG C NOGRPS=.TRUE. IF(NAME(2).EQ.IAT.AND.NAME(7).EQ.IAT) NOGRPS=.FALSE. C C SET DEFAULTS C IF(MBYTE(NAME(1)).EQ.0) NAME(2)=IAT IF(LBYTE(NAME(1)).EQ.0) NAME(7)=IAT IF(LBYTE(NAME(1)).NE.0.OR.NAME(2).EQ.IAT) GO TO 25 NAME(7 )=2HGE NAME(8 )=2HNE NAME(9 )=2HRA NAME(10)=2HL NAME(11)=2H C C SAVE RESET VALUES FOR LOOP C 25 IU=NAME(2) IG=NAME(7) C C SET ACERR FLAG C KERR=-200 C C GROUP LIST ONLY C GO TO(50,550),ITYPE 50 LINES=100 C C GET USER ENTRY C 100 CALL ACGTU (NAME(2),NAME(7),IBUF,IOF,IERR) IF(IERR.NE.0) GO TO 500 C C SET ACERR FLAG TO ZERO FOUND AT LEAST 1 ACCOUNT C KERR=0 C C TEST TO SEE IF WILL FIT ON PAGE C NTSST=LBYTE(IBUF(33+IOF)) IF(LINES+NTSST+18.LE.LPPG) GO TO 150 LINES=0 CALL ACWRL(2H1 ,1) 150 LINES=LINES+17 C C PRINT STARS CALL ACSTR CALL ACFMT (IERR,5,6HUSER: ,-20,0,10,NAME(2),1,2H. ,0,10,NAME(7)) CALL ACFMT (IERR) C C IF I AM NOT SYSTEM MANAGER OR GROUP MANAGER FOR GROUP C I CAN'T LOOK AT PASSWORD OR ID'S C IGID=IBUF(IOF+30) IF(IDSES.NE.7777B.AND.(MYCAP.NE.63.OR.IGID.NE.MYGID)) GO TO 175 C C PRINT PASSWORD C IF (IPBUF(1).NE.2HPA.AND.JPBUF(1).NE.2HPA) GO TO 170 CALL ACFMT (IERR,9,10HPASSWORD: ,-16,0,10,IBUF(2+IOF)) LINES=LINES+1 C C PRINT ID # C 170 IF(JPBUF(1).NE.2HID.AND.IPBUF(1).NE.2HID) GO TO 175 CALL ACFMT (IERR,12,12HUSER ID: ,I4,IBUF(IOF+29)) CALL ACFMT (IERR,12,12HGROUP ID: ,I4,IGID) LINES=LINES+2 C C PRINT HELLO FILE NAME C 175 IX=-14 IF(IBUF(7+IOF).EQ.2H ) IX=-80 C C DONT PRINT SC UNLESS SYSTEM MANAGER C ISC=IBUF(10+IOF) šë������þúIF(IDSES.NE.7777B.AND.(MYCAP.NE.63.OR.IGID.NE.MYGID)) ISC=0 C CALL ACFMT (IERR,11,12HHELLO FILE: ,IX,0,6,IBUF(7+IOF),1,2H: ,ICR 1 ,ISC,1,2H: ,ICR,IBUF(11+IOF)) C C SET UP PRINT FOR CAPABILTY C IX=-7 ICAPS=IBUF(22+IOF) IF(ICAPS.NE.63.OR.IBUF(IOF+29).EQ.7777B) IX=-80 C C PRINT CAPABILITY C CALL ACFMT (IERR,11,12HCAPABILITY: ,-14,I6,ICAPS,IX, 1 13,14HGROUP MANAGER ) CALL ACFMT (IERR,11,12HDISC LIMIT: ,-14,I6,IBUF(31+IOF)) CALL ACFMT (IERR,11,12HSST SPARES: ,-14,I6,LBYTE(IBUF(32+IOF))) CALL ACFMT (IERR) CALL ACFMT (IERR,9,10HUSER SST: ,-16, 1 22,22HSESSION LU / SYSTEM LU ) CALLACFMT (IERR,-25, 1 22,22H--------- ---------- ) C C COMPUTE NUMBER USER & GROUP SST'S C NGSST=MBYTE(IBUF(32+IOF)) NUSST=NTSST-NGSST C C PRINT SST'S C IF(NTSST.GT.31) 1 CALL READF(NDCB,IERR,IBUF(IOF+64),33,LEN,IBUF(IOF+64)) IF(NTSST.LE.0) GO TO 350 DO 300 I=1,NTSST LINES=LINES+1 IF(LINES.LE.LPPG) GO TO 190 LINES=5 CALL ACWRL(2H1 ,1) CALL ACSTR CALL ACFMT(IERR) CALL ACFMT (IERR,-25, 1 22,22HSESSION LU / SYSTEM LU ) CALLACFMT (IERR,-25, 1 22,22H--------- ---------- ) 190 IF(I.EQ.NUSST+1) GO TO 200 ISES=IAND(255,LBYTE(IBUF(33+IOF+I))+1) ISYS=IAND(255,MBYTE(IBUF(33+IOF+I))+1) CALL ACFMT (IERR,-25,I6,ISES,-5,I6,ISYS) GO TO 300 C C PRINT FIRST GROUP SST C 200 ISES=IAND(255,LBYTE(IBUF(33+IOF+I))+1) ISYS=IAND(255,MBYTE(IBUF(33+IOF+I))+1) CALL ACFMT (IERR,10,10HGROUP SST:,-15,I6,ISES 1 ,-5,I6,ISYS) 300 CONTINUE 350 CALL ACFMT (IERR) CALL ACTIM(IBUF(25+IOF),IERR) IF(IBUF(23+IOF).NE.0.OR.IBUF(24+IOF).NE.0) GO TO 370 CALL ACFMT (IERR,16,16HNEVER LOGGED OFF ) GO TO 380 370 CALL ACLTM(IBUF(23+IOF),ITBUF) CALL ACFMT (IERR,19,20HLAST LOGGED OFF: ,34,ITBUF) 38ÀT�����0 CALL ACFMT (IERR) CALL ACSTR C C GO BACK AND SEARCH REST OF DIRECTORY C ISRCH=.TRUE. NAME(2)=IU NAME(7)=IG IF(IU.EQ.IAT.OR.IG.EQ.IAT) GO TO 100 C C PRINT ALL GROUPS? C 500 IF(NOGRPS) GO TO 900 C YES C C GROUP PRINT ROUTINE C 550 LINES=100 ISRCH=.FALSE. C C GET GROUP ACCOUNT C 600 CALL ACGTG (NAME(2),IBUF,IOF,IERR) IF(IERR.NE.0) GO TO 900 C C SET ACERR FLAG FOUND 1 GROUP C KERR=0 C C TEST TO SEE IF IT WILL FIT ON PAGE C NGSST=-IBUF(6+IOF) IF(NGSST+LINES+11.LE.LPPG) GO TO 650 LINES=0 CALL ACWRL(2H1 ,1) 650 LINES=LINES+NGSST+11 CALL ACSTR CALL ACFMT (IERR) CALL ACFMT (IERR,6,6HGROUP:,-19,0,10,NAME(2)) CALL ACFMT (IERR) IF(IPBUF(1).NE.2HID.AND.JPBUF(1).NE.2HID) GO TO 675 CALL ACFMT (IERR,12,12HGROUP ID: ,I4,IAND(IBUF(IOF+1),7777B)) CALL ACFMT (IERR) LINES=LINES+2 675 CALL ACFMT (IERR,10,10HGROUP SST:,-15, 1 22,22HSESSION LU / SYSTEM LU) CALL ACFMT (IERR,-25 1 22,22H--------- ----------) NGSST=-IBUF(6+IOF) IF(NGSST.LE.0)GO TO 750 DO 700 I=1,NGSST ISES=IAND(LBYTE(IBUF(6+IOF+I))+1,255) ISYS=IAND(MBYTE(IBUF(6+IOF+I))+1,255) 700 CALL ACFMT (IERR,-25,I6,ISES,-5,I6,ISYS) 750 CALL ACFMT (IERR) CALL ACTIM(IBUF(2+IOF),IERR) CALL ACFMT (IERR) CALL ACSTR C C PRINT ALL GROUPS C ISRCH=.TRUE. NAME(2)=IU IF(IU.EQ.IAT) GO TO 600 C C CLEAN UP AND EXIT C 900 CALL ACCLL 950 IF(IERR.EQ.-200) IERR=KERR ISRCH=.FALSE. IF(IERR.NE.0) CALL ACERR(IERR) RETURN END ������������������������������������������������������÷¡������ÿÿ����� ���� ÿý�<�E ���������ÿ��92067-18370 2001� S C0122 �&ACLIA �ACCTS LISTS SESSION WID � � � � � � � � � � � � �H0101 ’Ù�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18370 C C RELOCATABLE PART NUMBER : 92067-16362 C C PROGRAMER(S) : J.M.N. C C C C C ACLIA SUBROUTINE TO LIST C SESSION WIDE INFORMATION C SUBROUTINE ACLIA(JTYPE) ,92067-16362 REV.2001 791020 LOGICAL IFOND,IFLG DIMENSION ITBUF(17),IBUF(128),LUX(2) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ ICMND(40) COMMON /ACOM7/ IPBUF(11),ISTRC,ISCS COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID EQUIVALENCE (IPBUF,IPB) C DATA I0,I1,I3,I4,I5,I6/2HI0,2HI1,2HI3,2HI4,2HI5,2HI6 / DATA ICR / 2HCR / DATA LPPG / 54 / DATA LUX / 0,0 / C C SAVE LIST(4) FOR POSIBLE RESTORE C LISV=LIST(4) LIST(4)=0 C C IF FROM SHUT DOWN THEN BYPASS PARSING C IPB=1 IF(JTYPE.EQ.2) GO TO 50 C C PARSE LIST DEVICE C CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) CALL ACOPL(IERR,3,24) IF(IERR.NE.0) GO TO 1100 C C COMPUTE GO TO INDEX FROM NEXT PARM C CALL NAMR(IPBUF,ICMND,80,ISTRC) IF(IPB.EQ.2HAC) IPB=0 IF(IPB.EQ.2HPO) IPB=1 IF(IPB.EQ.2HCO) IPB=2 IF(IPB.EQ.2HAL) IPB=3 IF(IPB.LT.0.OR.IPB.GT.3) IPB=3 IPB=IPB+1 C C GET FILE HEADER C 50 CALL READF(NDCB,IERR,NBUF,128,LEN,1) IF(IERR.LT.0) GO TO 1100 CALL ACSTR IF(JTYPE.EQ.2) GO TO 80 CALL ACFMT (IERR q������þú,-14,26,26HACCOUNT SYSTEM INFORMATION ) CALL ACFMT (IERR) CALL ACFMT (IERR,14,14HSESSION LIMIT: ,-16,I3,-NBUF(28), 1 9,10H SESSIONS ) C C IF NOT SYSTEM MANAGER DON'T GIVE SC C ISC=NBUF(10) IF(IDSES.NE.7777B) ISC=0 IX=-10 IF(NBUF(7).EQ.2H ) IX=-80 CALL ACFMT (IERR,20,20HSYSTEM MESSAGE FILE: ,IX,0,6, 1 NBUF(7),1,2H: ,ICR,ISC,1,2H: ,ICR,NBUF(11)) CALL ACFMT (IERR,21,22HCRN OF MESSAGE FILES ,-10,ICR,NBUF(26)) 80 LINES=7 GO TO (90,201,601,90),IPB 90 CALL ACFMT (IERR) CALL ACFMT (IERR,16,16HACTIVE SESSIONS: ) CALL ACFMT (IERR) CALL ACFMT (IERR,15,16HSESSION USER ,-15,11,12HLOG-ON TIME ) CALL ACFMT (IERR,15,16H------- ---- ,-15,11,12H----------- ) LINES=LINES+5 C C READ ACTIVE SESSION BLOCKS C I=128 LC=LOC(1)-1 100 I=I+4 IF(I.LT.128) GO TO 150 LC=LC+1 IF(LC.GE.LOC(2)) GO TO 200 I=1 CALL READF(NDCB,IERR,MBUF,128,LEN,LC) 150 LU=MBUF(I) IF(LU.EQ.0) GO TO 100 C CALL ACLTM(MBUF(I+1),ITBUF) ID=MBUF(I+3)*16+1 CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(5)+ID/128) ID=MOD(ID,128) IBL=NBUF(ID) IBL=MBYTE(IBL)+LBYTE(IBL)-22 CALL ACFMT (IERR,I4,LU,-5,0,10,NBUF(ID+1),1,2H. ,0, 1 10,NBUF(ID+6),IBL,14,ITBUF,4,ITBUF(13),2,2H ,2,ITBUF(11)) LINES=LINES+1 GO TO 100 C C PRINT DISC POOL C 200 GO TO (1000,201,601,201),IPB 201 CALL ACFMT (IERR) CALL ACFMT (IERR,10,10HDISC POOL: ) CALL ACFMT (IERR,32,32H DISC LU SIZE MOUNTED TO ) CALL ACFMT (IERR,32,32H ------- ---- ---------- ) LINES=LINES+3 CALL ACFST(MBUF) JJ=0 C C READ DISC POOL C 300 CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(3)) JJ=JJ+1 IFOND=.FALSE. LU=NBUF(JJ) IF(LU.EQ.0) GO TO 600 C C GET SIZE OF DISC C ITRKS=0 ISCS=0 LUX(1)=IOR(LU,10{ ������þú0000B) CALL XLUEX(100015B,LUX,IDVRT) GO TO 310 305 IDVRT=IAND(IDVRT,37400B)/256 IF(IDVRT.GE.30B.AND.IDVRT.LE.33B) GO TO 325 ITRKS=IDVRT/8 ISCS=MOD(IDVRT,8) C C WRITE DRIVER TYPE C CALL ACFMT(IERR,I6,LU,-4,2,2HDV,I1,ITRKS,I1,ISCS) GO TO 300 C C WRITE ABORTING ERROR AND CONTINUE C 310 CALL ABREG(IA,IB) CALL ACFMT(IERR,I6,LU,-4,8,8HERROR = ,2,IA,2,IB) GO TO 300 C 325 CALL XLUEX(1,LUX,ISCS,1,-1,0) CALL ABREG(IDVRT,ITRKS) C C SEARCH FOR MOUNTED DISC C DO 350 J=1,256,4 IF(MBUF(J).EQ.0) GO TO 575 LU2=LBYTE(MBUF(J)) IDCDE=MBUF(J+3) IF(LU.NE.LU2) GO TO 350 IF(IDCDE.EQ.0) GO TO 550 GO TO 370 350 CONTINUE GO TO 575 C C SEARCH FOR ID IN ACTIVE SESSIONS C 370 LASB=LOC(1) 380 I=-3 IF(LASB.GE.LOC(2)) GO TO 450 CALL READF(NDCB,IERR,IBUF,128,LEN,LASB) LASB=LASB+1 400 I=I+4 IF(I.GT.125) GO TO 380 IF(IBUF(I).EQ.0) GO TO 400 ID=IBUF(I+3)*16+1 CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(5)+ID/128) ID=MOD(ID,128) IF(NBUF(ID+11).NE.IDCDE) GO TO 425 LINES=LINES+1 IF(IFOND) GO TO 410 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2H* ,I3,ISCS,-4, 1 0,10,NBUF(ID+1),1,2H. ,0,10,NBUF(ID+6)) IFOND=.TRUE. GO TO 400 410 CALL ACFMT (IERR,-23,0,10,NBUF(ID+1),1,2H. , 1 0,10,NBUF(ID+6)) IFOND=.TRUE. GO TO 400 C C GROUP CARTRIDGE C 425 IF(NBUF(ID+12).NE.IDCDE) GO TO 400 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2H* ,I3,ISCS,-4, 1 0,10,NBUF(ID+6)) IFOND=.TRUE. LINES=LINES+1 C C NOT MOUNTED TO ANY ACTIVE SESSION C 450 IF(IFOND) GO TO 300 IREC=0 460 ID=1 CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(5)+IREC) 475 IF(NBUF(ID).EQ.0) GO TO 550 IF(NBUF(ID).LT.0) GO TO 490 IF(NBUF(ID+11).NE.IDCDE) GO TO 480 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2‚¾������þúH* ,I3,ISCS,-4, 1 0,10,NBUF(ID+1),1,2H. ,0,10,NBUF(ID+6),14,14H (NOT ACTIVE) ) LINES=LINES+1 GO TO 300 480 IF(NBUF(ID+12).NE.IDCDE) GO TO 490 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2H* ,I3,ISCS,-4, 1 0,10,NBUF(ID+6),14,14H (NOT ACTIVE) ) LINES=LINES+1 GO TO 300 490 ID=ID+16 IF(ID.LT.128) GO TO 475 IREC=IREC+1 GO TO 460 C C NOT MOUNTED TO ANY SESSION C 550 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2H* ,I3,ISCS,-4, 1 1,2H- ,I0,IDCDE) LINES=LINES+1 GO TO 300 C C DISC NOT MOUNTED C 575 CALL ACFMT (IERR,I6,LU,-2,I5,ITRKS,1,2H* ,I3,ISCS,-4, 1 16,16HDISC NOT MOUNTED ) LINES=LINES+1 GO TO 300 C C PRINT CONFIGURATION TABLE C 600 GO TO (1000,1000,601,601),IPB 601 IFLG=.FALSE. IDX=0 LINES=LINES+4 700 LNGTH=ACNFG(IERR,IDX)-1 IF(LNGTH.LT.0) GO TO 1000 I1=2 IF(LINES+LNGTH.LE.LPPG) GO TO 825 750 LINES=5 CALL ACFMT (IERR) CALL ACSTR CALL ACWRL(2H1 ,1) CALL ACSTR GO TO 850 825 IF(IFLG) GO TO 875 850 CALL ACFMT (IERR) CALL ACFMT (IERR,20,20HCONFIGURATION TABLE: ) CALL ACFMT (IERR,33,34H STATION SESSION LU / SYSTEM LU ) CALL ACFMT (IERR,33,34H ------- --------- ---------- ) C 875 IFLG=.TRUE. IF(I1.GT.2) GO TO 880 LINES=LINES+1 ISSN=ACNFG(IERR,IDX) IF(LNGTH.EQ.0) GO TO 900 ISST=ACNFG(IERR,IDX) ISTN=IAND(255,MBYTE(ISSN)+1) ISYS=IAND(255,MBYTE(ISST)+1) ISES=IAND(255,LBYTE(ISST)+1) CALL ACFMT (IERR,I6,ISTN,-3,I6,ISES,-7,I6,ISYS) 880 IF(LNGTH.LT.I1) GO TO 700 ISTRT=I1 DO 800 I1=ISTRT,LNGTH IF(LINES.GT.LPPG) GO TO 750 LINES=LINES+1 ISST=ACNFG(IERR,IDX) ISYS=IAND(255,MBYTE(ISST)+1) ISES=IAND(255,LBYTE(ISST)+1) 800 CALL ACFMT (IERR,-9,I6,ISES,-7,I6,ISYS) GO TO 700 C C SESSION LU ONLY C 900 CALL A P�����CFMT (IERR,I6,MBYTE(ISSN)+1) GO TO 700 1000 CALL ACFMT (IERR) CALL ACSTR 1100 IF(IERR.NE.0) CALL ACERR(IERR) IF(JTYPE.EQ.2) GO TO 1200 CALL ACCLL RETURN 1200 LIST(4)=LISV RETURN END ��������������������������������������á ������ÿÿ����� ���� ÿý�=� G ���������ÿ��92067-18371 2001� S C0122 �&ACLOA �ACCTS LOADS ACCOUNTS FI � � � � � � � � � � � � �H0101 Eø�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18371 C C RELOCATABLE PART NUMBER : 92067-18361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACLOA(JP) ,92067-16362 REV.2001 791018 LOGICAL ISRCH,IFBRK COMPLEX MESG(4) COMPLEX MESG2(5) INTEGER ONAME(3),INAME(6) DIMENSION LU2(2) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID,ICRN EQUIVALENCE (MESG2(4),IMES2),(IPBUF(1),IPB),(JPBUF(1),JPB) DATA MESG2 / 8HSTATION ,8HTABLE RE,8HQUIRES , 1 8H ,8HWORDS / DATA ONAME / 2H++,2HCC,2HT! / DATA INAME / 2H+@,2HCC,2HT!,3,-31178,-2 / DATA MESG /8H ,8HTOTAL AC ,8HCOUNTS R ,8HEQUIRED / DATA LU2 /0,500B / C C SET SHUT DOWN MESSAGE C CALL LMES(-17,18HSESSION SHUT DOWN ,-2) C C TELL LOGON LGOFF TO CLOSE DOWN C CALL ACSES(-2) C CALL RNRQ(1,IRN,ISTAT) IF(LIST(1).NE.0.OR.LIST(4).EQ.0) GO TO 100 LIST(1)=2H+@ LIST(2)=2HCC LIST(3)=2HT! LIST(4)=3 >������þú LIST(5)=-31178 LIST(6)=ICRN JP=3 CALL ACOPL(IERR,1,0) IF(IERR.NE.0) GO TO 999 C C PROMPT FOR CRN C 100 CALL ACNVS(32HENTER DISC LU FOR ACCTS FILE : _ ,16,0) ICRN=IPBUF(1) IF(ICRN.EQ.2H/A )GO TO 1000 IF(ICRN.GT.0) ICRN=-ICRN CALL ACREL(NBUF,128,LEN,IERR) KACCTS=(NBUF(6)-NBUF(5))*8-1 CALL ACITA(KACCTS,MESG,3 ) CALL ACWRI(MESG,16) NBF6O=NBUF(6) NBF5O=NBUF(5) IF(JP.GE.3) GO TO 200 CALL ACOPL(IERR,-1,0) IF(IERR.NE.-6) GO TO 120 JP=3 LIST(4)=-LIST(4) GO TO 200 120 IF(IERR.NE.0) GO TO 999 CALL ACREL(NBUF,128,LEN,IERR) C C PUT CURRENT RESOURCE NUMBERS C IN BUFFER C 200 NBUF(25)=IRN NBUF(34)=IRN2 NBUF(32)=ICLASS NBUF(35)=IDSZE LNGCO=NBUF(33) C C PROMPT FOR NUMBER ACCOUNTS C 201 CALL ACNVS(26HNUMBER OF USER ACCOUNTS? _ ,13,0) IUS=IPB IF(IUS.EQ.2H/A.OR.IUS.EQ.2H/E) GO TO 1000 CALL ACNVS(28HNUMBER OF GROUP ACCOUNTS? _,14,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 1000 IACCTS=(5*IUS)/4+IPB IACCTS=(IACCTS/8)*8+7 IF(KACCTS.GT.IACCTS) IACCTS=KACCTS IF(IACCTS.GT.6.AND.IACCTS.LE.4095) GO TO 209 CALL ACERR(-33) GO TO 201 C 209 ISIZE=NBUF(5)+(5*IACCTS)/8 C C TELL SIZE REQUIRED FOR STATION TABLE C CALL ACITA(128*LNGCO,IMES2,3) CALL ACWRI(MESG2,19) C C ASK FOR NEW SIZE C 210 CALL ACNVS(42HENTER <NUMBER OF STATIONS>,<AVERAGE SIZE> ,21,0) IF(IPB.EQ.2H/A.OR.IPB.EQ.2H/E) GO TO 1000 CALL NAMR(JPBUF,ICMND,80,ISTRC) C C COMPUTE NEW SIZE OF STATION TABLE C LNG=(IPB*(JPB+1))/128+1 IF(IAND(IPBUF(4),3).GT.1.OR.IAND(JPBUF(4),3).GT.1) GO TO 210 IF(IAND(IPBUF(4),3).EQ.0) LNG=NBUF(3)-NBUF(2) IF(LNG.LT.LNGCO) LNG=LNGCO IF(LNG.LT.200) GO TO 215 CALL ACERR(-33) GO TO 210 C C COMPUTE DELTA DUE TO STATION TABLE C ë������þú 215 LNDEL=LNG-NBUF(3)+NBUF(2) IEND=NBUF(5)-1 NB3O=NBUF(3) C C SET POINTERS C DO 220 I=3,6 220 NBUF(I)=NBUF(I)+LNDEL NB3N=NBUF(3) C ADJUST SIZE ISIZE=ISIZE+LNDEL C C SET SIZE OF DIRECTORY C NBUF6=NBUF(5)+IACCTS/8+1 NBUF(6)=NBUF6 NDIR=NBUF6-NBUF(5) C C CREAT NEW ++CCT!:-31178:ICRN C FOR ACCTS FILE C CALL ACCRE(MBUF,2H++,ISIZE,IERR) IF(IERR.LT.0) GO TO 999 C C READ ACCOUNTS WIDE INFORMATION C CALL WRITF(MBUF,IERR,NBUF,128) IF(IERR.LT.0) GO TO 999 DO 300 I=2,IEND CALL ACREL(NBUF,128,LEN,IERR) IF(IERR.LT.0) GO TO 999 IF(I.GE.NB3N.AND.I.LT.NB3O) GO TO 300 CALL WRITF(MBUF,IERR,NBUF,128) IF(IERR.LT.0) GO TO 999 IF(I+1.NE.NB3O.OR.LNDEL.LE.0) GO TO 300 C C FILL UP STATION TABLE C C CLEAR BUFFER C DO 250 J=1,128 250 NBUF(J)=0 C DO 260 J=1,LNDEL CALL WRITF(MBUF,IERR,NBUF,128) IF(IERR.LT.0) GO TO 999 260 CONTINUE 300 CONTINUE C C COMPUTE DELTA C JDEL=NDIR-NBF6O+NBF5O IDEL=NBUF6-NBF6O IF(JDEL.LT.0) GO TO 999 C C IF ACCTS ONLY THEN C SPACE UP TO DIRECTORY C IF(JP.GE.3) GO TO 330 CALL ACOPL(IERR,-1,0) IEND=NBF5O-1 DO 320 I=2,IEND CALL ACREL(NBUF,128,LEN,IERR) IF(IERR.LT.0) GO TO 999 320 CONTINUE C C UPDATE DIRECTORY C 330 CALL ACREL(NBUF,128,LEN,IERR) IF(IERR.LT.0) GO TO 999 DO 335 I=1,128,16 IF(NBUF(I).EQ.0) GO TO 340 IF(NBUF(I+13).NE.0) NBUF(I+13)=NBUF(I+13)+IDEL IF(NBUF(I+14).NE.0) NBUF(I+14)=NBUF(I+14)+IDEL 335 CONTINUE CALL WRITF(MBUF,IERR,NBUF,128) GO TO 330 C C BUILD REST OF DIRECTORY C 340 IF(JDEL.EQ.0) GO TO 365 NBUF(I)=-1 CALL WRITF(MBUF,IERR,NBUF,128) DO 350 I=1,128 350 NBUF(I)=0 DO 360 I=1,128,16 360 NBUF(I)=-1 C C WRITE IT C 36­�����5 DO 370 I=1,JDEL IF(I.EQ.JDEL) NBUF(113)=0 CALL WRITF(MBUF,IERR,NBUF,128) IF(IERR.LT.0) GO TO 999 370 CONTINUE C C FIX ACCOUNT ENTRIES C JERR=0 DO 500 I=NBUF6,ISIZE CALL ACREL(NBUF,128,LEN,JERR) IF(JERR.NE.0.AND.JERR.NE.-12) GO TO 998 IF(NBUF(1).LT.0) NBUF(64)=NBUF(64)+IDEL IF(NBUF(65).LT.0) NBUF(128)=NBUF(128)+IDEL CALL WRITF(MBUF,IERR,NBUF,128) IF(IERR.LT.0)GO TO 999 500 CONTINUE C C RENAME FILE FROM ++CCT! TO +@CCT! C CALL CLOSE(NDCB) DO 900 I=1,1000 520 CALL PURGE(NDCB,IERR,INAME,-31178) IF(IERR.GE.0) GO TO 520 IF(IERR.EQ.-6) GO TO 925 IF(IERR.NE.-8) GO TO 999 C C TELL USER HE IS WAITING C IF(I.EQ.2) 1 CALL ACWRI(30HWAITING FOR FILE TO BE CLOSED ,15) C C SUSPEND FOR 5 SEC C CALL EXEC(12,0,2,0,-5) IF(IFBRK(IDUM)) GO TO 995 900 CONTINUE C C IF CAN'T GET IT AFTER 10 SEC'S GIVE UP C GO TO 995 C C RENAME FILE TO +@CCT!:-31178:-2 C 925 CALL NAMF(MBUF,IERR,ONAME,INAME,-31178,ICRN,IDUM,70707B) C REWIND TAPE 995 LU2(1)=IOR(100000B,LIST(1)) IF(LIST(4).EQ.1) CALL XLUEX(3,LU2) C C CLOSE INPUT FILE CALL ACCLL CALL ACOPN(JERR,IDSES) IF(JERR.GE.0) GO TO 1000 C C POST ACERR C 998 IERR=JERR 999 CALL ACERR(IERR) C C RESTART SESSION C 1000 CALL ACSES(0) CALL RNRQ(40004B,IRN,ISTAT) GO TO 1200 1100 CONTINUE 1200 RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿ·������ÿÿ����� ���� ÿý�>�G ���������ÿ��92067-18372 1940� S C0122 �&ACNWG �ACCTS ADDS NEW GROUP � � � � � � � � � � � � �H0101 Í�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER : 92067-18372 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACNWG - NEW GROUP COMMAND ROUTINE C C CALLING SEQUENCE: CALL ACNWG C C ACERRS: -201 NO FREE ACCOUNTS C -202 ACCOUNT WITH THIS NAME ALREADY EXISTS C -203 INVALID ACCOUNT NAME C -209 INVALID SST ENTRY C -211 USER OR GROUP ID NOT AVAILABLE C FMP ACERR (READF,WRITF) C C SUBROUTINE ACNWG ,92067-16361 REV.1940 790227 DIMENSION MSGNM(6),MSGST(29),IUSER(5),IDMY(2) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) DATA MSGNM/2HGR,2HOU,2HP ,2HNA,2HME,2H? / DATA MSGST/2HSS,2HT ,2HDE,2HFI,2HNI,2HTI,2HON,2H? ,2H(E, 1 2HNT,2HER,2H S,2HES,2HSI,2HON,2H L,2HU,,2H S,2HYS, 2 2HTE,2HM ,2HLU,2H, ,2HOR,2H E,2HNT,2HER,2H /,2HE)/ C C INDX=6 C C CHECK IF A FREE ACCOUNT OF 64 WORDS EXISTS C CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1) IF(IERR.EQ.0) GO TO 100 CALL ACERR(IERR) RETURN C C PROMPT FOR THE GROUP NAME C 100 CALL ACPRM(MSGNM,6) C C READ AND PARSE THE GROUP NAME C CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(IPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(IPBUF(2).EQ.2H/E.OR.IPBUF(2).EQ.2H/A) RETURN C C IF NAME IS IÖ­������þúNVALID, REPORT ACERR AND RE-PROMPT C IF(IERR.EQ.0) GO TO 300 200 CALL ACERR(-203) GO TO 100 C C CHECK THAT NAME IS NOT IN USER.GROUP FORMAT, C THAT NAME IS NOT "@", AND THAT NAME IS NOT NULL C 300 IF(IAND(IPBUF(1),255).NE.0) GO TO 200 IF(IPBUF(2).EQ.2H@ ) GO TO 200 IF(IPBUF(1).EQ.0) GO TO 200 C C CHECK IF GROUP ALREADY EXISTS C IUSER(1)=0 CALL ACFDA(IUSER,IPBUF(2),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.-200) GO TO 350 C C ACERR - GROUP ACCOUNT ALREADY EXISTS C CALL ACERR(-202) GO TO 100 C C PROMPT FOR GROUP SST DEFINITION C 350 ICL=29 400 CALL ACPRM(MSGST,ICL) ICL=8 CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO END SST DEFINITION C ALSO CHECK FOR NULL OR BLANK (DEFAULT TO NO GROUP SST) C IF(JPBUF(1).EQ.2H/E) GO TO 500 ITEMP=IAND(JPBUF(4),3) IF((ITEMP.EQ.0).AND.(INDX.EQ.6)) GO TO 500 C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A) RETURN C C READ, PARSE AND VALIDATE SST ENTRY C SYSTEM LU MUST BE NUMERIC, 0-254 C SESSION LU MUST BE NUMERIC, 4-63 C IF(IAND(JPBUF(4),3).NE.1) GO TO 430 ISES=JPBUF(1) CALL NAMR(JPBUF,IBUF,80,ICHAR) ISYS=JPBUF(1) IF((ISYS.LT.0).OR.(ISYS.GT.254)) GO TO 430 IF(IAND(JPBUF(4),3).NE.1) GO TO 430 IF((ISES.LT.4).OR.(ISES.GT.63)) GO TO 430 C C CHECK IF SESSION LU HAS ALREADY BEEN DEFINED C IF(INDX.EQ.6) GO TO 420 DO 410 I=7,INDX IDMY=IAND(JBUF(I),255)+1 IF(IDMY.EQ.ISES) GO TO 430 410 CONTINUE 420 INDX=INDX+1 JBUF(INDX)=(IAND(255,ISYS-1)*256)+ISES-1 GO TO 400 430 CALL ACERR(-209) GO TO 400 C C GET A FREE ACCOUNT ENTRY C 500 ISIZE=INDX LEN=6-INDX CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1) IF(IERR.GE.0) GO TO 600 CALL ACERR(IERR) RETURN C C GET A GR'����� OUP ID C 600 CALL ACGID(-1,ID,IERR) IF(IERR.NE.-2) GO TO 700 CALL ACERR(-211) RETURN C C BUILD THE DIRECTORY ENTRY C 700 IBUF(1)=IPBUF(1)/256 DO 800 I=2,6 IBUF(I)=2H 800 CONTINUE DO 900 I=7,11 IBUF(I)=IPBUF(I-5) 900 CONTINUE IBUF(12)=0 IBUF(13)=ID IBUF(14)=IRECN IF(IOFST.NE.0) IBUF(14)=IOR(IRECN,100000B) IBUF(15)=0 IBUF(16)=0 CALL RNRQ(1,IRN,ISTAT) CALL ACDIR(2,IDIRN,IBUF,IERR) C C BUILD THE GROUP ACCOUNT ENTRY C CALL READF(NDCB,IERR,NBUF,128,IDMY,IRECN) IF(ISIZE.GT.64) ID=IOR(ID,100000B) NBUF(IOFST+1)=ID DO 1000 I=2,5 NBUF(IOFST+I)=0 1000 CONTINUE NBUF(IOFST+6)=LEN IF(ISIZE.EQ.6) GO TO 1200 DO 1100 I=7,INDX NBUF(IOFST+I)=JBUF(I) 1100 CONTINUE 1200 CALL WRITF(NDCB,IERR,NBUF,128,IRECN) IF(IERR.LT.0) CALL ACERR(IERR) CALL RNRQ(4,IRN,ISTAT) RETURN END ������������������������������Aú������ÿÿ����� ���� ÿý�?�G ���������ÿ��92067-18373 2013� S C0122 �&ACNWU �ACCTS ADDS NEW USER � � � � � � � � � � � � �H0101 Éú�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18373 C C RELOCATABLE PART NUMBER : 92067-16362 C C PROGRAMER(S) : J.M.N. C C C C ACNWU - NEW USER COMMAND ROUTINE C C CALLING SEQUENCE: CALL ACNWU C C ACERRS: -200 ACCOUNT NOT FOUND C -201 NO FREE ACCOUNTS C -202 ACCOUNT WITH THIS NAME ALREADY EXISTS C -203 INVALID ACCOUNT NAME C -204 INVALID PASSWORD C -206 INVALID FILE NAME C -207 INVALID CAPABILITY C -208 INVALID DISC LIMIT C -209 INVALID SST ENTRY C -210 CONFLICT IN SST DEFINITION C -211 USER OR GROUP ID NOT AVAILABLE C -212 INVALID NUMBER OF SST SPARES C FMP ACERR (READF,WRITF) C C SUBROUTINE ACNWU ,92067-16362 REV.2013 800131 DIMENSION MSNAM(5),MSGNM(6),MSGST(12),MSUPW(7),MSHFL(8) DIMENSION MSCAP(8),MSMXD(12),MSSST(29),MSSPR(11),MSLNK(32) DIMENSION MSGNX(9),LUMS1(27),LUMS2(31) DIMENSION IUSER(5),IDMY(2),IRECG(2) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA MSNAM/2HUS,2HER,2H N,2HAM,2HE?/ DATA MSGNM/2HGR,2HOU,2HP ,2HNA,2HME,2H? / DATA MSGST/2HUS,2HE ,2HGR,2HOU,2HP ,2HSS,2HT ,2H(Y,2H O, 1 ï������þú 2HR ,2HN),2H? / DATA MSUPW/2HUS,2HER,2H P,2HAS,2HSW,2HOR,2HD?/ DATA MSHFL/2HUS,2HER,2H H,2HEL,2HLO,2H F,2HIL,2HE?/ DATA MSCAP/2HUS,2HER,2H C,2HAP,2HAB,2HIL,2HIT,2HY?/ DATA MSMXD/2HMA,2HXI,2HMU,2HM ,2HDI,2HSC,2H C,2HAR,2HTR, 1 2HID,2HGE,2HS?/ DATA MSSST/2HSS,2HT ,2HDE,2HFI,2HNI,2HTI,2HON,2H? ,2H(E, 1 2HNT,2HER,2H S,2HES,2HSI,2HON,2H L,2HU,,2H S,2HYS, 2 2HTE,2HM ,2HLU,2H, ,2HOR,2H E,2HNT,2HER,2H /,2HE)/ DATA MSSPR/2HNU,2HMB,2HER,2H O,2HF ,2HSS,2HT ,2HSP,2HAR, 1 2HES,2H? / DATA MSLNK/2HLI,2HNK,2H T,2HO ,2HAN,2H E,2HXI,2HST,2HIN, 1 2HG ,2HAC,2HCO,2HUN,2HT?,2H (,2HEN,2HTE,2HR ,2H" ,2H" , 2 2HOR,2H U,2HSE,2HR.,2HGR,2HOU,2HP/,2HPA,2HSS,2HWO, 3 2HRD,2H) / DATA MSGNX/2HNE,2HXT,2H G,2HRO,2HUP,2H O,2HR ,2H/E,2H? / DATA LUMS1/2HCO,2HNF,2HLI,2HCT,2H I,2HN ,2HSS,2HT ,2HDE, 1 2HFI,2HNI,2HTI,2HON,2H -,2H A,2HSS,2HUM,2HIN,2HG , 2 2HUS,2HER,2H D,2HEF,2HIN,2HIT,2HIO,2HN / DATA LUMS2/2HUS,2HER,2H: ,2HSE,2HS ,2HLU,2H ,2H ,2H, , 1 2HSY,2HS ,2HLU,2H ,2H ,2H ,2H ,2H G,2HRO,2HUP, 2 2H: ,2HSE,2HS ,2HLU,2H ,2H ,2H, ,2HSY,2HS ,2HLU, 3 2H ,2H / C C C CHECK IF A FREE ACCOUNT OF 128 WORDS EXISTS C CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1) IF(IERR.EQ.0) GO TO 100 CALL ACERR(-201) RETURN C C PROMPT FOR THE USER NAME C 100 CALL ACPRM(MSNAM,5) C C READ AND PARSE THE USER NAME C CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(IPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF((IPBUF(2).EQ.2H/A).OR.(IPBUF(2).EQ.2H/E)) RETURN C C IF NAME IS INVALID, REPORT ACERR AND RE-PROMPT C NAME CANNOT BE IN USER.GROUP FORMAT C NAME CANNOT BE "@" OR NULL C IF(IERR.NE.0) GO TO 200 IF(IAND(IPBUF(1),255).NE.0) GO TO 200 IF(IPBUF(2).EQ.2H@ ) GO TO 200 IF(IPBUF(1).NE.0) GO TO 300 200 CALL›ó������þú ACERR(-203) GO TO 100 300 IF(IDSES.EQ.7777B) GO TO 310 C C GET THE GROUP NAME FROM C MY ACCOUNT C CALL ACDIR(1,MYDIR,IBUF,IERR) JPBUF(1)=256*LBYTE(IBUF(1)) JPBUF(2)=IBUF(7) JPBUF(3)=IBUF(8) JPBUF(4)=IBUF(9) JPBUF(5)=IBUF(10) JPBUF(6)=IBUF(11) C C SET MAXIMUM CAPABILITY C MAXCAP=62 GO TO 600 C 310 MAXCAP=63 C C PROMPT FOR THE GROUP NAME C CALL ACPRM(MSGNM,6) C C READ AND PARSE THE GROUP NAME C 320 CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN C C IF NAME IS INVALID, REPORT ACERR AND RE-PROMPT C NAME CANNOT BE IN USER.GROUP FORMAT AND CANNOT BE "@" C 330 IF(IERR.NE.0) GO TO 400 IF(IAND(JPBUF(1),255).NE.0) GO TO 400 IF(JPBUF(2).NE.2H@ ) GO TO 500 400 CALL ACERR(-203) GO TO 300 C C IF NO GROUP SPECIFIED, DEFAULT TO GENERAL C 500 IF(JPBUF(1).NE.0) GO TO 600 JPBUF(1)=3400B JPBUF(2)=2HGE JPBUF(3)=2HNE JPBUF(4)=2HRA JPBUF(5)=2HL C C CHECK THAT GROUP ACCOUNT EXISTS C 600 IUSER(1)=0 CALL ACFDA(IUSER,JPBUF(2),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.0) GO TO 700 CALL ACERR(-200) IF(IDSES.EQ.7777B) GO TO 310 RETURN C C CHECK IF USER.GROUP ACCOUNT ALREADY EXISTS C 700 CALL ACFDA(IPBUF(2),JPBUF(2),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.-200) GO TO 800 710 CALL ACERR(-202) GO TO 100 C C SAVE GROUP INFO (LENGTH OF NAME, NAME) C 800 DO 900 I=2,6 IPBUF(I+5)=JPBUF(I) 900 CONTINUE IPBUF(1)=IPBUF(1)+(JPBUF(1)/256) C C PROMPT FOR WHETHER TO USE GROUP SST C CALL ACPRM(MSGST,12) C C READ AND PARSE FOR Y OR N C CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT C—`������þúOMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN C C SET SIGN BIT IF Y OR NULL TO INDICATE USE GROUP SST C JBUF(33)=0 ITEMP=JPBUF(2)/256 IF((ITEMP.EQ.131B).OR.(JPBUF(1).EQ.0)) 1 JBUF(33)=100000B C C PROMPT FOR USER PASSWORD C 1100 CALL ACPRM(MSUPW,7) CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) IF(IERR.EQ.0) GO TO 1120 C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 1110 CALL ACERR(-204) IERR=0 GO TO 1100 C C IF NO PASSWORD SPECIFIED, DEFAULT TO NONE C 1120 IF(JPBUF(1).NE.0) GO TO 1140 DO 1130 KNDX=2,6 JBUF(KNDX)=2H 1130 CONTINUE GO TO 1170 C C PASSWORD CAN'T BE IN USER.GROUP FORMAT C 1140 IF(IAND(JPBUF(1),255).NE.0) GO TO 1110 DO 1150 KNDX=2,6 JBUF(KNDX)=JPBUF(KNDX) 1150 CONTINUE 1170 JBUF(1)=JPBUF(1)/256 C C PROMPT FOR USER HELLO FILE C 1200 CALL ACPRM(MSHFL,8) CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN C CHECK IF NULL OR BLANK (DEFAULT TO NO HELLO FILE) C ITEMP=IAND(JPBUF(4),3) IF(ITEMP.NE.0.AND.JPBUF(1).NE.2H/E ) GO TO 1208 DO 1205 KNDX=7,9 JBUF(KNDX)=2H 1205 CONTINUE JBUF(10)=0 JBUF(11)=0 GO TO 1300 C C CHECK IF ASCII C 1208 IF(ITEMP.EQ.3) GO TO 1210 CALL ACERR(-206) GO TO 1200 C C MOVE HELLO FILE NAMR C 1210 I=1 DO 1220 KNDX=7,9 JBUF(KNDX)=JPBUF(I) I=I+1 1220 CONTINUE JBUF(10)=JPBUF(5) JBUF(11)=JPBUF(6) C C PROMPT FOR USER CAPABILITY C 1300 CALL ACPRM(MSCAP,8) CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RÕ������þúETURN C C CHECK FOR NULL OR BLANK (DEFAULT CAPABILITY TO 30) C ITEMP=IAND(JPBUF(4),3) IF(ITEMP.NE.0) GO TO 1305 JBUF(22)=30 GO TO 1400 C C CHECK IF INTEGER, 1-63 C 1305 IF(ITEMP.EQ.1) GO TO 1320 1310 CALL ACERR(-207) GO TO 1300 1320 IF(JPBUF(1).LE.0.OR.JPBUF(1).GT.MAXCAP) GO TO 1310 C C MOVE CAPABILITY C JBUF(22)=JPBUF(1) C C PROMPT FOR MAXIMUM DISC CARTRIDGES C 1400 CALL ACPRM(MSMXD,12) CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT LIMIT TO 2) C ITEMP=IAND(JPBUF(4),3) IF(ITEMP.NE.0) GO TO 1405 JBUF(31)=2 GO TO 1450 C C CHECK FOR INTEGER BETWEEN 0 AND 60 C 1405 IF(ITEMP.EQ.1) GO TO 1420 1410 CALL ACERR(-208) GO TO 1400 1420 IF((JPBUF(1).GT.60).OR.(JPBUF(1).LT.0)) GO TO 1410 JBUF(31)=JPBUF(1) C C ZERO OUT LAST LOG-ON, CUMULATIVE TIME, CPU TIME C 1450 DO 1460 I=23,28 JBUF(I)=0 1460 CONTINUE C C PROMPT FOR USER SST DEFINITION C ICL=29 KNDX=33 1500 CALL ACPRM(MSSST,ICL) CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO END SST DEFINITION C IF(JPBUF(1).EQ.2H/E) GO TO 1600 C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT TO NO USER SST) C ITEMP=IAND(JPBUF(4),3) IF(KNDX.NE.33) GO TO 1510 IF(ITEMP.EQ.0) GO TO 1600 C C READ, PARSE AND VALIDATE SST ENTRY C SYSTEM LU MUST BE NUMERIC, 0-254 C SESSION LU MUST BE NUMERIC, 4-63 C 1510 IF(ITEMP.NE.1) GO TO 1540 ISES=JPBUF(1) C C PARSE THE SYSTEM LU C CALL NAMR(JPBUF,IBUF,80,ICHAR) ISYS=JPBUF(1) IF((ISYS.LT.0).OR.(ISYS.GT.254)) GO TO 1540 IFfõ������þú(IAND(JPBUF(4),3).NE.1) GO TO 1540 IF((ISES.LT.4).OR.(ISES.GT.63)) GO TO 1540 C C CHECK IF SESSION LU HAS ALREADY BEEN DEFINED C IF(KNDX.EQ.33) GO TO 1530 DO 1520 I=34,KNDX ITEMP=IAND(JBUF(I),255)+1 IF(ITEMP.EQ.ISES) GO TO 1540 1520 CONTINUE 1530 KNDX=KNDX+1 JBUF(KNDX)=(IAND(255,ISYS-1)*256)+ISES-1 ICL=8 GO TO 1500 1540 CALL ACERR(-209) ICL=8 GO TO 1500 C C SAVE INDEX FOR END OF USER SST C 1600 KNDXSV=KNDX C C PROMPT FOR SST SPARES C 1605 CALL ACPRM(MSSPR,11) CALL ACREI(IBUF,IERR) ICHAR=1 CALL NAMR(JPBUF,IBUF,80,ICHAR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN C C CHECK FOR NULL OR BLANK (DEFAULT TO 5) C ITEMP=IAND(JPBUF(4),3) IF(ITEMP.LE.1) GO TO 1620 1610 CALL ACERR(-212) GO TO 1605 1620 IF(ITEMP.EQ.0) JPBUF(1)=5 IF((JPBUF(1).LT.0).OR.(JPBUF(1).GT.60)) GO TO 1610 ISPAR=JPBUF(1) IF(ISPAR+KNDX.GT.100) GO TO 1610 C C PROMPT FOR LINK TO EXISTING ACCOUNT C 1700 CALL ACPRM(MSLNK,32) CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN C C CHECK FOR ERROR C IF(IERR.EQ.0) GO TO 1704 CALL ACERR(-203) GO TO 1700 C C CHECK FOR NULL OR BLANK (DEFAULT TO N), OR N C 1704 IF(JPBUF(1).EQ.0) GO TO 1780 C C NAME MUST BE IN USER.GROUP FORMAT C IF(IAND(JPBUF(1),255).NE.0) GO TO 1720 1710 CALL ACERR(-203) GO TO 1700 C C CHECK IF USER.GROUP ACCOUNT EXISTS C 1720 CALL ACGTU(JPBUF(2),JPBUF(7),NBUF,IOFST,IERR) IF(IERR.EQ.0) GO TO 1725 CALL ACERR(-200) GO TO 1700 C C CHECK THE PASSWORD (SKIP IF NO PASSWORD) 1725 ITEMP=IAND(NBUF(IOFST+1),77777B) IF(ITEMP.EQ.0) GO TO 1750 CALL PARSN(JPBUF,IBUF,80,ICHAR,Iî������þúERR) DO 1730 I=2,6 IF(JPBUF(I).NE.NBUF(IOFST+I)) GO TO 1740 1730 CONTINUE GO TO 1750 1740 CALL ACERR(-204) GO TO 1700 C C GET THE USER ID FROM THE ACCOUNT ENTRY C 1750 ID=NBUF(IOFST+29) IF(ID.GE.7776B) GO TO 1710 GO TO 1790 C C GET A USER ID C 1780 CALL ACGID(1,ID,IERR) IF(IERR.NE.-2) GO TO 1790 CALL ACERR(-211) RETURN 1790 JBUF(29)=ID C C GET GROUP ACCOUNT RECORD NUMBER C 1800 IUSER(1)=0 CALL ACFDA(IUSER,IPBUF(7),IDMY,IDMY,IRECG,IERR) IOFST=IRECG(2) CALL READF(NDCB,IERR,NBUF,128,LEN,IRECG) C C MERGE IN THE GROUP SST C IGLEN=0 C C CHECK IF GROUP SST IS TO BE USED C IF(JBUF(33).EQ.0) GO TO 1890 ICNT=IABS(NBUF(IOFST+6)) C C CHECK FOR EMPTY GROUP SST C IF(ICNT.LE.0.OR.ICNT.GT.64) GO TO 1890 K=IOFST+6 C C VALIDATE EACH GROUP SST ENTRY C DO 1880 I=1,ICNT ITEMP=IAND(NBUF(I+K),255) C C CHECK FOR CONFLICTS OR DUPLICATE SST DEFINITIONS C IF(KNDX.LT.34) GO TO 1865 DO 1860 J=34,KNDX ISES=IAND(JBUF(J),255) IF(ITEMP.NE.ISES) GO TO 1860 C C FOUND MATCHING SESSION LU - IF DUPLICATE DEFINITION C IGNORE IT, ELSE REPORT SST CONFLICT C IF(JBUF(J).EQ.NBUF(I+K)) GO TO 1880 GO TO 1870 1860 CONTINUE C C MOVE GROUP SST ENTRY TO USER C 1865 KNDX=KNDX+1 JBUF(KNDX)=NBUF(I+K) IGLEN=IGLEN+1 GO TO 1880 C C CONFLICT BETWEEN USER AND GROUP SST DEFINITION C 1870 CALL ACERR(-210) C C PRINT THE CONFLICTING LU DEFINITIONS C ISYSG=(NBUF(I+K)/256)+1 ISYSU=(JBUF(J)/256)+1 CALL ACITA(ISES+1,LUMS2(7),2) CALL ACITA(ISYSU,LUMS2(13),2) CALL ACITA(ISYSG,LUMS2(30),2) LUMS2(24)=LUMS2(7) LUMS2(25)=LUMS2(8) CALL ACWRI(LUMS1,27) CALL ACWRI(LUMS2,31) 1880 CONTINUE C C POST THE GROUP ID C 1890 JBUF(30)=IAND(NBUF(IOFST+1),77777B) C C öà������þú WRITE SST LENGTH WORDS C JBUF(32)=(IGLEN*256)+ISPAR JBUF(33)=IOR(JBUF(33),KNDX-33) C C SET BIT INDICATING ACCOUNT EXTENDS PAST 64 WORDS C CALL RNRQ(1,IRN,ISTAT) IF(KNDX.LE.64) GO TO 1930 JBUF(1)=IOR(JBUF(1),100000B) C C FIND A FREE ACCOUNT ENTRY C CALL ACFDF(IDIRN,IRECN,IOFST,IERR,2) IF(IERR.EQ.0) GO TO 1895 1892 CALL ACERR(IERR) CALL RNRQ(4,IRN,ISTAT) RETURN C C BUILD THE DIRECTORY ENTRY C 1895 CALL ACPGA(-2,IDIRN,0) C C COPY SECOND PART INTO ACCOUNT ENTRY C CALL READF(NDCB,IERR,NBUF,128,LEN,IRECN) DO 1920 I=1,33 NBUF(I+IOFST)=JBUF(63+I) 1920 CONTINUE CALL WRITF(NDCB,IERR,NBUF,128,IRECN) C C SET JBUF(64)= RECORD NUMBER OF SECOND PART C IF(IOFST.NE.0) IRECN=IRECN+100000B JBUF(64)=IRECN C C FIND A FREE ACCOUNT ENTRY C 1930 CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1) IF(IERR.NE.0) GO TO 1892 C C GENERATE MESSAGE FILE NAME C CALL ACMSN(IDIRN,JBUF(17)) C C BUILD THE DIRECTORY ENTRY C 1900 DO 2000 I=1,11 IBUF(I)=IPBUF(I) 2000 CONTINUE IBUF(12)=ID IBUF(13)=JBUF(30) IBUF(14)=IRECG(1) IF(IRECG(2).GT.0) IBUF(14)=IOR(IBUF(14),100000B) IBUF(15)=IRECN IF(IOFST.GT.0) IBUF(15)=IOR(IRECN,100000B) IBUF(16)=0 CALL ACDIR(2,IDIRN,IBUF,IERR) C C BUILD THE USER ACCOUNT ENTRY C CALL READF(NDCB,IERR,NBUF,128,LEN,IRECN) DO 2200 I=1,64 NBUF(I+IOFST)=JBUF(I) 2200 CONTINUE CALL WRITF(NDCB,IERR,NBUF,128,IRECN) CALL RNRQ(4,IRN,ISTAT) C C MORE GROUPS? C 2250 CALL ACPRM(MSGNX,9) C C READ AND PARSE THE NEXT GROUP NAME C CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND OR EXIT GROUP DEFINITION C ALSO CHECK FOR NULL OR BLANK C IF((JPBUF(2).EQ.2H/A).OR.(JPBUF(2).EQ.2H/E)) RETURN C C IF NAME IS INV·c���6��40ALID, REPORT ACERR AND RE-PROMPT C NAME CANNOT BE IN USER.GROUP FORMAT AND CANNOT BE "@" C IF(IERR.NE.0) GO TO 2300 IF(IAND(JPBUF(1),255).NE.0) GO TO 2300 IF(JPBUF(2).NE.2H@ ) GO TO 2400 2300 CALL ACERR(-203) GO TO 2250 C C IF NO GROUP SPECIFIED, DEFAULT TO GENERAL C 2400 IF(JPBUF(1).NE.0) GO TO 2500 JPBUF(1)=3400B JPBUF(2)=2HGE JPBUF(3)=2HNE JPBUF(4)=2HRA JPBUF(5)=2HL C C CHECK THAT GROUP ACCOUNT EXISTS C 2500 IUSER(1)=0 CALL ACFDA(IUSER,JPBUF(2),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.0) GO TO 2600 CALL ACERR(-200) GO TO 2250 C C CHECK IF USER.GROUP ACCOUNT ALREADY EXISTS C 2600 CALL ACFDA(IPBUF(2),JPBUF(2),IDMY,IDMY,IDMY,IERR) IF(IERR.EQ.-200) GO TO 2700 CALL ACERR(-202) GO TO 2250 C C SAVE GROUP INFORMATION (LENGTH OF NAME, NAME) C 2700 DO 2800 I=2,6 IPBUF(I+5)=JPBUF(I) 2800 CONTINUE IPBUF(1)=IAND(IPBUF(1),177400B)+(JPBUF(1)/256) C C PROMPT FOR WHETHER TO USE GROUP SST C CALL ACPRM(MSGST,12) C C READ AND PARSE FOR Y OR N C CALL ACREI(IBUF,IERR) ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN C C SET SIGN BIT IF Y OR NULL TO INDICATE USE GROUP SST C JBUF(33)=0 ITEMP=JPBUF(2)/256 IF((ITEMP.EQ.131B).OR.(JPBUF(1).EQ.0)) 1 JBUF(33)=100000B C C RESET KNDX TO COPY USER SST ONLY C KNDX=KNDXSV GO TO 1800 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������°¬6������ÿÿ����� ���� ÿý�@� N ���������ÿ��92067-18374 2013� S C0122 �&ACPAS �ACCTS PASSWORD ROUTINES � � � � � � � � � � � � �H0101 v@�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18374 C C RELOCATABLE PART NUMBER : 92067-16362 C C PROGRAMER(S) : J.M.N. C C C C ACPAS - ROUTINE TO VERIFY ACCESS TO ACCTS PROGRAM C C CALLING SEQUENCE: CALL ACPAS C C ACERRS: -204 = INVALID PASSWORD C C SUBROUTINE ACPAS ,92067-16362 REV.1940 790801 DIMENSION MSPAS(5),IUSER(5),IGRP(5),LUX(2),IESC(2) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM6/LOC(6) COMMON /ACOM7/IPBUF(11) COMMON /ACOM9/IBUF(40) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA MSPAS/2HPA,2HSS,2HWO,2HRD,2H? / C C CHECK IF PASSWORD EXISTS FOR ACCOUNT C WITH USER ID 7777B (MANAGER.SYS) C I1=LOC(5) I2=LOC(6)-1 DO 50 I=I1,I2 CALL READF(NDCB,IERR,NBUF,128,LEN,I) DO 50 J=1,128,16 IF(NBUF(J).LT.0) GO TO 50 IF(NBUF(J+11).EQ.7777B) GO TO 60 50 CONTINUE GO TO 400 C C READ THE ACCOUNT C 60 IREC=NBUF(J+14) IOFST=0 IF(0.GT.IREC) IOFST=64 IREC=IAND(IREC,77777B) CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) I=IAND(NBUF(IOFST+1),255) IF(I.EQ.0) GO TO 400 C C PROMPT WITH "PASSWORD? " C AND FETCH IT C KECHO=0 CALL ACPSN(MSPAS,5,IPBUF,IERR) KECHO=400B C C COMPARE PASSWORD WITH MANAGER.SYS ACCOUNT C 200 DO 300 I=2,6 IF(IPBUF(I).NE.NBUF(IOFST+I)) GO TO 500 300 CONTINUE[9������þú 400 IDSES=7777B RETURN 500 CALL ACERR(-204) CALL ACTRM END C ACAPA ALTERS THE CURRENT USERS PASSWORD C SUBROUTINE ACAPA ,92067-16362 REV.2013 800131 DIMENSION IWIPE(24),LU(2),KWIPE(23) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID EQUIVALENCE (IWIPE(2),KWIPE(1)) C DATA IWIPE / 15501B,6415B,5*2HXX,6527B,4*2HWW,53415B,5*2HII 1,6460B,4*2H00,2H0 / C C GO ASK FOR CURRENT PASSWORD C KECHO=0 CALL ACPSN(26HENTER CURRENT PASSWORD _,13,JBUF,IERR) KECHO=400B CALL ACWRI(2H ,1) C C GET CURRENT PASSWORD C CALL ACDIR(1,MYDIR,IBUF,IERR) IOF=0 IREC=IBUF(15) IF(0.GT.IREC) IOF=64 IREC=IAND(IREC,77777B) CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) C C VERFY PASSWORD C DO 100 I=1,6 IF(NBUF(I+IOF).NE.JBUF(I)) GO TO 900 100 CONTINUE C C ASK FOR NEW PASSWORD C KECHO=0 CALL ACPSN(26HENTER NEW PASSWORD _,13,JBUF,IERR) KECHO=400B IF(IERR.NE.0) RETURN CALL ACPRM(22HTHE NEW PASSWORD IS: ,11) CALL ACPRM(2H ,1) JBUF(7)=2H JBUF(8)=2HOK JBUF(9)=2H ( JBUF(10)=2HY JBUF(11)=2H0R JBUF(12)=2H N JBUF(13)=2H)? JBUF(14)=2H _ CALL ACPRM(JBUF(2),13) IF(ITTY.LE.0.OR.ITTY.GT.255) GO TO 150 LU(1)=IOR(100000B,ITTY) LU(2)=2100B CALL XLUEX(1,LU,IPB,-1) CALL ACPRM(IWIPE,24) CALL ACPRM(KWIPE,23) IF(IPB.NE.131B) RETURN CALL ACPRM(22HNEW PASSWORD INSTALLED ,11) C C INSTALL THE NEW PASSWORD C 150 CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) Xâ������þú DO 200 I=1,6 NBUF(I+IOF)=JBUF(I) 200 CONTINUE CALL WRITF(NDCB,IERR,NBUF,128,IREC) CALL RNRQ(4,IRN,ISTAT) RETURN 900 CALL ACERR(-204) CALL ACTRM END C C C C C C ACPSN PARSES A PASSWOORD C C CALLING SEQUENCE C C CALL ACPSN(MESS,LENGTH,JPASS,IERR) C C C C WHERE MESS IS PROMPT C C LENGTH IS LENGTH OF PROMPT IN WORDS C C JPASS IS THE BUFFER FOR PARSED PASSWORD C C IERR IS ERROR CODE C C SUBROUTINE ACPSN(MESS,MESSL,JPASS,IERR) 1 ,92067-16362 REV.1940 790801 COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DIMENSION JPASS(6),LUX(2),IESC(2) DATA LUX,IESC /0,0,15501B,15515B / C C PROMPT FOR USER PASSWORD C 1100 CALL ACPRM(MESS,MESSL) CALL ACREI(IBUF,IERR) IF(KECHO.EQ.400B) GO TO 1105 C C TEST FOR DVR07 C IF(ITTY.LE.0.OR.ITTY.GT.255) GO TO 1105 LUX(1)=IOR(100000B,ITTY) CALL XLUEX(13,LUX,IEQT5) IEQT5=IAND(37400B,IEQT5)/256 IF(IEQT5.NE.7B) GO TO 1105 CALL XLUEX(2,LUX,IESC,2) 1105 ICHAR=1 CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR) IF(IERR.EQ.0) GO TO 1120 C C CHECK FOR REQUEST TO ABORT COMMAND C IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 1110 CALL ACERR(-204) IF(KECHO.EQ.0) CALL ACTRM IERR=0 GO TO 1100 C C IF NO PASSWORD SPECIFIED, DEFAULT TO NONE C 1120 IF(JPBUF(1).NE.0) GO TO 1140 DO 1130 KNDX=2,6 JPASS(KNDX)=2H 1130 CONTINUE GO TO 1170 C C PASSWORD CAN'T BE IN USER.GROUP FORMAT C 1140 IF(IAND(JPBUF(1),255).NE.0) GO TO 1110 DO 1150 KNDX=2,6BM����� JPASS(KNDX)=JPBUF(KNDX) 1150 CONTINUE 1170 JPASS(1)=JPBUF(1)/256 RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������õÄ������ÿÿ����� ���� ÿý�A�J ���������ÿ��92067-18375 1940� S C0122 �&ACPUA �ACCTS PURGES THE ACC OUN � � � � � � � � � � � � �H0101 a�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18375 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACPUA(JTYPE,IERR) ,92067-16361 REV.1940 790801 LOGICAL XFTTY DIMENSION ICOM(10),LU2(2),NALL(11),SUCMD(4) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM4/ICMND(40) COMMON /ACOMD/ICLASS DATA ICOM /2HSP,0,2HSG,0,2HRP,100000B,2HRG,40000B,0,0 / DATA LU2(2) / 0 / DATA SUCMD / 4HSUNP,4HSDNP,4HSD,B,4HSD,S / DATA NALL/257,2H@ ,2H ,2H ,2H ,2H , 1 2H@ ,2H ,2H ,2H ,2H / C C ACPUA(2) PURGES THE ACCOUNTS FILE C AFTER THE SYSTEM BECOMES QUIET C C ACPUA(1) SHUTS DOWN SESSION SYSTEM C AFTER THE SYSTEM BECOMES QUIET C C ACPUA(3) SHUTS DOWN SESSION SYSTEM C FOR AN ACCOUNTS FILE LOAD C C ACPUA(4) SHUTS DOWN SESSION SYSTEM C AND RELEASES MEMORY C C ITYPE=JTYPE IERR=0 IF(ITYPE.EQ.3) GO TO 610 IF(ITYPE.NE.2) GO TO 100 25 CALL ACNVS(62HDO YOU REALLY WANT TO PURGE THE SESSION SYSTEM (YES 1OR NO)? _ ,31,0) IF(IPBUF(1).EQ.2HNO) RETURN IF(IPBUF(1).NE.2HYE.OR.IPBUF(2).NE.2HS ) GO TO 25 50 IF(IPFLG.LT.0) GO TO 60 IPBUF(4)=0 IF(ITYPE.EQ.3) GO TO 55 C C PROMPT FOR SHUT DOWN MESSAGE C CALL ACNVS(28HSHUT DOWN MESSAGE (20 CHARS) ,14,0) 55 CALL LMES(-17,18HSESSION SHUT DOWN 8|������þú ,-1) IF(ITLOG.GT.20) ITLOG=20 IF(IAND(IPBUF(4),3).NE.0) CALL LMES(-ITLOG,ICMND,-1) C C SET PURGE FLAG IN HEADER C 60 CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(30)=-ITYPE NBUF(28)=0 CALL WRITF(NDCB,IERR,NBUF,128,1) CALL RNRQ(4,IRN,ISTAT) IPFLG=-ITYPE IF(NBUF(29).EQ.0) GO TO 70 CALL ACLIA(2) 70 CALL ACGSP(NALL,IERR,4HDSNP) IF(IERR.NE.0) CALL ACGSP(NALL,IERR,4HDS ) CALL ACGSP(NALL,JERR,4HDJNP ) IF(JERR.NE.0) CALL ACGSP(NALL,JERR,4HDJ ) CALL READF(NDCB,KERR,NBUF,128,LEN,1) IF(IOR(IOR(NBUF(29),IERR),JERR).EQ.0) GO TO 95 CALL ACWRI(32HTO SHUT DOWN "NOW" WE MUST ABORT ,16) CALL ACWRI(32HTHE ABOVE PROCESSES!! ,16) CALL ACWRI(32H--------------------- ,16) CALL ACNVS(40HABORT THE ABOVE PROCESSES (YES OR NO)? _ ,20,0) IF(IPBUF(1).NE.2HYE) GO TO 800 IF(IPBUF(2).NE.2HS ) GO TO 800 C C MUST ABORT ABOVE SESSIONS,JOBS,AND SPOOLS C CALL DTACH C C SEARCH ACTIVE SESSION BLOCK C IREC=LOC(1) ILAST=128*(LOC(2)-IREC) DO 80 IDX=1,ILAST,4 LU=IVBUF(IDX,IREC) IF(LU.EQ.0) GO TO 80 LU=IOR(20000B,LU) CALL ACSDN(LU,JERR) 80 CONTINUE C C DISABLE SYSTEM CONSOLE AS SESSION TERMINAL C CALL ACSDN(0,JERR) C CLEAR IVBUF CALL IVBUF C C ABORT JOBS AND KILL SPOOLS C CALL ACGSP(NALL,ISD,4HSDNP) C C ISD GIVES STATE OF BATCH SPOOL SYSTEM C 1 BATCH AND SPOOL UP C 2 BATCH AND SPOOL SHUT DOWN C 3 BATCH SHUT DOWN C 4 SPOOL SHUT DOWN C CALL ACGSP(NALL,IERR,4HABNP) CALL ACSDN(20377B,JERR) CALL ACGSP(NALL,JERR,4HKSNP) CALL ACGSP(NALL,IERR,4HSUNP) DO 85 I=1,10 CALL ACGSP(NALL,IERR,4HABNP) CALL ACSDN(20377B,JERR) CALL ACGSP(NALL,JERR,4HKSNP) IF(IERR.EQ.0.AND.JERR.EQ.0) GO TO 90 C C zÁ����� WAIT 1 SEC C CALL EXEC(12,0,1,0,-100) 85 CONTINUE C C CANT KILL SPOOLS OR ABORT JOBS C CALL ACERR(-218) GO TO 800 C C RESET BATCH SPOOL SYSTEM C 90 CALL ACGSP(NALL,IERR,SUCMD(ISD)) C C DISABLE SYSTEM SESSION CONSOLE C 95 CALL ACSDN(0,JERR) C C TELL LOGON AND LGOFF TO SHUT DOWN C CALL ACSES(-2) IERR=0 RETURN C C CHECK FOR PARAMATERS C 100 CALL NAMR(JPBUF,ICMND,80,ISTRC) IF(IAND(JPBUF(4),3).NE.1) GO TO 700 LU=JPBUF(1) 150 IERR=-222 IF(LU.LT.0.OR.LU.GT.255) GO TO 500 IERR=-223 IF(LU.EQ.LUTRU(1)) GO TO 500 LU=IOR(20000B,LU) DO 300 I=1,3 CALL NAMR(JPBUF,ICMND,80,ISTRC) DO 200 J=1,12,2 IF(JPBUF(1).EQ.ICOM(J)) GO TO 300 200 CONTINUE C C NOT A LEAGAL RESPONSE C GO TO 500 C C MERGE BIT C 300 LU=IOR(LU,ICOM(J+1)) C C GO SCHEDULE LGOFF C CALL ACSDN(LU,IERR) IF(IERR.NE.0) GO TO 500 IERR=0 RETURN C C ACERR RETURN C 400 IERR=-223 500 CALL ACERR(IERR) RETURN 600 IF(ITYPE.EQ.1) GO TO 700 610 CALL ACNVS(38HPURGE EXISTING ACCOUNTS (YES OR NO)? _ ,19,0) GO TO 750 C C SESSION WIDE SHUT DOWN C 700 CALL ACNVS(66HDO YOU REALLY WANT TO SHUT DOWN THE SESSION SYSTEM * 1(YES OR NO)? _,33,0) 750 IERR=-218 IF(IPBUF(1).EQ.2HNO) RETURN IF(IPBUF(1).NE.2HYE.OR.IPBUF(2).NE.2HS ) GO TO 600 IF(JPBUF(1).EQ.2HRE) ITYPE=4 IERR=0 GO TO 50 800 CALL ACWRI( 1 48HWAITING FOR SESSIONS,JOBS,AND SPOOLS TO COMPLETE ,24) IERR=-218 RETURN END ������������������������������������������������������������������������������������������r������ÿÿ����� ���� ÿý�B�J ���������ÿ��92067-18376 1940� S C0122 �&ACSDN �ACCTS SHUT DOWN UTILITY � � � � � � � � � � � � �H0101 r3�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18376 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * NAM ACSDN,7 92067-16361 REV.1940 790111 ENT ACSDN EXT EXEC,.ENTR,$LGOF,XLUEX,XFTTY,LUSES,ACOMD EXT $CES,$LIBR,$LIBX * * LU NOP IERR NOP ACSDN NOP JSB .ENTR DEF LU * * CLEAR IERR * CLA STA IERR,I * * GET SCB ADDRESS * LDA LU,I AND B377 STA LU1 * * IF LU IS 0 THEN DISABLE LU 1 AS SESSION ACTRM * SZA JMP NRMLU NORMAL LU JSB $LIBR MUST GO PRIVILEGED NOP XSA $CESA,I ZAP ENTRY POINT JSB $LIBX DEF ACSDN THEN RETURN * NRMLU IOR ISGN STA LU2 JSB LUSES GO GET SCB ADDRESS DEF *+2 DEF LU1 SZA,RSS IF NO SCB THEN RETURN JMP ERR GO SET ERROR STA ISES SAVE SCB ADDRESS * LDA $LGOF STA ICLAS STUFF CLASS # JSB EXEC DEF RTRN1 DEF D20 DEF D0 DEF IDUM DEF D0 DEF LU,I DEF ISES DEF ICLAS * * PROGRAM SCHEDULE * RTRN1 JSB EXEC DEF RTRN2 DEF SCNAB DEF NAME RTRN2 NOP JSB XFTTY IF NOT INTERACTIVE RETURN DEF *+2 DEF LU2 SZA,RSS JMP ACSDN,I * LDA MESS1 SEND MESSAGE TO GUY YOU ABORTED JSB MESS LDA MESS2 JSB MESS JMP ACSDN,I RETURN * * ERROR RETURN * ERR LDA DM221 SET IERR TO -221 STA IERR,I')��� ��  JMP ACSDN,I * * CLASS IO WRITE REQUEST * MESS NOP STA BUFAD JSB XLUEX DEF RTRN3 DEF D18I DEF LU2 BUFAD BSS 1 DEF D15 DEF IDUM DEF IDUM DEF ACOMD RTRN3 NOP JMP MESS,I * $CESA DEF $CES+1 D20 DEC 20 D15 DEC 15 DM221 DEC -221 B377 OCT 377 D18I OCT 100022 D0 DEC 0 SCNAB OCT 100012 NAME ASC 3,LGOFF ISGN OCT 100000 MESS1 DEF *+1 ASC 15,SYSTEM MANAGER IS ABORTING YOU MESS2 DEF *+1 ASC 15,------------------------------ * ICLAS BSS 1 ISES BSS 1 LU1 BSS 1 LU2 BSS 2 IDUM BSS 1 END ������������������������������������������������������������������������������������������������������������������������»V ������ÿÿ����� ���� ÿý�C�J ���������ÿ��92067-18377 1940� S C0122 �&ACPUU �ACCTS PURGE USER � � � � � � � � � � � � �H0101 ß­�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18377 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C C PURGE,USER C PURGE,GROUP C RESET C CALLING SEQUENCE: C CALL ACPUU(ITYPE) C C WHERE: ITYPE=1 FOR PURGE,USER C ITYPE=2 FOR PURGE,GROUP C ITYPE=3,4 FOR RESET C ITYPE=3 FOR RESET,USER C ITYPE=4 FOR RESET,GROUP C C PURGE,USER C RESET,USER C C ACCOUNT NAME FUNCTION C C C USER.GROUP PURGE OR RESET ONE ENTRY FOR ACCOUNT C C USER.@ PURGE OR RESET ALL ENTRIES IN ALL GROUPS C WITH NAME USER C C @.GROUP PURGE OR RESET ALL USERS OF GROUP C C C @.@ PURGE OR RESET ALL USERS C C PURGE,GROUP C RESET,.GROUP C C GROUP PURGE OR RESET "GROUP" C C @ PURGE OR RESET ALL GROUPS C C C ACERRS: -200 ACCOUNT NOT FOUND C -201 NO FREE ACCOUNTS C -202 ACCOUNT WITH THIS NAME ALREADY EXISTS C -203 INVALID ACCOUNT NAME C -204 INVALID PASSWORD C -206 INVALID FILE NAME C -207 INVALID CAPABILITY C -208 INVALID DISC LIMIT C -209 INVALID SST ENTRY C -210 CONFLICT IN SST DEFINITION C -211 USER OR GQL������þúROUP ID NOT AVAILABLE C -212 INVALID NUMBER OF SST SPARES C FMP ACERR (READF,WRITF) C C SUBROUTINE ACPUU(ITYPE) ,92067-16361 REV.1940 790725 LOGICAL ISRCH COMPLEX QUES(3) DIMENSION MSNAM(5),MSGNM(6),MSGST(12),MSUPW(7),MSHFL(8) DIMENSION MSCAP(8),MSMXD(12),MSSST(29),MSSPR(11),MSLNK(31) DIMENSION MSGNX(6),LUMS1(27),LUMS2(32) DIMENSION IUSER(5),IDMY(2),IRECG(2),IRECU(2) DIMENSION NAME(11),IQUES(12),ITPS(4,4),NAMEP(10) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH COMMON /ACOM4/ ICMND(40) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID EQUIVALENCE (IPB,IPBUF) EQUIVALENCE (IQUES,QUES) DATA IAT/2H@ / DATA ITPS /2HUS,2HER,2H ,2H ,2HGR,2HOU,2HP ,2H , 1 2HUS,2HER,2HS ,2H ,2HGR,2HOU,2HPS,2H / DATA QUES /8HTO BE PU,8HRGED (Y ,8HOR N)? _ / DATA NAMEP /3007B,125052B,2HAC,2HCT,2H ,2H 1,125120B,2HUR,2HGE,2HD / C C PARSE ACCOUNT NAME C JERR=0 CALL PARSN(NAME,ICMND,80,ISTRC,JERR) IF(JERR.NE.0) GO TO 2800 C C PARSE FOR CPU OR CONNECT C IF(ITYPE.GE.3) CALL NAMR(IPBUF,ICMND,80,ISTRC) C C IF GROUP MOVE NAME(2) TO NAME(7) C GO TO (1100,1000,1100,1000),ITYPE 1000 DO 1010 I=2,6 NAME(I+5)=NAME(I) 1010 NAME(I)=2H NAME(2)=0 NAME(1)=MBYTE(NAME(1)) IU=IAT GO TO 1125 C C TEST FOR USER.GROUP FORMAT C 1100 IF(MBYTE(NAME(1)).EQ.0) GO TO 2900 IU=NAME(2) 1125 IF(LBYTE(NAME(1)).NE.0) GO TO 1150 NAME(7 )=2HGE NAME(8 )=2HNE NAME(9 )=2HRA NAME(10)=2HL NAME(11)=2H NAME(1)=IAND(177400B,NAME(1))+7 C C SAVE RESET VALUES FOR LOOP ½z������þúC 1150 IG=NAME(7) C C CHECK TO SEE IF ACCOUNT EXISTS C CALL ACFDA(NAME(2),NAME(7),IDIRN,IDMY,IDMY,JERR) IF(JERR.NE.0) GO TO 2900 IF(IDSES.EQ.7777B) GO TO 1200 C C IF GROUP MANAGER CHECK IF HIS GROUP C CALL ACDIR(1,IDIRN,IBUF,IERR) IF(MYGID.EQ.IBUF(13).AND.IG.NE.IAT) GO TO 1200 C C TELL THE BAD BOY C JERR=46 GO TO 2900 C 1200 NAME(2)=IU NAME(7)=IG ITP=ITYPE GO TO (1250,1300,1640,1640),ITYPE C C COMPUTE MESSAGE C 1250 IF(IU.EQ.IAT.OR.IG.EQ.IAT) ITP=3 GO TO 1350 1300 IF(IG.EQ.IAT) ITP=4 1350 DO 1400 I=1,4 1400 IBUF(I)=ITPS(I,ITP) IDX=8 CALL IPRSN(NAME,IBUF,IDX) IDX=IDX+1 IF(MOD(IDX,2).EQ.1) IDX=IDX+1 CALL ZPUT(IQUES,1,24) 1500 CALL ACNVS(IBUF,IDX/2,0) IF(IPB.EQ.2HN ) RETURN IF(IPB.NE.2HY ) GO TO 1500 C C GET GROUP ACCOUNT C 1640 IUSER(1)=0 CALL RNRQ(1,IRN,ISTAT) CALL ACFDA(IUSER,NAME(7),JDIRN,IRECU,IRECG,JERR) IF(JERR.NE.0) GO TO 2950 GO TO (1690,1650,1690,1650),ITYPE 1650 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECG) IOFST=IRECG(2) IF(ITYPE.NE.4) GO TO 1690 IF(IPB.EQ.2HCP ) GO TO 1660 NBUF(IOFST+2)=0 NBUF(IOFST+3)=0 1660 IF(IPB.EQ.2HCO) GO TO 1680 NBUF(IOFST+4)=0 NBUF(IOFST+5)=0 1680 CALL WRITF(NDCB,JERR,NBUF,128,IRECG) C C SET TO SEARCH ALL USERS OF GROUP C NAME(2)=IAT IU=IAT C C RELEASE RESOURCE NUMBER C 1690 CALL RNRQ(4,IRN,ISTAT) ISRCH=.FALSE. C C GET USER ACCOUNT C 1700 CONTINUE CALL ACFDA(NAME(2),NAME(7),IDIRN,IRECU,IRECG,JERR) IF(JERR.NE.0) GO TO 2500 CALL RNRQ(1,IRN,ISTAT) ISRCH=.FALSE. CALL ACFDA(NAME(2),NAME(7),IDIRN,IRECU,IRECG,JERR) IF(JERR.LT.0) GO TO 2950 IOFST=IRECU(2) CALL READF(NDCB,JERR,NBUF,128,LEN,IRECU) ID=NBUF(IOFST+29) IF(ID.GE.4094.OR.ITYPE.GT.2) GO TO 2000 C C FLAG A‰�����CCOUNT TO PURGE C CALL ACDIR(1,IDIRN,IBUF,IERR) DO 1800 JJ=1,10 1800 IBUF(JJ)=NAMEP(JJ) CALL ACDIR(2,IDIRN,IBUF,IERR) C C SET PURGE FLAG IN HEADER C CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(30)=1 CALL WRITF(NDCB,IERR,NBUF,128,1) IPFLG=1 C C IF RESET C 2000 IF(ITYPE.NE.3) GO TO 2400 IF(IPB.EQ.2HCP) GO TO 2100 NBUF(IOFST+25)=0 NBUF(IOFST+26)=0 2100 IF(IPB.EQ.2HCO) GO TO 2200 NBUF(IOFST+27)=0 NBUF(IOFST+28)=0 2200 CALL WRITF(NDCB,JERR,NBUF,128,IRECU) C C GO BACK AND SEARCH REST OF DIRECTORY C 2400 CALL RNRQ(4,IRN,ISTAT) ISRCH=.TRUE. NAME(2)=IU IF(IU.EQ.IAT) GO TO 1700 2500 IF(ITYPE.NE.2) GO TO 2550 IUSER(1)=0 ISRCH=.FALSE. CALL RNRQ(1,IRN,ISTAT) CALL ACFDA(IUSER,NAME(7),JDIRN,IRECU,IRECG,JERR) IF(JERR.NE.0) GO TO 2950 CALL ACDIR(1,JDIRN,IBUF,IERR) IF(IBUF(13).LE.3) GO TO 2525 DO 2510 JJ=1,10 2510 IBUF(JJ)=NAMEP(JJ) CALL ACDIR(2,JDIRN,IBUF,IERR) IPFLG=1 2525 CALL RNRQ(4,IRN,ISTAT) 2550 NAME(7)=IG IF(IG.NE.IAT) GO TO 3000 ISRCH=.TRUE. GO TO 1640 C C ACERR RETURN C 2800 JERR=-203 2900 CALL ACERR(JERR) GO TO 3000 C C UNLOCK RESOURCE NUMBER C 2950 CALL RNRQ(4,IRN,ISTAT) C C FINISHED C SO CLEAN UP C 3000 ISRCH=.FALSE. RETURN END ��������������������������������������������������������������������������������������������ìá������ÿÿ����� ���� ÿý�D�M ���������ÿ��92067-18378 1940� S C0122 �&ACTEL �ACCTS TELL COMMAND � � � � � � � � � � � � �H0101 ÙÍ�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18378 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACTEL ,92067-16361 REV.1940 790412 LOGICAL ISRCH,XFTTY,IFBRK COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/IBUF(40),JBUF(96) COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO COMMON /ACOMD/ICLASS DIMENSION LU(2),IDMY(2) DATA LU(2) / 0 / C C SET CLASS WITH WAIT C ICLS=IAND(17777B,ICLASS) C C CHECK FOR LU C ILU=-1 IC=ISTRC CALL NAMR(IPBUF,ICMND,80,IC) IF(IAND(IPBUF(4),3).NE.1) GO TO 10 C C TELL LU INSTEAD ACCOUNT C ISTRC=IC ILU=IPBUF(1) IF(ILU.LT.0.OR.ILU.GT.255) GO TO 398 LU(1)=IOR(100000B,ILU) GO TO 25 C C PARSE FOR USER NAME C 10 CALL PARSN(IPBUF,ICMND,80,ISTRC,IERR) C C TEST FOR USER.GROUP FORMAT C IF(LBYTE(IPBUF(1)).NE.0) GO TO 25 IPBUF(7 )=2HGE IPBUF(8 )=2HNE IPBUF(9 )=2HRA IPBUF(10)=2HL IPBUF(11)=2H C C PARSE FOR NAMR C 25 CALL NAMR(JPBUF,ICMND,80,ISTRC) IFILE=IAND(JPBUF(4),3) IF(IFILE.NE.3) Gy¼������þúO TO 30 CALL OPEN(LDCB,JERR,JPBUF,0,JPBUF(5),JPBUF(6)) IF(JERR.LT.0) GO TO 400 30 I=MOD(ISTRC-1,2) IDX=(ISTRC-1)/2+1 IF(I.NE.0) ICMND(IDX)=IOR(IAND(377B,ICMND(IDX)),20000B) LNGTH=ISTRC-I-1-ITLOG IF(ISTRC.GE.ITLOG) LNGTH=0 IF(ILU.GE.0) GO TO 105 IU=IPBUF(2) IG=IPBUF(7) IFLG=0 ISRCH=.FALSE. C C GO FIND ACOUNT(S) C 50 CALL ACFDA(IPBUF(2),IPBUF(7),IDIRN,IDMY,IDMY,IERR) IF(IERR.LT.0) GO TO 300 IF(IFLG.EQ.0) IFLG=-1 IDIRX=1 100 CALL ACASB(IDIRN,ISTAT,IDIRX) IF(ISTAT.EQ.0) GO TO 200 LU(1)=IOR(100000B,ISTAT) IF(.NOT.XFTTY(LU)) GO TO 100 105 IFLG=1 C C WRITE FILE C IF(IFILE.NE.3) GO TO 140 C C OUTPUT FILE C 110 LIM=-10 CALL READF(LDCB,IERR,JBUF,96,IB) IF(IERR.LT.0.OR.IB.LE.0) GO TO 130 CALL XLUEX(100022B,LU,JBUF,IB,ID,ID,ICLS) GO TO 399 C C GO DO CLASS GETS TO CLEAR CLASS BUFFERS C 115 CALL ACCGT(LIM,JERR) IF(JERR.NE.0) GO TO 110 GO TO 400 C 130 CALL RWNDF(LDCB) C C GO WRITE MESSAGE C 140 IF(LNGTH.GE.0) GO TO 100 CALL XLUEX(100022B,LU,ICMND(IDX),LNGTH,ID,ID,ICLS) GO TO 399 C C CLEAR CLASS BUFFERS C 145 CALL ACCGT(LIM,JERR) IF(JERR.EQ.0) GO TO 400 150 IF(ILU.GE.0) GO TO 300 GO TO 100 200 ISRCH=.TRUE. IPBUF(2)=IU IPBUF(7)=IG IF(IU.EQ.2H@ .OR.IG.EQ.2H@ ) GO TO 50 C C WE ARE FINISED C 300 ISRCH=.FALSE. IF(IFLG.EQ.0) CALL ACERR(-200) IF(IFLG.LT.0) CALL ACERR(-221) IF(IFILE.EQ.3) CALL CLOSE(LDCB) RETURN 398 JERR=-222 GO TO 400 399 JERR=10 400 CALL ACERR(JERR) RETURN END SUBROUTINE ACCGT(LIM,JERR) ,92067-16361 REV.1940 790412 LOGICAL IFBRK COMMON /ACOMD/ICLASS C C SET JERR C JERR=1 C C DO GETS TO RELEASE CLASS BUFFERS C 120 CALL EXEC(100025B,ICLASS,JBUF,1) RETURNiÏ����� 125 CALL ABREG(IA,IB) C C IF ONE REQUEST WAS COMPLETE GO TRY TO GET ANOUTHER C IF(0.LE.IA) GO TO 120 C C IF TOTAL OUTSTANDING BUFFERS LESS THAN LIMIT GO DO NEXT WRITE C IF(IA.GT.LIM) RETURN C ELSE SET LIMIT DOWN AN GO TO SLEEP FOR 0.5 SEC LIM=-5 CALL EXEC(12,0,1,0,-50) IF(.NOT.IFBRK(ID)) GO TO 120 JERR=0 RETURN END ����������������������������������������������������������������������������������������������������������������������ÛÞ������ÿÿ����� ���� ÿý�E�M ���������ÿ��92067-18379 1940� S C0122 �&ACUNL �ACCTS UNLOAD COMMAND � � � � � � � � � � � � �H0101 þ�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18379 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACUNL ,92067-16361 REV.1940 790625 LOGICAL ISRCH INTEGER ODCB,ONAME(3),INAME(6),NAMSV(6) DIMENSION LU2(2) COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/JBUF(136) COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO DIMENSION KDEL(202) LU2(2)=100B C C PARSE INPUT NAMR C CALL NAMR(LIST,ICMND,80,ISTRC) LIST(4)=IAND(LIST(4),3) C C LOCK RN C CALL RNRQ(1,IRN,ISTAT) C C COMPUTE REQUIRED SIZE C J=-1 IDELO=0 KDEL(1)=1 IACCTS=8*(LOC(6)-LOC(5)) DO 100 I=1,IACCTS CALL ACNXA(J,IREC,IDEL,KOUNT,IDIR,IDELX) C C INITIALIZE DELTA ARRAY C IF(IDELO.EQ.IDEL) GO TO 90 C C MAKE RECORD NUMBER(64 WORD) NEGATIVE C KDEL(IDELX)=-IDIR C C USE OLD DELTA C KDEL(IDELX+1)=IDELO KDEL(IDELX+3)=IDEL C C SET END OF TABLE C KDEL(IDELX+2)=1 IDELO=IDEL 90 IF(JBUF(J).EQ.0) GO TO 110 100 CONTINUE C C READ HEADER C 110 CALL READFÏœ������þú(NDCB,IERR,NBUF,128,LEN,1) JACCTS=8*(KOUNT/8)+7 NBUF(6)=NBUF(5)+(JACCTS+1)/8 IDELI=(NBUF(6)-LOC(6))*2 JSIZE=NBUF(6)+(JACCTS+1)/2 NBUF(29)=0 C C OPEN SAVE FILE C CALL ACOPL(IERR,2,JSIZE) IF(IERR.NE.0) GO TO 999 C C CHECK IF PUNCH C AND GENERATE LEADER C LU2(1)=IOR(LIST,100000B) CALL XLUEX(100015B,LU2,IEQ5,IEQ4) GO TO 120 115 IDVRT=IAND(IEQ5,37400B)/256 IF(IDVRT.NE.2) GO TO 120 LU2(2)=1000B CALL XLUEX(3,LU2) C C POST TO SAVE FILE C 120 CALL ACWRL(NBUF,128,IERR) IF(IERR.NE.0) GO TO 999 C C CLEAR ACTIVE SESSION TABLE C DO 125 I=1,128 125 NBUF(I)=0 C C WRITE REST OF SESSION WIDE INFORMATION C IEND=LOC(5)-1 DO 150 I=2,IEND IF(I.LT.LOC(2)) GO TO 130 CALL READF(NDCB,IERR,NBUF,128,LEN,I) IF(IERR.LT.0) GO TO 999 130 CALL ACWRL(NBUF,128,IERR) IF(IERR.NE.0) GO TO 999 150 CONTINUE C C BUILD DIRECTORY THAT HAS HOLES C REMOVED C J=-1 200 DO 500 I=1,128,16 CALL ACNXA(J,IREC,IDEL,KOUNT,IDIR,IDELX) CALL ACFID (JBUF(J+14),IDELI,KDEL) CALL ACFID (JBUF(J+13),IDELI,KDEL) JJ=J C C MOVE TO OUPUT BUFFER C DO 400 II=I,I+15 NBUF(II)=JBUF(JJ) 400 JJ=JJ+1 IF(NBUF(I).EQ.0.AND.I.LT.113) NBUF(I)=-1 500 CONTINUE C C WRITE DIRECTORY RECORD C CALL ACWRL(NBUF,128,IERR) IF(IERR.NE.0) GO TO 999 IF(JBUF(J).NE.O) GO TO 200 C C NOW WRITE THE ACCOUNT ENTRIES C II=1 J=-1 DO 1000 I=1,IACCTS CALL ACNXA(J,IDREC,IDEL,KOUNT,L,IDELX) IREC=L/2 IOFST=129+64*MOD(L,2) CALL READF(NDCB,IERR,NBUF(129),128,LEN,IREC) C C MOVE TO OUTPUT BUFFER C 800 DO 900 JJ=IOFST,IOFST+63 NBUF(II)=NBUF(JJ) 900 II=II+1 C C FIX EXTENSION ACLNK C IF(NBUF(IOFST)+1.LT.0) CALL ACFID (NBUF(IOFST+63),IDELI,KDEL) IF(255.GE.JBUF(J)) GO ¶»����� TO 950 C C SET MESSAGE FILE NAME C CALL ACMSN(I,NBUF(II-48)) 950 IF(II.LT.128.AND.JBUF(J).NE.0) GO TO 1000 CALL ACWRL(NBUF,128,IERR) IF(IERR.NE.0) GO TO 999 II=1 IF(JBUF(J).EQ.0) GO TO 1100 1000 CONTINUE C C PRINT ACERR C 999 CALL ACERR(IERR) C C CLOSE SAVE FILE AND UNLOCK RN C 1100 CALL RNRQ(4,IRN,ISTAT) IF(LIST(4).NE.1.OR.IERR.EQ.12) GO TO 1200 C C WRITE EOF AND REWIND C CALL XLUEX(3,LU2) LU2(2)=500B CALL XLUEX(3,LU2) C 1200 CALL ACCLL RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ ½������ÿÿ����� ���� ÿý�F�N ���������ÿ��92067-18380 1940� S C0122 �&ACAST �ACCTS ACTIVE SESSION � � � � � � � � � � � � �H0101  �����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18380 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACAST ALTERS SST FOR EITER GROUP C OR USER SST C C INPUT SST'S START IN LDCB(15) C NUMBER OF CHANGES ARE IN LDCB(14) C C CALLING SEQUENCE: C CALL ACAST(JBUF(33)) FOR USER C CALL ACAST(NBUF(6+IOFST)) FOR GROUP C SUBROUTINE ACAST(JBUF) ,92067-16361 REV.1940 781024 DIMENSION JBUF(64) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) KEND=LDCB(14) JEND=JBUF(1) IF(JEND.LT.0) JEND=-JEND-1 C C LOOP FOR ALL CHANGES C IF(KEND.LT.15) GO TO 700 DO 600 K=15,KEND IF(JEND.LE.0) GO TO 200 C C SEARCH FOR MATCH C DO 100 J=2,JEND+1 IF(IAND(LDCB(K),77B).EQ.IAND(JBUF(J),77B)) GO TO 300 100 CONTINUE C C NO MATCH C 200 IF(IAND(LDCB(K),128).EQ.128) GO TO 600 C C ADD ENTRY C JEND=JEND+1 JBUF(JEND+1)=LDCB(K) GO TO 600 C C FOUND MATCH C 300 IF(IAND(LDCB(K),128).NE.128) GO TO 500 C C DELETE ENTRY C DO 400 JJ=J,JEND 400 JBUF(JJ)=JBUF(JJ+1) JEND=JEND-1 GO TO 600 500 JBUF(J)=LDCB(K) 600 CONTINUE C C FIX JBUF(1) C 700 IF(JBUF(1).LT.0) JEND=-JEND JBUF(1)=JEND RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ ��� ���� �������� �������ÿÿ����� ���� ÿý�G�N ���������ÿ��92067-18381 1940� S C0122 �&ACSTR �ACCTS PRINTS STARS � � � � � � � � � � � � �H0101 ë�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18381 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C PRINT 45 *'S C SUBROUTINE ACSTR ,92067-16361 REV.1940 781024 CALL ACWRL(64H ************************************************** 1************ ,32) RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������4 ������ÿÿ����� ���� ÿý�H�N ���������ÿ��92067-18382 2001� S C0122 �&ACACP �ACCTS CLEAN UP ROUTINE � � � � � � � � � � � � �H0101 !�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18382 C C RELOCATABLE PART NUMBER : 92067-16363 C C PROGRAMER(S) : J.M.N. C C C C C ACACP PURGES ACCOUNTS WHICH C ARE FLAGED FOR PURGING C C CALLING SEQUENCE C CALL ACACP C SUBROUTINE ACACP ,92067-16363 REV.2001 791021 LOGICAL IFBRK DIMENSION NAMEF(3),NALL(11) DIMENSION LOGON(5),LGOFF(5),NAME1(5),NAME2(5) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM4/ICMND(40),NAMPR(3),ICLFG,NMPR3 COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2 COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM9/IBUF(128) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID DATA NAMEF /2H+@,2HCC,2HT! / DATA NALL /257,2H@ ,2H ,2H ,2H ,2H , 1 2H@ ,2H ,2H ,2H ,2H / DATA DJNP,DSNP /4HDJNP,4HDSNP / DATA LOGON / 2HOF,2H,L,2HOG,2HON,2H,1 / DATA LGOFF / 2HOF,2H,L,2HGO,2HFF,2H,1 / IFLG=0 C C GO SEE IF SHUT DOWN OR PURGE ACCOUNTS C CALL READF(NDCB,IERR,NBUF,128,LEN,1) IF(NBUF(30) .NE.0) IPFLG=NBUF(30) IF(NBUF(29).NE.0.OR.NBUF(30).GE.0) GO TO 50 IF(IPFLG.EQ.-1.OR.IPFLG.EQ.-3) GO TO 50 C C CHECK FOR SPOOLS C CALL ACGSP(NALL,IERR,DJNP) CALL ACGSP(NALL,JERR,DSNP) IF(IERR.NE.0.OR.JERR.NE.0) GO TO 50 C C RELEASE DISC POOL C ISIZE=0 CALL ACINM(ISIZE,MAXEV,IDUM,0,NBUF(35)) ICLS=0 IF(IPFLG.EQ.-2) ICLS=ICLASS C C RELEASE MEMORY ALLOCATION C DO 8 J=1,1000 CALL RLMEM(-2,V´������þúICLS) GO TO 600 5 IF(IPFLG.NE.-2) GO TO 50 IF(ICLS.EQ.0) GO TO 9 IF(J.EQ.2) CALL ACWRI(28HWAITING FOR CLASS # TO CLEAR ,14) C C WAIT 2 SEC C CALL EXEC(12,0,2,0,-2) IF(.NOT.IFBRK(IDUM)) GO TO 8 CALL ACERR(0) RETURN 8 CONTINUE RETURN C C RELEASE RESOURCE NUMBERS C 9 CALL RNRQ(44B,IRN,ISTAT) CALL RNRQ(44B,IRN2,ISTAT) ICLS=0 CALL RLMEM(-1,ICLS) GO TO 600 11 DO 10 I=1,100 CALL CLOSE(NDCB) CALL ACCRE(NDCB,NAMEF,0,IERR) IF(IERR.GE.0.OR.IERR.EQ.-6) GO TO 30 DO 44 JJJ=1,5 NAME1(JJJ)=LOGON(JJJ) 44 NAME2(JJJ)=LGOFF(JJJ) CALL MESSS(NAME1,10) CALL MESSS(NAME2,10) CALL EXEC(12,0,1,0,-1) 10 CONTINUE CALL ACERR(IERR) CALL ACOPN(IERR,IDSES) RETURN 30 CALL ACWRI(30HACCOUNTS FILE HAS BEEN PURGED ,15) IPFLG=-1 ICLFG=-1 CALL ACTRM 50 IF(IPFLG.EQ.0) RETURN LD=LOC(5) IDIRN=1 100 CALL READF(NDCB,IERR,NBUF,256,LEN,LD) DO 400 I=1,256,16 IF(NBUF(I).LT.0) GO TO 400 IF(0.EQ.NBUF(I)) GO TO 450 IF(0.LE.NBUF(I+1)) GO TO 400 C C FOUND ENTRY TO BE PURGED C ID=NBUF(I+12) IDU=NBUF(I+11) C C SEARCH ACTIVE SESSION BLOCK C TO SEE IF ACCOUNT IS IDLE C IRECA=LOC(1) IRECD=LOC(5) ILAST=128*(LOC(2)-IRECA) DO 150 IDX=1,ILAST,4 IF(IVBUF(IDX,IRECA).EQ.0) GO TO 150 IDR=IVBUF(IDX+3,IRECA)+1 IDG=IVBUF(16*IDR-3,IRECD) IF(IDIRN.EQ.IDR.OR.(IDU.EQ.0.AND.IDG.EQ.ID)) GO TO 160 150 CONTINUE 160 CALL IVBUF IF(IDIRN.EQ.IDR.OR.(IDU.EQ.0.AND.IDG.EQ.ID)) GO TO 350 C C IF GROUP ACCOUNT GO CHECK DISCS C IF(IDU.EQ.0) GO TO 200 ID=IDU C C NOT ACTIVE SESSION C SO GO CHECK GASP C CALL ACGSP(NBUF(I),IERR,DJNP) IF(IERR.NE.0) GO TO 350 CALL ACGSP(NBUF(I),IERR,DSNP) IF(IERR.NE.0) GO TO 350 C C SEE IF•����� ANOUTHER ACCOUNT HAS THIS ID C DO 170 IDR=1,10000 CALL ACDIR(1,IDR,IBUF,IRR) IF(IRR.LT.0) GO TO 200 IF(IDR.NE.IDIRN.AND.ID.EQ.IBUF(12)) GO TO 300 C C YES GO PURGE THIS ACCOUNT C 170 CONTINUE C C GET CARTRIDGE LIST C 200 CALL ACFST(MBUF) C C CHECK FOR DISCS THAT BELONG TO ACCOUNT C DO 250 J=4,256,4 IF(MBUF(J-3).EQ.0) GO TO 300 IF(MBUF(J).EQ.ID) GO TO 340 250 CONTINUE 300 CALL READF(NDCB,IERR,NBUF,256,LEN,LD) IREC=NBUF(I+14) IOFST=0 IF(IREC.LT.0) IOFST=64 IREC=IAND(77777B,IREC) CALL RNRQ(1,IRN,ISTAT) IF(NBUF(I).LE.255) GO TO 320 CALL READF(NDCB,IERR,IBUF,128,LEN,IREC) IF(IBUF(IOFST+1).GE.0) GO TO 320 JDIRN=IAND(IBUF(IOFST+64),77777B)-LOC(6)+1 IF(IBUF(IOFST+64).LT.0) JDIRN=JDIRN+1 CALL ACPGA(-1,JDIRN,0) 320 CALL ACPGA(-1,IDIRN,0) CALL RNRQ(4,IRN,ISTAT) GO TO 390 C C IF NOT ALREADY SET,THEN SET TO 20 FOR DISC ONLY C 340 IF(IFLG.EQ.0) IFLG=20 GO TO 390 C C SET IFLG=1 FOR ALL OTHER CONFLICTS C 350 IFLG=1 390 CALL READF(NDCB,IERR,NBUF,256,LEN,LD) 400 IDIRN=IDIRN+1 LD=LD+2 GO TO 100 C C UPDATE PURGE FLAG C 450 CALL ACSID CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,NBUF,128,LEN,1) IF(NBUF(30).LT.0) GO TO 500 NBUF(30)=IFLG IPFLG=IFLG CALL WRITF(NDCB,IERR,NBUF,128,1) 500 CALL RNRQ(4,IRN,ISTAT) RETURN C C MEMORY ACERR RETURN C 600 CALL ACERR(-225) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿÿ����� ���� ÿý�I�Q ���������ÿ��92067-18383 1940� S C0122 �&ACNVS �ACCTS CONVERSATION � � � � � � � � � � � � �H0101 ø�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18383 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACNVS(IOUT,NWORDS,MODE) ,92067-16361 REV.1940 781024 COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM4/ICMND(40) C WRITE PROMPT CALL ACPRM(IOUT,NWORDS) C READ RESPONSE CALL ACREI(ICMND,IERR) C C SET START OF BUFFER C ISTRC=1 C HOW TO PARSE? C 0 -- NAMR (NAME:SC:CR) C <>0 -- USER.GROUP C IF(MODE.NE.0) GO TO 100 C PARSE NAMR CALL NAMR(IPBUF,ICMND,80,ISTRC) RETURN C PARSE USER.GROUP 100 CALL PARSN(IPBUF,ICMND,80,ISTRC,IERR) RETURN END ��������������������������������������������������������������������������������������������������������������������������������r������ÿÿ����� ���� ÿý�J�P ���������ÿ��92067-18384 1940� S C0122 �&ACTIM �ACCTS TIME PRINT � � � � � � � � � � � � �H0101 °Ä�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18384 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C PRINT ACCUMULATED TIME C C CALLING SEQUENCE: C CALL ACTIM(ITIME,IERR) C WHERE ITIME IS A 4 WORD ARRAY C WORDS 1&2 CONNECT TIME C WORDS 3&4 CPU TIME C SUBROUTINE ACTIM(ITIME,IERR) ,92067-16361 REV.1940 781024 DIMENSION ITIME(4) DATA I1,I3,I5 / 2HI1,2HI3,2HI5 / C C PRINT CONNECT TIME C CALL ACDDV (ITIME(1),3600,IHRS,ISECS) IMINS=ISECS/60 ISECS=ISECS-60*IMINS CALL ACFMT (IERR,19,20HTOTAL CONNECT TIME: ,I5,IHRS,6,6H HOURS,I3, 1 IMINS, 8,8H MINUTES ,I3,ISECS,8,8H SECONDS ) C C PRINT CPU TIME C CALL ACDDV (ITIME(3),6000,IMINS,ICS) ISECS=ICS/100 ICS=ICS-100*ISECS IDS=ICS/10 ICS=ICS-10*IDS IHRS=IMINS/60 IMINS=IMINS-60*IHRS CALL ACFMT (IERR,19,20HTOTAL CPU TIME: ,I5,IHRS,6,6H HOURS,I3, 1 IMINS, 8,8H MINUTES ,I3,ISECS,1,2H. ,I1,IDS,I1,ICS, 2 8,8H SECONDS ) C END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������}Q������ÿÿ����� ���� ÿý�K�Q ���������ÿ��92067-18385 1940� S C0122 �&ACNFG �ACCTS CONFIGURATION TAB � � � � � � � � � � � � �H0101 k�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18385 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C FUNCTION ACNFG FETCHS NEXT WORD C OF CONFIGURATION TABLE C FUNCTION ACNFG(IERR,IDX) ,92067-16361 REV.1940 790309 COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM6 /LOC(6),IRN IREC=MBYTE(IDX) IF(IREC.EQ.IR.AND.IDX.NE.0) GO TO 100 IR=IREC CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(2)+IR*2) 100 IX=LBYTE(IDX)+1 IDX=IDX+1 ACNFG=NBUF(IX) RETURN END ������������������×S������ÿÿ����� ���� ÿý�L�R ���������ÿ��92067-18386 1940� S C0122 �&ACFDF �ACCTS FIND FREE � � � � � � � � � � � � �H0101 —l�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18386 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACFDF - ROUTINE TO FIND A FREE ACCOUNT ENTRY C C CALLING SEQUENCE: CALL ACFDF(IDIRN,IRECN,IOFST,JERR,K) C WHERE C IDIRN = DIRECTORY ENTRY NUMBER OF FREE C ACCOUNT (RETURNED) C IRECN = RECORD NBR OF FREE ACCOUNT (RETURNED) C IOFST = 0 IF FREE ACCOUNT STARTS IN 1ST WORD, C 64 IF STARTS IN 65TH WORD (RETURNED) C JERR = ACERR RETURN WORD C K = 1 FOR NORMAL REQUEST C K = 2 FOR EXTENTION REQUEST C (STARTS ON SECTOR BOUNDARY) C C ACERRS: -201 = NO FREE ACCOUNTS OF THIS SIZE C FMP ACERR (READF) C C SUBROUTINE ACFDF(IDIRN,IRECN,IOFST,JERR,K) 1 ,92067-16361 REV.1940 781211 COMMON /ACOM6 /LOC(6) COMMON /ACOM1/NDCB(272),NBUF(128) C C C GET RECORD NUMBER OF START OF DIRECTORY C INITIALIZE DIRECTORY ENTRY NBR, INDEX TO DIRECTORY C IREC=LOC(5) IDIRN=1-K 100 I=1 C C READ THE NEXT RECORD OF DIRECTORY C CALL READF(NDCB,JERR,NBUF,128,LEN,IREC) IF(JERR.LT.0)RETURN C C CHECK FOR END OF DIRECTORY C 200 IDIRN=IDIRN+K 201 IWD1=NBUF(I) IF(IWD1.EQ.0) GO TO 500 C C CHECK IF DIRECTORY ENTRY POINTS TO A FREE ACCOUNT ENTRY (-1) C Y£��� �� OR TO AN EXTENDED ACCOUNT ENTRY (-2) C IF(IWD1.GE.0.OR.IWD1.EQ.-2) GO TO 400 C C FOUND A FREE ACCOUNT C RETURN THE ACCOUNT RECORD NUMBER AND OFFSET C 300 IRECN=LOC(6)+(IDIRN-1)/ 2 IOFST=64*MOD(IDIRN-1,2) JERR=0 RETURN C C GET THE NEXT DIRECTORY ENTRY C IF SEARCHING FOR >64 WORDS, SEARCH ONLY THE ODD-NUMBERED C DIRECTORY ENTRIES C 400 I=I+(K*16) IF(I.LT.129) GO TO 200 IREC=IREC+1 GO TO 100 C C RETURN NO FREE ACCOUNTS OF THIS SIZE C 500 JERR=-201 RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‚Á ������ÿÿ����� ���� ÿý�M�T ���������ÿ��92067-18387 1940� S C0122 �&ACGSP �ACCTS SCHEDULE GASP � � � � � � � � � � � � �H0101 øÛ�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18387 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACGSP SCHEDULES GASP WITH THE PASSED C COMMAND PLACED AHEAD OF CUURENT USER.GROUP C C CALLING SEQUENCE: C CALL ACGSP(NAME,IERR,TYPE) C C SUBROUTINE ACGSP(NAME,IERR,TYPE) 1 ,92067-16361 REV.1940 790124 DIMENSION NAME(11),ISTRG(15),INAME(3),IBUF(5) EQUIVALENCE (STRG,ISTRG(2)) DATA ISTRG/ 2H,,,0,0,2H,,,0,0,0,0,0,2H .,0,0,0,0,0 / DATA INAME /2HGA,2HSP,2H / IERR=0 IF(KSPCR(IDUM).EQ.0) RETURN DO 10 I=2,6 10 ISTRG(I+3)=IAND(77777B,NAME(I)) DO 20 I=7,11 20 ISTRG(I+4)=IAND(77777B,NAME(I)) STRG=TYPE C C SCHEDULE GASP WITH REQUEST C DO 50 I=1,100 CALL EXEC(100011B,INAME,-63,0,0,0,0,ISTRG,15) GO TO 40 25 CALL RMPAR(IBUF) IERR=IBUF(1) RETURN C C WAIT FOR 1 SEC C 40 CALL EXEC(12,0,1,0,-100) 50 CONTINUE IERR=-3 RETURN END ����������������������������������������¿“������ÿÿ����� ���� ÿý�N�T ���������ÿ��92067-18388 1940� S C0122 �&ACGTG �ACCTS GET GROUP ACCO UNT � � � � � � � � � � � � �H0101 R�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18388 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACGTG- ROUTINE TO GET A GROUP'S ACCOUNT ENTRY C C CALLING SEQUENCE: CALL ACGTG (IGRP,IBUF,IOFST,IERR) C WHERE C IGRP = 5-WD BUFFER CONTAINING GROUP NAME, C PADDED WITH BLANKS C IBUF = 128-WD BUFFER WHERE ACCOUNT ENTRY C IS RETURNED C IOFST = RETURNED AS 0 IF ACCT STARTS AT 1ST WD, C 64 IF STARTS AT 65TH WD OF BUFFER C IERR = ACERR RETURN WORD C C ACERRS: -200 = ACCOUNT NOT FOUND C FMP ACERR (READF,READF IN ACFDA) C C SUBROUTINE ACGTG (IGRP,IBUF,IOFST,IERR) 1 ,92067-16361 REV.1940 781024 DIMENSION IUSER(5),IGRP(5),IBUF(128),IRECU(2),IRECG(2) COMMON /ACOM1/NDCB(272) C C GET RECORD NUMBER OF ACCOUNT ENTRY C IUSER(1)=0 CALL ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,IERR) IF(IERR.LT.0) RETURN IOFST=IRECG(2) C C READ THE ACCOUNT ENTRY INTO THE RETURN BUFFER C CALL READF(NDCB,IERR,IBUF,128,LEN,IRECG) RETURN END ������������������������������������������°Æ������ÿÿ����� ���� ÿý�O�U ���������ÿ��92067-18389 1940� S C0122 �&ACGTU �ACCTS GET USER ACCOUNTS � � � � � � � � � � � � �H0101 h�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18389 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACGTU- ROUTINE TO GET A USER'S ACCOUNT ENTRY C C CALLING SEQUENCE: CALL ACGTU (IUSER,IGRP,IBUF,IOFST,IERR) C WHERE C IUSER = 5-WD BUFFER CONTAINING USER NAME, C PADDED WITH BLANKS C IGRP = 5-WD BUFFER CONTAINING GROUP NAME, C PADDED WITH BLANKS C IBUF = 128-WD BUFFER WHERE ACCOUNT ENTRY C IS RETURNED C IOFST = RETURNED AS 0 IF ACCT STARTS AT 1ST WD, C 64 IF STARTS AT 65TH WD OF BUFFER C IERR = ACERR RETURN WORD C C ACERRS: -200 = ACCOUNT NOT FOUND C FMP ACERR (READF,READF IN ACFDA) C C SUBROUTINE ACGTU (IUSER,IGRP,IBUF,IOFST,IERR) 1 ,92067-16361 REV.1940 781024 DIMENSION IUSER(5),IGRP(5),IBUF(128),IRECU(2),IRECG(2) COMMON /ACOM1/NDCB(272) C C GET RECORD NUMBER OF ACCOUNT ENTRY C CALL ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,IERR) IF(IERR.LT.0) RETURN IOFST=IRECU(2) C C READ THE ACCOUNT ENTRY INTO THE RETURN BUFFER C CALL READF(NDCB,IERR,IBUF,128,LEN,IRECU) RETURN END ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� 0��� ���� �������� �������ÿÿ����� ���� ÿý�P�W ���������ÿ��92067-18390 1940� S C0122 �&ACGID �ACCTS GET ID # � � � � � � � � � � � � �H0101 o �����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18390 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACGID - ROUTINE TO GET A FREE USER OR GROUP ID C C CALLING SEQUENCE: CALL ACGID(ITYPE,ID,IERR) C WHERE C ITYPE = 1 FOR USER ID C = -1 FOR GROUP ID C ID = ID NUMBER (1-4095), RETURNED C IERR = ACERR RETURN WORD C C ACERRS: -1 = INVALID PARAMETER C -2 = NO ID AVAILABLE C FMP ACERR (READF,WRITF) C C SUBROUTINE ACGID(ITYPE,ID,IERR) ,92067-16361 REV.1940 781024 COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM1/NDCB(272),NBUF(256) C C CHECK TYPE PARAMETER C IF(IABS(ITYPE).NE.1) GO TO 70 C C READ USER/GROUP ID MAP FROM ACCOUNT FILE C CALL RNRQ(1,IRN,ISTAT) CALL READF(NDCB,IERR,NBUF,256,LEN,LOC(4)) IF(IERR.LT.0) RETURN C C SEARCH FOR USER OR GROUP ID? C IF(ITYPE.EQ.1) GO TO 40 C C SEARCHING FOR GROUP ID. SCAN ID MAP FROM 0 THROUGH C LOWEST USER ID C MAPWD=0 ID=0 10 IF(ID.GE.LOWUS) GO TO 80 MAPWD=MAPWD-ITYPE CALL ACGBT(NBUF(MAPWD),ITYPE,IBIT) IF(IBIT.NE.-1) GO TO 20 ID=ID+16 GO TO 10 20 ID=ID+IBIT C C UPDATE THE ID MAP C CALL WRITF(NDCB,IERR,NBUF,256,LOC(4)) IF(IERR.LT.0) RETURN C C UPDATE THE "USE" WORD (HIGHEST GROUP ID USED Op]��� �� R LOWEST C USER ID USED) C IF(ID.LE.IHIGR) RETURN IHIGR=ID IOFST=24 C C UPDATE THE WORD IN THE ACCOUNT FILE HEADER C 30 CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(IOFST)=ID CALL WRITF(NDCB,IERR,NBUF,128,1) 35 CALL RNRQ(4,IRN,ISTAT) RETURN C C SEARCHING FOR USER ID. SCAN ID MAP FROM 4095 THROUGH C HIGHEST GROUP ID C 40 MAPWD=257 ID=4095 50 IF(ID.LE.IHIGR) GO TO 80 MAPWD=MAPWD-ITYPE CALL ACGBT(NBUF(MAPWD),ITYPE,IBIT) IF(IBIT.NE.-1) GO TO 60 ID=ID-16 GO TO 50 60 ID=ID-(15-IBIT) C C UPDATE THE ID MAP C CALL WRITF(NDCB,IERR,NBUF,256,LOC(4)) IF(IERR.LT.0) RETURN IF(ID.GE.LOWUS) RETURN LOWUS=ID IOFST=23 GO TO 30 C C ACERR - INVALID PARAMETER C 70 IERR=-1 RETURN C C ACERR - NO ID AVAILABLE C 80 IERR=-2 GO TO 35 END ������������������������������������������������������������������äI ������ÿÿ����� ���� ÿý�Q�X ���������ÿ��92067-18391 1940� S C0122 �&ACSID �ACCTS SET ID # � � � � � � � � � � � � �H0101 |,�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18391 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACSID RESETS THE THE ID BIT MAP C AND LOWUS AND IHIGR SUBROUTINE ACSID ,92067-16361 REV.1940 790117 COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) C C CLEAR BIT MAP C DO 100 I=1,256 MBUF(I)=0 100 CONTINUE C C SET BIT FOR 0 C CALL ACSBT(0,MBUF) CALL ACSBT(7777B,MBUF) IREC=LOC(5) C C INITIALIZE IHIGR AND LOWUS C IHIGR=0 LOWUS=4095 C C LOCK OUT UNTIL BIT MAP IS BUILT C CALL RNRQ(1,IRN,ISTAT) C C LOOP THRUOGH ALL ACCOUNTS C IEND=128*(LOC(6)-IREC) DO 200 I=1,IEND,16 C C IF END OF DIRECTORY GET OUT C IF(IVBUF(I,IREC).EQ.0) GO TO 300 IF(IVBUF(I,IREC).LT.0) GO TO 200 IDU=IVBUF(I+11,IREC) IDG=IVBUF(I+12,IREC) IF(IDU.NE.0.AND.IDU.LT.LOWUS) LOWUS=IDU IF(IDG.GT.IHIGR) IHIGR=IDG CALL ACSBT(IDU,MBUF) CALL ACSBT(IDG,MBUF) 200 CONTINUE C C CLOSE IVBUF C 300 CALL IVBUF C C WRITE NEW ID BIT MAP C CALL WRITF(NDCB,IERR,MBUF,256,LOC(4)) CALL READF(NDCB,IERR,NBUF,128,LEN,1) NBUF(23)=LOWUS NBUF(24)=IHIGR CALL WRITF(NDCB,IERR,NBUF,128,1) CALL RNRQ(4,IRN,ISTAT) RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������…n��� ���� �������� �������ÿÿ����� ���� ÿý�R�Y ���������ÿ��92067-18392 1940� S C0122 �&ACGBT �ACCTS GET ID BIT � � � � � � � � � � � � �H0101 “ƒ�����þúASMB,R,L,C * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * * SOURCE PART NUMBER :92067-18392 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * *************************************************************** * NAM ACGBT,8 92067-16361 REV.1940 780807 * * * ACGBT IS A ROUTINE TO RETURN THE BIT POSITION OF THE NEXT * BIT WHOSE VALUE IS ZERO, SCANNING FROM BIT 0 TO BIT 15, OR * FROM BIT 15 TO BIT 0. ACGBT WILL UPDATE THE WORD, CHANGING * THE VALUE OF THE BIT FROM 0 TO 1. * * CALLING SEQUENCE: CALL ACGBT (WORD,DIREC,BITNO) * WHERE * WORD = WORD TO BE SCANNED * DIREC= DIRECTION TO SCAN, -1 MEANS 0 TO 15 * 1 MEANS 15 TO 0 * BITNO= BIT POSITION (0-15) OF BIT * = -1 IF NONE FOUND WITH VALUE 0 * * ENT ACGBT EXT .ENTR * WORD NOP DIREC NOP BITNO NOP ACGBT NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF WORD LDA M16 INITIALIZE BIT COUNT STA COUNT SAVE IT LDA WORD,I GET WORD TO BE SCANNED NEXT LDB DIREC,I GET DIRECTION TO SCAN SSB,RSS SCAN 0 TO 15? JMP *+3 NO, SO GET NEXT BIT FROM HIGH END ERA YES, GET NEXT BIT FROM LOW END RSS ELA SEZ,RSS BIT=0? JMP FOUND YES, FOUND A FREE BIT ISZ COUNT NO, INCREMENT BIT COUNT JMP NEXT CONTINUE WITH NEXT BIT CCA DONE WITH ALL 16 BITS, NONE FOUND STA BITNO,I RETURN NONE FOUND JMP ACGBT,I ïÒ��� ��  * FOUND LDB COUNT GET BIT COUNT ADB .16 COMPUTE NUMBER OF SHIFTS DONE CMB AND MAKE NEGATIVE STB CNT2 SAVE IT TO REVERSE THE SHIFTS LDB DIREC,I GET DIRECTION CCE SET THE BIT TO 1 SHIFT SSB,RSS IF SCANNED 15 TO 0, THEN JMP *+3 REVERSE SHIFT BY MOVING E TO HIGH END ELA ELSE REVERSE BY MOVING E TO LOW END RSS ERA ISZ CNT2 CONTINUE REVERSE SHIFT JMP SHIFT STA WORD,I RETURN UPDATED WORD * LDA COUNT GET BIT COUNT LDB DIREC,I GET DIRECTION SSB,RSS IF SCANNED 15 TO 0, THEN CMA,RSS MAKE COUNT POSITIVE TO GET BIT POSITION ADA .16 ELSE ADD 16 TO GET BIT POSITION STA BITNO,I RETURN BIT POSITION (0-15) JMP ACGBT,I RETURN * M16 DEC -16 .16 DEC 16 COUNT NOP CNT2 NOP END ����������������������������������������������������������������������������������������������;» ������ÿÿ����� ���� ÿý�S�Z ���������ÿ��92067-18393 1940� S C0122 �&ACSBT �ACCTS SET ID BIT � � � � � � � � � � � � �H0101  �����ASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18393 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * NAM ACSBT,7 92067-16361 REV.1940 781212 * * ACSBT SETS ID IN BIT MAP * * CALLING SEQUENCE: * CALL ACSBT(ID,NBUF) * WHERE: ID IS THE ID # TO BE SET * NBUF IS THE 256 WORD BUFFER CONTAINING * THE ID BIT MAP * ENT ACSBT EXT .ENTR * A EQU 0 B EQU 1 * ID NOP ID# NBUF NOP BUFFER ADDRESS OF BIT MAP ACSBT NOP JSB .ENTR DEF ID * LDB ID,I FETCH ID # CLA RRR 4 PUT WORD IN B REG ALF AND BIT IN A REG CMA COMPUTE SHIFT COUNT STA ID (DON'T NEED THIS ADDRESS ANYMORE) LDA SIGN 100000B LOOP RAL SHIFT THE ZERO TO THE RIGHT ISZ ID SPOT JMP LOOP * ADB NBUF COMPUTE ADDRESS OF WORD IOR B,I THEN MERGE BIT STA B,I AND RESTORE THE WORD JMP ACSBT,I AND RETURN * SIGN OCT 100000 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������. ������ÿÿ����� ���� ÿý�T�Z ���������ÿ��92067-18394 1940� S C0122 �&ACASB �ACCTS MODIFY ACTIVE SES � � � � � � � � � � � � �H0101 N�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18394 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACASB -FINDS A ENTRY IN THE ACTIVE SESSION BLOCK C C CALLING SEQUENCE: C CALL ACASB(IDIRN,LU,I) C C WHERE IDIRN IS THE DIRECTORY ENTRY NUMBER C LU IS THE STATION LU WHERE ACCOUNT C IS ACTIVE C I IS THE INDEX INTO THE ACTIVE SESSION C BLOCK C SUBROUTINE ACASB(IDIRN,LU,I) ,92067-16361 REV.1940 781111 COMMON /ACOM6 /LOC(6),IRN,IPFLG IREC=LOC(1) ILAST=128*(LOC(2)-IREC) DO 100 IDX=I,ILAST,4 IF(IDIRN-1.NE.IVBUF(IDX+3,IREC)) GO TO 100 LU=IVBUF(IDX,IREC) IF(LU.NE.0) GO TO 200 100 CONTINUE C C NOT AN ACTIVE SESSION C LU=0 C C FOUND ACTIVE SESSION C 200 I=IDX+4 C C POST IVBUF C CALL IVBUF RETURN END ������������������������������������������������������������������������������������5p������ÿÿ����� ���� ÿý�U�[ ���������ÿ��92067-18395 2001� S C0122 �&ACINM �ACCTS INITIALIZE MEMORY � � � � � � � � � � � � �H0101 a4�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18395 * * RELOCATABLE PART NUMBER : 92067-16363 * * PROGRAMER(S) : J.M.N. * * * * * THIS ROTINE ALLOCATES MEMORY * AND CLASS NUMBERS FOR THE SESSION * MONITER SYSTEM. * IT THEN INITIALIZES THE MEMORY * COPY OF THE DISC POOL. * * * CALLING SEQUENCE: * ISIZE=NSIZE * CALL INMEN(ISIZE,MAXEV,IBUF,LNGTH,OLDLN) * IF(ISIZE.EQ.-1) GO TO 999 * . . . * . . . * . . . * 999 . . . (NOT ENOUGH MEMORY) * * WHERE: NSIZE IS REQESTED SIZE OF MEMORY * ISIZE IS RETURNED SIZE OF MEMORY * OR (-1) NOT ENOUGH MEMORY * IBUF IS BUFFER CONTAINING DISC POOL * LNGTH IS BUFFER LENGTH OF DISC POOL * OLDLN IS OLD BUFFER LENGTH OF DISC POOL * * NAM ACINM,7 92067-16363 REV.2001 791016 ENT ACINM,RLMEM EXT .ENTR,EXEC,$LIBR,$LIBX EXT $LGOF,$LGON,$STH,$DSCS EXT $SMVE,$SRTI,$BALC,$BRTN,$SMEM,$SALI * A EQU 0 B EQU 1 * ISIZE NOP MAXEV NOP IBUF NOP LNGTH NOP OLDLN NOP * ACINM NOP JSB .ENTR DEF ISIZE * * SET UP POINTERS TO $SALC * XLA $SRTI+0 POINTER TO $SRTN STA $SRTN XLA $SALI+0 POINTER TO $SALC STA $SALC * * TEST IF SYSTEM ALREADY INITIALIZED * XLA DSCS,I SSA,RSS IF >=0 JUST INITIALIZE JMP DISPL DISC POOL * LDB ISIZE,I IF REQUESTING NONE RETURN SZB SSA,RSS IF < 0 INITIALIZE EVERYTHING JMP X������þúACINM,I ELSE RETURN * * DOES $SALC HAVE MEMORY * XLA SMEM1,I SZA JMP ACLSS YES BYPASS MEMORY ALLOCATION * * * GO GET BLOCK OF MEM * JSB $BALC DEF *+4 DEF ISIZE,I DEF IADDR DEF MAXEV,I * * WAS ANY MEMORY ALLOCATED LDA ISIZE,I SSA JMP ACINM,I NO RETURN * * COMPUTE SIZE AND ADDRESS OF BLOCK * LDA IADDR CMA,INA STA ADDR NEGATIVE OF ADDRESS LDB ISIZE,I CMB STB WRDS 1'S COMPLIMENT OF SESION LENGTH * * TELL $SALC SIZE AND ADDRESS * JSB $LIBR NOP XSA SMEM,I XSB SMEM1,I SJS $SRTN,I ADDR NOP WRDS NOP JSB $LIBX DEF *+1 DEF *+1 * * ALLOCATE CLASS NUMBERS * ACLSS LDA LGOF $LGOF JSB SETCL LDA LGON $LGON JSB SETCL LDA STH $STH JSB SETCL * * FINALLY INITIALIZE $DSCS * CLA JSB $LIBR NOP XSA DSCS,I $DSCS JMP DISP2 * * RETURN OLD MEMORY * DISPL JSB $LIBR NOP GO PRIVILEGED STA ADDR2 LDA OLDLN,I OLD LENGTH SZA,RSS IF NONE PREVIOUSLY JMP DISP2 BYPASS RETURN OF MEMORY STA WRDS2 SJS $SRTN,I ADDR2 NOP WRDS2 NOP * * ALOCATE MEMORY FOR DISC POOL * DISP2 LDA LNGTH,I SZA,RSS JMP SRTN IF NO DISC POOL THEN END STA WRDS3 SJS $SALC,I WRDS3 NOP JMP ERR JMP ERR IF NOT ENOUGH GO TO ACERR * * SET $DSCS AND MOVE IN POOL * STB OLDLN,I RETURN POOL LENGTH STA IADDR XSA DSCS,I * * TRANSFER DISC POOL * JSB $SMVE DEF SRTN DEF D2 DEF IADDR DEF NOP DEF IBUF,I DEF LNGTH,I * SRTN JSB $LIBX DEF ACINM * * ACERR SET ISIZE TO -2 * ERR LDA DM2 STA ISIZE,I ‚9������þúJMP SRTN * * CONSTANTS AND VARIABLES * LGOF DEF $LGOF+0 LGON DEF $LGON+0 DSCS DEF $DSCS+0 STH DEF $STH+0 SMEM DEF $SMEM+0 SMEM1 DEF $SMEM+1 * $SALC BSS 1 $SRTN BSS 1 IADDR BSS 1 D0 DEC 0 D2 DEC 2 DM1 DEC -1 DM2 DEC -2 B20K OCT 20000 CLASS BSS 1 CLADR BSS 1 D18 DEC 18 D12 DEC 12 D21 DEC 21 D20 DEC 20 SESID BSS 1 NOP NOP * * * THIS ROUTINE WILL ALLOCATE A CLASS # AND SAVE IT IN THE LOCATION * POINTED AT BY THE (A) REGISTER. THIS IS USED TO DEFINE CLASS NUMBERS * USED BY MULTIPLE PROGRAMS, USING A CLASS NUMBER DEFINED IN TABLE AREA * ONE. * * CALLING SEQUENCE: LDA ADDR (OF TABLE AREA 1 ENT) * JSB SETCL * RTN: * (THE VARIABLE 'CLASS' WILL CONTAIN THE CLASS NUMBER) * * SPC 5 SETCL NOP LDB A,I FETCH POSSIBLE GLOBAL DEFINITION STB CLASS AND SAVE FOR LATER USE. SZB IF ALREADY DEFINED JMP SETCL,I RETURN-- * STA CLADR SAVE GLOBAL ENT FOR RESTORATION * * GET A CLASS NUMBER * (MAY NEED TO DO THIS WITHOUT WAIT IN CASE NO CLASSES ARE FREE) * * JSB EXEC REQUEST DEF CLRTN A DEF D18 ZERO LENGTH WRITE DEF NOP TO GET A CLASS# DEF * DEF NOP DEF * DEF * DEF CLASS * * * GO PRIV AND SAVE CLASS# IN TABLE AREA 1 UNLESS SOMEONE BEAT US TO IT. * * CLRTN JSB $LIBR NOP LDB CLADR,I IS IT STILL ZERO? SZB OR DID SOMEONE ELSE SET IT UP? JMP BEAT SOMEONE ELSE DID IT FIRST-- * LDA CLASS FETCH CLASS NUMBER IOR B20K SET DONT DEALLOCATE STA CLADR,I AND SAVE IT FOR EVERYONE TO SEE STB CLADR SET THE "WE WON" FLAG * BEAT JSB $LIBX EXIT PRIV MODE DEF *+1 DEF *+1 LDA CLADR WHO WON? SZA,RSS IF WE GOT THERE FIRST, JMP SETCL,I THEN RETURN–Ý������þú * JSB EXEC OTHERWISE, RETURN THE CLASS DEF GETRT OBTAINED ABOVE DEF D21 DEF CLASS DEF SESID NOTHING IS TRANSFERED DEF NOP * GETRT LDA CLADR,I FETCH THE CLASS NUMBER DEFINED BY SOMEONE ELSE STA CLASS AND SAVE FOR OUR USE JMP SETCL,I * * * RLMEM RELEASES SESSION CLASS NUMBERS * AND MEMORY * * IDSCS NOP ICLAS NOP RLMEM NOP JSB .ENTR DEF IDSCS * * RELEASE CLASS NUMBERS * LDA ICLAS,I RELEASE CLASS NUMBER ICLASS JSB RLCL0 JMP RLME0 CLA STA ICLAS,I RLME0 LDB STH RELEASE $STH JSB RLCLS LDB LGON RELEASE $LGON JSB RLCLS LDB LGOF RELEASE $LGOF JSB RLCLS * XLA SMEM,I STA ADDR7 CMA,INA STA ADDR8 XLA SMEM1,I STA WRDS7 CMA STA WRDS8 CMA SET FOR MEMORY CHECK * JSB $LIBR NOP LDB IDSCS,I XSB DSCS,I SZA IF MEMORY GONE RETURN JMP RLME2 ISZ RLMEM JSB $LIBX DEF RLMEM RLME2 SJS $SRTN,I GO TAKE MEMORY FROM SESSION ADDR7 NOP WRDS7 NOP * * CLB SSA,RSS IF NOT DONE TAKE ACERR RETURN JMP RLRT2 * XSB SMEM1,I ELSE CLEAR MEMORY WORD COUNT * JSB $BRTN AND RETURN MEMORY TO SYSTEM ADDR8 NOP WRDS8 NOP ISZ RLMEM RLRT2 JSB $LIBX THEN RETURN DEF RLMEM * * * RELEASE CLASS NUMBER * RLCLS NOP STB CLSAD SAVE CLASS NUMBER ADDRESS LDA B,I GET CLASS NUMBER JSB RLCL0 GO TRY TO RELEASE JMP RLCLS,I IF NOT RELEASED JUST RETURN * CLA ELSE GO CLEAR ENTRY POINT JSB $LIBR NOP XSA CLSAD,I JSB $LIBX DEF RLCLS * CLSAD BSS 1 * * RLCL0 NOP SZA,RSS IF "0" RETURN JMP RLCL0,I * AND MASK MASK Séö�����AVE BITS IOR SIGN MERGE NO WAIT BIT STA CLASS RLCLW JSB EXEC WAIT 2 SECONDS TO CLEAR OUT DEF RLCL1 DEF D12 DEF D0 DEF D2 DEF D0 DEF DM2 * RLCL1 JSB EXEC TRY TO RELEASE CLASS # WITH GET DEF RLCL2 DEF D21I DEF CLASS DEF BUF DEF D1 * RLCL2 JMP RLCL3 IF ABORTED CLASS IS RELEASED INA SSA,RSS IF DATA RETURNED OR NO BUFFERS JMP RLCL1 TRY AGAIN JMP RLCL0,I * RLCL3 CPB A10 IF OUTSTANDING GET THEN GO DO CLASS WRITE READ JMP RLCL4 CPB A00 IF NO CLASS NUMBER IT'S RELEASED ISZ RLCL0 BUMP FOR RELEASED RETURN JMP RLCL0,I * SIGN OCT 100000 MASK OCT 017777 D21I OCT 100025 BUF BSS 1 A00 ASC 1,00 A10 ASC 1,10 * * CLASS WRITE/READ CALL * RLCL4 JSB EXEC DEF RLCL5 DEF D20 DEF D0 DEF BUF DEF D0 DEF SC DEF DM1 DEF CLASS RLCL5 JMP RLCLW GO TRY AGAIN * D1 DEC 1 SC DEC -31178 * END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¨�������ÿÿ����� ���� ÿý�V� ` ���������ÿ��92067-18396 1940� S C0122 �&ACLNK �ACCTS LINK TO SEGMENT � � � � � � � � � � � � �H0101 2è�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18396 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACLNK (ISEG,IGOTO) ,92067-16361 REV.1940 790214 C C ACLNKSCHEDULES A SEGMENT OR RETURNS TO C A SEGMENT WHICH IS ALREADY IN MEMORY. C IT ALSO SETS AN INDEX FOR A COMPUTED GO TO C WHICH EACH SEGMENT USES C C CALLING SEQUENCE: C COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) C . . . C . . . C . . . C ASSIGN 100 TO LRTRN C ASSIGN 200 TO LRTR2 C CALL ACLNK (ISEG,IGOTO) C 100 . . . [NORMAL RETURN] C . . . C . . . C . . . C 200 . . [ACERR RETURN] C C WHERE ISEG IS THE ASCII (1H ) OF C THE LAST CHARACTER OF C THE SEGMENT NAME. C IGOTO IS THE INDEX TO BE USED C BY A COMPUTED GOTO IN THE C IN THE SEGMENT. C C COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) LGOTO=IGOTO IF(NAMSG(3).EQ.ISEG) GO TO LTOSEG NAMSG(3)=ISEG CALL SEGLD(NAMSG,IERR) CALL ACERR(IERR) CALL ACWRI(NAMSG,12) CALL EXEC(6) RETURN END ������������������������������������������������������������������������������������§Ê������ÿÿ����� ���� ÿý�W�] ���������ÿ��92067-18397 1940� S C0122 �&ACLTM �ACCTS PRINT TIME � � � � � � � � � � � � �H0101 ë�����þúASMB,R,Q,C HED TIME PRINT SUBROUTINE * NAME: ACLTM * SOURCE: XXXXX-18XXX * RELPC: 92067-16361 * PGMR: G.A.A.,C.M.M.,J.M.N * * *************************************************************** * * SOURCE PART NUMBER :92067-18397 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ACLTM,7 92067-16361 REV.1940 780823 ENT ACLTM EXT .ENTR * CALLING SEQUENCE: * *C PUT THE DOUBLE PRECISION INTEGER IN ARRAY * CALL FTIME(ITIME,IBUF) * SUP * * GET TIME AND BUILD HEADER MESSAGE * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D12 DEC 12 B77 OCT 77 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD D1978 DEC 1978 YEAR OFFSET M1 OCT -1 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 * * P1 NOP P2 NOP ACLTM NOP JSB .ENTR DEF P1 * * LDA P1,I GET SECONDS MINUTES AND YEAR STA IYEAR AND B77 SRTIP OFF MINUTES AND YEAR STA ISEC LDA IYEAR ALF,ALF RAL,RAL POSITION MINUTES AND B77 STA IMIN LDA IYEAR ALF POSITION YEAR AND B17 ADA D1978 ADD OFFSET STA IYEAR ISZ P1 LDA P1,I GET HOURS AND DAYS AND B37 SRTIP OFF DAYS STA IHOUR XOR P1,I ALF,ALF ALF,RAR ADA DM366 CHECK THE NUMBER OF DAYS SSA,RSS CLA IF TO MANY MAKE 366 ADA D366 * STA IDAY * * LDA ISEC GET SECONDS JSB PD00 IOR O30K Ãæ������þúDON'T SUPPRESS LEADING ZEROS HERE STA TMSG+3 PUT SECONDS IN MESSAGE * LDA IMIN GET MINUTES JSB PD00 LDB "::" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S ":" ,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR GET HOURS LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+5 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR GET YEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+16 YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB B37 DEC 31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+10 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+12 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+7 LDB DM17 SET WORD COUNT STB COUNT LDA TMSGA AND THE TIME ARRAY OLOOP LDB A,I MOVE IT STB P2,I INA ISZ P2 ISZ COUNT JMP OLOOP * JMP ACLTM,I RETURN * * * PD00 NOP CONVERT TO 2 ASCII DIGITS CLB DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HINs����� GH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 "::" ASC 1,:: D10 DEC 10 DM17 DEC -17 COUNT BSS 1 O5 OCT 5 O7 OCT 7 B17 OCT 17 B37 OCT 37 D100 DEC 100 D153 DEC 153 D366 DEC 366 DM366 DEC -366 * SPC 1 * ITIME NOP TENS OF MSEC IHOUR NOP IDAY NOP IYEAR NOP IMIN NOP ISEC NOP * SPC 1 * MESSAGE FORMAT: ASC 17,10:03:22 AM MON., 29 DEC., 1975 * 0011223344556677889900112233445566 * TMSGA DEF *+1 TMSG ASC 17,12:01:00 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������©Ü������ÿÿ����� ���� ÿý�X�` ���������ÿ��92067-18398 1940� S C0122 �&ACMSN �ACCTS BUILD MESSAGE FILE � � � � � � � � � � � � �H0101 e�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18398 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACMSN - ROUTINE TO BUILD USER'S MESSAGE FILE NAME C C CALLING SEQUENCE: CALL ACMSN(ID,MSNAM) C WHERE C ID = USER ID C MSNAM = 3-WD RETURN BUFFER FOR MSG NAME C C ACERRS: NONE C C SUBROUTINE ACMSN(ID,MSNAM) ,92067-16361 REV.1940 781226 DIMENSION MSNAM(3) C C CONVERT INTEGER ID TO ASCII AND INSERT "+M" C CALL ACITA(ID,MSNAM,3) MSNAM(1)=2H+M RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ûí������ÿÿ����� ���� ÿý�Y�_ ���������ÿ��92067-18399 2001� S C0122 �&ACOPL �ACCTS OPEN LIST FILE � � � � � � � � � � � � �H0101 ûç�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18399 C C RELOCATABLE PART NUMBER : 92067-16363 C C PROGRAMER(S) : J.M.N. C C C C C OPEN OR CREAT A LIST FILE C OR LOCK AN LU C C SUBROUTINE ACOPL(IERR,ITYPE,JSIZE),92067-16363 REV.2001 791016 LOGICAL IFBRK,IFBNR DIMENSION ISIZE(2) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITY,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMC/ IECHO,LU,IDUM(11),LLST(4) EQUIVALENCE (LIST,LI1),(LIST(2),LI2),(LIST(3),LI3) DATA ISIZE / 0,128 / IERR=0 IF(ITYPE.GE.0) GO TO 5 LIST(4)=-LIST(4) CALL ACOPN(IERR,IDSES) GO TO 300 5 LIST4=IABS(LIST(4)) IF(ITYPE.EQ.3.OR.LIST4.NE.0) GO TO 7 LIST4=1 LIST(1)=8 7 LIST(4)=LIST4 IF(LIST4.EQ.0) RETURN C C IF LIST SAME AS LLIST USE LLIST C DO 20 I=1,3 IF(LIST(I).NE.LLST(I)) GO TO 30 20 CONTINUE C C IF CRN'S DIFFERENT AND NOT ZERO OPEN NEW FILE C LLDIF=IXOR(LIST(6),LLST(4)) IF(LLDIF.NE.0.AND.LIST(6).NE.0.AND.LLST(4).NE.0) GO TO 30 IF(LIST4.EQ.3) LIST(1)=-LIST(1) RETURN C C LIST IS UNIQUE C 30 IF(LIST4.EQ.3) GO TO 100 LIST(1)=LUTRU(LIST) IF(LIST(1).LT.0) GO TO 75 C C LOCK LU C 60 LU2=IOR(LIST,100000B) CALL ACLCK(LU2,IERR) IF(IERR.EQ.10) GO TO 80 IF(IERR.EQ.0)GO TO 90 C C ILLEGAL LU C 75 IERR=12 76 LIST(1)=-1 RETURN C C CALL ACERR TO TRANSFER CONTROL TO LOGLU C Øâ������þú 80 CALL ACERR(0) GO TO LRTRN C C IF NOT BINARY REQUEST RETURN C 90 IF(ITYPE.EQ.3) RETURN LIST(2)=100B IF(IFBNR(ITYPE,LIST)) RETURN IERR=4 CALL LURQ(70000B,LU2,1) GO TO 76 95 GO TO 76 C C TRY TO OPEN C 100 CALL ACTIN(LIST,IERR) IF(IERR.EQ.0) GO TO 200 CALL ACERR(IERR) RETURN 200 IOPTN=0 IF(LI1.EQ.2H+@.AND.LI2.EQ.2HCC.AND.LI3.EQ.2HT!) IOPTN=1 IF(LIST(7).EQ.0) LIST(7)=3 IF(LIST(8).EQ.0) LIST(8)=24 IF(ITYPE.GE.3) GO TO 250 LIST(7)=1 LIST(8)=JSIZE 250 CALL ACROP(LDCB,IERR,LIST,IOPTN,LIST(5),LIST(6) 1 ,LIST(8),LIST(7)) 300 IF(IERR.GT.0) IERR=0 RETURN END SUBROUTINE ACLCK(LU,IERR) 1 ,92067-16363 REV.1940 790721 C C LOCK LU IF NOT INTERACTIVE C C ERRORS: 10 BREAK C 12 LU NOT IN SWITCH TABLE C C LOGICAL IFBRK,XFTTY,IPFLG DIMENSION LU2(2) DATA LU2 /0,0 / C IPFLG=.FALSE. IERR=0 LU2=IOR(LU,100000B) IF(XFTTY(LU2)) RETURN 10 CALL LURQ(170001B,LU2,1) GO TO 75 11 CALL ABREG(LOCK,IDUM) IF(LOCK.EQ.0) RETURN IF(IPFLG) GO TO 50 IF(LOCK.LT.0) GO TO 25 CALL ACWRI(14HWAITING FOR LU,7) GO TO 50 25 CALL ACWRI(14HWAITING FOR RN,7) 50 IF(IFBRK(IDUM)) GO TO 60 IPFLG=.TRUE. CALL EXEC(12,0,2,0,-5) GO TO 10 C C CALL ACERR TO TRANSFER CONTROL TO LOGLU C 60 IERR=10 RETURN C C ILLEGAL LU C 75 IERR=12 RETURN END C C C THIS ROUTINE OPENS A LIST FILE C AND POSITSIONS IT AT EOF FOR UPDATE C C IF FILE DOES NOT EXIST THE FILE IS CREATED. C SUBROUTINE ACROP(IDCB,IERR,NAME,IOPT,ISC,ICRN,ISIZE,ITYPE) 1,92067-16363 REV.1940 790721 DIMENSION NAME(3),IDCB(144) C C TRY TO OPEN C CALL OPEN(IDCB,IERR,NAME,IPOTN,ISC,ICRN) IF(IERR.EQ.-6) GO TO 200Ž.����� C C IT EXISTED SO UPDATE C IF(ITYPE.LT.3) RETURN 100 CALL POSNT(IDCB,IERR,10000) IF(IERR.GE.0) GO TO 100 C C BACK UP TO WRITE OVER EOF C CALL POSNT(IDCB,IERR,-1) IERR=0 RETURN C C WE MUST CREATE IT C 200 CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,ISC,ICRN) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������É4������ÿÿ����� ���� ÿý�Z�b ���������ÿ��92067-18400 1940� S C0122 �&ACNXA �ACCTS GET NEXT ACCOUNT � � � � � � � � � � � � �H0101 <ú�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18400 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C NAXT GETS NEXT ACCOUNT C AND PUTS DIRECTORY IN JBUF C C CALLING SEQUENCE: C CALL ACNXA(J,IREC,IDEL,KOUNT,IDIR) C WHERE J IS OFFSET INTO JBUF OF DIRECTORY ENTRY C C J IS SET TO -1 TO START AT BEGINING C OF DIRECTORY C C IREC IS RECORD NUMBER OF DIRECTORY ENTRY C C IDEL IS MINUS THE NUMBER OF HOLES IN DIRECTORY C C KOUNT IS THE COUNT OF DIRECTORY ENTRIES C C IDIR IS THE DIRECTORY ENTRY NUMBER C C IDELX IS INDEX INTO DELTA TABLE C C SUBROUTINE ACNXA(J,IREC,IDEL,KOUNT,IDIR,IDELX) 1 ,92067-16361 REV.1940 781116 LOGICAL ISRCH COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) COMMON /ACOM8/LASTP(40),LENP COMMON /ACOM9/JBUF(136) COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO IF(J.LT.0) GO TO 60 KOUNT=KOUNT+1 IDELO=IDEL IF(JBUF(J).EQ.0) RETURN IF(IDELX.GE.200) GO TO 10 IF(JBUF(J).EQ.-1) GO TO 50 C 10 J=J+16 IDIR=IDIR+1 ‡ˆ��� ��  IF(J.LT.128) GO TO 30 CALL READF(NDCB,IERR,JBUF,128,LEN,IREC) IREC=IREC+1 J=1 C 30 IF(IDELX.GE.200) RETURN IF(JBUF(J).EQ.-2) GO TO 40 IF(JBUF(J).GE.0) GO TO 70 IDEL=IDEL-1 GO TO 10 C C ENTRY EXTENT C 40 IF(MOD(KOUNT,2).EQ.0) GO TO 70 JBUF(J)=-1 IDEL=IDEL+1 GO TO 70 50 JBUF(J)=-2 RETURN C C INITIALIZE J,IREC AND KOUNT C 60 KOUNT=0 IDIR=LOC(6)*2-1 J=128 IREC=LOC(5) IDEL=0 IDELX=-1 GO TO 10 C C IF DELTA CHANGED BUMP INDEX C 70 IF(IDEL.NE.IDELO) IDELX=IDELX+2 RETURN END ������������������������������������������������������������������������������������������������ÒÐ ������ÿÿ����� ���� ÿý�[�b ���������ÿ��92067-18401 1940� S C0122 �&ACFID �ACCTS FIND ID � � � � � � � � � � � � �H0101 e@�����ASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18401 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * NAM ACFID,7 92067-16361 REV.1940 781116 ENT ACFID EXT .ENTR * A EQU 0 IVAL NOP IDELI NOP KDEL NOP ACFID NOP JSB .ENTR DEF IVAL * LDA IVAL,I FETCH VALUE RAL ROTATE OFFSET FLAG TO LSB SZA,RSS IF ZERO DONT ADJUST JMP ACFID,I * * SEARCH FOR APPROPRIATE DELTA * LOOP LDB KDEL,I GET RECORD NUMBER (64 WORDS/RECORD) ISZ KDEL SSB,RSS IF END OF TABLE JMP FDEL GO USE DELTA ADB A COMPARE WITH RECORD # TO FIXED SSB IF VALUE LESS THAN TABLE ENTRY JMP FDEL THEN GO USE DELTA ISZ KDEL ELSE LOOK FOR NEXT TABLE ENTRY JMP LOOP * * FOUND DELTA FDEL ADA KDEL,I ADD TABLE OFFSET ADA IDELI,I ADD INITIAL OFFSET RAR ROTATE BACK STA IVAL,I PUT BACK CORRECTED VALUE JMP ACFID,I AND RETURN END ��������������s°������ÿÿ����� ���� ÿý�\�b ���������ÿ��92067-18402 1940� S C0122 �&ACPGA �ACCTS PURGE ACCOUNT � � � � � � � � � � � � �H0101 ­�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18402 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACPGA PURGES AN ACCOUNT ENTRY C OR RESERVES SPACE FOR SECOND C PART OF AN ENTRY C SUBROUTINE ACPGA(I,IDIRN,ID) ,92067-16361 REV.1940 781011 DIMENSION IBUF(16) COMMON /ACOM6 /LOC(6),IRN COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM1/NDCB(272),NBUF(256) DATA IBUF / 16*0 / IBUF(1)=I CALL ACDIR(2,IDIRN,IBUF,IERR) RETURN END ��������������������������������������ÍT������ÿÿ����� ���� ÿý�]�c ���������ÿ��92067-18403 2001� S C0122 �&ACTRM �ACCTS TERMINATE ACCTS � � � � � � � � � � � � �H0101 Aä�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18403 C C RELOCATABLE PART NUMBER : 92067-16363 C C PROGRAMER(S) : J.M.N. C C C C ACTRM- PROGRAM ACTRM INATION ROUTINE C C CALLING SEQUENCE: CALL ACTRM C C SUBROUTINE ACTRM ,92067-16363 REV.2001 791020 DIMENSION LU2(2) COMMON /ACOMC/ IECHO,LULOG COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(12) COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOM4/ICMND(40),NAMPR(3),ICLFG,NMPR3 COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE DIMENSION MSEND(5) DATA MSEND/2HEN,2HD ,2HAC,2HCT,2HS / DATA LU2 / 0,0/ 10 CALL CLOSE(ITDCB) CALL CLOSE(NDCB) CALL ACCLS(LLDCB,3) IF(LLIST.GT.255) GO TO 440 LU2(1)=IOR(LLIST,100000B) CALL LURQ(70000B,LU2,1) GO TO 440 430 CONTINUE 440 LU2(1)=IOR(LULOG,100000B) IF(ITYPE.GE.0) CALL XLUEX(2,LU2,MSEND,5) C C IF CLEAN UP REQUIRED SCHEDULE "ACCTS" TO CLEAN UP C IF(ICLFG.EQ.-1.AND.IPFLG.LE.0) GO TO 500 C C IF I AM NOT "ACCTS" SCHEDULE "ACCTS" C IF(NMPR3.EQ.2HS ) GO TO 490 CALL EXEC(100030B,NAMPR,-1) GO TO 500 480 GO TO 500 C C ELSE WAKE ME UP IN 30 SEC OUTSIDE OF SESSION C 490 CALL DTACH CALL EXEC(12,NAMPR,3,0,-2) CALL EXEC(6,0,0,-1) 500 CALL EXEC(6) RETURN END ����������������������������������������������������������������������������������������������������������������������������������������¯”��� ���� �������� �������ÿÿ����� ���� ÿý�^�e ���������ÿ��92067-18404 1940� S C0122 �&ACDDV �ACCTS SPECIAL DOUBLE � � � � � � � � � � � � �H0101 Ä�����ASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18404 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * * * ROUTINE TO DIVIDE DOUBLE WORD INTEGER * AND RETURN QUOTIENT AND REMAINDER * * CALLING SEQUENCE: * CALL ACDDV (IDBLE,IDIVR,IQUOT,IREMN) * WHERE: IDBLE IS DOUBLE WORD INTEGER * IDIVR IS DIVISOR * IQUOT IS QUOTIENT * IREMN IS REMAINDER * NAM ACDDV,7 92067-16361 REV.1940 790306 ENT ACDDV * EXT .ENTR * IDBL BSS 1 IDIV BSS 1 IQUO BSS 1 IREM BSS 1 ACDDV NOP JSB .ENTR DEF IDBL * DLD IDBL,I GET DIVIDEND SWP SWAP A & B BECAUSE NOBODY AGREES SSB IF NEGATIVE IT'S BAD JMP BAD * DIV IDIV,I DIVIDE SOS IF OVERFLOW SET MAX VALUE JMP OK * BAD LDA O7777 SET QUOTIENT TO MAX CCB ADB IDIV,I SET REMAINDER TO MAX MOD VALUE OK STA IQUO,I STB IREM,I JMP ACDDV,I AND RETURN * O7777 OCT 77777 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R+������ÿÿ����� ���� ÿý�_�e ���������ÿ��92067-18405 1940� S C0122 �&ACDIR �ACCTS READ AND WRITE � � � � � � � � � � � � �H0101 Øé�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18405 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACDIR - ROUTINE TO READ OR WRITE A DIRECTORY ENTRY C C CALLING SEQUENCE: CALL ACDIR(ICODE,IDIRN,IBUF,IERR) C WHERE C ICODE = 1 FOR READ, 2 FOR WRITE C IDIRN = DIRECTORY ENTRY NUMBER TO READ/WRITE C IBUF = 16-WD BUFFER WHERE ENTRY IS RETURNED C IERR = ACERR RETURN WORD C C ACERRS: -1 = INVALID PARAMETER C -2 = DIR. ENTRY NBR. EXCEEDS DIRECTORY SIZE C FMP ACERR (READF,WRITF) C C SUBROUTINE ACDIR(ICODE,IDIRN,IBUF,IERR) 1 ,92067-16361 REV.1940 781024 DIMENSION IBUF(16) COMMON /ACOM6 /LOC(6) COMMON /ACOM1/NDCB(272),NBUF(128) C C CHECK PARAMETERS C IF((ICODE.EQ.1).OR.(ICODE.EQ.2)) GO TO 200 100 IERR=-1 RETURN 200 IF(IDIRN.LT.1) GO TO 100 GO TO 400 300 IERR=-2 RETURN C C COMPUTE DIRECTORY ENTRY NUMBER AND READ THIS RECORD C 400 IREC=(IDIRN-1)/8 IENT=IDIRN-(IREC*8)-1 IENT=(IENT*16)+1 IREC=IREC+LOC(5) IF(IREC.GE.LOC(6)) GO TO 300 CALL READF(NDCB,IERR,NBUF,128,LEN,IREC) IF(IERR.LT.0) GO TO 900 C C CHECK THAT ENTRY NOT BEYOND END OF DIRECTORY C DO 500 I=1,IENT,16 IF(NBUF(I).EQ.0) GO TO 300 500 CONTINUE C C IF READ REQUEST, RETURN THE ENTRY C IERR=0 IF(ICODE.EQ.2) GO TOh��� ��  700 DO 600 I=1,16 IBUF(I)=NBUF(IENT) IENT=IENT+1 600 CONTINUE RETURN C C WRITE THE DIRECTORY ENTRY C 700 DO 800 I=1,16 NBUF(IENT)=IBUF(I) IENT=IENT+1 800 CONTINUE CALL WRITF(NDCB,IERR,NBUF,128,IREC) 900 IF(IERR.LT.0) CALL ACERR(IERR) RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������fÍ ������ÿÿ����� ���� ÿý�`�g ���������ÿ��92067-18406 1940� S C0122 �&ACFDA �ACCTS FIND ACCOUNT � � � � � � � � � � � � �H0101 ÁÁ�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18406 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACFDA - ROUTINE TO FIND A USER'S OR GROUP'S ACCOUNT LOCATION C C CALLING SEQUENCE: CALL ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,JERR) C WHERE C IUSER = 5-WD BUFFER CONTAINING USER NAME, C PADDED WITH BLANKS C IF GROUP, IUSER(1)=0 C IGRP = 5-WD BUFFER CONTAINING GROUP NAME, C PADDED WITH BLANKS C IDIRN = DIRECTORY ENTRY NUMBER OF ACCOUNT C (RETURNED) C IRECU = 2-WD ARRAY, WORD 1 IS RETURNED AS C RECORD NBR OF USER ACCT, C WORD 2 IS RETURNED AS OFFSET (0 OR 64) C IRECG = 2-WD ARRAY, WORD 1 IS RETURNED AS C RECORD NBR OF GROUP ACCT, C WORD 2 IS RETURNED AS OFFSET (0 OR 64) C JERR = ACERR RETURN WORD C C ACERRS: -200 = ACCOUNT NOT FOUND C FMP ACERR (READF) C C SUBROUTINE ACFDA(IUSER,IGRP,IDIRN,IRECU,IRECG,JERR) 1 ,92067-16361 REV.1940 781024 LOGICAL ISRCH DIMENSION IUSER(5),IGRP(5),IRECU(2),IRECG(2) COMMON /ACOM6 /LOC(5) COMMON /ACOM1/NDCB(272),NBUF(128) COMMON /ACOMA /ISRCH,IUR,IU,IGR,IG C DATA IAT/2H@ / C C C Ò»������þúGET RECORD NUMBER OF START OF DIRECTORY C INITIALIZE DIRECTORY ENTRY NBR, OFFSET, INDEX TO DIRECTORY C IRECU(2)=0 IRECG(2)=0 IF(ISRCH) GO TO 550 IREC=LOC(5) IF(IUSER(1).EQ.0) GO TO 50 IUR=IREC IU=1 GO TO 100 50 IGR=IREC IG=1 100 I=1 C C READ THE NEXT RECORD OF DIRECTORY C 150 CALL READF(NDCB,JERR,NBUF,128,LEN,IREC) IF(JERR.LT.0)RETURN C C CHECK FOR END OF DIRECTORY C 200 IF(NBUF(I).EQ.0) GO TO 600 C C CHECK IF DIRECTORY ENTRY POINTS TO A FREE ACCOUNT ENTRY (-1) C OR TO AN EXTENDED ACCOUNT ENTRY (-2) C IF(NBUF(I).LT.0) GO TO 500 C C CHECK IF DIRECTORY ENTRY POINTS TO A GROUP ACCOUNT OR USER C ACCOUNT. (GROUP IF NUMBER OF CHARACTERS IN USER NAME = 0) C IWD1=IAND(NBUF(I),177400B) IF((IWD1.EQ.0).AND.(IUSER(1).EQ.0)) GO TO 350 IF((IWD1.NE.0).AND.(IUSER(1).NE.0)) GO TO 250 GO TO 500 C C FOUND A USER ACCOUNT. SEE IF USER NAME MATCHES. C 250 IF(IUSER(1).EQ.IAT.AND.NBUF(I+1).GE.0) GO TO 350 DO 300 J=1,5 IF(IUSER(J).NE.NBUF(I+J)) GO TO 500 300 CONTINUE C C SEE IF GROUP NAME MATCHES C 350 IF(IGRP(1).EQ.IAT) GO TO 410 DO 400 J=1,5 IF(IGRP(J).NE.NBUF(I+J+5)) GO TO 500 400 CONTINUE C C SAVE USER OR GROUP POSITION C 410 IF(IUSER(1).EQ.0) GO TO 415 IU=I IUR=IREC GO TO 420 415 IG=I IGR=IREC C C PUT USER NAME IN IUSER C AND PUT GROUP IN IGRP C 420 DO 425 J=1,5 IUSER(J)=NBUF(I+J) 425 IGRP(J)=NBUF(I+J+5) C C FOUND THE MATCHING DIRECTORY ENTRY C RETURN THE ACCOUNT RECORD NUMBER AND THE OFFSET C AND COMPUTE DIRECTORY NUMBER C IDIRN=8*(IREC-LOC(5))+1+((I-1)/16) JERR=0 J=NBUF(I+13) IRECG(1)=IAND(J,77777B) IF(J.LT.0) IRECG(2)=64 J=NBUF(I+14) IF(IUSER(1).EQ.0) GO TO 450 IRECU(1)=IAND(J,77777B) IF(J.LT.0) IRECU(2)=64 RETURN 45L¯����� 0 IRECU(1)=J RETURN C C GET THE NEXT DIRECTORY ENTRY C 500 I=I+16 IF(I.LT.129) GO TO 200 IREC=IREC+1 GO TO 100 C C RESTORE USER OR GROUP POSITION C 550 I=IG IREC=IGR IF(IUSER(1).EQ.0) GO TO 575 I=IU IREC=IUR C C REREAD TO GET NEXT DIRECTORY ENTRY C 575 I=I+16 IF(I.LT.129) GO TO 150 IREC=IREC+1 GO TO 100 C C RETURN ACCOUNT NOT FOUND C 600 JERR=-200 RETURN END ����������������a6������ÿÿ����� ���� ÿý�a�i ���������ÿ��92067-18407 1940� S C0122 �&ACFMT �ACCTS FORMATER � � � � � � � � � � � � �H0101 •œ�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18407 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * * * ACFMT FORMAT AND OUTPUT DATA * NAM ACFMT,7 92067-16361 REV.1940 790725 ENT ACFMT EXT ACWRL,.ENTP EXT ACOM2,NAM.. * * * CALLING SEQUENCE: * CALL ACFMT(IERR,F1,IBUF1,-N,F2,IBUF2,F3,...,FN,IBUFN) * * WHERE: F1,F2,...,FN,... ARE FUNCTION CODES * N IS NUMBER OF BLANKS(NEXT PARM IS * A FUNCTION CODE * FUNCTION CODES ARE: * WHERE: 0<FN<"I0" PRINT N ASCII CHARACTERS * FN=0 PRINT ASCII CHARACTERS * UNTIL BLANK IS ENCOUNTERED * (MAXIMUM NO OF CHARS FOLLOWS) * * FN="I0" PRINT DECIMAL NUMBER * WITHOUT LEADING BLANKS * "I0"<FN<"I6" PRINT IN "IN" FORMAT * * IBUF1,IBUF2,IBUF3,... ARE EITHER ASCII STRINGS * OR NUMERIC DATA * * IERR NOP IPARS BSS 30 ACFMT NOP JMP CLPAR GO CLEAR PARAMETER LINKS NOP **THIS IS REQUIRED FOR .ENTP ACFM0 JSB .ENTP GET PARAMATER ADDRESSES DEF IERR * LDA PARMS STA PARPT SET PARAMETER ADDRESS POINTER * LDA BYADD SET OUTPUT BUFFER BYTE POINTER CAX * NEXT CCA CLEAR BLANK STOP FLAG STA IFLG * LDA PARPT,I GET NEXT PARM ADDRESS SZA,RSS IF ZERO THERE ARE NO MORE JMP END * LDA A,I Žî������þú GET FUNCTION CODE ISZ PARPT NXT0 LDB PARPT,I GET BUFFER ADDRESS CPA CR JMP CRCHK IF CODE "CR" GO CHECK IF ASCII SSA IF POSITIVE MUST BE ASCII OR INTEGER JMP NOTAS ELSE BLANKS ADA MI0 IS IT AN INTEGER SSA,RSS JMP INTGR YES ADA I0 NO RESTORE A REG * ISZ PARPT BUMP ADDRESS FOR NEXT SZA IF ZERO PRINT UNTIL A BLANK JMP ASCII ELSE PRINT N CHARS * LDA BLNK SET BLANK STOP FLAG STA IFLG LDA B,I GET MAXIMUM NO OF CHARS LDB PARPT,I GET THE BUFFER ADDRESS ISZ PARPT BUMP ADDRESS FOR NEXT * ASCII CMA,INA SET CHAR COUNTER STA CNTR CLE,ELB CONVERT TO BYTE ADDRESS LOOP2 LBT CPA IFLG IF CHAR IS A BLANK AND JMP NEXT BLANK STOP FLAG SET GO GET NEXT FUNC JSB SBTX TRANSFER STRING ISZ CNTR JMP LOOP2 JMP NEXT GO GET NEXT FUNCTION WHEN DONE * * CHECK IF SC OR CRN IS LEAGAL FILE NAME * CRCHK LDB B,I GET DATA STB CRNAM PUT IN 6 CHAR NAME JSB NAM.. GO TEST IT DEF *+2 DEF CRNAM LDB A IF A=0 LDA A2 THEN PRINT AS ASCII SZB LDA I0 ELSE PRINT AS INTEGER JMP NXT0 * A2 DEC 2 CR ASC 1,CR CRNAM ASC 3, 6 BLANKS NOTAS EQU * END STA CNTR NO,PRINT IABS(N) BLANKS LDA BLNK XBX GET OUTPUT BYTE ADDRESS LOOP3 CPB BYEND DONT GO OFF END JMP POST SBT ISZ CNTR JMP LOOP3 * XBX JMP NEXT GO GET NEXT FUNCTION * * INTGR CMA,INA STA NDGTS SAVE NUMBER OF DIGITS SZA,RSS LDA BLNK IF ZERO SET IFLG TO STA IFLG SUPPRESS LEADING BLANKS ISZ PARPT BUMP FOR NEXT LDA B,I GET NUMBER * LDY TLADD LDB BLKBL STB TBUF CLEAR WORKING ÐÉ������þúBUFFER STB TBUF+1 STB TBUF+2 * SSA,RSS JMP CNVT0 CMA,INA MAKE POSITIVE LDB DASH CNVT0 STB ISGN LOOP6 CLB CONVERT NEXT LEAST SIGNIFICANT 2 DIGITS DIV D10 STB TMP1 SZA IF MORE DIGITS GET NEXT DIGIT JMP CNVT1 LDB ISGN ELSE MERGE SIGN BLF,BLF ADB B20 ADJUST FOR CORRECT ASCII ADB TMP1 SBY 0 JMP CNVT2 * CNVT1 CLB DIV D10 CONVERT NEXT DIGIT BLF,BLF ADB TMP1 MERGE LOWER ADB "00" MAKE ASCII SBY 0 DSY DECREMENT POINTER SZA JMP LOOP6 MORE TO CONVERT LDB ISGN ADD SIGN SBY 0 CNVT2 LDB NDGTS COMPUTE NO OF DIGITS SZB,RSS LDB DM6 STB CNTR * ADB D6 AND STARTING ADDRESS ADB TBADD LOOP4 LBT CPA IFLG RSS JSB SBTX ISZ CNTR JMP LOOP4 JMP NEXT * * POST JSB ACWRL WRITE BUFFER DEF RTRN DEF IBUF DEF D32 DEF IERR,I RTRN JMP ACFMT,I RETURN * CLPAR LDA DM30 CLEAR PARM ADDRESSES STA CNTR LDB PARMS CLA LOOP5 STA B,I INB ISZ CNTR JMP LOOP5 JMP ACFM0 GO BACK AND GET PARMATERS ADDRESSES * * SBTX NOP STORE BYTE INTO ADDRESS XBX POINTED TO BY X REG CPB BYEND IF BUFFER END STOP JMP POST SBT XBX JMP SBTX,I * A EQU 0 B EQU 1 XX BSS 1 CNTR BSS 1 PARMS DEF IPARS PARPT BSS 1 IBUF ASC 2, * BUF BSS 29 BUFEN ASC 1, * BYADD DBL BUF BYEND DBL BUFEN BLNK OCT 40 IFLG BSS 1 DM6 DEC -6 D10 DEC 10 B20 OCT 20 "00" ASC 1,00 ** TMP1 BSS 1 ISGN BSS 1 BLKBL ASC 1, ***** DASH ASC 1, - **** TBADD DBL TBUF TBUF BSS 3 TLADD DEF *-1 DM30 DEC -30 D32 DEC 32 D6 DEC 6 I0 ASC 1,I0 MI0 OCT 133320 NDGTS BSS 1 ENÓ‹��������D ��������������Q<�������ÿÿ����� ���� ÿý�b�k ���������ÿ��92067-18408 1940� S C0122 �&ACCLL �ACCTS CLOSE LIST FILE � � � � � � � � � � � � �H0101 Ý�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18408 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C CLOSE LIST FILE C OR UNLOCK LU C SUBROUTINE ACCLL ,92067-16361 REV.1940 790721 DIMENSION LU2(2) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) DATA LU2 /0,1100B / IF(LIST(1).LE.0) RETURN IF(IAND(LIST(4),3).EQ.3) GO TO 100 C C TOP OF FORM C LU2(1)=IOR(LIST,100000B) CALL XLUEX(3,LU2,-1) C C UNLOCK LU C CALL LURQ(70000B,LU2,1) GO TO 110 50 LIST(1)=-1 RETURN C C CLOSE LIST FILE C 100 CALL ACCLS(LDCB,LIST(7)) 110 LIST(1)=-1 GO TO 50 END C C C THIS ROUTINE CLOSES AND TRUNCATES THE LIST FILES C C CALL ACCLS(IDCB,ITYPE) CC CC WHERE : IDCB IS THE DCB FOR THE FILE CC ITYPE IS FILE TYPE CC CC FILE TYPES 1 AND 2 WILL NOT CC BE TRUNCATED. C SUBROUTINE ACCLS(IDCB,ITYPE),92067-16361 REV.1940 790722 ITRUN=0 IF(ITYPE.LT.3) GO TO 105 C C FIND OUT WHERE WE ARE AND HOW BIG THE FILE IS C CALL LOCF(IDCB,IERR,I,IRB,I,JSEC) C C COMPUTE HOW MANY SECTORS TO DELETE C FOR THE STUPID (DUMB) FILE MANAGER C ITRUN=JSEC/2-IRB-1 C C CLOSE AND TRUNCATE C C (IF ITRUN=0 THEN NO TRUNCATION TAKES PLACE) 105 CALL CLOSE(IDCB,IERR,ITRUN) RETURN END ������������������������������������������������������������������������������������������������������ÿ†��� ���� �������� �������ÿÿ����� ���� ÿý�c�j ���������ÿ��92067-18409 1940� S C0122 �&ACPRM �ACCTS PROMPT � � � � � � � � � � � � �H0101 p�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18409 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACPRM - ROUTINE TO WRITE A PROMPT TO THE INTERACTIVE INPUT DEVICE C C CALLING SEQUENCE: CALL ACPRM(MSG,MSGLN) C WHERE C MSG = PROMPT TO BE WRITTEN C MSGLN = LENGTH OF PROMPT (#WORDS) C C SUBROUTINE ACPRM(MSG,MSGLN) ,92067-16361 REV.1940 790125 LOGICAL IFBRK DIMENSION MSG(40) COMMON /ACOM8/LASTP(40),LENP IF(IFBRK(IDUM)) CALL ACERR(0) C C C WRITE THE PROMPT C IF(MSGLN.EQ.-1) GO TO 200 CALL ACWRI(MSG,MSGLN) C C SAVE THE PROMPT IN CASE OF ACERR C DO 100 LENP=1,MSGLN LASTP(LENP)=MSG(LENP) 100 CONTINUE RETURN C C RE-PROMPT WITH THE LAST PROMPT ISSUED C 200 CALL ACWRI(LASTP,LENP-1) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������Åó������ÿÿ����� ���� ÿý�d�j ���������ÿ��92067-18410 1940� S C0122 �&ACREI �ACCTS READ FROM STANDARD � � � � � � � � � � � � �H0101 E!�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18410 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACREI - ROUTINE TO READ A RESPONSE FROM THE INPUT DEVICE/FILE C C CALLING SEQUENCE: CALL ACREI(IBUF,IERR) C WHERE C IBUF = BUFFER INTO WHICH TO READ C IERR = ACERR RETURN WORD C C SUBROUTINE ACREI(IBUF,IERR) ,92067-16361 REV.1940 790309 DIMENSION LU(2) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG DIMENSION IBUF(40),IPBUF(11) DATA IPNTR / 17 / DATA LU /0,0 / IERR=0 C C RESET ERROR FLAG C C C READING FROM? C C MEMORY (LDCB) 50 IF(ITTY.LE.0) GO TO 400 C FILE:SC:CR IF(ITTY.GT.255) GO TO 300 C C LU C LU(1)=IOR(ITTY,100000B) LU(2)=KECHO CALL XLUEX(1,LU,IBUF,-80) CALL ABREG(IA,ITLOG) IB=(ITLOG+1)/2 C C ECHO IF REQUIRED C 100 IF(IB.NE.0) GO TO 120 CALL ACWRI(2HTR,1) GO TO 130 120 CALL ACWRI(IBUF,-IB) C C FILL END OF BUFFER WITH BLANKS C 130 IF(IB.GE.40) RETURN DO 200 J=IB+1,40 200 IBUF(J)=2H C C CHECK FOR "/TR" OR CONTROL "D" C ISTRC=1 IF(IB.EQ.0) GO TO 250 CALL NAMR(IPBUF,IBUF,80,ISTRC) IF(IPBUF(1).NE.2H/T.OR.MBYTE(IPBUF(2)).NE.122B) GO TO 275 250 IERR=0 CALL ACXFR(IBUF,ISTRC,IERR) IF(IERR.EQ.0) GO TO 280 IF(IERR.EQ.10) IERR=0 CALL ACE_k��� �� RR(IERR) GO TO 280 C C TEST FOR "/HE" C 275 IF(IPBUF(1).NE.2H/H.OR.MBYTE(IPBUF(2)).NE.105B) RETURN IERFG=-1 CALL ACHLP (IBUF,ISTRC) IERFG=0 280 CALL ACPRM(IBUF,-1) GO TO 50 C C READ FROM FILE C 300 CALL READF(ITDCB,IERR,IBUF,40,IB) IF(IERR.LT.0.OR.IB.LT.0) IB=0 GO TO 700 C C READ FROM MEMORY (LDCB) FOR INITIALIZATION C 400 DO 500 IB=1,41 IBUF(IB)=LDCB(IPNTR) IPNTR=IPNTR+1 IF(IBUF(IB).EQ.0) GO TO 600 500 CONTINUE C C ADJUST IB C 600 IB=IB-1 700 ITLOG=2*IB GO TO 100 END ��������������������������������������������������������������������������������������������������������������������������������������������������ÿÞ ������ÿÿ����� ���� ÿý�e�l ���������ÿ��92067-18411 1940� S C0122 �&ACHLP �ACCTS HELP COMMAND � � � � � � � � � � � � �H0101 ÎÃ�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18411 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C SUBROUTINE ACHLP (ICMND,ISTRC),92067-16361 REV.1940 790722 LOGICAL ISRCH COMMON /ACOM1/NDCB(272),NBUF(256) COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) DIMENSION ICMND(40),IPBUF(11) COMMON /ACOM5/LOWUS,IHIGR COMMON /ACOM6 /LOC(6),IRN,IPFLG COMMON /ACOM8/LASTP(40),LENP COMMON /ACOMA /ISRCH,ISR1,ISR2,ISR3,ISR4 COMMON /ACOMB /ISTK(90),IPT COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG,KERRB(8) COMMON /ACOMD/ICLASS,KPB,KRR,KRRR DIMENSION LU2(2) EQUIVALENCE (LIST,LIST1) DATA LU2 / 0,0 / CALL NAMR(IPBUF,ICMND,80,ISTRC) ISV=ISTRC IP4=IAND(IPBUF(4),3) CALL NAMR(LIST,ICMND,80,ISTRC) IF(IERFG.EQ.-1.OR.IP4.EQ.1) GO TO 300 LIST(4)=IAND(LIST(4),3) CALL ACOPL(IERR,3,24) IF(IERR.NE.0) GO TO 100 KPB=IPBUF(1) LSAVE=LRTRN ASSIGN 75 TO LRTRN CALL ACLNK(2H5 ,4) 75 LRTRN=LSAVE IERR=KRR IF(KRRR.NE.0) CALL ACWRL(20H KEYWORD NOT FOUND ,10,IERR) IF(IERR.GE.0) GO TO 150 100 CALL ACERR(IERR) 150 CALL ACCLL KPB=0 RETURN C C CONVERT INTEGER ACERR NUMBER TO ASCII C 300 IF(IPBUF(1).NE.0) CALL ACITA(IPBUF,KERRB(5),2) C C CONVERT LIST DEVICE C KERRB(8)=2H IF(LIST1.NE.0) CALL ACITA(LIST,KERRB(7),2) LIST1=LUTRU(LIý™��� �� ST1) IF(LIST1.NE.LLIST) GO TO 450 C C UNLOCK LU SO HELP CAN USE IT C LU2=IOR(LLIST,100000B) CALL LURQ(70000B,LU2,1) GO TO 450 440 CONTINUE C C PUT IN COMMA C 450 KERRB(7)=2H , CALL EXEC(100027B,6HHELP ,LIST,0,0,0,0,KERRB,8) GO TO 500 460 IF(LIST1.EQ.LLIST) CALL ACLCK(LLIST,IERR) LIST1=-1 C C SET LIST DEVICE UNASSIGNED RETURN C C TELL HELP NOT LOADED C 500 CALL ACWRI(16H HELP NOT LOADED ,8) RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿG ������ÿÿ����� ���� ÿý�f�m ���������ÿ��92067-18412 1940� S C0122 �&ACERR �ACCTS ERROR ROUTINE � � � � � � � � � � � � �H0101 5Ê�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18412 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACERR - ACERR PROCESSING ROUTINE C C CALLING SEQUENCE: CALL ACERR(IERR) C WHERE C IERR = ACERR CODE NUMBER C C FORMAT: ACCT NNN C C SUBROUTINE ACERR(KERR) ,92067-16361 REV.1940 790307 DIMENSION IBUF(2) COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG,KERRB(7) EQUIVALENCE (KERRB(3),IBUF) C C DON'T LET PTERR CHANGE VALUE OF KERR C IERR=KERR C C CONVERT INTEGER ACERR NUMBER TO ASCII C CALL ACITA(IERR,IBUF(3),2) C C POST ACERR MNEMONIC TO SESSION CONTROL BLOCK C CALL PTERR(IBUF,IERR) C C WRITE ACERR MNEMONIC TO INTERACTIVE DEVICE C JERR=-1 CALL ACXFR(IBUF,IDU,JERR) CALL ACWRI(IBUF,4) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¯Ÿ������ÿÿ����� ���� ÿý�g�m ���������ÿ��92067-18413 1940� S C0122 �&ACWRL �ACCTS WRITE TO LIST FIL � � � � � � � � � � � � �H0101 8*�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18413 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C WRITE TO LIST LU OR FILE C C C CALLING SEQUENCE C CALL ACWRL(IBUF,NO,IERR) C C WHERE: IBUF IS OUTPUT BUFFER C NO IS NUMBER WORDS IN BUFFER C C SUBROUTINE ACWRL(IBUF,NO,IERR) ,92067-16361 REV.1940 790606 LOGICAL IFBNR,XFTTY,IFBRK DIMENSION LU2(2) COMMON /ACOM2/ LRTRN COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) DIMENSION IBUF(2) IF(IFBRK(IDUM)) GO TO 300 IERR=0 LU2(2)=LIST(2) IF(LIST(4).EQ.3) GO TO 100 IF(LIST(4).EQ.0) GO TO 200 C C WRITE TO LU C LU2(1)=IOR(LIST,100000B) IF=1 IF(XFTTY(LU2)) IF=2 IF(IFBNR(2,LIST)) IF=1 CALL XLUEX(2,LU2,IBUF(IF),NO-IF+1) RETURN C C WRITE TO FILE C 100 IF(LIST(1).LT.0) GO TO 150 CALL WRITF(LDCB,IERR,IBUF,NO) RETURN C C WRITE LOGICAL LIST FILE C 150 CALL WRITF(LLDCB,IERR,IBUF,NO) RETURN C C WRITE TO INPUT DEVICE C 200 CALL ACWRI(IBUF(2),NO-1) RETURN 300 CALL ACERR(0) CALL ACCLL GO TO LRTRN END ����������������������������������������������������������������������������������������Ð������ÿÿ����� ���� ÿý�h�n ���������ÿ��92067-18414 1940� S C0122 �&ACREL �ACCTS READ FROM LIST FI � � � � � � � � � � � � �H0101 $�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18414 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C C READ FROM "LIST" LU OR FILE C C C CALLING SEQUENCE C CALL ACREL(IBUF,NO,LEN,IERR) C C WHERE: IBUF IS OUTPUT BUFFER C NO IS NUMBER WORDS IN BUFFER C LEN IS LENGTH OF BUFFER RETURNED C C SUBROUTINE ACREL(IBUF,NO,LEN,IERR) ,92067-16361 REV.1940 781212 DIMENSION LU2(2) COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) DIMENSION IBUF(2) IF(IERR.EQ.-12) RETURN LU2(2)=LIST(2) IF(LIST(4).LT.0) GO TO 200 IF(LIST(4).EQ.3) GO TO 100 C C READ FROM LU C LU2(1)=IOR(LIST,100000B) CALL XLUEX(1,LU2,IBUF,NO) CALL ABREG(IA,LEN) IF(LEN.EQ.0) IERR=-12 RETURN C C READ FROM FILE C 100 CALL READF(LDCB,IERR,IBUF,NO,LEN) RETURN C C READ FROM +@CCT! FILE C 200 CALL READF(NDCB,IERR,IBUF,NO,LEN) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d������ÿÿ����� ���� ÿý�i�o ���������ÿ��92067-18415 1940� S C0122 �&ACITA �ACCTS INTEGER TO ASC II � � � � � � � � � � � � �H0101 Bß�����þúASMB,R,L * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * * SOURCE PART NUMBER :92067-18415 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * *************************************************************** * NAM ACITA,7 92067,16361 REV.1940 780801 * * * ACITA - INTEGER TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE: CALL ACITA(INT,IBUF,IWDS) * * CONVERTS AN INTEGER INT TO ITS DECIMAL EQUIVALENT * IN ASCII AND RETURNS IT IN THE ARRAY IBUF * (ARRAY LENGTH = IWDS) * * ENT ACITA EXT .ENTR * A EQU 0 INT BSS 1 IBUF BSS 1 IWDS BSS 1 ACITA NOP JSB .ENTR GET PARAMETER ADDRESSES DEF INT LDA TA SET UP NUMBER TABLE STA IPICK POINTER LDA IWDS,I GET LENGTH OF OUTPUT BUFFER CPA .2 IF 2 WORDS LONG, JMP JUST2 BUMP NUMBER TABLE POINTER GTINT LDA INT,I GET THE INTEGER LDB MINUS GENERATE THE SIGN SSA AND THE CMA,INA,RSS FIRST NUMBER LDB BLANK JSB ONEN STB IBUF,I SAVE IT LDB IWDS,I LENGTH OF OUTPUT BUFFER CPB .2 IF ONLY 2 WORDS LONG, JMP LAST SKIP TO LAST WORD CLB JSB ONEN BLF,BLF JSB ONEN ISZ IBUF STB IBUF,I LAST CLB JSB ONEN BLF,BLF ADB =B60 ADB A ISZ IBUF STB IBUF,I JMP ACITA,I SPC 1 JUST2 ISZ IPICK BUMP NUMBER TABLE POINTER ISZ IPICK JMP GTINT CONTINUE SPC 1 ONEN NOP CONVERSION ROUTINE ADB =B60 ON1 ADA IPICK,I I��� ��  SSA JMP ON2 INB JMP ON1 ON2 CMA,INA ADA IPICK,I CMA,INA ISZ IPICK JMP ONEN,I RETURN SPC 1 TA DEF NBUF NBUF DEC -10000 DEC -1000 DEC -100 DEC -10 BLANK OCT 20000 MINUS OCT 26400 .2 DEC 2 IPICK BSS 1 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������„q ������ÿÿ����� ���� ÿý�j�q ���������ÿ��92067-18416 1940� S C0122 �&ACXFR �ACCTS TRANSFER COMMANDS � � � � � � � � � � � � �H0101 Z8�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18416 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C SUBROUTINE ACXFR(ICMND,ISTRC,IERR),92067-16361 REV.1940 790722 LOGICAL IFBRK,XFTTY DIMENSION LU2(2),ISIZE(2) COMMON /ACOMB /ISTK(90),IPT COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMC/IECHO,LULOG,IDUM(11),LLST1,LLST2,LLST3,LLST4 DIMENSION ICMND(40),IPBUF(11) DATA LU2 / 0,0 / DATA ISIZE / 24,0 / IMODE=IERR C C IF CURRENT INPUT IS A FILE THEN CLOSE C IPTT=IPT IF(ITTY.LE.255) GO TO 200 C SAVE RECORD NUMBER CALL LOCF(ITDCB,IERR,ISTK(IPT+4),ISTK(IPT+7),ISTK(IPT+8)) CALL CLOSE(ITDCB) GO TO 210 200 LU2(1)=IOR(ITTY,100000B) C C PARSE TO GET NEXT INPUT LU OR FILE C 210 IF(IPT.LT.80) IPT=IPT+8 IF(IMODE.GE.0) GO TO 150 IF(ITTY.NE.LULOG) GO TO 125 110 IPT=IPTT RETURN 125 ITTY=LULOG GO TO 300 150 CALL NAMR(ISTK(IPT+1),ICMND,80,ISTRC) ISTK4=IAND(ISTK(IPT+4),3) 175 IF(ISTK4.NE.1.OR.ISTK(IPT+1).LT.0) GO TO 180 ISTK(IPT+1)=LUTRU(ISTK(IPT+1)) IF(ISTK(IPT+1).LT.0) GO TO 975 180 IF(ITTY.EQ.ISTK(IPT+1).AND.ITTY.LE.255) GO TO 400 ITTY=ISTK(IPT+1) C IF(ITTY.EQ.0.AND.ISTK4.EQ.1) GO TO 975 C IF ZERO OR NEGATIVE THEN BACK UP STACK C IF(ITTY.LE.0) GO TO 600 C C IS THERE ROOM ON STACK C IF(IPT.GE.80) GO TO 950 C C IF LU IS IT LEGAL C IF(ITTY.GT.255.AND.ISTK4.NE.3) GO TO 9WÝ������þú00 ISTK(IPT+4)=1 300 IF(ITTY.LE.255) GO TO 350 IF(ISTK(IPT+5).EQ.0) ISTK(IPT+5)=-31178 CALL OPEN(ITDCB,IERR,ISTK(IPT+1),0,ISTK(IPT+5),ISTK(IPT+6)) IF(IERR.LT.0) GO TO 999 IF(ISTK(IPT+4).EQ.1) GO TO 400 CALL APOSN(ITDCB,IERR,ISTK(IPT+4),ISTK(IPT+7),ISTK(IPT+8)) IF(IERR.LT.0) GO TO 999 GO TO 400 C C UNLOCK LU C 350 CALL LURQ(70000B,LU2,1) GO TO 360 355 CONTINUE C C LOCK LU C 360 CALL ACLCK(ITTY,IERR) IF(IERR.NE.0) GO TO 999 C C PARSE FOR LIST FILE OR LU C 400 IF(ITTY.LT.0) GO TO 975 410 CALL NAMR(IPBUF,ICMND,80,ISTRC) C C IF NULL NO CHANGE C ITY=IAND(IPBUF(4),3) IF(ITY.EQ.0) GO TO 500 IF(LLIST.GT.255) GO TO 440 LU2(1)=IOR(LLIST,100000B) CALL LURQ(70000B,LU2,1) GO TO 445 430 CONTINUE GO TO 445 C C CLOSE UNCONDITIONALLY C 440 CALL ACCLS(LLDCB,3) 445 LLIST=IPBUF(1) IF(IPBUF(1).EQ.0) GO TO 500 IF(ITY.NE.3) GO TO 450 C C SAVE LOGICAL LIST FILE NAME C LLST1=IPBUF(1) LLST2=IPBUF(2) LLST3=IPBUF(3) LLST4=IPBUF(6) C C SET TYPE AND SIZE C IF(IPBUF(7).LT.3) IPBUF(7)=3 IF(IPBUF(8).EQ.0) IPBUF(8)=24 C C IF FILE OPEN IT C C TEST AGAINST CURRENT INPUTS C CALL ACTIN(IPBUF,IERR) IF(IERR.NE.0) GO TO 500 CALL ACROP(LLDCB,IERR,IPBUF,0,IPBUF(5),IPBUF(6) 1 ,IPBUF(8),IPBUF(7)) IF(IERR.LT.0) GO TO 998 GO TO 500 450 IF(IPBUF(1).LE.0.OR.IPBUF(1).GT.255) GO TO 980 C C LOCK LU C LLST=LUTRU(LLIST) LLIST=0 IECH=IECHO IECHO=1 IF(LLST.LT.0) GO TO 975 CALL ACLCK(LLST,IERR) IECHO=IECH IF(IERR.NE.0) GO TO 998 LLIST=LLST C C PARSE FOR ECHO C 500 CALL NAMR(IPBUF,ICMND,80,ISTRC) IF(IPBUF(1).EQ.2HEC) IECHO=1 IF(IPBUF(1).EQ.2HNO) IECHO=0 IF(IERR.GT.0) IERR=0 RETURN C C ÛZ����� BACK UP STACK C 600 IF(ITTY.EQ.0) ITTY=-1 IPT=IPT-8+ITTY*8 IF(IPT.LT.0) IPT=0 IPTT=IPT ITTY=ISTK(IPT+1) GO TO 300 C C ACERRS 900 IERR=-222 GO TO 999 950 IERR=13 GO TO 999 975 IERR=12 GO TO 999 980 IERR=-222 998 LLIST=0 999 IPT=IPTT RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ûj������ÿÿ����� ���� ÿý�k�s ���������ÿ��92067-18417 1940� S C0122 �&ACTIN �ACCTS TEST INPUT NAM RS � � � � � � � � � � � � �H0101 V�����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18417 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C THIS ROUTINE TESTS A NAMR IN IPBUF AGAINST C THE CURRENT INPUT FILES IN THE TRANSFER STACK C C SUBROUTINE ACTIN(IPBUF,IERR) ,92067-16361 REV.1940 781024 COMMON /ACOMB /ISTK(90),IPT DIMENSION IPBUF(11) IERR=0 C C TEST ALL NAMRS IN STACK C DO 200 I=1,IPT+7,8 DO 100 J=1,3 IF(IPBUF(J).NE.ISTK(I+J-1)) GO TO 200 100 CONTINUE ICR=IPBUF(6) IF(ICR.EQ.0.OR.ICR.EQ.ISTK(I+5)) GO TO 300 200 CONTINUE C C NO MATCH RETURN C RETURN C C FOUND MATCH C 300 IERR=-215 RETURN END ��������������������������������������������������������������������������������������������������������������Ù������ÿÿ����� ���� ÿý�l�r ���������ÿ��92067-18418 1940� S C0122 �&ACWRI �ACCTS WRITE TO INPUT DEV � � � � � � � � � � � � �H0101 ?]�����þúFTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SOURCE PART NUMBER :92067-18418 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C C ACWRI - ROUTINE TO WRITE TO THE INPUT DEVICE C C CALLING SEQUENCE: CALL ACWRI(IBUF,ILEN) C WHERE C IBUF = BUFFER TO WRITE C ILEN = BUFFER LENGTH (WORDS) C IF ILEN<0 ECHO CALL FROM ACREI C C SUBROUTINE ACWRI(IBUF,ILEN) ,92067-16361 REV.1940 781024 COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) COMMON /ACOMC/ IECHO,LU LOGICAL XFTTY DIMENSION IBUF(40) DIMENSION ITTY2(2),LU2(2) DATA ID0 /0 / DATA ITTY2,LU2 /0,0,0,0 / C C IF ECHO CALL FROM ACREI C THEN BYPASS FIRST WRITE C ITTY2(1)=IOR(ITTY,100000B) ISAVE=IBUF(ID0) IBUF(ID0)=2H * IF(ILEN.GT.0) GO TO 50 ILEN=-ILEN IBUF(ID0)=2H GO TO 75 C C IF INTERACTIVE AND A LU THEN PRINT C 50 IF(ITTY.GT.0.AND.ITTY.LE.255.AND.XFTTY(ITTY2)) 1 CALL XLUEX(2,ITTY2,IBUF,ILEN) C C IF THERE IS A LIST FILE OR LU C THE WRITE TO IT C 75 IF(LLIST.LE.0) GO TO 200 IF(LLIST.LE.255) GO TO 100 C C WRITE TO FILE CALL WRITF(LLDCB,IERR,IBUF(ID0),ILEN+1) GO TO 200 C C WRITE TO LIST LU C 100 LU2(1)=IOR(LLIST,100000B) CALL XLUEX(2,LU2,IBUF(ID0),ILEN+1) C C IF ECHOING AND NOT SAME AS ITTY C THEN ECHO C 200 LU2(1)=IOR(LU,100000B) IF(IECHO.EQ.1.AND.LU.NE.ITTY) CALL XLUEX(2,LU2,IBUF,ILÉ��� �� EN) IBUF(ID0)=ISAVE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������K ������ÿÿ����� ���� ÿý�m�t ���������ÿ��92067-18419 2001� S C0122 �&ACSES �ACCTS SESSION UP DOWN � � � � � � � � � � � � �H0101 =ñ�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER :92067-18419 * * RELOCATABLE PART NUMBER : 92067-16363 * * PROGRAMER(S) : J.M.N. * * * * * ACSES SHUTS DOWN OR RESTARTS * THE SESSION SYSTEM SO THAT * ACCOUNTS CAN BUILD A NEW * ACCOUNT FILE (+@CCT!:-31178:-2 * * CALLING SEQUENCE* * *C SHUT DOWN *C * CALL ACSES(-2) * * * * RESTART SESSION * * CALL ACSES(0) * NAM ACSES,7 92067-16363 REV.2001 791020 ENT ACSES,LMES,KSPCR,ACFST EXT EXEC,.ENTR,$LIBR,$LIBX EXT $DSCS,$LGOF,$LGON EXT $LMES,$SPCR,$CL1,$CL2 * IDS1 NOP ACSES NOP JSB .ENTR DEF IDS1 * LDA IDS1,I JSB $LIBR NOP GO PRIVILEGED XSA $DSCS+1 JSB $LIBX DEF *+1 DEF *+1 LDB SNAB SZA IF ZERO A RESTART LDB QSCHD STB SCHDT XLA $DSCS+0 SSA IF $DSCS NEGATIVE JUST RETURN JMP ACSES,I * * * THEN IT IS A SHUT DOWN CALL * * DO CLASS WRITE/READ TO SHUT DOWN LOGON & LGOFF * * * XLA $LGON+0 LDB LOGON SHUT DOWN LOGON JSB CLASS * XLA $LGOF+0 LDB LGOFF SHUT DOWN LGOFF JSB CLASS * JMP ACSES,I FINISHED * * * * CLASS WRITE/READ CALL * CLASS NOP SZA,RSS JMP CLASS,I STA ICLAS STUFF CLASS # STB NAME SET PROGRAM NAME LDA IDS1,I SZA,RSS IF ZERO THIS IS START UP JMP RTRN2 LDA M2 STA CNT * CLAS1 JSB EXEC SEND SHUÖ¯������þúT DOWN MESSAGE DEF RTRN1 DEF D20I DEF D0 DEF IDUM DEF D0 DEF SC DEF M1 DEF ICLAS RTRN1 NOP ISZ CNT JMP CLAS1 SEND SHUT DOWN TWICE * RTRN2 JSB SCHD JMP CLASS,I AND RETURN * * PROGRAM SCHEDULE * SCHD NOP SCHD0 JSB EXEC DEF RTRN3 DEF SCHDT NAME BSS 1 RTRN3 JMP SCHD,I RETURN ON ABORT FOR SCHED AND B17 IOR IDS1,I IF QUEUE SCHEDULE OR SZA NOT DORMANT JMP SCHD,I RETURN * JSB EXEC ELSE WAIT 2 SEC DEF RTRN4 AND TRY AGAIN DEF D12 DEF D0 DEF D2 DEF D0 DEF M2 RTRN4 JMP SCHD0 GO TRY AGAIN * D0 DEC 0 * D20I OCT 100024 A EQU 0 B EQU 1 SNAB OCT 100012 QSCHD OCT 100027 M1 DEC -1 M2 DEC -2 LOGON DEF *+1 ASC 3,LOGON LGOFF DEF *+1 ASC 3,LGOFF SC DEC -31178 ICLAS BSS 1 IDUM BSS 1 SCHDT BSS 1 * * * * * LMES PUTS THE PROMPT STRING INTO MEMORY * STARTING AT $LMES * * CALLING SEQUENCE: * CALL LMES(ICNT,IPRMPT,IDSC1) *C *C WHERE ICNT IS NEGATIVE NUMBER OF CHARS IN STRING *C IPRMPT IS 10 WORD PROMPT STRING *C IDSC1 IS VALUE TO BE PUT IN $DSCS+1 * JBCNT NOP JBUF NOP IDSC1 NOP LMES NOP JSB .ENTR DEF JBCNT * LDB LMESS ADDRESS OF $LMES LDA DM11 SET UP WORD COUNT STA CNT JSB $LIBR NOP LDA JBCNT,I GET BYTE COUNT LOOP8 XSA B,I STUF INTO LMESS LDA JBUF,I FETCH TWO CHARS ISZ JBUF INB ISZ CNT JMP LOOP8 * LDA IDSC1,I STUFF $DSCS+1 XSA $DSCS+1 JSB $LIBX DEF LMES * LMESS DEF $LMES+0 DM11 DEC -11 CNT BSS 1 * * KSPCR FETCHES $SPCR * * CALLING SEQUENCE: * I=KSPCR(IDUM) * WHERE IDUM IS A DUMMY PARAMETER * KSPCR NOP XLA $SPCR+0 LDB KSPCR,ìÜ����� I JMP B,I * * ACFST READS CARTRIDGE LIST * CALLING SEQUENCE: * CALL ACFST(MBUF) * WHERE: MBUF IS A 256 WORD BUFFER * MBUF NOP ACFST NOP JSB .ENTR DEF MBUF * JSB EXEC GO READ CARTRIDGE LIST DEF ACFRT DEF D1 DEF D2 DEF MBUF,I DEF D256 DEF $CL1 DEF $CL2 ACFRT LDA DM64 SETLOOP COUNTER STA CNT LDB MBUF ADB D3 ACFLP LDA B,I GET ID VALUE AND B7777 MASK STA B,I ADB D4 ISZ CNT JMP ACFLP JMP ACFST,I RETURN * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D12 DEC 12 B17 OCT 17 B7777 OCT 7777 DM64 DEC -64 D256 DEC 256 END ����������2������ÿÿ����� ���� ÿý�n�v ���������ÿ��92067-18420 1940� S C0122 �&IFBNR �ACCTS IF DEVICE BINARY � � � � � � � � � � � � �H0101 �����FTN4,L C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C THIS ROUTINE DEACTRM INES IF LU CAN HANDLE BINARY DATA C C IRW=0 IF BOTH REA AND WRITE C IRW=1 IF READING C IRW=2 IF WRITING C IRW=3 IF BINARY C LOGICAL FUNCTION IFBNR(IRW,LU) 1 ,92067-16361 REV.1940 790104 DIMENSION LU2(2) C C SOURCE PART NUMBER : 92067-18420 C C RELOCATABLE PART NUMBER : 92067-16361 C C PROGRAMER(S) : J.M.N. C C C GET DRIVER STATUS C LU2(1)=IOR(LU,100000B) LU2(2)=600B CALL XLUEX(100003B,LU2,IEQ5,IEQ4) GO TO 100 80 LU2(2)=0 CALL XLUEX(100015B,LU2,IEQ5,IEQ4) GO TO 100 90 IDVRT=IAND(IEQ5,37400B)/256 ISTAT=IAND(4,IEQ5) IUNIT=IAND(IEQ4,3700B)/64 IF(IAND(IRW,IDVRT).NE.0.AND.IDVRT.LE.2) GO TO 300 IF(IDVRT.EQ.5.AND.(IUNIT.EQ.2.OR.IUNIT.EQ.1)) GO TO 200 IF(IDVRT.EQ.22B.OR.IDVRT.EQ.23B) GO TO 200 100 IFBNR=.FALSE. RETURN C C LU OK FOR THE BINARY IO C C CHECK FOR WRITE PROTECT ON DVR 5,22,23 C 200 IF((IRW.EQ.0.OR.IRW.EQ.2).AND.ISTAT.EQ.4) GO TO 100 300 IFBNR=.TRUE. RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������·i������ÿÿ����� ���� ÿý�o�u ���������ÿ��92067-18421 1940� S C0122 �&MBYTE �ACCTS GET UPPER BYTE � � � � � � � � � � � � �H0101 ?Ä�����ASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18421 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * * * MBYTE,LBYTE * FORTRAN CALLABLE SUBROUTINE * TO GET UPPER BYTE (MBYTE) OR * LOWER BYTE (LBYTE) OF THE * PASSED PARAMETER. * * CALLING SEQUENCE: * IUPPER=MBYTE(IWORD) * ILOWER=LBYTE(IWORD) * NAM MBYTE,7 92067-16361 REV.1940 780822 ENT MBYTE,LBYTE * MBYTE NOP DLD MBYTE,I GET RETURN ADDRESS LDB B,I AND PARAMETER BLF,BLF SWAP BYTES JMP BYTE * LBYTE NOP DLD LBYTE,I GET RETURN ADDRESS LDB B,I AND PARAMETER BYTE SWP AND B377 JMP B,I B377 OCT 377 B EQU 1 END ��������������������������������������������������������������������������������Ý!������ÿÿ����� ���� ÿý�p�v ���������ÿ��92067-18422 1940� S C0122 �&IVBUF �ACCTS TREAT FILE LIKE ME � � � � � � � � � � � � �H0101 gï�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18422 * * RELOCATABLE PART NUMBER : 92067-16361 * * PROGRAMER(S) : J.M.N. * * NAM IVBUF,7 92067-16361 REV.1940 781010 ENT IVBUF EXT READF,WRITF,ACOM1 * * VIRTUAL MEMORY ROUTINE FOR +@CCT!::-31178 * IN NDCB BUFFER IN NBUF OF COMMON /ACOM1/ * * CALLING SEQUENCE: *C FETCH VALUE FROM FILE * IVAL=IVBUF(INDEX,IREC) * *C STORE VALUE IN FILE * CALL IVBUF(INDEX,IREC,IVAL) * *C POST MEMORY TO DISC * CALL IVBUF * * WHERE: INDEX IS INDEX INTO FILE STARTING * FROM RECORD "IREC" * IREC IS STARTING RECORD FOR VIRTUAL * BUFFER (128 WORDS / RECORD) * * IVAL IS VALUE BEING FETCHED OR STORED * IVBUF NOP CLA CLEAR NEW RECORD NUMBER STA IRECN LDA IVBUF,I GET RETURN ADDRESS STA RTRN ISZ IVBUF CPA IVBUF IF NO PARMAMETERS IT IS A POST JMP WRITE * LDB IVBUF,I FETCH INDEX ADDRESS CCA OFSET FOR FORTRAN ADA B,I THEN THE VALUE LDB A AND B177 STRIP OFF OFFSET IN RECORD STA OFSET XOR B GET RECORD NUMBER ALF,ALF RAL (9 TO LEFT =7 TO THE RIGHT) ISZ IVBUF LDB IVBUF,I ADA B,I ADD STARTING RECORD NUMBER * IS IT IN MEMORY CPA IREC1 JMP REC1 YES IN FIRST BUFFER CPA IREC2 JMP REC2 YES IN SECOND BUFFER * STA IRECN NO TËp��� �� HEN POST FIRST BUFFER WRITE LDA IREC1 IF PREVIOUSLY SET UP SZA,RSS JMP READ * LDA WRFL1 SZA,RSS HAS IT BEEN WRITTEN IN JMP READ NO SKIP WRITF * JSB WRITF WRITE TO FILE DEF *+6 DEF ACOM1+0 DEF IERR BUF1 DEF ACOM1+272 DEF D128 DEF IREC1 * * MOVE POINTERS OF BUFFER #2 TO BUFFER #1 * READ LDA BUF2 LDB BUF1 STA BUF1 STB BUF2 LDA IREC2 STA IREC1 LDA WRFL2 WRITE FLAG STA WRFL1 CLA STA WRFL2 LDA IRECN STA IREC2 SZA,RSS IF IRECN =0 THEN IT IS A POST JMP WRIT2 * JSB READF READ FROM FILE DEF *+7 DEF ACOM1+0 DEF IERR BUF2 DEF ACOM1+272+128 DEF D128 DEF LEN DEF IREC2 * REC2 LDB BUF2 COMPUTE MEMORY ADDRESS LDA WRF2A JMP REC REC1 LDB BUF1 LDA WRF1A REC STA WRFLA ADB OFSET ISZ IVBUF LDA IVBUF IS IT A STORE CPA RTRN JMP ACLOA LDA IVBUF,I YES GET ADDRESS OF VALUE LDA A,I AND THEN VALUE STA B,I PUT IN VIRTUAL BUFFER * CCA STA WRFLA,I SET WRITTEN INTO FLAG JMP RTRN,I * ACLOA LDA B,I FETCH VALUE FROM VIRTUAL BUFFER JMP RTRN,I * WRIT2 LDA IREC1 SZA IF NOTHING IN BUFFER 1 JMP WRITE+1 JMP RTRN,I THEN NOTHING TO POST * A EQU 0 B EQU 1 * WRF1A DEF WRFL1 WRF2A DEF WRFL2 WRFLA BSS 1 WRFL1 BSS 1 WRFL2 BSS 1 IREC1 NOP IREC2 NOP IRECN NOP B177 OCT 177 D128 DEC 128 OFSET BSS 1 IERR BSS 1 RTRN BSS 1 LEN BSS 1 END * LDA IVBUF CPA RTRN ������������Aê ������ÿÿ����� ���� ÿý�q�x ���������ÿ��92067-18423 1926� S C0122 �&FESSN � � � � � � � � � � � � � �H0101 —�����þúASMB,R,L,C HED "FESSN" ROUTINE TO FIND IF IN SESSION MODE * NAME: FESSN * SOURCE: 92067-18423 * RELOC: 92067-18423 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FESSN,7 92067-18423 REV.1926 790504 ENT FESSN EXT .ENTR,$SMID,$SMDL SPC 1 * * ROUTINE TO DETERMINE IF A PROGRAM IS IN SESSION MODE * * CALLING SEQUENCE: JSB FESSN * DEF *+2 * DEF ADSCB ADDRESS OF SCB * DEF INSES INSES=1 NOT IN SESSION * INSES=0 IN SESSION * DEF SMID OFFSET TO USER ID WRD IN SCB * <RETURN> * * METHOD: THIS ROUTINE EXAMINES ID SEGMENT WORD 33 (SESSION WORD). * IF NEGATIVE OR ZERO, THE PROGRAM IS NOT IN SESSION, * OTHERWISE THE PROGRAM IS IN SESSION MODE. * SPC 1 ADSCB NOP RETURN ADDRESS OF SCB, IF IN SESSION INSES NOP SMID NOP SMDL NOP FESSN NOP ENTRY JSB .ENTR GET PARAMETER ADDRESS DEF ADSCB CURRENT EXECUTING PROGRAM LDB XEQT GET ID SEGMENT ADDRESS ADB .32 OFFSET TO ID SEGMENT SESSION WORD XLB B,I GET CONTENTS OF SESSION WORD CCE,SSB,RSS POSITIVE? SZB,RSS ZERO? RSS WAS NEGATIVE OR ZERO, SO NON-SESSION CLE IN SESSION, RETURN E=0 STB ADSCB,I CLA SEZ LDA N1 NONSESSION INSES=-1 STA INSES,I IN SESSION INSES=0 XLA $SMID STA SMID,I XLA $SMDL STA SMDL,I JMP FESSN,I Â^��� ��  RETURN SPC 1 B EQU 1 .32 DEC 32 N1 DEC -1 XEQT EQU 1717B ID SEG. ADDRESS OF CURRENT PROG. END ����������������������������������������������������������������������������������������������������������������������������������¶T ������ÿÿ����� ���� ÿý�r�y ���������ÿ��92067-18424 1903� S C0122 �&NMCHK � � � � � � � � � � � � � �H0101 }‰�����þúASMB,R,L,C * * NAME: NMCHK * SOURCE: 92067-18424 * RELOC: 92067-16104 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM NMCHK,6 92067-16104 REV.1903 790203 ENT NMCHK EXT $LIBR,$LIBX,.ENTP NAME NOP ADDRESS OF THE NAME NMCHK NOP ENTRY POINT JSB $LIBR PRIVILEDGE NOP JSB .ENTP GET THE PRAMS DEF NAME LDB N6 SET TO CHECK STB COUNT 6 CHARACTERS LDB NAME RBL LDA NAME,I DO SPECIAL EXTRA CHECK ALF,CLE,ALF ON AND B377 FIRST CHARACTER ADA N60B IF NUMERIC OR BLANK SEZ,CME THEN ADA N10 TAKE SEZ THE CPA N20B ERR JMP ER15 EXIT CREA1 CLE,ERB GET THE NAME ADDRESS LDA B,I GET A NAME WORD ELB RESTORE ADDRESS FOR NEXT TIME SLB,INB,RSS INCREMENT SKIP IF ODD ELSE ALF,ALF ROTATE AND B377 MASK IT CPA COLON IF COLON CLA FORCE ERROR ADA N40B BETWEEN " " SZA,RSS IF BLANK THEN JMP BLNK TAKE NOTE SEZ,CME AND ADA N13B "*" SEZ,CLE,RSS INCLUSIVE? JMP CREA2 YES - OK ADA N3 NO BETWEEN SEZ,CME "." AND ADA N62B "-" CREA2 ISZ NAME CHARACTER AFTER BLANK?? SEZ NO LEGAL OTHERWISE? JMP ER15 NO GO TAKE ERROR EXIT CREA3 ISZ COUNT DONE? JMP CREA1 NO DO NEXT CHARACTEá–��� �� R CLA,RSS GOOD NAME EXIT ER15 LDA N15 ERROR EXIT JSB $LIBX DEF NMCHK BLNK CCA SET BLANK FLAG STA NAME SO WE CAN DETECT JMP CREA3 INBEDDED BLANKS COUNT NOP COLON OCT 72 N62B OCT -62 N3 DEC -3 N13B OCT -13 N40B OCT -40 B377 OCT 377 N20B OCT -20 N60B OCT -60 N6 DEC -6 N10 DEC -10 N15 DEC -15 A EQU 0 B EQU 1 END ����������������������������������������������������������������������������`% ������ÿÿ����� ���� ÿý�s�z ���������ÿ��92067-18425 2013� S C0122 �&GASPH �GASP HEADER � � � � � � � � � � � � �H0101 RE�����ASMB,R,L * NAME: GASPH * SOURCE: 92067-18425 * RELOC: 92067-16425 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASPH,7 92067-16425 REV.2013 800102 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������µÏ������ÿÿ����� ���� ÿý�t�z ���������ÿ��92067-18426 1903� S C0122 �&GASP � � � � � � � � � � � � � �H0101 {g�����þú SPL,L,O ! NAME: GASP ! SOURCE: 92067-18426 ! RELOC: 92067-16425 ! PGMR: A.M.G. ! MOD FOR RTE 4 : C.M.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME GASP(3,80) "92067-16425 REV.1903 790628" ! ! LET G1ERP, \ERROR REPORT SUB. G1OMS, \OUTPUT MESSAGE SUB. G1ZAP, \ZERO A 16 WORD BUFFER G1IMS, \INPUT AND PARSE COMMAND/ANS G1RD, \READ RECORD SUB. G1OPN, \RESTORE A DCB SUB. G1WFI, \WRITE WRECORD ON CURRENT DCB G1CAP, \GET USER & PRIV CAP, USER ACCT# G1CHK \CHECK USER CAPABILITY BE SUBROUTINE ! LET ERTS \ERROR TEST SUB. BE SUBROUTINE,DIRECT LET KCVT, \CONVERT 2 DIGIT TO ASCII LOGLU, \GET USER TTY FUNCTION ICAPS, \GET USER CAPABILITY LUTRU \GET TRUE SYSTEM LU BE FUNCTION,EXTERNAL LET .CACT \GET USER ACCOUNT # BE FUNCTION,EXTERNAL,DIRECT LET POST, \FILE POST SUB. CREAT, \CREAT FILE SUB. OPEN, \OPEN FILE SUB. CLOSE, \CLOø‹������þúSE FILE SUB. POSNT, \POSITION FILE SUB. READF, \FILE READ ROUTINE WRITF, \FILE WRITE ROUTINE PARSE, \SYSTEM PARSE ROUTINE RNRQ, \RESOURCE MANAGEMENT ROUTINE. REIO, \SYSTEM I-O ROUTINE. PTERR, \SESSION POST ERROR ROUTINE RMPAR, \GET PARAMETERS EXEC, \GUESS WHO. \ \ FOLLOWING ARE LOCAL TO GASP PROGRAM \ G1ROT, \COMMAND ROUTER (DISPATCHER) G1CEX \EXIT COMMAND PROCESSOR BE SUBROUTINE,EXTERNAL LET ST.LU, \ROUTINE TO SET UP THE LUAV TBL. G1PCR \TO POST SPOOL CR TO $SPCR BE SUBROUTINE,DIRECT,EXTERNAL LET G0INT, \" GASP: IRRECOVERABLE INIT..." G0END, \"END GASP" OVRD. \ BE INTEGER,EXTERNAL ! ASSEMBLE ["EXT $SPOK"] ! LET G0NRD,G0CHR,G0CAP,G0ACT \STNG LNGTH FLG,#CHARS,CAP,ACCT# BE INTEGER,GLOBAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER(3),GLOBAL LET PRMPT BE INTEGER(2) LET JODCB,SPDCB BE INTEGER(16) !DO NOT REARRANGE THESE TWO LET G0DCB BE INTEGER(144),GLOBAL !LINES LET SIZE,SIZE1 BE INTEGER LET ERRS BE INTEGER(3) LET SIGN,ERRNO,SSPOL,SP.OK BE INTEGER LET NSPL,IERR,SAVE,SAVE1,SAVE2 BE INTEGER LET WRN,IRN,ICNWD,CHARS,FFILE,ADDR BE INTEGER LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,GLOBAL LET G0WD4 BE INTEGER(2),GLOBAL LET G0WD6,G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,GLOBAL N������þú LET G0W12 BE INTEGER(2) LET G0W14 BE INTEGER,GLOBAL LET G0W15 BE INTEGER,GLOBAL LET G0W16(110) BE INTEGER LET PBFN2,PBFN1 BE INTEGER LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4 BE INTEGER LET BUFX5 BE INTEGER(9) LET BUX14 BE INTEGER LET BUX15 BE INTEGER(17) LET G0PBX,G0PX1(7) BE INTEGER !RU,GASP GO HERE LET G0PBF BE INTEGER,GLOBAL LET G0P1V,G0NPF BE INTEGER,GLOBAL !COMMAND AND NO PRINT FLAG LET PARS1 BE INTEGER(2) LET G0P2V BE INTEGER,GLOBAL LET G0P14,G0P15,PARS2(16),PARMS,PARS3(7) BE INTEGER LET G0NOP BE INTEGER,GLOBAL LET G0SDN,G0JDN BE INTEGER,GLOBAL LET G0TTY,G0RDS,G0ERH,G0NPR BE INTEGER,GLOBAL ! INITIALIZE PRMPT TO 1,57137K INITIALIZE G0RDS TO 0 INITIALIZE G0NPF TO 0 INITIALIZE G0EXN TO "EXTND" INITIALIZE G0JBF TO "JOBFIL" INITIALIZE G0SPF TO "SPLCON" INITIALIZE ERRS,SIGN TO 4,"GASP " ! LET CNWD BE CONSTANT(400K) LET E BE CONSTANT(42440K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! GASP: CALL EXEC(22,2);SAVE1 _ $$1 CALL RMPAR(G0BUF) !GET THE PARAMETERS G0CAP _ 0 IF G0BUF = -63 THEN G0CAP _ 63 !IF CAP PASSED BY ACCTS SET IT IF SAVE1 > 20000K THEN SAVE1_0 !IF ASCII THEN NO LU GIVEN IFNOT [G0TTY _ (SAVE1 AND 77K)] THEN G0TTY _ LOGLU(G0TTY) G0TTY _ G0TTY + CNWD !SAVEG0TTY. CALL EXEC(14,1,G0BUF,-32) !GET THE RUN STRING IF ANY G0NRD _ .B. !GET THE CHAR COUNT OVRD._OVRD. OR 20000K !SET TO SEARCH ONLY SYS. DISCS ASSEMBLE ["EXT $SPCR";"XLA $SPCR";"STA SPCR"]!GET SPOOL CR IF [X_SPCR] THEN GOTO FCHEK CALL ST.LU !SET UP $LUAV AND CS43. FCHEK: CALL OPEN(JODCB,IERR,G0JBF,IOPTN,SEC,SPCR)!TRY TO OPEN JOBFIL. CALL ERTS Á{������þú !TEST FOR ERRORS IFNOT X THEN CALL G1PCR(JODCB) !SET UP $SPCR IF FIRST TIME ASSEMBLE ["XLA $SPCR";"STA SPCR"] !RELOAD SPOOL CR IN CASE JUST SET CALL G1ZAP(SPDCB) CALL OPEN(SPDCB,IERR,G0SPF,IOPTN,SEC,SPCR)!NOW TRY SPLCON CALL ERTS !TEST FOR ERRORS CALL G1OPN(G0DCB,IERR,G0JBF) !MOVE THE OPEN DATA CALL G1RD(G0PBX,17) !READ RECORD 17 IF X THEN GOTO RSTRT CALL G1RD(PBUFX,1) !REALLOCATE RN S RNRQ(20K,PBUFX,SAVE) !FOR SPLCON/JOBFIL G0PBX _ PBUFX !TIME THROUGH AFTER RNRQ(20K,G0P14,SAVE) !ALLOCATE HOLD BEM RN. CALL G1WFI(PBUFX,1) !BOOT-UP. CALL G1WFI(G0PBX,17) RSTRT: CALL G1OPN(G0DCB,IERR,G0SPF) !SET TO ACCESS SPLCON IF X THEN GO TO RSTR2 CALL G1RD(PBUFX,1) RNRQ(20K,PBUFX,SAVE) CALL G1WFI(PBUFX,1) RSTR2: CALL G1RD(PBUFX,3) G0SDN_PBUFX;G0JDN_G0P15 !SET THE DOPN FLAGS IF X THEN GO TO GETCD BUFX1 _ G0P14 CALL G1WFI(PBUFX,3) G0BUF _ "DS" !CALL DS TO CLEANUP ON BOOT-UP G0WD1 _ "AL" G0NRD,G0CHR _ 4 !# OF CHARACTERS IN COMMAND G0NPR _ "NP" !SET NO PRINT FLAG CALL PARSE(G0BUF,G0NRD,G0PBF) !PARSE THE RUN STRING IERR,G0RDS _ 0 CALL G1ROT(G0PBF,G0NOP,IERR) !CALL DS ROUTINE CALL G1CEX(-1) !TERMINATE GO TO GETCD !GET COMMAND ON RESTART ! TERM: CALL CLOSE(JODCB,IERR) !CLOSE THE FILE AND CALL CLOSE(SPDCB) EX: CALL EXEC(6) !EXIT ! GETCD: IFNOT G0RDS THEN [ \READ NEXT COMMAND AND CALL G1IMS(PRMPT)] !PARSE, IF NECESSARY. IERR,G0RDS _ 0 G0NPRÂÖ������þú _ G0NPF !SET UP PRINT FLAG CALL G1ROT(G0PBF,G0NOP,IERR) !GO TO PROPER ROUTINE. ERCHK: IF IERR THEN CALL G1ERP(IERR) !REPORT ANY ERRORS IF G0NRD < 0 THEN CALL G1CEX !IF RUN STRNG THEN EXIT G0NPF _ 0 !CLEAR NO PRINT FLAG GO TO GETCD !GO GET THE NEXT COMAND ! ! INIT: IF SAVE1 < 0 THEN GO TO EX !IF NO INPUT UNIT, EXIT. ASSEMBLE ["XLA $SPOK"; "STA SP.OK"] IF SP.OK > 0 THEN[\ !CHECK WHAT ST.LU RETURNED CALL G1OMS(G0INT);GO TO INIT1] !IF 0 OR NEG SEND ERROR G0P1V_60K !SET CODE TO GET TO INIT CALL G1ROT(G0PBF,G0NOP,IERR) !CALL INNITILIZE INIT1: CALL G1OMS(G0END) !SEND END MESSAGE GO TO EX ! ! THE FOLLOWING ROUTINE ZEROES A 16-WORD BUFFER AREA. ! G1ZAP: SUBROUTINE(LOCAT) GLOBAL LET LOCAT BE INTEGER SAVE2 _ @LOCAT - 1 REPEAT 16 TIMES DO [ \ $[SAVE2 _ SAVE2+1] _ 0] RETURN END ! ! THE FOLLOWING ROUTINE GETS THE RESPONSE TO QUESTIONS ! AT INITIALIZATION. ! G1IMS: SUBROUTINE(MESS) GLOBAL LET MESS BE INTEGER IF G0NRD > 0 THEN [ \IF WE HAVE A RUN STRING IF @MESS = @PRMPT THEN[ \AND WE NEED A COMMAND CALL PARSE(G0BUF,G0NRD,G0PBX); \THEN PARSE IT G0NOP _ PARMS - 2; \PARAMETERS IN RUN STRING IF G0PBF > 1 THEN[ \IF IT LOOKS REASONABLE G0CHR,G0NRD_ -G0NRD; \FLAG IT AS THE CURRENT RETURN]]] !COMMAND AND GO DO IT IF G0NRD > 0 THEN G0NRD_0 !CLEAR THE FLAG WORD IF NOT USING SAVE2 _ @MESS + 1 !POINT TO MESSAGE CALL EXEC (2,G0TTY,$SAVE2,MESS) !SEND MESSAGE TO CONSOLE CALL REIO(1,G0TTY,G0BUF,-32) CHARS _ $1 "‡������þú CALL PARSE(G0BUF,CHARS,G0PBF) G0CHR _ CHARS RETURN END ! ! WRITE OUT A MESSAGE ! G1OMS: SUBROUTINE(STRNG) GLOBAL LET STRNG BE INTEGER IF G0NPR = "NP" THEN RETURN SAVE2 _ @STRNG + 1 CALL EXEC(2,G0TTY,$SAVE2,STRNG) RETURN END ! ! READ RECORD NUMR TO RDBF ! G1RD: SUBROUTINE(RDBF,NUMR)GLOBAL CALL READF(G0DCB,IERR,RDBF,16,LOC,NUMR) !READ THE RECORD IF IERR<0 THEN GO TO ERMS RETURN END ! ! ERROR ROUTINE FOR FIRST OPENS ! ERTS: SUBROUTINE DIRECT G0P2V_0 IFNOT IERR+6 THEN GO TO INIT IF IERR= -32 THEN [G0P2V_IERR;GO TO INIT] IF IERR<0 THEN[\ ERMS: CALL G1ERP(IERR);GO TO TERM] RETURN END ! ! THIS OPEN ROUTINE REALLY JUST MOVES IN A SAVED DCB HEADER ! G1OPN: SUBROUTINE(NWDCB,RREI,NAMF) GLOBAL DPT_@NWDCB RREI_2 !ERROR IS ALWAYS TWO IF NAMF = "SP" THEN GO TO SPOPN !IF SPOOL GO DO IT SPT_@JODCB !SET SOURCE POINTER GO TO MVOPN !GO DO THE MOVE ! SPOPN: SPT_@SPDCB ! SET UP FOR SPOOL CON MVOPN: CALL POST(NWDCB,IERR) !POST ANY DATA FOR K_0 TO 15 DO[$(DPT+K)_$(SPT+K)] !MOVE DCB RETURN END ! ! WRITE A RECORD TO A FILE. ! G1WFI: SUBROUTINE(RECD,RNUM) GLOBAL,FEXIT LET RECD,RNUM BE INTEGER CALL WRITF(G0DCB,IERR,RECD,16,RNUM) IF IERR THEN FRETURN RETURN END ! ! PRINT CURRENT ERROR ROUTINE ! G1ERP: SUBROUTINE(BOMNO) GLOBAL SAVE_BOMNO IF BOMNO < 0 THEN [SAVE_ -BOMNO; \IF NEGATIVE SET SIGN SIGN_ 20055K] !TO "-" ERRNO_ KCVT(SAVE) !CONVERT TO ASCII CALL G1OMS(ERRS) !SEND THE MESSAGE ERR2 _ @ERRS + 1 !POINT TO ACTUAL MESSAGE CALL PTERR($ERR2,IDUM) !POST THE ERROR TO THE SCB SIGN _ " " ���*��($ !BLANK THE SIGN AGAIN G0ERH _ BOMNO !KEEP THE HISTORY RETURN !EXIT END ! ! G1CAP: SUBROUTINE(JERR) GLOBAL,FEXIT LET JERR BE INTEGER CALL G1OPN(G0DCB,JERR,G0SPF) !OPEN SPLCON FILE IF JERR THEN FRETURN CALL G1RD(G0BUF,3) !READ THIRD REC OF SPLCON PVCAP _ G0WD2 !PRIVILEGED CAPABILITY CAP _ ICAPS !USER CAPABILITY G0ACT _ .CACT !USER ACCT# IF G0ACT <= 0 THEN [G0ACT _ 0; \IF DETACHED OR NO SESSION CAP _ G0CAP] !ACCT#=0, SET CAP FOR ACCTS PROG RETURN END ! ! G1CHK: SUBROUTINE(KERR) GLOBAL,FEXIT LET KERR BE INTEGER X _ LOGLU(KERR) !GET THE LOGON LU OF USER KERR _ 0 IF G0ACT THEN X _ LUTRU(X) !IF UNDER SESSION, GET TRUE LU IF X = 1 THEN RETURN !IF SYSTEM CONSOLE THEN OK IF CAP < PVCAP THEN [KERR _ 46; \NOT ENOUGH CAPABILITY FRETURN] !ERROR RETURN RETURN END ! ! END GASP END$ ��������������������������������BD*������ÿÿ����� ���� ÿý�u�  ���������ÿ��92067-18427 1903� S C0122 �&G1CEX � � � � � � � � � � � � � �H0101 a�����þú SPL,L,O ! NAME: G1CEX ! SOURCE: 92067-18427 ! RELOC: 92067-16425 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CEX(8) "92067-16425 REV.1903 790206" ! LET CLOSE, \CLOSE FILE SUB. POST, \FLUSH FILE BUFFERS SUB. G1OPN, \LOCAL OPEN SUB. EXEC, \DON'T KNOW WHAT THIS IS PRTN, \PRAMETER RETURN ROUTINE G1OMS, \SEND MESSAGE SUB. RMPAR \GET PARAMETERS BE SUBROUTINE,EXTERNAL ! LET LOGLU \GET TERMINAL LU BE FUNCTION,EXTERNAL LET G1SUB, \SEGMENT FLAG ADDRESS G0JDN, \JOB SHUT DOWN FLAG G0SDN, \SPOOL SHUT DOWN FLAG G0DCB, \MASTER DCB G0TTY, \TERMINAL LU+ECHO G0END, \"GASP END" G0NRD, \INPUT STRING LENGTH G0CAP, \CAPABILITY G0BUF \INPUT BUFFER ADDRESS BE INTEGER,EXTERNAL ! LET G0RTN \RETURN PARAMETER BE INTEGER,GLOBAL G1CEX: SUBROUTINE(N) GLOBAL IF N # -1 THEN CALL G1OMS(G0END) CALL POST(G0DCB) !POST DCB IF Nž��� �� EEDED ! IFNOT G0JDN THEN GO TO EX !IF BOTH ! IFNOT G0SDN THEN GO TO EX !JOB AND SPOOL SHUT CALL G1OPN(G0DCB,I,"JO") !DOWN CLOSE BOTH FILES CALL CLOSE(G0DCB) !AND CALL G1OPN(G0DCB,I,"SP") !DO NORMAL TERM CALL CLOSE(G0DCB) CALL PRTN(G0RTN) !PASS BACK THE FLAG CALL EXEC(6) ! ! SPOOL OR JOB OR BOTH STILL ACTIVE ! SO SAVE RESOURCES AND TERMINATE ! EX: CALL EXEC(22,2) !DON'T SWAP ALL OF MEM G1SUB_0 !CLEAR SEGMENT FLAG CALL PRTN(G0RTN) !PASS BACK THE RETURN FLAG CALL EXEC(6,0,1,0) I_$$1 !GET THE LU CALL RMPAR(G0BUF) !GET PARAMETERS G0CAP _ 0 IF G0BUF = -63 THEN G0CAP _ 63 !CAPABILITY FOR ACCTS PROGRAM IF I > 20000K THEN I_0 !IF ASCII THEN IGNOR IFNOT [G0TTY_(I AND 77K)] THEN G0TTY_LOGLU(I) G0TTY_G0TTY+400K !SET THE ECHO BIT CALL EXEC(14,1,G0BUF,-32) G0NRD_ .B. !GET TURN ON STRING AND SAVE IT RETURN END END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������JÛ ������ÿÿ����� ���� ÿý�v�} ���������ÿ��92067-18428 1903� S C0122 �&ST.LU � � � � � � � � � � � � � �H0101 Œƒ�����þúASMB,R,L HED ST.LU * NAME: ST.LU * SOURCE: 92067-18428 * RELOC: 92067-16425 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ST.LU,8 92067-16425 REV.1903 781010 ENT ST.LU,G1PCR * EXT N.SEQ,$LIBR,$LIBX,$DVMP,$SPOK EXT $LUAV,.DRCT,EXEC,IS43,CS43,$SPCR * * THE FOLLOWING ROUTINE INITIALIZES THE SPOOL * AVAILABILITY TABLE, $LUAV, AND SETS CS43 # 0 * AS A DONE FLAG. * ST.LU NOP CLA ZAP STA INOGO THE VALIDITY FLAG LDA XEQT GET MY ID ADDRESS ADA D14 INDEX TO TYPE WORD LDA A,I PULL IT IN AND M7 KEEP ONLY TYPE CPA D3 IS THIS PROG BG ? RSS YES ISZ INOGO SET AN ERROR FLAG * JSB .DRCT DEF $LUAV GET ADDRESS OF $LUAV. STA ADDR INA STA PTR2 CLA SET COUNTERS AND POINTERS. STA CNTR2 LDA EQTA GET ADDRESS OF WORD 2 OF 1ST EQT. INA STA PTR1 LDA EQTNO SET COUNTER FOR # OF EQT'S CMA,INA TO SEARCH. STA CNTR1 CLB,INB STB NEQT JSB .DRCT GET DIRECT ADDRESS OF DEF IS43 IS43 ENTRY POINT TO SMD. STA SMDAD JSB $LIBR NOP LOOP1 LDA CNTR2 CPA ADDR,I JMP DONE LDA PTR1,I PICK UP EQT2 - DRIVER CPA SMDAD ENTRY POINT. MATCH IS43? JMP SEEK YES. INCR1 ISZ NEQT KEEP LOOKING AT EQT'S. LDA PTR1 ADA D15 INCREMENT TO NEXT EQT. STA PTR1 ISZ CNTR1 JMP LOOP1 * DONE LDA INOGO r ������þúGET THE ERROR FLAG XSA $SPOK AND SAVE IN SSGA SZA WERE THERE ANY ERRORS ? JMP OUT YES, DRIVER NOT IN OUR MAP * LDA CNTR2 STA N.SEQ DONE - SAVE # OF SPOOL EQT'S. CMA,INA,SZA DON'T SAVE IF THERE ARE NONE STA ADDR,I CCA SET CS43 TO STA CS43 -1 TO SHOW DONE OUT JSB $LIBX DEF ST.LU * SEEK CCB GET THE APPROPRIATE DRIVER MAP ENTRY ADB NEQT ADB $DVMP LDA B,I PULL IT IN SSA,RSS IS THE SYS DVR MAP BIT SET ? JMP NOWAY NO. LDA M1K1 GET CORRECT VALUE ? STA B,I AND PUT IT AWAY * CCA NOW SEE IF EQT HAS EXTENTS ADA NEQT MPY D15 ADA EQTA ADA D11 INDEX TO 12 WORD OF THE EXTENT LDA A,I PULL IT IN ADA DM18 SSA OK ? NOWAY ISZ INOGO NO ! * LDA DRT FOUND A SPOOL EQT. STA PTR3 MUST SEARCH DRT TO LDA LUMAX FIND THE CORRESPONDING CMA,INA LU #. STA CNTR3 CLB,INB LOOP2 LDA PTR3,I PICK UP DRT ENTRY. AND B77 GET EQT #. CPA NEQT MATCH THIS ONE? JMP ENTER YES. INB NO - KEEP LOOKING. ISZ PTR3 ISZ CNTR3 JMP LOOP2 JMP INCR1 ENTER STB PTR2,I MAKE AN ENTRY IN $LUAV. ISZ PTR2 CLA STA PTR2,I ISZ PTR2 ISZ CNTR2 JMP INCR1 * SMDAD BSS 1 M1K1 OCT 100001 DM18 DEC -18 INOGO NOP B77 OCT 77 D3 DEC 3 D11 DEC 11 D14 DEC 14 D15 DEC 15 M7 OCT 7 NEQT BSS 1 CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 PTR1 BSS 1 PTR2 BSS 1 PTR3 BSS 1 ADDR BSS 1 EQTA EQU 1650B EQTNO EQU 1651B DRT EQU 1652B LUMAX EQU 1653B XEQT EQU 1717B * * * THE FOLLOWING ROUTINE IS USED TO SETUP AND CLEAR * THE $SPCR FLAG. IT IS ASSUMED THAT THE VALUE * TO BE USED IS THE NEGATIVE OF THE LEj“����� AST 6 BITS * OF THE PASSED PARAMETER. * G1PCR NOP JSB $LIBR MUST BE PRIV TO POKE NOP DATA INTO THE SYSTEM LDA G1PCR,I GET THE VALUE TO SET LDA A,I AND B77 ISOLATE THE 6 BITS CMA,INA SET NEGATIVE XSA $SPCR SET THE WORD ISZ G1PCR SET THE RETURN ADDRESS JSB $LIBX EXIT ALL DONE DEF G1PCR * * A EQU 0 B EQU 1 * END ����������������������������������������������������������������^Ô������ÿÿ����� ���� ÿý�w� ���������ÿ��92067-18429 1940� S C0122 �&G1ROT �GASP COMMAND ROUTER � � � � � � � � � � � � �H0101 ì �����þúASMB,R,L HED G1ROT * NAME: G1ROT * SOURCE: 92067-18429 * RELOC: 92067-16425 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1ROT,8 92067-16425 REV.1940 790802 ENT G1ROT ENT G1SUB ENT G1SEG * * EXT .ENTR EXT EXEC EXT G1CEX * PBUFR NOP PLEN NOP IERR NOP * G1ROT NOP JSB .ENTR DEF PBUFR LDA 1717B GET MAIN NAME ADA D12 AND LDA A,I SET UP SAME SUFFIX STA GASP FOR SEGMENTS LDA G1SUB IF TABLE ADDRESS IS ZERO SZA,RSS THEN STA CSEG ZERO THE SEGMENT PRESENT FLAG LDB PBUFR INB B POINTS TO COMMAND ENTERED LDB B,I GET THE NUMONIC STB G1KLG SAVE IT * LDB BUFAD GET COMMAND TABLE ADDRESS CLA SET SEGMENT FLAG TO MAIN SEGST STA SEGID CLA SET SEGMENT OFFSET TO STA SEGOF ZERO NXTCM INB STEP TABLE ADDRESS LDA B,I GET ENTRY SSA NEGATIVE MEANS NEW SEGMENT JMP SEGST GO SET IT * SZA,RSS ZERO IS END OF LIST JMP G1RT1 ERROR EXIT * CPA G1KLG THIS IT? JMP ITSIT YES GO PROCESS * ISZ SEGOF STEP THE OFFSET JMP NXTCM TRY THE NEXT ONE * ITSIT LDA SEGID GET THE SEGID LDB RTAD SET ADDRESS IN CASE MAIN CMA,INA,SZA,RSS IF ZERO THEN ITS IN THE MAIN JMP MAIN * ADA "0" MAKE IT ASCII ALF,ALF AND ROTATE TO HIGH CPA CSEG CURRENT SEGMENT? JMúž������þúP G1SEG YES GO DO IT * STA CSEG SET NEW SEG NAME JSB EXEC CALL SYSTEM TO LOAD THE SEGMENT DEF G1SEG DEF D8 DEF GASP * G1SEG LDB G1SUB GET RETURNED ADDRESS MAIN ADB SEGOF ADD THE OFFSET LDB B,I GET ENTRY POINT OF SUB. JSB B,I DEF *+4 DEF PBUFR,I DEF PLEN,I DEF IERR,I JMP G1ROT,I * G1RT1 LDA D5 ILLEGAL COMMAND STA IERR,I SET ERROR CODE JMP G1ROT,I AND RETURN * GASP ASC 2,GASP CSEG NOP CURRENT SEGMENT G1SUB NOP CURRENT SEGMENTS ENTRY POINT TABLE ADDRESS D5 DEC 5 D8 DEC 8 D12 DEC 12 SEGID NOP SEGOF NOP * BUFAD DEF * ASC 1,EX OCT -1 FOLLOWING ARE IN SEGMENT 1 ASC 1,DJ ASC 1,CJ ASC 1,DS ASC 1,CS ASC 1,KS ASC 1,RS ASC 1,AB ASC 1,UP OCT -2 FOLLOWING ARE IN SEGMENT 2 ASC 1,DA ASC 1,?? "0" OCT 60 SPECIAL CODE TO GET TO IN ROUTINE ASC 1,SD ASC 1,SU NOP END OF TABLE RTAD DEF *+1 DEF G1CEX MAIN TRANSFER TABLE * ENT G1KLG * EXT $LUAV,.DRCT,G0WD1 * * THIS ROUTINE COUNTS THE NUMBER OF ACTIVE LU'S FOR THE * SPOLCON RECORD NUMBER PASSED BY SCANNING THE LU AVAILABLITY * TABLE ($LUAV) AND RETURNS THIS NUMBER IN THE A REGISTER * * CALLING SEQUENCE: * * JSB G1KLG * DEF RNUM NUMBER OF THE RECORD TO BE FOUND * --- RETURN A SET AS ABOVE * G1KLG NOP LDA $LUAV GET THE COUNT OF ENTRIES STA COUNT JSB .DRCT GET A DIRECT ADDRESS DEF $LUAV OF THE TABLE STA PTR AND SAVE IT CLA CLEAR THE RETURN COUNT STA RTN LDA G1KLG,I GET THE RECORD NUMBER LDA A,I TO LOCAL STA RNUM STORAGE ISZ G1KLG STEP TO THE RETURN ADDRESS * NEXT ISZ PTR STEP TO THE ENTRY LDA PTR,I GET THÍÑ����� E CURRENT LU ISZ PTR STEP TO THE RECORD NUMBER SSA,RSS IF NOT AN ACTIVE ENTRY JMP CONT JUST CONTINUE * LDB PTR,I GET THE ENTRY'S RECORD NUMBER CPB RNUM THIS IT? ISZ RTN YES STEP THE COUNT * CONT ISZ COUNT END OF THE LIST?? JMP NEXT NO TRY NEXT ONE * LDA RTN YES SEND BACK THE COUNT JMP G1KLG,I RETURN SPC 2 PTR NOP RTN NOP RNUM NOP COUNT NOP A EQU 0 B EQU 1 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������x������ÿÿ����� ���� ÿý�x�€ ���������ÿ��92067-18430 1903� S C0122 �&G0QIP � � � � � � � � � � � � � �H0101 ]–�����ASMB,R,Q HED G0QIP * NAME: G0QIP * SOURCE: 92067-18430 * RELOC: 92067-16425 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G0QIP,8 92067-16425 REV.1903 781215 ENT G0PCA,G0NJB,G0NLO,G0SZF,G0NSP ENT G0KIL,G0END,G0MXP,G0SLU,G0INT * SUP G0PCA DEC -49 ASC 25,CAPABILITY LEVEL FOR PRIVILEDGED GASP COMMANDS? _ GUARD G0NJB DEC -35 ASC 18,MAX NUMBER OF JOBS,JOB FILE DISC? _ GUARD G0NLO DEC -33 ASC 17,NUMBER,LOCATION OF SPOOL FILES? _ GUARD G0MXP DEC -48 ASC 20,MAXIMUM NUMBER ACTIVE AND PENDING SPOOL ASC 4,FILES? _ GUARD G0NSP DEC -34 ASC 17,NUMBER OF SPOOL FILES (5 TO 80)? _ GUARD G0SZF DEC -34 ASC 17,SIZE OF SPOOL FILES (IN BLOCKS)? _GUARD G0SLU DEC -31 ASC 16,ENTER OUTSPOOL DESTINATION LU _ GUARD G0END DEC 4 ASC 4,END GASP G0KIL DEC -47 ASC 24,MAY ABORT PROGRAM OR JOB, OK TO KILL ? _ GUARD G0INT DEC -40 ASC 20,/GASP: IRRECOVERABLE INITIALIZE ERROR ! * END ��������������������������������������������������������������������������������������������ú@������ÿÿ����� ���� ÿý�y� ���������ÿ��92067-18431 1940� S C0122 �&GASP1 �GASP SEGMENT 1 � � � � � � � � � � � � �H0101 U‹�����ASMB,R,L HED GASP1 * NAME: GASP1 * SOURCE: 92067-18431 * RELOC: 92067-16425 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP1,5 92067-16425 REV.1940 790802 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP1 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDJ DEF G1CDJ EXT G1CCJ DEF G1CCJ EXT G1CDS DEF G1CDS EXT G1CCS DEF G1CCS EXT G1CKS DEF G1CKS EXT G1CRS DEF G1CRS EXT G1CAB DEF G1CAB EXT G1CUP DEF G1CUP END GASP1 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������j������ÿÿ����� ���� ÿý�z�€ ���������ÿ��92067-18432 1903� S C0122 �&G1CDJ � � � � � � � � � � � � � �H0101 [‚�����þú SPL,L,O ! NAME: G1CDJ ! SOURCE: 92067-18432 ! RELOC: 92067-16425 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDJ(8) "92067-16425 REV.1903 780607" ! LET PRINT \SELECTIVE PRINT ROUTINE BE SUBROUTINE,DIRECT LET G1RDF \LOCAL READ FROM JOBFILE BE SUBROUTINE ! LET G1OMS, \MESSAGE OUTPUT ROUTINE EXEC, \WHAT! AGAIN! G1OPN, \GASP OPEN FILE ROUTINE READF \FILE READ ROUTINE (FMP) BE SUBROUTINE,EXTERNAL ! LET G1U.G \PARSE USER.GROUP ROUTINE BE FUNCTION,EXTERNAL,DIRECT ! LET G1CUG \COMPARE USER.GROUP ROUTINE BE PSEUDO,EXTERNAL,DIRECT ! LET .CACT \ROUTINE TO GET CURRENT ACCT. BE FUNCTION,EXTERNAL,DIRECT LET G1STM, \FORMAT MESSAGE ROUTINE .DFER \MOVE THREE WORDS ROUTINE BE SUBROUTINE,EXTERNAL,DIRECT ! LET G0BUF, \BUFFER FOR READ ROUTINE G0WD1, \WORD 1 OF ABOVE BUFFER G0WD2, \WORD 2 OF ABOVE BUFFER G0WD7, \WORD 7 OF ABOVE BUFFER G0WD8, \WORD 8 OF ABOVE BUFFER b������þú G0WD9, \WORD 9 OF ABOVE BUFFER G0W15, \WORD 15 OF ABOVE BUFFER G0TTY, \TTY LU G0DCB, \DCB FOR FILE ACCESS G0RTN, \# OF JOBS PRINTED (FOR EXIT) G0JBF \JOBFILE REFERENCE FOR OPEN BE INTEGER,EXTERNAL ! LET DOWN(6) BE INTEGER INITIALIZE DOWN TO 5," SHUT DOWN" LET HL,HEAD(10),US(11),SPOOL(3) BE INTEGER INITIALIZE HL,HEAD,US,SPOOL TO \SET UP THE HEAD 24,"JO# NAME STATUS USER.GROUP SPOOLS" LET USER(3) BE INTEGER INITIALIZE USER TO "USER.G" LET NOJO(5) BE INTEGER INITIALIZE NOJO TO 4," NO JOBS" LET SPACE BE REAL INITIALIZE SPACE TO 1," " ! LET CNWD BE CONSTANT(1100K) ! ! ! G1CDJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER BEGIN _ 19 NAM3_[NAM2_[NAM1_[TYP_[AL_@PBUFR+2]+2]+1]+1]+1 ICNWD _ CNWD + G0TTY !SET UP I/O DEVICE. ! ! ! FOR DJ ROUTINE THE FOLLOWING CONVENTIONS HOLD ! ! THE JOB RECORD IS PRINTED IF: ! ! 1) THE COMMAND IS 'DJAL' AND THE JOB NAME MATCHES (IF GIVEN) ! OR ! 2) <USER.GROUP> IS GIVEN AND THE USER MATCHES AND THE JOB NAME MATCHES ! OR ! 3) <USER.GROUP> IS NOT GIVEN AND THE CURRENT USER MATCHES AND THE JOB ! NAME IF GIVEN MATCHES. ! ! NOTE THE THE CURRENT USER IF OUTSIDE OF SESSION IS JOBS OUTSIDE OF SESSION ! THE ONLY WAY TO MIX BOTH SESSION AND NON SESSION JOBS IS WITH ! THE 'DJAL' OPTION. THE <USER.GROUP> MATCH ROUTINE WILL MATCH '@.@' ! WITH ANY SESSION USER BUT NOT WITH USERS OUTSIDE OF SESSION. ! ! ! NOW SET ALL OF THIS UP ! IF [U_G1U.G()] > 0 THEN[ \IF ERROR IN SUPPLIED <U.G> ERR _ 56; \REPORT IT AND������þú RETURN] !EXIT ! IF U < 0 THEN[ \IF NOT SUPPLIED THEN IF [AC _ .CACT()] < 0 THEN AC _ 0]!USE CURRENT USER (0 IF NO SESS) ! U.G_0 !SET DEFAULT U.G FLAG IF $AL = "AL" THEN GO TO U.GF !IF "AL" OPTION OR IFNOT U THEN[ \U.G PROVIDED THEN U.GF: U.G _ 1] !SET THE U.G FLAG ! IF $AL = "NP" THEN GO TO NXPRT !IF NP OPTION SKIP PRINT CALL EXEC(3,ICNWD,-1) ! ! SET UP THE HEAD BASED ON WHAT WE NEED TO PRINT ! IF U.G THEN[ \IF FULL HEAD THEN CALL .DFER(US,USER); \MAKE SURE USER IS RIGHT HL_24], \AND SET THE FULL LENGTH ELSE[ \OTHER WISE SET UP CALL .DFER(US,SPOOL); \THE SHORT HEAD HL_13] CALL G1OMS(HL) !PRINT THE HEAD CALL G1OMS(SPACE) CALL EXEC(3,ICNWD,1) NXPRT: CALL G1OPN(G0DCB,ERR,G0JBF) !OPEN THE JOB FILE IF ERR < 0 THEN RETURN CALL G1RDF(17,ERR)?[RETURN] !GET SPEC RECORD ENDR_G0WD1 !SAVE THE END RECORD G0RTN _ 0 !CLEAR THE RETURN COUNT FLAG ! ! ! IF JOB NUMBER GIVEN THEN ONLY THE GIVEN JOB IS PRINTED ! IF $TYP = 1 THEN[ \IF SO THEN JONO _ 18+$NAM1; \CACULATE THE NUMBER IF JONO > ENDR THEN[ \IF TOO LARGE ERR _ 3; \SET THE ERROR AND RETURN]; \EXIT FLAG _ 2; \SET THE PROPER FLAG CALL PRINT; \AND PRINT THE RECORD GO TO ENDJ] !GO CLEAN UP AND EXIT ! ! ! JOBS ARE PRINTED IN THE ORDER IN WHICH THEY WILL -������þúEXIT THE SYSTEM ! (AS NEAR AS WE CAN TELL) I.E. IN THE FOLLOWING ORDER: ! ! ALL JOBS IN "CS" STATUS ! ALL JOBS IN THE ACTIVE AND WAITING QUQUE ! ALL OTHER JOBS I.E. INPUT, HELD, ECT. ! ! FLAG _ 1 !SET FLAG TO PICK ONLY "CS" JOBS FOR JONO _ 19 TO ENDR DO CALL PRINT !PRINT ALL "CS" JOBS ! ! NOW DO THE JOB QUEUE ! FLAG _ 2 !SET FLAG TO PICK ANY WE GIVE IT AD _ @G0BUF !SET ADDRESS OF THE BUFFER PTR _ 1 !INITIALIZE THE Q POINTER ! QPRNT: CR _ (PTR/16) + 1 !CACULATE THE RECORD NUMBER CAD _ .B. + AD !AND OFFSET IN THE RECORD CALL G1RDF(CR,ERR)?[RETURN] !READ THE Q RECORD JONO_[ PTR _ $CAD AND 377K]+17 !GET THE JOB NUMBER IFNOT PTR THEN GO TO QDONE !IF NONE THEN END OF Q ! CALL PRINT !ELSE PRINT THE RECORD GO TO QPRNT !AND AROUND WE GO QDONE: !END OF Q PRINT ! ! NOW DO JOB OF STATUS OTHER THAN THE ABOVE ! NOTE THAT SINCE WE DID NOT LOCK THE JOBFIL A ! JOB CAN GO BY WITH OUT OUR REPORTING IT. BECAUSE OF THE ORDER ! HOWEVER WE SHOULD NOT REPORT THE SAME JOB TWICE (UNLESS OF ! COURSE SOME OTHER USER IS HOLDING A JOB) ! FLAG _ 3 !SET FLAG TO PRINT OTHERS FOR JONO _ 19 TO ENDR DO CALL PRINT !PRINT THEM OUT ! ! NOW DO THE CLEAN UP WORK ! ENDJ: IF $AL = "NP" THEN RETURN;!IF NO PRINT RETURN IFNOT G0RTN THEN CALL G1OMS(NOJO) !IF NO JOBS SAY SO CALL G1RDF(17,ERR)?[RETURN] IF G0W15 = "D" THEN CALL G1OMS(DOWN) !IF SHUT DOWN SAY SO RETURN END ! ! PRINT ROUTINE A LOT OF THE FILTERING OF JOBS GOES ON HERE. ! ! CALLING CONVENTIONS: ! ! FLAG = 1 PRINT "CS" ONLY ! F©÷������þúLAG = 2 PRINT INDEPENDENTLY OF JOB STATUS ! FLAG = 3 PRINT IF STATUS IS NOT "CS","A",OR "R" ! ! NAM1,NAM2,AND NAM2 POINT AT THE JOB NAME IF $TYP IS 2 ! ! JONO IS THE JOB RECORD NUMBER (JOB # IS JONO-18) ! ! ACCOUNT FLAGS ARE SET I.E. U#0 THEN USER.GROUP CHECK TO BE DONE ! AND IF NOT THEN AC MUST MATCH JOB ACCOUNT FLAG ! IF $AL = "AL" THEN ALL ACCOUNTS ARE TO BE PRINTED. ! ! IN THE CASE OF "AL" OR U > 0 THE ACCOUNT INFO WILL BE ! PRINTED OTHER WISE IT IS NOT. ! PRINT: SUBROUTINE DIRECT CALL G1RDF(JONO,ERR)?[RETURN] !READ THE JOB RECORD IF G0BUF < 0 THEN RETURN !IF NO JOB HERE THEN RETURN ! IF FLAG = 1 THEN[ \IF "CS" SCAN THEN IF G0WD2 # "CS" THEN RETURN, \IF NOT CS RETURN ELSE GO TO NAMCK] ! IF FLAG = 2 THEN GO TO NAMCK !IF NO ST FILTER GO TO NAME CK ! IF G0WD2 = "A" THEN RETURN !FLAG MUST BE 3 SO DO THE TESTS IF G0WD2 = "R" THEN RETURN !FLAG MUST BE 3 SO DO THE TESTS IF G0WD2 ="CS" THEN RETURN !FLAG MUST BE 3 SO DO THE TESTS ! NAMCK: IF $TYP # 2 THEN GO TO U.GTS !IF NO NAME GO TO U.G TESTS ! IF G0WD7 # $NAM1 THEN RETURN !IF NAME DOES NOT MATCH IF G0WD8 # $NAM2 THEN RETURN !THEN JUST EXIT IF G0WD9 # $NAM3 THEN RETURN ! U.GTS: IF $AL = "AL" THEN[ \IF AL OPTION G1CUG()_ G0WD1; \GET ACCOUNT INFO GO TO PRI] !AND THEN GO PRINT IT ! IFNOT U THEN[ \IF USER.GROUP PROVIDED G1CUG(),FAIL _ G0WD1; \CALL G1CUG TO TEST IT IFNOT FAIL THEN GO TO PRI; \IF OK GO PRINT IT RETURN] !ELSE RETURN IF AC # G0WD1 THEN RETURN !IF NOT RIGHT ACCOUNT RETURN ! PRI: CALL G1STM(JONO,U.G) !PRINT THE DATUM GGÚ���$��"0RTN_G0RTN+1 !STEP THE COUNT OF PRINTED RETURN !RETURN ALL DONE END ! ! ! G1RDF: SUBROUTINE(NUM,ERROR) GLOBAL,FEXIT LET NUM,ERROR BE INTEGER CALL READF(G0DCB,ERROR,G0BUF,16,LEN,NUM) IF ERROR THEN FRETURN RETURN END END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Õ/$������ÿÿ����� ���� ÿý�{� † ���������ÿ��92067-18433 1903� S C0122 �&G1CCJ � � � � � � � � � � � � � �H0101 [‚�����þú SPL,L,O ! NAME: G1CCJ ! SOURCE: 92067-18433 ! RELOC: 92067-16425 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CCJ(8) "92067-16425 REV.1903 790621" ! ! LET G1WFI, \GASP WRITE FILE ROUTINE G1OPN, \GASP OPEN FILE ROUTINE EXEC, \WHAT! THIS TURKEY AGAIN?? POST, \FMP FILE POST ROUTINE RNRQ, \SYSTEM RN LOCK ROUTINE G1RDF, \GASP WRITE FILE ROUTINE G1CAP, \GET USER CAP AND ACCT# G1CHK \CHECK USER CAPABILITY BE SUBROUTINE,EXTERNAL ! LET G1CUG \CHECK FOR U.G MATCH ROUTINE BE PSEUDO,EXTERNAL,DIRECT LET G1U.G \PARSE USER.GROUP BE FUNCTION,EXTERNAL,DIRECT ! LET GET.PTR \INTERNAL SUB TO GET JOB PTR BE SUBROUTINE,DIRECT ! ! LET G0BUF, \GASP BUFFER FOR JOB RECORDS G0WD1, \WORD 1 OF ABOVE BUFFER G0WD2, \WORD 2 OF ABOVE BUFFER G0WD7, \WORD 7 OF ABOVE BUFFER G0WD9, \WORD 9 OF ABOVE BUFFER G0DCB, \GASP FILE DCB G0RTN, \RETURN PARAMETER FOR AB ¶9������þú G0CAP, \CAPABILITY G0ACT, \USER ACCOUNT # G0JBF \JOBFIL REFERENT FOR G1OPN BE INTEGER,EXTERNAL ! LET FMGR(3),PAR1,PARS2,PAR2,RSTAT BE INTEGER ! LET IOPTN BE CONSTANT(3) LET SEC BE CONSTANT(123456K) ! INITIALIZE RSTAT TO 0 INITIALIZE FMGR TO "FMGR " LET CHHI BE CONSTANT (44400K) ! ! G1CCJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER PAR2 _ [PARS2 _ [PAR1 _ @PBUFR + 5] \ + 3] + 1 IFNOT $(@PBUFR+4) = 1 THEN [ \ RET1: ERR _ 3; GOTO RETN] CALL G1CAP(ERR)?[GO TO RETN] !GET CAP AND ACCT# FOR USER CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN G1RDF(17,ERR) ? [GOTO RETN] IF [REC_$PAR1+18] > G0WD1 THEN[ \IF BAD JOB NUM EXIT ER3: ERR_3;RETURN] IF $PAR1 <= 0 THEN GO TO ER3 !IF JOB # ILLEGAL SEND ERROR ! JRN _ G0BUF POST(G0DCB) RNRQ(1,JRN,RSTAT) CALL G1RDF(REC,ERR)?[GO TO RETN] IF [NP_G0BUF]<0 THEN [ERR_3;GO TO RETN]!IF NO JOB HERE EXIT IF (G0WD2 = "CS") OR (G0WD2 = "A") THEN [ \ RET2: ERR _ 4; GOTO RETN] ! IF G0WD1 # G0ACT THEN[ \IF NOT CALLERS ACCOUNT CALL G1CHK(ERR)?[GO TO RETN]] !AND NOT CAPABLE, ERROR ! IF PCNT < 0 THEN[ \ABORT REQUEST NP_0; \SET FOR INPUT ABORT IF G0WD2 = "I" THEN GO TO IAB; \IF INPUT OR IF (G0WD2 AND 177400K) = CHHI THEN[ \INPUT A OR H IAB: G0WD2_ "IA";GO TO WRT2]; \SET TO IA G0WD2_ "A";NP_ -G0BUF;GO TO WRT] !ELSE SET TO A ! IFNOT $PARS2 = 1 THEN GOTO CHR IF $PAR2 < 1 THEN GOTO RET1 NP,G0BUF _ $PAR2 AND 377K; GOTO WRT ! ! CHANGE STATUS ! CHR: PAR2_$PAR2 AND 177400K IF PAR2 = 44000K THEN[ Æ&������þú \HOLD REQUEST IFNOT [HI_G0WD2 AND 177400K] THEN \IF NO HIGH STATUS HI_G0WD2*400K; \USE THE LOW STATUS G0WD2_HI+"H";NP_0;GO TO WRT] !SET UP AND EXIT IF PAR2 = 51000K THEN[ \RELEASE REQUEST IF G0WD2 AND 177400K THEN \IF A HIGH STATUS G0WD2_G0WD2/400K; \JUST PUT IT LOW ELSE NOP IF G0WD2 # "R" THEN NP_0; \IF NOT READY DON'T Q IT GO TO WRT] ERR_56 !BAD PRAM SO SEND ERROR CJERR: IF ERR THEN GOTO RETN GOTO RET2 WRT: CALL G1WFI(G0BUF,REC) ? [GOTO RETN] ! ! ROUTINE TO REMOVE A JOB FROM THE JOB Q GIVEN THE RECORD # (REC) ! WE ASSUME JOB IS IN THE Q AND IS NOT ACTIVE ! WR,LR_0 !SET INITIAL POINTERS AD_@G0BUF PTR,JOBAT _ REC - 17 !GET THE POINTER IN THE Q CALL GET.PTR !FOR THE JOB TO BE REMOVED SP_PTR !AND SAVE FOR RE LINKING PTR_1 !START WITH THE HEAD UNTIL PTR=JOBAT DO[ \RUN DOWN THE LIST CALL GET.PTR; \TILL WE FIND A POINTER IFNOT PTR THEN GO TO RE.Q] !IF NOT FOUND EXIT LOOP ! ! WE FOUND IT NOW REMOVE IT ! $CAD_$CAD XOR PTR XOR SP !PUT IN NEW POINTER WR,PTR_1 !SET TO GET THE HEAD AGAIN CALL GET.PTR !GET THE HEAD IF (($CAD -< 8) AND 377K) = JOBAT THEN[\IF JOB WAS NEXT $CAD _ (SP -< 8) +PTR; \THEN UPDATE NEXT PTR WR_1] !SET THE MUST WRITE FLAG RE.Q: !END OF D Q ! IFNOT NP THEN GO TO JRQEX !IF NOT TO BE Q'ED SKIP ! ! THE FOLLOWING QUEUES A JOB IN THE JOB Q BY PRIORITY ! ! THIS ROUTINE REQUIRES THE³o������þú RECORD NUMBER (REC) AND PRIORITY (NP) ! ! JOBS ARE QUEUED IN THE FIRST SEVERAL RECORDS OF JOBFIL. THE ! FORMAT IS AS FOLLOWS: ! ! WORD0 - THE RN # FOR LOCKING THE FILE ! WORD1 - [ NEXT | HEAD ] ! WORD2-127 [PRIORITY | POINTER TO NEXT JOB ] ! ! WHERE: HEAD POINTS AT THE FIRST JOB IN THE Q ! NEXT POINTS AT THE NEXT JOB TO BE RUN. IF NEXT # HEAD THEN ! THE JOBS LINKED BETWEEN HEAD AND NEXT ARE ACTIVE. ! ACTIVE JOBS ARE EITHER RUNNING OR WAITING FOR ! ABORTION. ! PRIORITY IS THE PRIORITY OF THE JOB ! POINTER TO NEXT JOB IS A POINTER (WORD ADDRESS) TO THE NEXT ! ENTRY. IT IS 0 AT THE END OF THE LIST ! ! THE LOCATION IN THE FILE (I.E. WORD#) INDICATES THE JOB RECORD NUMBER ! I.E. REC # = WORD # +17. ! ! LETS BEGIN FIRST PICK UP THE HEAD AND NEXT POINTERS ! PTR_1 !ADDRESS OF HEAD CALL GET.PTR !GET HEAD (IN PTR) NEXT_([HEAD_PTR] XOR $CAD) -< 8 !SAVE HEAD AND NEXT ! ! IF PRORITY IS NEG. THEN WE ARE ABORT LINKING ! IF NP < 0 THEN[ \YES SCAN DOWN TO NEXT UNTIL NEXT = PTR DO CALL GET.PTR; \AND INSERT JUST BEFORE NEXT WR,$CAD _ ($CAD XOR PTR) OR JOBAT;\UP DATE POINTER TO INCLUDE JOB PTR_JOBAT; \NOW ADD THE JOB TO COMPLET LIST CALL GET.PTR; \ WR,$CAD_ 400K+NEXT; \SET PR TO HIGH GO TO JRQEX] !GO WRITE AND EXIT ! ! REINSERT BY PRIORITY ! MUST BE AFTER NEXT BUT IN HEAD LIST SO RUN DOWN HEAD LIST ! UNTIL NEXT = PTR. ! UNTIL NEXT=PTR DO CALL GET.PTR !THERE EASY WASN'T IT? ! ! NOW MUST DO A PRIORITY SEARCH FOR THE INSERT LOCATION ! NEXTQ: IFNOT PTR THEN GO TO QEND !IF END OF LIST PUT ITõ������þú HERE CALL GET.PTR !ELSE GET THE NEXT ENTRY IF (($CAD -< 8) AND 377K) <= NP THEN GO TO NEXTQ !LOOK AT PRIORITY ! ! EITHER END OF LIST OR PRIORITY FOUND ! PTR_LAST !BACK UP TO THE LAST ENTRY CALL GET.PTR !GET LAST ENTRY IN THE LIST QEND: WR,$CAD_($CAD XOR PTR) XOR JOBAT !REPLACE POINTER WITH NEW JOB SP_PTR !SAVE OLD PTR PTR_JOBAT !FETCH THE NEW JOB ENTRY CALL GET.PTR !AND WR,$CAD_(NP -< 8) OR SP !UP DATE IT'S NP AND POINTER ! ! NOW MUST UP DATE THE NEXT POINTER IF WE HAVE A NEW NEXT ! IF NEXT = SP THEN[ \WELL? PTR_1; \YES A NEW NEXT SO UP DATE IT CALL GET.PTR; \FETCH IT FIRST WR,$CAD_(JOBAT -< 8) + PTR] !UPDATE THE WORD ! ! ALL DONE MAKE SURE AND FLUSH THE FINAL RECORD ! JRQEX: IF WR THEN CALL G1WFI(G0BUF,CR) !FLUSH IT OUT GO TO RETN !SKIP WRITE BACK ! WRT2: CALL G1WFI(G0BUF,REC) RETN: IF RSTAT = 2 THEN [POST(G0DCB); \ RNRQ(4,JRN,RSTAT)] IF PCNT<0 THEN GO TO ABT IF PAR2 = 51000K THEN[\ IF GOING ACTIVE OR ABORT THEN ABT: IFNOT ERR THEN CALL EXEC(10,FMGR,-1)]!CALL FMGR TO FINISH RETURN END ! ! GET.PTR THIS ROUTINE GETS THE JOB Q ENTRY POINTED TO BY PTR ! IT ALSO SETS UP CAD TO POINT AT THE ENTRY AND EXTRACTS A ! NEW PTR. IF WR IS NOT ZERO IT WRITES THE LAST RECORD ! PROVIDED IT IS NOT ALSO THE NEW CURRENT RECORD. ! GET.PTR:SUBROUTINE DIRECT LAST_L !PROPAGATE THE LAST POINTER IFNOT [L_PTR] THEN GO TO RETN !RETURN IF END OF LIST CR_(PTR/16)+1 !CACULATE THE RECORD AND CAD_.B.+AD ˜������þú !BUFFER ADDRESSES IF CR # LR THEN[ \IF NOT THE SAME RECORD IF WR THEN[ \AND RECORD MODIFIED CALL G1WFI(G0BUF,LR)?[GO TO RETN];\THEN WRITE IT OUT WR_0]; \AND CLEAR THE WR FLAG CALL G1RDF([LR_CR],ERR)?[GO TO RETN]] !NOW READ THE NEW ONE PTR_$CAD AND 377K !EXTRACT THE NEW POINTER RETURN !AND RETURN END ! ! ! ABORT SETS THE JOB ACTIVE AND COUNTS ON FMGR TO CLEAN UP ! G1CAB: SUBROUTINE(P1,P2,P3) GLOBAL JONO_[P1F_@P1+4]+1 !SET UP ADDRESS OF JOBNO G0RTN_-1 !SET RETURN PRAM TO FALT RTN_0 !AND INITIALIZE THE REAL COUNT IF [U_G1U.G()] > 0 THEN [ \IF U.G BUT IN ERROR P3 _ 56; \THEN PUT OUT RETURN] !THE LIGHTS IF U < 0 THEN[ \IF NOT GIVEN THEN DO STD. CALL G1CCJ(P1,-1,P3); \AB CALL AND RETURN] !GET OUT ! CALL G1OPN(G0DCB,P3,G0JBF) !OPEN THE JOBFIL IF P3 < 0 THEN RETURN !QUIT IF ERROR ON OPEN ! CALL G1RDF(17,P3)?[RETURN] !GET THE TOTAL NUM OF JOBS ENDJ_G0WD1 !TO ENDJ $P1F _ 1 !SET THE NUM PRESENT FLAG FOR JOBNO _ 19 TO ENDJ DO[ \LOOP TO ABORT CALL G1RDF(JOBNO,P3)?[RETURN]; \READ THE JOB RECORD IF G0BUF > -1 THEN[ \IF A JOB HERE IFNOT [G1CUG() _ G0WD1] THEN[ \AND U.G MATCHES $JONO_JOBNO-18; \SET JOB NO. IN CALL BUF P3_0; \SET ERROR FLAG TO 0 CALL G1CCJ(P1,-1,P3); \CALL CJ TO ABORT THE JOB IF P3 THEN RTN _ RTN + 1 ]]]@š���*��($!IF ERROR STEP NOT DONE COUNT G0RTN_RTN !SET THE NO. NOT DONE AND P3_0 !CLEAR THE ERROR COUNT RETURN !ALL DONE END END END$ ��������������������������6W*������ÿÿ����� ���� ÿý�|� ˆ ���������ÿ��92067-18434 2013� S C0122 �&G1CKS �GASP KS COMMAND � � � � � � � � � � � � �H0101 ‰ˆ�����þú SPL,L,O ! NAME: G1CKS (G1CRS) ! SOURCE: 92067 18434 ! RELOC: 92067-16425 ! PGMR: G.A.A.,S.K. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CKS(8) "92067-16425 REV.2013 800102" ! ! ! THIS ROUTINE KILLS OUT SPOOL FILES WHICH ARE PENDING ! ON SOME LU OR IN ONE OF THE HOLD STATES. ! ! IT IS INVOKED WITH THE: ! ! KS,PRAM,USER.GROUP COMMAND ! ! WHERE PRAM IS: ! NUMERIC MEANING KILL THE SPOOL ACTIVE ON LU PRAM ! ASCII MEANING KILL THE SPOOL BY NAME PRAM ! ! USER.GROUP: IF PRAM ENTRY IS NULL AND USER.GROUP IS ! SPECIFIED, ALL SPOOLS BELONGING TO USER.GROUP ! ARE KILLED ! ! LET G1IMS,G1CAP,G1CHK, \ G1WFI,POST,G1OPN,G1RDF,EXEC,RNRQ,MESSS BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET G1CUG,G1FLU,G1SLU BE PSEUDO,EXTERNAL,DIRECT LET G1KLG,G1U.G BE FUNCTION,EXTERNAL,DIRECT ! LET G0DCB,G0SPF,G0JBF,G0CAP,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4,\ G0W10,G0W11,G0W15,G0P1V,G0KIL,G0RTN,G0SWD,G0ACT \ BE INTEGER,EXTERNAL ! LET RD,RECV,WRIF,KILL,GTACT,CAPCK BE SUBROUTINE,DIRECT ! LET SMP(3) BE INTEGER LET JOB(3) BE INTEGER INITIALIZE SMP TO "SMP " INITIALIZE JOB TO "JOB " ! LET OFMSG(6) BE INTEGER INITIALIZE OFMSG TO "OF ,PROGN,1 " ! INITIALIZE DRT TO 1652K !DEVICE REFERENCE TABLE INITIALIZE KEYWD TO 1657K !KEYWORD TABLE ! ASSEM«Œ������þúBLE["EXT $RNTB"] !RESOURCE NUMBER TABLE ARNTB: ASSEMBLE["DEF $RNTB+0"] !GET DIRECT ADDRESS ! LET SMDIR,LUAVA BE INTEGER ! INITIALIZE D1 TO 1 INITIALIZE D2 TO 2 INITIALIZE M1 TO -1 ! G1CKS: SUBROUTINE(PRAM,N,ER) GLOBAL ! LU_[PV3_[PV2_[PV_[PF_@PRAM+4]+1]+1]+1]+2 !SET UP PRAM ADDRESSES U.G _ -1 !INITIALIZE U.G FLAG IF $PF THEN GO TO OPNSP !IF PARM SPECIFIED IGNORE U.G IF N = -1 THEN GO TO NOPRM !RS COMMAND, FILE NAME NOT GIVEN U.G _ G1U.G !SET UP TABLE FOR USER.GROUP IF U.G < 0 THEN [ \NOT ENOUGH PARMS IF NO U.G NOPRM: ER _ 55; \ RETURN] IF U.G THEN [ \ERROR IN USER.GROUP PARAMETER ER _ 56; \BAD PARAMETER RETURN] ! OPNSP: CALL G1CAP(ER)?[GO TO EX] !GET USER CAP AND ACCT# CALL G1OPN(G0DCB,ER,G0SPF) !OPEN THE SPOOL FILE IF ER<0 THEN RETURN !IF ERROR EXIT ER_0 !SET TO ZERO SO NO ERROR IS REPORTED IF N= -1 THEN CALL EXEC(9,JOB,-1) !IF KILL CHECK JOB FIRST ! CALL G1RDF(1,ER)?[RETURN] !READ THE RN RECORD JRN_G0BUF !SAVE THE RN CALL POST(G0DCB) CALL RNRQ(1,JRN,RNST) !LOCK THE FILE LREC_[FREC_G0WD3]+G0WD1-1 !GET RECORD NUMBERS NLUS_G0WD2 !AND NUMBER OF LUS IF N= -1 THEN GO TO LUCK !IF RS CALL GO TO CHECK LU G0RTN _ -1 RTN _ 0 ! IF U.G THEN GO TO CKNAM !IF USER.GROUP NOT GIVEN SKIP FOR RNUM _ FREC TO LREC DO [ \KILL ALL SPOOLS FOR USER.GROUP CALL RD(RNUM); \READ SPOOL RECORD IF G0BUF >= 0 THEN [ \IF AN ACTIVE ENÅù������þúTRY CALL GTACT; \GET ACCOUNT # FOR SPOOL FILE IF ACCT THEN [ \IF SPOOL FILE DEFINED IN SESSION G1CUG,ER _ ACCT; \COMPARE USER.GROUP IFNOT ER THEN [ \IF USER.GROUP MATCHES CALL CAPCK; \CHECK CAPABILITY CALL KILL]]]] !KILL SPOOL FILE G0RTN _ RTN !# OF UNSUCCESSFUL TRIES TO KILL GO TO EX ! CKNAM: IF $PF=2 THEN GO TO NAM !IF NAME, DO NAME SEARCH G1FLU(),I _ $PV !GET TRUE LU FOR OUTSPOOL LU IFNOT I THEN GO TO ER43 !LU NOT FOUND IN SST IF I>0 THEN $PV _ I !ASSIGN TRUE OUTLU CKLU: FOR I_1 TO NLUS DO[ \START LU SCAN CALL RD((I*8)+1); \READ THE LU BLOCK IF (G0BUF AND 377K)=$PV THEN GO TO FLU]!JUMP IF FOUND ! ! END OF SCAN AND NOT FOUND ! BADPM: ER_56 !SEND BAD PRAM ERROR EX: CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN AND RETURN !EXIT ! ! THE LU WAS FOUND ! FLU: IFNOT G0WD1 THEN [ \IF NO QUE EXIT ER4: ER_4;GOTO EX] !WITH ERROR 4 RNUM_G0WD2 !GET THE FIRST FILE CALL RD(RNUM) !READ THE SPOOL CON RECORD CALL GTACT !GET ACCOUNT # FOR SPOOL FILE CALL CAPCK !CHECK CAPABILITY IF G0W10="A" THEN GO TO KILFL !MAKE SURE IT IS ACTIVE IF G0W10="AH" THEN [ \ELSE KILFL: CALL KILL; \KILL FILE GO TO EX] !EXIT GO TO ER4 !GO SEND ILLEGAL STATUS ! ! ! LUCK: IFNOT $LU THEN GO TO NAM !IF NO LU THEN OK G1SLU(),I _ $m������þúLU !GET TRUE LU FOR OUTSPOOL LU IFNOT I THEN [ \ERROR IF LU NOT FOUND IN SST ER43: ER _ 43; \ GO TO EX] IF I > 0 THEN $LU _ I !ASSIGN TRUE OUTSPOOL LU RNUM_@G0WD4+2 !SET UP TO SEARCH THE LU TABLE FOR RLHD_1 TO G0WD2 DO[ \SCAN FOR THE LU IF $RNUM = ($LU AND 377K) THEN GO TO NAM;\IF THIS IS IT JUMP RNUM_RNUM+1] !ELSE STEP TO NEXT ENTRY GO TO BADPM !NOT FOUND SEND BAD PRAM MESSAGE ! ! NAM: FOR RNUM_FREC TO LREC DO[ \SCAN THE SPOOL RECS CALL RD(RNUM); \TO FIND THE NAME IF G0BUF >= 0 THEN [ \IF AN ACTIVE ENTRY IF $PV=G0WD2 THEN[ \CHECK THE NAME IF $PV2=G0WD3 THEN[ \ IF $PV3=G0WD4 THEN GO TO FNAM]]]] GO TO BADPM !IF NOT FOUND THEN BAD PRAM ! ! NAME FOUND SO CHECK IF KS OR RS COMMAND ! FNAM: CALL GTACT !GET ACCOUNT # FOR SPOOL FILE CALL CAPCK !CHECK CAPABILITY IF N # -1 THEN [ \IF KS THEN CALL KILL; \CHECK STATUS GO TO EX] ! OLU _ G0W15 RLHD_G0W10 !SET CURRENT STATUS IF RLHD = "A" THEN GO TO AH !IF ACTIVE GO HOLD/ACTIVE IF RLHD = "AH"THEN GO TO W !IF HOLD/ACTIVE GO RELEASE TO WAIT IF RLHD = "W" THEN GO TO H !IF WAITING GO HOLD IF RLHD = "H" THEN GO TO HH !IF IN HOLD GO CHANGE LU ! GO TO ER4 !NOT IN A LEGAL STATUS SO EXIT ! ! SPOOL IS ACTIVE SO FIRST PUT A HOLD ON IT ! AH: G0W10_"AH" !SET STATUS CALL WRIF !WRITE TO THE FILE AND U]������þúNLOCK CALL EXEC(100027K,SMP,14,RNUM,G0W15,0,RLHD)!TELL SMP WHAT TO DO GO TO NOSMP !SMP CANNOT BE SCHEDULED ! ! SET UP TO NOW SET THE FILE ACTIVE ! RLHD_"AH" !SET CURRENT STATUS CALL RECV !RECOVER THE LOCK AND RECORD ! ! FILE IS IN ACTIVE HOLD SO SET THE NEW LU AND ! PUT IN WAIT STATUS ! W: G0W10_"W" !SET STATUS LUX_0 IF $LU THEN[IF $LU#G0W15 THEN LUX_$LU] !SET LU CALL WRIF !WRITE OUT AND UNLOCK CALL EXEC(100027K,SMP,15,RNUM,OLU,LUX,RLHD) !TELL SMP GO TO NOSMP !SMP CANNOT BE SCHEDULED RETURN !GO EXIT DONE ! NOSMP: ER _ -48 !SMP CANNOT BE SCHEDULED GO TO EX ! ! ! FILE IS IN A WAIT QUEUE SO PUT IN HOLD THEN CHANGE LU ! AND PUT BACK IN WAIT QUEUE FOR THE NEW LU ! H: G0W10_"H" !SET NEW STATUS CALL WRIF !WRITE IT OUT AND UNLOCK CALL EXEC(100027K,SMP,14,RNUM,G0W15,0,RLHD) !TELL SMP GO TO NOSMP !SMP CANNOT BE SCHEDULED ! ! NOW SET UP FOR THE WAIT QUEUE TRANSITION ! CALL RECV !RESET THE RN LOCK AND READ IF $LU THEN G0W15_$LU OLU_G0W15 !SET LU FOR CALL GO TO W !GO SET TO WAIT ! ! ! FILE IS IN HOLD SO JUST CHANGE LU AND EXIT ! HH: IF $LU THEN G0W15_$LU CALL WRIF !WRITE IT OUT AND UNLOCK RETURN !NOW RETURN ! END ! ! KILL: SUBROUTINE DIRECT KL1: FLAG_1 !SET LEGAL COUNT IF ACTIVE IF G0W10="A" THEN GO TO KL2 !SPOOL FILE MUST BE IF G0W10="AH" THEN GO TO KL2 ñ������þú !IN A DEFINED STATE FLAG_0 IF G0W10="W" THEN GO TO KL2 !IN A DEFINED STATE IF G0W10="H" THEN GO TO KL2 !IN A DEFINED STATE KL0: CALL .DFER($(@G0KIL+20),G0WD2) !MOVE FILE NAME INTO MESSAGE CALL G1IMS(G0KIL) !ELSE MAKE SURE FIRST IF G0P1V = "YE" THEN GO TO KL4 !IF YES ANSWER DO IT RTN _ RTN+1 !INCREMENT # UNSUCCESSFUL KILLS RETURN ! KL2: IF G1KLG(RNUM) > FLAG THEN GO TO KL0 !IF STILL WRITING, ASK FIRST KL4: CALL RNRQ(4,JRN,RNST) !UNLOCK THE FILE FOR SMP ASSEMBLE["EXT $SMVE";"EXT $SHED";"EXT $SMLK";"EXT $SMD#"] ASSEMBLE["LDA $SMLK";"STA SMLK"] ASSEMBLE["LDA $SMD#";"STA SMDIR"] ASSEMBLE["LDA $SHED";"STA SHED"] ! CALL RD(RNUM) !READ THE SPOOL CON RECORD ! ABFLG _ 0 !CLEAR ABORT FLAG ! ASSEMBLE ["EXT $LUAV"; \LU AVAILABILITY TABLE "EXT .DRCT"; \FIND DIRECT ADDRESS "JSB .DRCT"; \ "DEF $LUAV"; \ "STA LUAVA"] !DIRECT ADDRESS OF $LUAV TABLE ! LU _ G0WD1 !SPOOL LU # I _ $LUAVA !LENGTH OF $LUAV TABLE LUAVA _ LUAVA + 1 !POINT TO 1ST ENTRY IN $LUAV TABLE WHILE I # 0 DO [ \SCAN $LUAV TABLE IF $(LUAVA+1) # RNUM THEN GO TO NXTEN; \NEXT ENTRY IF $LUAVA >= 0 THEN GO TO NXTEN; \ SPLLU _ $LUAVA AND 77777K; \GET LU# IF SPLLU # LU THEN [LU _ SPLLU; \USE THE ALTERNATE SPOOL LU GO TO CHKAB]; \FIND THE SCB NXTEN: I _ I + 1; \INCREMENT NEGATIVE COUNT LUAVA _ LUAVA + 2] !POINT TO NEXT ENTRY ! CHKAB: OFSET _ $($DRT+LU-1) AND 3700K !GET Ã8������þúLU LOCK FLAG FROM DRT IFNOT OFSET THEN GO TO FNSCB !LU NOT LOCKED ASSEMBLE ["LDA OFSET"; \ "ALF,ALF"; \THE LU LOCK FLAG IN LOW 5 BITS "RAL,RAL"; \ "ADA ARNTB"] !INDEX INTO THE RN TABLE OFSET _ $.A. AND 377K !LU LOCK OWNER'S ID SEG # CALL .DFER(OFMSG(3),$($(OFSET+$KEYWD-1)+12)) !MOVE PROG NAME OFMSG(5) _ (OFMSG(5) AND 177400K) OR 54K !INSERT COMMA ABFLG _ 1 !SET ABORT FLAG ! FNSCB: IFNOT ACCT THEN [ \IF NOT IN SESSION, JUST KILL IF ABFLG # 0 THEN [ \IF ABORT FLAG SET THEN CALL MESSS(OFMSG,11)]; \SEND ABORT MESSAGE TO SYSTEM GO TO KL5] !KILL SPOOL FILE ! WHILE SHED # 0 DO [ \SCAN ALL SCB'S G0SWD _ SHED - SMLK; \SET SESSION WORD ASSEMBLE ["JSB $SMVE"; \READ DIRECTORY # OF SCB "DEF *+6"; \ "DEF D1"; \ "DEF G0SWD"; \ "DEF SMDIR"; \ "DEF I"; \ "DEF D1"]; \ IF I # ACCT THEN GO TO NXSCB; \GET NEXT SCB IF NO MATCH G1FLU(),I _ -LU; \SEARCH FOR SPOOL LU IN THIS SST OFSET _ .B.; \SAVE OFFSET INTO SST RETURNED IF I <= 0 THEN GO TO NXSCB; \IF SPOOL LU NOT FOUND, NEXT SCB IF ABFLG # 0 THEN CALL MESSS(OFMSG,11,0,-SHED); \ABORT LU LOCK OWNER I _ I - 1; \DECREASE LU# BY 1 FOR SST ENTRY I _ I OR 177000K; \SWITCH SESSION SPOOL LU TO 255 ASSEMBLE ["JSB $SMVE"; \REMOVE SPL LU ENTRY FROM SST "DEF *+6"; ¬������þú \ "DEF D2"; \WRITE "DEF G0SWD"; \SESSION WORD "DEF OFSET"; \OFFSET INTO SST FOR LU ENTRY "DEF I"; \SWITCH LU TO SYTEM LU 255 "DEF D1"]; \ GO TO KL5; \ASK SMP TO KILL FILE NXSCB: ASSEMBLE["JSB $SMVE"; \POINT TO NEXT SCB "DEF *+6"; \ "DEF D1"; \ "DEF G0SWD"; \ "DEF SMLK"; \READ THE LINK WORD OF SCB "DEF SHED"; \ "DEF D1"]] ! KL5: CALL EXEC(100027K,SMP,13,RNUM,G0WD1,0,G0W10) !CALL SMP TO KILL GO TO NOSMP !SMP CANNOT BE SCHEDULED CALL RNRQ(1,JRN,RNST) !LOCK FILE FOR U.G KILL REQUEST KL3: RETURN !AND EXIT END ! ! ! SUBROUTINE TO WRITE CURRENT RECORD AND UNLOCK THE DISC ! WRIF: SUBROUTINE DIRECT CALL G1WFI(G0BUF,RNUM)?[GO TO EX] !WRITE THE RECORD CALL POST(G0DCB) !MAKE SURE IT GOES TO THE DISC CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN RETURN !AND RETURN END ! ! SUBROUTINE TO LOCK THE RN AND REREAD THE RECORD ! RECV: SUBROUTINE DIRECT CALL RNRQ(1,JRN,RNST) !LOCK THE RN CALL RD(RNUM) !READ THE RECORD TO THE BUFFER RETURN !AND RETURN END ! ! ! RD: SUBROUTINE (R) DIRECT CALL G1RDF(R,ER)?[GO TO EX] RETURN END ! ! CAPCK: SUBROUTINE DIRECT IF ACCT # G0ACT THEN [ \IF NOT THE SAME ACCOUNT THEN CALL G1CHK(ER)?[GO TO EX]] !ERROR IF NOT ENOUGH CAPABILITY RETURN END ! }���6��40 ! GTACT - GETS ACCOUNT # FOR SPOOL FILE ! GTACT: SUBROUTINE DIRECT ACCT _ G0W11 !WORD 11 OF SPOOL RECORD IF G0W11<0 THEN [ \IF JOB REC# REMOVE SIGN BIT G0W11 _ G0W11 AND 77777K; \ CALL G1OPN(G0DCB,ER,G0JBF); \OPEN JOBFIL IF ER < 0 THEN GO TO EX; \ERROR CALL RD(G0W11); \READ JOB RECORD ACCT _ G0WD1; \WORD 1 OF JOB RECORD IS ACCT# CALL G1OPN(G0DCB,ER,G0SPF); \OPEN SPOOL FILE IF ER<0 THEN GO TO EX; \RETURN IF ERROR CALL RD(RNUM)] !READ SPOOL RECORD RETURN END ! ! ! THE RESTART SUBROUTINE JUST CALLS THE KS ROUTINE WITH N=-1. ! G1CRS: SUBROUTINE(P,PN,EW) GLOBAL CALL G1CKS(P,-1,EW) RETURN END END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������¯Ÿ6������ÿÿ����� ���� ÿý�}� ‹ ���������ÿ��92067-18435 2013� S C0122 �&G1CDS �GASP DS COMMAND � � � � � � � � � � � � �H0101 ƒ�����þúASMB,Q,C G1CDS DISPLAY SPOOL STATUS HED G1CDS * NAME: G1CDS G1CCS * SOURCE: 92067-18435 * RELOC: 92067-16425 * PGMR: G.A.A.,S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CDS,8 92067-16425 REV.2013 800102 * ENT G1CDS,G1CCS ENT G1U.G,G1CUG,G0U.G,G0UG1,G1FLU,G1SLU ENT G0SWD,G1OLK,G0JRN * EXT .ENTR,G1OMS,KCVT,CNUMD,$SMVE,SESSN,$LUAV,PARSN EXT .MVW,.DRCT,.CACT,.UNAM,IPRSN EXT G0DCB,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4 EXT G0WD8,G0WD9,G0W10,G0W11,G0W15 EXT G0SPF,G0JBF,G0CHR,G0RTN,G0ACT EXT G1OPN,READF,WRITF,POST,RNRQ EXT EXEC,G1KLG,G1CAP,G1CHK * A EQU 0 B EQU 1 XEQT EQU 1717B SUP * PBUF1 NOP PLEN1 NOP IERR NOP * G1CDS NOP JSB .ENTR FETCH PARAMETERS DEF PBUF1 CLA STA SPLU INITIALIZE SPOOL LU# STA G0RTN SET NONE PRINTED FLAG LDA DBLNK STA SPSTM+3 FILL LU# WITH BLANKS LDB PBUF1 GET ADDR OF PARAM LIST ADB D2 POINT TO SECOND WORD OF OPCODE LDA B,I CLE CPA "AL" DSAL? JMP STWHO THEN INDICATE SO IN WHO? FLAG CPA DBLNK DS? CCE,RSS CPA "NP" NO PRINT? CCE,RSS TREAT DSNP LIKE DS JMP BADCM BAD COMMAND * STWHO CLA,SEZ,INA IF E REG SET WHO? IS -1 CCA STA WHO? -1=CURRENT SESS, 1=ALL SPOOLS, 0=USER.GROUP CLA,INA CPA PLEN1,I SEE IF MORE THAN 1 PARM JMP BLDUG NO, DEFAULT TO ALL LUS * ADB D2 SKIP "DS" COMMAND LDA B,I GET LU Iˆ8������þúF ANY GIVEN SZA IF NULL OR NUMERIC CPA D1 THEN OK INB,RSS JMP ILPM1 ILLEGAL PARAMETER LDA B,I SET REQUESTED LU # STA TEMP1 SAVE IT STA SPLU LDA SPLU YES, FIND TRUE OUTSPOOL LU SZA,RSS OUTLU DEFINED? JMP BLDUG NO JSB G1SLU YES SZA DEFINED? SSA IN SESSION? JMP EXIT NO * STA SPLU BLDUG LDA WHO? IS ID DSAL? CPA D1 JMP NOPR1 YES, SKIP CHECK FOR USER.GROUP JSB G1U.G BUILD USER .GROUP TABLE SSA USER .GROUP DEFINED? JMP GTAC# NO SZA ERROR? JMP ILPM1 YES, THEN ILLEGAL PARAMETER STA WHO? INDICATE USER.GROUP TO MATCH JMP NOPR1 * GTAC# JSB .CACT GET ACCOUNT # OF CURRENT SESSION SSA SESSION DEFINED? CLA NO, THEN ACCOUNT # IS 0 STA ACCT# * NOPR1 JSB G1OPN OPEN SPLCON DEF *+4 NO NEED TO LOCK RN DEF G0DCB SO SPOOL SYSTEM CAN DEF IERR,I RUN FASTER DEF G0SPF SSA JMP EXIT1 EXIT IF ERROR CLA,INA READ 1ST REC JSB RD LDA G0BUF GET THE RN NUMBER STA G0JRN AND SAVE IT * LDA G0WD1 GET #SPOOL CONTROL RECS CMA,INA,SZA,RSS JMP DSNOS NO SPOOLS * STA RCONT SAVE THE COUNT LDA G0WD3 GET RECORD NUMBER OF STA RCNO FIRST CONTROL RECORD LDB D20 LDA WHO? SSA,RSS U.G GOING TO BE PRINTED LDB D26 STB SPSH2 SET THE LENGTH FOR HEADING JSB G1OMS SEND HEAD DEF *+2 DEF SPSH2 * JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE * LDA M31 BLANK THE SPOOL STATUS STA TEMP SAVE NEGATIVE COUNTER LDA DBLNK " " LDB ASPST CLRLP STA B,I INB ISZ TEMP INCREMENT NEGAç÷������þúTIVE COUNTER JMP CLRLP * * GTSLU LDA RCNO SET TO READ THE RECORD JSB RD READ IT CHCKN LDA G0BUF GET USAGE FLAG SSA IF NOT IN USE JMP GTNRC GO GET THE NEXT ONE * * PURG? LDA G0W15 GET OUTSPOOL LU AND B377 STA OUTLU JSB G1KLG GO SCAN THE $LUAV FOR DEF RCNO THIS RECORD SZA IF SOME ENTRIES OK SO JMP NOPU JUST CONTINUE * JSB CKPU CHECK FURTHER JMP CHCKN LOOK OK NOW * JSB EXEC CALL JOB TO SEE IF IT OWNS IT DEF *+4 DEF D9 DON'T WAIT(IF BUSY THEN NOT HIS) DEF JOB DEF MD1 SEND -1 TO JUST CLEAN UP * JSB CKPU OK NOW?? JMP CHCKN YES GO PROCESS * LDA OUTLU GET OUTSPOOL LU SZA,RSS DEFINED? JMP KILFL NO, THEN JUST KILL SPOOL FILE * LDA G0W10 GET STATUS WORD CPA "W" WAIT STATUS? JMP RDRC1 READ THE FIRST RECORD IN SPLCON * CPA "H" IF HOLD THEN REMOVE HO BIT JMP CLRHO * JMP NOPU IF ACTIVE OR ACTIVE HELD DO NOT PURGE * RDRC1 CLA,INA JSB RD READ RECORD # 1 LDA M10 - (MAX POSSIBLE OUTSPOOL LU'S) STA TEMP USE AS COUNTER LDA D9 START RECORD FOR OUTSPOOL LU QUEUE STA QRCNO LDA AG0BF ADA D6 POINT TO FIRST OUTSPOOL LU # QLOOP LDB A,I CPB OUTLU FOUND IT? JMP LUFND YES * LDB QRCNO POINT TO NEXT OUTSPOOL LU'S QUEUE ADB D8 STB QRCNO INA ISZ TEMP JMP QLOOP * JMP KILFL LU NOT FOUND, JUST KILL SPOOL FILE * LUFND LDA M8 GET READY TO READ THE OUTSPOOL QUEUE STA TEMP LDA QRCNO START REC# OF OUTSPOOL QUEUE'S STA NORC LDB AG0BF START OF BUFFER TO HOLD QUEUE STB TEMP3 READQ JSB READF READ A RECORD FROM THE OUTSPOOL QUEUE DEF *+7 ú¾������þú DEF G0DCB DEF IERR,I ERROR DEF TEMP3,I BUFFER ADDRESS DEF D16 RECORD LENGTH DEF TEMP2 # OF WORDS ACTUALLY READ DEF NORC RECORD # TO BE READ SSA ERROR? JMP EXIT1 YES * ISZ NORC READ NEXT REC IN QUEUE LDB TEMP3 ADB D16 INCREMENT BUFFER ADDRESS STB TEMP3 ISZ TEMP JMP READQ NOT DONE YET * LDA G0WD1 # OF ENTRIES IN THE QUEUE SZA,RSS QUEUE EMPTY? JMP HOLD YES, THEN CHANGE TO HOLD STATUS * CMA,INA NEGATIVE STA TEMP # OF ENTRIES IN QUEUE FOR A COUNTER LDA AG0BF ADA D2 POINT TO FIRST ENTRY IN QUEUE INQ? LDB A,I CPB RCNO IN THIS THE SPOOL FILE ENTRY? JMP NOPU0 YES, DO NOT PURGE SPOOL FILE * ADA D2 POINT TO NEXT ENTRY IN QUEUE ISZ TEMP MORE ENTRIES? JMP INQ? YES, TRY AGAIN * * CHANGE SPOOL FILE STATUS TO HOLD * HOLD LDA RCNO SPOOL FILE RCORD # JSB RD READ THE SPLCON RECORD LDA "H" SET STATUS TO HOLD STA G0W10 LDA "W" STA OSTAT SET THE OLD STATUS CLRHO LDA G0WD8 GET THE DISPOSITION FLAGS RAR,CLE,RAR CLEAR THE HOLD BIT ELA,RAL STA G0WD8 JSB WRITF WRITE THE SPLCON RECORD DEF *+6 DEF G0DCB DEF IERR,I AG0BF DEF G0BUF+0 DIRECT ADDRESS FOR BUFFER DEF D16 DEF RCNO SSA ERROR? JMP EXIT1 YES, THEN QUIT * JSB UNLOK UNLOCK RN FOR SPLCON NOP LDB D14 CALL SMP TO CHANGE STATUS JSB SMPR JMP NOSMP SMP CANNOT BE SCHDULED * JMP NOPU DO NOT PURGE THE FILE * KILFL JSB EXEC NO CALL SMP TO KILL IT DEF *+5 DEF S23 WAIT FOR IT DEF SMP DEF D13 KILL CODE DEF RCNO THIS IS THE BAD GUY * JMP NOSMP SMP NOT FOUND * ×-������þúJMP GTNRC GET THE NEXT RECORD * NOSMP LDA MD48 SMP CANNOT BE SCHEDULED JMP EXIT1 GET OUT * NOPU0 LDA RCNO READ THE SPOOL RECORD JSB RD * NOPU LDB SPLU GET THE REQUEST LU SZB IF NO REQUEST LU CPB OUTLU OR THIS IS IT RSS THEN DISPLAY STATUS JMP GTNRC ELSE SKIP TO NEXT RC * JSB CNUMD PREPARE HEADING DEF *+3 BY CONVERTING LU # DEF OUTLU DEF TEMP ADDRESS FOR CONVERTED # LDB TEMP+2 CPB AB0 IF RESULT IS ZERO LDB ADM GET "--" LDA TEMP+1 DST SPSTM+5 LDA G0W15 GET SYSTEM OUTSPOOL LU AND B377 CMA,INA,SZA,RSS JMP STMNS * JSB G1SLU FIND CORRESPONDING SESSION LU SZA SSA DEFINED? JMP STMNS NO STA TEMP YES, SAVE JSB KCVT CONVERT DEF *+2 DEF TEMP RSS STMNS LDA ADM STA SPSTM+3 SET UP LU IN BUFFER * JSB CNUMD CONVERT PRIORITY TO ASCII DEF *+3 DEF G0WD9 DEF SPSTM+11 STATUS MESSAGE * LDA G0WD2 MOVE NAM1,NAM2 STA SPSTM+8 LDA G0WD3 MOVE NAM3,NAM4 STA SPSTM+9 LDA G0WD4 MOVE NAM5,NAM6 STA SPSTM+10 LDA G0W10 PICK UP SPOOL STATUS AND B377 FROM WORD 10 CPA G0W10 IF SAME IOR B20K MERGE IN BLANK IOR G0W10 IF NOT MIRGE IN HIGH CHAR TOO CPA B20K IF UPPER BLANK ONLY LDA ADM USE "--" STA SPSTM+18 * LDA G0W11 SSA,RSS IN BATCH? JMP NOTBA NO ELA,CLE,ERA IN BATCH , CLEAR SIGN BIT STA G0W11 SAVE ADA MD18 GET JOB # STA TEMP JSB KCVT CONVERT TO ASCII FOR PRINTING DEF *+2 DEF TEMP STA SPSTM+16 * JSB GTACT GET ACCOUNT # SSA ERROR? JMP EXIT1 YES * JMP DE—q������þúCID * NOTBA LDB ADM INSERT -- STB SPSTM+16 IN SPOOL STATUS BUFFER * DECID LDB WHO? SSB,RSS JMP CMPUG COMPARE USER.GROUP * LDA D19 SET SPOOL STATUS MESSAGE TO PRINT STA SPSTM A SHORT MESSAGE LDA G0W11 GET ACCOUNT # CPA ACCT# SAME AS THAT FOR CURRENT SESSION? JMP PRNT YES, THEN PRINT JMP GTNRC NO, GET NEXT RECORD * CMPUG LDB D40 # OF CHARS IN LONG MESSAGE STB SPSTM LDA G0W11 GET ACCT# JSB G1CUG COMPARE USER.GROUP LDB WHO? CPB D1 ALL SPOOLS? JMP CHKSE YES, THEN CHECK IF IN SESSION SSA COMPARES? JMP GTNRC NO, GET NEXT RECORD JMP MVU.G * CHKSE LDA G0W11 GET ACCT # SZA IN SESSION? JMP MVU.G YES, MOVE USER.GROUP LDA D19 NO, PRINT SHORT MESSAGE STA SPSTM JMP PRNT * MVU.G JSB IPRSN MOVE THE USER.GROUP INTO MESSAGE BUFFER DEF *+4 DEF G0UG1 11 WORD SOURCE TABLE ASPST DEF SPSTM+1 DEF SPSTM CHARACTER OFFSET LDA SPSTM SET SPOOL STATUS MESSAGE LENGTH TO CMA,INA STA SPSTM PRINT LONG MESSAGE * PRNT JSB G1OMS PRINT SPOOL STATUS MESSAGE DEF *+2 DEF SPSTM * ISZ G0RTN COUNT THE PRINTED SPOOLS * GTNRC ISZ RCNO STEP THE RECORD NUMBER ISZ RCONT BUMP RC COUNT JMP GTSLU * EXIT LDA G0RTN IF NONE PRINTED SZA,RSS THEN SO JSB NOSP STATE LDA D3 READ SPLCON REC #3 JSB RD LDA G0BUF CHECK IF SHUT DOWN CPA "D" IS IN EFFECT RSS JMP DSDN NO, NOT DOWN JSB G1OMS YES, PRINT "SHUT DOWN" DEF *+2 DEF DOWN * DSDN CLA LDB SPLU IF NO LU SPECIFIED SZB,RSS THEN NO ERROR JMP EXIT1 IF CAN'T FIND ANY LDB SPSTM+3 GET LU# CPB DBLNK STILL������þú BLANKS? LDA D6 IF NO LU FOUND, ERR 6 EXIT1 STA IERR,I JMP G1CDS,I RETURN * BADCM LDA D5 JMP EXIT1 BAD COMMAND ERROR * ILPM1 LDA D56 ILLEGAL PARAMETER JMP EXIT1 * DSNOS JSB NOSP PRINT "NO SPOOLS" JMP DSDN DONE * NOSP NOP JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE FIRST JSB G1OMS PRINT NO SPOOLS MESSAGE DEF *+2 DEF NOSPM JMP NOSP,I * * ADM ASC 1,-- AB0 ASC 1, 0 "NP" ASC 1,NP "AL" ASC 1,AL WHO? NOP ACCT# NOP OUTLU NOP M10 DEC -10 QRCNO NOP M8 DEC -8 D8 DEC 8 D40 DEC 40 M31 DEC -31 D20 DEC 20 D19 DEC 19 D26 DEC 26 D2 DEC 2 B377 OCT 377 * RD NOP READ A RECORD FROM THE CURRENT FILE STA NORC SET THE RECORD NUMBER JSB READF GO READ IT DEF *+7 DEF G0DCB DEF IERR,I DEF G0BUF DEF D16 DEF TEMP DEF NORC JMP RD,I RETURN * NORC NOP RCNO NOP RCONT NOP B77 OCT 77 LU# NOP LUFLG NOP ZERO DEC 0 SST BSS 71 D71 DEC 71 * * * GTACT - ROUTINE GETS ACCOUNT # FROM JOB FILE RECORD * G0W11 MUST CONTAIN THE JOB RECORD # * CALLING SEQUENCE: JSB GTACT * RETURNS : A REG = ACCT # * = 0 IF NOT IN SESSION * = -ERROR # * * GTACT NOP JSB G1OPN DEF *+4 DEF G0DCB DEF IERR,I DEF G0JBF OPEN JOBFIL SSA ERRORS? JMP GTACT,I YES LDA G0W11 GET JOB RECORD# JSB RD READ THE JOB RECORD SSA ERRORS? JMP GTACT,I RETURN LDA G0WD1 GET DIRECTORY ENTRY # FOR SPOOL FILE STA G0W11 SAVE IT JSB G1OPN OPEN SPOOL FILE DEF *+4 DEF G0DCB DEF IERR,I DEF G0SPF SSA,RSS ERROR? LDA G0W11 NO, RETURN WITH ACCT# JMP GTACT,I ÖÄ������þúRETURN * * G1SLU - ROUTINE TO FIND SESSION WORD OF CURRENT USER * AND CALL G1FLU TO FIND SESSION OR SYSTEM LU * * CALLING SEQUENCE: A REG = SESSION LU * OR -(SYSTEM LU) * JSB G1SLU * RETURNS: A REG = -1 IF NOT IN SESSION * = 0 IF LU NOT FOUND IN SST * = SESSION OR SYSTEM LU * B REG = OFFSET FOR LU ENTRY IN SST IF * LU WAS FOUND IN SST * = MEANINGLESS OTHERWISE * * G1SLU NOP STA LUFLG SAVE THE A REG FOR NOW JSB SESSN GET SESSION WORD DEF *+2 DEF XEQT SMP'S ID SEGMENT ADDRESS STB G0SWD SAVE THE SESSION WORD CCA,SEZ IN SESSION? JMP G1SLU,I NO, THEN RETURN * LDA LUFLG YES, THEN CALL G1FLU TO FIND JSB G1FLU CORRESPONDING LU IN SST JMP G1SLU,I RETURN * G0SWD NOP * * * * G1FLU - ROUTINE TO FIND SESSION LU CORRESPONDING TO * GIVEN SYSTEM OR SESSION LU * CALLING SEQUENCE: G0SWD IS ASSUMED TO HAVE THE SESSION WORD * A REG = SESSION LU * OR -(SYSTEM LU) * JSB G1FLU * RETURNS: A REG = 0 IF LU NOT FOUND IN SST * = SESSION OR SYSTEM LU OTHERWISE * B REG = IF LU FOUND IN SST, OFFSET TO THE * LU ENTRY FROM SST LENGTH WORD * = IF LU NOT FOUND, MEANINGLESS * * NOTE: IF GIVEN LU IS A SESSION LU, THEN CORRESPONDING SYSTEM LU * WILL BE A NON-SPOOL LU * * * G1FLU NOP CLB,CLE SSA CMA,CCE,INA STA LU# SAVE LU # SEZ SET FLAG TO INDICATE WHICH LU TO LOOK FOR CCB IF FLAG = -1 THEN SYSTEM LU IS GIVEN STB LUFLG JSB $SMVE READ SST DEF *+6 DEF D1 DEF G0¨������þúSWD SESSION WORD DEF ZERO OFFSET FROM LENGTH WORD OF SST ASST DEF SST DEF D71 # OF WORDS TO READ * LDA SST STA TEMP NEGATIVE LENGTH LDA ASST INA STA TEMP1 POINTER INTO SST LDB LUFLG SSTLP LDA TEMP1,I GET AN ENTRY FROM SST SSB GIVEN SYSTEM LU? ALF,ALF YES, THEN BRING SYS LU IN LOW HALF INA AND B377 CPA LU# SAME AS LU # SPECIFIED? JMP FNDLU ENSST ISZ TEMP1 ISZ TEMP INCREMENT NEGATIVE LENGTH JMP SSTLP CLA DID NOT FIND LU ENTRY IN SST JMP G1FLU,I RETURN * FNDLU LDA SST GET THE NEGATIVE LENGTH OF SST CMA,INA ADA TEMP A REG HAS OFFSET INTO SST FOR THIS ENTRY INA STA FTMP2 SAVE THE OFFSET VALUE FOR NOW LDA TEMP1,I SSB,RSS SYSTEM LU TO FIND FROM SST? ALF,ALF YES INA AND B377 SSB JMP FLUEX RETURN * STA TEMP2 SAVE THIS SYSTEM LU# JSB .DRCT GET DIRECT ADDRESS FOR $LUAV DEF $LUAV STA FTEMP SAVE THIS ADDRESS LDA A,I SZA,RSS END OF $LUAV TABLE? JMP LUEXT YES, SYSTEM LU NOT A SPOOL LU STA FTMP1 SAVE NEGATIVE LENGTH WORD LUAV ISZ FTEMP LOOK AT NEXT ENTRY LDA FTEMP,I AND B377 CPA TEMP2 SAME AS LU # FOUND? JMP ENSST YES, THEN LOOK FOR ANOTHER ENTRY IN SST ISZ FTEMP POINT TO SECOND WORD OF ENTRY IN LUAV ISZ FTMP1 JMP LUAV LOOK AT NEXT ENTRY IN $LUAV LUEXT LDA TEMP2 FOUND THE SYSTEM LU# FOR OUTLU FLUEX LDB FTMP2 OFFSET TO THE LU ENTRY JMP G1FLU,I RETURN * FTEMP NOP FTMP1 NOP FTMP2 NOP * * HED ROUTINE TO PARSE USER.GROUP FROM RUN/COMMAND STRING * CALLING SEQUENCE: * CALL G1U.G * RETURNS: A REG = -1 = USER.GROUP NOT SPECIFIED * 0 = O.K. * Ð������þú 1 = NAME TOO LONG * 2 = INVALID CHARACTER(S) IN NAME * * * THE FORMAT OF THE 11 WORD G0U.G TABLE IS: * WORD 1: BITS 0-7 = CHARS IN GROUP NAME * BITS 8-15 = CHARS IN USER NAME * WORDS 2-6: USER NAME, PADDED WITH BLANKS * WORDS 7-11: GROUP NAME, PADDED WITH BLANKS * * G0U.G BSS 11 * * G1U.G NOP LDA G0CHR # OF CHARACTERS IN STRING SSA RUN STRING? JMP RUNST YES CMA,INA NO, COMMAND STRING LDB N2 DISCARD FIRST 2 COMMAS RSS RUNST LDB N4 RUN STRING -- DISCARD FIRST 4 COMMAS STB TEMP2 STA TEMP CHARACTER COUNT CMA,INA POSITIVE # CHARS IN STRING STA TEMP1 LDA D2 INITIALIZE TO NEXT CHAR POSITION STA G1CUG TEMP LOC FOR NOW LDA AGBUF STA TEMP3 CHRLP LDA TEMP3,I GET A WORD FROM THE STRING ALF,ALF JSB COMA? IS IT A COMMA? LDA TEMP3,I GET THE SAME WORD AND JSB COMA? TEST THE LOWER BYTE FOR A COMA ISZ TEMP3 POINT TO NEXT WORD IN STRING JMP CHRLP * * COMA? NOP AND B377 GET LOW BYTE OF WORD CPA COMMA COMMA? ISZ TEMP2 YES, INCREMENT # OF COMAS TO SKIP RSS JMP PRSUG USER.GROUP INFO NEXT IN STRING ISZ G1CUG ADVANCE CHAR POSITION ISZ TEMP ADVANCE CHARACTER COUNT JMP COMA?,I RETURN CCA -1 FOR USER.GROUP NOT SPECIFIED JMP G1U.G,I RETURN * * PARSE USER.GROUP INFORMATION * PRSUG JSB PARSN ROUTINE TO PARSE USER.GROUP DEF *+6 AG0UG DEF G0U.G TABLE ADDRESS FOR PARSED INFO AGBUF DEF G0BUF+0 START OF STRING DEF TEMP1 # OF CHARACTERS IN STRING DEF G1CUG POSITION TO START SCANNING IN STRING DEF TEMP2 ERROR RETURN * LDA G0U.G GET FIRST WORD OF PARSED STRING AND B377 GET # OF CHARS IN GROUP Íh������þú SZA GROUP WAS SPECIFIED? JMP EXGUG YES, RETURN LDA G0U.G IOR D7 INSERT 7 CHARS FOR GROUP STA G0U.G LDA AGNRL INSERT "GENERAL" FOR GROUP NAME LDB AG0UG ADB D6 JSB .MVW DEF D5 NOP EXGUG LDA TEMP2 JMP G1U.G,I RETURN * AGNRL DEF GENRL GENRL ASC 10,GENERAL N2 DEC -2 N4 DEC -4 D5 DEC 5 D7 DEC 7 TEMP3 NOP COMMA OCT 54 * HED COMPARE ROUTINE FOR USER.GROUP * CALLING SEQUENCE: * A REG = DIRECTORY ENTRY # FOR SPLCON RECORD * CALL G1CUG * RETURNS: A REG = -1 NO COMPARE * = 0 O.K. * * AGUG1 DEF G0UG1 G0UG1 BSS 11 * G1CUG NOP LDB AGUG1 11 WORD BUFFER JSB .UNAM DEF G0W15+1 ERROR MESSAGE BUFFER SSA ERROR? JMP G1CUG,I YES, RETURN * LDA AG0UG ADDRESS OF USER SUPPLIED TABLE INA STA TEMP1 SAVE ADDRESS LDA AGUG1 ADDRESS OF TABLE FROM SCB INA STA TEMP2 JSB CMPAR COMPARE USER NAME * * COMPARE GROUP NAME * LDA AG0UG ADA D6 POINT TO GROUP NAME STA TEMP1 LDA AGUG1 ADA D6 STA TEMP2 JSB CMPAR CLA JMP G1CUG,I RETURN * * ROUTINE TO COMPARE A FIVE WORD USER/GROUP NAME * CMPAR NOP LDB TEMP2,I GET FIRST WORD ELB,CLE,ERB REMOVE SIGN BIT -- IN CASE STB TEMP2,I SET BY ACCTS PROGRAM LDA TEMP1,I GET THE FIRST WORD OF NAME CPA "@" IS IT "@ " ? JMP CMPAR,I YES, THEN ANY CORRESP NAME IS OK LDA M5 STA TEMP WORD COUNT CCA CMPLP LDB TEMP2,I CPB TEMP1,I RSS COMPARES JMP G1CUG,I NO COMPARE, RETURN * ISZ TEMP1 ISZ TEMP2 ISZ TEMP JMP CMPLP CLA JMP CMPAR,I NAME COMPARES * * M5 DEC -5 TEMP NOP TEMP1 NOP TEMP2 NOP WRDCN NOP "@" ASC 1,@ * * û·������þú* * CKPU NOP RETURN P+2 IF SHOULD PURGE JSB POST POST THE BUFFER DEF *+2 THE DCB DEF G0DCB JSB RNRQ AND LOCK THE RN DEF *+4 DEF RNLOK DEF G0JRN DEF RNSTT LDA RCNO NOW JSB RD AND READ THE RECORD AGAIN LDA G0BUF NOW MAKE SURE NOTHING SSA HAS CHANGED JMP FG ALREADY CLEARED SO FORGET IT * JSB G1KLG GO GET THE COUNT DEF RCNO IF STILL ZERO SZA CONTINUE JMP FG ELSE FORGET IT * ISZ CKPU SET TO TAKE THE PU EXIT FG JSB UNLOK UNLOCK THE RN NOP IGNOR ERROR JMP CKPU,I RETURN * * HED G1CCS CHANGE SPOOL STATUS PBUF2 NOP PLEN2 NOP IERR2 NOP * G1CCS NOP CHANGE SPOOL STATUS ROUTINE JSB .ENTR FETCH PARAMETERS DEF PBUF2 LDA PLEN2,I GET NUMBER OF PARAMS ADA MD3 MAKE SURE NO LESS THAN 3 SSA JMP CSMPR * LDB PBUF2 INCRE TO PARAM 2 ADB D4 SINCE FIRST IS "CS" LDA B,I CPA D2 CHECK PARAM 2 FOR RSS ASCII NAME JMP CSBPR IF NOT, THEN ERROR 56 INB STB SPNM SAVE ADDR OF SPOOL NAME ADB D3 INCRE TO PARAM 3 STB PBUF2 * JSB G1CAP GET USER CAPABILITY AND ACCT# DEF *+2 DEF IERR2,I ERROR SEZ JMP EXIT3 ERROR RETURN * JSB G1OLK OPEN SPLCON, LOCK RN DEF G0SPF JMP EXIT2 EXIT IF ERRORS * LDA G0WD1 GET # SPOOL CONTROL RECS CMA,INA,SZA,RSS IF NONE, JMP NOSP2 THEN ERROR 6 STA SPCNT LDA G0WD3 GET SPOOL REC # OFFSET STA SPOFS STA RCNO * LDA D3 READ REC 3 FROM SPLCON FILE JSB RDREC LDA G0WD2 GET THE PRIVILEGED COMMAND CAPABILITY STA TEMP1 SAVE FOR NOW * CSRDS LDA RCNO £T������þú READ A SPOOL RECORD JSB RDREC * CCA CPA G0BUF IS THIS SPOOL REC UNUSED? JMP CSNXS YES, SO LOOK SOME MORE * LDA SPNM GET SPOOL NAME TO UPDATE STA TEMP LDA G0WD2 CPA TEMP,I COMPARE NAM1,NAM2 RSS JMP CSNXS ISZ TEMP LDA G0WD3 CPA TEMP,I COMPARE NAM3,NAM4 RSS JMP CSNXS ISZ TEMP LDA G0WD4 CPA TEMP,I COMPARE NAM5,NAM6 JMP CSFDS NAME MATCHES * CSNXS ISZ RCNO BUMP SPOOL REC # ISZ SPCNT BUMP COUNT, DONE? JMP CSRDS NO, READ NEXT SPOOL REC NOSP2 LDA D6 CANT FIND SPOOL REQ. JMP EXIT2 * CSFDS LDA G0W11 GET ACCOUNT # FOR THIS SPOOL FILE SSA,RSS IS IT A JOB #? JMP FACT# NO, THEN FOUND ACCOUNT# * ELA,CLE,ERA CLEAR SIGN BIT STA G0W11 SAVE THE JOB # JSB GTACT GET ACCT# SSA ERROR? JMP EXIT2 YES STA TEMP3 SAVE ACCT # LDA RCNO READ THE SPOOL RECORD JSB RDREC LDA TEMP3 FACT# CPA G0ACT SAME AS THAT FOR USER? JMP CAPOK YES, THEN USER OK * JSB G1CHK CHECK USER CAPABILITY DEF *+2 DEF IERR2,I SEZ JMP EXIT3 ERROR RETURN CAPOK LDA PBUF2,I YEH, WE FOUND IT. ISZ PBUF2 CPA D1 CHECK IF PARAM 3 IS # JMP CSPRI YES, PRIORITY CHANGE CPA D2 CHECK IF PARAM 3 IS ASCII JMP CSSTA YES, STATUS CHANGE CSBPR LDA D56 BAD PARAMETER EXIT2 STA IERR2,I EXIT3 JSB UNLOK UNLOCK RN, POST FILE NOP IGNORE ERROR LDA IERR2,I JMP G1CCS,I RETURN * CSILS LDA D4 ILLEGAL STATUS JMP EXIT2 * CSMPR LDA D55 MISSING PARAMETER JMP EXIT2 * * * CSSTA LDB G0W10 GET OLD SPOOL STATUS STB OSTAT LDA PBUF2,I GET NEW STATUS IN A ALF,ALF MOVE CHAR TO LOW BITS AND Å9������þúB377 KEEP ONLY 1 CHAR CPA "H" MUST EITHER BE "H" JMP CSH OR CPA "R" "R" JMP CSR JMP CSBPR ELSE BAD PARAM * CSH CPB "W" IF SPOOL WAITING JMP SMSET JUST SET HOLD CPB "H" IF ALREADY HELD JMP ALSET NO ERROR TO DO AGAIN CPB "AH" JMP ALSET LDA "AH" CPB "A" IF ACTIVE JMP SMSET THEN SET "AH" JMP CSBPR ANYTHING ELSE IS BAD * CSR LDA "W" RELEASE SPOOL CPB "W" IF IN WAIT JMP ALSET ALREADY DONE CPB "H" IF IN HOLD JMP CSSET RELEASE TO WAIT LDA "A" CPB "AH" IF IN ACTIVE-HOLD JMP CSSET THEN MAKE ACTIVE JMP CSBPR ANYTHING ELSE IS BAD * CSSET LDB D15 SET FOR A RELEASE CALL AND RSS SKIP TO THE CALL SMSET LDB D14 SET FOR A HOLD CALL JSB WRSMP WRITE THE RECORD AND CALL SMP ALSET CLA JMP EXIT2 * WRSMP NOP STB SMPR SAVE THE SMP CALL WORD STA G0W10 SET NEW STATUS JSB WR WRITE UPDATED RECORD BACK LDB SMPR RESET SMP CALL PRAM JSB SMPR GO TELL SMP JMP SMPER SMP CANNOT BE SCHEDULED * JMP WRSMP,I EXIT * * * SMPR - CALLING SEQUENCE: B REG = CALL PARM FOR SMP * JSB SMPR * RETURN: P IF SMP CANNOT BE SCHEDULED * P+1 NORMAL RETURN * SMPR NOP STB TEMP SET CALL PRAM JSB EXEC CALL SMP TO PUT SPOOL DEF *+8 INTO ANY QUEUE IT DEF S23 SHOULD BE IN DEF SMP DEF TEMP DEF RCNO DEF G0W15 DEF MD1 DEF OSTAT JMP SMPR,I CANNOT SCHEDULE SMP RETURN TO P ISZ SMPR RETURN TO P+1 JMP SMPR,I EXIT * * * CSPRI LDA G0W10 GET CURRENT STATUS STA OSTAT OF SPOOL FILE CPA "W" IS IT WAITING OR RSS CPÑ ������þúA "H" IN HOLD? RSS YES SO OK JMP CSILS ELSE ILLEGAL STATUS * LDB PBUF2,I GET THE NEW PRIORITY STB G0WD9 AND SET IT CPA "H" IF IN HOLD GO JMP CSPRH GO WRITE THE RECORD * LDA G0W10 ELSE PICK UP THE STATUS LDB D14 AND GO PUT IN HOLD JSB WRSMP LDB D15 NOW RELEASE TO NEW QUEUE JSB SMPR JMP SMPER SMP CANNOT BE SCHEDULED * JMP ALSET DONE GO EXIT * * CSPRH JSB WR WRITE THE NEW PRIORITY JMP ALSET AND EXIT * SMPER LDA MD48 SMP CANNOT BE SCHEDULED JMP EXIT2 * * WR NOP JSB WRITF WRITE UPDATED RECORD BACK DEF *+6 DEF G0DCB DEF IERR2,I DEF G0BUF DEF D16 DEF RCNO SSA JMP EXIT2 JSB UNLOK UNLOCK RN AND POST FILE NOP JMP WR,I EXIT * * RDREC NOP JSB RD SSA JMP EXIT2 JMP RDREC,I * * HED COMMON ROUTINES AND CONSTANTS TO DS,CS * * JSB G1OLK * DEF FILENAME * <ERROR RETURN, (A)=ERROR CODE> * <GOOD RETURN, (A)=MEANINGLESS> * G1OLK NOP OPEN FILE AND LOCK RN LDA G1OLK,I GET ADDR OF FILE NAME STA FNAME ISZ G1OLK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF UNLOK FNAME DEF * SSA ANY ERRORS? JMP OPLKE YES, BUG OUT * JSB READF READ FIRST RECORD DEF *+4 FROM FILE DEF G0DCB INTO GLOBAL BUFFER DEF UNLOK DEF G0BUF SSA ANY ERRORS? JMP OPLKE YES LDA G0BUF GET FIRST WORD OF RECORD STA G0JRN WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *ná���`��^Z+4 DEF RNLOK DEF G0JRN DEF RNSTT * ISZ G1OLK INCRE ADDR FOR GOOD RETURN OPLKE JMP G1OLK,I RETURN * * * * * JSB UNLOK * <ERROR RETURN> * <GOOD RETURN> * UNLOK NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF G0JRN DEF RNSTT ULOK1 ISZ UNLOK JMP UNLOK,I RETURN * * B20K OCT 20000 D1 DEC 1 D3 DEC 3 D4 DEC 4 D6 DEC 6 D9 DEC 9 D13 DEC 13 D14 DEC 14 D15 DEC 15 D16 DEC 16 D55 DEC 55 D56 DEC 56 S23 OCT 100027 MD1 DEC -1 MD3 DEC -3 MD18 DEC -18 MD48 DEC -48 * RNSTT DEC 1 ADDR NOP CNTR NOP SPLU NOP SPCNT NOP SPNM NOP SPOFS NOP G0JRN NOP OSTAT NOP RNLOK OCT 1 RNULK OCT 4 "A" OCT 101 "AH" ASC 1,AH "D" OCT 104 "H" OCT 110 "R" OCT 122 "W" OCT 127 SMP ASC 3,SMP JOB ASC 3,JOB SPSH2 NOP ASC 26, SESLU SYSLU NAME PRIORITY JOB# STATUS USER.GROUP SPSTM NOP BSS 31 LL LLL NNNNNN PPPP JJ SSSS UUUUUUUUUU.GGGGGGGGGG NOSPM DEC 6 ASC 6, NO SPOOLS DOWN DEC 5 ASC 5, SHUT DOWN SPACE DEC 1 DBLNK ASC 1, * BSS 0 SIZE END ����������������������������������������������������������������������������������������������������������������������������ß`������ÿÿ����� ���� ÿý�~�“ ���������ÿ��92067-18436 1903� S C0122 �&G1STM � � � � � � � � � � � � � �H0101 o•�����þúASMB,R,Q,C HED G1STM * NAME: G1STM * SOURCE: 92067-18436 * RELOC: 92067-16425 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1STM,8 92067-16425 REV.1903 790103 ENT G1STM * EXT G1OMS,CNUMD,KCVT,.DFER EXT ZPUT,SETDB,IPRSN,G0UG1 EXT G0WD2,G0WD3,G0WD7,G0W11,G0BUF * * THIS ROUTINE PRINTS THE JOB STATUS MESSAGE FOR GASP * THE CALLING SEQUENCE IS: * * JSB G1STM * DEF JRECNO JOB NO. + 18 * DEF U.G =0 IF NO U.G TO PRINT ELSE #0 * G1STM NOP DLD G1STM,I GET THE PRAM ADDRESSES ISZ G1STM SET RETURN ADDRESS ISZ G1STM SET RETURN ADDRESS LDA A,I GET THE JOB NUMBER ADA N18 AND ADJUST STA JNO SAVE FOR CONVERSION LDB B,I GET THE U.G FLAG STB U.GF AND SAVE IT JSB CNUMD CONVERT DEF *+3 DEF JNO THE JOB NUMBER DEF STAT TO THE STATUS BUFFER DLD STAT+1 MOVE THE RESULT ONE CHAR RRL 8 TO THE LEFT DST STAT+1 RESTORE THE DATA JSB .DFER MOVE NAME TO BUFFER. DEF NAME DEF G0WD7 JSB CNUMD CONVERT THE DEF *+3 DEF G0BUF PRIORITY DEF STUS TO THE BUFFER LDA G0WD3 FIGURE DIRECT AND MASKL OR LDB DIR SPOOL JOB SZA WELL? LDB SRC SPOOL JOB STB STUS SET RESULT LDA G0WD2 GET THE STATUS FLAG AND B377 KEEP LOW PART CPA G0WD2 IF SAME IOR HBLK PAD WITH A BLANK IOR G0WD2 ANàm������þúD SET STA STUS+3 STATUS IN BUFFER LDA BLANK GET A BLANK AND STA STUS+4 PAD THE NEXT WORD LDA D18 SET DEFAULT LENGTH (ALSO START OF FILES) STA LEN IN CASE NO U.G OR FILES INA SET START ADDRESS FOR STA STAT U.G NAMES LDA U.GF CHECK IF USER GROUP TO BE SZA,RSS PRINTED JMP NOU.G NO SKIP THE FORMATING * JSB IPRSN ELSE PUT OUT A DEF *+4 MUG SHOT OF THE USER DEF G0UG1 11 WORD SOURCE TABLE DEF STAT+1 BUFFER ADDRESS DEF STAT FIRST WORD OF BUFFER IS LENGTH LDA ILEN SET START ADDRESS FOR STA LEN FILE REPORTS NOU.G JSB SETDB SET UP THE CHAR DEST. BUFFER DEF *+3 DEF STAT+1 DEF LEN AND COUNTER CLA,INA STA FNUM LDA W11AD RAL,CLE,SLA,ERA REMOVE INDIRECT BIT LDA A,I GET DIRECT ADDRESS STA ADDR1 LDA M5 STA CNTR LOOP LDA M16 STA CNTR1 LDA ADDR1,I STA SAVE ILOP SLA JMP GOTON BACK RAR STA SAVE ISZ FNUM ISZ CNTR1 JMP ILOP * ISZ ADDR1 ISZ CNTR JMP LOOP * OUT LDA LEN CALCULATE THE RECORD SIZE CPA ILEN IF NO FILES LDA STAT USE PASSED BACK COUNT CMA,INA SET NEG TO INDICATE CHAR STA STAT SET LENGTH IN THE BUFFER JSB G1OMS DEF *+2 DEF STAT JMP G1STM,I GOTON JSB KCVT CONVERT DEF *+2 DEF FNUM THE FILE NUMBER STA TBUF SAVE IN A BUFFER JSB ZPUT PUT THE THREE CHAR STRING ' XX' DEF *+4 DEF BLANK STARTS WITH SECOND BLANK DEF D2 DEF D3 3 CHARS LDA LEN CHECK IF ROOM FOR MORE ADA N76 SSA,RSS WELL?? JMP OUT NO MORE ROOM JUST REPORT WHAT WE HAVE LDA SAVE JMP BACK NO CONTINUE * * SUP Ú¶����� JNO NOP U.GF NOP N18 DEC -18 STAT ASC 3 NAME ASC 3 STUS BSS 29 * DIR ASC 1, D SRC ASC 1, S LEN NOP ILEN DEC 40 FNUM BSS 1 ADDR1 BSS 1 CNTR BSS 1 W11AD DEF G0W11 CNTR1 BSS 1 B377 OCT 377 MASKL OCT 177400 D2 DEC 2 D3 DEC 3 D18 DEC 18 N76 DEC -76 M5 DEC -5 M16 DEC -16 BLANK OCT 20040 TBUF NOP MUST BE AFTER A BLANK HBLK OCT 20000 SAVE BSS 1 A EQU 0 B EQU 1 END ������������������������������������������������ž7������ÿÿ����� ���� ÿý��‡ ���������ÿ��92067-18437 1903� S C0122 �&GASP2 � � � � � � � � � � � � � �H0101 |z�����ASMB,R,L HED GASP2 * NAME: GASP2 * SOURCE: 92067-18437 * RELOC: 92067-16425 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP2,5 92067-16425 REV.1903 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP2 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDA DEF G1CDA EXT G1CQQ DEF G1CQQ EXT G1CIN DEF G1CIN EXT G1CSD DEF G1CSD EXT G1CSU DEF G1CSU END GASP2 ������������������������������������������������������ôû������ÿÿ����� ���� ÿý�€�† ���������ÿ��92067-18438 2013� S C0122 �&G1CSD �GASP SD COMMAND � � � � � � � � � � � � �H0101 †�����þúASMB,R,Q,C G1CSD SHUT DOWN/START UP HED G1CDS * NAME: G1CSD,G1CSU * SOURCE: 92067-18438 * RELOC: 92067-16425 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CSD,8 92067-16425 REV.2013 800102 * ENT G1CSD,G1CSU * EXT G0SDN,G0JDN,G0RTN,.ENTR EXT G0DCB,G0BUF,G0WD2,G0WD9 EXT G0W15,G0CAP EXT G1OPN,READF,WRITF,POST,RNRQ,G1CAP,G1CHK EXT EXEC * A EQU 0 B EQU 1 SUP * PBUF3 NOP PLEN3 NOP IERR3 NOP * G1CSD NOP JSB .ENTR FETCH PARAMETERS DEF PBUF3 CLA CLEAR ERROR RETURN PARM STA IERR3,I LDB PBUF3 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SD" LDA B,I STA PBUF3 SAVE PARAMETER 2 INDICATOR INB LDB B,I GET SECOND PARAMETER STB SFLAG SAVE THE SHUT DOWN FLAG JSB G1CAP GET USER AND PRIV CAP DEF *+2 DEF IERR3,I SEZ ERROR? JMP EXIT4 YES * LDA PBUF3 SZA,RSS IF NO PARAM 2 JMP BOTH THEN SHUT DOWN SPOOL AND JOBS * CPA D2 JMP SDASC SDBPR LDA D56 BAD PARAMETER JMP EXIT3 * BOTH STA SFLAG SET PARAM 2 TO 0 JMP SDSP IF NOT SPECIFIED * SDASC LDA SFLAG GET PARAM 2 CPA "S" SHUT DOWN SPOOLS? JMP SDSP YES CPA "B" SHUT DOWN BATCH JOBS? JMP SDBA YES JMP SDBPR ELSE BAD PARAM * SDSP JSB OPLOK TO SHUT DOWN SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN * JSB CAP? ENOUGH Ca]������þúAPABITILITY? * LDA D3 READ RECORD 3 JSB RD TO MEM * LDA "D" OK SET "D" INTO 1ST WORD CLB CPA G0BUF WAS IT ALREADY SHUT DOWN? LDB D4 YES, THEN SET FLAG FOR ACCTS PROG STB SPFLG USED FOR RETURN PARM FOR ACCTS PROG STA G0BUF OF REC 3 FOR SHUT DOWN STA G0SDN SET FLAG FOR TERM JSB WR WRITE THE RECORD BACK * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 SHUTDOWN PROCEDURE DEF S23 =100027B -- NO ABORT DEF SMP DEF D16 * JMP NOSMP SMP CANNOT BE SCHEDULED * LDA SFLAG SZA SHUTDOWN BOTH? JMP EXIT4 NO, DONE. * SDBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI * LDA D17 READ JOB RECORD JSB RD 17 * JSB CAP? DOES HE HAVE IT?? * CLB LDA "D" YES SET "D" INTO 15TH WORD CPA G0W15 WAS IT ALREADY SHUT DOWN? LDB D3 YES, THEN SET FLAG FOR ACCTS PROG STB BAFLG STA G0W15 AS FLAG FOR BM STA G0JDN SET FLAG FOR TERM JSB WR WRITE THE RECORD BACK RSS * EXIT3 STA IERR3,I EXIT4 JSB ULOKP NOW UNLOCK RN, POST FILE NOP CLB,INB SET UP RETURN FLAG FOR ACCTS LDA SPFLG GET SPOOL DOWN FLAG ADA BAFLG ADD TO IT BATCH DOWN FLAG SZA EITHER BOTH OR SPOOL OR BATCH WAS DOWN? LDB A YES, SET RETURN PARAMETER CPB D7 IF BOTH WERE DOWN THEN SEND LDB D2 BACK 2 AS RETURN PARM STB G0RTN 1=NONE DOWN,2=BOTH,3=BA,4=SP LDA IERR3,I JMP G1CSD,I RETURN * NOSMP LDA M48 SMP CANNOT BE SCHEDULED JMP EXIT3 * * RD NOP COMMON READ ROUTINE A= RECORD # STA REC SAVE THE RECORD # JSB READF DO THE READ DE3u������þúF *+7 DEF G0DCB USE STD. DCB DEF IERR3,I PASS ERRORS TO CALLERS CALLER DEF G0BUF READ TO COMMON BUFFER DEF D16 DEF RUBSH DON'T NEED RETURN LENGTH DEF REC RECORD NUMBER SSA IF THERE IS AN ERROR JMP EXIT3 EXIT ERROR IS IN IERR3 * JMP RD,I ELSE RETURN * * WR NOP SAME TYPE OF THING FOR JSB WRITF USE SAME RECORD NUMBER AS LAST READ DEF *+6 DEF G0DCB COMMON DCB DEF IERR3,I DEF G0BUF DEF D16 16 WORD RECORDS DEF REC RECORD NUMBER SSA TEST ERROR FLAG JMP EXIT3 ERROR EXIT * JMP WR,I ELSE RETURN READ OK * * CAP? NOP ROUTINE TO TEST CAPABILITY OF USER JSB G1CHK AGAINST THE PRIVILEGED CAP DEF *+2 DEF IERR3,I SEZ ERROR? JMP EXIT4 YES, NOT ENOUGH CAPABILITY * JMP CAP?,I RETURN * D7 DEC 7 M48 DEC -48 SFLAG NOP SPFLG NOP BAFLG NOP REC NOP RUBSH NOP HED G1CSU START UP SPOOL AND/OR BATCH SYSTEM PBUF4 NOP PLEN4 NOP IERR4 NOP * G1CSU NOP JSB .ENTR FETCH PARAMETERS DEF PBUF4 DLD IERR4 SET UP TO EXIT DST IERR3 THROUGH SHUT DOWN CLA CLEAR ERROR RETURN STA IERR3,I STA SPFLG STA BAFLG JSB G1CAP GET USER AND PRIV CAPABILITY DEF *+2 DEF IERR3,I SEZ ERROR? JMP EXIT4 YES * JSB EXEC TELL JOB TO CLEAN UP DEF *+4 IN ANY CASE DEF D9 IF BUSY DON'T WAIT DEF JOB DEF MD1 -1 CLEAN UP ONLY LDB PBUF4 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SU" LDA B,I STA PBUF4 SAVE FOR NOW INB LDB B,I GET S OR B FLAG STB SFLAG SAVE IT JSB G1CAP GET USER AND PRIV CAP DEF *+2 DEF IERR3,I N������þú SEZ IF ERROR JMP EXIT4 RETURN * LDA PBUF4 GET THE 2ND PARM SZA,RSS IF NO PARAM 2 JMP BOTHU THEN START UP SPOOL AND JOBS CPA D2 JMP SUASC * SUBPR LDA D56 JMP EXIT3 * BOTHU STA SFLAG SET PARAM 2 TO 0 JMP SUSP IF NOT SPECIFIED * SUASC LDA SFLAG GET PARAM 2 CPA "S" START UP SPOOLS? JMP SUSP YES CPA "B" START UP BATCH JOBS? JMP SUBA YES JMP SUBPR ELSE BAD PARAM * SUSP JSB OPLOK TO START UP SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN * LDA D3 THEN READ REC 3 JSB RD * LDB G0BUF IF SHUT DOWN THENHEN CPB "D" JSB CAP? CHECK THIS DUDE OUT. * CLA OK HE IS CLEAN SO CLEAR 1ST WORD STA G0BUF OF REC 3 FOR START UP STA G0SDN SET GLOBAL FLAG TOO TO LET SMP KNOW. JSB WR WRITE REC BACK TO SPLCON FILE * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 START UP PROCEDURE DEF S23 =100027B -- NO ABORT RETURN DEF SMP DEF D17 * JMP NOSMP SMP CANNOT BE SCHEDULED * LDA SFLAG SZA START UP BOTH? JMP EXIT4 NO, DONE. * SUBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI * LDA D17 READ REC # 17 JSB RD LDB G0W15 GET CURRENT STATUS CPB "D" IF DOWN NOW THEN JSB CAP? TEST IF THIS DUDE IS OK * CLA YES HE IS CLEAN SO CLEAR 15TH WORD STA G0W15 AS FLAG FOR BM STA G0JDN SET LOCAL GLOBAL TOO JSB WR WRITE RECORD BACK * JSB EXEC SCHEDULE FMGR DEF *+4 TO UPDATE JOBS DEF D10 DEF FMGR DEF MD1 -1 MEANS JOB UPDATE ONLY * SUDN JMP EXIT4 USE COMMON EXIT CODE * * HED COMMON ROU$¨�����TINES AND CONSTANTS TO DS,CS,SD,SU * * JSB OPLOK * DEF FILENAME * <GOOD RETURN, (A)=MEANINGLESS> * OPLOK NOP OPEN FILE AND LOCK RN LDA OPLOK,I GET ADDR OF FILE NAME STA FNAME ISZ OPLOK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF ULOKP FNAME DEF * * CLA,INA READ THE JSB RD FIRST RECORD LDA G0BUF GET FIRST WORD OF RECORD STA RNWD WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT * JMP OPLOK,I RETURN * * * * * JSB ULOKP * <ERROR RETURN> * <GOOD RETURN> * ULOKP NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF RNWD DEF RNSTT ULOK1 ISZ ULOKP JMP ULOKP,I RETURN * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D9 DEC 9 D16 DEC 16 D17 DEC 17 D10 DEC 10 D56 DEC 56 S23 OCT 100027 MD1 DEC -1 * RNSTT DEC 1 RNWD NOP TEMP NOP RNLOK OCT 1 RNULK OCT 4 "B" ASC 1,B "B " "D" OCT 104 "S" ASC 1,S "S " SMP ASC 3,SMP FMGR ASC 3,FMGR JOBFI ASC 3,JOBFIL JOB ASC 3,JOB SPCON ASC 3,SPLCON * BSS 0 SIZE END ����������������������������������������������y������ÿÿ����� ���� ÿý�� ‹ ���������ÿ��92067-18439 2013� S C0122 �&G1C?? �GASP ?? COMMAND � � � � � � � � � � � � �H0101 nh�����þúASMB,R,Q,C HED G1C?? - GASP ERROR EXPANDER MODULE * NAME: G1C?? * SOURCE: 92067-18439 * RELOC: 92067-16425 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1C??,8 92067-16425 REV.2013 800102 ENT G1CQQ EXT .DFER,G1OMS,G0BUF,G0ERH,G0TTY,.ENTR EXT EXEC SUP N NOP LST NOP SPC 1 G1CQQ NOP ENTRY POINT JSB .ENTR GEN PRAMS DEF LST SPC 1 LDA LST ADVANCE PRAM TO ADA .4 THE FIRST PRAM STA LST AND RESTORE LDB G0ERH GET ERROR PRAM ASR 16 EXTEND THE SIGN BIT DIV .1000 DIVID LDA B ERROR CODE TO A LDB LST,I GET FLAG ISZ LST STEP TO SZB IF NOT SUPPLIED USE .E.R. LDA LST,I ELSE USE FIRST PRAM CPA .99 IF PRAM=99 JMP ALL THEN PRINT ALL CODES ON LIST STA N SAVE CODE ADA MOSNG TEST FOR SSA DEFINED CODE JMP UDF TOO NEGATIVE LDA N ADA NHLP1 SSA JMP PRINT OK - PRINT IT ADA NHLG SSA JMP UDF IN MID CODE GAP - UNDEFINED ADA NHH SSA,RSS JMP UDF TO HIGH - UNDEFINED LDA N ADJUST N ADA NHLG FOR HIGH GROUP STA N TABLE PRINT LDA N GET N ADA TBAD ADD TABLE ADDRESS PR LDB A,I GET MESSAGE ADDRESS STB MSAD SET AS POINTER LDB B,I MESSAGE STB A LENGTH CMA,INA SET FOR QG������þú STA N MOVE ADB .2 AND STB LNMES OUTPUT JSB .DFER MOVE THE FIRST THREE WORDS DEF G0BUF TO THE BUFFER DEF LNMES INCLUDES THE LENGTH AND NAME LDA BUF.D HEAD RSS LDA A,I OF RAL,CLE,SLA,ERA MESSAGE JMP *-2 GET ADA .3 BUFFER ADDRESS AND MOVE ISZ MSAD LDB MSAD,I MOVE STB A,I MESSAGE INA TO ISZ N BUFFER JMP MOVE JSB G1OMS PRINT DEF FMRTN ON BUF.D DEF G0BUF DEVICE FMRTN CLA STA G0ERH JMP G1CQQ,I ELSE, RETURN SPC 3 UDF LDA DFUDF PICK UN DEFINED JMP PR AND SEND IT. SPC 3 ALL LDA G0TTY SAVE THE TTYLU STA TTY LOCALLY LDA LST IF ADA .4 A LU SUPPLIED LDA A,I THEN USE SZA IT STA G0TTY LDA G0TTY GET THE LU AND B77 KEEP ONLY THE LU IOR B1100 ADD THE PAGE BITS STA LUX SET FOR EJECT LDA PTRS SET THE STA CPTRS POINTER FOR THE MESSAGES WRIT JSB G1OMS WRITE DEF WRRTN THE CPTRS NOP THE WRRTN ISZ CPTRS LDA CPTRS ELIMINATE THE RAL,CLE,ERA NOT DEFINED LDA A,I MESSAGES CPA NDEF UNDEFINED MESSAGE? JMP WRRTN YES SKIP IT * LDA CPTRS,I IF LENGTH NEGATIVE SSA,RSS SKIP JMP WRIT ELSE GO WRITE NEXT MESSAGE SPC 3 LDA TTY RESTORE THE TTY LU STA G0TTY JSB EXEC SEND THE TOP OF FORM DEF EX DEF .3 DEF LUX DEF N2 EX JMP G1CQQ,I GO EXIT SPC 2 .1000 DEC 1000 .99 DEC 99 N2 DEC -2 .2 DEC 2 .3 DEC 3 .4 DEC 4 B77 OCT 77 B1100 OCT 1100 TTY NOP LUX NOP SPC 1 MSAD NOP DFUDF DEF *+1 NDEF DEF UDN-1 LNMES NOP «������þúGASP ASC 2,GASP TBAD DEF MS00 PTRS DEF LSHED,I ABS LUDN UDN ASC 6, NOT DEFINED LUDN EQU *-UDN LSHED DEF HEAD-1 THIS LIST DEF BLNK-1 IS IN DEF HD2-1 THE DEF BLNK-1 ORDER DEF ERM48-1 REP 14 DEF UDN-1 DEF ERM33-1 DEF ERM32-1 REP 17 DEF UDN-1 DEF ERM14-1 OF DEF ERM13-1 PRINTING DEF ERM12-1 AND DEF UDN-1 ALSO DEF UDN-1 NUMERICAL DEF UDN-1 ORDER DEF ERM8-1 DEF ERM7-1 DEF ERM6-1 DEF UDN-1 DEF ERM4-1 DEF UDN-1 DEF ERM2-1 DEF ERM1-1 MS00 DEF ER0-1 DEF ER1-1 DEF ER2-1 DEF ER3-1 DEF ER4-1 DEF ER5-1 DEF ER6-1 HLOW EQU *-MS00-1 MOST POSITIVE OF LOW GROUP DEF ER43-1 DEF UDN-1 DEF UDN-1 DEF ER46-1 REP 7 DEF UDN-1 DEF ER54-1 DEF ER55-1 DEF ER56-1 NHIG EQU *-MS00-HLOW-2 NUMBER OF HIGH ERRORS DEF N2 * A EQU 0 B EQU 1 MSTN EQU 48 MOST NEGATIVE ERROR CODE LHIG EQU 43 LOWEST OF HIGH GROUP HHIG EQU LHIG+NHIG HIGHEST OF HIGH GROUP SPC 1 MOSNG ABS MSTN MOST NEG. CODE NHLP1 ABS -HLOW-1 NEG. OF LOW HIGH BOUND NHLG ABS HLOW+1-LHIG NEG. OF LOW HIGH GAP NHH ABS LHIG-HHIG-1 NEG. OF HIGH SIZE. * * ERROR TABLE -CODES ARE ENTERED IN ANY ORDER. * ABS L0 ER0 ASC 6, 0 NO ERROR L0 EQU *-ER0 ABS LM1 ERM1 ASC 7, -1 DISC ERROR LM1 EQU *-ERM1 ABS LM2 ERM2 ASC 12, -2 DUPLICATE FILE NAME LM2 EQU *-ERM2 ABS LM4 ERM4 ASC 19, -4 MORE THAN 32767 RECORDS IN A TYPE ASC 4, 2 FILE LM4 EQU *-ERM4 ABS LM6 ERM6 ASC 9, -6 FILE NOT FOUND LM6 EQU *-ERM6 ABS LM7 ERM7 ASC 13, -7 BAD FILE SECURITY CODE LM7 EQU *-ERM7 ABS LM8 ERM8 ASC 15, -8 FILE OPEN OR LOCK REJECTED LM8 EQU *-ERM8 ‡{����� ABS LM12 ERM12 ASC 11, -12 EOF OR SOF ERROR LM12 EQU *-ERM12 ABS LM13 ERM13 ASC 8, -13 DISC LOCKED LM13 EQU *-ERM13 ABS LM14 ERM14 ASC 10, -14 DIRECTORY FULL LM14 EQU *-ERM14 * ABS LM32 ERM32 ASC 15, -32 DISC CARTRIDGE NOT FOUND. LM32 EQU *-ERM32 ABS LM33 ERM33 ASC 19, -33 NOT ENOUGH ROOM ON DISC CARTRIDGE. LM33 EQU *-ERM33 * ABS LM48 ERM48 ASC 14, -48 SMP CANNOT BE SCHEDULED LM48 EQU *-ERM48 SPC 1 ABS L1 ER1 ASC 7, 1 DISC ERROR L1 EQU *-ER1 ABS L2 ER2 ASC 11, 2 NUMBER OUT OF RANGE L2 EQU *-ER2 ABS L3 ER3 ASC 9, 3 BAD JOB NUMBER! L3 EQU *-ER3 ABS L4 ER4 ASC 9, 4 ILLEGAL STATUS L4 EQU *-ER4 ABS L5 ER5 ASC 9, 5 ILLEGAL COMMAND L5 EQU *-ER5 ABS L6 ER6 ASC 6, 6 NOT FOUND L6 EQU *-ER6 SPC 2 ABS L43 ER43 ASC 12, 43 LU NOT FOUND IN SST L43 EQU *-ER43 ABS L46 ER46 ASC 14, 46 INSUFFICIENT CAPABILITY! L46 EQU *-ER46 * ABS L54 ER54 ASC 13, 54 MOUNT ALL SPOOL DISCS! L54 EQU *-ER54 ABS L55 ER55 ASC 11, 55 MISSING PARAMETER L55 EQU *-ER55 ABS L56 ER56 ASC 9, 56 BAD PARAMETER L56 EQU *-ER56 SPC 2 ABS LHEAD HEAD ASC 9, GASP ERROR CODES LHEAD EQU *-HEAD ABS LHD2 HD2 ASC 9, ERROR MEANING LHD2 EQU *-HD2 ABS LBLNK BLNK ASC 1, LBLNK EQU *-BLNK ORG * PROGRAM LENGTH END ��������������������������������������������������������ÍŠ������ÿÿ����� ���� ÿý�‚�‹ ���������ÿ��92067-18440 2013� S C0122 �&G1CIN �GASP IN COMMAND � � � � � � � � � � � � �H0101 ~‚�����þú SPL,L,O ! NAME: G1CIN ! SOURCE: 92067-18440 ! RELOC: 92067-16425 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CIN(8) "92067-16425 REV.2013 800102" ! LET G1CDA, \DA COMMAND PROCESSOR G1OMS, \OUTPUT MESSAGE ROUTINE G1ZAP, \ZAP A BUFFER ROUTINE (16 WORDS) G1WFI, \WRITE A RECORD TO CURRENT FILE G1RD, \READ A RECORD FROM FILE G1OPN, \INTERNAL OPEN FILE ROUTINE G1CQQ, \?? COMMAND PROCESSOR G1ERP, \ERROR PRINT ROUTINE EXEC, \WHERE DID THIS COME FROM XLUEX, \EXTENDED LU EXEC CALL G1IMS, \INPUT RESPONCE ROUTINE POST, \FMP POST FILE ROUTINE CREAT, \FMP CREAT FILE ROUTINE OPEN, \FMP OPEN FILE ROUTINE CLOSE, \FMP CLOSE FILE ROUTINE RNRQ, \SYSTEM RESOURCE NUMBER ROUTINE ISMVE, \MOVE FROM SCB SUB. CNUMD \SYSTEM NO. TO DEC. ASCII SUB BE SUBROUTINE,EXTERNAL ! LET .DFER, \THREE WORD MOVE ROUTINE ST.LU, \SET UP $LUAV cÂ������þúECT. G1PCR \ROUTINE TO SET $SPCR BE SUBROUTINE,EXTERNAL,DIRECT ! ! LET KCVT, \CONVERT NO. TO 2-DIG. ASCII ICAPS \CURRENT USER CAPABILITY FETCH BE FUNCTION,EXTERNAL ! LET CRERR \INTERNAL ERROR SUB. BE SUBROUTINE LET GERR, \GENERATE GASP 2 ERROR ERPST \POST ERROR IN SCB BE SUBROUTINE,DIRECT ! LET G0END, \"GASP END" G0NJB, \"MAX NUMBER OF JOBS,..." G0NLO, \"NUMBER,LOCATION OF SPOOL ...." G0SZF, \"SIZE OF SPOOL FILES ...." G0NSP, \"NUMBER OF SPOOL FILES ...." G0MXP, \"MAXIMUM NUMBER ACTIVE ..." G0SLU, \"ENTER OUTSPOOL DESTI...." G0PCA, \"CAPABILITY LEVEL FOR PRIV..." \ G0JBF, \"JOBFIL" G0SPF, \"SPLCON" G0JDC, \JOBFIL DCB G0SDC, \SPLCON DCB G0DCB, \MASTER DCB G0BUF, \INTERNAL BUFFER 16 WORDS G0WD1, \WORD 1 OF G0BUF G0WD2, \WORD 2 OF G0BUF G0WD3, \WORD 3 OF G0BUF G0WD4, \WORD 4 OF G0BUF G0WD7, \WORD 7 OF G0BUF G0WD8, \WORD 8 OF G0BUF G0WD9, \WORD 9 OF G0BUF G0W10, \WORD 10 OF G0BUF ÍN������þú G0W11, \WORD 11 OF G0BUF G0W15, \WORD 15 OF G0BUF \ G0PBF, \PARSE BUFFER G0P1V, \PARAMETER 1 VALUE FROM G0PBF G0P2V, \PARAMETER 2 VALUE FROM G0PBF \ G0SDN, \SPOOL SHUT DOWN FLAG G0JDN, \JOB SHUT DOWN FLAG G0TTY, \TERMINAL LU + 400B G0NPR, \NO PRINT FLAG N.SEQ \NUMBER OF SPOOL EQTS BE INTEGER,EXTERNAL ! LET PBUFX, \INTERNAL BUFFER BUFX1, \WORD 1 OF PBUFX BUFX2, \WORD 2 OF PBUFX BUFX3, \WORD 3 OF PBUFX BUFX4, \WORD 4 OF PBUFX BUFX5(4), \WORD 5 OF PBUFX BUFX9, \WORD 9 OF PBUFX BUX10(4), \WORD 10 OF PBUFX BUX14, \WORD 14 OF PBUFX BUX15(17) \WORD 15 OF PBUFX BE INTEGER ! LET NOTIN(16) BE INTEGER INITIALIZE NOTIN TO -29,"SPOOL SYSTEM NOT INITIALIZED!" LET DUPNM(8),MESS(4),DINIT(8) BE INTEGER INITIALIZE DUPNM,MESS TO 11,"DUP FILE NAME XXXXXX. " INITIALIZE DINIT TO 7,"DEINITIALIZE?_" ! LET NOROM(3),DNO(12),MS,MSS(11) BE INTEGER INITIALIZE NOROM,DNO,MS,MSS TO 27,\ DISC FULL MESSAGE "DISC XXXXX FULL OR MISSING, XX SPOOL FILES CREATED. " ! LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IERR BE INTEGER !TWO LINES INITIALIZE SPOL TO "SPOL" INITIALIZE SPLNO TO 1 INITIALIZE SIZE1 TO 16 ,ý������þú! LET E BE CONSTANT(42440K) LET EXIT BE CONSTANT(42530K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! G1CIN: SUBROUTINE GLOBAL ASSEMBLE["EXT $SMID";"XLA $SMID";"STA SMID";\GET SESSION ID "EXT $DSCS";"XLA $DSCS";"STA DSCS"]!GET SESSION IS FLAG INOVR: PVCAP _ 0 !SET CAP INCASE SESSION IS NOT IF DSCS < 0 THEN GO TO INIT !IF NOT SESSON THEN GO INITIALIZE CAP _ ICAPS() !GET USERS CAP. CALL ISMVE($($1717K+32),SMID,USID,1) !GET USER ID WORD IF USID = 7777K THEN GO TO INIT0 !ALLOW ONLY SYSTEM MGR. HERE CALL G1OMS(NOTIN) !ELSE SEND "SPOOL SYS NOT INTI.." GO TO EXSM !AND EXIT ! INIT0: CALL G1IMS(G0PCA) !GET CAP FOR PRIV COMMANDS IF G0P1V > CAP THEN[ \IF MORE THAN SYS. MGR. CALL GERR; \COMPLAIN ABOUT IT GO TO INIT0] !AND TRY AGAIN PVCAP_G0P1V !AND SAVE IT FOR LATER ! INIT: CALL ST.LU AB_0 !CLEAR DEALLOCATE FLAG CLSFL_0 !CLEAR CLOSE FLAG FOR JOBFIL F _ -2 !SET FLAG FOR NO SHUT DOWN INIT2: CALL G1IMS(G0NJB) !INITIALIZE THE BATCH IFNOT [SAVE1 _ G0P1V] > 0 THEN [ \SYSTEM. GET # OF JOBS. INIT1: CALL GERR; GOTO INIT2] ! SIZE _ 3 IF G0P1V > 254 THEN GOTO INIT1 IF [SAVE _ G0P1V - 6] <= 0 THEN \FIGURE OUT THE SIZE OF GOTO CRJOB !JOBFIL, AND CREATE IT. IF (SAVE AND 7K) THEN \ SIZE _ SIZE + 1 SIZE _ (SAVE >-3) + SIZE CRJOB: SPDIS_G0P2V !SET THE DISC FOR JOBFIL CALL CREAT(G0DCB,IERR,G0JBF,SIZE,2,SEC,SPDIS) IF IERR = -32 THEN[ |\������þú \IF NOT A SYSTEM DISC COMPLAIN CALL G1CQQ(SIZE); \AND TRY GO TO INIT2] !AGAIN ! CALL CRERR(G0JBF) !CHECK FOR ERRORS CALL G1ZAP(PBUFX) CALL RNRQ(20K,IRN,SAVE) !ALLOCATE JOBFIL RN. PBUFX _ IRN !PUT IT IN JOBFIL. CALL G1WFI(PBUFX,0) ? [GOTO EXIN] PBUFX _ 0 !INITIALIZE FIRST 2 REPEAT 15 TIMES DO [ \JOBFIL SECTORS. CALL G1WFI(PBUFX,0) ? \ [GOTO EXIN]] NSP: CALL G1IMS(G0NSP) !GET # OF SPOOL FILES. IF [NSPL,BUFX2 _ G0P1V] > 80 THEN [ \MAKE SURE IT IS NOT NSP1: CALL GERR; GOTO NSP] !MORE THAN 80. IFNOT NSPL > 4 THEN GOTO NSP1 SZS: CALL G1IMS(G0SZF) !GET SIZE OF SPOOL FILES. IFNOT G0PBF = 1 THEN GOTO SZS1 !MAKE SURE NUMERIC. IFNOT [SSPOL,BUFX3 _ G0P1V] > 0 THEN [\MAKE SURE IT IS NON-ZERO. SZS1: CALL GERR; GOTO SZS] BUFX1 _ [SIZE _ SAVE1 + 18] PBUFX _ IRN !PUT IN RN NUMBER. RNRQ(20K,WRN,SAVE) !ALLOCATE HOLD BEM RN. BUX14 _ WRN BUFX9 _ PVCAP !SET CAP LEVEL IN RECORD WRT1: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 17. NOL: CALL G1ZAP(PBUFX) ADDR _ @PBUFX-1; FFILE _ 1 REPEAT 8 TIMES DO [ \GET # OF SPOOL FILES CALL G1IMS(G0NLO); \AT EACH LOCATION AND IF G0P1V = E THEN GOTO ADDUP; \MAKE UP JOBFIL IF G0P1V ="/E" THEN GO TO ADDUP; \ $[ADDR _ ADDR+1] _ (G0P1V <-8) \RECORD 18. XOR FFILE; \ FFILE _ FFILE + G0P1V; \ $[ADDR _ ADDR+1] _ G0P2V] ADDUP: ADDR _ @PBUFX-2 ;SAVE1 _ 0 !CHECK IF THE # OF FILES REPEAT 8 TIMES DO [ \AT EACH LOC‡Æ������þúATION AGREES SAVE1 _ (($[ADDR _ ADDR+2] -<8) \WITH THE TOTAL # OF AND 377K) + SAVE1] !FILES. IFNOT SAVE1 = NSPL THEN [ \IF DISAGREE, DO OVER. CALL GERR; GOTO NOL] WRT2: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 18. CALL G1ZAP(G0BUF) G0BUF _ -1 FOR SAVE _ 19 TO SIZE DO [ \INITIALIZE REST OF CALL G1WFI(G0BUF,0) ? \JOBFIL. [GOTO EXIN]] ! ! MNS: CALL G1IMS(G0MXP) !GET SPLCON INFORMATION. IFNOT G0PBF = 1 THEN GOTO MNS1 IFNOT [BUFX1 _ G0P1V + N.SEQ] >= NSPL\GET MAXIMUM # THEN [ \ MNS1: CALL GERR; GOTO MNS] !OF SPOOL FILES. IFNOT [BUFX4 _ G0P1V] > 0 \ THEN GOTO MNS1 BUFX2 _ 0; ADDR _ @BUFX5 REPEAT 11 TIMES DO THRU LUSET LUN: CALL G1IMS(G0SLU) !GET LOGICAL UNIT IF G0P1V = E THEN GOTO ALLDN !NUMBERS FOR IF G0P1V ="/E" THEN GOTO ALLDN !NUMBERS FOR IF [G0P1V_G0P1V AND 377K] < 3 THEN GO TO LUNER !LU 1,2 ILL CALL XLUEX(100015K,G0P1V+100000K,EQT5) !GET DRIVER TYPE GO TO LUNER !BAD LU ERROR IF (EQT5 AND 36000K)=14000K THEN[ \DISC ILLGAL LUNER: GERR;GO TO LUN] !REPORT ERROR AND TRY IFNOT [G0P2V_G0P2V AND 17K] THEN G0P2V_4 !DEFAULT DEPTH $[ADDR _ ADDR+1] _ G0P1V+G0P2V*400K !LEVEL IN HIGH HALF LUSET: BUFX2 _ BUFX2 + 1 ALLDN: IF (BUFX1 AND 7K) THEN SIZE _ 1, \ ELSE SIZE _ 0 SIZE _ (BUFX1 >-3) + SIZE + BUFX2 + 1 CCR: CREAT(G0DCB,IERR,G0SPF,SIZE,2,SEC,SPDIS)!CREATE SPLCON. CALL CRERR(G0SPF) F _ -1 !SET FLAG FOR SHUT DOWN O.K. BUFX3 _ ((BUFX2+1) <-3) + 1 RNRQ(20K,PBUFX,SAVE) !ALLOCATE SPLCON RN. ADDR _ @BUFX5 CALL G1ZAP(G0BUF) Ö×������þú G1WFI(G0BUF,2) ? [GOTO EXIN] !WRITE 2ND SPLCON REC. G0WD1 _ WRN G0WD2 _ PVCAP !SET PRIV CAP FOR SPLCON REC 3 REPEAT 6 TIMES DO [G1WFI(G0BUF,0) \ ? [GOTO EXIN]; \ G0WD2,G0WD1 _ 0] REPEAT BUFX2 TIMES DO [ \SET UP LOGICAL UNIT G0BUF _ $[ADDR _ ADDR+1]; \SECTORS IN SPLCON. $ADDR_$ADDR AND 377K; \ISOLATE THE LU G1WFI(G0BUF,0) ? [GOTO EXIN]; \ G0BUF _ 0; \ REPEAT 7 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? \ [GOTO EXIN]]] CALL G1ZAP(G0BUF); G0BUF _ -1 REPEAT BUFX1 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? [GOTO EXIN]] ! CALL G1WFI(PBUFX,1)?[GOTO EXIN] !WRITE 1ST SPLCON REC. ! AB_1 !SET DEALLOCATE FLAG CALL OPEN(G0JDC,IERR,G0JBF,3,SEC,SPDIS) !REOPEN JOB FILE CALL CRERR(G0JBF) CALL G1OPN(G0DCB,IERR,G0JBF) !SET UP MASTER DCB FOR JOBFIL CALL CRERR(G0JBF) AB _ 0 !CLEAR DEALLOCATE FLAG CALL G1PCR (G0DCB) !SET UP $SPCR TO JOBFIL CRN CALL G1RD(PBUFX,18) !GET BACK RECORD 18 ADDR _ @PBUFX-1 REPEAT 8 TIMES DO THRU LAST !CREATE ALL THE SPOOL FFILE _ $[ADDR _ ADDR+1] AND 377K !FILES. SAVE1 _ (($ADDR -<8) AND 377K)+FFILE-1 ICR _ $[ADDR _ ADDR+1] FOR FFILE _ FFILE TO SAVE1 DO [ \ IF [SPLNO _ KCVT(FFILE)] \ < 30000K THEN SPLNO _ \ SPLNO OR 30000K ; \ CALL CREAT(G0BUF,IERR,SPOL, \ SSPOL,3,SEC,ICR); \ IF IERR = -32 THEN GO TO TRUN; \ IF IERR= -33 THEN GO TO TRUN; \ CALL CRERR(SPOL)] LAÍY������þúST: ! CALL CLOSE(G0BUF) EXINT: CALL CLOSE(G0DCB) !CLOSE THE FILE AND RETURN ! ! TRUN: CALL G1RD(G0BUF,17) !SET UP JOB FILE FOR G0WD2_FFILE -1 !THE ACTUAL NUMBER OF FILES CALL G1WFI(G0BUF,17) !WRITE IT OUT CLSFL _ 1 !SET FLAG TO CLOSE JOBFIL MS_KCVT(FFILE-1) !SET UP THE MESSAGE CALL CNUMD(ICR,DNO) CALL G1OMS(NOROM) !SEND NO ROOM MESSAGE GO TO AGAIN END ! ! CRERR: SUBROUTINE(FIN) IF IERR > 0 THEN RETURN !IF NO ERRORS RETURN IF IERR = -2 THEN [CALL .DFER(MESS,FIN); \IF DUP NAME CALL G1OMS(DUPNM); \SEND MESSAGE AND GET ANS. AGAIN: CALL G1IMS(DINIT); \SEND MESSAGE AND GET ANS. IF G0P1V = "YE" THEN[ \IF DEINITIALIZING THEN CALL OPEN(G0SDC,IERR,G0SPF,3,SEC,SPDIS);\OPEN SPLCON FILE CALL G1CDA(F); \CALL DE-ALLOCATE ROUTINE GO TO INIT]] !GO TO RE-INITIALIZE IF CLSFL THEN CALL CLOSE (G0DCB) !CLOSE JOBFIL IF CLOSE FLAG SET EXIN: CALL G1CQQ(SIZE) !SEND ERROR MESSAGE CALL ERPST !SET IT UP FOR HELP EXSM: IF AB THEN[ \IF ABORT FLAG DEALLOCATE CALL G1CDA(-1); \AND THEN GO TO INOVR] !TRY AGAIN CALL G1OMS(G0END) !SEND END MESSAGE CALL EXEC(6) !TERMINATE END ! ! ERROR REPORT SUBROUTINE ! GERR: SUBROUTINE DIRECT IERR_2 !SET THE ERROR CODE CALL G1CQQ(SIZE) !PRINT THE MESSAGE CALL ERPST !SET UP FOR HELP RETURN END ! ! SET UP TO POST ERROR IN SCB ! ERPST: SUB“���6��40ROUTINE DIRECT G0NPR _ "NP" CALL G1ERP(IERR) G0NPR _ 0 RETURN END ! END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������<86������ÿÿ����� ���� ÿý�ƒ� ‘ ���������ÿ��92067-18441 2013� S C0122 �&G1CDA �GASP DA COMMAND � � � � � � � � � � � � �H0101 mp�����þú SPL,L,O ! NAME: G1CDA ! SOURCE: 92067-18441 ! RELOC: 92067-16425 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDA(8)"92067-16425 REV.2013 800102" ! LET G1OMS, \OUTPUT MESSAGE ROUTINE G1CQQ, \EXPAND AN ERROR CODE G1IMS, \PROMPT AND GET ANSWER G1CSD, \SHUT DOWN ROUTINE G1ZAP, \CLEAR A 16 WORD BUF. G1RD, \READ RECORD FROM CURRENT FILE G1ERP, \ERROR PROCESS ROUTINE ISMVE, \SCB READ ROUTINE \ PURGE, \FMP PURGE FILE ROUTINE OPEN, \FMP OPEN ROUTINE EXEC, \???? RNRQ \ALLOCATE/RELEASE RN NUMBERS BE SUBROUTINE,EXTERNAL ! LET .DFER, \MOVE THREE WORDS ROUTINE G1PCR \ROUTINE TO SET $SPCR BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT \CONVERT TO 2 CHAR. ASCII BE FUNCTION,EXTERNAL ! LET FERR \INTERNAL ERROR REPORTER BE SUBROUTINE ! LET G0END, \"END GASP" G0JBF, \"JOBFIL" G0SPF, \"SPLCON" G0D}������þúCB, \MASTER DCB G0BUF, \16 WORD BUFFER IN MAIN G0WD2, \WORD 2 OF G0BUF G0W14, \WORD 14 OF G0BUF G0P1V, \VALUE OF 1'ST PRAM IN PARSE BUF G0SDN, \LOCAL SPOOL SHUT DOWN FLAG G0JDN, \LOCAL JOB SHUT DOWN FLAG G0NPR \NO PRINT FLAG BE INTEGER,EXTERNAL ! LET RESON(8),MES(3) BE INTEGER INITIALIZE RESON TO 10,"ERROR ON FILE " ! LET G0N8M BE INTEGER(20) INITIALIZE G0N8M TO 19,"TRY DA AGAIN WHEN ABOVE FILE IS CLOSED" LET CLEAN(8) BE INTEGER INITIALIZE CLEAN TO 7,"SPOOL IS DEAD!" ! LET REALY(9) BE INTEGER INITIALIZE REALY TO 8,"KILL SPOOLING? _" ! LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IER,I BE INTEGER !TWO LINES INITIALIZE SPOL TO "SPOL" INITIALIZE SPLNO,IER TO 1,0 ! LET SEC BE CONSTANT(123456K) !JOBFIL/SPLCON SECURITY CODE LET RLF BE CONSTANT(40040K) !RN RELEASE CODE WORD ! G1CDA: SUBROUTINE(F) GLOBAL ! ! IF F = -1 OR -2 THEN COMING FROM INITIALIZE ! F = -1 IF O.K. TO SHUT DOWN ! F = -2 IF SHUT DOWN NOT O.K. BECAUSE SPLCON DOES NOT EXIST OR NOT OPENED ! ASSEMBLE["EXT $SMID";"XLA $SMID";"STA SMID";\GET SESSION ID "EXT $DSCS";"XLA $DSCS";"STA DSCS"]!GET SESSION IS FLAG IF DSCS < 0 THEN GO TO INIT !IF NOT SESSON THEN GO INITIALIZE CALL ISMVE($($1717K+32),SMID,USID,1) !GET USER ID WORD IF USID = 7777K THEN GO TO INIT !ALLOW ONLY SYSTEM MGR. HERE IER _ 46 !FAILED TEST SET UP ERROR CALL G1CQQ(SIZE) !SEND IT AND G0NPR _ "NP" !SET THE NO PRINT FLAG C������þúALL G1ERP(IER) !POST ERROR IN SCB AND RETURN !BAIL OUT! ! INIT: IF (F = -1 OR F = -2) THEN GO TO SHTDN !IF FROM INIT SKIP QUERY CALL G1IMS(REALY) !MAKE SURE IF G0P1V # "YE" THEN RETURN !IF A MISTAKE THEN RETURN ! ! FIRST CALL SHUT DOWN ! SHTDN: IF F = -2 THEN GO TO DOWN !SPLCON NOT OPENED OR CREATED IF G0JDN THEN[IF G0SDN THEN GO TO DOWN] IER _ 0 CALL G1CSD(SIZE1) ! ! FIRST GET THE NUMBER OF SPOOL POOL FILES TO PURGE ! DOWN: ASSEMBLE["XLA $SPCR";"EXT $SPCR";"STA SPCR"]! GET $SPCR CALL G1PCR(0) !ZAP $SPCR CALL OPEN(G0DCB,IER,G0SPF,0,SEC,SPCR) !TRY TO GET THE SPOOL CONTROL IF IER = -8 THEN [ \IF NOT AVAILABLE THEN CALL FERR(G0SPF); \REPORT IT AS SUCH AND GO TO EXX] !DO A REAL EXIT CALL G1ZAP(G0DCB) !ZAP THE DCB TO HOLD THE OPEN CALL OPEN(G0DCB,IER,G0JBF,0,SEC,SPCR)!OPEN JOB FILE IF IER = -8 THEN[ \IF JOBFIL NOT AVAILABLE CALL FERR(G0JBF); \REPORT THE PROBLEM GO TO EXX] !AND GO EXIT IF IER = 2 THEN GO TO RD17 !IF NO ERROR JUMP IF IER = -6 THEN[SPNO_80;GO TO GOTNO]!IF NO FILE PURGE 80 CALL G1PCR(-SPCR) !RESET $SPCR WE FAILED SOME HOW IF IER = -32 THEN IER _ 54 !CHANGE REPORT IF DISC NOT MOUNTED ! CALL FERR(G0JBF) !REPORT ANY OTHER ERROR GO TO EX !AND GET OUT ! ! RD17: CALL G1RD(G0BUF,17) !GET RECORD 17 CALL G1ZAP(G0DCB) !ZAP DCB TO KEEP FILE OPEN SPNO_G0WD2 AND 177K !SET THE COUNT IF SPNO > 80 THEN SPNO _ 80 !MAX # OF SPOOL FILES RN1_G0BUF ‹������þú !CAPTURE THE RN NUMBERS RN2_G0W14 !CAPTURE THE RN NUMBERS ! GOTNO: FOR I_1 TO SPNO DO THRU X SPLNO_KCVT(I) IF SPLNO < 30000K THEN SPLNO_SPLNO OR 30000K !FIX IF 01-09 CALL PURGE(G0DCB,IER,SPOL,SEC) !PURGE THE FILE IF IER > -1 THEN GO TO X IF IER = -6 THEN GO TO X !IF NO FILE OR NO ERROR CALL FERR(SPOL) !DON'T WORRY, ELSE REPORT GO TO EX !AND STOP X: !END OF LOOP ! CALL RNRQ(RLF,RN1,IS) !RELEASE THE TWO RN'S GO TO NEX1 ! NEX1: CALL RNRQ(RLF,RN2,IS) GO TO NEX2 ! NEX2: CALL PURGE(G0DCB,IER,G0JBF,SEC,SPCR) !PURGE JOB FILE IF IER < 0 THEN CALL FERR(G0JBF) !REPORT ERRORS ! CALL OPEN(G0DCB,IER,G0SPF,0,SEC,SPCR)!NOW GET SPLCON IF IER #2 THEN[ \IF ERROR REPORT IT Z: CALL FERR(G0SPF);GO TO EX] !AND EXIT ! CALL G1RD(G0BUF,1) !GET THE FIRST RECORD CALL G1ZAP(G0DCB) !DON'T LET PURGE CLOSE FILE CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE RN. GO TO NEX3 ! NEX3: CALL PURGE(G0DCB,IER,G0SPF,SEC,SPCR) !PURGE THE FILE IF IER < 0 THEN GO TO Z !IF ERROR REPORT IT CALL G1OMS(CLEAN) !ELSE REPORT DONE EX: IF (F = -1 OR F = -2) THEN [ \IF CALLED FROM INIT. RETURN IF IER # 54 THEN RETURN] !IF DISCS WERE FOUND EX2: CALL G1OMS(G0END) !ELSE EXIT CALL EXEC(6) ! EXX: CALL G1OMS(G0N8M) !SEND THE -8 LINE CALL G1PCR(-SPCR) !RESET THE SPOOL CR # GO TO EX2 !AND EXIT ! END ! ! FERR: SUBROUTINE(N) CALL .DFER(MES,N) !SET UP THE FILE NAME CALL G1OMS(RESON) Å����� !SENT IT CALL G1CQQ(SIZE) !CALL ?? TO SEND FULL MESSAGE G0NPR _ "NP" !SET THE NO PRINT FLAG CALL G1ERP(IER) !POST ERROR TO THE SCB RETURN END END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Pµ������ÿÿ����� ���� ÿý�„� Ž ���������ÿ��92067-18442 1903� S C0122 �&$YCOM � � � � � � � � � � � � � �H0101 Žc�����þúASMB,R,L,C,Q * * NAME: $YCOM * SOURCE: 92067-18442 * RELOC: 92067-16260 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $YCOM,1,10 92067-16260 REV.1903 781201 ENT $YCOM EXT $STH,$LGON,EXEC,$SHED,$SMLK * * * * $YCOM JSB EXEC FETCH STRING FROM SYS\SES CONSOLE (OPSYS) DEF ST.1 DEF .14 DEF .1 DEF BUFF DEF DM80 ST.1 EQU * * SZA SEE IF A STRING WAS FOUND JMP OUT NO STRING -- GO EXIT * * ADB N2 SUBTRACT 2 FOR CALL FLAG CMB,INB ADJUST LENGTH FOR CLASS I\O STB LEN TRANSFER LDB BUFF FETCH CALL FLAG SZB 0=LOGON 1=R$PN$ JMP BRK BREAK REQUEST * JSB EXEC GET LOGON GOING DEF SCHL DEF DS10 SCHED NO ABORT DEF LOGON SCHL EQU * NOP POSSIBLE ERROR RETURN * CLA LOG-ON REQUEST * * STA OPN1 OPTIONAL PARMS DEFINE CALL TO LOGON INA STA OPN2 LDA $LGON FETCH LOGON CLASS * DOIT STA CLAS * SZA,RSS IF NO CLASS JMP OUT GET OUT * * * JSB EXEC CLASS WRITE\READ REQUEST DEF ST.2 DEF .20 DEF NOP DEF BUFF+1 DEF LEN DEF OPN1 DEF OPN2 DEF CLAS ST.2 EQU * * OUT JSB EXEC DEF *+2 DEF .6 * * * BRK JSB EXEC GET R$PN$ GOING DEF SCHR DEF DS10 DEF R$PN$ SCHR EQU * NOP POSSIBLE ERROR RETURN * XLA DRT,óo��� �� I FETCH F.W. OF DRT AND B77 ISOLATE THE EQT # ADA N1 COUNTS FROM 1 MPY D15 OFFSET TO THE EQT FOR LU 1 ADA D3 OFFSET TO WORD 4 ADA EQTA START ADDR OF EQTS STA OPN2 * LDA $SMLK FETCH NEG OFFSET TO SST LEN WORD CMA,INA SET IT POSITIVE ADA $SHED STA OPN1 LDA $STH JMP DOIT * .1 DEC 1 N1 DEC -1 N2 DEC -2 D3 DEC 3 D15 DEC 15 DRT EQU 1652B EQTA EQU 1650B .6 DEC 6 DS10 OCT 100012 LOGON ASC 3,LOGON R$PN$ ASC 3,R$PN$ .14 DEC 14 .20 DEC 20 BUFF BSS 40 LEN NOP OPN1 NOP OPN2 NOP CLAS NOP DM80 DEC -80 B77 OCT 77 NOP NOP END $YCOM ������������������������������������Îú ������ÿÿ����� ���� ÿý�…�Œ ���������ÿ��92067-18443 1903� S C0122 �&MESSS � � � � � � � � � � � � � �H0101 ¢�����þúASMB,R,C,Q HED MESSS * NAME: MESSS * SOURCE: 92067-18443 * RELOC: PART OF 92067-16261 * PGMR: G.A.A.,C.M.M.,G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MESSS,7 92067-16261 REV.1903 790420 * ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN,$$OP,CAPCK EXT $ESTB,VSCBA,IDGET SPC 2 BUFFR NOP LNGTH NOP P1 NOP ISES NOP MESSS NOP JSB $LIBR GO PRIVILEGED. CNTR NOP JSB .ENTP GET PARAMETERS. DEF BUFFR LDB MESSS LDA HERE SZA JMP EXIT2 STB RTN A IS ZERO SO STB HERE - LDB DEFEF - STB MESSS THE FOLLOWING DEPENDS ON A=0 ******* * LDB ISES,I SEE IF SCB PASSED SZB,RSS IF NONE PASSED JSB $ESTB USE CURRENT USERS STB ISES SAVE POSSIBLE SCB ADDR * * * CAPCK RETURNS THE REQUESTED COMMAND IN THE A REGISTER * JSB CAPCK SEE IF REQUEST IS ALLOWED DEF BCK DEF BUFFR,I DEF LNGTH,I DEF ISES BCK EQU * * * CPA DM1 COMMAND ERROR? JMP CKERR YES * SSB CAPABILITY ERROR? JMP CPERR YES * CPA "EN" ENABLE SYSTEM CONSOLE ? JMP LU1? CONTINUE CHECKS * CPA "OP" SYS/SES CON OPERATOR REQUEST ? JMP LU1? YES - CONTINUE CHECKING * CPA "RU" IF RU JMP CKID * CPA "ON" OR ON JMP CKID * CPA "IT" OR IT, GO CHECK SESSION WORD JMP CKID TO SEE IF WE CAN DO THIS COMMAND * NSES CLA U-������þú STA $PVCN LDA BUFFR LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM. ISZ $PVCN SZA,RSS JMP CHECK IF NO RETURNED MESSAGE, THEN CHECK XLB A,I FOR SPECIAL PATCHING OF 'RU' OR 'ON' STB LNGTH OTHERWIZE PROCESS MESSAGE. BRS STB CNTR LOOP INA XLB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH EXIT CLB STB HERE STB P1 STB ISES JSB $LIBX DEF DEF RTN RTN NOP HERE NOP DEFEF DEF DEF * EXIT2 CLA JMP EXIT HED CHECK FOR RU AND ON PROCESSING * * THE FIRST CHECK IS MADE TO SEE IF THE SESSION WORD (ID32) * HAS TO BE SET UP FOR THE TARGET PROGRAM ("RU" OR "ON" ONLY). * * CHECK XLA $$OP,I GET THE OP CODE THE SYS PARSED. CPA "ON" ON ? JMP DP1 CPA "RU" RU ? JMP DP1 JMP EXIT2 NOT A "RU" OR "ON" * DP1 LDA ISES FETCH POSSIBLE PASSED SCB ADDR SSA IF NEG SESSION ADDR CMA,INA SET IT POS SZA,RSS IF NOT PASSED OR NOT SESSION JMP PROPA GO PROPAGATE CALLERS SESSION WORD * STA ISES SAVE POSITIVE VALUE FOR TEST JSB VSCBA GO VERIFY THE SCB ADDR DEF ID.2 DEF ISES ID.2 EQU * * SZA,RSS IF GOOD SCB ADDR, (A) WON'T BE ZERO JMP PROPA * LDA ISES USE PASSED SCB ADDR JMP PROP2 * PROPA LDA XEQT GET MY ID ADDR ADA D32 GET CALLER'S SESSION WORD XLA A,I PROP2 LDB $WORK PROPAGATE TO ADB D32 SON'S ID XSA B,I * * NOW SEE IF THE FIRST TEMP WORD OF THE TARGET PROGRAM'S ID * SHOULD BE STUFFED WITH THE TERMINAL LU. * LDA BUFFR,I IF RUN OR ON WAS SPECIFIED IN COL #1 CPA "ON" WE MUST TEST FURTHER JMP DP2 * CPA "RU" RU? JMP DP2 MORE TESTS REQUIRED JMP EXIT2 NOT IN FIRST COL, EXƒ5������þúIT * DP2 LDB $WORK GET PROGRAMS ID SEGMENT ADDRESS INB ADVANCE TO FIRST TEMP WORD XLA B,I IF 1ST PARM SPECIFIED SZA,RSS DON'T MESS WITH FIRST TEMP * * NOTE: THE NEXT LINE DEPENDS ON (A)=0 * LDA P1,I ELSE FETCH PASSED LU# XSA B,I RESTORE TEMP1 (IN ID SEGMENT) * JMP EXIT2 * * HED SYS/SES CONSOLE COMMAND PRE-PROCESSOR * LU1? LDA ISES THESE COMMANDS ARE PERMITTED SZA,RSS ON LU 1 ONLY. IF NOT SESSION, CONTINUE JMP NSES * SSA CHECK FOR NEG VALUE CMA,INA STA ISES * JSB VSCBA FETCH SESSION ID DEF IS.1 DEF ISES IS.1 EQU * * CPA D1 SESSION ID RETURNS IN (A) JMP NSES WERE OK * CKERR LDA OPER OP CODE ERROR RSS CPERR LDA CPER BUFFER ADDR GOES IN (A) RSS ILSTA LDA ISTAT ILLEGAL STATUS ERROR LDB A,I FETCH LENGTH STB ISES SAVE IN TEMP INA ADVANCE TO START OF BUFFER LDB BUFFR FETCH ADDRESS OF USER BUFFER MVW ISES MOVE ERROR MESSAGE INTO USER BUFFER * LDA ISES FETCH BUF LEN ALS MAKE IT A BYTE COUNT CMA,INA SET IT NEG JMP EXIT AND GET OT * * * * CHECK TARGET PROGRAM FOR TIME LIST RESTRICTIONS * * IF TARGET IS IN THE TIME LIST AND IT'S UNDER SESSION, THE REQUEST * MUST BE BY THE SAME SESSION. * * CKID LDA ISES FETCH SCB ADDR FOR THIS REQUEST SZA,RSS IF CALLER NOT IN SESSION JMP NSES NO CHECKS ARE DONE * STX IDAD CAPCK RETURNS ADDR OF PARM1 IN (X) JSB IDGET GO GET ID ADDR DEF *+2 DEF IDAD,I * SZA,RSS FIND IT ? JMP NSES NO SUCH PROG, LET OP SYS RETURN ERROR * LDB D14 ADB A ADVANCE TO TYPE WORD XLA B,I &FETCH AND D15 & ISOLATE CPA D5 IF IT'S A SEGMàY�����ENT JMP NSES CONTINUE * INB ADVANCE TO STATUS XLA B,I AND GET IT AND D15 ISOLATE STATUS SZA IF NOT DORMANT JMP ILSTA RETURN ILLEGAL STATUS * ADB D2 ADVANCE TO TIME LIST WORD XLA B,I ALF,SLA IF IN TIME LIST (AND DORMANT) RSS MUST GO CHECK SESSION WORD JMP NSES NOT IN TIME LIST * ADB D15 ADVANCE TO SESSION WORD XLA B,I FETCH IT CPA ISES DOES IT MATCH THE REQUEST SESSION JMP NSES YES, GO DO THE COMMAND SZA CHECK FOR MTM SSA OR NON SESSION JMP NSES LET THE COMMAND WORK ON THEM ALSO JMP ILSTA * * CPER DEF *+1 D8 DEC 8 ASC 8,CAPABILITY ERROR OPER DEF *+1 D6 DEC 6 ASC 6,OP CODE ERR * ISTAT DEF *+1 D7 DEC 7 ASC 7,ILLEGAL STATUS * "ON" ASC 1,ON "RU" ASC 1,RU "IT" ASC 1,IT "EN" ASC 1,EN "OP" ASC 1,OP D1 DEC 1 D2 DEC 2 D5 DEC 5 D14 DEC 14 D15 DEC 15 D32 DEC 32 DM1 DEC -1 IDAD NOP A EQU 0 B EQU 1 XEQT EQU 1717B * END ��������������������������������������������������������������������������������������¤ï������ÿÿ����� ���� ÿý�†� ���������ÿ��92067-18444 1903� S C0122 �&MKSCB � � � � � � � � � � � � � �H0101 v‘�����þúASMB,R,L,C,Q ** SCB BUILD MODULE ** HED SCB BUILD MODULE * NAME: MKSCB * SOURCE: 92067-18444 * RELOC: PART OF 92067-16261 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MKSCB,7 92067-16261 REV.1903 780518 EXT $LIBR,$LIBX,$SHED,$SMST,.ENTR,$SALC,$SMVE,$SMLK * ENT MKSCB * SKP * IBUFA NOP IBUFL NOP IADDR NOP IERR OCT -1 * MKSCB NOP JSB .ENTR DEF IBUFA FETCH PARMS * LDA IERR IF NOT ENOUGH SSA PARMS JMP MKSCB,I DO A NOP * LDA IBUFL,I FETCH SCB LENGTH ADA .3 AND ADD LINKAGE OVERHEAD STA RQLEN SAVE FOR $SALC CALL * LDA IBUFA,I FETCH REQUEST IDENT CMA,INA SET IT NEGATIVE STA NEGID AND SAVE FOR SCAN * LDA DSHED FETCH ADDRESS OF SCB LIST STA OLDLK AND SET IT AS OLD LINK ADDR * JSB $LIBR GO PRIV TO AVOID CONTENTION NOP * XLA $SHED FETCH FIRST SCB ADDR SZA,RSS IF ZERO (LIST EMPTY), JMP ENDLS GO ADD NEW SCB * STA CPNTR SET CURRENT SCB ADDR * NXLNK JSB $SMVE DEF SMRTN DEF .1 READ DEF CPNTR AT THIS LOCATION DEF NOP WITH THIS OFFSET DEF NXTLK PUT IT HERE DEF .4 MOVE FOUR WORDS SMRTN EQU * * LDA NXTID FETCH NXT ID ADA NEGID AND TEST AGAINST NEG REQUEST IDENT * SZA,RSS IF EQUAL JMP ERR3 EXIT ERROR=-3 * SSA,RSS IF NEW > REQUEST ID JMP GL‘Ñ������þúINK THIS MUST BE THE PLACE * LDA CPNTR FETCH ADDR OF CURRENT SCB STA OLDLK SAVE AS PREVIOUS SCB FOR NEXT PASS LDA NXTLK SET THE LINK ADDR AS ADDR OF STA CPNTR NEW "CURRENT" SCB SZA UNLESS END OF LIST JMP NXLNK GO FETCH 1ST 4 WORDS OF NEXT SCB SKP * * * GET MEMORY-- THEN SET ADDRESS OF BLOCK RETURNED INTO LOCATION * DEFINED BY OLDLK. MOVE CONTENTS OF CPNTR (POINTER TO NEXT SCB * OR ZERO) ALONG WITH BUFFER SIZE AND EXTENSION ADDRESS OF ZERO * TO THE FIRST 3 WORDS OF NEW SCB. THEN MOVE USER DEFINED SCB INTO * NEW SCB, STARTING WITH THE SESSION IDENTIFIER (WORD 4). * ENDLS STA CPNTR END OF LIST. FORCE LINK TO ZERO GLINK SJS $SALC RQLEN NOP REQUEST LENGTH+3 LDA N1 NO MEM EVER RETURN JMP NOMEM NO MEM NOW RTN ($SALC RTNS A=0) STA RQBLK GOT IT. A=ADDR, B=SIZE STB REQLN SET LENGTH INTO SCB HEADER * LDB $SMLK FETCH NEGATIVE COUNT TO SST LEN WD CMB,INB SET IT POSITIVE ADA B BUMP SCB ADDR TO SST LEN WD STA IADDR,I RETURN IT TO CALLER * CLA THEN STA REQEX SET EXTENSION ADDR=0 STA IERR,I AND ERROR CODE=0 * JSB $SMVE DEF SMRT2 DEF .2 WRITE DEF RQBLK TO THE NEW BLOCK DEF NOP WITH A ZERO OFFSET DEF CPNTR FROM TEMP BUFFER(LINK,SIZE AND EXT SIZE SET) DEF .3 THREE WORDS SMRT2 EQU * * * MOVE CALLER'S DATA OUT * JSB $SMVE DEF SMRT3 DEF .2 WRITE DEF RQBLK TO THE NEW BLOCK DEF $SMST OFFSET TO IDENT WORD DEF IBUFA,I FROM USER'S BUFFER DEF IBUFL,I USER'S LENGTH SMRT3 EQU * * * UPDATE OLD LINK * JSB $SMVE DEF SMRT4 DEF .2 WRITE DEF OLDLK TO OLD BLOCK OR $SHED DEF NOP ZERO OFFSET DEF RQBLK ADDR OF NEW BLOCK äª����� DEF .1 WRITE ONE WORD SMRT4 EQU * * CCA PRESET ERROR PARM STA IERR FOR NEXT ENTRY * JSB $LIBX DEF MKSCB * * ERR3 LDA N3 DUPLICATE IDENTIFIER ERROR RSS NOMEM ADA N1 NO MEM EVER=-2, NO MEM NOW=-1 STA IERR,I JMP SMRT4 GET OUT SKP DSHED DEF $SHED+0 RQBLK NOP OLDLK NOP NEGID NOP * * CAUTION! THE FOLLOWING BUFFER MUST BE STRUCTURED AS FOLLOWS: * * WORD 1 CPNTR * WORD 2 NXTLK&REQLN * WORD 3 REQEX * WORD 4 * WORD 5 NXTID * CPNTR BSS 5 NXTLK EQU CPNTR+1 REQLN EQU CPNTR+1 REQEX EQU CPNTR+2 NXTID EQU NXTLK+3 * **************************************************** A EQU 0 B EQU 1 .1 OCT 1 .2 OCT 2 .3 OCT 3 .4 OCT 4 N1 OCT -1 N3 OCT -3 NOP NOP END ������������������������������������������������������������������������������������������������������������������������������������������������������������������Ö1������ÿÿ����� ���� ÿý�‡� ���������ÿ��92067-18445 1903� S C0122 �&RLSCB � � � � � � � � � � � � � �H0101 x–�����þúASMB,R,L,C,Q ** SCB RELEASE MODULE ** HED SCB RELEASE MODULE * NAME: RLSCB * SOURCE: 92067-18445 * RELOC: PART OF 92067-16261 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RLSCB,7 92067-16261 REV.1903 780518 EXT $LIBR,$LIBX,$SHED,.ENTR,$SRTN,$SMVE * ENT RLSCB * SKP * SESID NOP IERR NOP * RLSCB NOP JSB .ENTR DEF SESID FETCH PARMS * LDA DSHED FETCH ADDRESS OF SCB LIST STA OLDLK AND SET IT AS OLD LINK ADDR * JSB $LIBR GO PRIV TO AVOID CONTENTION NOP * XLA $SHED FETCH FIRST SCB ADDR SZA,RSS IF ZERO (LIST EMPTY), JMP ERR1 GIVE SCB NOT FOUND ERROR * STA CPNTR SET CURRENT SCB ADDR * NXLNK JSB $SMVE DEF SMRTN DEF .1 READ DEF CPNTR AT THIS LOCATION DEF NOP WITH THIS OFFSET DEF NXTLK PUT IT HERE DEF .4 MOVE FOUR WORDS SMRTN EQU * * LDA NXTID FETCH NXT ID CPA SESID,I AND TEST AGAINST NEG REQUEST IDENT JMP FOUND * LDA CPNTR FETCH ADDR OF CURRENT SCB STA OLDLK SAVE AS PREVIOUS SCB FOR NEXT PASS LDA NXTLK SET THE LINK ADDR AS ADDR OF STA CPNTR NEW "CURRENT" SCB SZA UNLESS END OF LIST JMP NXLNK GO FETCH 1ST 4 WORDS OF NEXT SCB * ERR1 CCA JMP EXIT SET ERROR CODE AND EXIT SKP * * FOUND SCB -- SET CONTENTS OF CPNTR (LINK WORD OF SCB TO BE RELEASED) * INTO PREVIOUS LINK OR $SHED (DEFINED BY€ï������þú OLDLK). CALL SESSION MEMORY * MEMORY MANAGER TO RETURN MEMORY ALLOCATED TO SCB. IF EXTENSION * POINTER NOT ZERO, FETCH CONTENTS OF 1ST 2 WORDS OF EXTENSION (LINK * AND LENGTH). CALL SESSION MEMORY MANAGER TO RELEASE MEMORY ALLOCATED * TO EXTENSION. REPETE FOR ALL EXTENSIONS. * * * UPDATE PREVIOUS LINK * FOUND JSB $SMVE DEF SMRT2 DEF .2 WRITE DEF OLDLK TO OLD LINK DEF NOP WITH A ZERO OFFSET DEF NXTLK THE LINK WORD OF SCB BEING RELEASED DEF .1 ONE WORD SMRT2 EQU * * * RETURN MEMORY ALLOCATED TO SCB * LDA CPNTR FETCH ADDR & LENGTH LDB CURLN RTN DST SCBRT SAVE FOR RELEASE CALL * SJS $SRTN SCBRT BSS 2 * * * CHECK FOR EXTENSION * LDA SCBEX FETCH EXTENSION POINTER SZA,RSS IF ZERO, JMP EXIT ALL DONE. * JSB $SMVE DEF SMRT3 DEF .1 READ DEF SCBEX FROM LOCATION ADDRESSED BY SCB EXTENSION WORD DEF NOP (ZERO OFFSET) DEF EXPNT TO THE EXTENSION POINTER BUFFER DEF .2 READ 2 WORDS SMRT3 EQU * * LDA SCBEX FETCH SCB EXT ADDR LDB EXPNT FETCH NEXT LINK STB SCBEX AND SAVE FOR NEXT PASS LDB EXLEN FETCH SCB EXT LENGTH JMP RTN GO RELEASE EXT AND CHECK FOR MORE * EXIT STA IERR,I SET THE ERROR CODE CLB RESET ERROR PARM STB IERR FOR NEXT ENTRY JSB $LIBX EXIT DEF RLSCB SKP DSHED DEF $SHED+0 OLDLK NOP * * CAUTION! THE FOLLOWING BUFFER MUST BE STRUCTURED AS FOLLOWS: * * WORD 1 CPNTR&EXPNT * WORD 2 NXTLK&EXLEN * WORD 3 CURLN * WORD 4 SCBEX * WORD 5 NXTID * CPNTR BSS 5 EXPNT EQU CPNTR NXTLK EQU CPNTR+1 EXLEN EQU CPNTR+1 CURLN EQU CPNTR+2 SCBEX EQU CPNTR+3 NXTID EQU NXTLK+3 * **************************************************** .1 OCT 1 .2 OCT 2 .4 OCT 4 NOP NOP ê¹�������� END öä�������ÿÿ����� ���� ÿý�ˆ� ���������ÿ��92067-18446 1903� S C0122 �&4LDR � � � � � � � � � � � � � �H0101 ˆG�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-IV <1913> IFN NAM LOADR,4,90 92067-16002 REV.1926 790502 XIF IFZ NAM LOADR,4,90 92067-16446 REV.1913 790521 XIF * * ENT LOADR * * EXT $MATA,NAMR EXT $MNP,$MBGP,$MRTP,$MCHN,$SDA,$COML EXT $PLP,$DLP,$IDEX EXT REIO,OPEN,CLOSE,READF,$CVT3,LURQ,LOGLU EXT LOCF,APOSN,WRITF,CREAT,POST,POSNT EXT IFBRK,EXEC,$LIBR,$LIBX,PRTN EXT FTIME IFZ EXT .OWNR,PTERR,$SSCT,$STRK XIF * * NAME: RTE LOADER * SOURCE: 92067-18002 * RELOC: 92067-16002 * PGMR: C.M.M. * SUP PRESS EXTRANIOUS LISTING * SKP *1 LOADR ERROR CODES *0 ALL LOADR ERRORS ARE REPORTED TO THE LIST DEVICE. THE LIST * DEVICE MAY BE SPECIFIED AT LOAD TIME OR DEFAULTED. THE DEFAULT * LIST DEVICE IS SPECIFIED UNDER 'LIST = ' AT THE BEGINING OF THIS * DOCUMENT. * THE LOADR ERROR CODES ARE LISTED BELOW. NOTE THAT ERROR CODES * 19, 20, 21, 22, REFER TO RTE 4 ONLY. ERROR CODE 23 REFERS TO * RTE 3 ONLY. *0 LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * * 01 * - CHECKSUM ERROR (WAS IT A RELOCATABLE FILE ?) * 02 * - ILLEGAL RECORD * 03 * - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * (YOUR PROGRAM + MSEG SIZE IS TOO LARGE) * 04 * - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) * 05 * - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) * 06 *â§������þú - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) * 07 * ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) * 08 - NO TRANSFER ADDR (ONLY SUBROUTINES WERE LOADED WHERE'S THE MAIN?) * 09 * - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) * 10 - ILLEGAL PARAMETER IN RU STATEMENT OR IN STATEMENT PRIOR TO * A RELOCATE STATEMENT. * 11 - ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) * 14 * - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T * 16 - ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 18 - REQUESTED # OF PAGES EXCEEDS LARGEST POSSIBLE * ADDRESS SPACE FOR THAT PROGRAM. * 19 - EMA DECLARED TWICE OR DECLARED IN A PROGRAM SEGMENT * OR A REFERENCE TO THE EMA LABEL BEFORE THAT LABEL WAS * DECLARED EMA OR AN ATTEMPT TO DECLARE THE SAME LABEL AS * AN ENT RECORD (IE DUPLICATE ENT). EMA MUST BE DECLARED * IN THE MAIN. ANY INDIVIDUAL RELOCATABLE MODULES THAT * PRECEED THE MAIN MAY NOT HAVE EMA REFERENCES. EMA * REFERENCES MAY APPEAR ANYWHERE IN THE MAIN. EMA REFERENCES * IN SEGMENTS OR SUBROUTINES MAY APPEAR ANYWHERE WITHIN THE * MODULE BUT THAT MODULE MUST NOT BE RELOCATED BEFORE THE MAIN * 20 - NO ID EXTENSIONS AVAILABLE FOR YOUR EMA PROGRAM * 21 - PROGRAMS EMA SIZE IS TOO LARGE FOR CURRENT SYSTEMS * PARTITIONS. * 23 - ATTEMPT TO LOAD A SEGMENTED PROGRAM INTO REAL TIME PARTITION. * 24 - ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. * 25 - ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTEREp������þúD WITHIN A FILE. * 26 - NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH LOAD. * THIS ERROR CODE IS EXTREMELY RARE. IT CAN OCCUR WHEN * LOADING A SEGMENTED PROGRAM WHERE THERE WERE ENOUGH * LONG + SHORT ID SEGMENTS TO SUCCESSFULLY LOAD THE LAST * SEGMENT IN THE PROGRAM WHILE THE LAST SEGMENT LOAD WAS * GOING ON. HOWEVER, WHEN THE LOADR WENT TO CREATE THE * ID SEGMENTS NOT ENOUGH LONG + SHORT SEGMENTS WERE FOUND. * IN THIS CASE SOME ID SEGMENTS WERE CREATED BUT OTHERS * WERE NOT. IF THE PROGRAM IS RUN AN SC05 ERROR WOULD * RESULT. THE CORRECT ACTION IS TO OFF OR PURGE ALL ID'S * CREATED, FREE UP ADDITIONAL ID SEGMENTS, AND PERFORM THE * LOAD OVER AGAIN. * 27 - ATTEMPT TO ACCESS AN EMA EXTERNAL (ARRAY) WITH OFFSET * OR INDIRECT. TO ACCESS EMA ARRAYS USE THE H-P SUPPLIED * SUBROUTINES .EMAP & .EMIO . * 28 - UNDEFINED EXTERNALS EXIST. THIS IS PROBABLY THE MOST * COMMON ERROR FOR THE LOADR. BASICLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. * 29 - ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF * THAT PROGRAM EXIST. THE PROGRAM CAN'T BE PURGED BECAUSE * THE DISC SPACE CAN'T BE RELEASED OR THE OTHER PROGRAMS * WILL BE OUT TO LUNCH. THE PROPER COURSE HERE IS TO GET * RID OF ALL THE COPIED PROGRAMS (VIA OF,XXXXX COMMAND) AND * TRY THE LOAD AGAIN. * 30 - ATTEMPT TO REPLACE A COPIED PROGRAM. THE 'OP,RP' COMMAND * MAY NOT BE USED WITH A COPY OF A PROGRAM. YOU MUST REPLACE * THE ORGINAL. * 31 - L O A D R AND ONLY THE PROGRAM NAMED L O A D R MAY DO PERMINANT * LOADS OR PURGES. * 32 - DUPLICATE PROGRAM NAME. YOU HAVE ALREADY LOADED THE * SAME PROGRAM TWICE WITHOUT OFFING THE ORIGINAL. WE * WERE NICE THE SECOND TIME AND RENAMED YOUR PROGRAM * CALLED XXXXX TO ..XXX THE THIRD TIME WE DON'T RENAME. * 33 - NOT ENOUG)×������þúH ID SEGMENTS TO FINISH THE LOAD. CALL THE * SYSTEM MANAGER TO FREE UP SOME ID SEGS. * 34 - ATTEMPT TO REPLACE A PROGRAM THAT WAS EITHOR NOT * DORMANT OR STILL IN A PARTITION. DO AN ' OF ' ON * THE PROGRAM & TRY AGAIN. * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 32 - DUPLICATE PROGRAM NAME. YOU TRIED TO LOAD A * PROGRAM XXXXX BUT A PROGRAM CALLED XXXXX WAS ALREADY * IN THE SYSTEM, SO WE RENAMED YOUR PROGRAM TO * ..XXX AND CONTINUED THE LOAD. SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM THE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * L * CHAR 1 * CHAR 2 * *..................................................* * U * CHAR 3 * CHAR 4 * *..................................................* * CHAR 5 * ORDINAL * *..................................................* * TYPE * V* * S * *..................................................* * V = 0/1 ABS ADDRESS / BP LINK ADDRESS * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * * * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * œu������þú BIT 15 = 1 MEANS THE ENTRY IS FROM SYS LIBRARY * BIT 15 = 0 MEANS THE ENTRY FROM MODULE * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * BIT 15 = 1 SYMBOL REFERENCED BY CURRENT MODULE * BIT 15 = 0 SYMBOL NOT REFERENCED BY CURRENT MODULE * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL NUMBER * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 3 - EMA ENTRY THE SYMBOL IS CONSIDERED DEFINED. * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATION ). * V WILL ONLY BE SET IF THE REFERENCE IS TO EMA. * TYPE : * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * TYPE = 0 PROG RELOCATABLE * 1 BP RELOCATABLE * 2 COMMON RELOCATABLE * 3 ABSOLUTE * 4 INSTRUCTION REPLACEMENT * * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP §������þú BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THE BUFFERS BELOW AT YOUR UNDYING & EVERLASTING * PERIL !!!!!!! * IDCB3 BSS 144 LIST FILE DCB NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM RECORD BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 COMMAND FILE DCB SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 18 ID INFO TO BE MOVED INTO SYS ID AREA * .BUF EQU * END OF BUFFERS IN OVERLAYED CODE SKP * * ORG IDCB3 * LOAD ASC 3,LOADR * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITIONS IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE SPC 1 LOADR JSB LOGLU GET THE DEFAULT LU DEF *+2 DEF MYLU# STA MYLU# * JSB .OWNR GET THE OWNER WORD FOR THE ID STA OWNER * SPC 1 * THIS CODE IS PLACED HERE BECAUSE IT NEED ONLY EXECUTE * ONCE AND THEN I CAN USE ö-������þúTHE AREA FOR OVERLAY PURPOSES SPC 1 * LDA SECT2 GET THE # SECTRS PER TRACK ON LU 2 MPY P64 A = # WORDS PER TRACK STA D6144 SAVE FOR LATER. * LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR XLA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN XLA B,I SET UP LOADR SYMBOL TABLE TO STA BLST START FROM LOADR'S HIGH STA PLST MAIN ADDR AND GROW UP STA TLST TOWARD HIGH CORE. STA SLST STA FLST ADB N7 (B)=ADDR OF LOADR ID'S WORD 15 XLA B,I GET LOADR'S PROG TYPE LDB BKLWA GET ADDR OF LOADR'S LAST WORD AND P7 SPC 1 CPA P2 SKIP IF LOADR IS BG LDB RTLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR * LDB XEQT GET MY ID ADDRESS ADB P12 & CHECK IF I'M 'THE' L O A D R XLA B,I CPA LOAD CHECK 1ST TWO CHARACTERS INB,RSS OK ! ISZ TLOAD SET TEMP LOAD ONLY FLAG XLA B,I CPA LOAD+1 3RD & 4TH CHARS OK ? INB,RSS YES. ISZ TLOAD NO XLA B,I GET LAST CHAR AND M7400 IOR P32 APPEND A BLANK CPA LOAD+2 RSS PERM LOADS OK ! ISZ TLOAD * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ @†������þú NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" LDA SYSLN GET # OF,SYSTEM ENTRY POINTS ADA DSCLN ADD # OF USER ENTRY POINTS STA #ENTS TO GET TOTAL # OF ENTS * * SKP JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB GTCMD GET THE COMMAND FILE * * JSB NAMRR NOW GET THE INPUT FILE NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * JSB NAMRR NO, GO GET FMT PARAMETERS SSA JMP SEFIL LDB IPBUF GET THE FIRST OP JSB TEST CHECK IT OUT LDB IPBUF+1 NOW DO THE JSB TEST 2ND ONE LDB IPBUF+2 AND NOW THE LAST JSB TEST ONE. * JSB NAMRR NO, GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL LDA IPBUF GET THE # ÀŒ������þú STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * ******************CHECK OUT COMMAND FILE********************* * * SEFIL LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA WAS A COMMAND FILE ENTERED ? JMP SEFIX YES * LDB TYPE1 NO CMND FILE. WAS A RELO FILE ENTERED ? SZB WELL . JMP CNFLT YES, NO CMND BUT DO HAVE A RELO FILE * LDA B1777 NO CMND & NO RELO !!!! STA ISTRC FAKE OUT NAMR JSB GTCMD & FORCE A COMMAND ENTRY LU LDA TYPE2 GET THE TYPE * SEFIX ERA,SLA IS IT A FILE OR A LU ? JMP FOPEN A FILE ! JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * M200 OCT 200 MYLU# DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 TLOAD NOP 0 = PERM LOADS OK. SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  * LDA LISTU GET THE LIST LU LDB DOLST AND THE LU LOCK SUB ENTRY POINT SZB,RSS NOW IF DOLST NEVER CALLED SZA AND LIST LU NEVER RESET, THEN JMP CNFL1 SET UP USER CONSOLE AS DEFAULT * CLA,INA SET LU NOT FILE FLAG STA IPBUF+3 * LDA MYLU# CCB SET B TO -1 CPB BATCH BATCH MODE? LDA P6 YES, DEFAULT TO LU 6 STA IPBUF JSB DOLST NOW GO SET THE LU & LOCK IT * CNFL1 LDA EDFLG GET THE EDITING FLAG LDB TLOAD AND THE PERM LOAD OK FLAG. SZA THIS A PERM LOAD ? SZB,RSS THEN THIS BETTER BE THE L O A D R JMP CHEKR OK! * NOPUG LDA ERR31 YOU LOSE JMP ABOR ERR31 ASC 1,31 * * CHEKR LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5 .`������þú THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * * LDA #PGS DID HE SUPPLY A NEGATIVE SIZE ? SSA WELL ? JMP ER.17 SEND THE TURKEY A LOVE MESSAGE. LDA #PTTN GET THE PART'N SPECIFIED IF ANY SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SSA BUT IF NEG JMP ER.16 FLUSH HIM. SPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * XLA $MNP YES, DO SIZE CHECK NOW. GET MAX # PART'NS * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 7 * (PTTN# - 1) + $MATA MPY P7 IS ADDR OF ENTRY XLB $MATA ADA B XLB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 XLA A,I AND B1777 REMOVE RESERVED FLAG STA #PGPT SAVE #PAGES IN PTTN CMA ADA #PGS ENOUGH PAGES IN SSA SPECIFIED PTTN? JMP PGSOK YES SZA OK IF EQUAL LDA #PGS NO, BUT WAS SPECIFIC SZA SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN XLA $MBGP GET MAX BG PARTN STA #MXBG XLA $MRTP GET MAX RT PARTN STA #MXRT * µ»������þú * *E * CMMST LDB PTYPE GET THE PROG TYPE XLA $PLP ASSUME ITS A TYPE 2 OR TYPE 3 RBR,RBR IS IT ? SLB,RSS WELL ?! JMP SETLP YES * XLA $DLP NO, ITS A LARGE BG PROG TYPE = 4 LDB COMTP GET THE COMMON TYPE ADB #MPFT ADD IN SSGA SZB,RSS ANY COMMON ? JMP SETLP NO. * XLA $SDA THE FIND PG # OF START OF SYSDVR AREA ALF,ALF CONVERT TO PG # RAL,RAL SETLP STA URFWA SET THE LOAD POINT OF PROG. * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SUBTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA * * LEDT4 LDA COMTP GET THE COMMON TYPE SZA,RSS ANY COMMON JMP LCLCM NO JUST LOCAL COMMON LDB PTYPE GET THE PROG TYPE CPA P1 SYS COMMON OR REVERSE COMMON ? JMP STRAT SYS COMMON. * CPB P2 IS IT A RT PROGRAM ? JMP ITSBG YES, SO USE BG COMMON JMP ITSRT NO, A BG PROG SO USE RT COMMON * STRAT CPB P2 IS IT A RT PROG JMP ITSRT ITSBG LDA P3 SET MPFT FENCE STA #MPFT LDA BKORG GET START OF BG COMMON LDB BKCOM AND THE LENGTH JMP STUF ITSRT LDA P2 STA #MPFT NOW DO RT LIKE BG ABOVE LDA RTORG LDB RTCOM STUF STA COMAD STB MXCOM JMP CMEXI GO LOOK FOR SSƒ������þúGA. * LCLCM CCA SET THE LOCAL COMMON FLAG STA COMIN LDA P5 NOW ASSUME PROG BG OR RT LDB PTYPE GET THE PROG TYPE CPB P4 IS IT A LBG PROG ? CLA YES STA #MPFT * CMEXI LDA P4 WELL, DOES HE WANT SSGA ? LDB SSGA SZB 0/1 NO/YES STA #MPFT * * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPREL SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FROM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA CWABP INITIALIZE ALLOCATION WORD STA SEGB AND SEGMENT BASE PAGE STA IDA ADDRESS OF BASE ID SEG (NONE EXIST YET) STA TLOAD POINTER TO ZAP THE AREA WITH STA TFIX LOW END OF FIXUP TABLE (AGAIN NONE EXIST) LDA BKLWR SET LWA STA LWABP OF AREA * CLA STA MBUF CLEAR VALID MODULE PRESENT FLAG * LDA XEQT GET THE LWA + 1 OF THIS PROGRAM ADA P23 XLA A,I CMA,INA MAKE NEG ADA FWABP ADD START OF DUMMY BASE PAGE SSA ANY OVERLAP JMP LOVER YES, THIS IS A SYMBOL TABLE OVERFLOW * CLA LDI7 STA TLOAD,I DUMMY ISZ TLOAD BASE INB,SZB PAGE JMP LDI7 AREA * LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA MAPOF ALLOCATE ROOM FOR X,Y REGS & MAP REGS STA SEGM SEGMENT BASE STA TPREL HIGHEST USED MEMORY ADDRESS STA PPREL * LDB OPCOD GET THE LAST OPCODE ²������þúCPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. #SECT SHOULD BE 0. * CCB STB NUPLS SET NO. PROGS LOADED = -1 STB PLFLG SET LOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG OMIT ENTERING DEBUG INTO LST SKP * * ENTER '.BBUG' INTO LST * JSB LSTX SET CURRENT LST ADDRES NOP LDA CHRDE GET CHARS . , D STA LST1,I SET NAME 1,2 INTO LST LDA CHRBU GET CHARS B,U STA LST2,I SET NAME 3,4 INTO LST LDA UCHRG GET UPPER CHAR G STA LST3,I SET NAME 5 INTO LST LDA P2 SET LST4 = UNDEF SYMBOL & STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 JMP ABOR * ERR17 ASC 1,17 CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP SKP 2 ************************************************************›Ô������þú*********** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * L-10 ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUMP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 17,LIPULBRTSCRCNCSSDBPETERPRSBGLENLDC OPP NOP ERROR CODE LDJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF LB BG PROGRAM (LARGE) DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF BG PRIVLEDGED PROGRAM DEF LE LIST ENTRY POINTS DEF NL NO LISTING DESIRED DEF DC THIS PROGRAM NOT TO BE COPIED ! DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADü9������þúING THE PROGRAM *AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT *CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * SSGA = 0/1 DON'T USE / USE SSGA * COMTP = 0 ... NO COMMON ( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * DO3 LDA TYPE2 GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING * DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE CMND TYPE ERB,SLB IF ITS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO LDA TLOAD IS THIS ' THE ' LOADR SZA,RSS YES JMP CHEKR SO ALL'S WELL.ND OK. JMP NOPUG FORGET IT . * LB LDA P4 BACKROUND PROGRAM (LARGE) BG2 STA PTYPE JMP TEST,I RT LDA P2 JMP BG2 BG LDA P3 JMP BG2 * NC CLA,RSS SC CLA,INA SC2 STA COMTP JMP TEST,I RC LDA P3 JMP SC2 * SS CLA,INA STA #MPFT STA SSGA SSGA FLAG JMP TEST,I * DB CLA,INA STA DBFLG STA OPCOD JMP TEST,I * TE CLA,RSS PE CLA,INA PM2 STA EDFLG CLB CLEAR OWNER FLAG SZA FOR PERMINANT STB OWNER èP������þú LOADS. JMP TEST,I RP LDA P2 JMP PM2 * RS JMP TEST,I THE 'RS' OPTION WAS A MISTAKE. CMM * LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I DC LDA M2000 GET THE DON'T COPY FLAG STA COPY? AND SET UP FOR LATER JMP TEST,I GET THE NEXT COMMAND * * SKP * * THIS ROUTINE SETS UP THE LIST DEVICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB ANY LU SUPPLIED OR IS IT NULL ? JMP DOALU YES, SO FIX THE LU * INB NULL SUPPLIED, SO SET DEFAULT STB IPBUF+3 * LDA MYLU# STA IPBUF * * JSB CLOS3 CLOSE ANY OLD FILE * DOALU LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU SZA,RSS IS THERE ONE ? JMP ZIPLU NO . JSB INTER IS IT INTERACTIVE ? RSS NO! JMP ZIPLU YES, DON'T LOCK IT * JSB LURQ UNLOCK ANY PREVIOUS LOCK DEF *+2 DEF MSIGN * JSB LURQ NOW LOCK THE NON INTERACTIVE LU DEF *+4 DEF P1 SPECIFY LOCK DEF IPBUF SPECIFY THE LU DEF P1 AND THE # OF LU'S * LDA IPBUF GET THE LU IOR M200 SET V BIT TO USE COLUMN 1 ZIPLU STA LISTU AND SET IT UP * JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 dg������þúDEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3 ERROR CODE TO A JSB FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREAT IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP JMP PRERR MUST BE AN ERROR * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES SSA,RSS IF NEG SZA,RSS OR ZERO JMP PRERR IT'S AN ERROR. STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * ******************************************************3»������þú**************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TYPE PRIORITY HIGH MAIN LOW MAIN REQ'D SIZE EMA SIZE PTTN * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "<LONG BLANK ID>" OR "<SHORT BLANK ID>" * * * LLIST JSB SPACE LDB LLM1 PRINT LDA P76 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N38 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET XLB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP GTNBR TERMINATION * ADB P12 SET TO NAME AREA. XLA B,I GET NAME 1,2, STA LLM1+1 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB XLA B,I SET NAME 3,4 STA LLM1+2 IN MESSAGE. INB XLA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+3 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * XLA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+5 AND STORE. * XLA B,I GET THE WORD AGA¾©������þúIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * CLB STB OPCOD INSURE AN OCTAL CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN XLA A,I GET IT LDB LLM18 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD XLA A,I LDB LLM13 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LOW BP XLA A,I GET THE WORD LDB LLM23 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP XLA A,I LDB LLM28 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL4 YES * XLB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY XLA B,I GET THE PRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM8 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * LDA ZTEMP GET THE PROG TYPE AGAIN CPA P1 MEM RES ? JMP LL4 YES, SO WE'RE DONE * * XLB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD XLA B,I GET THE SIZE STA XTEMP SAVE IT AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+28 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4. NO, SO GO DO OUTPUT * AND M77 O������þú SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+37 SAVE IT * LL4. XLB ABT1,I GET THE ID SEG AGAIN ADB D28 GET TO EMA WORD XLA B,I PULL IT IN SZA,RSS ANY EMA DECLARED ? JMP LL4 NO, SO WE'RE DONE WITH THIS LINE * STA LLIST SAVE WORD AND B1777 KEEP EMA SIZE LDB LLM30 GET THE ADDRESS JSB CONVD AND CONVERT * LDA LLIST NOW GET THE MSEG SIZE FROM THE ALF ID EXTENSION RAL,RAL AND M77 XLB $IDEX ADA B XLA A,I NOW HAVE THE MSEG ADDRESS XLA A,I NOW HAVE THE MSEG WORD AND M37 JSB CNV99 STA LLM1+34 * * LL4 LDA P76 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD XLA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * * GTNBR LDA P3 INSURE DECIMAL CONVERSION STA OPCOD JSB BLKID LDA BID5 GET # OF LONG LDB L#1 GET ADDRESS JSB CONVD CONVERT * LDA BID6 GET # OF SHORT IDS LDB L#2 JSB CONVD * LDA BID11 GET # OF ID EXTS LDB L#3 JSB CONVD * JSB SPACE LDA P64 PRINT THE INFO LDB L#IDS JSB DRKEY AND AS PORKY PIG WOULD SAY : * JMP EXIT THA-THA-THA-THA-THATS ALL FOLKS !!!!! æ������þú* * * PURGE CLA,INA GO SET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZB RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU LDA FILE2 GET THE CMND FILE LU # AND M77 KEEP ONLY LOWER BITS JSB INTER SEE IF IT'S INTERACTIVE JMP TRLST NOPE GOTIT IOR M400 SET ECHO BIT STA LISTU AND SET THE LU JMP TRYAG GO PRINT THE MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP ONLY LU JSB INTER GO SEE IF ITS INTERACTIVE JMP LDI5 THAT'S NOT EITHOR, SO FLUSH HIM ! JMP GOTIT * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM2+1 GET AN ASCII BLANK STA NAM12,I AND INITIALIZE BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TOO !) SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * L#IDS DEF *+1 ASC 22,XXXXXX FREE LONG IDS, XXXXXX FREE SHORT IDS, ASC 10,XXXXXX FREE ID EXTS * L#1 DEF L#IDS+1 L#2 DEF L#IDS+12 L#3 DEF L#IDS+23 LLM1 DEF *+1 ASC 20,N-£������þúAME TYPE PRIORITY LO MAIN HI MAIN ASC 18, LO BP HI BP SIZE EMA MSEG PART'N SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, <SHORT BLANK ID> LLM3 DEF *+1 ASC 9, <LONG BLANK ID> * LLM13 DEF LLM1+12 LLM18 DEF LLM1+17 LLM23 DEF LLM1+20 LLM28 DEF LLM1+24 LLM8 DEF LLM1+7 LLM30 DEF LLM1+30 P24 DEC 24 P25 DEC 25 P76 DEC 76 N38 DEC -38 D28 DEC 28 LLM2 DEF *+1 ASC 5, PNAME ?_ * * * ADJST NOP XLA ABT1,I GET THE ID ADDRESS AGAIN LDB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+1 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+2 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+3 JMP LIST?,I SUCCESS !!! JMP LL2 SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVERLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3 LOCAL/SYS/REVERSE M60 OCT 60 ERR25 ASC 1,25 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD /APPEND DEBUG XTEMP NOP YTEMP NOP ZTEMP NOP BKLWR NOP LAST WORD OF AVAIL MEMORY #PGPT NOP # OF PAGES IN PART'N * * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * LSCAN SEARCHES FOR AN ENTRY IN LST IDENTICAL TO THE NAME IN TBUF. * * CALLING SEQUENCE: * A = IGNORED * B =è;������þú IGNORED * JSB LSCAN * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): END OF LST. CURRENT LST ADDRES POINT TO THE NEXT * AVAILABLE ENTRY IN LST. * (N+2): NAME FOUND IN LST. CURRENT LST ADDRES POINT * TO THIS ENTRY. * LSCAN NOP JSB INLST INITIALIZE LSTX LDB TLST ENTX1 CPB PLST END OF LST ? JMP SLSTS YES - GO MAKE NEW ENTRY LDA B,I RAL,CLE,ERA CPA TBUF NAME 1,2 EQUAL ? JMP *+3 YES ADB P5 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I CPA TBUF+1 NAME 3,4 EQUAL ? JMP *+3 ADB P4 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I AND M7400 MASK OFF ORDINAL STA TBUF+3 LDA TBUF+2 AND M7400 MASK IN NAME 5 CPA TBUF+3 NAME 5 EQUAL ? JMP *+3 YES - SET LST1-5 ADDRES ADB P3 JMP ENTX1 ADB N2 BACK UP TO LST1 STB TLST AND SET UP TO CALL LSTX JSB LSTX FAKE IT HLT 0 I ALREADY CHECKED!! ISZ LSCAN SET FOR (P+2) RETURN JMP LSCAN,I SLSTS STB TLST (FOR LSTX TO USE) JSB LSTX ** RETURN MUST ALWAYS BE (P+1) ** JMP LSCAN,I RETURN (P+1) HLT 0 SKP * * SET NAME INTO LST * * SELST SETS THE CURRENT NAME INTO LST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SELST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SELST NOP LDA TBUF GET NAME 1,2 STA LST1,I SET NAME 1,2 INTO LST. LDA TBUF+1 GET NAME 3,4 STA LST2,I SET NAME 3,4 INTO LST LDA TBUF+2 GET NAME 5 AND M7400 ISOLATE UPPER CHAR STA LST3,I SET NAME 5 INTO LST LDA TLST GET NEXT LST ADDR STA PLST SET NEW END OF LST JMP SELST,I RETURN * * * GTCMD NOP JSB CLOS2 CLOSE CURRENT LIB * 94������þúJSB NAMRR NOW GET THE COMMAND FILE NAME SSA,RSS END OF STRING ? JMP NOSTG NO * LDA MYLU# YES, NO STRING. GET THE DEFAULT LU CCB SET B-REG TO -1 CPB BATCH RUNNING UNDER BATCH? LDA P5 YES,DEFAULT TO LU 5 STA IPBUF PUT INTO PARSE BUFFER CLA,INA SET TYPE WORD TO LU (NOT A FILE) STA IPBUF+3 * NOSTG LDA N6 GET THE NEG COUNT AGAIN JSB MOVE AND MOVE THE NAME TO THE CMND NAME BUFFER DEF IPBUF SOURCE OF MOVE DEF FILE2 COMMAND FILE NAME ADDRESS * CLA CLEAR INTERACTIVE FLAG STA DFLAG * LDA TYPE2 GET THE PARSE TYPE WORD AND P3 KEEP ONLY THE LEAST TWO BITS STA TYPE2 AND SAVE FOR LATER * ERA,SLA IS IT A FILE OR AN LU ? JMP GTCMD,I FILE, SO JUST RETURN LDA FILE2 AN LU. JSB INTER SEE IF IT IS INTERACTIVE JMP GTCMD,I SO JUST RETURN * ISZ DFLAG IT IS SO SET THE INTERACTIVE BIT * STA FILE3 IT IS, SO MAKE IT THE LIST LU IOR M200 USE COLUMN 1 STA LISTU IOR M400 SET THE ECHO BIT STA FILE2 ON THE LU FOR THE PROMPT JMP GTCMD,I RETURN * * * * FOPEN JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DATA CONTROL BLOCK DEF IERR2 ERROR FLAG DEF FILE2 FILE NAMR DEF IPTN2 OPEN OPTION DEF F2SC SECURITY CODE DEF F2DSC CARTRIDGE REF # * SSA,RSS ANY ERRORS ? JMP FREAD NO LDB F2 GET THE FILE NAME ADDRESS JSB FLERR YES * * * COMMAND FILE PROCESSOR * * LREAD LDA DFLAG (ALL LU READS RETURN HERE) GET THE FLAG SZA ARE WE INTERACTIVE ?? JSB PRMTR YES, SO OUTPUT LOADR PROMPT JSB REIO NOW READ THE INPUT DEF *+5 DO IT IN A REENTRANT FASHION SO THAT DEF P1äÃ������þú WE ARE SWAPABLE DEF FILE2 DEF STRNG DEF N80 SZB,RSS WAS THE READ OF ZERO LENGTH ? JMP END?? YES, END OF INPUT, GO DO ERROR CHECKING CMND STB SLONG SAVE READ LENGTH FOR PARSING ROUTINE CLA,INA SET UP PARSING OFFSET TO START PARSING STA ISTRC AT THE FIRST CHARACTER JSB NAMRR PARSE THE OPCODE LDB IPBUF+1 GET 3RD & 4TH CHAR STB OP1? LDB IPBUF AND SAVE THE OPCODE STB OP? TEMPORARIALLY * * THESE COMMANDS MAY BE ENTERED ANY TIME * * CPB EN END OF COMMAND FILE ? JMP SECHK CPB /E END OF COMMAND FILE ? JMP SECHK CPB EX END OF COMMAND FILE ? JMP SECHK CPB LO MODIFY CURRENT LOAD POINT ? JMP SECHK CPB SE A SEARCH COMMAND ? JMP SECHK CPB FO A FORCE COMMAND ? JMP FORCE CPB RE A RELOCATE COMMAND ? JMP SECHK CPB DS DISPLAY UNDEFS ? JMP DSPLY CPB EC ECHO COMMANDS ? JMP SUPRS CPB LI LIBRARY FILE ? JMP GTLIB CPB .A ABORT ? JMP ABORT CPB AB ABORT ? JMP ABORT CPB TR TRANSFER ? JMP XEQTR CPB SL LIBRARY SEARCH ? JMP SECHK LDA B AND M7400 CPA AS2RK JMP NXTOP * LDA DONE? GET THE MAIN LOADED FLAG SZA,RSS HAS THE MAIN BEEN LOADED ? JMP OVLY1 NO, GO TO OVERLAY AREA FOR REST OF COMNDS * PRERR LDA DFLAG GET THE INTERACTIVE FLAG ? SZA,RSS ARE WE IN THE INTERACTIVE MODE ? JMP DOERR GO DO THE INPUT ERROR THING JSB PRMTR YES, JSB EXEC SO GIVE HIM ANOTHER CHANCE DEF *+5 DEF P2 DEF FILE2 DEF PROMT+6 DEF P1 * JMP NXTOP GO GET THE NEXT INPUT * DOERR LDA CLEN GET THE READ LENGTH SZA iè������þúIF NON ZERO ECHO IT JSB IECHO JMP LDI5 ELSE JUST ABORT THYSELF OP? NOP LAST OPCODE ISTRC DEC 1 POINTER TO CURRENT CHAR TO BE PARSED * * PROCESS THE COMMAND. * DSPLY LDA DFLAG GET THE CMND INTERACTIVE FLAG SZA,RSS IS IT INTERACTIVE ?? JMP DSPL1 NO LDB LISTU YES SO GET THE LIST LU STB QTEMP AND SAVE LDB FILE2 GET THE CMND LU STB LISTU AND USE IT AS THE LIST DEVICE LDB TYPE3 GET TYPE STB PTEMP AND SAVE CLB,INB STB TYPE3 JSB PUDF REPORT UNDEFS LDB QTEMP GET THE LIST LU BACK AGAIN STB LISTU AND RESTORE IT LDB PTEMP GET TYPE STB TYPE3 AND SAVE IT TOO JMP NXTOP GET NEXT COMMAND DSPL1 JSB PUDF REPORT UNDEFS JMP NXTOP GET THE NEXT COMMAND SUPRS CCA STA ECHO? NXTOP LDA TYPE2 GET THE TYPE OF INPUT ERA,SLA WHERE ARE WE READING FROM ? JMP FREAD A FILE JMP LREAD AN LU FORCE CCA SET THE FORCE STA FORCD FLAG. JMP NXTOP RELOC CLA,RSS NOW SET A FEW FLAGS SERCH CCA NOW SET A FEW FLAGS STA LIBFL IS A LIBRARY SEARCH * DOPRS CLA SET A FEW FLAGS STA SCSEG CLEAR SCAN TILL SEG ENCOUNTERED FLAG STA SLIBF NOT A SYS LIB SCAN STA LGOU NOT AN LG READ CMA STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST JSB NAMRR PARSE TH INPUT SSA WAS THERE ANYTHING TO PARSE ? JMP SE?? NO SEE IF LAST ONE WAS A SE,< > LDA IPBUF GET THE 1ST PARSED WORD SZA IF = 0 OR CPA PROMT+4 = ASCII BLANK THEN JMP SE?? BETTER BE A SE,0, OR SE,, COMMAND * LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION gÓ������þú LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * DLOAD JSB NAMRR GO PARSE THE INPUT TO GET NEW LOAD ADDRESS LDA IPBUF+3 GET THE TYPE OF PARAMETER SLA RAR,SLA ONLY NUMERIC ALLOWED. NO ASCII. JMP PRERR SHAME ON YOU ! LDA PPREL GET THE CURRENT LOAD ADDRESS CMA,INA AND MAKE SURE THAT THE NEW LOAD ADA IPBUF ADDRESS IS ABOVE THE OLD ONE SSA IS IT ? JMP PRERR NO, SEND AN ERROR LDB IPBUF GET THE ADDRESS AGAIN SSB IF NEGATIVE JMP PRERR ITS AN ERROR ALSO CLA OK, SO CLEAR THE UNUSED AREA ADB N1 UP TO BUT NOT INCLUDING THE WORD SPECIFIED JSB OUTAB OUTAB WILL CHECK TO SEE IF HE SET THE * LDA TPREL LOAD POINT TOO HIGH FOR THIS LOAD STA PPREL RESET THE LOAD POINT JMP NXTOP LOAD POINT TOO HIGH. NOW GET NEXT CMND. * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN FLIB NOP 0/-1 NOT/IS A LIBRARY FILE SCAN SVTP1 NOP OLD INPUT FILE TYPE WORD STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE CPA LO WAS IT A CHANGE LOAD ADDRESS CMND ? JMP DLOAD YES, SO GO SET UP NEW LOAD ADDRESS a+������þú CPA SL WAS IT A SEARCH LIBRARY COMMAND ? JMP SELIB THEN DO IT JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * GTLIB JSB NAMRR PARSE FOR NEXT INPUT SSA ANY ERRORS ? JMP PRERR YES, NOTHING TO PARSE * LDA IPBUF+3 GET THE TYPE WORD AND P3 KEEP ONLY TYPE CPA P3 WAS THE INPUT ASCII ? RSS YES. SO ITS OK FOR NOW. JMP PRERR NO, LU'S ARE NOT LIBRARY FILES. * LDB LPNTR GET THE POINTER TO THE LAST LIB FILE CPB END TOO MANY LIB FILES ? JMP PRERR THATS AN ERROR TOO. STB NXTAD OK. SO MOVE NAME & SC & CART # TO BUFFER AREA * LDA N3 MOVE COUNT JSB MOVE DEF IPBUF SOURCE NXTAD NOP DESTINATION SET ABOVE * LDB LPNTR GET THE SOURCE ADDR ADB P3 ADD MOVE COUNT LDA IPBUF+4 GET THE SECURITY CODE STA B,I & STUFF IT INB BUMP POINTER LDA IPBUF+5 GET THE CART REF # STA B,I AND STUFF THAT TOO. INB STB LPNTR RESET THE POINTER ADDRESS FO NEXT LIB. JMP NXTOP GET THE NEXT COMMAND. * XEQTR JSB GTCMD CLOSE OUT OLD FILE & OPEN NEW. JSB BREAK CHECK IF ABORT DESIRED LDA TYPE2 GET THE TYPE WORD ERA,SLA FILE OR LU JMP FOPEN FILE JMP LREAD LU * SELIB JSB LIBSC SCAN THE LIBRARIES JMP NXTOP GO GET NEXT COMMAND * * * THE FOLLOWING ARE THE LEGAL COMMAND FILE COMMANDS * DS ASC 1,DI TR ASC 1,TR SL ASC 1,SL LI ASC 1,LI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE FO ASC 1,FO EN ASC 1,EN .A ASC 1,/A AB ASC 1,AB /E ASC 1,/E EX ASC 1,EX LO ASC 1,LO AS2RK OCT 25000 AN * ECHO? NOP LPNTR DEF LIBRY POINTER TO LIBRARY NAME BUFFERS SPC 1 * * * IERR2 NOP Gm������þú ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 DEC 1 OPEN OPTION (NON EXCLUSIVE) IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO THE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JSB FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : * PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARAMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL ‡§������þú PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE HANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JSB FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR NOP SAVE RETURN ADDRESS STB EFILE SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO ASCII * STA B SAVE ASCII AND M774K GET THE UPPER BYTE CPA B20K IS IT A BLANK ? ADB B10K YES, SO FILL IN LEADING BLANK WITH A ZERO STB EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I ITw˜������þú STA EFBUF+11 INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * JSB PTERR POST ERROR TO SCB DEF *+2 DEF EFBUF+1 * * LDA DFLAG GET INTEACTIVE FLAG SZA,RSS WE INTERACTIVE ? JMP PRNIT NO,JUST GO PRINT IT * LDA LISTU SAVE THE LIST LU STA QTEMP LDA FILE2 REPLACE WITH INTERACTIVE LU STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * PRNIT LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP LDI5 NO, DO THE REST OF THE ERROR THING * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP STA TYPE3 AND TYPE OF LIST DEVICE WORD * JMP NXTOP GO GET NEXT COMMAND * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 M774K OCT 77400 B20K OCT 20000 B10K OCT 10000 * * *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR AND IGNORES ANY ERROR RETURNS. AFTER ALL WHAT ELSE *CAN YOU DO ?? * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB,CLE STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 Ìç������þú JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE RSS NOT INTERACTIVE JMP USEL2 IS INTERACTIVE USEL1 LDA MYLU# ITS NOT, SO USE START UP LU USEL2 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR-0XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SAVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 IF DVR07 SUBCHANNEL = 0 RSS §(������þúJMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LG, LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. LDA TYPE1 NO, SO GET THE READ TYPE WORD ERA,SLA IS THE READ FROM AN LU OR FILE JMP RREAD A FILE SO GO READ THE NEXT RECORD. * SKP * * LOAD FROM INPUT LU * JSB EXEC DEF *+5 DEF P1 1 = READ REQUEST DEF PGMIN PROG INPUT UNIT NO. DEF LBUF LBUF = INPUT BUFFER DEF P64 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP RECLS SZB JMP TESTR JMP RECLS * * PGMIN OCT 305 †½������þú SEOT OCT 705 B400 OCT 400 * * M240 OCT 240 * SPC 1 * OPENN NOP JSB OPEN OPEN THE FILE ! DEF *+8 DEF IDCB1 DCB DEF IERR1 ERROR FLAG DEFF1 DEF FILE1 ASCII FILE NAME DEF IPTN1 READ OPTION DEF F1SC SECURITY CODE DEF F1DSC CART REF # DEF IDCBS # OF BUFFER WORDS * SSA,RSS ANY ERROR IN THE READ ? JMP OPENN,I NO LDB F1 YES , GET THE FILE NAME JSB FLERR AND REPORT * * * * F1OPN JSB OPENN OPEN THE FILE FNXT1 CLA STA NAM#1 SET TO FIRST NAM IN FILE STA RSRSC DO NOT RESET AND RESCAN (AT BEGINNING) STA SXREC RESCAN POINT NOT SET YET STA #SEGS CLEAR # OF SEGMENTS ENCOUNTERED FLAG STA #NAMS CLEAR # OF NAMS FOUND WHILE SCAN TILL SEG FLAG STA YREC CLEAR THE SEGMENTED PROGRAM RESCAN POINTER STA ZREC CLEAR THE SEGMENTED PROGRAM RESCAN POINTER INA STA XREC SET RESCAN POINTER TO 1ST RECORD IN THE FILE. * SPC 1 RREAD JSB READF READ THE NEXR RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF LBUF RELOCATABLE RECORD BUFFER ! DEF P64 DEF LEN ACTUAL RECORD LENGTH READ * SPC 1 SSA,RSS ANY ERRORS ? JMP FNXT2 NO LDB F1 YES, GET THE FILE NAME JSB FLERR AND REPORT SPC 1 FNXT2 LDA LEN GET THE RECORD LENGTH READ SZA,RSS ZERO RECORD LENGTH ? JMP RREAD YES, SO TRY AGAIN SSA,RSS NO, WAS IT A NEG LENGTH ( -1 ) JMP TESTR NO, SO GO PROCESS RECORD ! * LDA FLIB THIS A FILE LIB SCAN (LI,XXXXX COMMAND) SZA,RSS WELL ? JMP NOLIB NO. * ISZ NUPLS YES, ANYTHING LOADED ? JMP RWNDL YES, SO DO IT AGAIN JMP LBRTN NO, SO GO CHECK OUT THE NEXT FILE. * SPC 1 NOLIB LDA RSCNX YES ! SZA WEDƒ������þúRE WE RESCANNING THE FILE ?? JMP NSCAN YES NOW GO RESET THE FILE BACK * LDA LIBFL IS THIS A LIBRARY SCAN ? ADA SCSEG AND NOT A SCAN TILL SEGMENT FOUND SZA,RSS WELL? JMP CK#SG NO, SEE IF ANY SEGMNETS IN THIS FILE LDA OP1? DID HE SAY SE, OR SEXXXX, ? CPA ASNUL WELL JMP RECLS SE, SO DON'T LOOK FOR BACKWARD REFS ISZ NUPLS YES, WAS ANYTHING LOADED ? JMP DUMMY YES, SO DO IT AGAIN (BACKWARD REF FIX) JMP RECLS NO, SO GO CLOSE THE FILE * CK#SG LDA #SEGS GET THE # OF SEGMENTS IN THIS FILE SZA,RSS ANY ? JMP RECLS NO. * LDA #NAMS WERE THERE ANY NAMS AFTER THE SEGMENT ? CMA,INA,SZA JMP SCANW YES,SET A REG NEG * * RECLS JSB CLOS1 NO , EOF REACHED. CLOSE FILE * ISZ SKP.1 SKIP IF 1ST CMND NOT YET DONE RSS JMP SECK1 GO DO LAST COMMAND * LDA TYPE2 GET THE CMND FILE TYPE WORD. SZA IS THERE A CMND FILE ? JMP NXTOP YES, SO GO GET NEXT COMMAND * CLFL1 LDA P3 NO CNMD FILE & NO RELOC FILE. MUST BE LDB MSEG FINISHED WITH USER INPUT. SO IF SZB THE PROG IS SEGMENTED. SET LAST SEG STA MSEGF FLAG. JMP LOADX NOW GO FINISH THE LOAD. * * F1 DEF FILE1 POINTER TO RELOC FILE BUFFER LEN NOP LENGTH OF READ OF RELO FILE ASNUL ASC 1, A BLANK OP1? NOP 2ND WORD OF SEARCH COMMAND (SEXXCH) * * * ALL FORCE LOADS COME HERE TO CLEAN UP FIX UP TABLE * * FIXCL LDA MSEG GET THE SEGMENTED PROG FLAG SZA,RSS IS PROG SEGMENTED ? JMP NODEX NO, DON'T NEED TO CLEAN UP FIXUP TABLE. * JSB SILST SET TO SCAN THE SEGMENTS LDB TLST LST FIXC0 CPB PLST END? JMP NODEX YES GO FINISH * STB LST1 SET LST1 FOR FIXAL ADB P3 TO GET THE LDA B,I DEFINED FLAG ß)������þú AND P7 ISOLATE IT CPA P2 UNDEFINED? JMP FIXC1 YES GO DEFINE IT * FIXC2 ADB P2 NO INDEX TO THE NEXT ONE JMP FIXC0 AND GO LOOK AT IT * FIXC1 LDA M2000 SET TYPE TO 4 (IN HIGH BYTE) STA B,I DEFINE THE SYMBOL INB SET ITS VALUE CLA STA B,I TO ZERO JSB FIXAL GO DO ALL FIXUPS LDB LST4 RESTOR B JMP FIXC2 AND CONTINUE THE LOOP * ERR05 ASC 1,05 ERR10 ASC 1,10 P13 DEC 13 PLFLG NOP LDI5 LDA ERR10 JMP ABOR * * * * * SYMBOL TABLE OVERFLOW * LOVER EQU * JSB CPRNM PRINT MODULE NAME(IF PRSENT) LDA ERR05 SET CODE EQUAL LST OVERFLOW ABOR JSB ERROR * JSB PTERR POST THE ERROR TO THE SCB DEF *+3 DEF MERR DEF MERR+3 (DUMMY PARAMETER) * ABORT CLA CLEAR PROG NAME STA PRAM IN NAME PASSED BACK STA PRAM+1 THRU PRTN ROUTINE STA PRAM+2 LDA MERR GET THE ERROR CODE STA PRAM+3 PUT INTO TO ERROR CODE LDA MERR+1 AND THE # OF THE ERROR CODE STA PRAM+4 STUFF IT IN RETURN MESSAGE FOR FATHER LDA P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP *+1,I TERMINATE LOADER(AND THIS PROGMER) DEF LTERM (SAVE A BP LINK TOO ) * MES10 DEF *+1 ASC 7,LOADR ABORTED SKP * * INPUT FROM DISC LOAD-AND-GO AREA (SYSTEM LIBRARY SCAN ) * LDRN2 LDB XCUR IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, RSS READ NEXT SECTOR JMP LDRN4 DON'T BOTHER ITS IN CORE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB SECT2 IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN6 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK ADD 1 TO TRACK # * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF P2 DEF 0������þúXBUF DEF P128 READ 2 LOGICAL SECTORS (1 PHYSICAL 7900) DEF LGTRK DEF LGSEC * ISZ LGSEC -ADD 2 FOR NEXT SECTOR. ISZ LGSEC LDA XBUFA SET STARTING BUFFER STA XCUR ADDR LDA N128 AND STA LGT1 COUNTER = -128. LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 -NO- CLA CLEAR THE STA LBOEF FLAG LDA N64 RESET COUNT FOR HALF SECTOR ONLY STA LGT1 CLA STA XCNT SET REC COUNT TO ZERO LDA XBHLF SET THE BUF ADDR STA XCUR TO THE ODD SECTOR * LDRN4 CLA IF CURRENT CPA XCNT REC COUNT = 0, RSS THEN SET FOR NEW REC. JMP LDRN5 CONTINUE WITH CURRENT REC. LDA XCUR,I GET NEXT ALF,ALF REC LENGTH (UPPER CHAR.), AND M77 SET NEGATIVE CMA,INA,SZA,RSS JMP LDRNE YES, READ NEXT SECTOR STA XCNT NO, SAVE COUNT FOR MOVE LDA ALBUF RESET ADDR OF STA LGT2 LBUF FOR MOVE. * LDRN5 LDA XCUR,I MOVE WORD FORM XBUF STA LGT2,I TO LBUF ISZ XCUR UPDATE BUFFER ISZ LGT2 ADDRES. ISZ XCNT INDEX NOP ISZ LGT1 COUNTERS. NOP CLA LDB XBUFA RESET ADDR OF CPA LGT1 'XBUF' IF STB XCUR END OF XBUF. CPA XCNT IF END OF REC, JMP TESTR GO TO PROCESS IT. CPA LGT1 IF END OF XBUF, JMP LDRN3 GO TO READ NEXT SECTOR. JMP LDRN5 CONTINUE WITH CURRENT REC. * N64 DEC -64 N128 DEC -128 P128 DEC 128 LDRNE LDA XBUFA WAS ZERO LENGTH REC AT CPA XCUR START OF A SECTOR? RSS JMP LDRN3 NO, READ NEW SECTOR. CCB YES, SUBTRACT 1 FROM CURR SECTOR ADB LGSEC IN CASE END OF LG ON ODD SECTOR JMP LDRN6 CHECK FOR END »9������þúOF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * * * LGTRK NOP TRACK LGSEC NOP SECTOR LGT1 NOP DOWN COUNTER IN XBUF LGT2 NOP CURRENT LBUF ADDR XCNT NOP REC LENGTH RIC NOP REC INDICATOR L7 OCT -7 XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * * SKP * * THE SCANX ROUTINE SAVES OUR LOCATION IN THE FILE AND * THEN REWINDS THE FILE TO THE BEGINING SO THAT THE FILE * MAY BE SCANNED FOR UNDEFS. THIS ALLOWS A SUBROUTINE TO * PLACED IN THE FILE ONLY ONCE, BUT TO HAVE IT APPENDED TO * ANY SEGMENT OR MAIN THAT CALLS IT. SCANX IS CALLED WHENEVER * A SEGMENT NAM IS ENCOUNTERED IN THE FILE. WHEN THE END OF * FILE IS ENCOUNTERED THE FILE MUST ALSO BE SCANNED (IE MAY BE * THE LAST SEGMENT IN THE PROGRAM) IN THIS CASE EOF IS REACHED * INSTEAD OF THE NEXT SEGMENT. THIS IS DETECTED BY THE FILE * READ ROUTINE. IF MORE THAN ONE NAM IS ENCOUNTERED AFTER AHEN * SEGMENT BUT BEFORE THE NEXT SEGMENT OR EOF THEN THE * CONTROL IS TRANSFERED TO SCANW (A REG IS NEG). THEN #SEGS IS * MADE NEG AS A FLAG SO THAT THE NSCAN ROUTINE WILL CLOSE THE * FILE INSTEAD OF GOING OF TO DO A SYSTEM LIBRARY SEARCH. * * SCANW STA #SEGS SET FLAG FOR EOF REACHED & RESCANNING FILE CLA STA SCSEG CLEAR SCAN TILL SEG FOUND FLAG. SCANX CCA SET THE RESCAN FLAG HERE.(NOT BELOW) STA RSCNX * LDB MSEG GET THE SEGMENTED PROG FLAG CPB P1 WE WORKING ON THE MAIN? JMP SCFLG YES, SO FORGET ABOUT REWIND (WE GOT IT ALL) * LDA RSRSC OK TO RESCAN FILE SZA,RSS IF NEW FILE AND SEGMENT LOADED JMP NOSCN ELSE DON'T RESCAN * DUMMY JSB POSTX POST FILE (KLUGE FIX FOR A FMGR BUG !!!!!!) * LDA XREC GET THE RESCAN POINTER SSA IF NEG, NO USEFUL SUBROUTINES IN THIS FILE pW������þú JMP NOSCN NEG, SO DON'T BOTHER WITH RESCAN * JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLG NO, SO GO SET THE FLAGS DORWN LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LIBFL IS A SCAN OF LIBRARY STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST * LDB MSEG GET SEG FLAG CPB P1 WORKING ON MAIN ? JMP TESTR YES, GO PROCESS THE RECORD AGAIN JMP RREAD READ THE RECORD * * * THE NSCAN ROUTINE SETS THE FILE BACK TO THE ORGINAL * LOCATION BEFORE THE SCANX ROUTINE REWOUND IT. * * NSCAN ISZ NUPLS ANYTHING LOADED LAST SCAN ?? JMP SMART SO DO IT AGAIN * LDA SXREC SET RESCAN POINT YET? SZA NO JMP APSNX YES * CCB LDA XREC GET THE POINTER TO 1ST SUBROUTINE AFTER CPA P1 FIRST SEGMENT. DID WE FIND A SUBROUTINE ? STB XREC NO, SO IN FUTURE NEVER REWIND THIS FILE * * APSNX JSB APOSN SET THE FILE BACK UP DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES NOSCN CLA WE NEED TO RESET A FEW FLAGS STA LIBFL NOT A LIBRARY SCAN STA RSCNX NO LONGER RESCANNING THE FILE * LDB #SEGS GET THE # OF SEGS LOADED FLAG SSB,RSS WAS THE RESCAN DUE TO EOF OR NEW SEGMENT JMP LOADX NEW SEGMENT. SCAN SYS LIB FOR OLD SEG JMP RECLS EOF. SO GO CLOSE THE FILE . * SKP * * SMART JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 KB������þú DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLX NO, SO GO SET THE FLAGS LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLX JSB POSTX (KLUGE FIX FOR FMGR BUG !!!!!) CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LIBFL IS A SCAN OF LIBRARY STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST * JMP RREAD SKP POSTX NOP JSB POST DEF *+3 POST THE FILE TO CLEAR ALL OF CORE BIT IN FMGR DEF IDCB1 ALSO FIXES A FMGR BUG ! DEF IERR1 * SSA,RSS ANY ERRORS ? JMP POSTX,I NO * LDB F1 YES JSB FLERR GO REPORT SKP * * * SAVIT SETS THE RESCAN POINT FOR A FILE. * ANY CHANGES SHOULD STILL HANDLE THE FOLLOWING CASES. * (WHERE THE FILE CONTAINS THE FOLLOWING THINGS IN THE * GIVEN ORDER). NOTE THAT SCANX ALSO CONTAINS SOME * CONDITION CHECKS. * MAIN = PROGRAM MAIN * SUB = SUBROUTINE * SEG = SEGMENT * * = PLACE THAT RESCAN POINTER SHOULD * BE SET TO. * IN THE FILES WHERE NO MAIN APPEARS, ASSUME THAT THE MAIN * WAS IN A PREVIOUS FILE. * * * ------------------------------------------------------- * ! MAIN ! SUB ! SUB ! SEG ! SUB ! SEG ! SUB ! SUB ! SUB ! * ------------------------------------------------------- * * * * -------------------------------------------------- * ! MAIN ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * -------------------------------------------------- * * * * -------------- ------- * ! MAIN ! SUB ! ! SEG ! * -------------- ------- * N©Æ������þúO RESCAN NO RESCAN * * -------------- ------------- * ! MAIN ! SEG ! ! SUB ! SEG ! * -------------- ------------- * NO RESCAN * * * ------------------------------------------- * ! SUB ! SEG ! SUB ! SUB ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------- * ! SEG ! SEG ! SEG ! SEG ! SEG ! * ------------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------------------- * ! SEG ! SEG ! SUB ! SEG ! SUB ! SUB ! SEG ! * ------------------------------------------- * * * * ------------------------------- * ! SUB ! SUB ! SUB ! SUB ! SUB ! * ------------------------------- * NO RESCAN * * ------------------------- ------------------- * ! SUB ! SEG ! SUB ! SUB ! ! SUB ! SEG ! SEG ! * ------------------------- ------------------- * * * * * -------------------------- * ! MAIN ! SEG ! SEG ! SEG ! * -------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SUB ! SUB ! SEG ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * * SKP * SAVIT NOP LDA SXREC DID WE ALREADY FIND THE SZA RESCAN POINT ? JMP SAVIT,I YES LDA PROGT GET THE NAM TYPE CPA P5 SEGMENT ? JMP SAVIT,I YES, FORGET IT * LDA RSCNX WE IN THE RESCAN MODE ? SSA,RSS YES JMP SAVIT,I NO FORGET IT * JSB POSNT OK,SO BACK UP THE FMGR POINTER BY ONE DEF *+4 DEF IDCB1 DEF IERR1 DEF ¥þ������þúN1 * SSA ERRORS JMP XYZER YES * JSB LOCF SAVE THE POSITION DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC DEF YREC DEF ZREC * SSA ERRORS ? JMP XYZER YES * JSB POSNT MOVE POSITION BACK DEF *+4 DEF IDCB1 DEF IERR1 DEF P1 * SSA ANY ERRORS ? JMP XYZER YES ISZ SXREC NO,SET FLAG - RESCAN PT HAS BEEN SET JMP SAVIT,I RETURN * XYZER LDB F1 YES JSB FLERR * * IREC NOP IRB NOP RSCNX NOP 0/-1 NO RESCAN/ RESCAN OF FILE IN PROGRESS IOFF NOP LGOU NOP LG (SYS LIBRARY) IN USE FLAG #SEGS NOP #OF SEGMENTS IN THIS FILE FLAG XREC NOP RESCAN REC # YREC NOP RESCAN BLOCK OFFSET # ZREC NOP RESCAN OFFSET IN BLOCK SXREC NOP 0/NON ZERO HAVE NOT/HAVE SET UP RESCAN PT * SKP * TEST FOR VALID REC * TESTR LDA LBUF+1 GET REC IDENTIFIER ALF,RAR AND M7 ISOLATE RIC STA RIC SAVE REC ID CODE SZA SKIP - ABSOLUTE REC ADA L7 SUBTRACT 6B SSA,RSS SKIP - VALID REC TYPE JMP RCERR INVALID REC TYPE * TEST FOR VALID CHECKSUM LDA LBUF GET REC LENGTH AND M7400 AND ZERO LOWER CHARACTER, STA B BLF,BLF ROTATE TO LOW B CMB,INB COMPLEMENT ADB P3 ADJUST FOR ADDR OF WORD 4 SSB,RSS SKIP - VALID REC LENGTH JMP RCERR INVALID (SHORT) REC STB WDCNT SET WORD COUNT FOR CHECKSUM LDA LBUF+1 GET WORD 2 - INITIALIZE CHECKSUM LDB ALBUF GET ADDR OF LBUF ADB P3 ADJUST ADDR FOR WORD 3 TEST1 ADA B,I ADD WORD TO CHECKSUM INB INCR CURRENT LBUF ADDR ISZ WDCNT SKIP - END OF REC JMP TEST1 CONTINUE Cα������þúHECKSUM TEST CPA LBUF+2 EQUAL TO GIVEN CHECKSUM? JMP LDRC YES - PROCESS REC * * CHECKSUM ERROR. PRINT MODULE NAME * (MODULE NAME WILL BE IN MBUF IF A NAM REC * HAS ALREADY BEEN READ. OTHERWISE, IT WILL NOT * BE PRINTED SINCE IT MAY BE GARBAGED IN THE * THE NAM RECORD ITSELF. * JSB CPRNM PRINT NAME IF ANY LDA ERR01 CODE 01 = CHECKSUM ERROR JMP ABOR PRINT DIAGNOSTIC ON SYSTEM TTY & ABORT * ERR01 ASC 1,01 ERR02 ASC 1,02 * * * ILLEGAL RECORD TYPE * RCERR EQU * JSB CPRNM PRINT MODULE NAME,IF GOOD LDA ERR02 CODE 02 = ILLEGAL REC JMP ABOR * * PRINT NAME OF MODULE(OR ENTRY POINT) * * CALLING SEQUENCE: * JSB PRNAM * DEF TO NAME TO BE PRINTED * <RETURN> * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA MBUF GET "VALID NAME" FLAG SZA,RSS NAME READ? JMP CPRNM,I NO, EXIT JSB PRNAM PRINT NAME DEF MBUF JMP CPRNM,I EXIT * * CLASSIFY RECS BY TYPE LDRC LDA RIC GET REC IDENTIFICATION CODE LDB PLFLG GET LOADING FLAG CPA P1 TYPE = NAM ? JMP NAMRX YES - PROCESS NAM REC SZB SKIP - NOT LOADING JMP NMERR REC OUT OF SEQUENCE CPA P2 TYPE = ENT? JMP ENTR YES - PROCESS ENT REC CPA P3 TYPE = DBL? JMP DBLR YES - PROCESS REC CPA P4 TYPE = EXT? JMP EXTR YES - PROCESS EXT REC CPA P6 TYPE = EMA? JMP EMARC YES - PROCESS EMA RECORD * * * MUST BE AN END RECORD. SKP * * *** PROCESS END RECORD *** * * * JSB BREAK SEE €“������þúIF WE SHOULD BREAK LDA IGNOR SZA,RSS LATEST SUBROUTINE LOADED ? JMP RESET YES, PROCESS AS NORMAL. * LDA BID3 NO, THEN RESTORE CURRENT STA CWABP FW AVAILABLE ON BASE PAGE. LDA BID4 AND END OF LST. STA PLST JMP NOCLR SKIP CLEARING OF BIT15 IN LST1 * * TEST FOR OVERFLOW OF COMMON * RESET LDA MCOMX GET COMMON LENGTH OF LAST MODULE CMA,INA SUBTRACT FROM INITIAL SET LENGTH ADA MXCOM SSA,RSS IF SAME OR LESS JMP NOCLR THEN OK * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR06 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. ERR06 ASC 1,06 MCOMX NOP LEN OF LAST MODULE SCANNED/LOADED * NOCLR LDA XBUFA RESET ADDR OF CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF LBUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET PRIMARY ENTRY POINT FLAG SLA,RSS SKIP - HAS PRIMARY ENTRY POINT JMP NOPRE OMIT PROCESSING NO ENTRY POINT SKP * * * PRINT MEMORY MAP LDA IGNOR SZA WAS LATEST SUBROUTINE LOADED? JMP NOPRE NO,SO DON'T DO PRIMARY ENTRY PT STUFF LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA LBUF+3 GEй������þúT WORD 3 OF END REC ADA PPREL ADD PROG RELOC BASE STA PRENT,I SET IN ID SEGMENT LDA MBUF GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT LDA MBUF+1 GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR * LDB MSEG NOW GET THE SEGMENT LOAD FLAG ERB,ERB TO E. LDB PTYPE GET THE PROG TYPE SEZ THIS A SEGMENT OR MAIN ? LDB M25 SEGMENT, SO SET TYPE & SEG BIT. IOR B * STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NPAR STORE PRIORITY SZA FROM NAME REC STA PRIOR,I IF NON-ZERO. LDA NPAR+1 IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. AND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA B IN 15-13 LDA NPAR+2 AND AND M7770 EXECUTION MULTIPLE IOR B IN 11-00 STA RESL,I LDA NPAR+5 GET SECONDS MPY P100 SCALE TO TMS ADA NPAR+6 TMS+SCALED SECONDS STA NPAR+5 SAVE LDA NPAR+3 GET HOURS MPY P60 SCALE TO MINUTES ADA NPAR+4 ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA NPAR+5 TMS+SCALED SECONDS SEZ WAS THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND THE ID IF ONE JMP NOPRE NONE StÃ������þúO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG  RSS THEN CHECK FOR COPIES OF THE PROGRAM JMP IDSN1 ELSE BE FRIENDLY & RENAME THE PROGRAM * JSB COPY. B-REG = ID ADDR/ SEE IF ANY COPIES OF PROG JMP NOPRE WE GOT BACK ! MUST NOT BE ANY COPIES. * * IDSN1 LDA MBUF GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA MBUF+1 NAME MESSAGE BUFFER STA MESS7+13 LDA MBUF+2 STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 INVALID RESET PROG NAME LDA RENAM GET ASCII '##' STA MBUF SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. LDA P4 LDB WNG32 NOW SEND A WARNING MESSAGE JSB SYOUT JMP IDSN REPEAT DUPLICATE PROG NAME SCAN * IDSN2 LDA ERR32 GET ERROR MESSAGE & JMP ABOR ABORT THYSELF. SPC 1 ERR32 ASC 1,32 WNG32 DEF *+1 ASC 2,W 32 P27 DEC 27 M25 OCT 25 M7770 OCT 7777 NPAR BSS 7 NAME RECORD PARAMETERS RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE CCA STA PLFLG SET 'LOOK FOR NAM' FLAG LDA IGNOR SZA,RSS IF LAST SCAN USEFUL JSB MAPPR THEN PRINT MEM MAP & UPDAT BASE * JSB INLST INITIALIZE LSTX LDB TLST CPORD CPB PLST END OF LST ? JMP SLTST YES - SET UP NEXT OPERATION ADB P2 CLEAR POSSIBLE ORDINAL LDA B,I FROM LST 3. AND M7400 STA B,I ADB P3 JMP CPORD CONTINUE CLEARING PROG ORDINALS SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA MBUF LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? Ä������þú YES, CHECK ON NEXT OPERATION. * * LDA MSEG IS THIS A SEGMENTED PROGRAM ? CPA P2 WELL ? RSS YES JMP LDRIN NO,GET NEXT RECORD * LDA PROGT THIS MODULE A SEGMENT ? CPA P5 WELL ? RSS YES JMP LDRIN NO, GO GET THE NEXT RECORD. * LDA LIBFL WE, SCANNING AT THE MOMENT ? SZA WELL ? JMP LDRIN NO, GET THE NEXT MODULE * CCA SET THE LIBRARY SCAN FLAG STA LIBFL CLA,INA SET THE SCAN TILL NEXT SEGMENT FLAG STA SCSEG JMP LDRIN GO GET THE NEXT SEGMENT * * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SEGM NOP SKP * * * PROCESS EMA RECORD. * * EMARC LDA LIBFL GET THE LIB SCAN FLAG SZA WE SCANNING ? JMP LDRIN YES SO IGNOR THE WHOLE THING * LDA EMABP ANY PREVIOUS DECELERATION ? SZA WELL ? JMP LL19 YES, ITS AN ERROR * * *E LDB ALBUF GET THE RECORD BUFFER ADDRESS INB INDEX TO EMA WORD LDA B,I & PULL IT IN AND B1777 KEEP ONLY EMA SIZE STA EMASZ * ADB P2 NOW GET THE SYMBOL NAME LDA B,I CHARS 1 & 2 STA TBUF * INB CHARS 3 & 4 LDA B,I STA TBUF+1 * INB CHAR 5 & ORDINAL # LDA B,I STA TBUF+2 * INB & MSEG SIZE LDA B,I AND M37 STA MSGSZ * JSB LSCAN SEE IF THIS SYMBOL PREVIOUSLY REFERENCED RSS JMP LL19 AN ERROR LDA MSEG IS THIS A SEGMENT ? CPA P2 WELL ? JMP LL19 THATS AN ERROR ALSO * LDA TBUF NOW PUT THE LABEL IN THE SYMBOL TABLE STA LST1,I LDA TBUF+1 STA LST2,I LDA TBÇ[������þúUF+2 STA LST3,I * LDA TLST UPDATE END OF SYMBOL TABLE STA PLST * LDA B200 NOW SET SYM TABLE V BIT ADA P3 SET SYMBOL AS EMA TYPE(DEFINED) STA LST4,I & PUT IN SYMBOL TABLE * JSB ALLOC GET A BP LINK STA LST5,I & PUT ABS ADDRESS IN TABLE STB EMABP SAVE DUMMY ADDRESS LOCALLY * LDB #PGS *E SZB ANY SPECIFIED SIZE GIVEN? JMP NOPG1 YES, CHECK AGAINST 32K MAX * LDA MSGSZ GET THE MSEG SIZE INA ACCOUNT FOR I/O OVERFLOW CPA P1 IF JUST 1 INA THEN SET MIN MSEG SIZE ALF,ALF NOW ADJUST TO # OF PAGES RAL,RAL CMA,INA & SET NEW UPPER BOUNDS FOR CODE ADA B7777 SPACE STA LWA JMP NOPG *E * NOPG1 LDA URFWA GET LOAD PT IN # PGS ALF *E RAL,RAL CONVERT TO # PAGES ADA B ADD # OF PAGES SPECIFIED LDB MSGSZ *E INB ACCOUNT FOR I/O OVERFLOW PAGE CPB P1 DEFAULTED EMA? INB YES, BUMP FOR MINIMUM SIZE ADA B (A) = # PAGES REQUIRED CMA,INA WITH EXTRA BP INA TAKE OUT EXTRA BP ADA D32 SUBTRACT FROM 32K LOGICAL SSA EXCEEDED 32K? JMP ER.18 YES. * NOPG JSB BLKID GO COUNT ID SEGS LDA BID9 SEE IF THERE ARE ANY SZA,RSS ID EXTENSIONS JMP LL20 IF NOT ABORT THYSELF JMP LDRIN GET THE NEXT RECORD * LL19 LDA ERR19 JMP ABOR ER.18 LDA ERR18 JMP ABOR ERR18 ASC 1,18 LL20. JSB $LIBX RETURN FROM PRIV PROCESSING DEF *+1 DEF *+1 LL20 LDA ERR20 JMP ABOR ERR19 ASC 1,19 ERR20 ASC 1,20 EMABP NOP MSGSZ NOP EMASZ NOP B7777 OCT 77777 * * * * MAPPR NOP LDB PLGTH GET LEN WORD SZB IF ZERO OR SSB COMPILER PRODUCE|ò������þúD JMP MAPP1 FORGET THE BSS FILL * ADB N1 ELSE SET TO RELATIVE ADDR OF ADB PPREL GET REAL CORE ADDR STB A INA CPA TPREL WAS IT LOADED? JMP MAPP1 YES SKIP THE FILL * CLA NO FILL THE BSS WITH ZERO'S JSB OUTAB OUTPUT FILL WORDS MAPP1 JSB PRMAP PRINT MEM MAP & UPDATE BASES JMP MAPPR,I RETURN * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA MSEG GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ MSEG NO, SO SET IT. CLA RESET THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SEGM GET THE SEGMENT BASE ADDRESS CPB PPREL IF SAME AS CURRENT SEGMENT THEN JMP NAMR3 LAST SEGMENT LOADED. THIS IS NEW ONE * * ISZ #SEGS INCREMENT THE # OF SEGMENTS ENCOUNTERED FLAG LDA N60 GET NEG COUNT JSB MOVE DEF LBUF SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE IS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * JSB LOCF OK SO SAVE OUR POSITION IN THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC RECORD # IN FILE USED IN JUST A SECOND DEF IRB DEF IOFF * SSA,RSS ANY ERRORS ? JMP *+3 NO * LDB F1 GET THE FILE NAME JSB FLERR AND REPORT * JMP SCANX RESCAN THE FILE * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO/YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND WHILE SCAd@������þúN FOR NEXT SEG. RSRSC NOP 0/-1 NOT OK/OK TO RESCAN FILE * * NAMR3 CCA SET FLAG TO STA RSRSC OK TO RESCAN FILE JMP NAMR1 NOW * * SKP * PROCESS NAM REC NAMRX SZB,RSS SKIP - VALID REC SEQUENCE JMP NMERR REC OUT OF SEQUENCE LDA FWABP GET DUMMY BP BASE CMA,INA AND SUBTRACT FROM ADA CWABP CURRENT DUMMY BP LOCATION. ADA BPFWA ADD OFFSET TO REAL BP BASE STA BPREL AND SET AS NEW BP REL BASE CLA SET UP FLAG TO 'NOT IGNORE' STA IGNOR LDA LBUF+9 GET PGM TYPE STA PROGT AND SAVE IT. LDA LIBFL IF SCANNING TILL NEXT SEG,THEN ADA SCSEG LOOK AT THE SEG ELS IF JUST SZA SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB LBUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL SEG FOUND OPERATION ? SZA WELL ? ISZ #NAMS YES, SO COUNT THE NAMS LDA LBUF+8 GET COMMON LENGTH STA MCOMX SET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP COMOK NO COMMON, TEST B.P. LENGTH LDB LIBFL IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP COMOK ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP COMOK ASSUME COMMON OK TILL 'END' IS READ * LDB URFWA GET THE BASE LOAD ADDRESS ADB MAPOF ACCOUNT FOR THE X&Y REGISTERS & MAP REGS CPB TPREL COMPARE TO HIGH MAIN RSS = , SO COMMON DECLRATION OK JMP CMERR COMMON ERROR STA MXCOM FIRST COMMON, SET MAX LENGTH LDA FWA ADJUST RELOCATION BASES SPC 1 ADA MAPOF 2 WORDS FOR X-Y REG SAVE SPC 1 STA COMAD SET +Ý������þúFWA OF COMMON (LOCAL) LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA COMAD ADA MXCOM COMPUTE COMMON UPPER BOUND + 1 SPC 1 SPC 1 STA PPREL SET AS LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP NAMR2 OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS NAMR2 LDA LWA CMA,INA COMPUTE LENGTH LEFT OVER AFTER ADA PPREL COMMON ALLOCATION. SSA SKIP IF INVALID COMMON LENGTH JMP COMOK COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR ERR03 ASC 1,03 ERR09 ASC 1,09 * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP ABOR SYMAD BSS 1 ADDR OF SYMBOL RELOCATION MXCOM NOP MAX COMMON LENGTH * * COMOK CLA SET UP FLAG TO STA PLFLG "NAM HAS BEEN READ" JSB SEMAP SET PROG NAME IN MEM MAP LDA PLST SAVE STA BID4 END OF LST ADDR LDA CWABP NEXT AVAILABLE WORD ADDR ON BP STA BID3 CCA LDB LIBFL GET THE LIB SCAN FLAG SZB WE SCANNING ? STA IGNOR YES, SET FLAG "TO IGNORE" LDA LBUF+7 GET BP LENGTH SZA,RSS ANY BP RELOCATION ? JMP CKSUB NO, THEN GO CHECK FOR SEG LOAD. CMA,INA SET NEGATIVE LENGTH OF STA ABT1 BASE PAGE AREA NEEDED. BPCLR JSB ALLOC MOVE CWABP BY SAME ISZ ABT1 ZEROED AND MOVED ALL ? JMP BPCLR NO, THEN DO MORE. * CKSUB JSB SAVIT YES, SO LOOK F¥������þúOR REWIND POINT LDA NAM#1 1ST NAM IN FILE SZA YES JMP LDRIN NO, GET NEXT REC CCB RESET STB NAM#1 SO WE KNOW WE DID IT LDA PROGT GET TYPE SZA,RSS IF ZERO ISZ #NAMS INC #NAMS CMA,INA ELSE MAKE IT NEG ADA P5 ADD 5 SSA IF WAS GREATER THAN 5 ISZ #NAMS INC #NAMS JMP LDRIN GET THE NEXT RECORD * PROGT NOP PROG TYPE BEING SCANNED NAM#1 NOP 0/-1 1ST NAM IN FILE/NOT 1ST NAM IN FILE P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * THE INLST AND LSTX SUBROUTINES SET THE ADDRES FOR THE CURRENT * ENTRY IN THE LOADER SYMBOL TABLE (LST). * * INITIALIZE LSTX * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST IN TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INLST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INLST NOP LDA BLST GET STARTING ADDR OF LST STA TLST SET CURRENT LST ADDR JMP INLST,I RETURN * * SPECIAL ROUTINE "SILST" * * THIS ROUTINE INITIALIZES THE LST FOR THE * BACKGROUND SEGMENT AREA ONLY, IF MAIN/SEGMENT * LOADING IS BEING DONE. IT USES THE CONTENTS * OF "SLST" - SLST IS INITIALIZED TO BE = TO * "BLST" BUT IS CHANGED AFTER THE "MAIN" PROG * IS LOADED TO BE THE ADDR OF THE ENTRY * FOLLOWING THE LAST ENTRY FOR THE MAIN. * * SAME CALLING SEQUENCE AS FOR "INLST". * SILST NOP LDA SLST SET SEGMENT LST ADDR STA TLST AS CURRENT ADDR. JMP SILST,I * * THIS ROUTINE INITIALIZES START OF LST TO BEGIN JUST * AFTER THE END OF RESIDENT LIB LST (START OF THE LST * BUILT FROM USER'S PROG) * FNLST NOP LDA FLST STA TLST JMP FNLST,I * * * SET CURRENT LST ADDRES * * THE LSTX SUBROUTINE SETS THE CURRENT LST ADDRES FROM TLST. * * CALLING Sa������þúEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * LSTX NOP LDA TLST GET CURRENT LST ADDR CPA PLST END OF LST? RSS YES - CONTINUE ISZ LSTX NO - INCR RETURN ADDR STA LST1 SET WORD 1 ADDR INA STA LST2 SET WORD 2 ADDR INA STA LST3 SET WORD 3 ADDR INA STA LST4 SET WORD 4 ADDR INA STA LST5 SET WORD 5 ADDR INA STA TLST SET NEXT LST ADDR CMA,INA ADA TFIX ADD FWA OF DUMMY ID SEGMENT AREA SSA,RSS IF RESULT = 0 OR <0, SZA,RSS THEN ERROR JMP LOVER OVERFLOW. JMP LSTX,I -OK, RETURN. * * * * SCAN TO SEE IF ANY UNDEFINED * (REGS MEANINGLESS ON ENTRY AND RETURN) * JSB LSTX1 * (P+1) RETURN - NO UNDEFINED * (P+2) RETURN - UNDEFINED EXIST * LSTX1 NOP JSB FNLST START LST FROM USER MAIN LDA MSEG BUT IF CPA P2 LOADING A SEGMENT JSB SILST THEN START FRM SEGMENT'S LST. LDB TLST GET CURRENT LST ADDR LSTX2 CPB PLST END OF LST ? JMP LSTX1,I YES - RETURN (P+1) ADB P3 LDA B,I GET LST4 AND P7 MASK IN STATUS CPA P2 UNDEF EXT ? JMP YEXT YES ADB P2 POINT TO NEXT SYMBOL JMP LSTX2 SEE NEXT SYMBOL YEXT ISZ LSTX1 UNDEF FOUND - BUMP RETURN ADDR JMP LSTX1,I RETURN (P+2) SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFÝÒ������þúFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 * * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINT OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA DBFLG IS DEBUG ALLOWED ? SZA,RSS WELL ? JMP DEBUG,I NO, SO FORGET IT * LDA IGNOR YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDA MBUF GET PROG NAME 1,2 CPA DB1 CHARS = D,B? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+1 GET PROG NAME 3,4 CPA DB2 CHARS = U,G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA DB3 CHAR = R? RSS YES - CONTINUE JMP DEBUG,I ¨ì������þú RETURN - PROG IS NOT 'DEBUG' * JSB SILST INITIALIZE FOR SEGMENT DSCAN JSB LSTX SET LST ADDRES HLT 0 'DEBUG' NOT FOUND IN LST LDA LST1,I GET NAME 1,2 CPA CHRDE CHARS = D,E? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST2,I GET NAME 3,4 CPA CHRBU CHARS = B,U? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR CPA UCHRG CHAR = G? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY * LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN STATUS CPA P2 UNDEFINED ? HLT 0 'DEBUG' IS UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT POINT LDB LST5,I AND PUT IT INTO ENTRY POINT JSB OUTAB 'DEBUG'(ON THE DISC) * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA PPREL ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I RETURN * DB1 ASC 1,DB DB2 ASC 1,UG DB3 OCT 51000 R DB1X ASC 1,.S ASC 1,TD OCT 41000 * * PROCESS ENT,EXT RECS * ENTR CCA,RSS ENT REC PROCESSOR EXTR CLA EXT REC PROCESSOR STA NXFLG SET ENT/EXT FLAG = -1/0 * LDA LIBFL GET THE LIBRARY SCAN FLAG SZA,RSS SCANNING LIBRARY JMP ADDON NO LDA PROGT YES, SO GET THE PROGRAM TYPE CPA P5 IS IT A SEGMENT ? JMP LDRIN YES, SO FORGET IT ADDON LDA LBUF+1 GET NO. SYMBOLS AND M37 ISOLATE SYMBOLS CMA,INA STA EXCNT SET ENT/EXT SYMBOL COUNT LDB ALBUF GET ADDR OF LBUF ADB P3 NEXSY LDA B,I GET SYMBOL 1,2 STA TBUF SAVE NAME 1,2 INB LDA B,I GET SYMBOL 3,4 STA TBUF+1 SAVE NAME 3,4 ü������þú INB LDA B,I GET SYMBOL 5 STA TBUF+2 SAVE NAME 5 INB STB SYMAD SAVE SYMBOL ADDR (FOR ENT) * LDB NXFLG GET ENT/EXT FLAG SZB,RSS SKIP - SET ENT ABSOLUTE ADDR JMP NOTEN OMIT SETTING ABS. ADDR FOR EXT AND P7 MASK IN RELOCATION BASE TYPE STA ENTYP SAVE ENT TYPE CLB CPA P4 IF TYPE 4 ENT JMP TYP4 THEN GO SET IT UP. ADA ENTRL ADD RELOCATION BASE ADDR LDB A,I GET PROPER RELOCATION BASE TYP4 ADB SYMAD,I ADD TO GET ABSOLUTE ADDR STB OPRND AND SAVE IT NOTEN JSB LSCAN SCAN LST FOR NAME JMP ENTX3 END OF LST * LDA LST4,I SET UP STATUS OF AND P3 SYMBOL MATCHED WITH. STA ENTST LDA LIBFL SZA,RSS SCANNING LIB ? JMP NRML NO LDA NXFLG SZA,RSS PROCESSING ENT ? JMP NRML NO LDA ENTST GET SYMBOL STATUS CPA P2 ENT MATCHED WITH EXT ? RSS YES - THEN IT IS OK. JMP ENTX5 NO - THEN FORGET IT. NRML LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP - PROCESS ENT JMP ENTX4 COMPLETE EXT PROCESSING * LDA ENTST GET STATUS OF SYMBOL CPA P2 IF STATUS = 2 (UNDEF SYMBOL) JMP ENT2X THEN SET ENT ABS VALUE FOR EXT * * DUPLICATE ENTRY POINT * CPA P3 AN EMA ENTRY PERHAPS ? JMP LL19 YES JSB CPRNM PRINT MODULE NAME JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * ERR07 ASC 1,07 * ENT2X LDA ENTYP GET ENT TYPE ALF,ALF POSITION ENT TYPE LDB LIBFL GET LIB SCAN FLAG SZB,RSS IF SCANNING LIB INA THEN SKIP THIS INSTRUCTION STA LST4,I SET LST4 CLA STA IGNOR SET TO 'NOT IGNORE' FOR LIB INA STA NUPLS SET FLAG FOR 'SOME9å������þú LIB LOADED' LDA OPRND OPERAND IN IT STA LST5,I SET VALUE INTO LST. JSB FIXAL FIX ALL REFERENCES JMP ENTX5 COMPLETE ENT PROCESSING * SKP * ENTX3 JSB SELST SET NAME INTO LST LDB NXFLG GET ENT/EXT FLAG SZB,RSS PROCESSING EXT ? JMP EXTNM YES LDA ENTYP ALF,ALF POSITION ENT TYPE LDB LIBFL SZB,RSS LIB SCAN ? INA NO, THEN SET STATUS = 1. STA LST4,I SET LST4 LDA OPRND SET SYMBOL VALUE STA LST5,I AND SET JMP ENTX5 IN LST5. COMPLETE ENT PROCESSING. * EXTNM LDA P2 STATUS = 2 FOR EXT STA LST4,I SET UP LST4 FOR EXT ENTX4 LDA TBUF+2 GET CHAR 5, ORDINAL STA LST3,I SET ORDINAL INTO LST ENTX5 LDB SYMAD GET SYMBOL ADDR LDA NXFLG GET ENT-EXT FLAG SZA SKIP - EXT INB INCR SYMBOL ADDR FOR ENT ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NEXSY PROCESS NEXT SYMBOL JMP LDRIN READ NEXT REC * EXCNT BSS 1 EXT/ENT SYMBOL COUNT NXFLG BSS 1 EXT/ENT FLAG ENTYP BSS 1 ENT TYPE BEING PROCESSED ENTST BSS 1 STATUS OF LST SYMBOL MATCHED M100 OCT 100 N5 DEC -5 * * SKP * PROCESS DBL REC DBLR LDA IGNOR SZA REC TO BE IGNORED ? JMP LDRIN YES, GET NEXT REC. * LDA LBUF+1 GET INSTRUCTION COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA ALBUF GET ADDR OF LBUF ADA P4 ADJUST FOR FIRST RELOCATION BYTE STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET WORD 2 OF DBL REC AND M300 ISOLATE REL TYPE FOR LOAD ADDR STA DBLBS SAVE FOR LATER LDB LBUF+3 GET THE RELOCATION ADDRESS CPA M100 IF = 1 JMP MBASE THEN PROG RELOCATABLE. ADB BPREL ¹������þú RELOCATE THE LOAD ADDRESS FOR BP. SZA IF = 0 THEN BASE PAGE RELOCATABLE JMP RCERR ELSE ERROR 2 - ILLEGAL REC. JMP DBL0 FOR BP REL, AVOID FWA RESET. * MBASE ADB PPREL RELOCATE THE LOAD ADDRESS FOR MAIN MEM. ISZ DBLFL (SKIPS ONLY IF 1ST DBL OF NEW SEGMENT) JMP DBL0 * * ADJUST PROGRAM RELOCATION BASE TO LOAD ADDR IN * FIRST DBL RECORD IN EACH LOADING OPERATION TO * NOT ALLOCATE DISC SPACE FOR BSS AREAS AT THE * BEGINNING OF A PROGRAM. ALSO,THIS ALLOWS FOR * A PSEUDO COMMON REGION BETWEEN A "MAIN" PROG * AND ALL SEGMENTS IF THE SAME SIZE BSS AREA IS * DECLARED AT THE BEGINNING OF EACH SEGMENT. * LDA LBUF+3 ADJUST FWA TO BSS DISPLACEMENT ADA FWA ON DISC LOWER BOUND. STA FWA SET NEW FWA FOR LOAD OPERATION STA TPREL DBL0 STB DBLAD SET THE LOAD ADDRESS DBL1 LDB CURAL,I GET RELOCATION BYTE STB REKEY SAVE RELOCATION RYTE LDA N5 STA INSCN SET RELOCATION BYTE COUNT ISZ CURAL INCR CURRENT LBUF ADDR DBL2 LDA REKEY GET RELOCATION BYTE ALF,RAR ROTATE TO LOW A STA REKEY SET NEXT RELOCATION BYTE AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES - GET LINK ADDR CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR EXT WITH OFFSET CPA P6 BYTE ADDR ? JMP DBL6 YES ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDA A,I SET RELOCATION BASE ADA CURAL,I ADD CURRENT INSTRUCTION WORD DBL3 LDB DBLAD GET LOAD ADDRESS TO B JSB OUTAB OUTPUT ABSOLUTE PROG WORD ON DISC DBL9 ISZ CURAL INCR CURRENT LBUF ADDR ISZ EXCNT SKIP - ALL INSTRUCTIONS OUT RSS NO - CONTINUE JMP LDRIN GET NEXT REC ISZ DBLAD INCR CURRENT DBL RELOCATION ADDR ISZ INSCN SKIP - GET NEW RELOCATION BYTE JMP DBL2 PROCESS NEXT^ç������þú INSTRUCTION JMP DBL1 GET NEXT RELOCATION BYTE DBL4 LDA CURAL,I GET CURRENT DBL WORD AND M377 ISOLATE ORDINAL STA EXORD AND SAVE IT. CLA STA OFSET SET OFFSET = 0 JSB DBLEX SET BP LINK ADDR FOR EXT JMP DBL9 INSTRUCTION IS OUTPUT BY DBLEX * DBL5 LDA CURAL,I GET CURRENT WORD FROM LBUF RAR,RAR POSITION AND AND M377 MASK IN ORDINAL IF ANY SZA,RSS ANY ORDINAL ? JMP DBL5M NO - GO PROCESS MEM REF. * STA EXORD SET UP ORDINAL LDB CURAL GET LBUF ADDR INB BUMP TO WHERE OFFSET IS LDA B,I GET OFFSET STA OFSET AND SET OFFSET VALUE. JSB DBLEX SET BP LINK FOR EXT REF ISZ CURAL INCREMENT LBUF ADDR JMP DBL9 GO INDEX TO NEXT WORD DBL5M LDA CURAL,I GET NEXT WORD FROM LBUF ISZ CURAL INCR CURRENT LBUF ADDR JSB MREF SET ADDR FOR MEM REF INSTR JMP DBL3 OUTPUT ABSOLUTE PROG WORD DBL6 LDA CURAL,I GET WORD 1 OF THE GROUP ALF POSITION AND AND M17 MASK IN TYPE. SZA IF NON-ZERO JMP RCERR THEN ILLEGAL REC ERROR LDA CURAL,I ELSE GET WORD 1 AGAIN AND P3 MASK IN RELOCATION TYPE LDB ENTRL GET RELOCATION BASE ADB A LDB B,I FROM TABLE RBL AND COVERT TO BYTE ADDR ISZ CURAL LDA CURAL,I GET WORD 2 (BYTE ADDR) SSA IF SIGN BIT SET JMP RCERR THEN ILLEGAL REC. ADA B ADD BASE BYTE ADDR TO GET INSTRUCTION JMP DBL3 GO TO OUTPUT ON DISC OR BP * DBLBS NOP LOAD ADDR INDICATOR OFSET NOP OFFSET FOR AN EXT M17 OCT 17 * * SKP * *********** LIBRARY FILE SCAN MODULE ************ * * LOADX JSB LSTX1 ANY UNDEFS ? JMP LOADQ NO, GO LOOK FOR PRIMARY ENTRY POINT OR SYS LIB JSB LIBSC GO SCAN FOR LIBRAR 3������þúIES JMP LOADQ GO SCAN SYSTEM LIBRARY * * SKP LIBSC NOP LDA START,I ANY LIBRARIES TO SEARCH ? SZA,RSS WELL ? JMP LIBSC,I NO, SO FORGET THE WHOLE THING. * * * LIBRARY FILE(S) EXIST * * LDB TYPE1 OK, BUT IS THERE ALSO A CURRENT INPUT STB SVTP1 FILE THAT WE ARE RELOCATING ? SZB,RSS WELL ? JMP LOADK NO INPUT FILE, BUT A LIBRARY FILE EXISTS. * * *********** LIBRARY EXISTS BUT WE HAVE AN INPUT FILE OPEN ************ * * ERB,SLB FILE OR LU OPEN ? RSS FILE. JMP LOADK LU. * JSB CLOS1 CLOSE THE INPUT FILE SSA,RSS ANY ERRORS ? JMP LOADK NO LDB F1 YES JSB FLERR * * ****** SET UP FOR LIBRARY SCAN ******** * * * LOADK LDA START GET THE 1ST LIB FILE PARAMETERS STA F1 SET INTO ERROR FLAG STA INCX AND THE OPEN CALL ADA P3 SET SEC CODE & CART ALSO STA INCY INA STA INCZ * NXLIB JSB OPEN OPEN THE LIB FILE DEF *+8 DEF IDCB1 DEF IERR1 INCX NOP NAME DEF IPTN1 NONEXCLUSIVE OPEN INCY NOP SECURITY CODE INCZ NOP CART REF DEF IDCBS # OF WORDS TO USE * LDB P3 SET FILE IN USE FLAG STB TYPE1 * SSA,RSS ANY ERRORS JMP STFLG NO, GO READ THE RELO CODE. LDB F1 YES, JSB FLERR GO SEND ERROR MESSAGE * RWNDL JSB POSTX (KLUGE FIX FOR FMGR APOSN BUG) JSB APOSN REWIND THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS JMP STFLG NO * LDB F1 YES JSB FLERR * STFLG CCA SET FLAGS STA LIBFL LIB SCAN STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST STA FLIB LIB FIj¹������þúLE SCAN IN PROGRESS FLAG CLA STA LGOU LG NOT IN USE STA SLIBF NOT A SYS LIB SCAN JMP RREAD HOP TO IT ! * * LBRTN JSB CLOS1 CLOSE THE FILE SSA,RSS ANY ERRORS JMP *+3 NO. LDB F1 YES JSB FLERR SEND ERROR * JSB LSTX1 ANY UNDEFS ? JMP LOADW NO, SO FORGET ABOUT THE REST OF THE LIB SEARCH * LDA INCX SET UP NEXT LIBRARY ADA P5 LDB A,I IS THERE A NEXT LIB ? SZB WELL ? CPB END WELL ? JMP LOADW NOPE. * STA F1 SET ERROR POINTER & STA INCX SET UP THE OPEN CALL LDA INCY ADA P5 STA INCY * LDA INCZ ADA P5 STA INCZ * JMP NXLIB GO GET 'EM ROVER ! * ANOP NOP * LOADW CLA LIB SCAN DONE STA FLIB * LDA DEFF1 SET ORGINAL F1 BACK UP STA F1 * LDA SVTP1 GET THE OLD TYPE WORD . STA TYPE1 & RESET SZA,RSS WAS A PREVIOUS FILE OPEN ? JMP LIBSC,I NO, SO RETURN * ERA,SLA YES, FILE OR LU RSS FILE JMP LIBSC,I LU SO RETURN * JSB OPENN OPEN THE ORGINAL FILE JSB APOSN POSITION FILE TO CORRECT DEF *+6 DEF IDCB1 AREA DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA,RSS ANY ERRORS JMP LIBSC,I NO, SO RETURN * LDB F1 GET THE FILE NAME JSB FLERR REPORT THE ERROR * * * * START DEF LIBRY LIBRY BSS 5 LIBRARY FILE 1 BSS 5 LIBRARY FILE 2 BSS 5 LIBRARY FILE 3 BSS 5 LIBRARY FILE 4 BSS 5 LIBRARY FILE 5 BSS 5 LIBRARY FILE 6 BSS 5 LIBRARY FILE 7 BSS 5 LIBRARY FILE 8 BSS 5 LIBRARY FILE 9 BSS 5 LIBRARY FILE 10 END DEF * END OF LIBRARY AREA SKP * 2¾������þú* * LOAD FROM PROG LIB * LOADQ LDA TYPE1 SEE IF THERE STILL A FILE OPEN. ERA,SLA IF THERE IS RSS (THERE IS) JMP LOADZ (THERE ISN'T) * JSB POSTX THEN THIS MUST BE A SEGMENTED PROGRAM * AND WE ARE GOING TO DO A LIB SCAN. * IF WE CALL POST THEN WE CAN USE THE * 256 WORDS AS BUFFER SPACE FOR THE SCAN. * * LOADZ LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JMP ABOR SO ABORT THYSELF LOADN CCA SET FLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LIBFL 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLAG STA LSTBK SET UP POINTERS TO DISC LIB SUCH LDB SYSLN GET THE START OF USER ENTS LDA PTYPE GET PROG TYPE CPA P3 PRIV PROG ? CLB YES, SO SET SCAN TO 0 STB DCNT LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRANSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA MSEG GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LO™ö������þúAD LDA OP? YES, GET THE LAST OPCODE CPA SE WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA #ENTS IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT JSB FNLST INITIALIZE TO START OF USER LST LDA MSEG IF SEG LOAD CPA P2 THEN JSB SILST INITIALIZE LST FOR SEG ONLY JSB MATCH SCAN LST FOR MATCHING NAME JMP SYLOK+1 NO MATCH - CHECK NEXT SYMBOL * GTSUB LDA TBUF+3 MATCH !(GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * ALF,ALF SET TYPE TO HIGH END STA B,I SET IN SYMBOL TABLE LST4 STA GTENT SAVE FOR ENT TYPE CHECK BELOW INB SET TO LST5 LDA TBUF+4 GET SYMBOL VALUE STA B,I SET IN LST5 ADB N4 SET TO LST1 STB LST1 SET FOR FIXUP * LDB GTENT GET THE SYMBOL TYPE SZB IS IT MEM RES ? JMP GTMEM NO, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. CMA NO. SO IF THE ADDRESS XLB $DLP IS ABOVE START OF COMMON ADA B SSA,RSS THEN CHECK FURTHER JMP GTMEM ELSE CONTINUE XLB $COML GET LENGTH OF COMMON BLF,BLF CONVERT TO PAGES RBL,RBL ADA B ADD TO CURRENT LOCATION SSA,RSS IF POS, THEN THE ENT IS IN COMMON JMP LL24 AND ITS AN ERROR. * GTMEM JSB FIXAL FIX ALL REFERENCES JMP SYLOK+1 CONTINUE SCAN * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DP‹������þúISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGNOR STA PLFLG STA NUPLS JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA * LL24 JSB PRNAM PRINT EXTERNAL NAME DEF TBUF LDA ERR24 JMP ABOR ERR24 ASC 1,24 * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 BIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETERMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB Ÿ������þúLDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORD JMP GTENT,I RETURN DONE SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP #ENTS NOP TOTAL # OF ENTS IN SYSTEM SPC 1 * * LIBFL NOP SLIBF NOP REKEY NOP INSCN NOP ERR08 ASC 1,08 * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * COUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP JSB LSTX1 ANY UNDEFINED ? JMP RNDEX NO LDB SYSLN SET UP FOR LIB SCAN LDA PTYPE GET PROG TYPE CPA P3 PRIV ? CLB YES, SET START OF SCAN = 0 STB DCNT SET UP THE START OF THE SCAN JMP CSUBR,I RETURN * * SCAN OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? JSB LSTX1 INITIALIZE LST & ANY UNDEF ? JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING Câù������þúONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA MSEG IS THE PROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE IUNDF LDA ERR28 NO, SO ABORT THYSELF JMP ABOR * ERR28 ASC 1,28 * SKP * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS JSB SYOUT PRINT: UNDEFINED EXTS JSB FNLST INITIALIZE LSTX * LDA MSEG IF LOADING CPA P2 A SEGMENT, INITIALIZE JSB SILST FOR IT IN LST. * XSCAN JSB LSTX SET LST ADDRES JMP PSUSP END OF EXTS LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED SYMBOL ? RSS YES - THEN SKIP JMP XSCAN TRY NEXT LST ENTRY ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB LST1 GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA Ì…������þú ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS IGNOR NOP UN# NOP SKP * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB P3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,INB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CLE,ERB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * ~ ������þú LDA LISTU GET THE LU TO WRITE TO AND M77 WITHOUT ANYTHING ELSE LDB MYLU# GET MY DEFAULT LU # SZA,RSS NULL OR BIT BUCKET ? STB LISTU YES THEN SET IT UP * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JSB FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (ASCII) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP STA MERR+1 SET CODE INTO ERROR MESSAGE LDA P4 LDB MESS5 MESS5 = ADDR: L XX JSB SYOUT PRINT: L XX JMP ERROR,I RETURN JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 4,L 77 * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SEú?������þúT COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN * * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYOUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OUTPUT MESSAGE * JMP SYOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: ASC 15 DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N20 DEC -20 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASèt������þúE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (18 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM4 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * EMAID * SHIGH * SESW1 * SESW2 * SESW3 * IDEX1 * IDEX2 * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT FLAG LDA N20 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA TFIX THE FIXUP TABLE STA SET2 SET NEW END LDB TFIX CURRENT ADDRESS TO B STA TFIX SET …p������þúNEW END OF FIXUP TBL. SETI0 CPB IDA END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA TFIX CMA,INA TEST FOR SYMBOL ADA PLST OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA IDA SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA IDA FOR NEW ADDR. LDB IDA SET CLA DUMMY SETI STA B,I ID INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA IDA LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG INA STA EMAID SET EMA WORD INA STA SHIGH HIGH MAIN + LARGEST SEG + 1 INA STA SESW1 SESSION MONITOR WORD # 1 INA STA SESW2 SESSION MONITOR WORD # 2 INA STA SESW3 SESSION MONITOR WORD # 3 INA STA IDEX1 ID EXTENSION WORD # 1 INA STA IDEX2 ID EXTENSION WORD # 2 * * LDA P99 INITIALIZE STA ‘}������þúPRIOR,I PRIORITY = 99 * IFN LDA MYLU# SET LU # CMA,INA STA SESW3,I XIF * CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P99 DEC 99 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG IDA NOP FWA OF CURRENT DUMMY ID SEGMENT EMAID NOP ADDRESS OF EMA WORD SHIGH NOP ADDRESS OF HIGH MAIN + SEG + 1 SESW1 NOP SESSION WORDS 1 - 3 SESW2 NOP SESW3 NOP IDEX1 NOP ID EXTENSION WORD 1 IDEX2 NOP ID EXTENSION WORD 2 SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA,RSS IF ENOUGH JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE * NOIDS LDA P20 LDB SETM JSB SYOUT LDA ERR33 JMP ABOR NOW ABORT THE POOR GUY * ERR33 ASC 1,33 * * DBLEX HANDLES ALL DBL EXTERNAL REFERENECS & EMA REFERENCES. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND 'OFSET' SHOULD HAVE ,Þ������þúA FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * EXORD = EXT ORDINAL # * OFSET = OFFSET OF INSTRUCTION * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBLEX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (A) HAS INSTRUCTION TO BE OUTPUT * DBLEX NOP JSB INLST INITIALIZE LSTX LDB PLST ADB P2 SET END PNTR STB PRMAP LDB TLST ADB P2 DBLF CPB PRMAP END OF LST ? JMP ORD? ORDINAL NOT FOUND * LDA B,I GET LST3 AND M377 MASK IN ORDINAL ADB P5 POINT TO NEXT LST1 CPA EXORD ORDINALS EQUAL ? RSS YES - SKIP JMP DBLF NO - CHECK NEXT LST ENTRY * ADB N7 BACK UP TO CURRENT SYMBOL STB TLST AND SET UP FOR LSTX JSB LSTX HLT 0 I HAVE ALLREADY CHECKED!! LDA REKEY SET THE DBL AND M7 TYPE STA T1FIX FOR FIXIT OR... LDA CURAL,I GET THE INSTRUCTION AND M1740 ISOLATE IT STA T2FIX AND SAVE IT ALSO LDA LST4,I GET WORD 4 OF LST ENTRY AND P3 ISOLATE THE TYPE CPA P3 IS IT EMA ? JMP EMDBL YES, SO PROCESS EMA EXTERNAL REFERENCE * CPA P2 IS SYMBOL DEFINED? JMP DBLE0 NO GO BUILD A FIX UP * JSB FIXIT YES FIX IT UP AND OUTPUT IT JMP DBLEX,I RETURN * DBLE0 LDB TFIX GET CURRENT END ADB N4 PUSH DOWN STB TFIX THE BOTTOM OF THE TABLE CMB,INB WAS THERE ROOM? ADB PLST SSB,RSS WELL?? JMP LOVER NOPE DID HIM IN * LDB TFIX YES JSB FIXX SET UP THIS ENTRY * LDA LST1 SET STA FIX2,I THE LST ENTRY LDA T2FIX COMBINE IOR T1FIX THE INSTRUCTION AND DBL TYPE STA FIX3,I AND SET IT LDA OFSET GET THE OFSET STA FI;j������þúX4,I AND SET IT LDA DBLAD NOW FOR THE ADDRESS STA FIX1,I JMP DBLEX,I EXIT * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * ERR14 ASC 1,14 * * PROCESS EMA EXTERNAL REFERENCE. * EMDBL LDA T1FIX GET THE TYPE OF DBL RECORD CPA P4 TYPE 4 ? RSS YES, SO ALL'S WELL JMP LL27 NO, ITS AN ERROR LDA T2FIX GET THE INSTRUCTION CODE SSA INDIRECT BIT SET ? JMP LL27 THAT'S AN ERROR ALSO * ADA MSIGN NOW SET THE SIGN BIT ADA LST5,I AND ADD THE BP LOCATION IN LDB DBLAD GET THE ABSOLUTE ADDRESS JSB OUTAB AND OUTPUT THE WORD JMP DBLEX,I RETURN * * LL27 LDA ERR27 JMP ABOR ABORT LOAD ERR27 ASC 1,27 * SKP * * THE OUTAB ROUTINE IS CALLED TO OUTPUT A WORD TO THE DISC * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE STB A SAVE IT ADB FWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TPREL BEYOND LAST WORD PUT OUT? INA SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TPREL NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED * * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSÉo������þúA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN OF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SEGM SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 ABSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * SKP * * FIXAL FIXES UP REFERENCES * TO ENTRY POINTS NOT DEFINED WHEN REFERENCED * BY TAKING THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND BUILDING AN APPROPIATE INSTRUCTION FROM IT. * * THE FIX UP TABLE HAS 4- WORDS PER ENTRY AS FOLLOWS: * ....................................................... * ********************************************************************* ´������þú* FIX1 MEMORY ADDRESS TO BE FIXED (-1 INDICATEDS AN EMPTY ENTRY) * * FIX2 SYMBOL TABLE ADDRESS OF EXT FOR THIS INSTRUCTION * * FIX3 INST OP CODE. BITS 2-0 = DBL TYPE (REKEY) 0,1,2,3,4,5 * * FIX4 OFSET FROM DBL RECORD. * *********************************************************************** * FIXAL EXTRACTS THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND LEAVES IT WHERE 'FIXIT' CAN FIND IT. THIS IS DONE TO ALLOW * 'FIXIT' CODE TO BE USED WITHOUT THE FIXUP TABLE OVER HEAD WHEN * DOING CODE THAT DOES NOT REQUIRE FIXUPS. * FIXAL NOP LDA LST1 LST1 MUST POINT TO SYM TAB ENTRY STA TLST JSB LSTX SET UP PROPER SYM TAB ENTRY HLT 0 * LDB IDA GET ORGION FIXA2 CPB TFIX END OF TABLE? JMP FIXA3 GO PACK THE TABLE * ADB N3 DOWN TO THE LDA B,I SYM. TBL. ENTRY ADB N1 SET B TO ORGION OF ENTRY CPA LST1 THIS ONE? JMP FIXA1 YES GO DO IT * JMP FIXA2 AROUND WE GO * FIXA1 JSB FIXX SET THE BASE ADDS IN FIX1-FIX4 LDA FIX3,I GET THE DBL CODE AND P7 AND STA T1FIX SET IT XOR FIX3,I GET THE MASKED INSTRUCTION STA T2FIX AND SET IT LDA FIX4,I GET THE OFFSET STA OFSET AND SET IT LDA FIX1,I GET THE MEMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CCA STA FIX1,I RELEASE THE FIXUP TABLE ENTRY STA FIX2,I * LDB FIX1 CONTINUE JMP FIXA2 SEARCH * FIXA3 LDB IDA TABLE GET THE BASE ADDRESS PKF00 CPB TFIX IF EMPTY JMP FIXAL,I JUST EXIT * ADB N4 INDEX TO FRONT OF ENTRY STB SET1 SET ADDRESS OF FIRST AVAILABLE ENTRY LDA B,I IS IT? SSA,RSS IT IS IF IT IS <0. JMP PKF00 NO AROUND WE GO * PKF01 LDA N4 SET UP A MOVE COUNTER STA SET2 TO MOVE THE NEXT ENTí ������þúRY PKF02 CPB TFIX IS THERE ANOTHER ENTRY? JMP PKF05 NO GO PATCH UP TFIX * ADB N4 YES CHECK IT LDA B,I STILL IN USE? SSA WELL JMP PKF02 NO TRY NEXT ONE * PKF03 STA SET1,I YES MOVE IT DOWN INB ISZ SET1 STEP THE ADDRESSES LDA B,I GET THE NEXT WORD ISZ SET2 FOUR WORDS MOVED YET? JMP PKF03 NO * LDA SET1 YES SET UP FOR THE NEXT ADA N8 EMPTY SLOT STA SET1 ADB N4 ALSO B JMP PKF01 TRY THE NEXT ENTRY * PKF05 LDA SET1 END OF THE FIX UP LIST ADA P4 SET THE ADDRESS STA TFIX OF THE LAST VALID ENTRY IN TFIX JMP FIXAL,I RETURN * * SKP * * * FIXIT CONFIGURES THE INSTRUCTION THAT FIXAL SET UP * * FIXIT NOP THIS ROUTINE BUILD A INSTRUCTION AND PUTS IT OUT LDA LST4,I GET THE SYMBOL TYPE ALF,ALF AND P7 TO A CPA P4 IF REPLACE OP JMP FIX05 GO DO IT * LDA LST5,I GET THE SYMBOL VALUE ADA OFSET ADD THE OFFSET STA OPRND SET FOR SCANNERS AND M0760 ISOLATE PAGE BITS CMA,CLE,INA SET E IF PAGE ZERO LDA T2FIX GET THE OPCODE SEZ IF BASE PAGE REF JMP FIX04 USE DIRECT LINK * LDB T1FIX GET THE DBL TYPE CPB P4 IF TYPE 4 THEN JMP FIX01 ALWAYS USE LINK * SZA ELSE USE LINK CPA MSIGN ONLY IF NOT A DEF JMP FIX04 A DEF DO DIRECT LINK * LDA OPRND CHECK IF A LINK NEEDED XOR DBLAD AND M0760 ISOLATE PAGE INFO SZA IN NOT SAME PAGE JMP FIX01 MUST USE LINK * LDA OPRND EXT REF WITH OFFSET TO SAME PAGE AND MPAG ISOLATE THE PAGE OFFSET IOR M2000 AND INDIRECT BIT ADD CURRENT PAGE ADA T2FIX BIT AND THE INSTRUCTION CODE JMP FIX03 âÛ������þúGO SEND IT TO THE DISC * FIX01 LDB OPRND IF OPCODE LDA T2FIX SSA IS INDIRECT ADB MSIGN ADD A SIGN BIT STB OPRND JSB SCAN SCAN FOR A LINK JMP FIX02 SUCCESS * JSB ALLOC NO LINK FOUND ALLOCATE ONE STB T3FIX SAVE ACTUAL MEMORY ADDRESS OF IMAGE LDB OPRND AND STB T3FIX,I SET THE OPERAND INTO IT LDB A GET ACTUAL ADDRESS FIX02 LDA T2FIX INSTRUCTION TO A IOR MSIGN ADD THE INDIRECT IOR B AND THE BASE PAGE ADDRESS FIX03 LDB DBLAD GET THE ADDRESS TO B JSB OUTAB SEND THE WORD JMP FIXIT,I RETURN * FIX04 ADA OPRND DIRECT DEF ADD IN OPERAND JMP FIX03 GO PRODUCE IT * FIX05 LDA LST5,I REPLACE OP JMP FIX03 SEND IT * * * FIXX SETS UP FIX1-FIX4 * * ON ENTRY B=FIX1 ADDRESS * FIXX NOP STB FIX1 INB STB FIX2 INB STB FIX3 INB STB FIX4 JMP FIXX,I SO YOU EXPECTED COMMENTS YET! * * * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP T1FIX NOP DBL WORD TYPE FROM REKEY IE THE R FROM THE RRRRR FIELD T2FIX NOP THE INSTRUCTION OP CODE IN THE PROPPER UPPER BITS T3FIX NOP JUST A TEMP TO HOLD A DUMMY BP ADDR FOR A MOMENT TFIX NOP EXORD BSS 1 SET2 NOP SET1 NOP M1740 OCT 174000 MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT SKP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB $CVT3 DO THE CONVERSÆw������þúION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * * THE SEMAP SUBROUTINE SETS THE NAME OF THE CURRENT PROG * INTO THE MEMORY MAP AND SETS THE PROG LENGTH. * IT ALSO EXTRACTS THE PRIORITY AND TIME PARAMETERS * FROM THE NAME RECORD AND STORES THEM INTO 'NPAR'. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SEMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SEMAP NOP LDA LBUF+3 GET PROG NAME 1,2 STA MBUF SET NAME INTO MEMORY MAP LDA LBUF+4 GET PROG NAME 3,4 STA MBUF+1 SET NAME IN MEMORY MAP LDA LBUF+5 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR B40 ADD BLANK CHAR STA MBUF+2 SET NAME IN MEMORY MAP LDA LBUF+6 GET PROG LENGTH STA PLGTH SAVE PROG LENGTH * LDA N7 MOVE PRIORITY,RESOLUTION CODE, JSB MOVE EX MUL,HRS,MINS,SECS, DEF LBUF+10 AND TENS OF MS TO DEF NPAR NPAR * LDA LBUF GET THE REC LENGTH ALF,ALF AND ADA N17 SUBTRACT 17 LDB P10 GET #WORDS IN MAP MESS. SSA,RSS IF NAM REC > 17 WORDS ADB A ADD DIFFERENCE TO MAP LENGTH BLS CONVERT TO WORDS STB NODE SAVE FOR MAP OUTPUT CPB P20 IF NO EXTRA WORDS JMP SEMAP,I EXIT * CMA,INA SET TO MOVE THE REST OF THE NAM JSB MOVE REC TO DEF LBUF+17 MBUF DEF MBUF+10 JMP SEMAP,I RETURN SPC 1 PLGTH BSS 1 PROG LENGTH B40 OCT 40 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA PRMAP SAVE WORD COUNT LDA MOVE,I GET SOURCE STA LSCAN œG������þúSET IN LSCAN ENTRY ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB LSCAN,I GET A WORD STB A,I PUT IT AWAY ISZ LSCAN STEP SOURCE INA AND DEST. ADDRES ISZ PRMAP DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT SPC 1 * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, THE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDA PPREL GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA ADA TPREL GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDA NODE LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN * LDA PLIST GET THE LIST OPTION SZA IF HE WANTS ENTS WE GIVE HIM LINKS TOO. JMP PRMA1 NO ENTS OF BP LINKS ASKED FOR * LDA FWABP GET THE ORGINE OF DUMMY BP CMA,INA AND FROM IT CALCULATE THE ADA CWABP CURRENT REAL BP ADDRESS ADA BPFWA NOW WE HAVE IT. LDB BPMSG SO CONVERT TO ASCII JSB CONVD * LDA P18 GET THE MSG LENGTH LDB BPADR AND THE ADDRESS JSB DRKEY AND REPORT TO THE USER JSB SPACE SPACE A LINE * PRMA1 LDA TPREL GET NEXT AVAIL ADDR STA PPREL SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * BPADR DEF *+{F������þú1 ASC 18, BP LINKAGE XXXXX BPMSG DEF BPADR+7 * NODE NOP MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TLST MACH? CPB PLST END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MATCH JMP MATCH,I RETURN (P+2) * * SKP * * SCAN DUMMY LINKAGE AREA FOR OPERAND * * SCAN LOOKS THROUGH THE DUMMY BASE PAGE TO FIND IF A * BP LINK HAS ALREADY BEEN ALLOCATED FOR THIS WORD. * ON RETURN : * * (P+1) - MATCH FOUND AND REG-A = 0 * AND REG-B = ABSOLUTE L`������þúINK ADDR * * (P+2) - NO MATCH - REGS ARE MEANINGLESS. * SCAN NOP LDB FWABP GET THE LOWER BOUND LDA OPRND AND THE OPERAND SRC CPB CWABP END OF ALREADY ALLOCATED LINKS ? JMP NOTFD DO NOT FOUND RETURN CPA B,I IS THIS THE GUY ? JMP FOUND YES ! INB NO, BUMP POINTER & TRY AGAIN JMP SRC * NOTFD ISZ SCAN MAKE THE NOT FOUND RETURN JMP SCAN,I * FOUND LDA FWABP NOW CALCULATE THE ABSOLUTE ADDRESS CMA,INA ADB A ADB BPFWA JMP SCAN,I MAKE THE FOUND RETURN * OPRND NOP ADDRESS OF WORD WE'RE LOOKIN FOR. CWABP NOP NEXT DUMMY LINK ADDR TO BE ALLOCATED FWABP NOP ADDR OF 1ST WORD OF DUMMY LINK AREA * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ABSOLUTE BASE PAGE ADDR * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA CWABP GET NEXT AVAILABLE BP ADDR ISZ CWABP INCR CURRENT BP ADDR LDB A CMB,INB SET B = - CURRENT BP ADDR ADB LWABP GET LWA BP LINKAGE. SSB,RSS SKIP - BP OVERFLOW JMP ALLO1 JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR ALLO1 CLB STB A,I ZERO THE LINK WORD LDB FWABP SUBTRACT FWA BP AREA CMB,INB FROM CURRENT ADDR, ADA B TO GET RELATIVE ADDR. ADA BPFWA ADD FWA OF ACTUAL AREA FOR LDB CWABP ABS ADDR, B=DUMMY AREA ADB N1 JMP ALLOC,I ADDR. -RETURN. * ERR04 ASC 1,04 BASE PAGE OVERFLOW * * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEŒû������þúMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECT * LINK THROUGH BASE PAGE. * * CALLING SEQUENCE: * A = FIRST WORD OF MEMORY REFERENCE GROUP * B = IGNORED * JSB MREF * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * MREF NOP STA ABT4 SAVE (A) TEMPORARILY AND P3 ISOLATE RELOCATION BASE TYPE LDB ENTRL GET RELOCATION ADDR PNTR ADB A ADD OFFSET TO GET PROPER PNTR LDB B,I GET RELOCATION BASE ADDR LDA ABT4 RESTORE (A) ADB CURAL,I ADD CURRENT INSTRUCTION ADDR AND M1740 ISOLATE INSTRUCTION CODE SSA SKIP - DIRECT REFERENCE ADB MSIGN SET SIGN OF ADDR = 1 STA INSTR SAVE INSTRUCTION CODE LDA DBLAD GET CURRENT RELOCATION ADDR AND M0760 ISOLATE CURRENT PAGE NO. STA PAGNO SAVE CURRENT PAGE NO. LDA B GET CURRENT ADDR AND M0760 ISOLATE PAGE NO. OF ADDR SZA,RSS BASE PAGE REFERENCE? JMP DBL8 YES CPA PAGNO CURRENT PAGE REFERENCE? JMP DBL7 YES, NO LINK NEEDED STB OPRND SAVE ABSOLUTE OPERAND JSB SCAN SCAN DUMMY LINK AREA JMP LNFND LINK FOUND JSB ALLOC ALLOCATE LINK STA TBUF SAVE BP LINK ADDR LDA OPRND GET CURRENT OPERAND STA B,I SET OPERAND IN DUMMY BASE PAGE. LDA TBUF GET BP LINK ADDR SMLNK IOR MSIGN ADD INDIRECT BIT MREF0 IOR INSTR ADD INSTRUCTION CODE TO ADDR JMP MREF,I RETURN LNFND SWP JMP SMLNK GO TO USE SAME LINK * DBL7 LDA B IT'S CURR PAGE AND M1777 SO REMOVE PAGE BITS FROM ADDR IOR M2000 AND SET CURR PAGE BIT JMP MREF0 ADD INSTR TO ADDR, RETURN * DBL8 LDA B IT'S BASE PAGE JMP MREF0 JUST ADD INSTR TO ADDR, RETURN * M1777 OCT 1777 INSTR BSS 1 PAGNO BSS 1 * * * Lk������þú SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM XSA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN * EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 * SKP * * NORMAL LOAD TERMINATION * NODEX LDA #PTTN IF NO PTTN SPECIFIED SZA THEN JMP NODEY CHECK INPUT #PAGES * XLB $MBGP GET THE MAX BG PROG LDA PTYPE & PROG TYPE CPA P2 IS PROG BG? RSS JMP *+3 XLB $MRTP NO, GET MAX RT SIZE * LDA EMABP *E SZA IF EMA, RSS JMP *+3 XLB $MCHN USE MAX MOTHER PTTN SIZE * LDA #PGS GET THE # OF PAGES REQUESTED CMA,INA & CHECK AGAINST MAX SIZE ADA B *E INA ACCOUNT FOR BP SSA DID HE ASK FOR TOO MUCH? JMP ER.18 YES, SO FLUSH HIM * NODEY LDA EMABP ANY EMA DECLARATION ? SZA,RSS WELL ? JMP NOEMA NO. * LDA MSEG THIS A SEGMENTED PROG ? SZA,RSS WELL ? JMP SEMBP NO, SO SET UP THE EMA BP LINK * LDA MSEGF YES, BUT IS THIS THE LAST SEGMENT ? CPA P3 WELL RSS YES, SO SET THE EMA BP LINK JMP NOEMA NO, DON'T PUT THE LINK IN BP YET * SEMBP LDA SHIGH,I GET HIGHEST LOAD POINT SZA,RSS THIS IT ? LDA TPREL NO. NOW WE HAVE IT ADA M1777 ALLIw«������þúGN TO NEXT PAGE AND M0760 STA EMABP,I AND STUFF INTO DUMMY BP * LDA #PGS GET SPECIFIED INPUT PAGES SZA,RSS ANY SPECIFIED? JMP NOEMA NO, FORGET IT * ADA N1 DON'T COUNT BP TWICE! ALF,ALF CONVERT #PAGES TO WORDS RAL,RAL *E ADA URFWA ADD TO LOAD PT STA EMABP,I PUT START ADDR MSEG INTO DUMMY BP * NOEMA LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE JSB INLST INITIALIZE LSTX ELIST JSB LSTX SET CURRENT LST ADDRES JMP NOLST END OF LST LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 IF STILL UNDEFINED JMP ELIST THEN DON'T LIST IT * LDA LST1,I GET NAME 1,2 CCE,SSA IF UN USED LIB ENTRY JMP ELIST DON'T LIST IT. * STA EMES+2 SET NAME 1,2 INTO BUFFER RAL,ERA SET THE SIGN BIT SO IT IS LISTED ONCE STA LST1,I RESET IN LST LDA LST2,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER * LDA LST4,I GET THE TYPE OF CONTENTS OF LST5 AND B200 SZA,RSS IS V BIT SET JMP GOTAD NO, LST5 IS VALUE LDA BPFWA GET THE ADDR OF FIRST REAL AVAIL LINK CMA,INA ADA LST5,I ADD LINK ALLOCATED TO GET OFFSET INTO ADA FWABP DUMMY LINK TABLE LDA A,I NOW GET THE ADDRESS RSS GOTAD LDA LST5,I GET THE DEFINING ADDRESS LDB EMES GET ADDR OF 'NNNNN·������þú ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TPREL SET STA MEM2,I ADDR LDA FWABP CALCULATE RELATIVE CMA,INA CURRENT BP ADDR ADA CWABP AND ADD FWA OF REAL ADA BPFWA AREA FOR LAST ADDR AND STA MEM4,I SET IN ID SEGMENT LDA FWABP IF SEGMENT BEING LOADED, CMA,INA SUBTRACT FWABP FROM SEGB ADA SEGB (SEGMENT BASE) AND ADD ADA BPFWA TO REAL FWA OF BASE PAGE, STA MEM3,I SET AS LOW BOUND OF BP. LDA SEGB GET CURRENT LOWER BOUND OF BP, CMA,INA ADA CWABP ADD CURRENT BP LINK ADDR LDB MSEG (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA PPREL = TO DISPLACEMENT ADA M177 TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDA SEGB SET FWA OF CURRENT BASE PAGE STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA PPREL STA MTMP+2 PPREL LDA DBLAD STA MTMP+3 DBLAD LDA SEGB STA MTMP+4 FWABP LDA CWABP STA MTMP+5 CWABP. * NOLS1 LDA ABT13 IF CURRENT ABT13 = LAST USED è������þú CPA CWABP BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS1 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA MSEG SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREAK LAST CHANCE TO BREAK THE PROGRAM * LDA MSEG CHECK FOR SPECIAL SZA,RSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 LDB PLST IF MAIN LOADED, SAVE END OF CPA P1 LST AS BEGINNING OF STB SLST SEGMENT AREA OF LST. * LDB SLST ERASE PREVIOUS STB PLST SEGMENT LST ENTRIES. STB TLST * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, JMP MSGP3 SKIP. JMP MSGP4 CONTINUE. MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 DRSET ASC 1,BS * * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * LDA DRSET RESET .DBUG TO .DBSG TO GET SEGMENTS STA CHRBU SUBROUTINE THAT ACCESSES DBUG. * JSB SILST INITIALIZE FOR SEGMENT AREA, JSB LSTX SET ADDRES FOR NEXT LST ENTRY NOP LDA CHRDE PUT STA LST1,I ".DBSG" LDA CHRBU IN STA LST2,I NEXT GD������þú LDA UCHRG LST ENTRY STA LST3,I FOR SEGMENT. LDA P2 SET LST4 = UNDEF SYMBOL STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. * LDA N3 GET # OF WORDS TO MOVE JSB MOVE MOVE EM DEF DB1X SOURCE DEF DB1 DESTINATION (SAVES 6 BP LINKS) * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA MSEG CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ MSEG SET 'MSEG' = 2. LDA PPREL SAVE SEGMENT STA SEGM BASE ADDR LDA CWABP SAVE BASE PAGE LOWER BOUND STA SEGB FOR LINK AREA FOR SEGMENTS. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SEGM RESET LOWER STA PPREL BOUNDS VALUES FOR STA FWA PPREL , FWA STA TPREL LDA SEGB STA CWABP CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA PLFLG NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LIBFL * * LDA IDA (A) = ID SEGMENT ADDR(DUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TO STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA ¥D������þú (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF LBUF DESTINATION * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * * MESS4 DEF *+1 PRAM ASC 6, READY PRAMX ASC 17, AT SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 LDA SLST SAVE SLST VALUE TEMPORARILY STA LSTX AND SET IT EQUAL TO FLST LDB FLST TO FOOL LSTX1 TO INITIALIZE STB SLST LST FROM START. JSB LSTX1 ANY UNDEFINED ? JMP MSGP9 NO - THEN DON'T OUTPUT MESSAGE LDA LSTX SET ACTUAL VALUE OF SLST BACK STA SLST LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT ISZ MSEG JSB PUDF GO REPORT THE UNDEFINEDS CCA ADA MSEG STA MSEG LDA FORCD GET THE FORCE LOAD FLAG SSA,RSS DO WE IGNOR UNDEFS ? JMP IUNDF NO SO ABORT THYSELF. MSGP9 LDA LSTX RESET ORIGNAL VALUE OF SLST STA SLST LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESET "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA PPREL PPREL LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA MTMP+5 STA CWABP CWABP CLA SET STARTING TRACK STA STRAK l_������þú AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDB EMABP GET THE EMA FLAG SZB,RSS ANY EMA DECLARED ? JMP NTRM. NO. * LDA MSGSZ GET THE SUPPLIED MSEG SIZE SZA WAS ANY SUPPLIED JMP SETMS YES * LDA B,I GET THE EMA DEFINING ADDRESS ALF & CONVERT TO PAGE # RAL,RAL CMA ACCOUNT FOR I/O OVERFLOW ADA P32 NOW HAVE MAX POSSIBLE MSEG * STA MSGSZ NO, USE MAX POSSIBLE SETMS ADA MSIGN NOW SET NON STANDARD MSEG BIT STA IDEX1,I AND PUT IN DUMMY ID SEGMENT * LDA EMASZ GET THE EMA SIZE LDB EMABP,I & START PAGE OF MSEG RBL PLACE INTO PROPER FIELD SZA,RSS WAS EMA SIZE DEFAULTED ? ADB M2000 YES, SO SET DEFAULT BIT STB IDEX2,I & PLACE IN DUMMY ID * LDA URFWA NOW CHECK OUT EMA SIZE ALF FIRST GET PROG SIZE RAL,RAL AND M37 CMA,INA LDB EMABP,I GET NEXT PAGE ADDRESS BLF RBL,RBL ADB A NOW HAVE PROG SIZE ADB EMASZ NOW HAVE REQ'D SIZE CMB,INB STB MESSM SAVE IT * LDA #PTTN WAS A PARTITION SPECIFIED ? SZA,RSS WELL ? JMP GTMCN NO * CCA *Ö������þú YES ADA #PTTN MPY P7 INDEX TO PROPER ENTRY ADA P4 XLB $MATA OF $MATA TABLE ADA B XLA A,I GET THE AND B1777 # OF PAGES * JMP GTMC1 * GTMCN XLA $MCHN GET MAX SIZE SZA IS IT 0. JMP GTMC1 NO XLA $MBGP ASSUME BG LDB PTYPE CPB P2 IS IT ? RSS NO JMP *+3 XLA $MRTP NO * GTMC1 ADA MESSM NOW ADD IN SIZE SSA OK ? JMP LL21 NO. * NTRM. LDA SHIGH,I CALCULATE # OF PAGES VALUE FOR ID SZA,RSS PROG SEGMENTED ? LDA TPREL NO * LDB URFWA GET LOAD POINT CMB MAKE NEG (ACCOUNT FOR HIGH MAIN '+' 1 ADA B A = # OF WORDS OF CODE ALF NOW ACCOUNT FOR PAGES RAL,RAL AND M37 ADA P2 ACCOUNT FOR BASE PAGE & CURRENT PAGE STA MES11+1 SAVE FOR # OF PAGES RELOCATED MESSAGE LDB #PGS GET ANY SUPPLIED SIZE SZB,RSS ANY SUPPLIED ? STA #PGS NO, SO USE CODE SIZE * CCB OK, SO BUILD ID SEG WORD 22 ADB #PTTN PUT PART'N WORD IN BITS 0-5 CCE,SSB SET BIT 15 IF PARTITION REQUESTED CLB,RSS IF NO PARTITION THE SET TO 0 RBL,ERB * CCA GET # PGS REQ'D LESS BP ADA #PGS ADA MSGSZ ADD IN MSEG SIZE ALF,RAR # PGS IN BITS 14 - 10 IOR #MPFT MEM PROT FENCE INTO BITS 9-7 ALF,ALF RAR IOR B SAVE THE WORD STA PG.PT FOR THE MVIDS ROUTINE * * LDA FWABP SET UP ADDR ADA N20 OF DUMMY STA IDA ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * * CONTROL TŸ¿������þúRANSFERS HERE FOR TEMPORARY LOADS & FOR PERM LOADS * WHERE NO PREVIOUS DISC SPACE IS AVAILABLE FOR THE PROG. * NTRM7 LDA IDA ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE IN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB IDA NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER INA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSE¸ö������þúD (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB IDA GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ������þúADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB IDA SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LD;������þúA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE CURRENT DISC LU CPB P3 IS IT LU 3 ? RAL,ERA THEN DON'T FORGET THE SIGN BIT. LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB IDA GET CURRENT ID SEG ADDR ADB P8 (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INH������þúA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LDB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA MSEG DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * SPC 1 NTRM4 LDA MES11+1 GET THE # OF PAGES RELOCATED JSB CNì������þúV99 CONVERT TO ASCII STA MES11+1 AND PUT INTO USER INFO BUFFER * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE * LDB P3 STB OPCOD SPECIFY DECIMAL CONVERSION * * LDA EMABP SZA,RSS ANY EMA ? JMP LOUT NO . LDA MSGSZ YES JSB CNV99 GET ASCII MSEG SIZE STA AMSEG+2 LDA EMASZ GET EMA SIZE SZA,RSS DEFAULTED ? JMP EDFLT YES LDB AEMAD GET ADDRESS OF ASCII JSB CONVD CONFERT IT JMP LOUT * EDFLT LDA N4 JSB MOVE DEF IDFLT DEF AEMA+2 * LOUT LDA #PGS GET # OF PAGES OF CODE LDB EMABP AND EMA DECLARATION SZB,RSS ANY EMA ? JMP *+4 NO ADA EMASZ YES, SO ADD EMA SIZE CPA #PGS IF DEFAULTED INA ADD 1 LDB PGRQD GET ADDRESS JSB CONVD AND CONVERT TO ASCII * * LDA P72 GET CHAR COUNT LDB MES11 & ADDRESS JSB DRKEY NOW GO TELL THGE FOLKES * * PTNCK LDB PTYPE CHECK #PAGES REQ'D DOESN'T LDA #MXBG CPB P2 RT OR BG PROG LDA #MXRT * INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P4 (A)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 2,W 17 CODE > PTTN SIZE * MES11 DEF *+1 ASC 18,00 PAGES RELOCATED 0000 PAGES REQ'D AEMA ASC 9, NO PAGES EMA AMSEG ASC 9, NO PAGES MSEG P72 DEC 72 PG.PT NOP WORD 22 OF ID SEG OF MAIN AEMAD DEF AEMA PGRQD DEF MES11+10 IDFLT ASC 4,s������þúDEFAULT * SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB WORD WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB WORD IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * JSB FTIME TELL THE FOKES THE TIME DEF *+2 DEF PRAMX+2 * LDA P46 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY * * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6Rc������þú 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 RELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 P46 DEC 46 TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP XLA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE STA ABT1 KEYWORD LIST ADDR. * MIDN1 XLB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE XLA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. XLA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN;������þú2 XLA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ ABT1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) XLB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ASL11 SEND L11 MESSAGE JMP ABOR AND ABORT SPC 2 ASL11 ASC 1,11 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP * THE COPY. SUBROUTINE CHECKS TO MAKE SURE THAT ALL PROGRAM * PURGES OR REPLACES DON'T RUN AFOUL OF COPIED PROGRAMS. THE * PROBLEM TO AVOID IS RELEASING THE DISC TRACKS THAT THE PROGRAM * YOU ARE PURGING OR REPLACING RESIDES ON IF OTHER COPIES OF * THAT PROGRAM'S ID SEGMENT ARE STILL LAYING AROUND. * IF THE PROGRAM TO BE PURGED IS A COPY THAT'S OK. IF THE PROGRAM * YOU ARE REPLACING IS A COPY, THAT'S NOT OK. * * * CALLING SEQUENCE JSB COPY. * B - REG = ID ADDRESS OF PROG TO PURGE * * * COPY. NOP STB IDADR SAVE THE ID ADDRESS OF PROG TO BE PURGED ADB P14 GET TO TYPE BIT XLA B,I AND P7 THIS A CPA P5 SEGMENT ? JMP COPY.,I THEN NOT TO WORRY. * ADB P17 NOW GET 2ND SESSION \2������þúWORD XLA B,I AND M1000 IS THIS PROGRAM SZA A COPY ? JMP CHKED YES, SEE IF THIS IS A REPLACE * XLA B,I GET THE WORD AGAIN. THIS PROG NOT A COPY AND M2000 BUT ARE COPIES POSSIBLE ? SZA JMP COPY.,I NO, SO ALLS WELL * ADB N5 OK, THIS PROG NOT A COPY, BUT COPIES POSSIBLE. XLA B,I GET THE DISC ADDRESS OF THE PROG STA DSKAD AND SAVE. * LDA KEYWD GET THE KEYWORD ADDRESS STA KEY AND SET UP FOR SEARCH * DSRCH XLB KEY,I GET THE PROG ID ADDRESS CPB IDADR THIS THE PROG WE'RE WORKING ON ? JMP NXTID THEN GET NEXT ID * SZB,RSS ANY MORE ID'S ? JMP ITOK? NO SO SEE IF ALLS WELL * ADB P12 GET THE NAME WORD XLA B,I SZA,RSS IF THE ID IS EMPTY FORGET CHECK JMP NXTID AND LOOK AT THE NEXT ONE * ADB P2 NOW LOOK AT THE TYPE XLA B,I AND M20 CPA M20 THIS A SEGMENT ? JMP ITOK? YES, WERE DONE, SEE IF EVERYTHING OK * ADB P12 OK, SO INDEX TO THE DISC ADDRESS OF XLA B,I IF IT IS THE SAME AS THE ONE WE ARE CPA DSKAD GOING TO REPLACE THEN THAT'S A NO NO. JSB PRTER PRINT THE OFFENDING PROGRAM NAME & CONTINUE * NXTID ISZ KEY BUMP ID POINTER & JMP DSRCH LOOK AT THE NEXT ID SEG. * ITOK? LDA ERFLG ANY ERRORS ? SZA,RSS WELL ? JMP COPY.,I NO, SO CONTINUE WITH THE LOAD. * LDA ERR29 GET THE ERROR CODE & JMP ABOR ABORT THYSELF * CHKED LDA EDFLG GET THE EDITING FLAG SZA,RSS WE DOING A REPLACE OPERATION ? JMP COPY.,I NO, JUST PURGING A PROG. * LDA ERR30 YOU CAN'T REPLACE A COPIED PROG ! JMP ABOR * * KEY NOP M1000 OCT 1000 ERFLG NOP COPIED PROGRAM ERROR FLAG N14 DEC -14 DSKAD NOP IDADR NOP ERR29 ASC ™Z������þú1,29 ERR30 ASC 1,30 DBUF1 DEF *+1 NBUF BSS 3 * * * THE PRTER ROUTINE JUST PRINTS THE ERRORS THAT COPY. FINDS. * IT WILL TELL THE USER OF ALL PROGS THAT ARE COPYS OF THE * ORGINAL THAT HE IS TRYING TO REPLACE. * * * CALLING SEQUENCE JSB PRTER * B-REG = ADDRESS OF ID WORD 26 * * PRTER NOP ADB N14 BACK UP TO THE PROGRAM' NAME WORD. XLA B,I AND PULL NAME IN LOCALLY STA NBUF * INB XLA B,I STA NBUF+1 * INB XLA B,I STA NBUF+2 * * LDA P5 GET THE CHAR COUNT LDB DBUF1 & ADDRESS JSB SYOUT &AND PRINT THE PROGRAM NAME ISZ ERFLG BUMP THE ERROR FLAG JMP PRTER,I RETURN SKP UREAD NOP DISC READ SUBROUTINE JSB EXEC READS 64 WORDS DEF *+7 DEF P1 DEF P2 ALBUF DEF LBUF DEF P64 DEF TRACK DEF SECTR JMP UREAD,I * TRACK NOP SECTR NOP * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * IFN TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! ADA DM1K SUBTRACT 1024 DIV D6144 DIVIDE BY TRK SIZE STA TRACK WE NOW HAVE THE TRACK LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) ADA D18 ADD IN STARTING SECTR OF OP SYS STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 XIkR������þúF * * * IFZ * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! DIV D6144 DIVIDE BY TRK SIZE-WARNING THIS MAY BE RESET STA TRACK TO RELATIVE TRACK ADD THE ABSOLUTE START TRACK XLA $STRK ADA TRACK STA TRACK OF THE OP SYSTEM. NOW HAVE THE TRACK. LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) * XLB $SSCT GET THE START SECTR OF OP SYS ADA B ADD IN RELATIVE SECTR TO GET ABS SECTR OF PATCH STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 XIF * * *THIS IS A GENERAL PURPOSE DISC PATCH SUBROUTINE * CALLING SEQUENCE JSB SYRUW * A REG = MEMORY ADDRESS (LOCATION) * B REG = REPLACEMENT VALUE * THE MEMORY LOCATION WILL BE CHANGED TO A DISC ADDRESS * AND THE CONTENTS OF THE B REG WILL BE PLACED THERE * THIS ROUTINE SHOULD ONLY BE USED TO MODIFY OP SYSTEM * LOCATIONS !!!!!! * SYRUW NOP UPDATE $BGFR & $RTFR ON DISC SWP FIX FROM DFINE TO WORK IN LOADR (CMM) STB UPDT1 JSB TRK GET THERE TRACK ADDRESS JSB UREAD READ THEIR SECTOR LDA WORD GET THE ADDRESS ADA ALBUF WITHIN THE SECTOR LDB UPDT1 GET CONTENTS OF THE NEW $RTFR WORD STB A,I STICK IT INTO THE BUFFER * ISZ P1 NOW p������þúMAKE IT A WRITE JSB UREAD PATCH ON DISC CLA,INA FIX P1 STA P1 JMP SYRUW,I UPDT1 NOP * SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT RELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,RBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) Øß������þúSTA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK # LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TPREL FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TPREL HIGH LOAD +1 !!!!!!!!!!!!! * STB TPREL SET NEW ADDR. LDA MSEG GET THE MSEG FLAG CPA P2 THIS A SEGMENT ? RSS YES. JMP ABOUT,I NO, JUST RETURN LDA SHIGH,I GET THE PAST HIGH CMA,INA ADA B IS THIS HIGH BIGGER ? SSA,RSS WELL ? STB SHIGH,I YES, SO SET UP NEW HIGH MAIN +SEG + 1 JMP ABOUT,I * TEMPQ NOP * * OVERFLOW OF TRACK ALLOCATION * * AB3 LDB TR������þúAKB GET THE BASE TRACK ADB #TRAK ADD IN THE # OF TRACKS SO FAR LDA TRKLU GET THE LU OF THE TRACK CPA P3 = LU # 3 ? ADB TATSD YES SO ADD IN # OF TRKS ON SYS DIS ADB TAT NOW ADD ADDRESS OF START OF TAT XLA B,I THIS TRACK FREE ? SZA WELL ? JMP AB10 NO * ISZ #TRAK YES SO BUMP TRACK # LDA XEQT GET MY ID ADDRESS JSB SYSET POST TO TAT JMP AB0 AND CONTINUE LOADING. * AB10 LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK CLB SET UP TO MPY LDA #TRAK MPY NO. OF TRACKS MPY ABT4 TIMES SECTS PER TRACK SZB ONE WORD HLT 3 SSA 15 BITS HLT 4 CMA,INA NEG TOTAL # SECTS REQUIRED STA #SECT SAVE OFF JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT DEF P128 DEF ABT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * ) ������þú LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA RESET TO ZERO STA ABT10 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 THEN CONTINUE TO LOAD. * CLA IF NOT DOING MAIN/SEGMENT CPA MSEG LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY IX������þúD SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY ONCE. LDA IDA (A)= STARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY vÓ������þú* THE CONTENTS OF "IDA" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AREA. * * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (IDA) = ADDR. OF DUMMY * ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA KLUGE GET THE KLUGE FLAG SZA,RSS ARE WE DOING THE STUPID SYS MOVE JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * THIS KLUGE WAS NOT MY DOING (C.M.M.) * LDB IDA ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINATION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * ÷¨������þú * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED * (B) = FIRST WORD DESTINATION ADDR * STRFR NOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND COUNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * * DMYMV LDB IDA SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N20 THEN SET MOVE COUNT=-20. STB NUMWD JSB BLKID GET CURRENT ID EXT LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN USE BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFER. JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB NAMOK SEE IF PROG NAME STILL OK. LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG I§Œ������þúD. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCATION. LDB BID8 GET # OF SMALL IDS W/O DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB IDA ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA N5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO ¹������þúPRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR TRANSFER ADDR PNTRS JMP MOVID DO MOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P31 INDEX TO 2ND SESSION WORD XLA B,I & PULL IT IN. AND B170K KEEP ONLY UPPER 4 BITS IOR COPY? SET UP THE COPY BIT IOR OWNER AND THE OWNER WORD STA SESW2,I & SET INTO THE 2ND SESSION WORD. * LDB ABT11 GET THE DESTINATION ID ADDR AGAIN ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS INB (B) = ADDR OF EMAID LDA N5 A = -5 FOR EMAID TO SESW3 JSB STRFR TRANSFER ADDRESS POINTERS * * * * LDA EMABP GET THE EMA FLAG SZA ANY DECLARED ? JMP DOEMA YES LDA N18 NO. CHANGE THE MOVE COUNT STA NUMWD TO 18. (IE DON'T USE ID EXTENSION) JMP MOVID GO MOVE THE DUMMY ID SEGMENT * DOEMA LDB BID9 GET THE ADDRESS OF THE ID EXT TO USE SZB,RSS IS THERE ONE ? JMP LL20. NO, EN ERROR LDA N2 SET FOR TRANSFER (ADDRESS IF ID EXTENSION) JSB STRFR SET UP THE POINTERS * LDA BID10 GET THE ID EXT # ALF,ALF ROTATE TO UPPER END RAL,RAL LDB EMASZ GET THE EMA SIZE SZB,RSS WAS IT DEFAULTED INA ������þú SET A FLAG ADA B NO, SO USE SPECIFIED SIZE STA EMAID,I AND PUT IN DUMMY ID SEGMENT * * SKP * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * * KLUGE INDICATES THAT THE SOURCE IS ALSO IN THE * SYSTEM AREA (AS OPPOSED TO THE DUMMY AREA) * AND THEREFORE ONE MUST USE CROSS MAP LOADS TO GET IT * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR AND SOURCE TOO. STB SRAD2 LDB NUMWD STB NUMW2 ALSO # OF WORDS TO MOVE KEPON LDB KLUGE ARE WE DOING KLUDGY SZB SYS ID TO SYS ID? JMP KEPNX YES, GO DO CROSS MAP LDA SRADR,I NO, GET WORD FROM SOURCE ID JMP *+3 AND CONTINUE KEPNX XLA SRADR,I KLUDGE - DO CROSS MAP LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD XSA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT DEF *+1 PROCESSING DEF *+1 * CLA CLEAR SESSION WORD FOR DISC XFER STA SESW3,I LDA COPY? STA SESW2,I & KEEP ONLY COPY BIT FOR DISC * * LDB ABT10 GET THE EDIT FLAG SZB,RSS PERM ADDITION ? JMP NODSK NO, SO DON'T USE THE DISC * LDB DESA INITIALIZE SOURCE POINTERS STB DESAM DODSK LDB KLUGE ARE WE DOING KLUDGE? SZB SYS ID MOVE TO SYS ID? JMP DDSKX YES, GO DO XMAP LOAD LDA SRAD2,I NO, JUST GET THE WORD JMP *+3 AND KEEP GOING DDSKX XLA SRAD2,I KLUDGE - CROSS MAP LOAD LDB DESAM,I GET THE DESTINATION ?C������þú JSB SYRUW FIX THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 ARE WE DONE ? JMP DODSK NO, SO PLAY IT AGAIN SAM * NODSK ISZ MVIDS SET UP THE SUCCESSFUL RETURN * LDB ABT11 ADB P14 GET THE PROG TYPE WE JUST LAID DOWN XLA B,I AND P7 CPA P5 SEGMENT ? JMP MVIDS,I YES, SO WERE DONE. * LDB ABT11 MAIN, SO DO SOME MORE PROCESSING STB #IDAD SAVE THE ID ADDRESS * LDA PG.PT GET PAGES/ PART'N WORD ADB P21 AND ADDRESS JSB SYSET AND SET UP THE WORD * LDB ABT10 PERM LOAD ? SZB,RSS JMP MVIDS,I NO, WE'RE DONE * LDA PG.PT LDB ABT11 ADB P21 JSB SYRUW * JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID LL21 LDA ERR21 JMP ABOR ERR21 ASC 1,21 P31 DEC 31 N18 DEC -18 NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID ? JMP NOIDS LONG LDA ERR26 SHORT JMP ABOR ABORT THYSELF WITH A L-26 ERROR ERR26 ASC 1,26 B170K OCT 170000 COPY? NOP 0/2000 COPIES OK/DON'T COPY OWNER NOP OWNER WORD FOR TARGET ID SEG * SKP * * THE NAMOK ROUTINE CHECKS THE IDS IN THE SYSTEM TO MAKE * SURE THAT THE PROGRAM JUST RELOCATED STILL HAS A UNIQUE * NAME. THAT IS, THAT SOMEBODY DIDN'T SNEAK AN RP IN ON US. * * * NAMOK NOP LDA SSFLG GET THE LONG/SHORT ID FLAG LDB IDA AND THE DUMMY ID ADDRESS SSA,RSS SHORT OR LONG ? INB 0 = LONG INB -1 = S[������þúHORT * STB NAM12 INB SET UP NAME FOR TEST STB NAM34 INB STB NAM5 * CCA SET UP FLAG FOR # OF TESTS STA NMFLG SET PROG NAME FLAG * ONEMR JSB MIDN FIND THE ID IF ONE JMP NAMOK,I NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGNORE DUPLICATE, JMP NAMOK,I AND CONTINUE. * LDA NAM12,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA NAM34,I NAME MESSAGE BUFFER STA MESS7+13 LDA NAM5,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM * JSB $LIBX RETURN TO INT PROCESSING DEF *+1 DEF *+1 * JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 ABORT THE GUY LDA RENAM GET ASCII '##' STA NAM12,I SET PROG NAME 1,2 = '..' LDB SSFLG IF MAIN, SET INTO OUTPUT MESSAGE SSB,RSS STA MESS4,I LDA P5 LDB NAM12 JSB SYOUT TELL THEM THE NEW NAME * JSB $LIBR NOP JMP ONEMR REPEAT DUPLICATE PROG NAME SCAN * SKP * * SUBROUTINE: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP JSB SETAB * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA # OF ADA ABT7,I BASE PAGE WORDS C#SXX CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ž¼������þúABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TOTAL JMP C#S,I RETURN. * * * * * SUBROUTINE: "C#SMX" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * IT USES CROSS LOADS BECAUSE THE ID SEGMENT IS NOT A * DUMMY ID SEGMENT, RATHER, IT IS AN ID IN MEMORY. * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#SMX * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#SMX NOP JSB SETAB * XLA ABT4,I DETERMINE CMA,INA # OF XLB ABT5,I MAIN WORDS ADA B STA ABT1 XLA ABT6,I DETERMINE CMA,INA # OF XLB ABT7,I BASE PAGE WORDS ADA B LDB C#SMX SET RETURN STB C#S JMP C#SXX * * SETAB NOP STA ABT4 INA STA ABT5 SET UP THE ADDR OF BOUNDS INA STA ABT6 INA STA ABT7 JMP SETAB,I * * SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BID7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * BID9 = ADDRS OF 1ST AVAIL ID EXTENSION, = 0 IF NONE * BID10 = ORDINAL # OF THE FREE ID EXT * BID11 = # OF FREE ID EXTENSIONS * * (NOTE: ABOVE PARAMETERS ARE ZERO IûX������þúF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA BID9 ADDRESS OF FREE ID EXT STA BID10 FREE ID EXTENSION'S ORDINAL # STA BID11 # OF FREE ID EXTENSIONS STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. * XLA $IDEX GET THE ADDR OF ID EXTENSION BLOCK STA IDEX AND SAVE JMP *+3 CNTEX ISZ IDEX BUMP POINTER ISZ BID10 BUMP ID EXTENSION # XLA IDEX,I GET THE ADDRESS SZA,RSS IF END OF LIST JMP BLK1A GO TO ID SEGS XLB A,I ELSE GET THE CONTENTS OF 1ST WORD SZB IS THIS ONE FREE ? JMP CNTEX NO STA BID9 SAVE THE ADDRESS ISZ BID11 COUNT IT AS FREE NXIDX ISZ IDEX BUMP POINTER XLA IDEX,I GET THE ADDRESS SZA,RSS FINISHED ? JMP BLK1A YES, COUNT REST OF IDS XLA A,I GET THE 1ST WORD SZA,RSS IS IT FREE ? ISZ BID11 YES, SO COUNT IT JMP NXIDX GO LOOK AT THE NEXT ONE * BLK1 ISZ KEYPT BUMP KEYWORD ADDR BLK1A XLB KEYPT,I GET KEYWORD SZB,RSS IF EÚx������þúND OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG XLA B,I IF NAM12=0 SZA,RSS THEN ITS A BLANK ID JMP BLK2 CPA P1 CHECK FOR REPLACE OPERATION FLAG JMP BLK2 CPA P2 JMP BLK2 * JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA XLB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. XLB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? STB BID2 NO, SET ADDR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL XLA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#SMX DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THEN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RîD������þúESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION XLB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#SMX DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION XLB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,I NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP BID9 NOP BID10 NOP BID11 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT IDEX NOP POINTER TO ID EXTENSION LIST DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * SKP * * * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * "#SECT" CONTAINS -# OF SECTORS REQUIRED * * A AND B MEANINGLESS Ô”������þú * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECOME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * * THE NUMBER OF SECTORS PER TRACK MAY DIFFER BETWEEN WHERE * THE LOADR HAS TRACKS NOW AND WHERE THE NEWLY REQUESTED * TRACKS ARE. CONSEQUENTLY, WE'D BETTER CHECK THE NUMBER OF * SECTORS WE REALLY WANT AGAINST THE NUMBER WE GET. * THE INITIAL REQUEST FOR TRACKS FALLS OUT BECAUSE #SECT= 0 * IE #SECTS IS NOT SET SO IT = 0 * * CLB SET UP TO MPY LDA #TRAK NO. OF TRKS MPY TRKS# TIMES SECTS PER TRK SZB SHOULD FIT IN ONE WORD HLT 1 SSA SHOULD FIT IN 15 BITS HLT 2 ADA #SECT SUBTRACT # OF SECTS REQUIRED * SSA,RSS HAVE ENOUGH? JMP ITRK2 POS,YES, CONTINUE * JSB EXEC NEG,NO,RELEASE DEF *+5 WHAT WE JUST GOTýk������þú DEF P5 DEF #TRAK DEF TRAKB DEF TRKLU * ISZ #TRAK AND ASK FOR MORE JMP ITRK9 * * ITRK2 LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF DISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY FLAG FOR TRACKS #SECT NOP NEG # SECTORS REQUIRED SKP * * 'EDIT' COMPLETION * ED00 LDA MSEG GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR b‰������þúJSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#SMX # SECTORS STA ED60 AND SAVE * LDB ED25 JSB COPY. ANY COPIES OF THIS PROG ? * * LDB TAT NO, SO SET THE SIGN BIT XLA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. ADB P2 (B)=NAM5 ADDR OF MATCHED ID XLA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. STA SWPID SAVE THE TYPE FOR A MOMENT CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD XLA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET XLA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET XLA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL JMP ED003 * * ADB P4 GET LAST PARTITION PROGRAM WAS IN XLA B,I AND M77 KEEP ONLY PARTITION MPY P7 NOW INDEX INTO $MATA TABLE XLB $MATA ADA B ADA P2 GET RESIDENT PROG XLA A,I CPA ED25 DID PROG TERM SERIALLY REUSABLE ? RSS YES, YOU LOSE JMP ED004 * * * SKP ED003 LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT LDA ERR34 AND ABORT THYSELFZERO JMP ABOR * ERR34 ASC 1,34 MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 LDB OPCOD GET THE OPERATION FLAG CPB P4 THIS A PURGE ? CLB,RSS YES, SET NAME = 0 CLB,INB SET REPLACE FLAG INTO ID * KEEPS OTHER LOADË!������þúRS & FMGR HONEST JSB $LIBR TURN OFF INTERUPTS NOP XSB LH1,I ZERO ISZ LH1 NAME XSB LH1,I IN ISZ LH1 CORE XLA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) XSA LH1,I * CLA LDB SWPID GET THE PROGRAM TYPE CPB P5 IS IT A SEGMENT ? JMP NOZAP FORGET ABOUT ID EXTENSION * LDA LH1 NOW GET THE ADDRESS OF ADA P14 THE ID EXT WORD XLA A,I PULL IT IN SZA,RSS ANY ID EXTENSION JMP NOZAP NO. * ALF YES RAL,RAL GET THE # TO LOW END AND M77 & KEEP ONLY THE # XLB $IDEX ADD START OF TABLE ADA B XLA A,I NOW HAVE THE ADDRESS CLB XSB A,I AND ZAP THE WORD NOZAP JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * SZA,RSS WAS THERE AN ID EXT ? JMP TKREL NO, GO RELEASE THE TRACKS SWP YES, SO ZAP THE DISC AS WELL. JSB SYRUW * * RELEASE "OLD" TRACKS * TKREL LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DISC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 „E������þú NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 RSS JMP *+3 XLA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, JMP NTRM7 GO TO USE FIRST BLANK. * LDA IDA GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 THEN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST ADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 XLB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) XLA B,I IF SZA,RSS ‡"������þú = JMP ED17 0, CHECK FURTHER. CPA P1 JMP ED17 ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR XLA B,I GET THE TYPE OF PROGRAM AND P7 CPA P1 MEM RES ? JMP ED12 YES, FORGET IT * JSB MEM? GET ADDR OF MEM1 NOP (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN XLA B,I SZA,RSS IF NO DISC ALLOCATION TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * SSA TRACK ALLOC ON LU 3 ? JMP ED12 YES, FORGET THIS TOO CMA,INA IS THE TRACK ABOVE THE ADA DSCLB THE LIB OF SYS ENTRY POINTS ? SSA WELL ? JMP ED12 WELL, WE CAN'T USE THAT EITHER * LDA B ADA N4 (A)=MEM1 ADDR JSB C#SMX GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. XLA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRM7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB IDA GET DUMMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF m������þúPROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 XLA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKID FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BID2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 Gæ������þúET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE AREA DEF P1 DEF DSKUN DEF LBUF DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF LBUF DEF P64 DEF ED66 DEF ED67 * ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CLA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGN SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 Я������þú (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB IDA STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA MSEG PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA IDA SET ADDR OF ADA N9 NEXT SHORT DUMMY STA IDA ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA IDA INA * ED181 CLB,INB CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TACKS STB FIX SAVE B REG FOR A MOMENT LDA IDA SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE Dg������þú* LDB A ID ADR TO B REG ADB P14 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 B = ADDR OF DMAIN XLA B,I GET THE DISC SPACE SSA IF ON LU 3 FORGET IT JMP SWPID,I * CMA,INA IF NOT BELOW DISC LIB ENTS ADA DSCLB THEN SSA JMP SWPID,I FORGET IT ALSO * LDA ED25 STA IDA SET IT IN IDA FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG STA KLUGE & KLUGE FLAG (THE PERSON WHO WROTE THIS * SHOULD BE SHOT !!!!!!!!!) LDB FIX GET THE B-REG BACK JSB MVIDS AND CALL MVIDS TO SET UP THE KLUGE. NOP IGNOR ERROR RETURN CLB CLEAR KLUGE FLAG STB KLUGE LDB DREL RESTORE STB IDA THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * KLUGE NOP FLAG USED ONLY BY SWPID FOR MOVING MEM1 - DMAIN * FROM NEW ID TO THE OLD ONE. * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMAIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL JSB MODID ISZ DREL ISZ SWPID DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM HLT 0 ** SHOUL݇������þúD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * A = # OF TRACKS TO RELEASE * B = DISC SWAP WORD * * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. (ED64 = TAT ADDRESS) LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64 BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR XLA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TABLE. ISZ ED62 JMP DR JMP DREL,I SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TATLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR STB FIX & SAVE NXTRK LDA DREL GET ID SEGMENT ADDR TO A XLB õ$������þúFIX,I THIS TRACK BELONG?? CPA B RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 ISZ FIX STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * * IFN * THESE TWO DUMMY SUBS MAKE THIS LOADR COMPATIBLE WITH * THE SESSION MONITER LOADR * * PTERR NOP LDA PTERR,I JMP A,I * * * .OWNR NOP CLA JMP .OWNR,I XIF MAPOF DEC 34 * SKP * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = PRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE MSEG NOP SEGMENTED PROG FLAG * 0 = NOT SEGMENTED PROGGMENTED FLAG * 1 = SEGMENTED PROG BUT WE'RE LOADING MAIš¨������þúN * 2 = SEG PROG & WE'RE LOADING A SEGMENT OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU NOP LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE WORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF LST1 NOP LST WORD 1 ADDR LST2 NOP LST WORD 2 ADDR LST3 NOP LST WORD 3 ADDR LST4 NOP LST WORD 4 ADDR LST5 NOP LST WORD 5 ADDR PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4 NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG NUPLS NOP NO. UTILITY PROGS LOADED TPREL NOP CURRENT MAX PROG RELOC ADDR DBLAD NOP DATA BLOCK RELOCATION ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT LBUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA LWABP NOP BASE PAGE AREA. SEGB NOP SEGMENT BASE PAGE LOWER BOUND DBLFL NOP FIRST DBL REC: -1,YES; 0,NO. FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P20 DEC 20 M7 EQU P7 M20 OCT 20 M77 ‰õ������þú OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE RBTAD DEF *+1 RELOCATION BASE TABLE NOP PPREL NOP CURRENT PROG BASE BPREL NOP BASE PAGE BASE COMAD NOP COMMON BASE NOP ABSOLUTE BASE BLOK# NOP UCHRG OCT 43400 MSIGN OCT 100000 CHRDE ASC 1,.D CHRBU ASC 1,BU AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 BLST NOP BEGINNING OF LOADER SYMBOL TABLE PLST NOP END OF LST TLST NOP CURRENT LST ADDR. SLST NOP INITIALIZE FOR SEGMENT AREA. FLST NOP FWA OF LST SET FOR USER'S PROG OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * SPC 1 #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR ERR16 ASC 1,16 SPC 1 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74™C���$��" # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS SYSLN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 SPC 1 SPC 1 BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA * BSS 0 SIZE OF LOADR SPC 3 END LOADR ������������������������������������������������������������������������¬$������ÿÿ����� ���� ÿý�‰�Š ���������ÿ��92067-18447 2013� S C0122 �&NSESS �NON-SES LIB HEADER � � � � � � � � � � � � �H0101 ‘�����ASMB,R,L * * NAME: NSESN * SOURCE: 92067-18447 * RELOC: 92067-16456 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM NSESN,0 92067-16456 REV.2013 800201 * END ��������������������������������������������������������������������������������������������������������������������������������������������������������������ºà������ÿÿ����� ���� ÿý�Š� ���������ÿ��92067-18449 2026� S C0122 �&SM.SB � � � � � � � � � � � � � �H0101 l�����þúASMB,R,L,C * NAME: SM.SB * SOURCE: 92067-18449 * RELOC: 92067-16125 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SM.SB,8 92067-16125 REV.2026 800304 ENT SM.SB EXT .ENTR PARAMETER FETCH ROUTINE EXT $SMD# OFFSET TO DIRECTORY ENTRY # IN SCB EXT $SMID OFFSET TO USER ID WORD IN SCB EXT APOSN FMP FILE POSITION ROUTINE EXT CLOS. INTERNAL FMGR CLOSE ROUTINE EXT CLOSE FMP FILE CLOSE ROUTINE EXT CREAT FMP FILE CREATE ROUTINE EXT FTIME FORTRAN'S TIME AND DAY ROUTINE EXT I.BUF INTERNAL (FMGR) DCB EXT IPRSN PACK SESSION USER NAME (INVERSE PARSE) EXT ISMVE MOVE WORDS FROM SESSION CONTROL BLOCK EXT LOCF FMP FILE LOCATION ROUTINE EXT NAMR NAMR PARSE ROUTINE EXT O.BUF INTERNAL (FMGR) DCB EXT OPEN FMP FILE OPEN ROUTINE EXT OPEN. INTERNAL FMGR OPEN ROUTINE EXT OVRD. SESSION OVERRIDE OPTION WORD EXT PARSN ACCOUNT NAME PARSE ROUTINE EXT POSNT FMP FILE POSITION ROUTINE EXT PURGE FMP FILE PURGE ROUTINE EXT READF FMP FILE READ ROUTINE EXT RNRQ EXEC REQUEST FOR RESOURCE NO. EXT SESSN DETERMINES IF IN SESSION EXT WRITF FMP FILE WRITE ROUTINE * A EQU 0 B EQU 1 * * PICK UP PARAMETERS * IBUFR NOP USER.GROUP,NAMR,MESSAGE ILEN NOP LENGTH OF BUFFER (POSITIVE # WORDS) IERR NOP ERROR RETURN WORD SM.SB NOP SM.SB ENTRY POINT JSB .ENTR GET PARAMETERS DEF IBúj������þúUFR * CLA INITIALIZE STA TEXT TEXT=1 IF TEXT (STRING) SUPPLIED STA FILE FILE=1 IF NAMR SUPPLIED STA EMPTY EMPTY=1 IF MSG FILE WAS CREATED BY THIS INVOCATION STA RWERR STA TEMP1 INA STA ICHAR INITIALIZE ICHAR=1 FOR PARSN * JSB SESSN IN SESSION? DEF *+2 DEF XEQT CURRENT PROGRAM SEZ SKIP IF IN SESSION (E=0) JMP ER45 NOT IN SESSION STB ADSCB SAVE SESSION WORD (IDSEG WD 33) * JSB ISMVE MOVE USER ID FROM SESSION CONTROL BLOCK DEF RTN1 DEF ADSCB SCB ADDRESS DEF $SMID OFFSET TO USER ID IN SCB DEF USRID USER ID RETURNED HERE DEF D1 1 WORD TO BE MOVED RTN1 EQU * * LDA ILEN,I LENGTH OF COMMAND BUFFER ALS CONVERT WORDS TO CHARACTERS STA LENTH SAVE NBR OF CHARACTERS IN COMMAND STRING JSB PARSN PARSE USER.GROUP NAME DEF RTN2 DEF DRTIM PARSE OUTPUT BUFFER DEF IBUFR,I INPUT BUFFER DEF LENTH LENGTH OF BUFFER (POSITIVE # OF CHARS) DEF ICHAR NEXT CHAR POSITION TO PARSE DEF JERR ERROR RETURN WORD RTN2 EQU * * LDB ADRTM ADDRESS OF FIRST WORD OF DRTIM BUFFER LDA B,I GET 1ST WORD OF USER.GROUP PARSE (#CHARS) SZA,RSS CHECK IF NO USER.GROUP NAME SUPPLIED JMP ER55 ERROR - NO USER.GROUP NAME AND M377 CHECK FOR GROUP SZA IS GROUP SPECIFIED? JMP LABL1 YES (NON-ZERO GROUP NAME LENGTH) LDA B,I PUT "7" FOR # OF CHARS.IN GROUP NAME IOR D7 STA B,I ADB D6 LDA DM4 STA CNTR1 SET COUNTER TO MOVE 4 WORDS LABL2 LDA ADGNL,I GET "GENERAL" STA B,I STORE INTO BUFFER LOCATION ISZ ADGNL GET NEXT WORD INB ISZ CNTR1 FINISHED? JMP LABL2 NO, STORE ANOTHER WORD AWAY * LABL1 JSB NAMR PARSE ãü������þúNAMR PARAMETER DEF *+5 DEF INAM PARSE OUTPUT BUFFER (10 WORDS) DEF IBUFR,I INPUT BUFFER DEF LENTH TOTAL LENGTH OF IBUFR (POSITIVE# CHARS) DEF ICHAR STARTING CHARACTER NUMBER IN IBUFR * LDA INAM CHECK TO SEE IF NAMR WAS SUPPLIED SZA,RSS WAS NAMR GIVEN? JMP LABL3 NO,DON'T BOTHER TO OPEN ANY FILES * ISZ FILE SET FLAG INDICATING NAMR WAS SUPPLIED * LDA INAM+4 SET UP SECURITY CODE STA NOPL LDA INAM+5 SET UP CARTRIDGE NUMBER STA NOPL+1 * JSB OPEN. OPEN NAMR TO BE SENT DEF RTN3 DEF O.BUF NAMR DCB DEF INAM FILE NAMR OR LU DEF NOPL SECURITY CODE, CRN DEF IOPTN RTN3 EQU * * LABL3 LDA ICHAR CURRENT CHARACTER POSITION CLE,ERA CONVERT CHARACTERS TO WORDS SEZ TEST IF ODD NUMBER OF CHARACTERS ISZ TEMP1 YES, SET BYTE FLAG SEZ,RSS TEST IF ODD NUMBER OF CHARACTERS ADA DM1 NO, SUBTRACT ONE STA ISTRW SAVE CURRENT WORD POSITION ADA IBUFR STA TEMP STA LBUFR * JSB NAMR CHECK FOR TEXT (STRING) DEF *+5 DEF INAM2 OUTPUT BUFFER DEF IBUFR,I INPUT BUFFER DEF LENTH TOTAL LENGTH OF IBUFR (POSITIVE# CHARS) DEF ICHAR NEXT CHARACTER POSITION TO PARSE * LDA INAM2 GET FIRST WORD OF OUTPUT BUFFER SZA,RSS IS THERE ANY TEXT? JMP LABL5 NO ISZ TEXT SET FLAG=1 INDICATING TEXT WAS GIVEN LDA TEMP1 YES CHECK BYTE POSTION SZA IS THERE ANY REMAINDER JMP LABL6 NO LDA TEMP,I 1ST WORD OF TEXT (STRING) AND M377 MASK OFF CHARACTER IOR M2000 MERGE BLANK IN LEFTMOST BYTE STA TEMP,I STORE BACK IN BUFFER LABL6 LDA ISTRW COMPUTE LENGTH OF TEXT CMA,INA ADA ILEN,I STA WRDCT LENGTH OF TEXT IN WORDS JMP LAB.5 * * †â������þú CALCULATE STRING LENGTH * LABL5 LDA FILE CHECK TO SEE IF NAMR WAS SUPPLIED SZA JMP LAB.5 YES LDA D50 NO, ERROR - NEITHER NAMR NOR TEXT SUPPLIED JMP EXIT ERROR EXIT - NOT ENOUGH PARAMETERS * LAB.5 LDA SECU STA NOPL SET SECURITY CODE CLA STA NOPL+1 SET CRN * LDA OVRD. OVERRIDE FLAG TO ALLOW SYS DISC WRITE STA TEMP SAVE IT'S CURRENT STATE IOR M2000 SET TO ALLOW SYS DISC WRITE STA OVRD. JSB OPEN OPEN THE ACCOUNT FILE DEF RTN4 DEF I.BUF DCB(ACCOUNT) DEF JERR ERROR RETURN WORD DEF ACCT ACCOUNT NAME=+@CCT! DEF D1 NON-EXCLUSIVE OPEN OPTION DEF NOPL SECURITY CODE DEF NOPL+1 DISC RTN4 EQU * LDA TEMP GET SAVED OVERRIDE FLAG STA OVRD. RESTORE PREVIOUS OVERRIDE VALUE LDA JERR GET ERROR CODE SSA OPEN ERROR? JMP EXIT YES * * READ ACCOUNT FILE HEADER * JSB READF DEF RTN5 DEF I.BUF DCB OF ACCOUNT FILE DEF JERR ERROR RETURN WORD DEF IBUF BUFFER LOCATION DEF D128 ONE RECORD LENGTH DEF LEN NUMBER OF WORDS READ RTN5 EQU * * LDA DFIBF GET LOCATION OF DIRECTORY ADA D24 OFFSET TO RESOURCE NUMBER WORD LDA A,I GET RESOURCE NUMBER TO USE STA RESNO JSB RNRQ LOCK RESOURCE NUMBER FOR ACCT FILE WRITE DEF RTN40 DEF D1 DEF RESNO RESOURCE NUMBER DEF ISTAT STATUS RETURN RTN40 EQU * * JSB READF RE-READ ACCOUNT FILE HEADER DEF RTN7 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF DEF D128 NUMBER OF WORDS TO READ DEF LEN NUMBER OF WORDS READ DEF D1 RECORD #1 RTN7 EQU * LDA DFIBF START OF BUFFER IBUF STA B ADA D4 BUMP T ã������þúO DIRECTORY LOCATION WORD LDA A,I STA DIRNO RECORD # OF START OF DIRECTORY STA DIR## ADB D5 LDA B,I STA ADACT LOCATION OF 1ST ACCOUNT ENTRY ADB D20 LDA B,I LU # OF MESSAGE FILES STA MSGLU SZA,RSS IF NO LU # SPECIFIED FOR MSG FILES, LDA DM2 DEFAULT TO LU 2 STA LUNO. SAVE LU # OF MSG FILES * * FINDING USER'S ACCOUNT * LAB80 LDA DM8 STA CNTR1 JSB READF READ IN ACCOUNT FILE DIRECTORY DEF RTN.5 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF DEF D128 NUMBER OF WORDS TO READ DEF LEN NUMBER OF WORDS READ DEF DIR## RECORD NUMBER OF DIRECTORY RTN.5 EQU * LDA D73 SET UP ERROR: ACCOUNT NOT FOUND STA JERR LDA DFIBF KEEP POINTER TO DIRECTORY STA TEMP2 STA TEMP TEMP WILL POINT TO ENTRIES IN DIRECT. LABL9 LDA TEMP,I GET # OF CHARACTERS IN NAME SZA,RSS JMP ERROR CPA DRTIM IS IT EQUAL TO # OF CHARS. IN PARM. IN NAME JMP LAB85 YES, CHECK LETTER FOR LETTER LABL8 LDA TEMP2 NO GET NEXT DIRECTORY ENTRY ADA D16 16 WORDS PER DIRECTORY STA TEMP2 UPDATE PTR. STA TEMP ISZ CNTR1 CNTR1 INITIALIZED TO -8 JMP LABL9 ISZ DIR## JMP LAB80 LAB85 LDA DM10 STA CNTR LDA ADRTM FIRST WORD OF DIR. ENTRY AND BUFFER CONTAINING STA TEMP1 NAME ARE = LAB95 ISZ TEMP1 INCREMENT BOTH BUFFERS TO THE ISZ TEMP NEXT WORDS LDA TEMP,I ARE THEY THE SAME CPA TEMP1,I RSS YES THEY ARE JMP LABL8 NO, FIND ANOTHER DIR ENTRY ISZ CNTR DECREMENT COUNTER JMP LAB95 CHECK ANOTHER WORD * * * YES FOUND ENTRY * LDA TEMP2 ADA D14 GET WORD 15(USER ACCT RECORD #) LDA A,I SEE IF BIT 15 IS SET CLB d§������þú SSA IS IT SET LDB D64 YES,ACCOUNT IS 2ND 64 WORDS STB OFFST NO ACCOUNT IS IN FIRST RECORD AND M7777 REMOVE SIGN BIT STA USACT USER ACCOUNT RECORD # * * NOW READ IN USER ACCOUNT ENTRY * JSB READF READ IN USER ACCOUNT FILE DEF RTN12 DEF I.BUF DEF JERR DEF UBUF BUFFER FOR USER ACCOUNT DEF D128 WHILE RECORD IS READ DEF LEN DEF USACT RTN12 EQU * * * GET USER MESSAGE FILE NAME THEN OPEN FILE * LDA ADBUF ADA D16 PICK UP ADDRESS OF NAME ADA OFFST ADD IN OFFSET LDB A,I STB NAME STORE IN NAME IN 3 WORD ARRAY INA LDB A,I STB NAME+1 INA LDB A,I STB NAME+2 PUT 3RD CHAR. AWAY INA INA LDB A,I SSB,RSS CHECK IF MESSAGE FILE EXISTS JMP CREA1 LAB10 LDA OVRD. STA TEMP IOR M2000 STA OVRD. JSB OPEN OPEN USER MESSAGE FILE DEF RTN13 DEF FDCB MESSAGE FILE DCB DEF JERR ERROR RETURN WORD DEF NAME MESSAGE FILE NAME DEF D1 DEF SECU SECURITY CODE RTN13 EQU * LDA TEMP STA OVRD. * LDA JERR SSA,RSS CHECK FOR ERROR JMP LAB11 NO CPA DM6 IF MESSAGE FILE NOT FOUND, JMP CREA1 CREATE IT JMP ERROR ELSE RETURN THE OPEN ERROR * * IF MESSAGE ISN'T CREATED THEN CREATE IT * CREA1 LDA OVRD. STA TEMP IOR M2000 STA OVRD. JSB CREAT CREATE MESSAGE FILE DEF RTN32 DEF FDCB MESSAGE FILE DCB DEF JERR ERROR RETURN WORD DEF NAME MESSAGE FILE NAME DEF DM1 FILE SIZE TO CREATE DEF D3 FILE TYPE DEF SECU SECURITY CODE DEF LUNO. LU OF MESSAGE FILES DEF D0 DEF D0 DEF D0 DEF M707 BYPASS LEGAL FILE NAME TEST RTÐG������þúN32 EQU * LDA TEMP STA OVRD. * LDA JERR SSA,RSS CHECK FOR CREATE ERROR JMP LAB22 NO ERROR CPA DM2 IF FILE ALREADY EXISTS, JMP LAB10 OPEN IT AND POSITION IT TO EOF CPA DM33 IF NO ROOM ON LU, RSS THEN TEST IF LU 2 JMP ERROR ELSE JUST REPORT CREATE ERROR LDA MSGLU GET LU # OF MESSAGE FILES SZA SPECIFIED? JMP ERROR YES, REPORT -33 ERROR LDA SECT3 SECTORS/TRACK ON LU 3 SZA,RSS IF 0, NO LU 3 JMP ERROR NO LU 3, REPORT -33 ERROR LDA LUNO. CPA DM3 ALREADY TRIED LU 3? JMP ERROR YES, RETURN -33 ERROR LDA DM3 LU 3 EXISTS, TRY CREATE ON LU 3 STA LUNO. JMP CREA1 * * FIND EOF OF USER MESSAGE FILE * LAB11 JSB READF READ MESSAGE FILE UNTIL THE DEF RTN14 IERR WORD HAS A -12 IN IT DEF FDCB DEF JERR OR THE LEN WORD IS -1 DEF UBUF BUFFER FOR READ INPUT DEF D128 DEF LEN RTN14 EQU * * LDA JERR DOES IT =-12 CPA DM12 JMP LAB25 YES FOUND END OF FILE LDA LEN CPA DM1 LEN=-1? JMP LAB25 YES, END OF FILE SSA,RSS JMP LAB11 JMP ERROR READ ERROR * LAB25 JSB LOCF FIND POSITION OF EOF DEF RTN16 DEF FDCB DEF JERR DEF FIREC RECORD NUMBER DEF FIRB NEXT BLOCK DEF FIOFF OFFSET WITHIN BLOCK RTN16 EQU * * JSB WRITF PUT ZERO-LENGTH RECD BETWEEN MESSAGES DEF RTN15 DEF FDCB DEF JERR DEF IBUF RTN15 EQU * * * GET TIME OF DAY AND SENDER OF MESSAGE * RSS LAB22 ISZ EMPTY SET FLAG TO INDICATE FILE WAS CREATED LDA DM30 STA CNTR LDB ADBUF LDA BLNK UP STA B,I INB ISZ CNTR JMP UP * JSB FTIME GET TIME OF DAY DEF RTN18 DEF UBUF:������þú+15 BUFFER FOR TIME OF DAY RTN18 EQU * * * GET SENDER'S NAME * LDA DIRNO START OF DIRECTORY STA DIR## * JSB ISMVE GET DIRECTORY ENTRY # FROM SCB DEF RTN55 DEF ADSCB ADDRESS OF SESSION CONTROL BLOCK DEF $SMD# OFFSET TO DIRECTORY ENTRY # WORD IN SCB DEF DNUM DIRECTORY ENTRY # RETURN WORD DEF D1 1 WORD TO BE MOVED RTN55 EQU * * LDA DNUM DIRECTORY ENTRY # CLB COMPUTE ACCT FILE RECORD CONTAINING DIR. ENTRY DIV D8 ADA DIRNO ADD RECORD NUMBER OF START OF DIRECTORY STA DNUM SAVE RECORD NUMBER BLF COMPUTE OFFSET INTO RECORD IN WORDS STB TEMP TEMPORARY SAVE * JSB READF READ RECORD CONTAINING DIRECTORY ENTRY DEF RTN56 DEF I.BUF ACCOUNT FILE DCB DEF IERR,I ERROR RETURN DEF IBUF DEF D128 NUMBER OF WORDS TO READ DEF LEN NUMBER OF WORDS READ DEF DNUM RECORD NUMBER TO READ RTN56 EQU * * LDA DFIBF ADDRESS OF 1ST WORD OF IBUF ADA TEMP OFFSET TO DIRECTORY ENTRY STA TEMP * JSB IPRSN INVERSE PARSE TO BUILD SENDER NAME STRING DEF *+4 DEF TEMP,I DEF UBUF DEF D1 * * READ USER ACCOUNT AND SET MESSAGES WAITING BIT * JSB READF READ USER'S ACCOUNT DEF RTN34 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF BUFFER FOR 128-WORD ACCOUNT FILE RECORD DEF D128 128 WORDS TO BE READ DEF LEN NUMBER OF WORDS ACTUALLY READ DEF USACT ACCOUNT FILE RECORD NUMBER RTN34 EQU * * LDB DFIBF ADDRESS OF IBUF ADB OFFST ADD OFFSET (0 OR 64) ADB D20 OFFSET TO "MESSAGE FILE EXISTS" WORD LDA B,I IOR M1000 SET MESSAGE WAITING BIT STA B,I SAVE IT * JSB POSNT RE-POSITION TO USER RECORD NUMBER DEF RTŒR������þúN35 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF USACT ACCOUNT FILE RECORD NUMBER DEF D1 FLAG TO POSNT RTN35 EQU * * JSB WRITF WRITE NEW USER ACCOUNT DEF RTN41 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF BUFFER WITH NEW ACCOUNT DEF D128 RTN41 EQU * * JSB RNRQ RELEASE THE RN LOCK DEF RTN42 DEF D4 DEF RESNO RESOURCE NUMBER DEF ISTAT STATUS RETURN RTN42 EQU * * JSB WRITF WRITE HEADER TO MESSAGE FILE DEF RTN19 DEF FDCB MESSAGE FILE DCB DEF JERR ERROR RETURN WORD DEF UBUF HEADER BUFFER (SENDER NAME, DATE) DEF D30 RTN19 EQU * * LDA JERR CPA DM33 CHECK IF NO ROOM FOR WRITE JMP BKUP NO ROOM, SO PURGE CURRENT MESSAGE CPA DM46 CHECK IF GREATER THAN 255 EXTENTS JMP BKUP YES, SO PURGE CURRENT MESSAGE LDA TEXT IF TEXT WAS SUPPLIED (TEXT=1), THEN SZA,RSS WRITE IT TO MESSAGE FILE JMP LAB15 TEXT NOT SUPPLIED * JSB WRITF WRITE TEXT (STRING) TO MESSAGE FILE DEF RTN30 DEF FDCB MESSAGE FILE DCB DEF JERR ERROR RETURN WORD DEF LBUFR,I BUFFER CONTAINING TEXT DEF WRDCT LENGTH OF TEXT (WORDS) RTN30 EQU * * LDA JERR CPA DM33 CHECK IF NO ROOM FOR WRITE JMP BKUP NO ROOM, SO PURGE CURRENT MESSAGE CPA DM46 CHECK IF GREATER THAN 255 EXTENTS JMP BKUP YES, SO PURGE CURRENT MESSAGE * LAB15 LDA FILE TEST IF NAMR SPECIFIED (FILE=1) SZA,RSS JMP LAB18 NOT SPECIFIED, SKIP NAMR READ-WRITE * JSB READF READF FROM USER SUPPLIED NAMR DEF RTN20 DEF O.BUF DCB DEF KERR ERROR RETURN WORD DEF UBUF BUFFER DEF D128 DEF LEN RTN20 EQU * LDA KERR STp������þúA RWERR * JSB WRITF NO, WRITE TO MESSAGE FILE DEF RTN21 DEF FDCB DCB OF MESSAGE FILE DEF JERR DEF UBUF DEF LEN NUMBER OF WORDS TO BE WRITTEN RTN21 EQU * * LDA LEN END OF FILE? CPA DM1 JMP LAB16 YES, CLOSE FILE * LDA KERR CPA DM12 END OF FILE? JMP LAB16 * LDA JERR SSA STA RWERR CPA DM33 CHECK IF NO ROOM FOR WRITE JMP BKUP NO ROOM, SO PURGE CURRENT MESSAGE CPA DM46 CHECK IF GREATER THAN 255 EXTENTS JMP BKUP GREATER THAN 255 EXTENTS, SO PURGE LDA RWERR SSA,RSS JMP LAB15 * * BACK UP MESSAGE FILE TO PREVIOUS MESSAGE, OR PURGE FILE IF NONE * BKUP LDA EMPTY EMPTY=1 IF FILE WAS CREATED BY THIS INVOCATION SZA,RSS WAS FILE CREATED BY THIS INVOCATION? JMP BKUP2 NO, ALREADY EXISTED - BACK UP TO PREVIOUS MESSAGE * LDA OVRD. OVERRIDE FLAG TO ALLOW SYS DISC WRITE STA TEMP SAVE IT'S CURRENT STATE IOR M2000 SET TO ALLOW SYS DISC WRITE STA OVRD. JSB PURGE YES, PURGE MESSAGE FILE DEF RTN72 DEF FDCB MESSAGE FILE DCB DEF IERR,I ERROR RETURN WORD DEF NAME MESSAGE FILE NAME DEF SECU SECURITY CODE DEF LUNO. RTN72 EQU * LDA TEMP GET SAVED OVERRIDE FLAG STA OVRD. RESTORE PREVIOUS OVERRIDE VALUE * JSB RNRQ GET THE RN LOCK AGAIN DEF RTN49 DEF D1 DEF RESNO RESOURCE NUMBER DEF ISTAT STATUS RETURN RTN49 EQU * * JSB READF READ USER'S ACCT TO CLEAR MESSAGES WAITING BIT DEF RTN45 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF BUFFER FOR 128-WORD ACCOUNT FILE RECORD DEF D128 128 WORDS TO BE READ DEF LEN NUMBER OF WORDS ACTUALLY READ DEF USACT ACCOUNT FILE RECORD NUMBER<*������þú RTN45 EQU * * LDB DFIBF ADDRESS OF IBUF ADB OFFST ADD OFFSET (0 OR 64 WORDS) ADB D20 OFFSET TO "MESSAGE FILE EXISTS" WORD CLA CLEAR THE MESSAGES WAITING BIT STA B,I SAVE IT * JSB POSNT RE-POSITION TO USER RECORD NUMBER DEF RTN46 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF USACT ACCOUNT FILE RECORD NUMBER DEF D1 FLAG TO POSNT RTN46 EQU * * JSB WRITF WRITE NEW USER ACCOUNT DEF RTN47 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF BUFFER WITH NEW ACCOUNT DEF D128 RTN47 EQU * * JSB RNRQ RELEASE THE RN LOCK DEF RTN48 DEF D4 DEF RESNO RESOURCE NUMBER DEF ISTAT STATUS RETURN RTN48 EQU * JMP ERROR * BKUP2 JSB APOSN POSITION TO END OF PREVIOUS MESSAGE DEF RTN73 DEF FDCB MESSAGE FILE DCB DEF IERR,I ERROR RETURN WORD DEF FIREC DEF FIRB DEF FIOFF RTN73 EQU * * JSB WRITF WRITE EOF DEF RTN74 DEF FDCB MESSAGE FILE DCB DEF IERR,I ERROR RETURN WORD DEF UBUF DEF DM1 RTN74 EQU * JMP ERROR * LAB16 JSB CLOS. CLOSE OUT MESSAGE FILE TO CLEAR DCB DEF RTN75 DEF O.BUF RTN75 EQU * * * NOW CLOSE FILE WITH TRUNCATE * LAB18 JSB LOCF FIND POSITION OF EOF DEF RTN22 DEF FDCB DEF JERR DEF IREC RECORD NUMBER DEF IRB NEXT BLOCK DEF IOFF OFFSET WITHIN BLOCK DEF JSEC SECTOR RTN22 EQU * * * CALCULATE THE NUMBER OF BLOCKS TO TRUNCATE * ITRUN=JSEC/2-IRB-1 * LDA JSEC GET NUMBER OF SECTORS CLB DIV D2 DIVIDE BY 2 (2 SECTORS/BLOCK) LDB IRB GET BLOCK CMB,INB ADA B SUBTRACT ADA DM1 SUBTRACT 1 STA ITRUN ZG������þúNUMBER OF BLOCKS TO TRUNCATE CLA CLEAR ERROR RETURN WORD JMP EXIT ERROR JSB RNRQ RELEASE RESOURCE NUMBER DEF RTN43 DEF D4 CODE FOR CLEARING RN DEF RESNO RESOURCE NUMBER FOR ACCT FILE WRITE DEF ISTAT RETURN BUFFER FROM RNRQ RTN43 EQU * * LDA RWERR SSA,RSS JMP EXITA JMP EXIT ER45 LDA D45 SESSION COMMAND ONLY RSS ER55 LDA D55 MISSING PARAMETER RSS EXITA LDA JERR EXIT STA IERR,I * * NOW CLOSE WITH TRUNCATE * JSB CLOS. CLOSE USER'S NAMR DEF RTN23 DEF O.BUF RTN23 EQU * JSB CLOSE CLOSE MESSAGE FILE DEF RTN24 DEF FDCB DEF JERR DEF ITRUN RTN24 EQU * * * CLOSE ACCOUNT FILE * JSB CLOSE CLOSE ACCOUNT DEF RTN25 DEF I.BUF RTN25 EQU * * * * JMP SM.SB,I * ACCT ASC 3,+@CCT! ADACT BSS 1 ADBUF DEF UBUF ADRTM DEF DRTIM ADSCB BSS 1 BLNK ASC 1, CNTR BSS 1 CNTR1 BSS 1 XEQT EQU 1717B ID SEG ADDR OF CURRENT PROGRAM DRTIM BSS 11 DIRECTORY IMAGE CONTAINS USER.GROUP NAME DFIBF DEF IBUF ADDRESS OF IBUF DIR## BSS 1 DIRNO BSS 1 DNUM BSS 1 DM46 DEC -46 DM33 DEC -33 DM30 DEC -30 DM12 DEC -12 DM10 DEC -10 DM8 DEC -8 DM6 DEC -6 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 D14 DEC 14 D16 DEC 16 D20 DEC 20 D24 DEC 24 D30 DEC 30 D45 DEC 45 D50 DEC 50 D55 DEC 55 D73 DEC 73 D64 DEC 64 D128 DEC 128 M377 OCT 377 M7777 OCT 77777 M1000 OCT 100000 M2000 OCT 20000 M707 OCT 70707 EMPTY BSS 1 EMPTY=1 IF MESSAGE FILE CREATED BY THIS INVOCATION FDCB BSS 144 FILE BSS 1 FILE=1 IF NAMR SUPPLIED FIOFF BSS 1 FIRB BSS 1 FIREC BSS 1 ADGNL DEF GENRL ADDRESS OF ASCII "GENERAL" GENRL ASC 4,GENERAL IBUF BSS 128 µä���N��LH ICHAR BSS 1 INAM2 BSS 10 INAM BSS 10 10 WRD OUTPUT BUFFER FOR NAMR ROUTINE IOPTN OCT 401 OPEN OPTION WORD IRB BSS 1 NEXT BLOCK IREC BSS 1 NEXT BLOCK ISTAT BSS 1 ISTRW BSS 1 ITRUN BSS 1 IOFF BSS 1 OFFSET WITHIN BLOCK JERR BSS 1 JSEC BSS 1 SECTOR WITHIN BLOCK KERR BSS 1 LBUFR BSS 1 LEN BSS 1 NUMBER OF WORDS READ FROM READ CALL LENTH BSS 1 LENGTH OF BUFFER TO BE PARSED LUNO. BSS 1 MSGLU BSS 1 LU OF MESSAGE FILES FROM ACCT FILE NAME BSS 3 NOPL BSS 2 SECURITY CODE, CRN OFFST BSS 1 RESNO BSS 1 RESOURCE NO. FROM ACCOUNT FILE RWERR BSS 1 SECT3 EQU 1760B SECU DEC -31178 TEMP BSS 1 TEMP1 BSS 1 TEMP2 BSS 2 TEXT BSS 1 TEXT=1 IF TEXT (STRING) SUPPLIED UBUF BSS 128 USACT BSS 1 USER ACCOUNT RECORD # USRID BSS 1 SENDER'S SESSION ID WRDCT BSS 1 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������X·N������ÿÿ����� ���� ÿý�‹� ���������ÿ��92067-18450 1903� S C0122 �&ME.SB � � � � � � � � � � � � � �H0101 |m�����þúASMB,R,L,C * NAME: ME.SB * SOURCE: 92067-18450 * RELOC: 92067-16125 * PGMR: R.D. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ME.SB,8 92067-16125 REV.1903 790510 ENT ME.SB EXT .ENTR PARAMETER FETCH ROUTINE EXT $SMD# OFFSET TO DIRECTORY ENTRY # IN SCB EXT $SMID OFFSET TO USER ID IN SESSION CONTROL BLOCK EXT CLOSE FMP FILE CLOSE ROUTINE EXT CREAT FMP FILE CREATE ROUTINE EXT I.BUF INTERNAL (FMGR) DCB EXT ISMVE MOVE WORDS FROM SESSION CONTROL BLOCK EXT LOCF FMP FILE LOCATION ROUTINE EXT N.OPL FMGR 10-WORD SUBPARAMETER ARRAY EXT O.BUF INTERNAL (FMGR) DCB EXT OPEN FMP FILE OPEN ROUTINE EXT OPEN. INTERNAL FMGR OPEN ROUTINE EXT OPENF FMP OPEN FOR TYPE 0 FILES EXT OVRD. SESSION OVERRIDE OPTION WORD EXT POSNT FMP FILE POSITION ROUTINE EXT PURGE FMP FILE PURGE ROUTINE EXT READF FMP FILE READ ROUTINE EXT RNRQ EXEC REQUEST FOR RESOURCE NO. EXT SESSN DETERMINES IF IN SESSION EXT WRITF FMP WRITF EXT XLUEX EXTENDED LU EXEC CALL * A EQU 0 B EQU 1 * * GET INPUT STRING AND PARSE IT * IBUFR NOP PARM 1 (TYPE,NAMR) IPURG NOP OPTION WORD TO PURGE MESSAGE FILE IERR NOP ERROR RETURN WORD ME.SB NOP SUBROUTINE ENTRY POINT * JSB .ENTR DEF IBUFR * LDA IBUFR,I CHECK FIRST PARAMETER (LIST DEVICE) SZA NOT SUPPLIED? JMP ME.1 CHECK IF ASCII OR NUMERIC >A������þú STA RDERR INITIALIZE FOR READ ERROR STA CLEAN INA DEFAULT LIST TO 1 STA INAM SAVE IT JMP ME.5 ME.1 LDB ADIBF,I ADDRESS OF PARAMETER ARRAY INB CPA D3 ASCII? JMP ME.2 YES CPA D1 NUMERIC? JMP ME.4 YES LDA D56 ERROR - BAD PARAMETER STA IERR,I RETURN ERROR JMP ME.SB,I RETURN ME.2 CMA,INA SET -3 AS COUNTER STA CTR SAVE IT LDA ADINM POINTER TO INAM STA TEMP ME.3 LDA B,I GET 1ST 2 CHARACTERS OF NAMR STA TEMP,I SAVE IT ISZ TEMP INB BUMP SOURCE ADDRESS ISZ CTR INCREMENT COUNTER JMP ME.3 MOVE NEXT 2 CHARACTERS OF NAMR JMP ME.5 ME.4 LDA B,I GET LU STA INAM SAVE IT * ME.5 JSB SESSN IN SESSION DEF *+2 DEF XEQT CURRENTLY EXECUTING PROGRAM SEZ,RSS SKIP IF NON-SESSION JMP L2 IN SESSION LDA D45 NON-SESSION STA IERR,I ERROR - SESSION COMMAND ONLY JMP ME.SB,I L2 STB ADSCB SAVE SCB ADDRESS * JSB ISMVE MOVE USER ID FROM SCB DEF RTN44 DEF ADSCB SCB ADDRESS DEF $SMID OFFSET TO USER ID IN SCB DEF USRID USER ID RETURNED HERE DEF D1 1 WORD TO BE MOVED RTN44 EQU * * LDA SECU STA NOPL LDA OVRD. GET SESSION OVERRIDE FLAG STA TEMP SAVE IT'S CURRENT STATE IOR M2000 SET TO ALLOW SYS DISC WRITE STA OVRD. SAVE IT JSB OPEN. OPEN ACCOUNT FILE DEF RTN4 DEF I.BUF ACCOUNT FILE DCB DEF ACCT ACCOUNT FILE = +@CCT! DEF NOPL DEF IOPTN OPTION WORD RTN4 EQU * LDA TEMP STA OVRD. RESET OVERRIDE FLAG * * READ ACCOUNT FILE HEADER * JSB READF DEF RTN5 DEF I.BUF DCB OF ACCOUNT FILE DEF JERR ERROR RETURN WORD –Ø������þú DEF IBUF BUFFER LOCATION DEF D128 ONE RECORD LENGTH DEF LEN NUMBER OF WORDS READ RTN5 EQU * * * LDA DFIBF GET LOCATION OF BUFFER ADA D24 OFFSET TO RESOURCE NUMBER LDA A,I STA RESNO * JSB RNRQ LOCK ACCT FILE RESOURCE NBR DEF RTN40 DEF D1 REQUEST TO SET LOCAL RN DEF RESNO ACCT FILE RESOURCE NUMBER DEF ISTAT STATUS RETURN WORD RTN40 EQU * * JSB READF RE-READ ACCOUNT FILE HEADER DEF RTN7 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF DEF D128 DEF LEN NUMBER OF WORDS READ DEF D1 ACCOUNT FILE RECORD 1 RTN7 EQU * * LDA DFIBF START OF BUFFER IBUF STA B ADA D4 LDA A,I RECORD # OF DIRECTORY STA DIRNO ADB D25 LDA B,I LU # OF MSG FILES STA LUNO. * * FIND USER'S DIRECTORY ENTRY * JSB ISMVE GET DIRECTORY ENTRY # FROM SCB DEF RTN55 DEF ADSCB SESSION CONTROL BLOCK ADDRESS DEF $SMD# OFFSET TO DIRECTORY ENTRY # IN SCB DEF DNUM DIRECTORY ENTRY # RETURN WORD DEF D1 1 WORD TO BE MOVED RTN55 EQU * * LDA DNUM GET DIRECTORY ENTRY # CLB COMPUTE ACCT FILE RECORD # WITH THIS ENTRY DIV D8 ADA DIRNO ADD RECORD # OF START OF DIRECTORY STA DNUM SAVE RECORD NUMBER CONTAINING DIRECTORY ENTRY BLF COMPUTE OFFSET INTO RECORD IN WORDS STB TEMP TEMPORARY SAVE JSB READF READ RECORD CONTAINING DIRECTORY ENTRY DEF RTN56 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF IBUF RETURN BUFFER DEF D128 DEF LEN NUMBER OF WORDS ACTUALLY READ DEF DNUM ACCOUNT FILE RECORD NUMBER RTN56 EQU * * LDA DFIBF ADDRESS OF START OF IBUF ADA TEMP OFU.������þúFSET TO START OF DIRECTORY ENTRY ADA D14 OFFSET TO USER ENTRY RECORD NUMBER LDA A,I CLB SET OFFSET TO 0 SSA SIGNED MEANS ACCT IN 2ND HALF OF RECD LDB D64 YES, ACCOUNT IS IN 2ND 64 WORDS STB OFFST NO ACCOUNT IS IN 1ST 64 WORDS AND M7777 REMOVE SIGN BIT STA USACT USER ACCOUNT RECORD # * * * NOW READ IN USER ACCOUNT ENTRY * JSB READF READ IN USER ACCOUNT FILE DEF RTN12 DEF I.BUF DEF JERR DEF UBUF BUFFER FOR USER ACCOUNT DEF D128 WHILE RECORD IS READ DEF LEN DEF USACT RTN12 EQU * * * CHECK TO SEE IF MAIL IS WAITING IF SO THEN OPEN MESSAGE FILE * OTHERWISE REPORT NO MAIL IS WAITING * LDA ADBUF ADDR OF BUFFER CONTAINING ACCOUNT ADA D20 OFFSET TO CARTRIDGE WORD ADA OFFST ADD IN OFFSET LDB A,I SSB JMP DOWN1 LDA D2044 PRINT NO MESSAGES WAITING ERROR STA JERR JMP ERROR DOWN1 ADA DM4 MAIL IS WAITING, GET MESSAGE LDB A,I FILE NAME STB NAME STORE NAME IN THREE WORD ARRAY INA LDB A,I STB NAME+1 INA LDB A,I STB NAME+2 PUT 3RD CHAR. AWAY * * OPEN MESSAGE FILE * JSB OPEN OPEN USER MESSAGE FILE DEF RTN13 DEF O.BUF MESSAGE FILE DCB DEF JERR DEF NAME DEF IOPTN DEF SECU DEF LUNO. RTN13 EQU * * LDA JERR CPA DM6 JMP RMOV SSA JMP ERR2 * * OPEN OR CREATE LIST FILE * JSB OPENF OPEN LIST FILE DEF RTN43 DEF UDCB LIST FILE DCB DEF JERR ERROR RETURN WORD DEF INAM NAMR OF LIST FILE OR DEVICE DEF ZERO EXCLUSIVE OPEN DEF N.OPL DEF N.OPL+1 RTN43 EQU * * LDA JERR CHECK FOR OPEN ERROR SSA,RSS JMP LAB15 CPA DM6 RS7h������þúS IF NOT FOUND, CREATE IT JMP ERROR ELSE REAL ERROR LDA N.OPL+3 GET LIST FILE SIZE SZA,RSS SPECIFIED? LDA DM1 USE -1 STA N.OPL+3 LDA N.OPL+2 GET LIST FILE TYPE SZA,RSS SPECIFIED? LDA D4 USE TYPE 4 STA N.OPL+2 JSB CREAT CREAT USER'S LIST FILE DEF RTN32 DEF UDCB USER'S FILE DCB DEF JERR DEF INAM FILE NAME DEF N.OPL+3 DEF N.OPL+2 TYPE DEF N.OPL SECURITY CODE DEF N.OPL+1 CRN RTN32 EQU * * LDA JERR SSA JMP ERROR ANY OTHER TYPE OF ERROR * * TRANSFER MESSAGE FILE TO USER'S FILE * LAB15 JSB LOCF GET LU # OF LIST DEVICE DEF RTN19 DEF UDCB LIST FILE DCB DEF JERR ERROR RETURN WORD DEF TEMP DUMMY DEF TEMP DUMMY DEF TEMP DUMMY DEF TEMP DUMMY DEF LU LU # RETURNED HERE DEF TYPE FILE TYPE RTN19 EQU * * LDA TYPE GET FILE TYPE SZA TYPE 0? JMP LAB18 NO, SO SET LP FLAG TO 0 * JSB XLUEX EXTENDED LU EXEC CALL DEF *+4 DEF D13 DEVICE STATUS REQUEST DEF LU LU # - CONTROL WORD DEF IEQT5 STATUS RETURN WORD * LDA IEQT5 GET STATUS WORD AND M3740 CHECK FOR LINE PRINTER CMA ADA M5000 LAB18 CLB SET LINE PRINTER FLAG TO 0 SSA IF POSITIVE, NOT LINE PRINTER INB LINE PRINTER, PAD BLANK ON WRITE STB LU SAVE LINE PRINTER FLAG * LAB19 JSB READF DEF RTN20 DEF O.BUF MESSAGE FILE DCB DEF KERR ERROR RETURN WORD DEF UBUF BUFFER DEF D128 DEF LEN NUMBER OF WORDS READ RTN20 EQU * * LDA LEN NUMBER OF WORDS READ CPA DM1 END OF FILE? JMP LAB16 YES, CLOSE MESSAGE FILE * LDA KERR ¾Ö������þú SSA ERROR OR END OF FILE? JMP LAB16 YES, CLOSE MESSAGE FILE * LDA LU GET LINE PRINTER FLAG STA B ADA LEN BUMP LENGTH BY 1 IF LINE PRINTER STA LEN SAVE WORDS TO BE WRITTEN CMB,INB ADB ADBUF SET WRITE BUFFER TO IBUF-1 IF LP STB TEMP * JSB WRITF NO WRITE FROM MESSAGE FILE DEF RTN21 DEF UDCB USER MESSAGE FILE DEF KERR DEF TEMP,I BUFFER TO BE WRITTEN (UBUF-1 IF LP) DEF LEN NUMBER OF WORDS TO BE WRITTEN RTN21 EQU * * LDA KERR CHECK FOR WRITE ERROR SZA,RSS JMP LAB19 READ NEXT RECORD * LAB16 JSB CLOSE CLOSE MESSAGE FILE DEF RTN75 DEF O.BUF DEF JERR RTN75 EQU * * LDA KERR CPA DM12 END OF FILE? JMP CLERR YES SZA CHECK FOR READ ERROR STA RDERR READ ERROR CLERR LDA JERR SZA JMP ERR2 * STA ITRUN INITIALIZE TRUNCATION WORD LDA IPURG,I GET PURGE REQUEST CPA D1 IF 1, THEN RSS PURGE THE MESSAGE FILE JMP LAB66 DON'T PURGE MESSAGE FILE * LDA OVRD. GET SESSION OVERRIDE FLAG STA TEMP SAVE IT'S CURRENT VALUE IOR M2000 SET TO ALLOW WRITE ON SYS DISC STA OVRD. JSB PURGE PURGE USER'S MESSAGE FILE DEF RTN65 DEF O.BUF MESSAGE FILE DCB DEF JERR ERROR RETURN WORD DEF NAME NAME OF MESSAGE FILE DEF SECU RTN65 EQU * LDA TEMP RESET OVERRIDE FLAG STA OVRD. JMP RMOV2 * * REMOVE MAIL WAITING BIT * RMOV LDA IPURG,I GET PURGE REQUEST CPA D1 IF 1, THEN REMOVE MSG WAITING BIT RSS JMP ERROR NOT 1, SO JUST REPORT MSG FILE NOT FOUND ISZ CLEAN RMOV2 JSB READF READ IN USER ACCOUNT RECORD DEF RTN34 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WÎ������þúORD DEF IBUF DEF D128 DEF LEN NUMBER OF WORDS READ DEF USACT USER ACCT FILE RECORD NUMBER RTN34 EQU * * LDB DFIBF 1ST WORD OF ACCOUNT ENTRY ADB OFFST OFFSET TO USER'S ACCT (0 OR 64) ADB D20 OFFSET TO MAIL WAITING WORD CLA CLEAR MESSAGE WAITING BIT STA B,I * JSB POSNT POSITION TO USER'S ACCOUNT RECORD DEF RTN39 DEF I.BUF ACCOUNT FILE DCB DEF JERR ERROR RETURN WORD DEF USACT RECORD NUMBER OF USER'S ACCOUNT DEF D1 FLAG TO POSNT RTN39 EQU * * JSB WRITF WRITE RECORD BACK IN ACCOUNT FILE DEF RTN41 DEF I.BUF DEF JERR DEF IBUF DEF D128 RTN41 EQU * * LAB66 JSB RNRQ DEF RTN42 DEF D4 DEF RESNO DEF ISTAT RTN42 EQU * LDA CLEAN SZA JMP OPERR * * CHECK TO SEE IF TRUNCATION IS NEEDED * LDA N.OPL+3 CHECK TO SEE IF SIZE WAS SPECIFIED CPA DM1 IF -1, CLOSE WITH TRUNCATE RSS JMP LAB88 * * CALCULATE THE NUMBER OF BLOCKS TO TRUNCATE * JSB LOCF FIND POSITION OF EOF DEF RTN22 DEF UDCB DEF JERR DEF IREC RECORD NUMBER DEF IRB NEXT BLOCK DEF IOFF OFFSET WITHIN BLOCK DEF JSEC SECTOR RTN22 EQU * * LDA JSEC GET NUMBER OF SECTORS CLB DIV D2 DIVIDE BY 2 (2 SECTORS/BLOCK) LDB IRB NUMBER OF BLOCKS CMB,INB ADA B SUBTRACT BLOCKS ADA DM1 SUBTRACT 1 STA ITRUN NUMBER OF BLOCKS TO TRUNCATE * CLA ERROR RETURN WORD JMP ERR2 OPERR LDA DM6 RSS ERROR LDA JERR ERR2 STA IERR,I SZA,RSS JMP LAB88 * JSB RNRQ CLEAR ACCT FILE RN LOCK DEF RTN45 DEF D4 CLEAR RN REQUEST CODE DEF RESNO ACCT FILE RESOURCE NUMBER DEF ISTAT STw���0��.*ATUS RETURN WORD RTN45 EQU * * LAB88 JSB CLOSE CLOSE USER'S FILE DEF RTN23 DEF UDCB DEF JERR DEF ITRUN RTN23 EQU * * JSB CLOSE CLOSE MESSAGE FILE DEF RTN24 DEF O.BUF DEF JERR RTN24 EQU * * JSB CLOSE CLOSE ACCOUNT FILE DEF RTN25 DEF I.BUF RTN25 EQU * LDA RDERR SZA STA IERR,I * * JMP ME.SB,I RETURN XEQT EQU 1717B ACCT ASC 3,+@CCT! ADACT BSS 1 ADBUF DEF UBUF ADIBF DEF IBUFR ADINM DEF INAM ADSCB BSS 1 CLEAN BSS 1 CTR BSS 1 DM12 DEC -12 DM6 DEC -6 DM4 DEC -4 DM1 DEC -1 ZERO DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D8 DEC 8 D13 DEC 13 D14 DEC 14 D20 DEC 20 D24 DEC 24 D25 DEC 25 D45 DEC 45 D56 DEC 56 D64 DEC 64 D128 DEC 128 D2044 DEC 2044 NO MESSAGES WAITING ERROR (SEVERITY SET) DIRNO BSS 1 DFIBF DEF IBUF DNUM BSS 1 IBUF BSS 128 IEQT5 BSS 1 INAM BSS 3 IOFF BSS 1 IRB BSS 1 IREC BSS 1 ISTAT BSS 1 IOPTN DEC 1 ITRUN BSS 1 JERR BSS 1 JSEC BSS 1 KERR BSS 1 LEN BSS 1 LU BSS 2 LUNO. BSS 1 M2000 OCT 20000 M3740 OCT 37400 M5000 OCT 5000 M7777 OCT 77777 NAME BSS 3 NOPL BSS 2 OFFST BSS 1 RDERR BSS 1 RESNO BSS 1 SECU DEC -31178 TEMP BSS 1 TYPE BSS 1 * * UBUF0 MUST DIRECTLY PRECEDE UBUF * UBUF0 ASC 1, UBUF BSS 128 UDCB BSS 144 USACT BSS 1 USRID BSS 1 END ����������������������������������������������������������������������������������ï0������ÿÿ����� ���� ÿý�Œ� ™ ���������ÿ��92067-18451 1903� S C0122 �&SESSN � � � � � � � � � � � � � �H0101 }¤�����þúASMB,R,L,C HED "SESSN" ROUTINE TO FIND IF IN SESSION MODE * NAME: SESSN * SOURCE: 92067-18451 * RELOC: 92067-16125 * PGMR: B.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SESSN,7 92067-16125 REV.1903 780413 ENT SESSN EXT .ENTR PARAMETER ADDRESS FETCH ROUTINE SPC 1 * * ROUTINE TO DETERMINE IF A PROGRAM IS IN SESSION MODE * * CALLING SEQUENCE: JSB SESSN * DEF *+2 * DEF ID ID SEG. ADDRESS OF PROGRAM * <RETURN> E=1 IF NOT IN SESSION MODE * E=0 IF IN SESSION MODE * B=ID SEGMENT SESSION WORD * * METHOD: THIS ROUTINE EXAMINES ID SEGMENT WORD 33 (SESSION WORD). * IF NEGATIVE OR ZERO, THE PROGRAM IS NOT IN SESSION, * OTHERWISE THE PROGRAM IS IN SESSION MODE. * SPC 1 ID NOP ID SEGMENT ADDRESS OF PROGRAM SESSN NOP ENTRY JSB .ENTR GET PARAMETER ADDRESS DEF ID LDB ID,I GET ID SEGMENT ADDRESS ADB .32 OFFSET TO ID SEGMENT SESSION WORD XLB B,I GET CONTENTS OF SESSION WORD CCE,SSB,RSS POSITIVE? SZB,RSS ZERO? RSS WAS NEGATIVE OR ZERO, SO NON-SESSION CLE IN SESSION, RETURN E=0 JMP SESSN,I RETURN SPC 1 B EQU 1 .32 DEC 32 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ø��� ���� �������� �������ÿÿ����� ���� ÿý��” ���������ÿ��92067-18452 1940� S C0122 �&PARSN �ACCOUNTS PARSE SUBROUTINE � � � � � � � � � � � � �H0101 k½�����þúASMB,R,Q,C HED ACCOUNT NAME PARSE ROUTINE * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SOURCE PART NUMBER : 92067-18452 * * RELOCATABLE PART NUMBER : 92067-16125 * * PROGRAMER(S) : J.M.N. * * NAM PARSN,7 92067-16125 REV.1940 790801 * * * PARSN IS A ROUTINE TO PARSE A SESSION MONITOR ACCOUNT NAME * OR PASSWORD. IT USES A SUBROUTINE CALLED CHECK WHICH * DETERMINES WHETHER A CHARACTER IS A VALID CHARACTER FOR AN * ACCOUNT NAME OR PASSWORD. PARSN SCANS THE COMMAND INPUT * UNTIL A COMMA, THE END OF THE BUFFER, OR A COMMENT * (INDICATED BY AN ASTERISK) IS REACHED. ASCII BLANKS * ARE IGNORED. INVALID CHARACTERS CAUSE AN ERROR RETURN. * THE RESULT OF THE PARSE IS RETURNED IN A 11-WORD BUFFER: * WORD 1: BITS 0-7 = CHARS IN GROUP NAME * BITS 8-15 = CHARS IN USER NAME * WDS 2-6: USER NAME, PADDED WITH BLANKS * WDS 7-11: GROUP NAME, PADDED WITH BLANKS * * THE VARIABLE "LIMIT" DETERMINES THE LENGTH OF THE PARSE OUTPUT * TO BE ALLOWED. ICHAR IS UPDATED TO INDICATE THE NEXT * CHARACTER POSITION AT WHICH TO BEGIN THE NEXT PARSE, JUST * AS THE ROUTINE NAMR DOES (ICHAR MUST BE DEFINED AS A VARIABLE). * * CALLING SEQUENCE: CALL PARSN (PBUF,UPBUF,LENTH,ICHAR,IERR) * WHERE * PBUF = PARSE OUTPUT BUFFER * UPBUF= PARSE INPUT BUFFER * LENTH= NUMBER OF CHARS IN INPUT BUFFER * ICHAR= NEXT CHARACTER POSITION AT WHICH TO PARSE * IERR = ERROR RE| ������þúTURN WORD * * ERRORS: -1 = ICHAR > LENTH * 1 = NAME TOO LONG * 2 = INVALID CHARACTER(S) IN NAME SKP * * * TEST PROGRAM: * * FTN4,L * PROGRAM CKPAR * DIMENSION IB(40),JB(11) * DATA IB/40*2H / * LU=LOGLU(IDMY) * 1 WRITE(LU,100) * 100 FORMAT(" PLEASE ENTER STRING TO PARSE") * READ(LU,200)(IB(I),I=1,40) * 200 FORMAT(40A2) * ICHAR=1 * 2 CALL PARSN(JB,IB,40,ICHAR,IERR) * NCHRU=JB(1)/256 * NCHRG=IAND(JB(1),377B) * WRITE(LU,300)NCHRU * 300 FORMAT(1X,"NUMBER OF CHARS IN USER NAME = ",I2) * WRITE(LU,500)(JB(J),J=2,6) * WRITE(LU,400)NCHRG * 400 FORMAT(1X,"NUMBER OF CHARS IN GROUP NAME = ",I2) * WRITE(LU,500)(JB(J),J=7,11) * 500 FORMAT(1X,"WORD 1 = ",A2/ * A 1X,"WORD 2 = ",A2/ * B 1X,"WORD 3 = ",A2/ * C 1X,"WORD 4 = ",A2/ * D 1X,"WORD 5 = ",A2/) * WRITE(LU,600)IERR,ICHAR * 600 FORMAT(1X,"ERROR = ",I2,5X,"NEXT CHAR POSITION = ",I2//) * IF (ICHAR.LE.80) GO TO 2 * STOP * END SKP ENT PARSN EXT .ENTR * PBUF NOP UPBUF NOP LENTH NOP ICHAR NOP IERR NOP PARSN NOP ENTRY JSB .ENTR GET PARAMETER ADDRESSES DEF PBUF LDA COMMA SET ALTERNATE TERIMINATOR TO COMMA STA ALTRM CLA STA NONBL CLEAR NON-BLANK CHARACTER COUNT LDB PBUF GET OUTPUT BUFFER ADDRESS STA B,I CLEAR OUTPUT CHARACTER COUNT STB CNTWD SAVE ADDRESS OF 1ST WD OF OUTPUT BUFFER INB BUMP TO WORD 2 OF OUTPUT BUFFER STB PBUF SAVE FOR PAK ROUTINE LDA LIMIT GET OUTPUT BUFFER LENGTH STA TEMP SAVE FOR COUNTING WORDS TO BLANK LDA BLNKS GET ASCII BLANKS CLEAR STA B,I ������þú INITIALIZE OUTPUT BUFFER WITH BLANKS INB BUMP OUTPUT BUFFER ADDRESS ISZ TEMP BUMP COUNT OF WORDS LEFT TO BE BLANKED JMP CLEAR MORE, SO CONTINUE LDA ICHAR,I DONE, NOW GET STARTING CHAR POSITION ADA M1 GET OFFSET FROM START OF INPUT BUFFER ARS CONVERT TO WORDS ADA UPBUF ADDRESS AT WHICH TO START PARSE LDB ICHAR,I CHARACTER POSITION CLE,SLB,RSS IF CHARACTER POSITION EVEN, CCE THEN SET THE LOW BYTE FLAG ELA,RAR SET SIGN BIT IF TO START AT LOW BYTE STA UPBUF OF INPUT BUFFER LDB LENTH,I GET LENGTH OF INPUT BUFFER FOR EOB CHECK SZB,RSS IF LENGTH IS ZERO, JMP OK THEN DONE SSB,RSS IF LENGTH IS POSITIVE, CMB,INB MAKE NEGATIVE SCAN1 ADB ICHAR,I CHECK IF ICHAR > LENGTH (IN CHARACTERS) CCA SSB POSITIVE? JMP SCAN2 NO, SO ICHAR NOT > LENGTH SZB ZERO? JMP ERROR ERROR RETURN (ICHAR>LENGTH IN CHARS) SCAN2 ADB A SET UP REMAINING CHARS IN INPUT BUFFER STB INCNT SAVE IT LDA LIMIT SET UP LIMIT FOR PARSE OUTPUT STA OUTCT LDB M2 INITIALIZE COUNT OF ASCII DOTS FOUND STB DOTCT SAVE IT STB ATCNT INITIALIZE COUNT OF "@"'S FOUND STB ENDP END OF PARSE INDICATOR RSS SKIP FIRST ISZ NEXTC ISZ INCNT CHECK FOR END OF BUFFER RSS NOT END OF BUFFER JMP ENPAR END OF BUFFER, SO DONE JSB UNPAK GET NEXT CHARACTER ISZ ICHAR,I BUMP CHARACTER POSITION CPA BLANK ASCII BLANK? JMP NEXTC YES, SKIP IT AND GET NEXT CHARACTER CPA COMMA COMMA? JMP ENPAR YES, DONE WITH PARSE CPA ALTRM CHECK ALTERNATE TERMINATOR JMP ENPAR CPA STAR ASTERISK? (COMMENT) JMP COMNT YES CPA DOT ASCII DOT? JMP CKDOT YES,¦ˆ������þú CHECK IF VALID TO HAVE A DOT CPA AT "@"? JMP CHKAT YES, CHECK IF VALID TO HAVE AN "@" JSB CHECK CHECK FOR VALID CHAR FOR NAME/PASSWORD JMP E2 ERROR RETURN - INVALID CHARACTER LDA ATCNT GET COUNT OF "@"'S FOUND CPA M1 IF ALREADY 1, JMP E2 ERROR - "@" FOLLOWED BY ANOTHER CHAR VALID JSB PAK VALID CHARACTER - PUT INTO OUTPUT BUFFER ISZ CNTWD,I BUMP OUTPUT CHARACTER COUNT ISZ OUTCT BUMP LIMIT CHECK FOR OUTPUT JMP NEXTC NOT TO LIMIT YET, GET ANOTHER CHARACTER JSB SKIPC SKIP CHARACTERS UNTIL EOB OR COMMA JMP E1 MORE NON-BLANK CHARS (EXCEEDED LIMIT) RSS ENPAR ISZ ENDP OK JSB IFDOT CHECK IF "NAME." FORMAT JMP E2 YES, SO INVALID NAME CLA EOB OR COMMA OR COMMENT, SO DONE ERROR STA IERR,I RETURN IN ERROR WORD JSB SETLN SET CHAR COUNTS IN OUTPUT BUFFER JMP PARSN,I RETURN E1 CLA,INA JMP ERROR E2 JSB SKIPC SKIP CHARACTERS UNTIL EOB OR COMMA NOP IGNORE ERROR 1, SINCE WE HAVE ERROR 2 LDA .2 ERROR, INVALID CHARACTER IN NAME JMP ERROR RETURN THE ERROR 2 SPC 1 SKIPC NOP ENTRY, SKIP CHARACTER ROUTINE SKIP0 LDA OUTCT CHECK IF OUTPUT LIMIT ALREADY REACHED SSA,RSS JMP SKIP1 LIMIT REACHED LDA ENDP CPA M1 JMP SKIP3 JSB PAK PUT CHARACTER INTO OUTPUT BUFFER ISZ CNTWD,I INCREMENT OUTPUT CHARACTER COUNT ISZ OUTCT INCREMENT LIMIT CHECK FOR OUTPUT NOP SKIP1 ISZ INCNT SKIP CHARACTERS UNTIL EOB OR COMMA RSS NOT END OF BUFFER JMP SKIP3 END OF BUFFER, SO DONE JSB UNPAK GET ANOTHER CHARACTER ISZ ICHAR,I BUMP CHARACTER POSITION CPA BLANK BLANK? JMP SKIP1 JUST CONTINUE WITH ANOTHER CHARACTER CPA COMMA COMMA? JMP SKIP3 YES, SO DONE CPA ALTRM !x������þú CHECK ALTERNATE TERM JMP SKIP3 LDB NONBL IF NO NONBLANK CHARACTERS CHECK FOR DOT SZB JMP SKIP2 * CPA DOT CHECK DOT JMP CKDOT SKIP2 ISZ NONBL BUMP NON-BLANK CHARACTER COUNT JMP SKIP0 CONTINUE SKIPPING UNTIL EOB OR COMMA SKIP3 LDA NONBL CHECK IF NON-BLANK CHAR COUNT NON-ZERO SZA,RSS IF SO,ERROR RETURN (P+1), A=NONBL COUNT ISZ SKIPC RETURN TO P+2, A=0 JMP SKIPC,I RETURN SPC 1 CKDOT LDA SLASH SET ALTERNATE TERMINATOR TO SLASH STA ALTRM LDA CNTWD,I GET COUNT OF CHARS PARSED SZA,RSS IF NONE, THEN JMP E2 ERROR - DOT IS INVALID ISZ DOTCT ELSE CHECK IF MORE THAN ONE DOT RSS NO, ASSUME DOT IS SEPARATOR JMP E2 YES, ERROR - DOT IS INVALID ALF,ALF MOVE # CHARS IN USER NAME TO UPPER BYTE STA CNTWD,I SAVE IT LDA CNTWD UPDATE OUTPUT BUFFER POINTER TO ADA .6 WORD 6 OF OUTPUT BUFFER STA PBUF AND SAVE IT FOR PAK ROUTINE LDA LIMIT RESET OUTPUT BUFFER COUNT FOR GROUP NAME STA OUTCT SAVE IT LDA M2 RESET COUNT OF "@"'S FOR GROUP STA ATCNT SAVE IT JMP NEXTC CONTINUE PARSE, THIS TIME FOR GROUP NAME SPC 1 CHKAT LDA CNTWD,I GET COUNT OF CHARACTERS PARSED AND B377 COUNT FOR PART OF NAME NOW BEING PARSED SZA IF NON-ZERO, JMP E2 ERROR - CAN'T ALLOW AN "@" ISZ ATCNT BUMP COUNT OF "@"'S FOUND JMP VALID ALLOW 1ST "@" FOUND SINCE NO OTHER CHARS SPC 1 COMNT LDA LENTH,I GET LENGTH OF INPUT BUFFER SSA IF NEGATIVE MAKE POSITIVE CMA,INA INA RETURN NEXT CHAR POSITION=LAST CHAR STA ICHAR,I POSITION OF INPUT BUFFER, PLUS 1 JMP OK SPC 1 SETLN NOP SET UP CHAR COUNTS IN OUTPUT BUFFER LDA CNTWD,I GET CHARACTER COUNT WORD LDB DOTCT Y������þú GET COUNT OF ASCII DOTS FOUND CPB M2 IF NONE FOUND (COUNT STILL = -2) ALF,ALF THEN SHIFT CHAR COUNT TO UPPER BYTE STA CNTWD,I SAVE IT JMP SETLN,I RETURN SPC 1 IFDOT NOP CHECK FOR "NAME." FORMAT LDA DOTCT COUNT OF NUMBER OF ASCII DOTS FOUND CPA M2 EVER FOUND A DOT? JMP ALLOW NO, SO ALLOW LDA CNTWD,I YES, SO BETTER HAVE A CHARACTER AFTER AND B377 THE DOT SZA IF YES, ALLOW ISZ IFDOT THEN ALLOW (RETURN P+2) JMP IFDOT,I RETURN SKP * * * ROUTINE TO CHECK IF A CHARACTER IS VALID FOR ACCT NAME/PASSWORD * * CHECK NOP ENTRY STA B SAVE CHARACTER CMA,INA ADA .126 SSA GREATER THAN 176B? JMP CHECK,I YES, INVALID CMA,INA ADA .78 SSA JMP CHEC1 LESS THAN 60B? CPA .10 IS IT 72B (COLON)? RSS YES CPA .16 IS IT 100B (@)? RSS YES ISZ CHECK BETWEEN 60B & 176B, AND NOT COLON OR @, JMP CHECK,I SO IT'S VALID CHEC1 CMB,INB ADB .41 SSB GREATER THAN 51B? JMP CHECK,I YES,INVALID CMB,INB ADB .8 SSB,RSS LESS THAN 41B? ISZ CHECK NO, BETWEEN 41B AND 51B, SO IT'S VALID JMP CHECK,I RETURN SPC 1 SKP * * * STRING UNPACK ROUTINE * * UNPAK NOP ENTRY LDB UPBUF ADDRESS TO UNPACK FROM, - IF LOW BYTE CLE ELB,RBR GET SIGN BIT LDA B,I GET CONTENTS OF PACKED BUFFER SEZ,RSS TEST IF SIGN BIT SET ALF,ALF NO, SHIFT HIGH BYTE TO LOW BYTE AND =B177 MASK HIGH BYTE SEZ,CME TEST IF SIGN BIT SET INB,RSS YES, INCREMENT UNPACK ADDRESS ELB,RBR STB UPBUF UPDATE ADDRESS OF UNPACK BUFFER STA CHAR SAVE FOR PAK ROUTINE JMP UNPA=���*��($K,I RETURN SPC 3 * * * STRING PACK ROUTINE * * PAK NOP ENTRY LDA CHAR SAVED BY UNPAK ROUTINE LDB PBUF ADDRESS TO PACK INTO, - IF LOW BYTE CLE ELB,RBR GET SIGN BIT SEZ,RSS TEST IF SIGN BIT SET ALF,ALF NO, SHIFT HIGH BYTE TO LOW BYTE STA CHAR SAVE CHARACTER LDA B,I GET CONTENTS OF ASCII BUFFER SEZ ALF,ALF AND =B177 MASK HIGH BYTE SEZ ALF,ALF XOR CHAR GET ACTUAL CHARACTER STA B,I PACK INTO CURRENT PACK ADDRESS SEZ,CME TEST IF SIGN BIT SET INB,RSS INCREMENT PACK ADDRESS ELB,RBR STB PBUF SAVE NEW PACK BUFFER ADDRESS JMP PAK,I RETURN SKP AT OCT 100 ASCII "@" B377 OCT 377 BLANK OCT 40 BLNKS OCT 20040 COMMA OCT 54 DOT OCT 56 SLASH OCT 57 STAR OCT 52 LIMIT DEC -10 -NBR OF CHARS ALLOWED IN OUTPUT BUFFER M2 DEC -2 M1 DEC -1 .2 DEC 2 .6 DEC 6 .8 DEC 8 .10 DEC 10 .16 DEC 16 .41 DEC 41 .78 DEC 78 .126 DEC 126 ATCNT NOP COUNT OF "@"'S FOUND CHAR NOP CHAR UNPACKED BY UNPAK, PACKED BY PAK CNTWD NOP ADDRESS OF 1ST WORD OF OUTPUT BUFFER DOTCT NOP COUNT OF ASCII DOTS FOUND (1 ALLOWED) ENDP NOP FLAG, -1 IF COMMA OR BUFFER END REACHED INCNT NOP NBR OF REMAINING CHARS IN INPUT BUFFER OUTCT NOP NBR OF REMAINING CHARS IN OUTPUT BUFFER NONBL NOP COUNT OF NON-BLANK CHARS FOUND BY SKIPC TEMP NOP ALTRM NOP A EQU 0 B EQU 1 END ��������������������������������������������������������������������������������������������������������������������������������������������������������Åâ*������ÿÿ����� ���� ÿý�Ž� š ���������ÿ��92067-18453 1903� S C0122 �&IPRSN � � � � � � � � � � � � � �H0101 Š™�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * * SOURCE PART NUMBER : 92067-18453 * * RELOCATABLE PART NUMBER : 92067-16125 * * PROGRAMER(S) : S.P.K.,J.M.N. * * * IPRSN - ROUTINE TO MOVE USER.GROUP IN PACKED FORMAT IN * USER BUFFER * CALLING SEQUENCE: JSB IPRSN * DEF *+4 * DEF NAME 11 WORD NAME OF USER AND GROUP * DEF BUF2 BUFFER TO MOVE USER.GROUP INTO * DEF PTR CHAR OFFSET INTO BUFFER * * NAM IPRSN,7 92067-16125 REV.1903 790103 ENT IPRSN EXT .ENTR,SETDB,ZPUT,CPUT NAME NOP BUF2 NOP PTR NOP * IPRSN NOP JSB .ENTR DEF NAME LDA PTR,I GET CHAR POSITION IN BUFFER ADA D21 MAX LENGTH OF USER.GROUP IS 21 CHARS STA TEMP3 SAVE THE END OF BUFFER ADDRESS JSB SETDB SET DESTINATION BUFFER DEF *+3 DEF BUF2,I DEF PTR,I LDA NAME,I GET FIRST WORD OF SOURCE BUFFER AND B377 GET # CHARS IN GROUP NAME STA TEMP2 SAVE XOR NAME,I GET # OF CHARS IN USER NAME ALF,ALF STA TEMP1 SZA,RSS JMP IPRS1 IF NO USER PRINT GROUP ONLY JSB ZPUT MOVE THE STRING CONTAINING USER NAME DEF *+4 DEF NAME,I SOURCE BUFFER DEF D3 SOURCE POINTER DEF TEMP1 # OF CHARS JSB CPUT INSERT A PERIOD BETWEEN USER, GROUP NAME DEF *+2 DEF "." ". " IPRS1 JSB ZPUT MOVE GROUP NAME DEF *+4 DEF NAME,I SOURCE Bzx��� �� UFFER DEF D13 SOURCE POINTER DEF TEMP2 # OF CHARS LDA PTR,I SAVE CURRENT POSITION OF DEST BUFFER POINTER STA TEMP2 BLNKL CPA TEMP3 IS THIS POSITION SAME AS END OF USER.GROUP? JMP DONE JSB CPUT INSERT SPACE IN BUFFER DEF *+2 DEF DBLNK LDA PTR,I JMP BLNKL * DONE LDA TEMP2 RETURN WITH POINTER TO END OF U.G STA PTR,I JMP IPRSN,I * "." ASC 1,. D21 DEC 21 D3 DEC 3 D13 DEC 13 TEMP3 NOP TEMP1 NOP TEMP2 NOP DBLNK ASC 1, B377 OCT 377 * * * * END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿ ������ÿÿ����� ���� ÿý��– ���������ÿ��92067-18454 2013� S C0122 �&$ESTB � � � � � � � � � � � � � �H0101 ƒ`�����ASMB,R,L,C,Q HED $ESTB * NAME: $ESTB * SOURCE: 92067-18454 * RELPC: 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ESTB,6 92067-1X454 REV.2013 790202 * ENT $ESTB EXT .ZPRV SKP $ESTB NOP JSB .ZPRV GO PRIV IF IN SYS LIB DEF LIBX LDB XEQT FETCH CALLERS ID ADDR ADB D32 ADVANCE TO SESSION WORD XLB B,I AND FETCH THE CONTENTS CLE,SSB,RSS SZB,RSS CLB,CCE LIBX JMP $ESTB,I DEF $ESTB MAKE LOADER HAPPY SKP XEQT EQU 1717B D32 DEC 32 B EQU 1 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ð>������ÿÿ����� ���� ÿý��– ���������ÿ��92067-18455 2001� S C0122 �&$SALC �SESSION MEM ALLOCATE � � � � � � � � � � � � �H0101 Eš�����þúASMB,R,L,C,Q HED * $SALC * SESSION MONITOR MEMORY ALLOCATION * * NAME: $SALC * SOURCE: 92067-18455 * RELOC: PART OF 92067-16261 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $SALC,0 92067-16261 REV.2001 791016 * ENT $SALC,$SRTN EXT $LIST,$WORK,$ALC,$RTN * SUP * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $SALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $SRTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * * IF, WHEN BUFFER REQUESTED, - (AVMEM) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * * JSB $SALC * DEC 32767 * * BLOCKS OF MEMORY AVAILABLE FORÒ6������þú OUTPUT BUFFERING ARE LINKED THROUGH * THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * * * REGISTERS ARE NOT PRESERVED * SKP $SALC NOP XLA $SALC,I GET THE LENGTH OF THE REQUEST STA ADX SAVE REQUEST LENGTH LDB A ADA AVMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. * ADB MAXEV EVER ENOUGH ? SSB,RSS JMP ERETN ISZ $SALC REJ CLA,CLE,RSS ERETN CCA,CLE JMP SETB * * * .A1 ISZ $SALC BUMP RTN ADDR CCA TRY AN ALLOCATION STA ALCIN SET CORE AVAIL. NOW TO 0 LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX SET BUFFER LENGTH STB A BUFFER ADDRESS TO A CCE,INB SET E FOR ACCEPTED RETURN LDB B,I 6>������þú GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $SALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB AVMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $SALC STEP RETURN ADDRESS UJP $SALC,I AND RETURN * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA AVMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * SKP HED * $SRTN * SESSION MONITOR MEMORY RETURN PROCESSOR * * $SRTN NOP ENTRY POINT FOR BUFFER RETURN XLA $SRTN,I (A) = FWA RETURN BUFFER (ADX) ISZ $SRTN * SSA SPECIAL ENTRY BY ACCOUNT PROGRAM ? JMP STUP YES-- GO CHECK IT OUT * STA ADX CMA,INA SET NEG AND STA SAVA SAVE * XLA $SRTN,I # OF WORDS RETURNED (X) .R1 STA ADX2 AND SAVE IN LOCAL TEMP ADA DM2 SSA <2? JMP RETNR BUFFER TO SMALL - IGNORE LDA PNTRA GET THE STARTING POINTER .R11 STA BAD BAD _ AAD INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS CPB PNTRA IF LOCAT POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT THE NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB ADX2 ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAÇ������þúS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER LENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA AVMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB AVMEM YES; SET IT RETNR ISZ $SRTN UJP $SRTN,I * * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB ADX2 SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * * SPC 5 STUP STA SAVA SAVE CALL CMA,INA PARM STA ADX * XLA $SRTN,I FETCH #WORDS SSA,RSS IF NOT NEG JMP RETNR THEN BAD CALL * LDB AVMEM IF NOTHING HAS BEEN CPB DM1 ALLOCATED JMP SET GO SET IT UP * CPA B RELEASE CALL -- VERIFY CALL PARAMETERS RSS # WORDS SPECIFIED MUST MATCH CURRENT DEFINITION JMP BADD ELSE REJECT REQUEST * LDA ADX START ADDRESS MUST ALSO CPA $PNTR MATCH CCA,RSS CURRENT DEFINITION JMP BADD2 OR REJECT AS SCB'S MAY STILL EXIST * STA AVMEM RESET LDB DAVMN STB PNTRA POINTERS TO LDB M7 STB $PNTR INDICATE NO MEMORY ALLOCATED JMP RETNR * * * BADD CLA,RSS # WORDS DOESN'T MATCH BADD2 CLA,INA START ADDR DOESN'T MATCH JMP RETNR * SET STA MAXEV SET MAX SIZE CMA SET IT POSITIVE JMP .R1 * DAVMN DEF AVMEM ADX NOP ADX2 NOP HED ÖÌ�����SESSION MONITOR MEMORY MANAGER SKP * * * * * PNTRA DEF AVMEM DUMMY BLOCK ADDRESS(DON'T MESS!) AVMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) $PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 DM1 OCT -1 D2 OCT 2 * MAXEV NOP MAX SIZE BLOCK EVER AVAILABLE ALCIN NOP * A EQU 0 B EQU 1 * BSS 0 LENGTH OF PROGRAM * END $SALC ��������������������������������������������������������������¾³������ÿÿ����� ���� ÿý�‘� › ���������ÿ��92067-18456 1903� S C0122 �&4AUTR � � � � � � � � � � � � � �H0101 ‹�����þúFTN,L C NAME: AUTOR C SOURCE: 92067-18456 C RELOC: 92067-16118 C PGMR: G.A.A. C E.J.W.,750505 C D.L.S.,760622 C E.J.W.,771219 C G.L.M.,790318 C C PROGRAM AUTOR(2,1),92067-16118 REV.1903 790318 DIMENSION ITM(3),ITMX(5),IPFM(26),IDY(2),IPLU(2),ILU(2) EQUIVALENCE (ITM(1),REG),(ITM(2),IB) EQUIVALENCE (IPFM(10),IHR),(IPFM(12),IMIN),(IPFM(14),ISEC) EQUIVALENCE (IPFM(16),IMS),(IPFM(21),IDY),(IPFM(26),IYR) EQUIVALENCE (IPLU,LUPF),(LUT,ILU) C DATA ILU /0,0/ DATA IPLU /0,0/ C DATA IPFM /2H P,2HOW,2HER,2H F,2HAI,2HLE,2HD ,2HAT,2H ,2HXX, C 2H: ,2HXX,2H: ,2HXX,2H. ,2HXX,2H0 ,2HON,2H D,2HAY, C 2H X,2HXX,2H O,2HF ,2H19,2H70/ C C C C NOTE: THE ENTRY POINT "XLUEX" IS PROVIDED FOR INTERNAL USE C ONLY. HEWLETT-PACKARD RESERVES THE RIGHT TO REMOVE OR C MODIFY THE CALLING SEQUENCE OR PARAMETER MEANINGS. THE C "XLUEX" CALLING SEQUENCE IS IDENTICAL TO "EXEC" EXCEPT C IN THE CONTROL WORD DEFINITION. C C EXEC CONTROL WORD: ONE WORD PARAMETER DEFINING LOGICAL UNIT C AND FUNCTION CODE. C C XLUEX CONTROL WORD: TWO WORD PARAMETER USED TO DEFINE: C C WORD 1>LOGICAL UNIT (BITS 7-0) C WORD 2>FUNCTION CODE (BITS 10-6) C C THE FUNCTION CODE FIELD IS IDENTICAL TO THE FUNCTION C CODE FIELD DEFINED FOR STANDARD EXEC I/O REQUESTS. C C DEFINE THE MAXIMUM LOGICAL UNIT NUMBER C LUMAX=IGET(1653B) C C C SCAN THE LU'S TO FIND THE LU FOR C THE PFAIL DRIVER DO 5 LUPF=1,LUMAX C DO A STATUS CALL C CALL XLUEX(100015B,LUPF,IEQT5,IEQT4) C C IGNOR UNDEFINED,AND UNASSIGNEâ������þúD LU'S. GO TO 5 C IS DRIVER TYPE EQUAL TO 43? C 600 IF (IAND(IEQT5,37400B)-21400B)5,15,5 C C YES, IS THE SELECT CODE=4? C 15 IF (IAND(IEQT4,77B)-4)5,20,5 C 5 CONTINUE C POWER FAIL LU NOT FOUND C C ISSUE "POWER FAIL LU NOT FOUND. TIME OF POWER FAIL UNKNOWN" C TO SYSTEM CONSOLE. C CALL EXEC(2,1, C51HPOWER FAIL LU NOT FOUND. TIME OF POWER FAIL UNKNOWN,-51) C C SET TO USE LU ZERO LUPF=0 C LU FOUND SET TO GET FAIL TIME C CALL THE PFAIL DVR TO GET FAIL TIME 20 CALL XLUEX(1,LUPF,ITM,3) C CONVERT THE DOUBLE INTEGER TO: C HR,MIN,SEC.TENS OF MS CALL TMVAL(ITM,ITMX) C GET THE YEAR OFFSET FROM DAYS IB=ITM(3)/365 C ADD THE BASE YEAR TO GET ACTUAL YEAR C AND CONVERT TO ASCII CALL ICONV(IYR,IB+70) C SUBTRACT THE YEARS TO GET DAYS AND C CORRECT FOR DAY ZERO. ID=ITM(3)-IB*365+1 C ISOLATE HUNDREDS AND CONVERT TO C ASCII C CALL ICONV(IDY,ID/100) C C FORCE HIGH BYTE TO A BLANK C IDY=IAND(IDY,20777B) C C ISOLATE TENS AND ONES DIGITS AND C CONVERT TO ASCII C CALL ICONV(IDY(2),MOD(ID,100)) C C CONVERT MILLISECONDS TO ASCII C CALL ICONV(IMS,ITMX) C C CONVERT SECONDS TO ASCII C CALL ICONV(ISEC,ITMX(2)) C C CONVERT MINUTES TO ASCII C CALL ICOÙè������þúNV(IMIN,ITMX(3)) C C CONVERT HOURS TO ASCII C CALL ICONV(IHR,ITMX(4)) C C ***************************** C THE FOLLOWING DO LOOP MAY BE C MODIFIED IF DESIRED. C IT SERVES TWO FUNCTIONS: C 1) BY SENDING A MESSAGE TO EACH TTY C THE DRIVER WILL RESET THE TTY C INTERFACE TO REENABLE ANY C TERMINALS (MUST ISSUE A STC). C 2) ANY USERS AT THE TERMINALS ARE C INFORMED THAT THE LAST LINE MAY C NOT HAVE BEEN TRANSMITTED C CORRECTLY. C ***************************** C C C C SCAN FOR ALL THE TTY TYPE DEVICES DO 30 LUT=1,LUMAX C DO STATUS CALL CALL XLUEX(100015B,LUT,IEQT5,ISTA2,ISTA3) C IGNOR UNDEFINED,AND UNASSIGNED LU'S GO TO 30 C CHECK IF TYPE 0 DEVICE (I.E. A TTY) 1 IF(IAND(IEQT5,37400B))25,2,25 C CHECK IF TYPE 5 DEVICE 25 IEQT5=IEQT5-2400B IF(IAND(IEQT5,37400B))30,27,30 C IF TYPE 5 DEVICE, CHECK TO SEE IF C SUBCHANNEL 0(I.E. A CONSOLE) 27 IF(IAND(ISTA3,37B))30,2,30 C IF FIND A DEVICE, WRITE TIME ON IT. 2 CALL XLUEX(2,LUT,IPFM,-52) 30 CONTINUE C ***************************** C USER POWER FAIL RECOVERY CODE C SHOULD BE ADDED HERE. C È•����� REMEMBER IF POWER FAILS C WHILE IN THIS CODE IT C MAY RUN FOR A FEW C SECONDS AFTER POWER IS C RESTORED AND THEN BE ABANDONED C AND RESTARTED FROM THE C TOP. C ***************************** C C SECOND CALL ON PFAIL ROUTINE RESETS C TO SAVE TIME ON NEXT FALUTRE. CALL XLUEX(1,LUPF,ITM,3) STOP END SUBROUTINE ICONV(LOC,IVAL) LOC=IVAL/10*256 LOC=IOR(IOR(LOC,30060B),MOD(IVAL,10)) RETURN END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������aM������ÿÿ����� ���� ÿý�’�› ���������ÿ��92067-18457 1940� S C0122 �&$CMND � � � � � � � � � � � � � �H0101 €b�����þúASMB,R,L,C,Q * NAME: $CMND * SOURCE: 92067-18457 * RELOC: 92067-16261 * PGMR: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $CMND,0 92067-16261 REV.1940 790729 ENT $CMND * * $CMND DEF EINDX DEFINE THE ADDRESS OF HIGHEST CAPABILITY DEF BEGIN DEFINE BEGINNING OF TABLE DEF END DEFINE END OF TABLE * L60 DEC -60 LEVEL 60 L60A DEF BEGIN DEFINE START OF THIS CAPABILITY * L50 DEC -50 L50A DEF L.50 * L30 DEC -30 L30A DEF L.30 * L10 DEC -10 L10A DEF L.10 * L00 NOP L00A DEF L.00 * EINDX EQU *-2 * * * ORG $CMND BSS L10A-L30A BSS L30A-L50A BSS L50A-L60A ORR * SKP L.60 EQU * BEGIN ASC 1,QU OCT 0 ASC 1,DN OCT 0 ASC 1,LU OCT 0 ASC 1,EQ OCT 0 ASC 1,TO OCT 0 ASC 1,BL OCT 0 ASC 1,TM OCT 0 ASC 1,OF OCT 0 ASC 1,BR OCT 0 ASC 1,GO OCT 0 ASC 1,SS OCT 0 * L.50 ASC 1,IT OCT 0 ASC 1,L3 ABILITY TO ADD AN ENTRY IN SST -- SL CMND OCT 0 ASC 1,AS OCT 0 ASC 1,UR OCT 0 ASC 1,ON OCT 0 ASC 1,PR OCT 0 * L.30 ASC 1,RU OCT 0 ASC 1,OF OCT 40000 ASC 1,SS OCT 40000 ASC 1,GO OCT 40000 ASC 1,RT OCT 0 ASC 1,SZ OCT 0 ASC 1,L2 LEVEL 2 SL CMND -- SPOOL AN LU OCT 0 * L.10 ASC 1,FL OCT 0 ASC 1,RS OCT 0 ASC 1,ñ°��� �� QU OCT 100000 ASC 1,BL OCT 100000 ASC 1,ST OCT 0 ASC 1,BR OCT 40000 ASC 1,EQ OCT 100001 ASC 1,SL OCT 0 ASC 1,TO OCT 100001 ASC 1,TE OCT 0 ASC 1,WH OCT 0 ASC 1,TI OCT 0 ASC 1,UP OCT 0 ASC 1,EN OCT 0 * L.00 ASC 1,OP OCT 0 ASC 1,HE OCT 0 * END EQU *-2 END $CMND ������������������������������������������������š* ������ÿÿ����� ���� ÿý�“�š ���������ÿ��92067-18459 1903� S C0122 �&GETSP � � � � � � � � � � � � � �H0101 …›�����ASMB,R,L * * NAME: GETSP * SOURCE: 92067-18459 * RELOC: 92067-16104 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GETSP,7 92067-16104 REV.1903 790503 * ENT GETSP EXT $SPCR,OVRD. * * GETSP NOP ISZ GETSP SET UP RETURN ADDRESS ISZ GETSP LDA OVRD. GET THE I CAN WRITE ON LU 2 & 3 WORD ADA B40K SET BIT 14 STA OVRD. & PUT IT BACK * LDA $SPCR JMP GETSP,I RETURN * * A EQU 0 B EQU 1 B40K OCT 40000 *$SPCR DEC -50 END ������������������������������������������������"������ÿÿ����� ���� ÿý�”�š ���������ÿ��92067-18463 1903� S C0122 �&XQPRG � � � � � � � � � � � � � �H0101 Š �����þúFTN4,L C C C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C NAME: XQPRG C SOURCE: 92067-18463 C RELOC: 92067-16125 C PGMR: C.M.M. C C C THE XQPRG ROUTINE IS A MEANS TO SCHEDULE A PROGRAM TO BE RUN. C IT MAKES EVERY ATTEMPT TO EITHER 'RP' OR SCHEDULE THE REQUESTED C PROGRAM. IT WILL RENAME THE PROGRAM IF POSSIBLE. C C C SEQUENCE OF EVENTS : C C I. DUP OR RP A COPY OF PROG ABCDE TO ABCLU C A. IF SUCCESS SCHEDULE THE PROGRAM C B. FAILURE C 1. IF ALREADY CLONED BUT NOT DORMANT OR IF ANOTHER C PROGRAM (ABCPQ) ALREADY HAS THE NAME ABCLU TRY TO C CLONE AN AB.LU PROGRAM. C A. IF SUCCESS SCHEDULE AB.LU C B. FAILURE C 1. IF ORGINAL PROGRAM RP'D SCHEDULE ORGINAL. C 2. IF ORGINAL PROGRAM NOT RP'D THEN RP IT C A. IF SUCCESS SCHEDULE ORGINAL C B. IF FAILURE RETURN IER = 1 C 2. IF NO ID SEGMENTS SCHEDULE THE ORGINAL C IF ORGINAL NOT RP'D RETURN IER = 2 C 3. IF CLONING ILLEGAL IE THE DON'T COPY BIT IS C SET, THEN SCHEDULE THE ORGINAL. C C C C C C C SUBROUTINE XQPRG(IDCB,ICD,IPROG,IG,IBX,IL,IRTN,IER) C,92067-16125 REV.1903 781025 C C IDCB - 144 WORD DATA CONTROL BLOCK C ICD - NO ABORT SCHEDULE REQUEST CODE. EXEC 9,10,23,24 C DON'T SET THE NO ABORT BIT. I'LL DO IT. C (������þú IPROG - 5 CHARACTER ASCII PROGRAM NAME C IBX - 80 CHARACTER STRING WHICH IS PASSED TO SCHEDULED PRG C IL - LENGTH OF ACTUAL INFO BEING PASSED(+WDS,-CHARS) C IG - 5 WORD ARRAY TO BE PASSED TO SCHEDULED PROGRAM C IRTN - 5 WORD ARRAY PASSED BACK FROM SCHEDULED PROGRAM C IER - 1 WORD ERROR FLAG, AS FOLLOWS: C C C C ON RETURN : IER = 0 SUCCESS C C IER = 1 THE DUPLICATION HAS FAILED. I TRIED TO C SCHEDULE AN ABCLU AN AB.LU AND EVEN THE C THE ORGINAL ABCDE. EITHOR ALL OF THESE C NAMES WERE TAKEN BY A DIFFERENT PROGRAM C OR ABCLU AND/OR AB.LU WERE ALREADY CLONED C AND BUSY AND THE ORGINAL ABCDE CAN'T BE C RP'D. IF YOU GET THIS ERROR JUST ISSUE C A ' DUPLICATE PROGRAM ERROR ' MESSAGE C AND FORGET IT. C C IER = 2 SYSTEM OUT OF ID SEGMENTS. I EVEN TRIED C TO SCHEDULE THE ORGINAL PROGRAM BUT IT C WAS BUSY OR NOT RP'D INTO THE SYSTEM. C C IER = 3 PROGRAM NOT FOUND. IE I COULDN'T FIND IT C ANYWHERE ON LU 2 OR LU 3 OR ANYPLACE. C C IER = 4 OPEN ERROR. I WENT OUT TO LU2 OR LU3 C TO FIND THE PROGRAM & DID INDEED FIND IT. C HOWEVER, WHEN I WENT TO OPEN THAT FILE TO C CREATE THE ID SEGMENT AN FMP ERROR OCCURED. C THE ERROR WILL BE IN THE IRTN(1) PARAMETER. C C IER = 5 CLOSE ERROR. FOUND THE PROGRAM ON THE DISC C BUT WHEN I CLOSED THE FILE AN FMP ERROR C :‰������þú OCCURED. THE ERROR WILL BE IN IRTN(1). C C IER = 6 CHECKSUM ERROR. THE PROGRAM WAS FOUND ON C THE DISC BUT WITH A CHECKSUM ERROR. THE C PROGRAM WAS PROBABLY NOT LOADED ON THIS C SYSTEM. C C IER = 7 THIS PROGRAM CAN'T BE COPIED. SO I TRIED C TO SCHEDULE THE ORGINAL BUT IT EITHOR C COULDN'T BE FOUND OR WAS BUSY. C C IER = 8 THE PROGRAM ABORTED ABNORMALLY OR PASSED C BACK A 100000B AS THE 1ST RETURN PARAMETER C VIA THE SUBROUTINE PRTN. C C IER = 9 THE EXEC CALL FAILED. THIS SHOULD NEVER C HAPPEN. C DIMENSION IDCB(144),IBX(40),IRTN(5),INAME(3),IPROG(3),IG(5) C C IKVT(IERP) = 2H00 + (IERP/10*256) + MOD(IERP,10) C C C SET A FEW FLAGS C NOID = 0 I100 = 0 LU = LOGLU(LU) CALL LUTRU(LU,LUX) LUX = IKVT(LUX) C C THE LANGUAGE TO INVOKE IS IPROG(1) AND OUR TERMINAL C ASCII LU IS IN LUX. SO GET THE NAME NEED FOR THE CLONE. C C INAME(1) = IPROG(1) INAME(2) = IAND(IPROG(2),77400B) + LUX/256 INAME(3) = IAND(LUX,377B) * 256 + 40B C C C ************************************ C * CLONE AN ID SEG * C ************************************ C 1 CALL CLONE(IDCB,IPROG,INAME,IPRGID,INAMID,IERRR,IFMPER) IRTN(1) = IFMPER C C C IERRR = 1 SUCCESS C IERRR = 2 ALREADY CLONED BUT NOT DORMANT C IERRR = 3 DUPLICATE PROG NAME (NOT THE SAME PROG) C IERRR = 4 SYSTEM OUT IF ID SEGS C IERRR = 5 NO SUCH PROGRAM C IERRR = 6 FMP OPEN ERROR C IERRR = 7 FMP CLOSE ERROR C IERRR = 8 CHECKSUM ERROR. P„‘������þúROG NOT LOADED ON THIS SYS C IERRR = 9 THIS PROG CAN'T BE COPIED C IERRR = 10 ILLEGAL PROGRAM NAME C C GO TO (1000,100,100,150,5030,5040,5050,5060,250,200)IERRR C C AT THIS POINT WE KNOW THAT THE ORGINAL CLONE REQUEST C DIDN'T WORK. EITHOR THE NAME IS BEING USED BY A DIFFERENT C PROGRAM OR THE SAME PROGRAM HAS ALREADY BEEN CLONED AND C BUT THAT PROGRAM IS BUSY. SO TRY A XX.LU NAME. IF THAT DOESN'T C WORK TRY TO USE THE ORGINAL. IF THAT DOESN'T WORK JUST FORGET IT. C C 100 IF(I100 .EQ. 1) GO TO 200 I100 = 1 INAME(2) = IOR(IAND(INAME(2),377B),27000B) GO TO 1 C C NO ID SEGS SEE OF ORGINAL IN MEMORY C 150 IF(IPRGID .EQ. 0) GO TO 5020 GO TO 250 C C C NAME I CAME UP WITH DIDN'T WORK. SO TRY THE C ORGINAL. C 200 IF(IPRGID .NE. 0) GO TO 250 C C ORGINAL NOT RP'D SO RP IT. C CALL CLONE(IDCB,IPROG,IPROG,IPRGID,IPRGID,IERRR,IFMPER) GO TO (250,250,5010,5020,5030,5040,5050,5060,250,5010) IERRR C C 250 INAME(1) = IPROG(1) INAME(2) = IPROG(2) INAME(3) = IPROG(3) NOID = 1 C C************************************************************************** C OK WE DID IT LETS INVOKE THE LANGUAGE C 1000 CALL EXEC(ICD+100000B,INAME,IG(1),IG(2),IG(3),IG(4),IG(5) 1 ,IBX,IL) C C************************************************************************* C GO TO 5000 1001 CALL ABREG(IA,IB) IF(IB .NE. 0) CALL RMPAR(IRTN) IF (NOID.EQ.0) CALL IDRPD(INAME,IERX) IF(IRTN .EQ. 100000B) GO TO 5080 C C SUCCESS !!!!!!!!!!! C IER = 0 RETURN C C C C ************************************* C * ERRORS * C ************************************* C C 5000 IF(NOID .EQ.0) CALL IDRPD(INAME,IERX) IER = 9 RETURN 5010 IER = 1 RETURN 5020 IER = 2 RETURNáˆ����� 5030 IER = 3 RETURN 5040 IER = 4 RETURN 5050 IER = 5 RETURN 5060 IER = 6 RETURN 5070 IER = 7 RETURN 5080 IER = 8 RETURN END END$ ��������������������������������������������������������������������������FÜ������ÿÿ����� ���� ÿý�•� Ÿ ���������ÿ��92067-18464 1903� S C0122 �&CLONE � � � � � � � � � � � � � �H0101 ‚ˆ�����þúFTN4,L SUBROUTINE CLONE(IDCB,OLDNAM,NEWNAM,OLDID,NEWID,IER,IFMPER) C,92067-16125 REV.1903 790420 INTEGER IDCB(144),OLDNAM(3),NEWNAM(3),OLDID C C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C NAME: CLONE C SOURCE: 92067-18464 C RELOC: 92067-16125 C PGMR: C.M.M. C C C C C THE CLONE SUBROUTINE IS CALLED TO DO WHATEVER IT TAKES TO CLONE C AN ID SEGMENT. C C C C ON RETURN : IER = 1 SUCCESS C C IER = 2 THE PROGRAM YOU NAMED WAS ALREADY CLONED AND C HAS AN ID SEGMENT. HOWEVER, THAT PROGRAM C IS BUSY. THAT IS IF YOU WISH TO C RUN IT USE THE EXEC 23 OR 24. ALTERNATELY C IF YOUR SURE YOU KNOW WHAT YOUR DOING C ABORT THE PROGRAM (OF,XXXXX,1) AND THEN C YOU CAN SCHEDULE IT. ALTERNATELY YOU C MIGHT PICK A DIFFERENT NAME ,SAY XX.LU, C AND TRY THAT NAME. HOWEVER, KEEP IN MIND C THAT THE SESSION ALREADY HAS ONE CLONE OF C THE PROGRAM. C C IER = 3 DUPLICATE PROGRAM NAME. THAT IS THE NAME C YOU GAVE ME IS ALREADY IN THE SYSTEM AND C IS NOT A CLONE OF THE PROGRAM YOU SPECIFIED C FOR EXAMPLE PROGRAM ABCDE IS WHAT YOU C WISHED CLONED TO ABCLU. HOWEVER, A PROGRAM C ÁH������þú CALLED ABCPQ HAS ALREADY BEEN CLONED TO C ABCLU. C WHAT YOU MIGHT WANT TO DO AT THIS POINT IS C PICK A DIFFERENT NAME AN TRY THIS SUBROUTINE C AGAIN. WHY DON'T YOU CALL IT AB.LU . IF C THAT DOESN'T WORK YOU COULD TRY SCHEDULING C THE ORGINAL PROGRAM. RECALL THAT THE C ID ADDRESS OF THE ORGINAL PROGRAM IS C RETURNED, IF IT IS 0, THEN YOU CAN CALL THIS C SUBROUTINE TO RP THE ORGINAL PROGRAM. IF C THAT DOESN'T WORK YOU ARE S.O.L. ISSUE A C 'DUPLICATE PROGRAM ERROR MESSAGE & FORGET C IT. C C IER = 4 SYSTEM OUT OF ID SEGMENTS. YOU MIGHT TRY C TO SCHEDULE THE ORGINAL IF IT'S IN MEMORY. C REMEMBER I RETURN THE ORGINAL'S ID ADDRESS C IF HE IS IN MEMORY. C C IER = 5 PROGRAM NOT FOUND. IE I COULDN'T FIND IT C ANYWHERE ON LU 2 OR LU 3 OR ANYPLACE. C C IER = 6 OPEN ERROR. I WENT OUT TO LU2 OR LU3 C TO FIND THE PROGRAM & DID INDEED FIND IT. C HOWEVER, WHEN I WENT TO OPEN THAT FILE TO C CREATE THE ID SEGMENT AN FMP ERROR OCCURED. C THE ERROR WILL BE IN THE IFMPER PARAMETER. C C IER = 7 CLOSE ERROR. FOUND THE PROGRAM ON THE DISC C BUT WHEN I CLOSED THE FILE AN FMP ERROR C OCCURED. THE ERROR WILL BE IN IFMPER. C C IER = 8 CHECKSUM ERROR. THE PROGRAM WAS FOUND ON C Ô������þú THE DISC BUT WITH A CHECKSUM ERROR. THE C PROGRAM WAS PROBABLY NOT LOADED ON THIS C SYSTEM. C C IER = 9 THIS PROGRAM CAN'T BE COPIED. THAT IS IT C WAS LOADED WITH THE DON'T COPY OPTION. C C IER = 10 ILLEGAL PROGRAM NAME. IE WHO DO YOU THINK C YOU KIDDING WITH A PROGRAM NAME LIKE THAT. C C C C*********************************************************************** C C C C OK CLEAR OUT A FEW WORDS C IFMPER = 0 NEWID = 0 C C SEE IF THE ORGINAL PROGRAM IS RP'D C OLDID = IDSGA(OLDNAM) IF(OLDID.EQ.0) GO TO 500 CALL IDDUP(OLDNAM,NEWNAM,IERX) GO TO 600 C C WELL THE PROGRAM ASKED FOR WAS NOT IN MEMORY SO LETS SEE IF C WE CAN FIND IT ON THE DISC. C C C 500 CALL OPEN(IDCB,IFMPER,OLDNAM,1,0,-2) IF(IFMPER .EQ. -6) CALL OPEN(IDCB,IFMPER,OLDNAM,1,0,-3) IF((IFMPER .EQ.-6).OR.(IFMPER.EQ. -32)) GO TO 1050 IF(IFMPER .LT. 0) GO TO 1060 C C WE FOUND IT ! SO DUPLICATE THE ID. C CALL IDRPL(IDCB,IERX,NEWNAM) CALL CLOSE(IDCB,IFMPER) C IF (IFMPER .LT.0) GO TO 1070 C 600 IF (IERX .EQ. 0) GO TO 999 C C WE SEEM TO HAVE A PROBLEM C 700 IF (IERX .EQ. 19) IER = 8 IF (IERX .EQ. 14) IER = 4 IF (IERX .EQ. 23) IER = 3 IF (IERX .EQ. 17) IER = 9 IF (IERX .EQ.-15) IER = 10 C C YOU LOSE TURKEY !!!!!!!!!!!!! C RETURN C 999 IER = 1 NEWID = IDSGA(NEWNAM) IF(IAND(IXGET(NEWID + 15),7) .NE. 0) IER = 2 C C SUCCESS !!!!!!!!!!!!!!!!!!!!!!!! C RETURN C C 1050 IER = 5 RETURN 1060 IER = 6 RETURN 1070 IER = 7 RETURN END END$ ����������������������������������������������������������������������������������������ôõ����������������������������������ÿÿ����� ���� ÿý�–�Ÿ ���������ÿ��92067-18465 1903� S C0122 �&CLERR � � � � � � � � � � � � � �H0101 ‡‹�����FTN4,L C C NAME: CLERR C SOURCE: 92067-18465 C RELOC: 92067-16104 C PGMR: C.M.M. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C SUBROUTINE CLERR(I,L,LU),92067-16104 REV.1903 790203 C C C CLERR IS THE ERROR POSTING ROUTINE FOR COMPL & CLOAD C IT REPORTS THE ERROR CODE PASSED INTO THE SUBROUTINE C IN PARAMETER ' I ' TO THE LU PASSED IN ' LU '. C THE ' L ' PARAMETER IS USED TO SEPERATE CLOAD FROM C COMPL. C L = 0 MEANS PROGRAM CLOAD C C DIMENSION IERMG(8) DATA IERMG/2H/C,2HLO,2HAD,2H: ,2HCL,2H- ,2H ,2H / C IKVT(IERR) = 2H00 + (IERR/10*256) + MOD(IERR,10) C C 1 IF(L .EQ. 0) GO TO 100 IERMG(2) = 2HOM IERMG(3) = 2HPL C 100 IERMG(7) = IKVT(I) CALL EXEC(2,LU,IERMG,7) CALL PTERR(IERMG(5),IER) RETURN END END$ ������c¨������ÿÿ����� ���� ÿý�—� ���������ÿ��92067-18466 1903� S C0122 �&DVR31 � � � � � � � � � � � � � �H0101 sx�����þúASMB,R HED DVR31 RTE MOVING HEAD DRIVER * * NAME: DVR31 * SOURCE: 92067-18466 * RELOC: 92067-16466 * PGMR: G.A.A. J.S.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVR31,0 92067-16466 REV.1903 790314 ENT I.31,C.31 EXT $UPIO,.MVW EXT $TB31 TBXX EQU $TB31 * * * * THIS DRIVER OPERATES UNDER THE CONTROL OF * THE I/O CONTROL MODULE OF THE REAL-TIME EXECUTIVE. * THIS DRIVER IS RESPONSIBLE FOR CONTROLLING DATA * TRANSMISSION WITH A MOVING HEAD TYPE DISC FILE. * * THIS DRIVER MAKES THE MOVING HEAD DISC APPEAR TO * HAVE 64 WORD SECTORS, HOWEVER SPEED IS IMPROVED * IF THE DRIVER DOES NOT HAVE TO DO THIS PROCESSING. * * THIS IS DONE BY ALWAYS STARTING A READ REQUEST ON AN * EVEN SECTOR AND BY ENDING WRITE REQUESTS WITHIN. * ODD SECTORS. * * * ALL DATA TRANSFER IS DONE UNDER DMA CONTROL. * THE USER SPECIFIES TRACK AND SECTOR AND * LENGTH OF EACH REQUEST. * * ERROR RETRY PROCEDURE : THE DRIVER SEEKS 202 AND * 0 FOR EACH ERROR DETECTED. THE DRIVER THEN * RETRIES THE OPERATION. THE USER MAY SPECIFY * CYCLIC CHECKING BE DONE ON WRITE REQUESTS * BY SETING SUBFUNCTION BIT 8 IN THE WRITE REQUEST. * A FAILED CYCLIC CHECK WILL CAUSE THE WRITE TO BE * RETRIED UP TO TEN TIMES. * * * SPECIAL SYSTEM REQUESTS: A GROUP OF TRANSFERS * MAY BE SPECIFIED BY AN INTERNAL SYSTEM * REQUEST (VIA <XSIO>). THIS REQUEST HAS THE * SPECIAL FORMAT: * * (EQ T7,I) 'CONTAINS A POINTER TO A GROUP OF * 3 OR 4 WORDS CONTAINING THE BUFFER ADDRESS(WORD 1), * LENGTH(WORD 2)îY������þú AND TRACK/SECTOR(WORD 3 OR IF SIGN * BIT IS SET ON WORD 3 THEN IT IS THE SECTOR (THE SIGN * IS STRIPED) AND WORD FOUR IS THE TRACK) ADDRESS FOR * EACH TRANSFER. THE GROUP OF TRANSFER VECTORS IS * OPEN-ENDED AND IS TERMINATED BY A ZERO-WORD. * ALL TRANSFERS ARE MADE BEFORE A COMPLETION * RETURN TO <CIC> IS MADE. SKP RWSUB NOP READ/WRITE ROUTINE ENTRY * E = 0 WRITE * E = 1 READ * * B = BUFFER ADDRESS * A = -LENGTH IN WORDS * * * STB UBUF SAVE BUFFER ADDRESS. STA LN.N SAVE LENGTH LDB TRACK GET THE TRACK AND BLF,BLF COMBINE WITH ADB UNIT THE UNIT CPB LTRUN SAME AS IN LOCAL BUFFER? LDB BM10 YES; B_-8. LDA HDSC CHECK THE HEAD SECTOR CPA LHDSC SAME AS IN LOCAL BUFFER? INB YES; !_B+1 LDA LN.N UNDER 129 WORDS SEZ,RSS IF WRITE JMP WRT1 GO DO WRITE TESTS * ADA D128 REQUESTED? CPB BM7 ALL CONDITIONS MET? SSA MET? JMP RD2 NO; GO READ * LDA LBUFA YES; SET FOR MOVE CPA UBUF IF DATA IS WANTED IN LOCAL JMP CLE BUFFER CLE AND RETURN * STA LBUFP SET UP FOR LDA LN.N MOVE LDB UBUF JSB MOVE AND MOVE DATA CLE CLE SET E FOR CONTINUATION JMP RWSUB,I RETURN * B40 EQU CLE * * * RD2 LDB UBUF READ; TO LOCAL CPB LBUFA BUFFER? STA LHDSC SHOW LOCAL SECTOR BUFFER ENPTY WRT1 SSB,RSS IF SAME TRACK JMP WRIT DIFFERENT TRACK SKIP * ADA D128 AND REQUEST TO WRITE MORE THAN 128 CLE,SSA,RSS WORDS OR CPB BM7 TO WRITE ON LOCAT SECTOR STB LHDSC YES; SET TO SHOW NONE IN WRIT LDA TRACK SET FOR SEEK JSB SEEK SEEK RECORã˜������þúD LDB RDCM GET THE READ COMMAND SEZ,CME,RSS READ? LDB WRCM NO - USE WRITE COMMAND ADB UNIT SET UNIT BITS CLCC5 CLC CMND PRESET THE COMMAND CHANNEL OTBC2 OTB CMND SEND COMMAND TO THE CONTROLLER LDB UBUF GET BUFFER ADDRESS SEZ,RSS ADB ADDCM AND SET DIRECTION BIT STFD STF DATA SET UP THE INTERFACE SSB FOR THE STCD1 STC DATA,C TRANSFER LDA DMAC GET THE DMA CONTROL WORD DMASW NOP DMA SWITCH NOP IF CHAN #6 ELSE RSS JMP CHAN6 CHANNEL SIX; GO DO IT. * OTA 7 CHANNEL 7; SEND CONTROL WORD CLC 3 SET FOR BUFFER OTB 3 SEND BUFFER ADDRESS LDA LN.N GET LENGTH STC 3 SET FOR LENGTH OTA 3 SEND IT. STC 7,C START DMA STCC1 STC CMND,C START DISC CLC 7 INHIBIT DMA INTERRUPT JSB WAITI GO WAIT FOR INTERRUPT STF 7 FOURCE DMA COMPLETION LIA 3 SAVE DMA RESIDUE. JMP CHAN7 GO TO DO STATUS * CHAN6 OTA 6 CHANNEL SIX; CLC 2 SAME OTB 2 IDEA LDA LN.N AS STC 2 ABOVE. OTA 2 STC 6,C STCC2 STC CMND,C CLC 6 JSB WAITI STF 6 LIA 2 * CHAN7 JSB STAT DO STATUS JMP WRIT ERROR; RETRY * LDA UBUF WAS XFER TO LOCAL BUFFER CPA LBUFA ? RSS JMP RWSUB,I NO; RETURN * LDA HDSC UPDATE THE STA LHDSC LOCAL BUFFER LDA TRACK GET THE CURRENT TRACK ALF,ALF TO HIGH A ADA UNIT COMBINE WITH UNIT STA LTRUN SET TRACK/UNIT WORD JMP RWSUB,I RETURN * * TRACK NOP DMAC OCT 120000 HDSC NOP LHDSC OCT -1 LTRUN NOP LN.N NOP UBUF NOP RDCM OCT 20000 READ COMMAND WRCM OCT 10000 WRITE COMMAND D128 DEC 128 BM7 OCT -7 * * * SEEK NOP SEEK ROUTIÒ–������þúNE * 1. SEEK RECORD WHOSE TRACK IS * IN A, UNIT HDSC * 2. KEEP LAST TRACK FLAG AND * DO ADDRESS RECORD IF SAME * TRACK/UNIT. CLCC2 CLC CMND CLEAR COMMAND. OTAD1 OTA DATA SEND CYLINDER NO. STCD2 STC DATA,C TO DATA CARD. LDB UNIT GET THE UNIT ADB LSTB ADD THE LAST SEEK TABLE ADDRESS STB CYL SAVE THE LAST SEEK ADDRESS LDB SEEKC GET THE SEEK COMMAND CPA CYL,I SAME AS LAST TIME? ADB ADDCM YES ADD THE ADDRESS COMMAND BIT ADB UNIT SET UNIT BITS OTBC1 OTB CMND SEND COMMAND STCC3 STC CMND,C START SEEK STA CYL,I SET LAST SEEK FLAG FOR NEXT TIME SWP WAIT SERVAL MORE CYCLES LDB HDSC GET THE HEAD AND SECTOR SFSD1 SFS DATA DATA READY? JMP NRERR NO; TAKE NOT READY EXIT * OTBD1 OTB DATA SEND HEAD/SECTOR INFO STCD3 STC DATA,C TELL CONTROLLER JMP SEEK,I RETURN * SEEKC OCT 30000 SEEK COMMAND LSTB DEF *+1 ADDRESS OF LAST SEEK TABLE OCT -1,-1,-1,-1 CYL NOP ADDRESS OF LAST SEEK FLAG FOR CURRENT UNIT. * * IGNOR STA EQT15,I ZERO TIME OUT JSB STATW DO STATUS JMP IGNO2 IGNOR THE RESULT * * * * * WAITI SUBROUTINE * A: SAVE E * B. IF FIRST EXIT SEND ACCEPT CODE * C. ELSE DO CONTINUATION RETURN * D. ON INTERRUPT SAVE RETURN * ADDRESS * E. NOT INTERRUPT FOR NEXT ENTRY * F. RESTOR E AND RETURN WAITI DEF IGNOR ELB B_E STB MOVE SAVE E CLA SET A FOR OPERATION INITIATED STA RTNCR������þúD SET RETURN CODE TO SHOW COMPLETION AFTER INTERRUPT IGNO2 ISZ C.XX STEP TO CONTINUATION RETURN JMP C.XX,I RETURN TO RTIOC * * * C.XX NOP INTERRUPT ENTRY FROM RTIOC LDB MOVE RESTORE E-REG. ERB JMP WAITI,I RETURN TO CONTINUE PROSSING * RTNCD OCT 4 ADDCM OCT 100000 HEAD NOP UNIT NOP * * * * STATUS CHECK SECTION * STATUS SHOULD BE RETURNED IMMEDIATELY. * IF IT IS NOT A NOT READY RETURN IS MODE * THE ERROR COUNTER IS RESET FOR EACH CORRECT * STATUS. * THE STATUS WORD IN THE E QT IS SET AS FOLLOWS * 0 - ANY ERROR * 1 - DATA ERROR * 2 - SEEK CHECK (ADDRESS A NON-EXISTANT TRACK) * 3 - FLAGGED CYLINDER (3 AND 4 IMPLIES DEFECTIVE) * 4 - ADDRESS ERROR (3 ALONE IMPLIES WRITE PRO.) * 5 - END OF TRACK (DATA TOO LONG) * 6 - NOT READY (POWER, SERVO, MECHANICAL) * * * A WRITE PROTECT OR FLAGED CYLINDER ERROR WILL * FOURCE A PARITY ERROR RETURN * NOT READY WILL FOURCE A NOT READY RETURN * * OVERRUN WILL FORCE THE STATUS ROUTINE TO RETRY * THE TRANSFER AN INFINITE # OF TIMES. * * OTHER ERRORS WILL CAUSE THE STATUS ROUTINE TO * RETRY THE TRANSFER UP TO TEN TIMES. * * STAT NOP STA SEEK SAVE DMA RESIDUE. JSB STATW DO STATUS COMMAND STA STATW SAVE THE STATUS AND B377 MASK TO 8 BITS IOR B IN WITH THE NEW STA EQT5,I SET IT IN THE TABLE. B30 SLA,ALS ANY ERRORS JMP ANALZ YES; GO ANALIZE * LDA SEEK GET DMA RESIDUE AND CME,SZA RETRY IF NONZERO. JMP STAT,I ISZ STAT NO; LDB BM12 STB ERCTR RESET COUNTER RTRY CME JMP STAT,I RETURN * * STATW NOP CORE Sâ4������þúTATUS ROUTINE CLCC3 CLC CMND CLEAR THE CHANNEL STCD4 STC DATA,C SET UP DATA CHANNEL. LDB UNIT SEND DRIVE UNIT LIAC1 LIA CMND GET THE ATTENTION BITS IF ANY SZA,RSS ANY SET ?? JMP OTBC3 NO GO USE THE CURRENT UNIT * CLB YES SET TO FIND IT ULOOP SLA,RAR TEST THE BITS JMP OTBC3 FOUND ONE GO DO IT * INB STEP B AND JMP ULOOP GO TRY AGAIN * OTBC3 OTB CMND TO COMMAND CHANNEL. STCC5 STC CMND,C START STATUS. LDA EQT5,I GET STATUS WORD AND B1774 OUT WITH THE OLD SWP B SAVE IN B(ALSO DELAY). SFSD2 SFS DATA IF NOT BACK JMP NRERR THEN GO TO NOT READY. * LIAD1 LIA DATA GET STATUS. RAL,ARS SET 15 IF 14 IS SET SSA,RSS FIRST STATUS?? JMP STATW,I RETURN TO ANALIZE STATUS * STA LHDSC SHOW NO SECTOR IN CORE LDB I.XX WAS THE DRIVER DOWNED BY US?? SZB,RSS YES IF ZERO SO JMP $UPIO GO UP IT * LDB RTNCD WHO HAS CONTROL? SZB,RSS IGNORE IF C.XX ENTRY JMP IGNO2 ELSE IGNOR THE INTERRUPT * LDA SEEKC ELSE SET UP CONTROLER FOR OTAC2 OTA CMND ANOTHER STATUS STCC6 STC CMND,C AND THEN JMP CLCC3 GO REDO THE STATUS * * ANALZ LDB STATW GET THE SAVED STATUS WORD RBR,BLR CLEAR SIGN AND LEAST BITS CPB B10 IF WRITE PROTECT RSS OR CPB B30 BAD CYLINDER FLAG SET JMP PARER ISSUE PARITY ERROR * LSR 6 IF NOT SLB,RBR READY? JMP NRERR ISSUE NOT READY ERROR. * * * IT MAY BE POSSIBLE TO RECOVER * SO RETRY * * ALF,SLA IF STILL SEEKING JMP SKCK1 GO WAIT FOR ATTENTION * CPB B100 IF OVERRUN, THEN JMP RTRY TRY AN INFINITE # OF TIMES. * ISZ ERCTR STEP COUNT CLA,CME,RSS IF NOT LAST RETRY SKIP JM‚ ������þúP PARER ELSE ISSUE PARITY ERROR * ISZ CYL,I RBR,SLB SEEK CHECK?? JMP STAT,I YES RETRY NOW * JSB SEEK SEEK 0 SKCK1 JSB WAITI GO WAIT FOR INTERRUPT JSB STATW DO CORE STATUS REQUEST JMP STAT,I TAKE RETRY EXIT. * B400 OCT 400 B1774 OCT 177400 B377 OCT 377 BM12 OCT -12 ERCTR OCT -12 D202 DEC 202 EQT# DEC 1 SET ON FIRST ENTRY * * NRERR CLA,INA NOT READY -SET A=1 -POST INTERRUPT CLB SET BEEN STB I.XX HERE FLAG LDB RTNCD GET THE RETURN CODE SZB,RSS IF ZERO DO COMPLETION EXIT JMP COMEX * ISZ C.XX PARER LDA B3 A_3 ERROR RETURN COMEX LDB EQT9,I COMPLETION RETURN STA RTNCD SET THE RETURN CODE JMP NRRTN AND TAKE THE CENTRAL EXIT * * B3 OCT 3 LBUFA DEF BUF BUFA EQU LBUFA * * MOVE NOP MOVE SUBROUTINE * ENTER WITH A = -COUNT * B = DESTINATION/SOURCE * E = 1 FROM LOCAL BUF * E = 0 TO LOCAL BUF * LBUFP = LOCAL BUFFER ADD * FOR THIS MOVE CMA,INA SET COUNT POSITIVE STA COUNT SET COUNTER LDA LBUFP GET LOCAL BUFFER ADDRESS SEZ,RSS IF FROM USER BUFFER SWP SWAP THE ADDRESSES. JSB .MVW GO MOVE THE WORDS DEF COUNT NOP JMP MOVE,I NO; RETURN. * * LBUFP NOP COUNT NOP SKP * THE TRIPLET PROCESSOR TAKE SYSTEM OR USER * GENERATED TRIPLETS AND TRANSLATES THEM * INTO READ, WRITE, AND MOVE REQUESTS * * CALLING SEQUENCE: * * EQT8 NEG REQUEST LENGTH IN WORDS * EQT9 SYSTEM TRACK NUMBER (NOT ACTUAL) * EQT10 SYSTEM SECTOR NUMBER (NOT ACTUAL) * EQtÂ������þúT11 REQUEST BUFFER ADDRESS. (SIGN BIT SET FOR READ) * * * $TB30 IS UESE TO TRANSLATE THE SYSTEM TRACK TO * AN ACTUAL UNIT AND CYLINDER NUMBER. * THE FORMAT IS: * * WORDS 1 TO 8 THE NUMBER OF TRACKS ON * UNITS 0-7 * WORDS 9 TO 16 THE FIRST TRACK ON UNITS * 0-7 * CONSTANTS FOR TIPLT * BM10 OCT -10 TB31A DEF TBXX MXSIZ NOP MAX NO OF WORDS PER TRACK #SECT DEC 96 SECTOR PER TRACK************ * * * * TIPLT DLD EQT9,I GET TRACK AND SECTOR ADDRESSES INA,SZA,RSS ** IF -1 DONT REJECT JMP CK02 * LDA EQT9,I GET TRACK # SSA,RSS IF EITHER IS NEGATIVE SSB THEN JMP REJCT GO REJECT THE CALL * RRL 6 SECTOR * 64 CMB,INB SET NEGATIVE ADB EQT8,I ADD THE NO OF WORDS IN XFER ADB MXSIZ SUBTRACT FROM MAX WORD COUNT SSB TRACK WRAP AROUND? JMP REJCT YES GO REJECT THE REQUEST * CK02 LDA BM12 SET ERROR COUNTER STA TPER FOR 10 TRIES * * LDA EQT6,I GET REQ CODE AND B2200 SZA JSB $SPCL IF SUBFUNC NOT= 0 SPECIAL TIPRT LDA SUBCH GET THE SUBCHANNEL ADA TB31A ADD THE TABLE ADDRESS LDB A,I GET THE FIRST TRACK TO B ADB EQT9,I ADD THE ADDRESSED TRACK STB TRACK SAVE THE TRACK ADDRESS ADA B10 STEP TO THE NUMBER OF TRACKS ADDRESS LDB A,I GET THE NUMBER OF TRACKS LDA EQT9,I ** GET TRACK# INA,SZA,RSS IF -1 RETURN LAST TRACK JMP EOT * * LDA B SET IN B FOR POSSIBLE REJECT CMA,INA NEGATE THE NUMBER ADA EQT9,I ADD THE ADDRESSED TRACK NUMBER SSA IF POSITIVE THE ERROR JMP TIP0 NEGATIVE SO OK - CONTINUE * EOT LDA EQT5,I SET THE IOR B40 END OF TAPE BIT IN THE STATUS ƒ������þú STA EQT5,I EQT STATUS WORD * * LDA EQT6,I GET REQ CODE SLA,RSS IF WRITE RETURN JMP NRRTN * LDA EQT7,I STA UBUF SET ADDRESS LDA #SECT STA UBUF,I * JMP NRRTN EXIT ERROR * TIP0 LDB EQT8,I BRING IN THE STB TPLN LENGTH LDB EQT11,I AND THE STB TPBUF BUFFER ADDRESS LDB SUBCH GET THE SUBCHANNEL CLA,CLE SET A FOR AN ODD SUBCHANNEL SLB,RSS IF EVEN INA RESET A FOR HEAD 2 LDB EQT10,I GET THE BRS ACTUAL SECTOR STB MOVE YES SAVE ADB NSEC IS IT ON THE ODD SSB,RSS SIDE OF THE DISC STB MOVE YES RESET ELA MOVE IN THE SECOND HEAD BIT ALF,ALF ROTATE HEAD TO BITS 8-9. STA HEAD SET HEAD WORD ADA MOVE ADD THE SECTOR STA HDSC SAVE FOR ADDRESS STA CHDSC AND FOR CYCLICK CHECK. * * LDA TPLN PRESET A FOR EVEN SECTOR LDB EQT10,I GET SECTOR CCE,SLB,RSS IF EVEN JMP TPNXT JUMP * LDB BUFA ELSE READ LDA DM128 128 WORDS TO JSB RWSUB LOCAL BUFFER LDA HLBUF SET MOVE BUFFER STA LBUFP ADDRESS LDB TPLN GET LENGTH ADB B100 LESS 64 LDA TPLN USE MIN OF REQUEST CLE,SSB AND LDA BM100 6 4 LDB TPBUF GET ADDRESS ELB,RBR CLEAR SIGN & SET READ/WRITE JSB MOVE GO MOVE THE WORDS. LDA DM128 SET TO WRITE LDB BUFA THE SECTOR SEZ,RSS WRITE REQUEST? JSB RWSUB YES; WRITE IT OUT. LDA BM100 UP DATE POINTERS TPA CMA,INA TO REFLECT STA MOVE LAST TRANSFER ADA TPBUF ADJUST BUFFER ADDRESS STA TPBUF LDA MOVE ADA B100 ROUND UP THE COUNT CLB CLEAR B FOR SHIFT LSR 7 oZ������þú SHIFT TO GET SECTOR COUNT ADA HDSC ADD TO THE CURRENT SECTOR STA HDSC SAVE FOR NEXT ACCESS AND B377 MASK TO SECTOR ONLY ADA NSEC SIDE TWO? IOR HEAD SET UP THE HEAD BITS IOR B400 SET SIDE TWO BIT SSA,RSS IF SIDE TWO STA HDSC RESET THE HEAD SECTOR ADDRESS LDA TPLN GET THE LENGTH ADA MOVE SUBTRACT THE NUMBER XFERED CLE,SSA,RSS IF NONE LEFT CHECK JMP CYCK FOR CYCLIC CHECK * STA TPLN SAVE LENGTH TPNXT LDB TPBUF GET BUFFER ADDRESS CLE,SSB READ? JMP TPRD YES; GO TRANSFER REST OF RECORD * ADA B100 NO; MORE THAN 64 WORDS LEFT CCE,SSA,RSS ? JMP TPB NO; GO TRANSFER LAST WORDS * LDA TPLN YES; TEST FOR MORE THAN LESS THAN AND B100 64 WORDS MOD 128 LEFT STA B SAVE FLAG ADA TPLN GET LENGTH TO SET FOR X-FER CLE,SZB IF LESS THAN 64 MOD 128 LEFT AND DM128 DELETE EXCELL OVER EVEN SECTORS LDB TPBUF GET BUFFER ADDRESS TPRD ELB,RBR SET READ/WRITE FLAG JSB RWSUB DO THE TRANSFER. LDA LN.N GET THE LENGTH AND JMP TPA GO UP DATE THE POINTERS * * TPB LDA DM128 WRITE OF LAST 64 WORD IN LDB BUFA FIRST HALF OF SECTOR STB LBUFP SET UP JSB RWSUB AND READ THE SECTOR LDA TPLN SET UP TO LDB TPBUF MOVE THE USER WORDS JSB MOVE GO MOVE TO THE BUFFER LDA DM128 WRITE THE BUFFER OUT AGAIN. LDB BUFA AGAIN JSB RWSUB * * * CYCK LDA EQT6,I REQUEST FOR CYCLIC AND B2002 CHECK CPA B2002 AND WRITE RSS YES SKIP JMP EOXF NO- RETURN * LDA CHDSC SET THE HEAD/SECTOR FOR STA HDSC SEEK LDA TRACK GET TRACK FOR SEEK JSB SEEK LDB EQT8,I CALCULATE THE CMB,INB Žn������þú NUMBER LDA EQT10,I OF B10 SLA SECTORS TRANSFERED ADB B100 START ODD - ADD 64 TO COUNT ADB B177 ROUND UP TO NEXT HIGHER SECTOR LSR 7 SECTOR COUNT TO B LDA CHCKC GET CHECK COMMAND ADA UNIT SET UNIT BITS CLCC4 CLC CMND PRESET THE COMMAND CHANNEL OTBD2 OTB DATA SEND SECTOR COUNT STCD5 STC DATA,C TO DATA OTAC1 OTA CMND SEND COMMAND STCC4 STC CMND,C START CHECK JSB WAITI GO WAIT CLA JSB STAT DO STATUS RSS RSS BAD - SKIP JMP EOXF O-K RETURN * ISZ TPER STEP COUNTER JMP TIPRT TOO MANY? - NO TRY AGAIN * JMP PARER YES; TAKE PARITY ERROR EXIT. * * * HLBUF DEF BUF+64 TPLN NOP TPBUF NOP TPER NOP CHCKC OCT 60000 CYCLIC CHECK COMMAND CHDSC NOP SUBCH NOP B100 OCT 100 DM128 DEC -128 BM100 OCT -100 NSEC NOP B7 OCT 7 * * REJCT CLA,INA ILLEGAL CALL SO REJECT JMP I.XX,I IT * * * D65 DEC 65 B5 OCT 5 B2200 OCT 2200 .TB31 NOP * * * * * $SPCL NOP CPA B2200 RSS JMP $SPCL,I LDA SUBCH ADA TB31A STA .TB31 LDA EQT10,I CPA B5 RSS JMP REJCT * LDA EQT8,I ADA D65 SZA JMP REJCT LDA EQT8,I CMA,INA STA COUNT LDB EQT7,I LDA .TB31 JSB .MVW DEF COUNT NOP * LDB EQT8,I JMP NRRTN SKP * INITIATOR ENTRY POINT I.XX NOP JMP CONFI CONFI CLEARS THIS WORD * LDA RSS SET UP LDB CHAN THE DMA SLB,RSS CHANNEL CLA SWITCH STA DMASW NOP IF CHANNEL 6, RSS IF 7. CCA ADA I.XX SET RETURN STA C.XX ADDRESS LDA B4 SET THE RETURN CODE STA RTNCD LDA EQT4,I GET THE UNIT RRR 6 FROM THE EQT AND ‰0������þúB7 MASK TO UNIT NUMBER STA SUBCH SET THE SUBCHANNEL CLE,ERA SHIFT TO THE UNIT STA UNIT SET THE UNIT JSB STATW CHECK TO MAKE SURE DISC IS READY RRR 6 SHIFT THE READY BIT SLA READY?? JMP NRERR NO GO TAKE NOT READY EXIT * LDA EQT6,I GET AND ISOLATE AND B3 THE REQUEST CPA B3 CONTROL? CLA,INA,RSS YES; SET FOR REJECT AND SKIP JMP OK NO; CONTINUE * JMP NRRTN GO NOT READY REJECT. * OK LDA BM12 RESET STA ERCTR THE ERROR COUNTER LDA EQT6,I GET THE REQUEST CODE SYS2 LDB EQT7,I GET BUFFER ADDRESS SSA SYSTEM REQUEST? JMP SYS YES; GO DO SYSTEM THING. * LNTS LDA EQT6,I GET THE CON WORD AGAIN RAR,CLE,ELA SET READ WRITE BIT RBL,ERB SET SIGN OF BUFFER ADDRESS TO SHOW DIRECTION STB EQT11,I AND SAVE FOR TIPLT CALL LDA EQT8,I GET THE LENGTH. STA EQT12,I SAVE FOR EXIT SSA,RSS MAKE NEGATIVE CMA,INA,RSS WORDS ARS AND STA EQT8,I SAVE B2002 SZA IF ZERO SKIP CALL JMP TIPLT CALL FOR X-FER * EOXF LDA EQT6,I GET REQUEST CODE SSA SYSTEM JMP SYS2 YES; GO GET NEXT TRIPLET * DONE LDB EQT12,I NO; DONE; GET TLOG CCE,SSB SET POSITIVE CMB,INB IF NEG. NRRTN LDA DIGNO GET THE DUMMY INTERRUPT ADDRESS STA WAITI AND SET IT. LDA RTNCD GET RETURN CODE (0 OR 4) CPA B4 IF 4 ISZ C.XX BUMP RETURN (DID -1 ON IT ABOVE) JMP C.XX,I ELSE JUST EXIT * DIGNO DEF IGNOR * SYS STB MOVE SYSTEM TRIPLET PROCESSOR INB STEP TO THE ADDRESS OF LDA B,I LENGTH AND STORE IT IN STA EQT8,I THE EQUIPMENT TABLE INB STEP TO THE DISC ADDRESS LDA B,I GET THE ADDRESS RAL,CLE,SLA,ERA þ‰������þúIF SIGN BIT SET THEN INB,RSS THIS IS A PURE SECTOR ADDRESS AND B177 MASK THE SECTOR AND STA EQT10,I AND SET IT IN THE EQT XOR B,I GET THE TRACK ADDRESS ALF,ALF ROTATE TO LOW A RAL SEZ IF FULL WORD TRACK LDA B,I USE FULL WORD STA EQT9,I AND SET IN THE EQT INB STEP TO ADDRESS OF NEXT TRIPLET STB EQT7,I AND SET IT IN THE EQT LDB MOVE,I GET THE BUFFER ADDRESS SZB IF ZERO THEN DONE JMP LNTS GO DO THE TRANSFER. * * LDA RTNCD GET THE RETURN CODE SZA,RSS IF ZERO- JMP DONE GO RETURN * LDA UNIT GET THE ADA LSTB LAST TRACK SEEKED ON LDA A,I THE CURRENT UNIT AND JSB SEEK SEEK SAME CYL. JSB WAITI GO WAIT FOR A INTERRUPT JMP DONE EXIT * * B4 OCT 4 B177 OCT 177 SKP BUF BSS 128 LN EQU * ORG BUF CONFI STA B SAVE THE SELECT CODE IOR OTA CONFIGURE STA OTAD1 ALL XOR B4000 THE STA OTBD1 I/O STA OTBD2 INSTRUCTIONS XOR B5100 STA STCD1 STA STCD2 STA STCD3 STA STCD4 STA STCD5 XOR B5000 XOR B4400 STA SFSD1 STA SFSD2 XOR B0600 STA LIAD1 XOR B0400 STA STFD XOR B221. STA DMAC INA NOW THE COMMAND CHANNEL XOR B226. STA OTAC1 STA OTAC2 XOR B4000 STA OTBC1 STA OTBC2 STA OTBC3 XOR B5100 STA STCC1 STA STCC2 STA STCC3 STA STCC4 STA STCC5 STA STCC6 XOR B5000 STA CLCC2 STA CLCC3 STA CLCC4 STA CLCC5 XOR B4200 STA LIAC1 CLB FIND LDA EQTA THE EQT CMA,INA NUMBER ADA EQT1 FOR THE UP REQUEST÷���T��RN DIV .15 INA AND STA EQT# SET IT CLA CLEAR THE JUMP TO STA I.XX+1 THIS ROUTINE LDA TB31B GET THE ADDRESS OF THE TABLE ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,SLA,ERA JMP *-2 STIL INDIRECT GO GET NEXT LEVEL * LDB A,I GET THE FIRST WORD OF THE TABLE CMB,SSB,INB,RSS SET POSITIVE IF NEG SKIP IF IT WAS POSITIVE INA,RSS IT WAS NEGATIVE SO STEP THE TABLE ADDRESS LDB SECTR IT WAS POSITIVE SO USE THE BASE PAGE SECTOR COUNT STA TB31A SET THE TABLE ADDRESS BRS,BRS ADDJUST TO NO. SECTORS PER SIDE CMB,INB SET NEGATIVE AND STB NSEC SET FOR THE DRIVER CMB,INB FIND THE BLF,BLF MAX NO STB MXSIZ OF WORDS PER TRACK AND SET JMP I.XX+1 * TB31B DEF TB31A ADDRESS OF THE TABLE ADDRESS OTA OTA 0 B221. OCT 22100 B226. OCT 22600 B4000 OCT 4000 B5100 OCT 5100 B5000 OCT 5000 B4400 OCT 4400 B0600 OCT 0600 B0100 OCT 0100 B0400 OCT 0400 B4200 OCT 4200 .15 DEC 15 TEST EQU LN-* ERROR HERE MEANS THE CONFIGURE ROUTINE * I TOO LONG. . EQU 1650B EQTA EQU . EQT1 EQU .+8 EQT4 EQU EQT1+3 EQT5 EQU EQT1+4 EQT6 EQU EQT1+5 EQT7 EQU EQT1+6 EQT8 EQU EQT1+7 EQT9 EQU EQT1+8 EQT10 EQU EQT1+9 EQT11 EQU EQT1+10 EQT12 EQU .+81 EQT15 EQU .+84 CHAN EQU .+19 I.31 EQU I.XX C.31 EQU C.XX CMND EQU 0 DATA EQU 0 A EQU 0 B EQU 1 SECTR EQU .+71 LNPG EQU LN DRIVER LENGTH END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������«ØT������ÿÿ����� ���� ÿý�˜�« ���������ÿ��92067-18467 1903� S C0122 �&DVR33 � � � � � � � � � � � � � �H0101 tz�����þúASMB * * NAME: DVR33 * PART NO. SOURCE: 92067-18467 * PART NO. RELOCATABLE: 92067-16467 * PRMR: B.B J.S.W *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * NAM DVR33 92067-16467 REV.1903 781027 * *.* IDENTIFICATION * * NAME: HP 12732A FLOPPY DISC RTE DRIVER * * MNEMONIC: DVR33 *.* PRODUCT USE * * * * DVR33 PROVIDES THE SOFTWARE INTERFACE BETWEEN THE RTE USER * * AND THE HP 12732A FLOPPY DISC SUBSYSTEM. THE SUBSYSTEM USES * * THE HP 9885M FLOPPY DISC. ACCESS TO THE DRIVER IS ACHIEVED * * THROUGH STANDARD EXEC CALLS USING THE DUAL CHANNEL PORT * * CONTROLLER (DCPC). UP TO FOUR DRIVES MAY BE CONNECTED TO ONE * * CONTROLLER. DVR33 SUPPORTS ONE CONTROLLER IN A SYSTEM. THE * * 12733A IS THE DRIVE (NO CONTROLLER) SUBSYSTEM AND CONSISTS * * OF A HP 9885S FLOPPY DISC DRIVE. *.* FUNCTIONAL SPECIFICATIONS *.* INPUT/OUTPUT INTERFACE * * DVR33 INTERFACES WITH THE HP 9885M FLOPPY DISC VIA TWO * * MODIFIED MICROCIRCUIT CARDS. THESE CARDS HAVE BEEN MODIFIED * * BY CHANGING THE PULL UP RESISTORS ON THE INPUT AND OUTPUT * * CIRCUITS TO MORE CLOSELY MATCH THE HP 9885M CONTROLLER INTERFA * * * * ONE CARD IS USED FOR DATA COMMUNICATION (12735-60002) WHILE * * THE OTHER IS THE CONTROL CARD (12735-60001). * * * * THE CARDS ARE ELECTRICALLY THE SAME EXCEPT FOR STRAPPING: * * * * STRAP POSITION (12735-60001) POSITION (12735-60002) * * W1 A A * * W2 B A * * W3 B B * * W4 B B * ;²������þú* W5 IN IN * * W6 IN IN * * W7 IN IN * * W8 OUT IN * * W9 B B * * * * THE TWO IO CARDS ARE CONNECTED TO THE HP 9855M VIA A 12735-600 * * INTERFACE CABLE. * * *.* READ/WRITE DATA * * * * CALLING SEQUENCE: * * * * JSB EXEC * * DEF RTRN * * DEF RCODE �� * * DEF CONWD * * DEF BUFFR * * DEF BUFFL * * DEF DTRAK * * DEF DSECT * * * * RTRN . (RETURN POINT) * * RCODE DEC1 OR 2 (REQUEST CODE 1=READ 2=WRITE) * * CONWD OCT CONWD (CONTROL WORD. SEE BELOW) * * BUFFR (BUFFER STARTING ADDRESS) * * BUFFL BSS N (WORDS IF +, CHAR. IF -) * * DTRAK DEC F (DECIMAL TRACK NO.) * * DSECT DEC G (DECIMAL SECTOR NO.) (0-58, EVEN SECTORS ONLY * * I.E., 0-2-4-6). * * * * THERE ARE 128 WORDS PER SECTOR, 30 SECTORS PER TRACK (0-58) * * (EVEN SECTORS ONLY), AND 67 TRACKS MAXIMUM (0-66). THE * * NUMBER OF TRACKS AVAILABLE WILL VARY FROM ONE DISKETTE TO * * ANOTHER DEPENDING ON HOW MANY BAD TRACKS WERE FOUND DURING * * FORMATTING WITH THE PROGRAM DSKET (SEE 5.0). THIS NUMBER IS * * WRITTEN IN WORD 1 OF TRACK 0, SECTOR 0 AND IS RETURNED * * IN THE B REG. WHEN A R/W REQUEST WITH TRACK>66 IS MADE. ONLY * * EVEN SECTORS ARE ALLOWED TO BE COMPATIBLE WITH THE RTE II * * FMGR. * * * * CONWD * * BITS 0-5 = LOGICAL UNIT NUMBER OF FLOPPY DRIVE * * BITS 6-10 * * 30 = READ WITH CLOSE TOLERANCE. THIS MODE MAY BE * * USED FOR READ AFTER WRITE (USER PROGRAMMED) * * WHERE THE FUTURE RECOVERY OF DATA IS VERY * * IMPORTANT. THIS MODE WILL CAUSE THE FLOPPY * * CONTROLLER TO PERFORM ADDITIONAL CHECKS IN * * THE READ FUNCTION. * * 23 = DSECT CONTAINS INFORMATION FOR FORMATTIN,L������þúG DISC. * * THIS IS A "HOOK" PUT INTO THE DRIVER FOR USE BY * * A DISC FORMAT PROGRAM "DSKET". IT IS NOT * * --- * * INTENDED THE BELOW SPECIAL CALLS BE DOCUMENTED * * FOR USER OPERATION BECAUSE OF THE POSSIBILITY * * OF DAMAGING THE HARDWARE AND/OR ACCIDENTALLY * * "WIPING OUT" INFORMATION OF THE DISKETTE. * * DSECT FUNCTION * * 7630 STEP TRACK IN * * 7640 WRITE ALL ZEROS (FOR DEFECTIVE TRACK) * * * * * * 0 FORMAT TRACK CONTAINED IN DTRACK * * * * DVR33 IS INTIALLY ENTERED THROUGH I.33. THE RETURN CONDITION * * IS INDICATED BY THE A REGISTER: * * * * A=0=OPERAYTION INITIATED * * 1=ILLEGAL READ/WRITE * * * * AN A=1 EXIT WILL OCCUR IN THE BELOW CONDITIONS: * * * * 1. SPECIFY NEGATIVE TRACK NUMBER * * 2. SPECIFY ODD OR NEGATIVE SECTOR * * 3. SPECIFY SECTOR > 58 * * 4. SPECIFY NON-EXISTENT TRACK N(0<N<67). * * THIS CAN OCCUR IF BAD TRACKS EXIST WHICH * * REDUCE THE NUMBER OF AVAILABLE TRACKS. TO * * DETERMINE THE NUMBER OF TRACKS ON A PARTICULAR * * DISKETTE, A READ/WRITE REQUEST WITH A TRACK>66 * * WILL RETURN THE NUMBER OF TRACKS IN THE B * * REGISTER. THEREFORE MAXIMUM TRACK NUMBER IS * * (B REGISTER-1). * * 5. WRITE TO TRACK 0, SECTOR 0. THIS ADDRESS IS * * RESERVED FOR USE BY DVR33. * * WORD 1 = NO. OF AVAILABLE TRACKS (1-67) * * WORD 2 = NO. OF REVOLUTIONS TO READ ONE TRACK. * * 6. ATTEMPT TO WRITE MORE SECTORS THAN ARE AVAILABLE ON THE * * DISKETTE. FOR EXAMPLE, IF THERE ARE ONLY 2 SECTORS LEFT * * ON THE LAST TRACK AND THE CURRENT REQUEST IN TO WRITE * * 512 WORDS (4 SECTORS). * * * * A=2=ILLEGAL CONTROL. ONLY VALID CONTROL REQUEST IS DYNAMIC STA~½������þúT * * AND RESET (0) * * A=3=EQUIPMENT MALFUNCTION OR NOT READY. CHECK FOR POWER ON. * * * * SUBSEQUENT INTERRUPTS CAUSE AN ENTRY AT C.33. IF THE OPERATIO * * IS NOT COMPLETED EXIT IS THROUGH CONTINUATION P+2. THE * * REGISTERS ARE NOT SIGNIFICANT. IF THE OPERATION IS COMPLETED, * * EXIT IS THROUGH CONTINUATION P+1 WITH RETURN CONDITION IN THE * * A AND B REGISTERS. * * * * A=0=SUCCESSFUL COMPLETION * * 1=DEVICE MALFUNCTION. THIS EXIT IS FOR SPURIOUS INTERRUPTS * * (UNEXPECTED INTERRUPTS WITH NO REQUEST IN PROCESS). * * THIS EXIT IS ALSO USED FOR CONTROLLER/DRIVE ERRORS. * * SEE STATUS WORD FOR CAUSE. * * 3=TRANSMISSION ERROR. THIS EXIT IS FOR THE BELOW ERRORS: * * 1. RECORD NOT FOUND * * 2. TRACK NOT FOUND * * 3. DATA CHECKWORD ERROR * * 4. DATA OVERRUN * * 5. TRANSFER INCOMPLETE * * FOR NORMAL READS 10 TRIES ARE MADE BEFORE TRANSMISSION * * ERROR EXIT IS TAKEN. FOR READ WITH CLOSE TOLERANCE * * (CONWD=30) 1 TRY IS MADE. * * 4=TIME OUT. THIS EXIT IS TAKEN IF AN EXPECTED INTERRUPT * * DOES NOT OCCUR WITHIN 5 SECONDS. PRIOR TO TAKING THIS * * EXIT, DVR33 RESETS (HEADS GO TO TRACK 0) THE 9885M/9885S. * * B=# OF WORDS OR CHARACTERS TRANSMITTED (DEPENDING ON USER * * REQUEST) * * *.* STATUS REQUEST * * * * CALLING SEQUENCE: * * * * JSB EXEC * * DEF RTRN * * DEF RCODE * * DEF LUN * * DEF STAT1 * * DEF STAT2 * * * * RTRN . (RETURN POINT) * * . * * . * * RCODE DEC13 (REQUEST CODE FOR STATUS) * * LUN DEC N (DECIMAL LOGICAL UNIT # OF DISC) * * STAT1 BSS 1 (STORAGE FOR STATUS WORD EQT5) * * STAT2 BSS 1 (STORAGE FOR EQT WORD 4)(OPTIONAL) * * * * THIS CALL RETURNS THE LAST ACCESSED DRIVE'S STATUS WORD (WORD * * OF THE EQUIPMENT TABLE) IN STAT1. * * * * BITS 8-15 ARE AS DEnK������þúSCRIBED IN THE RTE MANUAL. BITS 0-7 CONTAI * * THE HARDWARE STATUS. SEE TABLE 1. * * * * WORD 4 OF THE EQT (AS DEFINED IN THE RTE MANUAL) IN STAT2 IF * * IT IS CODED. * * * * TABLE 1 * * I/O STATUS WORD BITS * * --------------------- * * * STATUS IS RETURNED PER BELOW: * * * * BITS 0-6 MEANING OCTAL VALUE * * 0000000 NO ERROR 0 * * 0000011 NO DRIVE POWER 3 * * 0000101 DOOR OPEN 5 * * 0000111 NO DISC 7 * * 0001011 RECORD NOT FOUND 13 * * 0001101 TRACK NOT FOUND 15 * * 0001111 DATA CHECKWORD ERROR 17 * * 0010001 DATA OVERRUN 21 * * 0010011 READ CLOSE TOL. ERROR 23 * * 0011111 TRANSFER INCOMPLETE 37 * * * * BITS 0-7 * * 00100000 END OF TRACK 40 * * 01000000 DISC CHANGE 100 * * 10000000 DISC WRITE PROTECTED 200 * RETURNS OF 3, 5, AND 7 CAUSE A NOT READY (A=1) EXIT. * * * 13, 15, 17, 21, 37 CAUSE A PARITY ERROR (A=3) EXIT AFTER 10 TR * TRACK NO. IS IN B REGISTER. * 13, 15, 17 INDICATE A MEDIA PROBLEM (I.E., SCRATCHED SURFACE), * POSSIBLE HARDWARE MALFUNCTION. ERRORS 21 AND 37 INDICATE A HARDWA * MALFUNCTION * * * 23 CAUSES A SUCCESSFUL EXIT (A=0) AFTER 1 TRY.. TRACK NO. IS * B REGISTER. THEREFORE WHEN USING A READ WITH CLOSE TOLERANCE, IT * IMPORTANT THE STATUS AFTER EACH READ BE CHECKED FOR 23 IN EQT 5. * IF THIS OCCURS, THE DATA MAY STILL BE RECOVERABLE WITH A STANDARD * READ REQUEST. * * * (OCTAL 40) IS SET WHEN AN ATTEMPT IS MADE TO READ/WRITE * A TRACK >66. THE NUMBER OF TRACKS IS RETURNED IN THE B * WITH A REG. = 0. * (OCTAL100) IS SET WHEN A NEW DISC HAS BEEN INSŠ˜������þúERTED OR * POWER TURNED ON SINCE THE LAST REQUEST OR RESET JUST PERFORMED. * * * (OCTAL 200) IS SET IF THE WRITE PROTECTED NOTCH ON THE * DISK IS NOT COVERED. * * *.* CONTROL REQUEST * * * * CALLING SEQUENCE: * * * * JSB EXEC * * DEF RTRN * * DEF RCODE * * DEF CONWD * * * * RTRN (RETURN POINT) * * RCODE DEC3 (REQUEST CODE FOR CONTROL) * * CONWD * * BITS 0-5=LOGICAL UNIT NUMBER OF FLOPPY DRIVE * * BITS 6-10 * * 0=RESET CONTROLLER. ALL DRIVES ARE RESET WITH * * HEADS MOVING TO TRACK 0. RESET IS ALSO DONE AT POWE * * 6=DYNAMIC STATUS. CURRENT STATUS OF SELECTED LU * * RETURNED IN EQT5. * * * * * * * * * * * * *.* OPERATING SPECIFICATIONS * * *.* HARDWARE * * * * MINIMUM RTE SYSTEM WITH DCPC * * HP 12732A FLOPPY DISC DRIVE SUBSYSTEM (MASTER) * * HP 12735-60001 MICROCIRCUIT CARD (CONTROL) INTERFACE 1 * * HP 12735-60002 MICROCIRCUIT CARD (DATA) INTERFACE 2 * * INTERFACE CABLE (DUAL HOOD, LENGTH 15') HP 12735-60003 * * * * OPTIONAL: * * * * HP 12733A FLOPPY DISC DRIVE SUBSYSTEM (SLAVE) * * (3 SLAVES MAY BE CONNECTED TO ONE MASTER) * * SLAVE CABLE IS 6'. * * *.* SOFTWARE INSTALLATION * * *.* PROGRAM INPUT PHASE * * * * DRIVER DVR33 MUST BE LOADED DURING THIS PHASE * * *.* TABLE GENERATION PHASE * * * * *EQUIPMENT TABLE ENTRY * * * * A. EQUIPMENT TABLE ENTRY (EQT) FOR THE FLOPPY DISC CONTROLLER * * SC1,DVR33,D, * * WHERE SC1 IS THE SELECT CODE OF THE CONTROL CARD (HIGHER * * PRIORITY), AND "D" INDICATES DMA REQUIRED. * * * * B. DEVICE TABLE ENTRY * * * * *DEVICE REFERENCE TABLE * * LU=EQT,M,SUB * * WHERE LU IS THE LOGICAL UNIT NUMBER OF DRIVE, M IS THE EQT * * NUMBER, AND SUB IS THE DRIVE SUBCHANNEL NUMBER (0-3). * * THIS SAME NUMBER IS SET AS THE DRIVE NUMBÓk������þúER ON THE REAR OF * * 9885M/S. * * * * C. INTERRUPT TABLE ENTRY FOR THE FLOPPY DISC * * * * *INTERRUPT TABLE * * * * SC1,EQT,M * * SC2,EQT,M * * * * WHERE SC2 IS THE SELECT CODE OF THE DATA CARD (LOWER PRIOR *.* REFERENCES * * * * RTE II SOFTWARE SYSTEM P.N. 92001-93001 * * ------ ---------------- * * * * HP 12732 FLOPPY DISKETTE SUBSYSTEM P.N. 12732-90003 * * * * *.* FLOPPY DISKETTE FORMAT PROGRAM DSKET * * * * PRIOR TO USING A NEW DISC, IT IS NECESSARY TO FORMAT IT BY * * WRITING TRACK AND SECTOR ADDRESSES ON THE DISC. THIS IS * * DONE BY THE PROGRAM DSKET. * * * * ANOTHER FUNCTION OF DSKET IS TO IDENTIFY BAD TRACKS AND * * "MARK" THEM AS SUCH. DSKET IS A RELOCATABLE PROGRAM WHICH * * USES DVR33 FOR DISC COMMUNICATION. * * * * TO RUN DSKET PROCEED PER BELOW: * * * * 1. LOAD DSKET * * * * 2. TYPE RU,DSKET,X * * WHERE X=LU OF TERMINAL DSKET IS CONTROLLED FROM * * 3. DSKET RESPONDS: * * ENTER DRIVE LU? * * TYPE IN THE DISKETTE DRIVE LU * * 4. DSKET RESPONDS: * * DO YOU REALLY WANT TO FORMAT THIS DISKETTE? * * * * THIS QUESTION IS ASKED TO PREVENT ACCIDENTAL ERASURE * * OF VALUABLE INFORMATION. FORMATTING A DISKETTE ERASES AL * * DATA. * * * * IF THE OPERATOR RESPONDS YES THEN DSKET CONTINUES. FOR * * ANY OTHER RESPONSE DSKET ENDS. * * * * AFTER RESPONDING WITH YES, DSKET ASKS: * * * * STANDARD FORMAT? * * * * THIS QUESTION REFERS TO THE NUMBER OF REVOLUTIONS IT * * WILL TAKE TO READ AN ENTIRE TRACK. IF YES THEN FIVE * * REVOLUTIONS (1 SEC) MINIMUM IS REQUIRED TO READ A TRACK. * * * * BETWEEN CONSECUTIVE SECTORS THERE ARE 4 "FILL" SECTORS. * * THE "FILL" SECTORS GIVE THE SYSTEM PROCESS TIME BEFORE * * THE NEXT REQUEST. THIS TIME IS NEEDED BECAUSE MOST * * REQqí������þúUESTS ARE ON A SECTOR (128 WORD RECORD) BASIS. FOUR * * * * FOUR "FILL" SECTORS GIVE 4 X (1/6) X (1/30)=22 MSEC * * MAXIMUM AFTER THE LAST REQUEST IS COMPLETED AND THE * * NEXT ONE IS STARTED. IF THIS TIME IS EXCEEDED, THEN * * THE DISKETTE MUST ROTATE A COMPLETE REVOLUTION * * (167 MSEC) BEFORE THAT SECTOR CAN BE READ. * * * * THESE CALCULATIONS ASSUME: * * * * 6 REVOLUTIONS/SECOND * * 30 SECTORS/TRACK * * 4 FILL SECTORS * * * * TRACK 0 WOULD BE FORMATTED PER BELOW: * * SECTOR: 0,6,12,18,24,1,7,13,19,25,2,8 * * 14,20,26,3,9,15,21,27,4,10,16,22 * * 28,5,11,17,23,29 * * * * EACH SUCCEEDING TRACK WILL BE IN THE SAME ORDER AS * * ABOVE BUT THE STARTING TRACK CHOSEN TO ALLOW A TRACK * * SWITCHING TIME OF 4 "FILL" SECTORS. THAT IS * * TRACK 1 WILL PHYSICALLY START WITH SECTOR 11 SUCH THAT * * BY THE TIME THE HEAD IS SETTLED ON TRACK 1, SECTOR 0 * * WILL BE READY TO READ. * * * * IF THE OPERATOR ANSWERS NO TO THE STANDARD FORMAT? * * -------- ------- * * QUESTION THEN ALL TRACKS WILL BE FORMATTED WITH * * SERIAL SECTORS (0,1,2, ETC.) ALLOWING 4 "FILL" SECTORS * * BETWEEN TRACKS FOR TRACK SWITCHING SETTLING TIME. * * * * IT IS ANTICIPATED MOST DISKETTES WILL BE FORMATTED * * WITH THE "STANDARD FORMAT". THIS WILL OPTIMIZE * * THROUGHPUT USING SINGLE RECORD TRANSFERS. * * * * WE ARE ALLOWING THE SERIAL FORMAT FOR THE SITUATION * * WHERE THE USER HAS A LARGE BUFFER SPACE TO MAKE * * MULTIPLE SECTOR READ/WRITE REQUESTS AND THROUGHPUT * * IS IMPORTANT (I.E., STORAGE FOR HIGH SPEED ANALOG * * TO DIGITAL CONVERTER MEASUREMENTS). BOTH FORMATS * * ARE INTERECHANGEABLE FOR READING AND WRITING. THE * * B������þú ONLY NOTICEABLE DIFFERENCE WILL BE DATA THROUGHPUT * * SPEED. * * * * DATA FOR EACH READ/WRITE REQUEST IS TRANSFERRED VIA DMA * * AT 30 KHZ. * * IF NEITHER YES OR NO IS ENTERED TO THE QUESTION, * * STANDARD FORMAT?, THEN DSKET ENDS. * * -------- ------- * * * * IF YES OR NO WAS ENTERED THEN THE DISKETTE IS * * FORMATTED. UPON COMPLETION, THE NUMBER OF GOOD TRACKS * * IS WRITTEN IN SECTOR 0, TRACK 0, WORD 1 AND THE TYPE * * OF FORMAT (STANDARD = 5, SERIAL = 1) WRITTEN IN * * WORD 2. * * * * THE INFORMATION IN WORD 1 IS NEEDED TO TELL THE FILE * * MANAGER THE LAST TRACK AS WELL AS PREVENTING THE HEAD * * FROM BANGING AGAINST THE HEAD STOP ON MULTIPLE SECTOR * * READ/WRITE. THIS COULD OCCUR IF THE DRIVER DID NOT * * KNOW THE LAST LOGICAL TRACK. * * * * THE INFORMATION IN WORD 2 CAN BE USED TO READ THE * * FORMAT TYPE. * * * * COMPLETION OF FORMATTING IS INDICATED BY THE MESSAGE: * * * * THE NUMBER OF GOOD TRACKS IS N * * - * * WHERE N=NUMBER OF GOOD TRACKS (0-67). * * * * ALL TRACKS ARE NUMBERED SERIALLY AND THE USER NEED NOT * * CONCERN HIMSELF WITH BAD TRACKS OTHER THAN TO REALIZE * * THEIR EXISTENCE LIMITS THE STORAGE CAPACITY OF THE * * DISKETTE. * * STORAGE CAPACITY = NUMBER OF GOOD TRACKS X 3840 WORDS. * * REV. 1650 ORIGINAL * REV. 1723 FIXED PRIVELEGED PROBLEM * REV. 1805 FIXED MOUNT WITH NO DISK PROBLEM * AND PRIV. WITH DMA PROBLEM * * ENT I.33,C.33 * I.33 NOP STA COMAD SAVE SELECT CODE JSB SETIO CONFIGURE IO * CLA CLR COMMAND CHANNEL STA TEMP6 JSB OUTAC * * LDA B.12 SET RETRY COUNTER OF 10 FOR NORMAL READ STA EQT12,I * E—������þúLDA EQT4,I IOR BN11 SET TO HANDLE TIMEOUT STA EQT4,I * * CLA SET FOR INITIATION ENTRY STA TEMP4 RESRT LDA EQT6,I GET CONTROL WORD AND B2303 IS THIS A REQUEST FOR A FORMAT CPA B2302 INITIALIZATION ROUTINES? JMP FIP YES! GO PROCESS * LDA EQT6,I RAR SSA,SLA IF A CONTROL REQUEST JMP CONTL THEN GO TO CONTL ** LDA EQT6,I CHECK FOR READ MAX TRACK AND B2303 CPA B2301 JMP RMXTK YES! READ MAX TRACK ** LDA EQT9,I INA,SZA,RSS JMP RMXTK * LDA EQT9,I GET TRACK NO. SSA IF NEG. THEN REJECT JMP IREJ1 REJECT WITH A =1 (ILL. R\W) ADA D.67 IF >66 THEN READ NO. OF TRACKS SSA,RSS JMP RMXTK * LDB EQT6,I REJECT IF WRITE TO TRACK 0,SECTOR 0. LDA EQT9,I THIS IS RESERVED: ADA EQT10,I WORD 1 = NO. OF TRACKS SZA,RSS WORD 2 = NO. OF REV. TO READ (FORMAT TYPE) SLB JMP ON1 JMP IREJ1 * ON1 LDA EQT10,I GET SECTOR NO. SLA IF ODD OR >58 JMP IREJ1 REJECT REQUEST (A=1 FOR ILL. R W) SSA IF NEG. THEN REJECT JMP IREJ1 ADA D.59 SSA,RSS JMP IREJ1 NEG. SECTOR LDA EQT9,I GET TRACK LDB NUTRK GET NO. OF TRACKS FOR DISKETTE CMB,INB "NUTRK" IS LAST TRACK +1 ADA B IS REQUEST WITHIN NO. OF SSA GOOD TRACKS? JMP ISTR1 IT IS OK! JMP IREJ1 OUT OF RANGE A=1 (ILLEGAL R W) * *^^^^^^^FIRST LINE OF SECOND TAPE^^^^^^^ * * D.XX IS MINUS DECIMAL XX * DXX IS PLUS DECIMAL XX * B.XX IS MINUS OCTAL XX * BXX IS PLUS OCTAL XX * BNXX IS SOME OCTAL NUMBER * B1 OCT 1 D30 DEC 30 D.59 DEC -59 D60 DEC 60 D.67 DEC -67 D128 DEC 128 D.5 DEC -5 B.12 OCT -12 B2302 OCT 2302 B2301 OCT 2301 B2303 OCT 2303 B2 OCT 2 BN13 È������þúOCT 177000 BN11 OCT 10000 RDCLS NOP =4000 IF READ WITH CLOSE TOL. TEMP6 NOP NUTRK NOP # OF TRACKS ON DISK MWORD NOP -# OF WORDS TO TRANSFER TEMP2 NOP SECTOR # DRIVE NOP DRIVE # SEEK OCT 140000 FIPCD NOP FORMAT COMMAND STORAGE DMAIN OCT 100000 DMAW1 NOP DMA WORD 1 COMAD NOP COMMAND CHANNEL DMACH NOP DMA CHANNEL * DATA DEC 67 STORE DEF DATA * * IF TRACK NO. > 66 RMXTK IS CALLED TO * READ MAXIMUM TRACK NO. STORED ON TRACK 0 SECTOR 0 * RMXTK LDA EQT6,I AND B2303 CPA B1 RSS JMP $CONT LDA D60 LDB EQT7,I STA B,I $CONT CLA STA EQT9,I SET FOR TRACK 0 STA EQT10,I AND SECTOR 0 INA STA EQT8,I READ ONE WORD LDA STORE "STORE" HAS ADDRESS OF DATA STA EQT7,I SET BUFFER ADD. TO "DATA" LDA EQT6,I SET FOR READ AND BN13 IOR B2301 SET SPECIAL CODE FOR RMXTK STA EQT6,I * * * * BEGIN R\W OPERATION * ISTR1 LDA EQT8,I GET BUFFER LENGTH SSA,RSS CONVERT TO -WORDS CMA,INA,RSS ARS STA MWORD CMA,INA STA B SW1 NOP FORMAT SWITCH =NOP JMP OVER2 IF FORMAT COMMAND THAN GOTO OVER2 * SZB,RSS IS ZERO LENGTH? JMP IREJ4 YES, IMMEDIATE COMPLETION CLB DIV D128 DIVIDE WORDS BY SECTOR SIZE SZB,RSS A=QUOTIENT B=REMAINDER JMP OVER8 WHOLE SECTOR READ ISZ TEMP6 SET TEMP6 FOR PARTIAL SECTOR INA OVER8 STA TEMP2 TEMP2 =NO. SECTORS * * BELOW CODE DETERMINES NO. OF SECTORS LEFT FROM * REQUEST ADDRESS TO END OF DISK. IT THEN COMPARES * THIS TO THE NO. SECTORS REQUIRED TO COMPLETE * THE REQUEST. IF THERE ARE NOT ENOUGH THE REQUEST * IS REJECTED. * THE ABOVE CHECK IS IMPORTANT IN THAT IT KEEPS * THE HEAD FROM FLYING REPEATEDLY INTO THE * CAST IRON STOP. * * LDA NU«M������þúTRK GET NO. OF TRACKS LDB EQT9,I GET TRACK ADDRESS CMB,INB ADA B SUBTRACT FROM NO. OF TRACKS MPY D30 MULIPLY BY NO. OF SECTORS PER TRACK * LDB EQT10,I GET STARTING SECTOR BRS CHANGE TO PHYSICAL SECTOR CMB,INB ADA B SUBTRACT FROM SECTORS AVAILABLE * * A REG. NOW HAS NO. OF SECTORS AVAILABLE * LDB TEMP2 GET NUMBER OF SECTORS REQUIRED CMB,INB MAKE NEG. ADA B SUBTRACT FROM SECTORS AVAILABLE SSA IT SHOULD NOT BE NEG. JMP IREJ1 TOO MANY SECTORS REQUIRED. JSB PWORD SEND PASSWORD * LDA TEMP6 SZA,RSS CHECK FOR PARTIAL SECTOR READ JMP OVER9 LDA B2 SET FOR PARTIAL SECTOR JSB OUTAC OVER9 LDA EQT9,I GET STARTING TRACK ALF,RAL MOVE TO POSITION 5-11 LDB EQT10,I GET LOGICAL SECTOR BRS CHANGE TO PHYSICAL SECTOR BITS 0-4 IOR B ADD TRACK (BITS 5-11) IOR DRIVE ADD DRIVE (BITS 12-13) IOR SEEK COMPLETE SEEK COMMAND (14XXXX) * JSB OUTA SEND SEEK OVER2 JSB PWORD SEND PWORD FOR R\W * LDA EQT6,I GET CONTROL WORD RAR,CLE,ELA E=IN\OUT =1\0 * LDB EQT7,I GET STARTING ADDRESS SEZ SET DMA DIRECTION BIT ADB DMAIN IN/OUT = 1/0 LDA DMAW1 GET DMA WORD ONE OCT 1000SC DMASW NOP NOP/RSS= CHAN6/CHAN7 JMP CHAN6 OTA 7 SEND WORD 1 (CONTROL WORD) CLC 3 CONTROL IS 1000SC OTB 3 SEND WORD2(BUFFER ADDRESS) BIT 15 =1 FOR IN LDA MWORD GET MINUS NO. WORDS STC 3 OTA 3 SEND WORD3(WORD COUNT) * * DMA STARTS WITH FIRST FLAG. FOR READ DVR33 HAS SENT * FIRST STC. FOR WRITE NO STC IS SENT(DMA WILL SUPPLY) * JMP ON3 * * SAME AS ABOVE BUT FOR CHANNEL 6 * CHAN6 OTA 6 CLC 2 OTB 2 LDA MWORD STíj������þúC 2 OTA 2 * ON3 LDA FIPCD GET "FORMAT" COMMAND ** CLF 0 DISABLE INTERRUPTS FOR PRIVELEGE TIMING PROBLEM ** SW2 NOP "FIP" SWITCH =NOP FOR "FORMAT" JMP OTA03 CLA,CME BITS 15-14 = R/W 00/10 ERA IOR DRIVE ADD DRIVE BITS 12-13 IOR RDCLS ADD READ CLOSE TOLERANCE IOR TEMP2 ADD RECORD COUNT BITS 0-11 SSA IF WRITE THEN SEND COMD. AT OTA03 JMP OTA03 OTA04 OTA DATCH SEND READ COMD. HERE STC04 STC DATCH CLA CLR. BI DIRECTIONAL BUS SFS02 SFS DATCH RACE CONDITION HERE BETWEEN STC04 JMP *-1 AND STC06 (12 USEC. MAX) OTA03 OTA DATCH R\W =0XXXXX\1XXXXX STC06 STC DATCH * * BELOW CODE NECESSARY TO ALLOW RTE TO * RECOGNIZE AND PROCESS THE DMA INTERRUPT * USED TO DETERMINE WHEN THE SECTOR HAS * BEEN TRANSMITTED. * STCDM STC CMDCH,C INITIATE DMA CLA CPA DUMMY BYPASS BELOW CODE IF NO PRIVILIGED JMP OUT INTERRUPT REQUIRED * CLCD1 CLC CMDCH INHIBIT DMA INTERRUPT LDB INTBA GET EQT ASSIGNED TO DMA CHANNEL LDA DMACH GET CURRENT DMA CHANNEL CPA B7 IS IT 7? INB YES LDA B,I SET BIT 15 OF ENTRY EQUAL IOR DMAIN TO 1 STA B,I STF 0 ENABLE INTERRUPT SYSTEM * OUT JSB EXIT1 JMP CLCD2 * * * EXIT1 NOP STC10 STC CMDCH ENABLE ERROR INTERRUPT LDA BN10 SET 5 SEC. TIMEOUT STA EQT15,I CLA SET FOR GOOD RETURN LDB TEMP4 FIND OUT WHICH EXIT WE SZB,RSS SHOULD JMP I.33,I TAKE. ISZ C.33 TEMP2=0/1 = I.33/C.33+2 JMP C.33,I * *<C.33> IS CONTINUATION INTERRUPT * C.33 NOP STA TEMP1 ISZ TEMP4 SET FOR CONTINUATION ENTRY * LDB EQT4,I CHECK FOR TIME OUT ENTRY BLF SSB JMP TIMOT WE HAVE TIMED OUT LDA TEMP1 GET INTERRUPT S.C. ß������þú CPA DMACH IS THIS A DMA INTERRUPT? JMP STATW YES? * CPA COMAD IS THIS AN ERROR INTERRUPT? RSS JMP ON2 NO ERROR INTERRUPT CLCD2 CLC CMDCH TURN OFF DMA INTERRUPT FOR ERROR STFDM STF CMDCH STOP DMA HANDSHAKE CLFDM CLF CMDCH CLEAR FLAG TO KILL INT. * JMP STATU * * B4 OCT 4 B3 OCT 3 B17 OCT 17 B11 OCT 11 B7 OCT 7 BN9 OCT 10017 BN10 OCT 177000 BN12 OCT 50017 BN8 OCT 177400 BN2 OCT 177600 BN7 OCT 40000 BN20 OCT 77777 * BREGX NOP AREGX NOP STATS NOP STATUS STORAGE TEMP4 NOP 0\1 = I.33\C.33 TEMP1 NOP TEMP STORAGE PASS OCT 127207 PASSWORD * * ON2 LDA EQT1,I GET QUE WORD SZA,RSS JMP CREJ1 SPURIOUS INTERRUPT * JMP EXIT1,I CONTINUE AT ADDRESS STORED HERE * * <TIMOT> RESETS CONTROLLER AND TAKES TIMEOUT EXIT * TIMOT JSB PRESA RESET CONTROLLER JMP CREJ4 TIMEOUT EXIT * * * ** STATW CLA CPA DUMMY CHECK FOR PRIV. CARD JMP STATX LDB INTBA GET MY EQT LDA DMACH GET MY DMA CPA B7 MUST CLEAR SIGN BIT ON INTBA INB OR SYSTEM WILL ISSUE ANOTHER LDA B,I "STC" WHICH WILL CAUSE FLOPPY AND BN20 TO START HANDSHAKING AGAIN STA B,I AND CLEAR CORE ** STATX LDA EQT6,I IF DMA INT. AND WRITE THEN SLA,RSS CHECK DATA FLAG JSB SKPFG * * <STATU> GETS CONTROLLER STATUS * STATU CLA JSB OUTA LIA02 LIA DATCH GET STATUS STC02 STC DATCH JSB SKPFG TELL CONTROLLER WE GOT STATUS ALF,ALF STA STATS * LDB EQT7,I IF "FPCON" REQUEST THEN GOTO CPB BN10 OVER5. DO NOT CHECK XFER COMPLETE. JMP OVER5 * AND BN12 CHECK XFER COMPLETE(BIT 14) AND NO ERROR. CPA BN7 BN12=50017,BN7=40000 . JMP ERR0 NO ERROR SZA,RSS IF ONLY XFER COMP. NOT SET (BIT 14) THEN STA TE*ô������þúMP1 TEMP1 =0. (NO OTHER ERRORS) LDA STATS JMP ERR1 * * * "STATS" LOOKS LIKE THIS * * BITS 0-3 MEANING * 0 NO ERROR * 1 NO POWER * 2 DOOR OPEN * * 3 NO DISK IN DRIVE * 4 INVALID CMD. * 5 RECORD NOT FOUND * 6 TRACK NOT FOUND * 7 DATA CHECKWORD ERROR * 10 DATA OVER RUN * 11 VERIFY ERROR * * BITS 8-9 DRIVE NO. * 10 DISK CHANGE (2000) * 11 WRITE PROTECT (4000) * 12 NOT READY (10000) * 13 SEEK COMPLETE (20000) * 14 XFER COMPLETE (40000) * OVER5 AND BN9 CHECK FOR NR AND BITS 0-3 SZA ANY ERROR JMP ERR1 YES! EXAMINE STATUS * ERR0 LDB EQT8,I CALCULATE NO. WORDS SSB OR CHAR. CMB,INB IF CHAR. MAKE POS. STB BREGX SET TRANSMISSION LOG OK1 CLA SET A REG FOR SUCCESSFUL STA AREGX COMPLETION JMP EOOP1 EXIT * ERR1 LDB EQT10,I IF STATUS REQUEST DO NOT DOWN. CPB B7740 JMP OK1 STATUS REQUEST. * AND B11 IF VERIFY ERROR DO NOT RETRY CPA B11 JMP ERR0 VERIFY ERROR THEREFORE EXIT LDA STATS AND B17 ADA D.5 IF GREATER THAN 4 WE SSA,RSS WILL RETRY FOR TRANS. JMP RETRY ERROR LDA TEMP1 CHECK FOR TRANS. INCOMPLETE SZA,RSS JMP RETRY CREJ1 CLA,INA SET FOR MALFUNCTION STA AREGX CLA STA BREGX JMP EOOP1 * * ADDRESS,CHECKWORD,OVER RUN AND VERIFY ERROR * MAY BE RECOVERABLE * * RETRY ISZ EQT12,I INCREMENT COUNTER JMP RESRT HAVE WE RETRIED 10 TIMES JMP CREJ3 YES! RECOVERY NO POSSIBLE * IREJ1 CLA,INA SET FOR ILLEGAL R/W RSS * IREJ2 LDA B2 SET FOR ILLEGAL CONTROL ‘k������þú JMP I.33,I * IREJ3 LDB B3 SET FOR NOT READY LDA EQT5,I AND BN8 IOR B SET FOR NOT READY STA EQT5,I LDA B3 RSS RSS IREJ4 LDA B4 SET FOR IMMEDIATE COMPLETION JMP I.33,I * * <CREJ3> TRANSMISSION ERROR EXIT * CREJ3 LDB EQT9,I GET TRACK IN B REG. STB BREGX LDA B3 STA AREGX JMP EOOP1 * * <PWORD> SENDS PASSWORD TO CONTROLLER * PWORD NOP JSB PSTS CHECK FOR POWER ON JSB FIRST CHECK FOR FIRST ENTRY LDB PASS GET PASSWORD 127207 OTB02 OTB DATCH STC03 STC DATCH,C SEND IT JSB SKPFG JMP PWORD,I RETURN * * <PSTS> CHECKS FOR POWER STATUS. IF OFF THEN * A "PRESET" IS DONE TO CLEAR CONTROLLER AND * IT IS CHECKED AGAIN. * PSTS NOP LIA01 LIA CMDCH SSA IF SIGN SET THEN OK JMP PSTS,I JSB PRESA RESET CONTROLLER LIA03 LIA CMDCH CHECK IT AGAIN SSA JMP PSTS,I IT IS OK NOW LDB TEMP4 CHECK FOR ENTRY SZB,RSS I.33\C.33 =0\1 JMP IREJ3 I.33 NOT READY EXIT CLB,INB STB AREGX SET FOR C.33 NOT READY LDB B3 JMP OVER6 FIRST NOP LDA EQT11,I SZA IF EQT11 =0 THEN FIRST ENTRY JMP FIRST,I ISZ EQT11,I JSB PREST RESET CONTROLLER JMP FIRST,I * * <OUTA> OUTPUTS CONTENTS OF A REG. TO DATA CH. AND WAITS * FOR FLAG * OUTA NOP OTA01 OTA DATCH,C STC01 STC DATCH,C JSB SKPFG WAIT FOR FLAG JMP OUTA,I * * <OUTAC OUTPUTS CONTENTS OF A REG. TO CMD. CH. AND DOES * NOT WAIT FOR A FLAG. * OUTAC NOP OTA05 OTA CMDCH STC11 STC CMDCH JMP OUTAC,I * * * <SKPFG> GIVES TIMED INTERRUPT RESPONSE * SKPFG NOP STC09 STC CMDCH ENABLE INTERRUPT LDB BN2 SETUP TIMER FOR 200 USEC. ISZ B IF FLAG NOT SET EXIT JMP *-1 DRIVER AND CONTINUE TO SFS01 SFS DATCH WAIT FOR INTERRUPT. qD������þú JSB EXIT1 CLF01 CLF DATCH JMP SKPFG,I * CNTL0 JSB PREST LDA B4 LDB TEMP4 CHECK FOR I.33\C.33 EXIT SZB,RSS JMP IREJ4 CLA JMP C.33,I * * CONTL LSR 5 GET CONTROL WORD IN LOWER BITS AND B37 SZA,RSS IF CODE 0 THEN ABORT AND RESET JMP CNTL0 CPA B6 ONLY VALID COMMAND IS 6 RSS JMP IREJ2 LDA B7740 LOAD STATUS COMD STA EQT10,I * * * <FIP> DOES THE PROCESSING OF SPECIAL COMMANDS USED * IN THE FORMATTING OF A DISK. IT IS ONLY CALLED * IF BITS 6-10 OF CONWD=23. EQT10 (DSECT) CONTAINS * COMMAND TO BE PROCESSED. * * * DSECT COMMAND * 0 FORMAT * 7600 STEP TRACK IN * 7630 WRITE TRACK 0 AND SECTOR 0 * 7640 WRITE DEFECTIVE TRACK * 7740 STATUS * * FIP LDA EQT10,I GET COMMAND SZA,RSS JMP FMTRK FOR FORMAT TRACK CPA B7600 JMP FPCON STEP HEAD IN CPA B7630 JMP WRMAX FOR WRITING TRACK 0, SECTOR 0 CPA B7640 JMP FPCON WRITE DEFECTIVE TRACK CPA B7740 GET STATUS JMP FPCON JMP IREJ1 ILLEGAL R\W * * * <FMTRK> USED FOR FORMATTING DISK * FMTRK LDA EQT9,I GET TRACK TO FORMAT ALF,ALS POSITION IN BITS 5-11 IOR DRIVE ADD DRIVE IN BITS 12-13 IOR FMTCD ADD FORMAT COMMAND (140036) STA FIPCD * * <FPCON> USED FOR "STEP TRACK","WRITE DEF. TRK." * AND "STATUS" * * JMP ISTR1 * * FPCON JSB PWORD SEND PASSWORD LDA EQT10,I GET COMMAND LDB BN10 SET FPCON FLAG STB EQT7,I IOR DRIVE ADD DRIVE IOR STPCD ADD OCT 140037 JSB OUTA JMP STATU * * WRMAX CLA SET FOR SECTOR 0 STA EQT10,I STA EQT9,I SET FOR TRACK 0 JMP ISTR1 * * * <PRESA> DOES NOT WAIT FOR FLAG ON RESET * THIS IS USED BY <TIMOTu¬������þú> AND <FIRST> * PRESA NOP CLB JMP OVER1 * <PREST> SETS 9885 TO POWER ON CONDITION * AND WAITS FOR FLAG * PREST NOP CLB,INB OVER1 CLA,INA DRIVE IS PRESET BY TOGGLING BIT 0 JSB OUTAC CLA JSB OUTAC SZB,RSS CHECK FOR PRESA ENTRY JMP PRESA,I JSB OUTA WAIT FOR CONTROLLER TO PROCESS PRESET JMP PREST,I * BN3 OCT 170001 BN6 OCT 103700 BN5 OCT 100077 BN4 OCT 102300 B5600 OCT 5600 B5000 OCT 5000 B4000 OCT 4000 B.1 OCT -1 B.4 OCT -4 B200 OCT 200 B1400 OCT 1400 B40 OCT 40 B300 OCT 300 B100 OCT 100 B6 OCT 6 B1000 OCT 1000 B37 OCT 37 B400 OCT 400 B7740 OCT 7740 B7600 OCT 7600 B7630 OCT 7630 B7640 OCT 7640 B2000 OCT 2000 * FMTCD OCT 140036 STPCD OCT 140037 * * <CREJ4> IS TIMEOUT EXIT * CREJ4 LDA B4 STA AREGX * * <EOOP1> IS PRIMARY DRIVER EXIT * * EOOP1 LDB B37 IF TRANSMISSION INCOMPLETE ERROR LDA TEMP1 ONLY,THE SET FOR ERROR 37 SZA,RSS JMP OVER6 * LDA STATS GET STATUS WORD ALS SHIFT 1 AND B37 ISOLATE BITS (0-4) SZA IF NO ERROR SKIP INA ERROR,SET BIT 0 STA B LDA STATS POSITION DISK CHANGE TO ALF,ALF BIT 6 AND WRITE PROTECT ALF TO BIT 7 AND B300 ISOLATE AND IOR B OR WITH ERROR BITS STA B AND STORE OVER6 LDA EQT5,I GET OLD STATUS AND BN8 IOR B MERGE NEW STATUS STA EQT5,I AND REPLACE ** LDA EQT6,I CHECK FOR RMXTK EXIT AND B2303 CPA B2301 JMP MXTEK THIS IS A MAX TRACK EXIT ** LDB BREGX GET TRANS. LOG JMP EOOP2 REQUEST COMPLETE * * STATUS IN EQT5 IS RETURNED PER BELOW: * BITS 0-6 MEANING * 0000000 NO ERROR * 0000011 NO DRIVE POWER * 0000101 DOOR OPEN * 0000111 NO DISK * ß{������þú 0001001 INVALID COMMAND * 0001011 RECORD NOT FOUND * 0001101 TRACK NOT FOUND * 0001111 DATA CHECKWORD ERROR * 0010011 READ CLOSE TOL. ERROR * 0011111 TRANSMISSION INCOMPLETE * 0100001 END OF TRACK. DATA BLOCK TOO LONG * 0010001 DATA OVER RUN * * * * BITS 0-7 * 00100000 END OF TRACK. ACCESS TRACK>66 * 01000000 DISK CHANGE * 10000000 DISK WRITE PROTECTED * * * <EOFIP> USED FOR "FIP" EXITS * MXTEK LDB DATA GET NO. OF TRACKS ON DISK LDA DRIVE ALF GET DRIVE NO. ADA ADDR FIND STORAGE ADDRESS STB A,I STORE IT FOR FUTURE USE LDA AREGX SLA IF NO ERROR RETURN SET EOT BIT 5 JMP C.33,I LDA B40 IOR EQT5,I STA EQT5,I EOOP2 LDA AREGX CHECK FOR ERROR (A NOT 0) SLA,RSS JMP C.33,I CLA JSB OUTA ERROR, SO HANDSHAKE TO AVOID ANY EXTRA LDA AREGX INTERRUPTS ON DATA CHANNEL LDB BREGX JMP C.33,I RETURN * * * * SETIO NOP INA SET FOR CONFIG. DATA CHANNEL IOR BN4 STA SFS01 SFS IS 1023XX STA SFS02 IOR B1400 STC ID 1037XX STA STC01 STA STC02 STA STC03 STA STC04 STA STC06 ADA B.1 COFIG. COMMD. CHANNEL STA STC09 CMD CH. STA STC10 STA STC11 XOR B200 LIA IS 1025XX STA LIA01 CMD CH. STA LIA03 INA STA LIA02 DATA CH. STA LIA02 XOR B400 STA CLF01 * * LDA DMA STA DMACH * * LDA STC01 OTA IS 1026XX XOR B100 STA OTA01 STA OTA03 STA OTA04 ADA B.1 STA OTA05 CMD CH. XOR B4000 INA STA OTB02 DATA CH. AND BN5 STA DMAW1 CONFIGURE DMA WORD 1 LDA BN6 IOR DMACH èW������þú STA STCDM STC,C DMACH * IOR B5000 STA CLCD1 CLC IS 1077XX STA CLCD2 * XOR B5600 STF IS 1021XX STA STFDM THIS IS STF ON DMA IOR B1000 STA CLFDM THIS IS A 1031XX(CLF) ON DMA * * LDA EQT4,I CONFIGURE DRIVE # FROM SUBCHANNEL ALF ALS,ALS AND BN3 DRIVE IN BITS 12-13 (0-3) STA DRIVE ALF ADA B.4 CHECK FOR LEGAL SUBCHANNEL SSA,RSS LEGAL IS 0-3 JMP IREJ3 NOT READY ADA B4 ADA ADDR FIND NO OF TRACKS FOR THIS DRIVE LDA A,I STA NUTRK STORE IT AT NUTRK * * CLB LDA EQT6,I IS THIS READ CLOSE TOLERANCE SLA,RSS JMP OVER4 NOT A READ AND B2000 CPA B2000 LDB BN7 OVER4 STB RDCLS 40000B LDA RSS LDB DMACH GET ASSIGNED DMA CH. SLB,RSS CH7\CH6 = RSS\0 FOR DMASW CLA STA DMASW * LDB RSS LDA EQT6,I GET CONWD AND B2302 IF "FIP" COMMAND CPA B2302 THEN SEE IF "FORMAT" RSS JMP OVER7 LDA EQT10,I SZA,RSS CLB OVER7 STB SW1 SET A "RSS" IN ALL SWITCHES FOR STB SW2 NON "FORMAT" COMMAND JMP SETIO,I * * * STORAGE FOR NO. OF TRACKS * INITIALIZED FOR 67 * MAX1 DEC 67 DEC 67 DEC 67 DEC 67 ADDR DEF MAX1 * EQU'S FOR VARIOUS ENTRIES * A EQU 0 B EQU 1 CMDCH EQU 20 DATCH EQU 21 * * SYSTEM BASE PAGE COMMUNICATION AREA * . EQU 1650B ESTABLISH ORIGIN OF EQT'S EQT1 EQU .+8 LIST POINTER EQT2 EQU .+9 I.33 ADDRESS EQT3 EQU .+10 C.33 ADDRESS EQT4 EQU .+11 SUBCHANNEL(6-10) EQT5 EQU .+12 STATUS(0-7) EQT6 EQU .+13 CONWD EQT7 EQU .+14 BUFFER ADD. EQT8 EQU .+15 BUFFER LENGTH EQT9 EQU .+16 TRACK NO. EQT10 EQU .+17 SECTOR NO.(EXCEPT IF CONWD=33) EQT11 EQU .+18 FIRST ENTRY FLAGhú���~��|x EQT12 EQU .+81 RETRY COUNTER EQT13 EQU .+82 EXIT1 RETURN EQT14 EQU .+83 TIME OUT CLOCK EQT15 EQU .+84 TIME OUT VALUE * DMA EQU .+19 CURRENT DMA CHANNEL INTBA EQU .+4 FWA OF INTERRUPT TABLE DUMMY EQU .+55 ADDRESS OF PRIVILEGED IO CARD * * ORG * END ��������������������������������������������������������©ü~������ÿÿ����� ���� ÿý�™�³ ���������ÿ��92067-18469 1903� S C0122 �&T5IDM � � � � � � � � � � � � � �H0101 f›�����þúASMB,R,Q,C HED TYPE 5 ID MANAGER FOR RTE II,III & IV * NAM T5IDM,3,40 PRE REL 780224 (MOS) * NAM T5IDM,3,40 09570-16539 REV. A 761013 * NAM T5IDM,3,40 PRE RELEASE REV. C 780720 (RTE IV) NAM T5IDM,131,40 92067-16469 REV.1903 790222 * * *-------------------------------------------------------- * * RELOC. 09570-16539 * SOURCE 09570-18539 * * M. SPANN 24 MAR 77 REV. B * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY,1976. * ALL RIGHTS RESERVED.THE INFORMATION CONTAINED ON * THIS MEDIUM MAY BE USED WITH ONLY ONE COMPUTER * AT A TIME.IT SHALL NOT OTHERWISE BE RECORDED, * TRANSMITTED,OR STORED IN A RETRIEVAL SYSTEM. * COPYING OR OTHER REPRODUCTION WITHOUT PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY IS PROHIBITED, * EXCEPT THAT ONE COPY MAY BE MADE AND RETAINED FOR ARCHIVE * PURPOSES ONLY. * * --------------- * * THE INFORMATION CONTAINED ON THIS MEDIUM IS PROPRIETARY * TO HEWLETT-PACKARD COMPANY. IT MAY BE USED WITH ONE * COMPUTER ONLY AND IS NOT TO BE DISCLOSED TO ANY THIRD * PARTIES OR REPRODUCED IN ANY FORM EXCEPT THAT IT MAY BE * TRANSFERRED TO ONE BACKUP COMPUTER DURING A COMPUTER * MALFUNCTION OR DURING PREVENTIVE MAINTENANCE. * *--------------------------------------------------------- ENT T5IDM EXT EXEC,PRTN,NAM..,$OPSY EXT RMPAR,OPEN,CLOSE,FSTAT EXT IDSGA,IDRPD,$LIBR,$LIBX EXT DTACH,$CL1,$CL2 * FOR SESSION MONITOR * A EQU 0 B EQU 1 KEYWD EQU 1657B XEQT EQU 1717B BPA3 EQU 1744B TATSD EQU 1756B SECT2 EQU 1757B SECT3 EQU 1760B SUP SKP TSIZE EQU 1270 ROOM FOR 254 ENTRIES PNTR NOP TABLE - 5 HPNTR NOP MPNTR NOP BPNTR NOP TPNTR NOP TABLE EQU * START OF TABLE UNL REP TSIZE DEC -1 LST TEND DEF * END OF TABLE + 1 TBLA DEF PNTR TABLE - 5 TBLAD DEF TABLGo������þúE RROBN DEF TEND-5 ROUND ROBIN POINTER CRN# NOP NUMBER OF DISC LU'S CRN NOP TOP OF STACK OF DISC LU'S * DCB BSS 144 DCB SYSID EQU DCB ORG DCB LDA $CL2 CALCULATE THE LAST SECTOR NUMBER OF ADA D2 :CL ON SYSTEM DISC STA TEMP SAVE FOR LATER JSB EXEC GO READ THE :CL OF THE DISC DEF *+7 DEF D1 DEF PRC2 SYSTEM DISC DEF SYSIA DEF D128 DEF $CL1 :CL TRACK DEF TEMP & 2ND. SECTOR LDA SYSIA+125 GET SYSTEM SETUP CODE STA SYSUP AND SAVE FOR LATER USE CLA EXIT TO NEVER RETURN STA SYSI1 JMP SYSI1 SYSIA BSS 128 ORR DUMY EQU DCB+16-SYSIA ERROR HERE MEANS YOUR IN TROUBLE ORR NAME BSS 4 NAME OF ROOT SEGMT NUM NOP # OF SEGMTS TEMP NOP TEMPORARY STORAGE EFLAG NOP ERROR FLAG IERR NOP FOR FMGR CALLS NAME2 NOP FATHER'S NAME NOP NOP NOP ENTR# NOP NUMBER OF SEGMENTS REMAINING+1 BUFF EQU DCB BUFFER FOR CATRIDGE LIST SEARCH TAIL NOP TEMPORARY IDBUF BSS 35 BUFFER FOR HEADER RECORD ID EQU IDBUF-1 DID12 DEF ID+12 DID23 DEF ID+23 * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 SEGT EQU D5 D6 DEC 6 D11 DEC 11 D12 DEC 12 D14 DEC 14 D15 DEC 15 B17 EQU D15 B20 OCT 20 D20 DEC 20 D23 DEC 23 D28 DEC 28 D35 DEC 35 B40 OCT 40 B77 OCT 77 B177 OCT 177 HBIT OCT 100 B200 OCT 200 D128 EQU B200 B220 OCT 220 B377 OCT 377 DBLNK OCT 20040 OM20 OCT -20 OM360 OCT -360 OM200 OCT -200 MASK OCT 177400 DM1 DEC -1 DM3 DEC -3 * ***************************************************** UNL PRC OCT 74000 PRC2 OCT 74002 SKP LST * * ! T5IDM INTERNAL CIRCULAR LINKED LIST STRUCTURE ! * * LIST POINTER BACK/FWD * NAME1 ŒI������þú N/A * NAME2 M/E * NAME/TYPE A/T * DISC WORD 27TH WRD OF ID * * CALLING SEQUENCE * * :RU,T5IDM,FN,AM,E,#IDS,CRN * ***************************************************** * * TEST PROGRAM SHOWS PARAMETER PASSING TO SEGMENT *FTN,L * PROGRAM TEST1 * DIMENSION IP(5),ITESTA(3) * DATA ITESTA/2HTE,2HST,2HA / * CALL RMPAR(IP) * CALL CLOVL(ITESTA,IP) * STOP 0 * END * PROGRAM TESTA(5) * DIMENSION IP(5) * CALL RMPAR(IP) * WRITE (1,100) IP * 100 FORMAT ("THE INPUT PARAMETERS WERE "5I7) * STOP 77 * END * END$ * * TEST PROGRAM SHOWS RETURN TO MAIN FROM SEGMENTS *FTN,L * PROGRAM TEST2 * DIMENSION ITESTB(3) * DATA ITESTB/2HTE,2HST,2HB / * CALL RPIDS(ITESTB,5) * CALL CLOVL(ITESTB) * ITESTB(3) = 2HC * CALL CLOVL(ITESTB) * ITESTB(3) = 2HD * CALL CLOVL(ITESTB) * ITESTB(3) = 2HE * CALL CLOVL(ITESTB) * ITESTB(3) = 2HF * CALL CLOVL(ITESTB) * STOP 77 * END * PROGRAM TESTB(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTB OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTC(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTC OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTD(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTD OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTE(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTE OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTF(5) * DIMENSION I)s������þúDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTF OVERLAY SEGMENT") * GO TO IRTN * END * END$ SKP * EXAMPLE CALLING INTERFACE *ASMB,R,L,C * HED "CLOVL" ROUTINE TO CALL IN AN OVERLAY 2-77 (DLB) * NAM CLOVL,7 EXAMPLE ROUTINE TO USE TYPE 5 ID MANAGER * ENT CLOVL,RPIDS * EXT IDMG#,IDGT#,EXEC,.ENTR,PAU.E,.DFER * SPC 1 *A EQU 0 *B EQU 1 *XEQT EQU 1717B * SPC 1 ** PURPOSE (1): TO PRODUCE AND CALL AN RTE OVERLAY PROGRAM ** ** CALLING: ** ** CALL CLOVL(NAME) ** -OR- ** CALL CLOVL(NAME,IPBUF) ** <NO POSSIBLE RETURN FROM THIS SUBROUTINE WHEN CALLED THIS WAY> ** ** WHERE: ** ** NAME = 3 WORD BUFFER CONTAINNING SEGMENT PROGRAM NAME. ** IPBUF = OPTIONAL 5 WORD BUFFER TO PASS TO SEGMENT PROGRAM. ** ** PURPOSE (2): TO PRODUCE MULTIPLE SHORT IDSEGMENTS SO THAT THEIR SIZE ** CAN BE EXAMINED. ** ** CALLING: ** ** CALL RPIDS(NAME,NUMBR) ** ** WHERE: ** ** NAME = 3 WORD BUFFER CONTAINNING SEGMENT PROGRAM NAME. ** NUMBR = NUMBER OF SEGMENTS THAT NEED TO BE PRODUCED, WHERE ** THE LAST NON-BLANK CHARACTER WILL BE INCREMENTED TO ** DETERMINE THE NEXT NAME TO BE USED. ** ** * SPC 1 *NAME NOP *PRAMS DEF *+1 DEFAULT CALLED ADDRESS (IF FROM ROOT CODE) *CLOVL NOP * JSB .ENTR *DFNAM DEF NAME * LDA PRAMS GET PARAMETER BUFFER ADDRESS * STA PRMBF+0 * INA * STA PRMBF+1 * INA * STA PRMBF+2 * INA * STA PRMBF+3 * INA * STA PRMBF+4 * LDA DFNAM RESET THE OPTIONAL PARAMETER ADDRESS WORD * ADA O2 * STA PRAMS *AGAIN JSB EXEC CALL THE OVERLAY * DEF *+8 * DEF NA8 NO ABORT CALL EXEC (8 * DEF NAME,I *PRMBF REP 5 * DEF * * LDA NAME GET NAMES DIRECT ADDRESS * JSB IDMG# USE T5IDM TO PRODUCE THE OVERî ������þúLAY * JSB EXEC NOW TRY AGAIN * DEF *+8 * DEF NA8 * DEF NAME,I * DEF PRMBF+0,I * DEF PRMBF+1,I * DEF PRMBF+2,I * DEF PRMBF+3,I * DEF PRMBF+4,I * JSB .DFER MOVE THE SEGMENT NAME INTO THE MESSAGE BUFFER * DEF MESS * DEF NAME,I * LDA XEQT GET ADDRESS OF MY OWN NAME * ADA D12 INDEX INTO THE IDSEGMENT * LDB A,I GET 1ST TWO CHARS * STB PNAME * INA * DLD A,I GET LAST FOUR CHARS * STA PNAME+1 SAVE CHARS 3 & 4 * LSR 8 STRIP OFF LAST CHAR * BLF,BLF REPOSITION * ADB O40 * STB PNAME+2 SET THE LAST CHAR + SPACE * JSB EXEC NOW WRITE OUT THE NOT FOUND MESSAGE * DEF *+5 * DEF O2 WRITE * DEF PAU.E USE SAME LU AS THE "STOP" ROUTINE * DEF MESS * DEF D15 * JSB EXEC NOW PAUSE * DEF *+2 * DEF O7 NOW PAUSE FOR ID TO BE PRODUCED * JMP AGAIN NOW TRY SAME ALL OVER AGAIN * SPC 1 *O2 OCT 2 *O7 OCT 7 *D12 DEC 12 *D15 DEC 15 *O40 OCT 40 *NA8 OCT 100010 *MESS ASC 7,PROGA MISSING-PROGM SUSPENDED! *PNAME ASC 3,PROGM SUSPENDED! * ASC 5,SUSPENDED! *NAME1 NOP *NUMBR NOP *RPIDS NOP * JSB .ENTR GET CALLERS PARAMETERS * DEF NAME1 * LDA NAME1 GET ADDRESS OF SEGMENT NAME * LDB NUMBR,I GET THE NUMBER OF SEGMENTS NECESSARY * JSB IDGT# CALL TYPE 5 ID MANAGER INTERFACE ROUTINE * JMP RPIDS,I RETURN DONE * END SKP *ASMB,R,L,C * HED TYPE 5 MANAGER INTERFACE ** NAM IDGT#,7 PRE-REL 7-22-76 (MOS) ** NAM IDGT#,7 09570-16499 REV. A 761013 ** NAM IDGT#,7 PRE-REL 770213 (DLB) * NAM IDGT#,7 PRE-REL 780402 (DLB) (RTE-IV) ** **-------------------------------------------------------- ** ** RELOC. 09570-16499 ** SOURCE 09570-18499 ** ** M. SPANN 13 OCT 76 REV. ** **--------------------------------‡ß������þú------------------------- ** * ENT IDGT#,IDMG# * EXT EXEC,.XLB ** *A EQU 0 *B EQU 1 *XEQT EQU 1717B *TAT EQU 1656B *TATSD EQU 1756B ** *IDMG# NOP * LDB IDMG# * STB IDGT# * CLB,INB,RSS *IDGT# NOP * STB IDMG# SAVE NUMBER OF MODULES TO :RP, * STA TEMP * INA * STA TEMP+1 * INA * STA TEMP+2 * LDA XEQT GET IDSEGMENT ADDRESS OF THIS PROGRAM * ADA D26 BUMP TO THE DISC ADDRESS WORD * JSB .XLB GET THE DISC ADDRESS WORD * DEF A,I * LDB A,I * CLE,ELB GET THE DISC LU IN E-REG * LSR 8 POSITION DISC TRACK TO LO 8 BITS * CLA,SEZ CHECK IF ON LU = 3 * ADB TATSD YES, LU = 3, ADD IN TRACKS IN LU = 2 * ADB TAT INDEX INTO THE TAT TABLE * JSB .XLB GET THE VALUE IN THE TAT TABLE * DEF B,I * LDB B,I * CPB FMPTK CHECK IF IS ON A FMGR TRACK? * CLA,INA,RSS YES, CONTINUE * JMP EXIT NO, SKIP CALL TO T5IDM * ELA NOW CALCULATE IF ON LU = 2 OR 3 * CMA,INA MAKE NEGATIVE * STA CRN AND SET TO CRN = -2 OR -3 * JSB EXEC * DEF RTN *DEFER DEF SCHD * DEF T5IDM *TEMP NOP PARAMETERS TO PASS * NOP * NOP * DEF IDMG# NUMBER OF SEGMENTS * DEF CRN THE CARTRAGE OF THIS PROGRAM *RTN NOP T5IDM NOT FOUND *EXIT JMP IDGT#,I ** *SCHD OCT 100027 *D26 DEC 26 *FMPTK OCT 77776 *T5IDM ASC 3,T5IDM *CRN NOP * END SKP T5IDM JSB RMPAR GET SCHED PARMS DEF *+2 DEF NAME SYSI1 JMP SYSID ONE TIME CODE LDA NUM GET USER SPECIFIED DISC LU SSA,RSS MAKE SURE IT'S NEGATIVE CMA,INA STA CRN AND SAVE LDA NAME+3 GET NUMBER OF SEG FROM USER SZA IF HE SPECIFIED 0 SSA OR NEGATIVE CLA,INA DEFAULT TO 1 STA NUM SAVE STA ENTR# * Â������þú DO THE DOUG BASKINS' TABLE FLUSH LDB BPA3 GET START OF BCKGND BP CPB D2 IF RTE III OR IV CPA D1 AND LONG REQUEST JMP T50 SKIP IF SHORT OR RTE II LDB TBLA GET START OF TABLE STB IDBUF SAVE TEMP T5 LDB IDBUF LAST ENTRY PROCESSED ADB D5 BUMP TO NEXT CPB TEND END OF TABLE ? JMP T50 YES - DONE STB IDBUF SAVE POINTER ADB D3 TYPE STATUS WORD LDA B,I GET IT CPA DM1 VALID DATA ? JMP T50 NO AND B17 EXTRACT TYPE CPA D3 TYPE 3 ? JMP T5 YES - SKIP LDB IDBUF CURRENT ENTRY JSB FLUSH TRY TO DO AN RP,, JMP T5 TRY NEXT * T50 LDA NAME+1 SECOND WORD OF NAME SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK STA NAME+1 RESTORE AND B377 LOOK AT LOW BYTE SZA IF NULL JMP T51 NOT NULL LDA B40 IOR NAME+1 ADD BLANK STA NAME+1 RESTORE T51 LDA NAME+2 GET 3RD WORD OF NAME SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK AND MASK SAVE 5TH CHARACTER IOR B40 PUT BLANK IN 6TH POSITION STA NAME+2 SO MATCH WILL WORK CLA,CLE STA HPNTR INITIALIZE HEAD POINTER STA EFLAG ZERO ERROR COUNT SKP SRCH CLA INITIALIZE STA BPNTR BLANK POINTER STA MPNTR MATCH POINTER LDB TBLAD TABLE ADDRESS LOOP STB PNTR POINTER FOR SEARCH LOOP LDA B,I GET LINK WORD SZA,RSS IS IT A BLANK ? JMP BLANK -YES- CPA DM1 END OF ENTRIES ? JMP ENTR YES JSB MATCH IS IT ONE WE WANT ? DEF NAME STB MPNTR YES-SAVE ADDRESS AND HBIT [A] IS TYPE/STATUS SZA,RSS IS ENTRY A HEAD ? JMP NEXT NO CPB MPNTR IS HEAD A MATC,¨������þúH ? STB HPNTR YES SAVE ADDRESS JSB GOBCK LOOK AT TAIL OF LIST CPA D3 IS IT A TYPE 3 (FATHER) ? RSS YES JMP NEXT NO CHECK NEXT ENTRY CHCK JSB DRMNT REMOVE DORMANT TYPE 3 FROM LIST CPA D3 IS BACK TYPE 3? JMP CHCK YES- CHECK IT JSB GOFWD SEE IF ANY TYPE 3'S REMAIN CPA D3 JMP NEXT YES - LIST STILL MUST REMAIN CHC2 JSB FLUSH DO RP,, THING JSB GOFWD UNTILL CPA SEGT SKIP WHEN BACK TO HEAD JMP CHC2 NEXT LDB PNTR BUMP POINTER ADB D5 TO NEXT ENTRY CPB TEND END OF TABLE ? JMP ENTR YES JMP LOOP CONTINUE CHECKING * BLANK LDA BPNTR PREVIOUS BLANK ? SZA,RSS YES-SKIP STB BPNTR SAVE ADDRESS OF BLANK ENTRY JMP NEXT SKP * *TABLE HAS BEEN UPDATED ,CHECK ON CALLER ENTR LDB XEQT OUR ID ADDRESS ADB D20 21'ST WORD LDA B,I AND B377 EXTRACT FATHER'S ID # SZA,RSS DO WE HAVE A FATHER ? JMP EXIT NO! ADA DM1 WHY ??? ADA KEYWD CALCULATE HIS ID ADDRESS LDA A,I GET ID ADDRESS ADA D12 POINT TO HIS NAME LDB A,I GET 1ST WORD OF HIS NAME INA STB NAME2 SAVE LDB A,I GET 2ND WORD SZB,RSS IF NULL LDB DBLNK DEFAULT TO BLANK STB NAME2+1 SAVE INA LDB D12 ADD 12 TO POINT TO ADB A DISC ADD LDA A,I GET 3RD WORD SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK AND MASK SAVE 5TH CHARACTER IOR B40 PUT IN BLANK FOR MATCH STA NAME2+2 SAVE LDA B,I GET DISC ADD STA NAME2+3 SAVE LDB DM3 LU=3 SSA,RSS OR INB LU=2 LDA CRN LU SPECIFIED? SZA,RSS WELL?? STB CRN NO USE POP'S ™������þú JSB NAM.. CHECK IF NAME IS LEGAL ? DEF *+2 DEF NAME SZA JMP ERMOR NOT LEGAL SO RECORD ERROR LDB MPNTR DID WE FIND A MATCH ? SZB,RSS JMP NMTCH MATCH NOT FOUND * MATCH FOUND IN TABLE STB BPNTR SET POINTER FOR OPEN ADB D4 ADDRESS OF DISC WORD LDA B,I CHECK THE DISC WORD SZA DO WE HAVE A DISC ADDRESS ? CPA DM1 JMP NMTCH NO - OPEN FILE CLE,ELA PUT LU IN E REG. LDA CRN USER SPECIFIED LU RAR,ELA PUT E REG. IN LSB CPA CRN STILL SAME ? JMP ENT0 YES-THEY AGREE * ENL0 LDB MPNTR WE GOT THE WRONG DUDE !!! JSB GOBCK SEE IF WE CAN CHANGE HORSES CPA D3 TYPE THREE ? ENL1 JSB DRMNT IF DORMANT REMOVE FROM LIST CPA D3 IS BACK TYPE 3 ? JMP ENL1 YES - KEEP TRYING JSB GOFWD SEE IF ANY TYPE THREES CPA D3 REMAIN JSB ENL4 CHECK IF SAME FATHER ON DIFF LU. ENL3 JSB GOBCK BACK AROUND LIST CLA CLEAR OUT OLD DATA ADB D4 BUMP TO DISC WORD STA B,I CLEAR IT ADB DM4 RESTORE B REG. JSB FLUSH TRY RP,, IN CASE SZA IF SUCCESS CPA D14 OR NOT FOUND CPB MPNTR CHECK FULL CIRCLE JMP NMTCH YES -GO OPEN CORRECT FILE JMP ENL3 KEEP ON TRUCKING * ENL4 NOP JSB MATCH SEE IF SAME FATHER DEF NAME2 RSS YES SKIP JSB ERR GET OUT GRACEFULLY ADB D4 BUMP TO DISC WORD LDA B,I GET IT CLE,ELA LU TO E REG. LDA CRN USER SPECIFIED LU RAR,ELA REPLACE LSB CPA CRN STILL SAME ? JSB ERR YES - GET OUT LDA NAME2+3 GET NEW DISC WORD STA B,I PUT IN ENTRY ADB DM4 RESTORE B REG. JMP ENL4,I RETURN * ENT0 JSB IDSGA SEE Ü������þúIF NOW IN CORE DEF *+2 DEF NAME SZA IN CORE ? JMP ENTR1 YES LDB BPNTR ENTRY ADDRESS ADB D4 LDA B,I GET DISC WORD RAL,CLE,ERA PUT LU IN E REG STA B AND B177 EXTRACT SECTOR STA DCB+4 PUT IN DCB WORD XOR B REMOVE SECTOR FROM B ALF,ALF POSITION RAL STA DCB+3 PUT IN DCB LDA SECT2 IF LU=2 SEZ LDA SECT3 LU=3 STA DCB+8 PUT IN DCB CLA,INA FORM DISC LU ELA IF E SET IT'S LU=3 STA DCB PUT IN DCB LDB XEQT GET OUR ID ADDRESS STB DCB+9 SHOW FILE OPEN TO US JSB LOOK READ FILE HEADER JMP RPACK CHECKSUM ERROR LDB DID12 NAME IN FILE HEADER JSB MATCH SEE IF SAME AS DNAME DEF NAME REQUESTED NAME RSS YES - SKIP JMP ENL0 TRY FOR DESIRED ONE ENT00 JSB FID DO RP THING SZA ANY ERROR ? CPA D23 DUPLICATE ID ? JMP ENTR1 DUP OR NO ERROR CPA D14 NO ID AVAILABLE ? JSB ROBIN MAKE AN ID AVAILABLE JMP ERMOR NONE AVAILABLE JMP ENT00 TRY AGAIN * RPACK LDB TBLAD TABLE ADDRESS CLA RPK CPB TEND END OF TABLE ? JMP NMTCH YES - GO OPEN FILE ADB D4 WORD 5 STA B,I CLEAR DISC WORD INB JMP RPK LOOP FULL TABLE SKP * *NOW MAKE ENTRY IN OUR TABLE ENTR1 LDB HPNTR HEAD POINTER SZB FOUND ? JMP ENTR3 YES LDB BPNTR NOT FOUND SEARCH NTRL JSB GOBCK LOOK BACK AND HBIT SZA,RSS IS THIS THE HEAD OF THIS LIST ? CPB BPNTR LIST EXHUSTED ? RSS SKIP JMP NTRL NO KEEP LOOKING STB HPNTR SAVE HEAD ADDRESS ADB D3 LDA B,I GET WORD 4 IOR HBIT MARK AS HEAD STA B,I � ������þú IN ENTRY ENTR2 LDB HPNTR JMP EN1 LOOK FOR FATHER * ENTR3 CPB BPNTR IF ENTRY IS HEAD JMP EN1 LOOK FOR FATHER LDB BPNTR OTHERWISE JSB GOFWD CHECK CPB BPNTR IF ONLY ENTRY RSS YES - SKIP JMP ENTR2 NO LDB HPNTR HEAD OF NEW LIST JSB GOFWD LDA B LINK IN FRONT OF NEW HEAD LDB BPNTR JSB INSRT LDA DNAME GET NAME ADDRESS INB BUMP TO WHERE NAME GOES JSB MOVE DEC -4 JMP ENTR2 SKP EN0 JSB MATCH IS THIS FATHER DNAM2 DEF NAME2 FATHER'S NAME JMP MORE? YES-ALREADY IN LIST EN1 JSB GOBCK LOOK BACK CPA D3 IS THIS A FATHER ? JMP EN0 YES-SEE IF IT'S OURS * FATHER NOT IN LIST MAKE ENTRY JSB QBLNK LOOK FOR BLANK SZB,RSS FOUND ONE ? JMP MORE? NO-CHECK FOR MORE LDA NAME2+2 GET WORD 4 AND MASK SAVE 5TH CHAR OF NAME IOR D3 PUT IN TYPE STA NAME2+2 PUT IN ENTRY LDA HPNTR HEAD ADDRESS JSB INSRT INSERT BEHIND HEAD LDA DNAM2 FATHERS' NAME ADDRESS INB WHERE IT GOES JSB MOVE DEC -4 SKP * *MORE THAN 1 SEGMENT ? MORE? LDA ENTR# GET ENTRY NUMBER ADA DM1 SUBTRACT 1 STA ENTR# CCE,SZA,RSS MORE? JMP EXIT NO- LDA NAME+2 GET 3RD. WORD OF NAME AND MASK STRIP TYPE/STATUS IOR B40 PUT IN BLANK STA NAME+2 AND RESTORE LDB DNAM ADDRESS OF SEG NAME ADB D2 START WITH 3RD. WORD NOT LDA B,I GET WORD SEZ E=0,LOW BYTE ALF,ALF POSITION HIGH TO LOW AND B377 MASK CPA B40 IF BLANK CPB DNAM OR ONE CHAR NAME JMP NOT1 DONE CMB,SEZ,CME,INB IF NOW HIGH BYTE CMB,RSS DECREMENT B WIºà������þúTHOUT SETTING E-REG CMB,INB BACK UP ONE WORD JMP NOT NOT1 LDA B,I GET THE WORD SEZ IF HIGH BYTE ALF,ALF SHIFT TO LOW SEZ,INA INCREMENT NAME ALF,ALF REPOSITION STA B,I RESTORE JMP SRCH SEE IF IT IS IN LIST * ERMOR ISZ EFLAG COUNT ERRORS JMP MORE? MORE SEGMENTS ? SKP * *HERE IF ENTRY NOT FOUND IN TABLE NMTCH JSB IDSGA SEE IF ALREADY IN CORE DEF *+2 DNAM DEF NAME SZA IN CORE ? JMP MORE? YES CCB DETERMINE DISK LU STB CRN# DEFAULT TO ONE DISC LDA CRN USER SPECIFIED DISC SZA IF IT IS ZERO CLB,RSS NOT ZERO USE IT LDA DM2 ZERO - SO DEFAULT IS LU 2 STA CRN SAVE FOR OPEN SZB USER SPECIFIED LU ? LDB SECT3 NO - DO WE HAVE AN LU 3 ? SZB,RSS USER SPECIFIED OR NO LU 3 JMP NMCH1 GO DO OPEN '(A)_DISC LU' JSB FSTAT REQUEST CATRIDGE LIST DEF *+2 ADBUF DEF BUFF BUFFER LDB ADBUF ADDRESS OF BUFFER CLOP LDA B,I ENTRY SZA,RSS END OF LIST ? JMP NMCA YES AND B77 MASK OF LU CPA D2 LU=2 ? JMP FOUND YES CPA D3 LU=3 ? JMP FOUND YES ADB D4 BUMP ADDRESS JMP CLOP KEEP LOOKING FOUND CMA,INA MAKE LU NEGATIVE STA CRN SAVE LDB DM2 NOW HAVE TWO STB CRN# DISC LU'S NMCA LDA CRN NMCH1 STA TEMP FOR OPEN JSB OPEN OPEN THE FILE DEF ORTN RETURN DEF DCB DEF IERR DEF NAME DEF D1 NON-EXCLUSIVE OPEN DEF D0 SECURITY DEF TEMP LU ORTN CPA D6 DID WE OPEN TYPE 6 ? JMP NMCH2 YES - GOOD OPEN LDB CRN# GET NUMBER OF DISC LU'S TO SEARCH LDA TEMP WHcš������þúERE WE LOOKED CPA CRN TOP OF STACK ? CPB DM1 AND MORE THAN 1 DISC LU ? JMP NMC14 NO - NOT FOUND ,CLOSE THE DCB SLA,INA,RSS TRY OTHER DISC LDA DM3 JMP NMCH1 * NMCH2 LDA TEMP RETREIVE DISC LU STA CRN ALL SEGMT'S MUST BE ON SAME LU JMP NMCH3 SKIP NMC12 LDB NUM REQUESTED NO. OF SEGMENTS CPB D1 SHORT REQUEST JSB ROBIN MAKE AN ID AVAILABLE JMP NMC14 NONE AVAILABLE NMCH3 LDA CRN RETREIVE DISC LU CMA,INA MAKE POSITIVE JSB LOOK READ FILE HEADER JMP NMC14 CHECKSUM ERROR LDB DID12 CHECK NAME IN FILE HEADER JSB MATCH MUST MATCH DNAMN DEF NAME NAME REQUESTED RSS OK JMP NMC14 NO GO - CLOSE FILE JSB FID DO THE RP SZA,RSS ANY ERRORS ? JMP NMCH5 SUCCESS CPA D14 NO ID AVAILABLE ? JMP NMC12 YES - TRY TO FREE AN ID * NMC14 JSB CLOSE CLOSE DCB DEF *+2 DEF DCB JMP ERMOR TAKE ERROR EXIT * NMCH5 JSB CLOSE CLOSE DCB DEF *+2 DEF DCB * LDA NAME+2 MAKE UP ENTRY FOR SEGMENT AND MASK SAVE 5TH CHARACTER IOR SEGT INSERT TYPE LDB NUM REQUESTED NO OF ENTRIES CPB ENTR# IF FIRST ENTRY IOR HBIT IT'S A HEAD STA NAME+2 LDB HPNTR ADDRESS OF HEAD JSB GOFWD ADVANCE FORWARD STB TEMP SAVE LINK ADDRESS LDB BPNTR ENTRY ADDRESS TO B SZB,RSS DO WE HAVE A BLANK ? JSB QBLNK FIND ONE STB BPNTR SAVE ADDRESS SZB,RSS FOUND ? JSB ERR NO - TABLE FULL CPB MPNTR DID WE FIND IN TABLE ? JMP NMCH6 YES LDA TEMP LINK ADDRESS TO A JSB INSRT INSERT IN FRONT OF HEAD NMCH6 LDA DNAMN ADDRESS OF NAME INB WHERE IT GOES JSB MOVE DM4 DEC -4 ������þú LDA HPNTR DID WE HAVE A HEAD ? SZA,RSS LDA BPNTR N0 - NEW ENTRY IS HEAD STA HPNTR JMP ENTR1 GO PUT FATHER IN LIST SKP HED TERMINATE SAVING RESOURCES AND REPORT STATUS ERR NOP LDA *-1 GET ERROR ADDRESS STA NAME2 REPORT CLA,CCE,RSS EXIT CLA,CLE LDB EFLAG GET ERROR COUNT SZB ANY ERRORS ? CLA,CCE YES REPORT ! ERA STA EFLAG JSB DTACH RELEASE SELF FROM SESSION DEF *+1 JSB PRTN RETURN ANY ERROR DEF *+2 TO CALLER DEF EFLAG JSB EXEC DEF *+9 DEF D6 TERMINATE DEF D0 ME DEF D1 SAVING RESOURSES DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP JMP T5IDM SKP HED SUBROUTINES * [B] ADDRESS OF ENTRY * JSB MATCH * DEF NAME NAME TO MATCH * <P+1> IF MATCH * <P+2> IF NO MATCH * [A] TYPE/STATUS OF ENTRY * MATCH NOP STB TPNTR SAVE ENTRY ADDRESS LDA MATCH,I GET NAME ADDRESS ISZ MATCH <P+1> STA TEMP SAVE NAME ADDRESS INB DLD B,I 1ST TWO WORDS OF ENTRY NAME CPA TEMP,I SAME ? RSS YES-POSSIBLE MATCH JMP NXIT TAKE NO MATCH EXIT ISZ TEMP BUMP NAME POINTER CPB TEMP,I COMPARE ? RSS SAME JMP NXIT NO MATCH LDB TPNTR FIND ADDR OF LAST WORD ADB D3 IE WORD 4 ISZ TEMP LDA B,I GET LAST CHAR AND MASK IOR B40 BLANK CPA TEMP,I SAME ? JMP MXIT MATCH ! NXIT ISZ MATCH <P+2> LDB TPNTR ENTRY ADDRESS ADB D3 POINT TO MXIT LDA B,I TYPE STATUS AND B377 EXTRACT LDB TPNTR RESTÿ¤������þúORE ADDRESS JMP MATCH,I RETURN * * FIND A BLANK ENTRY IF IT EXISTS IN TABLE * QBLNK NOP LDB TBLAD TABLE ADDRESS RSS QLP ADB D5 BUMP TO NEXT ENTRY CPB TEND END OF TABLE ? CLB,RSS YES LDA B,I GET ENTRY'S LINK WORD CPA DM1 UNUSED ENTRY ? CLA YES - USE AS BLANK SZB END OF TABLE ? SZA,RSS OR BLANK FOUND ? JMP QBLNK,I RETURN JMP QLP ELSE SKP * * [A] LINK POINTER - INSERT BEFORE * [B] ENTRY POINTER * JSB INSRT * INSRT NOP STA TEMP STB TPNTR LDA TBLA TABLE ADDRESS CMA,INA ADA TPNTR CALCULATE NEW ENTRY LINK CLB DIV D5 STA B SAVE IN B BLF,BLF POSITION TO HIGH BYTE IOR B MERGE TOGETHER LDB TEMP GET LINK POINTER SZB,RSS START OF NEW LIST ? JMP INSR1 YES STA IERR TEMPORARY LDA B,I BACK UP ALF,ALF AND B377 EXTRACT BACK LINK MPY D5 ADA TBLA ADDR OF PREVIOUS STA TAIL SAVE TAIL ADDRESS LDA TAIL,I GET TAIL POINTERS LDB TEMP,I AND HEAD POINTERS RRL 8 ALF,ALF REVERSE LINKS STA TPNTR,I PUT IT IN ENTRY LDA IERR RETREIVE TEMPORARY CPB TAIL,I SPECIAL CASE ? JMP *+3 YES TWO ENTRY LIST RRR 8 STB TEMP,I NEW HEAD POINTERS STA TAIL,I NEW TAIL POINTERS LDA TPNTR,I NEW ENTRY POINTERS INSR1 STA TPNTR,I PUT IN NEW LINKS LDB TPNTR JMP INSRT,I RETURN SKP * * [B] ENTRY ADDRESS * JSB GOFWD OR GOBCK * [A] TYPE STATUS * [B] NEXT ENTRY IN LIST ADDRESS * GOFWD NOP LDA B,I SZB IF NO ADDRESS SZA,RSS OR NO LINK JMP GOFWD,I RETURN AND B377 GET FWD LINK MPY D5 ADA TBLA CALCKQ������þúULATE STA B SAVE ADDRESS IN B REG. ADA D3 LDA A,I GET WORD 4 AND B377 EXTRACT TYPE/STATUS JMP GOFWD,I * GOBCK NOP LDA B,I SZB IF NO ADDRESS SZA,RSS OR NO LINK JMP GOBCK,I RETURN ALF,ALF AND B377 GET BACK LINK MPY D5 ADA TBLA STA B ADDRESS OF PREVIOUS ENTRY ADA D3 LDA A,I WORD 4 AND B377 EXTRACT TYPE/STATUS JMP GOBCK,I SKP * [B] ADDRESS OF ENTRY * JSB DRMNT CHECK IF PRGM DORMANT * [A] TYPE STATUS * [B] ADDRESS OF NEXT ENTRY * DRMNT NOP STB TPNTR SAVE CURRENT POINTER INB ADDRESS OF NAME IN ENTRY STB DDEF FOR CALL JSB IDSGA GET ID ADDRESS DEF *+2 DDEF NOP NAME ADDRESS LDB TPNTR RESTORE POINTER SZA,RSS DOES IT EXIST ? JMP RMOVE N0-DORMANT ADA D15 STATUS WORD FROM ID LDA A,I AND B17 EXTRACT STATUS SZA,RSS 0=DORMANT JMP RMOVE DORMANT SO REMOVE FROM LIST JSB GOBCK LOOK AT BACK JMP DRMNT,I * RMOVE STB TAIL IF ONLY ENTRY JSB GOBCK GET ADDRESS OF BACK CPB TPNTR IF ONLY ENTRY JMP RXIT JUST MARK AS BLANK STB TAIL SAVE TAIL ADDRESS LDA B,I GET LINK WORD AND MASK GET BACK STA TEMP SAVE LDA TPNTR,I AND B377 GET ENTRY'S FWD LINK IOR TEMP FORM NEW LINK STA B,I NEW LINK FOR BACK LDB TPNTR JSB GOFWD ADDRESS OF FORWARD LDA B,I CPB TAIL ONLY TWO ENTRIES ? LDA TPNTR,I YES - SPECIAL CASE AND B377 EXTRACT ITS FWD STA TEMP AND SAVE LDA TPNTR,I GET ENTRIES FROM BACK AND MASK IOR TEMP FORM NEW LINK STA B,I PUT IN FORWARD'S LINK WORD RXIT LDB TPNTR RESTOR‘!������þúE B CLA STA B,I MARK ENTRY AS BLANK LDB TAIL RETURN WITH BACK ADDR LDA B ADA D3 LDA A,I AND B377 AND TYPE/STATUS JMP DRMNT,I RETURN SKP * * [B] ENTRY ADDRESS * JSB FLUSH - DO RP ,, ON ENTRY'S ID * [A] ERROR CODE * [B] UNCHANGED FLUSH NOP STB TPNTR SAVE ADDRESS INB ADDRESS OF NAME STB FNAM SAVE FOR CALL ADB D2 LDA B,I GET WORD 4 STA TEMP SAVE AND MASK EXTRACT TYPE/STATUS IOR B40 PUT IN BLANK STA B,I JSB IDRPD DO RP,, THING DEF *+2 FNAM NOP ID ADDRESS STA IERR SAVE ERROR CODE LDA TEMP RETREIVE SAVED TYPE STATUS LDB TPNTR ADB D3 STA B,I RESTORE WORD 4 LDB TPNTR AND B LDA IERR RETREIVE ERROR JMP FLUSH,I * * DO ROUND ROBIN TO MAKE ID AVAILABLE * JSB ROBIN * ROBIN NOP LDB RROBN GET ROUND ROBIN POINTER STB QBLNK SAVE TEMP JMP RR1 SKIP FIRST TIME RLP1 LDB RROBN GET ROUND ROBIN POINTER CPB QBLNK FULL CIRCLE ? JMP ROBIN,I YES - EXIT RR1 CPB TBLAD BEGINING OF TABLE ? LDB TEND YES - START AT BOTTOM ADB DM5 ADJUST TO PREVIOUS ENTRY STB RROBN SAVE ADB D3 TYPE STATUS WORD LDA B,I GET TYPE/STATUS CPA DM1 VALID ENTRY ? JMP RLP1 NO - KEEP LOOKING AND B17 EXTRACT TYPE CPA D3 IS IT TYPE 3 ? JMP RLP1 YES - LOOK AGAIN LDB RROBN JSB FLUSH DO RP,, SZA SUCCESS ? JMP RLP1 THIS ID NOT AVAIL TRY NEXT ISZ ROBIN BUMP RETURN (P+2) JMP ROBIN,I GOOD EXIT * SKP * * READ HEADER RECORD OF TYPE 6 FILE * FILE MUST BE OPEN AND DISC LU IN A REG. * * SYSUP NOP SYSTEM SETUP CODE WORD LOOK NOP B������þú IOR PRC MERGE IN PRIVILEDGE CODE STA TEMP SAVE DISC LU FOR EXEC CALL JSB EXEC DEF *+7 DEF D1 READ DEF TEMP DISC LU DFIDB DEF IDBUF DEST BUFFER ADDRESS DEF D35 LENGTH DEF DCB+3 DISC TRACK DEF DCB+4 DISC SECTOR LDA $OPSY CHECK IF RTE-IV SYSTEM LDB D28 CPA RT4FL IF RTE-IV, USE MORE WORDS FOR CHECKSUB ADB D5 MAKE IT 33 FOR RTE-IV STB LOOK1 SAVE FOR CHECKSUM CLA,CLE NOW CHECK FOR BELONGS THIS SYSTEM JSB SUM DEF IDBUF LOOK1 DEC 28 LDB LOOK1 GET INDEX INTO SKELITON DCB ADB DFIDB CPA B,I SAME ? INB,RSS YES - SKIP JMP ERR19 CHECKSUM ERROR LDA SYSUP GET THE SYSTEM SETUP CODE WORD CPA B,I SAME AS THIS SYSTEM? RSS YES - SKIP JMP ERR19 CHECKSUM ERROR LDA ID+15 GET TYPE WORD AND B17 MASK TO TYPE CPA SEGT SEGMENT ? RSS YES - SKIP JMP ERR19 NO - CLOSE FILE LDA DCB GET DISC LU ERA LSB 'LU' TO E REG. LDA DCB+3 GET TRACK ALF,ALF FOR DISC WORD ERA ADD LU IN BIT 15 LDB DCB+4 GET SECTOR ADA B PUT TOGETHER DISC WORD STA NAME+3 PUT IN OUR TABLE AND OM200 STRIP OUT SECTOR ADB D2 BUMP TO WHERE CODE STARTS CPB DCB+8 CHECK FOR TRACK CROSSING LDB B200 BUMP TRACK AND ZERO SECTOR ADA B FORM DISC WORD FOR ID STA ID+27 PUT IN SKELETON ID ISZ LOOK GOOD RETURN ERR19 JMP LOOK,I SPC 1 DM9 DEC -9 RT4FL EQU DM9 SKP * * FIND A BLANK SHORT ID AND SET IT UP * FID NOP JSB $LIBR GO PRIVILEDGE NOP TO PREVENT CONFLICTS JSB IDSGA SEE IF ID NOW IN CORE DEF *+2 DNAMF DEF NAME SEZ,CME NOT FO@ú������þúUND CLEAR E REG. JMP SERCH LDA D23 FOUND IN CORE JMP FXIT ERROR 23 ! LOOP1 LDA D14 SEZ,RSS IF DOWN TO DONT CARE ? JMP FXIT NO ID AVAILABLE * E=1 SEARCH FOR ID W/O TRACKS, E=0 DONT CARE ABOUT TRACKS SERCH CME TOGGLR E REG. LDA KEYWD ADDRESS OF ID TABLE STA TEMP RSS SKIP FIRST ISZ FIDL ISZ TEMP LDB TEMP,I GET ENTRY SZB,RSS END OF TABLE ? JMP LOOP1 TRY WITH TRACKS ADB D14 BUMP TO WORD 15 LDA B,I GET NAME/TYPE AND OM360 MASK TO CHAR 5 AND SHORT BIT CPA B20 NULL AND SHORT ? RSS YES - SKIP JMP FIDL LOOK SOME MORE ADB D5 CHECK FOR TRACKS LDB B,I WORD 20 SEZ,SZB IF HAS TRACKS AND CARE JMP FIDL SKIP THIS ONE * NOW SET UP THE ID LDB TEMP,I GET AVAILABLE ID ADDRESS ADB D11 CORRECT FOR SHORT ID LDA ID+8 ENTRY POINT ADDRESS STA B,I TO THE ID INB LDA DNAMF SEGMENT NAME JSB MOVE MOVE FIRST DM2 DEC -2 TWO WORDS LDA NAME+2 GET THIRD WORD AND MASK SAVE CHAR 5 XOR ID+15 MERGE IN PROG TYPE AND OM20 MASK OF BITS 4-14 XOR ID+15 IOR B220 PUT IN TEMP & SHORT BITS STA B,I MOVE TO ID INB LDA DID23 ADDRESS OF LOW MAIN ADDRESS JSB MOVE MOVE WORDS 23-27 DM5 DEC -5 CLA GOOD EXIT FXIT JSB $LIBX DEF FID * * MOVE ROUTINE A=SOURCE , B=DESTINATION ADDRESSES * MOVE NOP STA ID+18 SAVE SOURCE ADDRESS LDA MOVE,I GET COUNTER STA ID+19 SAVE ISZ MOVE SET RETURN MORE LDA ID+18,I GET NEXT WORD STA B,I PUT IT INB ISZ ID+18 ISZ ID+19 JMP MORE JMP MOVE,I RETURN - B=NEXT ADDRESS * * SUM ! P+1=ADDR. ,P+2=# O&f���x��vrF WORDS * SUM NOP LDB SUM,I ISZ SUM STB MOVE TEMP LDB SUM,I GET # OF WORDS CMB,INB NEGATE ISZ SUM ADA MOVE,I ACCUMULATE SUM ISZ MOVE INB,SZB JMP *-3 JMP SUM,I * END T5IDM ��������������������������������������������������������������������������������.÷x������ÿÿ����� ���� ÿý�š�³ ���������ÿ��92067-18470 2026� S C1422 �&LDRLB � � � � � � � � � � � � � �H0114 {�����ASMB,L * NAME: LDRLB * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH, ATL, BW * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LDRLB 92067-16470 REV.2026 800507 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������+Ò������ÿÿ��������þúASMB,R,L,C * NAME: L.SYE * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH, BW * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.SYE,7 92067-16470 REV.2026 800425 * * * * L.SYE IS USED TO ADD OR UPDATE AN ENTRY IN THE SYMBOL * TABLE. THE TABLE BELOW SHOWS THE POSSIBLE ACTIONS TAKEN * BY L.SYE UNDER VARIOUS CONDITIONS. * * * \ DESIRED STATE * PRESENT \ * STATE \ UNDEFINED DEFINED * \ * \-------------------------------------- * | | | * NOT FOUND | NEW ENTRY ADDED | NEW ENTRY ADDED | * | ERROR = 0,-5 | ERROR = 0,-5 | * | | | * ------------------+------------------- * | IF USER WANTS | | * SYMBOL | OVERIDE | SYMBOL DEFINED | * UNDEFINED | SET USER BITS | FIXUPS PROCESSED | * | AND SYMBOL VALUE | ERROR = 0 | * | ERROR = 0 | | * ------------------+------------------- * | | | * | IF USER WANTS | IF USER WANTS | * | OVERRIDE | OVERRRIDE | * SYMBOL | SYMBOL UNDEFINED | SYMBOL REDEFINED | * DEFINED | ELSE, NO ACTION | ELSE, NO ACTION | * | ERROR = 0 | ERROR = 0 | * | Ü9������þú | | * -------------------------------------- * * CALLING SEQUENCE: * JSB L.SYE * DEF *+5 * DEF SYMBL SYMBOL NAME ARRAY * DEF TYPE TYPE OF SYMBOL ENTRY * DEF VALUE VALUE OF SYMBOL * DEF OVERR >= 0, DO NOT OVERRIDE CURRENT DEFINITON * < 0, OVERRIDE CURRENT DEFINITION * DEF ERROR = 0, NO ERROR, * = -5, SYMBOL TABLE OVERFLOW. * * ENT L.SYE EXT .DFER,.ENTR,FIXAL,L.SCN,LS4.L,LS5.L EXT LSY.L,SELST,TBUF,TSY.L EXT CPL1H,CPL2H,TMP1,TMP2,PPST * A EQU 0 B EQU 1 * ASMBL NOP ADDRESS OF SYMBOL NAME ARRAY TYPE NOP ADDRESS OF NEW TYPE WORD VALUE NOP ADDRESS OF VALUE OVERR NOP OVERRIDE PARAMETER ERROR NOP RESULT RETURNED * L.SYE NOP JSB .ENTR RETRIEVE PARAMETER ADDRESSES DEF ASMBL * JSB .DFER PUT SYMBOL NAME INTO TBUF DEF TBUF DEF ASMBL,I * LDA TBUF SET FIRST WORD ASIDE STA TEMP ELA,CLE,ERA CLEAR OUT THE SIGN BIT STA TBUF FOR L.SCN * JSB L.SCN SCAN SYMBOL TABLE FOR MATCHING NAME JMP NOTFD NONE FOUND LDA LS4.L,I FOUND, LOAD CURRENT TYPE AND P7 MASK STATUS BITS ONLY CPA P2 SYMBOL CURRENTLY UNDEFINED ? JMP UNDEF YES * LDA OVERR,I DOES USER WANT TO OVERRIDE CURRENT SSA DEFINITION ? JSB SEVAL YES, SET TYPE VALUE IN LST JMP RETRN NO, JUST RETURN * UNDEF LDA OVERR,I DOES USER WANT TO OVERIDE DEFINITION SSA JSB SEVAL YES, SET TYPE VALUE IN LST * LDA TYPE,I CURRENTLY UNDEFINED AND P7 MASK STATUS BITS CPA P2 CURRENTLY UNDEF, USER WANT UNDmb����� EF ? JMP RETRN YES, NO ACTION TAKEN * JSB SEVAL NO, SET NEW TYPE, VALUE IN LST LDA CPL1H GET COUNT FOR PRELINK AREA STA TMP1 SAVE LDA CPL2H GET COUNT FOR POSTLINK AREA STA TMP2 & SAVE * JSB FIXAL FIX ALL REFERENCES TO THE SYMBOL * JSB PPST POST CP LNK IF CREATED JMP RETRN RETURN TO CALLER * NOTFD SSA OVERFLOW OF LST ? JMP OVFLW YES * LDA TEMP RESTORE ORIGIONAL FIRS WORD STA TBUF IN CASE SIGN BIT WAS SET JSB SELST NO, SET NAME IN LST JSB SEVAL TYPE AND VALUE LDA TSY.L STA LSY.L RETRN CLA,RSS SET GOOD ERROR RETURN FLAG OVFLW LDA N5 SET SYMBOL TABLE OVERFLOW ERROR STA ERROR,I JMP L.SYE,I AND RETURN TO CALLER * * * TEMP BSS 1 TEMPORARY VARIABLE FOR TBUF * SEVAL NOP SET TYPE AND VALUE INTO SYMBOL TABLE LDA TYPE,I GET DESIRED TYPE STA LS4.L,I SET INTO SYMBOL TABLE WORD 4 LDB VALUE,I GET DESIRED VALUE STB LS5.L,I SET INTO SYMBOL TABLE WORD 5 JMP SEVAL,I RETURN TO CALLER * P2 DEC 2 P7 DEC 7 N5 DEC -5 END ����������������������������������������������¾������ÿÿ��������ASMB,R,L,C * NAME: L.SGN * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.SGN,7 92067-16470 REV.1940 790201 * * * THE L.SGN ROUTINE SETS UP CONDITIONS FOR ALL FURURE SEGMENTS * L.SG0 MUST HAVE BEEN CALLED FIRST. * * CALLING SEQUENCE JSB L.SGN * DEF *+2 * DEF DUMMY (RESERVED FOR THE FUTURE) * (SET TO 0 FOR NOW) * ENT L.SGN EXT .ENTR,CBP.L,LSY.L,SGB.L,SGM.L,SSG.L EXT TH2.L,CPLS,CPL2 * A EQU 0 B EQU 1 * TEMPY NOP L.SGN NOP JSB .ENTR DEF TEMPY * LDA SGB.L RESET BASE PAGE POINTER STA CBP.L * LDA SSG.L & SYM TABLE POINTER STA LSY.L * LDA CPLS & RESET TOP OF FIXED CP IMAGE STA CPL2 AS HIGH CP LINK SPECS * LDA SGM.L & LOAD POINT STA TH2.L * JMP L.SGN,I RETURN END ��������������������������������������������������������������������������������������f0������ÿÿ��������þúASMB,R,L,C * NAME: L.SG0 * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.SG0,7 92067-16470 REV.1940 790201 * * * THE L.SG0 ROUTINE SETS UP CONDITIONS FOR ALL FUTURE SEGMENTS. * IT MUST ONLY BE CALLED ONCE AT THE END OF LOADING THE MAIN * AND BEFORE LOADING THE FIRST SEGMENT. * NOTE THAT IN FUTURE ENHANCEMENTS (MULTI LEVEL SEGMENTATION) * THIS ROUTINE WOULD BE CALLED TO SET CONDITIONS FOR EACH * LEVEL OF SEGMENTATION AND PROBABLY CALLED AGAIN WHEN MOVING * TO THE NEXT BRANCH OF THE TREE. * * * * CALLING SEQUENCE : JSB L.SG0 * DEF *+2 * DEF DUMMY (RESERVED FOR FUTURE) * ( SET TO 0 FOR NOW) * * ENT L.SG0 EXT .ENTR,CBP.L,LSY.L,SGB.L,SGM.L,SSG.L EXT TH2.L,CCPLK,CPL2,CPLS * A EQU 0 B EQU 1 * TEMPX NOP L.SG0 NOP JSB .ENTR DEF TEMPX * LDA CBP.L SAVE CURRENT BP LOCATION STA SGB.L * LDA LSY.L GET ADDRESS OF NEXT WORD FOR SYM TABLE STA SSG.L AND SAVE * LDA TH2.L GET HIGH ADDRESS + 1 SO FAR STA SGM.L * JSB CCPLK USE TO PACK CP LINK AREA BEFORE RESETTING * LDA CPL2 GET HIGH CP LINK SPECS STA CPLS SAVE AS TOP OF FIXED IMAGE * JMP L.SG0,I RETURN TO CALLER END ������������������������������������������������������������������������������������������������������������������������ÞË��� ���� �������� �������ÿÿ��������þúASMB,R,Q,C * NAME: L.SFT * SOURCE: 92070-18470 * RELOC: 92070-16470 * PGMR: B.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.SFT,7 92070-16470 REV.2026 800328 * * * L.SFT SCANS THE FIXUP TABLE OF THE LOADER LIBRARY FOR A * FIXUP POINTING AT THE CURRENT SYMBOL BEING PROCESSED. * THIS ROUNTINE IS USED TO DETERMINE WHICH LOCATIONS IN THE * PROGRAM BEING LOADED MAY NEED TO BE RELINKED TO THE SYSTEM * SNAP FILE. * * WARNING ANY CHANGES TO THE LOADER LIB MAY DAMAGE THIS ROUTINE * * CALLING SEQUENCE: A REG ADDRESS OF SYMBOL TABLE ENTRY BEING * SCANNED FOR * B REG 0 TO START * WORD 0 OF LAST FIXUP ENTRY SCANNED * ON SUBSEQUENT CALLS * JSB L.SFT * P+1 NO ENTRYS FOUND B REG END OF FIXUP TABLE * A REG UNCHANGED * P+2 ENTRY FOUND B REG WORD 0 0F ENTRY * A REG UNCHANGED * ENT L.SFT EXT FXS.L HIGHEST ADDRESS OF FIXUP TABLE( WORD 0) EXT FXN.L LOWEST ADDRESS OF FIXUP TABLE( WORD 0) * A EQU 0 B EQU 1 * N3 DEC -3 N1 DEC -1 * L.SFT NOP SZB,RSS INITIAL CALL? LDB FXS.L YES LOOP CPB FXN.L NO END OF FIXUP TABLE? JMP L.SFT,I YES NOT FOUND EXIT ADB N3 STEP TO SYMBOL TABLE ADDRESS OF ENTRY CPA B,I FIXUP FOR SYMBOL GIVEN IN CALL? JMP FND YES ADB N1 NO TRY NEXT ENTRY JMP ›M��� �� LOOP * FND ADB N1 STEP TO WORD 0 OF ENTRY ISZ L.SFT TAKE FOUND EXIT JMP L.SFT,I * END ������������������������������������������������������������������������������������������������������������������������������������öí ������ÿÿ��������þúASMB,R,L,C * NAME: L.MAT * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.MAT,7 92067-16470 REV.1940 790321 * * * * L.MAT FIXES UP PREVIOUS REFERENCES TO A MEMORY RESIDENT, * ABSOLUTE, OR RPL MICROCODE SYMBOL. * * * CALLING SEQUENCE: * JSB L.MAT * DEF *+5 * DEF ASYMB SYMBOL NAME ARRAY * DEF TYPE SYMBOL TYPE * DEF VALUE SYMBOL VALUE * DEF RESLT 0/1, USED/NOT USED * * ENT L.MAT EXT TBUF,L.SCN,LS4.L,LS5.L,FIXAL,.ENTR,.DFER EXT CPL1H,CPL2H,TMP1,TMP2,PPST * A EQU 0 B EQU 1 * ASYMM NOP ADDRESS OF SYMBOL NAME ARRAY TYPEM NOP ADDRESS OF TYPE WORD VALUM NOP ADDRESS OF SYMBOL VALUE RESLM NOP ADDRESS OF RESULT * * L.MAT NOP JSB .ENTR RETRIEVE PARAMETER ADDRESSES DEF ASYMM * JSB .DFER DEF TBUF DEF ASYMM,I * JSB L.SCN SCAN LST FOR MATCHING NAME JMP MAT00 NONE FOUND * LDA LS4.L,I ISOLATE STATUS BITS AND P7 CPA P2 UNDEFINED ? JMP MAT01 YES * MAT00 CLA,INA NO, NO FIXUP MAT02 STA RESLM,I RETURN RESULT FLAG JMP L.MAT,I * MAT01 LDA TYPEM,I SET NEW TYPE WORD ALF,ALF STA LS4.L,I LDA VALUM,I AND VALUE STA LS5.L,I * LDA CPL1H GET COUNT PRELINK STA TMP1 SAVE LDA CPL2H GET COUNT POSTLINK STA TMP2 & §H��� �� SAVE * JSB FIXAL FIX ALL REFERENCES TO THE SYMBOL * JSB PPST PST CP LNK IF CREATED * CLA RETURN "SYMBOL USED" JMP MAT02 * P2 DEC 2 P7 DEC 7 END ������������������������������������������ ������ÿÿ��������þúASMB,R,L,C * NAME: L.LDF * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH ,B.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.LDF,7 92067-16470 REV.2026 800331 * * * * L.LDF IS USED TO LIST ALL ENTRIES IN A MODULE. THE ROUTINE MAY BE * CALLED REPEATEDLY TO LIST ALL ENTRIES. ON FIRST CALL USER SETS * 'ADDRS' TO ZERO AND THE SYMBOL TABLE SEARCH IS DONE FROM THE FIRST * ENTRY. THE ADDRESS OF THE FIRST UNDEFINE SYMBOL IS RETURNED TO CALLER * AND ON SECOND CALL THIS UNMODIFIED 'ADDRS' WORD IS USED TO START THE * NEXT SCAN. WHEN THE END OF TABLE IS READ 'ADDRS' IS RETURNED * WITH A ZERO VALUE. * *BW 3/31/80 * ADDED OPTIONAL PARAMETER TO ALLOW THE SPECIFICATION OF AN OPTIONAL * NUMBER OF BITS IN THE SYMBOL TABLE TYPE WORD FOR STATUS SPECIFICATION. * * THIS IS DONE BY PROVIDING A MASK TO USE FOR MASKING THE STATUS FIELD * FROM THE TYPE WORD OF A SYMBOL TABLE ENTRY. THE MASK IS ANDED TO THE * TYPE WORD TO SELECT THE STATUS BITS USED TO DETERMINE IF A SYMBOL IS * UNDEFINED OR NOT. * * CALLING SEQUENCE: * JSB L.LDF * DEF RETURN * DEF ADDRS ADDRESS SYMBOL NAME, A-REG * DEF PNTR ADDRESS TO BE CARRIED, B-REG * DEF IGNO -1/1 DON'T IGNORE/IGNORE * ALREADY LISTED BIT * (OPTIONAL) DEF MASK MASK TO SELECT STATUS BITS. * ENT L.LDF EXT .ENTR,INLST,LSY.L * A EQU 0 B EQU 1 * L.LDF NOP LDA @P7 SET DEFAULT PARAMETERS ‰3��� ��  STA MASK LDA L.LDF SET RETURN ADDRESS FOR .ENTR CALL STA LLDF1 JMP LLDF2 * ADDRS NOP ADDRESS OF SYMBOL ARRAY PNTR NOP ADDRES TO BE CARRIED IGNO NOP -1/1 CK/NO CK ON ALREADY LISTED BIT MASK DEF P7 DEFAULT STATUS BITS MASK * LLDF1 NOP LLDF2 JSB .ENTR RETRIEVE PARAMETER ADDRESS DEF ADDRS * LDB PNTR,I SZB INITIALIZE LST ? JMP MARK MARK ENTRY AS LISTED * JSB INLST INITIALIZE LST JMP SCANT SCAN LST FOR NEXT ENTRY * MARK LDA B,I FIRST WORD IN SYMBOL NAME IOR B15 SET SIGN BIT STA B,I TO MARK SYMBOL AS LISTED NEXT ADB P5 GO TO NEXT SYMBOL SCANT CPB LSY.L END OF TABLE ? JMP ENDTB YES, RETURN 'END OF TABLE' TO CALLER LDA IGNO,I IGNORE ALREADY LISTED BIT? SSA,RSS WELL? JMP LDF1 YES, SO LIST IT ANYWAY LDA B,I SYMBOL ALREADY LISTED ? SSA JMP NEXT YES, EXAMINE NEXT ENTRY LDF1 LDA P3 INCREMENT TO LST4 ADA B LDA A,I AND MASK,I ISOLATE STATUS BITS CPA P2 UNDEFINED ? JMP NEXT YES RSS NO, DEFINED AND UNMARKED * ENDTB CLB STB ADDRS,I STB PNTR,I JMP LLDF1,I RETURN TO CALLER * * B15 OCT 100000 P2 DEC 2 P3 DEC 3 P5 DEC 5 @P7 DEF P7 P7 DEC 7 END ������������������������������������������������������������q› ������ÿÿ��������þúASMB,L,R,C * NAME: L.INT * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.INT,7 92067-16470 REV.1940 790201 * * * L.INT INITIALIZES PARAMETERS FOR THE LOADER LIBRARY SUB- * ROUTINES: * * 1. SYMBOL TABLE POINTERS ARE SET TO THE FIRST WORD OF * FREE SPACE. * 2. THE LAST WORD FREE SPACE IS SAVED AS AN UPPER BOUND ON * THE SYMBOL TABLE AND AS THE START OF THE FIXUP TABLE. * 3. THE FIRST WORD OF AVAILABLE BASE PAGE IS SAVED AS THE * BASE PAGE RELOCATION BASE ADDRESS. * 4. THE ADDRESS OF COMMON IS SAVED AS THE COMMON RELOCATION * BASE ADDRESS. IF ZERO, THE LOCAL COMMON FLAG IS SET. * 5. THE LENGTH OF COMMON IS SAVED FOR THE COMMON OVERFLOW * CHECK. * 6. THE FIRST WORD OF AVAILABLE PROGRAM AREA IS SAVED AS THE * ABSOLUTE FIRST WORD AVAILABLE, THE CURRENT MODULE FWA, THE * CURRENT SETMENT'S FWA, THE HIGH ADDRESS THIS MODULE, AND THE * HIGH ADDRESS THIS LOAD. * 7. THE PROGRAM LAST WORD AVAILABLE IS SAVED FOR THE CHECK * ON PROGRAM OVERFLOW. * 8. THE TABLE ADDRESS IS SAVED. * 9. THE INITIAL POINTER TO THE DUMMY CURRENT PAGE LINK * AREA IS SET. * * * * CALLING SEQUENCE: * JSB L.INT * DEF *+8 * DEF FWAFS FIRST WORD AVAILABLE FREE SPACE * DEF LWAFS LAST WORD AVAILABLE FREE SPACE * DEF BPFWA FIRST WORD AVAILABLE BASE PAGE * DEF COM.L ADDRESS SYSTEM COMMON OR ZERO * :D������þú DEF COMLN LENGTH OF COMMON * DEF PGFWA FIRST WORD AVAILABLE PROGRAM * DEF PGLWA LAST WORD AVAILABLE PROGRAM * DEF TABLE TABLE OF SUBROUTINE ADDRESSES * * ENT L.INT EXT .DFER,.ENTR,BPR.L,CAD.L,CBP.L,COMIN EXT DCPA,FXN.L,FXS.L,LWA,LSY.L EXT MXCOM,SGB.L,SSG.L,SYM.L,TH1.L,TH2.L EXT TBLE,TSY.L,URFWA EXT CPLS,CPL1,CPL2,LNKS,LNK1,LNK2,LNK3,LNK4 EXT DCPEN,NGEND * A EQU 0 B EQU 1 * AGMTS BSS 8 L.INT NOP JSB .ENTR RETRIEVE PARAMETER ADDRESSES DEF AGMTS * LDA AGMTS,I FIRST WORD AVAILABLE FREE SPACE STA SYM.L FIRST WORD SYMBOL TABLE STA TSY.L FRIST WORD CURRENT ENTRY IN SYMBOL TABLE STA SSG.L FIRST WORD SEGMENT ENTRY IN SYMBOL TABLE STA LSY.L LAST WORD OF SYMBOL TABLE LDA AGMTS+1,I LAST WORD FREE SPACE STA FXS.L LAST WORD AVAILABLE STA FXN.L TOP ENTRY IN FIXUP TABLE LDA AGMTS+2,I FIRST WORD USER BASE PAGE STA BPR.L BASE PAGE RELOCATION BASE STA CBP.L USERS BP LOCATION INDICATOR TOO STA SGB.L LDA AGMTS+3,I ADDRESS SYSTEM COMMON STA CAD.L OR 0 FOR LOCAL OR NO COMMON SZA LOCAL OR NO COMMON ? JMP XX1 NO, SYSTEM COMMON DECLARED CCB STB COMIN SET COMMON TYPE FLAG JMP XX2 XX1 LDA AGMTS+4,I COMMON LENGTH STA MXCOM SAVE AS MAXIMUM COMMON ALLOWED XX2 LDA AGMTS+5,I FIRST WORD AVAIL PROGRAM AREA STA URFWA CURRENT MODULE FIRST WORD AVAIL STA TH1.L HIGH ADDRESS THIS MODULE STA TH2.L HIGH ADDRESS THIS LOAD LDA AGMTS+6,I USER PROGRAM LAST WORD AVAIL STA LWA AND SAVE JSB .DFER DEF TBLE+0 DEF AGMTS+7,I LDA DCPA SET TO TOP OF DUMMY AREA STA CPLS TOP OF FIXED CP LINK AREA STA CPL1 ¼Å����� ADDR OF PRELINK SPECS STA CPL2 ADDR OF POSTLINK SPECS JSB LNKS SET UP SPECS CLA CLEAR REAL ADDR STA LNK1,I STA LNK2,I STA LNK3,I LDA LNK4 SET DUMMY IMAGE ADDRESS INA STA LNK4,I LDA DCPEN GET PTR TO END CMA,INA AND SAVE IT STA NGEND AS A NEGATIVE VALUE JMP L.INT,I AND RETURN END ��������������������������������������������������������������������������������������������������€������ÿÿ��������þúASMB,R,L,C * NAME: L.IFX * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.IFX,7 92067-16470 REV.1940 790321 * * * * * THIS ROUTINE IS CALLED TO CLEAN UP THE FIXUP TABLE IF A * SEGMENT IS TO BE FORCE LOADED. * * CALLING SEQUENCE: * * JSB L.IFX * DEF *+1 * * ENT L.IFX EXT SILST,SCLST,LS1.L,LS4.L EXT FIXAL,CPL1H,CPL2H,TMP1,TMP2,PPST EXT SCLST * A EQU 0 B EQU 1 * L.IFX NOP ISZ L.IFX SKIP RETURN ADDRESS * JSB SILST INITIALIZE LST TO START OF SEGMENT SYMBOLS LDA CPL1H GET COUNT PRELINK AREA STA TMP1 SAVE IT LDA CPL2H GET COUNT POSTLINK AREA STA TMP2 &STORE OFF * FIXC0 JSB SCLST SEARCH FOR NEXT UNDEF JMP FIXCP GO TAKE CARE OF POSSIBLE LINKS * STB LS1.L LDA M2000 SET TYPE TO 4 (IN HIGH BYTE) STA B,I DEFINE THE SYMBOL INB AND ITS VALUE CLA STA B,I TO ZERO JSB FIXAL GO DO ALL FIXUPS LDB LS4.L RESTORE B ADB P2 INCREMENT TO NEXT LST ENTRY JMP FIXC0 AND CONTINUE THE LOOP * * * FIXCP JSB PPST GO TAKE CARE OF POSSIBLE LINKS JMP L.IFX,I RETURN M2000 OCT 2000 P2 DEC 2 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������g��� ���� �������� �������ÿÿ��������þúASMB,R,L,C * NAME: L.ADD * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.ADD,7 92067-16470 REV.1940 790321 * * * * * L.ADD RETRIEVES THE VALUE OF A SYMBOL FROM ITS ENTRY IN THE * SYMBOL TABLE. THE FIVE CHARACTER SYMBOL NAME (FOR NOW) IS MOVED * INTO TBF.L AND THE ENTIRE SYMBOL TABLE SCANNED TILL A MATCHING * SYMBOL NAME IS FOUMND. THE VALUE RETURNED IN 'RESLT' IS SHOWN * BELOW. IF THE VALUE IN THE SYMBOL TABLE IS A BASE PAGE LINK * ADDRESS THE ACTUAL ADDRESS IS RETRIEVED AND RETURNED. NOTE THAT * THIS WILL BE THE CASE ONLY FOR AN EMA ARRAY NAME. * * * CALLING SEQUENCE: * JSB L.ADD * DEF *+3 RETURN ADDRESS * DEF ASYMA ADDRESS OF SYMBOL NAME ARRAY * DEF VALUA VALUE OF SYMBOL * DEF SADDR LST ENTRY ADDRESS * DEF RESLT 0 = OK, * 1 = NOT FOUND, * 2 = UNDEFINED. * * ENT L.ADD EXT .DFER,.ENTR,L.SCN,LS1.L,LS4.L,LS5.L EXT TBUF * A EQU 0 B EQU 1 * ASYMA NOP ADDRESS OF SYMBOL NAME ARRARY VALUA NOP ADDRESS OF VALUE OF SYMBOL SADDR NOP ADDRESS OF ADDRESS OF LST ENTRY RESLA NOP ADDRESS OF RESULT FLAG * L.ADD NOP JSB .ENTR RETRIEVE PARAMETER ADDRESSES DEF ASYMA * JSB .DFER DEF TBUF DEF ASYMA,I * JSB L.SCN SCAN ALL OF LST FOR SYMBOL NAME Ém��� ��  JMP ADD01 SYMBOL NOT FOUND IN LST * LDB LS1.L SYMBOL FOUND STB SADDR,I RETURN ENTRY ADDRESS LDA LS4.L,I EXAMINE SYMBOL STATUS AND P7 ISOLATE STATUS BITS CPA P2 SYMBOL UNDEFINED ? JMP ADD00 YES * LDA LS5.L,I NO, STATUS = DEFINED STA VALUA,I RETURN VALUE OF SYMBOL CLA,RSS ADD01 CLA,INA ADD00 STA RESLA,I JMP L.ADD,I RETURN TO CALLER P2 DEC 2 P7 DEC 7 END ������������������������Ü¢ ������ÿÿ��������þúASMB,R,L,C * NAME: L.LUN * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH, B.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.LUN,7 92067-16470 REV.2026 800331 * * * L.LUN ENABLES USER TO LIST THE CURRENT UNDEFINED EXTERNALS IN * THE ENTIRE SYMBOL TABLE OR CURRENT MAIN OR SEGMENT'S ENTRIES. * L.LUN IS CALLED REPEATEDLY WITH 'PNTRL' SET TO ZERO ON FIRST * ENTRY. ON RETURN 'ADDRL' POINTS TO THE NAME OF THE NEXT UNDEF * OR HAS VALUE ZERO IF THE END OF TABLE WAS REACHED. * *BW 3/31/80 * ADDED OPTIONAL PARAMETER TO ALLOW THE SPECIFICATION OF AN OPTIONAL * NUMBER OF BITS IN THE SYMBOL TABLE TYPE WORD FOR STATUS SPECIFICATION. * * THIS IS DONE BY PROVIDING A MASK TO USE FOR MASKING THE STATUS FIELD * FROM THE TYPE WORD OF A SYMBOL TABLE ENTRY. THE MASK IS ANDED TO THE * TYPE WORD TO SELECT THE STATUS BITS USED TO DETERMINE IF A SYMBOL IS * UNDEFINED OR NOT. * * CALLING SEQUENCE: * JSB L.LUN * DEF *+4 * DEF ADDRL ADDRESS OF SYMBOL NAME ARRAY,B-REG * DEF PNTRL ADDRESS POINTER TO BE CARRIED * DEF MNSEG 0 = CURRENT MAIN OR SEG'S ENTRIES * 1 = ENTIRE TABLE SCANNED. * (OPTIONAL) DEF MASK MASK TO SELECT STATUS BITS * ENT L.LUN,SCLST EXT .ENTR,INLST,LSY.L,SILST * A EQU 0 B EQU 1 * L.LUN NOP LDA @P7 SET DEFAULT STATUS BITS MASK STA MASK FOR OPTIONAL PARAMETER. LDA L.LUN SETUP .ENTR CALL TO GET PARMS STA LUNI<ù��� �� N JMP LUNGT * ADDRL NOP ADDRESS OF SYMBOL NAME ARRAY PNTRL NOP ADDRESS POINTER TO BE CARRIED MNSGL NOP ADDRESS OF MAIN SEGMENT FLAG MASK DEF P7 DEFAULT STATUS BITS MASK * LUNIN NOP LUNGT JSB .ENTR RETRIEVE PARAMETER ADDRESSES DEF ADDRL * LDB PNTRL,I IS THIS THE FIRST CALL TO L.LUN ? SZB,RSS JSB INITL YES, INITIALIZE POINTER * JSB SCLST FIND NEXT UNDEF CLB NONE FOUND STB ADDRL,I STA PNTRL,I JMP LUNIN,I RETURN TO CALLER * INITL NOP LDA MNSGL,I MAIN OR CURRENT MODULE ? JSB SILST DEFAULT TO CURRENT MOD'S SZA JSB INLST ENTIRE LST TO BE EXAMINED JMP INITL,I * SCLST NOP EXMIN CPB LSY.L END OF TABLE ? JMP SCLST,I YES, NONE FOUND ADB P3 NO LDA B,I AND MASK,I ISOLATE STATUS BITS ADB P2 CPA P2 UNDEFINED ? JMP FOUND JMP EXMIN AND EXAMINE FOUND LDA B ADB N5 SET UP ADDRL VALUE ISZ SCLST BUMP RETURN ADDRESS TO P+2 JMP SCLST,I AND RETURN * * P2 DEC 2 P3 DEC 3 N5 DEC -5 @P7 DEF P7 P7 DEC 7 END ��������������������Z´ ������ÿÿ��������þúASMB,R,L,C * NAME: L.REL * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH, ATL, BW * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.REL,7 92067-16470 REV.2026 800507 * * ENT L.REL,TBLE ENT COMIN,DCPA,DCPEN,INLST,L.SCN,PPST ENT LWA,LS1.L,LS2.L,LS3.L,LS4.L,LS5.L,FIXAL ENT MXCOM,SELST,SILST,TBUF,URFWA ENT CPLS,CPL1,CPL2,CPL1H,CPL2H ENT LNKS,LNK1,LNK2,LNK3,LNK4 ENT NGEND,TMP1,TMP2,CCPLK ***********************DEBUGGING STUFF***************** * ENT STLK,REEN,DUEN,PLCT * ENT EUSED ***********************END OF DEBUGGING STUFF********** EXT .ENTR,.MVW,INL.L EXT CAD.L,CBP.L,CPL.L,COM.L,EMA.L,FXN.L EXT IGN.L,LBS.L,MSG.L,NM1.L,NM2.L,NM3.L EXT NM1.L,SYM.L,TH1.L,TH2.L,RBT.L,SGB.L EXT LSY.L,PRI.L,TSY.L,EMS.L,SEG.L,PGT.L EXT BPR.L,NOR.L,FXS.L,NM4.L,SSG.L,SGM.L EXT EBP.L,L.BUF,RIC.L,PGL.L * A EQU 0 B EQU 1 * LS1.L NOP WORD ONE ADDRESS OF CURRENT LST ENTRY LS2.L NOP WORD TWO ADDRESS OF CURRENT LST ENTRY LS3.L NOP WORD THREE ADDRESS OF CURRENT LST ENTRY LS4.L NOP WORD FOUR ADDRESS OF CURRENT LST ENTRY LS5.L NOP WORD FIVE ADDRESS OF CURRENT LST ENTRY HED SEARCH SYMBOL TABLE ROUTINE * * * L.SCN SEARCHES FOR AN ENTRY IN LST IDENTICAL TO THE NAME IN TBUF. * IF FOUND RETURN IS TO P+2, B-REG IS SET TO THE ENTRY ADDRESS, AND * LS1.L -5 POINTERS ARE SET UP. IF NONE FOUND RETURN IS TO P+1, B-REG * IS SET TO THE NEXT AVAILABLE LST ENTRY ADDRESS, LS1.L -5 SET UP * ACCORDINGLY, AND A-REG<0 INDI]|������þúCATES SYMBOL TABLE OVERFLOW. * * ON RETURN: * A-REG >= 0, ALLS WELL, * < 0, SYMBOL TABLE OVERFLOW * B-REG = SYMBOL TABLE ENTRY ADDRESS * * L.SCN NOP JSB INLST INITIALIZE LST TO START LSC01 CPB LSY.L END OF LST ? JMP SLSTS YES - GO MAKE NEW ENTRY LDA B,I RAL,CLE,ERA CPA TBUF NAME 1,2 EQUAL ? JMP *+3 YES ADB P5 JMP LSC01 NO - CHECK NEXT ENTRY INB LDA B,I CPA TBUF+1 NAME 3,4 EQUAL ? JMP *+3 ADB P4 JMP LSC01 NO - CHECK NEXT ENTRY INB LDA B,I AND M7400 MASK OFF ORDINAL STA TBUF+3 LDA TBUF+2 AND M7400 MASK IN NAME 5 CPA TBUF+3 NAME 5 EQUAL ? JMP *+3 YES - SET LS1.L -5 ADDRES ADB P3 JMP LSC01 ADB N2 BACK UP TO LS1.L STB TSY.L AND SET UP TO CALL LSTX JSB LSTX FAKE IT HLT 1 I ALREADY CHECKED!! ISZ L.SCN SET FOR (P+2) RETURN JMP L.SCN,I SLSTS STB TSY.L (FOR LSTX TO USE) JSB LSTX ** RETURN MUST ALWAYS BE (P+1) ** JMP L.SCN,I RETURN (P+1) HLT 2 N2 DEC -2 SKP * * SET NAME INTO LST * * SELST SETS THE CURRENT NAME INTO LST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SELST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SELST NOP LDA TBUF GET NAME 1,2 STA LS1.L,I SET NAME 1,2 INTO LST. LDA TBUF+1 GET NAME 3,4 STA LS2.L,I SET NAME 3,4 INTO LST LDA TBUF+2 GET NAME 5 AND M7400 ISOLATE UPPER CHAR STA LS3.L,I SET NAME 5 INTO LST LDA TSY.L GET NEXT LST ADDR STA LSY.L SET NEW END OF LST JMP SELST,I RETURN * * * * * THE INLST AND LSTX SUBROUTINES SET THE ADDRES FOR THE CURRENT * ENTRY IN THE LOADER SYMBOL TABLE (LST). * * A†������þú INITIALIZE LSTX * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST IN TSY.L. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INLST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INLST NOP LDB SYM.L GET STARTING ADDR OF LST STB TSY.L SET CURRENT LST ADDR JMP INLST,I RETURN * * SPECIAL ROUTINE "SILST" * * THIS ROUTINE INITIALIZES THE LST FOR THE * SEGMENT AREA ONLY, IF MAIN/SEGMENT * LOADING IS BEING DONE. IT USES THE CONTENTS * OF "SSG.L" - SSG.L IS INITIALIZED TO BE = TO * "SYM.L" BUT IS CHANGED AFTER THE "MAIN" PROG * IS LOADED TO BE THE ADDR OF THE ENTRY * FOLLOWING THE LAST ENTRY FOR THE MAIN. * * SAME CALLING SEQUENCE AS FOR "INLST". * SILST NOP LDB SSG.L SET SEGMENT LST ADDR STB TSY.L AS CURRENT ADDR. JMP SILST,I * * * SET CURRENT LST ADDRES * * THE LSTX SUBROUTINE SETS THE CURRENT LST ADDRES FROM TSY.L. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * LSTX NOP LDA TSY.L GET CURRENT LST ADDR CPA LSY.L END OF LST? RSS YES - CONTINUE ISZ LSTX NO - INCR RETURN ADDR STA LS1.L SET WORD 1 ADDR INA STA LS2.L SET WORD 2 ADDR INA STA LS3.L SET WORD 3 ADDR INA STA LS4.L SET WORD 4 ADDR INA STA LS5.L SET WORD 5 ADDR INA STA TSY.L SET NEXT LST ADDR CMA ADA FXN.L ADD FWA OF DUMMY ID SEGMENT AREA LDB TSY.L JMP LSTX,I RETURN < 0 FOR SYMBOL TABLE OVERFLOW, * >= 0 FOR NO ERROR SKP * * * PPST POSSSIBLE POST OF CURRENT PAGE LINKS * CALCULATES IF ANY CREATED USING TMP1,TMP2 * AS THE OLD VALUES TO COMPARE WITH AND CALLS * û������þúPSTCP IF NECESSARY * * * PPST NOP LDA CPL1H GET COUNT FOR PRELINK CMA,INA MAKE IT NEG ADA TMP1 ADD OLD VALUE SSA,RSS IS ANS NEG? JMP CKH1 NO,THEN NO MORE LINKS ADDED LDA CPL1 YES, SET UP TO POST JSB PSTCP CKH1 LDA CPL2H GET COUNT FOR POST LINK CMA,INA MAKE IT NEG ADA TMP2 ADD OLD POSTLINK SSA,RSS ANY MORE LINKS? JMP PPST,I NO, THAT'S ALL THERE IS LDA CPL2 YES, THEN SET UP TO POST POST AREA JSB PSTCP JMP PPST,I RETURN SKP HED RELOCATE THE RECORD * * * THE L.REL ROUTINE IS CALLED BY THE USER WHENEVER HE WISHES TO * RELOCATE A RECORD THE TYPE IS ASSUMED TO BE IN ' RIC.L ' WHICH * WAS FILLED IN BY THE L.CLS ROUTINE. L.CLS MUST HAVE BEEN * CALLED BEFORE L.REC SO THAT THE PROPER TYPE IS KNOWN. THE * RECORD TO RELOCATE WILL BE IN L.BUF . * * * CALLING SEQUENCE JSB L.REL * DEF RETRN * DEF FLAG * * * ON RETURN FLAG = A-REG * = 0 ALLS WELL * = - # IS ERROR CODE * * * ERROR CODES * --------------- * * * -1 CHECKSUM ERROR * -2 ILLEGAL RECORD * -3 MEMORY OVERFLOW (PROGRAM TO LARGE) * -4 FIXUP TABLE OVERFLOW * -5 SYMBOL TABLE OVERFLOW * -6 COMMON BLOCK ERROR * -7 DUPLICATE ENTRY POINT * -8 RECORD OUT OF SEQUENCE * -9 ASMB PRODUCED ILLEGAL RECORD (NOT ME BOSS !!!) * -10 EMA DECLARED TWICE OR IN A SEGMENT * -11 ATTEMPT TO REFERENCE AN EMA EXTERNAL WITH OFFSET OR INDIRECT. * * * * FLAG NOP L.REL NOP JSB .ENTR DEF FLAG * * LDA RIC.L GET REC IDENTIFICATION CODE LDB NM1.L GET LOADING FLAG CPA P1 TYPE = NAM ? JMP NAMRX YES - PROCESS NAM REC Vž������þúCPA P7 ASCII IDENTIFIER ?? JMP ASCII YES - LET THE USER PROCESS IT SZB SKIP - NOT LOADING JMP NMERR REC OUT OF SEQUENCE CPA P2 TYPE = ENT? JMP ENTR YES - PROCESS ENT REC CPA P3 TYPE = DBL? JMP DBLR YES - PROCESS REC CPA P4 TYPE = EXT? JMP EXTR YES - PROCESS EXT REC CPA P6 TYPE = EMA? JMP EMARC YES - PROCESS EMA RECORD JMP ENDIT MUST BE AN END RECORD . * * * NMERR LDA N8 -8 IS RECORD OUT OF SEQUENCE ERROR JMP RETRN * P6 DEC 6 P4 DEC 4 P1 DEC 1 ADDR NOP ADDRESS OF ABSOLUTE WORD TO OUTPUT VALUE NOP THE VALUE TO PUT INTO ABOVE ADDRESS * * HED ASCII RECORD PROCESSOR * * ******************** ASCII RECORD PROCESSOR ************************ * ASCII JMP OK2GO ASCII IDENT PROCESSOR * * HED END RECORD PROCESSOR * * * ********************* END RECORD PROCESSOR ************************* SPC 2 * * ENDIT LDA IGN.L SZA,RSS LATEST SUBROUTINE LOADED ? JMP RESET YES, PROCESS AS NORMAL. * LDA BID3 NO, THEN RESTORE CURRENT STA CBP.L FW AVAILABLE ON BASE PAGE. LDA BID4 AND END OF LST. STA LSY.L LDA BID2 AND PRG BASE ADDR. STA TH1.L LDA CPLX AND HIGH CP LNK SPECS. STA CPL2 STA CPL1 AND LOW CP LNK SPECS. LDA CPLXH AND # OF CP LNKS IN AREA. STA CPL2H STA CPL1H LDA CPXND AND END+1 OF REAL CP AREA STA CPEND STA PLEND * JMP CLORD MAKE ALLS WELL RETURN * RESET LDB PGL.L GET LEN WORD SSB IF COMPILER PRODUCED JMP MAPP1 FORGET THE BSS FILL OR COM FILL * ADB N1 ELSE SET TO RELATIVE ADDR OF ADB TH1.L GET REAL CORE ADDR STB A INA ‘¢������þú CPA TH2.L WAS IT LOADED? JMP MAPP1 YES SKIP THE FILL * CLA NO FILL THE BSS WITH ZERO'S STA VALUE SAVE THE VALUE TO OUTPUT STB ADDR SAVE ADDRESS OF LAST WORD OF MODULE JSB ABOUT,I OUTPUT FILL WORDS DEF *+3 DEF ADDR ADDRESS DEF VALUE VALUE TO PUT INTO ADDRESS * MAPP1 LDA MCOMX GET COMMON LENGTH OF LAST MODULE CMA,INA SUBTRACT FROM INITIAL SET LENGTH ADA MXCOM SSA,RSS IF SAME OR LESS JMP NOCLR THEN OK * CMERR LDA N6 GET THE COMMON ALLOC ERROR CODE JMP RETRN & MAKE ERROR RETURN * NOCLR LDA L.BUF+1 GET PRIMARY ENTRY POINT FLAG SLA,RSS SKIP - HAS PRIMARY ENTRY POINT JMP NOPRE OMIT PROCESSING NO ENTRY POINT * LDA L.BUF+3 GET WORD 3 OF END REC ADA TH1.L ADD PROG RELOC BASE STA PRI.L PRIMARY ENTRY POINT ADDRESS WORD JMP CLORD NOW GO CLEAR THE ORDINALS * NOPRE CLA NO PRIMARY ENTRY POINT STA PRI.L * CLORD CCA STA NM1.L SET THE LOOK FOR NAM FLAG * JSB INLST INITIALIZE LSTX LDB TSY.L CPORD CPB LSY.L END OF LST ? JMP DONE YES - POST THE CP LINKS FOR THIS AREA ADB P2 CLEAR POSSIBLE ORDINAL LDA B,I FROM LST 3. AND M7400 STA B,I ADB P3 JMP CPORD CONTINUE CLEARING PROG ORDINALS * DONE LDA IGN.L IF NOTHING LOADED SZA THEN JMP SLTST NO LINKS TO DO LDA CPL1 GET PTR TO PRELINK AREA JSB PSTCP OUTPUT IT ********************DEBUGGING STUFF****************** * LDA LNK1,I * STA STLK * LDA LNK2,I * STA REEN * LDA LNK3,I * STA DUEN ********************END DEBUGGING STUFF************** LDA CPL2 GET PTR TO POSTLINK AREA JSB PSTCP AND OUTPUT * JMP SLTST SET UP NEXT OPERATION SPC 1 * OK2GO EQU * Ü������þú *** SUCCESSFUL RETURN *** SLTST CLA MAKE A SUCCESSFUL RETURN RETRN STA FLAG,I JMP L.REL,I * *********************DEBUGGING STUFF*********** *STLK NOP *REEN NOP *DUEN NOP *PLCT NOP *EUSED NOP *********************END DEBUGGING STUFF******* COMIN NOP COMMON DECLARATION FLAG MCOMX NOP LENGTH OF LAST COMMON DECLARATION ENCOUNTERED MXCOM NOP INITIAL LENGTH OF COMMON NGCNT NOP NEGATIVE LINK COUNT CURAD NOP CURRENT ADDR TO WRITE TO CURLN NOP CURRENT LINK TO WRITE OUT N6 DEC -6 P2 DEC 2 N1 DEC -1 SKP * * PSTCP * CURRENT PAGE LINKS FOR THE AREA SPECIFIED BY * LNK1,LNK2,LNK3,AND LNK4 ARE WRITTEN TO THE DISK * CALLING SEQUENCE: * A-REG = FIRST WORD ADDRESS OF LINK AREA * JSB PSTCP * * * PSTCP NOP JSB LNKS SET UP LNK1,LNK2,LNK3,LNK4 * LDA LNK1,I GET THE CMA,INA NUMBER OF ADA LNK3,I WORDS TO OUTPUT CMA,INA,SZA,RSS IF ZERO JMP PSTCP,I RETURN * STA NGCNT ELSE STORE NEGATIVE COUNT * LDA LNK4,I GET THE ADDR OF 1ST LINK STA CURLN AND SET IT LDB LNK1,I GET THE ADDR TO WRITE TO STB ADDR AND SET * NXTLK LDB ADDR ADDR TO B REG LDA CURLN,I WORD TO A REG STA VALUE AND TO VALUE * JSB ABOUT,I GO DO IT DEF *+3 DEF ADDR DEF VALUE * ISZ ADDR GET THE NEXT ADDRESS ISZ CURLN GET PTR TO NEXT VALUE ISZ NGCNT WE DONE? JMP NXTLK NOPE JMP PSTCP,I YES RETURN SKP HED EMA RECORD PROCESSOR * ********************* EMA RECORD PROCESSOR ************************* * * * * EMARC LDA LBS.L GET THE LIB SCAN FLAG SZA WE SCANNING ? JMP OK2GO YES SO IGNOR THE WHOLE THING * LDA EMA.L ANY PREVIOUS DECELERATION ? SZA §³������þúWELL ? JMP LL19 YES, ITS AN ERROR * LDB ALBUF GET THE RECORD BUFFER ADDRESS INB INDEX TO EMA WORD LDA B,I & PULL IT IN AND B1777 KEEP ONLY EMA SIZE STA EMS.L * ADB P2 NOW GET THE SYMBOL NAME LDA B,I CHARS 1 & 2 STA TBUF * INB CHARS 3 & 4 LDA B,I STA TBUF+1 * INB CHAR 5 & ORDINAL # LDA B,I STA TBUF+2 * INB & SEG.L SIZE LDA B,I AND M37 STA MSG.L * JSB L.SCN SEE IF THIS SYMBOL PREVIOUSLY REFERENCED RSS JMP LL19 AN ERROR SSA SYMBOL TABLE OVERFLOW? JMP SOV YES, THIS IS AN ERROR TOO! LDA SEG.L IS THIS A SEGMENT ? CPA P2 WELL ? JMP LL19 THATS AN ERROR ALSO * LDA TBUF NOW PUT THE LABEL IN THE SYMBOL TABLE STA LS1.L,I LDA TBUF+1 STA LS2.L,I LDA TBUF+2 STA LS3.L,I * LDA TSY.L UPDATE END OF SYMBOL TABLE STA LSY.L * LDA B200 NOW SET SYM TABLE V BIT ADA P3 SET SYMBOL AS EMA TYPE(DEFINED) STA LS4.L,I & PUT IN SYMBOL TABLE * JSB ALLOC,I GET A BP LINK DEF *+3 DEF DUMMY DEF REAL LDA REAL GET THE REAL BP ADDRESS LDB DUMMY GET THE DUMMY BP ADDRESS * STA LS5.L,I & PUT ABS ADDRESS IN TABLE STB EMA.L SAVE DUMMY ADDRESS LOCALLY * JMP OK2GO GET THE NEXT RECORD * LL19 LDA N10 JMP RETRN SOV LDA N5 JMP RETRN * * N10 DEC -10 B1777 OCT 1777 M37 OCT 37 B200 OCT 200 REAL NOP REAL BP ADDRESS RETURNED BY ALLOC DUMMY NOP DUMMY BP ADDRESS RETURNED BY ALLOC TBUF BSS 5 TEMP ARRAY FOR CURRENT SYMBOL BEING WORKED ON * HED NAM RECORD PROCESSOR * ********************* NAM RECORD PROCESSOR ************************* * * Éd������þú * NAMRX ISZ NM1.L SKIP - VALID REC SEQUENCE JMP NMERR REC OUT OF SEQUENCE * CLA SET UP FLAG TO 'NOT IGNORE' STA IGN.L * LDA CBP.L SET UP THE BASE PAGE BASE ADDRESS STA BPR.L * LDA TH2.L SET UP THE PROGRAM BASE ADDRESS STA TH1.L STA BID2 SAVE IT TOO * JSB CCPLK CLEAN UP THE CURRENT PAGE LINK AREA LDA CPL2 SAVE HIGH CP LINK SPECS STA CPLX IN CASE MODULE NOT LOADED LDA CPL2H SAVE # OF LNKS IN AREA STA CPLXH IN CASE MODULE NOT LOADED LDA CPEND SAVE END +1 STA CPXND IN CASE MOD NOT LOADED * LDA L.BUF+6 GET THE PROGRAM LENGTH (I HOPE) STA PGL.L * LDA L.BUF+9 GET PGM TYPE STA PGT.L AND SAVE IT. * JSB GETCP GET AN AREA JSB SETPL USE IT FOR PRELINK SET UP JSB CLRCP ZERO OUT THE LINKS CLA STA CPL1H RESET COUNT FOR PRELINKS STA CPL2H RESET COUNT FOR POSTLINKS ***************************DEBUGGING STUFF************ * STA PLCT *********************END DEBUGGING STUFF************** * * LDA L.BUF+3 GET PROG NAME 1,2 STA NM2.L+2 SET NAME INTO MEMORY MAP LDA L.BUF+4 GET PROG NAME 3,4 STA NM2.L+3 SET NAME IN MEMORY MAP LDA L.BUF+5 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR B40 ADD BLANK CHAR STA NM2.L+4 SET NAME IN MEMORY MAP LDA P3 AND # OF WORDS STA NM2.L+1 * CLA CLEAR INTERUPTABLE COUNT STA MCON1 STA MCON2 STA NM3.L+1 AND # WORDS IN NAM COMMENT FIELD * LDA TIMER SOURCE IS L.BUF+10 LDB DNPAR DESTINATION IS NM4.L+1 JSB .MVW MOVE PRI, EX, MUL,HRS,MINS,SECS,&10S OF MS DEF P7 MOVE 7 WORDS MCON1 NOP INTERUPT COUNT FOR MICRO CODE * LDA L.BUF GET THE REC LENGTH ALF,ALF AND ADA Å7������þúN17 SUBTRACT 17 SSA IF NAM REC > 17 WORDS JMP NONAM * STA NM3.L+1 THEN A COMMENT SO, SAVE # OF WORDS LDA SORC1 GET SOURCE ADDRESS L.BUF+17 LDB SORC2 &DESTINATION ADDRESS NM3.L+2 JSB .MVW GO MOVE THE WORDS DEF NM3.L+1 MCON2 NOP INTERUPT COUNT FOR MICRO CODE * * NONAM LDA L.BUF+8 GET COMMON LENGTH STA MCOMX SET COMMON LENGTH FOR THIS MODULE * SZA,RSS SKIP - HAS COMMON JMP COMOK NO COMMON, TEST B.P. LENGTH * LDB LBS.L IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP COMOK * ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP COMOK ASSUME COMMON OK TILL 'END' IS READ * LDB URFWA GET THE BASE LOAD ADDRESS CPB TH2.L COMPARE TO HIGH MAIN RSS = , SO COMMON DECLRATION OK JMP CMERR COMMON ERROR STA COM.L FIRST COMMON, SET MAX LENGTH STA MXCOM LDB TH1.L STB CAD.L AND SET THE ADDRESS AS WELL * ADA B STA TH1.L SET AS LOW PROG BOUND * * LDA LWA CMA,INA COMPUTE LENGTH LEFT OVER AFTER ADA TH1.L COMMON ALLOCATION. SSA SKIP IF INVALID COMMON LENGTH JMP COMOK COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LDA N3 RETURN MEMORY OVERFLOW JMP RETRN * COMOK JSB GETCP GET ANOTHER AREA JSB SETCP SET UP CP POST LINK AREA CLA SET UP FLAG TO STA NM1.L "NAM HAS BEEN READ" * LDA LSY.L SAVE STA BID4 END OF LST ADDR * LDA CBP.L NEXT AVAILABLE WORD ADDR ON BP STA BID3 * CCA LDB LBS.L GET THE LIB SCAN FLAG SZB WE SCANNING ? STA IGN.L YES, SET FLAG "TO IGNORE" LDA L.BUF+7 GET BP LENGTH SZA,RSS ANY BP RELOCATION ? Ø������þú JMP OK2GO NO, THEN GET NEXT REC. CMA,INA SET NEGATIVE LENGTH OF STA ABT1 BASE PAGE AREA NEEDED. BPCLR JSB ALLOC,I MOVE CBP.L BY SAME DEF *+3 DEF DUMMY DUMMY BP ADDRESS DEF REAL REAL BP ADDRESS * ISZ ABT1 ZEROED AND MOVED ALL ? JMP BPCLR NO, THEN DO MORE. * LDA CBP.L GET THE BASE PAGE LOAD ADDRESS CMA,INA NOW IF THE NEW START BP IS LOWER ADA BPR.L THEN LINKS ARE BEING ALLOCATED FROM SSA TOP DOWN & NEW BASE NEEDED. JMP OK2GO CLA,INA ADA CBP.L SET THE NEW BASE PAGE RELOCATION STA BPR.L ADDRESS. JMP OK2GO GET THE NEXT RECORD. * URFWA NOP LOAD POINT FOR THIS PROGRAM (NOT THIS MODULE) LWA NOP HIGHEST ADDRESS THIS PROGRAM CAN GO TO. BID2 NOP PROG BASE ADDRESS @ START OF THIS MODULE BID3 NOP BASE PAGE ADDRESS @ START OF THIS MODULE BID4 NOP LWA OF LST @ START OF THIS LOAD ABT1 NOP TEMP FOR # OF BP LINKS TO ALLOCATE P3 DEC 3 N3 DEC -3 P5 DEC 5 TIMER DEF L.BUF+10 DNPAR DEF NM4.L+1 SORC1 DEF L.BUF+17 SORC2 DEF NM3.L+2 P7 DEC 7 N17 DEC -17 B40 OCT 40 M7400 OCT 177400 * SKP * * * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF * LINKS AREAS NO LONGER ACTIVE * * CALLING SEQUENCE: * A REG = CURRENT RELOCATE ADDRESS * JSB CCPLK * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE CPLS AND * REFER TO AN AREA ON A PAGE BELOW THE PAGE ADDRESS IN THE * A REG. IT ALSO WILL DELETE ALL ZERO LENGTH AREAS. * * * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CUNUM ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCP4 SAVE FOR LAST VALID ENTRY CPA CPL2 IF NO POSSIBLE PURGE AREAS JMP CCPLK,I EXIT * JSB LNKS ELSE SET UP LNK AREAªc������þú JSB LNK GET 1ST POSSIBLE PURGE AREA LDA LNK1,I IF THIS AREA CPA LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CUNUM TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCP1 POINTER CCPL5 LDA LNK1 SEE CPA CPL2 IF THIS WAS THE LAST ENTRY JMP CCPL3 GO HANDLE JSB LNK ELSE GET NEXT ENTRY LDA LNK1,I IF STILL CPA LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADA CUNUM IF STILL SSA BELOW THE SAVE PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCP1 KEEP THE AREA STA TCP4 SET THE LAST AREA PTR STA TCP2 SET MOVE PTR LDA LNK2,I SET UP THE CMA,INA ADA LNK1,I MOVE STA TCP3 COUNT * LDA LNK1,I SET WORDS STA TCP2,I ONE ISZ TCP2 LDA LNK2,I TWO STA TCP2,I ISZ TCP2 STA TCP2,I THREE ISZ TCP2 LDA TCP2 AND INA STA TCP2,I FOUR LDB LNK4,I MOVE CCPL2 ISZ TCP2 THE LDA B,I IMAGE STA TCP2,I TO THE NEW LOCATION INB ISZ TCP3 JMP CCPL2 * LDA LNK1 AND CPA CPL2 CPL2 JMP CCPL3 IF END, GO DO END STUFF * LDA TCP2 UPDATE INA FOR NEXT ENTRY JMP CCPL1 & GO DO IT * CCPL3 LDB TCP4 GET NEW CPL2 LDA B,I GET VALUE CPA CPL2,I IF SAME AS OLD, JMP CCPL6 OTHER PTRS ARE OK INB OTHERWISE LDB B,I GET LNK2 STB CPEND FAKE OUT END OF LINKS CMA,INA SUBTRACT LNK1 AND ADA B FAKE OUT # OF LINKS STA CPL2H (LNK2-LNK1) LDB TCP4 GET THIS������þú AGAIN CCPL6 STB CPL2 SET UP CPL2, THE UPPER LIMIT JMP CCPLK,I AND GO BYE BYE * * TCP1 NOP NEXT AVAILABLE TCP2 NOP MOVE POINTER TCP3 NOP COUNT TCP4 NOP LAST AREA CUNUM NOP PAGE NUMBER * * SKP * * * * THE DUMMY CURRENT PAGE LINK AREA IS COMPOSED OF FOUR WORD * HEADERS AND LINK AREA IMAGES AS FOLLOWS: * * WORD 1: ACTUAL ADDRESS OF LINK AREA * WORD 2: ACTUAL ADDRESS OF LAST WORD + 1 OF AREA * ACTUALLY ALLOCATED. * WORD 3: ACTUAL ADDRESS OF LAST WORD + 1 FOR WHICH * DUMMY AREA IS SET ASIDE. FOR POSTLINK AREA, * WORD 2 AND WORD 3 ARE EQUAL. FOR PRELINK AREA * WORD 2 IS ALWAYS LESS THAN OR EQUAL TO WORD 3. * WORD 4: ADDRESS OF THE DUMMY IMAGE OF THE AREA. * THE IMAGE FOLLOWS THE 3 WORD DEFINITION OF THE AREA. * * THE LAST DEFINED AREA IS THE ONE THAT HAS A WORD 1 ADDRESS * OF CPL2, WHICH IS NORMALLY THE POST LINK AREA FOR THE CURRENT * MODULE. * * * LNK SETS UP LNK1,LNK2,LNK3,LNK4 FOR THE NEXT ENTRY * * LNK NOP LDA LNK1,I CALCULATE THE ADDRESS CMA,INA OF THE NEXT ADA LNK3,I ENTRY ADA LNK4,I BY SKIPPING OVER THE IMAGE * JSB LNKS SET UP THE NEW AREA * JMP LNK,I RETURN * * * * LNKS SETS UP LNK1,LNK2,LNK3,LNK4 GIVEN THE * FIRST WORD ADDRESS IN THE A REG * * * LNKS NOP STA LNK1 SET THE LINK POINTERS UP INA STA LNK2 INA STA LNK3 INA STA LNK4 JMP LNKS,I AND RETURN * * * LNK1 NOP LNK2 NOP LNK3 NOP LNK4 NOP SKP * * * GETCP SETS UP AND INITIALIZES A NEW CP LINK AREA * * GETCP NOP LDA CPL2 USE CURRENT TOP JSB LNKS TO SET ADDRESSES LDA LNK4 GET LAST POINTER ADA NGEND PAST END OF AREA? SSA /1������þúJSB LNK NO, SET UP ADDRESS FOR NEXT AREA CLA YES, REUSE LAST AREA STA LNK1,I SET AREA TO ZERO SIZE STA LNK2,I STA LNK3,I LDA LNK4 SET IMAGE ADDRESS INA STA LNK4,I LDA LNK1 SET NEW TOP STA CPL2 * JMP GETCP,I & RETURN SKP * * * SETPL SETS UP THE PRELINK AREA * * SETPL NOP LDA PGL.L IF PROG LENGTH SZA IS ZERO SSA OR COMPILER PRODUCED JMP USBP1 USE BP LINKS * LDA CPL.L CURR PG LINKING ALLOWED? SZA,RSS WELL? JMP USBP1 NO * LDA PGT.L GET MODULE TYPE CPA P5 A SEGMENT? JMP USBP1 YES, DO NOT PRELINK, POSSIBLE BSS * LDA TH1.L NO,- GET ADDR STA B OF LAST WORD IOR M1777 OF PAGE * CMB,INB COMPUTE # OF WORDS INB REMAINING ADB A ON PAGE STB TMP2 * LDA PGL.L COMPUTE # OF WORDS RAL,CLE,ERA OF PROG CMB,INB THAT FALL ADB A BEYOND THIS STB TMP1 PAGE * SSB PROG FIT ON RSS THIS PAGE? SZB,RSS NO-SKIP JMP USBP1 YES,DON'T SET UP PRELINK AREA * LDA TMP2 COMPUTE MINIMUM OF : ARS HALF # WDS OF PROG CMB,INB ON CURRENT PG -OR- ADB A # WDS OF PROG ON SSB,RSS NEXT PAGE * LDA TMP1 DIVIDE THIS CLB MINIMUM DIV P16 BY 16 SZA,RSS IF NON-ZERO USE AS SIZE JMP USBP1 OF LOW CURRENT PG LINK AREA RSS USBP1 CLA LDB TH1.L SET STB LNK1,I LOW LINK ADDR STB LNK2,I SAME FOR HIGH SINCE NONE ALLOC YET ADB A RESET STB TH1.L PROG LOAD ADDR STB PLEND & END OF PRELINK AREA + 1 STB LNK3,I LDA LNK1 SET UP STA CPL1 ADDR OF LOW ƒ'������þúSPECS JMP SETPL,I * P16 DEC 16 TMP1 NOP TMP2 NOP * SKP * * * CLRCP - ZEROES OUT THE LINKS IN THE AREA * POINTED TO BY LNK1 - LNK4 * * CLRCP NOP LDA LNK3,I GET NEG CMA,INA COUNT ADA LNK1,I TO CLEAR SZA,RSS IF ZERO JMP CLRCP,I DONE * STA TMP1 ELSE SAVE OFF COUNT LDA LNK4,I GET 1ST LINK TO WRITE STA TMP2 SAVE * CLRC1 LDA TMP2 CHECK FOR ADA NGEND OVERFLOW OF SSA,RSS IMAGE AREA JMP TRUN GO SHORTEN IF OVERFLOW CLA GET A ZERO STA TMP2,I CLEAR LINK ISZ TMP2 GET NEXT LINK ISZ TMP1 INC COUNT, DONE? JMP CLRC1 NO * JMP CLRCP,I YES * TRUN LDA LNK4,I CALC MAX ADA NGEND AREA SIZE CMA,SSA,INA IF NEG CLA SET TO ZERO ADA LNK1,I ADD BASE ADDR STA LNK3,I SET NEW UPPER END JMP CLRCP,I & RETURN SKP * * * SETCP SETS UP THE POST LINK AREA * * SETCP NOP * LDA PGL.L IF PROG LENGTH SZA IS ZERO SSA OR COMPILER PRODUCED JMP USBP3 DO NOT USE CP,USE BP LNKS * ADA TH1.L CALCULATE END OF PROG STA SAV1 SAVE FOR 1ST LNK AVAILABLE * LDB CPL.L CP LINKS ALLOWED? SZB,RSS WELL,ARE THEY? JMP USBP2 NO * AND M1777 YES, MASK OFF PAGE CPA M1777 IF EXACTLY ON BOUNDARY JMP USBP2 NO ROOM FOR CPLINKS LDA SAV1 GET END OF PROG IOR M1777 TO CALC END OF PAGE INA CAN USE UP TO NEXT PAGE RSS USBP2 LDA SAV1 IF BP, USE THIS AS END OF AREA STA CPEND STORE AS END OF CP LINKS LDA SAV1 USE END OF PROG AS STA LNK1,I 1ST LINK AVAILABLE STA LNK2,I AND HIGH FOR NOW STA LNK3,I AND HIGH ACTUALLY ALLOCATED JMP SETCP,I RETURN * ‹½������þúUSBP3 ADA TH1.L CALC END OF PROGRAM STA SAV1 KEEP IT AROUND JMP USBP2 GO FINISH UP * SAV1 NOP SKP HED ENT & EXT RECORD PROCESSOR * ******************* ENT & EXT RECORD PROCESSORS ******************** * * * * ENTR CCA,RSS ENT REC PROCESSOR EXTR CLA EXT REC PROCESSOR STA NXFLG SET ENT/EXT FLAG = -1/0 * LDA LBS.L GET THE LIBRARY SCAN FLAG SZA,RSS SCANNING LIBRARY JMP ADDON NO LDA PGT.L YES, SO GET THE PROGRAM TYPE CPA P5 IS IT A SEGMENT ? JMP OK2GO YES, SO FORGET IT ADDON LDA L.BUF+1 GET NO. SYMBOLS AND M37 ISOLATE SYMBOLS CMA,INA SZA,RSS IS IT ZERO? JMP ORD? YES, THEN IT'S A BAD RELOC. STA EXCNT SET ENT/EXT SYMBOL COUNT LDB ALBUF GET ADDR OF L.BUF ADB P3 NEXSY LDA B,I GET SYMBOL 1,2 STA TBUF SAVE NAME 1,2 INB LDA B,I GET SYMBOL 3,4 STA TBUF+1 SAVE NAME 3,4 INB LDA B,I GET SYMBOL 5 STA TBUF+2 SAVE NAME 5 INB STB SYMAD SAVE SYMBOL ADDR (FOR ENT) * LDB NXFLG GET ENT/EXT FLAG SZB,RSS SKIP - SET ENT ABSOLUTE ADDR JMP NOTEN OMIT SETTING ABS. ADDR FOR EXT AND P7 MASK IN RELOCATION BASE TYPE STA ENTYP SAVE ENT TYPE CLB CPA P4 IF TYPE 4 ENT JMP TYP4 THEN GO SET IT UP. ADA ENTRL ADD RELOCATION BASE ADDR LDB A,I GET PROPER RELOCATION BASE TYP4 ADB SYMAD,I ADD TO GET ABSOLUTE ADDR STB OPRND AND SAVE IT NOTEN JSB L.SCN SCAN LST FOR NAME JMP ENTX3 END OF LST * LDA LS4.L,I SET UP STATUS OF AND P3 SYMBOL MATCHED WITH. STA ENTST LDA LBS.L SZA,RSS SCANNING LIB ? JMP NRML NO LDA NXFLG SZA,RSS PROCESSING ENT ? JMP NRML ÜÛ������þúNO LDA ENTST GET SYMBOL STATUS CPA P2 ENT MATCHED WITH EXT ? RSS YES - THEN IT IS OK. JMP ENTX5 NO - THEN FORGET IT. NRML LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP - PROCESS ENT JMP ENTX4 COMPLETE EXT PROCESSING * LDA ENTST GET STATUS OF SYMBOL CPA P2 IF STATUS = 2 (UNDEF SYMBOL) JMP ENT2X THEN SET ENT ABS VALUE FOR EXT * * DUPLICATE ENTRY POINT * CPA P3 AN EMA ENTRY PERHAPS ? JMP LL19 YES * LDA N7 GET THE ERROR CODE JMP RETRN & RETURN * * ENT2X LDA ENTYP GET ENT TYPE ALF,ALF POSITION ENT TYPE LDB LBS.L GET LIB SCAN FLAG SZB,RSS IF SCANNING LIB INA THEN SKIP THIS INSTRUCTION STA LS4.L,I SET LS4.L CLA STA IGN.L SET TO 'NOT IGNORE' FOR LIB SZB STA NOR.L SET FLAG FOR 'SOME LIB LOADED' LDA OPRND OPERAND IN IT STA LS5.L,I SET VALUE INTO LST. JSB FIXAL FIX ALL REFERENCES JMP ENTX5 COMPLETE ENT PROCESSING * SKP * ENTX3 SSA SYMBOL TABLE OVERFLOW? JMP SOV YES, OVERFLOW JSB SELST SET NAME INTO LST LDB NXFLG GET ENT/EXT FLAG SZB,RSS PROCESSING EXT ? JMP EXTNM YES LDA ENTYP ALF,ALF POSITION ENT TYPE LDB LBS.L SZB,RSS LIB SCAN ? INA NO, THEN SET STATUS = 1. STA LS4.L,I SET LS4.L LDA OPRND SET SYMBOL VALUE STA LS5.L,I AND SET JMP ENTX5 IN LS5.L. COMPLETE ENT PROCESSING. * EXTNM LDA P2 STATUS = 2 FOR EXT STA LS4.L,I SET UP LS4.L FOR EXT ENTX4 LDA TBUF+2 GET CHAR 5, ORDINAL STA LS3.L,I SET ORDINAL INTO LST ENTX5 LDB SYMAD GET SYMBOL ADDR LDA NXFLG GET ENT-EXT FLAG SZA SKIP - EXT INB INCR SYMBOL ADDR FOR ENTsM������þú ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NEXSY PROCESS NEXT SYMBOL JMP OK2GO READ NEXT REC * EXCNT BSS 1 EXT/ENT SYMBOL COUNT NXFLG BSS 1 EXT/ENT FLAG ENTYP BSS 1 ENT TYPE BEING PROCESSED ENTST BSS 1 STATUS OF LST SYMBOL MATCHED SYMAD NOP DEFINING SYMBOL ADDR FOR ENT. OPRND NOP ABSOLUTE ADDR OF THE ENT JUST DEFINED ENTRL DEF TH1.L+0 M100 OCT 100 N5 DEC -5 * * HED DBL RECORD PROCESSOR * ********************* DBL RECORD PROCESSOR ************************* * * DBLR LDA IGN.L SZA REC TO BE IGNORED ? JMP OK2GO YES, GET NEXT REC. * LDA L.BUF+1 GET INSTRUCTION COUNT AND M77 ISOLATE COUNT CMA,INA SZA,RSS IS THE COUNT ZERO? JMP ORD? YES, ZERO COUNT IS A NO-NO STA EXCNT SET INSTRUCTION COUNT LDA ALBUF GET ADDR OF L.BUF ADA P4 ADJUST FOR FIRST RELOCATION BYTE STA CURAL SET CURRENT L.BUF ADDR LDA L.BUF+1 GET WORD 2 OF DBL REC AND M300 ISOLATE REL TYPE FOR LOAD ADDR STA DBLBS SAVE FOR LATER LDB L.BUF+3 GET THE RELOCATION ADDRESS CPA M100 IF = 1 JMP MBASE THEN PROG RELOCATABLE. ADB BPR.L RELOCATE THE LOAD ADDRESS FOR BP. SZA IF = 0 THEN BASE PAGE RELOCATABLE JMP RCER1 ELSE ERROR 2 - ILLEGAL REC. JMP DBL0 FOR BP REL, AVOID FWA RESET. * MBASE ADB TH1.L * * DBL0 STB DBLAD SET THE LOAD ADDRESS DBL1 LDB CURAL,I GET RELOCATION BYTE STB REKEY SAVE RELOCATION BYTE LDA N5 STA INSCN SET RELOCATION BYTE COUNT ISZ CURAL INCR CURRENT L.BUF ADDR DBL2 LDA REKEY GET RELOCATION BYTE ALF,RAR ROTATE TO LOW A STA REKEY SET NEXT RELOCATION BYTE AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES - •������þúGET LINK ADDR CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR EXT WITH OFFSET CPA P6 BYTE ADDR ? JMP DBL6 YES CPA P7 SEVEN IS NOT A VALID INDICATOR JMP ORD? SO SEND A BAD RELOC MESSAGE ADA RBT.L ADD RELOCATION BASE TABLE ADDR LDA A,I SET RELOCATION BASE ADA CURAL,I ADD CURRENT INSTRUCTION WORD DBL3 LDB DBLAD GET LOAD ADDRESS TO B * DABOT STA VALUE STB ADDR JSB ABOUT,I DEF *+3 DEF ADDR DEF VALUE * DBL9 ISZ CURAL INCR CURRENT L.BUF ADDR ISZ EXCNT SKIP - ALL INSTRUCTIONS OUT RSS NO - CONTINUE JMP OK2GO GET NEXT REC ISZ DBLAD INCR CURRENT DBL RELOCATION ADDR ISZ INSCN SKIP - GET NEW RELOCATION BYTE JMP DBL2 PROCESS NEXT INSTRUCTION JMP DBL1 GET NEXT RELOCATION BYTE DBL4 LDA CURAL,I GET CURRENT DBL WORD AND M377 ISOLATE ORDINAL STA EXORD AND SAVE IT. CLA STA OFSET SET OFFSET = 0 JSB DBLEX SET BP LINK ADDR FOR EXT JMP DBL9 INSTRUCTION IS OUTPUT BY DBLEX * DBL5 LDA CURAL,I GET CURRENT WORD FROM L.BUF RAR,RAR POSITION AND AND M377 MASK IN ORDINAL IF ANY SZA,RSS ANY ORDINAL ? JMP DBL5M NO - GO PROCESS MEM REF. * STA EXORD SET UP ORDINAL LDB CURAL GET L.BUF ADDR INB BUMP TO WHERE OFFSET IS LDA B,I GET OFFSET STA OFSET AND SET OFFSET VALUE. JSB DBLEX SET BP LINK FOR EXT REF ISZ CURAL INCREMENT L.BUF ADDR JMP DBL9 GO INDEX TO NEXT WORD DBL5M LDA CURAL,I GET NEXT WORD FROM L.BUF ISZ CURAL INCR CURRENT L.BUF ADDR JSB MREF SET ADDR FOR MEM REF INSTR JMP DBL3 OUTPUT ABSOLUTE PROG WORD DBL6 LDA CURAL,I GET WORD 1 OF THE GROUP ALF POSITION AND AND M17 MASK IN TYP0Ÿ������þúE. SZA IF NON-ZERO JMP RCER1 THEN ILLEGAL REC ERROR LDA CURAL,I ELSE GET WORD 1 AGAIN AND P3 MASK IN RELOCATION TYPE LDB ENTRL GET RELOCATION BASE ADB A LDB B,I FROM TABLE RBL AND COVERT TO BYTE ADDR ISZ CURAL LDA CURAL,I GET WORD 2 (BYTE ADDR) CLE CLEAR E REGISTER ADA B ADD BASE BYTE ADDR TO GET INSTRUCTION SEZ IF E REGISTER IS SET JMP RCER1 THEN ILLEGAL REC. JMP DBL3 GO TO OUTPUT ON DISC OR BP * RCER1 LDA N2 JMP RETRN * * DBLBS NOP LOAD ADDR INDICATOR OFSET NOP OFFSET FOR AN EXT DBLAD NOP ABSOLUTE LOAD ADDRESS FOR THIS WORD CURAL NOP POINTER INTO L.BUF FOR WORD BEING WORKED ON EXORD NOP ORDINAL # OF THE EXTERNAL REFERENCED M17 OCT 17 M77 OCT 77 M7 OCT 7 M300 OCT 300 INSCN NOP COUNTER (1 - 5) FOR CURRENT DBL WORD REKEY NOP DBL TYPE(0-6):ABS,PRG REL,BP REL,COM REL,EXT,MEM REF,BYTE * * * LOAD FROM PROG LIB * * * DBLEX HANDLES ALL DBL EXTERNAL REFERENCES & EMA REFERENCES. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND 'OFSET' SHOULD HAVE A FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * EXORD = EXT ORDINAL # * OFSET = OFFSET OF INSTRUCTION * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBLEX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (A) HAS INSTRUCTION TO BE OUTPUT * DBLEX NOP JSB INLST INITIALIZE LSTX LDB LSY.L ADB P2 SET END PNTR STB PRMAP LDB TSY.L ADB P2 DBLF CPB PRMAP END OF LST ? JMP ORD? ORDINAL NOT FOUND * LDA B,I GET LS3.L AND M377 MASK IN ORDINAL ADB P5 POINT TO NEXT LS1.L CPA EXORD ORDI¾ ������þúNALS EQUAL ? RSS YES - SKIP JMP DBLF NO - CHECK NEXT LST ENTRY * ADB N7 BACK UP TO CURRENT SYMBOL STB TSY.L AND SET UP FOR LSTX JSB LSTX HLT 0 I HAVE ALLREADY CHECKED!! LDA REKEY SET THE DBL AND M7 TYPE STA T1FIX FOR FIXIT OR... LDA CURAL,I GET THE INSTRUCTION AND M1740 ISOLATE IT STA T2FIX AND SAVE IT ALSO LDA LS4.L,I GET WORD 4 OF LST ENTRY AND P3 ISOLATE THE TYPE CPA P3 IS IT EMA ? JMP EMDBL YES, SO PROCESS EMA EXTERNAL REFERENCE * CPA P2 IS SYMBOL DEFINED? JMP DBLE0 NO GO BUILD A FIX UP * JSB FIXIT YES FIX IT UP AND OUTPUT IT JMP DBLEX,I RETURN * DBLE0 LDB FXN.L GET CURRENT END ADB N4 PUSH DOWN STB FXN.L THE BOTTOM OF THE TABLE CMB,INB WAS THERE ROOM? ADB LSY.L SSB,RSS WELL?? JMP LOVER NOPE DID HIM IN * LDB FXN.L YES JSB FIXX SET UP THIS ENTRY * LDA LS1.L SET STA FIX2,I THE LST ENTRY LDA T2FIX COMBINE IOR T1FIX THE INSTRUCTION AND DBL TYPE STA FIX3,I AND SET IT LDA OFSET GET THE OFSET STA FIX4,I AND SET IT LDA DBLAD NOW FOR THE ADDRESS STA FIX1,I JMP DBLEX,I EXIT * PRMAP NOP TEMP MSIGN OCT 100000 INDIRECT BIT FOR INDIRECT INSTRUCTIONS M377 OCT 377 * ORD? LDA N9 GET ILLEGAL RECORD ERROR JMP RETRN & RETURN. * * PROCESS EMA EXTERNAL REFERENCE. * EMDBL LDA T1FIX GET THE TYPE OF DBL RECORD CPA P4 TYPE 4 ? RSS YES, SO ALL'S WELL JMP LL27 NO, ITS AN ERROR LDA T2FIX GET THE INSTRUCTION CODE SSA INDIRECT BIT SET ? JMP LL27 THAT'S AN ERROR ALSO * ADA MSIGN NOW SET THE SIGN BIT ADA LS5.L,I AND AÃñ������þúDD THE BP LOCATION IN LDB DBLAD GET THE ABSOLUTE ADDRESS * STA VALUE STB ADDR JSB ABOUT,I AND OUTPUT THE WORD DEF *+3 DEF ADDR DEF VALUE * JMP DBLEX,I RETURN * LL27 LDA N11 GET THE ERROR CODE JMP RETRN & RETURN * LOVER LDA N4 FIXUP TABLE OVERFLOW JMP RETRN * * N9 DEC -9 N4 DEC -4 N7 DEC -7 N8 DEC -8 N11 DEC -11 * HED FIX UP TABLE PROCESSOR * * FIXAL FIXES UP REFERENCES * TO ENTRY POINTS NOT DEFINED WHEN REFERENCED * BY TAKING THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND BUILDING AN APPROPIATE INSTRUCTION FROM IT. * * THE FIX UP TABLE HAS 4- WORDS PER ENTRY AS FOLLOWS: * ....................................................... * *.................................................................... * FIX1 MEMORY ADDRESS TO BE FIXED (-1 INDICATEDS AN EMPTY ENTRY) * * FIX2 SYMBOL TABLE ADDRESS OF EXT FOR THIS INSTRUCTION * * FIX3 INST OP CODE. BITS 2-0 = DBL TYPE (REKEY) 0,1,2,3,4,5 * * FIX4 OFSET FROM DBL RECORD. * *..................................................................... * FIXAL EXTRACTS THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND LEAVES IT WHERE 'FIXIT' CAN FIND IT. THIS IS DONE TO ALLOW * 'FIXIT' CODE TO BE USED WITHOUT THE FIXUP TABLE OVER HEAD WHEN * DOING CODE THAT DOES NOT REQUIRE FIXUPS. * * T1FIX = TYPE OF DBL WORD (IE THE R FROM THE RRRRR FIELD IN REKEY) * T2FIX = THE INSTRUCTION OP CODE IN PROPPER UPPER BITS. * * * FIXAL NOP LDA LS1.L LS1.L MUST POINT TO SYM TAB ENTRY STA TSY.L JSB LSTX SET UP PROPER SYM TAB ENTRY HLT 0 * LDB FXS.L GET ORGION FIXA2 CPB FXN.L END OF TABLE? JMP FIXA3 GO PACK THE TABLE * ADB N3 DOWN TO THE LDA B,I SYM. TBL. ENTRY ADB N1 SET B TO ORGION OF ENTRY ¯¼������þú CPA LS1.L THIS ONE? JMP FIXA1 YES GO DO IT * JMP FIXA2 AROUND WE GO * FIXA1 JSB FIXX SET THE BASE ADDS IN FIX1-FIX4 LDA FIX3,I GET THE DBL CODE AND P7 AND STA T1FIX SET IT XOR FIX3,I GET THE MASKED INSTRUCTION STA T2FIX AND SET IT LDA FIX4,I GET THE OFFSET STA OFSET AND SET IT LDA FIX1,I GET THE MEMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CCA STA FIX1,I RELEASE THE FIXUP TABLE ENTRY STA FIX2,I * LDB FIX1 CONTINUE JMP FIXA2 SEARCH * FIXA3 LDB FXS.L TABLE GET THE BASE ADDRESS PKF00 CPB FXN.L IF EMPTY JMP FIXAL,I JUST EXIT * ADB N4 INDEX TO FRONT OF ENTRY STB SET1 SET ADDRESS OF FIRST AVAILABLE ENTRY LDA B,I IS IT? SSA,RSS IT IS IF IT IS <0. JMP PKF00 NO AROUND WE GO * PKF01 LDA N4 SET UP A MOVE COUNTER STA SET2 TO MOVE THE NEXT ENTRY PKF02 CPB FXN.L IS THERE ANOTHER ENTRY? JMP PKF05 NO GO PATCH UP FXN.L * ADB N4 YES CHECK IT LDA B,I STILL IN USE? SSA WELL JMP PKF02 NO TRY NEXT ONE * PKF03 STA SET1,I YES MOVE IT DOWN INB ISZ SET1 STEP THE ADDRESSES LDA B,I GET THE NEXT WORD ISZ SET2 FOUR WORDS MOVED YET? JMP PKF03 NO * LDA SET1 YES SET UP FOR THE NEXT ADA N8 EMPTY SLOT STA SET1 ADB N4 ALSO B JMP PKF01 TRY THE NEXT ENTRY * PKF05 LDA SET1 END OF THE FIX UP LIST ADA P4 SET THE ADDRESS STA FXN.L OF THE LAST VALID ENTRY IN FXN.L JMP FIXAL,I RETURN * * HED CONFIGURE INSTRUCTION FROM FIXUP TABLE * * * FIXIT IS CALLED BY FIXAL TO CONFIGURE THE INSTRUCTION. WHEN * FIXIT IS CALLED LS1.L - LS5.L MUST ALREADY BE SET UP * \ê������þú T1FIX MUST ALREADY BE SET UP * T2FIX MUST ALREADY BE SET UP FIXIT NOP THIS ROUTINE BUILD A INSTRUCTION AND PUTS IT OUT LDA LS4.L,I GET THE SYMBOL TYPE ALF,ALF AND P7 TO A CPA P4 IF REPLACE OP JMP FIX05 GO DO IT * LDA LS5.L,I GET THE SYMBOL VALUE ADA OFSET ADD THE OFFSET STA OPRND SET FOR SCANNERS AND M0760 ISOLATE PAGE BITS CMA,CLE,INA SET E IF PAGE ZERO LDA T2FIX GET THE OPCODE SEZ IF BASE PAGE REF JMP FIX04 USE DIRECT LINK * LDB T1FIX GET THE DBL TYPE CPB P5 EXT WITH OFFSET? JMP FIXB1 YES * LDB EBP.L NO OFFSET SSB IF FLAG = -1 JMP FRCBP EXT FORCED TO USE BP LINK * FIXB1 SZA ELSE USE LINK CPA MSIGN ONLY IF NOT A DEF JMP FIX04 A DEF DO DIRECT LINK * LDA OPRND CHECK IF A LINK NEEDED XOR DBLAD AND M0760 ISOLATE PAGE INFO SZA IN NOT SAME PAGE JMP FIX01 MUST USE LINK * * IF FORCING JSB EXT TO USE INDIRECT TO FORCE EXECUTION OF THE NEXT * INSTRUCTION THEN MUST USE LINK * LDA INL.L 0/-1 NO/YES FORCE JSB TO BE INDIRECT SZA,RSS FORCING JSB'S? JMP FXNRM NO LDA T2FIX YES THIS A JSB DIRECT INSTRUCTION? CPA CJSB JMP FIX01 YES FORCE TO USE INDIRECT LINK * FXNRM LDA OPRND EXT REF WITH OFFSET TO SAME PAGE AND MPAG ISOLATE THE PAGE OFFSET IOR M2000 AND INDIRECT BIT ADD CURRENT PAGE ADA T2FIX BIT AND THE INSTRUCTION CODE JMP FIX03 GO SEND IT TO THE DISC * FIX01 LDA DBLAD GET INSTRUCTION ADDR AND M0760 MASK OFF PAGE BITS STA OPPAG SAVE IT LDB OPRND IF OPCODE LDA T2FIX SSA IS INDIRECT ADB MSIGN ADD A SIGN BIT STB OPRND JSòá������þúB SCAN,I SCAN FOR A BP LINK DEF *+3 DEF OPRND DEF ADRS * LDB ADRS SSB,RSS DID WE FIND ONE ? JMP FIX02 SUCCESS * LDA CPL.L GET CP LINK FLAG SZA,RSS CP LINKS ALLOWED? JMP FIXB2 NO, GO ALLOC A BP * LDA BPLF BASE PAGE LINK NEEDED? SSA WELL? JMP FIXB2 YES, SKIP CURRENT PAGE STUFF * JSB SCNCP SCAN FOR A CP LINK SSB,RSS DID WE FIND ONE? JMP FIX02 SUCCESS * JSB ALLCP NO LINK FOUND, TRY TO ALLOCATE ONE ON CP SSA,RSS WAS ONE AVAILABLE? JMP FIXB3 YES * FIXB2 JSB ALLOC,I NO LINK FOUND ALLOCATE ONE ON BP DEF *+3 DEF DUMMY DEF REAL * LDB REAL GET THE REAL BP ADDRESS LDA DUMMY GET THE DUMMY BP ADDRESS * FIXB3 STA T3FIX SAVE ACTUAL MEMORY ADDRESS OF IMAGE LDA OPRND AND STA T3FIX,I SET THE OPERAND INTO IT LDA B GET ACTUAL ADDRESS FIX02 STB A SAVE AS IS AND MPAG REMOVE CURR PAGE BITS CPA B IF SAME WAS BASE PAGE RSS DON'T SET CURR PAGE BITS IOR M2000 ELSE SET CURR PAGE BITS IOR MSIGN ADD THE INDIRECT IOR T2FIX AND THE INSTRUCTION FIX03 LDB DBLAD GET THE ADDRESS TO B * STA VALUE JSB ABOUT,I SEND THE WORD DEF *+3 DEF DBLAD DEF VALUE * CLA RESET BP LINK NEEDED FLAG STA BPLF FOR NEXT TIME JMP FIXIT,I RETURN * FIX04 ADA OPRND DIRECT DEF ADD IN OPERAND JMP FIX03 GO PRODUCE IT * FIX05 LDA LS5.L,I REPLACE OP JMP FIX03 SEND IT * FRCBP CCA SET BASE PAGE LINK NEEDED FLAG STA BPLF TO -1 JMP FIX01 EXT FORCED TO USE BP LINK * * * FIXX SETS UP FIX1-FIX4 * * ON ENTRY B=FIX1 ADDRESS * FIXX NOP STB FIX1 INB STB FIX2 INB @������þú STB FIX3 INB STB FIX4 JMP FIXX,I SO YOU EXPECTED COMMENTS YET! * * * BPLF NOP 0/-1 NO/YES EXT,NO OFFSET,,AND EXT USE BP LINK ADRS NOP ADDRESS OF A BP LINK FOUND FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP T1FIX NOP DBL WORD TYPE ( 0-6 ) T2FIX NOP INSTRUCTION OP CODE IN PROPER BITS T3FIX NOP SET2 NOP SET1 NOP CJSB OCT 014000 JSB DIRECT INSTRUCTION M1740 OCT 174000 M0760 OCT 76000 M2000 OCT 2000 MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT ABT4 NOP HED CONFIGURE A MEMORY REFERENCE INSTRUCTION * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECT * LINK THROUGH BASE PAGE OR CURRENT PAGE IF POSSIBLE. * * CALLING SEQUENCE: * A = FIRST WORD OF MEMORY REFERENCE GROUP * B = IGNORED * JSB MREF * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * MREF NOP STA ABT4 SAVE (A) TEMPORARILY AND P3 ISOLATE RELOCATION BASE TYPE LDB ENTRL GET RELOCATION ADDR PNTR ADB A ADD OFFSET TO GET PROPER PNTR LDB B,I GET RELOCATION BASE ADDR LDA ABT4 RESTORE (A) ADB CURAL,I ADD CURRENT INSTRUCTION ADDR AND M1740 ISOLATE INSTRUCTION CODE SSA SKIP - DIRECT REFERENCE ADB MSIGN SET SIGN OF ADDR = 1 STA INSTR SAVE INSTRUCTION CODE LDA DBLAD GET CURRENT RELOCATION ADDR AND M0760 ISOLATE CURRENT PAGE NO. STA OPPAG SAVE CURRENT PAGE NO. LDA B GET CURRENT ADDR AND M0760 ISOLATE PAGE NO. OF ADDR SZA,RSS BASE PAGE REFERENCE? JMP DBL8 YES CPA OPPAG CURRENT PAGE REFERENCE? JMP DBL7 YES, NO LINK NEEDED STB OPRND SAVE ABSOLUTE OPERAND JSB SCAN,I SCAN DUMMY LINK AREA DEF *+3 o������þú DEF OPRND DEF ADRS * LDB ADRS GET THE ADDRESS SSB,RSS LINK FOUND ? * JMP SMLNK LINK FOUND * LDA CPL.L IS CPL.L SET? SZA,RSS YES,CONTINUE JMP ALBP NO, CP LINKS NOT ALLOWED * JSB SCNCP SCAN DUMMY CP AREA SSB,RSS LINK FOUND? * JMP SMLNK LINK FOUND * JSB ALLCP TRY TO ALLOCATE A CP LINK SSA,RSS GOT ONE? JMP SLNK YES GO SET IT UP * ALBP JSB ALLOC,I NO, ALLOCATE A LINK ON BP DEF *+3 DEF DUMMY DEF REAL * LDB REAL LINK ADDRESS LDA DUMMY DUMMY BP ADDRESS * SSA JMP RETRN SLNK STB TBUF SAVE BP LINK ADDR LDB OPRND GET CURRENT OPERAND STB A,I SET OPERAND IN DUMMY BP OR CP. LDB TBUF GET BP LINK ADDR SMLNK STB A SAVE IT AND MPAG REMOVE PAGE BITS CPA B SAME? RSS MUST BE BASE PAGE DON'T SET CUR PG BIT IOR M2000 NOT SAME SET CURR PAGE BIT IOR MSIGN ADD INDIRECT BIT MREF0 IOR INSTR ADD INSTRUCTION CODE TO ADDR JMP MREF,I RETURN * DBL7 LDA B IT'S CURR PAGE AND M1777 SO REMOVE PAGE BITS FROM ADDR IOR M2000 AND SET CURR PAGE BIT JMP MREF0 ADD INSTR TO ADDR, RETURN * DBL8 LDA B IT'S BASE PAGE JMP MREF0 JUST ADD INSTR TO ADDR, RETURN * M1777 OCT 1777 INSTR BSS 1 OPPAG BSS 1 ALBUF DEF L.BUF+0 * * HED ALLOCATE A CURRENT PAGE LINK * * * ALLCP ALLOCATES A WORD ON THE CURRENT PAGE TO BE USED * FOR INDIRECT LINKAGES. IF THE CURRENT PAGE AREA HAS * BEEN EXHAUSTED OR IS NOT USEABLE, THE A-REG AND B-REG * ARE BOTH SET TO -1. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLCP * * RETURN: * A = DUMMY CURRENT PAGE ADDRESS * B = REAL CURRENT PAGE ADDRESS * Ç2������þú* ALLCP NOP LDA CPL2,I GET PSTLINK AREA AND M0760 MASK OFF PAGE CPA OPPAG SAME AS OP? JMP CPALC YES, GO DO PSTLINK ALLOCATE * LDA CPL1,I NO, GET PRELINK AREA AND M0760 MASK OFF PAGE CPA OPPAG SAME AS OP? JMP PLALC YES, GO DO PRELINK ALLOCATE * NOCP CCA NO,SET A REG TO -1 CCB SET B REG TO -1 JMP ALLCP,I MAKE NOT ALLOCATED RETURN * PLALC LDA CPL1 SET UP LNK1,LNK2,LNK3,LNK4 JSB LNKS FOR CURRENT PRELINK AREA ********************DEBUGGING STUFF********* * ISZ PLCT *******************END DEBUGGING STUFF****** LDA LNK2,I GET LAST ADDR +1 CPA PLEND USED ALL LINKS IN AREA? JMP NOCP YES, DO NOT TRY ANYMORE LDA LNK4,I NOW CHECK ADA CPL1H LIMIT OF DUMMY AREA STA B A REG IS NOW DUMMY CUR PAG ADDR ADB NGEND SUBTRACT THE END SSB,RSS PASS END? JMP NOCP YES,DO NOT DO CUR PG ISZ CPL1H ELSE INC # OF LINKS PRELINK AREA JMP ALLC1 FINISH UP * CPALC LDA CPL2 SET LNK1,LNK2,LNK3,LNK4 JSB LNKS FOR CURRENT PSTLINK AREA * LDA LNK2,I GET LAST ADDR + 1 CPA CPEND USED ALL LINKS IN AREA? JMP NOCP YES, DO NOT DO IT * LDA LNK4,I NOW CHECK ADA CPL2H LIMIT OF DUMMY AREA STA B A REG IS NOW DUMMY CUR PG ADDR ****************DEBUGGING STUFF********************************* * STA EUSED **************END DEBUGGING STUFF******************************* ADB NGEND SUBTRACT END ADDR SSB,RSS PAST END? JMP NOCP YES, DO BP THING ISZ CPL2H ELSE STEP COUNT ISZ LNK3,I STEP LAST DUMMY ALLOCATED * ALLC1 LDB LNK2,I GET REAL ADDR TO B REG ISZ LNK2,I INCREMENT TO LAST + 1 * JMP ALLCP,I RETURN * HED SCAN DUMMY CURRENT PAGE LINK AREA FOR OPERAND * * * SCNCP Ô²������þúLOOKS THROUGH THE DUMMY CURRENT PAGE LINK AREA * TO SEE IF A CURRENT PAGE LINK HAS BEEN ALLOCATED FOR * THIS WORD AND IF SO, IF IT IS USEABLE BY THE CURRENT * INSTRUCTION ADDRESS. * * CALLING SEQUENCE * OPPAG = PAGE NUMBER OF INSTRUCTION ADDRESS * OPRND = OPERAND TO SCAN FOR * JSB SCNCP * * RETURN * B = +N/-1 ADDRESS TO USE/NOT FOUND * * SCNCP NOP * LDA DCPA SET UP THE FIRST AREA JSB LNKS JMP DOIT & GO SEARCH IT * NXTAR LDA LNK1 GET CURRENT ADDRESS CPA CPL2 IF LAST ENTRY JMP NFND MAKE NOT FOUND RETURN * JSB LNK ELSE GET NEXT ENTRY * DOIT LDA LNK1,I GET THE LOWER ADDR STA TMP AND SAVE AND M0760 ISOLATE THE PAGE CPA OPPAG AND COMPARE TO THE OP PAGE RSS SAME - CONTINUE JMP NXTAR DIFF - SCAN NEXT ENTRY * LDB LNK4,I SAME - GET IMAGE ADDR SRCH LDA TMP GET ACTUAL ADDR CPA LNK2,I END OF AREA? JMP NXTAR YES, CK NEXT AREA * LDA B,I NO. GET THE VALUE CPA OPRND THIS IT? JMP FND YES, MAKE FOUND RETURN INB NO, SET FOR NEXT LINK ISZ TMP JMP SRCH & CONTINUE SEARCHING * FND LDB TMP IF FOUND SET ACTUAL ADDR IN B REG RSS NFND CCB ELSE SET B REG TO -1 JMP SCNCP,I AND RETURN * TMP NOP * * SKP * * ALLOC NOP SCAN NOP ABOUT NOP TBLE EQU ALLOC DCPA DEF *+1 PTR TO START OF DUMMY CP AREA BSS 350 DUMMY CP LINK AREA DCPEN DEF * END +1 IF DUMMY CP AREA BSS 4 TO TAKE CARE OF RUN AWAY LNK1 - LNK4 * CPL1 NOP ADDR PRELINK CP LINK SPECS CPL2 NOP ADDR PSTLINK CP LINK SPECS CPL1H NOP # OF CP LINKS ASSIGNED IN PRELINK AREA CPL2H NOP # OF CP LINKS ASSIGNED IN PSTLINK AREA PLEND NOP END +1 OF REAL PRELINK AREA CPEND Ùo���´��²®NOP END +1 OF REAL PSTLINK AREA CPLS NOP ADDR TOP OF FIXED CP LINK AREA CPLX NOP SAVED CPL2 IN NAM IN CASE NOT LOADED CPLXH NOP SAVED CPL2H IN CASE MOD NOT LOADED CPXND NOP SAVED CPEND IN CASE MOD NOT LOADED * NGEND NOP NEGATIVE DCPEN END ����������������������������������������������������������������������������������������������������������������VÍ´������ÿÿ��������þúASMB,R,L,C * NAME: L.CLS * SOURCE: 92067-18460 * RELOC: 92067-16470 * PGMR: DJW, EFH * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.CLS,7 92067-16470 REV.1940 790515 * * * THE L.CLS ROUTINE CLASSIFIES RECORDS AS TO TYPE (1-7) AND * PERFORMS A CHECKSUM ON THE RECORD. THE RECORD TYPE IS LEFT * IN ' RIC ' AND IS ASSUMED TO BE THE RECORD TYPE WHEN THE L.REL * ROUTINE IS CALLED TO RELOCATE THE RECORD. THE RECORD BUFFER * ITSELF IS IN L.BUF WHICH IS AN INTERNAL 60 WORD BUFFER. THIS * IS THE ONLY BUFFER WHICH MAY BE USED TO RELOCATE RECORDS. * * * CALLING SEQUENCE: JSB L.CLS * DEF RETRN * DEF TYPE * DEF SBFLD * * ON RETURN: TYPE = A-REG * = RECORD TYPE (1 - 7) * = -1 CHECKSUM ERROR * = -2 ILLEGAL RECORD * * SBFLD = POSITIVE NO. - SUBFIELD TYPE * (0 FOR REC. TYP WI NO SUBFIELD) * (OR ILLEGAL RECORD ) * * * ENT L.CLS,RIC.L EXT .ENTR,L.BUF * A EQU 0 B EQU 1 * TYPE NOP SBFLD NOP L.CLS NOP JSB .ENTR DEF TYPE PICK UP PARAMETERS * CLA IN CASE OF ILLEGAL REC OR NO SUBFIELD STA SBFLD,I SET SUBFIELD TO 0 * LDA L.BUF+1 GET REC IDENTIFIER ALF,RAR AND M7 ISOLATE RIC STA RIC.L SAVE REC ID CODE STA TYPE,I SZA,RSS SKIP£®��� ��  IF TYPE = 0 IT'S AN ERROR JMP RCERR INVALID REC TYPE * * SAVE OFF SUBFIELD * CPA M7 TYPE SEVEN? RSS YES,CONTINUE CLA NO,SUB FIELD SET TO 0 LDA L.BUF+1 GET SUBFIELD ALF,ALF AND AND M37 ISOLATE IT STA SBFLD,I SAVE IT OFF * * TEST FOR VALID CHECKSUM * LDA L.BUF GET REC LENGTH AND M7400 AND ZERO LOWER CHARACTER, STA B BLF,BLF ROTATE TO LOW B CMB,INB COMPLEMENT ADB P3 ADJUST FOR ADDR OF WORD 4 SSB,RSS SKIP - VALID REC LENGTH JMP RCERR INVALID (SHORT) REC STB WDCNT SET WORD COUNT FOR CHECKSUM LDA L.BUF+1 GET WORD 2 - INITIALIZE CHECKSUM LDB ALBUF GET ADDR OF L.BUF ADB P3 ADJUST ADDR FOR WORD 3 TEST1 ADA B,I ADD WORD TO CHECKSUM INB INCR CURRENT L.BUF ADDR ISZ WDCNT SKIP - END OF REC JMP TEST1 CONTINUE CHECKSUM TEST CPA L.BUF+2 EQUAL TO GIVEN CHECKSUM? JMP LDRC YES - PROCESS REC * * CHECKSUM OR ILLEGAL RECORD ERROR * CCA,RSS CHECKSUM ERROR RCERR LDA N2 ILLEGAL RECORD ERROR RSS * LDRC LDA RIC.L STA TYPE,I JMP L.CLS,I SEND ALLS WELL RETURN. * * RIC.L BSS 1 RECORD TYPE INDICATOR M7 OCT 7 M37 OCT 37 WDCNT NOP RECORD WORD COUNT N2 DEC -2 P3 DEC 3 M7400 OCT 177400 ALBUF DEF L.BUF+0 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������˜ ������ÿÿ��������þúASMB,R,L,C * NAME: L.FLG * SOURCE: 92067-18470 * RELOC: 92067-16470 * PGMR: DJW, EFH ,BW * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM L.FLG,7 92067-16470 REV.2026 800507 * * ENT BPR.L, CAD.L, CBP.L, CPL.L, COM.L, EMA.L ENT EMS.L, FXN.L, FXS.L, IGN.L, LBS.L, LSY.L ENT MSG.L, NM1.L, NM2.L, NM3.L, NM4.L, NOR.L ENT PGT.L, PRI.L, RBT.L, SEG.L, SGB.L, SSG.L ENT SGM.L, SYM.L, TH1.L, TH2.L, TSY.L, EBP.L ENT L.BUF, PGL.L, INL.L * * * * * * MODULE FLAGS CONTAINS THE LOADER GLOBAL FLAG AND POINTER * VARIABLES AND THE RELOCATABLE INPUT BUFFER. THE POINTERS * AND FLAGS ARE DIVIDED INTO FOUR BASIC AREAS, CONTROL FLAGS * WHICH DETERMINE FLOW OF CONTROL AND LOAD OPTIONS, TABLE * POINTERS INTO THE SYMBOL TABLE AND FIXUP TABLE, PROGRAM RE- * LOCATION BASE ADDRESSES AND LENGTHS, AND POINTERS INTO THE * NAM RECORD INFORMATION. * * * I. CONTROL FLAGS * LBS.L NOP 0/-1, NO/YES SCAN THIS MODULE FOR UNDEFS. * SET BY USER BEFORE CALLING L.REL. NOR.L NOP -1/0, NO/YES A SUBROUTINE WAS LOADED IN THIS * SCAN. WILL BE SET TO -1 AT EVERY ENTRY TO * L.REL. SET BY LIBRARY. NM1.L NOP -1/0, YES/NO NAM MUST BE FIRST. SET TO * -1 AT EVERY END RECORD AND CLEARED AT * EVERY NAM RECORD BY THE LIBRARY. IGN.L NOP -1/0, IGNORE/DON'T IGNORE THIS MODULE. SET * BY LIBRARY WHEN IN SCAN MODE. IF ENTS * DO~²������þúN'T MATCH EXISTING UNDEFS, THE MODULE IS * IGNORED. CPL.L NOP 0/1, DON'T USE/USE CURRENT PAGE LINKING. SET * BY USER. (WILL NOT BE TESTED BY LIBRARY ON * FIRST PASS. SEG.L NOP 0/1/2, PROGRAM NOT SEGMENTED/ SEGMENTED AND LOADING * MAIN / SEGMENTED AND LOADING SEGMENT. EBP.L NOP 0/-1, NO/YES EXTERNALS FORCED TO USE BASE * PAGE LINKS. INL.L NOP 0/-1, NO/YES JSB EXT FORCED TO INDIRECT LINK * * * * II. TABLE POINTERS * * FXN.L NOP WORD 1 OF LAST ENTRY IN FIXUP TABLE. FXS.L NOP FIRST WORD AVAILABLE OF FIXUP TABLE. SYM.L NOP ADDRESS OF FIRST WORD OF LOADER LIBRARY * SYMBOL TABLE. LSY.L NOP ADDRESS OF LAST WORD + 1 OF SYMBOL TABLE. TSY.L NOP CURRENT TEMPORARY SYMBOL TABLE ENTRY. SSG.L NOP FIRST SYMBOL ENTRY FOR CURRENT SEGMENT. * * * III. NAM RECORD POINTERS * * EMS.L NOP EMA SIZE DECLARED IN PROGRAM. MSG.L NOP EMA MSEG SIZE IN NUMBER OF PAGES (MINIMUM OF * TWO IF EMA DECLARED). NM3.L DEF *+1 ADDRESS OF EXTENDED NAM COMMENT. FIRST WORD NOP IS NUMBER OF WORDS. BSS 43 NM4.L DEF *+1 ADDRESS OF PROGRAM INFORMATION OF THE THE NAM BSS 7 RECORD. THIS A SEVEN WORD ARRAY RESET FOR * EACH NAM CONTAINING THE PRIORITY, RESOLUTION * CODE, EXECTION MULTIPLE, HOURS, MINUTES * SECONDS, AND TENS OF MILLISECONDS. NM2.L DEF *+1 ADDRESS OF MODULE NAME, NUMBER OF WORD BSS 4 FOLLOWED BY NAME. PGT.L NOP CURRENT MODULE TYPE FROM NAM RECORD. SET BY * LIBRARY. NOTE THIS IS NOT THE PROGRAM TYPE * THAT WOULD GO INTO AN ID SEGMENT. PGL.L NOP PROGRAM LENGTH OUT OF NAM RECORD * ¹¨����� IF -1, WAS FTN2 OR ALGOL PRI.L NOP PRIMARY ENTRY POINT ADDRESS OF THIS MODULE. * EQUALS ZERO IF NO PRIMARY ENTRY POINT. * * * IV. PROGRAM RELOCATION ADDRESSES, LENGTHS * * CBP.L NOP ADDRESS OF NEXT AVAILABLE BASE PAGE LINK. * SET BY USER. COM.L NOP LENGTH OF LOCAL COMMON, = 0 IF NO COMMON DE- * CLARED, OR SYSTEM COMMON BEING USED. EMA.L NOP BASE PAGE LINK ADDRESS FOR EMA ARRAYS. TH2.L NOP HIGH ADDRESS OF THIS LOAD. SET BY LIBRARY. RBT.L DEF *+1 ADDRESS OF RELOCATION BASE TABLE. NOP TH1.L NOP BASE ADDRESS OF THIS MODULE. SET BY LIBRARY. BPR.L NOP BASE PAGE RELOCATION BASE ADDRESS. CAD.L NOP COMMON RELOCATION BASE ADDRESS. NOP ABSOLUTE BASE ADDRESS. SGM.L NOP SEGMENT BASE ADDRESS. SGB.L NOP SEGMENT BASE PAGE BASE ADDRESS. L.BUF BSS 64 RELOCATABLE INPUT BUFFER END ������������������x������ÿÿ����� ���� ÿý�¨�Jó ���������ÿ��92067-18471 2040� S C0122 �&4LDR �RTE-IVB LOADR SOURCE � � � � � � � � � � � � �H0101 5Ž�����þúASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-IV <1730> NAM LOADR,4,90 92067-16471 REV.2040 800730 * * ENT LOADR * * *******************DEBUGGING STUFF * EXT STLK,DUEN,REEN,PLCT * EXT EUSED,DCPA,NGEND,CPL2 *******************END DEBUGGING STUFF EXT $MATA,NAMR EXT $MNP,$MBGP,$MRTP,$MCHN,$SDA,$COML EXT $PLP,$DLP,$IDEX,$CMAD,$SMCA,ISMVE EXT REIO,OPEN,CLOSE,READF,$CVT3,LURQ,LOGLU EXT LOCF,APOSN,WRITF,CREAT,POST,POSNT EXT IFBRK,EXEC,$LIBR,$LIBX,PRTN EXT .OWNR,PTERR,FTIME,$SSCT,$STRK EXT BPR.L,CAD.L,CBP.L,CPL.L,COM.L,EBP.L,EMA.L EXT EMS.L,FXN.L,FXS.L,IGN.L,LBS.L,LSY.L EXT MSG.L,NM1.L,NM2.L,NM3.L,NM4.L,NOR.L EXT PGT.L,PRI.L,RBT.L,SEG.L,SGB.L,SSG.L EXT SGM.L,SYM.L,TH1.L,TH2.L,TSY.L EXT L.INT,L.ADD,L.SYE,L.MAT,L.LDF,L.LUN,L.IFX EXT L.CLS,L.BUF,L.REL,L.SG0,L.SGN,PGL.L * * NAME: RTE LOADER * SOURCE: 92067-18471 * RELOC: 92067-16471 * PGMR: C.M.M., EFH * SUP PRESS EXTRANIOUS LISTING * SKP *1 LOADR ERROR CODES *0 ALL LOADR ERRORS ARE REPORTED TO THE LIST DEVICE. THE LIST * DEVICE MAY BE SPECIFIED AT LOAD TIME OR DEFAULTED. THE DEFAULT * LIST DEVICE IS SPECIFIED UNDER 'LIST = ' AT THE BEGINING OF THIS * DOCUMENT. * THE LOADR ERROR CODES ARE LISTED BELOW. NOTE THAT ERROR CODES * 19, 20, 21, 22, REFER TO RTE 4 ONLY. * LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * ¢Ï������þú*CK SUM* - CHECKSUM ERROR (WAS IT A RELOCATABLE FILE ?) *IL REC* - ILLEGAL RECORD *OV MEM* - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * (YOUR PROGRAM + MSEG SIZE IS TOO LARGE) *OV BSE* - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) *OV SYM* - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) *CM BLK* - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) *DU ENT* ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) *TR ADD- NO TRANSFER ADDR (ONLY SUBROUTINES WERE LOADED WHERE'S THE MAIN?) *RE SEQ* - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) *IL PRM- ILLEGAL PARAMETER IN RU STATEMENT OR IN STATEMENT PRIOR TO * A RELOCATE STATEMENT. *CO RES- ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) *OV FIX* - FIXUP TABLE OVERFLOW (GIVE THIS LOADER MORE ROOM) *LM LIB- THE LIMIT ON THE NUMBER OF LIBRARIES SPECIFIED BY THE "LI" * COMMAND HAS BEEN EXCEEDED. (10 IS THE LIMIT) POSSIBLY YOU CAN * DO AN "SE" OF THE FILE INSTEAD OF TRYING TO MAKE IT A LIBRARY. *IL REL* - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T *IL PTN- ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. *RQ PGS- NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. *OV PTN- REQUESTED # OF PAGES EXCEEDS LARGEST POSSIBLE * ADDRESS SPACE FOR THAT PROGRAM. *ML EMA- EMA DECLARED TWICE OR DECLARED IN A PROGRAM SEGMENT * OR A REFERENCE TO THE EMA LABEL BEFORE THAT LABEL WAS * DECLARED EMA OR AN ATTEMPT TO DECLARE THE SAME LABEL AS * AN ENT RECORD (IE DUPLICATE ENT). EMA MUST BE DECLARED * IN THE MAIN. ANY INDIVIDUAL RELOCATABLE MODULES THAT * PRECEED THE MAIN MAY NOT HAVE EMA REFERENCES. EMA * REFERENCES MAY APPEAR ANYWHERE IN THE MAIN. EMA REFERENCES * IN SEGMENTS OR SUBROUTINES MAY APPEAR ANYWHERE WITHIN THE * MODULE BUT æ������þúTHAT MODULE MUST NOT BE RELOCATED BEFORE THE MAIN *ID EXT- NO ID EXTENSIONS AVAILABLE FOR YOUR EMA PROGRAM *SZ EMA- PROGRAMS EMA SIZE IS TOO LARGE FOR CURRENT SYSTEMS * PARTITIONS. *IL SCB- RETURN ILLEGAL SCB VALUE(NEGATIVE). *IN CAP- USER'S CAPABILITY LEVEL IS LOWER THAN 60 AND TRY TO PU,PE,RP. *SS ENT- ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. *IL CMD- ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTERED WITHIN A FILE. *ID SEG- NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH LOAD. * THIS ERROR CODE IS EXTREMELY RARE. IT CAN OCCUR WHEN * LOADING A SEGMENTED PROGRAM WHERE THERE WERE ENOUGH * LONG + SHORT ID SEGMENTS TO SUCCESSFULLY LOAD THE LAST * SEGMENT IN THE PROGRAM WHILE THE LAST SEGMENT LOAD WAS * GOING ON. HOWEVER, WHEN THE LOADR WENT TO CREATE THE * ID SEGMENTS NOT ENOUGH LONG + SHORT SEGMENTS WERE FOUND. * IN THIS CASE SOME ID SEGMENTS WERE CREATED BUT OTHERS * WERE NOT. IF THE PROGRAM IS RUN AN SC05 ERROR WOULD * RESULT. THE CORRECT ACTION IS TO OFF OR PURGE ALL ID'S * CREATED, FREE UP ADDITIONAL ID SEGMENTS, AND PERFORM THE * LOAD OVER AGAIN. *RF EMA- ATTEMPT TO ACCESS AN EMA EXTERNAL (ARRAY) WITH OFFSET * OR INDIRECT. TO ACCESS EMA ARRAYS USE THE H-P SUPPLIED * SUBROUTINES .EMAP & .EMIO . * IF LOADING A PROGRAM WRITTEN IN A HIGH LEVEL LANGUAGE * PROBABLY FORGOT $EMA STMT IN SORCE CODE OF A SUBROUTINE *UN EXT- UNDEFINED EXTERNALS EXIST. THIS IS PROBABLY THE MOST * COMMON ERROR FOR THE LOADR. BASICLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. *EX CPY- ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF * THAT PROGRAM EXIST. THE PROGRAM CAà’������þúN'T BE PURGED BECAUSE * THE DISC SPACE CAN'T BE RELEASED OR THE OTHER PROGRAMS * WILL BE OUT TO LUNCH. THE PROPER COURSE HERE IS TO GET * RID OF ALL THE COPIED PROGRAMS (VIA OF,XXXXX COMMAND) AND * TRY THE LOAD AGAIN. *RP CPY- ATTEMPT TO REPLACE A COPIED PROGRAM. THE 'OP,RP' COMMAND * MAY NOT BE USED WITH A COPY OF A PROGRAM. YOU MUST REPLACE * THE ORGINAL. *PE LDR- L O A D R AND ONLY THE PROGRAM NAMED L O A D R MAY DO PERMINANT * LOADS OR PURGES. *DU PGM- DUPLICATE PROGRAM NAME. YOU HAVE ALREADY LOADED THE * SAME PROGRAM TWICE WITHOUT OFFING THE ORIGINAL. WE * WERE NICE THE SECOND TIME AND RENAMED YOUR PROGRAM * CALLED XXXXX TO ..XXX THE THIRD TIME WE DON'T RENAME. *NO IDS- NOT ENOUGH ID SEGMENTS TO FINISH THE LOAD. CALL THE * SYSTEM MANAGER TO FREE UP SOME ID SEGS. *RP PGM- ATTEMPT TO REPLACE A PROGRAM THAT WAS EITHOR NOT * DORMANT OR STILL IN A PARTITION. DO AN ' OF ' ON * THE PROGRAM & TRY AGAIN. * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * *RQ PGS- NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. *IL CMD- ATTEMPT TO RELOCATE A MODULE OR TRANSFER TO A COMMAND * FILE WHILE DOING SPECIAL PROCESSING WHEN UNDEFINED * EXTERNALS EXIST. *UN EXT* ** - UNDEFINED EXTERNALS EXIST. BASICALLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. *DU PGM- DUPLICATE PROGRAM NAME. YOU TRIED TO LOAD A * PROGRAM XXXXX BUT A PROGRAM CALLED XXXXX WAS ALREADY * IN THE SYSTEM, SO WE RENAMED YOUR PROGRAM TO * ..XXX AND CONTINUED THE LOAD. SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM TH–…������þúE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * L * CHAR 1 * CHAR 2 * *..................................................* * U * CHAR 3 * CHAR 4 * *..................................................* * CHAR 5 * ORDINAL * *..................................................* * TYPE * V* * S * *..................................................* * V = 0/1 ABS ADDRESS / BP LINK ADDRESS * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * * * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * BIT 15 = 1 MEANS THE ENTRY IS FROM SYS LIBRARY * BIT 15 = 0 MEANS THE ENTRY FROM MODULE * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * BIT 15 = 1 SYMBOL REFERENCED BY CURRENT MODULE * BIT 15 = 0 SYMBOL NOT REFERENCED BY CURRENT MODULE * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL NUMBER * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 3 - EMA ENTRY THE SYMBOL IS CONSIDERED DEFINED. * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO äN������þú * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATION ). * V WILL ONLY BE SET IF THE REFERENCE IS TO EMA. * TYPE : * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * TYPE = 0 PROG RELOCATABLE * 1 BP RELOCATABLE * 2 COMMON RELOCATABLE * 3 ABSOLUTE * 4 INSTRUCTION REPLACEMENT * * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * IIILU DEC 1 DEBUG LU IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT RSDON NOP =1 WHEN ALL OF RUN STRING HAS BEEN PARSED * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THE BUFFERS BELOW AT YOUR UNDYING & EVERLASTING * PERIL !!!!!!! * IDCB3 BSS 144 LIST FILE DCB NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM RECORD BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 COMMAND FILE DCB SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 18 ID INFO TO BE MOVED INTO SYS ID AREA * .BUF EQU * END OF BUFFERS IN OVQœ������þúERLAYED CODE SKP * * ORG IDCB3 * LOAD ASC 3,LOADR * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITIONS IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE SPC 1 LOADR JSB LOGLU GET THE DEFAULT LU DEF *+2 DEF MYLU# STA MYLU# * JSB .OWNR GET THE OWNER WORD FOR THE ID STA OWNER * * SPC 1 * THIS CODE IS PLACED HERE BECAUSE IT NEED ONLY EXECUTE * ONCE AND THEN I CAN USE THE AREA FOR OVERLAY PURPOSES SPC 1 * LDA SECT2 GET THE # SECTRS PER TRACK ON LU 2 MPY P64 A = # WORDS PER TRACK STA D6144 SAVE FOR LATER LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR XLA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY STB EBP.L FORCE EXT TO USE BP LINK SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN XLA B,I SET UP LOADR SYMBOL TABLE TO STA SYM.L START FROM LOADR'S HIGH ADB N9 (B)=ADDR OF LOADR ID'S WORD 15 XLA B,I GET LOADR'S PROG TYPE LDB BKLWA GET ADDR OF LOADR'S LAST WORD ú������þú AND P7 SPC 1 CPA P2 SKIP IF LOADR IS BG LDB RTLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR * LDB XEQT GET MY ID ADDRESS ADB P12 & CHECK IF I'M 'THE' L O A D R XLA B,I CPA LOAD CHECK 1ST TWO CHARACTERS INB,RSS OK ! ISZ TLOAD SET TEMP LOAD ONLY FLAG XLA B,I CPA LOAD+1 3RD & 4TH CHARS OK ? INB,RSS YES. ISZ TLOAD NO XLA B,I GET LAST CHAR AND M7400 IOR P32 APPEND A BLANK CPA LOAD+2 RSS PERM LOADS OK ! ISZ TLOAD * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" LDA SYSLN GET # OF,SYSTEM ENTRY POINTS ADA DSCLN ADD # OF USER ENTRY POINTS STA #ENTS TO GET TOTAL # OF ENTS LDB XEQT ID SEG ADDR ADB P32 GO TO WORD 33 XLA B,I GET SESSION WORD STA IADR SAVE SCB ADDR * * SKP JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB GTCMD GET THE COMMAND FILE * * JSB NAMRR NOW GET THE INPUT FILEO������þú NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * * LDA IPBUF+6 * SZA,RSS * JMP *+5 * STA IIILU * JSB DBUGR * DEF *+2 * DEF IIILU * EXT DBUGR * * * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * OPFMT JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * ISZ FMT DID WE DO THE FMT PARAMS YET? JMP OPFMT NO, GO DO THEM * JSB NAMRR YES,GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL LDA IPBUF GET THE # STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * ******************CHECK OUT COMMAND FILE********************* * * SEFIL ISZ RSDON SET FLAG - RUN STRING DONE LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA WAS A COMMAND FILE ENTERED ? JMP SEFIX YES * LDB TYPE1 NO CMND FILE. WAS A RELO FILE ENTERED ? SZB WELL . JMP CNFLT YES, NO CMND BUT DO HAVE A RELO FILE * LDA B1777 NO CMND & NO RELO !!!! STA ISTRC FAKE OUT NAMR JSB GTCMD & FORCE A COMMAND ENTRY LU LDA OPCOD GET THE LAST OP CODE CPA P4 IF IT WAS A PURGE JMP CNFLT Ø������þúTHEN GO DO CONFLICT CHECKING LDA TYPE2 GET THE TYPE * SEFIX ERA,SLA IS IT A FILE OR A LU ? JMP FOPEN A FILE ! JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * FMT DEC -2 M200 OCT 200 TLOAD NOP 0 = PERM LOADS OK. SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  * LDA LISTU GET THE LIST LU LDB DOLST AND THE LU LOCK SUB ENTRY POINT SZB,RSS NOW IF DOLST NEVER CALLED SZA AND LIST LU NEVER RESET, THEN JMP CNFL1 SET UP USER CONSOLE AS DEFAULT * CLA,INA SET LU NOT FILE FLAG STA IPBUF+3 * LDA MYLU# CCB SET B TO -1 CPB BATCH BATCH MODE? LDA P6 YES, DEFAULT TO LU 6 STA IPBUF JSB DOLST NOW GO SET THE LU & LOCK IT * CNFL1 LDA EDFLG GET THE EDITING FLAG LDB TLOAD AND THE PERM LOAD OK FLAG. SZA THIS A PERM LOAD ? SZB,RSS THEN THIS BETTER BE THE L O A D R JMP CHEKR OK! * NOPUG LDA ERR31 YOU LOSE JMP ABOR * * CHEKR LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5 THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * * LDA #PGS DID HE SUPPLY A NEGATIVE SIZE ? SSA WELL ? JMP ER.17 SEND THE TURKEY A LOVE MESSAGE. LDA #PTTN GET THE PART'N SPECIFIED IF ANY SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SSA BUT IF NEG JMP ER.16 FLUSH HIM. G÷������þúSPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * XLA $MNP YES, DO SIZE CHECK NOW. GET MAX # PART'NS * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 7 * (PTTN# - 1) + $MATA MPY P7 IS ADDR OF ENTRY XLB $MATA ADA B XLB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 XLA A,I AND B1777 REMOVE RESERVED FLAG STA #PGPT SAVE #PAGES IN PTTN CMA ADA #PGS ENOUGH PAGES IN SSA SPECIFIED PTTN? JMP PGSOK YES SZA OK IF EQUAL LDA #PGS NO, BUT WAS SPECIFIC SZA SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN XLA $MBGP GET MAX BG PARTN STA #MXBG XLA $MRTP GET MAX RT PARTN STA #MXRT * * *E * CMMST LDB PTYPE GET THE PROG TYPE XLA $PLP ASSUME ITS A TYPE 2 OR TYPE 3 RBR,RBR IS IT ? SLB,RSS WELL ?! JMP SETLP YES * XLA $DLP NO, ITS A LARGE BG PROG TYPE = 4 LDB COMTP GET THE COMMON TYPE ADB #MPFT ADD IN SSGA SZB,RSS ANY COMMON ? JMP SETLP NO. * XLA $SDA THE FIND PG # OF START OF SYSDVR AREA ALF,ALF CONVERT TO PG # RAL,RAL SETLP STA URFWA SET THE LOAD POINT OF PROG. * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SU³6������þúBTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA * * LEDT4 LDA COMTP GET THE COMMON TYPE SZA,RSS ANY COMMON JMP LCLCM NO JUST LOCAL COMMON LDB PTYPE GET THE PROG TYPE CPA P1 SYS COMMON OR REVERSE COMMON ? JMP STRAT SYS COMMON. * CPB P2 IS IT A RT PROGRAM ? JMP ITSBG YES, SO USE BG COMMON JMP ITSRT NO, A BG PROG SO USE RT COMMON * STRAT CPB P2 IS IT A RT PROG JMP ITSRT ITSBG LDA P3 SET MPFT FENCE STA #MPFT LDA BKORG GET START OF BG COMMON LDB BKCOM AND THE LENGTH JMP STUF ITSRT LDA P2 STA #MPFT NOW DO RT LIKE BG ABOVE LDA RTORG LDB RTCOM STUF STA CAD.L STB COM.L JMP CMEXI GO LOOK FOR SSGA. * LCLCM CCA SET THE LOCAL COMMON FLAG STA COMIN LDA P5 NOW ASSUME PROG BG OR RT LDB PTYPE GET THE PROG TYPE CPB P4 IS IT A LBG PROG ? CLA YES STA #MPFT * CMEXI LDA P4 WELL, DOES HE WANT SSGA ? LDB SSGA SZB 0/1 NO/YES STA #MPFT * * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPR.L SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FR;$������þúOM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA FXS.L ADDRESS OF BASE ID SEG (NONE EXIST YET) STA MBUF1 POINTER TO ZAP THE AREA WITH LDA BKLWR SET LWA STA LWABP OF AREA * LDA SYM.L GET LWA+1 OF THIS PROG CMA,INA MAKE IT NEG ADA FWABP ADD START OF DUMMY BASE PAGE SSA ANY OVERLAP? JMP LOVER YES, SYMBOL TABLE OVERFLOW * CLA CLEAR LDI7 STA MBUF1,I DUMMY ISZ MBUF1 BASE INB,SZB PAGE JMP LDI7 AREA * STA NM2.L,I CLEAR VALID MODULE PRESENT FLAG LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA MAPOF ALLOCATE ROOM FOR X,Y REGS & MAP REGS STA SGM.L SEGMENT BASE * * * INITIALIZE THE LOADER LIBARY * * JSB L.INT INITIALIZE DEF *+9 DEF SYM.L FWA FREE SPACE DEF FXS.L LWA FREE SPACE DEF BPR.L FWA BASE PAGE DEF CAD.L SYS COMMON ADDR OR ZERO DEF COM.L LENGTH OF COMMON DEF SGM.L FWA PROGRAM DEF LWA LWA PROGRAM DEF SUBTB TABLE OF SUBROUTINE ADDRESSES LDB OPCOD GET THE LAST OPCODE CPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. * CCB STB NOR.L SET NO. PROGS LOADED = -1 STB NM1.L SET LOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG ¬������þú OMIT ENTERING DEBUG INTO LST SKP * * ENTER '.BBUG' INTO LST * JSB L.SYE DEF *+6 DEF CHRDE ENTER .DBUG DEF P2 UNDEFINED DEF N1 DUMMY PARAM DEF P1 DO NOT OVERRRIDE DEF RSLT * NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 JMP ABOR * CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP SKP 2 *********************************************************************** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * IL PRM ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUM!\������þúP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 20,LIPULBRTSCRCNCSSDBPETERPRSBGLENLDCMPCPBP OPP NOP ERROR CODE LDJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF LB BG PROGRAM (LARGE) DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF BG PRIVLEDGED PROGRAM DEF LE LIST ENTRY POINTS DEF NL NO LISTING DESIRED DEF DC THIS PROGRAM NOT TO BE COPIED ! DEF MP USE CURR PG LINKS (EXCLUDING EXTERNALS) DEF CP USE CURR PG LINKS (INCLUDING EXTERNALS) DEF BP USE BASE PG LINKS DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADING THE PROGRAM *AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT *CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * SSGA = 0/1 DON'T USE / USE SSGA * COMTP = 0 ... NO COMMON ×P������þú( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * CPL.L = 0/1 DON'T USE/USE CURR PG LINKS * EXCEPT EXTERNALS * EBP.L = -1/0 NO/YES USE CURR PG LINKS * INCLUDING EXTERNALS * (IF YES,FORCES CPL.L TO BE SET TO 1) * DO3 LDA RSDON WAS LI IN RUN STRING? SZA,RSS WELL? JMP LLIST YES, GO DO THE LISTING LDA TYPE2 NO, GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING * DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE COMMAND TYPE LDA RSDON WAS PU CODE IN RUNSTRING? SZA,RSS WELL? JMP THELD YES, SO SEE IF THIS IS 'THE' LOADR ERB,SLB NO, IF CMND IS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO THELD LDA TLOAD IS THIS ' THE ' LOADR SZA YES JMP NOPUG NO, FORGET IT. SZB WAS A COMMAND FILE ENTERED? JMP CHEKR YES, SO ALL'S WELL JMP SEFIL NO, SO GO DO IT. * LB LDA P4 BACKROUND PROGRAM (LARGE) BG2 STA PTYPE STB MES12+11 SET UP OPTION MESSAGE FOR END OF LOAD JMP TEST,I RT LDA P2 JMP BG2 BG LDA P3 JMP BG2 * NC CLA,RSS SC CLA,INA SC2 STA COMTP STB MES12+22 SET UP OPTION MESSAGE-COMMON JMP TEST,I RC LDA P3 JMP SC2 * SS CLA,INA STA #MPFT STA SSGA SSGA FLAG STB MES12+23 SET UP OPTION MESSAGE-SSGA JMP TEST,I * DB CLA,INA STA DBFLG STA OPCOD STB MES12+26 SET UP OPTION MESSAGE-DEBUG JMP TESTé/������þú,I * TE CLA,RSS PE CLA,INA PM2 STA EDFLG STB MES12+16 SET UP OPTION MESSAGE-LOAD CLB SZA STB OWNER CLEAR OWNER FLAG FOR PERM LOADS LDA IADR GET SESSION WORD SZA,RSS IF IT IS 0, JMP TEST,I THEN ITS NON- SESSION SSA,RSS JSB CAPCK IN SESSION, CHECK CAP LEVEL JMP TEST,I NOT IN SESSION, GO BACK RP LDA P2 JMP PM2 * RS JMP TEST,I THE 'RS' OPTION WAS A MISTAKE. CMM * LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I * DC LDA M2000 GET THE DON'T COPY FLAG STA COPY? AND SET UP FOR LATER JMP TEST,I GET THE NEXT COMMAND * CP CLA EXT'S NOT FORCED TO USE BP LINKS RSS MP CCA USE CURRENT PAGE LINKING STA EBP.L CLA,INA STA CPL.L STB MES12+4 SET UP OPTION MESSAGE-LINKS JMP TEST,I BP CLA USE BASE PAGE LINKS STA CPL.L CCA STA EBP.L STB MES12+4 SET UP OPTION MESSAGE-LINKS JMP TEST,I * * SKP * * THIS ROUTINE SETS UP THE LIST DEVICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB ANY LU SUPPLIED OR IS IT NULL ? JMP DOALU YES, SO FIX THE LU * INB NULL SUPPLIED, SO SET DEFAULT STB IPBUF+3 * LDA MYLU# STA IPBUF * * JSB CLOS3 CLOSE ANY OLD FILE * DOALU LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU SZA,RSS IS THERE ONE ? JMP ZIPLU NO . JSB INTER IS IT INTERACTIVE ? RSS Vg������þú NO! JMP ZIPLU YES, DON'T LOCK IT * JSB LURQ UNLOCK ANY PREVIOUS LOCK DEF *+2 DEF MSIGN * JSB LURQ NOW LOCK THE NON INTERACTIVE LU DEF *+4 DEF P1 SPECIFY LOCK DEF IPBUF SPECIFY THE LU DEF P1 AND THE # OF LU'S * LDA IPBUF GET THE LU IOR M200 SET V BIT TO USE COLUMN 1 ZIPLU STA LISTU AND SET IT UP * JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 DEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3 ERROR CODE TO A JSB FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREAT IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP JMP LSTCH LAST CHANCE IS AN OP OR FM * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAL������þúVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES SSA,RSS IF NEG SZA,RSS OR ZERO JMP PRERR IT'S AN ERROR. STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER LSTCH JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * ********************************************************************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TY PRIOR LMAIN HMAIN LO BP HI BP SZ EMA MSEG PTN TM COM S-ID * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "<LONG BLANK ID>" OR "<SHORT BLANK ID>" * * * LLIST JSB SPACE LDB LLM1 PRINT LDA P72 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N36 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET XLB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO ®Ì������þúSINGLE JMP GTNBR TERMINATION * ADB P12 SET TO NAME AREA. XLA B,I GET NAME 1,2, STA LLM1+1 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB XLA B,I SET NAME 3,4 STA LLM1+2 IN MESSAGE. INB XLA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+3 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * XLA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+4 AND STORE. * XLA B,I GET THE WORD AGAIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * XLA B,I ONE MORE TIME AND M200 GET TEMPORARY LOAD BIT STA WTEMP AND SAVE * CLB STB OPCOD INSURE AN OCTAL CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN XLA A,I GET IT LDB LLM11 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD XLA A,I LDB LLM8 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LOW BP XLA A,I GET THE WORD LDB LLM14 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP XLA A,I LDB LLM17 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL45 YES * PROR XLB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY XLA B,I GET THE PÉ������þúRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM5 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * * * XLB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD XLA B,I GET THE SIZE STA XTEMP SAVE IT AND M1600 GET MEMORY PROTECT FENCE ARS LDB NCMPF DEFAULT WILL BE NO COMMON CPA M200 REAL COMMON? LDB RTMPF CPA M300 BACKGROUND COMMON? LDB BGMPF CPA M400 SSGA? LDB SSMPF STB LLM1+33 PUT IT IN THE MESSAGE * LDA ZTEMP GET THE PROG TYPE AGAIN CPA P1 MEM RES ? JMP LL4 YES, SO WE'RE DONE * LDA XTEMP SIZE WORD AGAIN AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+21 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4. NO, SO GO DO OUTPUT * AND M77 SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+29 SAVE IT * LL4. XLB ABT1,I GET THE ID SEG AGAIN ADB D28 GET TO EMA WORD XLA B,I PULL IT IN SZA,RSS ANY EMA DECLARED ? JMP LL43 NO, SO WE'RE DONE WITH THIS LINE * STA LLIST SAVE WORD AND B1777 KEEP EMA SIZE LDB LLM22 GET THE ADDRESS JSB CONVD AND CONVERT * LDA LLIST NOW GET THE MSEG SIZE FROM THE ALF ID EXTENSION RAL,RAL AND M77 XLB $IDEX ADA B XLA A,I NOW HAVE THE MSEG ADDRESS XLA A,I NOW HAVE THE MSEG WORD AND M37 JSB CNV99 · ������þúSTA LLM1+26 * * LL43 XLB ABT1,I ID ADDR AGAIN! ADB P31 INDEX TO NEXT TO LAST WORD XLA B,I GET IT AND M377 OWNER IS IN LOW 8 BITS LDB LLM34 DESTINATION JSB CONVD CONVERT IT * * LL45 LDA PELD PERMANENT LDB WTEMP TEMPORARY? SZB WELL? LDA TELD YES, CHANGE A REG TO TEMPORARY STA LLM1+31 PUT IT IN THE MESS * * LL4 LDA P72 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD XLA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * * GTNBR LDA P3 INSURE DECIMAL CONVERSION STA OPCOD JSB BLKID LDA BID5 GET # OF LONG LDB L#1 GET ADDRESS JSB CONVD CONVERT * LDA BID6 GET # OF SHORT IDS LDB L#2 JSB CONVD * LDA BID11 GET # OF ID EXTS LDB L#3 JSB CONVD * JSB SPACE LDA P64 PRINT THE INFO LDB L#IDS JSB DRKEY AND AS PORKY PIG WOULD SAY : * JMP EXIT THA-THA-THA-THA-THATS ALL FOLKS !!!!! * * * PURGE LDA IADR GET SCB ADDR SZA,RSS IF ITS 0, JMP *+3 THEN IT IS NON-SESSION SSA,RSS CHECK IF IN SESSION JSB CAPCK YES, IN SESSION. GO TO CHECK CAP LEVEL CLA,INA NOT IN SESSION, GO GET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB )â������þú UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZB RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU * * * LDA TYPE1 WAS A NAME ENTERED? SZA FROM RUN STRING? JMP GOTNM YES,SO OK * * * LDA TYPE2 GET COMMAND TYPE ERA,SLA FILE OR LU? JMP TRLOG FILE, SO PROMPT LOG LU * LDA FILE2 GET THE CMND FILE LU # AND M77 KEEP ONLY LOWER BITS JSB INTER SEE IF IT'S INTERACTIVE JMP TRLST NOPE GOTIT IOR M400 SET ECHO BIT STA LISTU AND SET THE LU JMP TRYAG GO PRINT THE MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP ONLY LU JSB INTER GO SEE IF ITS INTERACTIVE JMP LDI5 THAT'S NOT EITHOR, SO FLUSH HIM ! JMP GOTIT * TRLOG LDA MYLU# GET LOG LU AND M77 KEEP ONLY LU JSB INTER SEE IF INTERACTIVE JMP LDI5 NO,SORRY JMP GOTIT YES,GO FOR IT * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM2+1 GET AN ASCII BLANK STA NAM12,I AND INITIALIZE BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT DEFCK JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TO¸ø������þúO !) * GOTNM LDA FILE1 NAME IS IN FILE1 STA NAM12,I MOVE TO NAM12 LDA FILE1+1 STA NAM34,I NAM34 LDA FILE1+2 STA NAM5,I NAM5 JMP DEFCK CONTINUE AS BEFORE SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * L#IDS DEF *+1 ASC 22,XXXXXX FREE LONG IDS, XXXXXX FREE SHORT IDS, ASC 10,XXXXXX FREE ID EXTS * L#1 DEF L#IDS+1 L#2 DEF L#IDS+12 L#3 DEF L#IDS+23 LLM1 DEF *+1 ASC 20,NAME TY PRIOR LMAIN HMAIN LO BP HI BP ASC 16,SZ EMA MSEG PTN TM COM S-ID SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, <SHORT BLANK ID> LLM3 DEF *+1 ASC 9, <LONG BLANK ID> * LLM8 DEF LLM1+8 LLM11 DEF LLM1+11 LLM14 DEF LLM1+14 LLM17 DEF LLM1+17 LLM5 DEF LLM1+5 LLM22 DEF LLM1+22 LLM34 DEF LLM1+34 P24 DEC 24 P25 DEC 25 N36 DEC -36 D28 DEC 28 LLM2 DEF *+1 ASC 5, PNAME ?_ * * * * CHECK THE CAPABILITY LEVEL WHEN IN SESSION. * THIS SUBROUTINE WILL NEVER BE CALLED IF USER NOT IN SESSION. * CAPCK NOP JSB CAPGT GET THE CAP. LEVEL LDA P60 CMA,INA IF LEVEL > OR = 60 ADA LCAP SSA IT IS O.K. JMP CAPER IF LEVEL < 60 , RETURN AN ERROR AND ABORT IT. JMP CAPCK,I * * * GET THE USER'S CAPABILITY LEVEL * CAPGT NOP JSB ISMVE DEF *+5 DEF IADR SCB ADDR DEF $SMCA OFSET BACK TO THE CAPABILITY DEF LCAP RETURN SESSION CAPABILITY LEVEL DEF P1 GET 1 WORD * LDA LCAP SSA JMP SCBER CONTENTS OF SCB ADDR IS INVALID, ABORT IT. JMP CAPGT,I IT IS VALID VALUE, GO BACK * * ERROR RETURN IF SCB CONTENT IS INVALID * SCBER LDA ERR22 JMP ABOR * * ERROR RETURN IF CAPABILITY LEVEL IS LOWER THAN 60 AND TRY TO * PU,PE,RP A PROGRAM. * CAPER LDA ERR23 JMP ABOR * * * ADJST NOP XLA ABT1,I GET THE ID ADDRESS AGAIN LDJT������þúB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+1 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+2 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+3 JMP LIST?,I SUCCESS !!! JMP LL2 SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVERLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3 LOCAL/SYS/REVERSE M60 OCT 60 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD /APPEND DEBUG TELD ASC 1,TE PELD ASC 1,PE NCMPF ASC 1,NC RTMPF ASC 1,RT BGMPF ASC 1,BG SSMPF ASC 1,SS WTEMP NOP XTEMP NOP YTEMP NOP ZTEMP NOP BKLWR NOP LAST WORD OF AVAIL MEMORY INDLU NOP TEMP LU WORD #PGPT NOP # OF PAGES IN PART'N * MYLU# DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * * * GTCMD NOP JSB CLOS2 CLOSE CURRENT LIB * JSB NAMRR NOW GET THE COMMAND FILE NAME SSA,RSS END OF STRING ? JMP NOSTG NO * LDA MYLU# YES, NO STRING. GET THE DEFAULT LU CCB SET B-REG TO -1 CPB BATCH RUNNING UNDER BATCH? LDA P5 YES,DEFAULT TO LU 5 STA IPBUF PUT INTO PARSE BUFFER CLA,INA SET TYPE WORD TO LU (NOT A FILE) €1������þú STA IPBUF+3 * NOSTG LDA N6 GET THE NEG COUNT AGAIN JSB MOVE AND MOVE THE NAME TO THE CMND NAME BUFFER DEF IPBUF SOURCE OF MOVE DEF FILE2 COMMAND FILE NAME ADDRESS * CLA CLEAR INTERACTIVE FLAG STA DFLAG * LDA TYPE2 GET THE PARSE TYPE WORD AND P3 KEEP ONLY THE LEAST TWO BITS STA TYPE2 AND SAVE FOR LATER * ERA,SLA IS IT A FILE OR AN LU ? JMP GTCMD,I FILE, SO JUST RETURN LDA FILE2 AN LU. JSB INTER SEE IF IT IS INTERACTIVE JMP GTCMD,I SO JUST RETURN * ISZ DFLAG IT IS SO SET THE INTERACTIVE BIT * LDB DOLST WAS DOLST EVER CALLED? SZB WELL? JMP STECH YES, LIST DEVICE SET UP ALREADY * ISZ DOLST NO, MARK IT SO WE KNOW WE DONE IT STA FILE3 IT IS, SO MAKE IT THE LIST LU IOR M200 USE COLUMN 1 STA LISTU STECH IOR M400 SET THE ECHO BIT STA FILE2 ON THE LU FOR THE PROMPT JMP GTCMD,I RETURN * * * * FOPEN JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DATA CONTROL BLOCK DEF IERR2 ERROR FLAG DEF FILE2 FILE NAMR DEF IPTN2 OPEN OPTION DEF F2SC SECURITY CODE DEF F2DSC CARTRIDGE REF # * SSA,RSS ANY ERRORS ? JMP FREAD NO LDB F2 GET THE FILE NAME ADDRESS JSB FLERR YES * * * COMMAND FILE PROCESSOR * * LREAD LDA DFLAG (ALL LU READS RETURN HERE) GET THE FLAG SZA ARE WE INTERACTIVE ?? JSB PRMTR YES, SO OUTPUT LOADR PROMPT JSB REIO NOW READ THE INPUT DEF *+5 DO IT IN A REENTRANT FASHION SO THAT DEF P1 WE ARE SWAPABLE DEF FILE2 DEF STRNG DEF N80 SZB,RSS WAS THE READ OF ZERO LENGTH ? JMP RETRY YES, END OF INPUT, GO SEE IF RETRY ALLOWED CMND STB SL@������þúONG SAVE READ LENGTH FOR PARSING ROUTINE CLA,INA SET UP PARSING OFFSET TO START PARSING STA TRYCT RESET RETRY COUNT STA ISTRC AT THE FIRST CHARACTER JSB NAMRR PARSE THE OPCODE LDB IPBUF+1 GET 3RD & 4TH CHAR STB OP1? LDB IPBUF AND SAVE THE OPCODE STB OP? TEMPORARIALLY * * THESE COMMANDS MAY BE ENTERED ANY TIME * * CPB EN END OF COMMAND FILE ? JMP SECHK CPB /E END OF COMMAND FILE ? JMP SECHK CPB EX END OF COMMAND FILE ? JMP SECHK CPB LO MODIFY CURRENT LOAD POINT ? JMP SECHK CPB SE A SEARCH COMMAND ? JMP SECHK CPB MS A MULTIPLE SEARCH COMMAND? JMP SECHK CPB FO A FORCE COMMAND ? JMP FORCE CPB RE A RELOCATE COMMAND ? JMP SECHK CPB DS DISPLAY UNDEFS ? JMP DSPLY CPB EC ECHO COMMANDS ? JMP SUPRS CPB LI LIBRARY FILE ? JMP GTLIB CPB .A ABORT ? JMP ABORT CPB AB ABORT ? JMP ABORT CPB TR TRANSFER ? JMP XEQTR CPB SL LIBRARY SEARCH ? JMP SECHK LDA B AND M7400 CPA AS2RK JMP NXTOP * LDA DONE? GET THE MAIN LOADED FLAG SZA,RSS HAS THE MAIN BEEN LOADED ? JMP OVLY1 NO, GO TO OVERLAY AREA FOR REST OF COMNDS * PRERR LDA DFLAG GET THE INTERACTIVE FLAG ? SZA,RSS ARE WE IN THE INTERACTIVE MODE ? JMP DOERR GO DO THE INPUT ERROR THING JSB PRMTR YES, JSB EXEC SO GIVE HIM ANOTHER CHANCE DEF *+5 DEF P2 DEF FILE2 DEF PROMT+6 DEF P1 * CLA CLEAR FLAG IN CASE STA LIBLM IT WAS SET * JMP NXTOP GO GET THE NEXT INPUT * RETRY LDA DFLAG WE INTERACTIVE? SZA,RSS WELL? JMP END?? v©������þú NO, END OF INPUT, GO DO ERROR CHECKING LDA TRYCT YES, GET TRY COUNT CPA P5 WE ALREADY TRY 5 TIMES? JMP END?? YES, SO DO ERROR CHECKING ISZ TRYCT NO, INCREMENT COUNT JMP LREAD AND TRY AGAIN * DOERR LDA CLEN GET THE READ LENGTH SZA IF NON ZERO ECHO IT JSB IECHO LDA LIBLM GET THE LIB LIM EXCEEDED FLG SZA,RSS WAS IT? JMP LDI5 NO,SO JUST ABORT THYSELF LDA ERR13 YES, SEND LM LIB JMP ABOR ERROR MESSAGE * LIBER ISZ LIBLM INC LIB LIM FLAG JMP PRERR GO PROCESS THE ERROR * OP? NOP LAST OPCODE LIBLM NOP LIBRARY LIMIT EXCEEDED FLAG ISTRC DEC 1 POINTER TO CURRENT CHAR TO BE PARSED TRYCT NOP REPROMPT COUNT FOR INTERACTIVE LU * * PROCESS THE COMMAND. * DSPLY LDA DFLAG GET THE CMND INTERACTIVE FLAG SZA,RSS IS IT INTERACTIVE ?? JMP DSPL1 NO LDB LISTU YES SO GET THE LIST LU STB QTEMP AND SAVE LDB FILE2 GET THE CMND LU STB LISTU AND USE IT AS THE LIST DEVICE LDB TYPE3 GET TYPE STB PTEMP AND SAVE CLB,INB STB TYPE3 JSB PUDF REPORT UNDEFS LDB QTEMP GET THE LIST LU BACK AGAIN STB LISTU AND RESTORE IT LDB PTEMP GET TYPE STB TYPE3 AND SAVE IT TOO JMP NXTOP GET NEXT COMMAND DSPL1 JSB PUDF REPORT UNDEFS JMP NXTOP GET THE NEXT COMMAND SUPRS CCA STA ECHO? NXTOP LDA TYPE2 GET THE TYPE OF INPUT ERA,SLA WHERE ARE WE READING FROM ? JMP FREAD A FILE JMP LREAD AN LU FORCE CCA SET THE FORCE STA FORCD FLAG. STB MES12+28 SET UP OPTION MESSAGE-FORCE JMP NXTOP RELOC CCA GET A -1 CPA UNFLG IS UNDEF PROCESSING FLAG SET? JMP W25 YES, RE NOT ALLOWED CLA,RSS NOW SEéæ������þúT A FEW FLAGS SERCH CCA NOW SET A FEW FLAGS STA LBS.L IS A LIBRARY SEARCH * DOPRS CLA SET A FEW FLAGS STA SCSEG CLEAR SCAN TILL SEG ENCOUNTERED FLAG STA SLIBF NOT A SYS LIB SCAN STA LGOU NOT AN LG READ CMA STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST JSB NAMRR PARSE TH INPUT SSA WAS THERE ANYTHING TO PARSE ? JMP SE?? NO SEE IF LAST ONE WAS A SE,< > LDA IPBUF GET THE 1ST PARSED WORD SZA IF = 0 OR CPA PROMT+4 = ASCII BLANK THEN JMP SE?? BETTER BE A SE,0, OR SE,, COMMAND * LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * W25 LDA P8 SEND A NASTY NOTE LDB WNG25 AND GIVE HIM JSB SYOUT ANOTHER JMP LREAD TRY * WNG25 DEF *+1 ASC 4,W-IL CMD * DLOAD JSB NAMRR GO PARSE THE INPUT TO GET NEW LOAD ADDRESS LDA IPBUF+3 GET THE TYPE OF PARAMETER SLA RAR,SLA ONLY NUMERIC ALLOWED. NO ASCII. JMP PRERR SHAME ON YOU ! LDA TH1.L GET THE CURRENT LOAD ADDRESS CMA,INA AND MAKE SURE THAT THE NEW LOAD ADA IPBUF ADDRESS IS ABOVE THE OLD ONE SSA IS IT ? JMP PRERR NO, SEND AN ERROR LDB IPBUF GET THE ADDRESS AGAIN SSB IF NEGATIVE JMP PRERR ITS AN ERROR ALSO CLA OK, SO CLEAR THE UNUSED AREA ADB N1 UP TO BUT NOT INCLUDING NEW LD ADDR JSB OUTAB OUTAB WILL CHECK TO SEE IF HE SET THE DEF *+3 DUMMY DEFS DEF *+2 TO FAKE OUT DEF *+1 OUTAB * JMP NXTOP LD PT RST IN L.REL,L.SG0. NOÔ>������þúW GET NEXT CMND. * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? JMP SEOK YES CPA MS WAS IT AN 'MS'? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * SEOK JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN FLIB NOP 0/-1 NOT/IS A LIBRARY FILE SCAN SVTP1 NOP OLD INPUT FILE TYPE WORD STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE CPA MS WAS IT A MSEARCH? JMP SERCH YES, SO SEARCH IN THIS CASE, TOO CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE CPA LO WAS IT A CHANGE LOAD ADDRESS CMND ? JMP DLOAD YES, SO GO SET UP NEW LOAD ADDRESS CPA SL WAS IT A SEARCH LIBRARY COMMAND ? JMP SELIB THEN DO IT JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * GTLIB JSB NAMRR PARSE FOR NEXT INPUT SSA ANY ERRORS ? JMP PRERR YES, NOTHING TO PARSE * LDA IPBUF+3 GET THE TYPE WORD AND P3 KEEP ONLY TYPE CPA P3 WAS THE INPUT ASCII ? RSS YES. SO ITS OK FOR NOW. JMP PRERR NO, LU'S ARE NOT LIBRARY FILES. * LDB LPNTR GET THE POINTER TO THE LAST LIB FILE CPB END TOO MANY LIB FILES ? JMP LIBER THATS AN ERROR TOO. STB NXTAD OK. SO MOVE NAME & SC & CART # TO BUFFER AREA * LDA N3 MOVE COUNT JSB MOVE DEF IPBUF öÄ������þúSOURCE NXTAD NOP DESTINATION SET ABOVE * LDB LPNTR GET THE SOURCE ADDR ADB P3 ADD MOVE COUNT LDA IPBUF+4 GET THE SECURITY CODE STA B,I & STUFF IT INB BUMP POINTER LDA IPBUF+5 GET THE CART REF # STA B,I AND STUFF THAT TOO. INB STB LPNTR RESET THE POINTER ADDRESS FO NEXT LIB. JMP NXTOP GET THE NEXT COMMAND. * XEQTR CCA GET A -1 CPA UNFLG ARE WE DOING SPECIAL UNDEF EXT STUFF? JMP XEQT1 YES, TR ALLOWED, TR,XXXXX NOT ALLOWED JSB GTCMD CLOSE OUT OLD FILE & OPEN NEW. JSB BREAK CHECK IF ABORT DESIRED LDA TYPE2 GET THE TYPE WORD ERA,SLA FILE OR LU JMP FOPEN FILE JMP LREAD LU * XEQT1 JSB NAMRR GET COMMAND FILE NAME SSA,RSS ANY? JMP W25 YES, NOT ALLOWED * CLA NO, RESTORE WHAT WE STARTED WITH STA UNFLG CLEAR UNDEF PROCESSING FLAG STA TRY2 CLEAR 2ND TRY NOT ALLOWED FLAG * LDB SVOP RESTORE STB OP? THE LAST OP CODE * LDA SF2TY GET SAVED COMMAND FILE TYPE SZA ANY? JMP XEQT3 YES, GO RESTORE IT * CPB EN NO, WAS COMMAND AN EN? JMP XEQT2 YES, GO CLEAR CMMD FILE CPB /E WAS COMMAND A /E? JMP XEQT2 YES, GO CLEAR CMMD FILE CPB EX WAS COMMAND AN EX? JMP XEQT2 YES, GO CLEAR CMMD FILE JMP XEQT4 NO,LEAVE CMMD AS IS, SEE ABOUT RELOC * XEQT2 STA TYPE2 CLEAR FILE TYPE WORD STA DFLAG AND INTERACTIVE LU WORD JMP XEQT4 GO CHECK OUT RELOCATABLE * XEQT3 LDA N6 JSB MOVE MOVE CMMD FILE DEF SFIL2 INFO BACK DEF FILE2 LDA SF2IN RESET INTERACTIVE FLAG STA DFLAG CLA CLEAR OUT STA SF2TY SAVED CMND FILE TYPE LDA TYPE2 IS COMMAND AN LU OR FILE? ERA,SLA ¼"������þú JSB OPPOS A FILE, SO OPEN AND POSITION IT * XEQT4 LDA SF1TY GET RELOC TYPE SZA,RSS ANY? JMP LOADX NO, GO PRETEND LIKE NOTHING HAPPENED * LDA N6 YES JSB MOVE RESTORE RELOC DEF SFIL1 FILE DEF FILE1 CLA CLEAR OUT STA SF1TY SAVED RELOC FILE TYPE LDA TYPE1 IS RELOC A FILE OR LU? ERA,SLA RSS * JMP LOADX AN LU SO GO PROCESS OLD OP * JSB OPEN A FILE, SO OPEN AND POSITION IT DEF *+8 DEF IDCB1 DEF IERR1 DEF FILE1 DEF IPTN1 DEF F1SC DEF F1DSC DEF IDCBS * SSA,RSS ANY ERRORS? JMP POS1 NO, SO GO POSITION IT LDB F1 YES, GET FILE NAME ADDRESS JSB FLERR AND SEND ERROR MESSAGE * POS1 JSB APOSN GET TO THE RIGHT RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF SF1RC DEF SF1RB DEF SF1OF * SSA,RSS ANY ERROR? JMP LOADX NO, PRETEND LIKE NOTHING HAPPENED LDB F1 YES, GET FILE NAME ADDRESS JSB FLERR AND SEND ERROR MESSAGE * OPPOS NOP ROUTINE TO OPEN & POSITION CMMD FILE * JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DEF IERR2 DEF FILE2 DEF IPTN2 DEF F2SC DEF F2DSC * SSA,RSS ERROR? JMP POS2 NO LDB F2 YES, GET FILE NAME ADDRESS JSB FLERR AND RETURN THE ERROR * POS2 JSB APOSN POSITION THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF SF2RC DEF SF2RB DEF SF2OF * SSA,RSS ANY ERROR? JMP OPPOS,I NO, RETURN LDB F2 YES, GET FILE NAME ADDRESS JSB FLERR RETURN ERROR JMP OPPOS,I RETURN * SELIB JSB LIBSC SCAN THE LIBRARIES JMP NXTOP GO GET NEXT COMMAND * * * THE FOLLOWING ARE THE LEGAL CÁÛ������þúOMMAND FILE COMMANDS * DS ASC 1,DI TR ASC 1,TR SL ASC 1,SL LI ASC 1,LI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE MS ASC 1,MS FO ASC 1,FO EN ASC 1,EN .A ASC 1,/A AB ASC 1,AB /E ASC 1,/E EX ASC 1,EX LO ASC 1,LO AS2RK OCT 25000 AN * ECHO? NOP LPNTR DEF LIBRY POINTER TO LIBRARY NAME BUFFERS SPC 1 * * * IERR2 NOP ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 DEC 1 OPEN OPTION (NON EXCLUSIVE) IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO THE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JSB FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : * PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARANÖ������þúMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE HANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JSB FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR NOP STB EFILE SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV9}X������þú9 CONVERT TO ASCII STA B IF 1ST CHAR IS AND M774K ASCII BLANK CPA B20K THEN ADB B10K CHANGE TO A ZERO STB EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I IT STA EFBUF+11 INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * JSB PTERR POST THE ERROR DEF *+2 DEF EFBUF+1 * LDA DFLAG GET INTEACTIVE FLAG SZA,RSS WE INTERACTIVE ? JMP PRNIT NO,JUST GO PRINT IT * LDA LISTU SAVE THE LIST LU STA QTEMP LDA FILE2 REPLACE WITH INTERACTIVE LU STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * PRNIT LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP FLER1 NO, LOG FILE ERROR TO LOG DEVICE * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP STA TYPE3 AND TYPE OF LIST DEVICE WORD * JMP NXTOP GO GET NEXT COMMAND * FLER1 LDA TYPE3 IS LIST DEVICE ERA,SLA FILE OR LU? JMP FLER2 FILE, SO CAN'T BE LOG DEVICE LDA LISTU IS LIST DEVICE AND M77 CPA MYLU# LOG DEVICE? JMP LDI5 YES, DO REST OF ERROR THING * FLER2 LDA LISTU SAVE LIST DEVICE STA QTEMP LDA MYLU# REPLACE WITH LOD DEVICE STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * LDA P26 GET CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY SO LOG FILE ERROR * LDA QTEMP RESTORE LIST DEVICE ^������þúSTA LISTU LDA PTEMP RESTORE TYPE OF LIST DEVICE STA TYPE3 * JMP LDI5 DO REST OF ERROR THING * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 M774K OCT 77400 B20K OCT 20000 B10K OCT 10000 * * *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR AND IGN.LES ANY ERROR RETURNS. AFTER ALL WHAT ELSE *CAN YOU DO ?? * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB,CLE STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE RSS NOT INTERACTIVE JMP USEL2 IS INTERACTIVE USEL1 LDA MYLU# ITS NOT, SO USE START UP LU USEL2 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR-0XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKýB������þúED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SAVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 IF DVR07 SUBCHANNEL = 0 RSS JMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LG, LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * D%������þú JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. LDA TYPE1 NO, SO GET THE READ TYPE WORD ERA,SLA IS THE READ FROM AN LU OR FILE JMP RREAD A FILE SO GO READ THE NEXT RECORD. * SKP * * LOAD FROM INPUT LU * JSB EXEC DEF *+5 DEF P1 1 = READ REQUEST DEF PGMIN PROG INPUT UNIT NO. DEF L.BUF+0 L.BUF = INPUT BUFFER DEF P64 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP RECLS SZB JMP TESTR JMP RECLS * * PGMIN OCT 305 SEOT OCT 705 B400 OCT 400 * * M240 OCT 240 * SPC 1 * OPENN NOP JSB OPEN OPEN THE FILE ! DEF *+8 DEF IDCB1 DCB DEF IERR1 ERROR FLAG DEFF1 DEF FILE1 ASCII FILE NAME DEF IPTN1 READ OPTION DEF F1SC SECURITY CODE DEF F1DSC CART REF # DEF IDCBS # OF BUFFER WORDS * SSA,RSS ANY ERROR IN THE READ ? JMP OPENN,I NO LDB F1 YES , GET THE FILE NAME JSB FLERR AND REPORT * * * * F1OPN JSB OPENN OPEN THE FILE FNXT1 CLA STA NAM#1 SET TO FIRST NAM IN FILE STA RSRSC DO NOT RESET AND RESCAN (AT BEGINNING) STA SXREC RESCAN POINT NOT SET YET STA #SEGS CLEAR # OF SEGMENTS ENCOUNTERED FLAG STA #NAMS CLEAR # OF NAMS FOUND WHILE SCAN TILL SEG FLAG STA YREC CLEAR THE SEGMENTED PROGRAM RESCAN PË ������þúOINTER STA ZREC CLEAR THE SEGMENTED PROGRAM RESCAN POINTER INA STA XREC SET RESCAN POINTER TO 1ST RECORD IN THE FILE. * SPC 1 RREAD JSB READF READ THE NEXR RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF L.BUF+0 RELOCATABLE RECORD BUFFER ! DEF P64 DEF LEN ACTUAL RECORD LENGTH READ * SPC 1 SSA,RSS ANY ERRORS ? JMP FNXT2 NO LDB F1 YES, GET THE FILE NAME JSB FLERR AND REPORT SPC 1 FNXT2 LDA LEN GET THE RECORD LENGTH READ SZA,RSS ZERO RECORD LENGTH ? JMP RREAD YES, SO TRY AGAIN SSA,RSS NO, WAS IT A NEG LENGTH ( -1 ) JMP TESTR NO, SO GO PROCESS RECORD ! * LDA FLIB THIS A FILE LIB SCAN (LI,XXXXX COMMAND) SZA,RSS WELL ? JMP NOLIB NO. * ISZ NOR.L YES, ANYTHING LOADED ? JMP RWNDL YES, SO DO IT AGAIN JMP LBRTN NO, SO GO CHECK OUT THE NEXT FILE. * SPC 1 NOLIB LDA RSCNX YES ! SZA WERE WE RESCANNING THE FILE ?? JMP NSCAN YES NOW GO RESET THE FILE BACK * LDA LBS.L IS THIS A LIBRARY SCAN ? ADA SCSEG AND NOT A SCAN TILL SEGMENT FOUND SZA,RSS WELL? JMP CK#SG NO, SEE IF ANY SEGMENTS IN THIS FILE LDA OP? CPA MS WAS THE COMMAND AN MS? JMP MSSE YES , CONTINUE CHECKING LDA OP1? DID HE SAY SE, OR SEXXXX, ? CPA ASNUL WELL JMP RECLS SE, SO DON'T LOOK FOR BACKWARD REFS MSSE ISZ NOR.L YES, WAS ANYTHING LOADED ? JMP DUMMY YES, SO DO IT AGAIN (BACKWARD REF FIX) JMP RECLS NO, SO GO CLOSE THE FILE * CK#SG LDA #SEGS GET THE # OF SEGMENTS IN THIS FILE SZA,RSS ANY ? JMP RECLS NO. * LDA #NAMS WERE THERE ANY NAMS AFTER THE SEGMENT ? CMA,INA,SZA JMP SCANW YES,SET A REG NEG * * RECLS JSB CLOS1 °÷������þú NO , EOF REACHED. CLOSE FILE * ISZ SKP.1 SKIP IF 1ST CMND NOT YET DONE RSS JMP SECK1 GO DO LAST COMMAND * LDA TYPE2 GET THE CMND FILE TYPE WORD. SZA IS THERE A CMND FILE ? JMP NXTOP YES, SO GO GET NEXT COMMAND * CLFL1 LDA P3 NO CNMD FILE & NO RELOC FILE. MUST BE LDB SEG.L FINISHED WITH USER INPUT. SO IF SZB THE PROG IS SEGMENTED. SET LAST SEG STA MSEGF FLAG. JMP LOADX NOW GO FINISH THE LOAD. * * F1 DEF FILE1 POINTER TO RELOC FILE BUFFER LEN NOP LENGTH OF READ OF RELO FILE ASNUL ASC 1, A BLANK OP1? NOP 2ND WORD OF SEARCH COMMAND (SEXXCH) * * * ALL FORCE LOADS COME HERE TO CLEAN UP FIX UP TABLE * * FIXCL LDA SEG.L GET THE SEGMENTED PROG FLAG SZA,RSS IS PROG SEGMENTED ? JMP NODEX NO, DON'T NEED TO CLEAN UP FIXUP TABLE. * JSB L.IFX CLEAN UP FIXUP TABLE DEF *+1 JMP NODEX GO FINISH * P13 DEC 13 LDI5 LDA ERR10 JMP ABOR * * * * * SYMBOL TABLE OVERFLOW * LOVER EQU * JSB CPRNM PRINT MODULE NAME(IF PRSENT) LDA ERR05 SET CODE EQUAL LST OVERFLOW ABOR JSB ERROR * JSB PTERR POST THE ERROR TO THE SCB DEF *+3 DEF MERR DEF ERROR (DUMMY PARAMETER) * ABORT CLA CLEAR STA PRAM+4 P5 LDA MERR PUT L- STA PRAM+3 IN P4 LDA MERR+1 AND THE STA PRAM ERROR LDA MERR+2 MESSAGE STA PRAM+1 IN P1-P3 LDA MERR+3 FOR PRTN ROUTINE STA PRAM+2 FOR RETURN MESS FOR FATHER LDA P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP *+1,I TERMINATE LOADER(AND THIS PROGMER) DEF LTERM (SAVE A BP LINK TOO ) * MES10 DEF *+1 ASC 7,LOADR ABORTED SKP * * INPUT FROM DISC LOAD-AND-GO AREA (SYSTEM LIBRARY SCAN ) * LDRN2 LDB XCUR _������þú IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, RSS READ NEXT SECTOR JMP LDRN4 DON'T BOTHER ITS IN CORE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB SECT2 IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN6 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK ADD 1 TO TRACK # * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF P2 DEF XBUF DEF P128 READ 2 LOGICAL SECTORS (1 PHYSICAL 7900) DEF LGTRK DEF LGSEC * ISZ LGSEC -ADD 2 FOR NEXT SECTOR. ISZ LGSEC LDA XBUFA SET STARTING BUFFER STA XCUR ADDR LDA N128 AND STA LGT1 COUNTER = -128. LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 -NO- CLA CLEAR THE STA LBOEF FLAG LDA N64 RESET COUNT FOR HALF SECTOR ONLY STA LGT1 CLA STA XCNT SET REC COUNT TO ZERO LDA XBHLF SET THE BUF ADDR STA XCUR TO THE ODD SECTOR * LDRN4 CLA IF CURRENT CPA XCNT REC COUNT = 0, RSS THEN SET FOR NEW REC. JMP LDRN5 CONTINUE WITH CURRENT REC. LDA XCUR,I GET NEXT ALF,ALF REC LENGTH (UPPER CHAR.), AND M77 SET NEGATIVE CMA,INA,SZA,RSS JMP LDRNE YES, READ NEXT SECTOR STA XCNT NO, SAVE COUNT FOR MOVE LDA ALBUF RESET ADDR OF STA LGT2 L.BUF FOR MOVE. * LDRN5 LDA XCUR,I MOVE WORD FORM XBUF STA LGT2,I TO L.BUF ISZ XCUR UPDATE BUFFER ISZ LGT2 ADDRES. ISZ XCNT INDEX NOP ISZ LGT1 COUNTERS. NOP CLA LDB XBUFA RESET ADDR OF CPA LGT1 'XBUF' IF STB XCUR END OF XBUF. CPA XCNT IF¤‡������þú END OF REC, JMP TESTR GO TO PROCESS IT. CPA LGT1 IF END OF XBUF, JMP LDRN3 GO TO READ NEXT SECTOR. JMP LDRN5 CONTINUE WITH CURRENT REC. * N64 DEC -64 N128 DEC -128 P128 DEC 128 LDRNE LDA XBUFA WAS ZERO LENGTH REC AT CPA XCUR START OF A SECTOR? RSS JMP LDRN3 NO, READ NEW SECTOR. CCB YES, SUBTRACT 1 FROM CURR SECTOR ADB LGSEC IN CASE END OF LG ON ODD SECTOR JMP LDRN6 CHECK FOR END OF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * * * LGTRK NOP TRACK LGSEC NOP SECTOR LGS# NOP # SECS / TRK LGT1 NOP DOWN COUNTER IN XBUF LGT2 NOP CURRENT L.BUF ADDR XCNT NOP REC LENGTH RIC NOP REC INDICATOR SUBFD NOP SUBFIELD INDICATOR XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * * SKP * * THE SCANX ROUTINE SAVES OUR LOCATION IN THE FILE AND * THEN REWINDS THE FILE TO THE BEGINING SO THAT THE FILE * MAY BE SCANNED FOR UNDEFS. THIS ALLOWS A SUBROUTINE TO * PLACED IN THE FILE ONLY ONCE, BUT TO HAVE IT APPENDED TO * ANY SEGMENT OR MAIN THAT CALLS IT. SCANX IS CALLED WHENEVER * A SEGMENT NAM IS ENCOUNTERED IN THE FILE. WHEN THE END OF * FILE IS ENCOUNTERED THE FILE MUST ALSO BE SCANNED (IE MAY BE * THE LAST SEGMENT IN THE PROGRAM) IN THIS CASE EOF IS REACHED * INSTEAD OF THE NEXT SEGMENT. THIS IS DETECTED BY THE FILE * READ ROUTINE. IF MORE THAN ONE NAM IS ENCOUNTERED AFTER AHEN * SEGMENT BUT BEFORE THE NEXT SEGMENT OR EOF THEN THE * CONTROL IS TRANSFERED TO SCANW (A REG IS NEG). THEN #SEGS IS * MADE NEG AS A FLAG SO THAT THE NSCAN ROUTINE WILL CLOSE THE * FILE INSTEAD OF GOING OF TO DO A SYSTEM LIBRARY SEARCH. * * SCANW STA #SEGS SET FLAG FOR EOF REACHED & RESCANNING FILE CLA STA SCSEG CLEAR S‚:������þúCAN TILL SEG FOUND FLAG. SCANX CCA SET THE RESCAN FLAG HERE.(NOT BELOW) STA RSCNX * LDB SEG.L GET THE SEGMENTED PROG FLAG CPB P1 WE WORKING ON THE MAIN ? JMP SCFLG YES, SO FORGET ABOUT REWIND (WE GOT IT ALREADY) * LDA RSRSC OK TO RESCAN FILE SZA,RSS IF NEW FILE AND SEGMENT LOADED JMP NOSCN ELSE DON'T RESCAN * DUMMY JSB POSTX POST FILE (KLUGE FIX FOR A FMGR BUG !!!!!!) * * LDA XREC GET THE RESCAN POINTER SSA IF NEG, NO USEFUL SUBROUTINES IN THIS FILE JMP NOSCN NEG, SO DON'T BOTHER WITH RESCAN * JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLG NO, SO GO SET THE FLAGS DORWN LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LBS.L IS A SCAN OF LIBRARY STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST * LDB SEG.L GET SEG FLAG CPB P1 WORKING ON MAIN ? JMP TESTR YES, GO PROCESS THE RECORD AGAIN JMP RREAD READ THE RECORD * * * THE NSCAN ROUTINE SETS THE FILE BACK TO THE ORGINAL * LOCATION BEFORE THE SCANX ROUTINE REWOUND IT. * * NSCAN ISZ NOR.L ANYTHING LOADED LAST SCAN ?? JMP SMART SO DO IT AGAIN * LDA SXREC SET RESCAN POINT YET? SZA NO JMP APSNX YES * CCB LDA XREC GET THE POINTER TO 1ST SUBROUTINE AFTER CPA P1 FIRST SEGMENT. DID WE FIND A SUBROUTINE ? STB XREC NO, SO IN FUTURE NEVER REWIND THIS FILE * * APSNX JSB APOSN SET THE FILE BACK UP DEF *+6 DEF IDCB1 DEF IERR1 D9������þú DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES NOSCN CLA WE NEED TO RESET A FEW FLAGS STA LBS.L NOT A LIBRARY SCAN STA RSCNX NO LONGER RESCANNING THE FILE * LDB #SEGS GET THE # OF SEGS LOADED FLAG SSB,RSS WAS THE RESCAN DUE TO EOF OR NEW SEGMENT JMP LOADX NEW SEGMENT. SCAN SYS LIB FOR OLD SEG JMP RECLS EOF. SO GO CLOSE THE FILE . * SKP * * SMART JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLX NO, SO GO SET THE FLAGS LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLX JSB POSTX KLUDGE FIX FOR FMGR BUG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LBS.L IS A SCAN OF LIBRARY STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST * JMP RREAD SKP POSTX NOP JSB POST DEF *+3 POST THE FILE TO CLEAR ALL OF CORE BIT IN FMGR DEF IDCB1 ALSO FIXES A FMGR BUG ! DEF IERR1 * SSA,RSS ANY ERRORS ? JMP POSTX,I NO * LDB F1 YES JSB FLERR GO REPORT * SKP * * * SAVIT SETS THE RESCAN POINT FOR A FILE. * ANY CHANGES SHOULD STILL HANDLE THE FOLLOWING CASES. * (WHERE THE FILE CONTAINS THE FOLLOWING THINGS IN THE * GIVEN ORDER). NOTE THAT SCANX ALSO CONTAINS SOME * CONDITION CHECKS. * MAIN = PROGRAM MAIN * SUB = SUBROUTINE * SEG = SEGMENT * * = PLACE THAT RESCAN POINTER SHOULD * BE SET TO. * IN THE FILES WHERE NO MAIN APPEARS, ASSUME THAT THE MAIN * WAS IN Aëä������þú PREVIOUS FILE. * * * ------------------------------------------------------- * ! MAIN ! SUB ! SUB ! SEG ! SUB ! SEG ! SUB ! SUB ! SUB ! * ------------------------------------------------------- * * * * -------------------------------------------------- * ! MAIN ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * -------------------------------------------------- * * * * -------------- ------- * ! MAIN ! SUB ! ! SEG ! * -------------- ------- * NO RESCAN NO RESCAN * * -------------- ------------- * ! MAIN ! SEG ! ! SUB ! SEG ! * -------------- ------------- * NO RESCAN * * * ------------------------------------------- * ! SUB ! SEG ! SUB ! SUB ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------- * ! SEG ! SEG ! SEG ! SEG ! SEG ! * ------------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------------------- * ! SEG ! SEG ! SUB ! SEG ! SUB ! SUB ! SEG ! * ------------------------------------------- * * * * ------------------------------- * ! SUB ! SUB ! SUB ! SUB ! SUB ! * ------------------------------- * NO RESCAN * * ------------------------- ------------------- * ! SUB ! SEG ! SUB ! SUB ! ! SUB ! SEG ! SEG ! * ------------------------- ------------------- * * * * * -------------------------- * ! MAIN ! SEG ! SEG ! SEG ! * -------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SUB -£������þú! SUB ! SEG ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * * SKP * SAVIT NOP LDA SXREC DID WE ALREADY FIND THE SZA RESCAN POINT? JMP SAVIT,I YES LDA PGT.L GET THE NAM TYPE CPA P5 SEGMENT ? JMP SAVIT,I YES, FORGET IT * * LDA RSCNX WE IN THE RESCAN MODE ? SSA,RSS YES JMP SAVIT,I NO FORGET IT * JSB POSNT OK,SO BACK UP THE FMGR POINTER BY ONE DEF *+4 DEF IDCB1 DEF IERR1 DEF N1 * SSA ERRORS JMP XYZER YES * JSB LOCF SAVE THE POSITION DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC DEF YREC DEF ZREC * SSA ERRORS ? JMP XYZER YES * JSB POSNT MOVE POSITION BACK DEF *+4 DEF IDCB1 DEF IERR1 DEF P1 * SSA ANY ERRORS ? JMP XYZER YES ISZ SXREC NO, SET FLAG-RESCAN PT HAS BEEN SET JMP SAVIT,I RETURN * XYZER LDB F1 YES JSB FLERR * * IREC NOP IRB NOP RSCNX NOP 0/-1 NO RESCAN/ RESCAN OF FILE IN PROGRESS IOFF NOP LGOU NOP LG (SYS LIBRARY) IN USE FLAG #SEGS NOP #OF SEGMENTS IN THIS FILE FLAG XREC NOP RESCAN REC # YREC NOP RESCAN BLOCK OFFSET # ZREC NOP RESCAN OFFSET IN BLOCK SXREC NOP 0/NON ZERO HAVE NOT/HAVE SET UP RESCAN PT * SKP * TEST FOR VALID REC * TESTR JSB L.CLS CLASSIFY RECORD DEF *+3 DEF RIC STORE TYPE DEF SUBFD STORE SUBFIELD * CPA N1 ERROR? JMP CSERR YES-PROCESS CHECKSUM ERROR CPA N2 ERROR? JMP RCERR YES-PROCESS ILLEGAL REC TYPE ERROR * * CPA P1 TYPE=NAM? JMP NAMRX YES-PROCESS NAM REC CPA P2 TYPE=ENT? &¥������þú JMP ENTR YES-PROCESS ENT REC CPA P3 TPE=DBL? JMP DBLR YES-PROCESS DBL REC CPA P4 TYPE=EXT? JMP EXTR YES-PROCESS EXT REC CPA P6 TYPE=EMA? JMP EMARC YES-PROCESS EMA REC CPA P7 TYPE=ASCII? JMP LDRIN YES-IGNORE JMP ENDIT MUST BE AN END REC * * CHECKSUM ERROR. PRINT MODULE NAME * (MODULE NAME WILL BE IN MBUF IF A NAM REC * HAS ALREADY BEEN READ. OTHERWISE, IT WILL NOT * BE PRINTED SINCE IT MAY BE GARBAGED IN THE * THE NAM RECORD ITSELF. * CSERR JSB CPRNM PRINT NAME IF ANY LDA ERR01 CODE 01 = CHECKSUM ERROR JMP ABOR PRINT DIAGNOSTIC ON SYSTEM TTY & ABORT THYSELF * * * * ILLEGAL RECORD TYPE * RCERR EQU * JSB CPRNM PRINT MODULE NAME,IF GOOD LDA ERR02 CODE 02 = ILLEGAL REC JMP ABOR * * PRINT NAME OF MODULE(OR ENTRY POINT) * * CALLING SEQUENCE: * JSB PRNAM * DEF TO NAME TO BE PRINTED * <RETURN> * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA NM2.L,I GET "VALID NAME" FLAG SZA,RSS NAME READ? JMP CPRNM,I NO, EXIT LDA NM2.L SET THE DEF TO THE NAME INA GET PAST THE COUNT STA CPRN1 JSB PRNAM PRINT NAME CPRN1 NOP JMP CPRNM,I EXIT * * * SKP * * *** PROCESS END RECORD *** * * * ENDIT JSB BREAK SEE IF WE SHOULD BREAK * JSB L.REL PROCESS END RECORD DEF *+2 DEF FLAG * CPA N6 ERROR? JMP CMERR YES, PROCESS COMMON ALLOC ERROR CPA N8 ERROR? JMP NMERR YES, PROCESS REC OUT OF SEQ JMP NOCLR SKIP CLEARING OF BIT15/������þú IN LST1 * FLAG NOP ERROR RETURNED HERE * * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR06 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. * NOCLR LDA XBUFA RESET ADDR CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF L.BUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT L.BUF ADDR SKP * * * PRINT MEMORY MAP ENDKY LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA PRI.L GET PRIMARY ENTRY POINT SZA,RSS ANY? JMP NOPRE NO, OMIT PRIMARY ENTRY POINT PROCESSING STA PRENT,I YES, SET IN ID SEGMENT LDB NM2.L GET ADDRESS INB INC TO PROG NAME 1,2 LDA B,I GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT INB INC TO PROG NAME 3,4 LDA B,I GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT INB INC TO PROG NAME 5 LDA B,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR * LDB SEG.L NOW GET THE SEGMENT LOAD FLAG ERB,ERB TO E. LDB PTYPE GET THE PROG TYPE SEZ THIS A SEGMENT OR MAIN ? LDB M25 SEGMENT, SO SET TYPE & SEG BIT. IOR B * STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPe`������þúE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NM4.L,I GET PRIORITY SZA,RSS JMP CAPOK USER DIDN'S SET PRIORITY, DEFAULT 99 LDB P99 CKECK IF PRIORITY IS >,= 99 CMB,INB ADA B THEN SSA,RSS DON'T CARE IF USER IS IN SESSION JMP CAPFN LDB IADR OTHERWISE, GET SCB ADDR SZB,RSS IF IT IS 0, JMP CAPFN THEN IT IS NON-SESSION SSB JMP CAPFN IF NOT IN SESSION, CAP LEVEL IS OK JSB CAPGT IF IN SESSION, GET CAP LEVEL JSB SERPR SEARCH "PR" LEVEL IN $CMND CAPFN LDA NM4.L,I THE CAP LEVEL IS O.K. STA PRIOR,I SAVE THE PRIORITY CAPOK LDB NM4.L GET ADDRESS INB LDA B,I IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. AND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA TEMP1 IN 15-13 INB LDA B,I AND AND M7770 EXECUTION MULTIPLE IOR TEMP1 IN 11-00 STA RESL,I ADB P3 LDA B,I GET SECONDS MPY P100 SCALE TO TMS LDB NM4.L ADB P6 ADA B,I TMS+SCALED SECONDS STA TEMP2 SAVE ADB N3 LDA B,I GET HOURS MPY P60 SCALE TO MINUTES LDB NM4.L ADB P4 ADA B,I ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA TEMP2 TMS+SCALED SECONDS SEZ WAS THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND T]6������þúHE ID IF ONE JMP NOPRE NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG RSS THEN CHECK FOR COPIES OF THE PROGRAM JMP IDSN1 ELSE BE FRIENDLY & RENAME THE PROGRAM * JSB COPY. B-REG = ID ADDR/ SEE IF ANY COPIES OF PROGRAM JMP NOPRE WE GOT BACK ! MUST NOT BE ANY COPIES. * IDSN1 LDB NM2.L GET ADDRESS INB INC TO NAME LDA B,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG INB LDA B,I NAME MESSAGE BUFFER STA MESS7+13 INB LDA B,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 INVALID RESET PROG NAME LDA RENAM GET ASCII '##' LDB NM2.L GET ADDRESS INB SET TO NAME STA B,I SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. LDA P8 LDB WNG32 NOW SEND A WARNING MESSAGE JSB SYOUT JMP IDSN REPEAT DUPLICATE PROG NAME SCAN * IDSN2 LDA ERR32 GET ERROR MESSAGE & JMP ABOR ABORT THYSELF. SPC 1 WNG32 DEF *+1 ASC 4,W-DU PGM P27 DEC 27 M25 OCT 25 M7770 OCT 7777 TEMP1 NOP TEMP2 NOP RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * * THIS SUBROUTINE SEARCH FOR THE "PR" IN THE SESSION $CMND TABLE. * AND ALSO CHECK THE CAPABILITY LEVEL. * SERPR NOP XLA $CMAD GET THE ADDR OF TESTER ADA P2 ADVANCED TO END OF CMND SEARCH XLB A,I FETCH THE WORD STB STOP SAVE THE STOP ADDRESS * CAP2 INA ADVANCED TO FIRST(NEXT) LEVEL XLB A,I FETCH CAP LEVEL (NEG. #) INA POINT AT START ADDR FOR THIS LEVEL ADB LCAP COMPARE TO USERS LEVEL SSB IF USER LEVEL IS LOWER JMP CAP2 GO TO TRY NEI#������þúXT ONE * * FOUND START SEARCH ADDR (IN THE A REG) * XLB A,I NXCMD XLA B,I FETCH CMND CPA PR IS PR CMND ? JMP SERPR,I YES- LET THEM DO IT ADB P2 NO- ADVANCE TO NEXT ONE CPB STOP END OF TABLE? JMP CPER1 YES- GIVE WARNING AND FORCE TO 99 JMP NXCMD NO - GO TO NEXT CMND * * * GIVE WARNING MESSAGE IF NOT FOUND "PR" IN THE CMND TABLE * CPER1 LDB NM2.L INB LDA B,I PUT THE NAME IN THE STA MESS6+14 WARNING MESSAGE INB LDA B,I STA MESS6+15 INB LDA B,I STA MESS6+16 LDA P31 READY TO PRINT OUT LDB MESS6 THE WARNING MESSAGE JSB SYOUT LDA ERR23 JSB ERROR AND IN-CAP ERROR MESSAGE JSB SPACE JMP CAPOK FORCE PRIOR 99, GO BACK * PR ASC 1,PR LCAP NOP USER CAPABILITY LEVEL IADR NOP SCB ADDR STOP NOP CMND TABLE STOP ADDR MESS6 DEF *+1 ASC 16,FORCE PROG PRIORITY 99 - * * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE LDA IGN.L SZA IF LAST SCAN USEFUL JMP SLTST STA TRY2 THEN CLEAR 2ND TRY ALLOWED FLAG JSB PRMAP THEN PRINT MEM MAP SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA NM2.L,I LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? YES, CHECK ON NEXT OPERATION. * * LDA SEG.L IS THIS A SEGMENTED PROGRAM ? CPA P2 WELL ? RSS YES JMP LDRIN NO,GET NEXT RECORD * LDA PGT.L THIS MODULE A SEGMENT ? CPA P5 WELL ? RSS YES JMP LDRIN NO, GO GET THE NEXT RECORD. * LDA LBS.L WE, SCANNING AT THE MOMENT ? SZA WELL ? JMP LDRIN NO, GET THE NEXT MODULE * CCA SET THE LIBRARY SCAN FLAG STA LBS.L CL$æ������þúA,INA SET THE SCAN TILL NEXT SEGMENT FLAG STA SCSEG JMP LDRIN GO GET THE NEXT SEGMENT * * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SKP * * * PROCESS EMA RECORD. * * EMARC JSB L.REL PROCESS EMA RECORD DEF *+2 DEF FLAG * CPA N10 ERROR? JMP LL19 YES PROCESS EMA DEC. TWICE OR IN A SEG ERROR * CPA N5 ERROR? JMP LOVER YES, SYMBOL TABLE OVERFLOW. * CPA N8 ERROR? JMP NMERR YES, RECORD OUT OF SEQUENCE * LDB #PGS *E SZB ANY SPECIFIED SIZE GIVEN? JMP NOPG1 YES, CHECK AGAINST 32K MAX * LDA MSG.L GET THE MSEG SIZE INA ACCOUNT FOR I/O OVERFLOW CPA P1 IF JUST 1 INA THEN SET MIN MSEG SIZE ALF,ALF NOW ADJUST TO # OF PAGES RAL,RAL CMA,INA & SET NEW UPPER BOUNDS FOR CODE ADA B7777 SPACE STA LWA JMP NOPG *E * NOPG1 LDA URFWA GET LOAD PT IN # PGS ALF *E RAL,RAL CONVERT TO # PAGES ADA B ADD # OF PAGES SPECIFIED LDB MSG.L *E INB ACCOUNT FOR I/O OVERFLOW PAGE CPB P1 DEFAULTED EMA? INB YES, BUMP FOR MINIMUM SIZE ADA B (A) = # PAGES REQUIRED CMA,INA WITH EXTRA BP INA TAKE OUT EXTRA BP ADA D32 SUBTRACT FROM 32K LOGICAL SSA EXCEEDED 32K? JMP ER.18 YES. * NOPG JSB BLKID GO COUNT ID SEGS LDA BID9 SEE IF THERE ARE ANY SZA,RSS ID EXTENSIONS JMP LL20 IF NOT ABORT THYSELF JMP LDRIN GET THE NEXT RECORD * LL19 LDA ERR19 JMP ABOR ER.18 LDA ERR18 JMP ABOR LL20. JSB $LIBX RETURN FROM PRIV PROCESSING DEF *+1 ¡á������þúDEF *+1 LL20 LDA ERR20 JMP ABOR B7777 OCT 77777 * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA SEG.L GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ SEG.L NO, SO SET IT. CLA RESET THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SGM.L GET THE SEGMENT BASE ADDRESS CPB TH1.L IF SAME AS CURRENT SEGMENT THEN JMP NAMR3 LAST SEGMENT LOADED. THIS IS NEW ONE * * ISZ #SEGS INCREMENT THE # OF SEGMENTS ENCOUNTERED FLAG LDA N60 GET NEG COUNT JSB MOVE DEF L.BUF+0 SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE IS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * JSB LOCF OK SO SAVE OUR POSITION IN THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC RECORD # IN FILE USED IN JUST A SECOND DEF IRB DEF IOFF * SSA,RSS ANY ERRORS ? JMP *+3 NO * LDB F1 GET THE FILE NAME JSB FLERR AND REPORT * JMP SCANX RESCAN THE FILE * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO/YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND WHILE SCAN FOR NEXT SEG. RSRSC NOP 0/-1 NOT OK/OK TO RESCAN FILE * * * NAMR3 CCA SET FLAG TO STA RSRSC OK TO RESCAN FILE JMP NAMR1 NOW * * SKP * PROCESS NAM REC NAMRX LDA LBS.L IF SCANNING TILL NEXT SEG,THEN ADA SCSEG LOOK AT THE SEG ELS IF JU ¼������þúST SZA SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB L.BUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL SEG FOUND OPERATION ? SZA WELL ? ISZ #NAMS YES, SO COUNT THE NAMS * JSB L.REL PROCESS THE NAM RECORD DEF *+2 DEF FLAG * CPA N8 ERROR? JMP NMERR PROCESS REC OUT OF SEQ ERROR CPA N6 ERROR? JMP CMERR PROCESS COMMON BLOCK ERROR CPA N3 ERROR? JMP LGERR PROCESS MEM OVERFLOW ERROR * * LDA L.BUF+8 GET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP CKSUB NO COMMON, CHECK FOR SEGMENT LOAD LDB LBS.L IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP CKSUB ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP CKSUB ASSUME COMMON OK TILL 'END' IS READ LDA CAD.L PUT FWA OF COMMON INTO A REG LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA TH1.L GET LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP CKSUB OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS JMP CKSUB COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP ABOR * * CKSUB JSB SAVIT YES, SO LOOK FOR REWIND POINT Ó·������þú LDA NAM#1 1ST NAM IN FILE SZA YES JMP LDRIN NO, GET NEXT REC CCB RESET STB NAM#1 SO WE KNOW WE DID IT LDA PGT.L GET TYPE SZA,RSS IF ZERO ISZ #NAMS INC #NAMS CMA,INA ELSE MAKE IT NEG ADA P5 ADD 5 SSA IF WAS GREATER THAN 5 ISZ #NAMS INC #NAMS JMP LDRIN GET THE NEXT RECORD * NAM#1 NOP 0/-1 1ST NAM IN FILE/NOT 1ST NAM IN FILE P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 * * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINTz+������þú OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA DBFLG IS DEBUG ALLOWED ? SZA,RSS WELL ? JMP DEBUG,I NO, SO FORGET IT * LDA IGN.L YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDB NM2.L INB LDA B,I GET PROG NAME 1,2 CPA DB1 CHARS = D,B? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' INB LDA B,I GET PROG NAME 3,4 CPA DB2 CHARS = U,G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' INB LDA B,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA DB3 CHAR = R? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' * CLA,INA SET A REG TO ONE STA MORS SET FOR SEGMENT * * JSB L.ADD FIND DEBUG IN SYMBOL TABLE DEF *+5 MAKE IT 6 WHEN ADD MORS DEF CHRDE DEF VALU VALUE OF SYMBOL DEF SADD LST ENTRY ADDR * DEF MORS SEGMENT DEF RSLT * * LDA RSLT CPA P1 NOT FOUND? HLT 0 .DBUG NOT FOUND IN LST CPA P2 UNDEFINED? HLT 0 .DBUG UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT PT LDB VALU AND PUT IT INTO ENTRY POINT * JSB OUTAB 'DEBUG'(ON THE DISC) DEF *+3 DEF *+2 DUMMY DEFS TO FAKE OUT DEF *+1 OUTAB * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA TH1.L ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I ›������þúRETURN * MORS NOP MAIN/SEG 0/1 VALU NOP VALUE OF SYMBOL SADD NOP LST ENTRY ADDRESS DB1 ASC 1,DB DB2 ASC 1,UG DB3 OCT 51000 R DB1X ASC 1,.S ASC 1,TD OCT 41000 * * PROCESS ENT,EXT RECS * ENTR EQU * ENT REC PROCESSOR EXTR JSB L.REL PROCESS ENT AND EXT RECORDS DEF *+2 DEF FLAG * * CPA N10 ERROR? JMP LL19 YES,EMA DECLARED 2 TIMES OR IN A SEG CPA N7 ERROR? JMP DEERR YES,DUPLICATE ENTRY POINT CPA N5 ERROR? JMP LOVER YES,SYMBOL TABLE OVERFLOW CPA N9 ERROR? JMP ORD? ASM PRODUCED ILLEGAL REC CPA N8 ERROR? JMP NMERR YES, REC OUT OF SEQUENCE JMP LDRIN GET NEXT REC * * DUPLICATE ENTRY POINT * DEERR JSB CPRNM PRINT MODULE NAME LDB TSY.L GET CURRENT SYMBOL TABLE ENTRY ADB N5 BACK UP ONE ENTRY LDA B,I GET CURRENT SYMBOL RAL,CLE,ERA CLEAR SIGN BIT STA TBUF STORE 1ST 2 LETTERS INB LDA B,I STORE 3RD AND 4TH LETTERS STA TBUF+1 IN TEMP INB LDA B,I STORE 5TH LETTER STA TBUF+2 IN TEMP JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * * * N5 DEC -5 * * SKP * PROCESS DBL REC DBLR ISZ DBLFL SKIPS ONLY ON 1ST DBL REC OF A SEGMENT JMP DBL0 LDA L.BUF+3 GET THE RELOCATION BASE FOR 1ST WORD ADA TH2.L ADD THAT TO THE HIGH +1 SO FAR STA TH2.L SO THAT BSS'S IN SEGMENTS AREN'T ZEROED STA FWA SET NEW FWA FOR LOAD OPERATION * DBL0 JSB L.REL PROCESS DBL RECORD DEF *+2 DEF FLAG * * CPA N2 ERROR? JMP RCERR YES, ILLEGAL REOCRD CPA N9 ERROR? JMP ORD? ASMB PRODUCED ILLEþA������þúGAL RECORD CPA N11 ERROR? JMP LL27 YES, ATTEMPT TO REF EMA EXT WI/ OFFSET OR INDIRECT CPA N8 ERROR? JMP NMERR YES, RECORD OUT OF SEQUENCE CPA N4 ERROR? RSS YES, FIXUP TABLE OVERFLOW * JMP LDRIN GET NEXT RECORD * * FIXUP TABLE OVERFLOW JSB CPRNM PRINT MODULE NAME LDA ERR12 FIXUP TABLE OVERFLOW ERROR JMP ABOR GO ABORT * * SKP * *********** LIBRARY FILE SCAN MODULE ************ * * LOADX CLB STB PNTR INITIALIZE FOR L.LUN INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ADB N1 IF SEG SET TO 0 STB MORS * JSB L.LUN ANY UNDEFINED? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP LOADQ NO - GO LOOK FOR PRIMARY ENT JSB LIBSC YES - GO SCAN FOR LIBRARIES JMP LOADQ GO SCAN SYSTEM LIBRARY * * SKP LIBSC NOP LDA START,I ANY LIBRARIES TO SEARCH ? SZA,RSS WELL ? JMP LIBSC,I NO, SO FORGET THE WHOLE THING. * * * LIBRARY FILE(S) EXIST * * LDB TYPE1 OK, BUT IS THERE ALSO A CURRENT INPUT STB SVTP1 FILE THAT WE ARE RELOCATING ? SZB,RSS WELL ? JMP LOADK NO INPUT FILE, BUT A LIBRARY FILE EXISTS. * * *********** LIBRARY EXISTS BUT WE HAVE AN INPUT FILE OPEN ************ * * ERB,SLB FILE OR LU OPEN ? RSS FILE. JMP LOADK LU. * JSB CLOS1 CLOSE THE INPUT FILE SSA,RSS ANY ERRORS ? JMP LOADK NO LDB F1 YES JSB FLERR * * ****** SET UP FOR LIBRARY SCAN ******** * * * LOADK LDA START GET THE 1ST LIB FILE PARAMETERS STA F1 SET INTO ERROR FLAG STA INCX AND THE OPEN CALL ADA P3 SET SEC CODE & CART ALSO STA INCY INA STA INCZ * NXLIB JSB OPEN OP5Ó������þúEN THE LIB FILE DEF *+8 DEF IDCB1 DEF IERR1 INCX NOP NAME DEF IPTN1 NONEXCLUSIVE OPEN INCY NOP SECURITY CODE INCZ NOP CART REF DEF IDCBS # OF WORDS TO USE * LDB P3 SET FILE IN USE FLAG STB TYPE1 * SSA,RSS ANY ERRORS JMP STFLG NO, GO READ THE RELO CODE. LDB F1 YES, JSB FLERR GO SEND ERROR MESSAGE * RWNDL JSB POSTX FIX FOR FMGR BUG JSB APOSN REWIND THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS JMP STFLG NO * LDB F1 YES JSB FLERR * STFLG CCA SET FLAGS STA LBS.L LIB SCAN STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST STA FLIB SET THE FILE LIB SCAN FLAG CLA STA LGOU LG AREA NOT IN USE STA SLIBF NOT A SYS LIB SCAN JMP RREAD HOP TO IT ! * * LBRTN JSB CLOS1 CLOSE THE FILE SSA,RSS ANY ERRORS JMP *+3 NO. LDB F1 YES JSB FLERR SEND ERROR * CLB STB PNTR INITIALIZE FOR L.LUN INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ADB N1 IF SEG SET TO 0 STB MORS * JSB L.LUN ANY UNDEFINED? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP LOADW NO JUMP TO LOADW * LDA INCX YES -SET UP NEXT LIBRARY ADA P5 LDB A,I IS THERE A NEXT LIB ? SZB WELL ? CPB END WELL ? JMP LOADW NOPE. * STA F1 SET ERROR POINTER & STA INCX SET UP THE OPEN CALL LDA INCY ADA P5 STA INCY * LDA INCZ ADA P5 STA INCZ * JMP NXLIB GO GET 'EM ROVER ! * ANOP NOP * LOADW CLA LIB SCAN DONE w�������þú STA FLIB * LDA DEFF1 SET ORGINAL F1 BACK UP STA F1 * LDA SVTP1 GET THE OLD TYPE WORD . STA TYPE1 & RESET SZA,RSS WAS A PREVIOUS FILE OPEN ? JMP LIBSC,I NO, SO RETURN * ERA,SLA YES, FILE OR LU RSS FILE JMP LIBSC,I LU SO RETURN * JSB OPENN OPEN THE ORGINAL FILE JSB APOSN POSITION FILE TO CORRECT DEF *+6 DEF IDCB1 AREA DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA,RSS ANY ERRORS JMP LIBSC,I NO, SO RETURN * LDB F1 GET THE FILE NAME JSB FLERR REPORT THE ERROR * * * * START DEF LIBRY LIBRY BSS 5 LIBRARY FILE 1 BSS 5 LIBRARY FILE 2 BSS 5 LIBRARY FILE 3 BSS 5 LIBRARY FILE 4 BSS 5 LIBRARY FILE 5 BSS 5 LIBRARY FILE 6 BSS 5 LIBRARY FILE 7 BSS 5 LIBRARY FILE 8 BSS 5 LIBRARY FILE 9 BSS 5 LIBRARY FILE 10 END DEF * END OF LIBRARY AREA SKP * * * LOAD FROM PROG LIB * LOADQ LDA TYPE1 SEE IF THERE STILL A FILE OPEN. ERA,SLA IF THERE IS RSS (THERE IS) JMP LOADZ (THERE ISN'T) * POSTR JSB POSTX THEN THIS MUST BE A SEGMENTED PROGRAM * AND WE ARE GOING TO DO A LIB SCAN. * IF WE CALL POST THEN WE CAN USE THE * 256 WORDS AS BUFFER SPACE FOR THE SCAN. * * LOADZ LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JMP ABOR AND ABORT THYSELF LOADN CCA SET FLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LBS.L 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLA1������þúG STA LSTBK SET UP POINTERS TO DISC LIB SUCH LDB SYSLN GET THE START OF USER ENTS STB DCNT LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRANSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA SEG.L GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LOAD LDA OP? YES, GET THE LAST OPCODE CPA SE WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND CPA MS WAS IT AN MS? JMP NXTOP MUST HAVE BEEN AN MS,<> COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA #ENTS IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT * CLB IF MAIN MORS = 0 LDA SEG.L ELSE CPA P2 IF SEG INB MORS = 1 STB MORS * JSB L.ADD SEE IF IN SYMBOL TABLE DEF *+5 MAKE IT 6 WHEN ADD MORS DEF TBUF NAME DEF VALU VALUE DEF SADD * DEF MORS FOR LATER OPTIMIZATION DEF RSLT * LDA RSLT CPA P2 FOUND AND UNDEFINED? ¨=������þú JMP GTSUB YES JMP SYLOK+1 NO,CHECK NEXT SYMBOL * * GTSUB LDA TBUF+3 (GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * SZA IS IT MEM RES ? JMP GTMEM NO, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. LDA TBUF+4 CMA NO. SO IF THE ADDRESS XLB $DLP IS ABOVE START OF COMMON ADA B SSA,RSS THEN CHECK FURTHER JMP GTMEM ELSE CONTINUE XLB $COML GET LENGTH OF COMMON BLF,BLF CONVERT TO PAGES RBL,RBL ADA B ADD TO CURRENT LOCATION SSA,RSS IF POS, THEN THE ENT IS IN COMMON JMP LL24 AND ITS AN ERROR. * GTMEM JSB L.MAT FIX ALL REFERENCES DEF *+5 DEF TBUF SYMBOL NAME DEF TBUF+3 SYMBOL TYPE DEF TBUF+4 SYMBOL VALUE DEF RSLT * JMP SYLOK+1 CHECK NEXT SYMBOL * * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGN.L STA NM1.L STA NOR.L JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA RSLT NOP * LL24 JSB PRNAM PRINT EXTERNAL NAME DEF TBUF LDA ERR24 JMP ABOR * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 ô#������þúBIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETERMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB LDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORD JMP GTENT,I RETURN DONE SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP #ENTS NOP TOTAL # OF ENTS IN SYSTEM SPC 1 * * SLIBF NOP * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * CFF������þúOUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP CLB STB PNTR INITIALIZE INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ELSE IF SEG SET TO 0 ADB N1 STB MORS * JSB L.LUN ANY UNDEFINED ? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP RNDEX NO JMP CSUBR,I RETURN * PNTR NOP POINTER INTO SYMBOL TABLE.LIB WILL UPDATE * * SCAN OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? CLB STB PNTR INITIALIZE INB LDA SEG.L IF MAIN,SET MORS TO 1 CPA P2 ADB N1 ELSE IF SEG, SET MORS TO 0 STB MORS * JSB L.LUN ANY UNDEF? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * LDB SYSLN SET UP FOR LIBRARY SCAN STB DCNT START OF THE SCAN JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB CLB STB DCNT SET START OF SCAN=0 JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND- GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING CONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA SEG.L IS THE Ûy������þúPROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE * UNDF CCA GET A -1 CPA TRY2 ALREADY PROCESSING 2ND TRY JMP IUNDF SO ABORT THIS TIME CPA BATCH RUNNING UNDER BATCH? JMP IUNDF YES, NO DICE STA UNFLG NO,SET THE SPECIAL UNDEF PROCESSING FLG STA TRY2 SET FLAG, IF END ENTERED NO 2ND TRY LDA P8 LDB WNG28 SEND WARNING MESSAGE JSB SYOUT * LDA OP? SAVE THE STA SVOP LOADR OP * LDA TYPE2 GET THE COMMAND TYPE ERA,SLA FILE OR LU? JMP SVF2 FILE - SO SAVE FILE INFO LDA DFLAG LU - SEE IF INTERACTIVE SZA,RSS JMP SVF2 NO, SO SAVE LU INFO JSB SVF1 YES, SAVE THE RELOCATABLE JMP LREAD & GO PROMPT * SVF2 LDA N6 JSB MOVE SAVE DEF FILE2 COMMAND FILE OR LU DEF SFIL2 LDA DFLAG SAVE INTERACTIVE FLAG STA SF2IN * LDA TYPE2 IF AN LU ERA,SLA THEN RSS JMP SVFX SEE ABOUT SAVING RELOC FILE INFO * JSB LOCF ELSE IF FILE, SAVE POSITION DEF *+6 DEF IDCB2 DEF IERR2 DEF SF2RC DEF SF2RB DEF SF2OF * JSB CLOS2 AND CLOSE THE FILE * SVFX JSB SVF1 SAVE RELOC FILE INFO * LDA MYLU# RESET DEFAULT LU IOR M400 SET THE ECHO BIT FOR THE PROMPT STA FILE2 AS COMMAND LU CLA,INA STA TYPE2 SET THE TYPE TO LU STA DFLAG SET INTERACTIVE FLAG JMP LREAD & |º������þúGO PROMPT * SVF1 NOP LDA TYPE1 GET TYPE FLAG SZA,RSS IF ZERO JMP SVF1,I JUST RETURN-NO FILE TO SAVE * LDA N6 JSB MOVE SAVE DEF FILE1 RELOCATABLE FILE OR LU DEF SFIL1 NAMR * LDA TYPE1 FILE OR LU? ERA,SLA RSS JMP SVF1,I LU, SO DONE * LDA IREC FILE SO SAVE POSITION STA SF1RC LDA IRB STA SF1RB LDA IOFF STA SF1OF * JSB CLOS1 CLOSE THE FILE JMP SVF1,I RETURN * * IUNDF LDA ERR28 NO, SO ABORT THYSELF JMP ABOR * * WNG28 DEF *+1 ASC 4,W-UN EXT SFIL2 BSS 3 SAVED COMMAND FILE SF2TY NOP SAVED TYPE WORD, FILE OR LU SF2SC NOP SECURITY CODE SF2CR NOP CARTRIDGE REFERENCE SF2IN NOP 0/1 NON/INTERACTIVE CMMD LU UNFLG NOP -1/0 UNDEF'S/NO UNDEF'S TRY2 NOP 0/-1 2ND TRY OK/IF END THEN JUST END * SF2RC NOP SAVED CMMD FILE NEXT REC SF2RB NOP SAVED CMMD FILE BLOCK SF2OF NOP SAVED CMMD FILE OFFSET IN BLOCK * SFIL1 BSS 3 SAVED RELOC FILE SF1TY NOP SAVED RELOC TYPE, FILE OR LU SF1SC NOP SECURITY CODE SF1CR NOP CARTRIDGE REFERENCE * SF1RC NOP SAVED RELOC NEXT REC SF1RB NOP SAVED RELOC BLOCK SF1OF NOP SAVED RELOC OFFSET IN BLOCK * SVOP NOP LAST OP CODE SKP * * * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA PNTR INITIALIZE STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS JSB SYOUT PRINT: UNDEFINED EXTS * CLB,INB LDA SEG.L SET MORS TO 1 IF MAIN CPA P2 UÁ������þúADB N1 SET MORS TO 0 IF SEG STB MORS * XSCAN JSB L.LUN GET NEXT UNDEFINED EXTERNAL DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS SEE IF REACHED THE END? JMP PSUSP END OF EXTS ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB SADD GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS UN# NOP SKP * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE CPA MS WAS IT A MSEARCH (NO NAMR) JMP NXTOP YES, GET NEXT OP CODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB [á������þúP3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,INB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CLE,ERB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * LDA LISTU GET THE LU TO WRITE TO AND M77 WITHOUT ANYTHING ELSE LDB MYLU# GET MY DEFAULT LU # SZA,RSS NULL OR BIT BUCKET ? STB LISTU YES THEN SET IT UP * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JSB FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (DECIMAL) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND Bv»������þú ARE DESTROYED. * ERROR NOP MPY P3 CALC OFFSET INTO LIST OF ERR CODES ADA EMESS ADD START ADDR OF LIST STA MERR1 SAVE ADDR LDB A,I GET 1ST 2 CHARS STB MERR+1 MOVE TO MESSAGE INA GET LDB A,I NEXT 2 CHARS STB MERR+2 MOVE THESE TO MESSAGE INA LDB A,I GET FINAL 2 CHARS STB MERR+3 FINISH OFF MESSAGE LDA P8 LENGTH OF MESS IN CHARS LDB MESS5 ADDR OF MESS JSB SYOUT OUTPUT /LOADR: L-XX XXX JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 4,L-77 XXX MERR1 NOP ADDRESS OF LOADR ERROR MESSAGE EMESS DEF EMSS-3 * * EMSS ASC 3,CK SUM CHECKSUM ERROR ASC 3,IL REC ILLEGAL RECORD ASC 3,OV MEM MEMORY OVERFLOW ASC 3,OV BSE BASE PAGE OVERFLOW ASC 3,OV SYM SYMBOL TABLE OVERFLOW ASC 3,CM BLK COMMON BLOCK ERROR ASC 3,DU ENT DUPLICATE ENTRY POINT ASC 3,TR ADD NO TRANSFER ADDRESS ASC 3,RE SEQ RECORD OUT OF SEQUENCE ASC 3,IL PRM ILLEGAL PARAMETER ASC 3,CO RES ATTEMPT TO REPLACE A CORE RESIDENT PROG ASC 3,OV FIX FIXUP TABLE OVERFLOW ASC 3,LM LIB LIMIT ON # OF LIBRARIES REACHED ASC 3,IL REL ASMB PRODUCED ILLEGAL RELOCATABLE ASC 3, UNUSED ASC 3,IL PTN ILLEGAL PARTITION NUMBER ASC 3,RQ PGS # PGS REQUIRED > AMT IN PARTITION ASC 3,OV PTN REQUESTED PGS > LARGEST ADDR SPACE FOR PROG ASC 3,ML EMA MULTIPLE DECLARATION OF EMA ASC 3,ID EXT NO ID EXTENS AVAILABLE FOR EMA PROG ASC 3,SZ EMA EMA SIZE TOO LARGE FOR CORR PTTN ASC 3,IL SCB SCB CAP LEVEL IS NEGATIVE ASC 3,IN CAP USER CAP LEVEL IS LOWER THAN 60 AND TRY TO PU,PE,RP ASC 3,SS ENT SSGA ACCESS NOT DECLARED BUT TRIED TO ACCESS ASC 3,IL CMD ILLEGAL COMMAND,BATCH PU, OR PU/LI FROM TR FILE ASC 3,ID SEG NOT ENOUGH ID SEGS TO FINISH LOAD ASC 3,RF EMA ILLEGAL RE•š������þúFERENCE TO EMA ARRAY ASC 3,UN EXT UNDEFINED EXTERNALS EXIST ASC 3,EX CPY ATTEMPT TO RP OR PU PROG WHERE COPIES EXIST ASC 3,RP CPY ATTEMPT TO REPLACE A COPIED PROG ASC 3,PE LDR ONLY 'LOADR' MAY DO PERM LOADS OR PURGES ASC 3,DU PGM DUPLICATE PROGRAM NAME ASC 3,NO IDS NOT ENOUGH ID SEGS TO FINSH LOAD(NONE DONE) ASC 3,RP PGM ATTMPT TO REPLACE PROG NOT DORMANT OR IN A PTTN SKP * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SET COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN * * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYOUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OU–=������þúTPUT MESSAGE * LDA TYPE3 WAS WRITE ERA,SLA TO A FILE? JMP LOGIT YES, SO WASN'T LOG LU LDA LISTU IS LIST DEVICE AND M77 CPA MYLU# LOG DEVICE? JMP SYOUT,I YES,DONE * LOGIT LDA BLNK2 GET A BLANK STA MADDR,I PUT IN BUFFER,(MADDR SET UP IN DRKEY) LDA MADDR GET BUFFER LOCATION STA BLOC STORE IT FOR THE WRITE * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE CODE DEF MYLU# LOG LU BLOC DEF 0 BUFFER LOCATION DEF COUNT CURRENT COUNT * LDA LTEMP RESTORE STA MADDR,I ALTERED WORD * JMP SYOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: ASC 15 DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N20 DEC -20 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOþ������þúR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (18 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM4 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * EMAID * SHIGH * SESW1 * SESW2 * SESW3 * IDEX1 * IDEX2 * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT FLAG LDA N20 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA FXN.L THE FIXUP TABLE STA SET2 SET NEW END LDB FXN.L CURRENT ADDRESS TO B STA FXN.L SET NEW END OF FIXUP TBL. SETI0 CPB FXS.L END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA FXN.L CMA,INA TEST FOR SYMBOL ADA LSY.L OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA FXS.L SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA FXS.L FOR NEW ADDR. LDB FXS.L SET CLA DUMMY SETI STA B,I ID \Ø������þú INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA FXS.L LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG INA STA EMAID SET EMA WORD INA STA SHIGH HIGH MAIN + LARGEST SEG + 1 INA STA SESW1 SESSION MONITOR WORD # 1 INA STA SESW2 SESSION MONITOR WORD # 2 INA STA SESW3 SESSION MONITOR WORD # 3 INA STA IDEX1 ID EXTENSION WORD # 1 INA STA IDEX2 ID EXTENSION WORD # 2 * * LDA P99 INITIALIZE STA PRIOR,I PRIORITY = 99 * * CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P99 DEC 99 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 ±ê������þú SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG EMAID NOP ADDRESS OF EMA WORD SHIGH NOP ADDRESS OF HIGH MAIN + SEG + 1 SESW1 NOP SESSION WORDS 1 - 3 SESW2 NOP SESW3 NOP IDEX1 NOP ID EXTENSION WORD 1 IDEX2 NOP ID EXTENSION WORD 2 SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA,RSS IF ENOUGH JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE * NOIDS LDA P20 LDB SETM JSB SYOUT LDA ERR33 JMP ABOR NOW ABORT THE POOR GUY * * * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * * * * LL27 LDA ERR27 JMP ABOR ABORT LOAD * SKP * * THE OUTAB ROUTINE IS CALLED TO OUTPUT A WORD TO THE DISC * * CALLING SEQUENCE: * A = VALUE OF WORD * B = ADDRESS OF WORD * JSB OUTAB * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF ADDR ADDRESS OF WORD * DEF VALUE VALUE OF WORD * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE * LDA OUTAB FAKE OUT RETURN ADA P3 LOADR LIB THINKS STA OUTAB WE HAVE 3 DEFS STB A SAVE IT ADB å³������þúFWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TH2.L BEYOND LAST WORD PUT OUT? INA SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TH2.L NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED * * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN OF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SGM.L SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 AB7´������þúSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * * * * SET2 NOP SKP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB $CVT3 DO THE CONVERSION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * SPC 1 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA WDCNT SAVE WORD COUNT LDA MOVE,I GET SOURCE STA ATEMP SET IN A TEMP ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB ATEMP,I GET A WORD STB A,I PUT IT AWAY ISZ ATEMP STEP SOURCE INA AND DEST. ADDRES ISZ WDCNT DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, T= ������þúHE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDB NM2.L GET ADDRESS INB INC TO NAME LDA B,I NAME 1,2 INTO REG A STA MBUF SET IN BUFFER INB INC TO NAME 3,4 LDA B,I NAME 3,4 INTO REG A STA MBUF+1 SET INTO BUFFER INB INC TO NAME 5 LDA B,I NAME 5 INTO REG A STA MBUF+2 SET INTO BUFFER LDA TH1.L GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA LDB PGL.L PROG LENGTH SZB IF ZERO SSB OR NEGATIVE JMP ADTH2 ADDING LWA IS CORRECT (NO LINKS) ADA TH1.L ELSE ADD CURR PROG RELOC ADDR ADA B AND LENGTH RSS ADTH2 ADA TH2.L GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDB NM3.L GET EXTENDED NAM COMMENT LDA B,I GET LENGTH OF COMMENT SZA,RSS IF ZERO - SKIP MOVE JMP PMAP1 CMA,INA SET TO MOVE COMMENT INB STB SORC SET SOURCE OF MOVE JSB MOVE SORC NOP FROM EXTENDED NAM COMMENT DEF MBUF+10 TO MBUF PMAP1 LDA P10 GET # OF WORDS IN MAP MESS ADA NM3.L,I ADD # WORDS IN COMMENT FIELD ALS CONVERT TO WORDS LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN ***************************DEBUGGING STUFF****************** * LDA EUSED * LDB ECP1 * JSB CONVD * LDA P24 * LDB ECPM * JSB DRKEY * LDA CPL2 * LDB EC;­������þúP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY * * * LDA STLK GET START LINK * CMA,INA MAKE NEG * LDB DUEN GET LAST SET ASIDE * ADB A ADD TO GET * STB ALCP # SET ASIDE * LDB REEN GET LAST ALLOCATED * ADB A AGAIN SUB START TO GET * STB USED # REALLY USED * CMB,INB SUBTRACT FROM * ADB ALCP THOSE SET ASIDE * STB A TO GET # WASTED * LDB CPMA1 * JSB CONVD # WASTED * LDA USED * LDB CPMA8 * JSB CONVD # USED * LDA ALCP * LDB CPM14 * JSB CONVD # ALLOCATED * LDA PLCT * LDB CPM23 * JSB CONVD # ATTEMPTED * LDA P62 * LDB CPMA * JSB DRKEY * CLA * STA PLIST ********************END DEBUGGING STUFF*********** * LDA PLIST GET THE LIST OPTION SZA IF HE WANTS ENTS WE GIVE HIM LINKS TOO. JMP PRMA1 NO ENTS OF BP LINKS ASKED FOR * LDA CBP.L CURRENT REAL BP ADDRESS LDB BPMSG SO CONVERT TO ASCII JSB CONVD * LDA P18 GET THE MSG LENGTH LDB BPADR AND THE ADDRESS JSB DRKEY AND REPORT TO THE USER JSB SPACE SPACE A LINE * **********************DEBUGGING STUFF******************* * LDA P2 * STA PLIST ************************END DEBUGGING STUFF*************** PRMA1 LDA TH2.L GET NEXT AVAIL ADDR STA TH1.L SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * ******************DEBUGGING STUFF************* *ECPM DEF *+1 * ASC 12, LAST DUMMY USED *ECP1 DEF ECPM+1 *CPMA DEF *+1 * ASC 22, WASTED USED ALLOCATED * ASC 9, ATTEMPTED *CPMA1 DEF CPMA+1 *CPMA8 DEF CPMA+8 *CPM14 DEF CPMA+14 *CPM23 DEF CPMA+23 *P62 DEC 62 *ALCP NOP *USED NOP ****************************END DEBUGGING STUFF****** BPADR DEF *+1 ASC 18, BP LINKAGE XXXXX BPMSG DEF BPADR+7 * MD������þú MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TSY.L MACH? CPB LSY.L END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MATCH JMP MATCH,I RETURN (P+2) * * SKP * * SCAN DUMMY LINKAGE AREA FOR OPERAND * * SCAN LOOKS THROUGH THE DUMMY BASE PAGE TO FIND IF A * BP LINK HAS ALREADY BEEN ALLOCATED FOR THIS WORD. * CALLING SEQUENCE: * B = VALUE TO SCAN FOR * JSB SCAN * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF VALUE VALUE TO SCAN FOR * DEF BPADR 1Ç������þú +N/-1 ADDRESS TO USE/NOT FOUND * ON RETURN : * * - MATCH FOUND ADDRESS TO USE RETURNED * * - NO MATCH - ADDRESS RETURNED AS -1 * SCAN NOP LDA SCAN,I STA RTRN SAVE RETURN ADDRESS ISZ SCAN LDA SCAN,I STA OPRND SAVE DEF TO VALUE ISZ SCAN LDA SCAN,I STA ADS SAVE DEF TO BP ADDR * LDA BPFWA FIRST LINK ALREADY CMA,INA MAKE NEGATIVE TO FIX UP ADA CBP.L ADD CURRENT LINK ADA FWABP ADD FIRST LINK ADDRESS STA CADR ADDR OF CURRENT LINK LDA FWABP GET THE LOWER BOUND SRC CPA CADR END OF ALREADY ALLOCATED LINKS ? JMP NOTFD DO NOT FOUND RETURN CPB A,I IS THIS THE GUY ? JMP FOUND YES ! INA NO, BUMP POINTER & TRY AGAIN JMP SRC * NOTFD CCB SET BPADDR TO -1 STB ADS,I MAKE NOT FOUND RETURN JMP RTRN,I * FOUND LDB FWABP NOW CALCULATE THE ABSOLUTE ADDRESS CMB,INB ADA B ADA BPFWA STA ADS,I SET BPADDR TO THIS ADDRESS JMP RTRN,I MAKE THE FOUND RETURN * OPRND NOP ADDRESS OF WORD WE'RE LOOKIN FOR. ADS NOP ADDRESS TO USE OR NEG ONE FOR NOT FOUND FWABP NOP ADDR OF 1ST WORD OF DUMMY LINK AREA RTRN NOP RETURN ADDRESS CADR NOP ADDRESS OF END OF ALLOCATED LINKS * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF DUMMY RETURNED DUMMY BP ADDRESS * DEF REAL RETURNED REAL BP ADDRESS * * RETURN: * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA ALLOC,I SAVE OFF RETURN ADDRESS STA RT``������þúRN ISZ ALLOC DLD ALLOC,I DST DBPA SAVE DEF TO DUMMY BP AND REAL BP * CCA SUBTRACT ONE TO GET ADA CBP.L LAST BP LINK USED CPA BKGBL WAS IT THE LAST ONE AVAILABLE? JMP ALLO1 YES - BP OVERFLOW * INA GET NEXT AVAILABLE BP LINK STA RBPA,I SAVE REAL BP ADDRESS ISZ CBP.L INCREMENT NEXT AVAILABLE LDB BPFWA GET FWA OF ACTUAL AREA CMB,INB MAKE NEGATIVE TO FIX UP ADB A ADD CURRENT TO GET OFFSET FROM BEGINNING ADB FWABP ADD ADDR OF 1ST DUMMY BP LINK CLA STA B,I ZERO THE LINK WORD STB DBPA,I SAVE DUMMY BP ADDRESS JMP RTRN,I RETURN * ALLO1 JSB CPRNM PRINT MODULE NAME (IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR * DBPA NOP DUMMY BASE PAGE ADDR DEF RBPA NOP REAL BASE PAGE ADDR DEF * * M1777 OCT 1777 * * * SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM XSA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN * EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 * SKP * * NORMAL LOAD TERMINATION * NODEX LDA #PTTN IF NO PTTN SPECIFIED SZA THEN JMP NODEY CHECK INPUT #PAGES * XLB $MBGP GET THE MAX BG PROG LDA PTYPE & PROG TYPE CPA P2 IS PROG BG? RSS JMP *+ç©������þú3 XLB $MRTP NO, GET MAX RT SIZE * LDA EMA.L *E SZA IF EMA, RSS JMP *+3 XLB $MCHN USE MAX MOTHER PTTN SIZE * LDA #PGS GET THE # OF PAGES REQUESTED CMA,INA & CHECK AGAINST MAX SIZE ADA B *E INA ACCOUNT FOR BP SSA DID HE ASK FOR TOO MUCH? JMP ER.18 YES, SO FLUSH HIM * NODEY LDA EMA.L ANY EMA DECLARATION ? SZA,RSS WELL ? JMP NOEMA NO. * LDA SEG.L YES,GET SEGMENTED PROG FLAG SZA,RSS IF NOT SEGMENTED-END OF NORMAL LOAD JMP SETEM THEN SET DUMMY BP LDA MSEGF ELSE GET FINAL LOAD FLAG CPA P3 IS IT? RSS YES, SET DUMMY BP JMP NOEMA NO, DON'T SET IT * SETEM LDA SHIGH,I GET HIGHEST LOAD POINT SZA,RSS THIS IT ? LDA TH2.L NO. NOW WE HAVE IT ADA M1777 ALLIGN TO NEXT PAGE AND M0760 STA EMA.L,I AND STUFF INTO DUMMY BP * LDA #PGS GET SPECIFIED INPUT PAGES SZA,RSS ANY SPECIFIED? JMP NOEMA NO, FORGET IT * ADA N1 DON'T COUNT BP TWICE! ALF,ALF CONVERT #PAGES TO WORDS RAL,RAL *E ADA URFWA ADD TO LOAD PT STA EMA.L,I PUT START ADDR SEG.L INTO DUMMY BP * NOEMA LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE CLA STA PNTR START AT ZERO ELIST JSB L.LDF LIST DEFINED ENTS AND EXTS DEF *+4 DEF SADD DEF PNTR DEF N1 CK ALREADY LISTED BIT * SZB,RSS END OF LST? JMP NOLST 9������þú YES-BYE-BYE * LDA B,I GET NAME 1,2 * STA EMES+2 SET NAME 1,2 INTO BUFFER INB LDA B,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER INB LDA B,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER * INB LDA B,I GET THE TYPE OF CONTENTS OF LST5 INB AND B200 SZA,RSS IS V BIT SET JMP GOTAD NO, LST5 IS VALUE LDA BPFWA GET THE ADDR OF FIRST REAL AVAIL LINK CMA,INA ADA B,I ADD LINK ALLOCATED TO GET OFFSET INTO ADA FWABP DUMMY LINK TABLE LDA A,I NOW GET THE ADDRESS RSS GOTAD LDA B,I GET THE DEFINING ADDRESS LDB EMES GET ADDR OF 'NNNNN ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TH2.L SET STA MEM2,I ADDR LDA CBP.L CURRENT BP ADDRESS STA MEM4,I SET IN ID SEGMENT LDA SGB.L IF SEGMENT BEING LOADED, SZA,RSS LDA BPFWA IF SGB.L NOT SET YET STA MEM3,I SET AS LOW BOUND OF BP. LDA SGB.L GET CURRENT LOWER BOUND OF BP, SZA,RSS LDA BPFWA IF SGB.L NOT SET YET CMA,INA ADA CBP.L ADD CURRENT BP LINK ADDR LDB SEG.L (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA TH2.L = TO DISPLACEMENT ADA M177Ë������þú TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDB SGB.L SET FWA OF CURRENT BASE PAGE SZB,RSS LDB BPFWA IF SGB.L NOT SET YET LDA BPFWA CMA,INA ADA B ADA FWABP END OF CALCULATION OF CURRENT BP LDB SEG.L M/SEG FLAG STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA TH1.L STA MTMP+2 TH1.L LDA DBLAD STA MTMP+3 DBLAD LDA ABT13 STA MTMP+4 FWABP LDA BPFWA CMA,INA ADA CBP.L ADA FWABP STA MTMP+5 CBP.L. * NOLS1 LDA BPFWA CALCULATE LAST USED BP ADDR CMA,INA ADA CBP.L ADA FWABP STA CBPT NOLS0 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CBPT BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS0 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA SEG.L SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREAK LAST CHANCE TO BREAK THE PROGRAM * LDä«������þúA SEG.L CHECK FOR SPECIAL SZA,RSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 CPA P1 IF MAIN LOADED, JSB MEND SET SEGMENT AREA OF LST. * JSB L.SGN RESET SEGMENT CONDITIONS DEF *+2 DEF LEVEL * LDB SSG.L ERASE PREVIOUS STB TSY.L * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, JMP MSGP3 SKIP. JMP MSGP4 CONTINUE. * MEND NOP JSB L.SG0 DEF *+2 DEF LEVEL RIGHT NOW SEND A 0:LATER MLS JMP MEND,I * MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 DRSET ASC 1,BS LEVEL NOP CBPT NOP * * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * LDA DRSET RESET .DBUG TO .DBSG TO GET SEGMENTS STA CHRBU SUBROUTINE THAT ACCESSES DBUG. * JSB L.SYE PUT .DBSG INTO LST DEF *+6 DEF CHRDE DEF P2 UNDEFINED DEF N1 NO VALUE DEF P1 DO NOT OVERRIDE DEF RSLT * LDA N3 GET # OF WORDS TO MOVE JSB MOVE MOVE EM DEF DB1X SOURCE DEF DB1 DESTINATION (SAVES 6 BP LINKS) * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA SEG.L CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ SEG.L SET 'SEG.L' = 2. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SGM.L RESET LOWER STA TH1.L BOUNDS VALUES FOR STA FWA TH1.L , FWA CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA NM1.L NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LBS.L * * LDA FXS.L (A) = ID SEGMENT ADDR(ä+������þúDUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TO STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF L.BUF+0 DESTINATION * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * * MESS4 DEF *+1 PRAM ASC 6, READY PRAMX ASC 17, AT SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 CLA STA PNTR START AT ZERO INA STA MORS START FOR MAIN * JSB L.LUN FIND UNDEFS DEF *+4 DEF SADD DEF PNTR DEF MORS SZB,RSS END OF SYMBOL TABLE? JMP MSGP9 NO LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT ISZ SEG.L JSB PUDF GO REP¸â������þúORT THE UNDEFINEDS CCA ADA SEG.L STA SEG.L LDA FORCD GET THE FORCE LOAD FLAG SSA,RSS DO WE IGN.L UNDEFS ? JMP IUNDF NO SO ABORT THYSELF. MSGP9 LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESET "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA TH1.L TH1.L LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA FWABP CMA,INA ADA MTMP+5 ADA BPFWA STA CBP.L CBP.L CLA SET STARTING TRACK STA STRAK AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA MTMP+5 BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDB EMA.L GET THE EMA FLAG SZB,RSS ANY EMA DECLARED ? JMP NTRM. NO. * LDA MSG.L GET THE SUPPLIED MSEG SIZE SZA WAS ANY SUPPLIED JMP SETMS YES * LDA B,I GET THE EMA DEFINING ADDRESS ALF & CONVERT TO PAGE # RAL,RAL CMA ACCOUNT FOR I/O OVERFLOW ADA P32 NOW HAVE MAX POSSIBLE MSEG * STA MSG.L NO, USE MAX POSSIBLE SETMS ADA MSIGN NOW SET NON STANDARD MSEG BIT STA IDEX1,I AND PUT IN DUMMY ID SEGMENT * LDA EMS.L GET THE EMA SIZE LDB EMA.L,I & START PAGE OF MÇ&������þúSEG RBL PLACE INTO PROPER FIELD SZA,RSS WAS EMA SIZE DEFAULTED ? ADB M2000 YES, SO SET DEFAULT BIT STB IDEX2,I & PLACE IN DUMMY ID * LDA URFWA NOW CHECK OUT EMA SIZE ALF FIRST GET PROG SIZE RAL,RAL AND M37 CMA,INA LDB EMA.L,I GET NEXT PAGE ADDRESS BLF RBL,RBL ADB A NOW HAVE PROG SIZE ADB EMS.L NOW HAVE REQ'D SIZE CMB,INB STB MESSM SAVE IT * LDA #PTTN WAS A PARTITION SPECIFIED ? SZA,RSS WELL ? JMP GTMCN NO * CCA YES ADA #PTTN MPY P7 INDEX TO PROPER ENTRY ADA P4 XLB $MATA OF $MATA TABLE ADA B XLA A,I GET THE AND B1777 # OF PAGES * JMP GTMC1 * GTMCN XLA $MCHN GET MAX SIZE SZA IS IT 0. JMP GTMC1 NO XLA $MBGP ASSUME BG LDB PTYPE CPB P2 IS IT ? RSS NO JMP *+3 XLA $MRTP NO * GTMC1 ADA MESSM NOW ADD IN SIZE SSA OK ? JMP LL21 NO. * NTRM. LDA SHIGH,I CALCULATE # OF PAGES VALUE FOR ID SZA,RSS PROG SEGMENTED ? LDA TH2.L NO * LDB URFWA GET LOAD POINT CMB MAKE NEG (ACCOUNT FOR HIGH MAIN '+' 1 ADA B A = # OF WORDS OF CODE ALF NOW ACCOUNT FOR PAGES RAL,RAL AND M37 ADA P2 ACCOUNT FOR BASE PAGE & CURRENT PAGE STA MES11+1 SAVE FOR # OF PAGES RELOCATED MESSAGE LDB #PGS GET ANY SUPPLIED SIZE SZB,RSS ANY SUPPLIED ? STA #PGS NO, SO USE CODE SIZE * CCB OK, SO BUILD ID SEG WORD 22 ADB #PTTN PUT PART'N WORD IN BITS 0-5 CCE,SSB SET BIT 15 IF PARTITION REQUESTED CLB,RSS IF NO PARTITION THE SET TO 0 RBL,ERB * ç2������þú CCA GET # PGS REQ'D LESS BP ADA #PGS ADA MSG.L ADD IN MSEG SIZE ALF,RAR # PGS IN BITS 14 - 10 IOR #MPFT MEM PROT FENCE INTO BITS 9-7 ALF,ALF RAR IOR B SAVE THE WORD STA PG.PT FOR THE MVIDS ROUTINE * * LDA FWABP SET UP ADDR ADA N20 OF DUMMY STA FXS.L ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * * CONTROL TRANSFERS HERE FOR TEMPORARY LOADS & FOR PERM LOADS * WHERE NO PREVIOUS DISC SPACE IS AVAILABLE FOR THE PROG. * NTRM7 LDA FXS.L ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE IN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB FXS.L NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA 7R������þú TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER INA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSED (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB FXS.L GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? °������þú JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB FXS.L SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIš6������þúFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LDA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE CURRENT DISC LU CPB P3 IS IT LU 3 ? RAL,ERA THEN DON'T FORGET THE SIGN BIT. LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID¿à������þú * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB FXS.L GET CURRENT ID SEG ADDR ADB P8 (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 É������þú INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LDB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA SEG.L DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * SPC 1 NTRM4 LDA MES11+1 GET THE # OF PAGES RELOCATED JSB CNV99 CONVERT TO ASCII STA MES11+1 AND PUT INTO USER INFO BUFFER * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE * LDB P3 STB OPCOD SPECIFY DECIMAL CONVERSION * * LDA EMA.L SZA,RSS ANY EMA ? JMP LOUT NO . LDA MSG.L YES JSB CNV99 GET ASCII MSEG SIZE STA AMSEG+2 LDA EMS.L GET EMA SIZE SZA,RSS DEFAULTED ? JMP EDFLT YES LDB AEMAD GET ADDRESS OF ASCII JSB CONVD CONFERT IT JMP LOUT * EDFLT LDA N4 JSB MOVE DEF IDFLT DEF AEMA+2 * LOUT LDA #PGS GET # OF PAGES OF CODE LDB EMA.L AND EMA DECLARATION SZB,RSS ANY EMA ? JMP *+4 NO ADA EMS.L YES, SO ADD EMA SIZE CPA #PGS IF DEFAULTED INA ADD 1 LDB PGRQD GET ADDRESS JSB CONVD AND CONVERT TO ASCII * * LDA P72 GET CHAR COUNT LDB MES11 & ADDRESS JSB DRKEY NOW GO TELL THGE FOLKES * * LDA P56 GET LENGTH LDB MES12 AND MESS JSB DRKEY TO OUTPUT OPTIONS SET * * * PTNCK LDB PTYPE CHECK #PAGES REQ'D DOESN'T LDA #MXBG CPB P2 Ó¸������þúRT OR BG PROG LDA #MXRT * INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P8 (A)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 4,W-RQ PGS CODE > PTTN SIZE * MES11 DEF *+1 ASC 18,00 PAGES RELOCATED 0000 PAGES REQ'D AEMA ASC 9, NO PAGES EMA AMSEG ASC 9, NO PAGES MSEG MS11# EQU MES11+1 P72 DEC 72 PG.PT NOP WORD 22 OF ID SEG OF MAIN AEMAD DEF AEMA PGRQD DEF MES11+10 IDFLT ASC 4,DEFAULT MES12 DEF *+1 ASC 17,LINKS:BP PROGRAM:BG LOAD:TE ASC 11, COMMON:NC P56 DEC 56 * SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB WORD WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB WORD IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * JSB FTIME TELL THE FOKES THE TIME DEF *+2 DEF PRAMX+2 * LDA P46 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * ************************DEBUGGING STUFF************** * LDA DCPA * LDB ECP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY * LDA NGEND * CMA,INA * LDB ECP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY *********************END DEBUGGING STUFF****************** * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG±Ã������þú * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE DLEN LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY * * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * LDB BLNK2 GET A BLANK BLANK LDA PRAM+4 IS IT AN ERROR? SZA YES, OK STB PRAM+4 NO, BLANK OUT THE RE SZA STB PRAM+3 JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 RELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 P46 DEC 46 TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)Û[������þú=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP XLA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE STA ABT1 KEYWORD LIST ADDR. * MIDN1 XLB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE XLA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. XLA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 XLA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ ABT1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) XLB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ERR11 SEND L11 MESSAGE ŽL������þú JMP ABOR AND ABORT SPC 2 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP * THE COPY. SUBROUTINE CHECKS TO MAKE SURE THAT ALL PROGRAM * PURGES OR REPLACES DON'T RUN AFOUL OF COPIED PROGRAMS. THE * PROBLEM TO AVOID IS RELEASING THE DISC TRACKS THAT THE PROGRAM * YOU ARE PURGING OR REPLACING RESIDES ON IF OTHER COPIES OF * THAT PROGRAM'S ID SEGMENT ARE STILL LAYING AROUND. * IF THE PROGRAM TO BE PURGED IS A COPY THAT'S OK. IF THE PROGRAM * YOU ARE REPLACING IS A COPY, THAT'S NOT OK. * * * CALLING SEQUENCE JSB COPY. * B - REG = ID ADDRESS OF PROG TO PURGE * * * COPY. NOP STB IDADR SAVE THE ID ADDRESS OF PROG TO BE PURGED ADB P14 GET TO TYPE BIT XLA B,I AND P7 THIS A CPA P5 SEGMENT ? JMP COPY.,I THEN NOT TO WORRY. * ADB P17 NOW GET 2ND SESSION WORD XLA B,I AND M1000 IS THIS PROGRAM SZA A COPY ? JMP CHKED YES, SEE IF THIS IS A REPLACE * XLA B,I GET THE WORD AGAIN. THIS PROG NOT A COPY AND M2000 BUT ARE COPIES POSSIBLE ? SZA JMP COPY.,I NO, SO ALLS WELL * ADB N5 OK, THIS PROG NOT A COPY, BUT COPIES POSSIBLE. XLA B,I GET THE DISC ADDRESS OF THE PROG STA DSKAD AND SAVE. * LDA KEYWD GET THE KEYWORD ADDRESS STA KEY AND SET UP FOR SEARCH * DSRCH XLB KEY,I GET THE PROG ID ADDRESS CPB IDADR ������þú THIS THE PROG WE'RE WORKING ON ? JMP NXTID THEN GET NEXT ID * SZB,RSS ANY MORE ID'S ? JMP ITOK? NO SO SEE IF ALLS WELL * ADB P12 GET THE NAME WORD XLA B,I SZA,RSS IF THE ID IS EMPTY FORGET CHECK JMP NXTID AND LOOK AT THE NEXT ONE * ADB P2 NOW LOOK AT THE TYPE XLA B,I AND M20 CPA M20 THIS A SEGMENT ? JMP ITOK? YES, WERE DONE, SEE IF EVERYTHING OK * ADB P12 OK, SO INDEX TO THE DISC ADDRESS OF XLA B,I IF IT IS THE SAME AS THE ONE WE ARE CPA DSKAD GOING TO REPLACE THEN THAT'S A NO NO. JSB PRTER PRINT THE OFFENDING PROGRAM NAME & CONTINUE * NXTID ISZ KEY BUMP ID POINTER & JMP DSRCH LOOK AT THE NEXT ID SEG. * ITOK? LDA ERFLG ANY ERRORS ? SZA,RSS WELL ? JMP COPY.,I NO, SO CONTINUE WITH THE LOAD. * LDA ERR29 GET THE ERROR CODE & JMP ABOR ABORT THYSELF * CHKED LDA EDFLG GET THE EDITING FLAG SZA,RSS WE DOING A REPLACE OPERATION ? JMP COPY.,I NO, JUST PURGING A PROG. * LDA ERR30 YOU CAN'T REPLACE A COPIED PROG ! JMP ABOR * * KEY NOP M1000 OCT 1000 ERFLG NOP COPIED PROGRAM ERROR FLAG N14 DEC -14 DSKAD NOP IDADR NOP DBUF1 DEF *+1 NBUF BSS 3 * * * THE PRTER ROUTINE JUST PRINTS THE ERRORS THAT COPY. FINDS. * IT WILL TELL THE USER OF ALL PROGS THAT ARE COPYS OF THE * ORGINAL THAT HE IS TRYING TO REPLACE. * * * CALLING SEQUENCE JSB PRTER * B-REG = ADDRESS OF ID WORD 26 * * PRTER NOP ADB N14 BACK UP TO THE PROGRAM' NAME WORD. XLA B,I AND PULL NAME IN LOCALLY STA NBUF * INB XLA B,I STA NBUF+1 * INB XLA B,I STA NBUF+2 * * LDA P5 GET THE CHAR COUNT LDB DBUF1 & ADDRESS JSB SYOUT &Aϯ������þúND PRINT THE PROGRAM NAME ISZ ERFLG BUMP THE ERROR FLAG JMP PRTER,I RETURN SKP UREAD NOP DISC READ SUBROUTINE JSB EXEC READS 64 WORDS DEF *+7 DEF P1 DEF P2 ALBUF DEF L.BUF+0 DEF P64 DEF TRACK DEF SECTR JMP UREAD,I * TRACK NOP SECTR NOP * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! DIV D6144 DIVIDE BY TRK SIZE-CAUTION MAY BE RESET STA TRACK TO RELATIVE TRACK XLA $STRK ADD THE ABSOLUTE START TRACK ADA TRACK STA TRACK WE NOW HAVE THE TRACK LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) * XLB $SSCT GET THE START SECTR OF OP SYS ADA B ADD IN RELATIVE SECTR TO GET ABS SECTR OF PATCH STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 *THIS IS A GENERAL PURPOSE DISC PATCH SUBROUTINE * CALLING SEQUENCE JSB SYRUW * A REG = MEMORY ADDRESS (LOCATION) * B REG = REPLACEMENT VALUE * THE MEMORY LOCATION WILL BE CHANGED TO A DISC ADDRESS * AND THE CONTENTS OF THE B REG WILL BE PLACED THERE * THIS ROUTINE SHOULD ONLY BE USED TO MODIFY OP SYSTEM * LOCATIONS !!!!!! * SYRUW NOP UPDATE $BGFR & $RTFR ON DISC SWP FIX FROM DFINE TO WORK IN LOADR (CMM) STB UPDT1 †������þúJSB TRK GET THERE TRACK ADDRESS JSB UREAD READ THEIR SECTOR LDA WORD GET THE ADDRESS ADA ALBUF WITHIN THE SECTOR LDB UPDT1 GET CONTENTS OF THE NEW $RTFR WORD STB A,I STICK IT INTO THE BUFFER * ISZ P1 NOW MAKE IT A WRITE JSB UREAD PATCH ON DISC CLA,INA FIX P1 STA P1 JMP SYRUW,I UPDT1 NOP * SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT RELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,ü������þúRBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) STA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK # LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TH2.L FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TH2.L HIGH LOAD +1 !!!!!!!!!!!!! * STB TH2.L SET NEW ADDR. LDA SEG.L GET THE SEG.L FLAG CPA P2 THIS A SEGMENT ? RSS YES. JMP ABOUT,I NO, JUST RETURN ¦e������þú LDA SHIGH,I GET THE PAST HIGH CMA,INA ADA B IS THIS HIGH BIGGER ? SSA,RSS WELL ? STB SHIGH,I YES, SO SET UP NEW HIGH MAIN +SEG + 1 JMP ABOUT,I * TEMPQ NOP * * * OVERFLOW OF TRACK ALLOCATION * AB3 LDB TRAKB GET THE BASE TRACK ADB #TRAK ADD IN THE # OF TRACKS SO FAR LDA TRKLU GET THE LU OF THE TRACK CPA P3 = LU # 3 ? ADB TATSD YES SO ADD IN # OF TRKS ON SYS DISK ADB TAT NOW ADD ADDRESS OF START OF TAT XLA B,I THIS TRACK FREE ? SZA WELL ? JMP AB10 NO * ISZ #TRAK YES SO BUMP TRACK # LDA XEQT GET MY ID ADDRESS JSB SYSET POST TO TAT JMP AB0 AND CONTINUE LOADING * AB10 LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK CLB SET UP TO MPY LDA #TRAK MPY NO. OF TRACKS MPY ABT4 TIMES SECTS PER TRACK SZB ONE WORD HLT 3 SSA 15 BITS HLT 4 CMA,INA NEG TOTAL # SECTS REQUIRED STA #SECT SAVE OFF JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT DEF P128 DEF AB¥������þúT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA RESET TO ZERO STA ABT10 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 THEN CONTINUE TO LOAD. * Ð$������þú CLA IF NOT DOING MAIN/SEGMENT CPA SEG.L LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY ID SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY ONCE. LDA FXS.L (A)= STARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * ù‡������þú BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY * THE CONTENTS OF "FXS.L" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AREA. * * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (FXS.L) = ADDR. OF DUMMY * ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA KLUGE GET THE KLUGE FLAG SZA,RSS ARE WE DOING THE STUPID SYS MOVE JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * THIS KLUGE WAS NOT MY DOING (C.M.M.) * LDB FXS.L ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINAT¶������þúION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED * (B) = FIRST WORD DESTINATION ADDR * STRFR NOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND COUNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * * DMYMV LDB FXS.L SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N20 THEN SET MOVE COUNT=-20. STB NUMWD JSB BLKID GET CURRENT ID EXT LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN USE BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFE½×������þúR. MBACK JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB NAMOK SEE IF PROG NAME STILL OK. LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG ID. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCATION. LDB BID8 GET # OF SMALL IDS W/O DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB FXS.L ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA €������þúN5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO PRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR TRANSFER ADDR PNTRS JMP MOVID DO MOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P31 INDEX TO 2ND SESSION WORD XLA B,I & PULL IT IN. AND B170K KEEP ONLY UPPER 4 BITS IOR COPY? SET UP THE COPY BIT IOR OWNER AND THE OWNER WORD STA SESW2,I & SET INTO THE 2ND SESSION WORD. * LDB ABT11 GET DESTINATION ID ADDR AGAIN ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS INB (B) = ADDR OF EMAID LDA N5 A = -5 FOR EMAID TO SESW3 JSB STRFR TRANSFER ADDRESS POINTERS * * * * LDA EMA.L GET THE EMA FLAG SZA ANY DECLARED ? JMP DOEMA YES LDA N18 NO. CHANGE THE MOVE COUNT STA NUMWD TO 18. (IE DON'T USE ID EXTENSION) JMP MOVID GO MOVE THE DUMMY ID SEGMENT * DOEMA LDB BID9 GET THE ADDRESS OF THE ID EXT TO USE SZB,RSS IS THERE ONE ? JMP LL20. NO, EN ERROR ¨F������þú LDA N2 SET FOR TRANSFER (ADDRESS IF ID EXTENSION) JSB STRFR SET UP THE POINTERS * LDA BID10 GET THE ID EXT # ALF,ALF ROTATE TO UPPER END RAL,RAL LDB EMS.L GET THE EMA SIZE SZB,RSS WAS IT DEFAULTED INA SET A FLAG ADA B NO, SO USE SPECIFIED SIZE STA EMAID,I AND PUT IN DUMMY ID SEGMENT * * SKP * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * * KLUGE INDICATES THAT THE SOURCE IS ALSO IN * THE SYSTEM AREA (AS OPPOSED TO THE DUMMY AREA) * AND THEREFORE ONE MUST USE CROSS MAP LOADS TO GET IT * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR AND SOURCE TOO. STB SRAD2 LDB NUMWD STB NUMW2 ALSO # OF WORDS TO MOVE KEPON LDB KLUGE ARE WE DOING KLUDGY SZB SYS ID TO SYS ID? JMP KEPNX YES, GO DO CROSS MAP LDA SRADR,I NO, GET WORD FROM SOURCE ID JMP *+3 AND CONTINUE KEPNX XLA SRADR,I KLUDGE - DO CROSS MAP LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD XSA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT DEF *+1 PROCESSING DEF *+1 * CLA CLEAR SESSION WORD FOR DISC XFER STA SESW3,I LDA COPY? STA SESW2,I & KEEP ONLY COPY BIT FOR DISC * * LDB ABT10 GET THE EDIT FLAG SZB,RSS PERM ADDITION ? JMP NODSK NO, SO DON'T USE THE DISC * LDB DESA INITIALIZE SOURCE POINTERS STB DESAM DODSK �������þúLDB KLUGE ARE WE DOING KLUDGE? SZB SYS ID MOVE TO SYS ID? JMP DDSKX YES, GO DO XMAP LOAD LDA SRAD2,I NO, JUST GET THE WORD JMP *+3 AND KEEP GOING DDSKX XLA SRAD2,I KLUDGE - CROSS MAP LOAD LDB DESAM,I GET THE DESTINATION JSB SYRUW FIX THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 ARE WE DONE ? JMP DODSK NO, SO PLAY IT AGAIN SAM * NODSK ISZ MVIDS SET UP THE SUCCESSFUL RETURN * LDB ABT11 ADB P14 GET THE PROG TYPE WE JUST LAID DOWN XLA B,I AND P7 CPA P5 SEGMENT ? JMP MVIDS,I YES, SO WERE DONE. * LDB ABT11 MAIN, SO DO SOME MORE PROCESSING STB #IDAD SAVE THE ID ADDRESS * LDA PG.PT GET PAGES/ PART'N WORD ADB P21 AND ADDRESS JSB SYSET AND SET UP THE WORD * LDB ABT10 PERM LOAD ? SZB,RSS JMP MVIDS,I NO, WE'RE DONE * LDA PG.PT LDB ABT11 ADB P21 JSB SYRUW * JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID LL21 LDA ERR21 JMP ABOR P31 DEC 31 N18 DEC -18 NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID ? JMP NOIDS LONG LDA ERR26 SHORT JMP ABOR ABORT THYSELF WITH A L-26 ERROR B170K OCT 170000 COPY? NOP 0/2000 COPIES OK/DON'T COPY OWNER NOP OWNER WORD FOR TARGET ID SEG * SKP * * THE NAMOK ROUTINE CHECKS THE IDS IN THE SYSTEM TO MAKE * SURE THAT THE PROGRAM JUST RELOCATED STILL HAS A UNIQUE * NAME. ¶ ������þú THAT IS, THAT SOMEBODY DIDN'T SNEAK AN RP IN ON US. * * * NAMOK NOP LDA SSFLG GET THE LONG/SHORT ID FLAG LDB FXS.L AND THE DUMMY ID ADDRESS SSA,RSS SHORT OR LONG ? INB 0 = LONG INB -1 = SHORT * STB NAM12 INB SET UP NAME FOR TEST STB NAM34 INB STB NAM5 * CCA SET UP FLAG FOR # OF TESTS STA NMFLG SET PROG NAME FLAG * ONEMR JSB MIDN FIND THE ID IF ONE JMP NAMOK,I NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGN.LE DUPLICATE, JMP NAMOK,I AND CONTINUE. * LDA NAM12,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA NAM34,I NAME MESSAGE BUFFER STA MESS7+13 LDA NAM5,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM * JSB $LIBX RETURN TO INT PROCESSING DEF *+1 DEF *+1 * JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 ABORT THE GUY LDA RENAM GET ASCII '##' STA NAM12,I SET PROG NAME 1,2 = '..' LDB SSFLG IF MAIN, SET INTO OUTPUT MESSAGE SSB,RSS STA MESS4,I LDA P5 LDB NAM12 JSB SYOUT TELL THEM THE NEW NAME * JSB $LIBR NOP JMP ONEMR REPEAT DUPLICATE PROG NAME SCAN * SKP * * SUBROUTINE: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP JSB SETAB * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA È‚������þú # OF ADA ABT7,I BASE PAGE WORDS C#SXX CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TOTAL JMP C#S,I RETURN. * * * * * SUBROUTINE: "C#SMX" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * IT USES CROSS LOADS BECAUSE THE ID SEGMENT IS NOT A * DUMMY ID SEGMENT, RATHER, IT IS AN ID IN MEMORY. * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#SMX * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#SMX NOP JSB SETAB * XLA ABT4,I DETERMINE CMA,INA # OF XLB ABT5,I MAIN WORDS ADA B STA ABT1 XLA ABT6,I DETERMINE CMA,INA # OF XLB ABT7,I BASE PAGE WORDS ADA B LDB C#SMX SET RETURN STB C#S JMP C#SXX * * SETAB NOP STA ABT4 INA STA ABT5 SET UP THE ADDR OF BOUNDS INA STA ABT6 INA STA ABT7 JMP SETAB,I * * SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BIDÞê������þú7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * BID9 = ADDRS OF 1ST AVAIL ID EXTENSION, = 0 IF NONE * BID10 = ORDINAL # OF THE FREE ID EXT * BID11 = # OF FREE ID EXTENSIONS * * (NOTE: ABOVE PARAMETERS ARE ZERO IF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA BID9 ADDRESS OF FREE ID EXT STA BID10 FREE ID EXTENSION'S ORDINAL # STA BID11 # OF FREE ID EXTENSIONS STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. * XLA $IDEX GET THE ADDR OF ID EXTENSION BLOCK STA IDEX AND SAVE JMP *+3 CNTEX ISZ IDEX BUMP POINTER ISZ BID10 BUMP ID EXTENSION # XLA IDEX,I GET THE ADDRESS SZA,RSS IF END OF LIST JMP BLK1A GO TO ID SEGS XLB A,I ELSE GET THE CONTENTS OF 1ST WORD SZB IS THIS ONE FREE ? JMP CNTEX NO STA BID9 SAVE THE ADDRESS ISZ BID11 COUNT IT AS FREE NXIDX ISZ IDEX BUMP POINTER XLA IDEX,I GET THE ADDRESS SZA,RSS FINISHED ? JMP BLK1A YES, COUNT REST OF IDä’������þúS XLA A,I GET THE 1ST WORD SZA,RSS IS IT FREE ? ISZ BID11 YES, SO COUNT IT JMP NXIDX GO LOOK AT THE NEXT ONE * BLK1 ISZ KEYPT BUMP KEYWORD ADDR BLK1A XLB KEYPT,I GET KEYWORD SZB,RSS IF END OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG XLA B,I IF NAM12=0 SZA,RSS THEN ITS A BLANK ID JMP BLK2 CPA P1 CHECK FOR REPLACE OPERATION FLAG JMP BLK2 CPA P2 JMP BLK2 * JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA XLB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. XLB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? STB BID2 NO, SET ADDR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL XLA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#SMX DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THE‹������þúN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION XLB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#SMX DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION XLB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,I NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP BID9 NOP BID10 NOP BID11 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT IDEX NOP POINTER TO ID EXTENSION LIST DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KE×Æ������þúYPT NOP KEYWORD * SKP * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * "#SECT" CONTAINS -# OF SECTORS * REQUIRED * * A AND B MEANINGLESS * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECOME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * * THE NUMBER OF SECTORS PER TRACK MAY DIFFER BETWEEN WHERE * THE LOADR HAS TRACKS NOW AND WHERE THE NEWLY REQUESTED * TRACKS ARE. CONSEQUENTLY, WE'D BETTER CHECK THE NUMBER OF * SECTORS WE REALLY WANT AGAINST THE NUMBER WE GET. * THE INITIAL REQUEST FOR TRACKS FALLS OUT BECAUSE #SECT= 0 * IE #SECTS IS NOT SET SO IT IS = 0 * * CLB SET UP TO MPY LDA #TRAK NO. OF TRKS MPY TRKS# TIMES SECTS PER TRK SZB SHOULD FIT IN ONE WORD ‹y������þú HLT 1 SSA SHOULD FIT IN 15 BITS HLT 2 ADA #SECT SUBTRACT # OF SECTS REQUIRED * SSA,RSS HAVE ENOUGH? JMP ITRK2 POS,YES, CONTINUE * JSB EXEC NEG,NO,RELEASE DEF *+5 WHAT WE JUST GOT DEF P5 DEF #TRAK DEF TRAKB DEF TRKLU * ISZ #TRAK AND ASK FOR MORE JMP ITRK9 * * ITRK2 LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF DISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY FLAG FOR TRACKS #SECT NOP NEG # OF SECTORS REQUIRED SKP * * 'EDIT' COMPLETION * ED00 LDA SEG.L GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA ²«������þú CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#SMX # SECTORS STA ED60 AND SAVE * LDB ED25 JSB COPY. ANY COPIES OF THIS PROG ? * LDB TAT NO, SO SET SIGN BIT XLA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. ADB P2 (B)=NAM5 ADDR OF MATCHED ID XLA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. STA SWPID SAVE THE TYPE FOR A MOMENT CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD XLA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET XLA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET XLA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL JMP ED003 * * ADB P4 GET LAST PARTITION PROGRAM WAS IN XLA B,I AND M77 KEEP ONLY PARTITION MPY P7 NOW INDEX INTO $MATA TABLE XLB $MATA ADA B ADA P2 GET RESIDENT PROG XLA A,I CPA ED25 DID PROG TERM SERIALLY REUSABLE ? RSS YES, YOU LOSE JMP ED004 * * * SKP ED003 LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT LDA ERR34 AND ABORT THYSELFZERO JMP ABOR * MES70 DEF *+1 ASC 9,SET PRGM IS¨������þúNACTIVE BIT12 OCT 10000 LH1 NOP * ED004 LDB OPCOD GET THE OPERATION FLAG CPB P4 THIS A PURGE ? CLB,RSS YES, SET NAME = 0 CLB,INB SET REPLACE FLAG INTO ID * KEEPS OTHER LOADRS & FMGR HONEST JSB $LIBR TURN OFF INTERUPTS NOP XSB LH1,I ZERO ISZ LH1 NAME XSB LH1,I IN ISZ LH1 CORE XLA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) XSA LH1,I * CLA LDB SWPID GET THE PROGRAM TYPE CPB P5 IS IT A SEGMENT ? JMP NOZAP FORGET ABOUT ID EXTENSION * LDA LH1 NOW GET THE ADDRESS OF ADA P14 THE ID EXT WORD XLA A,I PULL IT IN SZA,RSS ANY ID EXTENSION JMP NOZAP NO. * ALF YES RAL,RAL GET THE # TO LOW END AND M77 & KEEP ONLY THE # XLB $IDEX ADD START OF TABLE ADA B XLA A,I NOW HAVE THE ADDRESS CLB XSB A,I AND ZAP THE WORD NOZAP JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * SZA,RSS WAS THERE AN ID EXT ? JMP TKREL NO, GO RELEASE THE TRACKS SWP YES, SO ZAP THE DISC AS WELL. JSB SYRUW * * RELEASE "OLD" TRACKS * TKREL LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DIž'������þúSC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 RSS JMP *+3 XLA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, JMP NTRM7 GO TO USE FIRST BLANK. * LDA FXS.L GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 THEN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST :Û������þúADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 XLB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) XLA B,I IF SZA,RSS = JMP ED17 0, CHECK FURTHER. CPA P1 JMP ED17 ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR XLA B,I GET THE TYPE OF PROGRAM AND P7 CPA P1 MEM RES? JMP ED12 YES FORGET IT * JSB MEM? GET ADDR OF MEM1 NOP (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN XLA B,I SZA,RSS IF NO DISC ALLOCATION TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * SSA TRACK ALLOC ON LU 3? JMP ED12 YES, FORGET THIS,TOO CMA,INA IS THE TRACK ABOVE THE ADA DSCLB LIB OF SYS ENTRY POINTS? SSA WELL? JMP ED12 WELL, WE CAN'T USE THAT EITHER * LDA B ADA N4 (A)=MEM1 ADDR JSB C#SMX GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. XLA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRMêM������þú7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB FXS.L GET DUMMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 XLA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKID FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BIRõ������þúD2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 GET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE AREA DEF P1 DEF DSKUN DEF L.BUF+0 DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF L.BUF+0 DEF P64 DEF ED66 DEF ED67 * ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CL1������þúA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGN SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB FXS.L STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA SEG.L PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA FXS.L SET ADDR OF ADA N9 NEXT SHORT DUMMY STA FXS.L ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA FXS.L INA * ED181 CLB,INB CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TÎå������þúACKS STB FIX SAVE OFF B REG LDA FXS.L SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE * LDB A ID ADDR TO B REG ADB P14 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 B= ADDR OF DMAIN XLA B,I GET THE DISC SPACE SSA IF ON LU 3 FORGET IT JMP SWPID,I * CMA,INA IF NOT BELOW DISC LIB ENTS ADA DSCLB THEN SSA JMP SWPID,I FORGET IT ALSO * LDA ED25 STA FXS.L SET IT IN FXS.L FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG STA KLUGE & KLUGE FLAG (THE PERSON WHO WROTE THIS * SHOULD BE SHOT LDB FIX RESTORE B REG JSB MVIDS AND CALL MVIDS TO SET UP NOP IGN.L ERROR RETURN CLB STB KLUGE LDB DREL RESTORE STB FXS.L THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * KLUGE NOP FLAG USED ONLY BY SWPID FOR MOVING MEM1 * FROM NEW ID TO OLD ONE. * * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMAIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL JSB MODID ISZ DREL ISZ SWPI}������þúD DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM HLT 0 ** SHOULD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * A = # OF TRACKS TO RELEASE * B = DISC SWAP WORD * * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. (ED64 = TAT ADDRESS) LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64 BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR XLA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TABLE. ISZ ED62 JMP DR JMP DREL,I SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TA'ÿ������þúTLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR STB FIX & SAVE NXTRK LDA DREL GET ID SEGMENT ADDR TO A XLB FIX,I THIS TRACK BELONG?? CPA B RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 ISZ FIX STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * MAPOF DEC 34 * * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = PRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU NOP LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE W_������þúORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4 NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG DBLAD NOP DATA BLOCK RELOCATION ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT L.BUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA LWABP NOP BASE PAGE AREA. DBLFL NOP FIRST DBL REC: -1,YES: 0,NO FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N10 DEC -10 N11 DEC -11 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P19 DEC 19 P20 DEC 20 P28 DEC 28 P29 DEC 29 P30 DEC 30 P33 DEC 33 P34 DEC 34 M7 EQU P7 M20 OCT 20 M77 OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M1600 OCT 1600 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE NOP ABSOLUTE BASE BLOK# NOP MSIGN OCT 100000 CHRDE ASC 1,.D DO NOT CHRBU ASC 1,BU CHANGE THIS UCHRG OCT 43400 ORDER AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF ª¹������þúLONG ID SEGMENT * TABLE OF SUBROUTINES FOR LIBRARY SUBTB DEF ALLOC ALLOC BP LINK SUB DEF SCAN SCAN FOR EXISTING BP LINK SUB DEF OUTAB OTPT A WORD THAT HAS JUST BEEN RELOCATED SUB * SPC 1 #MNPG NOP LOWEST PAGE NO. USED BY PROG #MXPG NOP HIGHEST PAGE NO. USED BY PROG #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR SPC 1 SKP * * ERROR CODES * ERR01 EQU P1 ERR02 EQU P2 ERR03 EQU P3 ERR04 EQU P4 ERR05 EQU P5 ERR06 EQU P6 ERR07 EQU P7 ERR08 EQU P8 ERR09 EQU P9 ERR10 EQU P10 ERR11 EQU P11 ERR12 EQU P12 ERR13 EQU P13 ERR14 EQU P14 * ERR16 EQU P16 ERR17 EQU P17 ERR18 EQU P18 ERR19 EQU P19 ERR20 EQU P20 ERR21 EQU P21 ERR22 EQU P22 ERR23 EQU P23 ERR24 EQU P24 ERR25 EQU P25 ERR26 EQU P26 ERR27 EQU P27 ERR28 EQU P28 ERR29 EQU P29 ERR30 EQU P30 ERR31 EQU P31 ERR32 EQU P32 ERR33 EQU P33 ERR34 EQU P34 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCL²æ����� N EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS SYSLN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 SPC 1 SPC 1 BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA * BSS 0 SIZE OF LOADR SPC 3 END LOADR ��������������������������������������������ÞŠ������ÿÿ����� ���� ÿý�©�‡1 ���������ÿ��92067-18472 1913� S C0122 �&MESSA � � � � � � � � � � � � � �H0101 “�����þúASMB,R,Q,C HED MESSS * NAME: MESSS * SOURCE: 92067-18472 * RELPC: 92067-16456 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MESSS,7 92067-16456 REV.1913 780724 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN,$$OP SPC 2 SPC 2 BUFFR NOP LNGTH NOP P1 NOP MESSS NOP JSB $LIBR GO PRIVILEGED. CNTR NOP JSB .ENTP GET PARAMETERS. DEF BUFFR LDA MESSS LDB HERE SZB JMP EXIT2 THERE STA RTN STA HERE LDA DEFEF STA MESSS CLA STA $PVCN LDA BUFFR LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM. ISZ $PVCN SZA,RSS JMP CHECK IF NO RETURNED MESSAGE, THEN CHECK XLB A,I FOR SPECIAL PATCHING OF 'RU' OR 'ON' STB LNGTH OTHERWIZE PROCESS MESSAGE. BRS STB CNTR LOOP INA XLB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH EXIT CLB STB HERE STB P1 EXIT1 JSB $LIBX DEF DEF RTN RTN NOP HERE NOP DEFEF DEF DEF SPC 2 26 CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. INB LDA BUFFR,I TEST FOR ON,RUN CPA .ON COMMANDS JMP DP1 TEST 1ST PRAM CPA .RU JMP DP1 JMP DP2 SPC 2 DP1 XLA B,I LU# IF GIVEN SZA,RSS IN FIRST LDA P1,I PARAMETER. XSA B,I * DP2 XLA $$OP,I GET THE OP CODE THE SYS PARSED CPA .ON ON ? JMP DP3 CPç��� �� A .RU RU ? JMP DP3 JMP EXIT2 * DP3 LDB XEQT GET MY ID ADDRESS JSB SES#3 NOW GET THE SESSION WORD XLA B,I STA HERE & SAVE IT * LDB $WORK GET THE SON'S ID ADDRESS JSB SES#3 AND GET IT'S SESSION WORD ADDRESS LDA HERE GET THE FATHERS WORD XSA B,I AND PROPIGATE TO THE SON. * * EXIT2 CLA ZERO OUT 'A' REG FOR RETURN JMP EXIT SPC 2 * SES#3 NOP ADB D14 INDEX TO TYPE WORD XLA B,I GET THE TYPE AND D7 KEEP ONLY TYPE CPA D1 IS IT MEM RES ? ADB DM4 ADB D18 B = SESSION WORD # 3 ADDRESS JMP SES#3,I RETURN * * .ON ASC 1,ON .RU ASC 1,RU D1 DEC 1 D5 DEC 5 D7 DEC 7 D14 DEC 14 D18 DEC 18 D29 DEC 29 DM4 DEC -4 A EQU 0 B EQU 1 XEQT EQU 1717B * END �������������������������������������������������������������������������������������������� Ó ������ÿÿ����� ���� ÿý�ª�± ���������ÿ��92067-18473 2013� S C0122 �&NCMND �NON-SES LIB %CMND MODULE � � � � � � � � � � � � �H0101 ^ì�����ASMB,R,L,C,Q * NAME: $CMND * SOURCE: 92067-18473 * RELPC: 92067-16456 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $CMND,8 92067-16456 REV.2013 800201 * ENT $CMND,$SALC,$SRTN * $CMND NOP $SALC EQU $CMND $SRTN EQU $CMND * * * * * * * * * * * END ��������������������������������������������Ŷ������ÿÿ����� ���� ÿý�«�± ���������ÿ��92067-18474 2013� S C0122 �&.TAE. � � � � � � � � � � � � � �H0101 ƒF�����ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18474 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: G.A.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .TAE.,7 92067-1X474 REV.2013 781128 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB <ENTRY> * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: <ENTRY> IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .TAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .TAY.,.ZAE. ENT .TAE. * DEC 1024 THIS IS THE FOUR WORD/ELEMENT .TAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 256 DEF .TAY. * END ��������������������������������������������������������¬ ������ÿÿ����� ���� ÿý�¬�² ���������ÿ��92067-18475 2013� S C0122 �&.ERES � � � � � � � � � � � � � �H0101 u|�����þúASMB,L,C HED ".ERES" - EMA ADDRESS RESOLVER. * NAME: .ERES * SOURCE: 92067-18475 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: B.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .ERES,7 92067-1X475 REV.2013 781226 * ENT .ERES SUP * A EQU 0 SPC 1 * .ERES RESOLVES AN ADDRESS IN EMA BUT DOES NOT MAP IN THE * PAGE CONTAINING THE RESULTING ADDRESS. INSTEAD, THE * ADDRESS IS RETURNED IN (B,A). THE CALLING SEQUENCE IS * IDENTICAL TO THAT OF ".EMAP" EXCEPT THE "ARRAY ADDRESS" * IS IGNORED, SO THE ARRAY MUST ALWAYS BE IN EMA. SPC 2 * LOCALS. * EMSG ASC 2,20EM T1 BSS 1 UPPER WORD RUNNING RESULT. T2 BSS 1 LOWER. ND BSS 1 LOOP COUNTER OF # DIMENSIONS. TABLE BSS 1 ADDR OF ARRAY DESCRIPTOR. RTN BSS 1 RETURN ADDRESS. * * ERROR HANDLING AND ZERO-DIMENSION CASE. * ERROR DLD EMSG (A,B) = ASCII "20EM" JMP RTN,I TAKE ERROR EXIT. ZEROD DLD TABLE,I JUST CHECK SIGN OF OFFSET. JMP NCHK SPC 2 * COPY RETURN ADDRESS, TABLE ADDR, & # DIM. * .ERES NOP LDA .ERES,I COPY RETURN ADDR. ISZ .ERES STA RTN ISZ .ERES SKIP ARRAY ADDR LDA .ERES COPY TABLE ADDR ISZ .ERES LDA A,I (FIRST REMOVE INDIRECTS) RAL,CLE,SLA,ERA JMP *-2 LDB A,I B = # DIM. INA SKIP IT IN TABLE. STA TABLE SSB # DIM < 0 ? JMP ERROR YES. CMB,INB,SZB,RSS NEGATE. ZERO ? /ý������þú JMP ZEROD YES. STB ND NO. KEEP AS COUNTER. CLA SET CURRENT OFFSET TO ZERO. STA T1 STA T2 SKP * LOOP THRU SUBSCRIPTS AND COMPUTE OFFSET. * LOOP LDA .ERES,I NEXT SUBSCRIPT ADDR. ISZ .ERES LDA A,I NEXT SUBSCRIPT. CLO ADD - (LOWER BOUND) CAREFULLY. ADA TABLE,I ISZ TABLE CLE,SSA,RSS RESULT NEGATIVE SOC OR OVERFLOW ? JMP ERROR YES. ADA T2 NO. ADD TO CURRENT SUM. STA T2 SEZ PROPOGATE CARRY. ISZ T1 (CAN'T SKIP) LDA TABLE,I SIZE OF PREVIOUS DIM (OR # WDS / ELEMENT) SSA NEGATIVE ? JMP ERROR YES. MPY T2 LOWER PRODUCT. STA T2 SSB IF T2<15> = 1, FIX UPPER PART OF PRODUCT. ADB TABLE,I LDA T1 UPPER PART OLD VALUE. STB T1 SAVE UPPER PART LOWER MULTIPLY. SZA,RSS ANY NEED TO DO UPPER MULTIPLY ? JMP LOOPE NO. MPY TABLE,I YES. DO IT. CLE,SZB THIRD WORD ? JMP ERROR YES. ADA T1 NO. ADD TO SUM. STA T1 SEZ,INA,RSS OFL ? (A#-1) SSA JMP ERROR YES. LOOPE ISZ TABLE ISZ ND DO ONCE FOR EACH DIMENSION. JMP LOOP * * ADD OFFSET FROM START OF EMA. * DLD TABLE,I THIS IS IT. CLE,SSB NEGATIVE ? JMP ERROR YES. ADA T2 ADD LOWERS. SEZ,CLE PROPOGATE CARRY. ISZ T1 (T1#-1) ADB T1 ADD UPPERS. SEZ,RSS CARRY OR NCHK SSB RESULT < 0 ? JMP ERROR YES. ISZ RTN NO. RETURN RESULT IN (B,A) JMP RTN,I SPC 1 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������€r�������� ������������� �������ÿÿ����� ���� ÿý�­�µ ���������ÿ��92067-18476 2013� S C0122 �&SEGLD � � � � � � � � � � � � � �H0101 }‡�����þúASMB,R,L,C ** SEGLD ** HED SEGLD - ROUTINE TO LOAD A SEGMENT * NAME: SEGLD * SOURCE: 92067-18476 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SEGLD CALLS EXEC TO LOAD SEGMENT. IF SEGMENT NOT FOUND, SEGLD * SCHEDULES T5IDM PROGRAM TO BUILD THE ID SEGMENT FOR THE SEGMENT * AND THEN CALLS EXEC TO LOAD SEGMENT. * * CALLING SEQUENCE: * CALL SEGLD(SGNAM,IERR,IP1,IP2,IP3,IP4,IP5) * WHERE: ISGNM = NAME OF SEGMENT * IERR = ERROR RETURNED BY SEGLD * IP1 - IP5 = OPTIONAL PARAMETERS TO BE PASSED * TO THE SEGMENT * * RETURN: * IERR = 5 IF SEGMENT NOT FOUND * = 0 IF SEGMENT LOADED * * NAM SEGLD,7 92067-1X476 REV.2013 790202 ENT SEGLD * EXT .ENTP,EXEC,.DFER,$OPSY * SGNAM NOP IERR NOP PARM1 NOP PARM2 NOP PARM3 NOP PARM4 NOP PARM5 NOP * SEGLD NOP JMP CLRPM POINT THE 5 OPTIONAL .ZERO DEF ZERO PARAMETERS TO ZERO GTPRM JSB .ENTP GET THE PARAMETERS PASSED DEF SGNAM * TRY JSB EXEC LOAD SEGMENT DEF *+8 DEF .S8 =100010B -- NO ABORT BIT SET DEF SGNAM,I NAME OF SEGMENT DEF PARM1,I FIVE DEF PARM2,I DEF PARM3,I OPTIONAL DEF PARM4,I DEF PARM5,I PARAMETERS NOP * * SCHEDULE T5IDM TO SET UP ID SEGMENT FOR SEGMENT * JSB .DFER GET SEGMENT NAME DEF SGNM1 DEF SGNAM,I JSB EXEC DEF *+7 DEF .S23 =100027B SCHEDULE WITH NO ABORT Ù­��� ��  DEF T5IDM DEF SGNM1 SEGMENT DEF SGNM2 NAME DEF SGNM3 DEF .1 ONE SEGMENT TO LOAD JMP SC05 T5IDM PROGRAM NOT FOUND * LDA $OPSY HOW TO GET THE RETURN PARAMETER ERA,SLA TEST THE DMS BIT JMP DMS IF DMS INSTALLED JMP * LDA B,I ELSE JUST LOAD THE DATA JMP TS GO TEST THE RESULT * DMS XLA B,I DMS DO THE DM CROSS LOAD TS SZA,RSS IF ZER THEN THE SEGMENT WAS SET UP JMP TRY GO TRY AGAIN * SC05 LDA .5 SEND ERROR 5 TO INDICATE SCO5 STA IERR,I JMP SEGLD,I RETURN * * ZERO DEC 0 .S23 OCT 100027 .1 DEC 1 .5 DEC 5 SGNM1 NOP SGNM2 NOP SGNM3 NOP T5IDM ASC 3,T5IDM * .S8 OCT 100010 * * CLRPM LDA .ZERO STA PARM1 STA PARM2 STA PARM3 STA PARM4 STA PARM5 JMP GTPRM DONE * * * A EQU 0 B EQU 1 END ��������������������������������‹ï ������ÿÿ����� ���� ÿý�®�µ ���������ÿ��92067-18477 2013� S C0122 �&LIMEM � � � � � � � � � � � � � �H0101 {�����ASMB,R,L,C ** LIMEM ** HED LIMEM - MEMORY LIMITS * NAME: LIMEM * SOURCE: 92067-18477 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * LIMEM RETURNS THE FIRST WORD OF AVAILABLE MEMORY (IF SEGMENTED * PROGRAM, IT IS HIGH WORD LARGEST SEGMENT + 1) AND THE NUMBER * OF WORDS IN AVAILABLE MEMORY UPTO THE END OF PROGRAM PARTITION * * CALLING SEQUENCE: CALL LIMEM(IWHCH,IFWAM,IWRDS) * WHERE: IF IWHCH IS < 0 THEN JUST RETURN, IFWAM,IWRDS ARE * MEANINGLESS. * IF IWHCH IS >= 0 THEN LIMEM RETURNS: * IFWAM = FIRST WORD OF AVAILABLE MEMORY * IWRDS = NUMBER OF WORDS IN AVAILABLE MEMORY * * * NAM LIMEM,7 92067-1X477 REV.2013 790126 ENT LIMEM * EXT EXEC,.ENTR * IWHCH NOP IFWAM NOP IWRDS NOP * LIMEM NOP JSB .ENTR GET PARAMETERS DEF IWHCH LDA IWHCH,I SSA GET MEMORY LIMITS? JMP LIMEM,I NO, RETURN * JSB EXEC DEF *+5 DEF .26 GET LIMITS DEF IFWAM,I FIRST WORD OF AVAIL MEM DEF IWRDS,I # OF WORDS DEF IWHCH # OF PAGES JMP LIMEM,I RETURN * .26 DEC 26 END ��������������������������������������������������������������������������������������������������������������������������������+l������ÿÿ����� ���� ÿý�¯�µ ���������ÿ��92067-18478 2040� S C0122 �&EQRQ � � � � � � � � � � � � � �H0101 “]�����þúASMB,Q,C ** RTE-IV EQUIPMENT (UN)LOCKING MODULES ** HED ** EQUIPMENT LOCKING MODULE ** * NAME: EQTRQ * SOURCE: 92067-18478 * RELOC: 92067-16268 * PGMR: AVD * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * NAM EQTRQ,6 92067-1X478 REV.2040 800724 * ENT EQTRQ EXT $LIBR,$ERAB,$XEQ,$LIST,$PVCN,$DRAD EXT LUTRU,$CVT3,MESSS,$ELTB,$SCD3,$RNTB * SUP A EQU 0 B EQU 1 * ***************************************************************************** * THE EQUIPMENT LOCK FEATURE ALLOWS A PROGRAM TO LOCK THE EQUIPMENT * (CONTROLLER) ASSOCIATED WITH A GIVEN LU TO THE PROGRAM EXCLUSIVELY. * ANY OTHER PROGRAM IS PUT IN THE WAIT LIST WHEN IT EITHER REQUESTS A LOCK * ON EFFECTIVELY THE SAME EQUIPMENT, REQUESTS A LOCK WHEN THERE IS (TEMPO- * RARILY) NO PLACE TO DOCK THE LOCK (I. E., THE LOCKING TABLE IS FULL), OR * ATTEMPTS I/O THROUGH AN EQUIPMENT THAT IS LOCKED (TO SOMEONE ELSE). * WHEN THE EQUIPMENT IS EVENTUALLY UNLOCKED, ATTEMPT WILL BE MADE TO * SCHEDULE THE WAITING PROGRAM. * WHEN A PROGRAM TERMINATES NORMALLY (I. E., THROUGH AN EXEC 6 CALL WITH * THE NOT SAVING RESOURCES OPTION), ALL EQUIPMENTS LOCKED TO HER WILL BE * RELEASED. IF THE TERMINATION IS A SAVING RESOURCES ONE, EQUIPMENTS * LOCKED TO HER STAY LOCKED TO HER ID SEGMENT ADDRESS (LET'S HOPE SHE CAN * BE RESCHEDULED WITH THE SAME ID SEGMENT ADDRESS). * IF A PROGRAM TERMINATES ABNORMALLY (DEFINED AS THE COMPLEMENT OF THE * MEANING OF "NORMALLY" ABOVE), AND HAD SPECIFIED A LOCK_ON_ABORT OPTION * IN HER LOCKING REQUEST, THE EQUIPMENT STAYS LOCKED--THOUGH NOT Ã������þúTO HER * PER SE. ANOTHER PROGRAM (FATHER? CLONE?? LOVER???) CAN THEN RELOCK IT * TO HIMSELF AND PROCEED TO USE IT. * UNLOCKING OF AN EQUIPMENT IS ALSO DONE WITH THIS SAME CALL, BUT IS * RATHER UNINTERESTING TO DESCRIBE, SO SEE THE DRY E.R.S. BELOW. SKP * * * CALLING SEQUENCE: * * ASSEMBLER: * * EXT EQTRQ * . * . * . * JSB EQTRQ * DEF *+3 * DEF IOPT * DEF LU * RETURN----- * . * . * . * LU DEC LU # WHOSE ASSOCIATED EQT. IS TO BE (UN)LOCKED * IOPT DEC OPTION_WORD (DESCRIBED BELOW) * * * FORTRAN: * * CALL EQTRQ (IOPT, LU) *WITH IOPT BIT 14 CLEAR * RETURN POINT---- * * -OR- * * CALL EQTRQ (IOPT, LU) *WITH IOPT BIT 14 SET * GO TO ERROR ROUTINE * RETURN POINT---- * * * BIT ASSIGNMENTS IN THE OPTION WORD ARE AS FOLLOWS: * * BIT 0 1/0 LOCK/UNLOCK * * NO ABORT ON CALL / * 14 1/0 ERROR, RETURN ASCII / ABORT ON ERROR * CODE IN (A) & (B) / * * IN ADDITION, FOR THE LOCK REQUEST: * * BIT 13 1/0 KEEP EQT. / RELEASE * LOCKED ON / ON * ABORTION / ABORTION * * 15 1/0 WITHOUT WAIT / WITH WAIT SKP * * * (1) THE ABORT ERRORS FOR THIS CALL ARE: * * MNEMONIC MEANING * * EQ00 ILLEGAL LU SPECIFIED * (MAPS INTO SYSTEM CONSOLE EQT) * * EQ01 NON-EXISTENT LU SPECIFIED * (LU SPECIFIED > LUMAX) * * * (2) ON RETURN FROM LOCK_WITHOUT_WAIT: * * (A) = 0 IF SUCCESSFUL, OR EQT. ALREADY LOCKED * TO THIS PROGRAM (LOCKING A BIT BUCKET IS * ALWAYS SUCCESSFUL, AND RESULTS IN A BIG * 5������þú FAT NOP) ALSO, (B) = LOCKED EQT. #, * * -1 IF EQUIPMENT LOCK TABLE FULL, * * 1 IF EQT. ASSOCIATED WITH SPECIFIED LU LOCKED * TO ANOTHER PROGRAM. * * 2 IF EQT. ASSOCIATED WITH SPECIFIED LU HAS ONE OR * MORE ASSOCIATED LU'S LOCKED TO ANOTHER PROGRAM. * * * (3) ON RETURN FROM THE LOCK_WITH_WAIT REQUEST: * * (A) = 0 AND (B) = LOCKED EQT #. * * IF THE EQUIPMENT SPECIFIED IS LOCKED TO ANOTHER PROGRAM, OR THE * EQUIPMENT LOCK TABLE IS FULL, THE CALLING PROGRAM * IS PUT IN STATE 3 (GENERAL WAIT) UNTIL THE REQUEST * CAN BE FULFILLED. * * * (4) ON RETURN FROM UNLOCK: * * (A) = 0 IF SUCCESSFUL, * * -1 IF EQT. ASSOCIATED WITH SPECIFIED LU WAS NOT * LOCKED TO BEGIN WITH, * * 1 IF EQT. ASSOCIATED WITH SPECIFIED LU LOCKED * TO ANOTHER PROGRAM, * * 2 IF EQT. IS BUSY WITH LOCKER'S I/O. * ******************************************************************** SKP * * EQTRQ NOP * JSB $LIBR PLEASE_MAKE_ME_PRIVILEGED CALL. NOP * CLA CLEAR PRIVILEGED COUNTER SINCE STA $PVCN WE WON'T RETURN VIA $LIBX. * CCA ADA EQTRQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION. * LDA EQTRQ,I SET RETURN ADDR JSB $DRAD (RESOLVE INDIRECTS FOR FTN CALLS) STA RQRTN IN CASE OF ABORT. * ISZ EQTRQ THIS POINTS EQTRQ TO P+2. LDA EQTRQ,I GET OPTION WORD JSB $DRAD (RESOLVE INDIRECTS FOR FTN CALLS) LDA A,I SPECIFIED IN CALL. RAL,CLE,ELA GET BIT 14 (NO_ABORT) IN E. LDB XEQT GET TO THE STATUS WORD (WORD ADB D15 16 OF THE ID SEGMENT). XLA B,I PICK UP STATUS. RAL,ERA PUT (E) IN BIT 15  ������þú XSA B,I OF THE STATUS WORD. SSA AND IF NO_ABORT BIT WAS SET, BUMP THE ISZ RQRTN RETURN ADDR (RTE NO_ABORT MECHANISM). * LDA EQTRQ PICK UP ADA D1 THE LU # LDA A,I SPECIFIED JSB $DRAD (RESOLVE INDIRECTS FOR FTN CALLS) LDA A,I IN CALLING SEQUENCE. STA SELU STORE FOR THE FOLLOWING CALL. JSB LUTRU GET TRUE SYSTEM LU. DEF *+2 DEF SELU LDB D1 PREPARE TO ISSUE "EQ01" ERROR. CPA D1 DID THEY SPECIFY THE SYSTEM CONSOLE? JMP EQT95 YEP--AND THAT'S A NO-NO. * SSA IF TRUE SYSTEM LU IS NEGATIVE, JMP EQT90 GO ISSUE "EQ00" ERROR. * LDB LUMAX GET MAX LU # IN SYSTEM ADB D1 PLUS ONE. CMB,INB TAKE 2'S COMPLE. ADB A ADD SPECIFIED LU #. SSB,RSS IF LU HAS NO ASSOCIATED DRT, JMP EQT90 GO ISSUE "EQ00" ERROR. * CCB GET THE ADA B DRT ENTRY ADA DRT POINTED TO BY LDA A,I SPECIFIED LU #. AND B77 ISOLATE THE EQT #. STA TEMP1 STORE THE EQT # THUS ARRIVED AT. SZA,RSS IS IT LE BITTE BUCKETTE? JMP EQT70 YEP, LOCK/UNLOCK IS A NOP. * LDB D1 PREPARE TO ISSUE "EQ01" ERROR. LDA DRT,I IF SPECIFIED LU MAPS INTO AND B77 THE SAME EQT.# THAT THE CPA TEMP1 SYSTEM CONSOLE MAPS INTO, JMP EQT95 AGAIN ISSUE "EQ01" ERROR. * CLO CLEAR OVERFLOW, TO BE USED AS A FLAG. LDB EQTRQ,I GET OPTION WORD LDA B,I SPECIFIED IN CALL. SLA IF LSB OF (A) IS NONZERO, STO SET LOCK_REQUEST FLAG. * XLA $ELTB GET $ELTB TABLE ADDR. XLB A,I GET HEADER WORD. RBL,CLE,ERB (E)=SIGN, (B)=TABLE_LENGTH. STB TEMP6 KLUDGE #_OF_EMPTIES TO BE NONZERsQ������þúO. ADA D1 GET ADDR OF 1ST EQT. # IN TABLE. STA TEMP3 STORE LOCALLY HERE STA TEMP9 AND HERE. STB TEMP4 ALSO STORE TABLE LENGTH. SEZ,RSS IF TABLE IS EMPTY, JMP EQT40 JUMP. * CMB,INB STORE COMPLE OF STB TEMP5 TABLE LENGTH. CLA INITIALIZE STA TEMP6 #_OF_EMPTIES IN TABLE. EQT30 LDA TEMP3 COMPARE AN EQT. # XLA A,I FROM TABLE SZA,RSS (IF BLANK ENTRY IS ENCOUNTERED, ISZ TEMP6 BUMP #_OF_EMPTIES.) CPA TEMP1 WITH THIS REQUEST'S EQT. #. JMP EQT65 MATCHES, GO SEE IF LOCKED TO HIM. * ISZ TEMP3 GET ADDR OF NEXT EQT. #. ISZ TEMP5 IF TABLE NOT ALL DONE, JMP EQT30 LOOP BACK. * EQT40 CCA MAKE (A) = -1. SOS IF UNLOCK REQUEST, JMP EQT70 RETURN WITH WASN'T_LOCKED RESPONSE. * LDA TEMP6 GET #_OF_EMPTIES IN TABLE. SZA IF AT LEAST ONE EMPTY ENTRY, JMP EQT45 TABLE NOT FULL, GO ADD AN ENTRY. * CCA FIRST SET UP RETURN CODE ( (A) = -1 ) LDB EQTRQ,I GET OPTION WORD LDB B,I SPECIFIED IN CALL. SSB IF REQUEST IS WITHOUT_WAIT, JMP EQT70 RETURN WITH (A) = -1. * XLA $ELTB GET TABLE ADDR AS SEMAPHORE. JMP EQT85 GO SUSPEND CALLER AND RETURN. * EQT45 LDA TEMP9 GET BACK ADDR OF 1ST EQT # IN STA TEMP3 TABLE, AND STORE IT. EQT50 XLA A,I GET AN EQT # FROM TABLE. SZA,RSS IF EMPTY ENTRY, JMP EQT55 USE THE SLOT TO ADD AN ENTRY. ISZ TEMP3 GET NEXT LDA TEMP3 EQT. # ADDR IN A. JMP EQT50 LOOP BACK. * EQT55 NOP ******************************************************** CLB,INB GET MAX LU'S ADB LUMAX IN SYSTEM PLUS 1. CMB,INB NEGATE IT STB TEMP2 AND STORE. CCB A������þúGET FWA OF DRT AND ADB DRT PRIME IT FOR THE NEXT BUMP. EQT56 INB GET TO NEXT DRT ENTRY FW. ISZ TEMP2 HAVE WE COMPLETED RSS A PASS THROUGH THE DRT? JMP EQT57 -YES. NO HARM IN ALLOWING EQT LOCK. * LDA B,I GET DRT ENTRY'S FW. AND B77 ISOLATE EQT#. CPA TEMP1 DOES DRT ENTRY POINT TO OUR EQT? RSS JMP EQT56 -NO. CONTINUE SEARCHING OTHER LU LOCKERS. * LDA B,I AGAIN GET DRT ENTRY'S FW. AND B3700 THIS TIME ISOLATE RN TABLE OFFSET * (AKA "LU LOCK FLAG"). SZA,RSS IT'S OUR EQT'S LU, BUT IS IT LOCKED? JMP EQT56 -NO. CONTINUE SEARCHING OTHER LU LOCKERS. * ALF,ALF ROTATE RN TABLE OFFSET RAL,RAL INTO LOW BITS. ADA D$RN ADD BASE ADDRESS. STA TEMPA SAVE ADDRESS IN CASE SUSPENSION NEEDED XLA A,I GET RN TABLE ENTRY. AND B377 ISOLATE LOCKER'S KEYWORD TABLE INDEX * (AKA ID NUMBER). ADA KEYWD AND USE THE ID NUMBER TO LDA A,I GET LU LOCKER'S ID SEGMENT ADDRESS. CPA XEQT DOES IT MATCH OUR CHAP'S? JMP EQT56 -YES. CONTINUE SEARCHING OTHER LU LOCKERS. * LDB EQTRQ,I GET OPTION WORD IN LDB B,I CALLER'S REQUEST. SSB IF CALL IS WITHOUT WAIT, GIVE HIM JMP EQT75 A "2" (SIBLING LU LOCKED TO ANOTHER"). * LDA TEMPA ELSE SUSPEND HIM ON JMP EQT85 LOCKED LU'S RN TABLE ENTRY. * ********************************************************* EQT57 XLB $ELTB FIRST INSURE XLA B,I THAT THE IOR B100K NOT_EMPTY BIT XSA B,I IS SET. LDA TEMP1 GET EQT. # SPECIFIED. LDB TEMP3 STORE IT IN XSA B,I ENTRY WORD 1. ADB TEMP4 GET ADDR OF ENTRY WORD 2. EQT60 LDA EQTRQ,I GET THE LDA A,I m#������þúOPTION WORD. RAL,RAL PICK UP BIT 13 ELA (LOCK_ON_ABORT) IN (E). LDA XEQT COMBINE CALLER'S ID SEGMENT ADDR RAL,ERA WITH LOCK_ON_ABORT BIT. XSA B,I STORE IT IN 2ND WORD OF ENTRY. LDA TEMP1 STORE LOCKED EQT. # XSA XB,I IN CALLER'S (B). CLA RETURN WITH JMP EQT70 (A) = 0. * EQT65 LDB TEMP3 GET ID ADDR WORD ADB TEMP4 (I. E., WORD2) XLA B,I OF THIS EQT.'S ENTRY. ELA,CLE,ERA GET RID OF THE LOCK_ON_ABORT BIT. CPA XEQT COMPARE WITH CALLER'S ID. RSS JMP EQT80 JUMP IF NOT LOCKED TO CALLER. * SOC IF THIS IS A LOCK REQUEST, JMP EQT60 RELOCK THE EQT. WITH (MAYBE) CHANGED OPTION. * CCA GET ADDR WHERE LOCKER'S ADA TEMP1 I/O REQUESTS MAY STILL BE MPY D15 PENDING (VIZ., EQT ENTRY'S ADA EQTA 1ST WORD). XLA A,I PICK UP REQUEST LIST POINTER. SZA ANY REQUESTS LEFT? JMP EQT75 -YES, CAN'T UNLOCK YET. * JMP EQCL -NO, SO GO UNLOCK THE EQT. * BACK CLA RETURN WITH OK RESPONSE. EQT70 XSA XA,I STICK RETURN CODE IN CALLER'S (A). LDA RQRTN STICK RETURN ADDR XSA XSUSP,I IN SUSP ADDR WORD JMP $XEQ AND RETURN VIA THE DISPATCHER. * EQT75 LDA D2 RETURN WITH 2 ("CAN'T UNLOCK YET" OR JMP EQT70 "SIBLING LU(S) LOCKED TO ANOTHER") * EQT80 LDA D1 RETURN CODE = 1. SOS IF UNLOCK REQUEST, JMP EQT70 RETURN WITH "LOCKED TO ANOTHER" RESPONSE. * LDA B,I GET SPECIFIED EQT.'S ID # SLOT. SZA,RSS IF LOCKED WITHOUT OWNER, JMP EQT60 GO LOCK TO CALLER (FILL ENTRY 2ND WORD). * LDA D1 FIRST SET UP RETURN CODE ( (A) = 1 ). LDB EQTRQ,I GET OPTION WORD LDB B,I SPECIFIED IN CALL. Û ������þú SSB IF REQUEST IS WITHOUT_WAIT, JMP EQT70 RETURN WITH (A) = 1. * LDA TEMP3 GET ENTRY ADDR AS SEMAPHORE. EQT85 XSA XTEMP,I STORE IT IN SUSP. FLAG WORD. JSB $LIST GO PUT CALLER IN OCT 503 GENERAL WAIT LIST JMP $XEQ AND RETURN. * EQT90 CLB MAKE (B) = 0 FOR "EQ00" ERROR. EQT95 LDA ASEQ ISSUE "EQXX" ERROR JMP $ERAB AND EXIT. SKP * * * CONSTANTS, EQUATES, TEMPORARIES, AND SUCH. * ASEQ ASC 1,EQ D1 DEC 1 D2 DEC 2 D15 DEC 15 B77 OCT 77 B377 OCT 377 B3700 OCT 3700 B100K OCT 100000 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B XA EQU 1731B XB EQU 1732B TEMP1 NOP EQT. # TO BE (UN)LOCKED TEMP2 NOP COMPLE OF #-OF-DRT'S-YET-TO-BE-TRAVERSED TEMP3 NOP TABLE ADDR OF NEXT EQT 2 B COMPARED TEMP4 NOP TABLE LENGTH TEMP5 NOP COMPLE OF #-OF-COMPARES-YET-2-B-DONE TEMP6 NOP # OF EMPTIES IN TABLE TEMP9 NOP TABLE ADDR OF 1ST EQT # TEMPA NOP LOCKED LU'S RN TABLE ENTRY ADDR (SEMAPHORE) SELU NOP SESSION LU (USED FOR "LUTRU" CALL) D$RN DEF $RNTB+0 FORCE A DIERCT ADDRESS TO RN TABLE SKP HED ** EQUIPMENT LOCK CLEARING ROUTINE ** * * EQCL CLB LDA TEMP3 FIRST PRESERVE ADDR OF STA TEMP7 ENTRY FOR SEMAPHORING. XSB A,I CLEAR ENTRY'S 1ST WORD. ADA TEMP4 COMPUTE ADDR OF ENTRY'S 2ND WORD. XSB A,I CLEAR 2ND WORD. ADA TEMP4 COMPUTE ADDR OF ENTRY'S 3RD WORD. XLB A,I GET THE 3RD WORD (LIST POINTER), STB TEMP8 AND PRESERVE IT. CLB THEN CLEAR XSB A,I THE 3RD WORD ALSO. * EQEMP ISZ TEMP6 BUMP EMPTIES COUNT FOR 1 CREATED/FOUND. EQNOT ISZ TEMP3 GET ADDR OF NEXT EQT. # IN TABLE. ISZ TEMP5 BUMP #_OF_COMPARES_DONE FOR 1 JUST DONE. RSS Íà������þú IF ALL ENTRIES HAVE BEEN TRAVERSED, JMP EQUNE SKIP COUNTING EMPTIES. * LDA TEMP3 CHECK NEXT ENTRY XLA A,I IN TABLE. SZA,RSS IF IT IS BLANK, JMP EQEMP BUMP EMPTIES COUNT. IN ANY CASE, JMP EQNOT GET TO NEXT ENTRY. * EQUNE LDA TEMP6 GET TOTAL #_OF_EMPTIES IN TABLE. CPA TEMP4 COMPARE WITH TABLE LENGTH. JMP EQCNE TABLE EMPTY, GO CLEAR NOT_EMPTY BIT. * JMP EQCNT ELSE CONTINUE. * EQCNE XLB $ELTB GET THE HEADER XLA B,I WORD OF TABLE. ALR,RAR CLEAR NOT_EMPTY BIT, XSA B,I AND RESTORE. * EQCNT CCA GET ADDR WHERE TO REHANG ANY ADA TEMP1 HUNG $XSIO CALLS FOR SPECIFIED MPY D15 EQUIPMENT NUMBER (VIZ., ITS EQT ADA EQTA ENTRY'S WORD ZERO). LDB TEMP8 GET POINTER TO $XSIO LINKED LIST. SZB,RSS IF THERE IS NO $XSIO PENDING, JMP EQSCD SKIP DRIVER INITIATION. * XSB A,I REHANG $XSIO POINTER ON THE EQT. * DLD UP SET UP THE "UP, " PART DST IBUFA OF THE "UP, XXX" COMMAND. * CCE SET UP TO CONVERT LDA TEMP1 EQT.# INTO ASCII. JSB $CVT3 GO DO IT. * ADA D1 GET TO ADDR OF ASCII NUMBER. DLD A,I PICK UP THE ASCII REPRESENTATION, DST IBUFA+2 AND APPEND IT TO THE "UP, ". *************************************************************************** LDA ADDR SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I SINCE WE WILL BE "SUSPENDED" **************************************($MESS IS AN OPEN ENDED FELLA).****** CALL JSB MESSS NOW SEND THE "UP,XX" COMMAND DEF *+3 SO THAT I/O (I.E., $XSIO) DEF IBUFA MAY BEGIN DEF ICOUN ON THIS EQT. * JSB $LIBR GO PRIVILEGED AGAIN, SINCE THE MESSS NOP CALL MESSED UP OUR PRIVILEGED STATUS. * CLA CLEAR THE���<��:6 PRIVILEGED COUNTER, STA $PVCN SINCE WE WON'T RETURN VIA $LIBX. * EQSCD LDA TEMP7 GET ENTRY ADDR. JSB $SCD3 SCHEDULE WAITERS_FOR_THIS_EQT. XLA $ELTB GET TABLE HEADER ADDR. JSB $SCD3 SCHEDULE WAITERS_FOR_PLACE_TO_DOCK_A_LOCK. JMP BACK AND RETURN TO MOMMY. * * * * * MORE CONSTANTS, EQUATES, TEMPORARIES, AND SUCH. * TEMP7 NOP TABLE ADDR OF EQT.# TO BE UNLOCKED TEMP8 NOP $XSIO LINKED LIST POINTER ADDR DEF CALL UP ASC 4,UP, ICOUN DEC 8 IBUFA ASC 11, END ����������������; <������ÿÿ����� ���� ÿý�°�¿ ���������ÿ��92067-18479 2040� S C0122 �&CHEL � � � � � � � � � � � � � �H0101 †N�����þúASMB,Q,C ** RTE-IV EQUIPMENT LOCK CHECKING MODULE ** * NAME: CHEL * SOURCE: 92067-18479 * RELOC: 92067-16268 * PGMR: AVD * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * NAM CHEL,7 92067-1X479 REV.2040 800724 * ENT CHEL EXT $ELTB * SUP A EQU 0 B EQU 1 * ******************************************************************* * THE CHECK EQUIPMENT LOCK ROUTINE ALLOWS A DRIVER OR OTHER * PROGRAM TO DETERMINE WHETHER A GIVEN EQUIPMENT IS LOCKED OR NOT. * IT IS UP TO THE CALLING ROUTINE TO TAKE APPROPRIATE ACTION BASED * ON THAT KNOWLEDGE. * THIS ROUTINE IS APPENDED TO THE CALLER'S MEMORY SPACE. * * CALLING SEQUENCE: * * LDB EQT # WHOSE LOCKEDNESS (LOCHNESS?) IS TO BE KNOWN * JSB CHEL * RETURN--- * * ON RETURN: * (A) = 0, IF SPECIFIED EQT. NO. IS NOT LOCKED. ELSE, * (A) = LOCKER'S ID SEGMENT ADDRESS. ******************************************************************* * * CHEL NOP CLO FIRST CLEAR OVERFLOW, TO BE USED AS A FLAG. RSA GET A COPY OF THE STATUS REGISTER. ALF GET WHICH_MAP? BIT IN LEAST_SIGNI_POZ. SLA AND COPY IT INTO STO THE FLAG. SOS IF THE SYSTEM MAP IS ENABLED, JMP CH500 GO DO A REGULAR LOAD, * XLA $ELTB,I ELSE DO A CROSS-LOAD. CH050 SSA,RSS IF TABLE IS EMPTY, JMP CH200 RETURN WITH (A) = 0. * ELA,CLE,ERA GET RID OF NOT_EMPTY BIT FROM HEADER WORD. STA TEMP1 STORE TABLE LENGTH. CMA,INA NEXT STORE 2'S COMPLE STA TE¶��� �� MP2 OF TABLE LENGTH. SOS IF THE SYSTEM MAP IS ENABLED, JMP CH501 GO DO REGULAR LOAD, * XLA $ELTB ELSE DO A CROSS-LOAD. CH075 ADA D1 GET ADDR OF 1ST EQT. # STA TEMP3 IN TABLE, AND STORE IT. CH100 LDA TEMP3 GET ADDR OF NEXT EQT. # IN TABLE. SOS IF THE SYSTEM MAP IS ENABLED, JMP CH502 GO DO REGULAR LOAD, * XLA A,I ELSE DO A CROSS-LOAD. CH150 CPA B COMPARE WITH CALLER-SPECIFIED EQT. #. JMP CH300 MATCHES, SO GO FIND LOCKER. * ISZ TEMP3 GET ADDR OF NEXT EQT. # IN TABLE. ISZ TEMP2 IF NOT ALL ENTRIES COMPARED, JMP CH100 LOOP BACK. * CH200 CLA EQT. NOT LOCKED, (A) = 0, JMP CHEL,I AND RETURN. * CH300 LDA TEMP3 GET MATCHED EQT. #'S ENTRY ADDR. ADA TEMP1 OFFSET TO LOCKER'S ID SEG ADDR. SOS IF THE SYSTEM MAP IS ENABLED, JMP CH503 GO DO REGULAR LOAD, * XLA A,I ELSE DO A CROSS-LOAD. ELA,CLE,ERA KEEP ONLY THE ID SEG ADDR. JMP CHEL,I RETURN WITH (A) = LOCKER'S ID SEG ADDR. * * CH500 LDA $ELTB,I JMP CH050 * CH501 LDA $ELTB JMP CH075 * CH502 LDA A,I JMP CH150 * CH503 LDA A,I ELA,CLE,ERA JMP CHEL,I * * * D1 DEC 1 TEMP1 NOP TEMP2 NOP TEMP3 NOP END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������T6 ������ÿÿ����� ���� ÿý�±�¸ ���������ÿ��92067-18480 1926� S C0122 �&RUN.C � � � � � � � � � � � � � �H0101 i™�����þúASMB,L,C NAM RUN.C,7 92067-16100 790405 REV. 1926 $CLIB * * SOURCE: 92067-18480 * * PROC RUN.C(FCB1,FCB2,PRAM,ID); * STRING ID; * COMMENT ID IS THE NAME STRING OF THE PROGRAM TO BE SCHEDULED; * INTEGER ARRAY PRAM; * COMMENT PRAM IS A 5 WORD ARRAY USED TO PASS USER DATA BETWEEN * THE FATHER AND SON PROCESSES; * RECORD FCB1,FCB2; * COMMENT FCB'S ARE DATA STRUCTURES CONTAINING ALL THE DATA * NECESSARY TO MANAGE A FILE IT IS ASSUMED THAT FCB1 IS TO BE * THE INPUT FILE, AND FCB2 IS THE LIST FILE BEING PASSED TO THE * SON PROCESS; * BEGIN * MOVE FCB1 TO FCB1. FOR 25 WORDS; * MOVE FCB2 TO FCB2. FOR 25 WORDS; * IF FCB1 = SYSSCRATCH THEN * UNLINK(FCB1); * CLOSE-ALL-LINKED-FCB'S; * GET-ID-FOUND * SCHEDULE(ID,PRAMLIST); * IF ERROR THEN GO ERROR EXIT; * PICKUP_AND_STORE_THE_RETURN_PARAMETERS; * IF FCB1 = SYSSCRATCH THEN * LINK_IT_BACK_IN; * END OF RUN.C; SKP ENT RUN.C EXT EXEC GUESS WHO EXT LUTRU UNIQUE LOGLU NO. UNDER SESSION EXT .MVW THE MOVE WORDS GUY EXT C.TRN THE TURN ON STRING EXT C.TTY THE TERMINAL EXT C.RP ID FINDER EXT CLO.C THE LIBRARY CLOSE ROUTINE EXT INDC. INDIRECT CLEANER EXT FCB1. FCB1'S PLACE IN THE TURN ON STRING EXT FCB2. FCB1'S PLACE IN THE TURN ON STRING EXT C.HLK THE FCB LINKED LIST HEAD EXT C.PAS THE PARAMETER PASSING BUFFER * PROC RUN.C(FCB1,FCB2,ID,PRAM); * STRING ID; * INTEGER ARRAY PRAM; * COMMENT PRAM IS A 5 WORD ARRAY USED TO PASS USER DATA BETWEEN * THE FATHER AND SON PROCESSES; * RECORD FCB1,FCB2; * BEGIN A EQU 0 B EQU 1 .FCB1 DEF FCB1. .FCB2 DEF FCB2. FCB1P BSS 1 LOCAL POINTER SET UP TO POINT TO FCB1 FCB2P BSS 1 LOCAL POINTER SET UP TO POINT TO FCB2 .CHLK DEF C.HLK .PRAM BSS 1 .CPAS DEF C.PAS D5 DEC 5 D25 DEC 25 D112 DEC 112 B77 OCT 77 .SKED DEC 23 SCRFG BSS 1 ùU������þú THE SCRATCH FILE FLAG DUPFG BSS 1 THE DUPPED ID FLAG\TEMP STORAGE RUN.C BSS 1 * MOVE FCB1 TO FCB1. FOR 25 WORDS; LDB RUN.C JSB INDC. GET THE FROM ADDRESS AND CLEAR OFF INDIRECTS STB FCB1P SAVE FOR LATER USE LDA B ADA =D2 LDB .FCB1 GET THE TO ADDRESS AND CLEAR OFF INDIRECTS JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW MOVE IT DEF D25 NOP * MOVE FCB2 TO FCB2. FOR 25 WORDS; ISZ RUN.C LDB RUN.C JSB INDC. STB FCB2P (WILL FIX C.#SC LATER) LDA B ADA =D2 LDB .FCB2 JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW MOVE IT DEF D25 NOP * IF FCB1 = SYSSRATCH THEN LDB FCB1P ADB =D7 LDA B,I STA SCRFG SAVE IT FOR LATER USE SZA JMP CLOSE * UNLINK(FCB1); LDA .CHLK NEXT LDB A,I SZA,RSS JMP CLOSE CPB FCB1P JMP FOUND LDA B JMP NEXT GO AROUND AGAIN FOUND LDB B,I STB A,I * CLOSE ALL_LINKED_FCB'S; CLOSE LDA C.HLK SZA,RSS JMP SKED STA CLOSF JSB CLO.C CLOSF BSS 1 JMP *+2 JMP CLOSE ISZ RUN.C JMP EXIT * COPY C.#SC FROM OLD FCB2 TO NEW ONE. SKED LDA FCB2P GET IT. ADA =D6 LDA A,I STA FCB2.+4 PUT IN NEW. * MOVE_THE_USERS_PARAMETERS_DOWN; ISZ RUN.C LDB RUN.C JSB INDC. STB ID ISZ RUN.C LDB RUN.C JSB INDC. STB .PRAM LDA B LDB .CPAS JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW DEF D5 NOP * GET-ID-FOUND LDA C.TTY+2 AND B77 STA DUPFG JSB LUTRU DEF *+2 DEF DUPFG LDB ID JSB C.RP JMP EXIT NO ERROR RETURN STA DUPFG STB ID * †ë����� SCHEDULE(ID,PRAMLIST); JSB EXEC DEF *+9+1 DEF .SKED ID BSS 1 DEF C.PAS DEF C.PAS+1 DEF C.PAS+2 DEF C.PAS+3 DEF C.PAS+4 DEF C.TRN DEF D112 * IF ERROR THEN GO ERROR EXIT; * PICKUP THE RETURN PARAMETERS AND STORE THEM INTO PRAM; LDA B LDB .PRAM JSB .MVW DEF D5 NOP LDA DUPFG * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-CORRECTS SESSION 'RP' PROBLEM * SZA,RSS * *THAT'S IT! * JMP EXIT LDB ID CLA JSB C.RP DELETE ID NOP NO ERROR RETURN EXIT ISZ RUN.C * IF FCB1 = SYSSCRATCH THEN LDA SCRFG SZA JMP RUN.C,I * LINK_IT_BACK_IN; LDA FCB1P STA C.HLK CLA STA FCB1P,I JMP RUN.C,I END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������[N������ÿÿ����� ���� ÿý�²�º ���������ÿ��92067-18481 2013� S C0122 �&LUSES � � � � � � � � � � � � � �H0101 œ�����þúASMB,R,L,C,Q HED LUSES * NAME: LUSES * SOURCE: 92067-18481 * RELPC: 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LUSES,7 92067-1X481 REV.2013 790122 * ENT LUSES EXT $SHED,$SMST,$SMLK * * * * PURPOSE: TO DETERMINE IF A SESSION CONTROL BLOCK EXISTS * FOR A SPECIFIED SESSION TERMINAL. * * * * CALLING SEQUENCE: JSB LUSES * DEF *+2 * DEF LU * * * RETURNS: (A)=0 IF SESSION CONTROL BLOCK NOT FOUND. * (A)=ADDRESS OF SST LENGTH WORD OF REQUESTED * SESSION CONTROL BLOCK IF FOUND. * * * (B)= UNDEFINED SPC 5 LUSES NOP ISZ LUSES ADVANCE TO IDENTIFIER LDA LUSES,I AND FETCH IT'S ADDRESS ISZ LUSES ADVANCE TO RETURN POINT LDA A,I FETCH AND STA IDENT SAVE IDENTIFIER * LDA $SHED FETCH HEAD OF SCB LIST * *****FUTURE PTN TABLE WORK GOES HERE * --GO PRIV AND SET UP MAP * NEXT SZA,RSS END OF LIST? JMP LUSES,I YES--RTN (A)=0 * LDB A MOVE SCB ADDR TO B LDA $SMST FETCH OFFSET TO IDENT ADA B ADVANCE TO IT XLA A,I THEN FETCH IT AND B377 ISOLATE IT CPA IDENT THIS THE ONE WERE LOOKING FOR ? JMP MATCH YES-- * XLA B,I NO-- FETCH NEXT SCB OR END JMP NEXT CONTINUE SCAN * MATCH LDA $SMLK GET NEG LENGTH TO LINK WORD(FROM SST LEN) CMA,INA SET IT POSITIVE ADA B MOVEö��� ��  SCB POINTER TO SST LENGTH WORD JMP LUSES,I AND RETURN * IDENT NOP B377 OCT 377 A EQU 0 B EQU 1 END ������������������������������������������������������������������������������������������������������������������������uL ������ÿÿ����� ���� ÿý�³�º ���������ÿ��92067-18482 1903� S C0122 �&VSCBA � � � � � � � � � � � � � �H0101 {�����þúASMB,R,L,C,Q * NAME: VSCBA * SOURCE: 92067-18482 * RELPC: 92067-16261 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM VSCBA,6 92067-16261 REV.1903 790202 * ENT VSCBA * EXT $SHED,ISMVE,$SMLK,.ZPRV * * * VSCBA NOP JSB .ZPRV GO PRIV IF IN SYS LIB DEF LIBX DLD VSCBA,I FETCH RETURN STA VSCBA ADDRESS AND SAVE FOR EXIT * LDB B,I FETCH TEST ADDRESS * LDA $SMLK SET OFFSET TO ADA B ADJUST TEST ADDRESS STA SCBAD AND SAVE * LDA $SHED FETCH HEAD OF SCB LIST * NEXT SZA,RSS CHECK FOR END OF LIST JMP LIBX END OF LIST-- NO MATCH (RETURNS A=0) * STA TEMP0 SAVE LOCATION OF THIS SCB * JSB ISMVE DEF V.2 DEF TEMP0 READ FROM LOCATION DEFINED BY TEMP0 DEF NOP WITH A ZERO OFFSET DEF TEMP1 PUT IT HERE DEF .4 MOVE 4 WORDS V.2 EQU * * LDA TEMP4 PRE-FETCH POSSIBLE ID AND B377 ISOLATE SESSION ID LDB TEMP0 IS THIS THE CPB SCBAD REQUESTED SCB ? JMP LIBX YES-- RETURN A= SESSION IDENTIFIER * LDA TEMP1 FETCH LINK TO NEXT SCB JMP NEXT GO GET IT * LIBX JMP VSCBA,I DEF VSCBA * TEMP0 NOP * * DO NOT CHANGE THE ORDER OF THE FOLLOWING: TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP * * DO NOT CHANGE THE ORDER OF THE ABOVE TEMPS * B EQU 1 NOP NOP SCBAD NOP .4 DEC 4 B377 OCT 377 * END ��������������������������������������������������eà��� ���� �������� �������ÿÿ����� ���� ÿý�´�» ���������ÿ��92067-18483 2013� S C0122 �&$SMVE � � � � � � � � � � � � � �H0101 ’`�����þúASMB,R,L,C,Q ** SCB READ\WRITE MODULE ** HED SCB READ \ WRITE MODULE * NAME: $SMVE * SOURCE: 92067-18483 * RELOC: PART OF 92067-16268 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $SMVE,6 92067-1X483 REV.2013 800129 * * ******************************************************************** * * ******************************************************************** * * $SMVE ENTRY POINT NAMES * ENT $SMVE,ISMVE * * $SMVE EXTERNAL REFERENCE NAMES * EXT .ENTR,$LIBR,$LIBX * ******************************************************************** * * NOTE: THIS ROUTINE IS PRIVLEGED FOR READS AND WRITES SO * IT COULD OPERATE IN THE MEMORY RESIDENT LIBRARY. * NOTE THAT READS WOULD OTHERWISE BE DONE NON-PRIVLEGED. * * * * * PURPOSE: TO READ OR WRITE FROM/TO A SESSION CONTROL BLOCK WHICH * MIGHT NOT BE IN SAM. * * * CALLING SEQUENCE: READ ONLY -- ISMVE -- * * CALL ISMVE(IADDR,IOFF,IBUF,LEN) * * WHERE: IADDR= LOCATION TO READ FROM. * IOFF = OFFSET FOR ABOVE LOCATION. * IBUF = LOCATION TO READ INTO. * LEN = NUMBER OF WORDS TO TRANSFER. * * * READ OR WRITE -- $ISMVE -- * * JSB $SMVE * DEF RTN * DEF RW * DEF IADDR * DEF IOFF * DEF IBUF * DEF LEN * * * * WHERE: RW=1=READ/2=WRITE * IADDb§������þúR=READ/WRITE FROM\TO HERE * IOFF =SAME AS ABOVE * IBUF =USER BUFFER TO READ TO/ WRITE FROM * LEN =SAME AS ABOVE * * SKP ISMVE NOP JSB $LIBR NOP LDA DADDR FETCH NEW ADDR FOR .ENTR STA WHR LDA DF1 DETCH ADDRESS OF .1 STA RW FORCE READ ONLY LDA ISMVE JMP SM.1 * $SMVE NOP JSB $LIBR NOP LDA DRW FETCH ADDR OF FULL PARM LIST STA WHR LDA $SMVE SM.1 STA DENT JMP DENT+1 SPC 5 DADDR DEF ADDR DRW DEF RW DF1 DEF .1 .1 DEC 1 RW NOP ADDR NOP OFF NOP BUF NOP NUM DEF ZERO * DENT NOP JSB .ENTR FETCH CALL WHR DEF RW PARAMETERS * LDA NUM MUST HAVE FIVE CPA DZERO PARAMETERS OR JMP DENT,I REJECT THE CALL * * * THIS IS WHERE ANY TABLE PARTITION WORK MUST BE DONE * * STX ISMVE SAVE XREG LDA ADDR,I FETCH SCB ADDRESS ADA OFF,I ADD OFFSET * LDB RW,I FETCH READ \ WRITE CODE SLB IF A READ REQUEST JMP READ GO DO IT * * WRITE REQUEST * * * * STA TO SAVE SCB ADDR AS "TO" ADDR * LDA BUF FETCH "FROM" ADDRESS LDB TO FETCH "TO" ADDRESS LDX NUM,I FETCH MOVE LENGTH * MWI MOVE WORDS INTO ALT MAP * JMP EXIT * * READ LDB BUF FETCH "FROM" ADDRESS LDX NUM,I FETCH LENGTH * MWF MOVE WORDS FROM ALT MAP * EXIT LDA DZERO STA NUM RESET FOR PARM CHECK LDX ISMVE RESTORE X REG. JSB $LIBX EXIT DEF DENT * TO NOP DZERO DEF ZERO ZERO NOP END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������~@�������� ������������� �������ÿÿ����� ���� ÿý�µ�½ ���������ÿ��92067-18484 2013� S C0122 �&PTERR � � � � � � � � � � � � � �H0101 ‘�����ASMB,R,L,C HED PTERR * NAME: PTERR * SOURCE: 92067-18484 * RELO: 92067-16268 * PGMR: N.J.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * **************************************************************** * NAM PTERR,7 92067-1X484 REV.2013 781013 ENT PTERR EXT .ENTR, SESSN, $SMVE, $SMER SUP * * INMIC NOP IERR DEF ZERO PTERR NOP JSB .ENTR DEF INMIC * JSB SESSN GET SESSION TABLE ADDRESS DEF *+2 DEF XEQT CCA SEZ IN SESSION? JMP EXIT NO - GO SET ERROR TO -1 STB ISESN * JSB $SMVE WRITE 4-WORD MNEUMONIC DEF *+6 IN SCB ERROR CODE DEF .2 DEF ISESN DEF $SMER DEF INMIC,I DEF .4 CLA * EXIT STA IERR,I SET ERROR CODE LDA D.ZER RESET OPTIONAL STA IERR ERROR PARAMETER JMP PTERR,I * XEQT EQU 1717B ZERO DEC 0 .2 DEC 2 .4 DEC 4 ISESN NOP D.ZER DEF ZERO * * END END ��������������������������������������������������������������������������������������������������������������������������������������������������������P°������ÿÿ����� ���� ÿý�¶�¼ ���������ÿ��92067-18485 2013� S C0122 �>ERR � � � � � � � � � � � � � �H0101 ‘ˆ�����ASMB,R,L,C HED GTERR * NAME: GTERR * SOURCE: 92067-18485 * RELO: 92067-16268 * PGMR: N.J.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * **************************************************************** * NAM GTERR,7 92067-1X485 REV.2013 780930 ENT GTERR EXT .ENTR, SESSN, ISMVE, $SMER SUP * * INMIC NOP IERR DEF ZERO GTERR NOP JSB .ENTR DEF INMIC * JSB SESSN GET SESSION TABLE ADDRESS DEF *+2 DEF XEQT CCA SEZ IN SESSION? JMP EXIT NO - GO SET ERROR TO -1 STB ISESN * JSB ISMVE WRITE 4-WORD MNEUMONIC DEF *+5 IN SCB ERROR CODE DEF ISESN DEF $SMER DEF INMIC,I DEF .4 CLA * EXIT STA IERR,I SET ERROR CODE LDA D.ZER RESET OPTIONAL STA IERR ERROR PARAMETER JMP GTERR,I * XEQT EQU 1717B ZERO DEC 0 .4 DEC 4 ISESN NOP D.ZER DEF ZERO * * END END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������§������ÿÿ����� ���� ÿý�·�½ ���������ÿ��92067-18486 2040� S C0122 �&AN425 �7925 GFR ANSWER FILE � � � � � � � � � � � � �H0101 ¨Ÿ�����þú&LIS25::10 ***LIST FILE NAME ** ANSWER FILE &AN425 92067-18486 2040 RTE4B 7925 801001 YES *ECHO ON !SYS25::10::4000 ***SYSTEM FILE - STORED ON LU 10 7925 *SYSTEM DISC TYPE: 7925 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 7925,256,0,0,2,0,8 *SUBCHANNEL 0 7925,256,0,2,2,0,8 *SUBCHANNEL 1 7925,256,0,4,4,0,8 *SUBCHANNEL 2 7925,256,66,4,4,0,8 *SUBCHANNEL 3 7925,203,132,0,4,0,5 *SUBCHANNEL 4 7925,203,132,4,4,0,5 *SUBCHANNEL 5 7925,203,184,0,4,0,5 *SUBCHANNEL 6 7925,203,184,4,4,0,5 *SUBCHANNEL 7 7925,228,0,8,1,0,8 *SUBCHANNEL 8 7925,400,236,0,9,0,14 *SUBCHANNEL 9 7925,400,282,0,9,0,14 *SUBCHANNEL 10 7925,228,328,0,9,0,6 *SUBCHANNEL 11 7925,1024,354,0,9,0,29 *SUBCHANNEL 12 7925,1024,471,0,9,0,29 *SUBCHANNEL 13 7925,2048,588,0,9,0,67 *SUBCHANNEL 14 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 64 *MEMORY SIZE !BOO25::10 ***BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IVB OPERATING SYSTEM * REL,%CR4S1::32767 ¼������þúREL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * REL,%DVR00::32767 *TTY/PUNCH/PHOTOREADER DVR REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%4DV05::32767 *2644/45 DRIVER (WITH CTU) REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVB12::32767 *2608 LINE PRINTER DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR32::32767 *7905/06/20/25 DISC DRIVER REL,%DVA32::32767 *7906H/20H/25H/9895 DISC DRIVER REL,%$TA32::32767 *7906H/20H/25H/9895 AUX TRACK MAP * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *CURRENT PAGE LINKING LOADER REL,$LDRLB::32767 *LOADER LIBRARY REL,%WHZAT::32767 *WHZAT REL,%BMPG1::32767 *FILE MANAGER REL,%BMPG2::32767 *D.RTR DIRECTORY MGR REL,%RT4GN::32767 *GENERATOR REL,%SSTCH::32767 *SWITCH PROGRAM REL,%FORMT::32767 *MAC/ICD DISC INITIALIZATION PROGRAM REL,%LSAVE::32767 *MAC/ICD DISC LU SAVE PROGRAM REL,%USAVE::32767 *MAC/ICD DISC UNIT SAVE PROGRAM REL,%LCOPY::32767 *MAC/ICD DISC COPY PROGRAM REL,%RESTR::32767 *MAC/ICD DISC RESTORE PROGRAM REL,%HELP ::32767 *HELP PROGRAM REL,%SMON1::3276±������þú7 *SESSION MONITOR SOFTWARE REL,%SMON2::32767 *SESSION MONITOR SOFTWARE * ********************** LIBRARIES * REL,$DSCLB::32767 *DISC DRIVER LIBRARY REL,$DKULB::32767 *DISC BACKUP LIBRARY REL,%DBKLB::32767 *7900 DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%BMPG3::32767 *BATCH LIBRARY REL,%UTLIB::32767 *UTILITIES LIBRARY REL,$MLIB1::32767 *SYSTEM INDEPENDENT LIBRARY PT.1 REL,$MLIB2::32767 *SYSTEM INDEPENDENT LIBRARY PT.2 * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * FORMT,4 SWTCH,4 RT4GN,4 LCOPY,4 D.RTR,3,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * *.MPY,RP,100200 *.DIV,RP,100400 *.DLD,RP,104200 *.DST,RP,104400 *.MVW,RP,105777 Z$DBL,RP,3 *3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 *** ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR32,D *EQT # 1 - 7925 DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSO7������þúLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER 23,DVB12,B,X=5 *EQT # 9 - 2608 LINE PRINTER 24,DVA32,D,T=200 *EQT #10 - 7906H/20H/25H/9895 DISC /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7925 SUBCHANNEL 1 1,2 *LU # 11 - 7925 SUBCHANNEL 2 1,3 *LU # 12 - 7925 SUBCHANNEL 3 1,4 *LU # 13 - 7925 SUBCHANNEL 4 1,5 *LU # 14 - 7925 SUBCHANNEL 5 1,6 *LU # 15 - 7925 SUBCHANNEL 6 1,7 *LU # 16 - 7925 SUBCHANNEL 7 1,8 *LU # 17 - 7925 SUBCHANNEL 8 1,9 *LU # 18 - 7925 SUBCHANNEL 9 1,10 *LU # 19 - 7925 SUBCHANNEL 10 1,11 *LU # 20 - 7925 SUBCHANNEL 11 1,12 *LU # 21 - 7925 SUBCHANNEL 12 1,13 *LU # 22 - 7925 SUBCHANNEL 13 1,14 *LU # 23 - 7925 SUBCHANNEL 14 4,4 *LU # 24 - PUNCH 5,0 *LU # 25 - 2767 LINE PRINTER 9,0 *LU # 26 - 2608 LINE PRINTER 10,0 *­/�����LU # 27 - 7906H/20H/25H/9895 DISC LU * ***DISC SUBCHANNEL 00 OF $TA32 /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,PRG,PRMPT 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 24,EQT,10 25,EQT,9 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 14,BG 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,20 RT4GN,20 FORMT,17 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT ������������������������Š}������ÿÿ����� ���� ÿý�¸�  ���������ÿ��92067-18487 2040� S C0122 �&AF25H �7925H GFR ANSWER FILE � � � � � � � � � � � � �H0101 ÝŸ�����þú&LI25H::10 ***LIST FILE NAME ** ANSWER FILE &AF25H 92067-18487 2040 RTE4B 7925H 801001 YES *ECHO ON !SY25H::10::4000 ***SYSTEM FILE - STORED ON LU 10 7925H *SYSTEM DISC TYPE: 7925H 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 7925H,256,0,0,2,0,8 *SUBCHANNEL 0 7925H,256,0,2,2,0,8 *SUBCHANNEL 1 7925H,256,0,4,4,0,8 *SUBCHANNEL 2 7925H,256,66,4,4,0,8 *SUBCHANNEL 3 7925H,203,132,0,4,0,5 *SUBCHANNEL 4 7925H,203,132,4,4,0,5 *SUBCHANNEL 5 7925H,203,184,0,4,0,5 *SUBCHANNEL 6 7925H,203,184,4,4,0,5 *SUBCHANNEL 7 7925H,228,0,8,1,0,8 *SUBCHANNEL 8 7925H,400,236,0,9,0,14 *SUBCHANNEL 9 7925H,400,282,0,9,0,14 *SUBCHANNEL 10 7925H,228,328,0,9,0,6 *SUBCHANNEL 11 7925H,1024,354,0,9,0,29 *SUBCHANNEL 12 7925H,1024,471,0,9,0,29 *SUBCHANNEL 13 7925H,2048,588,0,9,0,67 *SUBCHANNEL 14 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 64 *MEMORY SIZE !BO25H::10 ***BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IVB OPERATING SYSTEM * REL,%CR4pj������þúS1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * REL,%DVR00::32767 *TTY/PUNCH/PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH CTU) REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR12::32767 *2767A LINE PRINTER DRIVER REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR32::32767 *7905/06/20/25 DISC DRIVER REL,%$TB32::32767 *7906H/20H/25H/9895 AUX TRACK MAP REL,%DVA32::32767 *7906H/20H/25H/9895 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *CURRENT PAGE LINKING LOADER REL,$LDRLB::32767 *LOADER LIBRARY REL,%WHZAT::32767 *WHZAT REL,%BMPG1::32767 *FILE MANAGER REL,%BMPG2::32767 *D.RTR DIRECTORY MGR REL,%RT4GN::32767 *GENERATOR REL,%SSTCH::32767 *SWITCH PROGRAM REL,%FORMT::32767 *MAC/ICD DISC INITIALIZATION PROGRAM REL,%LSAVE::32767 *MAC/ICD DISC LU SAVE PROGRAM REL,%USAVE::32767 *MAC/ICD DISC UNIT SAVE PROGRAM REL,%LCOPY::32767 *MAC/ICD DISC COPY PROGRAM REL,%RESTR::32767 *MAC/ICD DISC RESTORE PROGRAM REL,%HELP ::32767 *HELP PROGRAM REL,%SMON1::32767 *SESSION MONITOR SOFTWARE Hª������þúREL,%SMON2::32767 *SESSION MONITOR SOFTWARE * ********************** LIBRARIES * REL,$DSCLB::32767 *DISC DRIVER LIBRARY REL,$DKULB::32767 *DISC BACKUP LIBRARY REL,%DBKLB::32767 *7900 DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%BMPG3::32767 *BATCH LIBRARY REL,%UTLIB::32767 *UTILITIES LIBRARY REL,$MLIB1::32767 *SYSTEM INDEPENDENT LIBRARY PT.1 REL,$MLIB2::32767 *SYSTEM INDEPENDENT LIBRARY PT.2 * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * FORMT,4 SWTCH,4 RT4GN,4 LCOPY,4 D.RTR,3,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 Z$DBL,RP,3 *3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 *** ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVA32,D,T=200 *EQT # 1 - 7925H DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - ¦¤������þúPHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER 25,,DVB12,B,X=15 *EQT # 9 - 2608 LINE PRINTER 24,DVR32,D *EQT #10 - 7905/06/20/25 DISC /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7925H SUBCHANNEL 1 1,2 *LU # 11 - 7925H SUBCHANNEL 2 1,3 *LU # 12 - 7925H SUBCHANNEL 3 1,4 *LU # 13 - 7925H SUBCHANNEL 4 1,5 *LU # 14 - 7925H SUBCHANNEL 5 1,6 *LU # 15 - 7925H SUBCHANNEL 6 1,7 *LU # 16 - 7925H SUBCHANNEL 7 1,8 *LU # 17 - 7925H SUBCHANNEL 8 1,9 *LU # 18 - 7925H SUBCHANNEL 9 1,10 *LU # 19 - 7925H SUBCHANNEL 10 1,11 *LU # 20 - 7925H SUBCHANNEL 11 1,12 *LU # 21 - 7925H SUBCHANNEL 12 1,13 *LU # 22 - 7925H SUBCHANNEL 13 1,14 *LU # 23 - 7925H SUBCHANNEL 14 4,4 *LU # 24 - PUNCH 5,0 *LU # 25 - 2767 LINE PRINTER 9,0 *LU # 26 - 2608 LINE PRINTER 10,0 *LU # 27 - 7905/06/20/25 DISC LU * H2����� *** DISC SUBCHANNEL 00 OF $TB32 /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,PRG,PRMPT 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 24,EQT,9 25,EQT,10 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 14,BG 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,20 RT4GN,20 FORMT,17 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT ����������������������������������������������������������������������������Ô������ÿÿ����� ���� ÿý�¹� à ���������ÿ��92067-18488 2013� S C0122 �&G1CUP �GASP UP COMMAND � � � � � � � � � � � � �H0101 ””�����þúASMB,Q,C G1CUP UP OUTSPOOL EQT'S HED G1CUP UP OUTSPOOL EQT'S * NAME: G1CUP * SOURCE: 92067-18488 * RELOC: 92067-16425 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CUP,8 92067-16425 REV.2013 800102 * ENT G1CUP * EXT .ENTR,$CVT3,G1OLK,MESSS,$SMLK,RNRQ EXT G0DCB,G0BUF,G0WD1,G0WD2,G0WD6,G0W10,G0W15 EXT G0SPF,G0JRN EXT READF,WRITF,POST EXT EXEC,XLUEX * A EQU 0 B EQU 1 XEQT EQU 1717B DRT EQU 1652B SUP * PBUF NOP PLEN NOP IERR NOP * G1CUP NOP JSB .ENTR FETCH PARAMETERS DEF PBUF LDA PBUF PARSE BUFFER ADDRESS ADA D4 POINT TO SECOND PARAMETER LDB A,I SZB,RSS NULL? JMP SETRS YES, THEN OK * CPB D2 ASCII? INA,RSS YES JMP ILLPM NO, THEN ILLEGAL PARM * LDB A,I GET THE FIRST TWO CHARS CPB RS IS IT RS? JMP SETRS YES * ILLPM LDA D56 ILLEGAL PARAMETER JMP EXIT * D2 DEC 2 D4 DEC 4 D6 DEC 6 D9 DEC 9 D56 DEC 56 RS ASC 1,RS RSFLG NOP AG0W6 DEF G0WD6+0 TO GET A DIRECT ADDRESS TEMP NOP MSIGN OCT 100000 * SETRS STB RSFLG 0 IF RS NOT SPECIFIED JSB G1OLK OPEN SPLCON FILE AND LOCK RN DEF G0SPF SPLCON FILE NAME JMP EXIT ERROR FOUND * CLA,INA READ THE FIRST SPLCON RECORD JSB RDREC LDA AG0W6 LIST OF OUTSPOOL LU'S - SOURCE ADDRESS LDB PBUF DESTINATION ADDRESS INB STB PLEN SAVE POINTER TO LIST OF óA������þúOUTLU'S MVW G0WD2 # OF OUTSPOOL LU'S NOP LDA G0WD2 SAVE # OF OUTSPOOL LU'S CMA,INA,SZA,RSS 0? JMP EXIT YES, THEN RETURN * STA PBUF,I USE AS COUNTER LDA D9 START OF OUTSPOOL QUEUE RECORDS STA QREC SAVE UPLP LDA QREC READ THE RECORD OF FIRST QUEUE JSB RDREC LDA G0WD1 # OF ENTRIES IN QUEUE FOR THIS SZA,RSS OUTSPOOL LU JMP NXTLU NO QUEUE, CHECK NEXT OUTLU * LDA G0WD2 SPLCON REC# OF FIRST ENTRY IN QUEUE STA RNUM SAVE REC # JSB RDREC LDA G0W10 GET CURRENT STATUS OF SPOOL FILE STA OSTAT SAVE OLD STATUS CPA "A" ACTIVE? RSS YES CPA "AH" ACTIVE HOLD? RSS YES JMP NXTLU NO, GET NEXT OUTLU * LDA PLEN,I GET THE LU # IOR MSIGN SET SIGN BIT TO AVOID SST TRANSLATION STA TEMP JSB XLUEX GET STATUS OF OUTSPOOL LU DEF *+6 DEF D13 STATUS REQUEST DEF TEMP OUTSPOOL LU WITH SIGN BIT SET DEF ISTA1 EQT 5 WORD DEF ISTA2 EQT 4 WORD DEF ISTA3 STATUS OF LU LDA ISTA3 GET LU STATUS SSA,RSS DOWN? JMP NXTLU NO, THEN CHECK NEXT OUTLU * LDA DRT EQT IS DOWN, FIND EQT # ADA PLEN,I ADA M1 POINT TO DRT ENTRY FOR OUTLU LDA A,I AND B77 MASK EQT # CCE CONVERT TO ASCII DECIMAL JSB $CVT3 ADA D2 POINT TO LAST 2 DIGITS LDA A,I STA UPMSG+2 SET UP "UP, EQ" MESSAGE LDA XEQT GET THE ID SEGMENT ADDRESS OF THIS PROG ADA D32 POINT TO WORD 33 OF ID SEG LDA A,I SZA,RSS IN SESSION? JMP MESS NO, THEN NO OVERRIDES REQUIRED * ADA $SMLK OFFSET TO THE LINK WORD CMA,INA NEGATIVE SCB ADDRESS STA ISTA1 USED AS OVERRIDE FOR CAPABILITY CHECK JSB Õ������þúMESSS SEND UP,EQT# COMMAND TO THE OP SYSTEM DEF *+5 DEF UPMSG DEF D6 # OF CHARS DEF ZERO DEF ISTA1 -(SCB ADDRESS) JMP RELSE * MESS JSB MESSS OUTSIDE OF SESSION DEF *+3 SEND UP,EQT# COMMAND DEF UPMSG DEF D6 * RELSE LDB RSFLG RESTART SPECIFIED? SZB JMP DORS YES * DOCS LDA "A" JUST RELEASE THE SPOOL FILE CCB JMP STATS * DORS LDA G0W10 GET STATUS OF SPOOL FILE CPA "AH" ACTIVE HELD? JMP SETW YES THEN SET STATUS TO WAIT * LDA "AH" STATUS IS ACTIVE, SET TO ACTIVE HOLD STA G0W10 JSB WRULK WRITE SPLCON REC AND UNLOCK RN JSB EXEC SCHEDULE SMP TO SET HOLD DEF *+8 DEF S23 DEF ISMP DEF D14 DEF RNUM RECORD # DEF G0W15 OUTSPOOL LU DEF ZERO DEF OSTAT OLD STATUS OF SPOOL FILE * JMP NOSMP SMP CANNOT BE SCHEDULED * LDA "AH" NOW SET THE OLD STATUS TO ACTIVE HOLD STA OSTAT JSB RNRQ LOCK RN# DEF *+4 DEF D1 DEF G0JRN DEF ISTA1 LDA RNUM GET SPLCON REC # FOR SPOOL FILE JSB RDREC READ RECORD * SETW LDA "W" RESTART SO SET TO WAIT STATUS CLB STATS STA G0W10 SET NEW STATUS STB TEMP JSB WRULK WRITE REC AND UNLOCK SPLCON CLSMP JSB EXEC SCHEDULE SMP TO RELEASE A HOLD DEF *+8 DEF S23 =100027B -- NO ABORT DEF ISMP DEF D15 RELEASE A HOLD DEF RNUM SPLCON RECORD # DEF G0W15 OLD OUTSPOOL LU DEF TEMP DEF OSTAT OLD STATUS OF SPOOL FILE * JMP NOSMP SMP CANNOT BE SCHEDULED * JSB RNRQ LOCK RN FOR NEXT LU DEF *+4 DEF D1 DEF G0JRN DEF ISTA1 NXTLU LDA QREC GET QUEUE RECORD # ADA D8 POINT TO NEXT QUEUE STA QREC ISZ PLEN POINúz������þúT TO NEXT OUTSPOOL LU ISZ PBUF,I INCREMENT NEGATIVE # OF OUTLU'S JMP UPLP * CLA,RSS * NOSMP LDA M48 SMP CANNOT BE SCHEDULED EXIT STA IERR,I SET ERROR RETURN JSB UNLOK UNLOCK RN AND POST DCB * JMP G1CUP,I RETURN * * QREC NOP RNUM NOP OSTAT NOP ISTA1 NOP ISTA2 NOP ISTA3 NOP D1 DEC 1 D8 DEC 8 D13 DEC 13 D14 DEC 14 D15 DEC 15 D32 DEC 32 S23 OCT 100027 M1 DEC -1 M48 DEC -48 B77 OCT 77 ZERO DEC 0 ISMP ASC 3,SMP "A" OCT 101 "AH" ASC 1,AH "W" OCT 127 UPMSG ASC 3,UP, XX * * SKP HED G1CUP (WRULK,RDREC SUBROUTINES) * * WRULK - ROUTINE TO WRITE A SPLCON RECORD AND UNLOCK * RN FOR SPLCON FILE * CALLING SEQUENCE: JSB WRULK * * WRULK NOP JSB WRITF WRITE UPDATED RECORD BACK DEF *+6 DEF G0DCB DEF IERR,I DEF G0BUF DEF D16 DEF RNUM SPLCON RECORD # SSA ERROR? JMP EXIT YES * JSB UNLOK POST DCB AND UNLOCK RN JMP WRULK,I RETURN * D16 DEC 16 * * * UNLOK - ROUTINE POSTS THE DCB AND UNLOCKS THE RN NUMBER * CALLING SEQUENCE: JSB UNLOK * * UNLOK NOP JSB POST POST THE DCB DEF *+2 DEF G0DCB * JSB RNRQ UNLOCK RN DEF *+4 DEF NABT4 =40004B DEF G0JRN DEF ISTA1 RN STATUS NOP *************************** JMP UNLOK,I RETURN * NABT4 OCT 40004 * * RDREC - ROUTINE TO READ A RECORD FROM SPLCON FILE * CALLING SEQUENCE: A REG = SPLCON RECORD # * JSB RDREC * * RDREC NOP STA ISTA2 JSB READF READ A RECORD FROM FILE CURRENTLY DEF *+7 OPEN DEF G0DCB DEF IERR,I DEF G0BUF DEF D16 DEF ISTA3 DEF ISTA2 RECORD # TO READ SSA ERROR? JMP EXIT YES * JMP RDREC,I RETURN * * END �������� ���������������������� "�������ÿÿ����� ���� ÿý�º� Ä ���������ÿ��92067-18489 2026� S C0122 �"HELPA � � � � � � � � � � � � � �H0101 ‚�����þúREAD 011 READT REJECTED THE SIZE (NUMBER OF TRACKS) YOU SPECIFIED BECAUSE IT'S OF A BAD FORMAT (E.G. NEGATIVE VALUE) OR THE SIZE REQUESTED IS NOT LARGE ENOUGH TO RESTORE THE CARTRIDGE ON MAG TAPE. "" READ 012 THE ROUTINE READT USES TO MOUNT A CARTRIDGE DETECTED AN ERROR. THIS ERROR IS RETURNED IN THE FMGR FORMAT. THE FOLLOWING ARE POSSILBE ERROR CONDITIONS. FIND THE ONE THAT APPLYS TO YOU AN DO AS SUGGESTED. FMGR 012 DUPLICATE LABEL OR CRN ALREADY MOUNTED. HAVE THAT DISC OR CRN REMOVED THEN RUN READT AGAIN. FMGR 056 THE SIZE REQUESTED IS TOO LARGE FOR THE DISC LU SPECIFIED. RUN READT AGAIN WITH A SMALLER SIZE PARAMTER. FMGR 063 YOU CURRENTLY HAVE MOUNTED THE MAXIMUM NUMBER OF DISC CARTRIDGES IN YOUR SESSION. REMOVE ONE AND RUN READT AGAIN. FMGR 064 THERE ARE PRESENTLY NO MORE FREE DISC LUS IN THE DISC POOL. HAVE SOMEONE RELEASE A CARTRIDGE THAT THEY ARE NOT CURRENTLY USING. FMGR 065 THERE IS A CONFLICT IN SST DEFINITION. YOU ARE TRYING TO MOUNT A DISC LU THAT HAS A SESSION LU NUMBER ASSIGNED TO TO SOME OTHER DEVICE. CHECK YOUR SST AND FIND OUT TO WHAT LU THAT NUMBER IS ASSIGNED, THEN CHANGE IT OR CHOOSE ANOTHER DISC LU. FMGR 066 THERE IS NO MORE ROOM IN YOUR SST TO PLACE AN ENTRY. REMOVE AN ENTRY FROM YOUR SST IF POSSIBLE. IF THAT'S NOT DESIRABLE THEN CALL SYSTEM MANAGER. "" READ 013 THE DESIRED DISC LU OR THE AVAILABLE FREE LUS IN THE DISC POOL ARE NOT LARGE ENOUGH TO RESTORE THE CARTRIDGE THAT'S ON MAG TAPE. "" READ 014 THE FMP TRACKS ON LU 2 OR LU 3 (IF 3 EXISTS) ARE NOT RESTORABLE WITH READT. "" READ 015 BAD TRANSMISSION -- MEMORY TO DISC TRK XXX SEC YYY READT TRIED TO TRANSFER DATA FROM MEMORY TO A DISC LU. DURING THIS PROCESS A CHECK OF THE TRANSMISSION LOG SHOWED AN UNEXPECTED VALUE. RUN READT AGAIN, IF IT HAPPENS ONCE MORE CALL YOUR SYSTEM MANAGER. "" READ 016 BAD TRANSMISSION -- MAG TAPE TO MEMORY R~î������þúEC XXX READT DETECTED AN ERROR IN TRANSMISSION OF DATA FROM THE MAG TAPE UNIT INTO MEMORY. TRY READING THE TAPE AGAIN. IF IT HAPPENS ONCE MORE CALL YOUR SYSTEM MANAGER. "" WRIT 001 THE REQUESTED MAG TAPE UNIT IS DOWN. BY UPPING THE APPROPRIATE EQT THE DEVICE CAN BE ENABLED. "" WRIT 002 ONLY THE SYSTEM MANAGER CAN SAVE SYSTEM DISCS. "" WRIT 003 THE MAG TAPE YOU WISH TO USE IS LOCKED TO SOME PROCESS. FIND OUT WHO CURRENTLY HAS THE MAG TAPE LOCKED (E.G. RU,WHZAT) AND WAIT UNTIL IT'S RELEASED OR HAVE THE USER RELEASE IT FOR YOU. "" WRIT 004 THE PARAMETER DESCRIBING THE DESIRED MAG TAPE UNIT DOES NOT SATISFY READT'S REQUIREMENTS FOR A LEGAL MAG TAPE UNIT. THE POSSIBLE CAUSES FOR THIS ERROR INCLUDE: 1.THE SPECIFIED MAG TAPE LU IS NOT BETWEEN -63 AND +63. 2. THE DRIVER OF THE SPECIFIED LU IS NOT A MAG TAPE DRIVER. "" WRIT 005 THE DESIRED MAG TAPE UNIT IS OFF-LINE. THE ON-LINE BUTTON MUST BE DEPRESSED TO ENABLE THE ON-LINE SWITCH. "" WRIT 006 A WRITE RING IS REQUIRED TO WRITE INFORMATION ON A MAG TAPE. PLACE A WRITE RING ON THE TAPE SPOOL AND RUN WRITT AGAIN. "" WRIT 007 THE DRIVER DETECTED A PARITY ERROR WHEN READING FROM THE MAG TAPE. TRY AGAIN, IF IT OCCURS AGAIN THEN THE TAPE MAY BE IRRECOVERABLE. CALL SYSTEM MANAGER. "" WRIT 008 THE END OF TAPE WAS REACHED. MOUNT THE FOLLOWING TAPE TO WRITE THE REMAINING PORTIONS OF THE CARTRIDGE. TO CONTINUE THE PROGRAM ENTER "GO". TO HALT THE PROCESS ENTER "AB". NOTE HOWEVER THAT A RESPONSE OF AN "AB" WILL PLACE A PARTIALLY COMPLETED CARTRIDGE ON YOUR TAPE. "" WRIT 009 THE DESIRED CARTRIDGE HAS A FILE OPEN OR THE CARTRIDGE IS LOCKED TO ANOTHER PROGRAM. TRY DOING A DL ON THAT CARTRIDGE AND FIND OUT WHAT'S LOCKING THE PROGRAM OR WHAT FILE IS OPEN. "" WRIT 010 THE DESIRED CARTRIDGE OR DISC LU COULD NOT BE FOUND. DO A CL (CARTRIDGE LIST) TO MAKE SURE THAT WHAT YOU'RE SEEKING IS REALLY THERE. "" WRIT 011 WRITT REJECTED THE USE OF THE SPECIFIED DISC LU. THERE ARE A VARIETY OF REA}«������þúSONS FOR THIS, THEY INCLUDE: 1.THE DISC LU NUMBER MUST BE A NEGATIVE NUMBER BUT NO SMALLER THAN -63. 2.THE DESIRED DISC LU IS NOT IN YOUR SST. 3.THE DRIVER TYPE OF THE REQUESTED DISC LU IS NOT A DISC DRIVER. "" WRIT 012 YOU CANNOT SAVE FMP TRACKS OFF LU 2 OR LU 3 (IF 3 EXITS) WITH WRITT. "" WRIT 013 WRITT TRIED TO READ DATA FROM A DISC LU INTO MEMORY AND FOUND THE TRANMISSION IRREGULAR. RUN WRITT AGAIN, IF THE SITUATION OCCURS ONCE MORE THERE MAY BE A BAD TRACK ON THAT DISC LU. SAVE AS MUCH DATA AS YOU CAN AND NOTIFY YOUR SYSTEM MANAGER. "" WRIT 014 THE TRANSMISSION OF DATA FROM MEMORY TO MAG TAPE MAY BE FAULTY. RUN WRITT AGAIN, IF IT HAPPENS ONCE MORE CALL YOUR SYSTEM MANAGER. "" DM MAPPING ERROR. AN ATTEMPT WAS MADE TO READ/WRITE OUTSIDE OF THE MAPPED ADDRESS SPACE. "" MP MEMORY PROTECT ERROR. THE CALL WAS NOT AN EXEC, $L1BR, OR $L1BX CALL. "" RE A RE-ENTRANT SUBROUTINE ATTEMPTED TO CALL ITSELF. "" RQ AN ILLEGAL REQUEST CODE IS SPECIFIED IN AN EXEC CALL. "" TI A BATCH PROGRAM EXCEEDS THE ALLOWED TIME. "" SC00 A BATCH PROGRAM ATTEMPTED TO SUSPEND (EXEC(7)). "" SC01 MISSING PARAMETER. "" SC02 ILLEGAL PARAMETER "" SC03 THE SPECIFIED PROGRAM CANNOT BE SCHEDULED. "" SC04 THE SPECIFIED PROGRAM IS NOT A SUBORDINATE (OR "SON") TO THE PROGRAM ISSUING THE COMPLETION CALL. "" SC05 THE PROGRAM GIVEN IS NOT DEFINED. "" SC06 NO RESOLUTION CODE IS SPECIFIED IN THE EXECUTION TIME EXEC CALL. "" SC07 A PROHIBITED CORE LOCK WAS ATTEMPTED. "" SC08 THE PROGRAM JUST SCHEDULED IS ASSIGNED TO A PARTITION SMALLER THAN THE PROGRAM ITSELF OR TO AN UNDEFINED PARTITION. UNASSIGN THE PROGRAM OR REASSIGN THE PROGRAM TO A PARTITION THAT IS AS LARGE OR LARGER THAN THE PROGRAM. "" SC09 THE PROGRAM JUST SCHEDULED IS TOO LARGE FOR ANY PARTITION OF THE SAME TYPE. FOR EXAMPLE, TRYING TO SCHEDULE A 23K BACKGROUND PROGRAM WHEN THE LARGEST BACKGROUND PARTITION IS ONLY 21K. "" ˆh������þúSC10 THERE IS NOT ENOUGH SYSTEM AVAILABLE MEMORY FOR THE STRING PASSAGE. "" SC11 EXEC SCHEDULE OR TIMED EXECUTION REQUEST WAS ISSUED AND PROGRAM SPECIFIED IS ALREADY IN THE TIME LIST FOR ANOTHER SESSION. "" RN00 THERE ARE NO OPTION BITS SET IN THE CALL. "" RN01 NOT USED "" RN02 THE SPECIFIED RESOURCE NUMBER IS NOT DEFINED. "" RN03 AN UNAUTHORIZED ATTEMPT WAS MADE TO CLEAR A LOCAL RESOURCE NUMBER. "" LU01 A PROGRAM HAS ONE OR MORE LOGICAL UNITS LOCKED AND IS TRYING TO LOCK ANOTHER WITH WAIT. "" LU02 ILLEGAL LOGICAL UNIT REFERENCE. THE LU SPECIFIED IS EITHER 1) ILLEGAL OR NON-EXISTENT FOR THE CURRENT SESSION/SYSTEM CONFIGURATION, OR 2) A DISK LU, BUT THE "DISK ALSO" BIT WAS NOT SET IN THE LU LOCK REQUEST. "" LU03 NOT ENOUGH PARAMETERS ARE FURNISHED IN THE CALL. LOGICAL UNIT REFERENCE LESS THAN ONE. LOGICAL UNIT NOT LOCKED TO CALLER. "" LU04 TRYING TO LOCK A LOGICAL UNIT NOT DEFINED IN CALLER'S SST. "" DR01 NOT ENOUGH PARAMETERS WERE SPECIFIED. "" DR02 THE NUMBER OF TRACKS IS <= ZERO OR AN ILLEGAL LOGICAL UNIT WAS SPECIFIED. "" DR03 AN ATTEMPT TO RELEASE A TRACK ASSIGNED TO ANOTHER PROGRAM WAS MADE. "" IO00 AN ILLEGAL CLASS NUMBER WAS SPECIFIED. OUTSIDE TABLE, NOT ALLOCATED, OR BAD SECURITY CODE. "" IO01 NOT ENOUGH PARAMETERS WERE SPECIFIED. "" IO02 AN ILLEGAL LOGICAL UNIT NUMBER WAS SPECIFIED. "" IO03 ILLEGAL EQT REFERENCED BY LU IN I/O CALL (SELECT CODE=0). "" IO04 AN ILLEGAL USER BUFFER WAS SPECIFIED. EXTENDS BEYOND RT\BG AREA OR NOT ENOUGH SYSTEM AVAILABLE MEMORY TO BUFFER THE REQUEST. "" IO05 AN ILLEGAL DISC TRACK OR SECTOR WAS SPECIFIED. "" IO06 A REFERENCE WAS MADE TO A PROTECTED TRACK OR TO UNASSIGNED LG TRACKS. "" IO07 THE DRIVER HAS REJECTED THE CALL. "" IO08 THE SPECIFIED DISC TRANSFER IS LONGER THAN ONE TRACK. "" IO09 THE LG TRACKS OVERFLOWED. "" IO10 CLASS GET CALL ISSUED WHILE ONE CALL ALREADY OUTSTANDING. ¥r������þú "" IO11 A TYPE 4 PROGRAM MADE AN UNBUFFERED I/O REQUEST TO A DRIVER THAT DID NOT DO ITS OWN MAPPING. "" IO12 AN I\O REQUEST SPECIFIED A LOGICAL UNIT NOT DEFINED FOR USE BY THIS SESSION. THE "SL" COMMAND WILL REPORT ALL LOGICAL UNITS AVAILABLE TO YOUR SESSION. "" IO13 AN I/O REQUEST SPECIFIED AN LU WHICH WAS EITHER LOCKED TO ANOTHER PROGRAM, OR POINTED TO AN EQT WHICH WAS LOCKED TO ANOTHER PROGRAM. "" IO20 READ ATTEMPTED ON WRITE ONLY SPOOL FILE. REVISE PROGRAM CALL TO SPOPN OR CHECK "SL" COMMAND PARAMETERS. "" IO21 READ ATTEMPTED PAST END-OF-FILE. REVISE PROGRAM AND RE-RUN. "" IO22 SECOND ATTEMPT TO READ JCL CARD FROM BATCH INPUT FILE BY OTHER THAN FMGR. REVISE PROGRAM AND RE-RUN. "" IO23 WRITE ATTEMPTED ON READ ONLY SPOOL FILE. REVISE PROGRAM CALL TO SPOPN OR CHECK "SL" COMMAND PARAMETERS. "" IO24 WRITE ATTEMPTED BEYOND END-OF-FILE; USUALLY, SPOOL FILE OVERFLOW. OBTAIN MORE SPOOL ROOM ON DISC (SEE PK COMMAND IN BATCH SPOOL MANUAL) OR DO NOT USE SPOOLING AT THIS TIME. "" IO25 ATTEMPT TO ACCESS SPOOL LU THAT IS NOT CURRENTLY SET UP. MAY BE CAUSED BY GASP KS COMMAND - IF OTHER REASON CORRECT OFFENDING PROGRAMS. "" IO26 I/O REQUEST MADE TO A SPOOL THAT HAS BEEN TERMINATED BY THE GASP KS COMMAND. RESET THE SESSION LOGICAL UNIT WITH THE "CS" OR "SL" COMMAND. "" IOET AN END-OF-TAPE CONDITION OCCURRED ON THE SPECIFIED LU. CORRECT THE CONDITION AND SET THE EQT UP. "" IONR THE SPECIFIED LU IS NOT READY. MAKE THE DEVICE READY AND SET THE EQT UP. "" IOTO THE SPECIFIED LU HAS TIMED OUT. EXAMINE THE DEVICE, CORRECT THE PROBLEM, AND SET THE EQT UP. "" IOPE A PARITY ERROR OCCURRED IN THE DATA TRANSMISSION FROM THE SPECIFIED LU. EXAMINE THE DEVICE, CORRECT THE PROBLEM, AND SET THE EQT UP. "" ILL INT AN ILLEGAL INTERRUPT OCCURRED ON THE SPECIFIED CHANNEL. "" L 01 THIS IS A CHECKSUM ERROR. MOST LIKELY YOU SPECIFIED A FILE TO THE LOADR THAT DID NOT CONTAIN RELOCATABLE FORMAT CODE. A’|������þú TYPICAL MISTAKE IS SPECIFYING THE SOURCE FILE NAME INSTEAD OF THE BINARY FILE NAME. IF THE FILE YOU SPECIFIED WAS THE CORRECT ONE THEN THAT FILE HAS BEEN OVERLAYED OR CORRUPTED. PURGE THAT FILE AND RECOMPILE THE ORIGINAL SOURCE AND TRY AGAIN. "" L 02 THE LOADR FOUND A RECORD THAT WAS NOT A NAM, ENT, EXT, DBL, EMA, OR END RECORD. THE CHECKSUM WAS OK BUT THE RECORD WAS UNIDENTIFIED. WAS THE FILE SPECIFIED A RELOCATABLE FILE ? TRY RECOMPILING AND LOADING. "" L 03 THE SIZE OF THE CODE LOADED SO FAR EXCEEDS THE MAX SIZE THAT YOU SPECIFIED OR EXCEEDS THE LARGEST POSSIBLE SIZE FOR A PROGRAM. MAX SIZE FOR LARGE BACKROUND (LB) NON EMA PROGRAMS IS 28K WORDS (INCLUDING BASE PAGE) AND 26K FOR LB EMA PROGRAMS. CONSULT THE GENERATION MAP FOR THE MAX SIZE OF REAL TIME AND BACKGROUND PROGRAMS. IF YOUR PROGRAM IS JUST TOO LARGE THE FOLLOWING SOLUTIONS MIGHT BE TRIED: 1. IF THE PROGRAM IS NOT TYPE 4 (LARGE BACKROUND [LB]) MAKE IT A TYPE 4 BY SPECIFYING THE ' OP,LB ' COMMAND TO THE LOADR. 2. IF YOU SPECIFIED A SIZE, THEN DON'T SPECIFY A SIZE THE LOADR WILL DO ALL IT CAN TO MAKE YOUR PROGRAM FIT. 3. SEGMENT THE PROGRAM 4. TRY WRITING SOME OF THE PROGRAM IN ASSEMBLY 5. SEE IF THERE ARE ANY DATA DECLARATIONS THAT CAN BE REMOVED OR ANY DATA DECLARATIONS THAT CAN BE MOVED TO EMA. "" L 04 BASE PAGE OVERFLOW. THIS PROGRAM HAS USED TOO MANY BASE PAGE LINKS. RELOAD THE PROGRAM BUT THIS TIME SPECIFY THE ' OP,LE ' OPTION. THIS WILL LIST ALL ENTRY POINTS AND THE BASE PAGE LINKAGES. THIS LOAD WILL ALSO FAIL, HOWEVER, NOW YOU KNOW WHICH MODULES ARE USING UP ALL THE LINKS. BY USING THE LO,XXXXX COMMAND AND ALLIGNING THOSE MODULES TO PAGE BOUNDARIES THE LINKAGE NEEDS CAN BE REDUCED. ALTERNATELY YOU MAY WISH TO REARRANGE THE LOADING ORDER OF YOUR SUBROUTINES. THIS MAY IMPROVE (OR MAKE WORSE) THE LINKAGE NEEDS OF YOUR PROGRAM. "" L 05 THIS IS Ì2������þúA SYMBOL TABLE OVERFLOW. THE LOADR NEEDS MORE ROOM FOR ITS INTERNAL SYMBOL TABLE AND FIX UP TABLE. SINCE THE LOADR IS A TYPE 4 PROGRAM IT CAN BE MADE AS LARGE AS THE LARGEST NORMAL BACKROUND PARTITION. TO GIVE THE LOADR MORE ROOM USE THE ' SZ ' OPERATOR COMMAND. THAT IS, *SZ,LOADR,XX XX = # OF PAGES OR FROM FMGR, :SYSZ,LOADR,XX BY INCREASING THE SPACE FOR THE LOADR THE L 05 PROBLEM SHOULD BE SOLVED. CONSULT THE RTE IV PROGRAMMERS REFERENCE MANUAL FOR MORE INFORMATION ON THE 'SZ ' COMMAND. IF THE SZ COMMAND DOES NOT SOLVE THE PROBLEM, THEN TRY USING THE LOADR ' SE ' COMMAND AFTER EVERY LOADR 'RE' COMMAND. THIS WILL REDUCE SPACE NEEDED FOR FIXUPS. IN ADDITION TO USING THE 'SE' COMMAND AFTER EVERY 'RE' COMMAND, TRY LOADING A NUMBER OF YOUR SUBROUTINES (STILL DOING 'SE') BEFORE THE MAIN OF THE PROGRAM. "" L 06 THIS IS A COMMON BLOCK ERROR. THIS ERROR ONLY OCCURS IF THE LARGEST COMMON DECLARATION OF A PROGRAM DOES NOT APPEAR IN THE FIRST MODULE OF THE PROGRAM LOADED. PROGRAMS THAT USE COMMON MUST DECLARE THAT COMMON IN THE FIRST ROUTINE LOADED AND THAT COMMON DECLARATION MUST BE THE LARGEST ENCOUNTERED IN THE LOAD. "" L 07 DUPLICATE ENTRY POINT. GENERALLY THIS OCCURS WHEN THE SAME SUBROUTINE WAS LOADED TWICE. ALTERNATELY YOU NAMED A SUBROUTINE WITH THE SAME NAME (ENT IN ASMB) THAT WAS ALREADY BEING USED SOMEWHERE ELSE WITHIN THE PROGRAM THAT YOU WERE TRYING TO LOAD. CONFUSION SOMETIMES OCCURS WITH SEGMENTED PROGRAMS. A SUBROUTINE LOADED WITH THE MAIN MUST NOT BE AGAIN LOADED WITH A SEGMENT. LOOK AT THE LOAD MAP FOR THE LOAD. DID YOU TRY TO LOAD THE SUBROUTINE WITH A SEGMENT WHERE THAT SUBROUTINE WAS ALREADY LOADED WITH THE MAIN ? THE LOAD MAP WILL LIST ALL SUBROUTINES LOADED WITH THE MAIN. "" L 08 NO TRANSFER ADDRESS. ONLY SUBROUTINES WERE LOADED. THE LOADR COULD NOT TELL WHICH MODULE OF THE PROGRAM WAS THE MAIN AND WHICH ONES WERE SUBROUTINES. IF THE PROGRAM WAS WRITTEN IN FORTRAN NO M¾������þúODULES WERE FOUND THAT CONTAINED THE 'PROGRAM XXXXX' STATEMENT. IF THE PROGRAM WAS WRITTEN IN ASMB YOU PROBABLY FORGOT TO PUT A LABEL ON THE END STATEMENT. IN ASMB THE MAIN OF A SEGMENT OR OF A PROGRAM IS DIFFERENTIATED FROM SUBROUTINES BY PLACING THE LABEL OF WHERE THE PROGRAM OR SEGMENT IS TO START EXECUTION AS THE OPERAND OF THE END STATEMENT. IF MULTIPLE ROUTINES HAVE LABELS ON THE END STATEMENT THE FIRST ONE ENCOUNTERED IS USED AS THE MAIN OF THE PROGRAM. "" L 09 RECORD OUT OF SEQUENCE. THE LOADR WAS RELOCATING AND ENCOUNTERED RECORDS IN THE WRONG ORDER. RELOCATIBLE RECORDS ARE IN THE ORDER OF NAM, ENT, EXT, DBL, AND END. GENERALLY THIS ERROR OCCURS WHEN RELOCATING FROM AN LU, SAY A MAG TAPE, AND THE TAPE IS INCORRECTLY POSITIONED. IF THE RELOCATION WAS FROM A FILE, RECOMPILE THE SOURCE AND TRY AGAIN, AS THE FILE IS CORRUPT. "" L 10 THE RUN STRING SUBMITTED TO THE LOADER WAS IN ERROR. TRY AGAIN. "" L 11 ATTEMPT TO REPLACE A MEMORY RESIDENT PROGRAM. YOU TRIED TO REPLACE A MEMORY RESIDENT PROGRAM. THIS IS ILLEGAL. "" L 14 THE COMPILER PRODUCED AN ILLEGAL RECORD. A DBL RECORD WAS PRODUCED THAT REFERENCED AN EXTERNAL BUT THAT EXTERNAL WAS NOT IN ANY OF THE EXT RECORDS. THIS IS AN IMPOSSIBLE CONDITION. RECOMPILE AND TRY AGAIN. THIS COULD ALSO BE A COMPILER BUG. "" L 16 YOU SPECIFIED A PARTITION IN THE LOAD OF THE PROGRAM, HOWEVER, THAT PARTITION DOES NOT EXIST OR HAS BEEN DOWNED DUE TO A PARITY ERROR. TRY AGAIN, THIS TIME SPECIFY A PARTITION THAT EXISTS OR DON'T SPECIFY ANY PARTITION AT ALL. "" L 17 THE NUMBER OF PAGES THAT YOU SPECIFIED IN THE LOAD OF THE PROGRAM EXCEEDS THAT NUMBER OF PAGES IN THE PARTITION YOU SPECIFIED. EITHER SPECIFY A DIFFERENT PARTITION OR NO PARTITION AT ALL. "" L 18 THE SPECIFIED PROGRAM SIZE IS TOO LARGE FOR THE PARTITION. EITHER SPECIFY A SMALLER SIZE OR NO SIZE AT ALL. SEE ALSO L 03 ERROR FOR OTHER ALTERNATIVES. "" L 19 ILLEGAL EMA DECLARATION. TWO DIFFERENT EMA LA/_������þúBELS WERE USED, OR THE EMA DECLARATION WAS NOT MADE IN THE MAIN OF A PROGRAM AND THAT MAIN LOADED FIRST, OR AN EMA LABEL WAS ALSO DECLARED AS AN ENTRY POINT IN ANOTHER MODULE. THE EMA DECLARATION MUST BE IN THE MAIN OF THE PROGRAM AND THAT MAIN MUST BE THE FIRST MODULE LOADED. THE EMA STATEMENT MUST BE IN ANY SEGMENT OR SUBROUTINE REFERENCING ANY ELEMENT IN EMA. "" L 20 NO ID EXTENSIONS AVAILABLE FOR THE EMA PROGRAM. YOU MUST FREE UP SOME ID EXTENSIONS BEFORE THE EMA PROGRAM CAN BE SUCCESSFULLY LOADED. "" L 21 THE PROGRAMS DECLARED EMA SIZE IS TOO LARGE FOR THIS SYSTEMS PARTITIONS DEFINITION, IE THERE IS NO EXISTING PARTITION LARGE ENOUGH TO RUN THIS PROGRAM. EITHER REBOOT AND RECONFIGURE SYSTEM TO ALLOW MORE EMA SPACE OR DECLARE LESS EMA SPACE IN THE PROGRAM. "" L 24 YOU ATTEMPTED TO ACCESS AN SSGA ENTRY POINT BUT YOU DID NOT ASK FOR SSGA AT THE BEGINNING OF THE LOAD. RELOAD THE PROGRAM BUT THIS TIME DO A 'OP,SS' AT THE BEGINNING OF THE LOAD. "" L 25 ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO USE THE 'LI' OR 'PU' COMMANDS WITHIN A LOADR COMMAND FILE. LI AND PU COMMANDS ARE NOT ALLOWED WITHIN A LOADR COMMAND FILE UNLESS THAT COMMAND FILE IS AN INTERACTIVE DEVICE (IE A TTY OR CRT). "" L 26 NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH THE LOAD. THIS IS AN EXTREMELY RARE ERROR. THE LOADR WAS CREATING ID SEGMENTS AND THERE WERE ENOUGH ID SEGMENTS AT THE BEGINING TO FINISH THE LOAD, HOWEVER, BETWEEN CREATING ONE ID SEGMENT AND CREATING THE NEXT ALL OTHER ID SEGMENTS WERE USED UP (MAYBE ANOTHER LOADR OR FILE MANAGER GOT THEM) AT ANY RATE THERE AREN'T ENOUGH TO FINISH THE LOAD. THE PROPER RESPONSE TO THIS ERROR IS TO ' OF ' OR PURGE ALL SEGMENTS AND THE MAIN OF THE LOAD THAT WAS JUST UNSUCCESSFUL FREE UP SOME ADDITIONAL ID SEGMENTS AND TRY THE LOAD AGAIN. IF ENOUGH ID SEGMENTS ARE FREED UP THE LOAD WILL SUCCEED. THIS ERROR COULD ONLY OCCUR IN SEGMENTED LOADS. "" L 27 ATTEMPT TO ACCESS AN EMA EXTERNAL WITH OFFSEÁæ������þúT OR INDIRECT. IF THIS IS A FORTRAN PROGRAM YOU MORE THAN LIKELY FORGOT TO PUT THE $EMA STATEMENT IN A SUBROUTINE THAT ACCESSED AN EMA ELEMENT. IF THE PROGRAM WAS WRITTEN IN ASMB USE THE H-P SUPPLIED ROUTINES .EMAP AND .EMIO TO MAP IN THE ARRAYS AND THEN INDEX INTO THE ARRAY VIA THE ADDRESS RETURNED, NOT VIA A REFERENCE TO THE EMA LABEL. "" L 28 UNDEFINED EXTERNALS EXIST WHICH PROHIBITS THE LOAD FROM COMPLETING. AN UNDEFINED EXTERNAL IS A REFERENCE MADE BY THE ROUTINE YOU ARE LOADING TO ANOTHER ROUTINE. FOR EXAMPLE IF YOUR FORTRAN PROGRAM HAD THE FOLLOWING CODE : CALL XYZ(I,J,K) THEN THE SUBROUTINE XYZ WOULD BE AN EXTERNAL. THE PROBLEM YOU HAVE IS THAT YOU LOADED THE ROUTINE THAT CONTAINED THE CALL TO XYZ BUT YOU DIDN'T LOAD THE XYZ SUBROUTINE ITSELF. XYZ IS THE UNDEFINED EXTERNAL. THE PROPER COURSE HERE IS TO RELOAD YOUR PROGRAM BUT THIS TIME DON'T FORGET TO LOAD THE ROUTINES LISTED WHEN THE LOADR ABORTED THE LAST TIME YOU TRIED TO LOAD THE PROGRAM. ONE LAST POINT. IT IS POSSIBLE TO FORCE LOAD A PROGRAM OR SEGMENTS THAT HAVE UNDEFINED EXTERNALS. THIS IS DONE WITH THE LOADR 'FORCE' COMMAND. HOWEVER, IF YOU FORCE LOAD THE PROGRAM IT IS YOUR RESPONSIBILITY TO MAKE SURE THAT THE LINE OF CODE THAT REFERENCES THE EXTERNAL IS NEVER EXECUTED. THAT IS, MAKE SURE THAT THE CALL TO XYZ IS NOT EXECUTED OR YOUR PROGRAM WILL PROBABLY BE ABORTED WITH A DM OR MP ERROR. "" L 29 ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF THAT PROGRAM EXIST. IT IS NOT POSSIBLE TO REPLACE OR PURGE A PROGRAM FROM THE SYSTEM IF COPIES OF THAT PROGRAM EXIST. THE PROBLEM HERE IS THAT OTHER COPIES OF THE SAME PROGRAM EXIST AND MAY BE IN USE. THE PROPER COURSE HERE IS TO DO AN ' OF,PROG,8 ' ON ALL THE PROGRAMS LISTED AS COPIES. THIS WILL GET RID OF THOSE PROGRAMS SO THAT YOU CAN PERFORM THE PROGRAM PURGE OR REPLACE. NOTE THAT THIS PROCESS SHOULD ONLY BE DONE BY THE SYSTEM MANAGER. "" L 30 ATTEMPT TO REPLACE A COPIED PROGRAM. YOU TRIEêµ������þúD TO DO A PROGRAM REPLACE ON A PROGRAM THAT WAS A COPY OF ANOTHER PROGRAM. REPLACEMENT OPERATIONS MAY ONLY BE DONE ON THE ORIGINAL PROGRAM NOT THE COPIED PROGRAM. THE PROPER THING TO DO NOW IS EDIT THE SOURCE OF YOUR PROGRAM AND MAKE SURE THE NAME IS THE ORIGINAL PROGRAM NAME. "" L 31 TRYING TO DO A PURGE OR PERMANENT LOAD WITH A COPY OF THE LOADR. RE-RUN THE LOADR USING THE REAL PROGRAM: RU,LOADR:IH . "" L 32 THIS PROBLEM RESULTS WHEN YOU TRY TO LOAD THE SAME PROGRAM SEVERAL TIMES BUT DO NOT GET RID OF THE EARLIER LOADS. FOR EXAMPLE, YOU LOADED A PROGRAM CALLED XXXXX AND FOR SOME REASON LOADED THE SAME PROGRAM AGAIN. IN THIS CASE THE LOADR WARNED YOU WITH A W 32 WARNING MESSAGE AND THEN RENAMED YOUR PROGRAM TO ..XXX . THAT IS THE LOADR FORGIVES YOU THE FIRST TIME. HOWEVER, YOU HAVE NOW LOADED A PROGRAM WITH THE SAME NAME A THIRD TIME. THE LOADR WILL NOT FORGIVE THIS AGAIN. THE SOLUTION IS TO DO A :OF,XXXXX,8 :OF,..XXX,8 AND NOW START THE LOAD OVER AGAIN. "" L 33 NOT ENOUGH ID SEGMENTS TO FINISH THE LOAD. YOUR SYSTEM HAS RUN OUT OF ID SEGMENTS. CALL THE SYSTEM MANAGER TO FREE UP SOME ID SEGMENTS. HE WILL PROBABLY USE THE OFF COMMAND TO PURGE SOME PROGRAMS FROM THE SYSTEM. "" L 34 YOU TRIED TO REPLACE A PERMANENT PROGRAM. HOWEVER, THAT PROGRAM TERMINATED SERIALLY REUSABLE, SAVING RESOURCES, OR WAS OPERATOR SUSPENDED. THAT IS, THE PROGRAM STILL OWNED A SYSTEM PARTITION. OFF THE PROGRAM AND REPEAT THE LOAD. "" CL- 01 THE INPUT TO THE COMPL & CLOAD PROGRAMS MUST BE A SOURCE FILE. THESE PROGRAMS DO NOT ACCEPT INPUT FROM AN LU. THUS THE ANSWER TO THE PROMPT NAMR(S),NAMR(L),NAMR(R),<C.S.> MUST NOT CONTAIN AN LU FOR THE 1ST PARAMETER IE THE SOURCE NAMR. "" CL- 02 NO CONTROL STATEMENT WAS SPECIFIED SO COMPL OR CLOAD OPENED THE SOURCE FILE TO FIND OUT WHICH LANGUAGE TO INVOKE (IE FTN4, ASMB). AN FMP ERROR WAS DETECTED ON THE OPEN REQUEST. THIS FMP ERROR WAS LISTED ALONG WITH THóÅ������þúE CL- 02 ERROR MESSAGE. "" CL- 03 NO CONTROL STATEMENT WAS SPECIFIED SO COMPL OR CLOAD OPENED THE SOURCE FILE TO FIND OUT WHICH LANGUAGE TO INVOKE (IE FTN4,ASMB). WHILE SCANNING THE FILE FOR THE CONTROL STATEMENT AN FMP READ ERROR OCCURED. THIS ERROR WAS LISTED ALLONG WITH THE CL- 03 ERROR MESSAGE. "" CL- 04 NO CONTROL STATEMENT WAS SPECIFIED SO COMPL OR CLOAD OPENED THE SOURCE FILE TO FIND OUT WHICH LANGUAGE TO INVOKE (IE FTN4,ASMB). THAT CONTROL STATEMENT MAY OR MAY NOT HAVE BEEN FOUND. HOWEVER, AN FMP ERROR WAS DETECTED DURING THE CLOSE OF THE FILE. THAT ERROR WAS LISTED ALONG WITH THE CL- 04 MESSAGE. "" CL- 05 COMPL & CLOAD RECOGNIZE THE EXISTENCE OF ALL H-P SUPPLIED LANGUAGES AND SOME NOT SUPPLIED BY H-P. THE LANGUAGES IT RECOGNIZES ARE FTN4, PASCL, ASMB, COBOL, RPG, MICRO, SPL, ALGOL, HPAL, AND SNOBL. THE CONTROL STATEMENT MUST BE SPELLED EXACTLY AS SHOWN. IF NO CONTROL STATEMENT WAS SPECIFIED AND THE CONTROL STATEMENT OF THE PROGRAM WAS NOT IN THE FIRST 10 LINES OF THE PROGRAM, THEN A CL- 05 ERROR WILL RESULT. "" CL- 06 THE LANGUAGE REQUESTED WAS FOUND AND INVOKED BY COMPL OR CLOAD, HOWEVER, THE EXEC 23 REQUEST MADE BY CLOAD OR COMPL WAS REJECTED BY THE OPERATING SYSTEM. THIS ERROR COULD ONLY HAPPEN IF THE LANGUAGE WAS PURGED FROM THE SYSTEM BETWEEN THE 'RP' AND THE EXEC REQUEST. IF YOU GET THIS ERROR, TRY AGAIN. IF IT HAPPENS AGAIN REPORT IT TO THE SYSTEM MANAGER. "" CL- 07 THIS ERROR MAY OCCUR WHEN THE LANGUAGE REQUESTED IN THE OPTIONAL CONTROL STATEMENT OR THE SOURCE FILE CONTROL STATEMENT WAS RECOGNIZED BUT THE LANGUAGE WAS NOT FOUND. COMPL & CLOAD BOTH TRY TO SCHEDULE THE REQUESTED LANGUAGE, FAILING THAT, THEY BOTH TRY TO ' RP ' THE LANGUAGE. IF THAT FAILS THEN THE LANGUAGE DOES NOT EXIST ON THE SYSTEM. IF THIS ERROR OCCURS FOR A LANGUAGE THUT WAS PREVIOUSLY ON THE SYSTEM, CONTACT THE SYSTEM MANAGER AS THE LANGUAGE HAS BEEN REMOVED FROM THE SYSTEM. "" CL- 08 THE LANGUAGE REQUESTED EXISTS ON THE SYSTEM ™ƒ������þúAND COMPL OR CLOAD WAS IN THE PROCESS OF ' RP 'ING IT. WHEN THE FILE WAS CLOSED AN FMP ERROR OCCURED. THAT ERROR WAS LISTED WITH THE CL- 08 ERROR MESSAGE. "" CL- 09 THE LANGUAGE REQUESTED EXISTS ON THE SYSTEM AND COMPL OR CLOAD WAS IN THE PROCESS OF ' RP ' ING IT. HOWEVER, THAT ' RP ' FAILED BECAUSE THE CHECKSUM CALCULATED WHEN THE LANGUAGE WAS 'SP' ED DID NOT MATCH THE SYSTEM CHECKSUM. GENERALLY THIS ERROR MEANS THAT THE PROGRAM WAS NOT LOADED ON THIS SYSTEM BUT THAT THE ABSOLUTE MEMORY IMAGE OF THE PROGRAM (TYPE 6 FILE) WAS BROUGHT OVER TO THIS SYSTEM VIA A FMGR 'ST' OR 'DU' COMMAND. PROGRAMS TO BE RUN ON THIS SYSTEM MUST BE LOADED ON THIS SYSTEM WITH THE LOADR PROGRAM OR THE GENERATOR. NO OTHER METHOD OF CREATING ABSOLUTE PROGRAMS IS ALLOWED. THE FILE CONTAINING THE LANGUAGE AND ALL ITS SEGMENT FILES SHOULD BE PURGED AND THE PROGRAM LOADED WITH THE LOADR. "" CL- 10 THE LANGUAGE REQUESTED EXISTS ON THE SYSTEM AND COMPL OR CLOAD WAS IN THE PROCESS OF 'RP'ING THE LANGUAGE. HOWEVER, DURING THE OPEN REQUEST AN FMP ERROR OCCURED. TTHIS ERROR WAS REPORTED WITH THE CL- 10 ERROR MESSAGE. "" CL- 11 THIS SESSION HAS MORE THAN 80 SPOOL FILES CURRENTLY RESIDING ON THE SPOOL DISC. CLOAD AND COMPL USE FILE NAMES CONSTRUCTED AS FOLLOWS: CHAR 1 & 1 = CO CHAR 3 & 4 = SESSION # (01 - 99) THIS IS THE NUMBER LISTED IN THE BREAK POINT MODE S = XX COMMAND ? THE XX IS THE USERS SESSION # CHAR 5 & 6 (01 - 80) THIS IS JUST A COUNTER THE FILES WOULD BE CREATED AS COXX01 THEN COXX02 AND SO ON. THESE FILES CONTAIN THE OUT SPOOLED LISTING. THE CL- 11 ERROR MEANS THAT 80 OF THESE FILES ALREADY EXIST AND NO MORE WILL BE CREATED FOR THIS SESSION. NOTE THAT RU,COMPL,SOURCE,6:NS WILL INHIBIT SPOOLING TO LU 6. THAT IS, A ' 6:NS ' IN THE LIST NAMR POSITION WILL INHIBIT SPOOLING AND BYPASS TŒ������þúHIS ERROR CONDITION. "" CL- 12 THE COMPILER WAS ABORTED AND THUS THE COMPLILATION WAS NOT SUCCESSFULLY COMPLETED. THE ABNORMAL END WAS PROBABLY DUE TO AN ' OF ' COMMAND. IF THE ABNORMAL END WAS DUE TO OTHER TYPE COMPILER ERRORS THE ERROR WILL BE ON THE LISTING OR REPORTED TO YOUR TERMINAL. TRY THE COMPILATION AGAIN. IF IT FAILS AGAIN CONSULT YOUR SYSTEM MANAGER. "" CL- 13 THE COMPILATION WAS NOT SUCCESSFUL. ERRORS OR WARNINGS WERE FOUND. YOUR BEST BET IS TO GO GET THE LISTING, CORRECT THE ERROR, AND TRY AGAIN. GOOD LUCK ! "" CL- 14 THIS ERROR RESULTS WHEN THE SYSTEM IS OUT OF ID SEGMENTS AND IT IS IMPOSSIBLE TO ' RP ' THE COMPILER OR LOADR. GO GET THE SYSTEM MANAGER AS HE IS THE ONLY ONE WHO WILL KNOW WHICH ID SEGMENTS CAN BE DONE AWAY WITH. AFTER SOME ID SEGMENTS ARE FREE TRY AGAIN AND THE COMPILATION SHOULD WORK. "" CL- 15 THIS ERROR MEANS THAT ONE OF THE INPUT PARAMETERS WAS IN ERROR. MOST OFTEN IT MEANS THAT THE LIST LU THAT YOU SPECIFIED IS ILLEGAL OR NOT DEFINED FOR YOUR SESSION. "" CL- 30 CLOAD WAS TRYING TO ' RP ' THE LOADR BUT ENCOUNTERED AN FMP ERROR ON THE CLOSE OF THE FILE THAT CONTAINED THE LOADR. THE FMP ERROR WAS LISTED WITH THE CL- 30 ERROR. YOU SHOULD REPORT THIS TO THE SYSTEM MANAGER. "" CL- 31 CLOAD WAS TRYING TO ' RP ' THE LOADR AND A CHECKSUM ERROR RESULTED. THIS COULD ONLY OCCUR IF THE LOADR WAS NOT LOADED ON THIS SYSTEM BUT WAS BROUGHT OVER TO THIS SYSTEM VIA A FMGR 'ST' OR 'DU' COMMAND. THIS ERROR IS A SERIOUS ONE AND THE SYSTEM MANAGER SHOULD BE CONSULTED. "" CL- 32 CLOAD WAS TRYING TO ' RP ' THE LOADR BUT ENCOUNTERED AN FMP ERROR ON THE FMP OPEN REQUEST. YOU SHOULD REPORT THIS TO THE SYSTEM MANAGER. "" CL- 33 THIS SHOULD BE AN IMPOSSIBLE ERROR ! THE ONLY WAY THIS COULD HAPPEN IS IF THE LOADR WAS NOT LOADED AT GENERATION TIME OR IF AN ILLEGAL NON SUPPORTED MEMORY OR DISC MODIFICATION HAS BEEN MADE. REPORT THIS TO THE SYSTEM MANAGER IMMEDIATELY ! "" CL- 34 THE LOADR WAS LOADIN5É������þúG YOUR PROGRAM BUT WAS ABORTED ABNORMALLY. THIS WAS PROBABLY THE RESULT OF AN ' OF ' COMMAND. ANY OTHER ABNORMAL ENDING ERROR WILL BE REPORTED TO YOUR CONSOLE. TRY THE LOAD AGAIN. IF THE ERROR OCCURS AGAIN REPORT IT TO THE SYSTEM MANAGER. "" CL- 35 THE LOAD WAS NOT SUCCESSFUL. MORE OFTEN THAN NOT LOAD ERRORS ARE A RESULT OF UNDEFINED EXTERNALS. CHECK THE LOADR LISTING FOR THE TYPE OF ERROR. IF IT IS AN UNDEFINED EXTERNAL, THEN YOU ARE PROBABLY MISSING A SUBROUTINE SOMEWHERE. IF THIS IS THE CASE CLOAD IS NOT THE PROGRAM YOU SHOULD BE USING. RATHER, YOU SHOULD BE USING THE PROGRAMS COMPL TO COMPILE YOUR CODE AND THE LOADR TO LOAD THE SEPARATE MODULES THAT THE PROGRAM REQUIRES. "" CL- 36 THIS IS A LOADR SCHEDULING ERROR. FOR SOME REASON THE CLOAD PROGRAM WAS UNABLE TO CREATE A COPY OF THE LOADR FOR YOU AND EVEN THE ORGINAL LOADR WAS NOT AVAILABLE. CALL THE SYSTEM MANAGER FOR ASSISTENCE. "" CL- 37 THE LIST DEVICE FOR CLOAD MUST BE AN LU BECAUSE BOTH THE COMPILER AND THE LOADR MUST TALK TO THE DEVICE. IF THE LOADR WERE TO LIST TO THE SAME FILE THAT THE COMPILER DID THE COMPILER LISTING WOULD BE OVERLAYED. YOU CAN GET THE LISTING TO GO TO A FILE, HOWEVER, IF YOU USE THE SPOOL SYSTEM. (IE THE :SL,LU#,NAMR COMMAND) "" GASP -48 SMP CANNOT BE SCHEDULED SMP PROGRAM IS NOT FOUND OR THERE IS NOT A BIG ENOUGH PARTITION TO RUN SMP. THE DEFAULT FOR SMP IS TYPE 2 (REALTIME) AND 6 PAGES IN SIZE. "" GASP -33 NOT ENOUGH ROOM ON CARTRIDGE AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE WHICH HAS NO MORE ROOM. TRY USING ANOTHER CARTRIDGE OR DECREASE THE FILE SIZE. "" GASP -32 CARTRIDGE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE THAT CANNOT BE FOUND IN THE CARTRIDGE LIST. CHECK THE CARTRIDGE NUMBER FOR CORRECTNESS. "" GASP -14 DIRECTORY FULL THERE IS NO MORE ROOM IN THE FILE DIRECTORY. PURGE ANY UNUSED FILES AND PACK THE DISC IF POSSIBLE. OTHERWISE, TRY ANOTHER CARTRIDGE. "" ������������������������������������������L���`����^�Z�������������������������������������������������������������������������������������������Z`�������ÿÿ����� ���� ÿý�»�Ð ���������ÿ��92067-18490 2026� S C0122 �"HELPB � � � � � � � � � � � � � �H0101 x„�����þúGASP -13 DISC LOCKED THE CARTRIDGE SPECIFIED IS LOCKED. INITIALIZE THE CARTRIDGE IF IT WAS NOT INITIALIZED, OTHERWISE KEEP TRYING. "" GASP -12 EOF OR SOF ERROR AN ATTEMPT WAS MADE TO READ, WRITE, OR POSITION A FILE BEYOND THE FILE BOUNDARIES. CHECK THE RECORD POSITION PARAMETERS. THE RESULTS DEPEND ON THE FILE TYPE AND THE CALL. "" GASP -8 FILE OPEN OR LOCK REJECTED AN ATTMPT WAS MADE TO OPEN A FILE THAT WAS ALREADY OPENED EXCLUSIVELY OR WAS ALREADY OPENED TO EIGHT PROGRAMS, OR THE CARTRIDGE CONTAINING THE FILE IS LOCKED. USE THE CL OR DL COMMAND TO LOCATE THE LOCK. IF THE FILE IS BEING PACKED, CHECK TO SEE IF SPOOLING IS SHUT DOWN. "" GASP -7 ILLEGAL SECURITY CODE OR ILLEGAL WRITE ON LU2 OR 3 1. AN ATTEMPT WAS MADE TO ACCESS A FILE WITHOUT SPECIFYING THE SECURITY CODE OR WITH THE WRONG SECURITY CODE. FIND OUT THE CORRECT CODE AND USE IT OR DO NOT ACCESS THE FILE. OR 2. AN ATTEMPT WAS MADE BY A SESSION USER (NOT THE SYSTEM MANAGER) TO WRITE ON LU 2 OR 3. SESSION USERS DO NOT HAVE WRITE ACCESS TO LU 2 OR 3. "" GASP -6 FILE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A FILE THAT CANNOT BE FOUND. CHECK THE FILE NAME. "" GASP -4 MORE THAN 32767 RECORDS IN A TYPE 2 FILE AN ATTEMPT WAS MADE TO CREATE A TYPE 2 FILE WITH TOO MANY RECORDS OR WITH A RECORD SIZE THAT IS TOO LARGE. CHECK THE SIZE PARAMETER. "" GASP -2 DUPLICATE FILE NAME A FILE ALREADY EXISTS WITH THE NAME SPECIFIED. REPEAT THE COMMAND WITH A NEW NAME OR PURGE THE EXISTING FILE. "" GASP -1 DISC ERROR THE DISC IS DOWN. TRY AGAIN AND THEN REPORT THE PROBLEM TO THE SYSTEM MANAGER. "" GASP 1 DISC ERROR NN DISC ASSOCIATED WITH LU NN IS DOWN; REPORT PROBLEM TO THE SYSTEM MANAGER. "" GASP 2 NUMBER OUT OF RANGE NUMBER ENTERED IN GASP INITIALIZATION IS INCONSISTENT WITH PREVIOUS ENTRIES OR EXCEEDS MAXIMUM SPECIFIED AT GENERATION; CHECK LAST ENTRY AND CHANGE. "" GASP 3 BAD JOB NUMBER! SPECIFIED JOB NUMBER NOT CÎ�������þúURRENTLY ASSIGNED; CHECK ASSIGNED JOB NUMBERS WITH DJ COMMAND; RE-ENTER COMMAND WITH VALID JOB NUMBER. "" GASP 4 ILLEGAL STATUS COMMAND IS NOT VALID FOR CURRENT STATE OF JOB OR SPOOL FILE; CHECK STATUS WITH DJ OR DS. "" GASP 5 ILLEGAL COMMAND COMMAND NOT RECOGNIZED BY GASP; CHECK AND RE-ENTER COMMAND CORRECTLY. "" GASP 6 NOT FOUND SPECIFIED JOB OR SPOOL NOT CURRENTLY ASSIGNED; CHECK WITH DJ OR DS. "" GASP 43 LU NOT FOUND IN SST THE OUTSPOOL LU SPECIFIED IN COMMAND IS NOT DEFINED IN THE SESSION SWITCH TABLE FOR THIS SESSION USER. USE FMGR SL COMMAND TO ADD THE LU TO THE SST OR USE ANOTHER OUTSPOOL LU. "" GASP 46 INSUFFICIENT CAPABILITY AN ATTEMPT WAS MADE TO EXECUTE A COMMAND THAT REQUIRES A HIGHER CAPABILITY LEVEL THAN THE CAPABILITY LEVEL DEFINED FOR THIS SESSION USER. "" GASP 55 MISSING PARAMETER A REQUIRED PARAMETER HAS BEEN OMITTED. CHECK THE COMMAND AND RE-ENTER IT WITH THE MISSING PARAMETER. "" GASP 56 BAD PARAMETER A PARAMETER WAS SPECIFIED INCORRECTLY; CHECK THE COMMAND AND RE-ENTER IT CORRECTLY. "" LGON 06 THIS IS AN INFORMATIONAL DIAGNOSTIC. THE STATION (TERMINAL) BEING LOGGED ONTO HAS A CONFIGURATION TABLE ENTRY WHICH IS A DUPLICATE OF AN ENTRY IN THE USERS ACCOUNT FILE ENTRY. IF THE USER HAS THE CAPABILITY TO MAKE CHANGES IN THE SESSION SWITCH TABLE (SL,X,Y), BOTH THE CONFIGURATION TABLE AND THE USERS ACCOUNT FILE DEFINITION (OF THE SESSION LU) ARE REPORTED. IN EITHER CASE, THE USER'S ACCOUNT FILE DEFINITION IS USED. CONTACT YOUR SYSTEM MANAGER TO HAVE THE CONFLICT REMOVED. "" LGON 09 YOUR SESSION HAS EXCEEDED THE MAXIMUM SESSION SWITCH TABLE SIZE. THE OVERFLOW WAS DETECTED IN ONE OF THE FOLLOWING AREAS: BUILDING THE SST ENTRIES DEFINED BY THE USER'S ACCOUNT ENTRY, BUILDING SST ENTRIES DEFINED BY THE STATION CONFIGURATION TABLE OR MOUNTING SYSTEM GLOBAL DISCS. CONTACT YOUR SYSTEM MANAGER AS YOU MAY BE MISSING SOME DEVICE DEFINITIONS. "" LGON 11 THE LOGON PROGRAM RECEIVED­������þú THE SPECIFIED ERROR WHEN ATTEMPTING TO MOUNT A PRIVATE OR GROUP DISC TO THIS SESSION. CHECK THE TERMINAL USERS MANUAL (ERROR SUMMARY) FOR MORE INFORMATION. "" LGON 13 THIS IS AN INFORMATIONAL DIAGNOSTIC. LOGON DETECTED A USER SST WHICH ATTEMPTED TO REDEFINE A SYSTEM DISC'S LOGICAL UNIT NUMBER. DISC LU'S MUST BE DIRECT MAPS (SESSION LU=SYSTEM LU). CONTACT YOUR SYSTEM MAN- AGER TO CORRECT YOUR ACCOUNT. "" ACCT 012 LU NOT IN SESSION SWITCH TABLE ENTER THE CORRECT LU OR EXIT ACCTS AND PUT LU IN SST WITH SL COMMAND "" ACCT 004 ILLEGAL LU A LU WAS SPECIFIED WHICH: 1) CAN NOT HANDLE BINARY DATA 2) IS NOT AN INPUT DEVICE 3) IS NOT AN OUTPUT DEVICE 4) THE DEVICE IS WRITE PROTECTED "" ACCT 013 TRANSFER STACK OVERFLOW THE TRANSFER STACK IS ONLY 10 DEEP TR,-11 CLEARS THE TRANSFER STACK "" ACCT 046 INSUFFICIENT CAPABILITY AN ATTEMPT WAS MADE TO EXECUTE A COMMAND WHICH IS RESERVED FOR GROUP MANAGERS OR THE SYSTEM MANAGER. "" ACCT-200 ACCOUNT NOT FOUND GROUP ACCOUNT MUST BE DEFINED BEFORE A USER CAN BE ASSIGNED TO IT "" ACCT-201 NO FREE ACCOUNTS THE "LO,0" COMMAND CAN BE USED TO EXPAND THE ACCOUNTS FILE "" ACCT-202 ACCOUNT WITH THIS NAME ALREADY EXISTS "" ACCT-203 INVALID ACCOUNT NAME 1) ONLY 10 ALPHANUMERIC CHARACTERS ARE ALLOWED FOR A NAME. 2) WHEN LINKING TO AN ACCOUNT WHICH BELONGS TO GROUP GENERAL ".GENERAL" MUST BE SPECIFIED. "" ACCT-204 INVALID PASSWORD 1) THE PASSWORD OF THE SYSTEM MANAGER IS REQUIRED TO RUN ACCTS FROM A NON SESSION CONSOLE. 2) THE PASSWORD OF THE ACCOUNT TO WHICH THIS IS BEING LINKED IS REQUIRED. 3) THE PASSWORD FOR CURRENT ACCOUNT IS INCORRECT. 4) THE NEW PASSWORD CONTAINS AN ILLEGAL CHARACTER. THE CHARACTER MUST BE PRINTABLE AND NOT A DELIMITER ( . , * / ). "" ACCT-205 INVALID COMMAND ENTER "HE" TO GET THE COMMANDS "" ACCT-206 INVALID FILE NAME "" ACCT-207 INVALID CAPABILITY CAPABIg·������þúLITY MUST BE BETWEEN 1 AND 63 "" ACCT-208 INVALID DISC LIMIT ONLY 60 DISCS ARE ALLOWED "" ACCT-209 INVALID SST ENTRY SESSION LU MUST BE GREATER THAN 3 AND LESS THAN 64 SYSTEM LU MUST BE GREATER THAN 0 AND LESS THAN 255 SESSION LU IS ALREADY DEFINED. "" ACCT-210 CONFLICT IN SST DEFINITION USER AND GROUP SST'S DISAGREE "" ACCT-211 USER OR GROUP ID NOT AVAILABLE ENTER "LIST,USER,@.@,6,ID" TO FIND LARGEST GROUP ID AND SMALLEST USER ID PURGE AND REBUILD THE CONFLICTING ACCOUNT(S) "" ACCT-212 INVALID NUMBER OF SST SPARES MUST BE BETWEEN 0 AND 60 SPARES PLUS DISC LIMIT MUST BE LESS THAN 68 "" ACCT-213 INVALID MEMORY REQUEST MEMORY REQUEST MUST BE BETWEEN 70 AND 7000 WORDS "" ACCT-215 LIST NAMR IN TRANSFER STACK REISSUE TR COMMAND "" ACCT-218 SESSION NOT SHUT DOWN SESSION MUST SHUT DOWN FOR LOAD,<NAMR> "" ACCT-219 NOT ENOUGH ROOM IN FILE FOR NEW TABLE ENTER "LO,0" TO EXPAND FILE "" ACCT-220 CORRUPT STATION TABLE SPARES SORRY MUST BUILD ACCOUNTS FILE FROM SCRATCH "" ACCT-221 NOT AN ACTIVE SESSION THE SESSION ADDRESSED IS NOT ACTIVE "" ACCT-222 ILLEGAL SYSTEM LU SYSTEM LU MUST BE BETWEEN 1 AND 255 "" ACCT-223 ILLEGAL SHUT DOWN PARAMETER SHUT DOWN OPTIONS ARE: 1)"SD" SHUT DOWN THE SESSION SYSTEM 2)"SD,RE SHUT DOWN THE SESSION SYSTEM AND RELEASE SESSION MEMORY 3)"SD,<LU>,RP" SHUT DOWN SESSION <LU> AND RELEASE PRIVATE DISCS 4)"SD,<LU>,RG" SHUT DOWN SESSION <LU> AND RELEASE GROUP DISCS <LU> CANNOT BE TERMINAL LU FROM WHICH ACCTS IS RUNNING. YOU CANNOT SHUT DOWN YOUR OWN SESSION. "" ACCT-225 SESSION MEMORY CAN NOT BE RETURNED TO SYSTEM (REBOOT) "" ACCT-046 GREATER THAN 255 EXTENTS ATTEMPT TO CREATE EXTENT 256. MAKE FILE SIZE OF MAIN LARGER. "" ACCT-099 DIRECTORY MANAGER EXEC REQUEST WAS ABORTED AN EXEC REQUEST MADE BY D.RTR WAS ABORTED. MAKE SURE THAT ALL DISCS BEING ACCESSED ARE UP. DÚ������þúNOTIFY SYSTEM MANAGER. "" ACCT-041 NO ROOM IN SST "" ACCT-040 LU NOT FOUND IN SST TRYING TO ACCESS AN LU THAT IS NOT IN YOUR SST. USE THE SL COMMAND TO ADD THE LU TO THE SST. "" ACCT-039 CONFLICT IN SST DEFINITION "" ACCT-035 ALREADY 63 DISCS MOUNTED TO SYSTEM AN ATTEMPT WAS MADE TO MOUNT A DISC WHEN THERE ARE ALREADY 63 DISCS MOUNTED. A DISC WILL HAVE TO BE DISMOUNTED BEFORE A NEW ONE MAY BE MOUNTED. "" ACCT-034 DISC ALREADY MOUNTED. AN ATTEMPT WAS MADE TO MOUNT A DISC THAT IS ALREADY MOUNTED ON THE CARTRIDGE LIST. EITHER DISMOUNT THE DUPLICATE DISC OR MOUNT A DIFFERENT ONE. "" ACCT-033 NOT ENOUGH ROOM ON CARTRIDGE AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE WHICH HAS NO MORE ROOM. TRY USING ANOTHER CARTRIDGE OR DECREASE THE FILE SIZE. "" ACCT-032 CARTRIDGE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A CARTRIDGE THAT CANNOT BE FOUND IN THE CARTRIDGE LIST. CHECK THE CARTRIDGE NUMBER FOR CORRECTNESS. "" ACCT-030 VALUE TOO LARGE FOR PARAMETER "" ACCT-026 QUEUE FULL OR MAX PENDING SPOOLS EXCEEDED THE SPOOL QUEUE IS FULL OR THE MAXIMUM NUMBER OF PENDING SPOOLS HAS BEEN EXCEEDED. THE JOB MUST BE RE-RUN WHEN THE SPACE BECOMES AVAILABLE. "" ACCT-025 NO SPLCON ROOM THE SPLCON IS FULL. THIS ERROR MAY OCCUR WHEN THE SPOOL SYSTEM IS COMPETING WITH PROGRAMS USING THEIR OWN SPOOLING FILE AND RUNNING OUTSIDE OF BATCH. "" ACCT-024 NO MORE BATCH SWITCHES THE LU SWITCH TABLE IS FULL. THE SIZE OF THE SWITCH TABLE SPECIFIED AT SYSTEM GENERATION IS INADEQUATE. NOTIFY THE SYSTEM MANAGER OF THIS CONDITION. "" ACCT-023 NO AVAILABLE SPOOL FILES ALL SPOOL FILES ARE CURRENTLY BEING USED. RE-RUN THE JOB AFTER A SPOOL FILE BECOMES AVAILABLE. "" ACCT-022 NO AVAILABLE SPOOL LU'S ALL SPOOL LOGICAL UNITS ARE CURRENTLY UNAVAILABLE. RE-RUN THE JOB AFTER A SPOOL LU BECOMES AVAILABLE. "" ACCT-021 ILLEGAL DESTINATION LU THE LU SPECIFIED WAS NOT ALLOCATED BY GASP. TRY AGAIN USING A LU ALLOCATED BY G5„������þúASP. "" ACCT-020 ILLEGAL ACCESS LU 1. THE LOGICAL UNIT NUMBER SPECIFIED IN THE LU OR CS COMMAND WAS NOT A POSITIVE LOGICAL UNIT NUMBER. RE-ENTER THE CORRECTED COMMAND. OR 2. THERE IS AN LU ENTRY IN THE CARTRIDGE LIST THAT DOES NOT POINT TO A DISC DEVICE. THIS HAPPENED BECAUSE AFTER THE DISC WAS MOUNTED THE LU COMMAND WAS USED TO DO A LOGICAL UNIT SWITCH ON THE DEVICE. SWITCH THE LU BACK TO ITS DISC DEFINITION. IF DESIRED, DISMOUNT THE DISC. THE LU CAN THEN BE SWITCHED TO A NON-DISC DEVICE. "" ACCT-019 ILLEGAL ACCESS ON A SYSTEM DISC AN ATTEMPT WAS MADE TO WRITE ON A SYSTEM DISC. THE SYSTEM MANAGER IS THE ONLY USER THAT HAS THIS CAPABILITY. "" ACCT-018 ILLEGAL LU; LU NOT ASSIGNED TO SYSTEM ATTEMPT TO ACCESS AN LU THAT IS NOT ASSIGNED TO THE SYSTEM. "" ACCT-017 ILLEGAL READ/WRITE ON TYPE 0 FILE AN ATTEMPT WAS MADE TO READ, WRITE, OR POSITION A TYPE 0 FILE THAT DOES NOT SUPPORT THE OPERATION. CHECK THE FILE PARAMETERS OR THE NAMR. "" ACCT-016 ILLEGAL TYPE 0 OR FILE BLOCKSSIZE=0 ONE OF THE FOLLOWING OCCURED: 1) THE WRONG FILE TYPE WAS SPECIFIED, 2) AN ATTEMPT WAS MADE TO CREATE OR PURGE A TYPE 0 FILE, OR 3) THE SIZE SPECIFIED WAS ZERO BLOCKS. CHECK THE SIZE AND TYPE PARAMETERS. "" ACCT-015 ILLEGAL NAME THE FILE NAME DOES NOT CONFORM TO THE SYNTAX RULES. CORRECT THE NAME AND RE-ENTER THE COMMAND. "" ACCT-014 DIRECTORY FULL THERE IS NO MORE ROOM IN THE FILE DIRECTORY. PURGE ANY UNUSED FILES AND PACK THE DISC IF POSSIBLE. OTHERWISE, TRY ANOTHER CARTRIDGE. "" ACCT-013 DISC LOCKED THE CARTRIDGE SPECIFIED IS LOCKED. INITIALIZE THE CARTRIDGE IF IT WAS NOT INITIALIZED, OTHERWISE KEEP TRYING. "" ACCT-012 EOF OR SOF ERROR AN ATTEMPT WAS MADE TO READ, WRITE, OR POSITION A FILE BEYOND THE FILE BOUNDARIES. CHECK THE RECORD POSITION PARAMETERS. THE RESULTS DEPENDS ON THE FILE TYPE AND THE CALL. "" ACCT-011 DCB NOT OPEN AN ATTEMPT WAS MADE TO ACCESS AN UNOPENED DCB. ¥_������þúUSE THE CREATE OR OPEN CALL TO OPEN THE DCB AND CHECK FOR ERRORS. "" ACCT-010 NOT ENOUGH PARAMETERS ONE OR MORE OF THE REQUIRED PARAMETERS WERE OMITTED FROM THE CALL. ENTER THE REQUIRED PARAMETERS. "" ACCT-009 ATTEMPT TO USE APOSN OR FORCE A TYPE 0 FILE TO TYPE 1 A TYPE 0 FILE CANNOT BE POSITIONED WITH APOSN OR BE FORCED TO A TYPE 1 FILE. CHECK THE FILE TYPE. "" ACCT-008 FILE OPEN OR LOCK REJECTED AN ATTMPT WAS MADE TO OPEN A FILE THAT WAS ALREADY OPENED EXCLUSIVELY OR WAS ALREADY OPENED TO EIGHT PROGRAMS, OR THE CARTRIDGE CONTAINING THE FILE IS LOCKED. USE THE CL OR DL COMMAND TO LOCATE THE LOCK. IF THE FILE IS BEING PACKED, CHECK TO SEE IF SPOOLING IS SHUT DOWN. "" ACCT-007 ILLEGAL SECURITY CODE OR ILLEGAL WRITE ON LU2 OR 3 1. AN ATTEMPT WAS MADE TO ACCESS A FILE WITHOUT SPECIFYING THE SECURITY CODE OR WITH THE WRONG SECURITY CODE. FIND OUT THE CORRECT CODE AND USE IT OR DO NOT ACCESS THE FILE. OR 2. AN ATTEMPT WAS MADE BY A SESSION USER (NOT THE SYSTEM MANAGER) TO WRITE ON LU 2 OR 3. SESSION USERS DO NOT HAVE WRITE ACCESS TO LU 2 OR 3. "" ACCT-006 FILE NOT FOUND AN ATTEMPT WAS MADE TO ACCESS A FILE THAT CANNOT BE FOUND. CHECK THE FILE NAME. "" ACCT-005 RECORD LENGTH ILLEGAL AN ATTEMPT WAS MADE TO READ OR POSITION A FILE TO A RECORD THAT HAS NOT BEEN WRITTEN, OR TO WRITE AN ILLEGAL RECORD LENGTH ON AN UPDATE. CHECK THE FILE POSITION OR SIZE PARAMETER. "" ACCT-004 MORE THAN 32767 RECORDS IN A TYPE 2 FILE AN ATTEMPT WAS MADE TO CREATE A TYPE 2 FILE WITH TOO MANY RECORDS OR WITH A RECORD SIZE THAT IS TOO LARGE. CHECK THE SIZE PARAMETER. "" ACCT-003 BACKSPACE ILLEGAL AN ATTEMPT WAS MADE TO BACKSPACE A DEVICE (OR TYPE 0 FILE) THAT CANNOT BE BACKSPACED. CHECK THE DEVICE TYPE. "" ACCT-002 DUPLICATE FILE NAME A FILE ALREADY EXISTS WITH THE NAME SPECIFIED. REPEAT THE COMMAND WITH A NEW NAME OR PURGE THE EXISTING FILE. "" ACCT-001 DISC ERROR THE DISC IS DOWN. TRY AGAIN AND t������þú THEN REPORT THE PROBLEM TO THE SYSTEM MANAGER. "" L-CK SUM THIS IS A CHECKSUM ERROR. MOST LIKELY YOU SPECIFIED A FILE TO THE LOADR THAT DID NOT CONTAIN RELOCATABLE FORMAT CODE. A TYPICAL MISTAKE IS SPECIFYING THE SOURCE FILE NAME INSTEAD OF THE BINARY FILE NAME. IF THE FILE YOU SPECIFIED WAS THE CORRECT ONE THEN THAT FILE HAS BEEN OVERLAYED OR CORRUPTED. PURGE THAT FILE AND RECOMPILE THE ORIGINAL SOURCE AND TRY AGAIN. "" L-IL REC THE LOADR FOUND A RECORD THAT WAS NOT A NAM, ENT, EXT, DBL, EMA, GEN, LOD, OR END RECORD. THE CHECKSUM WAS OK BUT THE RECORD WAS UNIDENTIFIED. WAS THE FILE SPECIFIED A RELOCATABLE FILE ? TRY RECOMPILING AND LOADING. "" L-OV MEM THE SIZE OF THE CODE LOADED SO FAR EXCEEDS THE MAX SIZE THAT YOU SPECIFIED OR EXCEEDS THE LARGEST POSSIBLE SIZE FOR A PROGRAM. MAX SIZE FOR LARGE BACKGROUND (LB) NON EMA PROGRAMS IS 28K WORDS (INCLUDING BASE PAGE) AND 26K FOR LB EMA PROGRAMS. CONSULT THE GENERATION MAP FOR THE MAX SIZE OF REAL TIME AND BACKGROUND PROGRAMS. IF YOUR PROGRAM IS JUST TOO LARGE THE FOLLOWING SOLUTIONS MIGHT BE TRIED: 1. IF THE PROGRAM IS NOT TYPE 4 (LARGE BACKGROUND [LB]) MAKE IT A TYPE 4 BY SPECIFYING THE ' OP,LB ' COMMAND TO THE LOADR. 2. IF YOU SPECIFIED A SIZE, THEN DON'T SPECIFY A SIZE THE LOADR WILL DO ALL IT CAN TO MAKE YOUR PROGRAM FIT. 3. SEGMENT THE PROGRAM 4. TRY WRITING SOME OF THE PROGRAM IN ASSEMBLY 5. SEE IF THERE ARE ANY DATA DECLARATIONS THAT CAN BE REMOVED OR ANY DATA DECLARATIONS THAT CAN BE MOVED TO EMA. "" L-OV BSE BASE PAGE OVERFLOW. THIS PROGRAM HAS USED TOO MANY BASE PAGE LINKS. IF THE CP OPTION WAS NOT USED, TRY USING IT TO PUT LINKS ON THE CURRENT PAGE INSTEAD OF ALL ON THE BASE PAGE. IF THE CP OPTION WAS USED, RELOAD THE PROGRAM BUT THIS TIME SPECIFY THE 'OP, LE' OPTION. THIS WILL LIST ALL ENTRY POINTS AND THE BASE PAGE LINKAGES. THIS LOAD WILL ALSO FAIL,pF������þú HOWEVER, NOW YOU KNOW WHICH MODULES ARE USING UP ALL THE LINKS. BY USING THE LO,XXXXX COMMAND AND ALIGNING THOSE MODULES TO PAGE BOUNDARIES THE LINKAGE NEEDS CAN BE REDUCED. ALTERNATELY YOU MAY WISH TO REARRANGE THE LOADING ORDER OF YOUR SUBROUTINES. THIS MAY IMPROVE (OR MAKE WORSE) THE LINKAGE NEEDS OF YOUR PROGRAM. "" L-OV SYM THIS IS A SYMBOL TABLE OVERFLOW. THE LOADR NEEDS MORE ROOM FOR ITS INTERNAL SYMBOL TABLE AND FIX UP TABLE. SINCE THE LOADR IS A TYPE 4 PROGRAM IT CAN BE MADE AS LARGE AS THE LARGEST NORMAL BACKGROUND PARTITION. TO GIVE THE LOADR MORE ROOM USE THE ' SZ ' OPERATOR COMMAND. THAT IS, *SZ,LOADR,XX XX = # OF PAGES OR FROM FMGR, :SYSZ,LOADR,XX BY INCREASING THE SPACE FOR THE LOADR THE L-OV SYM PROBLEM SHOULD BE SOLVED. CONSULT THE RTE-IVB TERMINAL USER'S REFERENCE MANUAL FOR MORE INFORMATION ON THE 'SZ ' COMMAND. IF THE SZ COMMAND DOES NOT SOLVE THE PROBLEM, THEN TRY USING THE LOADR ' SE ' COMMAND AFTER EVERY LOADR 'RE' COMMAND. THIS WILL REDUCE SPACE NEEDED FOR FIXUPS. IN ADDITION TO USING THE 'SE' COMMAND AFTER EVERY 'RE' COMMAND, TRY LOADING A NUMBER OF YOUR SUBROUTINES (STILL DOING 'SE') BEFORE THE MAIN OF THE PROGRAM. "" L-CM BLK THIS IS A COMMON BLOCK ERROR. THIS ERROR OCCURS IF THE LARGEST COMMON DECLARATION OF A PROGRAM DOES NOT APPEAR IN THE FIRST MODULE OF THE PROGRAM LOADED. PROGRAMS THAT USE COMMON MUST DECLARE THAT COMMON IN THE FIRST ROUTINE LOADED AND THAT COMMON DECLARATION MUST BE THE LARGEST ENCOUNTERED IN THE LOAD. THIS ERROR IS ALSO GENERATED IF THE AMOUNT OF COMMON REQUESTED EXCEEDS THAT WHICH IS AVAILABLE. "" L-DU ENT DUPLICATE ENTRY POINT. GENERALLY THIS OCCURS WHEN THE SAME SUBROUTINE WAS LOADED TWICE. ALTERNATELY YOU NAMED A SUBROUTINE WITH THE SAME NAME (ENT IN ASMB) THAT WAS ALREADY BEING USED SOMEWHERE ELSE WITHIN THE PROGRAM THAT YOU WERE TRYING TO LOAD. CONFUSION SOMETIMES OCCURS WITH SEGMENTED PROGRAMS. A SUBROUTINE LOADED WITH THE MAINw{������þú MUST NOT BE AGAIN LOADED WITH A SEGMENT. LOOK AT THE LOAD MAP FOR THE LOAD. DID YOU TRY TO LOAD THE SUBROUTINE WITH A SEGMENT WHERE THAT SUBROUTINE WAS ALREADY LOADED WITH THE MAIN ? THE LOAD MAP WILL LIST ALL SUBROUTINES LOADED WITH THE MAIN. "" L-TR ADD NO TRANSFER ADDRESS. ONLY SUBROUTINES WERE LOADED. THE LOADR COULD NOT TELL WHICH MODULE OF THE PROGRAM WAS THE MAIN AND WHICH ONES WERE SUBROUTINES. IF THE PROGRAM WAS WRITTEN IN FORTRAN NO MODULES WERE FOUND THAT CONTAINED THE 'PROGRAM XXXXX' STATEMENT. IF THE PROGRAM WAS WRITTEN IN ASMB YOU PROBABLY FORGOT TO PUT A LABEL ON THE END STATEMENT. IN ASMB THE MAIN OF A SEGMENT OR OF A PROGRAM IS DIFFERENTIATED FROM SUBROUTINES BY PLACING THE LABEL OF WHERE THE PROGRAM OR SEGMENT IS TO START EXECUTION AS THE OPERAND OF THE END STATEMENT. IF MULTIPLE ROUTINES HAVE LABELS ON THE END STATEMENT THE FIRST ONE ENCOUNTERED IS USED AS THE MAIN OF THE PROGRAM. "" L-RE SEQ RECORD OUT OF SEQUENCE. THE LOADR WAS RELOCATING AND ENCOUNTERED RECORDS IN THE WRONG ORDER. RELOCATABLE RECORDS ARE IN THE ORDER OF GEN/LOD, NAM, ENT, EXT, DBL, AND END. GENERALLY THIS ERROR OCCURS WHEN RELOCATING FROM AN LU, SAY A MAG TAPE, AND THE TAPE IS INCORRECTLY POSITIONED. IF THE RELOCATION WAS FROM A FILE, RECOMPILE THE SOURCE AND TRY AGAIN, AS THE FILE IS CORRUPT. "" L-IL PRM THE RUN STRING SUBMITTED TO THE LOADER WAS IN ERROR. TRY AGAIN. "" L-CO RES ATTEMPT TO REPLACE A MEMORY RESIDENT PROGRAM. YOU TRIED TO REPLACE A MEMORY RESIDENT PROGRAM. THIS IS ILLEGAL. "" L-OV FIX THIS IS A FIXUP TABLE OVERFLOW. THE LOADR NEEDS MORE ROOM FOR ITS INTERNAL SYMBOL TABLE AND FIX UP TABLE. SINCE THE LOADR IS A TYPE 4 PROGRAM IT CAN BE MADE AS LARGE AS THE LARGEST NORMAL BACKGROUND PARTITION. TO GIVE THE LOADR MORE ROOM USE THE ' SZ ' OPERATOR COMMAND. THAT IS, *SZ,LOADR,XX XX = # OF PAGES OR FROM FMGR, :SYSZ,LOADR,XX BY INCREASING THE SPACE FOR THE LOADR THE L-OV Sþ������þúYM PROBLEM SHOULD BE SOLVED. CONSULT THE RTE-IVB TERMINAL USER'S REFERENCE MANUAL FOR MORE INFORMATION ON THE ' SZ ' COMMAND. IF THE SZ COMMAND DOES NOT SOLVE THE PROBLEM, THEN TRY USING THE LOADR ' SE ' COMMAND AFTER EVERY LOADR 'RE' COMMAND. THIS WILL REDUCE SPACE NEEDED FOR FIXUPS. IN ADDITION TO USING THE 'SE' COMMAND AFTER EVERY 'RE' COMMAND, TRY LOADING A NUMBER OF YOUR SUBROUTINES (STILL DOING 'SE') BEFORE THE MAIN OF THE PROGRAM. "" L-LM LIB THE LIMIT ON THE NUMBER OF LIBRARIES SPECIFIED BY THE 'LI' COMMAND HAS BEEN EXCEEDED. YOU MAY SPECIFY 10 LIBRARIES. INSTEAD OF SPECIFYING ANOTHER LIBRARY YOU CAN SPECIFICALLY DO A 'SE' OF THE FILE. "" L-IL REL THE COMPILER PRODUCED AN ILLEGAL RECORD. ONE OF THE FOLLOWING OCCURRED: THE NUMBERS OF ENTRIES SPECIFIED IN AN ENT OR EXT RECORD WAS ZERO. THE NUMBER OF INSTRUCTION WORDS SPECIFIED IN A DBL RECORD WAS ZERO. A RELOCATABLE INDICATOR IN A DBL RECORD WAS SEVEN. A DBL RECORD WAS PRODUCED THAT REFERENCED AN EXTERNAL BUT THAT EXTERNAL WAS NOT IN ANY OF THE EXT RECORDS. ALL OF THE ABOVE ARE IMPOSSIBLE CONDITIONS. RECOMPILE AND TRY AGAIN. THIS COULD ALSO BE A COMPILER BUG. "" L-IL PTN YOU SPECIFIED A PARTITION IN THE LOAD OF THE PROGRAM, HOWEVER, THAT PARTITION DOES NOT EXIST OR HAS BEEN DOWNED DUE TO A PARITY ERROR. TRY AGAIN, THIS TIME SPECIFY A PARTITION THAT EXISTS OR DON'T SPECIFY ANY PARTITION AT ALL. "" L-RQ PGS THE NUMBER OF PAGES THAT YOU SPECIFIED IN THE LOAD OF THE PROGRAM EXCEEDS THAT NUMBER OF PAGES IN THE PARTITION YOU SPECIFIED. EITHER SPECIFY A DIFFERENT PARTITION OR NO PARTITION AT ALL. "" L-OV PTN THE SPECIFIED PROGRAM SIZE IS TOO LARGE FOR THE PARTITION. EITHER SPECIFY A SMALLER SIZE OR NO SIZE AT ALL. SEE ALSO L-OV MEM ERROR FOR OTHER ALTERNATIVES. "" L-ML EMA ILLEGAL EMA DECLARATION. TWO DIFFERENT EMA LABELS WERE USED, OR THE EMA DECLARATION WAS NOT MADE IN THE MAIN OF A PROGRAM AND THAT MAIN LOADED FIRST, OR AN EMA LABEL WAS ALSO DECLARED AS AN ENTRY-������þú POINT IN ANOTHER MODULE. THE EMA DECLARATION MUST BE IN THE MAIN OF THE PROGRAM AND THAT MAIN MUST BE THE FIRST MODULE LOADED. THE EMA STATEMENT MUST BE IN ANY SEGMENT OR SUBROUTINE REFERENCING ANY ELEMENT IN EMA. "" L-ID EXT NO ID EXTENSIONS AVAILABLE FOR THE EMA PROGRAM. YOU MUST FREE UP SOME ID EXTENSIONS BEFORE THE EMA PROGRAM CAN BE SUCCESSFULLY LOADED. "" L-SZ EMA THE PROGRAMS DECLARED EMA SIZE IS TOO LARGE FOR THIS SYSTEMS PARTITIONS DEFINITION, IE THERE IS NO EXISTING PARTITION LARGE ENOUGH TO RUN THIS PROGRAM. EITHER REBOOT AND RECONFIGURE SYSTEM TO ALLOW MORE EMA SPACE OR DECLARE LESS EMA SPACE IN THE PROGRAM. "" L-SS ENT YOU ATTEMPTED TO ACCESS AN SSGA ENTRY POINT BUT YOU DID NOT ASK FOR SSGA AT THE BEGINNING OF THE LOAD. RELOAD THE PROGRAM BUT THIS TIME DO A 'OP,SS' AT THE BEGINNING OF THE LOAD. "" L-IL CMD ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO USE THE 'LI' OR 'PU' COMMANDS WITHIN A LOADR COMMAND FILE. LI AND PU COMMANDS ARE NOT ALLOWED WITHIN A LOADR COMMAND FILE UNLESS THAT COMMAND FILE IS AN INTERACTIVE DEVICE (IE A TTY OR CRT). "" L-ID SEG NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH THE LOAD. THIS IS AN EXTREMELY RARE ERROR. THE LOADR WAS CREATING ID SEGMENTS AND THERE WERE ENOUGH ID SEGMENTS AT THE BEGINNING TO FINISH THE LOAD, HOWEVER, BETWEEN CREATING ONE ID SEGMENT AND CREATING THE NEXT ALL OTHER ID SEGMENTS WERE USED UP (MAYBE ANOTHER LOADR OR FILE MANAGER GOT THEM) AT ANY RATE THERE AREN'T ENOUGH TO FINISH THE LOAD. THE PROPER RESPONSE TO THIS ERROR IS TO ' OF ' OR PURGE ALL SEGMENTS AND THE MAIN OF THE LOAD THAT WAS JUST UNSUCCESSFUL, FREE UP SOME ADDITIONAL ID SEGMENTS AND TRY THE LOAD AGAIN. IF ENOUGH ID SEGMENTS ARE FREED UP THE LOAD WILL SUCCEED. THIS ERROR COULD ONLY OCCUR IN SEGMENTED LOADS. "" L-RF EMA ATTEMPT TO ACCESS AN EMA EXTERNAL WITH OFFSET OR INDIRECT. IF THIS IS A FORTRAN PROGRAM YOU MORE THAN LIKELY FORGOT TO PUT THE $EMA STATEMENT IN A SUBROUTINE THAT ACCëç������þúESSED AN EMA ELEMENT. IF THE PROGRAM WAS WRITTEN IN ASMB USE THE H-P SUPPLIED ROUTINES .EMAP AND .EMIO TO MAP IN THE ARRAYS AND THEN INDEX INTO THE ARRAY VIA THE ADDRESS RETURNED, NOT VIA A REFERENCE TO THE EMA LABEL. "" L-UN EXT UNDEFINED EXTERNALS EXIST WHICH PROHIBITS THE LOAD FROM COMPLETING. AN UNDEFINED EXTERNAL IS A REFERENCE MADE BY THE ROUTINE YOU ARE LOADING TO ANOTHER ROUTINE. FOR EXAMPLE IF YOUR FORTRAN PROGRAM HAD THE FOLLOWING CODE : CALL XYZ(I,J,K) THEN THE SUBROUTINE XYZ WOULD BE AN EXTERNAL. THE PROBLEM YOU HAVE IS THAT YOU LOADED THE ROUTINE THAT CONTAINED THE CALL TO XYZ BUT YOU DIDN'T LOAD THE XYZ SUBROUTINE ITSELF. XYZ IS THE UNDEFINED EXTERNAL. THE PROPER COURSE HERE IS TO RELOAD YOUR PROGRAM BUT THIS TIME DON'T FORGET TO LOAD THE ROUTINES LISTED WHEN THE LOADR ABORTED THE LAST TIME YOU TRIED TO LOAD THE PROGRAM. ONE LAST POINT. IT IS POSSIBLE TO FORCE LOAD A PROGRAM OR SEGMENTS THAT HAVE UNDEFINED EXTERNALS. THIS IS DONE WITH THE LOADR 'FORCE' COMMAND. HOWEVER, IF YOU FORCE LOAD THE PROGRAM IT IS YOUR RESPONSIBILITY TO MAKE SURE THAT THE LINE OF CODE THAT REFERENCES THE EXTERNAL IS NEVER EXECUTED. THAT IS, MAKE SURE THAT THE CALL TO XYZ IS NOT EXECUTED OR YOUR PROGRAM WILL PROBABLY BE ABORTED WITH A DM OR MP ERROR. "" L-EX CPY ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF THAT PROGRAM EXIST. IT IS NOT POSSIBLE TO REPLACE OR PURGE A PROGRAM FROM THE SYSTEM IF COPIES OF THAT PROGRAM EXIST. THE PROBLEM HERE IS THAT OTHER COPIES OF THE SAME PROGRAM EXIST AND MAY BE IN USE. THE PROPER COURSE HERE IS TO DO AN ' OF,PROG,8 ' ON ALL THE PROGRAMS LISTED AS COPIES. THIS WILL GET RID OF THOSE PROGRAMS SO THAT YOU CAN PERFORM THE PROGRAM PURGE OR REPLACE. NOTE THAT THIS PROCESS SHOULD ONLY BE DONE BY THE SYSTEM MANAGER. "" L-RP CPY ATTEMPT TO REPLACE A COPIED PROGRAM. YOU TRIED TO DO A PROGRAM REPLACE ON A PROGRAM THAT WAS A COPY OF ANOTHER PROGRAM. REPLACEMENT OPERATIONS MAY ONLY BE¯‹���T��RN DONE ON THE ORIGINAL PROGRAM NOT THE COPIED PROGRAM. THE PROPER THING TO DO NOW IS EDIT THE SOURCE OF YOUR PROGRAM AND MAKE SURE THE NAME IS THE ORIGINAL PROGRAM NAME. "" L-PE LDR TRYING TO DO A PURGE OR PERMANENT LOAD WITH A COPY OF THE LOADR. RE-RUN THE LOADR USING THE REAL PROGRAM: RU,LOADR:IH. "" L-DU PGM THIS PROBLEM RESULTS WHEN YOU TRY TO LOAD THE SAME PROGRAM SEVERAL TIMES BUT DO NOT GET RID OF THE EARLIER LOADS. FOR EXAMPLE, YOU LOADED A PROGRAM CALLED XXXXX AND FOR SOME REASON LOADED THE SAME PROGRAM AGAIN. IN THIS CASE THE LOADR WARNED YOU WITH A W-DU PGM WARNING MESSAGE AND THEN RENAMED YOUR PROGRAM TO ..XXX. THAT IS THE LOADR FORGIVES YOU THE FIRST TIME. HOWEVER, YOU HAVE NOW LOADED A PROGRAM WITH THE SAME NAME A THIRD TIME. THE LOADR WILL NOT FORGIVE THIS AGAIN. THE SOLUTION IS TO DO A :OF,XXXXX,8 :OF,..XXX,8 AND NOW START THE LOAD OVER AGAIN. "" L-NO IDS NOT ENOUGH ID SEGMENTS TO FINISH THE LOAD. YOUR SYSTEM HAS RUN OUT OF ID SEGMENTS. CALL THE SYSTEM MANAGER TO FREE UP SOME ID SEGMENTS. HE WILL PROBABLY USE THE OFF COMMAND TO PURGE SOME PROGRAMS FROM THE SYSTEM. "" L-RP PGM YOU TRIED TO REPLACE A PERMANENT PROGRAM. HOWEVER, THAT PROGRAM TERMINATED SERIALLY REUSABLE, SAVING RESOURCES, OR WAS OPERATOR SUSPENDED. THAT IS, THE PROGRAM STILL OWNED A SYSTEM PARTITION. OFF THE PROGRAM AND REPEAT THE LOAD. "" ������������������������������������������������������������������������������������������������������������������������������������������������������������������������&sT������ÿÿ����� ���� ÿý�¼�Ï ���������ÿ��92067-18491 2013� S C0122 �&SAVST � � � � � � � � � � � � � �H0101 {¨�����ASMB,L,C,Q * NAME: SAVST * SOURCE: 92067-18491 * RELOC: 92067-16268 * PGMR: D.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SAVST,6 92067-1X491 REV.2013 790924 * * * THE FUNCTION OF SUBROUTINE SAVST IS TO SAVE THE RUN STRING * SO THAT IT IS NOT RELEASED BY THE OPERATING SYSTEM BEFORE * THE PROGRAM HAS RETRIEVED IT. SINCE THE RUN STRING IS NOT * RELEASED IN RTE-IVB UNTIL THE PROGRAM TERMINATES, SAVST IN * RTE-IVB HAS NO FUNCTION EXCEPT TO PROVIDE FOR COMPATIBILITY * WITH RTE-L. * * CALLING SEQUENCE: CALL SAVST * * * ENT SAVST EXT .ENTR * * SAVST NOP JSB .ENTR CALL .ENTR TO SET UP RETURN ADDRESS DEF SAVST JMP SAVST,I RETURN TO CALLER END ����������������������������������������������������������������������������������������������������������������������������(|������ÿÿ����� ���� ÿý�½�à ���������ÿ��92067-18500 1940� S C0122 �&SGBPT �DBUGR BREAK POINT TABLE � � � � � � � � � � � � �H0101 †×�����ASMB,R,Q,C * * DATE:790907 * NAME:SGBPT * SOURCE: 92067-18500 * RELOC: 92067-16075 * PGMR: R.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SGBPT,7 92067-16075 REV.1940 790907 ENT SGBPT,SGBPE SGBPT DEF *+1 REP 10 OCT 0,0,0,0,0 SGBPE DEF * END ����������������������������������������������������������������������_@������ÿÿ����� ���� ÿý�¾�Ä ���������ÿ��92067-18501 2001� S C0122 �&WHZAT �WHZAT UTILITY � � � � � � � � � � � � �H0101 Ö‚�����þúASMB,R,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * HED WHZAT FOR RTE-IV NAM WHZAT,1,1 92067-16501 REV.2001 791026 * * NAME: WHZAT * SOURCE: 92067-18501 * RELOC: 92067-16501 * PRGMR: E.J.W.,D.B. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL EXT $ELTB EXT $MATA,$MNP * A EQU 0 B EQU 1 * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B * * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * RU,WHZAT,LU,AL * * *��� *���13:37: 1:770 *���------------------------------------------------------------------------ *��� PRGRM T PRIOR PT SZ DO.SC.IO.WT.ME.DS.OP. .PRG CNTR. .NEXT TIME. *���------------------------------------------------------------------------ *���**FMG73 3 00051 22 10 * * * * 3,WHZ73 * * * * * P:42274 *��� WHZ73 3 00001 13 4 . 1, . . . . . . . . . . . P:37045 *���. *���. *���**FMG18 3 00051 20 10 * * * * 3,REA18 * * * * * P:42274 *��� REA18 3 00090 9 16 . . . 2,EQ: 8,AV:2,ST:004 P:61106 *���**FMG66 3 00051 14 10 * * * * 3,EDI66 * * * * * P:42274 *��� EDI66 3 00051 21 7 . . . 2,EQ: 12,AV:2,ST:002 P:42704 *���**FMG78 3 00051 29 10 * * * * 3,SNGGN * * * * * P:42274 *��� SNGGN 3 00099 18 14 . . . 2,EQ: 23,AV:2,ST:002 P:52640 *���**FMG84 3 00051 41 10 * * * * 3,EDI84 * * * * * P:42274 *��� EDI84 3 00051 36 15 . . . 2,EQ: 30,AV:2,ST:002 P:45055 *���**FMG70 3 00051 32 10 * * * * 3,EDI70 * * * * * P:42274 *��� EDI70 3 00051 35 15 . . . 2,EQ: 15,AV:2,ST:002 P:45055 *���**FMG74 3 00051 31Ž‡������þú 10 * * * * 3,SHE74 * * * * * P:42274 *��� SHE74 3 00051 27 14 . . . 2,EQ: 19,AV:2,ST:002 P:55304 *���. *��� R$PN$ 1 00010 0 . . . . . 3,CL 025 . . . . P:41016 *��� UPLIN 1 00003 0 . 0, . . . . . . . . . . . . P:00000 13:37: 4:120 *��� GRPM 1 00004 0 . . . . . 3,CL 039 . . . . P:45600 *��� RTRY 1 00020 0 . . . . . 3,CL 038 . . . . P:46366 *��� SPOUT 2 00011 4 3 . . . . 3,CL 024 . . . . P:34250 *��� LOGON 3 00049 30 11 . . . . 3,CL 026 . . . . P:35616 *��� LGOFF 3 00051 40 9 . . . . 3,CL 027 . . . . P:35133 *��� QCLM 3 00028 20 2 . . . . 3,CL 037 . . . . P:34045SWP *��� DLIST 3 00030 13 3 . . . . 3,CL 036 . . . . P:37113SWP *��� PROGL 3 00030 29 5 . . . . 3,CL 030 . . . . P:34065SWP *��� RFAM 3 00030 30 8 . . . . 3,CL 032 . . . . P:47203SWP *��� EXECM 3 00030 21 3 . . . . 3,CL 033 . . . . P:34054SWP *��� EXECW 3 00030 20 2 . . . . 3,CL 035 . . . . P:35614SWP *��� OPERM 3 00030 20 2 . . . . 3,CL 031 . . . . P:35377SWP *��� PTOPM 3 00030 47 2 . . . . 3,CL 034 . . . . P:34052 *��� FMG81 3 00051 45 10 . . . 2,EQ: 27,AV:2,ST:002 P:52220 *���------------------------------------------------------------------------ *���ALL LU'S OK *���ALL EQT'S OK *���LOCKED LU'S (PROG NAME) 8(REA18), *���MAX CONT. FREE TRKS : 127, LU 3 *���------------------------------------------------------------------------ *���13:37: 2:170 *��� * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IVB * RU,WHZAT,LU,PA * * 09:00:21:250 * ********************************************************************** * PTN# SIZE PAGES BG/RT PRGRM * ********************************************************************** * 1 7 42- 48 BG FMG11 * 2 15 49- 63 BG EDITR * 3 16 64- 79 RT WHZAT * 4M 48 80- 127 BG EMAPR * 5C 16 80- 95 BG <NONE> * 6C 16 96- 111 BG <NONE> * 7C 16 112- 127 BG <NONE> * 8M sm������þú 64 128- 191 RT <NONE> * 9SR 16 128- 143 RT <NONE> * 10S 16 144- 159 RT PROGQ * 11S 16 160- 175 RT SAMPL * 12SR 16 176- 191 RT <NONE> * 13 R 64 192- 255 BG EMAID * 14 <UNDEFINED> * 15 <UNDEFINED> * ********************************************************************** * 09:00:21:310 * * SKP WHAT XLA B,I RAL CHECK IF ASCHII SSA JMP WHASC YES,TREAT THIS AS SECOND PARAMETER RAR RESTORE A REGISTER CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 STA CRTLU SAVE LU FOR OUTPUT INB XLA B,I STA PARM2 SAVE SECOND PARAMETER INB XLA B,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES INB PICK UP THE XLB B,I SESID FROM LAST TIME STB SESID AND SAVE FOR NOW IF NEEDED JMP WHT1 * WHASC RAR RESTORE A REGISTER STA PARM2 STORE THAT AS SECOND PARAMETER CLA INITIALIZE SESSION AS ZERO STA SESID INA & LU NO AS 1 STA CRTLU JMP WHT1 * SPC 2 WHT1 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE JSB DASHS ERASE EOL + A LINE OF DASHES * LDA PARM2 CPA "PA" PARTITION REPORT REQUEST ? JMP WHATP YES. * LDA .HEAD GET THE HEAD LDB DM76 AND JSB PRINT PRINT IT JSB DASHS PRINT A LINE * LDA NAMSB CLEAR THE ID STACK STA NAMST (STACK OF PROCESSED ID'S) STA DLKFL SET THE DEAD LOCK FLAG * LDA PARM2 GET THE SECOND PARAMETER CPA "AL" IF ALL CODED,THEN GO REPORT ALL JMP Ø������þúFULL * CPA "SM" ALMOST ALL ? JMP FULL YES, GO DO IT. * LDA XEQT GET CURRENT SESSION ADD ADA D32 XLA A,I FROM THE ID SZA IF NOT ZERO STA SESID SAVE IT LDA SESID WELL, WHAT DO WE HAVE ?? SZA,RSS IF ZERO JMP FULL1 REPORT ALL ACTIVE PROGRAMS JMP SES * FULL EQU * LDA XEQT GET THE SESSION ADDRESS AGAIN ADA D32 XLA A,I SZA,RSS IF ZERO,NON SESSION JMP FULL1 ZERO SO REPORT ALL THE PROGRAMS * STA SESID SAVE IT JSB DOIT DISPLAY THE SESSION RELATED PROGRAMS FIRST JSB ODTSP OUTPUT AN ADDITIONAL LINE * FULL1 CLA NOW DISPLAY REST OF THE PROGRAMS STA SESID JSB DOIT YES, DO IT JMP FINIS EXIT * SES EQU * JSB DOIT DISPLAY ONLY SESSION RELATED PROGRAMS JMP FINIS * * * SUBROUTINE DO IT * DOIT NOP CLA STA IDCNT SET UP TO START THE ID SCAN STA ALL * * NXSES LDA KEYWD START THE SCAN ADA IDCNT GET KEY WORD ADDRESS XLA A,I GET THE ID ADDRESS STA IDPNT SET IT DOWN IN CASE THIS IS IT SZA,RSS END OF LIST?? JMP FINX YES GO CHECK ALL FLAG * ADA D14 IS A SHORT ID XLB A,I GET FLAG WORD BLF,BLF ROTATE IT AROUND BLF,SLB,BLF WELL?? JMP FINX YES END OF USEFUL ID'S * INA CHECK IF ID IS IN USE XLB A,I GET STATUS SZB ZERO DORMANT JMP NOTDM NOT DORMANT CONSIDER IT * ADA D2 GET THE TIME LIST WORD XLB A,I GOT IT BLF,SLB IN THE TIME LIST?? RSS YES JMP NOYET NO DON'T WORRY ABOUT THIS ONE * * * NOTDM LDA IDPNT RESTORE ‘í������þúA TO THE ID ADDRESS LDB SESID GET THE SESSION ID SZB,RSS IF ZERO JMP MAIN GO DO THE ALL TESTS * ADA D32 INDEX TO THE SESSION WORD XLA A,I GET THE WORD CPA B IN THE SESSION?? JMP THISS YES GO DO IT * NOYET ISZ IDCNT NO INDEX THE COUNT JMP NXSES AND TRY AGAIN * * THISS JSB THIS CHECK IF ALREADY REPORTED JMP NOYET ALREADY DONE DON'T DO IT TWICE * THIS1 LDB IDPNT CHECK IF THE PROGRAM IN IN A FATHER SON ADB D20 CHAIN XLA B,I GET FATHER POINTER RAL POSITION THE BIT SSA IS THEIR A FATHER? JMP POP YES GO TRY HIM * ADB DM5 NO TRY FOR A SON XLA B,I GET STATUS WORD AND B10K ISOLATE THE WAITING BIT SZA SET?? JMP PRGN1 YES THIS IS A PROGININATOR * LDA ALL AN INDEPENDENT PROG. CHECK IF OK TO REPORT SZA WELL? JMP PRGN1 YES GO DO IT * JMP NOYET NO SKIP IT * POP RAR THERE IS A FATHER GO UP TO GET HIM AND B377 ISOLATE HIS NUMBER ADA M1 AND COMPUTE HIS ADA KEYWD ADDRESS XLA A,I GET HIS ID ADDRESS LDB IDPNT SAVE THE CURRENT ONE STB PROCS IN TEMP STA IDPNT AND SET IT UP JSB THIS HAVE WE BEEN HERE BEFORE?? RSS YES SKIP FOR FURTHER TESTS JMP THIS1 NO GO CHECK IF THE PROGIN. YET * LDB ALL CHECK IS SECOND SCAN CPB D2 IF SO THEN IT IS NOT AN ERROR RSS ELSE LET JMP THIS1 NATURE TAKE ITS COURSE * LDA PROCS NOT ERROR STA IDPNT RESTORE THE SON AND * PRGN1 CLA STA PRGFL INITIALIZE THE 'PROGINATOR' FLAG * PROGN JSB THIS MAKE SURE WE ARE NOT IN A LOOP JMP DEAD REPORT A DEAD LOCK * JSB STKNA WE ARE GOING TO PRINT THIS ONE ž������þú LDB D15 GET STATUS JSB IDWRD AND AND B17 SET IT UP STA STATS FOR THE PROCS SUB. JSB PROCS PROCESS IT LDA SON CHECK IF A SON FOUND SZA IF SO STA IDPNT SET UP TO PRINT HIM SZA WELL?? JMP PRGN1+1 YES GO DO IT * LDB ALL IF ALL IS 2 THEN CPB D2 DON'T RESET IT LDA B STA ALL CLEAR ALL IF NOT 2 LDB LNAID IF LAST NAME PRINTED WAS NOT SZB,RSS THE ONE WE WERE REPORTING JMP ENDBL (IT WAS SKIP IT) * STB IDPNT AND SET UP TO RUN DOWN THE BLOCK CPA D2 IF ALREADY IN INDEPENDENTS RSS DON'T STEP ALL ISZ ALL ELSE SET THE ALL FLAG DLD BLOCK TELL HIM WHAT WE ARE DOINT JSB PRINT JMP THIS1 * ENDBL EQU * CLA STA PRGFL INITIALIZE THE PROG FLAG LDA NAMST UP DATE THE STA DLKFL THE DEAD LOCK FLAG JMP NOYET AND CONTINUE SCAN * * FINX CLA STA IDCNT START THE SCAN ALL OVER CPA ALL IF ALL READY DONE RSS THEN JMP DOIT,I RETURN FROM THE SUBROUTINE * LDA D2 AND STA ALL SET UP TO PICK UP THE INDEPENDENTS JSB ODTSP OUTPUT A SEPARATION LINE JMP NXSES GO DO IT * * DEAD CMA CHECK IF A TRUE DEAD LOCK ADA DLKFL TRUE IF IN SAME DEPEND LOOP SSA,RSS WELL JMP DEAD2 NO JUST A COLISION * DLD DEMES SEND THE DEAD LOCK MESSAGE JSB PRINT DEAD2 JSB SETPT SEND A WARNING MESSAGE AND LDA .SEAB SET UP THE SEE ABOVE MESSAGE JSB MVBYT MOVE IT IN DEF .SEAB+1 LDA IDPNT GET THE NAME TO REFERENCE JSB MVNAM AND MOVE IT INTO THE MESSAGE CLA STA LNAID CLEAR THE FLAG WORD JSB OUTPT SEND THE LINE TO THE DEVICE LDB ALL IF DOING ALL O–������þúCPB D2 THEN JMP ENDBL JUST CONTINUE * CLA ELSE CLEAR STA ALL THE FLAG JMP ENDBL AND CONTINUE * * STKNA NOP STACK AN ID SEGMENT ADDRESS LDA IDPNT STA NAMST,I ISZ NAMST PUSH POINTER JMP STKNA,I AND RETURN * * THIS NOP CHECK IF ID IS IN STACK (P+1 IF SO, ELSE P+2) LDA NAMSB GET STACK BASE THISO CPA NAMST END OF STACK? JMP THISX YES ALL OK * LDB A,I NO GET THE ENTRY CPB IDPNT HERE ALREADY? JMP THIS,I YES EXIT * INA NO TRY NEXT ONE JMP THISO * THISX ISZ THIS NOT FOUND EXIT JMP THIS,I * PRGFL NOP SON NOP LNAID NOP ID ADDRESS OF LAST NAME PRINTED XEQT EQU 1717B SESID NOP B10K OCT 10000 DM5 DEC -5 ALL NOP "AL" ASC 1,AL "SM" ASC 1,SM "PA" ASC 1,PA * BLOCK DEF *+2 DEC -15 OCT 0,0 ASC 6,** BLOCK ** INDEP DEF *+2 DEC -6 OCT 0,0 ASC 1,** DEMES DEF *+2 DEC -28 OCT 0,0 ASC 12,*********** DEAD LOCK ** .SEAB DEF *+2 DEC 32 OCT 0,0 ASC 14,*** SEE ABOVE FOR REPORT ON NAMST NOP DLKFL NOP NAMSB DEF *+1 BSS 256 SPC 2 * MAIN ADA D15 VERIFY XLA A,I THAT THIS AND B17 IDSEG(16[4-0])=PROG STATUS CPA D3 IF IN GEN WAIT JMP MAYBE GO TEST FOR "SOME OPTION" * SZA NOT DORMANT ? JMP THISS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDWRD THAT THIS ALF,SLA IDSEG(18[12])=TIME LIST INDICATOR JMP THISS PROG IS IN TIME LIST ! * JMP NOYET ELSE GO TRY THE NEXT ONE * MAYBE LDA ALL IF DOING FATHER SON TYPES LDB PARM2 OR IF NOT "SOME OPTION CPB "SM" THEN SZA,RSS GO JMP THISS GO DO IT * JMP NOYET ELSE TRY NEXT ONí¦������þúE * * ********************************************************************** * SUBROUTINE ODTSP * OUTPUTS A LINE CONTAINING ONLY A DOT AND A SPACE ************************************************************************ * ODTSP NOP RETURN ADDRESS JSB SETPT RESET STACK LDA .DTSP DOT & SPACE JSB MVBYT PUSH ON THE STACK DEF D2 JSB OUTPT OUTPUT JMP ODTSP,I RETURN * * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D8 DEC 8 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D21 DEC 21 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 36 .STAK DEF STACK STKPT NOP .TM. DEF STACK+32 .DNTM DEF STACK+27 .PR. DEF STACK+27 .LAST DEF STACK+37 ADASH OCT 0,0 UNL REP 36 ASC 1,-- LST .ASTE DEF ADASH * .SPAC DEF *+1 UNL REP 36 ASC 1, LST * .DTSP DEF *+1 UNL REP 20 ASC 1,. LST * .STSP DEF *+1 UNL REP 20 ASC 1,* LST DM4 DEC -4 D7 DEC 7 SPC 4 PROCS NOP JSB SETPT CLEAR THE STACK CLB AND STB SON THE SON FLAG * JSB PSPAC PUSH 2 SPACES JSB PSPAC * * * DISPLAY PROGRAM'S NAME * LDA IDPNT ID SEG ADDRESS JSB MVNAM MOVE NAME TO OUTPUT STACK CLA STA LNAID CLEAR NAME MOVED FLAG FOR SESSION REPORTS JSB PSPAC PUSH A SPACE * * PUSH THE TYPE TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD AND D7 MASK OFF IDSEG(15[2-0]) STA TYP SAVE IT JSB .ASC1 & STORE THE BYTE LDB D28 LDA TYP GET THE TYPE CPA D1 IS IT MEMO¦9������þúRY RESIDENT ? CLA,RSS YES,SKIP EMA STUFF JSB IDWRD LDB .SPAC SZA IS IT EMA ? LDB .E YES ,PUT 'E' IN LINE LDA B ELSE USE THE SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH IN THE PRIORITY PRIOR LDB D6 GET PROGRAM PRIORITY JSB IDWRD IN A-REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD GET (IDWRD+20) LDB .SPAC SSA IF RUNNING UNDER BATCH LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH THE PARTITION SIZE LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM ? RSS JMP PRLNG NO, PROCESS DISK RESIDENT * LDA .RSDT YES,RESIDENT PROGRAM JSB MVBYT PRINT IT IN PARTITION 0 DEF D6 JMP STAT * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PARTITION SZA NO, WAS IT IN ANY PTTN JMP PRPTN YES, ASSIGNED OR IN PTTN * LDB D8 JSB IDWRD HAS PROG BEEN SUSPENDED BEFORE SZA JMP PRPT YES, THEN PARTITION # 1 IS OK * LDA .SPAC NO,PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG PRPT CLA PRPTN INA CONVERT TO ASCII JSB .ASC2 AND ADD TO STACK * PRASG LDA .SPAC LDB NUM SSB WAS PROG. ASSIGNED TO PTTN LDA .A YES, PUT 'A' IN LINE JSB MVBYT ELSE, PUT A ¨U������þúSPACE IN LINE DEF D1 * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 JSB PSPAC SPACE * * STAT EQU * CLA INITIALIZE THE STR VAR.(DEFAULT IS DOTS) STA STR * LDA STATS CALCULATE STATUS COLM. SZA,RSS DORMANT ? JMP M NO DOTS/STARS NECESSARY MPY D3 3 CHAR PER COLUMN SLA IF ODD,SUBTRACT 1 FROM IT ADA M1 STA NUM * LDA STKPT SAVE THE CURRENT STACK POINTER STA PTR * LDA .DTSP FOR OTHERS PUSH DOTS AND SPACES JSB MVBYT DEF NUM # OF BYTES. * LDB STATS IF STATUS ODD,ADD ADDITIONAL SPACE SLB JSB PSPAC PUSH ADDITIONAL SPACE * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC1 & PUSH ONTO STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 * LDA STATS GET STATUS CPA D2 I/O SUSPEND ? JMP EQT YES, PROCESS EQT # CPA D3 GENERAL WAIT ? JMP WAIT YES. JMP TLIST JUMP TO TLIST TO PROCESS PROG CNT & TIME * TYP NOP EQTPT NOP #EQTS NOP .RSDT DEF *+1 ASC 3, 0 . .A DEF *+1 ASC 1,AA .B DEF *+1 ASC 1,BB .E DEF *+1 ASC 1,EE D28 DEC 28 D50 DEC 50 DM100 DEC -100 * * STATE 2 - I/O WAIT PROCESSING EQT CLA STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 15 WORD EQT ADA EQTA STA EQTPT SAVE THIS EQT7S ADDRESS XLA A,I GET CONTENTS OF EQT'S FIRST WORD * IDSLP SZA,RSS ô4������þú SCAN SUSPEND LIST. NULL LIST ? JMP NXTEQ YES, GO TO NEXT EQT CPA IDPNT NO, POINT TO OUR ID SEG JMP FNDEQ YES, GO PROCESS SSA IF INDIRECT, MUST BE GARBAGE JMP NXTEQ XLA A,I NO, NEXT LIST ELEMENT JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT COUNTER LDA #EQTS ARE WE THROUGH ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES, MUST BE OSCAR JMP EQTLP NO GO TO EQT LOOP * OSCAR LDA .EXEC MOVE EXEC ON STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST & PROG CNTR * * .EXEC DEF *+1 ASC 3,EXEC B140K ABS 140000B .LPAR DEF *+1 ASC 1,( * .EQ DEF *+1 ASC 2,EQ: .AV DEF *+1 ASC 2,,AV: .CMBL EQU .AV .ST DEF *+1 ASC 2,,ST: B300 ABS 300B B70 ABS 70B * FNDEQ EQU * * FDEQ0 LDA .EQ MOVE EQ: JSB MVBYT DEF D3 * LDA #EQTS CALCULATE EQT# INA JSB .ASC3 CONVERT TO ASCII * FDEQ1 LDA .AV PUSH ',AV:' ON THE STACK JSB MVBYT DEF D4 * LDB EQTPT GET DEVICE LOG STATUS ADB D4 LDA B,I GET THE STATUS WORD STA EQST SAVE IT AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONVERT TO ASCII & STORE * LDA .ST PUSH ',ST:' ON STACK JSB MVBYT DEF D4 * * NOW, CONVERT THE STATUS WORD INTO THE OCTAL ADDRESS LDA EQST STATUS WORD AND B300 ISOLATE THE STATUS WORD CLB RRR 6 SHIFT IT RIGHT BY 6 JSB .ASC1 PRINT IT * LDA EQST Î������þú STATUS WORD AND B70 CLB RRR 3 JSB .ASC1 PRINT SECOND OCTAL DIGIT LDA EQST AND D7 CLB JSB .ASC1 PRINT THE THIRD DIGIT * JMP TLIST PROCESS PRG CNT & TIME LIST * DM8 DEC -8 D20 DEC 20 D27 DEC 27 REASN NOP TEST EQU REASN EQST NOP * WAIT EQU * XLB $ELTB GET THE ADDRESS OF THE EQT LOCK TABLE STB .ELTB SAVE IT CLB,INB GET IDSEG(2) JSB IDWRD STA REASN CPA .RNTB RESOURCES LOCK ? JMP RESLK YES-PUSH "RESOURCE" ONTO STACK * CPA .CLAS NO-CLASS LOCK ? JMP CLSLK YES-PUSH "CLASS #" ONTO STACK * CPA .ELTB CHECK IF EQT LOCK TABLE FULL JMP LKWT YES, DISPLAY THAT MESSAGE * CPA D4 NO-DEVICE DOWN ? JMP DEVDN YES-PUSH "DEVICE DOWN" ONTO STACK * JSB TSTWD RNTBL<=IDSEG(2)<=[RNTBL] ? .RNTB DEF $RNTB+0 JMP RNLCK YES-PUSH "RN LOCK" ONTO STACK * JSB TSTWD CLASS<=IDSEG(2)<=[CLASS] ? .CLAS DEF $CLAS+0 JMP CLGET YES-PUSH "CLASS GET" ONTO STACK * JSB TSTWD EQTLOCK <=IDSEG(2)<=[EQTLOCK] .ELTB NOP JMP EQLK * LDA 1650B EQT <= IDSEG(2) <= #EQTS CMA,INA - S.A. OF EQT ADA REASN + POINTER SSA IF -, THEN POINTER < EQT S.A. JMP SONID FORGET IT CLB RESULT IS ADD REL S.A.EQT DIV D15 MOD 15 INA + 1 STA TEMP = EQT # CMA,INA -EQT# ADA 1651B + # EQT'S SSA,RSS IF POS,THEN VALID EQT # JMP BL SO PROCESS IT * SONID EQU * LDB D15 JSB IDWRD CHECK IF BIT 12 SET ALF,SLA JMP SNID1 SET * CLA STA SON LDA REASN PUSH THE NAME OF THE PROG JSB MVNAM LDA .QUE JMP PUSH8 * SNID1 JSB PS`������þúTR PUSH STARS LDA REASN STA SON JSB MVNAM MOVE SON'S NAME ON THE STACK JMP TLIST * SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL EQU * LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEMP JSB .ASC3 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE * * RESOURCE LOCK RESLK EQU * LDA .RN?? PUSH 'RN ??' ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK EQU * LDA .CL?? PUSH 'CL ??' ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST * * EQT LOCK WAIT,NO ENTRY AVAILABLE IN $ELTB LKWT EQU * LDA .EQWT PUSH THE MESSAGE ON THE STACK JSB MVBYT DEF D15 * JMP TLIST * .EQWT DEF *+1 ASC 8,EQLK TABLE FULL * SPC 2 .LU DEF *+1 ASC 2,LU: .DN DEF *+1 ASC 2, DN, * DEVDN EQU * * LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE,IT IS THE EQT ADDR OF DOWN DEVICE JMP DVDNE * LDA .LU PUSH ',LU:' ON STACK JSB MVBYT DEF D3 * LDA REASN PUSH THE LOGICAL UNIT NO JSB .ASC3 * LDA .DN PUSH ' DN,' JSB MVBYT DEF D4 * CCA FIND EQT NO FOR LU ADA REASN ADA DRT LDA A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT SAVE IT IN 'EQTPT' JMP FDEQ0 * DVDNE EQU * CMA,INA STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR. CMA,INA CLB DIV D15 AND DIVIDING BY 15 INA OFFSET IT BY 1 STA #EQTS õ������þú SAVE IT * LDA .EQ PUSH EQ: JSB MVBYT DEF D3 * LDA #EQTS EQT NO JSB .ASC3 DISPLAY IT * LDA .DN DISPLAY ' DN,' JSB MVBYT DEF D3 JMP FDEQ1 * SPC 2 B37 OCT 37 @DRT EQU 1652B @LUMX EQU 1653B .RNLK DEF *+1 ASC 2,RN 00,LKPRG=PROGA .LKPR DEF *+1 ASC 4,,LKPRG= * RNLCK EQU * STA RN SAVE RN# TEMP LDA @DRT GET DRT ADDRESS STA PTR SET UP POINTER LDA @LUMX GET MAX # OF LU'S CMA,INA SET UP COUNTER STA CNT LLOOP EQU * LDA PTR,I SEARCH FOR LU LOCK,GET DRT ENTRY RRR 6 POSITION LU LOCK RN AND B37 & MASK IT CPA RN LU LOCK ? JMP LULCK YES,PROCESS IT ISZ PTR NO, LOOP ISZ CNT JMP LLOOP LDA .RNLK PUSH 'RN LK' ONTO STACK JSB MVBYT DEF D4 LDA RN PROCESS RNLCK JSB ZASC3 JSB PLOCK PUT PROG NAME INTO MESSAGE JMP TLIST SPC 2 .LULK DEF *+1 ASC 3,LULK 00,LKPRG=PROGA * LULCK LDA .LULK PUT 'LULK' ONTO STACK JSB MVBYT DEF D4 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC3 PUT LU# IN MESSAGE JSB PLOCK PUT PROGRAM NAME IN MESSAGE JMP TLIST * * EQT LOCK, PUSH IT ON THE STACK EQLK EQU * XLB REASN,I GET THE EQT NO STB EQNO SAVE IT * XLA $ELTB,I GET THE TABLE LENGTH AND B77K MASK OUT THE MSB ADA REASN POINT TO LOCKER'S ID NO XLA A,I AND B77K ISOLATE THE IDNSEG NO. STA IDNO SAVE IT * PUSH THE MESSAGE EQLK XXX,LKPRG = PROGA ON THE STACK LDA .EQLK JSB MVBYT MOVE THE MESSAGE DEF D4 * LDA EQNO PROCESS EQT NO JSB .ASC3 * LDA .LKPR ð2������þú PUSH ',LKPRG=' JSB MVBYT DEF D7 * GET THE ID ADDRESS & PUSH THE PROG NAME ON THE STACK LDA IDNO JSB MVNAM MOVE NAME * JMP TLIST * .EQLK DEF *+1 ASC 2,EQLK * IDNO BSS 1 EQNO BSS 1 * ************************************************************************* * SUBROUTINE - PSTR PUSHES STARS ON THE STACK(OVERWRITES * THE PREVIOUSLY PUSHED DOTS) ************************************************************************* .STST DEF *+1 ASC 1,** * PSTR NOP LDA PRGFL GET THE PROGINATOR FLAG SZA IF ZERO,IT IS AN ACTUAL PROGINATOR JMP PSTEX OTHERWISE,IT ITSELF WAS A SON JSB SETPT PUSH 2 STARS IN THE BEGINNING OF LINE LDA .STST JSB MVBYT DEF D2 * LDA PTR RESTORE THE OLD VALUE OF STACK POINTER STA STKPT * LDA .STSP PUSH STARS & SPACES JSB MVBYT DEF NUM * JSB PSPAC PUSH ADDITIONAL SPACE AS STATE IS ODD LDA D3 STA STR MAKE STR NON-ZERO FOR SUB PFILL JSB .ASC1 PUSH THE STATE NO ON THE STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 PSTEX JMP PSTR,I RETURN * STR NOP * SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK JSB MVBYT DEF D7 LDA .RNTB ADA RN XLA A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD XLA A,I JSB MVNAM MOVE NAME JMP PLOCK,I * PLCK9 LDA .GLBL JSB MVBYT MOVE NAME 'GLOBL' DEF D5 JMP PLOCK,I * .GLBL DEF *+1 ASC 3,GLOBL M1 DEC -1 RN NOP PTR NOP CNT NOP PTSSP NOP .CLGT DEF *+1 ASC 3,CL CL# NOP * CLGET EQU * STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEFÞ"������þú D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST EQU * JSB PSPAC PUSH A SPACE LDA .PR. PROGRAM COUNTER'S LOCATION CLE,ELA CONVERT TO BYTES CMA,INA MAKE IT NEGATIVE ADA STKPT COMPUTE STKPT-PR CMA,INA COMPUTE # OF DOTS OR STARS TO BE PUT IN SSA,RSS MORE THAN WE CAN FIT IN JMP NXTM2 YES,WE ARE OK. * NO, WE CAN NOT PUT PROGRAM COUNTER IN THIS LINE,GOTO NEXT JSB OUTPT PRINT THIS LINE FIRST JSB SETPT INITIALIZE THE STACK POINTER LDA .SPAC JSB MVBYT PUT SPACES IN THE NEXT LINE DEF D50 JMP NXTM3 NXTM2 JSB PFILL PUSH STARS/DOTS DEPENDING UPON THE CASE NXTM3 LDA .P PUSH P: JSB MVBYT DEF D2 * NOW GET THE POINT OF SUSPENSION FROM ID SEGMENT LDB D8 GET POINT OF SUSPENSION JSB IDWRD RAL STA PTSSP POINT OF SUSPENSION * LDB DM5 LOOP COUNT STB CNT NXLLP LDA PTSSP LOOP,GET POINT OF SUSPENSION ALF ROTATE LEFT 4 TIMES RAR EFFECTIVELY ROTATE LEFT 3 TIMES STA PTSSP SAVE IT AND D7 ISOLATE THE DIGIT JSB .ASC1 DISPLAY THE OCTAL DIGIT ISZ CNT INCREMENT THE LOOP COUNT JMP NXLLP DISPLAY THE NEXT DIGIT * * NOW DETERMINE IF THE PROGRAM SWAPPED OUT * IF SO,PUSH SWP ON THE STACK LDA .SPAC LDB TYP GET TYPE OF THE PROGRAM CPB D1 JMP NXTM4 * LDB D27 JSB IDWRD GET THE SWAP TRACK ADDRESS AND B77K LDB A B GETS CONTENTS OF A-REG LDA .SPAC SZB,RSS IF ZERO, NOT SWAPPED OUT JMP NXTM4 * LDA .SWP PUSH, SWP ON THE STACK NXTM4 JSB MVBYT DEF D3 * LDB D17 TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTM5 á������þúJMP DUMP NO, DUMP THE CURRENT LINE NXTM5 EQU * * NXTM6 LDA IDPNT ADA D18 JSB CNVTM CONVERT TIME * DUMP JSB OUTPT DISPLAY THE CURRENT LINE JMP PROCS,I * SPC 2 FINIS JSB DASHS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. CLA INITIALIZE NOOUT STA NOOUT LDA .DNLU PRINT LINE HEAD. JSB MVBYT DEF D9 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE NEED MORE LINES * LDA DRT GET LU TABLE AREA ADDRESS, ADA LUMAX POSITION TO WORD TWO STA EQTPT TABLE AND SAVE. CLA INITIALIZE STA #EQTS COUNTER. * DNLU1 LDA EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. * ISZ NOOUT INCREMENT THE COUNT LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION TO START ADA STKPT SEE IF TOO FULL YET. SSA LINE FULL YET? JMP DNLU2 NO, DO IT * JSB OUTPT YES, DUMP LINE LDA PTR SET UP NEW LINE STA STKPT JUST LIKE THE PREVIOUS DNLU2 LDA .CMBL YES--PROCESS IT. JSB MVBYT PUSH A ','. DEF D1 LDA #EQTS CONVERT LU# JSB .ASC3 TO ASCII. NXTLU ISZ EQTPT INCREMENT DRT WORD 2 POINTER. LDA #EQTS IF LAST, CPA LUMAX THEN GO RSS DUMP LINE. JMP DNLU1 ELSE CONTINUE. LDA NOOUT FETCH THE COUNT OF DOWN LU'S SZA ZERO ? JMP NXTLO NO, PRINT THE LINE JSB SETPT YES, DISPLAY THE MESSAGE 'ALL LU'S OK' LDA .LUOK JSB MVBYT DEF D12 * NXTLO JSB OUTPT PRINT STACK. * JSB SETPT RESET STACK FOR DOWN EQTS CLA INITIALIZE THE COUNT OF DOWN EQT STA NOOUT * LDA .DNEQ PRINT LINE HEAD JSB MVBYT DEF D10 LDA STKPT 4������þú SAVE CURRENT POSITION STA PTR IN CASE WE NEED ANOTHER LINE * LDA EQTA GET EQT TABLE AREA ADDRESS ADA D4 INDEX TO STATUS STA EQTPT PUSH POINTER CLA INIT STA #EQTS EQT COUNTER DEVLP LDA EQTPT,I FIND EQT'S. GET STATUS ISZ #EQTS RAL,RAL POSITION AND D3 & MASK CPA D1 IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT * ISZ NOOUT INCREMENT THE COUNT LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION ADA STKPT TO SEE IF FULL YET? SSA FULL YET? JMP DNEQ2 NO, DO IT * JSB OUTPT DUMP LINE LDA PTR SET UP FOR ANOTHER LINE STA STKPT JUST LIKE THE PREVIOUS DNEQ2 LDA .CMBL PUSH "," JSB MVBYT DEF D1 LDA #EQTS CONV EQT# TO ASCII JSB .ASC3 NXTDV LDA EQTPT BUMP ADA D15 TO NEXT STA EQTPT EQT STATUS WORD LDA #EQTS WAS THIS THE LAST CPA EQT# RSS YES-DUMP IT JMP DEVLP NO-CONTINUE LDA NOOUT FETCH THE COUNT OF DOWN EQT'S SZA ZERO ? JMP DONE NO, PRINT THE LINE AS IT IS JSB SETPT INITIALIZE THE POINTER LDA .EQOK MESSAGE 'ALL EQT'S OK' JSB MVBYT DEF D12 SPC 2 DONE JSB OUTPT PRINT STACK DONE1 EQU * JSB LOCLU DISPLAY ALL LOCKED LU'S JSB LOCEQ DISPLAY ALL LOCKED EQT'S JSB CMTRK COMPUTE FREE TRACKS AVAILABLE JSB COMSM DISPLAY SAM RELATED INFO IF NEED BE DONE2 JSB DASHS * EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 LDA XEQT CHECK IF I AM IN TIME LIST ADA D17 XLA A,I GET THE WORD ALF,SLA WELL?? LDA PARM2 YES USE CURRENT PRAM2 ÄÌ������þú STA PARM2 NO RESET PARM2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF CRTLU DEF SESID RSTRT JMP WHAT RESTART SPC 2 ZERO OCT 0 D18 DEC 18 DM6 DEC -6 RNTBL NOP CLASS NOP NUM NOP D4 DEC 4 .DNEQ DEF *+1 ASC 5,DOWN EQT'S .DNLU DEF *+1 ASC 5,DOWN LU'S .EQOK DEF *+1 ASC 6,ALL EQT'S OK .LUOK DEF *+1 ASC 6,ALL LU'S OK .SWP DEF *+1 ASC 2,SWP .P DEF *+1 ASC 1,P: D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 11, PRGRM T PRIOR PT SZ ASC 10,DO.SC.IO.WT.ME.DS.OP ASC 10,. .PRG CNTR. . ASC 5,NEXT TIME. SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 B7K OCT 7777 B77K OCT 77777 SPC 2 * ************************************************************************* * SUBROUTINE PFILL PUSHES EITHER THE STARS OR DOTS ON THE STACK * DEPENDING ON THE CASE(STR NONZERO OR ZERO) * ARG: A-REG CONTAINS NO OF PLACES TO BE FILLED IN ************************************************************************* * PFILL NOP SZA,RSS IF ZERO,EXIT JMP PFLEX YES STA NUM SAVE NO OF SPACES TO BE FILLED IN LDA STKPT CHECK IF STKPT ODD OR EVEN SLA,RSS IF ODD ,IT IS POINTING TO ODD COLM JMP PFL1 THE STARS/DOTS START AT EVEN COLM JSB PSPAC PUSH ADDITIONAL SPACE TO MAKE IT EVEN LDA NUM ADA M1 NUM = NUM-1 SZA,RSS IF ZERO,FORGET IT JMP PFLEX YES STA NUM PFL1 LDA .DTSP PICK APPROPRIATE TEXT DEPENDING ON STR LDB STR SZB LDA .STSP TAKE STARS AS STR NON ZERO JSB MVBYT DEF NUM * PFLEX JMP PFILL,I RETURN STBYÜH������þúT NOP LDB TO OCT 105764 JSB SBT STB TO JMP STBYT,I SPC 2 * ('A'REG = WORD ADDRESS OF FROM) * JSB MVBYT * DEF COUNT * MVBYT NOP CLE,ELA LDB STKPT DST FROM LDA MVBYT,I ISZ MVBYT STA .MVBY DLD FROM OCT 105765 JSB MBT .MVBY NOP NOP STB STKPT JMP MVBYT,I SPC 2 SPC 2 PSPAC NOP LDA .SPAC PUSH A SPACE JSB MVBYT DEF D1 JMP PSPAC,I SPC 2 SETPT NOP LDA .STAK ADA D2 CLE,ELA STA STKPT JMP SETPT,I SPC 2 OUTPT NOP LDA .STAK LDB .STAK CLE,ELB CONV TO BYTES CMB,INB ADB STKPT ADD ON CURRENT BYTE POSITION CMB,INB JSB PRINT JMP OUTPT,I SPC 2 DASHS NOP LDA .ASTE LDB DM76 JSB PRINT JMP DASHS,I * DM76 DEC -76 SPC 2 * 'A'REG = UPPER LIMIT * 'B'REG = LOWER LIMIT * TEST = ??????????? * JSB TESTR * RETURN -'A'REG : POS => FALSE NEG => TRUE . TESTR NOP CMB,CLE,INB ADB TEST LDB TEST CMB,SEZ,CLE,INB ADB A ERA SIGN = E. E=0 FALSE E=1 TRUE JMP TESTR,I SPC 2 TSTWD NOP LDB TSTWD,I GET ADDR OF TABLE ISZ TSTWD XLA B,I GET UPPER LIMIT BY ADDING AND B77K MASK OUT THE MSB ADA B SIZE OF TABLE TO ADDR STB SAVEB SAVE ADDR OF TABLE AS LOWER LIMIT JSB TESTR SSA,RSS ISZ TSTWD LDA SAVEB CMA,INA ADA TEST JMP TSTWD,I SPC 2 * (A) = ID SEG ADDR * JSB MVNAM * MVNAM NOP MOVE NAME FROM ID SEG TO OUTPUT LINE STA LNAID SAVE LAST ID NAME USED ADA D12 LDB D3 CBX MOVE 3 WORDS FROM SYSTEM MAP LDB DWRD1 BECAUSE MBF REQUIRES MWF DEST. TO BE AT EVEN WORD M������þú LDA DWRD1 JSB MVBYT DEF D5 JMP MVNAM,I * WORD1 NOP WORD2 NOP WORD3 NOP SPC 2 PRINT NOP STA .BUFF STB CNT JSB EXEC DEF *+1+4 DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * TOD NOP JSB SETPT LDA @TIME JSB CNVTM JSB OUTPT JMP TOD,I SPC 2 @TIME DEF $TIME+0 MS NOP SEC NOP MIN NOP HOURS NOP DAY NOP .HOUR DEF HOURS .COLN DEF *+1 ASC 1,:: .ZERO DEF *+1 ASC 1,00 SPC 2 CNVTM NOP LDB D3 MOVE 3 WORDS OF TIME CBX TO USER MAP FROM SYS MAP LDB DWRD1 MWF JSB TMVAL CONVERT INTO COMPONENTS DEF *+1+2 DWRD1 DEF WORD1 DEF MS LDA .HOUR STA PTR LDA DM4 STA CNT JMP TLOOR * TLOOP LDA .COLN PUSH A ":" OUT JSB MVBYT DEF D1 TLOOR LDA PTR,I JSB .ASC2 CONVERT TIME TO ASCII CCA ADA PTR STA PTR ISZ CNT JMP TLOOP * LDA .ZERO ADD "0" FOR LAST NUMBER JSB MVBYT TO MULTIPLY BY 10 FOR MS DEF D1 JMP CNVTM,I RETURN WITH ASCII VALUES IN ARRAY TIME SPC 2 IDWRD NOP ADB IDPNT XLA B,I JMP IDWRD,I SPC 2 * 'A'REG = BINARY VALUE * 'B'REG = 5 MINUS NUMBER OF DIGITS TO BE CONVERTED * 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES * JSB ASCII * 'A'REG = LAST BYTE * 'B'REG = BYTE ADDRESS UPDATED * ASCII NOP STA VAL CLA ELA STA FILL LDA STKPT STA TO LDA B (A)=(B)=DIGIT COUNT CODE ADB DM4 STB CCNTR SZB,RSS IF ONLY ONE DIGIT JMP LSTDG GO TO LAST DIGIT CODE ADA .N10K ADJUST POWERS OF TEN TO STA QPNTR NUMBER OF DIGITS DESIRED LOOP LDA VAL CLB DIV QPNTR,I DIVIDE BY POWER OF TEN STB VAL ê������þú SAVE REMAINDER (LOWER DIGITS) SZA JMP ASCNV CPA FILL LEADING ZEROES WANTED? JMP LZERO NO, BLANK OUT IF E#0 ORIGINALLY ASCNV IOR B60 NOT 0 OR LEADING 0 WANTED STA FILL SO INSURE NO 0 GETS LOST ASCST JSB STBYT ISZ QPNTR INCRE TO NEXT POWER OF TEN ISZ CCNTR BUMP DIGIT COUNTER JMP LOOP MORE THAN 1 DIGIT LEFT LSTDG LDA VAL IOR B60 DO LAST DIGIT EVEN IF ZERO JSB STBYT STB STKPT (B) IS STILL NEXT BYTE ADDR JMP ASCII,I * LZERO LDA B40 REPLACE LEADING ZEROES JMP ASCST WITH BLANKS SPC 2 .ASC1 NOP CONVERT 1 DIGIT TO ASCII CLE LDB D4 JSB ASCII JMP .ASC1,I SPC 2 .ASC2 NOP CONVERT BINARY TO ASCII CLE LDB D3 JSB ASCII JMP .ASC2,I SPC 2 .ASC3 NOP CONVERT 3 DIGITS, LEADING BLANKS CLE LDB D2 JSB ASCII JMP .ASC3,I SPC 2 ZASC3 NOP CONVERT 3 DIGITS, LEADING ZEROES CCE LDB D2 JSB ASCII JMP ZASC3,I SPC 2 .ASC4 NOP CONVERT 4 DIGITS, LEADING BLANKS CLB,CLE,INB JSB ASCII JMP .ASC4,I SPC 2 .ASC5 NOP CONVERT 5 DIGITS, LEADING BLANKS CLB,CLE JSB ASCII JMP .ASC5,I SPC 2 ZASC5 NOP CONVERT 5 DIGITS, LEADING ZEROES CLB,CCE JSB ASCII JMP ZASC5,I SPC 2 VAL NOP .N10K DEF N10K N10K DEC 10000,1000,100,10 D1 DEC 1 D10 EQU N10K+3 QPNTR NOP CCNTR NOP FILL NOP SAVEB EQU VAL B40 OCT 40 D32 EQU B40 B60 OCT 60 SKP WHATP LDA .PHED LDB DM38 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB DASHS '----------' * CLA,INA STA PTN# INIT PARTITION NUMBER CLA SET STA UFLAG NO. UNDEFINED TO ZERO XLA $MATA STA PTNAD INIT P¬������þúARTITION ADDR XLA $MNP GET # OF PARTITIONS SZA,RSS JMP DONE IN CASE BOO-BOO MPY D7 ADA PTNAD CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN XLA PTNAD,I GET LINK WORD SSA,RSS PARTITION DEFINED? JMP CKPTN YES, CHECK STUFF * IFZ * LDB D3 UNDEFINED BUT WAS JSB PTNWD THIS DUE TO A SZA,RSS PARITY ERROR ? JMP UNDEF NO * LDA .PERR GET THE PARITY ERROR JSB MVBYT MESSAGE & DEF D16 JMP DMPTN DUMP IT * XIF UNDEF ISZ UFLAG STEP UNDEFINED FLAG JMP DMP0 GO STEP THE PT. NO. * * CKPTN JSB FLUSU FLUSE UNDEFINED IF ANY JSB SETPT SET UP THE NEW LINE LDA PTN# JSB .ASC2 PUT PART. NO. ON LINE LDB D3 JSB PTNWD GET WORD 4 SSA,RSS IS IT MOTHER PTTN? JMP NTMOM NO * LDA .M FILL IN 'M' JMP DOMCS * NTMOM LDB D4 JSB PTNWD GET WORD 5 RAL SSA,RSS IS SUBPTTN IN CHAIN MODE? JMP NTCHN NO * LDA .C FILL IN 'C' JMP DOMCS * NTCHN LDB D6 JSB PTNWD GET WORD 7 STA B LDA .SPAC USE SPACE IF NOT SUBPTTN SZB LDA .S ELSE FILL IN 'S' DOMCS JSB MVBYT DO 'M' 'C' OR 'S' DEF D1 * CKRES LDB D4 JSB PTNWD CALC ADDR OF RES-SIZE CLE,ELA RAR KEEP ONLY 10 BITS AND B1777 (STATUS JUNK IN HIGH BITS) STA PTSIZ SAVE SIZE OF PART. LDA .SPAC OUTPUT SPACE IF NOT RESERVED SEZ ELSE LDA .R USE 'R ' IF RESERVED JSB MVBYT DEF D1 * LDA PTSIZ GET PART. SIZE (MAX=1024) INA ADD 1 FOR BASE PAGE JSB .ASC5 CONVERT TO ASCII + OUTPUT * LDA .SPAC JSB MVBYT 2 MORE SPACES DEF D2 * LDB D3 ‚:������þú JSB PTNWD ADDR OF START PAGE # AND B1777 PAGE # IN LOW 10 BITS ONLY STA PAGE# JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDA .DASH JSB MVBYT PUT "-" ON OUTPUT STACK DEF D1 * LDA PAGE# ADA PTSIZ CALCULATE LAST PAGE # JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDB D5 JSB PTNWD CLE,ELA PUT RT-BG BIT INTO (E) LDA .BG 'BG " IF BACKGROUND SEZ ELSE LDA .RT ' RT' IF REAL-TIME JSB MVBYT CLASS PARTITION DEF D7 * LDB D2 JSB PTNWD SZA,RSS EMPTY? JMP NOPRG YES, PRINT '<NONE>' JSB MVNAM MOVE NAME TO OUTPUT * DMPTN JSB OUTPT DUMP OUTPUT STACK DMP0 ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D7 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? RSS YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * JSB FLUSU FLUSH FINAL UNDEFS IF ANY JMP DONE2 AND GO EXIT * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD XLA B,I JMP PTNWD,I * * FLUSU NOP ROUTINE TO PUT OUT LINE FOR UNDEFINED PART. LDA UFLAG ARE THERE ANY? SZA,RSS WELL? JMP FLUSU,I NO JUST RETURN * JSB SETPT YES START A LINE LDA UFLAG CACULATE THE FIRST PT. NO. CMA,INA FROM COUNT AND CURRENT #. ADA PTN# THERE JSB .ASC2 SEND IT OUT LDA UFLAG CHECK IF MORE THAN 1 CPA D1 WELL JMP ONLY1 NO JUST ONE * LDA .MINU ELSE SEND RANGE '-' JSB MVBYT TO THE LINE DEF D1 CCA NOW GET THE LAST NUMBER ADA PTN# AND SEND IT JSB .ASC2 TO THE LINE ONLY1 LDA .UNDF SEND THE UNDEF LINE JSB MVBYT DEF D14 «Ä������þú CLA STA UFLAG JSB OUTPT SEND THE LINE JMP FLUSU,I ALL DONE EXIT SPC 2 .PHED DEF *+1 OCT 0,0 ASC 17,PTN# SIZE PAGES BG/RT PRGRM * .MINU DEF *+1 ASC 1,-- UFLAG NOP .UNDF DEF *+1 ASC 7, <UNDEFINED> .PERR DEF *+1 ASC 8, <PARITY ERROR> * .R DEF *+1 ASC 1,RR * .S DEF *+1 ASC 1,SS * .C DEF *+1 ASC 1,CC * .M DEF *+1 ASC 1,MM * .DASH DEF *+1 ASC 1,- * .BG DEF *+1 ASC 4, BG * .NONE DEF *+1 ASC 3,<NONE> .RT DEF *+1 ASC 4, RT * B1777 OCT 1777 DM38 DEC -38 PTSIZ EQU STATS PTNAD EQU EQTPT PTN# EQU IDCNT LPTAD EQU IDPNT PAGE# EQU #EQTS * * ************************************************************************* * * SUBROUTINE - LOCEQ * SUBROUTINE TO PRINT THE LOCKED EQTS * * IF NO EQT IS LOCKED,IT DOES NOT PRINT ANYTHING.THE SUBROUTINE * ACCESSES A TABLE ($ELTB) IN TABLE AREA II.IF THE MOST SIGNIFICANT * BIT OF THE FIRST WORD OF THIS TABLE SET,THE TABLE HAS ATLEAST * ONE ENTRY,OTHERWISE THE TABLE IS EMPTY. * * DATE : 6/25/79 DB ************************************************************************* * * LOCEQ NOP RETURN ADDRESS XLB $ELTB GET THE ADDRESS LDA B,I GET THE FIRST WORD OF THE TABLE. SSA,RSS IF M.S.B. NOT SET,SKIP THE SUBROUTINE. JMP LCEEX YES,EXIT * * THE TABLE HAS ATLEST ONE NON-ZERO ENTRY.BUT WE HAVE TO BE CAREFULL * BECAUSE BY THE TIME WE PICK UP THE ENTREE, THE ENTREES MIGHT * BECOME ZERO(BECAUSE OF INTERRUPT).THEREFORE, IF ALL THE ENTRIES * ARE ZEROS, NO MESSAGE IS PRINTED. * JSB SETPT RESET THE STACK LDA .LKEQ LOCKED EQT MESSAGE. JSB MVBYT MOVE THE MESSAGE ON THE STACK DEF D24 * XLB $ELTB ¢$������þú GET THE TABLE ADDRESS AGAIN XLA B,I GET THE FIRST WORD AND B77K A-REG CONTAINS THE NO OF ENTRIES. STA LENTH SAVE IT * ADA B CREATE THE LAST POINTER INA STA TBLST SAVE IT AS THE LAST POINTER INB B-REG POINTS TO FIRST EQT NO STB TBPTR STORE IT AS A TABLE POINTER * LCLP0 CLA STA NOOUT INITIALIZE THE 'NOOUT' * * LCLP1 LDB TBPTR PICK UP THE POINTER CPB TBLST COMPARE IT AGAINST THE LAST POINTER JMP LOCN2 YES, SKIP * LDB NOOUT NUMBER OF LOCKED EQT OUTPUT IN THIS LINE CPB D4 IS IT ONLY 4 (ALLOWS 4 PER LINE) JMP LOCN3 YES * XLA TBPTR,I GET THE EQT SZA,RSS IF ZERO, NOT A VALID ENTRY JMP LOCN1 YES, GET THE NEXT ENTREE ISZ NOOUT MAKE IT NON ZERO AS ATLEAST 1 LOCKED EQT JSB .ASC3 CONVERT TO ASCHII * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT MOVE BYTES DEF D1 * * NOW DETERMINE THE PROGRAM'S NAME & PUSH IT ON THE STACK. LDB TBPTR PICK UP THE POINTER ADB LENTH POINT TO ID-ADDRESS XLA B,I GET THE ID-ADDRESS AND B77K MASK OUT THE M.S.B JSB MVNAM MOVE THE NAME ON THE STACK * LDA .RPAR PUSH RIGHT PARANTHESIS,COMMA & SPACE JSB MVBYT MOVE THE BYTES DEF D2 * LOCN1 ISZ TBPTR BUMP THE POINTER JMP LCLP1 CONTINUE THE LOOP * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT. LOCN2 LDA NOOUT ARE ALL ZEROS ? SZA JSB OUTPT DISPLAY THE LINE LCEEX JMP LOCEQ,I EXIT * * ONE LIêÔ������þúNE FULL,GO TO THE NEXT LINE LOCN3 JSB OUTPT OUTPUT THE LINE JSB SETPT INITIALIZE THE STACK POINTER LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LCLP0 GO & PROCESS MORE * * D26 DEC 26 * * ************************************************************************** * * SUBROUTINE - LOCLU * IT PRINTS THE LOCKED LU'S. * THE SUBROUTINE SEARCHES THE DRT TABLE,PICKS OUT THE RESOURCE * NO & FROM THE RESOURCE TABLE, PICKS OUT THE LOCKER'S ID-SEGMENT * NO. THEN THE CORRESPONDING NAME IS DISPLAYED * THE MESSAGE IS: * LOCKED LU'S(PROG NAME) XXX(PROGA),XXX(PROGB) * * IF NONE OF THE LU'S ARE LOCKED,NO MESSAGE IS DISPLAYED. * ************************************************************************ * RNTB DEF $RNTB+0 LOCLU NOP RETURN ADDRESS JSB SETPT RESET THE STACK LDA .LKLU PUSH THE TITLE 'LOCKED LU'S' JSB MVBYT DEF D24 * LDA @DRT GET THE DRT ADDRESS STA TBPTR SAVE IT AS THE TABLE POINTER * LDA @LUMX GET MAX # OF LU'S CMA,INA SAVE NEGATIVE OF THAT STA CNT1 * LULP0 CLA INITIALIZE THE 'NOOUT' STA NOOUT * LULP1 EQU * LDB NOOUT NUMBER CPB D4 ALLOW 4 PER LINE JMP LUCN3 YES,PRINT NEW LINE * XLA TBPTR,I GET THE WORD FROM THE DRT TABLE RRR 6 AND B37 ISOLATE THE RESOURCE NO SZA,RSS IF ZERO,IT IS NOT LOCKED JMP LUCN1 YES, PICK THE NEXT ONE * * LOOK INTO THE RNTB TO MAKE SURE THAT THE ENTREE IS VALID ADA RNTB POINT TO THE RESOURCE NO ENTREE XLA A,I GET THE ENTREE AND B377 ISOLATE THE LOCKER'S ID SEG NO SZA,RSS IF IT IS ZERV������þúO,IT IS NOT OWNED. JMP LUCN1 YES,LOOK INTO THE NEXT ENTREE STA IDNO1 SAVE IT ISZ NOOUT * * NOW PUSH THE LU NO & THE CORRESPONDING PROGRAM NAME. * LDA CNT1 ADA @LUMX LU NO : @LUMX-CNT INA JSB .ASC3 CONVERT TO ASCHII & PUSH IT ON STACK * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT DEF D1 * LDA IDNO1 GET THE IDNO CPA B377 IS IT GLOBAL JMP LUGLB YES ADA M1 CREATE A POINTER IN KEYWORD BLOCK ADA KEYWD XLA A,I GET THE ID-NUMBER JSB MVNAM MOVE THE NAME ON THE STACK JMP LUCN0 * LUGLB LDA .GLBL GLOBAL JSB MVBYT MOVE THE WORD 'GLOBAL' DEF D5 * LUCN0 LDA .RPAR PUSH RIGHT PARENTHESIS,COMMA & SPACE JSB MVBYT DEF D2 * LUCN1 ISZ TBPTR INCREMENT THE TABLE POINTER ISZ CNT1 INCREMENT THE -VE COUNT JMP LULP1 CONTINUE * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT LDA NOOUT CHECK IF IT IS ZERO SZA IF ZERO,THIS LINE NOT TO BE OUTPUT JSB OUTPT OUTPUT THE LINE LCLEX JMP LOCLU,I RETURN FROM THE SUBROUTINE * * THIS LINE OF DISPLAY FULL, GO TO NEXT LINE LUCN3 JSB OUTPT OUTPUT THIS LINE JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LULP0 JUMP BACK. * .RPAR DEF *+1 ASC 2,), * .LKEQ DEF *+1 ASC 12,LOCKED EQT'S (PROG NAME) * * .LKLU DEF *+1 ASC 12,LOCKED LU'S (PROG NAME) TBPTR BSS 1 TABLE POINTER LENTH BSS 1 LENGTH OF THE ENTRIES NOOUT BSS 1 TBLST BSS 1 CNT1 BSS 1 IDNO1 BSS 1 * * ********************************************************ÛP������þú********************* * * SUBROUTINE - CMTRK * * SUBROUTINE TO COMPUTE TOTAL NO OF CONTIGOUS FREE TRACKS * AVAILABLE ON EITHER LU2 (SYSTEM DISK) OR LU3 (AUX. DISK). * ***************************************************************************** * TAT EQU 1656B TATSD EQU 1756B TATLG EQU 1755B * CMTRK NOP RETURN ADDRESS JSB SETPT INITIALIZE THE STACK POINTER LDA .FRTR FREE TRACKS MESSAGE JSB MVBYT PUSH IT ON THE STACK DEF D24 * * COMPUTE MAX. NO OF FREE TRKS ON SYSTEM DISK. * LDA TAT GET THE TRACK ASSIGNMENT TABLE ADDRESS LDB TATSD NO OF TRACKS ON THE SYSTEM DISK. JSB COMPT COMPUTE NO OF FREE CONTIGOUS TRACKS AVAILABLE STA MAXL2 RESULT IN A-REG.(SAVE IT) * * NOW DO THE SAME FOR THE AUXILIARY DISK (LU 3) * LDA TAT TRACK ASSIGNMENT TABLE ADDRESS ADA TATSD CREATE POINTER (EQ TO TAT+TATSD) LDB TATSD NO OF TRACKS ON AUX DISK = TATLG-TATSD ADB TATLG COMPUTE TATSD-TATLG CMB,INB NEGATE IT SZB,RSS IF AUX NOT DEFINED, FORGET IT JMP CM1 JSB COMPT COMPUTE FREE TRACKS ON AUX DISK STA MAXL3 SAVE IT * * CHECK WHICH IS GREATER CMA,INA -MAXL3 ADA MAXL2 COMPUTE MAXL2-MAXL3 SSA,SZA JMP CM2 MAXL3 .GT. MAXL2 CM1 LDA MAXL2 MAXL2 .GT. MAXL3 LDB D2 LOGICAL UNIT NO JMP CM3 * CM2 LDA MAXL3 MAXL3 .GT. MAXL2 LDB D3 CM3 STB LUNO SAVE LOGICAL NO JSB .ASC3 PUSH THE NO OF TRACKS ON THE STACK * LDA .LU1 PUSH 'LU' ON THE STACK JSB MVBYT DEF D6 * LDA LUNO PUSH LOGICAL UNIT NO JSB .ASC3 ON THE STACK JSB OUTPT OUTPUT THE LINE !D������þú JMP CMTRK,I RETURN * * MAXL2 NOP MAXL3 NOP D24 DEC 24 .LU1 DEF *+1 ASC 3,, LU * .FRTR DEF *+1 ASC 12,MAX CONT. FREE TRKS : * ************************************************************************* * SUBROUTINE - COMSM * COMPUTES THE MAX CONTIGOUS SAM,TOTAL SAM & * LARGEST SAM EVER AVAILABLE AT THE INSTANT OF TIME ************************************************************************* * SUSP3 EQU 01714B EXT $PNTI,$MAXI EXT $LIBR,$LIBX * COMSM NOP RETURN ADDRESS LDA SUSP3 CHECK THE MEMORY SUSPEND LIST SZA,RSS IF NO PROG MEM SUSPENDED,SKIP IT JMP SMEX * CLA CAX X-REG ACTS AS ACCUMULATOR FOR TATAL SAM CLB B- REG WOULD CONTAIN THE MAX CONT. SAM AVAIL XLA $PNTI,I GET THE SAM FREE LIST HEADER STA PNTR STORE IT LOCALLY * **************GO PRIVILEGED FROM HERE * JSB $LIBR NOP * CMM1 XLA PNTR,I PICK # OF FREE WORDS ADX A ADD TO ACCUMULATOR * ADA B COMPUTE (A-B):B-REG IS NEGATIVE SSA SKIP IF (A).GT.(B) JMP CMM2 NO,(A).LT.(B),B THEN REMAINS UNCHANGED CMA,INA MAKE IT -(A-B) ADB A B-REG = -B+[-(A-B)]=-A<=>MAX SAM SO FAR CMM2 ISZ PNTR BUMP THE POINTER XLA PNTR,I GET THE ADDRESS OF NEXT FREE BLOCK CPA B77K END OF LIST ? JMP SMEXT YES,PRINT THE STUFF & BUZZ 0FF STA PNTR UPDATE THE POINTER JMP CMM1 CONTINUE IN THE LOOP * ***************GO UNPRIVILEGED HERE * SMEXT JSB $LIBX DEF *+1 DEF *+1 * * X-REG CONTAINS TOTAL SAM AVAIL:B-REG CONTAINS -VE OF MAX * CONT. SAM AVAILABLE. * CMB,INB MAKE IT +VE STB MAXSM STX TOTSM SAVE B & X REGS * JSB SETPT INITIALIZE STACK POINTER LDA üZ������þú.MXSM JSB MVBYT PUSH TITLE ON THE STACK DEF D24 * LDA MAXSM PUSH MAX SAM JSB .ASC5 * LDA .WRD PUSH 'WORDS' JSB MVBYT DEF D8 * JSB OUTPT FLUSH THE MESSAGE * JSB SETPT INITIALIZE THE STACK AGAIN LDA .TOSM PUSH THE TITLE FOR TOTAL SAM JSB MVBYT DEF D24 * LDA TOTSM JSB .ASC5 * LDA .WRD JSB MVBYT PUSH WORDS DEF D8 * JSB OUTPT FLUSH THE MESSAGE OUT * JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .LRSM JSB MVBYT 'LARGEST SAM EVER AVAILABLE' DEF D28 * XLA $MAXI,I CMA,INA JSB .ASC5 * LDA .WRD JSB MVBYT DEF D8 * JSB OUTPT * SMEX JMP COMSM,I RETURN PNTR NOP MAXSM NOP TOTSM NOP .MXSM DEF *+1 ASC 12,MAX CONT. SAM AVAIL : .TOSM DEF *+1 ASC 12,TOTAL SAM AVAILABLE : .LRSM DEF *+1 ASC 14,MAX CONT. SAM EVER AVAIL : * * .WRD DEF *+1 ASC 4, WORDS * * * ************************************************************************* * * SUBROUTINE - COMPT * SUBROUTINE TO COMPUTE THE MAX NO OF CONTIGOUS FREE TRACKS * * ARGUMENTS: A-REG : ADDRESS FROM WHERE THE SEARCH TO BEGIN IN TAT * B-REG : TOTAL NO OF TRACKS ON THE DISK * * RESULT PASSED BACK IN A-REG * ************************************************************************* * COMPT NOP RETURN ADDRESS ADA M1 OFFSET THE BEGINNING SEARCH ADDRESS BY 1 STA BGADR SAVE THE BEGINNING SEARCH ADDRESS CMB,INB SAVE NEGATIVE OF TOTAL NO OF TRACKS AVAILABLE INB OFFSET IT BY 1(FOR LOOP END CHECK) STB TKCNT * CLA INITIALIZE VAR 'MAXTK' STA MAXTK * CMLP0 CLB B-REG WOULD HAVE NO OF FREE TRKS IN A LOOP CMLP1 ISZ BGADÛÝ���À��¾ºR INCREMENT BEGINNING ADDRESS ISZ TKCNT SEARCHING DONE ? JMP CM4 JMP CMEXT YES,EXIT CM4 XLA BGADR,I GET THE ENTREE FROM THE TRACK ASSIGN TABLE SZA JMP CM5 NON ZERO, COMPUTE IF .GT. THE PREVIOUS ONE INB INCREMENT B-REG. JMP CMLP1 FIND MORE * CM5 STB TEMP1 SAVE IT TEMPORARILY CMB,INB NEGATIVE OF FREE TRACKS FOUND ADB MAXTK MAXTK-FREE TRACKS FOUND SSB,RSS JMP CMLP0 OK,MAXTK .GT. FREE TRACKS FOUND LDB TEMP1 MAXTK = FREE TRACKS FOUND IN THIS LOOP STB MAXTK JMP CMLP0 * CMEXT LDA MAXTK PICK UP THE MAX FREE TRACKS FOUND JMP COMPT,I RETURN * MAXTK BSS 1 TEMP1 BSS 1 BGADR BSS 1 TKCNT BSS 1 LUNO BSS 1 * UNS END WHAT ��������������������������������¡ À������ÿÿ����� ���� ÿý�¿�$ä ���������ÿ��92067-18502 1940� S C0122 �CRETS0 �CREATE SCRATCH FILE SUB � � � � � � � � � � � � �H0101 ^�����þúASMB,R,L,C,Q * NAME: CRETS * SOURCE: 92067-18502 * RELOC: 92067-16125 * PGMR: M.L.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CRETS,7 92067-16125 REV.1940 790726 * HED CRETS ENT CRETS EXT .ENTR, EXEC, D.R, OVRD. EXT $$CPU, ECREA, RMPAR SUP * * * CRETS IS THE SCRATCH FILE CREATION MODULE OF THE REAL TIME * FILE MANAGEMENT PACKAGE. * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZ) * O R * IER = CRETS(IDCB,IERR,NUM,NAME,ISIZE,ITYPE,IS,ILU,IBLK,JSIZ) * * W H E R E: * * IDCB IS THE ADDRESS OF A 144-WORD ARRAY WHICH * CRETS WILL USE AS A SCRATCH AREA. IF * ISIZE<0 THEN THE CREATED FILE IS ALSO * OPENED TO THIS DATA CONTROL BLOCK. * * IERR IS THE ADDRESS TO WHICH THE ERROR CODE * IS RETURNED. THIS INFORMATION IS ALSO * RETURNED IN THE A REGISTER. * * ERROR CODES ARE: * * >0 THE CRETS WAS SUCCESSFUL - THE #SECTORS IS RETURNED * -1 THE DISC IS DOWN * -2 DUPLICATE NAME * -4 FILE TOO LONG * -6 CARTRIDGE NOT FOUND * -10 NOT ENOUGH PARAMETERS IN THE CALL * -13 DISC LOCKED * -14 DIRECTORY FULL * -15 ILLEGAL NAME * -16 ILLEGAL TYPE OR SIZE * -38 ILLEGAL FILE NUMBER * * * NUM THE SCRATCH FILE NUMBER TO CREATE 0 THROUGH 99 * * * NAME IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME * WHICH CRETS HAS CREATED. NOTE: THISëY������þú IS A RETURNED * PARAMETER. * * ISIZE A TWO-ENTRY ARRAY. EACH ENTRY IS A DOUBLE WORD. * THE FIRST ENTRY IS THE FILE SIZE IN 128-WORD * DOUBLE SECTORS (DOUBLE WORD). THE SECOND ENTRY * IS USED ONLY FOR TYPE 2 FILES AND IS THE RECORD * LENGTH (DOUBLE WORD). THE DEFAULT FILE SIZE IS * 24 BLOCKS. * * ITYPE IS THE FILE TYPE--MUST BE >0. THE DEFAULT IS TYPE 3. * * IS (OPTIONAL); IS THE FILE'S SECURITY CODE. * IF IS>0 THE FILE IS WRITE PROTECTED. * IF IS<0 THE FILE IS OPEN PROTECTED. * IF IS=0 OR IS NOT CODED THE FILE IS PUBLIC. * * ILU (OPTIONAL); DIRECTS THE CRETS TO: * IF ILU<0 THEN THE DISC AT LOGICAL UNIT (-ILU). * IF ILU>0 THEN THE DISC WITH LABEL ILU. * IF ILU=0 OR NOT CODED, THE FIRST AVAILABLE * DISC WITH ENOUGH ROOM IS USED. * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * JSIZE (OPTIONAL) THE SIZE OF THE FILE CREATED IF * SUCCESSFUL. THIS IS A DOUBLE WORD VALUE * SKP CRETS NOP ENTRY POINT LDA CRETS MOVE THE STA DRETS RETURN ADDRESS LDA DZERO GET DUMMY 0 FOR DEFAULT STA NAME STA SC STA LU STA IBLK LDA DFLTS GET DEFAULT SIZE STA SIZE (=24 BLOCKS) LDA DFLTT GET DEFAULT TYPE STA TYPE (= 3) LDA DDMSZ GET POINTER TO DUMMY SIZE STA FSIZ STORE AT PARAMETER ADDRESS JMP DRETS+1 GO SET UP PARAMETERS ¡É������þú SPC 3 DCB NOP IERR NOP NUM NOP NAME NOP SIZE NOP TYPE NOP SC NOP LU NOP IBLK NOP FSIZ NOP * DRETS NOP JSB .ENTR DEF DCB * LDA NAME TEST FOR ENOUGH CPA DZERO PARAMETERS JMP ER10 NOT ENOUGH! ERROR LDA NAME GET POINTER TO USER'S NAME BUFFER INA INCREMENT TO SECOND WORD STA NAME2 AND SAVE INA INCREMENT TO THIRD WORD STA NAME3 AND SAVE * CLA CALCULATE WHAT THE ID SEGMENT NUMBER STA IDNUM IS FOR THIS PROGRAM. STEP LDB KEYWD THROUGH THE KEYWORD TABLE UNTIL KEY ISZ IDNUM AN ADDRESS IS FOUND THAT MATCHES XLA B,I XEQT - THE CURRENT PROGRAM EXECUTING. CPA XEQT MATCH? JMP CONVT FOUND IT SO GO CONTINUE INB STEP POINTER IN KEYWORD TABLE JMP KEY AND GO TRY THE NEXT ONE * CONVT LDA IDNUM GET ID SEGMENT NUMBER JSB CHAR CONVERT TO ASCII STB NAME2,I STORE TEMPORARILY IN LOW BITS JSB CHAR CONVERT THE NEXT CHAR OF ID # STB NAME,I STORE IN LOW BITS JSB CHAR CONVERT 100'S DIGIT BLF,BLF SHIFT TO HIGH BYTE ADB NAME,I ADD 10'S DIGIT STB NAME,I AND STORE IN USER'S BUFFER * LDB NAME2,I GET 1'S DIGIT LDA $$CPU GET CPU FLAG ALF,ALF AND PUT IN UPPER BYTE LSL 8 SHIFT BYTES INTO POSITION IN B ADB B60 ADD 60B TO CONVERT TO ASCII STB NAME2,I STORE IN USER'S BUFFER * LDA NUM,I TEST SCRATCH FILE NUMBER SSA TEST IF NEGATIVE JMP ER38 YES, ERROR 38 ADA M100 TEST FOR TOO LARGE SSA,RSS JMP ER38 YES, ERROR 38 * LDA NUM,I GET NUMBER AGAIN JSB CHAR CONVERT 1'S TO ASCII STB NAME3,I STORE IN USER'S BUFFER JSB CHAR CONVERT UPPER CHARACTER BLF,BLF SHIFT «=������þúUP ADB NAME3,I ADD LOWER CHARACTER STB NAME3,I AND STORE IN USER'S BUFFER * * CALL ECREA * CREAT JSB ECREA CALL DOUBLE WORD CREATE DEF RTN DEF DCB,I DEF IERR,I DEF NAME,I DEF SIZE,I DEF TYPE,I DEF SC,I DEF LU,I DEF IBLK,I DEF FSIZ,I DZERO DEF ZERO DEF ILNAM * RTN SZA,RSS TEST FOR ERROR JMP EXIT NO ERROR, EXIT CPA M2 A -2 ERROR? JMP PURGE YES, DO SCRATCH FILE PURGE EXIT STA IERR,I NO, EXIT WITH CREAT ERROR CODE JMP DRETS,I * * * PURGE CCE SET UP D.RTR CALLING PARAMETERS LDA XEQT PUT ID SEGMENT ADDRESS WITH RAL,ERA BIT 15 SET STA IDNUM INTO 1ST PARAMETER * DLD NAME,I SET UP NAME WITH CCE SCRATCH FILE PURGE BIT RBL,ERB SET AND PASS IT TO DST PARAM D.RTR IN A STRING LDA NAME3,I PUT 3RD WORD INTO STA PARAM+2 STRING ALSO * JSB EXEC SCHEDULE D.RTR TO DO OPEN WITH DEF SCRTN SCRATCH FILE PURGE FLAG SET DEF .23 DEF D.R DEF IDNUM DEF OVRD. DEF LU,I DEF SC,I DEF ZERO DEF PARAM STRING DEF .3 3 WORDS LONG * SCRTN JSB RMPAR DEF *+2 DEF PARAM * LDA PARAM CPA M101 IS IT -101 ? JMP EXIT YES, ERROR, CAN'T PURGE JMP CREAT NO, GO TRY TO CREATE THE FILE AGAIN * * ER38 LDA M38 SET ILLEGAL FILE NUMBER RETURN JMP EXIT * ER10 LDA M10 SET NOT ENOUGH PARAMETERS JMP EXIT * * CHARACTER CONVERSION SUBROUTINE * CHAR NOP CLB CLEAR UPPER BITS DIV .10 CONVERT TO DECIMAL CHARACTER ADB B60 CONVERT TO ASCII JMP CHAR,I RETURN SKP * * CONSTANTS * .3 DEC 3 .10 DEC 10 .23 DEC 23 B60 OCT 60 M38 DEC -38 M100 DEC -100 M101 DEC -101 >1�����M2 DEC -2 M10 DEC -10 ZERO NOP NOP TWO NECESSARY FOR DOUBLE WORD DFLTS DEF DSIZE DSIZE NOP DEFAULT SIZE DEC 24 = 24 BLOCKS DFLTT DEF DTYPE DTYPE DEC 3 = 3 DDMSZ DEF DUMSZ ILNAM OCT 70707 XEQT EQU 1717B KEYWD EQU 1657B A EQU 0 B EQU 1 * * VARIBLES * IDNUM NOP NAME2 NOP NAME3 NOP * PARAM BSS 5 FOR D.RTR AND RMPAR * DUMSZ BSS 2 DUMMY RETURN SIZE * END EQU * END ����������������������ÏÇ������ÿÿ����� ���� ÿý�À� Ê ���������ÿ��92067-18503 2026� S C0122 �&VVALD � � � � � � � � � � � � � �H0101 €�����þúFTN,L,C C * SUBROUTINE VVALD (IA,IB,OFSET,LEN,TA,SA,ILNTH,FLAG,IERR) & ,92067-1X503 REV.2026 800522 C * C * C * C ******************************************************************* C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C * CONSENT OF HEWLETT-PACKARD COMPANY. C ******************************************************************* C * C * C * NAME: VVALD C * SOURCE: 92067-18503 C * RELOC: 92067-16503 C * PGMR : R.D C * C * C * C ****************************************************************** C * C * C * C * C * C C THIS SUBROUTINE CHECKS FOR POSSIBLE PROBLEMS UPON READING FROM C MAG TAPE (INITIATED BY READT) BEFORE THE DATA IS RESTORED TO THE C DISC AND AFTER WRITING IT TO THE DISC. C IF END OF TAPE IS FOUND, THE USER WILL BE REQUESTED TO MOUNT THE NEXT C TAPE OR ABORT THE PROGRAM. C C THE PARAMETERS ARE: C C IA,IB - CONTENTS OF A AND B REGISTER IMMEDIATELY AFTER ATTEMPT C TO READ. C OFSET - FIRST POSITION OF THE BUFFER THAT IS TO BE RESTORED TO C THE DISC. C < 0 IF WRITE CHECK, >0 IF READ CHECK C LEN - NUMBER OF WORDS TO BE RESTORED. C TA - TRACK ADDRESS C SA - SECTOR ADDRESS C ILNTH - WORD/TRACK VALUE OF MAG TAPE C FLAG - CATCHES FMGR ERROR NUMBER C IERR - ERROR CODE C = 0 NO PROBLEMS C = 1 END OF FILE ENCOUNTERED C =-1 ABORT MAIN PROGRAM (READT) C =-2 PARITY ERROR FOUND C C IMPLICIT INTEGER (A-Z) DIMENSION JBUF(8192),MRR2(14),MRR8(12),MRR15(32),MRR16(29) COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193) EQUIVALENCE (JBUF,IBUF(2)) DATA MRR2/6412B,2HRE,2HAD,2H 0,2H02,2H ,2HBA,2HD ,2HTA,2HPE, & 2H F,2HOR,2HMA,2HT / DATA MRR8/6412B,2HRE,2HAD,2H 0,2H08,2Hò¤������þú ,2HEN,2HD ,2HOF,2H T,2HAP, & 2HE / DATA MRR15/6412B,2HRE,2HAD,2H 0,2H15,2H B,2HAD,2H T,2HRA,2HNS, & 2HMI,2HSS,2HIO,2HN-,2H-M,2HEM,2HOR,2HY ,2HTO,2H D,2HIS, & 2HC ,2HTR,2HK ,2H ,2H ,2H ,2HSE,2HC ,2H ,2H ,2H / DATA MRR16/6412B,2HRE,2HAD,2H 0,2H16,2H B,2HAD,2H T,2HRA,2HNS, & 2HMI,2HSS,2HIO,2HN-,2H-M,2HAG,2H T,2HAP,2HE ,2HTO,2H M,2HEM, & 2HOR,2HY ,2HRE,2HC ,2H ,2H ,2H / C C WHAT KIND OF CHECK - READ FROM TAPE OR WRITE TO DISC? C IF(OFSET.LT.0) GOTO 500 C C END OF FILE ENCOUNTERED? C IF(IAND(IA,200B).EQ.0) GOTO 480 IERR=1 RETURN C C CHECK TO MAKE SURE TRANSMISSION LENGTH WAS ACCURATE. C (IBUF(1)=RECORD NUMBER) C 480 IF((IB.EQ.ILNTH+1).OR.(IAND(IA,200B).EQ.200B)) GOTO 481 CALL CNUMD(IBUF(1),MRR16(27)) CALL EXEC(2,ILU,MRR16,29) CALL PTERR(MRR16(2),FLAG) C C CHECK A REGISTER FOR PARITY ERROR. C 481 IF((IAND(IA,2B).NE.2)) GOTO 485 GOTO 204 C C CHECK FOR END OF TAPE. (A REGISTER HAS EQT STATUS WORD FIVE). C 485 IF((IAND(IA,00040B).NE.40B)) RETURN C C REWIND MAG TAPE. C CALL EXEC(3,MTLU+500B) C C ASK TO MOUNT ANOTHER TAPE C CALL EXEC(2,ILU,MRR8,12) CALL PTERR(MRR8(2),FLAG) 482 CALL EXEC(2,ILU,28HPLEASE MOUNT SUBSEQUENT TAPE,-28) 483 CALL EXEC(2,ILU,25HAFTER MOUNTING ENTER "GO",-25) CALL REIO(1,ILU,INBF,1) IF(INBF.EQ.2HAB) GOTO 91 IF(INBF.NE.2HGO) GOTO 483 C C SET UP TAPE COUNTER C ITAPE=ITAPE+1 C C READ FIRST RECORD OF THE FOLLOWING TAPE C CALL EXEC(1,MTLU,INBUF,1) CALL ABREG(IA,IB) C C THE FIRST RECORD SHOULD BE THE TAPE COUNT. IS IT WHAT WAS EXPECTED? C IF YES, CONTINUE ON; ELSE ASK TO MOUNT ANOTHER TAPE. C IF(INBUF.NE.ITAPE) GOTO 490 C C WRITE BUFFER TO DISC (IT MAY BE REDUNDANT). C CALL EXEC(2,IDISC+74000B,JBUF(OFSET),LEN,TA,SA) GOTO 500 C C WRONG TAPE, ASK AGAIN. C 490 CALL EQƒ����� XEC(2,ILU,MRR2,14) CALL PTERR(MRR2(2),FLAG) ITAPE=ITAPE-1 GOTO 482 C C WRITE CHECK - TRANSMISSION LENGTH O.K. AND ERROR BIT CLEAR? C 500 IF(IAND(IA,1).NE.1)RETURN CALL CNUMD(TA,MRR15(25)) CALL CNUMD(SA,MRR15(30)) CALL EXEC(2,ILU,MRR15,32) CALL PTERR(MRR15(2),FLAG) RETURN C C ABORT REQUESTED. C 91 IERR=-1 RETURN C C PARITY ERROR. C 204 IERR=-2 RETURN END END$ ��������������������������������������������KH������ÿÿ����� ���� ÿý�Á�É ���������ÿ��92067-18504 2026� S C0122 �&REDIR SUBROUTINE � � � � � � � � � � � � � �H0101 es�����þúFTN,L,C C SUBROUTINE REDIR(ISCTR,IDUM,FLAG,IERR) & ,92067-1X504 REV.2026 800522 C * C * C ******************************************************************* C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C * CONSENT OF HEWLETT-PACKARD COMPANY. C ******************************************************************* C * C * C * NAME : REDIR C * SOURCE: 92067-18504 C * RELOC: 92067-16504 C * PGMR : R.D. C * C * C * C ******************************************************************* C * C * C * C * C C THIS SUBROUTINE IS CALLED BY READT TO FIX AND RESTORE DIRECTORY C ENTRIES WHEN THE SEC/TRK VALUE OF THE MAG TAPE IS NOT THE SAME C AS THAT OF THE DISC. IT CLEARS ALL OPEN FLAGS, AND RESETS C THE STARTING SECTOR AND TRACK ADDRESSES FOR EACH DIRECTORY ENTRY. C (THE FIRST FILE, THEN, WILL BEGIN AT TRACK 0, SECTOR 0). C C THE DIRECTORY ENTRIES ARE WRITTEN USING SECTOR SKIPPING. BECAUSE C OF THIS, THERE IS A TWO SECTOR BLOCK WITH DIRECTORY ENTRIES,THE NEXT C 12 SECTORS ARE SKIPPED, 2 SECTORS WITH DIRECTORY ENTRIES,..., ETC. C AS A RESULT, AS EACH BLOCK OF ENTRIES ARE RESET, THEY ARE C IMMEDIATELY RESTORED TO THE DISC. C C THE PARAMETERS ARE: C C ISCTR - SEC/TRK VALUE OF THE CARTRIDGE ON THE MAG TAPE C IDUM - SEC/TRK VALUE OF THE DISC CARTRIDGE C FLAG - CATCHES FMGR ERROR FOR USE IN CALLS TO SUB. VVALD C IERR - ERROR CODE (AS GAINED FROM SUBROUTINE VVALD) C = 0 NO PROBLEMS (NORMAL TERMINATION) C = 1 END OF FILE ENCOUNTERED C =-1 ABORT MAIN PROGRAM (READT) C =-2 PARITY ERROR C C C C LOCAL VARIABLES USED: C C ILNTH,JLNTH - WORD/TRK OF MAG TAPE AND DISC C TOTL - TOTAL LENGTH FROM ALL DIRECTORY ENTRIES (IN SECTORS) C SEC - SECTOR ADDRESS OF BLOCK �×������þúTO BE WRITTEN TO DISC C DIRTK - CURRENT DIRECTORY TRACK COUNT C SECTR - # SECTORS WRITTEN TO THE DISC C OFSET - FIRST WORD OF JBUF TO BE WRITTEN NEXT C ENTRY - # DIRECTORY ENTRIES FOUND (8 IN EACH BLOCK) C SKIP - # WORDS TO SKIP FOR SECTOR SKIPPING THRU DIRECTORY TRACK C FIRST - =0, FIRST DIRECTORY TRACK FROM THE MAG TAPE C C C AREAS OF CONCERN IN THE DIRECTORY ENTRIES ARE: C C JBUF(1) - STATUS A.K.A. JBUF(N-8) C = 0 LAST DIRECTORY ENTRY C JBUF(5) - STARTING TRACK A.K.A. JBUF(N-4) C JBUF(6) - (RIGHT BYTE) STARTING SEC. A.K.A. JBUF(N-3) C C C *** NOTE *** C C IN CASES WHERE THE RATIO OF INTEGER VARIABLES ARE COMPUTED, EACH IS C FLOATED BEFORE THE OPERATION. THIS IS TO AVOID THE TRUNCATION AFTER C EACH INTEGER OPERATION WHICH NORMALLY OCCURS. C C IMPLICIT INTEGER(A-Z) DOUBLE PRECISION TOTL(2) DIMENSION JBUF(8192) COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193) EQUIVALENCE (JBUF,IBUF(2)) FIRST=0 SEC=0 DIRTK=1 SKIP=12*64 ENTRY=1 SECTR=0 OFSET=1 N=9 ILNTH=ISCTR*64 JLNTH=IDUM*64 C MNDIR=JBUF(9) TEMP=0 CNTR=0 C C C GET READY TO SET ENTRIES. (4 DIRECTORY ENTRIES/SECTOR) C 10 DO 46 I=1,ISCTR*4 C C LAST DIRECTORY ENTRY? C C C C IF THIS IS THE FIRST TIME THROUGH; SKIP. C IF(FIRST.NE.0) GOTO 450 IF((DIRTK.EQ.1).AND.(N.EQ.9)) GOTO 455 C C IF IT'S THE FIRST DIRECTORY ENTRY, GO SET TRACK AND SECTOR ADDRESSES C TO ZERO. C IF((DIRTK.EQ.1).AND.(N.EQ.25)) GOTO 445 GOTO 450 C C FIRST DIRECTORY ENTRY. THIS FILE WILL START AT 0,0. C 445 TA=JBUF(5) SA=0 TOTL=FLOAT(JBUF(5))*FLOAT(IDUM) C C C INTIALIZE THE PREVIOUS FILE'S TRACK AND SECTOR POINTER C OLDTA=JBUF(5) OLDSA=0 OLDSZ=0 C C TIME TO CLEg������þúAR ALL OPEN FLAGS. C 450 DO 45 J=1,7 JBUF(N+J)=0 45 CONTINUE C C IF FILE DIRECTORY ENTRY IS TYPE 0 FILE C THEN DON'T COMPUTE TRACK/SECTOR. C IF(JBUF(N-5).EQ.0)GO TO 455 C C GRAB CURRENT FILE TRACK AND SECTOR ADRRESSES BEFORE UPDATE C TA1=JBUF(N-4) SA1=IAND(JBUF(N-3),000377B) SZ1=JBUF(N-2) IF(SZ1.LT.0)SZ1=IABS(SZ1)*128 C C C NOW COMPUTE DIFFERENCE BETWEEN OLD AND CURRENT TRACK AND C SECTOR LOCATION C DIFTA=TA1-OLDTA DIFSA=SA1-OLDSA SIZE=FLOAT(DIFTA)*FLOAT(ISCTR)+DIFSA C IF(SIZE.LE.OLDSZ)GO TO 452 TOTL=(TOTL)-FLOAT(ISEC)+FLOAT(SIZE) C C REFIGURE TRACK AND SECTOR BASED ON NEW SIZE C TA=(TOTL)/FLOAT(IDUM) SA=(TOTL)-(FLOAT(TA)*FLOAT(IDUM)) C C SET CURRENT DIRECTORY ENTRIES. C 452 JBUF(N-4)=TA JBUF(N-3)=IAND(JBUF(N-3),177400B) JBUF(N-3)=IOR(JBUF(N-3),SA) C OLDTA=TA1 OLDSA=SA1 OLDSZ=SZ1 C C CALCULATE STARTING SECTOR AND TRACK FOR NEXT FILE. (DON'T NEED TO C INCREMENT, ALWAYS START AT SECTOR ZERO). WATCH OUT FOR POSSIBLE C NEGATIVE LENGTH OF FILE. C ISEC=JBUF(N-2) IF(ISEC.LT.0) ISEC=IABS(ISEC)*128 TOTL=(TOTL)+FLOAT(ISEC) TA=(TOTL)/FLOAT(IDUM) SA=(TOTL)-(FLOAT(TA)*FLOAT(IDUM)) C C CHECK NUMBER OF DIRECTORY ENTRIES WHICH HAVE BEEN RESET. MAY C HAVE TO INCREMENT "N" TO GET THE NEXT DIRECTORY ENTRY DUE TO C SECTOR SKIPPING. C 455 ENTRY=ENTRY+1 IF(ENTRY.LE.8) GOTO 456 C C ALL DONE WITH THIS 2 SECTOR BLOCK OF DIRECTORY ENTRIES RESTORE IT. C TEMP=TEMP+1 C CALL EXEC(2,IDISC+74000B,JBUF(OFSET),128,TSIZE-DIRTK,SEC) C C MAKE SURE WRITE WAS O.K. C CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,128,TSIZE-DIRTK,SEC,0,FLAG,0) C C UPDATE ALL POINTERS SO CAN GET NEXT SET OF DIRECTORY ENTRIES C IN THE PROPER ORDER. C ENTRY=1 SEC=SEC+14 IF(SEC.GE.IDUM) SEC=SEC-IDUM ¦k������þú OFSET=OFSET+128+SKIP IF(OFSET.GT.ILNTH) OFSET=OFSET-ILNTH N=N+SKIP IF(N.GT.ILNTH) N=N-ILNTH C C CHECK TO SEE IF DISC TRACK FULL. C SECTR=SECTR+2 IF(SECTR.LT.IDUM) GOTO 456 C C RAN OUT OF DISC TRACK. START A NEW ONE. C DIRTK=DIRTK+1 SEC=0 SECTR=0 C C INCREMENT "N" TO POINT TO NEXT DIRECTORY ENTRY TO BE FOUND ON C THE MAG TAPE. C 456 N=N+16 46 CONTINUE C C IF LOOP ENDS NATURALLY, NEED NEXT DIRECTORY TRACK FROM MAG TAPE. C MNDIR=MNDIR+1 IF(MNDIR)550,600,600 550 CALL EXEC(1,MTLU,IBUF,ILNTH+1) CALL ABREG(IA,IB) C C MAKE SURE READ WAS O.K. C IERR=0 CALL VVALD(IA,IB,OFSET,128,TSIZE-DIRTK,SEC,ILNTH,FLAG,IERR) IF(IERR.NE.0) GOTO 600 C C RESET NECESSARY POINTERS AND GO AGAIN. C OFSET=1 N=9 FIRST=-1 GOTO 10 C C DONE. NOW CLEAR OUT OLD ENTRIES WHICH MAY BE LEFT ON THE DISC. C 600 IF(SECTR.GE.IDUM) GOTO 900 DO 42 I=1,128 JBUF(I)=0 42 CONTINUE C C WANT TO CLEAR OFF OLD DIRECTORY ENTRIES FROM DISC. C 48 CALL EXEC(2,IDISC+74000B,JBUF,128,TSIZE-DIRTK,SEC) C C MAKE SURE WRITE WAS O.K. C CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,128,TSIZE-DIRTK,SEC,0,FLAG,0) SEC=SEC+14 IF(SEC.GE.IDUM) SEC=SEC-IDUM SECTR=SECTR+2 IF(SECTR.LT.IDUM) GOTO 48 C C DID THE NUMBER OF DIRECTORY TRACKS CHANGE? IF YES, UPDATE INFO ALREADY C RESTORED TO THE DISC. C 900 IF(DIRTK.EQ.NDIR) RETURN CALL EXEC(1,IDISC,JBUF,128,TSIZE-1,0) C TEMP=TEMP*2 C 910 CNTR=CNTR+1 C C TEMP HAS TOTAL NUMBER OF SECTORS WRITTEN TO DISC DIRECTORY C TEMP=TEMP-IDUM IF(TEMP.GT.0)GO TO 910 JBUF(9)=-CNTR JBUF(8)=TSIZE-CNTR C CALL EXEC (2,IDISC+74000B,JBUF,128,TSIZE-1,0) C C MAKE SURE WRITE WAS O.K. C CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,128,TSIZE-1,0,0,FLAG,0) Ù†����� RETURN END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������U������ÿÿ����� ���� ÿý�Â� Ì ���������ÿ��92067-18505 2026� S C0122 �&REFMT SUBROUTINE � � � � � � � � � � � � � �H0101 jw�����þúFTN4,L,C SUBROUTINE REFMT (ISCTR,IDUM,FLAG,IERR,TEMP2) & ,92067-1X505 REV.2026 800522 C C * C * C ******************************************************************* C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C * CONSENT OF HEWLETT-PACKARD COMPANY. C ******************************************************************* C * C * C * NAME : REFMT C * SOURCE: 92067-18505 C * RELOC: 92067-16505 C * PGMR : R.D C * C * C * C ******************************************************************* C * C * C * C * C C C THIS SUBROUTINE RE-FORMATS DATA TRACKS STORED ON A MAG TAPE C (VIA WRITT) BEFORE RESTORING IT TO A DISC CARTRIDGE (AS INITIATED C BY READT) WHICH HAS A DIFFERENT SEC/TRK VALUE. C THE FULL TRACK (RECORD) IS READ FROM THE MAG TAPE EACH TIME AND THE C LARGEST PORTION OF THAT RECORD IS WRITTEN TO THE DISC EACH TIME. C C THE PARAMETERS ARE: C C ISCTR - SEC/TRK OF MAG TAPE C IDUM - SEC/TRK OF DISC C FLAG - CATCHES FMGR ERROR FOR USE IN CALLS TO SUB. VVALD C IERR - ERROR CODE (AS GAINED FROM SUBROUTINE VVALD) C = 1 END OF FILE ENCOUNTERED (NORMAL TERMINATION) C =-1 ABORT MAIN PROGRAM (READT) C =-2 PARITY ERROR C TEMP2 - THE STARTING FMP TRACK C C C C LOCAL VARIABLES USED: C C ILNTH,JLNTH - WORD/TRK OF MAG TAPE AND DISC C TRK - TRACK ADDRESS C SEC - SECTOR ADDRESS C TOTL - TOTAL # WORDS WRITTEN TO DISC C FILL,FILL2 - SUBPORTIONS (IN WORDS) OF THE MAG TAPE RECORD C C IMPLICIT INTEGER (A-Z) DIMENSION JBUF(8192) COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193) EQUIVALENCE (JBUF,IBUF(2)) C C INITIALIZE FOR THE DATA TRANSFER C TRK=TEMP2 SEC=0 TOTL=0 FILL2=0 ILNTH=ISCTR*64 JLNTH=ØÇ������þúIDUM*64 C C GET NEXT RECORD (TRACK) FROM MAG TAPE C 300 CALL EXEC(1,MTLU,IBUF,ILNTH+1) CALL ABREG(IA,IB) C C CALCULATE THE 1ST PORTION OF THE RECORD TO BE RESTORED C FILL=JLNTH-TOTL C C MAKE SURE IT'S NOT TOO BIG C IF(FILL.GT.ILNTH) FILL=ILNTH C C MAKE SURE THAT READ WAS VALID C IERR=0 CALL VVALD(IA,IB,1,FILL,TRK,SEC,ILNTH,FLAG,IERR) IF(IERR.NE.0) RETURN C C EVERYTHING'S O.K. RESTORE THAT PORTION C CALL EXEC(2,IDISC+74000B,JBUF,FILL,TRK,SEC) C C MAKE SURE WRITE WAS O.K. C CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,FILL,TRK,SEC,0,FLAG,0) C C CALCULATE THE NEXT SECTOR C SEC=SEC+FILL/64 TOTL=TOTL+FILL C C TRACK FULL? C IF(SEC.LT.IDUM) GOTO 300 C C FULL. RESET SECTOR POINTER AND INCREMENT TRACK POINTER C TRK=TRK+1 SEC=0 TOTL=0 C C ANYMORE OF THAT RECORD LEFT? IF YES, GO RESTORE IT. IF NOT, GET C NEXT ONE. C IF(TOTL.EQ.ILNTH) GOTO 300 C C CALCULATE THE REMAINING PORTION OF THE RECORD C 400 FILL2=ILNTH-FILL C C MAKE SURE IT'S NOT BIGGER THAN IT'S SUPPOSED TO BE C IF(FILL2.GT.JLNTH) FILL2=JLNTH IF(FILL2.EQ.0) GOTO 300 C C NOW RESTORE THE SECOND PORTION. C CALL EXEC(2,IDISC+74000B,JBUF(FILL+1),FILL2,TRK,SEC) C C MAKE SURE WRITE WAS O.K. C CALL ABREG(IA,IB) CALL VVALD(IA,IB,-1,FILL2,TRK,SEC,0,FLAG,0) C C UPDATE THE SECTOR POINTER C SEC=SEC+FILL2/64 TOTL=TOTL+FILL2 C C TRACK FULL? C IF(SEC.LT.IDUM) GOTO 460 C C FULL. INCREMENT THE TRACK POINTER AND RESET THE SECTOR POINTER C TRK=TRK+1 SEC=0 TOTL=0 C C KEEP GOING UNTIL DONE C 460 IF((FILL+FILL2).EQ.ILNTH) GOTO 300 FILL=FILL+FILL2 GOTO 400 END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ž6�������� ������������� �������ÿÿ����� ���� ÿý�Ã�Ë ���������ÿ��92067-18507 2001� S C0122 �&$TA32 �ICD GRANDFATHER TRACK M � � � � � � � � � � � � �H0101 VŽ�����þúASMB,Q,L NAM $TA32,15 92067-16507 REV.2001 791015 AUX TRACK MAP TABLE ENT $TA32 * * * $TA32 DEC -27 * * 7906H/7920H SUBCHANNELS * * SC00 DEC 96 96 SECTORS PER TRACK DEC 0 STARTING AT TRACK 0 OCT 4000 2 SURFACES, HEAD 0 ,ADDRESS 0 DEC 256 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC01 DEC 96 SECTORS PER TRACK DEC 132 STARTING TRACK OCT 4000 2 SURF.,HEAD 0 ,ADDR 0 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC02 DEC 96 SECTORS PER TRACK DEC 236 STARTING TRACK OCT 4000 2 SURF.,HEAD 0, ADDR 0 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC03 DEC 96 SECTORS PER TRACK DEC 340 STARTING TRACK OCT 4000 2 SURF, HEAD 0 ,ADDR 0 DEC 138 NUMBER OF TRACKS OCT 100004 HPIB,NUMBER OF SPARES * * SC04 DEC 96 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 002040 1 SURF.,HEAD 2, ADDR 0 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC05 DEC 96 SECTORS PER TRACK DEC 208 STARTING TRACK OCT 002040 1 SURF, HEAD 2, ADDR 0 DEC 198 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC06 DEC 96 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 002060 1 SURF., HEAD 3, ADDR 0 DEC 400 NUMBER OF TRACKS OCT 100013 HPIB,NUMBER OF SPARES * * SC07 DEC 96 SECTORS PER TRACK DEC 0 L������þú STRARTING TRACK OCT 002100 1 SURF., HEAD 4, ADDR 0 DEC 400 NUMBER OF TRACKS OCT 100013 HPIB,NUMBER OF SPARES * * SC08 DEC 96 SECTORS PER TRACK DEC 411 STARTING TRACK OCT 012000 5 SURF., HEAD 0, ADDR 0 DEC 1024 NUMBER OF TRACKS OCT 100032 HPIB,NUMBER OF SPARES * * SC09 DEC 96 SECTORS PER TRACK DEC 621 STARTING TRACK OCT 012000 5 SURF., HEAD 0, ADDR 0 DEC 985 NUMBER OF TRACKS OCT 100031 HPIB,NUMBER OF SPARES * * * 7925 SUBCHANNELS * * SC10 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4001 2 SURF.,HEAD 0, ADDR 1 DEC 256 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC11 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4041 2 SURF.,HEAD 2, ADDR 1 DEC 256 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC12 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 256 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC13 DEC 128 SECTORS PER TRACK DEC 66 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 256 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC14 DEC 128 SECTORS PER TRACK DEC 132 STARTING TRACK OCT 10001 4 SURF.,HEAD 0, ADDR 1 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC15 DEC 128 SECTO©������þúRS PER TRACK DEC 132 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC16 DEC 128 SECTORS PER TRACK DEC 184 STARTING TRACK OCT 10001 4 SURF., HEAD 0, ADDR 1 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC17 DEC 128 SECTORS PER TRACK DEC 184 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 203 NUMBER OF TRACKS OCT 100005 HPIB,NUMBER OF SPARES * * SC18 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 2201 1 SURF.,HEAD 8, ADDR 1 DEC 228 NUMBER OF TRACKS OCT 100010 HPIB,NUMBER OF SPARES * * SC19 DEC 128 SECTORS PER TRACK DEC 236 STARTING TRACK OCT 22001 9 SURF.,HEAD 0, ADDR 1 DEC 400 NUMBER OF TRACKS OCT 100016 HPIB,NUMBER OF SPARES * * SC20 DEC 128 SECTORS PER TRACK DEC 282 STARTING TRACK OCT 22001 9 SURF., HEAD 0, ADDR 1 DEC 400 NUMBER OF TRACKS OCT 100016 HPIB,NUMBER OF SPARES * * SC21 DEC 128 SECTORS PER TRACK DEC 328 STARTING TRACK OCT 22001 9 SURF.,HEAD 0 , ADDR 1 DEC 228 NUMBER OF TRACKS OCT 100006 HPIB,NUMBER OF SPARES * * SC22 DEC 128 SECTORS PER TRACK DEC 354 STARTING TRACK OCT 22001 9 SURF.,HEAD 0, ADDR 1 DEC 1024 NUMBER OF TRACKS OCT 100035 HPIB,NUMBER OF SPARES * * SC23 DEC 128 Ž����� SECTORS PER TRACK DEC 471 STARTING TRACK OCT 22001 9 SURF., HEAD 0, ADDR 1 DEC 1024 NUMBER OF TRACKS OCT 100035 HPIB,NUMBER OF SPARES * * SC24 DEC 128 SECTORS PER TRACK DEC 588 STARTING TRACK OCT 22001 9 SURF., HEAD 0, ADDR 1 DEC 2048 NUMBER OF TRACKS OCT 100103 HPIB,NUMBER OF SPARES * * * 9895 SUBCHANNELS * * SC25 DEC 60 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4002 2 SURF., HEAD 0,ADDR 2 DEC 134 NUMBER OF TRACKS OCT 100024 HPIB,NUMBER OF SPARES * * SC26 DEC 60 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4002 2 SURF.,HEAD 0, ADDR 2 DEC 134 NUMBER OF TRACKS OCT 102024 HPIB,UNIT 1,NUMBER OF SPARES END ��1R������ÿÿ����� ���� ÿý�Ä�Í ���������ÿ��92067-18509 2001� S C0122 �&$TB32 �MAC GRANDFATHER TRACK M � � � � � � � � � � � � �H0101 [�����þúASMB,Q,L NAM $TB32,15 92067-16509 REV.2001 791015 AUX TRACK MAP TABLE ENT $TB32 * * * $TB32 DEC -25 * * 7905/7906/7920 SUBCHANNELS * * SC00 DEC 96 96 SECTORS PER TRACK DEC 0 STARTING AT TRACK 0 OCT 4000 2 SURFACES, HEAD 0 ,ADDRESS 0 DEC 256 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC01 DEC 96 SECTORS PER TRACK DEC 132 STARTING TRACK OCT 4000 2 SURF.,HEAD 0 ,ADDR 0 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC02 DEC 96 SECTORS PER TRACK DEC 236 STARTING TRACK OCT 4000 2 SURF.,HEAD 0, ADDR 0 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC03 DEC 96 SECTORS PER TRACK DEC 340 STARTING TRACK OCT 4000 2 SURF, HEAD 0 ,ADDR 0 DEC 138 NUMBER OF TRACKS DEC 4 NUMBER OF SPARES * * SC04 DEC 96 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 002040 1 SURF.,HEAD 2, ADDR 0 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC05 DEC 96 SECTORS PER TRACK DEC 208 STARTING TRACK OCT 002040 1 SURF, HEAD 2, ADDR 0 DEC 198 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC06 DEC 96 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 002060 1 SURF., HEAD 3, ADDR 0 DEC 400 NUMBER OF TRACKS DEC 11 NUMBER OF SPARES * * SC07 DEC 96 SECTORS PER TRACK DEC 0 STRARTING TRACK aD������þú OCT 002100 1 SURF., HEAD 3, ADDR 0 DEC 400 NUMBER OF TRACKS DEC 11 NUMBER OF SPARES * * SC08 DEC 96 SECTORS PER TRACK DEC 411 STARTING TRACK OCT 012000 5 SURF., HEAD 0, ADDR 0 DEC 1024 NUMBER OF TRACKS DEC 26 NUMBER OF SPARES * * SC09 DEC 96 SECTORS PER TRACK DEC 621 STARTING TRACK OCT 012000 5 SURF., HEAD 0, ADDR 0 DEC 985 NUMBER OF TRACKS DEC 25 NUMBER OF SPARES * * * 7925 SUBCHANNELS * * SC10 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4001 2 SURF.,HEAD 0, ADDR 1 DEC 256 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC11 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 4041 2 SURF.,HEAD 2, ADDR 1 DEC 256 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC12 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 256 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC13 DEC 128 SECTORS PER TRACK DEC 66 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 256 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC14 DEC 128 SECTORS PER TRACK DEC 132 STARTING TRACK OCT 10001 4 SURF.,HEAD 0, ADDR 1 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC15 DEC 128 SECTORS PER TRACK DEC 132 STARTING TRACÐp������þúK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC16 DEC 128 SECTORS PER TRACK DEC 184 STARTING TRACK OCT 10001 4 SURF., HEAD 0, ADDR 1 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC17 DEC 128 SECTORS PER TRACK DEC 184 STARTING TRACK OCT 10101 4 SURF., HEAD 4, ADDR 1 DEC 203 NUMBER OF TRACKS DEC 5 NUMBER OF SPARES * * SC18 DEC 128 SECTORS PER TRACK DEC 0 STARTING TRACK OCT 2201 1 SURF.,HEAD 8, ADDR 1 DEC 228 NUMBER OF TRACKS DEC 8 NUMBER OF SPARES * * SC19 DEC 128 SECTORS PER TRACK DEC 236 STARTING TRACK OCT 22001 9 SURF.,HEAD 0, ADDR 1 DEC 400 NUMBER OF TRACKS DEC 14 NUMBER OF SPARES * * SC20 DEC 128 SECTORS PER TRACK DEC 282 STARTING TRACK OCT 22001 9 SURF., HEAD 0, ADDR 1 DEC 400 NUMBER OF TRACKS DEC 14 NUMBER OF SPARES * * SC21 DEC 128 SECTORS PER TRACK DEC 328 STARTING TRACK OCT 22001 9 SURF.,HEAD 0 , ADDR 1 DEC 228 NUMBER OF TRACKS DEC 6 NUMBER OF SPARES * * SC22 DEC 128 SECTORS PER TRACK DEC 354 STARTING TRACK OCT 22001 9 SURF.,HEAD 0, ADDR 1 DEC 1024 NUMBER OF TRACKS DEC 29 NUMBER OF SPARES * * SC23 DEC 128 SECTORS PER TRACK DEC 471 STARTING TRACK OCT 22001 ,™����� 9 SURF., HEAD 0, ADDR 1 DEC 1024 NUMBER OF TRACKS DEC 29 NUMBER OF SPARES * * SC24 DEC 128 SECTORS PER TRACK DEC 588 STARTING TRACK OCT 22001 9 SURF., HEAD 0, ADDR 1 DEC 2048 NUMBER OF TRACKS DEC 67 NUMBER OF SPARES END ������������������������������������������������������������������������������������������������������������������������������������������Ô•������ÿÿ����� ���� ÿý�Å�Î ���������ÿ��92067-18512 2001� S C0122 �&MTLDR �MAG TAPE LOADR � � � � � � � � � � � � �H0101 Œr�����þúASMB,A,B,L MAG TAPE LOADER ORG 2 ************************************************************** * * REV. 1913 781218 * ************************************************************** * JMP *+1,I DEF START * * ORG 77500B * DC EQU 20B CC EQU DC+1 A EQU 0 B EQU 1 START LIA 1 GET S REGISTER LSR 6 SHIFT 6 BITS RIGHT AND B77 MASK OUT LOWER 6 BITS STA SCODE * * LDB IOTB1 GET TABLE 1 ADDRESS JSB SETIO SET IO INSTR ISZ SCODE LDB IOTB2 GET TABLE 2 ADDRESS JSB SETIO NRD LDB RDCMD GET READ COMMAND JSB CMD DO IT IOD1 STC DC,C START DATA CHANNEL IOC2 SFC CC JMP STAT CHECK STATUS IOD2 SFS DC ANY DATA JMP *-3 NO IOD3 LIB DC,C YES GET IT(RECORD COUNT) BLF,BLF POSITION COUNT TO LOWER BYTE CMB MAKE IT NEGATIVE STB WCT SAVE INPUT COUNT IOC3 SFC CC JMP STAT YES EXIT TO STATUS IOD4 SFS DC WAIT TO READ NEXT WORD JMP *-3 IOD5 LIB DC,C GET LOAD ADDRESS STB 0 START CHECKSUM STB CMD AND ADDRESS POINTER JMP *+4 NWD STB CMD,I PUT WORD IN MEMORY ADA 1 MOVE ISZ CMD MOVE UP ADDRESS IOD6 SFS DC WAIT FOR NEXT WORD JMP *-1 IOD7 LIB DC,C GET DATA TO STORE IN MEMORY ISZ WCT FINISHED WITH DATA? JMP NWD NO READ NEXT WORD CPB 0 IS CHECK SUM OK? JMP NRD+3 YES-WAIT FOR COMMAND CHANNEL STATUS HLT 11B NO IOC4 EQU * STAT LIA CC GET STATUS ALF,ALF POSITION EOF BIT SSA IS IT EOF JMP 2 GO TO LOC 2 TO START !DISK ALF,ALF RAR,SLA HLT 0 JMP NRD YES RED NEXT RECORD * * * * CMD NOP IOC5 OTB CC IOC6 LIA CC RAR,RAR RAR,SLA JMP *-4 IOC7 STC CC,CX°��� ��  JMP CMD,I * * SL0RW OCT 1501 RDCMD OCT 1423 * * SCODE NOP BM100 OCT -100 B77 OCT 77 * * SETIO NOP STB .IOTB LOOP LDB .IOTB,I SZB,RSS JMP SETIO,I LDA B,I AND BM100 ADA SCODE STA B,I RESET IO INSTRUCTION ISZ .IOTB JMP LOOP * * .IOTB NOP IOTB1 DEF *+1 DEF IOD1 DEF IOD2 DEF IOD3 DEF IOD4 DEF IOD5 DEF IOD6 DEF IOD7 NOP * IOTB2 DEF *+1 DEF IOC2 DEF IOC3 DEF IOC4 DEF IOC5 DEF IOC6 DEF IOC7 NOP WCT NOP END ��������������������������������������������������������������������������������������������������������������������Và ������ÿÿ����� ���� ÿý�Æ�Í ���������ÿ��92067-18513 2001� S C0522 �&SWTCH �SWTCH MAIN � � � � � � � � � � � � �H0105 m=�����þúASMB,Q,R,C HED SWTCH - TRANSFERS FILE CONTAINING RTE-IV SYSTEM GENERATED ONLINE NAM SWTCH,3,10 92067-16513 REV.2001 791022 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWTCH * SOURCE: 92067-18513 * BINARY: 92067-16513 * WRITTEN BY: KFH,JJC * **************************************** SPC 2 * * TURN - ON SEQUENCE: * * RU,SWTCH,FNAME:SC:CR,CHAN/DISC LU,SUBCH/UNIT/ADDR,AUTO,FILES,TYPE6,INIT * * WHERE: * * FLNAME:SC:CR IS THE ABSOLUTE OUTPUT FILE NAME OF THE NEW SYSTEM * CHAN 7900 DISC ONLY: <OCTAL TARGET SELECT CODE>"B" * OR * DISC LU 7905/05/20/25(H) DISCS: DUMMY LU THAT POINTS AT DRIVER * SUBCH IS THE TARGET 7900 SUBCHANNEL * OR * UNIT IS THE TARGET 7905/06/20/25 UNIT * OR * ADDR IS THE HPIB SELECT ADDRESS * AUTO IS Y/N, FOR AUTO BOOT-UP * FILES IS Y/N, FOR SAVING THE TARGET FILE SYSTEM * TYPE6 IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET * INIT IS Y/N, FOR INITIALIZING ANY ADDITIONAL SUBCHANNELS SPC 2 * * * THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CALLED THE * ABSOLUTE OUTPUT FILE WHICH CONTAINS A COMPLETE RTE-IV+ * SYSTEM FOR THE SPECIFIC DISC CONFIGURATION AS SPECIFIED AT * GENERATION TIME. SWTCH COPIES THE FILE ONTO THE SPECIFIED * DISC SELECT CODE AND SUBCHANNEL FOR 7900 TYPE DISCS. SWTCH * CONFIGURES ITS OWN DRIVER TO THIS SELECT CODE. IN THE CASE OF * ALL TYPE 32 DISCS (IE. 7905/05/20/25 (H)) ßÊ������þúSWTCH REQUIRES A * DUMMY DISC LU WHICH POINTS AT THE CORRECT DRIVER IN THE HOST * SYSTEM. SWTCH THEN CALLS THE ON-LINE DRIVER VIA THE DRIVER * LIBRARY SUBROUTINES TO DO THE NECESSARY I/O TO THE TARGET DISC. * * BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, * THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION, * INCLUDING THE SYSTEM SUBCHANNEL DEFINITION. * * IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW * FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN * INTO THE FMP CARTRIDGE DIRECTORY SO THAT ON BOOTUP, FMP * WILL REMAIN INTACT (INITIALIZED). SKP * ENTRY POINTS * ENT SWTCH * ENT \SWTM ENT \DFTR,\DSHD,\DNSU,\DNSP,\DNTR,\DSUB ENT \TUNT,\TDLU,\TSUB,\DUNT,\D#ST,\D#WT ENT \INIT,\LNTH ENT \BUFI,\BUFA,\XOUT,\SAVE ENT \TRAK,\SECT ENT \CVAS,\CLEN,\DSPL,\BLIN,\RDIN,\DFLT ENT \FFMP,\STRK ENT \BOOT,\TMT,\LU2,\MODE * * EXTERNAL ENTRY POINTS * EXT RMPAR,EXEC,$LIBR,SEGLD EXT OPEN,READF,LOCF,CLOSE EXT $LIBR,$LIBX * EXT \DSK0,\DSK5 EXT \INP0,\INT0 EXT \STD0 EXT CNUMD,GETST EXT \RET EXT \FLGT,\SETD,\BADH EXT EQTRQ,\GDMA,\RDMA,$DATC * SPC 2 A EQU 0 B EQU 1 SUP SKP * HEADER RECORD #1 FORMAT * * FOR A 7905/6/20/25(H) SYSTEM: * * ------------------------------------ * ! # 64-WORD SECTORS/TRACK ! * ------------------------------------ * ! FIRST CYLINDER # ! ONE 5-WORD * ------------------------------------ * ! # SUFACES ! STARTING HEAD!UNIT/AD! ENTRY FOR * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNELS * ------------------------------------ * !100!UNIT(3)!00 ! #SPARES(8) ! 0 THRU 31 * ------------------------------------ * <- HPßÞ������þúIB DISCS -> * ONLY * * FOR A 7900 SYSTEM: * * ------------------------------------ * ! FIRST TRACK # ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 SKP * HEADER RECORD #2 FORMAT * * . * . * . * * ------------------------------------ * ! 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ! INDICATES AN RTE-IV+ * ------------------------------------ * 59 !1! SYSTEM SUBCHANNEL# BIT 15=HPIB ! * ------------------------------------ * 60 ! SYSTEM EQT # ! * ------------------------------------ * 61 ! NUMBER OF EQT'S ! * ------------------------------------ * 62 ! PRIV. INT. CHANNEL ! * ------------------------------------ * 63 ! TBG CHANNEL ! * ------------------------------------ * 64 ! # SUBCHANNELS ! TTY CHANNEL ! * ------------------------------------ * 65 ! CHANNEL # ! EQT TYPE ! FOR EQT #1 * ------------------------------------ * . . * . . * . . * ------------------------------------ * 127 ! CHANNEL # ! EQT TYPE ! FOR EQT #63 * ---------D������þú--------------------------- SKP SPC 4 *------------------------------------------------------------------------ * * THE FOLLOWING 8192 WORDS WILL BE OVERLAID * ONCE THE TRANSFER PROCESS BEGINS. BUFR * WILL CONTAIN ONE TRACK'S WORTH OF INFO. * *------------------------------------------------------------------------ SPC 4 IBBUF BSS 16 COMMAND BUFFER FOR DRIVER LIBRARY BUFR BSS 128 BUFFER FOR MAXIMUM SIZE TRACK (8192 WORDS) * * MES1 DEF *+1 ASC 22, ****** W A R N I N G ****** MES2 DEF *+1 ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM ASC 9,TRANSFER PROCESS. SPC 2 BSS 512+BUFR-* NEED TO READ IN 4 RECORDS AT VERF1 SPC 2 MES3 DEF *+1 ASC 14,FILE NAME OF NEW RTE SYSTEM? MES4 DEF *+1 ASC 16,ILLEGAL FILE NAME - FMP ERR XXXX MES4A DEF MES4+15 MES5 DEF *+1 ASC 15,NEW SYSTEM I/O CONFIGURATION: MES6 DEF *+1 ASC 18,SELECT CODE XX PRIVILEGED INTERRUPT MES6A DEF MES6+7 MES7 DEF *+1 ASC 9,SELECT CODE XX TBG MES7A DEF MES7+7 MES8 DEF *+1 ASC 11,SELECT CODE XX TYPE=XX MES8A DEF MES8+7 MES8B DEF MES8+11 MES9 DEF *+1 ASC 24,NEW SYSTEM (LU2) SELECT CODE= XX SUBCHANNEL= XX MES9A DEF MES9+16 MES9B DEF MES9+24 MES10 DEF *+1 ASC 12,PLATTER XX FIRST TRACK# MS10A ASC 9,XXXX #TRACKS XXXX MS10C DEF MS10A MS10D DEF MS10A+7 MES11 DEF *+1 ASC 4,ILLEGAL MS12 ASC 25,TARGET SELECT CODE FOR NEW SYSTEM? (XX OR " "CR) MES12 DEF MS12 MSS12 DEF *+1 ASC 25,TARGET DISC LU FOR NEW SYSTEM? (XX) MES13 DEF *+1 ASC 18,TARGET ADDRESS/UNIT/PLATTER FOR NEW ASC 10,SYSTEM? (X OR " "CR) MES16 DEF *+1 ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN MES17 DEF *+1 ASC 25,TARGET ADDRESS/UNIT/PLATTER. (" "CR TO CONTINUE) MES18 DEF *+1 ASC 16,SAVE FILES AT TARGET? (Y OR N) MES19 DEF *+1 ASC 19,NEW SYSTEM WI$P������þúLL DESTROY SOME FMP FILES MES20 DEF *+1 ASC 12,OK TO PROCEED? (Y OR N) MES22 DEF *+1 ASC 15,PURGE TYPE 6 FILES? (Y OR N) MES23 DEF *+1 ASC 23, INFORMATION STORED ON ADDRESS/UNIT/PLATTER XX ASC 13, OF TARGET SELECT CODE XX MS23A DEF MES23+23 MS23B DEF MES23+36 MS23C DEF *+1 ASC 9, WILL BE DESTROYED MES24 DEF *+1 ASC 12,AUTO BOOT-UP? (Y OR N) MES25 DEF *+1 ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. MES26 DEF *+1 ASC 22,DISC IN HOST SYSTEM DRIVE WILL BE OVERLAID. MES32 DEF *+1 ASC 17,READY TO TRANSFER. OK TO PROCEED? MES34 DEF *+1 ASC 18,INITIALIZE SUBCHANNELS ? (Y OR N) MS34A DEF MES34+12 "L" ASC 1,L MES35 DEF *+1 ASC 15,TARGET PLATTER? (XX OR " "CR) MES36 DEF *+1 ASC 20,TARGET ADDRESS/UNIT XX FOR SUBCHANNELS MS36A ASC 24, ASC 20, ASC 24, COMBL ASC 1,, MS36B DEF MS36A MES37 DEF *+1 ASC 20,DESTN. ADDRESS/UNIT XX FOR SUBCHANNELS MS37A ASC 24, ASC 20, ASC 24, MS37B DEF MS37A MES38 DEF *+1 ASC 18,TARGET ADDRESS/UNIT? (XX OR " "CR) MES40 DEF *+1 ASC 17,#TRACKS FIRST CYL MS40A DEF MES40+6 MS40B DEF MES40+16 MES41 DEF *+1 ASC 17,HEAD # #SURFACES MS41A DEF MES41+6 MS41B DEF MES41+16 MES42 DEF *+1 ASC 17,ADDR/UNIT #SPARES MS42A DEF MES42+6 MS42B DEF MES42+16 MES43 DEF *+1 ASC 17,#SECTORS/TRACK MS43B DEF MES43+16 MES46 DEF *+1 ASC 12,OUTDATED SYSTEM SOFTWARE * SWAP0 DEF *+1 ASC 3,SWSG1 7900 DISK DRIVER SEGMENT SWAP5 DEF *+1 ASC 3,SWSG2 TYPE 32(13037 CTRLR) & HPIB DRIVER SEGMENT SKP * CONSTANTS * B177 OCT 177 B777 OCT 777 B2060 OCT 20060 * N6 DEC -6 N7 DEC -7 N8 DEC -8 N31 DEC -31 N64 DEC -64 N89 DEC -89 N128 DEC -128 * P7 DEC 7 P12 DEC 12 P13NA OCT 100015 DECIMAL 13 +100000B (NO ABORT BIT) P14 DEC 14 P31 DEC 31 P98 DEC 98 P161 DEC 161 ¹Q������þúP512 DEC 512 * * #LEP EQU 1762B # OF LIBRARY ENTRY POINTS IN LIST ALEP EQU 1761B ADDR " " " LIST LEPL NOP LENGTH " " " " LCNT NOP COUNTER $T ASC 1,$T B3 ASC 1,B3 .2 ASC 1,2 TMTSF OCT 2202 SKP * * GTLEN COMPUTES LLEN FOR READING THE * LIBRARY ENTRY POINTS LIST INTO * BUFR * * CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. * JSB GTLEN * GTLEN NOP LDB P512 THE NORMAL BUFFER SIZE CMA,INA IF MORE THAN THE REMAINING ADA P512 LEP SIZE, THEN USE THE SIZE SSA,RSS IN (A) LDB LEPL STB LLEN JMP GTLEN,I SPC 5 * * READD READS LLEN WORDS AT TRACK LTRK, AND * SECTOR LSEC * READD NOP JSB EXEC DEF *+7 DEF D1 DEF P2 DEF BUFR DEF LLEN DEF LTRK DEF LSEC * JMP READD,I * * LTRK NOP LSEC NOP SKP * * VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH * AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING * CHECKS ARE MADE: * * VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE * LAST SYSTEM TRACK (AS DEFINED BY THE NEW * SYSTEM) * OR VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY * EXISTS ON THIS TRACK * * * RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE * (P+2) CAN SAVE IT * VFYSY NOP CLA STA \INIT CLEAR INIT WORD FOR DISKD * LDA N128 STA \LNTH READ 128 WORDS CCE HOPEFULLY THEY WILL CONTAIN LDB \BUFA THE DIRECTORY AT STB BPTR TARGET SUBCHANNEL CCA ADA \DNTR DESTINATION SYSTEM LAST(LOGICAL) STA \TRAK TRACK, LESS 1 CLA STA \SECT INA STA \MODE SET TYPE 32 DRIVER MODE TO REG R/W JSB DISKD * * * VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY * LDA N31 è!������þúMAX # CARTRIDGE ENTRIES STA TEMP1 CHCD0 LDA BPTR,I GET WORD 0 OF ENTRY SSA JMP NEWFD LU WORD < 0 LDB N64 ADB A SSB,RSS JMP NEWFD LU > 77(8) * CPA D0 END OF LU'S ? JMP CHCD3 YES CPA P2 LU 2 (SYSTEM) ? RSS YES JMP CHCD1 CHECK WORDS 1-3 IN ENTRY * LDB BPTR GET WORD #1 OF THE (POSSIBLY) INB SYSTEM LU 2 ENTRY LDA B,I SSA JMP NEWFD LAST FMP TRACK WORD < 0 STA D.LT SAVE FOR LATER CHECKS * CHCD1 LDA N3 STA TEMP2 * CHCD2 ISZ BPTR CHECK WORDS 1,2,&3 LDA BPTR,I OF ENTRY FOR VALUES SSA >= 0 JMP NEWFD INVALID ISZ TEMP2 JMP CHCD2 CHECK NEXT WORD ISZ BPTR NEXT ENTRY WORD 0 ISZ TEMP1 LAST ENTRY (31)? JMP CHCD0 NO,CONTINUE * * POSSIBLY A NEW FILE DIRECTORY FORMAT: CARTRIDGE DIRECTORY * IS AT END OF OP SYSTEM * NEWFD LDB \BUFA RESET BUFFER POINTER STB BPTR TO CHECK FOR FD AT ISZ D.LT BEGINNING OF DIRECTORY TRACK NOP SET D.LT TO 0 TO INDICATE ISZ OLDNU A POTENTIAL NEW FORMAT JMP CHFD0 CHECK FOR FD * CHCD3 LDA D.LT (WAS INITIALLY -1) SSA JMP NEWFD NEVER SET BY A LU 2 LDA BF124 SZA JMP NEWFD WORD 124 OF CD MUST = 0 * * * LOOKED LIKE A CARTRIDGE DIRECTORY. NOW TRY FOR A * FILE DIRECTORY IN THE NEXT BLOCK. * CCA ADA \DNTR DETERMINE DISK ADDRESS OF NEXT STA \TRAK BLOCK CONTAINING THE LDA P14 FILE SPEC ENTRY STA \SECT READ 128 WORDS, HOPEFULLY THE LDB \BUFA SPEC ENTRY STB BPTR CCE JSB DISKD * CHFD0 LDA BPTR,I TESTS FOR A VALID FILE DIRECTORY ENTRY: SSA,RSS JMP NOTFS WORD 0 MUST BE < 0 * LDA N7 WORDS 1-7,9-15 IN SPEC MUST BE{h������þú >= 0 STA TEMP2 CHFD1 ISZ BPTR LDA BPTR,I SSA JMP NOTFS < 0, THEREFORE INVALID ISZ TEMP2 JMP CHFD1 * ISZ BPTR WORD 8 MUST BE < 0 LDA BPTR,I SSA,RSS JMP NOTFS LDA N6 NOW CHECK WORDS 9-15 STA TEMP2 CHFD2 ISZ BPTR LDA BPTR,I SSA JMP NOTFS ISZ TEMP2 JMP CHFD2 * LDA BF6 WORD 6 (#SECTORS/TRACK) MUST BE CPA \D#ST SAME AS DESTINATION SYSTEM RSS JMP NOTFS AND LDB BF5 >= WORD 5 (NEXT AVAILABLE SECTOR) CMB,INB ADA B SSA JMP NOTFS INVALID * LDA BF7 LOWEST DIRECTORY TRACK(LOGICAL) LDB BF8 MINUS THE NEGATIVE # DIRECTORY STB D.# TRACKS, CMB MINUS 1 ADA B GIVES LAST FMP TRACK CPA D.LT MUST = LAST FMP TRACK INDICATED JMP CHFD3 IN CD FOR LU 2 LDB D.LT ELSE NONE FOUND AT ALL SZB JMP NOTFS NEITHER STA D.LT OTHERWISE UPDATE LAST FMP TRACK * CHFD3 LDB \DNTR DOES THE LOGICAL DIRECTORY TRACK # ADB N1 AT TARGET = LOGICAL DIRECTORY TRACK # CPA B FOR DESTINATION (THE LAST LOGICAL TRACK FOR RSS SYSTEM LU) ? JMP NOTFS NO LDA BF4 SAVE THE FIRST FMP TRACK FOR STA \FFMP FUTURE CHECKS * * SET UP SOME VALUES FOR SCANNING THE DIRECTORY * ENTRIES LATER - ESPECIALLY WHEN PURGING OVERLAID FILES * OR TYPE 6 FILES * LDA OLDNU GET THE FLAG TO INDICATE THE DIFFERENCES LDB \D#ST DETERMINE # OF 16-WORD RBL,RBL ENTRIES PER TRACK SZA,RSS OLD VERSION ADB N8 HAS 8 LESS CUZ OF CD CMB,INB COMPLEMENT STB FDT#E NUMBER TO SCAN ON FIRST TRACK LDB P4 NOW DETERMINE THE WORD 4 OFFSET SZA,RSS IN THE FILE SPEC'N ENTRY ADB P896 n������þú BEGINNING OF SECOND BLOCK FOR OLD ADB \BUFA ADD BUFFER ADDRESS STB FDOFF AND SAVE LDB \BUFA NOW THE OFFSET FOR THE FIRST SZA,RSS DIRECTORY ENTRY (OK TO ADB P128 SCAN THE SPEC'N ENTRY) STB FIRDE LDA \D#WT NOW SET A POINTER TO THE ADA \BUFA LAST WORD+1 IN THE DIRECTORY STA DTEND TRACK BUFFER * ISZ VFYSY LOOKS VALID JMP VFYSY,I * P896 DEC 896 SPC 2 * * ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE * TARGET FILE STRUCTURE TO BE SAVED * NOTFS CLA,INA STA \CLEN * LDA \TSUB LDB DEQT SLB,RSS LDA \TUNT LDB MS23A JSB \CVAS * LDB DEQT LDA \T32C SELECT CODE IF TYPE 32 DISC SLB LDA \TDLU SELECT CODE IF TYPE 31 DISC LDB MS23B JSB \CVAS LDA P36 LDB MES23 "INFORMATION STORED ON ADDRESS/UNIT/... JSB \DSPL OF TARGET SELECT CODE YY WILL BE DESTROYED" LDA P9 LDB MS23C JSB \DSPL * JSB OK? CHECK ANSWER * CLA STA \SAVE DON'T \SAVEFILES STA TYP6 " " PURGE TYPE 6'S JMP VFYSY,I * P36 DEC 36 * BF4 EQU BUFR+4 BF5 EQU BUFR+5 BF6 EQU BUFR+6 BF7 EQU BUFR+7 BF8 EQU BUFR+8 BF124 EQU BUFR+124 SKP * VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP * IN HEADER RECORD #3 * * * RETURN: (P+1) NOT A BOOTSTRAP * (P+2) YES, ONE EXISTS * VT0S0 NOP * LDA DSIB? IS THIS AN HPIB SYSTEM?? SLA DSIB?=1/0=HPIB/NOT HPIB JMP IBISY YES-IBI SYSTEM * LDB BPTR ADB B155 LDA P5 # WORDS FOR CHECKSUM JSB CHKSM CPA MAGIC DOES IT MATCH THE BOOT'S CHECKSUM ISZ VT0S0 YES - INCR RETURN ADDR. JMP VT0S0,I RETURN * * CHECK OUT THE ICD BOOT EXTENSION IN THE FILE * IBISY LDB BPTR ADB B277 OFFSþ{������þúET INTO THE BOOT TO 'BENTR' LDA P5 # WDS FOR CHECKSUM JSB CHKSM COMPUTE 5 WD CHECKSUM CPA MAGIC DOES IT MATCH MAGIC WORD?? ISZ VT0S0 YES- INCR RETURN JMP VT0S0,I RETURN * * * B155 OCT 155 B277 OCT 277 * MAGIC OCT 101707 THE CHECKSUM OF 5 INSTRUCTIONS IN * THE BOOT EXTENSION SKP * OK? QUERIES THE USER WITH: * "OK TO PROCEED? (Y OR N)" * AND TRANSFERS TO \XOUT ON A "N" RESPONSE, * DOING A SIMPLE RETURN ON A "Y" RESPONSE. * OK? NOP LDA P12 LDB MES20 JSB \DSPL JSB YE?NO DECIPHER ANSWER JMP OK?+1 INVALID REPLY JMP OK?+1 INVALID REPLY JMP \XOUT NO,TERMINATE SWTCH JMP OK?,I SPC 4 * YE?NO READS THE OPERATOR ANSWER ( Y OR N ) * RETURNS TO (P+1) IF INVALID ANSWER * (P+2) IF /E * (P+3) IF NO * (P+4) IF YES * YE?NO NOP LDA N2 LDB \BUFI JSB \RDIN RETRIEVE ANSWER IN IBBUF * CLE CHECK HIGH HALF FIRST LDA IBBUF CPA "/E" JMP EOUT YENO ALF,ALF AND B377 CPA "N" JMP NOUT CPA "Y" JMP YOUT * SEZ CHECK THE LOW HALF? JMP YE?NO,I ALREADY DID - NEITHER MATCHES LDA IBBUF SWITCH EM ALF,ALF CCE JMP YENO CHECK THE LOW HALF * YOUT ISZ YE?NO NOUT ISZ YE?NO EOUT ISZ YE?NO JMP YE?NO,I * "N" OCT 116 "Y" OCT 131 "/E" ASC 1,/E SPC 4 * * READS TARGET RESPONSES, INCLUDING RE-ISSUING EXEC CALL * IN CASE OF TIME-OUTS. * TARGT NOP LDA N8 MAX INPUT LENGTH LDB \BUFI JSB \RDIN GET RESPONSE JMP TARGT,I YES, RETURN SKP * * PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) * PRODUCES A PARAMETER BUFFER 12 WORDS LONG * * THE TWELVE WORDS ARE DESCRIBED AS FOLLOWS: ]ò������þú SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 8 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR : P1 : P2 , P3 , P4 , P5 , P6 , P7 , P8 * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 14,15 * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH " * WORD 11 = 7TH " * WORD 12 = 8TH " SPC 2 * * WHERE: * DNAME = TWELVE WORD DESTINATION PARAMETER BUFFER ADDRESS * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "PARMP" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER. * SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 INBUF NOP INPUT BUFFER ADDRESS PARML NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF * PARMP NOP CCA SET TO NO COMMAS STA FRSTC CLA,INA STA ISTRC SET FIRST CHAR LDB \BUFI STB INBUF INPUT BUFFER ADDRESS LDB DNAME STB BPTR NOW CLEAR OUT DEST BUFFER =©������þú LDA N12 GET DEST BUFFER LENGTH STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 STA WORD4,I INITIALIZE THE TYPE WORD STA FILEW AND THE FILE FLAG LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB PARML GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DI\DN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - PARML -1 CCA,SEZ TEST E FOR ERROR JMP PARMP,I RETURN A= -1 FOR ERROR LDA BPTR GET DESTINATION BUFFER LDB A ADB P3 SET ADDRESS OF TYPE WORD STB BPTR AND BUFFER POINTER LDB P3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER STA FILEW AND SAVE FILE TYPE(IF ANY) LDB FRSTC WAS A COMMA ENCOUNTERED SZB JMP MORE0 NO RAR,RAR YES, SKIP APPROPRIATE RAR,RAR POSITIONS IN WORD4,I STA WORD4,I FOR P1 AND P2 ISZ BPTR AND UPDATE DESTINATION ISZ BPTR POINTER JMP MORE1 MORE0 LDB N2 SET TO GET THE NEXT 2 PARAMETERS AFTER: STB SUBCT ISZ BPTR LDA BPTR CLB,INB JSB SCAN IOR WORD4,I SET BITS FOR SECURITY CODE (FIRST TIME THRU), RAR,RAR OR LABEL PARAMETER(SECOND TIME THRU) STA WORD4,I ISZ SUBCT RSS JMP MORE1 LDB FRSTC GOT A COMMA AFTER ONLY ONE COLON? SZB JMP MORE0+2 NO, A SECOND COLON ISZ BPTR UPDATE DESTINATION POINTER RAR,RAR AND TYPE BITS FOR NULL PARAMETER P2 STA WORD`5���N��LH4,I MORE1 LDB N6 NOW SCAN FOR NEXT 6 SUB-PARAMS STB SUBCT MORE2 ISZ BPTR LDA BPTR GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM IOR WORD4,I MERGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL EIGHT? JMP MORE2 NO, CONTINUE JMP PARMP,I ������������������������������������������������������������������������������������������������������������������������������������������������ª°N������ÿÿ��������þú SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+PARML SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+PARML = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU PARML ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *- ADB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA FSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINUS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR CHARACTER AMORE STB FSTCA SAVE THE 1ST CHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT ã¨������þú STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP INCOM CHECK FOR FIRST COMMA CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECK IT SPC 2 INCOM ISZ FRSTC FIRST COMMA? NOP NO SPC 2 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERSION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, RETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER SPC 1 MMORE MPY BASE1 TRY CONVERSION STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKn°������þúIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA P3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS CLE,ELB FORM CHARACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP —ô������þú ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 FRSTC DEC -1 FIRST COMMA NOT IN YET O10 OCT 10 D10 DEC 10 SUBCT NOP HOLDS SUB-PARAM. COUNTER N12 DEC -12 SPC 4 WORD4 DEF *+5 ADDRESS FOR TYPE WORD DNAME DEF *+1 NAME BSS 3 FOR FILE NAME BSS 1 TYPE WORD BSS 8 PARAMETERS 1-8 ISECU EQU NAME+4 ICR EQU NAME+5 PARM3 EQU NAME+6 PARM4 EQU NAME+7 PARM5 EQU NAME+8 PARM6 EQU NAME+9 PARM7 EQU NAME+10 PARM8 EQU NAME+11 APARM EQU NAME FILEW NOP SKP * PYN - CHECKS FOR A "Y" OR "N" TURN-ON PARAMTER * A-REG = THE PARAMETER * B-REG = PRESENT STATE OF WORD 4,I * * RETURN:(P+1) NEITHER, OR NOT SPECIFIED * (P+2) GOT ONE, A-REG = 0 FOR NO, =1 FOR YES * PYN NOP STA TEMP1 SAVE THE PARAMETER RBR,RBR NEXT WORD4 POSITION SLB,RSS IS THIS PARAMETER SPECIFIED? JMP PYN,I NO * LDA B AND P3 CPA P3 ASCII? RSS JMP PYN,I NO STB TEMP2 SAVE CCB LDA TEMP1 ALF,ALF SHIFT TO LOW AND B377 CPA "N" CLB CPA "Y" CLB,INB SSB,RSS ISZ PYN MATCH SSB,RSS ISZ BATCH ONE *f������þúMORE FOUND NOP LDA B RESTORE LDB TEMP2 JMP PYN,I SPC 3 B400 OCT 400 N72 DEC -72 N2001 DEC -2001 USED FOR DATE CODE CHECK "!!" ASC 1,!! CLER2 OCT 177773 P192 DEC 192 P160 DEC 160 P35 DEC 35 O32 OCT 32 SKP * * * MAINLINE CODE FOR SWTCH * * THE PRECEDING CODE AND THE CODE UP TO BFULL IS OVERLAID * WHEN THE TRANSFER IS BEGUN * SWTCH NOP STB APARM JSB RMPAR DEF *+2 DEF APARM * * * SET UP THE OPERATOR'S LU * LDA APARM GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ APARM NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? JMP *+3 NO,ASCII - USE DEFAULT LU 1 LDA APARM STA OPLU SET THE LU * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * LDA SYSTY GET I-O CHANNEL ADA P3 OF SYSTEM CONSOLE LDA A,I AND B77 STA HTTY * JSB \BLIN LDA P22 DISPLAY WARNING MESSAGES. LDB MES1 JSB \DSPL LDA P32 LDB MES2 JSB \DSPL * * * PARSE THE TURN-ON PARAMETERS * JSB GETST GET THE PARAMETER STRING DEF *+4 DEF IBBUF PUT RESULT IN MESSAGE BUFFER DEF P48 DEF ERR * PARS SZB,RSS ANY THERE? JMP GTNAM NO RBL CONVERT TO CHARACTERS STB PARML SAVE # CHARACTERS JSB PARMP GO PARSE THEM CPA N1 JMP GTNAM COUL\DN'T * * RETRIEVE CHANNEL PARAMETER * LDB WORD4,I GET THE TYPE WORD INTO B SZB,RSS LDB FILEW FILE NAME ONLY SPECIFIED? SZB,RSS JMP GTNAM NO PARAMTERS BLF,BLF SWAP HIGH AND LOW BLF SLB,RSS CHECK BITS 5-4 JMP CP2 NOT SPECIFIED LDA B AND P3 CHECK TYPE CPA D1 RSS JMP CP2 NOT AN INTEGER P������þú LDA PARM3 STA \TDLU GOT ONE - CHECK IT'S RANGE LATER ISZ BATCH * * RETRIEVE THE SUBCHANNEL/UNIT CP2 RBR,RBR GET BITS 7-6 TO LOW SLB,RSS JMP CP3 NOT SPECIFIED LDA B AND P3 CPA D1 MUST BE AN INTEGER RSS JMP CP3 NOT ONE LDA PARM4 STA \TSUB SAVE IT ISZ BATCH * * RETRIEVE PARAMETERS 5, 6, 7, AND 8 CP3 LDA PARM5 JSB PYN CHECK BITS 9-8 RSS NO GOOD STA AUTO LDA PARM6 JSB PYN CHECK BITS 11-10 RSS NO GOOD STA \SAVE LDA PARM7 JSB PYN CHECK BITS 13-12 RSS NO GOOD STA TYP6 LDA PARM8 JSB PYN CHECK BITS 15-14 RSS NO GOOD STA SUBI * LDA FILEW GET FILE TYPE CPA P3 ASCII FILE NAME? ISZ BATCH YES, NOP * CPA P3 FILE NAME? JMP VERIF YES, GO VERIFY IT GTNAM JSB \BLIN NO. LDA P14 LDB MES3 JSB \DSPL ASK FOR FILE NAME, SECUR, LABEL. * READN LDA N72 READ INPUT. LDB \BUFI JSB \RDIN * STB PARML POSITIVE # CHARACTERS. * LDA IBBUF WANT TO EXIT? CPA "!!" CHECK FOR !! JMP \XOUT YES * JSB PARMP PARSE THE STRING. SSA JMP GTNAM TRY AGAIN * VERIF JSB OPEN OPEN THE FILE. DEF *+7 DEF DCB DEF ERR DEF NAME DEF D0 DEF ISECU DEF ICR * SSA,RSS OPEN ERROR? JMP VERF1 NO. * ERRV LDA P2 STA \CLEN SET CONVERSION LENGTH * LDA ERR LDB MES4A WHERE TO STUFF ERROR CODE JSB \CVAS STUFF THE "FMP ERR XXXX" MSG * LDA P9 PRINT LENGTH FOR NO FMP ERR LDB ERR SSB WAS IT AN FMP ERR?? LDA P16 YES-PRINT "...FMP ERR XXXX" LDB MES4 ¤d������þú SEND "ILLEGAL FILENAME [FMP ERR XXXX]" JSB \DSPL JSB CLOSE DEF *+3 DEF DCB DEF ERR JMP GTNAM * VERF1 CPA D1 TYPE 1 FILE? JMP READH JMP ERRV NO * READH JSB READF READ FIRST FOUR RECORDS. DEF *+5 DEF DCB DEF ERR DEF BUFR DEF P512 * SSA READ ERROR? JMP ERRV YES. * LDA BUFR+187 GET DEST. SUBCHANNEL RAL,CLE,ERA PUT SIGN BIT IN E REG. STA \DSUB SAVE DEST. SUBCH. W/O SIGN * CLA SET DSIB?=1 IF HPIB SYSTEM ELA STA DSIB? SET FLAG * LDB \BUFA DOES THIRD RECORD LOOK LIKE ADB P256 STB BPTR A TRACK 0, SECTOR 0 BOOTSTRAP? JSB VT0S0 VERIFY IT JMP ERRV NOT ONE * * LDA DNAME STUFF NEW SYS FILENAME IN LDB MS44A MESSAGE FOR LATER POSSIBLE USE MVW P3 * LDA DCB+5 SAVE FILE SIZE. ARS ADA N2 LESS TWO FOR HEADER RECORDS STA SIZE # 128-WORD SECTORS. * LDA DCB+9 SAVE DCB CONTENTS STA TEMP1 JSB CLOSE BEFORE CLOSING THE DEF *+3 ABSOLUTE OUTPUT FILE DEF DCB VIA FMP DEF ERR LDA TEMP1 NOW FUDGE THE DCB IN ORDER STA DCB+9 KEEP IT OPEN CLA CLEAR THE IN-BUFFER FLAGS STA DCB+13 (OLD DCB FORMAT) LDA DCB+7 AND CLER2 =177773 STA DCB+7 (NEW DCB FORMAT) * LDA P256 GET # WORDS TO ADD INTO CHECKSUM LDB \BUFA COMPUTE 256 WORD CHECKSUM FOR SYSTEM FILE ADB P256 SO WE CAN CHECK IT AGAIN WHEN THEY JSB CHKSM INSERT TARGET CARTRIDGE (& POSSIBLY STA CKSUM REMOVE THE CART. W/ THE FILE!) * SKP * * PROCESS HEADER RECORD * LDA BUFR+186 GET NEW SYSTEM INFO CPA N1 CHECK TYPE RSS JMP ERRV NOT AN RTE-IV+ SYSTEM !,������þú LDA BUFR+189 STA #EQTS # EQT'S IN SYSTEM LDA BUFR+190 STA DPI DESTINATION PRIVILEGED INTERRUPT LDA BUFR+191 STA DTBG " TBG CHANNEL LDA BUFR+192 STA B AND SAVE AND B377 ISOLATE STA DTTY " TTY CHANNEL LDA B ALSO GET THE ALF,ALF AND B377 NUMBER OF STA #SUBC DEFINED SUBCHANNELS LDB \BUFA ADB BUFR+188 ADB P192 LDA B,I ALF,ALF AND B377 STA \DCH " SYSTEM DISK CHANNEL LDA B,I AND B377 STA DEQT " DISK TYPE(EQT) * LDA \BUFA MOVE THE TRACK MAP TABLE IMAGE LDB \TMT TO THE PERMANENT STORAGE AREA MVW P160 FROM HEADER RECORDS 1 AND 2 * * CHECK TO MAKE SURE WE DON'T HAVE THE OLD DRIVER'S!! WE REQUIRE * 2001 OR LATER DVR32 & DVA32. RELAX IF 7900 TARGET. * LDA DEQT SLA JMP SWP WE HAVE 7900 TARGET-DON'T CHECK LDB $DATC GET THE DATE CODE OF OP SYS ADB N2001 SUBTRACT 2001 DECIMAL SSB,RSS BETTER BE POSITIVE JMP SWP OK,CONTINUE IF $DATC>=2001 JSB \BLIN SORRY SEND THE MESSAGE LDB MES46 LDA P12 "OUTDATED SYSTEM SOFTWARE" JSB \DSPL JMP \XOUT ABORT * * ROLLS IN THE CORRECT DISK DRIVER SEGMENT, DEPENDENT * UPON THE DESTINATION DISK TYPE * SWP LDA DEQT LDB SWAP5 ADDRESS OF 7905/7920 SEGMENT'S NAME LDA DEQT SLA LDB SWAP0 " 7900 " " STB SWAPA JSB SEGLD ROLL IN THE SEGMENT - IT WILL DEF *+3 COME BACK TO \SWTM AFTER SWAPA NOP EXECUTING THE SEGMENT'S DEF SGERR FRONT END CODE * * * DISPLAY DESTINATION I/O CONFIGURATION * \SWTM JSB \BLIN LDB MES5 LDA P15 JSB \DSPL "NEW SYSTEM I/O CONFIGURATION" JSB \BLIN * LD¦y������þúB D1 SET FOR \CVAS STB \CLEN LDA DPI SZA,RSS DEFINED? JMP OUT1 NO LDB MES6A JSB \CVAS LDA P18 LDB MES6 JSB \DSPL "SELECT CODE XX PRIVILEGED INTERRUPT" * OUT1 LDA DTBG LDB MES7A JSB \CVAS LDA P9 LDB MES7 JSB \DSPL "SELECT CODE XX TBG" * LDA #EQTS GET NUMBER OF EQT'S IN DEST SYSTEM CMA,INA STA TEMP2 NEG. # EQT'S ST0 LDA #EQTS CMA,INA STA TEMP1 NEG. CURRENT EQT # LDB \BUFA ADB P192 STB TEMP4 POSITION IN EQT'S IN H.R.2 LESS 1 * ST1 ISZ TEMP4 LDA TEMP4,I GET ENTRY ALF,ALF AND B377 AND ITS CHANNEL CPA CURCH NEXT CHANNEL? RSS JMP ST2 NOPE LDB MES8A YES,DISPLAY IT JSB \CVAS LDA TEMP4,I AND B377 LDB MES8B JSB \CVAS LDA P11 LDB MES8 JSB \DSPL "SELECT CODE XX TYPE YY" ISZ TEMP2 INCREMENT # FOUND RSS JMP ST4 ALL DONE * ST2 ISZ TEMP1 END OF EQT LIST? JMP ST1 NO ISZ CURCH CHANNEL NOT IN SYSTEM JMP ST0 SEARCH FOR NEXT * END DISPLAY DESTINATION SYSTEM I\O CONFIGURATION * ********************************************************************** * * * DISPLAY DESTINATION SYSTEM SUBCHANNEL DEFINITION * ST4 JSB \BLIN LDA \DCH GET DESTINATION SELECT CODE # LDB MES9A JSB \CVAS LDA \DSUB CMA,INA MAKE NEG FOR DECIMAL CONVERT LDB MES9B JSB \CVAS LDA P24 LDB MES9 JSB \DSPL "NEW SYSTEM(LU 2) SELECT CODE=XX SUBCHANNEL=XX" * JSB \BLIN LDA DEQT SLA,RSS JMP D05 7905/7920 DESTINATION DISK * LDA \DSUB FOR 7900 DISC: ADA B2060 ALF,ALF STA MES10+5 STORE PLATTER # IN MESSAGE LDA \DFTR CMA,INA Š������þú LDB P2 SET FOR \CVAS STB \CLEN LDB MS10C " FIRST TRACK # " JSB \CVAS LDA \DNTR CMA,INA LDB MS10D " # TRACKS " JSB \CVAS LDA P21 LDB MES10 " LOGICAL SUBCHANNEL XX FIRST TRACK XXX JSB \DSPL # TRACKS XXX" JMP GETEM * D05 LDA P3 7905/7920 SUBCHANNEL DEFINITION STA \CLEN SET MAX CONVERSION LENGTH (WORDS) LDA \DSHD CMA,INA LDB MS41A JSB \CVAS STORE HEAD # IN MESSAGE LDA \DNTR CMA,INA LDB MS40A " # TRACKS " JSB \CVAS LDA \DUNT CMA,INA LDB MS42A JSB \CVAS " UNIT/ADD " LDA \DNSU CMA,INA LDB MS41B JSB \CVAS " # SURFACES " LDA \DFTR CMA,INA LDB MS40B " FIRST CYL " JSB \CVAS LDA \DNSP CMA,INA LDB MS42B JSB \CVAS " # SPARES " LDA \D#ST CMA,INA LDB MS43B JSB \CVAS " #SECTORS/TRACK " * LDA P17 LDB MES40 " #TRACKS NNNNN FIRST CYL CCCCC " JSB \DSPL LDA P17 LDB MES41 " HEAD # HHHHH #SURFACES SSSSS " JSB \DSPL LDA P17 LDB MES42 " UNIT/ADD UUUUU #SPARES PPPPP " JSB \DSPL LDA P17 LDB MES43 " #SECTORS TRACK KKKKK " JSB \DSPL * GETEM LDA SIZE GET SYSTEM LENGTH IN BLOCKS RAL CONVERT TO 64-WORD SECTORS CLB DIV \D#ST AND CONVERT TO # TRACKS SZB INA BUMP FOR PARTIAL TRACKS ADA P9 ADD THE 9 TRACK MINIMUM FREE TRACKS STA \STRK AND SAVE LDA \D#WT GET #WORDS TRACK AND CMA,INA COMPLEMENT STA ND#WT FOR DMA TRANSFER LENGTHS SKP * * CHECK TARGET CHANNEL\DUMMY DISC LU- IF NOT SPEC'D:ASK FOR IT * w5������þúJSB \BLIN LDA \TDLU GET TARGET CHANNEL SSA,RSS SPECIFIED? JMP CHTD YES, CHECK VALIDITY OF TARGET ASKCH LDA DEQT LDB MSS12 "TARGET DISC LU FOR NEW SYSTEM? (XX)" SLA GET THE 7900 OR TYPE 32 DISC PROMPT LDB MES12 "TARGET SELECT CODE FOR NEW SYSTEM?(XXOR" "CR) LDA P25 JSB \DSPL "TARGET DISC LU FOR NEW SYSTEM? (XX)?" * OR"TARGET SELECT CODE FOR NEW SYSTEM?.." JSB TARGT READ ANSWER JSB \DFLT CR? JMP ASK1 NO LDB DEQT SLB,RSS DON'T ALLOW \DFLT ON TYPE 32 DISCS--- JMP DLUER -TOO DANGEROUS-MAY CROSS ICD W/ MAC'S LDA \DCH DEFAULT 7900 DISC TO DEST SEL CODE STA \TDLU SAVE DEFAULTED VALUE JMP CHTD GO CHECK THE DEFAULTED TARGET * ASK1 LDA P3 GET 3 DIGITS MAX LDB DEQT SLB,RSS TYPE 32 DISC?? CMA,INA YES: SET NEG. FOR CONV ASCII DEC.=>BIN. JSB GET# CONVERT ANSWER JMP DLUER ERROR-TRY AGAIN STA \TDLU * * CHECK THE RANGE OF THE ANSWER * CHTD LDB DEQT SLB JMP CHCH CHECK 7900 CHAN. RANGE * ADA N64 CHECK RANGE OF DUMMY LU SSA,RSS JMP DLUER TOO BIG: SEND MESSAGE * JSB EXEC DEF *+5 GET INFO ABOUT DUMMY LU DEF P13NA REQUEST INFO. ABOUT LU-SET NO ABORT BIT DEF \TDLU DEF TEQT5 DEF TEQT4 * JMP DLUER EXEC ERROR-ILLEGAL LU -TRY AGAIN * LDA TEQT4 AND B77 STA \T32C SAVE SELECT CODE OF TARGET DISC LDA TEQT5 ALF,ALF AND B377 GET THE DEVICE TYPE CPA O32 IT BETTER BE TYPE 32 JMP GTSCH IT IS .. SO CONTINUE * DLUER LDA P7 LDB MES11 "ILLEGAL TARGET" JSB \DSPL JMP ASKCH GIVE 'EM ANOTHER CHANCE * CHCH ADA N8 CHECK FOR CORRECT SSA RANGE (10-77 OCTAL) Ö¶������þú JMP DLUER < 10, TRY AGAIN ADA N56 SSA,RSS JMP DLUER > 77, TRY AGAIN * * FOR 7900 ONLY:CONFIGURE DRIVER DISKD TO TARGET SELECT CODE. * JSB \STD0 * * CHECK TARGET SUBCHANNEL OR UNIT * GTSCH LDA \TSUB GET THE TARGET SUBCHANNEL SSA,RSS SPECIFIED? JMP CHSB YES, CHECK VALIDITY ASKSB JSB \BLIN LDA P28 LDB MES13 JSB \DSPL "TARGET ADDR\UNIT\PLATTER FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB \DFLT CR? JMP ASK3 NO LDA DEQT SLA,RSS DEFAULT TO EITHER 7900 SUBCHANNEL OR 7905/7920 UNIT JMP ASK2 LDA \DSUB DEFAULT TARGET SUBCHANNEL TO DESTINATION SUBCHANNEL STA \TSUB JMP OKAY * ASK2 LDA \DUNT FOR TYPE 32 DISCS STA \TUNT DEFAULT TARGET UNIT TO DESTINATION UNIT JMP OKAY * ASK3 LDA P2 GET 2 DIGITS JUST INCASE JSB GET# CONVERT ANSWER TO OCTAL JMP ASKSB ERROR, TRY AGAIN STA \TSUB **TEMP** * CHSB ADA N8 SSA,RSS JMP ASKSB > 7, TRY AGAIN LDB \TSUB LDA DEQT FOR THE 7905/7920, SAVE THE ANSWER AS THE UNIT SLA,RSS STB \TUNT JMP OKAY SKP *CONSTANTS B77 OCT 77 B2200 OCT 2200 N56 DEC -56 N16 DEC -16 * D0 DEC 0 D1 DEC 1 D4 DEC 4 P5 DEC 5 P11 DEC 11 P18 DEC 18 P15 DEC 15 P19 DEC 19 P21 DEC 21 P23 DEC 23 P24 DEC 24 P25 DEC 25 P60 DEC 60 P28 DEC 28 P32 DEC 32 P48 DEC 48 * SGERR NOP ERROR WORD FOR SEGLD IOFF NOP IRB NOP IREC NOP JSEC NOP * SPC 2 * HOST => CURRENT SYSTEM UNDER WHICH SWTCH IS OPERATING * HSBCH NOP HOST SYSTEM DISK SUBCHANNEL HCH NOP " " " CHANNEL HEQT NOP " " " TYPE HUNIT NOP " " " UNIT (7905/6/20) HNHD NOP " " SUBCHANNEL STARTING HEAD (7905/6/20) HNSU NOP þw���N��LH " " " # SURFACES HFTR NOP " " " STARTING TRACK/CYLINDER H#ST DEC 96 " " " SECTORS/TRACK (DEFAULT) HTTY NOP " " TTY CHANNEL ����������������������������������������������������������������������������������������������������nÅN������ÿÿ��������þú SKP * * WE PASSED THE FIRST TEST!!! * * IF THE HOST AND TARGET SYSTEM'S ARE BOTH TYPE 32 DISCS,THEN WE'RE * GOING TO SEARCH $T(A\B)32 NOW BEFORE THE USER HAS AN OPPORTUNITY * TO INSERT A DIFFERENT SYSTEM DISC. THE HOST SUBCHANNEL DEFINITION * MUST BE DETERMINED IN ORDER TO CHECK FOR AN OVERLAY OF THE HOST * SYSTEM. * OKAY JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+6 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 DEF HSBCH * LDA IEQT4 GET CHANNEL AND B77 STA HCH STA B LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 STA HEQT CPA DEQT SLA SAME DISC TYPE - SEE WHICH JMP OKAYY 7900, NO PROBLEM CUZ CAN USE SUBCHANNEL * CPB \T32C HOST CHAN=TARGET CHAN.(WE KNOW TYPE=32) RSS YES JMP OKAYY NO PROBLEM HERE * * GET THE TRACK MAP TABLE CONTAINING THE * HOST SYSTEM SUBCHANNEL DEFINITION IN BUFR. * WE REQUIRE THE HOST SYSTEM TO BE RTEIVB OR LATER * SO A SIMPLE EXEC CALL WILL RETURN THE TABLE. * * JSB EXEC DEF *+7 DEF D1 DEF TMTSF DEF BUFR DEF P161 DEF D0 DEF P5 * * * GET HOST SUBCHANNEL DEFINITION FROM NEW FORMAT * LDA HSBCH MPY P5 LDB \BUFA RETRIEVE FROM TABLE: INB ADB A LDA B,I STA H#ST HOST SUBCHANNEL'S #SECTORS/TRACK INB LDA B,I STA HFTR " " FIRST CYLINDER INB LDA B,I AND B17 STA HUNIT " " UNIT# LDA B,I ALF,RAL RAL AND B77 STA HNSU " " # SURFACES LDA B,I ALF,ALF ALF AND B77  STA HNHD " " STARTING HEAD # INB INB LDA B,I GET HOST SYS SUBCH'S TMT WORD5 SSA Äõ������þú IS THE HPIB DISC BIT SET?? ISZ HSIB? YES: HOST IS AN HPIB SYSTEM! SKP * * * DO THE LOCK & GIVE OPERATOR OPPORTUNITY TO INSERT CARTRIDGE * OKAYY JSB EXEC CORE LOCK - TO DEF *+3 PREVENT SWTCH FROM DEF P22 FROM BEING SWAPPED OUT DEF D1 * LDA DEQT SLA JMP NLOCK NO LOCK FOR 7900 * JSB EQTRQ LOCK THE TARGET DISC DEF *+3 DEF D1 LOCK OP CODE DEF \TDLU LOCK EQT OF THIS LU * JSB EXEC NOW DO DUMMY I/O REQUEST DEF *+3 NOTE-THIS DUMMY I/O REQUEST DEF P3 CAUSES US TO WAIT UNTIL ALL I/O DEF \TDLU PREVIOUS TO THE EQT LOCK IS COMPLETE * BEFORE WE PRINT "NOW IS THE TIME... * CLA,INA SET FLAG TO INDICATE EQT LOCK STA LOK32 -1\1=NOT LOCKED\LOCKED * * NLOCK LDA BATCH CMA,SSA,INA,SZA SKIP IF <= 0 JMP SAVE? NOT SO IN BATCH MODE * CLA REMEMBER MESSAGE SENT FOR LATER STA SWPFL POSSIBLE ABORT. JSB \BLIN CRLF LDA P23 LDB MES16 JSB \DSPL LDA P25 "NOW IS THE TIME TO INSERT CORRECT CARTRIDGE LDB MES17 IN TARGET ADDRESS\UNIT\PLATTER (" "CR TO CONTINUE) JSB \DSPL * JSB TARGT GET THE RESPONSE JSB \DFLT CHECK FOR " "CR JMP CRLF TRY AGAIN * * CHECK IF FILE STRUCTURE AT TARGET IS TO BE SAVED * SAVE? LDA \SAVE WAS IT SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SAV?? YES * SAV1 LDA P16 NO, ASK THEM LDB MES18 JSB \DSPL "SAVE FILES AT TARGET? (Y OR N) * JSB YE?NO READ ANSWER JMP SAV1 INVALID REPLY JMP SAV1 INVALID REPLY CLA,RSS NO CLA,INA YES, SAVE IT STA \SAVE * SAV?? LDA DEQT SLA JSB \GDMA CLAIM DMA CH 7 FOR 7900 DISC LDA \SAVE CPA D0 DO WE SAVE THE FILES ? JMt�������þúP SUBI? NOPE * * CHECK THE SYSTEM AT THE TARGET * JSB VFYSY VERIFY THE SYSTEM OUT THERE! JMP SUBI? CAN'T SAVE THE FILES * LDA \STRK SIZE OF NEW SYSTEM (INCLUDING 9 TRACKS LDB \FFMP OF AVAILABLE TRACK SPACE) MUST BE CMA,INA < FIRST FMP TRACK OF TARGET ADA B SUBCHANNEL SSA,RSS JMP SAVE6 NO PROBLEM * LDA P19 WARN USER LDB MES19 JSB \DSPL "NEW SYSTEM WILL DESTROY SOME FMP FILES" JSB OK? "OK TO PROCEED?" * CCA SET TO PROCEED, BUT SAVE AS MANY FILES STA \SAVE AS POSSIBLE * * * CHECK IF TYPE 6 FILES ARE TO BE SAVED * SAVE6 LDA TYP6 SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SUBI? YES * SAV6A LDA P15 NO, ASK THEM LDB MES22 JSB \DSPL "PURGE TYPE 6 FILES? (Y OR N)" * JSB YE?NO DECIPHER ANSWER JMP SAV6A INVALID REPLY * * DETERMINE IF ANY ADDITIONAL SUBCHANNELS ARE TO BE INITIALIZED * JMP SAV6A /E AN INVALID REPLY CLA,RSS NO CLA,INA YES STA TYP6 SKP SUBI? LDA SUBI SPECIFIED AT TURN-ON TIME? SZA,RSS JMP AUTO? ONLY THAT NOT WANTED CCB ADB #SUBC GET NUMBER OF SUBCHANNELS SZB,RSS ASIDE FROM SYSTEM SUBCHANNEL JMP AUTO?-1 NONE, SO SKIP QUERY * SSA,RSS YES, OR NOT-YET-SPECIFIED? JMP SUBBR YES, SO DON'T ASK AGAIN * SUBIA LDA P18 LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNELS? (Y OR N)" JSB YE?NO DECIPHER ANSWER JMP SUBIA INVALID REPLY JMP SUBIA INVALID REPLY CLA,RSS NO CLA,INA YES STA SUBI SAVE SZA,RSS IF NO, THEN MOVE ON TO JMP AUTO? AUTO BOOT QUERY * SUBBR LDA "L" CHANGE MESSAGE STA MES34+11 LDA DEQT GET DISC TYPE SLA,RSS BRANCH TO REQUEST bç������þú JMP SUBI5 7905/6/20 INITIALIZATIONS * * REQUEST INITIALIZATIONS OF ADDITIONAL 7900 SUBCHANNELS * CCB,RSS NXSUB LDB SUBIA GET LAST SUBCHANNEL DISPLAYED INB CPB \DSUB JMP NXSUB+1 CPB #SUBC JMP AUTO? DONE ASKING * STB SUBIA SAVE SUBCHANNEL # LDA \TMT POSITION INTO TRACK MAP TABLE ADA P8 BUFFER TO GET # OF ADA B TRACKS DEFINED FOR THIS SUBCHANNEL LDA A,I SZA,RSS ANY? JMP NXSUB+1 NO,TRY NEXT SUBCH ADB B2060 CONVERT TO ASCII STB MES34+12 AND STORE IN MESSAGE NXA LDA P18 LDB MES34 NOW ASK? JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXA INVALID REPLY JMP AUTO? /E SO EXIT JMP NXSUB NO INIT * ASKTS LDA P15 LDB MES35 ASK 'EM JSB \DSPL "TARGET PLATTER?" JSB TARGT GET RESPONSE JSB \DFLT CR? JMP NASK NO LDA SUBIA DEFAULT IMPLIED, SO GO TO TMT JMP CSST GO COMPARE WITH SYS SUBCH TARGET * * GET TARGET PLATTER FOR 7900 SUBCHANNEL * NASK CLA,INA GET TARGET PLATTER JSB GET# RESPONSE JMP ASKTS INVALID REPLY CSST CPA \TSUB SAME AS SYSTEM SUBCH'S? JMP ASKTS YES - NOT ALLOWED * LDB SUBIA GET THIS SUBCHANNEL # ADB \TMT AND OFFSET INTO THE TMT BUFFER ADB P16 PAST THE DEF'NS (16 WORDS) STA B,I SAVE TARGET PLATTER FOR THIS SUBCHANNEL ADB N16 BACK UP TO FIRST TRACK ENTRY LDA B,I AND MARK THE SUBCHANNEL IOR MSIGN TO ENABLE INITIALIZATION STA B,I JMP NXSUB NOW TRY THE NEXT ONE SKP * * REQUEST INITIALIZATIONS OF ADDITIONAL 7905/6/20 SUBCHANNELS * SUBI5 LDB MS36B SET MESSAGE BUFFER ADDRESS STB TEMP2 FOR STORAGE OF SUBCH #'S CLA CLEAR HEADER STA HDÚé������þúFLG FLAG INA SET ASCII CONVERSION LENGTH STA \CLEN TO 1 WORD - FOR \CVAS CLB STB TEMP1 FIRST SUBCHANNEL # * * DISPLAY THOSE SUBCHANNELS ON SAME UNIT AS SYSTEM SUBCHANNEL * SUB0 CPB \DSUB SAME AS SYS SUBCH? JMP SUB1 YES, SO NEEDED ASK RBL,RBL POSITION INTO TMT FOR ADB TEMP1 ADB \TMT THIS SUBCHANNEL'S ENTRY ADB P2 LDA B,I AND GET WORD 2 OF ENTRY AND B17 ISOLATE THE UNIT # CPA \DUNT SAME UNIT AS FOR SYS SUBCH? RSS YES JMP SUB1 NO - MOVE ON TO NEXT LDA TEMP1 GET SUB # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER ADDRESS JSB \CVAS CONVERT TO ASCII AND PUT IN MESSAGE LDA COMBL GET A COMMA AND PLACE ISZ TEMP2 AFTER THE # STA TEMP2,I IN THE MESSAGE ISZ TEMP2 NEXT BUFFER POSITION ISZ HDFLG INDICATE ONE 'FOUND' FOR THIS UNIT * SUB1 ISZ TEMP1 BUMP TO NEXT SUBCH # LDB TEMP1 CPB #SUBC LAST SUBCH DONE? RSS YES JMP SUB0 * LDA HDFLG ANY FOUND MATCHING \DUNT? SZA,RSS JMP NMTCH NO * LDB \TUNT STORE THE UNIT#\ADDRESS IN THE MESSAGE ADB B2060 STB MES36+11 * RAL SET # OF WORDS TO PRINT ADA P20 LDB MES36 GET BUFFER ADDRESS JSB \DSPL "TARGET ADDR/UNIT XX FOR SUBCHANNELS ..." * * * ASK IF SUBCHANNELS ON \TUNT ARE TO BE INITIALIZED * CCA STA TEMP2 ALLOW ALL MATCHES IN INIT? LDA \DUNT GET UNIT FOR TMT MATCHING LDB \TUNT AND PASS TARGET UNIT FOR THOSE SUBCH'S JSB INIT? * * DISPLAY SUBCHANNELS MATCHING EACH DEFINED UNIT * NMTCH CLA INITIALIZE THE UNIT # STA TEMP5 OTHER LDB MS37B AND THE BUFFER POINTER STB TEMP2 CLB STB TEMP1 CLEAR THE SUBCH ©§������þú# STB HDFLG CLEAR UNIT MATCH FLAG CPA \DUNT SAME UNIT AS SYSTEM SUBCH? JMP NXUNT CAN'T ALLOW (ALREADY DONE) * OT1 RBL,RBL POSITION TO SUBCH'S ENTRY ADB TEMP1 ADB \TMT IN THE TMT BUFFER ADB P2 MOVE TO WORD 2 LDA B,I AND GET IT AND B17 CPA TEMP5 IS IT THE UNIT WE WANT? RSS YUP JMP NXTSB NO, TRY THE NEXT * ADB N2 POS'N TO #SEC TRK LDA B,I GET IT &CHECK CPA P60 IS IT AN 88020?? ISZ TEMP3 YES- SET 88020 UNIT FLAG ADB P3 POS'N TO WORD3- #TRKS * LDA B,I AND GET THE # OF TRACKS SZA,RSS JMP NXTSB SKIP IF NO TRACKS ASSIGNED SSA OR IF ALREADY SPECIFIED JMP NXTSB * LDA TEMP1 GET SUBCH # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER POSITION JSB \CVAS STORE IN MESSGE LDA COMBL NOW PLACE A COMMA ISZ TEMP2 AFTER THE NAME STA TEMP2,I ISZ TEMP2 ISZ HDFLG BUMP COUNTER * NXTSB ISZ TEMP1 BUMP TO NEXT SUBCHANNEL LDB TEMP1 RETRIEVE IT CPB #SUBC AND SEE IF DONE RSS YES JMP OT1 NO, CONTINUE SCANNING * LDA HDFLG ANY FOUND? SZA,RSS JMP NXUNT NO, TRY NEXT UNIT LDB TEMP5 STORE UNIT IN MESSAGE ADB B2060 STB MES37+11 RAL DETERMINE LENGTH OF MESSAGE ADA P20 BY # OF SUBCH'S STORED IN IT LDB MES37 DISPLAY JSB \DSPL "DESTINATION ADDR/UNIT XX FOR SUBCHANNELS ..." * LDA TEMP3 GET 88020 UNIT FLAG SZA IS IT ONE?? JMP NXUNT YES- SKIP THE TARGET UNIT PROMPT * * ASK FOR TARGET UNIT FOR THIS SET OF SUBCHANNELS * ASKTU LDA P18 ASK FOR TARGET UNIT LDB MES38 JSB \DSPL "TARGET UNIT? (XX OR " "CR, OR /E) JS–������þúB YE?NO GET RESPONSE JMP TDFLT CHECK DEFAULT JMP NXUNT /E JMP ASKTU NO, TRY A NUMBER JMP ASKTU YES, NEED A NUMBER TDFLT JSB \DFLT CR? JMP GETU NO LDA TEMP5 GET DEFAULTED UNIT JMP CSSTU AND GO CHECK AGAINST TARGET SYS UNIT * GETU CLA,INA RETRIEVE TARGET UNIT # JSB GET# FROM RESPONSE JMP ASKTU INVALID REPLY - ASK AGAIN CSSTU CPA \TUNT SAME AS SYS SUBCH UNIT? JMP ASKTU YES - CAN'T ALLOW * * REQUEST INITIALIZATION OF EACH SUBCHANNEL OF CURRENT SET * LDB A GET TARGET UNIT # LDA \DUNT SET FOR DISALLOWING STA TEMP2 \DUNIT REPONSES LDA TEMP5 GET DEST UNIT # JSB INIT? AND ASK FOR INITIALIZATIONS * NXUNT ISZ TEMP5 BUMP UNIT COUNTER CLA STA TEMP3 RESET 88020 UNIT FLAG LDA TEMP5 RETRIEVE IT CPA P8 AND CHECK IF DONE JMP AUTO? YES JMP OTHER NO - START SUBCH SCAN AGAIN SKP * * SCAN TRACK MAP TABLE (IN BUFFER) FOR SUBCHANNELS THAT MAY BE * INITIALIZED, BASED UPON THE 'MATCH' UNIT IN THE A-REG. THE TARGET * UNIT FOR THESE SUBCHANNELS (IF INITIALIZED) IS IN THE B-REG. * INIT? NOP STA TEMP3 SAVE TMT MATCH UNIT STB TEMP4 AND TARGET UNIT CLB INITIALIZE STB TEMP1 NEXT SUBCHANNEL # * INIT1 CPB \DSUB SYSTEM SUBCHANNEL? JMP NXS YES, SO SKIP RBL,RBL CONVERT TO TMT ENTRY # ADB TEMP1 ADB \TMT AND OFFSET INTO BUFFER ADB P2 LDA B INA IF WORD3 IS NEGATIVE LDA A,I THEN THIS SUBCH ALREADY SSA HAS BEEN SPECIFIED JMP NXS SO SKIP THIS ENTRY SZA,RSS JMP NXS ALSO SKIP IF NO TRACKS ASSIGNED TO IT * LDA B,I ISOLATE THE AND B17 UNIT CPA TEMP2 THIS UNIT MATCH DISALLOWED?(SYS SUBCH) ‘Ž������þú JMP NXS YES, TRY NEXT SUBCH * CPA TEMP3 ONE WE'RE LOOKING FOR? RSS YES JMP NXS TRY NEXT ONE * STB TEMP6 SAVE BUFFER POSITION LDA TEMP1 GET SUBCH # CMA,INA LDB MS34A AND CONVERT TO ASCII JSB \CVAS AND STORE IN MESSAGE NXI LDA P18 NOW ASK 'EM LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXI INVALID REPLY JMP INIT?,I /E SO EXIT JMP NXS NO REPLY * LDB TEMP6 GET BUFFER POSITION LDA B,I AND WORD 2 OF SUBCH'S ENTRY AND B1777 MASK OFF UNIT IOR TEMP4 AND ADD IN TARGET UNIT STA B,I RE-STORE INB NOW SET THE SIGN BIT LDA B,I FOR WORD 3 TO IOR MSIGN INDICATE A SPECIFIED ENTRY STA B,I * NXS ISZ TEMP1 BUMP SUBCHANNEL # LDB TEMP1 RETRIEVE IT AND CPB #SUBC AND SEE IF DONE JMP INIT?,I YES JMP INIT1 CONTINUE SCAN * SKP * * THE FOLLOWING CONDITIONS FOR AUTO BOOT-UP ARE CHECKED: * DESTINATION CHANNEL(\DCH) = TARGET CHANNEL(\T32C OR \TDLU) * DESTINATION SUBCH/UNIT/ADDR = TARGET SUBCH/UNIT/ADDR * DESTINATION TBG CHANNEL = HOST TBG CHANNEL * DESTINATION TTY CHANNEL = HOST TTY CHANNEL * DESTINATION PI CHANNEL = HOST PI CHANNEL ( IF BOTH EXIST) * IF TYPE 32 DEST. SYS: * TARGET DISC TYPE(IB/NON-IB)=DEST. DISC TYPE (IB/NON-IB) * STB SUBI CLEAR INIT WORD IF NO SUBCH'S AUTO? LDA AUTO SPECIFIED AT TURN-ON TIME? SZA,RSS JMP CHPNT YES, ONLY THAT THEY DON'T WANT IT * LDB DEQT GET DEST. SYS DISC TYPE LDA \T32C GET TARGET SEL. CODE-IF TYPE 32 DISC SLB TYPE 32?? LDA \TDLU NO: SO GET TARGET SEL. CODE FROM \TDLU CPA \DCH IS TARGET SEL. CODE = DEST. SEL CODE??­I������þú RSS JMP CANT NO MATCH LDB DEQT SLB CHECK SUBCHANNELS OR UNITS JMP AUT0 * LDA \DUNT CPA \TUNT RSS JMP CANT NO MATCH ON 7905/7920 UNIT * LDA \TDLU ADA B2200 ADD TARGET LU TO 2200B FOR EXEC CALL STA TEMP1 * JSB EXEC SPECIAL DRIVER CALL TO GET DEF *+7 5 WORDS OF TMT FOR TARGET LU DEF D1 DEF TEMP1 DEF BUFR DEF P5 DEF D0 DEF P5 * LDB \BUFA ADB D4 LDA B,I PICK UP WORD 5 ENTRY(IBI IF SIGN SET) RAL XOR DSIB? IF DEST. IS HPIB,REQ. TARGET HPIB ALSO! SLA JMP CANT NO-THE TYPES DONT MATCH-CANT AUTO BOOT JMP AUT1 YES-BOTH ARE SAME TYPE-LET'S BOOT * * AUT0 LDA \DSUB CPA \TSUB RSS JMP CANT NO MATCH ON 7900 SUBCHANNEL # * AUT1 LDA TBG GET HOST TBG CHANNEL CPA DTBG RSS JMP CANT TBG'S DON'T MATCH LDA HTTY CPA DTTY RSS JMP CANT TTY CHANNELS DON'T MATCH LDA PI GET HOST PI CHANNEL CPA D0 IF EITHER THE HOST OR JMP AUT2 LDB DPI CPB D0 DESTINATION PI IS 0, JMP AUT2 THEN DON'T CHECK CPA B RSS JMP CANT PI CHANNELS DON'T MATCH * * * AUTO BOOT-UP IS POSSIBLE * AUT2 LDA AUTO HAS IT BEEN SPECIFIED YET? SSA,RSS -1=NOT SPECIFIED, 1=YES JMP CHPNT YES, AND WANT IT AUT3 LDA P12 LDB MES24 JSB \DSPL "AUTO BOOT-UP? (Y OR N)" JSB YE?NO GET ANSWER JMP AUT3 INVALID REPLY JMP AUT3 INVALID REPLY CLA,RSS NO CLA,INA YES STA AUTO JMP CHPNT * * * WON'T BE BOOTING UP NEW SYSTEM * CANT LDA P25 LDB MES25 JSB \DSPL "PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP" CLA STA AUTO * * ������þú * DETERMINE IF WE MIGHT BE OVERLAYING PART OF THE HOST SYSTEM. * IF WE ARE INSTALLING THE SYSTEM ON THE SAME DISC DRIVE * AS THE HOST SYSTEM,THEN WARN THE USER TO REBOOT OR SWAP DISCS. * * CHPNT LDB DEQT GET DEST. DISC TYPE CPB HEQT SAME AS LU2 IN HOST SYSTEM?? RSS YES: MIGHT BE AN OVERLAY CASE JMP GO LDA \T32C GET TARGET SELECT CODE SLB 7900 TARGET DISC?? LDA \TDLU YES, SO GET 7900 TARGET SEL. CODE CPA HCH REPLACING CURRENT? RSS MAYBE JMP GO SLB,RSS JMP CHPT5 CHECK TYPE 32 SUBCHANNEL DEFN LDA HSBCH GET HOST SUBCHANNEL CPA \TSUB SAME 7900 SUBCHANNELS? RSS JMP GO NO,SO NO PROBLEM * * WILL BE REPLACING CURRENT SYSTEM * REPL ISZ OVLAY SET OVERLAY FLAG=1 (TRUE) JSB \BLIN LDA AUTO ARE WE AUTO BOOTING?? SZA JMP GO YES-NO WARNINGS. LDA P22 NO-WARN THE USER. LDB MES26 SEND "DISC IN HOST SYSTEM DRIVE JSB \DSPL WILL BE OVERLAID." JMP GO * * GOT 7905/7920 HOST SUBCHANNEL DEFINITION (VIA $TB32) AT OKAY * * 7905/7920 CHECKS FOR OVERWRITE OF HOST SYSTEM, USING HUNIT ONLY * CHPT5 LDA HUNIT CPA \TUNT SAME UNIT? JMP REPL YES - SO SEND WARNING IF NO AUTO-BOOT * * ALLOW OPERATOR ONE MORE OPPOR\TUNTY TO GET OUT * GO LDA BATCH NO MESSAGE IN BATCH MODE CMA,SSA,INA,SZA SKIP IF <= 0 JMP PURGF LDA P17 LDB MES32 JSB \DSPL "READY TO TRANSFER. OK TO PROCEED?" JSB YE?NO JMP GO INVALID REPLY JMP GO INVALID REPLY JMP \XOUT BAIL OUT JMP PURGF YES, GET WITH IT SKP * * PURGE ALL FILES FROM THE FILE DIRECTORY (AND THEIR EXTENTS) * THAT WERE OVERLAID BY THE NEW SYSTEM - LISTING THEM AT THE * SAME TIME. * PURGF LDB \SAVE WERE THE FMP FILES TO BE Æ������þú\SAVED? SZB,RSS JMP XFER NO * LDA D.LT CONVERT LAST FMP LOGICAL ADDRESS STA \TRAK CLB STB \SECT LDA D.# STA TEMP4 SAVE FOR LOOP CHECKS * CLA,INA SET MODE=1 FOR TYPE 32 DISC DRIVER STA \MODE * STB \INIT FOR DISKD LDA ND#WT STA \LNTH LDA \BUFA STA BPTR * LDA \SAVE SSA,RSS WERE ANY FMP FILES OVERLAID? JMP PUR6 NO,CHECK ON TYPE 6 FILES * LDA LWAM SET THE ADDRES OF THE ADA N3 FIRST FILE NAME ENTRY STA PENT * CLA,INA STA REWRT SET RE-WRITE FOR FD LDB \BUFA CCE SET FOR READ JMP BFULL * SPC 3 ****************************************************************************** * * THE FOLLOWING BSS ALLOWS FOR OVERLAY OF THE * PREVIOUS CODE, AND ADDS ADDITIONAL BSS'S FOR * AN AREA TOTALING 8192(DECIMAL) WORDS - MAXIMUM * WORDS PER TRACK. * BSS 8192+BUFR-* * ***************************************************************************** SPC 3 BFULL JSB DISKD FIRST FULL TRACK READ JSB \BLIN LDA P10 HEADING: LDB MES27 JSB \DSPL "OVERLAID FMP FILES:" CCA STA CURCH SET FOR PURGT LDA FDOFF POSITION TO FILE SPEC'N WORD 4 LDB \STRK AND STORE THE NEW FIRST STB A,I FMP TRACK * LDB FIRDE POSITION TO FIRST FILE ENTRY ON TRACK LDA FDT#E LOOP0 STA TCNT SET # ENTRIES TO SEARCH LOOP1 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRB ALREADY PURGED SZA,RSS JMP INCRB NOT AN ENTRY ADB P4 POSITION TO TRACK ADDRESS LDA B,I LDB \STRK COMPARE WITH LAST SYSTEM CMB,INB TRACK ADA B SSA WAS THE FILE IN THE NEW SYSTEM AREA? JSB PURGT PURGES,LISTS ENTRYüj���H��FB * INCRB JSB UPDAT SET TO SEARCH NEXT ENTRY JMP LOOP1 CONTINUE IN SAME TRACK JMP PUR6 PURGE TYPE 6 FILES JMP LOOP0 CONTINUE IN NEW TRACK * FDOFF NOP SPEC'N ENTRY WORD 4 OFFSET INTO TRACK BUFFER FIRDE NOP BUFFER ADDRESS OF FIRST DIRECTORY ENTRY FDT#E NOP FIRST DIR TRACK'S # OF ENTRIES TO SEARCH ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������dH������ÿÿ��������þú SKP * PURGES ANY TYPE 6 FILES OF THE TARGET FMP FILE SYSTEM * PUR6 LDA TYP6 ARE WE TO PURGE ANY? SZA,RSS JMP XFER NO * CLA CLEAR THE STA REWRT REWRITE & FILES FLAGS STA CURCH FOR PURGT STA \SECT LDA D.# STA TEMP4 SET THE # DIRECTORY TRACKS TO SEARCH LDA D.LT FIRST DIRECTORY TRACK STA \TRAK LDB \BUFA STB BPTR CLA,INA STA \MODE SET MODE=1 FOR REG. R/W CCE JSB DISKD READ IT * LDB FIRDE POSITION TO FIRST FILE DIR ENTRY LDA FDT#E LOOP2 STA TCNT # ENTRIES TO SEARCH LOOP3 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRE ALREADY PURGED SZA,RSS JMP INCRE NOT AN ENTRY ADB P3 POSITION TO FILE TYPE LDA B,I CPA P6 A TYPE 6? RSS JMP INCRE NOPE LDA HDRSW SZA JMP LOOP4 ISZ HDRSW JSB \BLIN LDA P10 PRINT HEADING: LDB MES28 JSB \DSPL "TYPE 6 FILES PURGED:" * LOOP4 JSB PURGT PURGE AND LIST ENTRY INCRE JSB UPDAT POSITION TO NEXT DIRECTORY ENTRY JMP LOOP3 CONTINUE IN SAME TRACK JMP XFER DONE WITH DIRECTORY JMP LOOP2 CONTINUE IN NEW TRACK SPC 2 B50 OCT 50 N6144 DEC -6144 HDRSW NOP HEADER SWITCH SKP * BEGIN THE TRANSFER, READING FROM THE ABSOLUTE FILE VIA READF * CALLS, AND WRITING OUT THE NEW SYSTEM VIA DISKD. * BEFORE TRANSFER IS BEGUN, CALL SPINT TO INITIALIZE SPARES ON * SYSTEM SUBCHANNEL. * XFER JSB IMESS "INSTALLING SYSTEM SUBCHANNEL XX" LDA MSINT NOW REPLACE THE 'INSTALLING' LDB MSINS WITH THE 'INITIALIZING' MVW P9 * LDB DEQT SLB IS IT A TYPE 32 DISC?? JMP SKP32 7900 DISC SO DON'T INIT THE SPARES HERE JSB SPINT GO INIT THE SPARES-UNLESS FMGR OWNS C������þú'EM SSA WAS INIT SUCCESSFUL?? JMP \XOUT NO: FATAL ERROR ON SYSTEM SUBCHANNEL! LDA P2 LDB \D#ST GET # SEC/TRK CPB P64 IS THIS A 7910 DISC?? LDA P3 YES-DON'T PROTECT THE OP SYS * ***** KLUDGE FOR 7910 STA \MODE SET WRITE PROTECT&INIT. MODE FOR DRIVER JMP GORDD * * SKP32 LDB \INP0 SET WRT PROT STB \INIT * GORDD LDA \BUFA STA BPTR * CLB STB \TRAK LDA SIZE # 128-WORD SECTORS RAL CONVERT TO # 64-WORD SECTORS DIV \D#ST SIZE OF SYSTEM CMA,INA NOW MEANS THE SYSTEM SIZE IN TRACKS STA TEMP1 NEGATIVE STB TEMP2 REMAINING # OF SECTORS LDA \D#WT SET WORDS PER TRACK STA \LNTH AS TRANSFER LENGTH * JSB READF READ A TRACK STARTING WITH RECORD #3 DEF *+7 DEF DCB DEF ERR DEF BUFR BUFFER ADDRESS DEF \LNTH WORDS TO READ DEF LLEN RET: WORDS ACTUALLY READ DEF P3 FIRST REC'D TO READ SSA READ ERROR? JMP RDERR YES * LDA P256 # WDS TO ADD INTO CKSUM LDB \BUFA JSB CHKSM RECOMPUTE CHECKSUM AFTER THEY'VE CPA CKSUM INSERTED TARGET CARTRIDGE JMP CHKOK FILE MATCHES - OK * JSB \BLIN LDA D21 LDB MES44 JSB \DSPL "DISC CART. CONTAINING SYS FILE HAS BEEN... LDA P20 LDB MS44A JSB \DSPL JMP \XOUT REMOVED FROM DISC DRIVE" * * CHKOK LDA \BUFA COMPUTE ADDRESS OF SYSTEM ADA P1024 COMMUNICATION AREA IN NEW ADA B50 BASE PAGE. LDB A POSITION TO LOCATION 1650. ADB P6 GET TAT ADDRESS AT 1656 WHILE LDB B,I WE'RE THERE. STB TAT * JMP WDISK WRITE TRACK TO DISK * * READ FROM ABSOLUTE DISK FILE * RDISK LDA \D#WT ISZ TEMP1 LAST FULL TRACÍÚ������þúK'S WORTH? JMP READ NO, CONTINUE LDA TEMP2 GET # OF LEFTOVER SECTORS SZA,RSS JMP DDONE NONE! MPY P64 CONVERT TO # WORDS ISZ EOFLG SET EOF FLAG * * CLEAR REMAINDER OF TRACK * STA \LNTH SAVE # WORDS TO BE READ CMA,INA DETERMINE # REMAINING ON TRACK ADA \D#WT CMA,INA LDB \BUFA GET STARTING ADDRESS ADB \LNTH WITHIN BUFFER JSB CLRBF AND CLEAR THE AREA TO FOLLOW RSS THE LAST RECORD READ IN * * READ ANOTHER TRACK FROM ABS FILE * READ STA \LNTH # WORDS TO READ JSB READF DEF *+5 DEF DCB DEF ERR DEF BUFR DEF \LNTH SSA READ ERROR? JMP RDERR YES * * WRITE TO THE TARGET * WDISK LDA \TRAK DISPLAY DESTINATION OTA 1 * LDA ND#WT STA \LNTH # WORDS TO READ/WRITE LDB \BUFA BUFFER(CORE) ADDRES CLE SET TO WRITE JSB DISKD AND DO IT. * SSA ERROR?? JMP \XOUT YES-FATAL SINCE ON SYS SUBCHANNEL * LDA EOFLG DONE WITH TRANSFER? SZA NO JMP DDONE ISZ \TRAK INCREMENT DESTINATION JMP RDISK ADDRESS BY ONE TRACK * * * * TRANSFER COMPLETE. INITIALIZE THE NECESSARY DISK TRACKS * DDONE LDB DEQT GET TYPE OF DISCLIZE BITS SLB,RSS JMP TYP32 * LDB \INT0 GET WRT INIT BITS & SET FOR 7900 ONLY STB \INIT SET FOR DISKD FOR 7900 ONLY * TYP32 LDB P3 STB \MODE SET DRIVER MODE TO INIT TRACKS * LDA \SAVE SZA,RSS JMP WHOLE INITIALIZE WHOLE REST OF SUBCHANNEL SSA JMP INIT2-1 INITIALIZE ONLY THE 9 AVAILABLE TRACKS * * INITIALIZE ONLY UP TO TARGET(EXISTING) FIRST FMP TRACK * LDA \FFMP COMPUTE NUMBER OF TRACKS UP TO FMGR AREA JMP LESS * * INITIALIZE REST OF SYSTEM SUBCHANNEL * WHOLE LD<]������þúA \DNTR COMPUTE # TRACKS LEFT ON SUBCHANNEL LESS LDB \STRK ADB N9 CMB,INB ADA B CMA,INA JMP INIT2 * * INITIALIZE THE MINIMUM 9 TRACKS SINCE WE'RE OVERLAYING * SOME FMGR FILES AS IT IS. * N9 DEC -9 * LDA N9 INIT2 STA TEMP1 NEGATIVE # * * CLEAR ENTIRE BUFFER FIRST * LDB \BUFA STARTING ADDRESS LDA ND#WT AND SIZE JSB CLRBF DO IT * * SET FIRST TRACK * LDA \STRK ADA N9 AND B377 STA \TRAK NEXT TRACK TO WRITE IN1 OTA 1 LDB \BUFA CLE JSB DISKD SSA WAS THERE A FATAL DRIVER ERROR?? JMP \XOUT YES- THIS IS SYS SUBCH-SO ABORT 'EM * ISZ \TRAK INCREMENT THE TRACK NUMBER LDA \TRAK ISZ TEMP1 DONE? JMP IN1 NO SKP * * ANY ADDITIONAL SUBCHANNELS TO BE INITIALIZED? * ISUBS LDA SUBI SHOULD WE INITIALIZE ANY SZA,RSS ADDITIONAL SUBCHANNELS? JMP UPTAT NO CLA SIGNAL A NON-SYSTEM LU STA \LU2 LDA \DSUB SAVE THE DESTINATION DISK SUBCHANNEL STA TEMP1 * LDB DEQT BRANCH ON THE SLB,RSS DISK TYPE JMP INS5 7905/6/20 * * INITIALIZE SPECIFIED 7900 SUBCHANNELS * LDB N6144 STB \D#WT SET TRANSFER LENGTH LDA \TSUB SAVE THE DESTINATION TARGET SUBCHANNEL STA TEMP2 LDB \INT0 SET THE WRITE INIT STB \INIT FLAG CLB INITIALIZE THE STB \DSUB SUBCHANNEL # TO SCAN INS0 ADB \TMT OFFSET INTO THE TMT FOR ENTRY LDA B,I IS THIS SUBCHANNEL SSA,RSS TO BE INITIALIZED? JMP INS1 NO AND B7777 STA \DFTR SET THE STARTING TRACK TO BE ADB P8 INITIALIZED LDA B,I STA \DNTR AND THE NUMBER OF TRACKS ADB P8 LDA B,I STA \TSUB THE TARGET PLATTER # JSB ILOOP GO INICØ������þúTIALIZE THAT SUBCHANNEL * INS1 ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB SEE IF DONE CPB #SUBC RSS YES JMP INS0 NO, CONTINUE SCAN OF TMT * LDB TEMP1 RESTORE THE SYSTEM SUBCHANNEL'S STB \DSUB SPECIFICATIONS ADB \TMT LDA B,I STA \DFTR THE STARTING TRACK # ADB P8 LDA B,I STA \DNTR THE NUMBER OF TRACKS LDA TEMP2 STA \TSUB AND THE TARGET PLATTER JMP UPTAT EXIT SKP * * INITIALIZE SPECIFIED 7905/06/20/25 (H) SUBCHANNELS * INS5 LDA \TUNT SAVE THE TARGET UNIT FOR STA TEMP2 THE SYSTEM SUBCHANNEL LDA \DSUB SAVE DESTINATION SYSTEM SUBCHANNEL STA \TSUB **KLUDGE** FOR USE AT ILSPAR IN TYPE 32 DRIVER CLB STB \DSUB INITIALIZE SUBCH # FOR SCAN * INS6 JSB \SETD GO SET UP \DSUB'S SPECS LDA \D#WT SET TRANSFER LENGTH CMA,INA NEGATE STA ND#WT SET UP NEG # WORDS/TRACK STA \LNTH LDA \DUNT SET THE TARGET UNIT STA \TUNT FROM THE ENTRY CCA RESET THE HEADING FLAG TO STA \BADH DISPLAY SUBCHANNEL # OF BAD/SPARED TRACKS SEZ INITIALIZE IT? JSB ILOOP YES * ISZ \DSUB BUMP SUBCHANNEL # LDB \DSUB DONE YET? CPB #SUBC RSS YES JMP INS6 TRY THE NEXT SUBCHANNEL * LDB TEMP1 RE-STORE THE STB \DSUB SYSTEM SUBCHANNEL'S DESTINATION LDB TEMP2 SUBCH , AND THE TARGET STB \TUNT UNIT JSB \SETD RESET SYSTEM SUBCH SPECS JMP BOOT? * SKP * * ILOOP NOP JSB IMESS PRINT INITIALIZING MESSAGE JSB SPINT GO CLEAN UP SPARES ON THIS SUBCH SSA ERROR IN INIT SPARES?? JMP IABRT SEND "UNABLE TO INITIALIZE SUBCHANNEL XX" LDA \DNTR GET THE # OF TRACKS CMA,INA FOR THIS SUBCHANNEL STÓm������þúA TEMP3 AND SET AS THE LOOP COUNTER CLA SET THE STARTING TRACK # STA \TRAK TO INITIALIZE STA \SECT CLEAR SECTOR # LDA P3 STA \MODE SET DRIVER IN INIT. TRACKS MODE * IL1 LDA \TRAK DISPLAY TRACK # OTA 1 IN SW REG LDB \BUFA GET BUFFER ADDRESS CLE SET TO WRITE JSB DISKD WRITE INIT THE TRACK SSA,RSS CHECK \RET STATUS-IF NEG,ABORT SUBCH JMP IOK STATUS OK * IABRT JSB INERR SEND "UNABLE TO INITIALIZE SUBCHANNEL XX" JMP ILOOP,I ABORT INIT OF THIS SUBCHANNEL &DO NEXT * IOK ISZ \TRAK INCREMENT THE TRACK # ISZ TEMP3 AND THE LOOP COUNTER JMP IL1 CONTINUE JMP ILOOP,I DONE WITH THIS SUBCHANNEL SPC 4 IMESS NOP CLA,INA STA \CLEN SET CONVERSION LENGTH JSB \BLIN PRINT A BLANK LINE LDA \DSUB GET SUBCHANNEL TO BE INIT'D CMA,INA LDB MSIN1 JSB \CVAS CONVERT FOR MESSAGE * LDA P16 LDB MSINS PRINT: JSB \DSPL "INITIALIZING SUBCHANNEL XX" JMP IMESS,I * MSINS DEF *+1 ASC 16,INSTALLING SYSTEM SUBCHANNEL XX MSIN1 DEF MSINS+16 MSINT DEF *+1 ASC 9,INITIALIZING SPC 4 INERR NOP SEND "UNABLE TO INIT. SUBCH XX" CLA,INA STA \CLEN SET CONVERT LENGTH TO 1 WORD JSB \BLIN LDA \DSUB CURRENT SUBCH CMA,INA LDB MS14A WHERE TO STUFF ASCII SUBCH JSB \CVAS CONVERT SUBCH FOR MESSAGE * LDA P17 LDB MES14 JSB \DSPL SEND "UNABLE TO INITIALIZE * SUBCHANNEL XX" JMP INERR,I RETURN * MES14 DEF *+1 ASC 17,UNABLE TO INITIALIZE SUBCHANNEL XX MS14A DEF MES14+17 SKP * * UPDATE THE 7900 TAT FOR ANY BAD TRACKS ENCOUNTERED DURING * THE TRANSFER OR INITIALIZATION. * UPTAT CLA CLEAR THE WRITE STA \INIT INITIALIZE FLAG A‹������þú LDA N6144 STA \LNTH SET TRANSFER LENGTH LDA DEQT GET THE TARGET DISK TYPE SLA,RSS JMP BOOT? NO BAD ONES ON A 7905/7920 * LDA \FLGT GET ADDRESS OF BAD TRACK TABLE STA TEMP3 AND SAVE IT FOR RETRIEVAL LDA A,I GET THE FIRST BAD TRACK CPA N1 -1 MEANS END OF LIST JMP BOOT? NO BAD TRACKS * LDA TAT CONVERT THE TAT CORE ADDRESS ADA P128 TO TRACK # AND OFFSET CLB (ALLOW FOR T0S0 BOOTSTRAP) DIV P6144 STB TEMP1 TAT'S OFFSET INTO TRACK BUFFER STA TEMP2 TRACK CONTAINING THE TAT CMB,INB ADB P6144 SET THE # OF (POSSIBLE) TAT STB TYP6 ENTRIES ON TRACK TEMP2 * CMB,INB DETERMINE IF NEXT BAD TRACK IS ON LDA TEMP3,I THE TAT ENTRIES OF TRACK TEMP2 AND B1776 ALF,ALF ROTATE TRACK TO LOW A RAL ADB A SSB JMP RDTAT IT IS TRAK2 ISZ TEMP2 ADJUST VARIABLES FOR NEXT TRACK LDA TEMP1 CMA,INA ADA P6144 CONVERT NEW OFFSET TO NEG (BECAUSE CMA,INA OF LOGICAL BAD TRACK #'S) STA TEMP1 * RDTAT CLA STA REWRT CLEAR REWRITE FLAG STA \SECT LDA TEMP2 STA \TRAK LDB \BUFA CCE JSB DISKD GO READ IT! * SETBD LDA TEMP3,I GET THE BADTTRACK# AND B1776 INTO LOW A ALF,ALF RAL ADA TEMP1 aADD TAT OFFSET INTO TRACK BUFFER ADA \BUFA LDB MSIGN STB A,I SET THE TAT ENTRY ISZ REWRT SET TO REWRITE THE TRACK ISZ TEMP3 POINT TO NEXT BAD TRACK ENTRY * LDA TEMP3,I GET THE NEXT BAD TRACK CPA N1 END OF LIST? JMP TROUT YES AND B1776 ROTATE IT TO LOW A ALF,ALF RAL ADA TYP6 ADD # ENTRIES ON TEMP2 SSA,RSS TO SET IF ITS ON THIS TAT TRACK JMP SETBD ON TEMP2, SO GO SET ITª;������þú * TROUT LDA REWRT IS TRACK TEMP2 TO BE RE-WRITTE? SZA,RSS JMP BOOT? NO LDA \INP0 STA \INIT LDB \BUFA GET THE BUFFER ADDRESS CLE CLEAR TO WRITE JSB DISKD AND DO IT * LDA TEMP3,I CPA N1 DONE NOW? RSS YES JMP TRAK2 NO,SET ENTRIES THAT ARE ON NEXT TRACK SKP * BOOT? LDA AUTO ARE WE TO BOOT UP ? SZA,RSS JMP XOUTT NO-GIVE 'EM A CHANCE TO RMV TARGET * * * BOOT THE NEW RTE! * BOOT JSB FINSH "SWTCH FINISHED" JSB \BLIN LDA N256 LENGTH OF LONGEST BOOT EXTENSION(HPIB) STA \LNTH CLA SET FOR TRACK 0, SECTOR 0. STA \INIT STA \TRAK STA \SECT ISZ \BOOT SET SO DISKD WILL BRANCH * LDA DEQT SLA,RSS DEST. DISC TYPE?? JMP BOT32 DO TYPE 32 DISC BOOT UP * * * 7900 DISC TYPE BOOT UP PROCEDURE. * LDB B2011 WRITE THE BOOTSTRAP LOADR HERE CCE SET TO READ JSB DISKD LOAD THE SYSTEM LOADER. **** NOTE - FOR 7900 BOOT, WE NEVER COME BACK FROM JSB DISKD * SPC 4 * * 7905/06/10/20/25 (H) DISC BOOT UP- (ALL TYPE 32 DISCS) * BOT32 CLA,INA SET DRIVER MODE TO REG READ STA \MODE CCE * JSB DISKD READ 256 WORDS TO GET BOOT EXTENSION * JSB $LIBR TURN OFF INTERRUPTS,IGNORE MEM PROT. NOP * LDA \DCH SEL CODE FOR SYS DISC OTA 6 DMA CW1-SET UP FOR BOOT EXT. LSL 6 OTA 1 SET IN S REG. FOR BOOT EXT. TOO LDA \BUFA ADDR OF BOOT EXTENSION COPY LDB B2011 ADDR IN TBL AREA I TO WRITE BOOT MVW B256 OVERWRITE TA I W/ BOOT EXT. * CLB LFB CLEAR BASE PAGE FENCE CLC 0,C CLF 1 SIMULATE A PRESET ON FRONT PANEL * LDA M2055,I DJP A,I DISABLE MAPPING,JMP TO RTE-IV BOOT- BYE! * B2011 OCT ’p������þú2011 M2055 OCT 2055 B256 DEC 256 LWAM EQU 1777B SKP * NORMAL TERMINATION EXIT - FOR RETURN TO CURRENT OP SYSTEM * XOUTT LDA OVLAY GET OVERLAY FLAG SZA,RSS SKIP MESSAGE IF NO OVERLAY JMP NOVR * JSB \BLIN LDA P20 LDB MS45C "IF TRANSFERRING TO NEW SYSTEM, JSB \DSPL IT MUST BE BOOTED..." LDA D19 LDB MS45D JSB \DSPL NOVR ISZ SWPFL SKIP MESSAGE IF IN BATCH MODE. JSB SWAPD "IF RETURNING TO HOST..REPLACE TARGET.." JSB FINSH "SWTCH FINISHED" JMP XDONE TERMINATE NOW * * FOR ABNORMAL TERMINATIONS SEND MESSAGE MES15 \XOUT JSB \BLIN LDA P10 LDB MES15 JSB \DSPL "TRANSFER CANCELLED." ISZ SWPFL SEND MSG IF COUTERPART SENT ERALIER JSB SWAPD "NOW IS THE TIME...REMOVE TARGET..." LDA P9 LDB MS15A JSB \DSPL "SWTCH TERMINATED." * XDONE LDA DEQT SLA JMP RLDMA RELEASE DMA IF 7900 HAD IT * ISZ LOK32 HAD WE LOCKED EQT PREVIOUSLY? JSB ULDSK YES-UNLOCK FOR TYPE 32 DISCS RSS * RLDMA JSB \RDMA RELEASE CH 7 ONLY IF WE HAVE IT * JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * JSB EXEC TERMINATE DEF *+2 DEF P6 SPC 2 RDERR CMA,INA ABSOLUTE FILE READ ERROR STA ERR JSB CNUMD DEF *+3 DEF ERR DEF MS31A * LDA MS31A+2 SAVE ERROR CODE ONLY STA MS31A LDA P6 LDB MES31 JSB \DSPL JMP \XOUT * MSIGN OCT 100000 D7 DEC 7 LOK32 DEC -1 -1\0=EQT NOT LOCKED\EQT IS LOCKED SWPFL DEC -1 0\-1 = "TIME TO INSERT" MSG SENT\NOT SENT OVLAY DEC 0 1\0 = HOST UNIT OVERLAID\NOT OVERLAID HED SWTCH SUBROUTINES. ********************************** * * ROUTINE TO SEND "NOW IS THE TIME TO REMOVE TARGET CARTRIDGE * (" "CR TO CONTINUE) * SWAPD NOP MSOVR JSö†������þúB \BLIN LDA P27 LDB MES45 JSB \DSPL "IF RETURNING TO HOST SYSTEM, TARGET LDA P26 CARTRIDGE MUST NOW BE REPLACED BY LDB MS45A HOST CARTRIDGE (" "CR TO CONTINUE) JSB \DSPL LDA N2 LDB \BUFI JSB \RDIN GET THE RESPONSE JSB \DFLT MAKE SURE IT'S " "CR JMP MSOVR REPROMPT-BAD RESPONSE JMP SWAPD,I RETURN * SPC 2 * * SUBROUTINE TO UNLOCK DISC * ULDSK NOP JSB EQTRQ DEF *+3 DEF MSIGN DEF \TDLU JMP ULDSK,I SPC 2 FINSH NOP JSB \BLIN LDA D7 LDB MES33 JSB \DSPL SEND "SWTCH FINISHED" JSB \BLIN JMP FINSH,I SPC 2 * * CONTROLS CALLS TO THE CORRECT DISK DRIVER, * DEPENDENT UPON THE DESTINATION DISK TYPE * DISKD NOP DST ABREG SAVE 'EM LDA DEQT SLA JMP DISK1 DLD ABREG JSB \DSK5 CALL TO 7905/7920 DRIVER LDA \RET GET DRIVER RETURN STATUS: -1=ERROR JMP DISKD,I * DISK1 DLD ABREG JSB \DSK0 CALL TO 7900 DRIVER JMP DISKD,I * ABREG BSS 2 A & B REGISTER SAVE AREA SPC 4 * * SPINT CALLS THE TYPE32 DRIVER TO INITIALIZE ALL THE SPARES ON * THE CURRENT SUBCHANNEL PRIOR TO WRITING ANY DATA TO THEM. * SPINT NOP LDA P4 STA \MODE SET DRIVER INTO SPARE CLEANUP MODE * CLA STA \SECT LDA \DNTR STA \TRAK GET FIRST SPARE ON THIS SUBCHANNEL * LDA ND#WT GET NEG WORDS/TRACK STA \LNTH SET IT FOR DRIVER TOO. LDB \BUFA JSB CLRBF CLEAR TRACK BUFFER * LDB \DNSP GET # SPARES SZB,RSS RETURN IF NO SPARES JMP SPINT,I * CMB,INB STB N#SP SET LOOP COUNTER * NXTSP LDA \TRAK OTA 1 DISPLAY IN SWITCH REG CLE LDB \BUFA BUFFER ADDR JSB DISKD GO INIT THIS TRACK ISZ \TRAK µ������þúNEXT TRACK SSA A=\RET STATUS FROM DRIVER JMP SPINT,I RETURN W/ ERROR ISZ N#SP JMP NXTSP NOT DONE * JMP SPINT,I RETRUN * SKP * * CLEAR A-REG NUMBER OF WORDS IN A BUFFER STARTING AT B-REG * CLRBF NOP STA TEMP2 AND SAVE CLA CLEAR STA B,I INB BUMP BUFFER ADDRESS ISZ TEMP2 AND LOOP COUNTER JMP CLEAR CONTINUE JMP CLRBF,I DONE SKP * * * UPDATES THE DIRECTORY POINTERS ( AND POSSIBLY TRACK # ) * WHEN PURGING FILES * * RETURN: (P+1) CONTINUE IN SAME DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (P+2) DONE WITH THE DIRECTORY * (P+3) CONTINUE IN NEXT DIRECTORY TRACK * (B) IS ADDRESS OF NEXT ENTRY * (A) IS # ENTRIES TO SEARCH ON NEXT PASS * UPDAT NOP LDB BPTR SET TO SEARCH NEXT ENTRY ADB P16 DIRECTORY ENTRY ISZ TCNT DONE WITH TRACK? JMP UPDAT,I NO,CONTINUE ISZ UPDAT * LDA CURCH ARE WE PURGING EXTENTS? SZA,RSS JMP UPDTT NOPE * * SEARCH THE JUST COMPLETED DIRECTORY TRACK FOR THE EXTENTS * OF ANY OVERLAID FILES * LDA #PF ANY SO FAR? SZA,RSS JMP UPDTT NO, CONTINUE CMA,INA STA PCNT SAVE AS A COUNTER LDB LWAM GET ADDRESS OF 1ST ENTRY ADB N3 * PEXT0 LDA \BUFA AND ADDRESS OF BUFFER TO SEARCH STB TEMP3 PEXT1 STA BPTR SAV BOTH ADDRESS POINTERS * STA TEMP2 LDA TEMP2,I GET WORD 0 OF A FILE DIRECTORY ENTRY SSA JMP PEXT2 ALREADY PURGED SZA,RSS JMP PEXT2 NOT A VALID ENTRY CPA B,I CHARACTERS 1&2? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 3&4? INB,RSS JMP PEXT2 NO ISZ TEMP2 LDA TEMP2,I CPA B,I CHARS 5&6 RSS cU������þú JMP PEXT2 NO CCA STA BPTR,I YES, SO PURGE THE EXTENT ISZ REWRT SET TO REWRITE THE DIRECTORY TRACK * PEXT2 LDA BPTR POINT TO NEXT FILE ENTRY ADA P16 LDB TEMP3 CPA DTEND DONE? RSS JMP PEXT1 NO CONTINUE WITH TRACK BUFFER ADB N3 MOVE TO NEXT LIST ENTRY ISZ PCNT DONE WITH FILE LIST? JMP PEXT0 JMP UPDTT YES * UPDTT LDA REWRT DOES THIS ONE NEED TO BE REWRITTEN? SZA,RSS JMP INCRT NO, NO ENTRIES WERE PURGED * LDB \BUFA REWRITE THE THIS DIRECTORY TRACK CLE JSB DISKD * INCRT ISZ TEMP4 DONE WITH THE DIRECTORY? RSS JMP UPDAT,I YES * CCA ADA \TRAK NO, UPDATE THE DISK ADDRESS STA \TRAK BUMP TO PREVIOUS TRACK ( THE CLA NEXT DIRECTORY TRACK) STA \SECT CCE LDB \BUFA JSB DISKD READ NEXT DIRECTORY TRACK CLA STA REWRT CLEAR LDA \D#ST SET LOOP COUNTER RAL,RAL CMA,INA LDB \BUFA AND BUFFER POINTER ISZ UPDAT JMP UPDAT,I * PCNT NOP LOOP COUNTER OF PURGED FILES DTEND NOP END OF DIRECTORY TRACK BUFFER SKP * * PURGT PURGES AND DISPLAY FILE FOR ONE OF TWO REASONS: * A FILE OVERLAID BY THE NEW SYSTEM * A TYPE 6 FILE SPECIFIED BY THE USER TO BE PURGED * PURGT NOP LDB BPTR INSERT THE FILE LDA B,I NAME INTO THE STA MS29 OUTPUT MESSAGE INB BUFFER LDA B,I STA MS29+1 INB LDA B,I STA MS29+2 LDA P6 LDB MES29 JSB \DSPL OUTPUT THE FILE NAME * ISZ REWRT FLAG TO REWRITE DIRECTORY TRACK CCA STA BPTR,I SET WORD 0 OF ENTRY TO PURGE IT LDA CURCH SZA,RSS PURGE THE EXTENTS AND CLEAR THE SIZE WORD? JMP PURGT,I NO * * ENTERS THE FILE NAME SOu���N��LH ITS EXTENTS CAN LATER * BE SEARCHED FOR AND PURGED * & CLEAR THE SIZE WORD TO PREVENT RECOVERY OF DISC SPACE * LDB BPTR FIRST CLEAR THE SECTOR SIZE WORD ADB P6 SINCE OVERLAID FILES' SPACE CANNOT CLA BE RECOVERED STA B,I ADB N1 SEE IF THIS IS AN EXTENT FILE ENTRY LDA B,I IF SO, DON'T RE-ENTER THE FILE ALF,ALF NAME IN THE LIST AND B377 SZA JMP PURGT,I IT WAS ISZ #PF INCREMENT # ENTRIES IN FILE LDB PENT LDA MS29 STORE FILE NAME IN LIST STA B,I UPWARDS INB LDA MS29+1 STA B,I LDA MS29+2 INB STA B,I LDA PENT ADA N3 READY FOR NEXT ENTRY STA PENT JMP PURGT,I * PENT NOP ADDRESS OF NEXT ENTRY TO USE #PF NOP # OF PURGED FILE ENTRIES ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������JíN������ÿÿ��������þú SKP \BLIN NOP OUTPUT A BLANK LINE. LDB DBLNK CLA,INA JSB \DSPL JMP \BLIN,I SPC 4 \DSPL NOP DISPLAY MESSAGE ON OPERATOR CONSOLE STA DSPL STB DSPB JSB EXEC DEF *+5 DEF P2 DEF OPLU DSPB NOP DEF DSPL JSB LOOP WAIT UNTIL DEVICE AVAILABLE JMP \DSPL,I TO RETURN * DSPL NOP SPC 4 \RDIN NOP READS FROM OPERATOR CONSOLE STA DSPL INPUT LENGTH: +/- = WORDS/CHARS STB BFADR BUFFER ADDRESS INPT JSB EXEC DEF *+5 DEF P1 DEF OPLU BFADR NOP DEF DSPL MAXIMUM INPUT LENGTH SZB,RSS CHECK TRANS. LOG JMP INPT TRY AGAIN FOR ANSWER LDA B GET TRANS. LOG CMA STA \NLNG SAVE NEG. OF TRANS. LOG LESS 1 JMP \RDIN,I RETURN * \NLNG NOP NEG OF TRANSMISSION LOG -1 SPC 2 * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. (B) IS THE LENGTH OF INPUT IN CHARACTERS * RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * \DFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP \DFLT,I NO, SO DON'T BOTHER CHECKING LDA IBBUF MSG BUFFER AND B1774 CPA UBLNK ISZ \DFLT GOT ONE JMP \DFLT,I * UBLNK OCT 20000 SPC 4 LOOP NOP LOOPS ON A STATUS CHECK UNTIL LOOPS JSB EXEC THE DEVICE IS NO LONGER DEF *+5 BUSY DEF P13 DEF OPLU DEF IEQT5 DEF IEQT4 * LDA IEQT5 AND M1400 SZA JMP LOOPS JMP LOOP,I * M1400 OCT 140000 SKP * * CONVERT A TO ASCII AT B * * THE \CVAS SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. * * CALLING SEQUENCE: * \CLEN = MAXIMUM # WORDS IN ANSWER * A = NO. Tן������þúO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB \CVAS * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CVAS NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA CTEMP PUT NUMBER IN TEMPORARY LDA \CLEN GET # WORDS CPA P1 IF ONLY 1 THEN ADB P2 ADVANCE 2 POWERS STB RANAD SET OWER RANGE ADDRESS LDB N2 ALSO SET LOOP COUNT CPA P1 INB ONCE FOR 2 WORDS STB TCNT LDB CTEMP NUMBER INTO B NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CVAS,I YES - RETURN * OPWRS DEF *+1 OCT 1000 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 1000 DEC 100 P10 DEC 10 P1 DEC 1 * \CLEN NOP MAXIMUM # WORDS IN ANSWER CURAT NOP BUFFER ADDRESS TCNT NOP TEMPORARY LOOP COUNTER CTEMP NOP SPC 6 * * GET DIGIT FOR \CVAS * * GETD PROVIDES THE ASCII CHARACTERS FOR \CVAS. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB ������þú RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * RANAD NOP SKP * * CONVERT OCTAL OR DECIMAL ASCII TO BINARY * * THE GET# SUBROUTINE CONVERTS THE NEXT CHARACTERS IN IBBUF FROM * TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = (+/-) MAX. NO. OF CHARS IN CONVERSION REQUEST. * +=CONVERT OCTAL; -=CONVERT DECIMAL * B = IGNORED * \NLNG = THE TRANSMISSION LOG IN # CHARACTERS(RET BY TARGT) * \BUFA = THE ADDR OF THE ASCII BUFFER TO PARSE * JSB GET# * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION OR ALL BLANKS * (N+2): A = CONVERTED NO. * B = DESTROYED * GET# NOP LDB P8 GET OCTAL BASE SSA SKIP IF OCTAL REQUEST LDB P10 GET DECIMAL BASE STB BASE1 SET THE DESIRED BASE * * CMB,INB SET NEG STB DRANG SET DIGIT RANGE * SSA,RSS IS THIS AN OCTAL REQUEST?? CMA,INA YES-MAKE DIGIT COUNT NEGATIVE STA MAXC SET NEG. MAX # OF DIGITS * CCB B=-1 STB BLKCK INITIALIZE CHECK FOR ALL BLANKS STB BUFUL SET BUFUL=-1 (START W/ UPPER CHAR) LDA \BUFI STA BPTR CLA STA NUM# CLEAR ACCUMULATOR GETNX LDB BUFUL GET UPPER-LOWER FLAG IGNOR ISZ \NLNG OUT OF CHARACTERS?? RSS NO-CONTINUE JMP GDONE YES-RETURN LDA BPTR,I GET CHAR FROM BUFFER SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ BPTR INCR BUFFER ADDRESS STB BUFUL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR YES ¯§������þú ISZ BLKCK OK-WE FOUND A NON-BLANK:SAVE IT NOP ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA IS CHAR > OCTAL 60?? JMP DGERR NO- TOO BAD ADA DRANG IS DIGIT < # BASE SSA,RSS YES IF RESULT IS NEG JMP DGERR SORRY - BAD DIGIT LDA NUM# GET PREVIOUS ACCUMULATOR MPY BASE1 MULTIPLY NEW DIGIT BY BASE ADA TCHAR SET A = NEW OCTAL NO. STA NUM# SAVE ACCUMULATOR SZB TEST FOR OVERFLOW RSS SSA TEST FOR OVERFLOW JMP DGERR INVALID NUMBER ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT GDONE ISZ BLKCK IF BLKCK WAS=-1:ERR-ALL BLANKS ISZ GET# SET SUCCESS RETURN LDA NUM# GET THE RESULT FROM ACCUMULATOR DGERR JMP GET#,I RETURN * TCHAR NOP TEMP CHAR SAVE AREA. DRANG NOP NEG ACCEPTABLE DIGIT RANGE NUM# NOP ACCUMULATOR FOR CONVERSION BLANK OCT 40 BUFUL NOP UPPER/LOWER CHARACTER = -1/0 BLKCK NOP NEG/POS=BLANK LINE/>=1 NON-BLANK MAXC NOP MAXIMUM # DIGITS IN CONVERSION L60 OCT -60 CKSUM NOP STORAGE FOR SYS FILE CHECK SUM SPC 2 ********************************************************************** * CHKSM ROUTINE * * * CHKSM - COMPUTES (A REG.) WORD CHECKSUM TO CHECK THE SYSTEM FILE * * CALLING SEQUENCE * JSB CHKSM * A=# OF WORDS TO ADD TO OBTAIN CHECKSUM * B=ADDR OF 1ST WORD TO ADD IN CHECKSUM * RETURN: * (P+1) * A=THE CHECKSUM (ALL 256 WORDS XOR'D TOGETHER) * CHKSM NOP CMA,INA STA TEMP6 CLA * XLOOP XOR B,I INB ISZ TEMP6 JMP XLOOP * JMP CHKSM,I RETURN SPC 1 * END CHKSM * ************************************************************­Ÿ������þú********** SKP HED SWTCH CONSTANTS AND STORAGE. * DESTINATION => GENERATION-DEFINED SYSTEM * \DCH NOP DESTINATION SYSTEM DISC CHANNEL \DSUB NOP " " " SUBCHANNEL DEQT NOP " " " EQT TYPE \DUNT NOP " " " UNIT \DFTR NOP " " " FIRST TRACK/CYLINDER \DNTR NOP " " " NUMBER TRACKS \DSHD NOP " " " STARTING HEAD (7905/7920) \DNSU NOP " " " NUMBER SURFACES " \DNSP NOP " " " " SPARES " \D#ST NOP " " " SECTORS/TRACK \D#WT NOP " " " WORDS/TRACK DTTY NOP " TTY CHANNEL DPI NOP " PI CHANNEL DTBG NOP " TBG CHANNEL DSIB? DEC 0 1/0 = DEST. SYSTEM HPIB/NON-HPIB SPC 3 * TARGET => TEMPORARY STORAGE FOR NEW SYSTEM * \TDLU DEC -1 TARGET DISC CHANNEL \TSUB DEC -1 " " SUBCHANNEL \TUNT DEC -1 " " UNIT (7905/7920) \T32C NOP TARGET SELECT CODE FOR TYPE 32 DISCS SKP * MES15 DEF *+1 ASC 10,TRANSFER CANCELLED. ASC 9,SWTCH TERMINATED. MS15A DEF MES15+11 MES27 DEF *+1 ASC 10,OVERLAID FMP FILES: MES28 DEF *+1 ASC 10,TYPE 6 FILES PURGED: MES29 DEF *+1 MS29 ASC 6, MES31 DEF *+1 ASC 5,FILE ERR - MS31A BSS 0 MES33 DEF *+1 ASC 7,SWTCH FINISHED MES44 DEF *+1 ASC 21,DISC CARTRIDGE CONTAINING NEW SYSTEM FILE ASC 20,XXXXXX HAS BEEN REMOVED FROM DISC DRIVE MS44A DEF MES44+22 MES45 DEF *+1 ASC 22,IF RETURNING TO HOST SYSTEM,TARGET CARTRIDGE ASC 5, MUST NOW ASC 15,BE REPLACED BY HOST CARTRIDGE ASC 11, (" "CR TO CONTINUE) MS45A DEF MES45+28 MS45C DEF *+1 ASC 20,IF TRANSFERRING CONTROL TO NEW SYSTEM,IT ASC 19,MUST BE BOOTED AFTER SWTCH TERMINATES. MS45D DEF MS45C+21 SPC 3 \BOOT NOP "WE'RE BOOTING" FLAG FOR DISKD (0=NOT NOW) AUTO i4������þúDEC -1 AUTO BOOT-UP FLAG (0=NO, 1=YES) \SAVE DEC -1 SAVE TARGET FILES(0=NO,1=YES,-1=OVERLAYS SOME) TYP6 DEC -1 PURGE TYPE 6 FILES FLAG (0=NO, 1=YES) SUBI DEC -1 INITIALIZE SUBCHANNELS FLAG," " BATCH DEC -6 BATCH MODE ( NO<=0, YES>=1 ) #EQTS NOP NUMBER OF DESTINATION EQT'S CURCH DEC 0 CURRENT CHANNEL COUNTER D.LT DEC -1 LAST DIRECTORY TRACK FROM TARGET'S CD D.# NOP # DIRECTORY TRACKS FROM TARGET'S CD TAT NOP DISK ADDRESS OF TAT IN NEW SYSTEM \FFMP NOP FIRST LOGICAL FMP TRACK AT TARGET N#SP NOP NEG # OF SPARES FOR CURRENT SUBCHANNEL HSIB? DEC 0 1/0 = HOST SYSTEM HPIB/NON-HPIB #SUBC NOP NUMBER OF DEFINED DISK SUBCHANNELS HDFLG NOP HEADER FLAG \LU2 DEC 1 LU 2 OR 3 FLAG OLDNU NOP =0 OLD FMGR FORMAT, =1 NEW FORMAT ND#WT NOP NEGATIVE DEC # WORDS/TRACK * \LNTH NOP LENGTH OF READ/WRITE \INIT NOP DISKD COMMAND MASK \TRAK NOP DESTINATION DISK ADDRESS \SECT NOP \BUFI DEF IBBUF ADDR OF COMMAND BUFF+DATA BUFF \BUFA DEF BUFR BPTR NOP BUFR POINTER EOFLG NOP REWRT NOP RE-WRITE TRACK FLAG SIZE NOP # BLOCKS IN FILE \STRK NOP # TRACKS IN FILE (PLUS 8) \MODE NOP MODE FLAG FOR TYPE 32 DRIVER SEG. * TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP " TEMP4 NOP " TEMP5 NOP " TEMP6 NOP " * PI EQU 1737B TBG EQU 1674B SYSTY EQU 1675B * IEQT4 NOP IEQT5 NOP * TEQT4 NOP EQT 4 OF TARGET DISC TEQT5 NOP EQT 5 OF TARGET DISC SKP P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 P6 DEC 6 P8 DEC 8 P9 DEC 9 P13 DEC 13 P16 DEC 16 P17 DEC 17 D19 DEC 19 P20 DEC 20 D21 DEC 21 P22 DEC 22 P26 DEC 26 P27 DEC 27 P64 DEC 64 P128 DEC 128 P256 DEC 256 P1024 DEC 1024 P6144 DEC 6144 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N256 DEC -256 * B17 OCT 17 B60 OCT 60 B377 OCT 377 B1774 OCT 177400 B1776 OCT 177600 B1777 OCÑ���*��($T 177760 B7777 OCT 77777 * OPLU DEC 1 DEFAULT OPER CONSOLE LU (MAY * BE OVERWRITTEN) CNTR NOP DBLNK DEF BLNK BLNK OCT 20040 * * DCB BSS 144 ERR NOP LLEN NOP * \TMT DEF *+1 BSS 160 * END EQU * * * END SWTCH ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������X*������ÿÿ����� ���� ÿý�Ë�B ���������ÿ��92067-18514 2001� S C0122 �&SWSG1 �SWTCH SEG. #1 � � � � � � � � � � � � �H0101 ƒ�����þúASMB,Q,R,C HED SWTCH - SWSG1, 7900 DISK DRIVER SEGMENT NAM SWSG1,5,10 92067-16514 REV.2001 791018 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWSG1 * SOURCE: 92067-18514 * BINARY: 92067-16514 * WRITTEN BY: KFH, JJC * **************************************** * * * ENTRY POINTS * ENT \DSK0,\STD0 ENT \INP0,\INT0 ENT \GDMA,\RDMA ENT \FLGT * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \TDLU,\TSUB,\DFTR,\DNTR,\D#ST,\D#WT EXT \INIT,\LNTH EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \DSUB,\XOUT,\BUFA EXT \BOOT,\TMT,\LU2 EXT \TRAK,\SECT * * A EQU 0 B EQU 1 SUP SKP BEG0 LDA P96 SET #SECTORS/TRACK STA \D#ST MPY M100 STA \D#WT AND THE #WORDS/TRACK LDB \DSUB SEGMENT'S ENTRY POINT ADB \TMT OFFSET INTO TRACK MAP TABLE BUFFER LDA B,I GET FIRST WORD OF SUCHANNEL'S ENTRY STA \DFTR SET STARTING TRACK ADB P8 POSITION TO SECOND WORD OF SUBCH'S ENTRY LDA B,I AND GET ITS STA \DNTR # OF TRACKS JMP \SWTM RETURN SPC 3 TEMP BSS 3 TEMP FOR INTIALIZATION * M100 OCT 100 B177 OCT 177 M440 OCT 440 M0100 OCT 10000 M0600 OCT 60000 VERIFY OPCODE M1776 OCT 177600 M7700 OCT 177700 * N10 DEC -10 * P10 DEC 10 P2 DEC 2 P4 DEC 4 P8 DEC 8 P9 DEC 9 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 ¯ù������þúDEC 17 P18 DEC 18 P25 DEC 25 P96 DEC 96 * \INP0 OCT 101000 INITIALIZE, WRITE PROTECT COMMAND BITS \INT0 OCT 100000 " " " SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD0 NOP LDA \TDLU SAVE TARGET DISK CHANNEL STA TEMP1 LDA #DATA GET # WORDS TO BE CONFIGURED LDB HPDSK GET ADDRESS OF INSTR ADDR LIST STDS1 STA TEMP2 SAVE NO. OF INSTRUCTIONS STDS2 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR TEMP1 INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP2 SKIP - DONE WITH SET JMP STDS2 CONFIGURE NEXT INSTRUCTION * LDA TEMP1 DONE WITH COMMAND CHANNEL? CPA \TDLU RSS JMP STDS3 YES LDA #CMND GET # COMMAND INSTRUCTIONS ISZ TEMP1 STEP TO COMMAND CHANNEL JMP STDS1 GO CONFIGURE * STDS3 LDA N10 CLEAR THE BAD TRACK STA TEMP TABLE LDB \FLGT GET ADDRESS OF TABLE CCA STA TEMP+2 SET TO NO BAD TRACKS STDS4 STA B,I SET TO -1 FOR NO ENTRY INB STEP TABLE ADDRESS ISZ TEMP DONE? JMP STDS4 NO, DO NEXT ONE STA B,I JMP \STD0,I RETURN * * #DATA ABS I/OTB-I/OTC # DATA INSTRUCTIONS #CMND ABS I/OTC-I/OTD # COMMAND INSTRUCTIONS HPDSK DEF I/OTB,I ADDR OF I/O INSTRUCTION LIST TEMP1 NOP TEMP2 NOP * ADDRESS OF BAD TRACK TABLE \FLGT DEF \STD0+1 WHICH OVERLAYS 10 WORDS OF \STD0 SKP * * GTDMA ALLOCATES A DMA CHANNEL FOR SWTCH * \GDMA NOP CKDMA LDB INTBA ADDR OF INT TABLE INB WTDMA LDA B,I CHECK WITH INTERRUPTS ON SZA IS DMA CH 7 FREE?? JMP WTDMA #@������þúNOPE-WAIT WITH INTS ON * JSB $LIBR TURN OFF INTS. & CHECK AGAIN NOP CLF 0 LDB INTBA INB LDA B,I IS IT REALLY FREE?? SZA,RSS JMP GOTIT YES-GO GRAB IT JSB INTON NOPE-IT GOT AWAY-TRY AGAIN JMP CKDMA RETRY-W/ INTS ON * GOTIT LDA B777 STA B,I STUFF 777B IN INT TABL FOR SWTCH LDA USMAP USER MAP TO DMA CH 7 XMA SET IT UP JSB INTON TURN ON INTS&RETURN TO MAIN JMP \GDMA,I RETURN * SPC 3 * * RLDMA RELEASES THE DMA CHANNEL * \RDMA NOP JSB $LIBR TURN OFF INTS. NOP CLF 0 * LDB INTBA INB * LDA B,I GET PSEUDO ID SEG ADDR. CPA B777 SWTCH BETTER HAVE IT CLA OK-SO GIVE IT BACK STA B,I IF NOT-BAD NEWS,BUT LEAVE IT JSB INTON TURN ON INTS & RETURN TO MAIN JMP \RDMA,I RETURN * * SPC 3 * B777 OCT 777 USMAP OCT 100001 CTRL WRD: USER > PORT B MAP * INTBA EQU 1654B SPC 5 * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. * INIER JSB INTON TURN INTERRUPTS BACK ON LDA STATB GET STATUS AND AND M440 MASK SEEK CHECK CHECK AND END OF CYLINDER SZA,RSS BITS - IF NOT SET CONTINUE JMP INIE0 WITH BAD TRACK ROUTINE * LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P15 ELSE SEND BAD SPECIFICATION LDB ERR43 JSB \DSPL "INVALID DISC SPECIFICATIONS" JMP \XOUT TERMINATE SWTCH * INIE0 LDA \INIT SAVE THE \INIT STA TEMP2 FLAG WORD LDA DFCYF SET COMMAND STA \INIT TO FLAG TRACK DEFECTIVE CLE AND LDB \BUFA CALL JMP DISK0+1 DRIVER * INIEH ISZ TEMP+2 BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA P10 LDB \TSUB MÁ������þúGET SUBCHANNEL ADB BLK0 ADD ASC BLANK 0 STB EMES1-1 SET IN MESSAGE LDB EMES1 SEND THE JSB \DSPL MESSAGE * INIES LDA \TRAK GET TRACK ADDRESS CMA,INA SET NEGATIVE FOR DECIMAL CONVERSION LDB P2 STB \CLEN FOR \CVAS LDB ALBUF SET BUFFER ADDRESS JSB \CVAS CONVERT THE NUMBER LDA P4 AND LDB ALBUF SEND JSB \DSPL THE TRACK NUMBER * * TRACK IS NOW FLAGGED AND REPORTED IT IS NOW ENTERED IN THE * BAD TRACK TABLE. * LDA \LU2 SHOULD IT BE ENTERED IN TABLE? SZA,RSS JMP DISK0,I NO, RETURN NOW LDA TEMP2 STA \INIT RESTORE IT LDA \TRAK GET THE TRACK ALF,ALF RAR ADA \DSUB STA TEMP1 AND SAVE LDB \FLGT GET THE BAD TRACK TABLE ADDRESS LDA N10 ALLOW 10 ENTRIES STA TEMP+1 SET COUNTER INIE1 LDA B,I GET ENTRY SSA NEGATIVE? JMP INIET YES - USE THIS ONE * INB NO ALREADY USED ISZ TEMP+1 STEP COUNT 10 YET? JMP INIE1 NO - TRY NEXT ONE * LDB ER41A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P17 LDB ERR41 JSB \DSPL "LIMIT OF 10 BAD TRACKS EXDEEDED" JMP \XOUT AND TERMINATE SWTCH * INIET LDA TEMP1 GET SUBCHANNEL/TRACK STA B,I SET IN TABLE JMP DISK0,I GO FINISH INITILIZATION. * DFCYF OCT 100400 ALBUF DEF *+1 BSS 2 EMES2 ASC 10,BAD TRACKS PLATTER EMES1 DEF EMES2 BLK0 ASC 1, 0 * ERR41 DEF *+1 ASC 17,LIMIT OF 10 BAD TRACKS EXCEEDED ER41A DEF ERR41+17 ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 HED DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK51 DATA CHANNEL DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK56 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK6s‰������þú0 DEF DSK61 DEF DSK62 DEF DSK63 DEF DSKDR I/OTC DEF DSK01 COMMAND CHANNEL DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK17 DEF DSK18 DEF DSK19 DEF DSK20 I/OTD EQU * HED 7900 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO INIER * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 \DSK0 EQU * DISK0 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK ADA \DFTR ADD FIRST TRACK TO RELATIVE TRACK STA T#AC0 SAVE ABSOLUTE TRACK LDB \TSUB GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT STB UN#IT SAVE UNIT NUMBER LDA M0600 GET PRIMARY VERIFY OPCODE ADA B ADD IN THE UNIT STA V#CMD SAVE CONFIGURED VERIFY COMMAND ADB M0100 SET COMMANDS LDA \INIT ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R#DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS É›������þú IF E = 0 INA SET HEAD 2 LDB \SECT GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB NSEC SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 ****** CLF 0 * RTRY LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND M100 CHECK READY BIT SZA IF SET JMP NRERR GO TELL THE MAN * LDA T#AC0 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R#DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSKDR GET DMA WORD OTA 7 ASSIGN DMA CLC 3 SET FOR ADDRESS OTB 3 SEND ADDRESS LDA \LNTH SET LENGTH STC 3 SET FOR LENGTH OTA 3 SEND IT STC 7,C START DMA DSK03 STC 1,C START DRIVE CLC 7 JSB STATC GET STATUS STA STATB SAVE LDA STATB SLA JMP ERRCH CHECK ERROR STATUS * LDB MADDR CHECK IF READ OR WRITE SSB JMP NVRFY DON'T VERIFY ON READS * VERFY LDA T#AC0 GET THE TRACK ADDRESS JSB SEEK RESEEK FOR THE VERIFY LDB \D#ST GET # SEC/TRK FOR VERIFY RBR CONVERT TO 128 WD SECTORS LDA V#CMD GET THE VERIFY COMMAND DSK18 CLC 1 RESET COMMAND CHANNEL DSK62 OTB 0 SEND THE SECTOR COUNT vÉ������þú DSK63 STC 0,C OUT IT GOES DSK19 OTA 1 OUTPUT DE' CMD WORD DSK20 STC 1,C START DRIVE JSB STATC WAIT FOR CMD DONE&GET STATUS STA STATB SAVE STATUS SLA IF ERROR BIT SET JMP ERRCH THEN CHECK ERROR STATUS * NVRFY LDA \BOOT ARE WE BOOTING UP? SZA,RSS JMP DISKR NO,CONTINUE LDA \TDLU GET TARGET CHANNEL = DEST. CHANNEL LSL 6 SET UP S REG. FOR BOOT EXT. OTA 1 SYS DISC IN BITS 11-6 LDA DSKDR SET UP DMA SEL CODE FOR BOOT OTA 6 SET BITS 15 & 13 TOO CLB MUST CLEAR THE MPFT LFB CLC 0,C SIMULATE A CLF 1 PRESET ON FRONT PANEL LDA M2055,I GET STARTING ADDRESS DJP A,I WELL SAID-JMP TO RTE-IV BOOT * M2055 OCT 2055 M2011 OCT 2011 M1742 EQU 1742B * DISKR JSB INTON OK, SO TURN ON INTERRUPTS LDA \INIT CHECK IF MAY HAVE BEEN ALF,ALF FLAGGING A DEFECTIVE SLA TRACK, SO RETURN JMP INIEH TO REPORT IT JMP DISK0,I ELSE RETURN * ERRCH RAL,CLE,ERA CLEAR SIGN BIT CPA P9 WRITE PROTECT ERROR? (BITS 3,0) RSS CPA M2011 DATA PROTECT SWITCH ON? (BITS 10,3,0) JMP WRPTM YES - GO TELL 'EM * CPA P25 DEFECTIVE CYLINDER? (BITS 4,3,0) JMP DISBM * AND M100 ISOLATE READY BIT SZA READY? JMP NRERR NO - GO TELL USER * CLA YES, TRY TO RECOVER JSB SEEK SEEK TO CYLINDER 0 ISZ EDCNT INCREMENT # TRIES JMP DSK16 NOT TEN YET GO TRY AGAIN * LDA \INIT 10 TIMES IN INIT PHASE? CPA \INT0 JMP INIER YES GO TO INIT ERROR ROUTINE * * JSB INTON TURN THE INTERRUPTS BACK ON LDA \TRAK INSERT THE TRACK IN THE MESSAGE CMA,INA NEGATE FOR \CVAS LDB P2 STB \CLEN LDB ER22A JSB Ä������þú\CVAS LDB ER22B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXX" LDA \INIT DETERMINE ACTION TO TAKE ALF,ALF RAR SLA IF WRITE PROTECT BIT SET,THEN JMP \XOUT TRACKS WERE BEING WRITTEN, SO EXIT LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO TO INIT ERROR ROUTINE JMP \XOUT ELSE TERMINATE SWTCH * * DISBM JSB INTON ON INTERRUPTS! LDA \INIT IF DEFECTIVE CYLINDER ALF,ALF IS BEING FLAGGED BY SLA INIER JMP INIEH IGNORE ERROR, GO REPORT TRACK * RAL IF WRITE PROTECT SET, THEN SLA THE SYSTEM IS BEING WRITTEN JMP IRERR AND THAT'S IRRECOVERABLE! * LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO FLAG IT DEFECTIVE * IRERR LDA \TRAK INSERT TRACK # IN MESSAGE CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT AND EXIT * * NRERR JSB INTON INTERRUPTS ON JSB \BLIN DISC NOT READY LDB MS33A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA P14 LDB MES33 TELL 'EM JSB \DSPL "READY DISC AND PRESS RUN" JSB $LIBR TURN OFF NOP CLF 0 ******* CLF 0 DSK56 LIA 0 GET STATUS TO A HLT 33B PAUSE JMP RTRY ON RESTART, RETRY * * WRPTM JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS ON LDB MS32A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB MES32 JSB \DSPL "TURN OFF DISC PROTECT - PRESS RUN" JSB $LIBR OFF AGAIN NOP CLF 0 ******* CLF 0 ð������þú HLT 32B WAIT FOR IT JMP RTRY AND DO IT AGAIN * SPC 3 * * TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK17 CLF 1 JSB $LIBX DEF INTON SPC 2 * SEEK ROUTINE SEEK NOP DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 * * WAIT AND STATUS ROUTINE STATC NOP DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 7 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 3 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP NSEC DEC -24 W#CMD OCT 010000 UN#IT NOP H#AD NOP S#EKC OCT 030000 THE FOLLOWING CMDS ARE TO BE CONFIGURED R#DCM OCT 020000 DSKDR OCT 120000 MUST BE CONFIGURED T#AC0 NOP V#CMD OCT 060000 VERIFY CMD - MUST BE CONFIGURED SKP * ESUB NOP CLA,INA SET FOR 1 WORD STA \CLEN CONVERSION LDA \TSUB GET CURRENT SUBCHANNEL # CMA,INA NEGATIVE FOR DECIMAL CONVERSION JSB \CVAS JMP ESUB,I * SPC 5 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * ERR40 DEF *+1 ²���<��:6 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 * MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 * MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 * END EQU * * END BEG0 * * END EQU * END BEG0 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Í&<������ÿÿ����� ���� ÿý�Ì�Û ���������ÿ��92067-18515 2001� S C0322 �&SWSG2 �SWTCH SEG. #2 � � � � � � � � � � � � �H0103 ‡ �����þúASMB,Q,R,C HED SWTCH - SWSG2, TYPE 32 DISC DRIVER SEGMENT NAM SWSG2,5,10 92067-16515 REV.2001 791018 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************************* * * NAME: SWSG2 * SOURCE: 92067-18515 * BINARY: 92067-16515 * WRITTEN BY: JJC * ******************************************************************* * * * ENTRY POINTS * ENT \DSK5,\BADH ENT \SETD,\RET * * * EXTERNAL ENTRY POINTS * * DRIVER LIBRARY ROUTINES EXT XSEEK,XADRC,XFMSK,XDRED,XEND EXT XRDFS,XDWRT,XINIT,XVRFY,XRCAL,XSTAT * EXT \SWTM EXT \DFTR,\DNTR,\DSHD,\DNSU,\DNSP EXT \TDLU,\TUNT,\DSUB,\DUNT,\TSUB,\D#ST,\D#WT EXT \CVAS,\CLEN,\DSPL,\BLIN,\RDIN,\DFLT EXT \LNTH,\LU2,\BUFI,\MODE EXT \SAVE EXT \TRAK,\SECT EXT \TMT EXT \FFMP,\STRK * * A EQU 0 B EQU 1 SUP SKP BEG5 JSB \SETD SEGMENT'S ENTRY POINT JMP \SWTM RETURN TO MAIN * * * * DETERMINE SUBCHANNEL SPECIFICATIONS, USING INFORMATION * RETRIEVED FROM THE \TMT ENTRY FOR \DSUB. * \SETD NOP LDA \DSUB GET DESTINATION SUBCHANNEL MPY P5 CONVERT TO 5 WORD PER ENTRY OFFSET LDB A ADB \TMT INTO THE \TMT BUFFER LDA B,I GET WORD 0 STA \D#ST AND SET THE SECTORS/TRACK RAR DIVIDE BY 2 FOR XVRFY STA S#CTR ALF,RAL RAL,RAL STA \D#WT SET # WORDS/TRACK INB LDA B,I GET WORD 1 OF EN…¾������þúTRY STA \DFTR AND SAVE STARTING TRACK OF SUBCH INB LDA B,I GET WORD 2 OF ENTRY AND M17 ISOLATE THE UNIT # STA \DUNT AND SAVE LDA B,I NOW GET ALF,ALF AND MASK ALF AND M77 THE STA \DSHD STARTING HEAD LDA B,I ALF,RAL NOW ISOLATE RAL AND M77 THE STA \DNSU NUMBER OF SURFACES INB LDA B,I GET WORD 3 OF ENTRY RAL,CLE,ERA SET E IF INIT WANTED STA \DNTR SET THE # OF TRACKS INB LDA B,I AND FINALLY AND M377 PICK UP ONLY 8 BITS STA \DNSP SET THE # OF SPARES RESERVED CLA SET CURRENT SPARE TO ZERO STA CRSP# JMP \SETD,I * SPC 7 HED TYPE 32 I/O DISC DRIVER * THE DISK5 SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * CALLING SEQUENCE * \LNTH = NEGATIVE # WORDS TO TRANSMIT * E = 1 FOR READ * E = 0 FOR WRITE * * * THE \DSK5 ROUTINE INTERCEPTS ALL DISC I.O CALLS FOR TYPE 32 * DISCS. IT HAS FOUR MODES OF OPERATION. * MODE 1 : STANDARD READS/WRITES TO THE DISC * MODE 2 : WRITE (PROTECT) SYSTEM TRACKS & SPARING AS NEEDED * MODE 3 : INITIALIZING TRACKS (WRITE ALL ZEROS-NO WRT PROT) * : ALSO WHEN WRITING 7910 SYS TRKS(NO FRMT SW ON 7910) * MODE 4 : INITIALIZING (&CLEANING UP UNUSED) SPARE TRACKS * * THE SWITCH MAIN PROGRAM CALLS \DISK5 IN MODE4 FOR EACH SUBCHANNEL * BEFORE IT BEGINS ANY WRITING OR INITIALIZING. THIS IS DONE SO * THAT ALL THE SPARES FOR A GIVEN SUBCHANNEL CAN BE CLEANED UP. * IF WE ARE CLEANING UP SPARES ON THE SYSTEM SUBCHANNEL AND SAVING * FILES, THE SPARES WHICH BELONG TO THE FMP FILES (BEING SAVED) WILL * NOT BE CLEANED; THEY WILL BE LEFT INTACT. * * \DSK5 NOP CLA ELA SH©Ã������þúIFT E INTO LSB OF A REG. STA \R/W SAVE E IN \R/W * LDA N10 STA ERCNT INITIALIZE ERROR COUNTER * LDA \LNTH GET NEG. # OF WORDS TO XFER CMA,INA MAKE POS. FOR DRIVER LIBRARY STA LEN * CLA STA \RET CLEAR RETURN STATUS FLAG STA SPD CLEAR INIT WRITE FLAG * LDA \SECT RAR ADJUST OUT 64 WD/SECTR JAZZ STA SEC# SET SECTOR # FOR R/W ROUTINES * LDA \TRAK LOGICAL TRACK ADDRESS ON CURRENT SUBCHANNEL JSB DADTR CONVERT LOGICAL \TRAK TO PHYSICAL DISC ADDR DST SKCYL SET CYL/HEAD FOR SEEK COMMAND DST ARCYL SET CYLINDER/HEAD FOR ADDRESS RECORD COMMAND * LDA A067 PRESET \ACTN FOR RDFS FOR TRACK STATUS STA \ACTN SPC 3 ********************************************************************** * BEGIN INCASE(\MODE): * SPC 1 LDA TBL01 ADA \MODE JMP A,I * TBL01 DEF * JMP MOD01 JMP MOD02 JMP MOD02 JMP MOD04 * SPC 3 * * MODE=1: REGULAR READ OR WRITE * MOD01 LDA P4 STA FLMSK SET FILE MASK - ENABLE SPARING * LDB A017 PRESET ACTION CODE FOR READ LDA \R/W \R/W : READ/WRITE = 1/0 SZA,RSS IS THIS A WRITE? LDB A107 SET FOR REG WRT W/ SEEK STB \ACTN SET ACTION WORD JMP DSGO SPC 3 * * MODE=2,3: WRITING SYSTEM TRACKS OR INITIALIZING TRACKS * MOD02 CLA STA FLMSK SET FILE MASK FOR NO AUTO SEEK TO SPARE LDA A067 SET UP TO READ FULL SEC/W/SEEK STA \ACTN LDA P1 STA PHASE SET PHASE FOR STATUS READ TO SYS/INIT TRACK JMP DSGO SPC 3 * * MODE=4: INITIALIZE SPARES - SPARE CLEANUP MODE * MOD04 CLA STA FLMSK SET FILE MASK FOR NO AUTO SEEK LDA P3 STA PHASE SET PHASE FOR STATUS READ TO SPARE SPC 1 ìó������þú * END INCASE(\MODE): * ********************************************************************** SKP ********************************************************************** ********************************************************************** ** MAIN DRIVER LOOP ** SPC 1 * THE MAIN DRIVER LOOP REPEATEDLY CALLS XFER TO PERFORM DISC * COMMANDS AND THEN EXAMINES STATUS WORD 1 RETURNED BY XFER. * THE APPROPRIATE PROCESSING BLOCK IS BRANCHED TO BY THE INCASE * CONSTRUCT. ALL THE PROCESSING BLOCKS RETURN TO THE COMMON * RETURN POINT: "ENDBR". WE CONTINUE IN THIS LOOP UNTIL ONE OF THE * PROCESSING BLOCKS SETS \RET TO A +1 FOR A SUCCESSFUL COMPLETION * OF A COMMAND SEQUENCE OR -1 FOR AN UNSUCCESSFUL RETURN TO THE * CALLING PROGRAM. SPC 2 DSGO JSB XFER WE'ER LOOPING AGAIN:CALL ACTION ROUTINE * RET W/ A=STAT1 WORD; B=STAT2 SPC 3 * BEGIN INCASE(STAT1): (RETURNED IN A REG BY XFER) * SPC 1 ADA TBL02 GET (ADDRESS OF BRANCH TABLE + STAT1) JMP A,I BRANCH TO THE PROCESSING BLOCK * TBL02 DEF *+1 CODE ERROR PROCESSING JMP ENDOK 00 NO ERROR - GO ENTER NEXT PHASE JMP FAULT 01 ILLEGAL OP - PROGRAM FAULT JMP FAULT 02 UNIT AVAIL. PROGRAM FAULT JMP FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 04 " " " " JMP FAULT 05 " " " " JMP FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP DSKER 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JMP FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JMP FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JMP FAULT 15 UNIMPLEMENTED ERROR CODE - FAULT  J������þú JMP DSKER 16 OVER RUN JUST RETRY JMP DSKER 17 CORRECTABLE ERROR DON'T EVEN TRY JMP ILSPR 20 ILLEGAL SPARE JMP DEFTR 21 DEFECTIVE TRACK JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JMP FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 25 " " " " JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 UNIT UNAVAIL-RETRY 10 TIMES SPC 1 * END INCASE (STAT1); SPC 2 ENDBR LDA \RET CHECK THE DRIVER'S STATUS SZA,RSS LOOP AGAIN IF \RET=0 JMP DSGO * LDA A1000 SET ACTION WORD STA \ACTN TO SEND AN END COMMAND JSB XFER SEND IT. * JMP \DSK5,I RETURN TO MAIN SPC 2 ** END DRIVER MAIN LOOP ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** ENDOK ** SPC 1 * A SUCCESSFUL DISC OPERATION HAS JUST BEEN COMPLETED. ENDOK * DETERMINES WHAT PHASE THE DRIVER JUST FINISHED AND SETS UP * THE NEXT PHASE BY ALTERING "PHASE" AND "\ACTN" FLAGS. SPC 2 ********************************************************************** ** BEGIN INCASE(\MODE): ** ENDOK LDA TBL03 GET ADDRESS OF BRANCH TABLE ADA \MODE JMP A,I BRANCH TO APPROPRIATE BLOCK * TBL03 DEF * JMP EOK1 JMP EOK2 JMP EOK2 JMP EOK4 * SPC 3 * * MODE=1: REGULAR READ OR WRITE WAS SUCCESSFUL-RETURN TO MAIN * EOK1 CLA,INA SET FOR RETURN TO MAIN- SUCCESSFUL R/W STA \RET \RET: ABORT/LOOP AGAIN/OK-RET/NEXT SUBCH = -1/0/1/2 ÷n������þú JMP ENDBR SPC 3 * * MODE=2,3: WRITING SYSTEM TRACKS/INITIALIZING TRACKS MODE * EOK2 LDA TBL04 ADA PHASE JMP A,I * TBL04 DEF * JMP PHA1 STATUS CHECK TO SYSTEM/INIT TRACK DONE&OK JMP PHA2 WRITE INITIALIZE TO SYS/INIT TRACK DONE&OK JMP PHA3 STATUS CHECK TO POTENTIAL SPARE DONE&OK JMP PHA4 WRITE INITIALIZE TO SPARE DONE&OK JMP PHA5 WRITE INIT ON BAD TRACK-FOR FIXUP DONE&OK **** JMP PHA6 NOT IMPLEMENTED. PHASE=6 IS ILLEGAL * SPC 3 * * PHASE=1: FINISHED STATUS READ. OK-SO NOW DO WRITE INIT TO TRACK * PHA1 LDB S010 PRESET FLAG BITS FOR MODE 2-WRT PROTECT LDA \MODE IN MODE2 OR MODE3?? CPA P3 CLB MODE3- SO DON'T WRITE PROTECT. STB SPD SAVE IN FLAG WORD - FOR WRITE INITIALIZE * ISZ PHASE ADVANCE TO PHASE2- WRITE INITIALIZE. LDA A207 SET FOR WRITE INIT,& SEEK STA \ACTN JMP ENDBR SPC 3 * * PHASE=2:JUST DID WRITE INIT.-NOW VERIFY THE TRACK * PHA2 LDA A407 SEEK,VERIFY,CHECK STATUS STA \ACTN JSB XFER GO VERIFY & RETURN WT STATUS SZA ANY TYPE OF ERROR IS BAD NEWS. JMP VFAIL VERIFY FAILED- GET FIRST SPARE * CLA,INA STA \RET SUCCESSFUL VERIFY-SIGNAL MAIN & RETURN STATUS JMP ENDBR * VFAIL DLD CYL# VERIFY FAILED- SAVE BAD TRK DST BDCYL FOR LATER. CLE JSB RPORT REPORT:"BAD TRACK... " JSB NIXSP GET NEXT POTENTIAL SPARE JMP ENDBR ERROR RETURN FOR NIXSP-IE. OUT OF SPARES!! DST SKCYL SET SEEK ADDRESS TO SPARE DST ARCYL SET ADDR RECORD CLA STA FLMSK FILE MASK - NO AUTO SEEK TO SPARE * ISZ PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE LDA A067 SET FOR RDFS FOR TRK STATUS STA \ACTN JMP ENDBR SPC 3 * * PHASE=3: STATUS WRT TO POTENTIAL S6¬������þúPARE WAS OK - NOW DO A WRT * INITIALIZE TO SPARE & POINT IT TO THE BAD TRACK * PHA3 DLD BDCYL GET DEFECTIVE TRACK ADDRESS & SET IT DST ARCYL IN SPARE WITH AN ADDRESS RECORD COMMAND CLB STB FLMSK NO AUTO SEEK * LDB S110 PRESET SPD BITS FOR MODE2: WRITE PROTECT LDA \MODE CPA P3 MODE2 OR MODE3?? LDB S100 MODE3: SET SPARE , NO PROTECT STB SPD SET IT. * ISZ PHASE SET PHASE4: WRITE INITIALIZE A SPARE. LDA A207 SET ACTION WORD: SEEK&WRT INIT STA \ACTN JMP ENDBR SPC 3 * * PHASE=4: WRITE INITIALIZE TO SPARE WAS SUCCESSFUL - NOW FIXUP * ORIGINAL BAD TRACK WITH SPARE'S ADDRESS. * PHA4 DLD BDCYL GET ADDRESS OF ORIGINAL BAD TRACK & SET DST SKCYL UP TO SEEK TO IT. DLD CYL# GET ADDR OF THE CHOSEN SPARE AND DST ARCYL SET IT IN THE BAD TRACK W/ AN ADDRESS REC'D COMMAND. * CLB STB FLMSK DISABLE SPARING FEATURE * LDB S011 PRESET SPD BITS FOR MODE2: WRITE PROTECT,DEFECTIVE LDA \MODE CPA P3 MODE2 OR MODE3?? LDB S001 MODE3: DEFECTIVE, NO PROTECT STB SPD SET IT. * ISZ PHASE ADVANCE TO PHASE5: WRT INIT FOR FIXUP TO DEF. TRACK LDA A207 SET ACTION WORD TO WRITE INIT.,W/ SEEK STA \ACTN JMP ENDBR SPC 3 * * PHASE5: WRITE INIT FOR FIXUP DONE-NOW VERIFY THE BAD TRACK * THAT WAS SPARED. WE'RE GOING TO DO A SEEK TO THE BAD * TRACK WITH SPARING ENABLED, AND VERIFY IT. * PHA5 DLD BDCYL GET ADDR OF THE ORIGINAL BAD TRACK DST ARCYL AND SET UP TO SEEK TO IT. LDA P4 STA FLMSK ENABLE SPARING-SO WE'LL RESEEK TO THE SPARE TRACK. * LDA A407 SEEK,SPARING ENABLED,VERIFY & RETURN STATUS STA \ACTN JSB XFER GO VERIFY THIS BAD TRACK,SEEKING TO ITS SPARE SZA JMP FA‚ò������þúILV ANY ERROR IS BAD NEWS. * DLD CYL# GET ADDR OF SPARED USED CCE SIGNAL RPORT TO SEND "SPARED TO... JSB RPORT SEND "SPARED TO XXXX YYYY .... * CLA,INA STA \RET SIGNAL MAIN THAT WE'RE DONE & RETURN OK STATUS. JMP ENDBR * FAILV JSB NIXSP BAD NEWS- GET NEXT POTENTIAL SPARE & WRT FOR STATUS. JMP ENDBR ERROR RETURN FOR NIXSP- IE. OUT OF SPARES! DST SKCYL SET UP TO SEEK TO NEXT SPARE  DST ARCYL AND CHECK ITS STATUS. * CLB STB FLMSK DISABLE AUTO-SEEK TO SPARE * LDA P3 STA PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE. LDA A067 SET FOR RDFS FOR STATUS &SEEK STA \ACTN JMP ENDBR * * MODE=4: SPARE CLEANUP/INITIALIZATION MODE. * EOK4 LDA PHASE CPA P3 ARE WE IN PHASE3? - (STATUS READ TO SPARE)? RSS YES - STATUS WRT WAS OK - NOW DO WRT INIT TO SPARE. JMP PHB4 NOT IN PHASE3 - GO CHECK IF IN 4. * PHB3 CLB GET READY TO DO A WRITE INIT TO THE SPARE. STB FLMSK DISABLE AUTO-SEEK TO SPARE. * ISZ PHASE ADVANCE TO PHASE4- WRITE INITIALIZE TO SPARE. LDA A207 SET ACTION WORD TO SEEK & WRITE INIT STA \ACTN JMP ENDBR * PHB4 CPA P4 ARE WE IN PHASE4?- (WRT INIT TO SPARE)? RSS YES - WRT INIT WENT OK- NOW VERIFY THE SPARE. JMP PHB6 NOT IN PHASE4 - GO CHECK IF IN 6. * LDA A407 SEEK,FILE MASK,VERIFY & RET STATUS STA \ACTN SET ACTION WORD FOR XFER JSB XFER GO VERIFY THE SPARE SZA IF STATUS=0, WE'RE OK. JMP FAIL ANY ERROR IS BAD NEWS. * CLA,INA VERIFY WENT OK - SIGNAL SUCCESS & RETURN TO MAIN. STA \RET JMP ENDBR * FAIL LDA A207 SET ACTION FOR INIT AGAIN STA \ACTN * CLA,INA SET SPD BITS FOR FLAGGIN A DEFECTIVE SPARE. STA SPD SET 'EM. ri������þú ISZ PHASE ADVANCE TO PHASE6: FLAG THAT DEFECTIVE SPARE. ISZ PHASE JMP ENDBR GO AROUND DRIVER LOOP AGAIN-SAME OLD PHASE4:INIT SPARE * * * MUST BE IN PHASE 6: REPORT BAD SPARE & RETURN TO MAIN PHB6 DLD SKCYL GET SET TO REPORT BAD SPARE CLE SIGNAL RPORT TO SEND: JSB RPORT "BAD TRACK ..... " * CLA,INA WE'RE ALL DONE-SPARE HAS BEEN FLAGGED DEFECTIVE. STA \RET SIGNAL THE MAIN & RETURN. JMP ENDBR SPC 1 ** END ENDOK BLOCK ** ********************************************************************** ********************************************************************** SPC 4 ********************************************************************** ********************************************************************** ** FAULT ** SPC 1 * ENTRY CONDITIONS: * STATUS ERRORS 1,2,12,27 * UNIMPLEMENTED STATUS ERRORS 3,4,5,6,13,15,24,25 * FAULT JSB DCYLR OUTPUT:"DEFECTIVE CYLINDER - TRACK XXXX YY" CCA SET RETURN STATUS FLAG TO ABORT STA \RET JMP ENDBR SPC 1 ** END FAULT BLOCK ** ********************************************************************** ********************************************************************** SPC 4 ********************************************************************** ********************************************************************** ** RECAL ** SPC 1 * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL ISZ ERCNT UP THE ERROR COUNT: FATAL YET?? JMP AGAIN NO: SEND RECALIBRATE COMMAND AND TRY AGAIN * JSB PARER YES: OUTPUT:"PARITY/DATA ERROR.." CCA STA \RET SET RETURN SÜ������þúTATUS FOR ABORT JMP ENDBR * * KLUDGE FOR 7910 DISCS * AGAIN LDA \D#ST GET SEC/TRK CPA P64 JMP SEEK0 * JSB XRCAL SEND A RECAL COMMAND DIRECTLY TO DRIVER LIBRARY. DEF *+4 DEF \TDLU+0 DEF \TUNT+0 DEF IER JMP RCOUT * SEEK0 JSB XSEEK SIMULATE A RECALIBRATE FOR 7910 DEF *+9 DEF \TDLU+0 DEF \TUNT+0 DEF P0 CYLINDER DEF P0 HEAD DEF P0 SECTOR DEF STAT1 DEF STAT2 DEF IER * * RCOUT LDA \ACTN GET \ACTN WORD FOR FIXUP IOR P1 SET \ACTN(1) -FORCE A SEEK ! JMP ENDBR GO TRY AGAIN-SAME PHASE,SAME COMMAND,W/ SEEK SPC 1 ** END RECAL BLOCK ** ********************************************************************** ********************************************************************** SPC 4 ********************************************************************** ********************************************************************** ** EOCYL ** SPC 1 * * EOCYL ENTRY CONDITIONS: * STATUS ERRORS 11 AND 14 * EOCYL JSB SPECR SEND ERR MSG:"INVALID DISC SPECIFICATIONS XX" CCA STA \RET RETURN ABORT STATUS TO MAIN JMP ENDBR SPC 1 ** END EOCYL BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** DSKER/DEFTR ** SPC 1 * DSKER ENTRY CONDITIONS: * STATUS 10,16,17 ERRORS * INVALID STATUS 2 ERROR * * DEFTR ENTRY CONDITIONS: ¥0������þú * STATUS 21 ERROR * DSKER ISZ ERCNT STEP THE ERROR COUNTER: FATAL # ERRORS YET?? JMP ENDBR NO: GO TRY THE SAME THING AGAIN * * YES: CHECK WHICH MODE WE'RE IN AND DO SOMETHING * SPC 1 ********************************************************************** * BEGIN INCASE(\MODE): DEFTR * SPC 1 DEFTR LDA TBL05 ADA \MODE JMP A,I * TBL05 DEF * JMP DSK01 JMP DSK02 JMP DSK02 JMP DSK04 * SPC 1 * * MODE=1: REGULAR R/W DRIVER MODE-PARITY ERROR IS FATAL,SO ABORT * DSK01 JSB PARER OUTPUT:"PARITY/DATA ERROR.. " CCA STA \RET RETURN ABORT STATUS TO MAIN JMP ENDBR SPC 1 * * MODE=2,3: WRITE INIT TRACK/WRITE SYSTEM TRACK MODE: * SET UP FOR STATUS READ TO NEXT SPARE. * DSK02 LDA PHASE CHECK TO SEE WHICH PHASE WE'RE IN ADA N3 SEPARATE PHASE 1,2 FROM PHASE 3,4,5,6 SSA,RSS FOR PHASE 1,2: SAVE PHYSICAL ADDR OF BAD TRACK JMP GTSPR FOR PHASE 3,4,5,6 WE'VE ALREADY SAVED BAD TRACK * DLD CYL# SAVE ADDRESS OF BAD TRACK DST BDCYL CLE SIGNAL RPORT TO REPORT "BAD TRACK... JSB RPORT GO REPORT BAD TRACK-ALSO PRINT HEADER IF FIRST TIME * GTSPR JSB NIXSP GET THE NEXT POTENTIAL SPARE FOR THIS SUBCHANNEL JMP ENDBR ERROR RETURN FOR NIXSP - IE. OUT OF SPARES! DST SKCYL SEEK TO THE SPARE-WE'RE GOING FOR ITS STATUS DST ARCYL SET UP ADDRESS RECORD * CLB STB FLMSK TURN OFF AUTO-SEEK TO SPARE * LDA P3 STA PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE LDA A067 SET THE ACTION WORD FOR STA \ACTN READ FULL SECTOR & SEEK FOR SPARE JMP ENDBR SPC 1 * * MODE=4: SPARE INITIALIZATION/CLEANUP MODE. * DSK04 LDA PHASE WHICH PHASE ARE WE IN?? CPA P6 DID WE JUST GET DONE FLq���H��FBLAGGIN IT DEFECTIVE?? JMP DSKRT YES: RETURN "OK" STATUS TO MAIN & CLEAN UP NEXT SPARE * ALSO REPORT BAD TRACK * CLA,INA NO: LET'S GO INIT THE SPARE & FLAG IT DEFECTIVE STA SPD SET DEFECTIVE BIT(0) LDA P6 STA PHASE SET PHASE6: WRITE INIT. A SPARE-FLAG DEFECTIVE * LDA A207 SET FOR SEEK & WRITE INIT STA \ACTN JMP ENDBR ALL SET?? OK-AROUND WE GO AGAIN. * DSKRT DLD ARCYL GET CYL/HEAD OF THIS BAD SPARE CLE SIGNAL RPORT TO SEND "BAD TRACK... JSB RPORT GO REPORT SPARE AS BAD TRACK CLA,INA STA \RET RETURN TO MAIN WITH OK STATUS- WE'RE DONE W/ THIS ONE JMP ENDBR SPC 1 * END INCASE(\MODE); * ********************************************************************** SPC 1 ** END DSKER/DEFTR BLOCK ** ********************************************************************** ********************************************************************** ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‘%H������ÿÿ��������þú SKP ********************************************************************** ********************************************************************** ** ILSPR ** SPC 1 * ILLEGAL SPARE (STATUS 20 ERROR) * APPARENTLY DID A SEEK TO A TRACK W/ ITS SPARE BIT SET * SPC 1 ********************************************************************** * BEGIN INCASE(\MODE): * SPC 1 ILSPR LDA TBL06 ADA \MODE JMP A,I * TBL06 DEF * JMP ILS01 MODE1: REG R/W MODE - ABORT 'EM JMP ILS02 MODE2,3: WRITING SYS TRACKS OR INIT TRACKS- JMP ILS02 CHECK WHICH PHASE WE'RE IN. JMP ILS04 MODE4: SPARE INITIALIZE/CLEANUP MODE. * * MODE=1: REGULAR R/W-SHOULDN'T HAVE SEEKED TO A SPARE-ABORT * ILS01 JSB DCYLR SEND "DEFECTIVE CYLINDER-TRACK XXXX" CCA STA \RET RETURN ABORT STATUS TO MAIN JMP ENDBR SPC 1 * * MODE=2,3: * ILS02 LDA PHASE WHICH PHASE ARE WE IN?? CPA P3 PHASE3&1 ARE THE ONLY LEGAL PHASES FOR THIS MODE JMP ILPH3 PHASE3: WE WERE CHECKING THE STATUS OF A SPARE. * * PHASE=1: WE JUST DID A STATUS READ TO SYS/INIT TRACK & FOUND ITS SPARE * BIT SET-RECLAIM IT AND USE IT. * ILPH1 CLB PRESET SPD BITS FOR MODE3-(NO PROTECT FOR INIT TRKS) LDA \MODE MODE2 OR MODE3?? CPA P2 LDB S010 IF MODE2: SET PROTECT BIT FOR SYSTEM TRACK WRITE STB SPD SET IT. * ISZ PHASE SET PHASE2: WRITE INITIALIZE THE TRACK LDA A207 SET ACTION WORD SEEK & WRITE INIT STA \ACTN JMP ENDBR AROUND WE GO AGAIN..RECLAIM THIS OLD SPARE FOR DATA. * * PHASE=3: WE JUST DID A STATUS READ TO A POTENTIAL SPARE. ITS SPARE * BIT WAS SET-INDICATING IT IS ALREADY IN USE. GO GET THE * NEXT POTENTIAL SPARE & CHECK ITS STATUS. * ILPH3 JSB NIXSP ñ������þú GET NEXT SPARE JMP ENDBR ERROR RETURN FOR NIXSP - IE. OUT OF SPARES! DST SKCYL DST ARCYL SET UP SEEK AND ADDR REC'D COMMANDS W/ ADDR JMP ENDBR SAME PHASE & \ACTN AS LAST TIME-STATUS WRT TO SPARE SPC 1 * * MODE=4: SPARE INIT/CLEANUP MODE * WE JUST DID A STATUS READ TO SPARE AREA, AND FOUND THE TRACK * ALREADY IN USE AS A SPARE. DO WE WANT TO PRESERVE IT, OR CLEAN * IT? WE'LL CLEAN IT UNLESS IT'S ON THE SYSTEM SUBCHANNEL, * FMGR OWNS IT, AND WE'RE SAVING FILES. * ILS04 LDA \SAVE IF(NOT SAVING FILES.OR.NON-SYS SUBCH) SLA,RSS JMP REUSE THEN REUSE SPARE LDA \LU2 SZA,RSS JMP REUSE THEN REUSE SPARE * LDA A025 ELSE CHECK IF FMGR OWNS SPARE. STA \ACTN GO READ FULL SECTOR-SEE WHO'S USING THIS SPARE. * JSB XFER READ ONLY 3 WORDS INTO DPBUF SZA,RSS ANY ERROR IS BAD NEWS. JMP XOK NO ERROR. * CCB STB \RET JMP ENDBR GO ABORT * XOK JSB FMTR? SEE IF FMGR OWNS SPARE-RET FMSP? IN REG. A SZA DOES FMGR OWN IT?? JMP NOUSE YES: DON'T INITIALIZE IT * REUSE CLA STA SPD CLEAN SPD BITS * ISZ PHASE STEP INTO PHASE4- WRITE INITIALIZE SPARE LDA A207 STA \ACTN SET ACTION WORD FOR INIT JMP ENDBR GO AROUND AGAIN * NOUSE CLB,INB STB \RET SET RETURN STATUS OK. JMP ENDBR SPC 1 * END INCASE(\MODE); * ********************************************************************** SPC 1 ** END ILSPR BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ****************************************v•������þú****************************** ** ST2ER ** SPC 1 * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NOT READY SEND MESSAGE TO READY DISC * FORMAT SW OFF SEND MESSAGE TO TURN ON FORMAT SW * PROTECTED SEND MESSAGE TO TURN OFF PROTECT * NONE OF ABOVE GO TO DSKER & PROCESS AS DATA ERROR * * INPUTS: * A=STAT1 * B=STAT2 * ST2ER SSB,RSS JMP NST2 * * ASSUME NOT READY OR SEEK CHECK ERROR * LDA B AND P4 IS SEEK CHECK BIT SET?? SZA JMP SPECS YES- * NRERR JSB NRDER NO- MUST BE A NOT READY ERROR JMP RETRY GIVE 'EM ANOTHER CHANCE * SPECS JSB SPECR SEND INVALID DISC SPECIFICATIONS ERROR CCB STB \RET RETURN ABORT STATUS- SEEK CHECK ERROR JMP ENDBR * * * CHECK IF FORMAT SW OR PROTECT SW ERR * NST2 LDA \R/W SZA JMP DSKER READ- SO CHAULK IT UP AS ANY OTHER ERROR * LDA B GET STAT2 WORD AGAIN AND M40 FORMAT BIT SET?? SZA,RSS JMP FRMSW NO - GO TELL 'EM TO TURN IT ON * LDA B GET STAT2 AND M100 SZA,RSS PROTECT BIT SET?? JMP DSKER NO- UNKNOWN STATUS 2 ERR- TREAT AS ANY OTHER ERROR * JSB PROTR YES- TELL 'EM TO TURN OFF PROTECT SW JMP RETRY START FRESH & TRY THAT COMMAND AGAIN * FRMSW JSB FRMER GO TELL THEM TO TURN ON FORMAT SWITCH * RETRY LDA N10 STA ERCNT GIVE THEM 10 MORE TRIES TO DO THE OPERATION JMP ENDBR SPC 1 ** END ST2ER BLOCK ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** Ü������þú UWAIT ** SPC 1 * * UWAIT BRANCHED TO ON STATUS 27 ERROR * * IF UNIT/ADDR >7, OR RETRY 10 TIMES, THEN CALL * SPECR TO ISSUE: "INVALID DISC SPECIFICATONS XX" * UWAIT LDA \TUNT CMA,INA ADA P7 SSA JMP USPEC THEN ISSUE ERROR ISZ ERCNT ELSE BUMP ERROR COUNTER JMP ENDBR AND TRY AGAIN * USPEC JSB SPECR CCA STA \RET JMP ENDBR * SPC 1 ** END UWAIT ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** END OF BRANCH TABLE BLOCKS. ** ** ** ********************************************************************** ********************************************************************** SPC 6 ********************************************************************** ********************************************************************** ** ** * BEGIN TYPE 32 DRIVER SUBROUTINES ** ** ********************************************************************** ********************************************************************** SPC 4 ********************************************************************** * XFER ROUTINE * SPC 1 * * XFER PROVIDES THE INTERFACE BETWEEN THE SWITCH DRIVER AND THE * DRIVER LIBRARY ROUTINES. IT TAKES THE FLAG WORD "\ACTN" AS * INPUT, AND CALLS THE APPROPRIATE LIBRARY ROUTINES IF THEIR n������þú* CORRESPONDING BIT IN \ACTN IS SET. * * * BIT MEANING * * 0 - SEEK - CALL XSEEK * 1 - ADDRESS RECORD - CALL XADRC * 2 - FILE MASK - CALL XFMSK * 3 - REGULAR READ - CALL XDRED * 4 - READ FULL SECTOR - CALL XRDFS * 5 - STATUS WORD FIXUP - CALL STFIX(GETS SPD BITS AFTER XRDFS) * 6 - REGULAR WRITE - CALL XDWRT * 7 - WRITE INITIALIZE - CALL XINIT * 8 - VERIFY - CALL XVRFY * 9 - SEND END COMMAND - CALL XEND * 10 - * 11 - * 12 - * 13 - * 14 - * 15 - * * XFER NOP * XFOVR LDA \ACTN STA TEMP1 SAVE \ACTN WORD * JSB REQST GET STATUS BEFORE ANYTHING JSB CKST1 CHECK IT JMP XFOVR PWR FAIL JMP XEXIT ERROR CASE * JSB SKIP? SKIP IF ACTN BIT0=1 JMP ADRC? TRY NEXT BIT * SEEK? JSB XSEEK DEF *+9 DEF \TDLU+0 DEF \TUNT+0 DEF SKCYL DEF SKHD DEF SEC# DEF STAT1 DEF STAT2 DEF IER * *** PATCH FOR 7910H LDA \D#ST SEC/TRK CPA P64 IS THIS A 7910H? ISZ SK10H YEP-SET TO IGNORE SEEK ERRORS * JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPERATION JMP XEXIT ERROR RETURN * ADRC? JSB SKIP? SKIP IF TEMP1(0)=1-ALSO ROTATE JMP FMSK? TRY NEXT BIT * JSB XADRC SEND ADDRESS RECORD COMMAND DEF *+7 DEF \TDLU+0 DEF \TUNT+0 DEF ARCYL DEF ARHD DEF SEC# DEF IER * FMSK? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP READ? TRY NEXT BIT * *** PATCH FOR 7910 DISC LDA \D#ST GET #SECTORS/TRACK CPA P64 IS THIS A 7910 DISC- JMP READ? YES-DON'T SEND FILEMASK-ILLEGAL CMD. * JSB XFMSK SEND FILE MASK COMMAND DEF *+5 DEF \TDLU+0 DEF \TUNT+0 DEF FLMSK DEF IER * REn������þúAD? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP RDFS? GO TRY NEXT BIT * JSB XDRED SEND REGULAR READ COMMAND DEF *+8 DEF \TDLU+0 DEF \TUNT+0 DEF \BUFI,I BUFFER ADDRESS DEF LEN POS. # OF WORDS/TRACK DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPERATION JMP XEXIT ERROR RETURN * RDFS? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP RDFS! TRY NEXT BIT * JSB XRDFS SEND READ FULL SECTOR COMMAND DEF *+8 DEF \TDLU+0 DEF \TUNT+0 DEF DPBUF DEF P3 DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPERATION JMP XEXIT ERROR RETURN * RDFS! JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP WRIT? TRY NEXT BIT * JSB STFIX FIX UP ST1 WORD TO REFLECT SPD BITS JMP XEXIT ERROR-EITHER S OR D WAS SET * WRIT? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP INIT? TRY NEXT BIT * JSB XDWRT SEND REGULAR WRITE COMMAND DEF *+8 DEF \TDLU+0 DEF \TUNT+0 DEF \BUFI,I DEF LEN DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPERATION JMP XEXIT ERROR RETURN * INIT? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP VRFY? * JSB XINIT DEF *+9 DEF \TDLU+0 DEF \TUNT+0 DEF \BUFI,I DEF LEN DEF SPD DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPERATION JMP XEXIT ERROR RETURN * VRFY? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP ENDX? * JSB XVRFY SEND A VERIFY COMMAND DEF *+7 DEF \TDLU+0 DEF \TUNT+0 DEF S#CTR DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL-RESTART OPE¢������þúRATION JMP XEXIT ERROR RETURN * ENDX? JSB SKIP? SKIP IF TEMP1(0)=1&ROTATE JMP XEXIT * JSB XEND SEND END COMMAND DEF *+3 DEF \TDLU+0 DEF \TUNT+0 * XEXIT LDA ST1 GET 5 BIT FIELD FROM STAT1 WORD LDB STAT2 GET STAT2 WORD IN B FOR THE RETURN JMP XFER,I RETURN TO DRIVER W/ STATUS IN A&B * SPC 1 * END XFER ROUTINE * ********************************************************************** SPC 2 ********************************************************************** * SKIP? ROUTINE-TEST & ROTATES TEMP1 * SPC 1 * RETURN: (P+1) - IF BIT0 TEMP1=0 * (P+2) - IF BIT0 TEMP1=1 * ALSO ROTATES TEMP1 RIGHT BEFORE RETURNING * SKIP? NOP LDA TEMP1 SLA,RAR ISZ SKIP? INCREMENT RETURN ADDRESS STA TEMP1 JMP SKIP?,I RETURN SPC 1 * * ********************************************************************** SPC 4 ********************************************************************** * CKST1 ROUTINE * SPC 1 * CKST1: 1) CHECKS IER TO SEE IF PWR. FAIL,DSJ^=0,OR TIME OUT IN LAST * DRIVER LIBRARY REQUEST. * -IF TIMEOUT(IERR=4),OR POWER FAIL, SEND NOT READY ERROR, * DO STATUS TO CLR DSJ&RETURN TO (P+1). * 2) SIFTS OUT THE 5 BIT S1 FIELD FROM STAT1 * 3) IF S1=37 (ATTENTION), REQUEST STATUS AGAIN UNTIL S1^=37. * * RETURN: (P+1): POWER FAIL/TIMEOUT RETURN-RESTART OPERATION * (P+2): ABNORMAL STATUS RETURN- ST1^=0 * (P+3): NORMAL RETURN- ST1=0 * CKST1 NOP STOVR LDA IER CPA P4 IS IT A TIMEOUT?? JMP PFAIL YEP. * CPA P2 IS IT A POWER FAIL?? JMP PFAIL YEP. * 9¥������þú LDA STAT1 ALF,ALF AND M37 MASK S1 OFF STAT1 WORD CPA M37 ATTENTION?? RSS YES-ASK FOR STATUS AGAIN JMP RTNST NO-RETURN THE CURRENT STATUS * JSB REQST REQUEST STATUS JMP STOVR EXAMINE STATUS AGAIN * PFAIL JSB NRDER SEND "READY DISC ..ENTER " "RET" JSB REQST CLEAR DSJ WITH A REQ. STATUS COMMAND JMP CKST1,I TAKE POWER FAIL RETURN-START FRESH * RTNST LDB SK10H IS THIS A 7910H SEEK OPERATION?? ISZ CKST1 INCR RETURN ADDRESS SZB,RSS JMP NOT10 RETURN STANDARD STATUS * CLA LDB STAT2 CHECK STATUS 2 BEFORE IGNORING SSB LDA M23 FAKE A STATUS 2 ERR IN ST1 CLB STB SK10H RESET THE KLUDGE FLAG * NOT10 STA ST1 RETURN THE STATUS IN ST1 SZA,RSS ISZ CKST1 SET (P+3) RETURN- NORMAL JMP CKST1,I SPC 1 * END CKST1 * ********************************************************************** SPC 3 ********************************************************************** * STFIX ROUTINE * * * STFIX -IS CALLED AFTER A READ FULL SECTOR IN ORDER TO * DETERMINE IF THE S OR D BIT IS SET ON THE CURRENT TRACK. * THIS USED TO BE DETERMINED BY DOING A FAKE WRITE FOR STATUS * IN RTEIVA SWTCH.SOME DISCS DO NOT SUPPORT FILE MASK,SO A * READ FULL SECTOR & JSB STFIX REPLACES THE OLD FAKE WRITE. * STFIX NOP CLB LDA HDSSP GET THE SPD/HEAD/SECTOR WORD RAL,SLA,RAL FROM THE PREAMBLE RETURNED BY XRDFS LDB ST20 FAKE A STATUS 20-ILLEGAL ACCESS TO SPARE RAL,SLA NOW TEST D BIT LDB ST21 FAKE A STATUS 21-DEFECTIVE TRACK STB ST1 SAVE IT AWAY AS JSB CKST1 WOULD DO * SZB,RSS ISZ STFIX INCR RETURN ADDR IF NO S OR D ERROR 'ÿ������þú JMP STFIX,I RETURN SPC 1 * * ********************************************************************** SPC 4 ********************************************************************** * REQST ROUTINE * SPC 1 * REQST CALLS THE DRIVER LIBRARY TO GET THE STATUS OF THE DISC DRIVE * REQST NOP JSB XSTAT DEF *+6 DEF \TDLU+0 DEF \TUNT+0 DEF STAT1 DEF STAT2 DEF IER JMP REQST,I SPC 1 * END REQST * ********************************************************************** SPC 4 ********************************************************************** * NIXSP ROUTINE * SPC 1 * * NIXSP FINDS THE NEXT POTENTIAL SPARE ON THE CURRENT SUBCHANNEL * AND CONVERTS ITS LOGICAL ADDRESS TO PHYSICAL AND STORES * IT IN CYL#,HEAD#, AND UNIT#. * * CALLING SEQUENCE: * * * JSB NIXSP * A = IGNORED * B = IGNORED * * RETURN: * (P+1): ERROR RETURN - IE. OUT OF SPARES! * (P+2): NORMAL RETURN - NEXT POTENTIAL SPARE ADDR IN A&B * A = CYL# OF NEXT POTENTIAL SPARE * A = -1 IF OUT OF SPARES * B = HEAD# OF NEXT POTENTIAL SPARE * * NIXSP NOP LDA \DNSP GET NUMBER OF SPARES FOR THIS SUBCHANNEL CPA CRSP# ARE THERE NO MORE SPARES?? JMP NMORE NOPE- THEY'RE ALL GONE- SEND BAD SPEC MESSAGE. * LDA \DNTR GET LAST TRACK ON THIS SUBCHANNEL ADA CRSP# COMPUTE LOGICAL ADDRESS OF NEXT POTENTIAL SPARE * JSB DADTR GO SET UP PHYSICAL ADDRESS OF NEXT SPARE:CYL,HEAD,UNIT ISZ CRSP# ADVANCE CURRENT SPARE COUNTER ISZ NIXSP SET NORMAL RETURN ADDRESS : (P+2) JMP NIXSP,I RETURN WITH SUCCESSFUL STATU������þúS * NMORE JSB \BLIN JSB NOSPR SEND "OUT OF SPARES XX" CCA SEND ERROR FLAG TO CALLING ROUTINE. STA \RET SET ABORT FLAG SO MAIN KNOWS WHATS HAPPENING JMP NIXSP,I ERROR RETURN SPC 1 * END NIXSP * ********************************************************************** SPC 5 ********************************************************************** * FMTR? * * * FMTR? CHECKS OUT A TRACK THAT HAS ITS SPARE BIT SET TO SEE IF * FMGR IS USING IT AS A SPARE. IT READS THE PREAMBLE OF THE SPARE * TO PICK UP THE ADDRESS OF THE DEFECTIVE TRACK THAT IS USING IT. * * CALLING SEQUENCE: * JSB FMTR? * * RETURN: * (P+1) * A = 0: FMGR IS NOT USING SPARE * A = 1: FMGR IS USING SPARE * B = DESTROYED * FMTR? NOP LDB \SAVE LDA \FFMP GET FIRST LOGICAL FMP TRACK SSB IF SOME WERE OVERLAID LDA \STRK THEN GET NEXT TRACK AFTER SYSTEM JSB DADTR CONVERT FIRST FMP TRACK TO CYL & HEAD * * CHECK IF DEFECTIVE TRACK LIES WITHIN CURRENT SUBCHANNEL DEFINITION * LDA N9 CLEAR SURFACE BUFFER STA TEMP1 SET LOOP COUNTER CLA LDB DSBUF GET BUFFER ADDRESS STA B,I INB ISZ TEMP1 DONE? JMP *-3 NO * LDA \DNSU GET # SURFACE OCCUPIED BY SYSTEM CMA,INA SUBCHANNEL, AND SET AS A STA TEMP1 LOOP COUNTER CLB,INB GET 'OCCUPIED' INDICATOR LDA \DSHD GET STARTING HEAD # ADA DSBUF AND OFFSET INTO BUFFER SETDS CPA ESBUF END-OF-BUFFER? JMP CHEKK (ERRONEOUS DEF'N) STB A,I MARK SURFACE AS ONE OCCUPIED BY SYS SUBCH INA BUMP BUFFER ADDRESS ISZ TEMP1 DONE? JMP SETDS NO * CHEKK LDA HDSSP GET HEAD # OF DEFECTy������þúIVE TRACK ADDR FROM PREAMBLE ADA DSBUF AND GET CORRESPONDING ENTRY IN TABLE LDB A,I SZB,RSS POSSIBLY WITHIN THE SYS SUBCH? JMP USESP NO, SO SPARE CAN BE RESUED * * COMPARE WITH FIRST FMP CYLINDER * LDB CYL# GET STARTING CYLINDER OF FMP CMB,INB AND COMPARE WITH DEF TRACK'S CYLINDER ADB CYLSP SSB JMP USESP CYL# > CYLSP: 1ST FMP TRK > DEF TRK USING SPARE SZB JMP CLAST CYL# < CYLSP: 1ST FMP TRK < DEF. TRACK USING SPARE * * SEE IF DEFECTIVE HEAD PRECEEDS STARTING HEAD OF FMP * LDA HEAD# GET FIRST FMP HEAD# SZA,RSS IF ZERO THEN JMP FOWNS NO HEAD PRECEEDS IT - FMGR HAS DIBBS ON THIS ONE CMA,INA ADA HDSSP GET DEFECTIVE HEAD# AND COMPARE WITH THAT SSA,RSS OF THE FIRST FMP - LESS? JMP FOWNS NO, THIS SPARING MUST BE PRESERVED JMP USESP GO AHEAD AND USE THIS SPARE * * SEE IF DEFECTIVE TRACK'S CYLINDER IS > LAST FMP CYLINDER * CLAST CCA CONVERT LAST TRACK ON SUBCHANNEL ADA \DNTR TO PHYSICAL CYLINDER AND HEAD JSB DADTR ADDRESSES LDB CYLSP GET DEFECTIVE TRACK CYL CMB,INB AND COMPARE WITH LAST FMP CYL ADB CYL# JUST COMPUTED SSB GREATER? JMP USESP YES, REUSE THAT SPARE SZB LESS? JMP FOWNS YES- FMGR OWNS THIS ONE * * SEE IF DEFECTIVE HEAD# IS > LAST FMP CYL HEAD# * LDA HEAD# GET LAST FMP HEAD LDB HDSSP COMPARE WITH HEAD# OF DEFECTIVE TRACK CMB,INB ADA B SSA,RSS JMP FOWNS FMGR OWNS IT.TRACK * * USESP CLA SIGNAL: OK TO RECLAIM THIS SPARE! JMP FMTR?,I RETURN * FOWNS CLA,INA JMP FMTR?,I SIGNAL: FMGR OWNS THIS SPARE-LEAVE IT ALONE! SPC 1 * END FMTR? * **********************************************ý���H����F�B************************ ����������������������������������������DH�������ÿÿ��������þú SKP ********************************************************************** * DADTR * SPC 1 * DADTR ROUTINE TO TRANSLATE A LOGICAL TRACK ADDRESS INTO * PHYSICAL CYL,HEAD,UNIT/ADDR ON THE DISC. * * CYL AT: CYL# * HEAD AT: HEAD# * UNIT AT: UNIT# * * CALLING SEQUENCE: * * LDA TRACK SET LOGICAL TRACK ADDRESS IN A. * JSB DADTR CALL * * RETURN: * * (P+1) * A = CYL# * B = HEAD# * * DADTR NOP CLB DIVIDE # TRACKS BY DIV \DNSU NUMBER OF HEADS/CYL ADA \DFTR ADD BASE CYLINDER ADDRESS STA CYL# SET THE CYLINDER ADDRESS * ADB \DSHD ADD THE BASE HEAD ADDRESS STB HEAD# STORE IT AS PROMISED * JMP DADTR,I RETURN A= UNIT, B=HEAD * CYL# NOP HEAD# NOP * SPC 1 * * ********************************************************************** SPC 3 ********************************************************************** * CVLOG * SPC 1 * CVLOG CONVERTS PHYSICAL DISC ADDR IN A&B TO * A LOGICAL TRACK # IN REG. A * INPUTS: * A = PHYSICAL CYLINDER # * B = PHYSICAL HEAD# * * RETURN: * (P+1) * A = LOGICAL TRACK ON CURRENT SUBCHANNEL * CVLOG NOP STB TEMP1 SAVE HEAD # * LDB \DFTR FIRST CYLINDER # CMB,INB MAKE NEGATIVE ADA B COMPUTE LOGICAL CYL# MPY \DNSU MULT. BY # OF HEADS * LDB \DSHD GET STARTING HEAD CMB,INB MAKE NEG ADB TEMP1 GET LOGICAL HEAD# * ADA B ADD IT TO (CYL# X #HEADS) JMP CVLOG,I RETURN A=LOGICAL TRACK# SPC 1 * §Ô������þú * ********************************************************************** SPC 5 ********************************************************************** * RPORT ROUTINE * SPC 1 * * RPORT SENDS THE MESSAGES: * FOR E=0: "BAD TRACK XXXX YYYY HH ZZZZ" * FOR E=1: "SPARED TO XXXX YYYY HH ZZZZ" * WHERE: * XXXX IS THE LOGICAL TRACK # OF THE CURRENT SUBCHANNEL * YYYY IS THE PHYSICAL CYLINDER # * HH IS THE HEAD# * ZZ IS THE UNIT#/ADDRESS SELECT# * * INPUTS: * A = PHYSICAL CYLINDER # * B = PHYSICAL HEAD# * RPCYL - PHYSICAL CYLINDER TO REPORT * RPHD - PHYSICAL HEAD TO REPORT * * IT ALSO SENDS A HEADER IF THIS IS THE FIRST BAD TRACK ON THIS * SUBCHANNEL: * LOGICAL CYL HEAD SELECT ADDR/UNIT * SPC 1 RPORT NOP DST RPCYL SAVE THE DISC ADDR FOR LATER * ELA SAVE THE E REG. IN TEMP2(0) STA TEMP2 ERA * * JSB CVLOG CONVERT ADDR TO LOGICAL TRACK# CMA,INA SET UP TO CONVERT THE TRACK LDB P2 STB \CLEN LDB ALBUF TO THE MESSAGE BUFFER JSB \CVAS DO IT * LDA TEMP2 ERA RESTORE E REG. TO MSG FLAG(SPARE/BAD) * LDA ABTMS GET "BAD TRACK" OVERLAY FOR MESSAGE SEZ LDA ASPMS IF E=1 (SPARE REPORT) GET ADDR OF "SPARED TO" LDB \MODE SEE IF IN MODE4 (SPARE CLEANUP) CPB P4 LDA ABSPR GET "BAD SPARE" OVERLAY FOR MESSAGE LDB EMES4 GET DESTINATION ADDR FOR OVERLAY MVW P5 STUFF THE PREAMBLE IN THE MESSAGE * LDA RPCYL NOW CONVERT CMA,INA THE CYL. # LDB ACYLM FOR THE MESSAGE JSB \CVAS * CLA,INA STA \CLEN LDA RPHD CONVERT THE HEAD# TO ASCII AND CMA,INA LDB AHDMç������þúS JSB \CVAS STUFF IT IN MESSAGE * LDA \TUNT NOW THE UNIT CMA,INA LDB AUNMS WHERE TO STUFF CONVERTED ASCII JSB \CVAS * ISZ \BADH HAVE WE OUTPUT THE HEADER YET? JMP RPRT YES...GO OUPUT MESSAGE: XXXXXXXXXX XXXX YYYY HH ZZ * JSB \BLIN NO.. OUTPUT THE HEADERS LDB EMES1 JSB ESUB GO STUFF THE SUBCHANNEL # IN MESSAGE: * LDA P12 LDB EMES2 JSB \DSPL "BAD TRACKS SUBCHANNEL XX" * LDA P19 LDB EMES3 SEND THE MESSAGE: JSB \DSPL "LOGICAL CYL HEAD ADDR/UNIT" * RPRT LDA P15 LDB EMES4 SEND THE "(BAD TRACK/SPARED) TO XXXX YYYY HH ZZ" JSB \DSPL MESSAGE. * JMP RPORT,I RETURN SPC 1 * END RPORT * ********************************************************************** SPC 5 ********************************************************************** * ESUB * SPC 1 ESUB NOP CLA,INA SET FOR A 1-WORD CONVERSION STA \CLEN LDA \DSUB GET CURRENT SUBCHANNEL CMA,INA JSB \CVAS JMP ESUB,I SPC 1 * * ********************************************************************** SPC 5 ********************************************************************** * SPECR ROUTINE * SPC 1 * * SPECR SENDS THE MESSAGE: "INVALID DISC SPECIFICATIONS XX" * WHERE XX IS THE SUBCHANNEL * SPECR NOP JSB \BLIN LDB ER43A STUFF THE MESSAGE WITH SUBCHANNEL # JSB ESUB LDB ERR43 SEND THE MESSAGE: LDA P15 JSB \DSPL "INVALID DISC SPECIFICATIONS XX" JMP SPECR,I RETURN SPC 1 * END SPECR ö4������þú * ********************************************************************** SPC 4 ********************************************************************** * NOSPR ROUTINE * SPC 1 * NOSPR SEND THE MESSAGE: "OUT OF SPARES XX" * NOSPR NOP JSB \BLIN LDB ER42A STUFF SUBCHANNEL JSB ESUB * LDB ERR42 LDA P8 JSB \DSPL SEND "OUT OF SPARES XX" JMP NOSPR,I RETURN SPC 1 * END NOSPR * ********************************************************************** SPC 4 ********************************************************************** * PARER ROUTINE * SPC 1 * * PARER SENDS THE MESSAGE: "PARITY OR DATA ERROR TRACK XXXX YY * WHERE XXXX IS THE LOGICAL TRACK # ON SUBCHANNEL YY * PARER NOP JSB \BLIN LDB P2 STB \CLEN SET CONVERSION LENGTH LDA \TRAK GET LOGICAL TRACK ADDRESS CMA,INA LDB ER22A STUFF ASCII HERE JSB \CVAS LDB ER22B TELL ESUB WHERE TO PUT THE SUBCH# JSB ESUB * LDA P18 LDB ERR22 GET ADDR OF MESSAGE FOR \DSPL JSB \DSPL JMP PARER,I RETURN SPC 1 * END PARER * ********************************************************************** SPC 5 ********************************************************************** * NRDER ROUTINE * SPC 1 * NRDER SENDS THE MESSAGE: "READY DISC AND ENTER " "CR" * AND WAITS FOR THE RESPONSE * NRDER NOP JSB \BLIN LDB MS33A GO STUFF THE PROBLEM SUBCHANNEL JSB ESUB IN THE MESSAGE NROVR LDA P15 LDB MES33 JSB \DSPL JSB INBLK JMP NROVR INPUT ERR JMP NRDER,I REÊ������þúTURN SPC 1 * END NRDER * ********************************************************************** SPC 5 ********************************************************************** * FRMER ROUTINE * SPC 1 * * FRMER SENDS THE MESSAGE: "TURN ON FORMAT SWITCH AND ENTER " "CR XX * AND WAITS FOR THE RESPONSE * FRMER NOP JSB \BLIN LDB MS34A JSB ESUB STUFF THE SUBCHANNEL # IN THE MESSAGE FMOVR LDA P20 LDB MES34 JSB \DSPL JSB INBLK JMP FMOVR INPUT ERR JMP FRMER,I SPC 1 * END FRMER * ********************************************************************** SPC 5 ********************************************************************** * PROTR ROUTINE * SPC 1 * * PROTR SENDS THE MESSAGE: "TURN OFF DISC PROTECT - PRESS RET XX" * AND WAITS FOR THE RESPONSE * WHERE XX IS THE SUBCH # * PROTR NOP JSB \BLIN LDB MS32A JSB ESUB STUFF SUBCHANNEL # IN MESSAGE PROVR LDA P20 LDB MES32 JSB \DSPL JSB INBLK JMP PROVR INPUT ERR JMP PROTR,I SPC 1 * END PROTR * ********************************************************************** SPC 5 ********************************************************************** * DCYLR ROUTINE * SPC 1 * * DCYLR OUTPUTS THE MESSAGE: "DEFECTIVE CYLINDER - TRACK XXXX YY" * WHERE XXXX IS THE LOGICAL TRACK # ON SUBCHANNEL YY * DCYLR NOP LDA \TRAK CMA,INA LDB P2 STB \CLEN LDB ER40A WHERE TO PUT THE ASCII TRACK # JSB \CVAS * LDB ER40B WHERE TO‹Û������þú PUT THE SUBCH# JSB ESUB LDA P18 LDB ERR40 JSB \DSPL JMP DCYLR,I SPC 1 * END DCYLR * ********************************************************************** SPC 5 ********************************************************************** * INBLK * SPC 1 * INBLK CALLS \RDIN TO INPUT A MAX OF 2 CHARS, SO THAT THE * OPERATOR CAN SIGNAL SWITCH WHEN THEY ARE READY,AFTER THEY * FLIPPED A SWITCH ON THE DRIVE OR WHATEVER. SPC 1 INBLK NOP LDA N2 SET MAX # OF CHARS TO INPUT LDB \BUFI ADDR OF BUFFER JSB \RDIN JSB \DFLT MAKE SURE ITS A " "CR JMP INBLK,I ERR RETURN * ISZ INBLK JMP INBLK,I RETURN SPC 1 * END INBLK * ********************************************************************** SPC 5 ********************************************************************** ********************************************************************** ** ** * END DRIVER SUBROUTINES * ** ** ********************************************************************** ********************************************************************** SPC 5 * SWTCH DRIVER VARIABLES,CONSTANTS,MESSAGES SPC 2 N2 DEC -2 N3 DEC -3 N6 DEC -6 N9 DEC -9 N10 DEC -10 * P0 DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P15 DEC 15 P18 DEC 18 P19 DEC 19 P20 DEC 20 P64 DEC 64 * M17 OCT 17 M23 OCT 23 M37 OCT 37 M77 OCT 77 M40 OCT 40 M100 EQU P64 M137 OCT 137777 M377 ݘ������þúOCT 377 MSIGN OCT 100000 * A017 EQU M17 SEEK,ADRC,FMSK,READ A025 OCT 25 SEEK,FILEMASK,RDFS A067 OCT 67 SEEK,ADRC,FMSK,RDFS,STFIX A107 OCT 107 SEEK,ADRC,FMSK,WRITE A207 OCT 207 SEEK,ADRC,FMSK,INIT A407 OCT 407 SEEK,ADRC,FMSK,VERFY A1000 OCT 1000 XEND * S001 EQU P1 D BIT SET S010 EQU P2 P BIT SET S011 EQU P3 D&P BIT SET S100 EQU P4 S BIT SET S110 EQU P6 S&P BIT SET * ST20 OCT 20 STATUS S1 FOR ILLEGAL ACCESS TO SPARE ST21 OCT 21 STATUS S1 FOR DEFECTIVE TRACK * \ACTN NOP ACTION FLAG WORD TO DRIVE XFER ROUTINE \RET NOP STATUS RETURNED TO MAIN -1/0/1: * -1=ERROR; 0=LOOP DRIVER AGAIN; 1=OK \R/W NOP 0/1 = WRITE/READ MADDR NOP BUFFER ADDRESS� FOR DATA PHASE NOP CURRENT PHASE FLAG FOR LOOPING THRU DRIVER CRSP# NOP CURRENT SPARE NUMBER (RANGE= 0 TO \DNSP) ERCNT NOP DISC OPERATION ERROR COUNTER (RANGE:-10 TO 0) FLMSK NOP FILE MASK BITS: 4/0 = AUTO-SEEK TO SPARE/NO AUTO SEEK SKCYL NOP PHYSICAL CYLINDER # FOR SEEK COMMAND SKHD NOP PHYSICAL HEAD# FOR SEEK COMMAND ARCYL NOP PHYSICAL CYLINDER # FOR ADDRESS RECORD COMMAND ARHD NOP PHYSICAL HEAD# FOR ADDRESS RECORD COMMAND BDCYL NOP PHYSICAL CYLINDER # FOR CURRENT DEFECTIVE TRACK BDHD NOP PHYSICAL HEAD # FOR CURRENT DEFECTIVE TRACK RPCYL NOP PHYSICAL CYLINDER # FOR REPORT ROUTINE RPHD NOP PHYSICAL HEAD# FOR REPORT ROUTINE SEC# NOP SECTOR ADDRESS DRIVER LIBR CALLS S#CTR NOP # OF 128 WD SEC/TRK ST1 NOP 5-BIT S1 FIELD FROM STAT1 STAT1 NOP STATUS WORD 1 RETURNED FROM DRIVER LIBRARY STAT2 NOP STATUS WORD 2 RETURNED FROM DRIVER LIBRARY IER NOP ERROR INDICATOR FOR DRIVER LIBRARY CALLS SPD NOP INITIALIZE FLAG BITS SPARE/PROTECT/DEFECTIVE LEN NOP POSITIl‚���0��.*VE # OF WORDS TO TRANSFER SK10H NOP FLAG TO IGNORE SEEK ERRS ON 7910H \BADH DEC -1 BAD TRACKS HEADER FLAG DPBUF BSS 16 COMMAND BUFFER FOR HPIB NOP NEXT 3 WORDS FOR READ FULL SECTOR COMMAND CYLSP NOP CYLINDER ADDR STORED IN SPARE HDSSP NOP HEAD/SECTOR ADDR STORED IN SPARE * DSBUF DEF *+1 BSS 9 SUBCHANNEL SURFACE BUFFER ESBUF DEF * * TEMP1 NOP TEMP2 NOP EMES4 DEF EMS4 EMES2 DEF *+1 ASC 11,BAD TRACKS SUBCHANNEL XX EMSS2 NOP LOCATION FOR XX EMES1 DEF EMSS2 EMES3 DEF *+1 ASC 5, ASC 14, LOGICAL CYL HEAD ADDR/UNIT EMS4 ASC 6,BAD TRACK TKMS ASC 3, CYLMS ASC 3, HEDMS ASC 2, UNIMS ASC 1, ALBUF DEF TKMS ACYLM DEF CYLMS AHDMS DEF HEDMS AUNMS DEF UNIMS * BSPR ASC 5,BAD SPARE BTMS ASC 5,BAD TRACK SPMS ASC 5,SPARED TO ABSPR DEF BSPR ASPMS DEF SPMS ABTMS DEF BTMS * ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 ERR42 DEF *+1 ASC 8,OUT OF SPARES XX ER42A DEF ERR42+8 MES32 DEF *+1 ASC 20,TURN OFF DISC PROTECT - ENTER " "CR XX MS32A DEF MES32+20 MES34 DEF *+1 ASC 20,TURN ON FORMAT SWITCH - ENTER " "CR XX MS34A DEF MES34+20 MES33 DEF *+1 ASC 15,READY DISC AND ENTER " "CR XX MS33A DEF MES33+15 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * * END EQU * END BEG5 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������6Ò0������ÿÿ����� ���� ÿý�Ï�&ö ���������ÿ��92067-18517 2040� S C0122 �&DSCLB �LIBRARY HEADER � � � � � � � � � � � � �H0101 §q�����ASMB,Q,C ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: DSCLB - LIBRARY HEADER * SOURCE: 92067-18517 * RELOC: PART OF 92067-12002 * PGMR: J.S.W * NAM DSCLB,0 92067-12002 REV.2040 800717 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������,2������ÿÿ����� ���� ÿý�Ð�Ö ���������ÿ��92067-18518 2040� S C0122 �&XPRTY �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 æì�����ASMB,Q NAM XPRTY,7 92067-1X518 REV.2040 800717 ENT XPRTY * ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: XPRTY * SOURCE: 92067-18518 * RELOC: PART OF 92067-12002 * PGMR: J.S.W * * * CALLIN SEQUENCE: * CALL XPRTY(INTEGER) * WHERE INTEGER IS THE VALUE TO BE CONFIGURED * PARITY BIT IS BIT 7, ONLY 7 BITS ARE COUNTED * * * XPRTY NOP LDA XPRTY,I GET RETURN ADDRESS STA RETN SAVE,RETURN ISZ XPRTY STEP TO PARAMETER 1 LDA XPRTY,I GET PARAMETER ADDRESS STA .NUM SAVE IT LDA .NUM,I GET ITS VALUE LDB BM7 GET BIT COUNT (7 BITS) CCE INDICATES ODD OR EVEN SLA,RAR IF EVEN SKIP CME SET INDICATER ISZ 1 PUMP COUNTER JMP *-3 LDA .NUM,I GET OLD NUMBER SEZ IOR BIT7 SET PARITY BIT IN BIT 7 STA .NUM,I JMP RETN,I RETURN * * BIT7 OCT 200 .NUM NOP RETN NOP BM7 DEC -7 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������g������ÿÿ����� ���� ÿý�Ñ�× ���������ÿ��92067-18519 2040� S C0122 �&ISHL �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 âš�����þúASMB,Q HED ISA S61.1 LOGICAL SHIFT ROUTINE 92067-1X519 REV.2001 ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: ISHL * SOURCE: 92067-18519 * RELOC: PART OF 92067-12002 * PGMR: J.S.W * * * * CALL FORMAT: * I= ISHL(M,N) * * WHERE * M = NUMBER TO BE SHIFTED * N = BIT COUNT IF POSITIVE SHIFT LEFT N BITS * IF NEGATIVE SHIFT RIGHT N BITS * * * NAM ISHL,7 92067-1X519 REV.2001 791101 ENT ISHL EXT .ENTR,EXEC SUP SPC 3 OP3 NOP NUMBER TO BE SHIFTED NUM NOP NUMBER OF SHIFTS ISHL NOP JSB .ENTR FETCH PARAMETER DEF OP3 ADDRESSES LDA OP3,I FETCH LDB NUM,I PARAMETER VALUES SSB,RSS IF POSITIVE JMP LSHFT GO TO LEFT SHIFT * * RIGHT SHIFT RSHFT CLE,ERA SHIFT RIGHT ONE PLACE INB,SZB IF AT END JMP RSHFT CONTINUE, OTHERWISE JMP ISHL,I RETURN * * LEFT SHIFT LSHFT CMB,RSS IF ZERO NO SHIFT LSHF1 CLE,ELA LEFT SHIFT ONE PLACE INB,SZB IF NOT FINISHED JMP LSHF1 CONTINUE, OTHERWISE JMP ISHL,I RETURN END �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ���� �������� �������ÿÿ����� ���� ÿý�Ò�Ù ���������ÿ��92067-18520 2040� S C0122 �&XIDEN �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÈÔ�����FTN4,Q,C SUBROUTINE XIDEN(LU,DVID,IDENT,IER),92067-1X520 REV.2040 800717 IMPLICIT INTEGER(A-Z) C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XIDEN C SOURCE: 92067-18520 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION BUF(20) C ID=IAND(DVID,7B) C BUF(1) = 476B BUF(2) = 737B BUF(3) = 100740B+ID CALL XPRTY(BUF(3)) CALL ZSENS(LU,BUF,1) IDENT = BUF(17) CALL XDSJ(LU,DVID,IER) RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������¿N������ÿÿ����� ���� ÿý�Ó�Ù ���������ÿ��92067-18521 2040� S C0122 �&XSTAT �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Ïê�����FTN4,Q,C SUBROUTINE XSTAT(LU,IDVID,KS1,KS2,IER),92067-1X521 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XSTAT C SOURCE: 92067-18521 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(20) C C REQUST STATUS AND RETURN IN KS1,KS2 IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) C IBUF(2)=550B IBUF(3)=3 IBUF(4)=1000B+IUNIT IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100550B 100 CALL ZSENS(LU,IBUF,2) CALL XDSJ(LU,IDVID,IER) KS1=IBUF(17) KS2=IBUF(18) C C RETURN C 500 IBUF(1)=ID REG=EXEC(1,LU+2300B,IBUF,2,0,0) KS1=IBUF(2) KS2=IBUF(3) RETURN END END$ ����������������þ������ÿÿ����� ���� ÿý�Ô�Ú ���������ÿ��92067-18522 2040� S C0122 �&XSEEK �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÔÒ�����FTN4 SUBROUTINE XSEEK(LU,IDVID,ICYL,IHD,ISEC,IS1,IS2,IER X ),92067-1X522 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XSEEK C SOURCE: 92067-18522 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(10) INTEGER ICYL,IHD,ISEC C C C SEEK TO TARGET CYLINDER,HEAD AND SECTOR (ICYL,IHD,ISEC) C C C C MASK OUT UNIT AND ADDRESS IN IDVID C ID=IDVID C IUNIT=IAND(IDVID,17400B)/256 ID=IAND(IDVID,7B) IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=2B IBUF(4)=IUNIT IBUF(5)=IAND(ICYL,177400B)/256 IBUF(6)=IAND(ICYL,377B) IBUF(7)=IHD IBUF(8)=ISEC+1000B IBUF(9)=100677B C C 100 CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C 500 IBUF(1)=ID+100000B IBUF(2)=-3 IBUF(3)=101200B+ID IBUF(4)=ICYL IBUF(5)=IHD*256+ISEC REG=EXEC(1,LU+2200B,IBUF,9,1,0) IS1=IBUF(2) IS2=IBUF(3) C RETURN END END$ ��������������û������ÿÿ����� ���� ÿý�Õ�Û ���������ÿ��92067-18523 2040� S C0122 �&XLGAD �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÊÍ�����FTN4,Q,C SUBROUTINE XLGAD(LU,IDVID,ICYL,IHD,ISEC,IER X ),92067-1X523 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XLGAD C SOURCE: 92067-18523 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C C REQUEST LOGICAL DISC ADDRESS C C DIMENSION IBUF(20) C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=24B IBUF(4)=1000B IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100550B C C C 100 CALL ZSENS(LU,IBUF,2) CALL XDSJ(LU,IDVID,IER) IHD=IAND(IBUF(18),177400B)/256 ISEC=IAND(IBUF(18),377B) C ICYL=IBUF(17) C RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=112000B GO TO 100 END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Í������ÿÿ����� ���� ÿý�Ö�Ü ���������ÿ��92067-18524 2040� S C0122 �&XINIT �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Ðä�����FTN4,Q,C C SUBROUTINE XINIT(LU,IDVID,IBUF,LEN,ISPD,IS1,IS2, IER),92067-1X524 XREV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XINIT C SOURCE: 92067-18524 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C SAVE SPD ISPD2=ISPD C INITIALIZE WITH S,P,D BIT C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 1 ISPD2=IAND(ISPD,377B)*32 C CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN C IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=13B+ISPD2 IBUF(4)=1000B+IUNIT IBUF(5)=677B IBUF(6)=440B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B C C C C 200 CALL ZWRIT(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) C C RETURN C C 500 IBUF(1)=ID IBUF(2)=-1 ISPD2=ISHL(ISPD2,13) IBUF(3)=ISPD2+5600B+ID REG=EXEC(1,LU+2200B,IBUF,LEN,4,0) IS1=IBUF(2) IS2=IBUF(3) C RETURN END END$ ����������������������������������������������DF������ÿÿ����� ���� ÿý�×�Ý ���������ÿ��92067-18525 2040� S C0122 �&XDRED �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÈØ�����FTN4 SUBROUTINE XDRED(LU,IDVID,IBUF,LEN,IS1,IS2,IER X ),92067-1X525 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XDRED C SOURCE: 92067-18525 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C UNBUFFERED READ (WITH DMA) C IUNIT=IAND(IDVID,177400B)/256 C C C C ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=5B IBUF(4)=1000B+IUNIT IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B 100 CALL ZREAD(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=102600B+ID REG=EXEC(1,LU+2200B,IBUF,LEN,3,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������gº������ÿÿ����� ���� ÿý�Ø�Þ ���������ÿ��92067-18526 2040� S C0122 �&XDWRT �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Öí�����FTN4 SUBROUTINE XDWRT(LU,IDVID,IBUF,LEN,IS1,IS2,IER X ),92067-1X526 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XDWRT C SOURCE: 92067-18526 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C UNBUFFERRED WRITE C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C C C IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=10B IBUF(4)=1000B+IUNIT IBUF(5)=677B IBUF(6)=440B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B 100 CALL ZWRIT(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=104200B+ID REG=EXEC(1,LU+2200B,IBUF,LEN,4,0) IS1=IBUF(2) IS2=IBUF(3) END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������12������ÿÿ����� ���� ÿý�Ù�ß ���������ÿ��92067-18527 2040� S C0122 �&XFMSK �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÚÚ�����FTN4 SUBROUTINE XFMSK(LU,IDVID,MSK,IER),92067-1X527 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XFMSK C SOURCE: 92067-18527 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(16) C C C SET FILE MASK WITH MASK IN MSK ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 1 IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=17B IBUF(4)=MSK+1000B IBUF(5)=100677B 100 CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=107400B+MSK GO TO 100 END END$ ����������™ö������ÿÿ����� ���� ÿý�Ú�à ���������ÿ��92067-18528 2040� S C0122 �&XRCAL �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÕÑ�����FTN4,Q,C SUBROUTINE XRCAL(LU,IDVID,IER),92067-1X528 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XRCAL C SOURCE: 92067-18528 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(16) C C C RECALIBRATE-- SEEK TO TRACK 0 SECTOR 0 C C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=1 IBUF(4)=1000B IBUF(5)=100677B C C 100 CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=100600B+ID GO TO 100 END END$ ������������������������������������������������������������������������������������������������������������������������������������nd������ÿÿ����� ���� ÿý�Û�á ���������ÿ��92067-18529 2040� S C0122 �&XADRC �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÖÉ�����FTN4 SUBROUTINE XADRC(LU,IDVID,ICYL,IHD,ISEC,IER X ),92067-1X529 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XADRC C SOURCE: 92067-18529 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(10) C C C ADDRESS RECORD C ID=IAND(IDVID,7B) C C C C C IF(IFDVR(LU).EQ.0) GO TO 500 1 IBUF(1)=440B+IDVID CALL XPRTY(IBUF(1)) IBUF(2)=550B C C OP CODE C IBUF(3)=14B IBUF(4)=0 IBUF(5)=IAND(ICYL,177400B)/256 IBUF(6)=IAND(ICYL,377B) IBUF(7)=IHD IBUF(8)=ISEC+1000B IBUF(9)=100677B C C 100 CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) RETURN 500 IBUF(1)=ID IBUF(2)=-3 IBUF(3)=106000B IBUF(4)=ICYL IBUF(5)=IHD*256+ISEC GO TO 100 END END$ ������������������������������������������������������������������������������I*������ÿÿ����� ���� ÿý�Ü�â ���������ÿ��92067-18530 2040� S C0122 �&XVRFY �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Öî�����FTN4,Q,C SUBROUTINE XVRFY(LU,IDVID,ISC, IS1,IS2, IER),92067-1X530 REV.2040 X800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XVRFY C SOURCE: 92067-18530 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(20) C C C C VERIFY C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) IF(IFDVR(LU).EQ.0) GO TO 500 C C C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B C OP CODE C IBUF(3)=7 IBUF(4)=IUNIT IBUF(5)=IAND(ISC,177400B)/256 IBUF(6)=IAND(ISC,377B)+1000B IBUF(7)=100677B C C CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.4) GO TO 900 CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C 900 IER=4 RETURN C 500 IBUF(1)=ID IBUF(2)=-2 IBUF(3)=103600B+ID IBUF(4)=ISC REG=EXEC(1,LU+2200B,IBUF,4,1,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$ ������������������������������������������������������������������������������������������������������������������������¤Ò������ÿÿ����� ���� ÿý�Ý�ã ���������ÿ��92067-18531 2040� S C0122 �&XRDFS �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÓÚ�����FTN4,Q,C SUBROUTINE XRDFS(LU,IDVID,IBUF,LEN,ISTAT1,ISTAT2,IER X ),92067-1X531 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XRDFS C SOURCE: 92067-18531 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C READ FULL SECTOR C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=6B IBUF(4)=1000B IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B C C CALL ZREAD(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,ISTAT1,ISTAT2,IXX) RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=3200B+ID REG=EXEC(1,LU+2200B,IBUF,LEN,3,0) ISTAT1=IBUF(2) ISTAT2=IBUF(3) RETURN END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ï������ÿÿ����� ���� ÿý�Þ�ä ���������ÿ��92067-18532 2040� S C0122 �&XWRFS �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Ùè�����FTN4,Q,C SUBROUTINE XWRFS(LU,IDVID,IBUF,LEN,IS1,IS2,IER X ),92067-1X532 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XWRFS C SOURCE: 92067-18532 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 C CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=11B IBUF(4)=1000B IBUF(5)=677B IBUF(6)=440B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B CALL ZWRIT(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=4600B REG=EXEC(1,LU+2200B,IBUF,LEN,4,0) IS1=IBUF(2) IS2=IBUF(3) RETURN C END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¾l������ÿÿ����� ���� ÿý�ß�å ���������ÿ��92067-18533 2040� S C0122 �&XRDOF �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÞÍ�����FTN4,Q,C SUBROUTINE XRDOF(LU,IDVID,IBUF,LEN,IOFSET,IS1,IS2,IER X ),92067-1X533 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XRDOF C SOURCE: 92067-18533 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C C IF(IFDVR(LU).EQ.0) GO TO 500 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=16B IBUF(4)=0 IBUF(5)=0 IBUF(6)=IOFSET+1000B IBUF(7)=677B IBUF(8)=500B+ID CALL XPRTY(IBUF(8)) IBUF(9)=100740B CALL ZREAD(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) C C RETURN C C 500 IBUF(1)=ID+100000B IBUF(2)=-2 IBUF(3)=107200B+ID IBUF(4)=IOFSET REG=EXEC(1,LU+2200B,IBUF,LEN,3,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������“è������ÿÿ����� ���� ÿý�à�æ ���������ÿ��92067-18534 2040� S C0122 �&XRDNV �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÞÝ�����FTN4,Q,C SUBROUTINE XRDNV(LU,IDVID,IBUF,LEN,IS1,IS2,IER X ),92067-1X534 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XRDNV C SOURCE: 92067-18534 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(1) C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=22B IBUF(4)=1000B IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100740B CALL ZREAD(LU,IBUF,LEN) CALL XDSJ(LU,IDVID,IER) CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C C 500 IBUF(1)=ID IBUF(2)=-1 IBUF(3)=111200B+ID REG=EXEC(1,LU+2200B,IBUF,LEN,3,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ñ‹������ÿÿ����� ���� ÿý�á�ç ���������ÿ��92067-18535 2040� S C0122 �&XPHAD �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÐÏ�����FTN4,Q,C SUBROUTINE XPHAD(LU,IDVID,ICYL,IHD,ISEC,IER ),92067-1X535 REV.2040 X 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XPHAD C SOURCE: 92067-18535 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(20) C C C REQUEST PHYSICAL DISC ADDRESS C C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) RETURN C CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=24B IBUF(4)=1000B+IUNIT IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100550B C CALL ZSENS(LU,IBUF,2) CALL XDSJ(LU,IDVID,IER) ICYL=IBUF(17) IHD=IAND(IBUF(18),177400B)/256 ISEC=IAND(IBUF(18),377B) RETURN END END$ ����������������������������������������������æê������ÿÿ����� ���� ÿý�â�è ���������ÿ��92067-18536 2040� S C0122 �&XFRMT �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Óé�����FTN4 SUBROUTINE XFRMT(LU,IDVID,IDATA,ITYPE,ISTAG,IER),92067-1X536 REV. X2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XFRMT C SOURCE: 92067-18536 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(20) C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) RETURN C CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=754B IBUF(3)=30B IBUF(4)=IUNIT C C ISTAG=IAND(ISTAG,377B) ITYPE=IAND(ITYPE,377B) C IBUF(5)=ITYPE IBUF(6)=ISTAG IBUF(7)=1000B+IDATA IBUF(8)=100677B CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) RETURN END END$ ���������������������������������������������������������������������������������������������������������������������������� —������ÿÿ����� ���� ÿý�ã�é ���������ÿ��92067-18537 2040� S C0122 �&XSPAR �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Õå�����FTN4,Q,C SUBROUTINE XSPAR (LU,LASTRK,IER),92067-1X537 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XSPAR C SOURCE: 92067-18537 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IREG(2),IBUF(20) INTEGER S1 EQUIVALENCE (IA,REG,IREG(1)),(IB,IREG(2)) C C THIS ROUTINE RETURNS THE FIRST AVAILABLE SPARE TRACK # FOR THIS LU C IF IER=1 OUT OF SPARES C C IER=0 C C GET TRACK MAP AND FIND # OF SPARES C CALL ZTMAP(LU,IBUF,5) C C GET # OF SPARES FROM TMT , IF ZERO SET IER=1 AND RETURN C NSPAR=IAND(IBUF(5),377B) IF(NSPAR.EQ.0) GO TO 50 NTRK=0 LASTRK=IBUF(4) 10 CALL XGTAD(LU,IDVID,LASTRK,0,ICYL,IHD,ISEC) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) CALL XDRED(LU,IDVID,IBUF,1,ISTAT1,ISTAT2,IER) S1=IAND(ISTAT1,17400B)/256 ISP=IAND(ISTAT1,120000B) IF(S1.NEQ.20B.AND.ISP.EQ.0 ) RETURN LASTRK=LASTRK+1 NTRK=NTRK+1 IF(NTRK.LT.NSPAR) GO TO 10 50 IER=1 RETURN END END$ ��������������������������������������������������������������������������������������������������������������������w������ÿÿ����� ���� ÿý�ä�ê ���������ÿ��92067-18538 2040� S C0122 �&XGTAD �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÊÛ�����FTN4 SUBROUTINE XGTAD(LU,IDVID,LTRK,LSEC,ICYL,IHD,ISEC X ),92067-1X538 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XGTAD C SOURCE: 92067-18538 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION ITMT(5) C C C C GET TRACK MAP ENTRY C CALL ZTMAP(LU,ITMT,5) NOTRK=ITMT(4) NHEAD=ITMT(3) NHEAD=ISHL(NHEAD,-10) IHD1=IAND(ITMT(3),1760B)/17B IHD=MOD(LTRK,NHEAD)+IHD1 ICYL=(LTRK/NHEAD)+ITMT(2) ISEC=LSEC/2 IDVID=IAND(ITMT(5),16000B)/4 IDVID=IDVID+IAND(ITMT(3),17B) RETURN END END$ ������������������������������������������������������÷������ÿÿ����� ���� ÿý�å�ë ���������ÿ��92067-18539 2040� S C0122 �&XEND �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ̱�����FTN4 SUBROUTINE XEND(LU,IDVID),92067-1X539 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XEND C SOURCE: 92067-18539 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C C DIMENSION IBUF(6) C C SEND END COMMAND C ID=IAND(IDVID,7B) C IF(IFDVR(LU).EQ.0) GO TO 500 IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=25B IBUF(4)=1000B IBUF(5)=100677B CALL ZCTRL(LU,IBUF,5) RETURN C C C 13037 DISC C 500 IBUF(1)=0 IBUF(2)=-1 IBUF(3)=112400B REG=EXEC(1,LU+2200B,IBUF,5,1,0) RETURN END END$ ����������������������5������ÿÿ����� ���� ÿý�æ�ì ���������ÿ��92067-18540 2040� S C0122 �&XTTBL �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 Ðä�����FTN4,Q,C SUBROUTINE XTTBL(LU,DP),92067-1X540 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XTTBL C SOURCE: 92067-18540 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C IMPLICIT INTEGER (A-Z) INTEGER DP(8),ITMT(5) C C THIS SUBROUTINE RETURNS DISC PARAMETERS AS FOLLOWS: C C DP(1) = HPIB ADDRESS C DP(2) = UNIT NUMBER C DP(3) = STARTING HEAD C DP(4) = STARTING CYLINDER C DP(5) = NUMBER OF SPARES THIS LU C DP(6) = NUMBER OF TRACKS THIS LU C DP(7) = NUMBER OF SECTORS/TRACK C DP(8) = NUMBER OF SUFACES (OR HEADS) C C CALL ZTMAP(LU,ITMT,5) C DP(1)=IAND(ITMT(3),17B) DP(2)=IAND(ITMT(5),16000B)/2000B DP(3)=IAND(ITMT(3),1760B)/20B DP(4)=ITMT(2) DP(5)=IAND(ITMT(5),377B) DP(6)=ITMT(4) DP(7)=ITMT(1)/2 DP(8)=IAND(ITMT(3),176000B) DP(8)=ISHL (DP(8),-10) RETURN END END$ ������G������ÿÿ����� ���� ÿý�ç�í ���������ÿ��92067-18541 2040� S C0122 �&XDSJ �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 É·�����FTN4 SUBROUTINE XDSJ(LU,IDVID,KDSJ),92067-1X541 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XDSJ C SOURCE: 92067-18541 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C C DIMENSION IBUF(3) DATA IBUF/0,0,0/ KDSJ=0 IF(IFDVR(LU).EQ.0) RETURN C C ID=IAND(IDVID,7B) CALL ZDSJ(LU,ID,IBUF) CALL ABREG(IA,IB) IF(IB.EQ.0) GO TO 50 KDSJ=IBUF(1) RETURN 50 KDSJ=4 RETURN END END$ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ƒ������ÿÿ����� ���� ÿý�è�î ���������ÿ��92067-18542 2040� S C0122 �&IFDVR �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ØË�����þúASMB,Q,C NAM IFDVR,7 92067-1X542 REV.2040 800717 * * * SOURCE PART NO.: 92067-18542 * RELOC. PART NO.: 92067-1X542 * NAME: IFDVR * PART OF $DSCLB(92067-12002) * * * PROGRAMMER: JRS * ******************************************************************* * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * * ******************************************************************* * * * * THIS SUBROUTINE TAKES AN LU IN A RTE-IVB SYSTEM AND * DECIDES IF IT IS A DVA32 OR DVR32 LU, BY KNOWING THAT ONLY * DVA32 PROCESSES ITS OWN TIME OUTS. THE FIRST TIME IFDVR IS * ENTERED, IT MAKES AN EXEC 1 (GET TRACK MAP) REQUEST TO * INSURE THE DRIVER HAS BEEN ENTERED. THIS GIVES THE DRIVER * A CHANCE TO SET THE TIME OUT PROCESSING BIT. THIS ROUTINE * ALSO WORKS IN NON SESSION ENVIROMENTS. * * CALL IFDVR(LU) * * * LU: THE LU WHOSE EQT NEEDS TO BE EXAMINED * * EXT .ENTR,EXEC ENT IFDVR LU NOP IFDVR NOP JSB .ENTR DEF LU * LDA LU,I COMPARE LU TO FLAG TO FIND OUT IF WE... CPA FLAG HAVE WE BEEN HERE BEFORE JMP GETEQ YES...FLAG IS CLEAR...NO NEED TO ENTER DRIVER * STA FLAG SAVE IT FOR FUTURE REFERENCE ADA B2200 ....ADD 2200B STA DLU JSB EXEC NO...MAKE SURE DRIVER HAS BEEN ENTERED ONCE DEF GETEQ DEF D1 EXEC 1- GET TRACK MAP DEF DLU LU AND CONWD OF 0(CLEAR) DEF LBUF TRACK MAP BUFFER DEF B5 1 SUBCHANNELS WORTH DEF NOP1 DEF NOP2 * GETEQ LDA LU,I GET THE ALLEGED LU ��� ��  LDB DRTI GET THE HEAD OF THE DRT ADA B ADD IT TO THE REAL LU ADA DM1 SUBTRACT 1 FOR GOOD MEASURE LDA A,I GET THE DRT ENTRY FOR MY LU AND B77 KEEP ONLY THE EQT PART ADA DM1 SUBTRACT 1 TO OFFSET EQT# MPY D15 MULTIPLY EQT BY 15 FOR OFFSET LDB EQTA GET THE HEAD OF THE EQT LIST ADB A ADD HEAD AND OFFSET INTO EQT ADB D3 ADD 3 TO GET TO EQT4 LDB B,I GET THE EQT4 WORD RBL,RBL GET BIT 12... RBL,ELB ...OUT IN THE OPEN CLA,SEZ WAS B BIT SET PREVIOUSLY?? CCA YES * JMP IFDVR,I BLOW THIS TACO STAND! * A EQU 0 B EQU 1 DRTI EQU 1652B HEAD OF THE DRT TABLE EQTA EQU 1650B HEAD OF THE EQT TABLE B2200 OCT 2200 B5 OCT 5 B77 OCT 77 D15 DEC 15 D1 DEC 1 D3 DEC 3 DLU NOP DM1 DEC -1 FLAG DEC -1 NOP1 NOP NOP2 NOP LBUF BSS 5 END ������������Uc ������ÿÿ����� ���� ÿý�é�ð ���������ÿ��92067-18543 2001� S C0122 �&XDCAS �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 ´ó�����þúASMB,Q,L NAM XDCAS,7 92067-1X543 REV. 2001 791101 ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: XDCAS * SOURCE: 92067-18543 * RELOC: PART OF 92067-12003 * PGMR: J.S.W * ENT XDCAS ROUTINE TO CONVERT DECIMAL INTEGERS TO ASCII XDCAS NOP CLA STA IFLAG STA CWORD LDA XDCAS,I STA RETRN ISZ XDCAS LDA XDCAS,I STA INAM BUFFER ADDRESS ISZ XDCAS LDA XDCAS,I LDA A,I ADA N1 STA NWORD LENGTH OF BUFFER-1 LDA INAM BUFFER TO BE BLANKED LOOP0 LDB SPACE STB A,I BLANK OUT A WORD IN BUFFER LDB CWORD USE CWORD AS COUNTER TO POINT IN TO BUFFER CPB NWORD ALL WORDS IN BUFFER DONE? JMP DCAS1 YES, GO ON INA ISZ CWORD INCREMENT COUNTER JMP LOOP0 DCAS1 ISZ XDCAS LDA XDCAS,I LDA A,I LOAD INTEGER TO BE CONVERTED LOOP CLB DIV D10 DIVIDE INTEGER BY BASE 10 STA QOTNT QOTNT IS USED TO EXTRACT REMAINING DIGITS ADB .60 B REG CONTAINS REMAINDER WHICH IS THE LATEST DIGIT * TO BE CONVERTED BY ADDING OCTAL 60 STB BYTE ASCII INTEGER SAVED LDA IFLAG CHECK TO SEE IF THIS IS A LOW ORDER BYTE SZA LOW ORDER BYTE IF IFLAG=0, ELSE HIGH ORDER BYTE JMP HIGH LDA BYTE STA CWORD STORE BYTE IN Î ��� �� LOWER HALF OF CWORD LDA QOTNT GET READY TO EXTRACT AND CONVERT NEXT DIGIT ISZ IFLAG SET FLAG TO INDICATE WORKING ON HIGH ORDER BYTE JMP LOOP START CONVERSION AGAIN HIGH LDA BYTE BIT 0 NOT SET IF HIGH ORDER BYTE ALF,ALF STORE BYTE IN UPPER HALF OF CWORD ADA CWORD STA CWORD LDA NWORD ADA INAM REG A POINTS TO BUFFER WHERE CWORD IS PLACED LDB CWORD STB A,I LDA NWORD SZA,RSS HAS THE BUFFER BEEN FILLED? JMP RETRN,I YES,RETURN TO CALLING ROUTINE ADA N1 NO,DECREASE NWORD TO POINT TO NEXT WORD IN BUFFER STA NWORD CLA STA IFLAG CLEAR FLAG TO INDICATE WORKING ON LOW ORDER BYTE LDA QOTNT GET READY TO EXTRACT NEXT DIGIT SZA IF QOTNT=0 THEN NO MORE DIGITS LEFT TO CONVERT JMP LOOP JMP RETRN,I * A EQU 0 B EQU 1 RETRN BSS 1 NWORD BSS 1 CWORD BSS 1 IFLAG BSS 1 QOTNT BSS 1 BYTE BSS 1 N1 DEC -1 D10 DEC 10 .60 OCT 60 INAM BSS 1 SPACE ASC 1, END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������š ������ÿÿ����� ���� ÿý�ê�ñ ���������ÿ��92067-18544 2001� S C0122 �&DATCO �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 ´ì�����ASMB,Q,L NAM DATCO,7 92067-1X544 REV.2001 791101 ***************************************************************** * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * * COMPANY. * * * ***************************************************************** * * NAME: DATCO * SOURCE: 92067-18544 * RELOC: PART OF 92067-12003 * PGMR: J.S.W * * * NAME: DATCO * SUBROUTINE TO GET DATE CODE AND RETURN TO FORTRAN CALLER * * CALLING SEQUENCE: * I=DATCO(IDUMMY) * EXT $DATC,.ENTR ENT DATCO * * DUMMY NOP DATCO NOP JSB .ENTR SET UP THE RETURN ADDRESS DEF DUMMY LDA $DATC GET DATE CODE STA DUMMY,I SET PARAMETER JMP DATCO,I END END$ ������������������������������������������������������������������������������������������������������$a������ÿÿ����� ���� ÿý�ë�ñ ���������ÿ��92067-18545 2001� S C0122 �&RDATK �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Éã�����þúFTN4,L SUBROUTINE RDATK(LU,LTRK,LSEC,LEN,ISUBC,IXBUF,IBT,LOG),92067-1X545 X REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: RDATK C SOURCE: 92067-18545 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C C THIS SUBROUTINE READS ONE TRACK FROM THE DISC BY USING THE C DISC LIBRARY SUBROUTINES. THE TARGET DISC TRACK ADDRESS IS IN C LTRK AND LSEC. THE 5 WORD ARRAY ISUBC CONTAINS THE SUBCHANNEL C TRACK MAP DEFINITION. THIS SUBROUTINE CONVERTS THE LOGICAL C LTRAK AND LSEC INTO PHYSICAL CYLINDER ,HEAD AND SECTOR (ICYL,IHD C ISEC) AND CALLS THE DISC LIBRARY TO DO THE READ C EQTRQ IS CALLED AT ENTRY TO LOCK THE EQT AND UNLOCK AT EXIT C C CALLING SEQUENCE: C LU - DISK LU C LTRK- LOGICAL TRACK # C LSEC- LOGICAL SECTOR # C LEN - TRANSFER LENGTH, # OF WORDS REQUESTED C ISUBC- 5 WORD ARRAY CONTAINING CURRENT SUBCHANNEL DEFINITION C IXBUF- BUFFER TO HOLD ONE TRACK OF DATA (PLUS 16 WORDS HEADER) C IBT- IF 1 BAD TRACK EXISTS, IF 0 NO BAD TRACKS C LOG- LOG LU C C IMPLICIT INTEGER(A-Z) DIMENSION ISUBC(1),IXBUF(1),ITEMP(6),LINE(60) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C READ A TRACK -- ON LINE SAVE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C CONVERT LOGICAL TO PHYSICAL TRK ADDRESS C CHECK STATUS C RETRY=0 CALL MXGTA(LU,IDéÚ������þúVID,LTRK,LSEC,ICYL,IHD,ISEC,ISUBC) 10 CALL XSTAT(LU,IDVID,ISTAT1,ISTAT2,IER) IF(IER.EQ.4) GO TO 950 IF(ISTAT2.LT.0) GO TO 950 C C LOCK EQT WITH WAIT C C IF A REG RETURNED IS NON-ZERO ERROR C ELSE THE LOCK IS GOOD C 15 IOPT=1 CALL EQTRQ(IOPT,LU) CALL ABREG(IA,IB) IF(IA.EQ.0) GO TO 50 IF(IA.EQ.-1) GO TO 980 CALL EXEC(2,LOG,15HEQT LOCK FAILED,-15) C C C C FILE MASK, SEEK, READ TO TARGET CYL,HEAD SECTOR C 50 MSK=4 CALL XFMSK(LU,IDVID,MSK,IER) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) IF(IER.EQ.2) GO TO 10 IF(IER.EQ.4) GO TO 950 IF(ISTAT2.LT.0) GO TO 900 C C CALL XDRED(LU,IDVID,IXBUF,LEN,ISTAT1,ISTAT2,IER) IF(IER.EQ.2) GO TO 10 IF(IER.EQ.4) GO TO 950 C D WRITE(1,9999) ISTAT1,ISTAT2 D9999 FORMAT("ST1 ST2=",2@7) C NOW CHECK STATUS IS1=IAND(ISTAT1,17400B)/256 IF(IS1.NEQ.0) GO TO 800 IF(IAND(ISTAT1, 20000B).NEQ.0) GO TO 850 IF(IAND(ISTAT1,40000B).NEQ.0) IXBUF(16)=IOR(IXBUF(16),100000B) C C C EXIT POINT C CALL XEND TO SEND END COMMAND AND UNLOCK EQT C 500 CALL XEND(LU,IDVID) IOPT=0 CALL EQTRQ(IOPT,LU) RETURN C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ERROR HANDLING ROUTINES C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 800 IF(IS1.GT.16B.AND.IS1.GT.20B) GO TO 850 RETRY=RETRY+1 IF( RETRY.GE.10) GO TO 850 GO TO 15 C C C 900 CALL EXEC(2,LOG,10HSEEK ERROR,-10) GO TO 15 950 CALL EXEC(2,LOG,15HDRIVE NOT READY,-15) CALL EXEC(2,LOG,48HREADY DISC AND ENTER "GO " TO CONTINUE , X ,-48) ITTY=LOGLU(ISES) CALL EXEC(1,ITTY+400B,IXX,-2) IF(IXX.EQ.2HGO) GO TO 10 IF(IXX.EQ.2H/E.OR.IXX.EQ.2HEN.OR.IXX.EQ.2HEX) STOP GO TO 950 C C 850 IXBUF(16)=IOR(IXBUF(16),40000B) DO 880 I=1,60 880 LINE(I)=2H C iÜ����� CALL EXEC(2,LOG,18H SOURCE SUBCHANNEL,-18) CALL EXEC(2,LOG, X 47H BAD TRACK AT: TRACK# CYL HEAD UNIT/ADDRESS,-47) IUNIT=IAND(IDVID,77B) CALL XDCAS(LINE( 9),2,LTRK) CALL XDCAS(LINE(13),2,ICYL) CALL XDCAS(LINE(15),2,IHD) CALL XDCAS(LINE(18),2,IUNIT) CALL EXEC(2,LOG,LINE,-60) C C SET BAD TRACK INDICATOR C IBT=1 GO TO 500 C C 980 CALL EXEC(2,LOG,19HEQT LOCK TABLE FULL,-19) GO TO 500 END ��������������������’f������ÿÿ����� ���� ÿý�ì�ô ���������ÿ��92067-18546 2001� S C0122 �&WRTRK �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Öû�����þúFTN4,L SUBROUTINE WRTRK(LU,LTRK,ISUBC,IXBUF,LOG,IBT),92067-1X546 REV.2001 X 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: WRTRK C SOURCE: 92067-18546 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION ISUBC(1),IXBUF(1),ITEMP(6),LINE(60) C DATA IPROCT/0/ C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C WRITE TRACK- ON-LINE RESTORE,COPY C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IRETRY=0 DO 1 I=1,30 1 LINE(I)=2H C C C CONVERT LOGICAL TO PHYSICAL TRK ADDRESS C CHECK STATUS C LSEC=0 CALL MXGTA(LU,IDVID,LTRK,LSEC,ICYL,IHD,ISEC,ISUBC) 100 CALL XSTAT(LU,IDVID,ISTAT1,ISTAT2,IER) IF(IER.EQ.4) GO TO 950 IF(ISTAT2.LT.0) GO TO 950 C C LOCK EQT C IOPT=1 CALL EQTRQ(IOPT,LU) CALL ABREG(IA,IB) IF(IA.EQ.0) GO TO 150 IF(IA.EQ.-1) GO TO 980 CALL EXEC(2,LOG,15HEQT LOCK FAILED,-15) C C C C FILE MASK, SEEK, WRITE C 150 MSK=4 D7000 FORMAT("WRITING CYL,HD,SEC,L=",4I8) CALL XFMSK(LU,IDVID,MSK,IER) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,ISTAT1,ISTAT2,IER) IF(IER.EQ.2) GO TO 100 IF(IER.EQ.4) GO TO 950 IF(ISTAT2.LT.0) GO TO 900 ISIZE=ISUBC(1)*64 C CALL XDWRT(LU,IDVID,IXBUF,ISIZE,ISTAT1,ISTAT2,IER) IF(IER.EQ.2) GO TO 100 ‘°������þúIF(IER.EQ.4) GO TO 950 C C C CHECK STATUS: IF S1=26B WRITING ON PROTECTED TRACK C IF P BIT WRITING ON PROTECTED TRACK C IF S1 NOT =0 BAD TRACK IS1=IAND(ISTAT1,17400B)/256 IF(IAND(ISTAT1,20000B).NEQ.0) GO TO 850 IF(IS1.EQ.26B) GO TO 800 IF(IAND(ISTAT1,40000B).NEQ.0) GO TO 800 IF(IS1.NEQ.0) GO TO 850 C NOW CHECK STATUS C 400 IF(IAND(IXBUF(16),40000B).EQ.0) GO TO 500 CALL EXEC(2,LOG,40H FOLLOWING TRACK NOT SAVED SUCCESSFULLY:,-40) IUNIT=IAND(IDVID,77B) CALL EXEC(2,LOG,31H TRACK# CYL HEAD UNIT/ADDRESS,-31) CALL XDCAS(LINE(1),3,LTRK) CALL XDCAS(LINE( 5),2,ICYL) CALL XDCAS(LINE( 7),2,IHD) CALL XDCAS(LINE(10),2,IUNIT) CALL EXEC(2,LOG+200B,LINE,-22) 500 CALL XEND(LU,IDVID) C C UNLOCK EQT C IOPT=0 CALL EQTRQ(IOPT,LU) RETURN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ERROR HANDLING C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 800 IF (IPROCT.EQ.1) GO TO 400 CALL EXEC(2,LOG,28H WRITING ON PROTECTED TRACKS,-28) IPROCT=1 GO TO 400 900 IF(IRETRY.EQ.0)CALL EXEC(2,LOG,10HSEEK ERROR,-10) IRETRY=IRETRY+1 IF(IRETRY.GT.10) RETURN GO TO 100 950 CALL EXEC(2,LOG,15HDRIVE NOT READY,-15) CALL EXEC(2,LOG,48HREADY DISC AND ENTER "GO,<PROG-NAM>" TO CONTINUE, X ,-48) PAUSE GO TO 100 C C 850 DO 880 I=1,60 880 LINE(I)=2H C IUNIT=IAND(IDVID,77B) CALL XDCAS(LINE( 9),3,LTRK) CALL XDCAS(LINE(13),2,ICYL) CALL XDCAS(LINE(15),2,IHD ) CALL XDCAS(LINE(18),2,IUNIT) CALL EXEC(2,LOG,17H DEST. SUBCHANNEL,-17) CALL EXEC(2,LOG, X 47H BAD TRACK AT: TRACK# CYL HEAD UNIT/ADDRESS,-47) CALL EXEC(2,LOG,LINE,-60) C IBT=1 GO TO 400 C C 980 CALL EXEC(2,LOG,19HEQT LOCK TABLE FULL,-19) GO TO 500 END ����üe�������� ������������� �������ÿÿ����� ���� ÿý�í�õ ���������ÿ��92067-18547 2001� S C0122 �&COMPR �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Òç�����FTN4,L SUBROUTINE COMPR(IBUFA,IBUFB,LEN,IER),92067-1X547 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: COMPR C SOURCE: 92067-18547 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION IBUFA(1),IBUFB(1) C C IER=0 C DO 10 I=1,LEN IF(IBUFA(I).NEQ.IBUFB(I)) IER=1 10 CONTINUE C RETURN END ��������������������������������������������������En������ÿÿ����� ���� ÿý�î�ô ���������ÿ��92067-18548 2001� S C0122 �&XGTPM �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Ëþ�����þúFTN4,L SUBROUTINE XGTPM(ISTR,N,LOG,IDLU,MTLU,IVRFY),92067-1X548 REV.2001 X 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XGTPM C SOURCE: 92067-18548 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION ISTR(1),IPBUF(10) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GET PARAMETER ROUTINE C C RU,<PROG-NAM>,<LOG LU>,<DISC LU>,<MT LU>,<OPTION>,<TITLE> C C N=1 INDICATES LSAVE OR USAVE C N=0 RESTOR C ISTR-- ARRAY CONTAINING THE RUN STRING C IDLU- DISC LU C MTLU- MAG TAPE LU C IVRFY- 1 FOR VERIFY OR DE OPTION C 0 NO VERFIFY OR ASK OK IN RESTOR C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DO 2 I=1,75 2 ISTR(I)=2H C C C FIRST CHECK DATE CODE OF SYSTEM SOFTWARE IF > THAN 2001 LOG=1 C CALL DATCO(IDATE) IF(IDATE.LT.2001) GO TO 960 C C IPTR=1 CALL EXEC(14,1,ISTR,-80) CALL ABREG(IA,IB) LEN=IB IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,10 10 IF(NAMR(IPBUF,ISTR,LEN,IPTR))500,15 15 ISTR(1)=2H ISTR(2)=IAND(ISTR(2),377B)+20000B IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,20 20 LOG=0 IF(IAND(IPBUF(4),3).EQ.1) LOG=IPBUF(1) IF(IAND(IPBUF(4),3).EQ.0) LOG=LOGLU(ISESS) IF(LOG.LE.0) GO TO 930 C C SEE IF LOG LU IS IN SESSION AND SEE C IF IT IS DISK LU, IF D™‚������þúISK LU, ILLEGAL C CALL EXEC(13+100000B,LOG,IEQT5) GO TO 930 11 IF(IAND(IEQT5,37400B).EQ.15000B) GO TO 930 C C C PARSE DISK LU C IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,30 30 IF(IAND(IPBUF(4),3).NEQ.1) GO TO 700 35 IDLU=IPBUF(1) IF(IDLU.LE.0) GO TO 910 C C C PARSE MTLU C IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 65,40 40 MTLU=0 IF(IAND(IPBUF(4),3).GT.1) GO TO 800 IF(IAND(IPBUF(4),3).EQ.1) MTLU=IPBUF(1) IF (MTLU.LT.0) GO TO 920 IF(IAND(IPBUF(4),3).EQ.0) MTLU=8 IF(MTLU.EQ.0) GO TO 65 IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 75,50 C C 50 IVRFY=0 IF(IAND(IPBUF(4),3).EQ.0) GO TO 80 IF(IPBUF(1).EQ.2HVE) IVRFY=1 IF(IPBUF(1).EQ.2HDE) IVRFY=1 IF(IVRFY.EQ.1.OR.N.EQ.0) GO TO 80 CALL EXEC(2,LOG, X47H ILLEGAL VERIFY PARAMETER- DEFAULT TO NO VERIFY,-47) GO TO 80 C C 65 MTLU=8 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK TO SEE IF MT IS ON-LINE ,IF NOT PRINT MESSAGE AND STOPS C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 75 IVRFY=0 80 IF(MTLU.GE.64) GO TO 800 CALL EXEC(13+100000B,MTLU,IEQT5,ISTAT1,ISTAT2) GO TO 800 81 IF(IAND(IEQT5,37000B)-11000B) 800,88,800 88 IF(IAND(IEQT5,040000B).EQ.40000B) GO TO 890 IF(IAND(ISTAT2,100000B).EQ.100000B) GO TO 890 C C NOW SEE IF MT LU IS LOCKED, IF YES PRINT MESSAGE, IF NOT C SEE IF LOCK IS SUCCESSFUL. C CALL LURQ(140001B,MTLU,1) GO TO 99 89 CALL ABREG(IA,IB) IF(IA.NEQ.0) GO TO 99 C C SEE IF MT ON-LINE C C CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).NEQ.1) GO TO 200 CALL EXEC(2,LOG+200B,17HMAG TAPE OFF-LINE,-17) STOP 66 C C MT LU IS LOCKED C 99 CALL EXEC(2,LOG+200B,12HMT LU LOCKED,-12) STOP 66 C C CHECK DISK LU VALIDITY C 200 IF(IDLU.GE.64) GO TO 250 CALL EXEC(13+100000B,IDLU,IEQT5) -ï������þú GO TO 250 220 IDTYPE=IAND(IEQT5,37400B)/256 IF(IDTYPE.GT.31B.AND.IDTYPE.LT.34B) RETURN 250 CALL EXEC(2,LOG+200B,15HILLEGAL DISK LU,-15) STOP 66 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GET PARAMETER INTERACTIVELY C C FIRST CHECK IF LOG LU IS SUPPLIED, IF YES INVALID 500 LOG=LOGLU(ISESS) CALL EXEC(2,LOG+200B,17HLOGLU DEFAULT TO_,-17) CALL CNUMD(LOG,IPBUF) CALL EXEC(2,LOG+200B,IPBUF,-6) C C ASK DISK LU C 510 CALL EXEC(2,LOG,8HDISK LU?,-8) CALL REIO(1,LOG+400B,ISTR,-6) CALL ABREG(IA,IB) LEN= IB IPTR=1 C C IF(ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2H/E) STOP IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 510,520 C C 520 IF(IPBUF(4).NEQ.1) GO TO 524 IDLU=IPBUF(1) IF(IDLU.LE.0) GO TO 524 C C CHECK IF DISK LU IS VALID C IF(IDLU.GE.64) GO TO 524 CALL EXEC(13+100000B,IDLU,IEQT5) GO TO 524 523 IDTYPE=IAND(IEQT5,37400B)/256 IF(IDTYPE.GT.31B.AND.IDTYPE.LT.34B) GO TO 522 524 CALL EXEC(2,LOG+200B,15HILLEGAL DISK LU,-15) GO TO 510 C C 522 CALL EXEC(2,LOG,18HMT LU? (DEFAULT=8),-18) CALL REIO(1,LOG+400B,ISTR,-6) CALL ABREG(IA,IB) LEN= IB C IF(ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2H/E)STOP C ASK MTLU IPTR=1 IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 530,530 C 530 MTLU=8 IF(IAND(IPBUF(4),3).GT.1) GO TO 532 IF(IAND(IPBUF(4),3).EQ.1) MTLU=IPBUF(1) C C C CHECK IF MTLU IS VALID C IF(MTLU.GE.64) GO TO 532 CALL EXEC(13+100000B,MTLU,IEQT5) GO TO 532 531 IDTYPE=IAND(IEQT5,37400B)/256 IF(IDTYPE.GT.22B.AND.IDTYPE.LE.24B) GO TO 533 532 CALL EXEC(2,LOG+200B,13HILLEGAL MT LU,-13) GO TO 522 C C 533 IVRFY=0 IF(N.EQ.0) GO TO 550 534 CALL EXEC(2,LOG,7HVERIFY?,-7) CALL EXEC(1,LOG+400B,ISTR,-2) IF(ISTR(1).EQ.2HVE.OR.ISTR(1).EQ.2HDE.OR.ISTR(1).EQ.2HYE) IVRFY=Om�����1 IF(ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2H/E) STOP IF(ISTR(1).EQ.2HNO) GO TO 550 IF(IVRFY.EQ.0) GO TO 534 C C 550 DO 600 I=1,50 600 ISTR(I)=2H C C IF SAVE ASK FOR LABEL C THEN CHECK IF MT IS ON LINE C C IF(N.EQ.0) GO TO 80 CALL EXEC(2,LOG,16HFILE ID (LABEL)?,-16) CALL REIO(1,LOG+400B,ISTR(2),-40) GO TO 80 700 CALL EXEC(2,LOG,39H ILLEGAL DISK LU: NON NUMERIC CHARACTER,-39) STOP 66 800 CALL EXEC(2,LOG,14H ILLEGAL MT LU,-14) STOP 66 890 CALL EXEC(2,LOG+200B,13HMAG TAPE DOWN,-13) STOP 66 900 STOP 1 910 CALL EXEC(2,LOG,31H DISK LU MUST BE GREATER THAN 0,-31) STOP 66 920 CALL EXEC(2,LOG,31H MT LU MUST BE GREATER THAN 0 ,-31) STOP 66 930 LOG=LOGLU(ISESS) CALL EXEC(2,LOG,15H ILLEGAL LOG LU,-15) STOP 66 960 CALL EXEC(2,LOG,25H OUTDATED SYSTEM SOFTWARE, -25) STOP 66 END END$ ����������������������������������������������������������������{â������ÿÿ����� ���� ÿý�ï�ø ���������ÿ��92067-18549 2001� S C0122 �&EOTAP �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Åî�����þúFTN4,L SUBROUTINE EOTAP(ITTY,MTLU,IHDR,IBUF,ISIZE X ),92067-1X549 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: EOTAP C SOURCE: 92067-18549 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION IHDR(1),IBUF(1) C C C END OF TAPE WHEN READING (RESTORING) C C 100 CALL EXEC(2,ITTY,11HEND OF TAPE,-11) CALL EXEC(2,ITTY,15HMOUNT NEXT TAPE,-15) CALL EXEC(2,ITTY,32HTYPE "GO" TO CONTINUE ,-32) C C CALL EXEC(1,ITTY+400B,IGO,-2) IF(IGO.NEQ.2HGO) GO TO 100 C C CHECK IF MT LU IS STILL UP C 120 CALL EXEC(13,MTLU,IEQT5) IF(IAND(IEQT5,40000B).EQ.0) GO TO 150 CALL EXEC(2,ITTY,10HMT LU DOWN,-10) CALL EXEC(2,ITTY, X 47HUP THE EQT AND TYPE "GO,<PROG-NAM>" TO CONTINUE, X -47) PAUSE GO TO 120 C 150 CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.1)GO TO 900 C C READ HEADER,PRINT HEADER AND TAPE NO. CALL EXEC(1,MTLU,IHDR,247) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.1) GO TO 970 200 CALL EXEC(2,ITTY,IHDR,-76) CALL EXEC(2,ITTY,8HTAPE # _,-8) CALL XDCAS(IGO,1,IHDR(247)) CALL EXEC(2,ITTY,IGO,-2) C C ASK IF OK TO PROCEED, IF YES ,READ NEXT TRACK FROM TAPE C IF NO ASK AGAIN C CALL EXEC(2,ITTY,4HOK?_,-4) CALL EXEC(1,ITTY+400B,IGO,-2) IF(IGO.EQ.2HNO) GO TO 100 IF(IGO.NEQ.2HYE) G,»��� �� O TO 200 IF(IGO.EQ.2H/E.OR.IGO.EQ.2HEN.OR.IGO.EQ.2HEX)STOP CALL EXEC(1,MTLU,IBUF,ISIZE) CALL ABREG(IA,IB) IF(IAND(IA,1).EQ.1) GO TO 970 RETURN 970 CALL EXEC(2,ITTY,15HMT PARITY ERROR,-15) STOP 66 C C 900 CALL EXEC(2,ITTY,18HMAG TAPE OFF-LINE ,-18) GO TO 100 END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������Ž‡ ������ÿÿ����� ���� ÿý�ð�÷ ���������ÿ��92067-18550 2001� S C0122 �&WREOT �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Íö�����FTN4,L SUBROUTINE WREOT(ITTY,MTLU,IHDR,IBUF,ISIZE X),92067-1X550 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: WREOT C SOURCE: 92067-18550 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION IHDR(1),IBUF(1) C C C C PUMP TAPE NUMBER C 10 IHDR(247)=IHDR(247)+1 C CALL EXEC(2,ITTY,11HEND OF TAPE,-11) CALL EXEC(2,ITTY,15HMOUNT NEXT TAPE,-15) 100 CALL EXEC(2,ITTY,32HTYPE "GO,<PROG-NAM>" TO CONTINUE,-32) C C PAUSE C 120 CALL EXEC(13,MTLU,IEQT5) IF(IAND(IEQT5,40000B).EQ.0) GO TO 150 CALL EXEC(2,ITTY,10HMT LU DOWN,-10) GO TO 100 C C 150 CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,4B).EQ.4) GO TO 900 IF(IAND(IA,1).NEQ.0) GO TO 950 C CALL EXEC(2,MTLU,IHDR,247) CALL EXEC(2,MTLU,IBUF,ISIZE) CALL ABREG(IA,IB) IF(IAND(IA,40B).EQ.40B) GO TO 10 RETURN C C 900 CALL EXEC(2,ITTY,18HWRITE RING MISSING,-18) GO TO 100 950 CALL EXEC(2,ITTY,17HMAG TAPE OFF-LINE,-17) GO TO 100 END END$ ����������������������������������������������������������������������������XÐ������ÿÿ����� ���� ÿý�ñ�÷ ���������ÿ��92067-18551 2001� S C0122 �&MXGTA �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 ÙÛ�����FTN4,L SUBROUTINE MXGTA(LU,IDVID,LTRK,LSEC,ICYL,IHD,ISEC,ITMT X),92067-1X551 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: MXGTA C SOURCE: 92067-18551 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION IREG(2),ITMT(1) C C C C C CONVERT LOGICAL TO PHYSICAL DISC ADDRESS (CYL,HD,SEC) C C NOTRK=ITMT(4) NHEAD=ITMT(3) NHEAD=ISHL(NHEAD,-10) IHD1=IAND(ITMT(3),1760B)/17B IHD=MOD(LTRK,NHEAD)+IHD1 ICYL=(LTRK/NHEAD)+ITMT(2) ISEC=LSEC/2 IDVID=IAND(ITMT(5),16000B)/4 IDVID=IDVID+IAND(ITMT(3),17B) RETURN END END$ ��������������������������Êu������ÿÿ����� ���� ÿý�ò�ø ���������ÿ��92067-18552 2040� S C0122 �&XSECA �DSCLB SUBROUTINE � � � � � � � � � � � � �H0101 ÒË�����FTN4,Q,C SUBROUTINE XSECA(LU,IDVID,ISEC,IER),92067-1X552 REV.2040 800717 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: XSECA C SOURCE: 92067-18552 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C C DIMENSION IBUF(20) C C C REQUEST SECTOR ADDRESS C IUNIT=IAND(IDVID,177400B) ID=IAND(IDVID,7B) IF(IFDVR(LU).EQ.0) RETURN C CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+IDVID CALL XPRTY(IBUF(1)) IBUF(2)=550B IBUF(3)=4 IBUF(4)=1000B IBUF(5)=677B IBUF(6)=500B+ID CALL XPRTY(IBUF(6)) IBUF(7)=100550B C READ 1 WORD INTO BUF(17) C CALL ZSENS(LU,IBUF,1) CALL XDSJ(LU,IDVID,IER) ISEC=IBUF(17) RETURN END END$ ������������������������������������������������������������������������������������������������������������������������������������éH������ÿÿ����� ���� ÿý�ó�ù ���������ÿ��92067-18553 2013� S C0322 �&DV?32 �&?D DIS? D?????- � � � � � � � � � � � � �H0103 T4�����þúASMB,Q,C,N * HED DVA32 12821 (HPIB) RTE DISC DRIVER * HPIB DISK DRIVER WITH SPECIALS * NAME: DVA32 * SOURCE: 92060-18553 * RELOC: 92060-16553/92067-16506 * PGMR: * J.S.W. -- NEW TRACK MAP FORMAT * J.R.S. -- DMA CONFIG...9895 FIRST STATUS CLEAR * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM DVA32,0 92067-16553 REV.2013 800129 XIF IFZ NAM DVC32,0 92067-16506 REV.2013 800129 XIF * * * THIS DRIVER OPERATES UNDER THE CONTROL OF * THE I/O CONTROL MODULE OF THE REAL-TIME EXECUTIVE. * THIS DRIVER IS RESPONSIBLE FOR CONTROLLING DATA * TRANSMISSION WITH A MOVING HEAD TYPE DISC FILE. * * THIS DRIVER MAKES THE MOVING HEAD DISC APPEAR TO * HAVE 64 WORD SECTORS, HOWEVER SPEED IS IMPROVED * IF THE DRIVER DOES NOT HAVE TO DO THIS PROCESSING. * * THIS IS DONE BY ALWAYS STARTING A READ REQUEST ON AN * EVEN SECTOR AND BY ENDING WRITE REQUESTS WITHIN. * ODD SECTORS. * * * ALL DATA TRANSFER IS DONE UNDER DMA CONTROL. * THE USER SPECIFIES TRACK AND SECTOR AND * LENGTH OF EACH REQUEST. * * THE USER MAY SPECIFY * CYCLIC CHECKING BE DONE ON WRITE REQUESTS * BY SETING SUBFUNCTION BIT 8 IN THE WRITE REQUEST. * A FAILED CYCLIC CHECK WILL CAUSE THE WRITE TO BE * RETRIED UP TO TEN TIMES. * * * SPECIAL SYSTEM REQUESTS: A GROUP OF TRANSFERS * MAY BE SPECIFIED BY AN INTERNAL SYSTEM * REQUEST (VIA <XSIO>). THIS REQUEST HAS THE * SPECIAL FORMAT: * * (EQ T7,I) 'CONTAINS A POINTER TO A GROUP OF * 3 OR 4 WORDS CONTAINING THE BUFFER ADDRESS(WOR#.������þúD 1), * LENGTH(WORD 2) AND TRACK/SECTOR(WORD 3 OR IF SIGN * BIT IS SET ON WORD 3 THEN IT IS THE SECTOR (THE SIGN * IS STRIPED) AND WORD FOUR IS THE TRACK) ADDRESS FOR * EACH TRANSFER. THE GROUP OF TRANSFER VECTORS IS * OPEN-ENDED AND IS TERMINATED BY A ZERO-WORD. * ALL TRANSFERS ARE MADE BEFORE A COMPLETION * RETURN TO <CIC> IS MADE. * * * ************************************************************************** * * CONTROL REGISTER FORMAT FOR 12821 HPIB CARD * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * SRQ IFC REN IRL LBO LBI EOI ATN X NRD PPE P/E P L T CIC * ************************************************************************** * IFN ENT IA32,CA32 EXT $TA32,.MVW,$UPIO XIF IFZ ENT IC32,CC32 EXT $TC32,.MVW,$UPIO XIF * * A EQU 0 A REGISTER B EQU 1 B REGISTER . EQU 1650B BASE PAGE ORIGIN EQTA EQU . EQT1 EQU .+8 I/O R QUEST LIST POINTER EQT2 EQU .+9 INITIATION SECTION ADDRESS EQT3 EQU .+10 COMPLETION SECTION ADDRESS EQT4 EQU .+11 I/O ASSIGNMENT EQT5 EQU .+12 DEVICE STATUS INFO EQT6 EQU .+13 I/O REQUEST INFO EQT7 EQU .+14 REQUEST BUFFER ADDRESS EQT8 EQU .+15 REQUEST BUFFER LENGTH EQT9 EQU .+16 REQUEST TRACK # EQT10 EQU .+17 SECTOR # EQT11 EQU .+18 DRIVER TEMP EQT12 EQU .+81 XMIT LOG EQT13 EQU .+82 NOT USED EQT14 EQU .+83 TIME-OUT VALUE SET BY USER OF RTGEN EQT15 EQU .+84 TIME-OUT CLOCK * IBI EQU 26B SELECT CODE FOR IBI CARD * CHAN EQU .+19 DMA CHANNEL * INTBA EQU 1654B DUMMY EQU 1737B * IF REQ TRACK > LAST TRACK IN SUB OR -1 AND READ * RETURN LAST TRACK AND SECTOR PER TRACK * * SYSTEM TRIPLET FORMAT (XSIO CALL): * * 1ST WORD - REQ BUFFER ADDRESS * 2ND - LENGTH * 3RD - TRACK/SECTOR * TERMINATED BY 0 * * * ’E������þú SKP * I.34 DEC -1 -1 MEANS NO IO IN PROGRESS STA SCODE SAVE DEVICE CODE JMP CONFI CONFIGURE SELECT CODR AND I/O LDA CHAN GET DMA CHANNEL # ADA STF COFIGURE STF DMA STA STFD SET STF DMA ADA B500 STA OTAD CONFIGURE ALL DMA INSTRUCTIONS XOR B1100 STA STCDC START DMA INSTRUCTION XOR B5000 STA CLCD INHIBIT DMA INTERRUPT INSTR STA CLCD1 INHIBIT DMA INTERRUPT INSTR 800114 JRS XOR B4 STA CLCD2 XOR B4000 STA STCD2 XOR B100 * STA OTAD2 STA OTAD3 ADA BM100 STA LIAD2 * *********************************************** * NOW SET UP EXIT FLAGS AND RETURN ADDRESS * ********************************************** * CLA A=0 => I.XX STA XFLAG INDICATE EXIT FLAG STA TFLAG CLEAR TIME OUT FLAG * LDA I.34 GET RETURN ADDRESS STA C.34 SET IT * * SET UP TB34 ENTRY ADDRESS AND CHECK FOR ILLEGAL SUBCHANNEL # * * LDA EQT4,I GET UNIT AND CHANNEL # * IF DMA NOT ASSIGNED REJECT CALL**** * (MAY NOT NEEDED) * SSA,RSS DMA BIT (15) SET? JMP REJCT NO DMA, REJECT IOR BIT12 ENABLE TIME-OUT FOR DRIVER STA EQT4,I SET IT RRR 6 BITS 6-10 HAS UNIT # AND B37 EXTRACT UNIT # STA B SAVE IN B STA SUBC# SAVE SUBCHANNEL# ADB TB34A,I NEG SUBC# SSB,RSS IF POSSITIVE JMP REJCT REJECT * * * 5 WORD PER ENTRY * MPY B5 STA .SUBC SAVE SUBCHANNEL ENTRY ADDRESS * * LDA EQT6,I GET REQUEST CODE AND B3 BIT 0 & 1 HAS ICODE CPA B3 CONTROL REQUEST? JMP $CNTL CONTROL REQ * STA REQC SAVE REQ CODE LDA BM12 RESET COUNTER STA ERCTR ERROR RETRY COUNTER * * * LDA EQT6,I GET REQUEST CODE SYS2 LDB �c������þúEQT7,I GET BUFFER ADDRESS SSA SYSTEM CALL? JMP SYS YES GO DO SYSTEM CALL * * LNTS LDA EQT6,I GET REQ CODE RAR,CLE,ELA SET RBL,ERB SIGN OF BUFFER ADDRESS TO SHOW DIRECTION STB EQT11,I AND SAVE FOR TRIPLT CALL * LDA EQT8,I GET XFER LENGTH STA EQT12,I SET IT FOR RETURN SSA,RSS MAKE IT NEGATIVE WORD COUNT CMA,INA,RSS ARS IF CHAR COUNT, TAKE HALF STA EQT8,I SET IT UP FOR READ/WRITE SZA CHECK FOR ZERO XFER JMP TIPLT GO PROCESS $TB34 OR SYSTEM TRIPLET * EOXF LDA EQT6,I GET REQ CODE SSA SYYTEM CALL? JMP SYS2 YES SYRTN JSB ENDCM SEND END COMMAND .RTN. LDB EQT12,I GET XMIT LOG CCE,SSB SET TO POSITIVE CMB,INB IF NEGAIVE JMP DONE NO,RETURN ********************************************************** * * CONTROL REQUEST: * SUBFUNCTION=0 => PROGRAM ABORTND SEND IFC * UNADDRESS DEVICE AND IFC * NOT=0=> IGNORE, RETURNS IMMEDIATELY * * ********************************************************** * MASK7 OCT 77774 MASK FOR BITS 3 TO 14 * $CNTL LDA EQT6,I GET REQUEST CODE & SUBFUNCTION AND MASK7 EXTRACT BITS 3-14 SZA,RSS IF ZERO MEANS PROGRAM ABORT JMP CLEAR CLEAR CARD RETURN * JSB $UNLS UNADDRESS DEVICE CB LDA IFCTL SET UP CONTROL REG FOR IFC JSB SETC SET IBI CLC08 CLC IBI CONTROL MODE LIA01 LIA IBI GET STATUS STC08 STC IBI DATA MODE AND BIT7 GET BIT 7 (IFC) SZA CLEAR? JMP CLC08 NO TRY AGAIN CLA CLEAR FIFO JSB CFIFO JMP DONE IMMEDIATE COMPLETION * IFCTL OCT 40001 * CLEAR JSB CFIFO CLA JSB SETC JMP DONE * ********************************************** * * CONSTANT POOL * * **********§«������þú**************************************** EQT# NOP B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B17 OCT 17 B37 OCT 37 B177 OCT 177 B377 OCT 377 B500 OCT 500 B1100 OCT 1100 B5000 OCT 5000 BIT12 OCT 10000 SET BIT 12 BM100 OCT -100 BM12 DEC -10 B100 OCT 100 B4000 OCT 4000 BIT11 EQU B4000 STF STF 0 REQC NOP REQUEST CODE (1=READ,2=WRITE) SCODE OCT 14 SELECT CODE FOR CARD XFLAG NOP EXIT FLAG: 0 => I.34, NONZERO => C.34 IFN TB34A DEF $TA32 ADDRESS OF TRACK MAP TABLE XIF IFZ TB34A DEF $TC32 ADDRESS OF TRACK MAP TABLE XIF .TB34 NOP POINTER FOR SUBCHANNEL ENTRY TPER NOP RETRY COUNTER ERCTR NOP SECTR NOP # SECTOR PER TRACK MXSIZ NOP # OF WORDS PER TRACK * SUBC# NOP SUBCHANNEL ENTRY# .SUBC NOP SUBCHANNEL ENTRY ADDRESS CHDSC NOP * ******************************************************** * * REJECT CALL,RETURN TO RTIOC * ********************************************************* TEMP NOP TEMPORY STORAGE FOR SYSTEM CALL (XSIO) REJCT EQU * CLA,INA REJECT CALL,A=1 JMP I.34,I REJECT CALL * *********************************************************** * * * SPC 5 SYS STB TEMP SYSTEM TRIPLE PROCESSOR INB STEP TO THE ADDRESS OF LDA B,I LENGTH AND STORE IT IN STA EQT8,I EQT 8 INB STEP TO DISC ADDRESS LDA B,I GET THE ADDRESS RAL,CLE,SLA,ERA IF FOUR WORD ENTRY INB,RSS STEP TO THE TRACK AND SKIP MASK AND B177 MASK THE SECTOR AND STA EQT10,I SET IT IN THE EQT XOR B,I GET THE TRACK ADDRESS ALF,ALF ROTATE TO LOW A RAL SEZ IF FOUR WORD ENTRY USE LDA B,I FULL FOURTH WORD FOR TRACK STA EQT9,I AND SET IN THE EQT INB STEP TO ADDRESS OF NEXT TRIPLET STB EQT7©¦������þú,I AND SET IT IN EQT 7 LDB TEMP,I GET THE BUFFER ADDRESS SZB IF ZERO THEN DONE JMP LNTS AGAIN JSB STATR LDA PPCTL FORCE A DUMMY INTERRUPT JSB SETC P POLL JSB WEXIT JMP SYRTN SEND END COMMAND AND RETURN * * * SKP * TRIPLET PROCESSER-- PROCESS $TB34 INFO :: TRANSLATE LOGICAL TRACK * AND SECTOR WITH SUBCHANNEL INTO PHYSICAL DISK ADDRESS * $TA32 FORMAT: * * WORD * 0 $TA32 NEGATIVE # OF SUBCHANNEL * 1 # OF SECTORS PER TRACK * 2 CYLINDER # OF TRACK 0 * 3 BITS 10-15: # HEADS THIS SUBC * 4-9 : STARTING HEAD# * 3-0 : HPIB DEVICE ADDRESS * 4 # OF TRACKS IN THIS SUBCHANNEL * 5 CONTROLLER/UNIT/ # OF SPARES * (REPEAT 1-5 FOR N SUBCHANNEL) * * EQT8-- REQ LENGTH * EQT9-- REQ TRACK # * EQT10- REQ SECTOR # * SPC 5 B16K OCT 16000 FCODE NOP B2301 OCT 2301 B2200 OCT 2200 UNIT# NOP UNIT # OF THIS HPIB ADDRESS BM10 OCT -10 B2300 OCT 2300 * TIPLT EQU * LDA .SUBC GET SUBCHANNEL ENTRY DISPLACEMENT ADA TB34A ADD TO $TB34 ADDRESS INA STEP 1ST WORD OF $TB34 (COUNTER) STA .TB34 SAVE SUBCH ADDRESS * LDA EQT6,I GET REQUEST CODE CPA B2301 SUBFUNCTION CODE=23 AND READ? JMP FUSTA YES, FULL STATUS AND B2300 EXTRACT BITS 6-10 STA FCODE SAVE FUNC. CODE CPA B2200 SPECIAL CALL? SUBF=22? JMP $SPCL YES, DO SPECIALS * * LDB .TB34,I GET 1ST WORD CONTENT--SECTOR # STB SECTR ISZ .TB34 * CLA PREVENT OVERFLOW ASL 6 SECTOR * 64 TO MAKE WORD PER TRACK STB MXSIZ SAVE IT * * DLD EQT9,I GET TRACK AND SECTOR * SEE IF TRACK = -1 * INA,SZA,RSS *TRACK= -1? 3Â������þú JMP CK02 YES DONT REJECT * LDA EQT9,I GET TRACK# SSA,RSS IF EITHER IS NEGATIVE SSB GO REJECT JMP REJCT * CLA ASL 6 REQUEST SECTR *64 CMB,INB MAKE IT NEGATIVE ADB EQT8,I ADD XFER LENGTH ADB MXSIZ SUBTRACT MAX WORD PER TRACK SOS IF REQUEST TOO MANY WORDS SSB JMP REJCT REJECT CALL # * * CK02 EQU * LDA BM12 STA VRER SET ERROR RETRY COUNT LDA .TB34,I GET STARTING CYL # STA CYL01 SAVE IT ISZ .TB34 * * NOW SET UP UNIT # * LDA .TB34 ADDRESS FOR 3 WORD OF TA32 ADA B2 5TH WORD LDA A,I GET CONTENT OF 5TH WORD AND B16K MASK OUT UNIT # ALF PUT UNIT # IN ITS PLACE RAL,RAL STA UNIT# SAVE IT * DLD .TB34,I GET WORD 3,4 OF &TB34 * A HAS HEAD,SURF,UNIT# * B HAS # OF TRACK IN THIS SUBCH AND B17 ISOLATE UNIT # STA ADDRS HPIB ADDRESS * LDA EQT9,I GET TRACK # INA,SZA,RSS IF -1 RETURN LAST TRACK JMP EOT * LDA B # OF TRACKS IN THIS SUBCH CMA,INA NEGATE ADA EQT9,I ADD TO REQ TRACK # TO CHECK SSA IF REQ TRACK > TRACK IN SUBCH JMP CONT NO,OK EOT LDA EQT5,I SET END OF TAPE IN EQT 5 IOR B40 STA EQT5,I UPDATE EQT5 * LDA REQC GET REQUEST CODE SLA,RSS IF WRITE REQUEST JMP XOUT DONT RETURN SECT/TRK * LDA EQT7,I GET IBUFR ADDRESS STA UBUF SAVE IT IN UBUF LDA SECTR GET #SECTR/TRK STA UBUF,I RETURN IT IN IBUF(1) JMP XOUT IMMEDIATE COMPLETION TRACK TOO LARGE * * * * FUSTA-- GET FULL STATUS AND STORE IN IBUFR 1-4 * * * * FUSTA LDB EQT7,I GET IBUFR ADDRESS STB UBUF SET UP POINTER LDA EQT8,I GET ${������þúLENGTH ADA B2 CHECK IF LENGTH =2 SZA YES,RETURN CURRENT STATUS JMP GT2ST RETURN OLD AND NEW * * CSTAT JSB STATR GET CURRENT STATUS DLD S1 GET S1 S2 DST UBUF,I PUT INTO IBUFR 1,2 LDB EQT8,I JMP DONE * * GT2ST ADA B2 MAKE SURE LENGTH =4 SZA JMP REJCT IF NOT REJECT * ADB B2 IBUFR(3) ADDRESS STB TPBUF SET POINTER DLD S1 GET S1 S2 (OLD) DST TPBUF,I STORE THEM IN IBUF 3 4 JMP CSTAT GET CURRENT STATUS * * * * * CONT EQU * * JSB $UNLS JSB DSJ SEE IF DISK IS READY SZA,RSS IF DSJ NOT 0 CHECK STATUS JMP ST.OK IF ZERO EVERYTHING OK JSB STATR CHECK STATUS RAR,RAR BIT 1 OF S2 SLA SET? JMP NRERR ST.OK LDA .TB34,I GET HEAD& DEVICE ADDRESS ALF,RAL # HEAD IN LOW A RAL SHIFT 6 BITS LEFT TO GET HEAD# AND B77 ISOLATE # OF HEAD STA HEAD# SAVE LDA EQT9,I GET REQ TRACK CLB CLEAR B FOR DIVIDE DIV HEAD# TRACK/# HEADS * A= CYL OFFSET / B= HD OFFSET ADA CYL01 QUOTIENT ADD TO BASE CYLINDER STA TRACK SAVE TRACK # FOR RD.WR COMPARE ASR 8 PUT HEAD# IN BITS 7 TO 15 LDB .TB34,I BLF ADA B AND B374H LDB EQT10,I GET SECTOR CLE,ERB TAKE 1/2 OF IT * ADA B COMBINE HEAD WITH SECTORFOR COMPARE TIPRT STA CHDSC SAVE FOR CYCL CHECK * STA HDSC SAVE IT FOR COMPARE LDB EQT8,I BRING IN THE LENGTH STB TPLN SET IN FOR READ/WRITE LDB EQT11,I AND THE STB TPBUF BUFFER ADDRESS SPC 4 LDA TPLN PRESENT A FOR EVEN SECTOR LDB EQT10,I GET SECTOR CCE,SLB,RSS IF EVEN SECOTR JMP TPNXT NO PATCHING * LDB BUFA ELSE READ ^S������þú LDA DM128 128 WORDS TO JSB RD.WR LOCAL BUFFER LDA HLBUF SET MOVE BUFFER STA LBUFP ADDRESS LDB TPLN GET LENGTH ADB B100 LESS 64 LDA TPLN USE MIN OF REQUEST CLE,SSB AN LDA BM100 64 LDB TPBUF GET ADDRESS ELB,RBR CLEAR SIGN AND SET READ/WRITE JSB MOVE GO MOVE THE WORDS LDA DM128 SET TO WRITE LDB BUFA THE SECTOR SEZ,RSS WRITE REQUEST? JSB RD.WR YES WRITE IT OUT LDA BM100 UPDATE POINTERS * TPA CMA,INA TO REFLECT STA MOVE LAST TRANSFER ADA TPBUF ADJUST BUFFER ADDRESS STA TPBUF TPBUF=TPBUF+(-(-A REGISTER)) LDA MOVE LENGTH THAT HAS BEEN XFERED ADA B100 ROUND UP THE COUNT CLB CLEAR B FOR SHIFT LSR 7 SHIFT TO GET SECTOR COUNT ADA HDSC ADD TO THE CURRENT SECTOR STA HDSC SAVE FOR NEXT ACCESS LDA TPLN GET THE LENGTH ADA MOVE SUBTRACT THE NUMBER XFERED CLE,SSA,RSS IF NON LEFT CHECK JMP CYCK FOR CYCLIC CHECK * STA TPLN SAVE UPDATED LENGTH * TPNXT LDB TPBUF GET BUFFER ADDRESS CLE,SSB READ? JMP TPRD NO GOT TRANSFER LAST WORDS * ADA B100 CCE,SSA,RSS JMP TPB * LDA TPLN YES,TEST FOR MORE THAN/LESS THAN AND B100 64 WORDS MOD 128 LEFT STA B SAVE FLAG ADA TPLN GET LENGTH TO SET FOR XFER CLE,SZB IF LESS THAN 64 MOD 128 LEFT AND DM128 DELETE EXCELL OVER EVEN SECTOR LDB TPBUF GET BUFFER ADDRESS TPRD ELB,RBR SET READ/WRITE FLAG JSB RD.WR DO THE XFER LDA LN.N GET THE LENGTH JMP TPA GO UPDATE THE POINTERS * * TPB LDA DM128 WRITE OF LAST 64 WORD IN LDB BUFA FIRST HALF OF SECTOR STB LBUFP SET UP JSB RD.WR ANlš������þúD READ THE SECTOR LDA TPLN SET UP TO LDB TPBUF MOVE THE USER WORDS JSB MOVE GO MOVE TO THE BUFFER LDA DM128 WRITE THE BUFFER OUT AGAIN LDB BUFA JSB RD.WR * SPC 4 CYCK LDA EQT6,I REQUEST FOR CYLIC CHECK? AND B2002 CPA B2002 AND WRITE? RSS JMP EOXF NO,RETURN * * LDB CHDSC GET HEAD/SECTOR STB HDSC SET IT LDA TRACK GET TRACK JSB SEEK DO A SEEK LDB EQT8,I GET LENGTH CMB,INB CALCULATE # OF SECTORS LDA EQT10,I TRANSFERRED B10 SLA START ODD ADB B100 ADD 64 ADB B177 ROUND UP NEXT HIGHER SECTOR LSR 7 JSB VERFY DO VERIFY JSB STATS GET STATUS JMP BADV BAD NEWS JMP EOXF OK RETURN * * BADV LDA CHDSC ISZ VRER STEP VERIFY ERROR COUNTER JMP TIPRT RETRY JMP PARER TOO MANY! PARITY ERROR * * * * * * * VRER NOP VERIFY RETRY COUNTER B2002 OCT 2002 VERIFY AFTER WRITE REQUEST CODE LBUFA DEF BUF BUFA EQU LBUFA HLBUF DEF BUF+64 HIGH PORTION OF LOCAL BUFFER TPLN NOP TPBUF NOP DM128 DEC -128 B77 OCT 77 B374H OCT 37400 * SKP * * * * * *RD.WR-- READ/WRITE SUBROUTINE * * *READ=01 WRITE=10 IN EQT7 * E=0 => WRITE * E=1 => READ * * B= BUFFER ADDRESS * * A = -LENGTH IN WORDS * * * * * RD.WR NOP * STB UBUF SAVE BUFFER ADDRESS STA LN.N SAVE LENGTH * * SEE IF R/W TO SAME SUBCHANNEL# ,TRACK AND HEAD/SECTOR * LDB SUBC# GET SUBCH # CPB LSUBC SAME AS LAST SUBCH? RSS YES, SAME SUBCH, CHECK TRACK STA LTRK NO,DIFFERENT SUBCH:- SET TO NEGATIVE * TO FAIL NEXT TEST * LDB TRACK GET CURRENT TRACK CPB LTRK SAME AS IN LOCAL BUFFER? LDB BM10 YES qi������þú B=-8 * LDA BM7 GET COUNT STA TPER INIT ERROR COUNTER * LDA HDSC CHECK THE HEAD/SECTOR CPA LHDSC SAME AS IN LOCAL BUFFER? INB YES B=B+1 LDA LN.N UNDER 129 WORDS? SEZ,RSS IF WRITE JMP WRT1 GO DO WRITE TESTS * ADA D128 REQUEST? CPB BM7 ALL CONDITION MET? SSA MET? JMP RD2 NO GO READ * LDA LBUFA YES SET FOR MOVE CPA UBUF IF DATA IS WANTED IN LOCAL BUFFER JMP CLE CLEAR E AND RETURN * STA LBUFP SET UP FOR LDA LN.N MOVE LDB UBUF JSB MOVE AND MOVE DATA CLE CLE SET E FOR CONTINUATION JMP RD.WR,I RETURN B40 EQU CLE SPC 5 RD2 LDB UBUF READ CPB LBUFA TO LOCAL BUFFER? STB LTRK SHOW LOCAL SECTOR BUFFER EMPTY WRT1 SSB,RSS IF SAME TRACK JMP WRIT DIFFERENT TRACK SKIP * ADA D128 AND REQUEST TO WRITE MORE THAN 128 CLE,SSA,RSS WORDS OR CPB BM7 TO WRITE ON LOACAL SECTOR STB LTRK YES SETR TO SHOW LOCAL BUFF EMPTY * RE.SK ISZ TPER RSS JMP PARER FAILED 6 TIMES GO PARITY ERROR WRIT LDA TRACK SET UP TRACK# & HD/SEC FOR SEEK LDB HDSC JSB SEEK SEEK CYL,HEAD&SECTOR JSB DSJ GET DSJ RESPONSE SZA,RSS ANY ERROR JMP SKOK NO,ERROR JSB STATR RAR,SLA,RAR IF BIT 13 (NOT READY) SET JMP NRERR NOT READY ABORT RAR,SLA IF SEEK CHECK BIT SET JMP RE.SK RE-SEEK RAR,SLA CHECK FIRST STATUS BIT...IF SET RETRY SEEK JMP RE.SK RE-SEEK JRS 800129 * SKOK EQU * * * CALL READ/WRITE TO DO DISK OP * * E=0 FOR READ E=1 FOR WRITE (AFTER CME INSTR) SEZ,CME FLIP E FOR RETRY , IF READ JMP .RD ADDRESS DEVICE JSB WRITE ADDRESS TO LISTEN JMP *+2 ÑÝ������þú .RD JSB READ DO READ * LDA UBUF GET USER BUFFER ADDRESS SEZ,RSS READ? (E=0 FOR READ, E=1 FOR WRITE ) ADA SIGNB SET SIGN IN BUFFER ADDRESS FOR READ * * CALL STDMA TO SET UP DMA, CHECK FOR PRIV. SYSTEM, ENABLE DMA INTR * IF PRIV. SYS. START DMA, WAIT AND ABORT DMA * JSB STDMA DO THE DMA STUFF JSB $UNLS UNADDRESS DEVICE LIAD2 LIA 2 GET DCPC WORD COUNT JSB STATS REQUEST STATUS JMP WRIT ERROR RETRY * LDA UBUF WAS XFER TO LOCAL BUFFER? CPA LBUFA RSS JMP RD.WR,I NO RETURN * LDA TRACK UPDATE ALL FLAGS AND STA LTRK LOCAL BUFFER LDA HDSC DISK ADDRESS STA LHDSC * LDA SUBC# UPDATE LAST SUBCHANNEL# STA LSUBC JMP RD.WR,I RETURN * LSUBC OCT -1 LAST SUBCHANNEL# TRACK NOP LTRK OCT -1 HDSC NOP LHDSC NOP LAST HEAD/SECTOR# LN.N NOP UBUF NOP D128 DEC 128 BM7 OCT -7 * * THE FOLLOWING CODES HANDLE READ/WRITE OPERATION USING DMA IN A PRIV. * SYSTEM. IF PRIV. SYSTEM, INHIBIT DMA INTERRUPT AND SET SIGN BIT * OF INTERRUPT ENTRY IN INTERRUPT TABLE FOR DMA CHANNEL 6 OR 7 * THEN WAIT FOR DMA COMPLETION, ABORT DMA, CLEAR THE ENTRY AND EXIT * IF NOT A PRIV. SYSTEM, SEE IF READ, IF NO, INHIBIT DMA INTERRUPT. * STDMA NOP CLCD2 CLC 2 SET DMA CONTROL OTAD2 OTA 2 SEND BUFFER ADDRESS LDA SCODE GET SELECT CODE OTAD OTA 6 SEND TO DMA LDA LN.N GET XFER LENGTH STCD2 STC 2 SET UP DMA WORD 2 OTAD3 OTA 2 SEND LENGTH * * SEE IF PRIVELEGED SYSTEM, SET BIT 15 OF DMA ASSIGNMENT TO * ENABLE DMA INTERRUPT IN READ . * CLF 0 INTERRUPT OFF STCDC STC 6,C STAT DMA HERE * CLA IF NOT A PRIV. SYSTEM CPA DUMMY IGNORE THE FOLLOWING JMP X NO SPECIAL PROCESSING NEEDED * CLCD CLC 6 INHIBIT DMA INTERRUPT HERE (LET RTIOC DO IT LATER) d���N��LH * SEZ IF WRITE JMP INTON DONT WANT DMA INTERRUPT, JUST WAIT FOR THE CARD * READ LDB INTBA GET INTERRUPT TABLE ADDRESS LDA STCDC FIND OUT CHANNEL 6 OR 7 SLA IF CHANNEL 6 SKIP INB CHANNEL 7 GET SECOND WORD STB .CHAN SAVE THE ENTRY ADDRESS LDA B,I GET CONTENT IOR SIGNB SET SIGN BIT STA B,I RESTORE, SET SIGN BIT INTON STF 0 RE-ENABLE INTERRUPT JMP XWAIT WAIT FOR DMA DONE * X SEZ IF WRITE REQUEST CLCD1 CLC 6 INHIBIT DMA INTERRUPT XWAIT EQU * JSB .WAIT WAIT FOR XFER DONE STFD STF 6 ABORT DMA * * IF PRIV. SYSTEM CLEAR INTERRUPT TABLE ENTRY BIT 15 TO PREVENT * FURTHER INTERRUPT FORM DMA * IF NOT PRIV. SYSTEM RETURN * CLA IF PRIV. SYSTEM CPA DUMMY SKIP TO CLEAR INTBA JMP STDMA,I ELSE RETURN LDA .CHAN,I GET DMA INTERRUPT ENTRY ADDRESS AND SMSK MASK OUT SIGN BIT STA .CHAN,I PUT IT BACK JMP STDMA,I * SMSK OCT 77777 CLEAR SIGN BIT MASK .CHAN NOP * ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������zAN������ÿÿ��������þú SKP * STATUS ROUTINE * * CALLING SEQUENCE * * JSB STATS * <RETRY RETURN> * <OK RETURN> * * * STATUS 1 WORD MEANING AND ACTION * * * CODE PROBLEM ACTION * * 00 NO ERROR OK RETURN * 07 CYL COMP ERR RECALIBRATE-- SEEK TO TRK 0 SECT 0 * 10 DATA ERROR RETRY (UP TO 10 TIMES) * 11 HEAD/SECT COMP RECALIBRATE (AS IN 07) * 16 OVERRUN RETRY FOREVER * * 20 ILL TRACK PARITY ERROR EXIT * 22 NOT READY RETRY * 23 STATUS 2 IF PROTECT THEN PARITY ERR ELSE * NOT READY RETURN * 26 WRITE PROTECT * * -- ALL OTHERS NOT READY ABORT * * * STATS NOP JSB STATR GET STATUS * LDB S1CD GET S1 SZB,RSS ANY ERROR? JMP OKEX NO,EXIT * CPB B20 ILLEGAL TRACK? JMP PARER YES * CPB B26 WRITE PROTECT? JMP PARER PARITY ERROR RETURN * CPB B23 STATUS 2 ERROR JMP NR? CHECK NOT READY * CPB B16 RETRY OVERRUNS? JMP REXIT FOR EVER * ISZ ERCTR STEP ERROR COUNT RSS STILL OK CONTINUE JMP PARER TOO MANY ERRORS * CPB B7 FOR CYL ERROR RSS RECALIBRATE * CPB B11 AND HEAD/SECT COMP ERROR JMP RECAL RECALIBRATE * JMP REXIT ELSE RETRY * * OKEX LDB BM12 RESET ERROR COUNT STB ERCTR * ISZ STATS PUMP RETURN ADDRESS FOR OK RETURN JMP STATS,I RETURN * * NR? ALF,ALF IF PROTECTED SEZ,SSA IF SWITCH OFF AND WRITE JMP PARER TAKE PARITY ERROR EXIT JMP NRERR ELSE TAKE NOT READY EXIT * * RETRY XFER, SET E= NOT E WANT SAME OPERATION * (E WAS FLIPPED IN RD.WR) * * RACALIBRATE-- * * FOR 7902,7910- SEEK TO TRACK 0 SECTOR 0 * THEN SEEK TO TARGET SECTOR * FOR IDC-- SEND RECALIBRATE COMMAND * * š‰������þúRECAL EQU * ELB SAVE E REGISTER LDA SECTR GET #SEC/TRK ADA BM96 FIND OUT IF 7902 OR 10 ERB RESTORE E REGISTER SSA SEC/TRK>64 JMP R7902 NO,MUST BE 7902 OR 10 JSB OTBUS SEND COMMAND OCT 440 PRIMARY LISTEN OCT 550 SECONDARY GET OCT 1 OP CODE OCT 100000 LBO JSB $UNLS JMP REXIT RETRY * * *RE-SEEK * R7902 CLA SEEK TO TRACK 0 CLB HEAD/SECTOR 0 JSB SEEK * LDA TRACK SEEK BACK TO TARGET TRACK LDB HDSC JSB SEEK JMP REXIT * * REXIT CME SET E TO NOT E JMP STATS,I RETRY EXIT * B26 OCT 26 B23 OCT 23 B16 OCT 16 B7 OCT 7 B11 OCT 11 BM96 DEC -96 SKP * SKP BM1K DEC -200 2 SECOND TIME OUT WEXIT NOP WAIT EXIT ELB SAVE E REGISTER IN MOVE STB MOVE BEFORE EXIT TO RTE LDB EQT14,I GET TIME OUT VALUE FROM EQT14 SZB,RSS IF USER SET IT, SKIP LDB BM1K ELSE PICK UP THE 2 SECOND TIME OUT STB EQT15,I SET TIME OUT TO 2 SECONDS LDB XFLAG GET EXIT FLAG SZB IF C.34 IGNOR ISZ C.34 PUMP RETURN ADDRESS FOR CONTINUATION RTN CLA A=0 RETURN CODE EXIT EQU * STCC7 STC IBI,C ENABLE INTERRUPT JMP C.34,I RETURN TO RTIOC * * DONE LDA PPCTL DO PPOL BEFORE LEAVING JSB SETC $SRTN CCA CLEAR STA I.34 THE IO IN PROGRESS FLAG LDA XFLAG GET EXIT FLAG SZA XFLAG=0 => I.34 JMP RTN ELSE C.34 RETURN XOUT LDA B4 IMMEIATE COMPLETON JMP EXIT EXIT * * NOT READY RETURN * * * M8 DEC -8 NRERR JSB ENDCM SEND END COMMAND TO.RT LDA ADDRS GET HPIB ADDRESS ADA M8 ADDR-8=COUNTER CLB,CCE E=1,B=0 ELB SHIFT BIT IN PLACE INA,SZA v������þúDONE? JMP *-2 NOT YET LDA B PUT IN A IOR DVCNR COMBINE PREVIOUS STA DVCNR SAVE NR DEVICE ADDRESS JSB CFIFO LDA PPCTL DO PARALLEL POLL STA TFLAG SET TIME OUT FLAG JSB SETC LDB XFLAG GET EXIT FLAG (I.34 OR C.34) CLA,INA A=1 RETURN CODE * SZB,RSS IF FLAG= 0 SET A=1 FOR I.34 PARER LDA B3 CCB SET I.34 TO -1 STB I.34 LDB EQT9,I GET REQ TRACK # FOR RETURN JMP EXIT * ************************************************************** * * COMPLETION/CONTINUTION POINT * **************************************************************** * * C.34 NOP STA XFLAG SET XFLAG TO NONZERO INDICATE C.34 RETURN * * IF INTERRURPT IS UNEXPECTED GO CHECK DEVICE UP * ISZ I.34 SEE IF INTERRUPT IS DUE TO NORMAL IO OR POWER UP RSS IF NOT -1 NORMAL IO JMP TOUT2 TIME-OUT OR POWER UP REENTRY HERE LDA MOVE RESTORE E REGISTER ERA FROM MOVE LDA BIT11 BIT 11 MASK AND EQT4,I SZA,RSS IS BIT 11 SET? TIME-OUT JMP WEXIT,I NO TIMEOUT,RETURN TO WAIT ROUTINE * * WE HAVE A TIME OUT HERE * * TFLAG= ZERO MEANS REQUEST IN PROGRESS * = NONZERO UNEXPECTED INTERRUPT, IGNORE * CCA CLEAR REQUEST IN PROGRESS FLAG STA I.34 LDA TFLAG GET TIME OUT FLAG SZA IF ZERO SEE IF NR JMP IGNOR UNEXPECTED INTERRUPT JSB CFIFO CLEAR FIFO CLA CLEAR JSB SETC CONTROL REGISTER OF CARD LDA FCODE GET SUBFUNCTION CODE CLB CLEAR XMIT LOG SZA IF FUNCTION CODE NOT ZERO JMP RTN MUST BE SPECIALS, RETURN JMP TO.RT TIME OUT, NOT READY * * TIME-OUT PROCESSOR * * * WE ARE HERE 'CAUSE OF INTERRUPT DUE TO TIME OUT OR P POLL * * TOUT2 LDA BIT11 CLEAR TIME-OUT BIT IN EQT40B������þú STA TFLAG SET TIME OUT FLAG TO IGNORE EXTRA NR MSG CMA AND EQT4,I CLEAR TIME OUT BIT STA EQT4,I UPDATE EQT4 PLOOP JSB PPOL DO P POLL LDA DVCNR GET NR DEVICE ADDRESS IOR PPRPS COMBINE WITH POLL RESULT XOR DVCNR EXTRACT UNEXPECTED RESPONSE SZA,RSS IF ZERO JMP UPDVC UP EQT * * GO THRU EACH BIT TO SEE IF IT NEEDED DISABLED LDB M8 SLA CHECK BIT 0 AND SHIFT JSB DSPOL SEND END CMD TO DISABLE POLL CLE,ERA NEXT BIT INB,SZB ALL? JMP *-4 MORE CCA RESET I.34 TO INDICATE NO ACTIVE IO STA I.34 SO THAT NEXT INTERRUPT WILL COME HERE JSB CFIFO CLEAR FIFO LDA PPCTL CONDUCT PARALLEL POLL AGAIN JSB SETC SET CARD TO PPOL JMP IGNOR RETURN TO RTIOC (IGNORE INTERRUPT) * * P POLL REPONSE VS. HPIB ADDRESS * *POLL RESP BIT 7 6 5 4 3 2 1 0 * ADDRESS 0 1 2 3 4 5 6 7 * * DSPOL NOP STA SAVE1 STB SAVE2 SAVE A,B CMB STB ADDRS SET ADDRESS FOR END CMD JSB DSJ DO DSJ TO CLEAR HOLD OFF LDA SAVE1 RESTORE A,B LDB SAVE2 JMP DSPOL,I RETURN SAVE1 NOP SAVE2 NOP DVCNR NOP * * * NOW WE HAVE A RESPONSE (THE DISK IS ALIVE) UP THE DEVICE * * UPDVC CLB CLEAR DEVICE ADDRESS BITS STB DVCNR NR DEVICE ADDRESS CLEAR LDA EQT# JMP $UPIO * TFLAG NOP TIME OUT FLAG * ********************************************************** * * * WAITF-- WAIT FOR FLAG TO SET, NO INTERRUPT * * CALLING SEQUENCE: JSB .WAIT * <NOT READY RETURN> * OK RETURN * ************************************************************* WAITF NOP LDB TMCNT GET COUNTER SFS1 SFS IBI IS FLAG SET? (READY?) JMP WLOOP TRY AGAIN ISZ WAITF YES,READY RETURN JM/ ������þúP WAITF,I RETURN * TMCNT DEC -35 TRY 35 TIMES * * WLOOP ISZ B INCREMENT COUNT DOWN **ISZ B*** JMP SFS1 CHECK AGAIN JMP WAITF,I TIME OUT RETURN * * * * .WAIT--GENERAL WAIT, WAIT FOR FLAG SET, IF NOT * SET AFTER 35 TIMES GO OUT AND WAIT FOR INTERRUPT * ************************************************************** * HEAD# EQU * TEMP STORAGE FOR HEAD # .WAIT NOP JSB WAITF WAIT FOR FLAG JSB WEXIT NOT SET, GO WAIT FOR INTERRUPT JMP .WAIT,I WE'VE GOT IT * * * * * * * * * * PARALLEL POLL ROUTINE * PPOL NOP JSB CFIFO LDA PPCTL GET P POLL CONTROL WORD JSB SETC SET CONTROL REG GTPPL JSB DATIN AND B377 MASK LOW 8 STA PPRPS SZA,RSS IF ZERO READ AGAIN JMP GTPPL CLA ZERO OUT CONTOL REGISTER JSB SETC JMP PPOL,I RETUTN PPCTL OCT 10047 CONTROL WORD FOR PARALLEL POLL PPRPS NOP * *************************************************************** * * SEND END COMMAND TO CONTROLLER * *************************************************************** * ENDCM NOP JSB OTBUS SEND DATA TO BUS OCT 440 PRIMARY ENDC2 OCT 550 SECONDARY ENDC3 OCT 25 END OP CODE OCT 1000 EOI OCT 100677 UNLISTEN JSB CFIFO CLEAR CARD JMP ENDCM,I RETURN * * ********************************************************** * * * *READ-- SET UP READ DISK OP CODE * SEND DISK OP-CODE * SET UP DEVICE TO TALK * SET IBI TO LISTEN * * * ********************************************************** READ NOP JSB $OTU# FIX UNIT# OCT 440 BUS=ATN,LISTEN,ADDRESS1 OCT 550 SECONDARY LISTEN,UNBUFFERED READ OCT 5 DISK READ OP CODE OCT 101000 UNIT 0,LBO * * * JSB $UNLS UNLISTEN DEVICE * JSB OTBUS TO RECEI/������þúVE DATA OCT 500 BUS=ATN,TALK,ADDRESS1 OCT 100740 SECONDARY,LBO JSB CFIFO CLEAR FIFO LDA RCTL1 GET READ CONTROL WORD JSB SETC SET CONTROL REG * * JSB CFIFO LDA RCTL2 INT=IRL,O,L,CIC JSB SETC SET CONTROL REG JMP READ,I * RCTL1 OCT 413 ATN,P,T,CIC RCTL2 OCT 1015 EOI,P,L,CIC * * ****************************************************** * * * * WRITE-- UNBUFFERED WRITE * SEND WRITE OP-CODE * SET DISK TO LISTEN * SET IBI TO TALK * SET UP DISK TO WRITE * * ******************************************************** WRITE NOP JSB $OTU# SEND COMMAND OCT 440 ATN,LISTEN,ADDRESS 1 OCT 550 SECONDARY,UNBUFFERED WRITE OCT 10 DISK WRITE OP CODE OCT 101000 LBO,UNIT 0 JSB $UNLS UNLISTEN * *NOW WRITE DATA TO DISK * JSB OTBUS OCT 440 ATN,T OCT 100740 LBO,SECONDARY JSB CFIFO CLEAR FIFO LDA WRCTL JSB SETC JSB CFIFO JMP WRITE,I * WRCTL OCT 5013 LBO,EOI,P,T,CIC * **************************************************************************** * * STATUS WORD REQUST-- RETURNS 2 STATUS WORDS * **************************************************************************** * * STATR-- STATUS REQUEST. STATUS WORD SAVE INTO S1,S2. * * CALLING SEQUENCE * JSB STATR * <RETURN> * * STATR NOP JSB DSJ DO DSJ FIRST JSB $OTU# OCT 440 ATN,LISTEN,DEVICE 1 OCT 550 SECONDARY OCT 3 STATUS OP CODE OCT 101000 JSB $UNLS JSB OTBUS OCT 500 PRIMARY TALK OCT 100550 LBO SECONDARY * JSB CFIFO CLEAR FIFO LDA CNTL 10413 IRL,ATN,P,T,CIC JSB SETC SET CONTROL * * JSB CFIFO CLEAR FIFO LDA PICTL 10015 IRL,P,L,CIC JSB SETC üo������þú SET UP CARD FOR LISTEN JSB DATIN GET S1 STATUS STA S1 * AND B377 GET UNIT STA SU SAVE IT XOR S1 GET BACK RIGHT BYTE ALF,ALF ROTATE TO LOW A AND B37 KEEP STATUS STA S1CD * JSB DATIN STA S2 GET S2 AND SAVE IT * JSB $UNTK UNTALK BUS * LDA S2 RETORE S2 * RAL ROTATE S2 1 BIT LEFT XOR EQT5,I PUT IN LOW EQT 5 AND B377 EXTRACT RIGHT BYTE XOR EQT5,I LDB S1 IF PROTECTED RBL SET SSB BIT4 OF EQT 5 IOR B20 STA EQT5,I * JMP STATR,I S1 NOP STATUS-1 WORD S2 NOP STATUS-2 SU NOP UNIT# S1CD NOP TSTAT PICTL OCT 10015 IRL,P,L,CIC CNTL OCT 10413 IRL,ATN,P,T,CIC B20 OCT 20 * * **************************************************************************** * * $OTU#-- THIS ROUTINE CONFIGURES THE UNIT # INTO HPIB COMMAND SEQUENCE * * CALLING SEQUENCE * * JSB $OTU# * <DATA WORD 1> * <DATA WORD 2> * <DISK OP CODE> * <EOI OR 0> --+UNIT # TO BE CONFIGURED * * *********************************************************************** * $OTU# NOP LDB *-1 GET RETURN ADDRESS STB OTBUS SET UP OTBUS ADB B3 STEP TO UNIT WORD LDA B,I GET OLD CONTENT AND LBMSK CLEAR LOW 8 IOR UNIT# PUT IN NEW UNIT # STA B,I UPDATE THE WORD JMP OTBUS+1 LOOKS LIKE A JSB OTBUS * * * LBMSK OCT 177400 LEFT BYTE MASK * * * OTBUS- OUTPUT COMMANDS TO HPIB BUS * * CALLING SEQUENCE * JSB OTBUS * <CONTROL WORD TO IBI> * <DATA WORD 1> * <DATA WORD 2> * ... * ... * <DATA WORD N + BIT 15 SET> * * OTBUS NOP JSB CFIFO LDA CPUTK GET CONTROL WORD JSB SETC * * LDA OTBUS,I GET PRIMARY ã!������þúADDRESS AND MASK5 MASK OUT OLD ADDRESS IOR ADDRS PUT IN NEW ADDRESS JSB ODPAR GENERATE ODD PARITY LOOP EQU * OTA03 OTA IBI,C OUTPUT TO BUS ISZ OTBUS STEP TO NEXT DATA LDA OTBUS,I GET DATA SSA,RSS END OF COMMAND DATA JMP LOOP OTA05 OTA IBI SEND LAST BYTE OUT JSB .WAIT WAIT FOR ACCEPTENCE ISZ OTBUS JMP OTBUS,I * * MASK5 OCT 177740 ADDRS NOP * * * ODPAR-- ODD PARITY GENERATOR * * A REGISTER CONTAINS RESULTANT * E SAVED AND RESTORED * ODPAR NOP STA SAVEA STB SAVEB SAVE A B ERB SAVE E STB MOVE LDB BM7 BIT COUNTER CCE SET E=1 SLA,RAR COUNT BITS CME IF 1 FLIP E ISZ B INCREMENT COUNTER JMP *-3 LDA SAVEA RESORE A SEZ ODD OR EVEN IOR BIT7 ODD ADD PARITY LDB MOVE RESTORE E ELB LDB SAVEB RESTORE B JMP ODPAR,I * SAVEA NOP SAVEB NOP BIT7 OCT 200 * * ************************************************************************* * * UNTALK UNLISTEN DEVICE * ************************************************************************* * * UNTLK OCT 737 LBO,ATN,UNTALK UNLSN OCT 100677 LBO,ATN,UNLISTEN * * * * $UNTK EQU * $UNLS NOP LDA NRFD JSB SETC JSB CFIFO LDA UNTLK STC07 STC IBI OTA07 OTA IBI,C * LDA UCTL JSB SETC LDA CPUTK JSB SETC LDA UNLSN OTA08 OTA IBI JSB .WAIT CLA JSB SETC JMP $UNTK,I * NRFD OCT 4101 LBO,NRFD,CIC CPUTK OCT 4003 LBO,T,CIC UCTL OCT 4103 LBO,NFRD,T,CIC * * * ************************************************************************* * * * * * SEEK-- SEEK DISK SECTOR * * A REGISTER-- TRACK # * B -- HEAD/SECTOR# * * * **********************Ÿ†������þú************************************************* * SEEK NOP * * STA CYL01 SAVE TRACK# LSR 8 GET HIGH8 (HEAD#) STB HD# SET HEAD CLB LSR 8 GET BACK SECTOR# IOR LBEOI PUT IN EOI,LBO STA SEC# * LDB CYL01 RESTORE TRACK LSR 8 GET HIGH TRACK# STB CYL01 SET LOW TRACK# CLB LSL 8 SHIFT BACK LOW 8 STB CYL02 SET LOW TRACK# * * E REGISTER IS USED IN RD.WR ROUTINE * ADA INSTRUCTION AFFECTS E * ELB SAVE E REGISTER LDA SECTR CHECK IF REQ IS FOR ADA D96 7902 OR 7910 ERB RESTORE E REGISTER SSA,RSS YES ,NO FILE MASK JSB SETFM IF NO DO FILE MASK * JSB $OTU# OCT 440 ATN,PRIMARY TALK OCT 550 TALK ADDRESS 1 OCT 02 SEEK OP CODE] OCT 0 UNIT 0 CYL01 NOP CYL. # CYL02 NOP HD# NOP HEAD&SECTOR # SEC# NOP JSB $UNLS JMP SEEK,I SIGNB OCT 100000 BIT 15 =1 * LBEOI OCT 101000 LBO,EOI * * * * SET FILE MASK FOR AUTO SPARING * * SETFM NOP JSB OTBUS OCT 440 OCT 550 OCT 17 FILMS OCT 1004 LBO,FILE MASK FOR SPARING OCT 100677 LBO UNLISTEN ,ATN JMP SETFM,I D96 DEC -96 * ********************************************************************** * * DSJ-- DEVICE SPECIFIC JUMP * DSJ NOP JSB OTBUS SEND COMMAND OCT 500 TALK ADDRESS 1 OCT 100560 SECONDARY,LBO * JSB CFIFO CLEAR FIFO LDA DJCTL GET CONTROL WORD FOR DSJ JSB SETC CONFIGURE CARD TO ACCEPT JSB DATIN AND B377 STA DJSTA SAVE STATUS JSB $UNTK LDA DJSTA JMP DSJ,I RETURN DJCTL OCT 10005 IRL,L,CIC * DJSTA NOP * *********************************************************************** * * * * SETC -- TOp ������þú CONFIGURE IBI CONTROL REGISTER * * A REGISTER HAS CONTROL WORD * SETC NOP CLCC6 CLC IBI CONTROL MODE OTA04 OTA IBI OUTPUT TO CONTROL REG * STC04 STC IBI DATA MODE JMP SETC,I RETURN * * * * CFIFO-- CLEAR FIFO,RESET POINTERS AND FLAG * CFIFO NOP CLC09 CLC IBI,C MASTER RESET STC06 STC IBI JMP CFIFO,I * * * DATIN-- LOAD DATA FROM FIFO * DATIN NOP JSB .WAIT LIA02 LIA IBI CLF01 CLF IBI JMP DATIN,I * * ********************************************************************** SPC 4 * * MOVE SUBROUTINE * MOVE ONE BLOCK OF DATA FROM SOURCE TO DESTINATION * * A= -COUNT * B=DESTINATION/SOURCE ADDRESS * E=1 FROM LOCAL BUFFR * E=0 TO LOCAL BUFFR * LBUFP= LOCAL BUFFER ADDRESS FOR THIS MOVE * * MOVE NOP CMA,INA SET COUNT POSITIVE STA COUNT SET COUNT LDA LBUFP GET LOCAL BUFFER ADDRESS SEZ,RSS IF TO LOCAL BUFFER SWP SWAP ADDRESS JSB .MVW DEF COUNT NOP JMP MOVE,I * * COUNT NOP LBUFP NOP SPC 4 * VERIFY-- COMMAND TO DO VERIFY * * B REGISTER-- SECTOR COUNT * VERFY NOP LSR 8 PUT HIGH 8 TO LOW 8 OF B STB VSEC CLB LSL 8 GET BACK LOW 8 ADB LBEOI PUT BIT 15 LBO &EOI STB VSEC+1 SET IT JSB $OTU# OCT 440 PRIMARY TALK OCT 550 SECONDARY TALK OCT 7 OCT 0 SECTOR CNT BYTE1 VSEC OCT 0 SECTOR COUNT BYTE 1 OCT 101000 EOI,LBO,UNIT# JSB $UNLS UNLISTEN JMP VERFY,I SKP * * * SPECIAL EXEC CALLS FOR SPARING ETC. * * $SPCL LDB EQT9,I GET TRACK# (IFC) CPB B5 IFC=5 ? JMP GTDSJ YES, DSJ REQ. CPB B6 IFC=6? JMP GTPOL IFC= 6 GET PARALLEL POLL SZB,RSS IS IT ZERO JMP $TMT YES, GET TMT CMB,INB wç������þú MAKE IT NEGATIVE ADB B4 ISECT <= 4 ? SSB IF YES OK JMP REJCT NO,ERROR * LDA EQT7,I SET UP INPUT BUFFER ADDRESS STA EQT13,I SAVE IT IN EQT13 ADA B20 IBUF(17) STA EQT11,I ADDRESS OF IBUF(17) * * NOW SEND DATA OUT TO BUS * JSB $$OUT LDA EQT8,I GET LENGTH STA LN.N SET IT FOR DMA LDA EQT9,I GET ITRCK(FUNCTION CODE) CPA B1 ISEC=1 (CONTROL COMMANDS) JMP CLRIO FINISH CPA B2 IFC=2? JMP SENSE SENSE COMMAND CPA B3 IFC=3 JMP $READ READ REQUEST JSB $WRCF WRITE COMMANDS LDA EQT11,I GET INPUT BUFFER ADDRESS CCE SET E=1 FOR WRITE $DMA JSB STDMA DO THE DMA STUFF * * $DONE JSB $UNLS UNLISTEN CLRIO CLA CLEAR FIFO ISZ TFLAG SET TIME OUT FLAG JSB CFIFO JSB SETC CLEAR CARD * * NOW SEE IF END COMMAND IS HERE ,IF NOT DONT DO PPOL (ELSE IT WILL * CAUSE AN END COMMAND TO BE SENT) * IF END COMMAND DO PPOL AND RETURN SO THAT POWER RETURN OR HEAD LOADED * WILL INTERRUPT * ISZ EQT13,I SET UP IBUF(2) ADDRESS LDA EQT13,I ADDRESS OF IBUF(2) DLD A,I GET IBUF(2) AND IBUF(3) CONTENT CPA ENDC2 IS IT END CMD SECONDARY RSS YES CHECK OP CODE JMP NOPOL NO, OTHER OP CODE, RETURN W/O PPOL SWP SWAP A AND B CONTENT LDB EQT12,I SO WE CAN PUT XMIT LOG IN B REG CPA ENDC3 IS IT END OP CODE JMP .RTN. YES, PPOL AND RETURN NOPOL LDB EQT12,I XLOG JMP $SRTN RETURN WITH NO PPOL * * $READ JSB $RDCF SET UP CARD TO READ LDA EQT11,I DEST. BUFFER ADDRESS ADA SIGNB SET SIGN BIT FOR READ CLE CLEAR E FOR READ JMP $DMA SET UP DMA * * GTPOL JSB PPOL GET P POLL LDA PPRPS GET RESPONSE JMP $RTN RETURN IN IBUF(1) * GTDSJ LDA é������þúEQT10,I GET HPIB ADDRESS STA ADDRS SET FOR DSJ JSB DSJ GET DSJ $RTN LDB EQT7,I INPUT BUFFER STA B,I PUT DSJ INTO IBUF(1) JMP $DONE * ** SENSE JSB $SCF SET CARD FOR SENSE COMMAND GET JSB DATIN READ 1 WORD BYTE LDB EQT11,I GET INPUT BUFFER ADDRESS STA B,I PUT INTO BUFFER ISZ EQT11,I NEXT WORD ISZ EQT8,I UPDATE LENGTH JMP GET GET NEXT WORD JMP $DONE * * * $$OUT NOP JSB CFIFO CLEAR FIFO LDA CPUTK CPU TALK JSB SETC SET UP CARD XLOOP LDB EQT7,I GET COMMAND LDA B,I FORM EQT7 OTA06 OTA IBI,C SEND IT OUT ISZ EQT7,I NEXT WORD SSA,RSS SIGN BIT SET? JMP XLOOP NO, MORE JSB .WAIT WAIT FOR ACCEPTANCE JMP $$OUT,I RETURN * * * $RDCF NOP JSB CFIFO CLEAR FIFO LDA RCTL1 READ CONTROL WORD 1 JSB SETC SET CARD JSB CFIFO CLEAR CARD LDA RCTL2 CONTROL WORD 2 JSB SETC SET CARD JMP $RDCF,I * * * $WRCF NOP JSB CFIFO CLEAR CARD LDA WRCTL DMA WRITE CONFIGURATION JSB SETC JSB CFIFO JMP $WRCF,I * * * CONFIGURE CARD TO DO SENSE COMMANDS * * $SCF NOP JSB CFIFO LDA CNTL IRL,ATN,P,T,CIC JSB SETC SET IT JSB CFIFO LDA PICTL IRL,P,L,CIC LDB EQT12,I GET LENGTH SSB IF LENGTH NEGATIVE AND CBIT3 GET UNPACKED BYTES JSB SETC JMP $SCF,I B1 OCT 1 B6 OCT 6 CBIT3 OCT 177767 BIT 3 ZERO * * * GET TRACK MAP TABLE AND RETURN IN IBUF(1) * * FORMAT-- CALL EXEC(1,LU+2200B,IBUF,LEN,0,5) * IF LEN=161 ENTIRE TMT, IF =5 ONE SUBCHNL ENTRY * $TMT LDA EQT8,I ADA B5 IS LENGTH = 5? SZA,RSS JMP GTSUB YES,GET 5 WORD LDA EQT8,I LDB A CMB,INB STB COUNT ADA .161 äx���N��LHIS LENGTH = 161? SZA JMP REJCT NO, REJECT * * LDA TB34A $TA32 ADDRESS TMOVE LDB EQT7,I IBUF(1) ADDRESS JSB .MVW MOVE THE TABLE DEF COUNT NOP LDB EQT8,I JMP $SRTN RETURN WITH NO PPOL * * .161 DEC 161 GTSUB LDA B5 STA COUNT LDA .TB34 JMP TMOVE * ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¨lN������ÿÿ�������� SKP * CONFIGURATION SECTION * * BUF BSS 128 LN EQU * * * ORG BUF CONFI LDA .IOTB GET IO INSTRUCTION ADDRESS LDA A,I GET ITS ADDRESS RAL,CLE,SLA,ERA REMOVE INDIRECT JMP *-2 SZA,RSS END OF LISTS? JMP ENDCF DONE LDB A PUT ADDRESS IN B LDA A,I GET CONTENT OF I/O (OP CODE) AND BM100 MASK- 177700 ADA SCODE PUT IN S. C. STA B,I NEW INSTRUCTION ISZ .IOTB NEXT ONE JMP CONFI AGAIN * * * ENDCF CLA WIPE OUT JMP CONFI STA I.34+2 LDA EQTA CMA,INA ADA EQT1 CLB DIV .15 INA STA EQT# LDA TB34B GET THE ADDRESS OF THE TABLE ADDRESS LDA A,I GET ADDRESS RAL,CLE,SLA,ERA IS IT INDIRECT JMP *-2 STA TB34A JMP I.34+3 * * TB34B DEF TB34A .15 DEC 15 * .IOTB DEF *+1 DEF SFS1 DEF LIA01 DEF LIA02 DEF OTA03 DEF OTA04 DEF OTA05 DEF OTA06 DEF STC04 DEF STCC7 DEF CLCC6 DEF CLF01 DEF CLC08 DEF CLC09 DEF STC06 DEF STC07 DEF STC08 DEF OTA07 DEF OTA08 NOP * * LNPG EQU LN TEST EQU LN-* IFN IA32 EQU I.34 CA32 EQU C.34 XIF IFZ IC32 EQU I.34 CC32 EQU C.34 XIF END ����������������������������������������������������������������š������ÿÿ����� ���� ÿý�ö�! ���������ÿ��92067-18554 2040� S C0122 �&FORMT �FORMAT UTILITY � � � � � � � � � � � � �H0101 ˜à�����þúASMB,Q,R,C HED FORMT - SPARE,INITIALIZE,VERIFY,FORMAT (FLOPPY),RE-FORMAT NAM FORMT,3,10 92067-16554 REV.2040 800717 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ****************************************************************** * * * NAME: FORMT * * SOURCE: 92067-18554 * * RELOC: 92067-16554 * * PGMR: KFH & JJC & WL & BC * * * ****************************************************************** SPC 2 * * TURN - ON SEQUENCE: * * FO,DISC LU, FILL * / VE,DISC LU \ *BC * RU,FORMT [,[OPLU] [,< IN,DISC LU > ]] * \ RE,DISC LU / *BC * SP,DISC LU,TRACK * * WHERE: * * OPLU IS THE LU OF THE OPERATOR'S CONSOLE * FO MEANS FORMAT A FLOPPY DISC * DISC LU LU OF A TYPE 32 DISC SUBCHANNEL * FILL SECTOR FILL VALUE FOR A FLOPPY (=INTERLEAVE-1) * IN MEANS INITIALIZE AN ENTIRE DISC SUBCHANNEL * SP MEANS SPARE ONE TRACK ON A DISC LU * VE MEANS VERIFY A DISC LU (NON-DESTRUCTIVE) *BC * RE MEANS RE-FORMAT A DISC LU (RESET ALL D,S,P BITS) *BC * TRACK BAD LOGICAL TRACK TO BE SPARED, ATTEMPTING TO PRESERVE DATA SKP * * EXTERNAL ENTRY POINTS * EXãÊ������þúT RMPAR,EXEC,GETST,PARSE,.MVW EXT ICAPS,LOGLU *BC EXT $DATC,.OPSY,LIMEM,LURQ *WL EXT EQTRQ * * DRIVER LIBRARY ROUTINES * EXT XSEEK, XADRC, XFMSK, XDRED, XEND, XRDOF EXT XRDFS, XDWRT, XINIT, XVRFY, XRCAL, XSTAT EXT XSPAR, XFRMT, XLGAD, XTTBL, XDSJ *WL * SPC 2 A EQU 0 B EQU 1 SUP SKP * * * MAINLINE CODE FOR FORMT * * FORMT STB OPLU JSB RMPAR DEF *+2 DEF OPLU * JSB GETST GET THE RUN STRING-PARSE LATER DEF *+4 DEF RBUFR DEF N64 MAX INPUT (CHARS) DEF TEMP1 XMISSION LOG(CHARS) * * SET UP THE OPERATOR'S LU * LDA OPLU GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ OPLU NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? CLA,INA,RSS NO,ASCII - USE DEFAULT LU 1 * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * * GET MEMORY BOUNDS AND SET \BUFI & \BUFA; TASK PROCESSORS * WILL CHECK FOR THE CORRECT MEMORY REQUIREMENTS * JSB LIMEM *WL DEF *+4 FETCH FREE MEMORY BOUNDS *WL DEF P0 *WL DEF FWA *WL DEF BSIZE NO. OF WORDS AVAILABLE FOR BUFFER *WL LDA FWA *WL STA \BUFI AND SAVE ADA P16 SKIP HPIB COMMAND BUFFER STA \BUFA AND SAVE START OF DATA BUFFER LDA N16 ADJUST THE COMMAND BUFFER ADA BSIZE OUT OF THE MAX BUFFER AVAILABLE STA BSIZE TO MAKE CLRBF SIMPLER * * IN RTE-IV, PERFORM CORE LOCK TO PREVENT SWAP * JSB .OPSY CHECK THE SYSTEM TYPE *WL CPA N29 L20 SYSTEM? *BC LDA N31 YES, MAKE SYS TYPE N31 *BC CPA N17 NO. RTE-6? *BC “Ù������þú LDA N9 YES, MAKE SYS TYPE N9 *BC STA \SYST SAVE IT. *WL CPA N9 VALUE FOR RTE-IV *WL RSS *WL JMP PRSE SKIP IF RTE-L *WL LDB .DATC,I ALSO CHECK *BC ADB N2001 OP SYS DATE-NEED CURRENT DRIVERS SSB,RSS MUST BE 2001 OR LATER *WL JMP DATOK DATE OK- CONTINUE * LDB P26 GET PTR FOR "OUTDATED..SOFTWARE" JSB PROMT NOT LATEST DRIVERS,& EQT LOCK SOFTWARE JMP \XOUT ABORT-OUTDATED SYS SOFTWARE * DATOK LDA P12 STA PTCH7 SET MS07 LENGTH FOR RTE-IV * JSB EXEC DEF *+3 DEF P22 DEF P1 * * * PARSE THE RUN PARAMETERS * PRSE JSB PARSE GET TYPE OF RUN PARAMETERS... DEF *+4 DEF RBUFR BUFFER TO PARSE DEF TEMP1 XMISSION LOG FROM GETST DEF PSBUF 33 WORD RESULT BUFF * CLB TYPE CODE: 0/1/2=NULL/NUM/ASCII LDA PTYP2 TYPE OF "TASK" PARM CPA P2 IS IT ASCII? INB YEP - WHAT WE WANTED! RUPM3 RBL SAVE THAT BIT LDA PTYP3 GET TYPE OF "DISC LU" CPA P1 IS IT NUMERIC?? INB YEP-NUMERIC IS OKAY RUPM4 RBL SAVE BIT LDA PTYP4 GET TYPE OF TRK#,#FILL PARM CPA P1 IS IT NUMERIC?? INB YEP- OK SAVEB RSS SKIP THE CLB SKP * * INITIALIZE ALL PARAMETERS BEFORE NEXT TASK * ITASK CLB STB BATCH CLEAR/SAVE BATCH FLAG CLA STA INDEX STA \MODE STA PHASE STA \DTYP STA LEN ********ANY MORE? ******************************************************* * * CLB LDA BATCH ISSUE PROMT? AND P4 SZA JMP SET2 NO JSB PROMT ASK "TASK?" CLE TASK? JSB PTASK PARSE & BRANCH TO APPROPRIATE PROCESSOR V?������þú JMP EXIT EN OR /E JMP FPROC FORMAT JMP IPROC INIT JMP SPROC SPARE JMP VPROC VERIFY *BC JMP RPROC RE-FORMAT *BC * SET2 LDA PARM2 MOVE 2ND RUN PARAMETER TO STA RBUFR PROPER BUFFER CCE DISABLE CALL TO TARGT BY PTASK JMP TASK? AND CONTINUE * * COME HERE AT END OF FPROC,IPROC,VPROC,SPROC,RPROC TO SEE * WHATS NEXT * DONE? JSB UNLOK UNLOCK \DLU'S EQT IF IT'S LOCKED JSB ULKLU UNLOCK DISC LU'S IF PREVIOUSLY LOCKED * ONLY 'FO' COMMAND LOCKS FLOPPY LU'S LDB BATCH DONE WITH FORMT OR TRY ANOTHER TASK? CPB P7 JMP EXIT ONLY ONE TIME AROUND JMP ITASK ASK FOR MORE * .DATC DEF $DATC+0 SKP ********************************************************************** ********************************************************************** ** FPROC ** SPC 1 * FPROC MAKES 4 PASSES OVER THE FLOPPY DISC WITH BIT PATTERNS * C6,63,6D,& 88 (HEX), EACH PASS WITH AN INTERLEAVE VALUE OF * OF 1, TYPE 2, AND OVERRIDING ANY OLD FORMAT. A SEEK TO CYL 0, * HEAD 0 IS DONE FIRST, FOLLOWED BY THE FORMAT COMMAND TO THE * CONTROLLER (15-20 SECS), AND A VERIFY COMMAND FOR 4620 SECTORS * (30 SECS). ON VERIFY ERRORS, THE OFFENDING CYL/HEAD IS SAVED * IN TABLE BFTBL, AND THE VERIFY IS CONTINUED WITH THE NEXT * TRACK UNTIL THE ENTIRE FLOPPY IS DONE. THIS IS REPEATED FOR * EACH BYTE PATTERN. * * RETRIEVING THE BAD TRACK ADDRESSES FROM BFTBL, A WRITE INITIALIZE * IS DONE TO EACH BAD TRACK WITH THE D-BIT SET. (DATA BYTE =0) * * THE FIFTH AND FINAL FORMAT/VERIFY COMBINATION (9 MINS?) IS DONE * WITH BYTE PATTERN = 0, THE INTERLEAVE VALUE \FILL SPECIFIED BY * THE USER , TYPE = 2, AND THE OVERRIDE OLD FORMAT BIT OFF. ANY * ERRORS ON THZ������þúE VERIFY CAUSE THE WARNING MESSAGE MES23 TO BE ISSUED * AT THE END OF THE TASK. ONLY THE # GOOD TRACKS ARE VERIFIED. * * THE NUMBER OF GOOD TRACKS IS ALWAYS DISPLAYED AT THE END OF FPROC. * FPROC CLA SPECIFY FLOPPY DISC ONLY JSB LU? AND RETRIEVE \DLU * LDB P2 STB INDEX SET FOR EXPLN LDA BATCH PROMT WITH WARNING? CPA P7 JMP FPR2 NO JSB PROMT ASK "DO YOU REALLY WANT TO FORMAT THIS DISC?" * FPR1 JSB PRESP PARSE RESPONSE JMP YNERR INVALID ANSWER NOP EN OR /E JMP DONE? NO JMP FPR2 YES NOP " ",CR YNERR JSB EXPLN ?? - TELL 'EM WHAT WE WANT JMP FPR1 AND GET AGAIN * FPR2 LDB P3 SET INDEX FOR EXPLN STB INDEX CLA LDB P128 SET DATA XFER SIZE FOR INIT CMD. STB LEN NOTE- INIT ONLY SUPPORTS 1 SECTOR. LDB P145 WANT 16WD CMD+145WD DATA BUFFER FOR * THE TRACK MAP TABLE(161 WDS)FOR "LKLUS". JSB CLRBF CLEAR BUFFER & CHECK ITS SIZE * LDB BATCH WAS THE SECTOR INTERLEAVE VALUE SPECIFIED SLB,RSS IN THE RUN STRING? JMP FPR3 NO, SO PROMT LDA PARM4 ELSE GET IT AND JMP SAVEF SAVE THE FILL VALUE * FPR3 LDB P3 DISPLAY: JSB PROMT "# OF FILL SECTORS?" * FPR4 JSB PRESP PARSE RESPONSE JMP FPR5 POSSIBLY NUMERIC JMP DONE? EN OR /E NOP NO NOP YES NOP " ",CR FLERR JSB EXPLN ?? - SEND "ENTER SECTOR INTERLEAVE VALUE... JMP FPR4 AND GET AGAIN * FPR5 JSB BIDEC CONVERT RESPONSE TO BINARY JMP FLERR INVALID DIGIT SAVEF INA CONVERT #FILL SECS TO INTERLEAVE VALUE STA \FILL SAVE THE INTERLEAVE # ADA N30 MUST BE <=29 FOR HP FORMAT SSA,RSS IS IT? JMP FLERR NOPE! * LDA \DLU ˆ������þúGET THE FLOPPY LU TO FORMAT LDB \SYST GET OP SYS TYPE CPB N9 IS IT RTE-IV?? JMP LOKLU YES-GO LOCK ALL LU'S OF FLOPPY JSB ELOCK CALL (DUMMY) EQT LOCK FOR RTE-L RSS WHICH CHECKS FORMAT FOR STAND ALONE PROG LOKLU JSB LKLUS RTE-IV:DON'T LOCK EQT-LOCK ALL FLOPPY LU'S * WARNING-THE LKLUS ROUTINE IS FOR RTE-IV ONLY. IT REFERENCES * THE DEVICE REFERENCE TABLE DIRECTLY AND TRACK MAP TBL DIRECTLY. CCB STB WARNG NO WARNING NECESSARY YET LDA P6 SET MODE STA \MODE CLE JSB DISKD SSA ANY PROBLEMS? JMP BADFL TELL 'EM TO RETRY OR CHUCK THE DISC * LDA BADFT DETERMINE THE # OF GOOD TRACKS CMA,INA BY GETTING TOTAL# & SUBTRACTING # BAD ADA \DNTR ONES DETECTED JSB ASDEC CONVERT THAT # TO ASCII LDB MS06. AND STORE IN MESSAGE JSB .MVW DEF P2 NOP * LDB P6 DISPLAY JSB PROMT "# OF GOOD TRACKS = XXXX" JMP DONE? * BADFL LDB P24 DISPLAY: JSB PROMT "MAX OF 20 BAD TRACKS EXCEEDED" JMP DONE? * ** END FPROC BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** IPROC ** SPC 1 * IPROC - ASKS IF OK TO DESTROY DATA ON SUBCHANNEL (NON-BATCH MODE) * INITIALIZES THE HARD-DISC SUBCHANNEL \DLU * CLEANS UP SPARES AT THE END FIRST * DISPLAYS THE LOGICAL TRACK # BEING INIT'D IN THE SWREG * IPROC CLA,INA SPECIFY HARD DISCS ONLY JSB LU? * LDA \SYST SEE RTE-L:OK TO INIT LU2 THERE *BC ü^������þú CPA N31 JMP IPR0 * LDA \DLU CPA P2 IS IT THE SYS DISC?? JMP LUERR DON'T ALLOW INIT OF LU2 CPA P3 LU3? *BC JMP LUERR DON'T ALLOW INIT OF LU3 *BC * IPR0 LDA P6 ARE WE IN BATCH? CPA BATCH (CONVERT 6 TO 7 FOR INIT MODE) ISZ BATCH INA CPA BATCH WHERE NO OPERATOR INTERVENTION JMP IPR2 IS DESIRED? YES * LDB P2 OTHERWISE ASK FIRST STB INDEX SAVE FOR EXPLN IF NECESSARY LDB P5 DISPLAY: JSB PROMT "DATA WILL BE DESTROYED, OK TO PROCEED?" IPR1 JSB PRESP PARSE RESPONSE JMP IPERR INVALID RESPONSE NOP EN OR /E JMP DONE? NO JMP IPR2 YES NOP " ",CR IPERR JSB EXPLN ?? AND ERRORS JMP IPR1 TRY AGAIN * * * IPR2 CLA LDB \D#WT AND BUFFER SIZE STB LEN SAVE I/O TRANSFER LENGTH JSB CLRBF CLEAR BUFFER WITH SIZE CHECKS * CCA STA \BADH SIGNAL NO BAD TRACK HEADER YET JSB SPINT SPARE CLEANUP-LOCK EQT EACH TIME SSA ERROR IN INIT SPARES?? JMP DONE? YES, SO REQUEST NEW TASK LDA \DNTR GET THE # OF TRACKS CMA,INA FOR THIS SUBCHANNEL STA SLOOP AND SET AS THE LOOP COUNTER CLA SET THE STARTING TRACK # STA \TRAK TO INITIALIZE LDA P3 STA \MODE SET DRIVER IN INIT. TRACKS MODE * IPR4 LDA \TRAK DISPLAY TRACK # OTA 1 IN SW REG JSB ELOCK LOCK THE EQT CLE SET TO WRITE JSB DISKD WRITE INIT THE TRACK JSB UNLOK UNLOCK THE EQT LDA \RET GET THE RETURN STATUS FROM DRVR SSA CHECK \RET STATUS JMP DONE? ERROR * ISZ \TRAK INCREMENT THE TRACK # ISZ SLOOP AND THE LOOP COUNTER JMP IPR4 CONTINUE * LDA *������þúUSED# GET # OF SPARES USED OR DEF. CMA,INA TRACKS REMAINING ON SUBCHANNEL ADA \DNSP JSB SPSAV AND DISPLAY * JMP DONE? DONE WITH FORMT OR TRY A NEW TASK? * ** END IPROC BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** SPROC ** SPC 1 * * SPROC SPARES ONE TRACK ON SUBCHANNEL \DLU * ATTEMPTS TO PRESERVE ALL DATA ON THE DEFECTIVE TRACK BY * READING ONE SECTOR AT A TIME * ISSUES READ WITH OFFSET REQUESTS AT +(0,10,20,30,40,50,60) * AND -(10,20,30,40,50,60) IN ORDER TO RETRIEVE THE DATA * SPROC CLA,INA INDICATE A HARD DISC JSB LU? AND GET THE DISC LU WITH CHECKING DONE * CLA LDB \D#WT GET TRACK SIZE STB LEN AND SAVE AS TRANSFER LENGTH JSB CLRBF CHECK BUFFER SIZE & CLEAR * LDA \DNSP GET # SPARES ALLOCATED SZA JMP SP0 CONTINUE LDB P12 ELSE TELL 'EM THAT THE DISC LU IS OUT OF SPARES JSB PROMT SPARES JMP DONE? AND TRY AGAIN * SP0 CCA ADA \DNTR GET LAST TRK# ON THIS SUBCHANNEL JSB ASDEC AND CONVERT TO ASCII LDB XP04. JSB .MVW NOW MOVE INTO EXPL'N MESSAGE IN CASE OF ?? DEF P2 NOP * CCA STA \BADH SIGNAL NO BAD TRACK HEADER YET STA WARNG AND NO WARNING MESSAGE YET LDA P4 STA INDEX SET FOR EXPLN MESSAGES * LDB BATCH ALL PARM'S SPECIFIED? SLB,RSS JMP SP1 NO, SO PROMT * LDA PARM4 ELSE GET RUN PARAMETER JMP SAVE4 AND SAVE * SP1 ˆ•������þú LDB P4 JSB PROMT DISPLAY "TRACK TO BE SPARED?" * SP2 JSB PRESP PARSE RESPONSE JMP SP3 POSSIBLY NUMERIC JMP DONE? /E OR EN NOP NO NOP YE TRKER JSB ERR13 " ",CR - ISSUE ERROR MESSAGE JSB EXPLN ?? - ISSUE MESSAGE JMP SP2 AND TRY AGAIN * SP3 JSB BIDEC CONVERT RESPONSE TO NUMERIC JMP TRKER INVALID NUMBER SAVE4 STA \TRAK SAVE IT CMA CHECK IF IT LIES WITHIN ADA \DNTR THE SUBCHANNEL BOUNDS SSA JMP TRKER NOPE! * * JSB ELOCK LOCK THE EQT OF \DLU * * * LDA P5 STA \MODE SET THE PROPER MODE CCE JSB DISKD SSA CHECK \RET STATUS JMP DONE? NOT GOOD * LDA STRAK GET THE # OF THE SPARE THAT WAS USED INA CMA,INA ADA \DNTR AND DETERMINE THE # SPARES LEFT ADA \DNSP ON THIS SUBCHANNEL JSB SPSAV DISPLAY IT * JMP DONE? ALL DONE? * ERR13 NOP LDB P13 DISPLAY: JSB PROMT "INVALID TRACK #" JMP ERR13,I * ** END SPROC BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** RPROC ** * *BC * RE-FORMAT A DISC LU, CLEAN OFF ALL S,D,P BITS *BC * IF IN RTE IVB AND LU 2,3 IS TO BE ACCESSED, USER MUST BE *BC * LU1 (NON-SESSION) OR CAPABILITY 60 (SESSION) *BC * AND IN INTERACTIVE MODE *BC * ˆ€������þú *BC * RTE-L ACCESS IS NOT RESTRAINED AT ALL *BC * *BC * *BC RPROC CLA,INA HARD DISC ONLY *BC JSB LU? *BC * *BC LDB BATCH *BC CPB P6 *BC ISZ BATCH IF 6,MAKE IT 7 *BC * *BC * *BC LDB BATCH IF BATCH GO AROUND *BC CPB P7 *BC JMP RPR3 *BC * *BC LDB P2 *BC STB INDEX *BC LDB P5 PRINT... *BC JSB PROMT "DATA WILL BE DESTROYED, OK TO *BC * PROCEED?" *BC RPR1 JSB PRESP GET RESPONSE *BC JMP RPR2 INVALID ANSWER *BC NOP *BC JMP DONE? NO *BC JMP RPR3 YES *BC NOP *BC RPR2 JSB EXPLN EXPLAIN POSSIBLE ANSWERS *BC JMP RPR1 GO BACK *BC * *BC RPR3 LDA \SYST RTE-L ? *BC CPA N31 *BC JMP ROK YES - GO AROUND CHECKS *BC * '������þú *BC LDA \DLU WHAT DISC LU ARE WE TALKING TO? *BC CPA P2 LU2 ? *BC JMP MGR.S YES - CHECK FOR A CAPABILITY 60 *BC CPA P3 LU3? *BC RSS YES *BC JMP ROK NO - SKIP FURTHER CHECKS *BC * *BC MGR.S LDB BATCH *BC CPB P7 *BC JMP BNC YES - LU2,3 ALTERATION *BC * *BC JSB ICAPS CHECK SESSION CAPABILITY LEVEL *BC DEF RTN *BC DEF IDUMY *BC RTN STA ICPSE *BC CPA P60 QUALIFIED USER? (CAP =60) *BC JMP MOK YES - NO MORE CHECKS NEEDED *BC SZA 0 MEANS NON-SESSION *BC JMP BNC YES, WRONG CAPABILITY LEVEL *BC * *BC JSB LOGLU NO, CHECK FOR LU1 ONLY *BC DEF RTN1 *BC DEF IDUMY *BC RTN1 CPA P1 LU1? *BC JMP MOK YES *BC * *BC BNC LDB P27 *BC JSB PROMT PRINT... *BC JMP DONE? UNAUTHORIZED LU2,3 ALTERATION *BC * MOK LDB P28 PRINT.... *BC JSB PROMT "DO YOU REALLY WANT TO *BC * RE-FORMAT THE SYSTEM DISC?" *BC LDB P2 *BC STB INDEX v>������þú *BC M.1 JSB PRESP PARSE RESPONSE *BC JMP M.2 NUMERIC RESPONSE *BC NOP EN OR /E *BC JMP DONE? NO *BC JMP ROK YE *BC NOP " "CR *BC M.2 JSB EXPLN ?? *BC JMP M.1 TRY AGAIN *BC * *BC * *BC * ALL CHECKS HAVE BEEN MADE FOR AUTHORIZED ACCESS. NOW IT'S OK *BC * TO GO AHEAD *BC * *BC ROK CLA *BC LDB \D#WT GET THE # OF WORDS/TRACK *BC STB LEN SET LENGTH TO THAT *BC JSB CLRBF CLEAR THE BUFFER *BC * *BC CCA ALLOW FOR HEDDER ON 1ST ERROR *BC STA \BADH *BC * *BC LDA \DNTR GET # OF TRACKS *BC ADA \DNSP ADD THE # OF SPARES *BC CMA,INA *BC STA LPCTR SET THE LOOP COUNTER *BC * *BC CLA SET LOGICAL TRACK TO 0 *BC STA \TRAK *BC LDA P7 SET MODE NUMBER TO 7 *BC STA \MODE *BC * *BC RPR7 LDA \TRAK DISPLAY LOGICAL TRK # IN S.R. *BC OTA 1 Ü‹������þú *BC JSB ELOCK LOCK THE EQT *BC CLE *BC JSB DISKD RE-FORMAT THE TRACK *BC JSB UNLOK UNLOCK THE EQT *BC ISZ \TRAK BUMP TRACK # *BC ISZ LPCTR DONE YET? *BC JMP RPR7 NO. DO NEXT TRACK *BC JMP DONE? YES *BC * *BC * CONSTANTS *BC * *BC IDUMY BSS 1 *BC ICPSE BSS 1 *BC LPCTR BSS 1 *BC P60 DEC 60 *BC P27 DEC 27 *BC P28 DEC 28 *BC P29 DEC 29 *BC * *BC ** END RPROC BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** VPROC ** * *BC * VERIFY (NON-DESTRUCTIVLY) A DISC LU *BC * *BC VPROC CCA INDICATE DON'T CARE *BC JSB LU? SO FAR AS HARD OR FLOPPY DISC *BC * *������þúBC LDB BATCH *BC CPB P6 IF 6, MAKE IT 7 *BC ISZ BATCH *BC * *BC CLA *BC LDB \D#WT SET BUFFER FOR A FULL TRACK *BC STB LEN *BC JSB CLRBF CLEAR THE BUFFER *BC CCA ALLOW FOR MESSAGE HEDDER *BC STA \BADH *BC LDA \DNTR GET THE NUMBER OF TRACKS *BC CMA,INA AND SET THE LOOP COUNTER *BC STA LPCTR *BC CLA SET FOR LOGICAL TRACK 0 *BC STA \TRAK *BC LDA P8 *BC STA \MODE SET MODE # TO 8 *BC * *BC LDA \D#ST GET # OF SECTORS PER TRACK *BC CPA P30 FLOPPY? *BC JMP VFL YES SO GO AROUND *BC * *BC VPR1 LDA \TRAK HARD DISC.. *BC OTA 1 SHOW LOGICAL TR# IN S.R. *BC JSB ELOCK LOCK THE EQT *BC CCE *BC JSB DISKD VERIFY A TRACK *BC JSB UNLOK UNLOCK THE EQT *BC ISZ \TRAK BUMP THE TRACK # *BC ISZ LPCTR DONE YET? *BC JMP VPR1 NO , GO DO THE NEXT TRACK *BC JMP DONE? YES *BC * *BC * FLOPPY VERIFY *Wh������þúBC * *BC VFL LDA \DLU ONLY USE LU LOCK FOR RTEIVB *BC LDB \SYST *BC CPB N9 *BC JMP LK *BC JSB ELOCK *BC RSS *BC * *BC LK JSB LKLUS *BC LK1 LDA \TRAK *BC OTA 1 S.R. SHOWS LOGICAL TR # *BC CCE *BC JSB DISKD VERIFY THE FLOPPY TRACK *BC ISZ \TRAK BUMP THE TRACK # *BC ISZ LPCTR DONE YET? *BC JMP LK1 NO. GO DO NEXT ONE *BC JMP DONE? YES *BC * *BC * *BC * *BC * *BC * *BC * *BC * *BC ** END VPROC BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** TERMINATE FORMT ** SPC 1 EXIT CLB,RSS SET FOR PROPER MESSAGE * * ABNORMAL TEÁß������þúRMINATION EXIT * \XOUT CLB,INB ADB P15 JSB PROMT DISPLAY "FORMT -------" * LDA \SYST CHECK FOR AN RTE-IV *BC CPA N9 RSS JMP TERM * JSB EXEC REMOVE CORE LOCK DEF *+3 DEF P22 DEF P0 * TERM JSB EXEC DEF *+2 DEF P6 HED FORMT SUBROUTINES. ******************************** ********************************************************************** ********************************************************************** ** LU? ** SPC 1 * LU?: PROMPT "DISC LU?", UNLESS SPECIFIED IN A RU PARAMETER * DOES VALIDITY CHECKS ON THE LU - TYPE 32 WITH #SECTORS/ * TRACK = 30,32,48,OR 64 * GETS THE SUBCHANNEL DEF'N FOR \DLU (CALLS \SETD) * ISSUES AN ERROR MESSAGE ON AN ILLEGAL RESPONSE OR LU * ISSUES AN EXPLANATION MESSAGE AFTER A ?? RESPONSE OR ERROR * * A-REG ON ENTRY = 0/1 FOR FLOPPY DISC/HARD DISC * -1 FOR DON'T CARE *BC * LU? NOP STA \DTYP SAVE DISC REQUEST TYPE CLB,INB SET FOR EXPLN STB INDEX * LDB BATCH RBR SLB,RSS JMP LU1? ISSUE PROMPT NOW LDA PARM3 ELSE GET 3RD RUN JMP SAVE3 * LU1? CLB,INB JSB PROMT "DISC LU?" * LU2? JSB PRESP READ & PARSE REPSONSE JMP LU3? POSSIBLY NUMERIC JMP ITASK EN OR /E NOP NO NOP YE LUERR JSB ERR14 " ",CR JSB EXPLN ?? - PRINT EXPLANATION (WITH ERR14 ALSO) JMP LU2? AND TRY AGAIN * LU3? JSB BIDEC CONVERT ASCII # JMP LUERR INVALID DIGIT SAVE3 STA \DLU SAVE VALUE AND B7700 MASK OFF LOWEST 6 BITS TO SZA MAKE SURE LU < 64 JMP LUERR IT ISN'T * JSB EXEC EXEC CALL-NO ABORTT������þú: GET DRVR DEF *+6 TYPE CODE AND DEF P13NA AND SUBCHANNEL DEF \DLU BASE ON LU DEF IEQT5 DEF IEQT4 DEF \DSUB JMP LUERR ERROR RETURN * LDA \DSUB GET THE SUBCH AND B37 MASK ONLY THE SUBCH(SIGN MEANS UP\DN) STA \DSUB SET IT LDA IEQT5 EXTRACT TYPE ALF,ALF AND B77 LDB \SYST IS IT RTE-L? *WL CPB N31 *WL JMP RTL YES *WL CPA B32 CORRECT TYPE FOR RTE-4? *WL JMP LUOK YES, CONTINUE. *WL JMP LUERR NO,ASK AGAIN. *WL RTL ADA M30 *WL SSA LESS THAN 30B? *WL JMP LUERR YES, TRY AGAIN. *WL ADA M10 *WL SSA,RSS GREATER THAN 37B? *WL JMP LUERR YES, ASK AGAIN. *WL * LUOK JSB \SETD GET SUBCHANNEL DEF'N & EXTRACT PARAM'S*WL LDA \DNTR GET TRACK SIZE SZA,RSS IF ZERO JMP LUERR THEN ISSUE ERROR LDA \D#ST GET # SECTORS/TRACK LDB \DTYP AND DISC TYPE REQUIRED SSB SIGN NEGATIVE FOR DON'T CARE? *BC JMP DC YES *BC SLB JMP HARDD HARD TYPE REQUIRED FOR TASK REQUESTED CPA P30 CORRECT # FOR A FLOPPY? JMP LU?,I YES JMP LUERR NO,TRY AGAIN * HARDD CPA P32 7910 SIZE? RSS CPA P48 7905/06/20 SIZE? RSS CPA P64 7925 SIZE? JMP LU?,I OK,RETURN FOR FURTHER CHECKS JMP LUERR ELSE TRY AGAIN * ERR14 NOP LDB P14 DISPLAY: JSB PROMT "INVALID DISC LU" JMP ERR14,I * *BC DC NOP DON'T CARE ABOUT HARD/FLOPPY *BC CPA P30 2W������þú FLOPPY? *BC RSS YES *BC CPA P32 7910? *BC RSS YES *BC CPA P48 7905/6/20? *BC RSS YES *BC CPA P64 7925? *BC RSS YES *BC JMP LUERR NONE OF THE ABOVE. INVALID LU *BC JMP LU?,I OK. IT'S ONE OF THE ABOVE *BC * P13NA OCT 100015 OPCODE FOR EXEC 13+NO ABORT * ** END LU? ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** PTASK ** SPC 1 * PTASK READS AND PARSES RESPONSES TO THE TASK? QUERY * FOR ?? OR INVALID RESPONSES, THE EXPLANATION MESSAGE * IS DISPLAYED AND THE RESPONSE OBTAINED & REPARSED * CHECKS ONLY THE FIRST 2 CHARACTERS OF A RESPONSE, * WHICH MUST BE LEFT-JUSTIFIED * E-REG = 0/1 FOR ENABLING/DISABLING TARGT CALL - DEPENDS ON * PRESENCE OF PARM2 IN RUN STRING * * RETURN POINTS: (P+1) EN OR /E * (P+2) FO * (P+3) IN * (P+4) SP * (P+5) VE *BC * (P+6) RE *BC * PTASK NOP SEZ,RSS IF E=1 THEN SKIP TARGT CALL * PTAS0 JSB TARGT READ RESPONSE INTO RBUFR CLB LDA RBUFR CHECK FOR VALID RESPONSES TO TASK? PROMPT CPA "EN" RSS '������þú CPA "EX" RSS CPA "/E" JMP EANS EN OR /E OR EX CPA "FO" JMP FANS FO(RMAT) CPA "IN" JMP IANS IN(ITIALIZE) CPA "SP" JMP SANS SP(ARE) CPA "VE" *BC JMP VANS VERIFY *BC CPA "RE" *BC JMP RANS RE-FORMAT *BC * * FOR ?? OR ANY OTHER REPOSNSE ASIDE FROM THE ABOVE, DISPLAY * JSB EXPLN "ENTER FO(RMAT),"IN(ITIALIZE),SP(ARE),EN" JMP PTAS0 AND TRY AGAIN * RANS ISZ PTASK SET APPROPRIATE RETURN POINTS *BC VANS ISZ PTASK *BC SANS ISZ PTASK IANS ISZ PTASK FANS ISZ PTASK EANS JMP PTASK,I * "EN" ASC 1,EN "EX" ASC 1,EX "/E" ASC 1,/E "FO" ASC 1,FO "IN" ASC 1,IN "SP" ASC 1,SP "VE" ASC 1,VE *BC "RE" ASC 1,RE *BC * ** END PTASK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** PRESP ** SPC 1 * PRESP READS AND PARSES RESPONSES TO THE VARIOUS QUERIES * INTERCEPTS EN,/E,NO,YE," "CR,AND ?? RESPONSES WITH * THE FOLLOWING RETURN POINTS: (P+1) NUMERIC, OR ERROR * (P+2) EN OR /E * (P+3) NO * (P+4) YE * (P+5) " ",CR * (P+6) ?? * PRESP NOP JSB TARGT READ RESPONSE INTO RBUFR * q������þú LDA RBUFR CHECK FOR VALID KNOWN RESPONSES CPA "/E" RSS CPA "EX" RSS CPA "EN" JMP ERES /E OR EN CPA "NO" JMP NRES NO CPA "YE" JMP YRES YE CPA "??" JMP ?RES ?? * JSB DFLT JMP PRESP,I NONE OF THE ABOVE - EITHER NUMERIC OR ERRONEOUS RSS " ",CR * ?RES ISZ PRESP SET THE APPROPRIATE RETURN POINTS ISZ PRESP YRES ISZ PRESP NRES ISZ PRESP ERES ISZ PRESP JMP PRESP,I * "NO" ASC 1,NO "YE" ASC 1,YE "??" ASC 1,?? * ** END PRESP ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** SPINT ** SPC 1 * SPINT CALLS THE TYPE32 DRIVER TO INITIALIZE ALL THE SPARES ON * THE CURRENT SUBCHANNEL PRIOR TO WRITING ANY DATA TO THEM. * SPINT NOP LDA P4 STA \MODE SET DRIVER INTO SPARE CLEANUP MODE * CLA STA \SEC# STA USED# INIT # SPARES USED LDA \DNTR STA \TRAK GET FIRST SPARE ON THIS SUBCHANNEL * LDB \DNSP SZB,RSS RETURN IF NO JMP SPINT,I SPARES ALLOCATED * CMB,INB STB N#SP SET LOOP COUNTER * NXTSP LDA \TRAK OTA 1 DISPLAY IN SWITCH REG JSB ELOCK LOCK THE EQT CLE JSB DISKD GO INIT THIS TRACK JSB UNLOK UNLOCK THE EQT ISZ \TRAK NEXT TRACK LDA \RET GET THE DRIVER'S STATUS RET SSA A=\RET STATUS FROM DRIVER JMP SPINT,I RETURN W/ ERROR * ISZ N#SP JMP NXTSP NOT DONE * JMP SPINT,I RETRUN * ** \I������þú END SPINT ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** PROMT ** SPC 1 * PRINTS ALL PROMPTS AND MESSAGES BASED ON AN INDEX CONTAINED * IN THE B-REG ON ENTRY - IF NEGATIVE, THEN DON'T CALL \BLIN * PROMT NOP CLE,SSB PRINT A BLANK LINE? CMB,CCE,INB NO AND SET B POSITIVE STB IDXPR SAVE MESSAGE INDEX SEZ,RSS SKIP IF NEGATIVE JSB \BLIN PRINT A BLANK LINE FIRST * LDB IDXPR GET INDEX AGAIN LDA PRMLN GET WORD LENGTH OF MESSAGE ADA B BY OFFSETTING INTO TABLE LDA A,I ADB PRMA AND NOW GET THE ADDRESS LDB B,I IN THE SAME FASHION * JSB \DSPL AND DISPLAY IT JMP PROMT,I RETURN * IDXPR NOP PRMLN DEF *+1 MESSAGE LENGTH TABLE P3 DEC 3 P4 DEC 4,20 P9 DEC 9,10 P19 DEC 19 P12 DEC 12 PTCH7 DEC 5 WARNING-SET TO 12 FOR RTE-IV DEC 19 P16 DEC 16 DEC 14 P32 DEC 32,16 P8 DEC 8,8 P7 DEC 7,7 P26 DEC 26,18,13 P15 DEC 15,16,11 P35 DEC 35,15,8,12 DEC 23,24 *BC P21 DEC 21 *BC * PRMA DEF *+1 MESSAGE ADDRESS TABLE DEF MES00 DEF MES01 DEF MES02 DEF MES03 DEF MES04 DEF MES05 DEF MES06 DEF MES07 DEF MES08 MS09. DEF MES09 MS10. DEF MES10 DEF MES11 DEF MES12 DEF MES13 DEF MES14 DEF MES15 DEF MES16 DEF MES17 DEF MES18 DEF MES19 DEF MES20 DEF MES21 DEF MES22 DEF MEúã������þúS23 DEF MES24 DEF MES25 DEF MES26 DEF MES27 *BC DEF MES28 *BC DEF MES29 *BC * ** END PROMT ** ********************************************************************** ********************************************************************** SPC 3 SKP ********************************************************************** ********************************************************************** ** EXPLN ** SPC 1 * PRINTS THE EXPLANATIONS MESSAGES SPECIFIED BY THE * CURRENT VALUE OF INDEX * EXPLN NOP JSB \BLIN PRINT A BLANK LINE * LDB INDEX GET INDEX LDA MSGLN ADA B FIRST GET THE WORD LDA A,I LENGTH OF THE MESSAGE ADB MSGA LDB B,I NOW ITS ADDRESS JSB \DSPL AND DISPLAY IT JMP EXPLN,I RETURN * MSGLN DEF *+1 MESSAGE LENGTH TABLE P33 DEC 33 *BC DEC 9 P6 DEC 6 P14 DEC 14 P13 DEC 13,6 * MSGA DEF *+1 EXPLANATION ADDRESS TABLE DEF XPL00 DEF XPL01 DEF XPL02 DEF XPL03 DEF XPL04 (ASSUMES TRACK # ALREADY STUFFED IN MESSAGE) DEF XPL02 ** END EXPLN ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** SPSAV,CLRBF,\BLIN,\DSPL,\RDIN,TARGT,\DFLT ** SPC 1 * * PRINTS THE REMAINING SPARE TRACKS ON A GIVEN LU * A-REG ON ENTRY = # * SPSAV NO������þúP JSB ASDEC CONVERT # TO ASCII LDB MS10. JSB .MVW STORE IN MESSAGE DEF P2 NOP LDB P10 JSB PROMT DISPLAY "XXXX SPARE TRACKS AVAILABLE" JMP SPSAV,I SPC 4 * * SET B-REG NUMBER OF WORDS AT \BUFA TO A-REG, AND CHECK THAT * BUFFER SIZE >= TRACK SIZE FOR \DLU * CLRBF NOP CMB,INB STB TEMP3 AND SAVE ADB BSIZE SSB IF BUFFER TOO SMALL JMP TOOSM THEN GIVE ERROR * LDB \BUFA CLEAR STA B,I INB BUMP BUFFER ADDRESS ISZ TEMP3 AND LOOP COUNTER JMP CLEAR CONTINUE JMP CLRBF,I DONE * TOOSM LDB P21 DISPLAY JSB PROMT "NOT ENOUGH ROOM FOR TRACK BUFFER" JMP \XOUT AND TERMINATE SPC 4 * * \BLIN NOP OUTPUT A BLANK LINE. LDB DBLNK CLA,INA JSB \DSPL JMP \BLIN,I SPC 4 * * \DSPL NOP DISPLAY MESSAGE ON OPERATOR CONSOLE STA DSPL STB DSPB JSB EXEC DEF *+5 DEF P2 DEF OPLU DSPB NOP DEF DSPL JMP \DSPL,I TO RETURN * DSPL NOP SPC 4 * * READS OPERATOR RESPONSE INTO RBUFR AND REISSUES EXEC * CALL IN CASE OF CONSOLE TIME-OUTS. * \RDIN NOP READS FROM OPERATOR CONSOLE STA DSPL INPUT LENGTH: +/- = WORDS/CHARS INPT JSB EXEC DEF *+5 DEF P1 DEF OPLU RBUFA DEF RBUFR DEF DSPL MAXIMUM INPUT LENGTH SZB,RSS CHECK TRANS. LOG JMP INPT TRY AGAIN FOR ANSWER LDA B GET TRANS. LOG CMA STA \NLNG SAVE NEG. OF TRANS. LOG LESS 1(FOR BIDEC) JMP \RDIN,I RETURN * \NLNG NOP NEG OF TRANSMISSION LOG -1 SPC 4 * * TARGT NOP LDA N8 MAX INPUT LENGTH JSB \RDIN GET RESPONSE JMP TARGT,I YES, RETURN SPC 4 * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. ||������þú(B) IS THE LENGTH OF INPUT IN CHARACTERS * RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * DFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP DFLT,I NO, SO DON'T BOTHER CHECKING LDA RBUFR AND B1774 CPA LBLNK ISZ DFLT GOT ONE JMP DFLT,I * LBLNK OCT 20000 SKP * ********************************************************************** ********************************************************************** ** ASDEC ** SPC 1 * * THE ASDEC SUBROUTINE CONVERTS THE CONTENTS OF A TO DECIMAL ASCII * AND STORES THE RESULT IN ITS OWN BUFFER @ CURAT. THE CALLER OF * ASDEC IS RESPONSIBLE FOR MOVING THE APPROPRIATE # WORDS TO ITS * OWN BUFFER. * * CALLING SEQUENCE: * A = DECIMAL # TO BE CONVERTED * * RETURN: A = BUFFER ADDRESS OF CURAT * ASDEC NOP CMA,INA MAKE IT NEGATIVE *WL LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET LOWER RANGE ADDRESS LDB N2 ALSO SET LOOP COUNT STB TCNT LDB CURAT *WL STB TEMP5 *WL LDB A NUMBER INTO B *WL NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA TEMP5,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR TEMP5,I ADD UPPER CHAR *WL STA TEMP5,I SAVE NEXT 2 CHARACTERS *WL ISZ TEMP5 INCR MESSAGE ADDRESS *WL ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT LDA CURAT JMP ASDEC,I YES - RETURN * * DPWRS DEF *+1 DEC 1000 DEC 100 P10 DEC 10 P1 DEC 1 * CURAT DEF *+1 BUFFER ADDRESS BSS 2 TCNT NOP TEMPORARY LOOP COUNTER CTEMP NOP SPC 6 * * GET DIGIT FOR \CVAS * * GETD PROVIDES THE ASCII CHAÄ0������þúRACTERS FOR \CVAS. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * RANAD NOP SKP ********************************************************************** ********************************************************************** ** BIDEC ** SPC 1 * * THE BIDEC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN BUFR FROM * DECIMAL ASCII TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A & B ARE IGNORED * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * BIDEC NOP LDB P10 GET DECIMAL BASE STB BASE1 SET THE DESIRED BASE * * CMB,INB SET NEG STB DRANG SET DIGIT RANGE * CCB SET FOR HIGH CHAR STB BUFUL LDA RBUFA STA TEMP4 CLA STA NUM# CLEAR ACCUMULATOR GETNX LDB BUFUL GET UPPER-LOWER FLAG IGNOR ISZ \NLNG OUT OF CHARACTERS?? RSS NO-CONTINUE JMP GDONE YES-RETURN LDA TEMP4,I GET CHAR FROM BUFFER SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ TEMP4 INCR BUFFER ADDRESS STB BUFUL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR YES ADA L60 SUBTRACT 60B FYÙ������þúROM CHAR STA TCHAR SAVE CHAR ADA DRANG IS THIS DIGIT INRANGE SSA,RSS YES IF RESULT IS NEG JMP DGERR SORRY - BAD DIGIT LDA NUM# GET PREVIOUS ACCUMULATOR MPY BASE1 MULTIPLY NEW DIGIT BY BASE ADA TCHAR SET A = NEW OCTAL NO. STA NUM# SAVE ACCUMULATOR SZB TEST FOR OVERFLOW RSS SSA TEST FOR OVERFLOW JMP DGERR INVALID NUMBER JMP GETNX GET NEXT DECIMAL DIGIT * GDONE ISZ BIDEC INCR RETURN ADDRESS LDA NUM# GET THE RESULT FROM ACCUMULATOR DGERR JMP BIDEC,I RETURN * TCHAR NOP TEMP CHAR SAVE AREA. DRANG NOP NEG ACCEPTABLE DIGIT RANGE NUM# NOP ACCUMULATOR FOR CONVERSION BLANK OCT 40 BUFUL NOP UPPER/LOWER CHARACTER = -1/0 MAXC NOP MAXIMUM # DIGITS IN CONVERSION L60 OCT -60 BASE1 NOP SKP HED FORMT - TYPE 32 DISC DRIVER ROUTINES ********************************************************************** ********************************************************************** ** \SETD ** * * DETERMINE SUBCHANNEL SPECIFICATIONS, USING INFORMATION * RETRIEVED FROM THE \TMT ENTRY FOR \DLU * \SETD NOP JSB XTTBL GET THE TMT ENTRY *WL DEF *+3 CORRESPONDING TO \DLU *WL DEF \DLU *WL DEF \TMT+1 * LDA N8 8 PARAMETERS *WL STA TEMP4 *WL LDB \TMT *WL LDA DPAD WHERE WE'RE GOING TO PUT THEM*WL STA TEMP5 *WL SET.1 LDA B,I *WL STA TEMP5,I *WL ISZ TEMP5 *WL INB *WL ISZ TEMP4 *WL N«������þú JMP SET.1 *WL LDA \DUNT FETCH UNIT # *WL ALF,ALF MOVE IT TO HIGH BYTE *WL IOR \DADD ADD HP-IB ADDRESS *WL STA \DUNT *WL LDA \D#ST FETCH SECTORS/TRACK *WL ALF,RAL AND MULTIPLY BY 128 *WL RAL,RAL TO GET WORDS/TRACK *WL STA \D#WT AND SAVE IT. *WL CLA SET CURRENT SPARE TO ZERO STA CRSP# JMP \SETD,I * SPC 1 * DISC SUBCHANNNEL SPECIFICATIONS * DPAD DEF \DADD ADDRESS OF DISC SPECS. *WL \DLU NOP CURRENT TYPE 32 DISC LU \DSUB NOP DISC SUBCHANNEL FOR \DLU \DADD NOP HP-IB ADDRESS *WL \DUNT NOP UNIT/ADDRESS *WL \DSHD NOP STARTING HEAD *WL \DFTR NOP STARTING CYLINDER *WL \DNSP NOP NUMBER OF SPARES *WL \DNTR NOP NUMBER OF TRACKS *WL \D#ST NOP NUMBER OF PHYSICAL SECTORS/TRACK *WL \DNSU NOP NUMBER OF SURFACES *WL \D#WT NOP WORDS/TRACK \DNSD NOP SECTORS/FLOPPY \TRAK NOP CURRENT TRACK # \SEC# NOP CURRENT SECTOR # \DTYP NOP DISC TYPE = 0/1 FOR FLOPPY/HARD DISC * ** END \SETD ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** ELOCK ROUTINE ** SPC 1 ELOCK NOP LDA LKFLG SZA JMP ELOCK,I IMMEDIATE RETURN-ALREADY LOCKED INA STA LKFLG SET LOCK FLAG FOR SAFETY VAL������þúVE JSB EQTRQ LOCK THE EQT FOR \DLU DEF *+3 DEF P1 DEF \DLU * JMP ELOCK,I RETURN SPC 1 LKFLG NOP 0/1=NOT LOCKED/LOCKED SPC 1 ** END ELOCK ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** UNLOK ROUTINE ** SPC 1 UNLOK NOP LDB LKFLG IS THE LOCK FLAG SET?? SZB,RSS JMP UNLOK,I RETURN-WE DIDN'T HAVE IT CLB RESET LOCK FLAG STB LKFLG JSB EQTRQ DEF *+3 DEF MSIGN DEF \DLU * JMP UNLOK,I RETURN * MSIGN OCT 100000 SPC 1 ** END UNLOK ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** LKLUS ROUTINE ** SPC 1 * LOCKS ALL DISC LU'S WHICH POINT TO THE SAME HPIB ADDRESS * OF THE DISC LU PASSED IN THE A-REG.(ONLY WORKS FOR RTE-IV) * THIS ROUTINE IS CALLED FOR THE FO[RMAT] OPTION TO LOCK LU'S * OF BOTH FLOPPY DISC DRIVES FOR THE DURATION OF THE FORMAT * PROCESS(7-19 MINUTES FOR DOUBLE SIDED),SO THAT THE EQT * DOES NOT HAVE TO BE LOCKED. * A=LU OF THE DISC WHO WE'RE GOING TO LOCK * RETURN: (P+1) * LKLUS NOP CLB,INB STB TEMP2 INIT CURRENT LU TO INVESTIGATE * STA RBUFR SET KEY LU IN THE LOCK TABLE ADA B2200 SET BITS FOR SPECIAL DRI8u������þúVER CALL STA TEMP3 TO GET THE TRACK MAP TABLE * JSB EXEC DEF *+7 DEF P1 READ DEF TEMP3 LU+SPECIAL FUNCTION CODE DEF \BUFI,I ADDRESS OF TRACK MAP BUFFER DEF P161 #WORDS TO GET(WHOLE TABLE) DEF P0 DEF P5 * LDA RBUFR GET KEY DISC LU JSB GTEQT RETURN A=SUBCHAN, B=EQT# STB KEQT SAVE THE KEY EQT TO SEARCH FOR JSB GTADR PASS A=SUBCH; RET A=HPIB ADDR OF DISC STA KADDR SAVE HPIB ADDRESS FOR LATER SEARCH * LDB ARBUF GET ADDR OF LU LOCK TABLE STB TEMP1 SAVE FOR LATER LDA LUMAX GET #LU'S IN DRT OFF BASE PG. CMA,INA SET LOOP COUNTER STA TEMP3 FOR EXHAUSTIVE SEARCH THRU ALL LU'S * CHKLU LDA TEMP2 GET CURRENT LU TO ASK ABOUT JSB GTEQT RET A=SUBCH, B=EQT# OF CURR LU CPB KEQT IS IT THE RIGHT EQT?? RSS YES-CHECK HPIB ADDRESS JMP NXTLU NO -GO ASK ABOUT NEXT LU * JSB GTADR GET HPIB ADDR OF LU IN A.REG CPA KADDR IS IT THE SAME AS TARGET DISC?? RSS YES-GO ENTER IN THE LU LOCK TBL JMP NXTLU NO -GO ASK ABOUT NEXT LU * MATCH LDA TEMP2 GET THE LU THAT MATCHED STA TEMP1,I SALT IT AWAY IN LOCK TABLE ISZ LK#LU INCREMENT # OF LU'S NEED TO LOCK ISZ TEMP1 ADVANCE TO NEXT FREE LOCK TABLE SLOT * NXTLU ISZ TEMP2 STEP TO NEXT LU IN SEARCH ISZ TEMP3 SEARCHED ALL LU'S IN DRT?? JMP CHKLU NOPE-SEARCH ANOTHER * JSB LURQ NOW LOCK ALL THE LU'S DEF *+4 THAT POINT TO THE DISC DEF LKOPT THAT WE'RE FORMATTING ARBUF DEF RBUFR TABLE OF THE LOCKEE'S DEF LK#LU NUMBER OF LOCKEE'S * NOP ERROR RETURN JMP LKLUS,I RETURN-ALL FLOPPY LU'S LOCKED * LKOPT OCT 054001 OPTIONS:NO ABORT,IGNORE SST,W/ WAIT,DISCS OK LK#LU NOP NUMBER OF LU'S TO LOCK KEQT NOP —>������þú EQT# OF DISC TO FORMAT KADDR NOP HPIB ADDR OF DISC TO FORMAT DRT EQU 1652B BASE PAGE-1ST WORD OF DRT LUMAX EQU 1653B BASE PAGE-LENGTH OF DRT * * GTEQT NOP SUBROUTINE TO GET EQT&SUBCH CCB OF LU PASSED IN A REG. ADB A (LU-1) IS OFFSET INTO DRT ADB DRT ADD 1ST WORD ADDR OF DRT LDA B,I GET DRT WORD 1 FOR THIS LU AND B77 MASK OFF EQT NUMBER SWP & GIVE TO B.REG * LDA A,I GET DRT WORD AGAIN ALF,RAL ROTATE SUBCH TO LOW 5 BITS AND B37 MASK OFF SUBCHANNEL OF LU JMP GTEQT,I RET: A=SUBCHANNEL,B=EQT# * * * SUBROUTINE TO GET THE HPIB ADDRESS OF THE DISC SUBCHANNEL * SPECIFIED IN THE A.REG. (ACCESSES THE TRACK MAP TABLE) * GTADR NOP MPY P5 OFFSET 5 WORDS PER SUBCH INTO TABLE ADA P3 OFFSET TO HEAD\ADDR WORD ADA \BUFI ADD TABLE'S BASE ADDR LDA A,I GET THE HEAD\HPIB ADDR WORD AND B17 MASK OFF THE HPIB SELECT ADDRESS JMP GTADR,I RETURN A=HPIB ADDR OF DISC SUBCHANNEL * ** END LKLUS ROUTINE ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** ULKLU ROUTINE ** * * ULKLU-UNLOCKS ALL LU'S THAT ARE LOCKED TO FORMAT * BY THE LKLUS ROUTINE * ULKLU NOP LDA LK#LU GET # OF LU'S CURRENTLY LOCKED SZA,RSS JMP ULKLU,I NONE LOCKED-RETURN JSB LURQ DEF *+4 DEF ULKOP UNLOCK OPTION DEF RBUFR LU BUFFER DEF LK#LU # LU'S LOCKED NOP ERROR RETURN CLA STA LK#LU SET # LOCKED TO ZERO x`������þú JMP ULKLU,I RETURN * ULKOP OCT 154000 UNLOCK ALL DISC LU'S,IGNORE SST,NO ABORT * ** END ULKLU ROUTINE ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** ** SPC 1 * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER OF READS OR WRITES * * CALLING SEQUENCE * LEN = # WORDS TO TRANSMIT * E = 1 FOR READ * E = 0 FOR WRITE * * * DISKD HAS FOUR MODES OF OPERATION: * MODE 3 : INITIALIZING AN ENTIRE SUBCHANNEL * MODE 4 : INITIALIZING SPARE TRACKS PRIOR TO MODE 3 * MODE 5 : SPARING ONE TRACK ON A SUBCHANNEL * MODE 6 : FORMATTING A FLOPPY DISC * MODE 7 : RE-FORMAT A HARD DISC TRACK *BC * MODE 8 : VERIFY A TRACK (HARD OR FLOPPY) *BC * * THE FORMT PROGRAM CALLS DISKD IN MODE4 FOR EACH SUBCHANNEL BEFORE * IT BEGINS ANY WRITING OR INITIALIZING IN MODE3. THIS IS DONE SO * THAT ALL THE SPARES FOR A GIVEN SUBCHANNEL CAN BE CLEANED UP. * * DISKD NOP CLA ELA SHIFT E INTO LSB OF A REG. STA \R/W SAVE E IN \R/W * LDA N10 STA ERCNT INITIALIZE ERROR COUNTER * * CLA STA \RET CLEAR RETURN STATUS FLAG STA SPD CLEAR INIT WRITE FLAG STA \SEC# AND SET TO SECTOR 0 * LDA \TRAK LOGICAL TRACK ADDRESS ON CURRENT SUBCHANNEL JSB DADTR CONVERT LOGICAL \TRAK TO PHYSICAL DISC ADDR DST SKCYL SET CYL/HEAD FOR SEEK COMMAND DST ARCYL SET CYLINDER/HEAD FOR ADDRESS RECORD COMMAND * SPC 3 ************-‚������þú********************************************************** * BEGIN INCASE(\MODE): * SPC 1 LDA TBL01 ADA \MODE JMP A,I * TBL01 DEF * NOP N/A NOP N/A JMP MOD03 JMP MOD04 JMP MOD05 JMP MOD06 JMP MOD07 *BC JMP MOD08 *BC * SPC 3 * * MODE=3: INITIALIZING TRACKS * MOD03 CLA STA FLMSK SET FILE MASK FOR NO AUTO SEEK TO SPARE LDA A067 GET ACTION: SEEK,ADRC,FLMSK,RDFS,CALL STFIX STA \ACTN SET FOR READ FULL SECTOR FOR STATUS LDA P1 STA PHASE SET PHASE FOR STATUS READ TO INIT TRACK JMP DSGO SPC 3 * * MODE=4: INITIALIZE SPARES - SPARE CLEANUP MODE * MOD04 CLA STA FLMSK SET FILE MASK FOR NO AUTO SEEK LDA A067 GET ACTION: SEEK,ADRC,FLMSK,RDFS,STFIX STA \ACTN SET FOR READ FULL SEC FOR TRACK'S STATUS LDA P3 STA PHASE SET PHASE FOR STATUS READ TO SPARE JMP DSGO SPC 3 * * MODE=5: SPARE ONE TRACK * MOD05 CLA STA FLMSK SET FILE MASK FOR NO AUTO SEEK TO SPARE LDA \D#ST CMA,INA STA SLOOP SET LOOP COUNTER = # SECTORS/TRACK CLA STA PHASE PHASE = 0 FOR READ W/ OFFSETS STA OFSET START WITH OFFSET = 0 LDA A2007 RESET ACTION WORD TO STA \ACTN READ W/ OFFSET RATHER THAN WRITE LDB \BUFA SET BUFFER ADDRESS FOR STB BPTR MOVING EACH SECTOR TO TRACK BUFFER JMP DSGO SPC 3 * * MODE=6: FORMAT A FLOPPY * MOD06 CLA SET # BAD TRACKS TO 0 STA BADFT STA PASSX INIT FOR DISPLAY RTN PASS# CLB DST SKCYL FIRST SEEK TO CYL 0/HEAD 0 INA STA INTLV WITH INTERLEAVE =1 (FASTEST) LDA A4000 SET ACTION WORD TO FORMAT ONLY STA \ACTN üÃ������þú -SEEK ILLEGAL UNLESS FORMATTED JSB ONLY1 SET ERCNT TO 1 TRY LDB BFTBL INITIALIZE POINTER TO BAD STB BPTR TRACK TABLE FOR PHASE 8 * * DO A STATUS REQUEST TO THE FLOPPY TO DETERMINE WHAT TYPE OF * DISC MEDIA WE'RE TALKING TO. IF THE FLOPPY IS UNFORMATTED OR * AN UNRECOGNIZABLE FORMAT, THE HARDWARE MAY TAKE UP TO 10 SEC. * TO COMPLETE THE 1ST STATUS REQUEST,WHILE IT TRIES TO MAKE SENSE OF * THE MEDIA. TO GUARANTEE THAT WE HAVE A LEGITIMATE STATUS REPORT, * THE 1ST STATUS IS IGNORED(INCASE THE DRIVER TIMED OUT),AND A * 2ND STATUS REQUEST IS ISSUED AT REQ6+5. * REQ6 JSB REQST **NOTE-FIRST STATUS CMD MAY TAKE UP TO CLB,INB SLEEP FOR 1 SEC. BEFORE POLLING LDA P2 2 POLLS MAX. WAIT=10 SEC. JSB SLEEP WAIT FOR DRIVE READY INCASE LONG STATUS. JMP NODSC TIMEOUT RET-NOT RDY IF>11 SEC. JSB REQST DO A 2ND STATUS FOR REAL NOW LDA STAT2 ALF ALF,RAR *WL AND B17 CAN BE DETERMINED SZA,RSS JMP NODSC NO DISC IN SPECIFIED DRIVE CLB,INB SET AT LEAST ONE SURFACE CPA P5 BLANK OR UNKNOWN FORMAT OF A RSS DOUBLE-SIDED CPA P6 OR HP FORMAT DOUBLE-SIDED INB STB \DNSU SET #SURFACES BASED ON DISC LDA B MPY P77 SET TOTAL # OF TRACKS ON DISC STA \DNTR MPY P30 NOW SET THE # SECTORS PER DISC STA \DNSD FOR THE VERIFY COMMAND * LDB BPAT1 START WITH FIRST BIT PATTERN STB BPATT JSB PASS# DISPLAY THE PASS #1 MESSAGE LDA YOVRD AND YES TO OVERRIDE OLD STA FTYP FORMAT BIT WITH TYPE = 2 LDB P7 SET PHASE STB PHASE TO 7 FOR FORMAT/VERIFY COMBO JMP DSGO * NODSC JSB NRDER ISSUE NOT READY MESSAGE IF JMP REQ6 NO FLOPPY IN DRIVE * R…������þú *BC * *BC * *BC MOD07 LDA A207 SET ACTION WORD FOR.. *BC STA \ACTN INITIALIZE *BC LDA P13 SET PHASE TO 13 *BC STA PHASE *BC CLA SET FILE MASK FOR NO AUTO *BC STA FLMSK SEEK TO SPARE *BC JMP DSGO *BC * *BC * *BC * *BC MOD08 LDA A407 SET ACTION WORD FOR... *BC STA \ACTN VERIFY *BC LDA P4 SET FILE MASK FOR.. *BC STA FLMSK AUTO SEEK TO SPARE *BC CCA SET ERROR COUNT *BC STA ERCNT FOR ONLY ONE TRY *BC LDA \D#ST GET THE # OF SECTORS PER TRACK *BC CPA P30 FLOPPY? *BC JMP FL YES *BC LDB P14 NO - HARD DISC *BC RSS *BC FL LDB P15 SET PHASE NUMBER *BC STB PHASE *BC JMP DSGO GO DO IT *BC SPC 1 * END INCASE(\MODE): * ********************************************************************** SKP ********************************************************************** ********************************************************************** ** MAIN DRIVER LOOP ** SPC 1 * THE MAIN DRIVER LOOP REPEATEDLY CALLS XFER T€������þúO PERFORM DISC * COMMANDS AND THEN EXAMINES STATUS WORD 1 RETURNED BY XFER. * THE APPROPRIATE PROCESSING BLOCK IS BRANCHED TO BY THE INCASE * CONSTRUCT. ALL THE PROCESSING BLOCKS RETURN TO THE COMMON * RETURN POINT: "ENDBR". WE CONTINUE IN THIS LOOP UNTIL ONE OF THE * PROCESSING BLOCKS SETS \RET TO A +1 FOR A SUCCESSFUL COMPLETION * OF A COMMAND SEQUENCE OR -1 FOR AN UNSUCCESSFUL RETURN TO THE * CALLING PROGRAM. SPC 2 DSGO JSB XFER WE'ER LOOPING AGAIN:CALL ACTION ROUTINE * RET W/ A=STAT1 WORD; B=STAT2 SPC 3 * BEGIN INCASE(STAT1): (RETURNED IN A REG BY XFER) * SPC 1 ADA TBL02 GET (ADDRESS OF BRANCH TABLE + STAT1) JMP A,I BRANCH TO THE PROCESSING BLOCK * TBL02 DEF *+1 CODE ERROR PROCESSING JMP ENDOK 00 NO ERROR - GO ENTER NEXT PHASE JMP FAULT 01 ILLEGAL OP - PROGRAM FAULT JMP FAULT 02 UNIT AVAIL. PROGRAM FAULT JMP FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 04 " " " " JMP FAULT 05 " " " " JMP FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP DSKER 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JMP FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JMP FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JMP FAULT 15 UNIMPLEMENTED ERROR CODE - FAULT JMP DSKER 16 OVER RUN JUST RETRY JMP DSKER 17 CORRECTABLE ERROR RETRY JMP ILSPR 20 ILLEGAL SPARE JMP DEFTR 21 DEFECTIVE TRACK JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JMP FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 25 " " " " JMP FRMSW 26 WRITE WITH P BIT SET&FORMAT SW OFF .ø������þú JMP UWAIT 27 WAIT FOR THE UNIT. SPC 1 * END INCASE (STAT1); SPC 2 ENDBR LDA \RET CHECK THE DRIVER'S STATUS SZA,RSS LOOP AGAIN IF \RET=0 JMP DSGO * LDA A1004 GET ACTION WORD FOR END WITH/FILEMASK LDB \MODE NO FILEMASK COMMAND IF A CPB P6 FLOPPY DISC LDA A1000 END ONLY LDB PHASE *BC CPB P15 *BC LDA A1000 *BC STA \ACTN AND SAVE FOR XFER LDA P4 STA FLMSK SET FOR AUTO-SEEK REGARDLESS IF APPLICABLE LDA ST1 SAVE ST1 FOR C78? BEFORE XFER *BC STA ST.1 CHANGES IT *BC JSB XFER SEND IT. * JSB C78? CHECK FOR FORMT ABORT *BC LDA \RET RETURN THE NEWS: -1= ERROR JMP DISKD,I RETURN TO MAIN SPC 2 ** END DRIVER MAIN LOOP ** ********************************************************************** ********************************************************************** SPC 2 ********************************************************************** ********************************************************************** ** THE FOLLOWING VARIABLES DETERMINE THE STATE OF THE MAIN DRVR LOOP** SPC 1 * \MODE - FOR COMMUNICATING TO DRIVER FROM MAIN. * * =1 - REGULAR READ/WRITE * =2 - WRITE SYSTEM TRACKS (WITH PROTECT) * =3 - WRITE INITIALIZE TRACKS-ALSO FOR 7910 SYSTEM BECAUSE * 7910 HAS NO FORMAT SWITCH * =4 - INITIALIZE SPARES - CLEANUP MODE. * =5 - * =6 - * =7 - RE-FORMAT *BC * =8 - VERIFY *BC * * PHASE - FOR REMEMBERING PRESENT STATE WHILE LOOPING THRU DRIVER. * * =1 - STATUS READ TO SYSTEM/INIT TRACK. * =2 - WRITE INITIALIZÑŽ������þúE TO SYSTEM/INIT TRACK. * =3 - STATUS READ TO SPARE. * =4 - WRITE INITIALIZE TO SPARE. * =5 - WRITE INITIALIZE FIXUP TO SYSTEM TRACK. * =6 - WRITE INITIALIZE TO SPARE - FLAGGING DEFECTIVE. * =7 - * =8 - * =13- RE-FORMAT A HARD DISC TRACK *BC * =14- VERIFY A HARD DISC TRACK *BC * =15- VERIFY A FLOPPY TRACK *BC SPC 1 ** ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** ENDOK ** SPC 1 * A SUCCESSFUL DISC OPERATION HAS JUST BEEN COMPLETED. ENDOK * DETERMINES WHAT PHASE THE DRIVER JUST FINISHED AND SETS UP * THE NEXT PHASE BY ALTERING "PHASE" AND "\ACTN" FLAGS. SPC 2 ********************************************************************** ** BEGIN INCASE(\MODE): ** ENDOK LDA TBL03 GET ADDRESS OF BRANCH TABLE ADA \MODE JMP A,I BRANCH TO APPROPRIATE BLOCK * TBL03 DEF * NOP NOP JMP EOK3 JMP EOK4 JMP EOK5 JMP EOK6 JMP EOK78 *BC JMP EOK78 *BC * SPC 3 EOK78 CLA,INA *BC STA \RET *BC JMP ENDBR *BC * *BC * * MODE=3 INITIALIZING TRACKS MODE * EOK3 LDA TBL04 ADA PHASE JMP A,I * TBL04 DEF * JMP PHA1 JUST FINISHED STATUS READ TO INIT TRACµ������þúK JMP PHA2 JUST FINISHED WRITE INITIALIZE TO INIT TRACK JMP PHA3 JUST FINISHED STATUS READ TO POTENTIAL SPARE JMP PHA4 JUST FINISHED WRITE INITIALIZE TO SPARE JMP PHA5 JUST FINISHED WRITE INIT ON BAD TRACK-FOR FIXUP JMP * MAYBE 6***DEBUG ONLY...SHOULDN'T GET HERE!!!! * SPC 3 * * PHASE=1: FINISHED STATUS READ. OK-SO NOW DO WRITE INIT TO TRACK * PHA1 CLB MODE3- SO DON'T WRITE PROTECT. STB SPD SAVE IN FLAG WORD - FOR WRITE INITIALIZE * ISZ PHASE ADVANCE TO PHASE2- WRITE INITIALIZE. LDA A207 SET ACTION:WRITE INIT STA \ACTN JMP ENDBR SPC 3 * * PHASE=2:JUST DID WRITE INIT.-NOW VERIFY THE TRACK * PHA2 LDA A407 SEEK,VERIFY,CHECK STATUS STA \ACTN JSB XFER GO VERIFY & RETURN WT STATUS SZA ANY TYPE OF ERROR IS BAD NEWS. JMP VFAIL VERIFY FAILED- GET FIRST SPARE * CLA,INA STA \RET SUCCESSFUL VERIFY-SIGNAL MAIN & RETURN STATUS JMP ENDBR * VFAIL CLA STA IDXPR SET FOR RPORT DLD CYL# VERIFY FAILED- SAVE BAD TRK DST BDCYL FOR LATER. JSB RPORT REPORT:"BAD TRACK... " JSB NIXSP GET NEXT POTENTIAL SPARE JMP ENDBR ERROR RETURN FOR NIXSP-IE. OUT OF SPARES!! DST SKCYL SET SEEK ADDRESS TO SPARE DST ARCYL SET ADDR RECORD CLA STA FLMSK FILE MASK - NO AUTO SEEK TO SPARE * ISZ PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE LDA A067 ACTION: SEEK,FMSK,RDFS,STFIX FOR TRACK STATUS STA \ACTN JMP ENDBR SPC 3 * * PHASE=3: STATUS WRT TO POTENTIAL SPARE WAS OK - NOW DO A WRT * INITIALIZE TO SPARE & POINT IT TO THE BAD TRACK * PHA3 DLD BDCYL GET DEFECTIVE TRACK ADDRESS & SET IT DST ARCYL IN SPARE WITH AN ADDRESS RECORD COMMAND CLB STB FLMSK NO AUTO SEEK LDB S100 …ý������þú MODE3: SET SPARE , NO PROTECT STB SPD SET IT. * ISZ PHASE SET PHASE4: WRITE INITIALIZE A SPARE. LDA A207 SET ACTION WORD: WRT INIT STA \ACTN JMP ENDBR SPC 3 * * PHASE=4: WRITE INITIALIZE TO SPARE WAS SUCCESSFUL - NOW FIXUP * ORIGINAL BAD TRACK WITH SPARE'S ADDRESS. * PHA4 DLD BDCYL GET ADDRESS OF ORIGINAL BAD TRACK & SET DST SKCYL UP TO SEEK TO IT. DLD CYL# GET ADDR OF THE CHOSEN SPARE AND DST ARCYL SET IT IN THE BAD TRACK W/ AN ADDRESS REC'D COMMAND. * CLB STB FLMSK DISABLE SPARING FEATURE LDB S001 MODE3: DEFECTIVE, NO PROTECT STB SPD SET IT. * ISZ PHASE ADVANCE TO PHASE5: WRT INIT FOR FIXUP TO DEF. TRACK LDA A207 SET ACTION WORD TO WRITE INIT.,W/ SEEK STA \ACTN JMP ENDBR SPC 3 * * PHASE5: WRITE INIT FOR FIXUP DONE-NOW VERIFY THE BAD TRACK * THAT WAS SPARED. WE'RE GOING TO DO A SEEK TO THE BAD * TRACK WITH SPARING ENABLED, AND VERIFY IT. * PHA5 DLD BDCYL GET ADDR OF THE ORIGINAL BAD TRACK DST ARCYL AND SET UP TO SEEK TO IT. LDA P4 STA FLMSK ENABLE SPARING-SO WE'LL RESEEK TO THE SPARE TRACK. * LDA A407 SEEK,ENABL SPR'ING,VERIFY,GET STATUS STA \ACTN JSB XFER GO VERIFY THIS BAD TRACK,SEEKING TO ITS SPARE SZA JMP FAILV ANY ERROR IS BAD NEWS. * CLA,INA SIGNAL RPORT TO SEND STA IDXPR "SPARED TO..." DLD CYL# GET ADDR OF SPARED USED JSB RPORT SEND "SPARED TO XXXX YYYY .... * CLA,INA STA \RET SIGNAL MAIN THAT WE'RE DONE & RETURN OK STATUS. JMP ENDBR * * MAYBE SETUP A PHASE 6 FOR MARKING SPARE DEFECTIVE? **************** * FAILV JSB NIXSP BAD NEWS- GET NEXT POTENTIAL SPARE & WRT FOR STATUS. JMP ENDBR ERROR RETURN FOR NIXSP- IE. OUT OF SPARES! DS¤I������þúT SKCYL SET UP TO SEEK TO NEXT SPARE  DST ARCYL AND CHECK ITS STATUS. * CLB STB FLMSK DISABLE AUTO-SEEK TO SPARE * LDA P3 STA PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE. LDA A067 ACTION: SEEK,RDFS FOR STATUS,STFIX STA \ACTN JMP ENDBR SPC 3 * * MODE=4: SPARE CLEANUP/INITIALIZATION MODE. * EOK4 LDA PHASE CPA P3 ARE WE IN PHASE3? - (STATUS READ TO SPARE)? RSS YES - STATUS WRT WAS OK - NOW DO WRT INIT TO SPARE. JMP PHB4 NOT IN PHASE3 - GO CHECK IF IN 4. * * PHASE3: * CLB GET READY TO DO A WRITE INIT TO THE SPARE. STB FLMSK DISABLE AUTO-SEEK TO SPARE. * ISZ PHASE ADVANCE TO PHASE4- WRITE INITIALIZE TO SPARE. LDA A207 ACTION:ADRC,WRITE INIT STA \ACTN JMP ENDBR * * PHASE4: * PHB4 CPA P4 ARE WE IN PHASE4?- (WRT INIT TO SPARE)? RSS YES - WRT INIT WENT OK- NOW VERIFY THE SPARE. JMP PHB6 NOT IN PHASE4 - GO CHECK IF IN 6. * LDA A407 SEEK,VERIFY & RET STATUS STA \ACTN SET ACTION WORD FOR XFER JSB XFER GO VERIFY THE SPARE SZA IF STATUS=0, WE'RE OK. JMP FAIL ANY ERROR IS BAD NEWS. * CLA,INA VERIFY WENT OK - SIGNAL SUCCESS & RETURN TO MAIN. STA \RET JMP ENDBR * FAIL LDA A207 SET ACTION FOR INIT AGAIN STA \ACTN * LDA S001 SET SPD BITS FOR FLAGGIN A DEFECTIVE SPARE. STA SPD SET 'EM. ISZ PHASE ADVANCE TO PHASE6: FLAG THAT DEFECTIVE SPARE. ISZ PHASE JMP ENDBR GO AROUND DRIVER LOOP AGAIN-SAME OLD PHASE4:INIT SPARE * * PHASE 6: REPORT BAD SPARE & RETURN TO LOOP * PHB6 LDA P2 SIGNAL RPORT TO SEND STA IDXPR "BAD SPARE..." DLD SKCYL GET SET TO REPORT BAD SPARE JSB RPORT "BAD TRACK ..... " * CLA,INA é������þú WE'RE ALL DONE-SPARE HAS BEEN FLAGGED DEFECTIVE. STA \RET SIGNAL THE MAIN & RETURN. JMP ENDBR SPC 3 * * MODE=5: SPARE ONE TRACK * EOK5 LDA PHASE WHERE ARE WE? CPA P4 JMP PHA4 SAME ACTION AS IN PHASES 4 & 5 CPA P5 FOR MODE 3 JMP PHA5 CPA P6 JUST MARKED A SPARE DEFECTIVE JMP PHAS6 NOW GET ANOTHER * * * PHASE=0: DONE READING THIS SECTOR, MOVE ON TO NEXT UNLESS * ALL ON TRACK READ * PHAS0 LDA RBUFA MOVE CONTENTS OF READ W/OFFSET ADA P16 BUFFER TO BIG TRACK BUFFER \BUFA LDB BPTR GET CURRENT POSITION IN \BUFA JSB .MVW MOVE 'EM OVER! DEF P128 NOP STB BPTR UPDATE FOR NEXT TIME * ISZ SLOOP DONE WITH LOOP - IE, ALL SECTORS ON TRACK? RSS NO JMP DONES YES - ON TO NEXT PHASE ISZ \SEC# BUMP TO NEXT SECTOR CLA RESET OFFSET STA OFSET LDA N10 AND THE RETRY COUNTER STA ERCNT JMP ENDBR AND CONTINUE SPC 3 * * DO A WRITE INIT OF SPARE TRACK W/ DATA & ADDR OF DEFECTIVE TRACK * DONES CLA SIGNAL RPORT TO SEND* STA IDXPR "BAD TRACK..." DLD CYL# SAVE BAD TRACK ADDRESS DST BDCYL FOR SPARE'S WRITE INIT JSB RPORT "BAD TRACK ..." JMP NEWSP * PHAS6 LDA P2 STA IDXPR SEND "BAD SPARE..." MESSAGE DLD SKCYL FOR BAD SPARE ENCOUNTERED JSB RPORT * NEWSP JSB XSPAR NOW GET THE NEXT AVAILABLE DEF *+4 DEF \DLU DEF STRAK DEF IER LDA IER WAS ONE AVAILABLE? SZA JMP NOSP NO! * LDA STRAK GET PHYSICAL ADDRESS JSB DADTR OF SPARE DST SKCYL AND SAVE FOR THE SEEK DLD BDCYL GET ADDRESS OF DEFECTIVE DST ARCYL TRACK AGAIN FOR ADDRESS REC CLB STB \SEC# RESET SECTOR POINTER *WL¦������þú STB FLMSK CLEAR FILE MASK TO DISABLE AUTOSEEK ADB S100 STB SPD SET TO SPARE, NO PROTECT * LDA P4 INDICATE STA PHASE NEW PHASE LDA A207 SET ACTION:SEEK,INIT STA \ACTN WRITE INIT WITH SEEK JMP ENDBR * * OUT OF SPARES FOR THIS LU * NOSP LDB P12 SEND MESSAGE: JSB PROMT "OUT OF SPARE TRACKS FOR THIS LU" CCA STA \RET JMP ENDBR AND ABORT TASK SPC 3 * * MODE=6: FORMATTING A FLOPPY * EOK6 JSB ONLY1 SET ERCNT TO 1 TRY ONLY LDA PHASE CPA P7 RSS JMP PHAS8 * * PHASE 7 = FORMAT COMMAND DONE, NOW ISSUE VERIFY TO * GET ANY BAD TRACKS * ISZ PHASE SET TO PHASE 8 CLB CLA DST SKCYL START W/ A SEEK TO CYL 0, HEAD 0 LDA A401 ACTION: SEEK,VERIFY STA \ACTN SET FOR A VERIFY W/ SEEK * CLA GET MAX # SECTORS/DISC LDB BPATT IF PASS 5 THEN SZB,RSS LDA BADFT VERIFY ONLY THE GOOD TRACKS MPY P30 CMA,INA AND SUBTRACT FROM TOTAL# ADA \DNSD FOR THE DISC STA \D#ST ***NOTE THAT OLD VALUE WAS DESTROYED! JMP ENDBR AND CONTINUE * * PHASE 8 - VERIFY COMPLETE, SO SET UP THE NEXT BYTE * PATTERN FOR THE FORMAT CALL. IF BPAT5, * MEANING THE FINAL PASS, THEN EXIT * PHAS8 CPA P9 JMP PHAS9 GO PROCESS THE NEXT BAD TRACK IN BFTBL * LDB BPATT FINAL PASS JUST DONE? CPB BPAT5 JMP DONE6 YES CPB BPAT4 IF PASS 4 JUST COMPLETED, JMP LOOPB GO DO THE WRITE INIT'S * CPB BPAT3 ELSE UPDATE THE BYTE PATTERN LDB BPAT4 CPB BPAT2 LDB BPAT3 CPB BPAT1 LDB BPAT2 STB BPATT AND SAVE JSB PASS# DISPLAY THE PASS #X MESSAGE * CLA CLB DST SKCYL ANOTHER SEEK TO CYL 0/HEAD 0 LDÕÅ������þúA A4001 SEEK,FORMAT STA \ACTN SEEK AND FORMAT LDB P7 STB PHASE RESET TO 7 AGAIN JMP ENDBR * * FIRST 4 PASSES COMPLETED - NOW DO THE WRITE INIT'S * WITH D-BITS SET TO BAD TRACKS IN BFTBL * LOOPB LDA BADFT IF NO BAD TRACKS ENCOUNTERED SZA,RSS THEN JMP PASS5 TO 5TH FORMAT/VERIFY COMBO * CMA ELSE SET #BAD TRACKS,LESS 1 (ISZ @PHAS9) STA SLOOP AS LOOP COUNTER LDB BFTBL POINT TO FIRST ADDRESS STB BPTR PAIR IN TABLE ISZ PHASE PHASE 9 (CLRBF ALREADY SET BUFFER=0) * * PHASE 9: DO A WRITE INIT W/D-BIT SET TO THE NEXT BAD * TRACK IN BFTBL UNTIL BADFT TRACKS DONE * INIT COMMAND ONLY SUPPORTS INIT OF ONE * SECTOR AT A TIME,BUT MARKS THE D BIT IN * WHOLE TRACK EVEN IF ONLY ONE SECTOR IS * INITIALIZED. SO DO ONLY 1 TO SAVE TIME. * SET LEN UP TO 128 AT FPR2+4 IN FPROC. * PHAS9 ISZ SLOOP DONE WITH 'EM ALL? RSS NO, KEEP ON GOING JMP PASS5 YES, GO DO LAST FORMAT/VERIFY PASS * DLD BPTR,I GET THE BAD CYL # AND HEAD # DST SKCYL SET FOR SEEK ISZ BPTR ISZ BPTR POINT TO NEXT ADDRESS PAIR LDB S001 SET D-BIT ONLY STB SPD LDA A201 SEEK, WRITE INIT STA \ACTN JMP ENDBR CONTINUE * * INITIATE 5TH AND FINAL FORMAT/VERIFY PASS WITH: * DATA BYTE=0, TYPE=2, OVERRIDE FORMAT=OFF, AND * INTERLEAVE=\FILL * PASS5 JSB PASS# DISPLAY THE PASS #X MESSAGE LDB BPAT5 EQUALS 0 STB BPATT CLA DST SKCYL START OVER AGAIN LDB \FILL GET USER-SPECIFIED INTERLEAVE VALUE STB INTLV AND SET LDA A4001 SET FOR A STA \ACTN FORMAT W/ SEEK LDB NOVRD DO NOT OVERRIDE THE PRESENT FORMATTING STB FTYP ON DISC. TYPE =2 FOR HP LDA P7 STA PHASE START IT UP AGAI ´������þúN! JMP ENDBR * * DONE WITH MODE 6, ALL PHASES * DONE6 ISZ WARNG WILL BE >=0 ONLY IF BAD TRACKS JSB RFFLP DURING PASS 5 - ISSUE WARNING CLA,INA STA \RET SIGNAL OK COMPLETION JMP ENDBR * RFFLP NOP LDB P23 DISPLAY: JSB PROMT "WARNING! POSSIBLE BAD FLOPPY MEDIA..." JMP RFFLP,I SPC 1 ** END ENDOK BLOCK ** ********************************************************************** ********************************************************************** SPC 6 ********************************************************************** ********************************************************************** ** NEWOF ** SPC 1 * INCREMENTS THE OFFSET VALUE FOR READ WITH OFFSET IN THIS * ORDER: 0,10,20,30,40,50,60,-10,-20,-30,-40,-50,-60. (THE * VALUES ARE STORED IN THE LOWER BYTE OF OFSET, IN SIGN/ * MANGITUDE FORM). * A WARNING MESSAGE IS ISSUED IF AN ERROR STILL OCCURS AFTER * AN OFFSET OF -60 WAS USED FOR THIS SECTOR, UNLESS THE MESSAGE * WAS ALREADY ISSUED FOR THIS TRACK. * NEWOF LDB ST1 IF ALREADY MARKED DEFECTIVE CPB B21 THEN DON'T BOTHER WITH ALL THE JMP RDWRN THESE OFFSET VALUES * LDA OFSET WAS THIS THE LAST TRY? CPA N60B JMP RDWRN YES - MAY ISSUE WARNING * LDB N3 STB ERCNT ELSE RESET RETRY COUNTER ADA P10 BUMP BY 10 * 25 MICRO-INCHES CPA P70 LAST POSITIVE VALUE? LDA N10B YES, START AT NEG 10 STA OFSET JMP ENDBR AND CONTINUE * RDWRN ISZ WARNG HAS MESSAGE BEEN ISSUED YET? JMP PHAS0 YUP! LDB P11 DISPLAY JSB PROMT "WARNING! ALL INFORMATION ON ..." JMP PHAS0 GO TO NEXT SECTOR * ** END NEWOF BLOCK ** ********ö¢������þú************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** C78? ** * *BC * *BC * SUBROUTINE C78? CHECKS FOR CERTAIN FATAL COMBINATIONS OF *BC * ERROR STATUS NUMBERS, MODES, PHASES AND NUMBER OF RETRYS *BC * NORMAL RETURN IS AT P+1 *BC * OTHERWISE ABORT THE TASK *BC * *BC C78? NOP *BC LDA \RET *BC CCB *BC CPA B *BC RSS *BC JMP C78?,I NO ERROR. EXIT *BC LDB \MODE *BC CPB P7 *BC RSS *BC CPB P8 *BC RSS *BC JMP C78?,I * *BC LDA PHASE ABORT IF PHASE 13, ERROR 16 AND *BC CPA P13 ERROR COUNT = 0 *BC RSS *BC JMP C78.1 *BC LDA ST.1 GET ERROR STATUS # *BC CPA B16 *BC RSS OVER-RUN AFTER 10 RETRYS ON *BC * HARD DISC "RE" COMMAÅ–������þúND *BC JMP C78.1 *BC LDA ERCNT *BC SZA *BC RSS *BC JMP DONE? *BC * *BC C78.1 LDA ST.1 ALSO, ABORT IF ERROR 14,11,1 *BC CPA B11 2,12,3,4,5,6,13,15,24 *BC RSS OR 25 IN MODES 7 OR 8 *BC CPA P1 *BC RSS *BC CPA P2 *BC RSS *BC CPA B27 *BC RSS *BC CPA B12 *BC RSS *BC CPA P3 *BC RSS *BC CPA P4 *BC RSS *BC CPA P5 *BC RSS *BC CPA B6 *BC RSS *BC CPA B13 *BC RSS *BC CPA B15 *BC RSS *BC CPA B24 *BC RSS *BC CPA B25 *BC RSS *BC CPA B14 *BC RSS ¶������þú *BC JMP C78.2 *BC LDA \MODE *BC CPA P7 *BC JMP DONE? *BC CPA P8 *BC JMP DONE? *BC * *BC C78.2 LDA ST.1 *BC CPA B22 *BC RSS ALSO ABORT IF ERROR 22,23 AND *BC CPA B23 AB.B HAS BEEN SET TO 1 *BC RSS *BC CPA B27 *BC RSS *BC JMP C78.3 *BC LDA AB.B *BC CPA P1 *BC RSS *BC JMP C78.3 *BC CLA *BC STA AB.B *BC JMP DONE? *BC * *BC C78.3 JMP C78?,I RETURN *BC ** END C78? ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** PASS # ** SPC 1 * DISPLAYS THE CURRENT FORMAT PASS # CONTAINED IN PASSX * PASS# NOP ISZ PASSX BUMP TO CURRENT PASS LDA PASSX ANDÉÑ������þú GET IT JSB ASDEC CONVERT TO ASCII INA MOVE THE CONVERTED VALUE LDB MS25. JSB .MVW DEF P1 NOP * LDB P25 GET PROMT MESSAGE INDEX LDA PASSX CPA P1 IF PASS 1 RSS THEN SEND A BLANK LINE CMB,INB OTHERWISE SIGNAL PROMT NOT TO JSB PROMT JMP PASS#,I * PASSX NOP * ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** PHS8? AND SAVBD BLOCK ** SPC 1 * * MODE 6 ERROR CONDITIONS: STATUS 7,10,11,21, & INVALID STATUS 2 * IF VERIFYING IN PHASE 8, THEN ENTER THE BAD TRACK IN * BDTBL AND SET TARGET ADDRESS FOR NEXT SEEK TO FOLLOWING * TRACK. IN ALL PHASES, RE-SEEK AND TRY OPERATION AGAIN. * PHS8? LDB PHASE ARE WE VERIFYING? CPB P8 JSB SAVBD YES - GO ENTER BAD TRACK # IN BDTBL * LDA \ACTN INSURE THAT A IOR P1 RE-SEEK IS DONE STA \ACTN JSB ONLY1 SET ERCNT TO 1 TRY ONLY JMP ENDBR AND CONTINUE SPC 3 * * SAVBD REQUESTS THE LOGICAL ADDRESS OF THE OFFENDING TRACK * AND CHECKS TO SEE IF THE END OF THE DISC WAS REACHED. * IF SO, PHASE 8 COMPLETES SUCCESSFULLY AND THE NEXT * STEP DETERMINED BY BRANCHING TO PHAS8. * IF PASS 1 THRU 4 OF PHASE 8 THEN THE OFFENDING TRACK'S * CYL/HEAD ADDRESS IS ENTERED IN BDTBL(IF NOT ALREADY * THERE). # BAD TRACKS CANNOT EXCEED 20 (RANDOM CHOICE), * ELSE AN ERROR IS SENT AND FPROC TERMINATED. * IF PASS 5 THEN A FLAG IS SIMPLY SET SO THAT THE WARNING * MESSAGE IS DISPLAYED AT THE END OF FPROC. * SAVBD NOP XL½¯������þúOVR JSB XLGAD REQUEST THE LOGICAL DISC ADDRESS DEF *+7 OF THE BAD TRACK DEF \DLU DEF \DUNT DEF LGCYL DEF LGHD DEF LGSCT DEF IER JSB CKST1 JMP XLOVR PWR FAIL-TRY OVER AFTER NRDY MSG NOP ERROR RTN-NOT APPLICABLE**DON'T MOVE * LDA LGCYL END OF DISC? (JUST CHECKING CPA P76 THE CYL SHOULD BE ENOUGH) JMP PHAS8 YES, GO SET UP NEXT PASS * LDB BPATT IF FINAL VERIFY PASS, THEN SZB,RSS SET WARNING FLAG SO JMP SETWF MESSAGE WILL BE PRINTED * LDA BADFT SCAN BAD TRACK TABLE FOR CMA A MATCHING ADDRESS STA TEMP2 SET LOOP COUNTER LDB BFTBL AND TABLE POINTER STB TEMP3 * DLD LGCYL GET DEFECTIVE ADDRESS ALOOP ISZ TEMP2 DONE WITH THE SEARCH? RSS CONTINUE JMP ENTER NO MORE ADDRESS PAIRS CPA TEMP3,I SAME CYL? RSS JMP NEXTP TRY NEXT PAIR ISZ TEMP3 CPB TEMP3,I SAME HEAD? JMP SETSK YES, SO JUST RESET SEEK BEFORE CONTINUING RSS NO NEXTP ISZ TEMP3 POSTION TO NEXT ISZ TEMP3 ADDRESS PAIR JMP ALOOP * ENTER LDA BADFT LIMIT OF 20 EXCEEDED? CPA P20 JMP BMEDA YES! ISZ BADFT BUMP COUNT DLD LGCYL ELSE SAVE BAD TRACK DST TEMP3,I IN NEXT POSITION OF BDTBL * SETSK JSB CVLOG CONVERT THAT ADDR TO LOGICAL TRACK # INA SET SEEK TO NEXT TRACK AFTER DEFECT. STA TEMP2 SAVE FOR SETTING SECTOR COUNT JSB DADTR RECONVERT TO CYL/HEAD ADDR DST SKCYL AND SET FOR NEXT SEEK CPA P77 END OF DISC?-DON'T SEEK IF SO JMP PHAS8 YES, GO ON TO NEXT STEP * LDA TEMP2 GET # TRACKS VERIFIED SO FAR. MPY P30 CONVERT TO SECTORS. CMA,INA MAKE NEGATIVE & SUBTRACT FROM ADA \DNSD DISC TOTAL-GET # LEFT =Ã������þúTO VERIFY STA \D#ST AND SAVE FOR VERIFY COMMAND JMP SAVBD,I CONTINUE * SETWF ISZ WARNG SET FLAG BECAUSE ENCOUNTERED STILL NOP ANOTHER BAD TRACK DURING PASS 5 DLD LGCYL GET BAD ADDRESS SO CAN BUMP IT JMP SETSK FOR THE NEXT SEEK * BMEDA LDB P24 DISPLAY: JSB PROMT "WARNING! POSSIBLE BAD FLOPPY MEDIA..." CCA IF >20 BAD ONES STA \RET ABNORMAL TERMINATON JMP ENDBR * SPC 2 * ONLY1 NOP CCB SET ERCNT TO -1 FOR FLOPPY DISC STB ERCNT SO ONLY 1 TRY MADE BY S/W JMP ONLY1,I * ** END PHS8?/SAVBD BLOCK ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** FAULT ** SPC 1 * ENTRY CONDITIONS: (PROGRAM ERRORS - SHOULDN'T HAPPEN!) * STATUS ERRORS 1,2,12 * UNIMPLEMENTED STATUS ERRORS 3,4,5,6,13,15,24,25 * FAULT CCA HAVE NO CHOICE BUT TO ABORT THIS TASK STA \RET JMP ENDBR SPC 1 ** END FAULT BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** RECAL ** SPC 1 * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL LDA \MODE IF FORMATTING A FLOPPY CANNOT CPA P6 ISSUE A RECALIBRATE COMMAND JMP PHS8? CORREC%ô������þúTIVE ACTION IF PHASE 8 OF MODE 6 ISZ ERCNT UP THE ERROR COUNT: FATAL YET?? JMP AGAIN NO: SEND RECALIBRATE COMMAND AND TRY AGAIN CPA P5 IF MODE 5 THEN WE'RE READING W/OFFSET JMP NEWOF EACH SECTOR SO TRY NEXT OFFSET * JSB CYLER DISPLAY "CYLINDER COMPARE ERROR" AND ETC. CCA STA \RET SET RETURN STATUS FOR ABORT JMP ENDBR * * KLUDGE FOR 7910 DISCS * AGAIN LDA \D#ST GET SEC/TRK CPA P32 JMP SEEK0 * JSB XRCAL SEND A RECAL COMMAND DIRECTLY TO DRIVER LIBRARY. DEF *+4 DEF \DLU+0 DEF \DUNT+0 DEF IER JMP RCOUT * SEEK0 JSB XSEEK SIMULATE A RECALIBRATE FOR 7910 DEF *+9 DEF \DLU+0 DEF \DUNT+0 DEF P0 CYLINDER DEF P0 HEAD DEF P0 SECTOR DEF STAT1 DEF STAT2 DEF IER * * RCOUT LDA \ACTN GET \ACTN WORD FOR FIXUP IOR P1 SET \ACTN(1) -FORCE A SEEK ! JMP ENDBR GO TRY AGAIN-SAME PHASE,SAME COMMAND,W/ SEEK SPC 1 ** END RECAL BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** DSKER/DEFTR ** SPC 1 * DSKER ENTRY CONDITIONS (DATA ERRORS): * STATUS 10,16,17 ERRORS * INVALID STATUS 2 ERROR * * DEFTR ENTRY CONDITIONS: * STATUS 21 ERROR * DSKER ISZ ERCNT STEP THE ERROR COUNTER: FATAL # ERRORS YET?? JMP ENDBR NO: GO TRY THE SAME THING AGAIN * * YES: CHECK WHICH MODE WE'RE IN AND DO SOMETHING * SPC 1 ********************************************************************** * BEGIN INCA?������þúSE(\MODE): DEFTR * SPC 1 DEFTR LDA TBL05 ADA \MODE JMP A,I * TBL05 DEF * NOP N/A JMP ENDBR N/A JMP DSK03 JMP DSK04 JMP DSK05 JMP PHS8? ACTION IF PHASE 8 (VERIFY) JMP DSK78 ACTION IF MODE 7 OR 8 *BC JMP DSK78 " " " " " " *BC * SPC 1 * * MODE=3: WRITE INIT TRACK - SET UP FOR STATUS READ TO NEXT SPARE * DSK03 LDA PHASE CHECK TO SEE WHICH PHASE WE'RE IN ADA N3 SEPARATE PHASE 1,2 FROM PHASE 3,4,5,6 SSA,RSS FOR PHASE 1,2: SAVE PHYSICAL ADDR OF BAD TRACK JMP GTSPR FOR PHASE 3,4,5,6 WE'VE ALREADY SAVED BAD TRACK ****** IGNORE ERROR IF PHASE 5? IF PHASE4, GOTO PHASE6?? *********** * CLA SIGNAL RPORT TO SEND: STA IDXPR "BAD TRACK..." DLD CYL# SAVE ADDRESS OF BAD TRACK DST BDCYL JSB RPORT GO REPORT BAD TRACK-ALSO PRINT HEADER IF FIRST TIME * GTSPR JSB NIXSP GET THE NEXT POTENTIAL SPARE FOR THIS SUBCHANNEL JMP ENDBR ERROR RETURN FOR NIXSP - IE. OUT OF SPARES! DST SKCYL SEEK TO THE SPARE-WE'RE GOING FOR ITS STATUS DST ARCYL SET UP ADDRESS RECORD * CLB STB FLMSK TURN OFF AUTO-SEEK TO SPARE * LDA P3 STA PHASE SET PHASE3: STATUS READ TO POTENTIAL SPARE LDA A067 SET THE ACTION WORD FOR STA \ACTN SEEK,RDFS,STFIX, TO GET TRACK'S STATUS JMP ENDBR SPC 1 * * MODE=4: SPARE INITIALIZATION/CLEANUP MODE. * DSK04 LDA PHASE WHICH PHASE ARE WE IN?? CPA P6 DID WE JUST GET DONE FLAGGIN IT DEFECTIVE?? JMP DSKRT YES: RETURN "OK" STATUS TO MAIN & CLEAN UP NEXT SPARE * ALSO REPORT BAD TRACK * LDA S001 NO: LET'S GO INIT THE SPARE & FLAG IT DEFECTIVE STA SPD SET DEFECTIVE BIT(0) LDA P6 ºÁ������þú STA PHASE SET PHASE6: WRITE INIT. A SPARE-FLAG DEFECTIVE * DLD SKCYL MAKE SURE THAT THE ADDRESS IS THERE DST ARCYL ESPECIALLY FOR MODE 5 LDA A207 SET ACTION FLAG: ADRC,WRIT INIT STA \ACTN JMP ENDBR ALL SET?? OK-AROUND WE GO AGAIN. * DSKRT LDA P2 SIGNAL RPORT TO SEND: STA IDXPR "BAD SPARE..." DLD SKCYL GET CYL/HEAD OF THIS BAD SPARE JSB RPORT GO REPORT SPARE AS BAD TRACK CLA,INA STA \RET RETURN TO MAIN WITH OK STATUS- WE'RE DONE W/ THIS ONE JMP ENDBR SPC 1 * * MODE=5: SPARING ONE TRACK * DSK05 LDA PHASE SZA,RSS IF STILL READING SECTORS JMP NEWOF THEN TRY A NEW OFFSET * CPA P5 IF PHASE 5 THEN JMP PHA5 IGNORE ERROR ON BAD TRACK CPA P4 IF A WRITE INIT JMP DSK04 TO SPARE THEN MARK IT DEFECTIVE JMP PHAS6 GET THE NEXT SPARE SINCE THIS WAS DEF SPC 1 * END INCASE(\MODE); * ********************************************************************** SPC 1 ** END DSKER/DEFTR BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** DSK78 - DISC DRIVER ROUTINE ** * *BC * ENTERED IN THE EVENT OF AN ERROR STATUS 10,16,17,21 AFTER *BC * 10 RE-TRYS IF "RE" COMMAND OR 0 RE-TRYS IF "VE" COMMAND *BC * *BC DSK78 LDA ST1 GET THE STATUS WORD *BC CPA B10 DATA ERROR? *BC RSS YEï������þúS. SAY "BAD TRACK" *BC CPA B17 DATA ERROR? *BC RSS YES *BC CPA B21 DEFECTIVE TRACK? *BC RSS YES *BC CPA B22 *BC RSS *BC CPA B23 *BC RSS *BC JMP E16 *BC * *BC CLA PRINT "BAD TRACK" *BC STA IDXPR *BC DLD CYL# *BC DST BDCYL *BC JSB RPORT *BC EEX CCA *BC STA \RET *BC JMP ENDBR RETURN TO MAIN *BC * *BC E16 LDB P29 PRINT... *BC JSB PROMT "UNEXPECTED HARDWARE FAILURE" *BC JMP EEX *BC * *BC * CONSTANTS *BC * *BC B11 OCT 11 *BC B16 OCT 16 *BC B10 OCT 10 *BC AB.B NOP *BC B12 OCT 12 *BC B6 OCT 6 *BC B13 OCT 13 *BC B15 OCT 15 *BC B14 OCT 14 "¬������þú *BC B24 OCT 24 *BC B25 OCT 25 *BC B27 OCT 27 *BC B22 OCT 22 *BC ** END DSK78 ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** EOCYL ** SPC 1 * * EOCYL ENTRY CONDITIONS: * STATUS ERRORS 11 AND 14 * SEEK CHECK FROM ST2ER * EOCYL LDA \MODE IF MODE 5 CPA P5 THEN TRY A NEW OFFSET VALUE JMP NEWOF CPA P6 IF MODE 6 THEN JMP PHS8? DETERMINE APPROPRIATE ACTION TO TAKE * LDA ST1 *BC CPA B22 *BC RSS *BC CPA B23 *BC RSS *BC JMP SP *BC CLA,INA *BC STA AB.B *BC * *BC * *BC SP JSB SPECR SEND ERR MSG:"INVALID DISC SPECIFICATIONS XX" CCA STA \RET RETURN ABORT STATUS TO MAIN JMP ENDBR SPC 1 ** END EOCYL BLOCK ** ********************************************************************** ********************************************************************** 1������þúSKP ********************************************************************** ********************************************************************** ** ILSPR ** SPC 1 * ILLEGAL SPARE (STATUS 20 ERROR) * APPARENTLY DID A SEEK TO A TRACK W/ ITS SPARE BIT SET * SPC 1 ********************************************************************** * BEGIN INCASE(\MODE): * SPC 1 ILSPR LDA TBL06 ADA \MODE JMP A,I * TBL06 DEF * NOP N/A JMP ENDBR N/A JMP ILS03 CHECK WHICH PHASE WE'RE IN. JMP ILS04 MODE4: SPARE INITIALIZE/CLEANUP MODE. JMP NEWOF NEW OFFSET VALUE - WILL EVENTUALLY GET TO NUSEC JMP ENDBR N/A JMP MD78 *BC JMP MD78 *BC * MD78 LDA P2 *BC STA IDXPR *BC DLD CYL# PRINT... *BC DST BDCYL "BAD SPARE" *BC JSB RPORT *BC CCA *BC STA \RET *BC JMP ENDBR *BC SPC 1 * * MODE=3: * ILS03 LDA PHASE WHICH PHASE ARE WE IN?? CPA P3 PHASE3&1 ARE THE ONLY LEGAL PHASES FOR THIS MODE JMP ILPH3 PHASE3: WE WERE CHECKING THE STATUS OF A SPARE. * * PHASE=1: WE JUST DID A STATUS READ TO INIT TRACK & FOUND ITS SPARE * BIT SET-RECLAIM IT AND USE IT. * ILPH1 CLB PRESET SPD BITS FOR MODE3 STB SPD SET IT. * ISZ PHASE SET PHASE2: WRITE INITIALIZE THE TRACK LDA A207 SET ACTION WORD FOR WRT INIT STA \ACTN JMP ENDBR AROUND WE GO AGAIN..RECLAIM THIS OLD ������þú SPARE FOR DATA. * * PHASE=3: WE JUST DID A STATUS READ TO A POTENTIAL SPARE. ITS SPARE * BIT WAS SET-INDICATING IT IS ALREADY IN USE. GO GET THE * NEXT POTENTIAL SPARE & CHECK ITS STATUS. * ILPH3 JSB NIXSP GET NEXT SPARE JMP ENDBR ERROR RETURN FOR NIXSP - IE. OUT OF SPARES! DST SKCYL DST ARCYL SET UP SEEK AND ADDR REC'D COMMANDS W/ ADDR JMP ENDBR SAME PHASE & \ACTN AS LAST TIME-STATUS WRT TO SPARE SPC 1 * * MODE=4: SPARE INIT/CLEANUP MODE * WE JUST DID A STATUS READ TO SPARE AREA, AND FOUND THE TRACK * ALREADY IN USE AS A SPARE, BUT REUSE IT. * ILS04 CLA STA SPD CLEAN SPD BITS * ISZ PHASE STEP INTO PHASE4- WRITE INITIALIZE SPARE LDA A207 STA \ACTN SET ACTION WORD FOR INIT JMP ENDBR GO AROUND AGAIN SPC 1 * END INCASE(\MODE); * ********************************************************************** SPC 1 ** END ILSPR BLOCK ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** ST2ER ** SPC 1 * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NOT READY SEND MESSAGE TO READY DISC * FORMAT SW OFF SEND MESSAGE TO TURN ON FORMAT SW * PROTECTED SEND MESSAGE TO TURN OFF PROTECT * NONE OF ABOVE GO TO DSKER & PROCESS AS DATA ERROR * * INPUTS: * A=STAT1 * B=STAT2 * ST2ER SSB,RSS JMP NST2 * * ASSUME NOT READY OR SEEK CHECK ERROR * LDA B AND P4 IS SEEK CHECK BIT SET?? SZA JMP EOCYL YES- "INVALD DISC SPEC'NS" ERRѪ������þúOR * NRERR JSB NRDER NO- NOT RDY ERR- TELL OPERATOR JMP RETRY GIVE 'EM ANOTHER CHANCE * * * CHECK IF FORMAT SW OR PROTECT SW ERR * NST2 LDA \R/W SZA JMP DSKER READ- SO CHAULK IT UP AS ANY OTHER ERROR * LDA B GET STAT2 AND B100 MASK WRT PROTECT BIT SZA PROTECT SWTCH SET?? JMP PRTSW YEP- SEND THE ERROR-TURN OF WRT PROT... * LDA B GET STAT2 WORD AGAIN AND B40 FORMAT BIT SET?? SZA JMP DSKER YES- COUNT AS SOME UNKNOWN ST2 ERR FRMSW JSB FRMER NO- TELL 'EM-TURN ON FORMAT SWITCH JMP RETRY START FRESH * PRTSW JSB PROTR TELL 'EM-DISABLE WRITE PROTECT\RD ONLY * RETRY LDA N10 NORMALLY GET 10 RETRIES, BUT LDB \MODE CPB P6 IF A FLOPPY THEN CCA SET TO ONLY ONE TRY LDB PHASE *BC CPB P15 *BC CCA *BC STA ERCNT GIVE THEM MORE TRIES TO DO THE OPERATION LDB \MODE JUST TO BE SURE *BC JMP ENDBR SPC 1 ** END ST2ER BLOCK ** ********************************************************************** ********************************************************************** SPC 4 ********************************************************************** ********************************************************************** ** UWAIT ** SPC 1 * * UWAIT BRANCHED TO ON STATUS 27 ERROR * * IF UNIT/ADDR >7, FLOPPY UNIT >3, OR RETRY 10 TIMES, THEN CALL * SPECR TO ISSUE: "INVALID DISC SPECIFICATONS XX" * UWAIT LDB \MODE IF MODE=6 THEN LDA \DUNT CPB P6 CHECK FLOPPY UNIT JMP UFLOP LDA PHASE *BC (������þúCPA P15 *BC JMP UFLOP *BC * CMA,INA IF UNIT/ADDR OUT OF RANGE ADA P7 SSA JMP USPEC THEN ISSUE ERROR ISZ ERCNT ELSE BUMP ERROR COUNTER JMP ENDBR AND TRY AGAIN * USPEC JSB SPECR CCA STA \RET CLA,INA *BC STA AB.B *BC JMP ENDBR * UFLOP ALF,ALF LOOK AT UNIT# AND NOT<3 SZA,RSS IF >=3 JMP ENDBR (CONTINUE) JMP USPEC ERROR * NOT<3 OCT 177774 SPC 1 ** END UWAIT ** ********************************************************************** ********************************************************************** SPC 3 ********************************************************************** ********************************************************************** ** END OF BRANCH TABLE BLOCKS. ** ** ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** ** ** * BEGIN DISC DRIVER SUBROUTINES ** ** ********************************************************************** ********************************************************************** SPC 5 ********************************************************************** * XFER ROUTINE * SPC 1 * * XFER PROVIDES THE INTERFACE BETWEEN THE ¿Œ������þúSWITCH DRIVER AND THE * DRIVER LIBRARY ROUTINES. IT TAKES THE FLAG WORD "\ACTN" AS * INPUT, AND CALLS THE APPROPRIATE LIBRARY ROUTINES IF THEIR * CORRESPONDING BIT IN \ACTN IS SET. * * * BIT MEANING * * 0 - SEEK - CALL XSEEK * 1 - ADDRESS RECORD - CALL XADRC * 2 - FILE MASK - CALL XFMSK * * 3 - REGULAR READ - CALL XDRED * 4 - READ FULL SECTOR - CALL XRDFS * 5 - STATUS WORD FIXUP - CALL STFIX(GETS SPD BITS AFTER XRDFS) * * 6 - REGULAR WRITE - CALL XDWRT * 7 - WRITE INITIALIZE - CALL XINIT * 8 - VERIFY - CALL XVRFY * * 9 - SEND END COMMAND - CALL XEND * 10 - READ WITH OFFSET - CALL XRDOF * 11 - FORMAT COMMAND - CALL XFRMT * * 12 - * 13 - * 14 - * 15 - * * XFER NOP * XFOVR LDA \ACTN STA TEMP1 SAVE \ACTN WORD * JSB REQST GET STATUS BEFORE ANYTHING JSB CKST1 CHECK IT JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR CASE * JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP ADRC? TRY NEXT BIT * SEEK? JSB XSEEK DEF *+9 DEF \DLU+0 DEF \DUNT+0 DEF SKCYL DEF SKHD DEF \SEC# DEF STAT1 DEF STAT2 DEF IER * LDA \D#ST 7910H PATCH-IGNORE ERRONEOUS SEEK ERRS CPA P32 IS IT A 10H (32 SEC/TRACK) ISZ SK10H YEP-SET FLAG FOR CKST1 ROUTINE * JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * ADRC? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP FMSK? TRY NEXT BIT * JSB XADRC SEND ADDRESS RECORD COMMAND DEF *+7 DEF \DLU+0 DEF \DUNT+0 DEF ARCYL DEF ARHD DEF \SEC# DEF IER * FMSK? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP READ? TRY NEXT BIT * ¼â������þúLDA \D#ST * 7910H PATCH-FLMSK ILLEGAL COMMMAND CPA P32 IS IT A 10H? (32 SEC/TRK) JMP READ? YEP- DON'T SEND IT * JSB XFMSK SEND FILE MASK COMMAND DEF *+5 DEF \DLU+0 DEF \DUNT+0 DEF FLMSK DEF IER * READ? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP RDFS? GO TRY NEXT BIT * JSB XDRED SEND REGULAR READ COMMAND DEF *+8 DEF \DLU+0 DEF \DUNT+0 DEF \BUFI,I BUFFER ADDRESS DEF LEN POS. # OF WORDS/TRACK DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * RDFS? JSB SKIP? JMP RDFS! TRY NEXT BIT * JSB XRDFS SEND READ FULL SECTOR COMMAND DEF *+8 DEF \DLU+0 DEF \DUNT+0 DEF DPBUF DEF P3 DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * RDFS! JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP WRIT? * JSB STFIX FIX UP ST1 WORD TO REFLECT SPD BITS JMP XEXIT ERROR-EITHER S OR D WAS SET * WRIT? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP INIT? TRY NEXT BIT * JSB XDWRT SEND REGULAR WRITE COMMAND DEF *+8 DEF \DLU DEF \DUNT DEF \BUFI,I DEF LEN DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * INIT? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP VRFY? * JSB XINIT DEF *+9 DEF \DLU+0 DEF \DUNT+0 DEF \BUFI,I DEF LEN DEF SPD DEF STAT1 DEF STAT2 DEF IER JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * VRFY? JSB SKÊD������þúIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP ENDX? * JSB XVRFY SEND A VERIFY COMMAND DEF *+7 DEF \DLU+0 DEF \DUNT+0 DEF \D#ST+0 DEF STAT1 DEF STAT2 DEF IER * LDA IER CHECK FOR TIMEOUT CPA P4 IS IT ?? RSS YES-MUST BE A FLOPPY,SO WAIT JMP NFLOP NO-CONTINUE-STAT1,STAT2 IS VALID * * IF THIS IS A FLOPPY VERIFY,IT MAY TAKE UP TO 6.5 MINUTES, * DEPENDING ON THE FILL VALUE,AND THE # SECTORS TO VERIFY. * A SINGLE-SIDED DISC WITH FILL=0(INTLV=1), 77 TRACK VERIFY, * REQUIRES 15 SEC. TO COMPLETE. EXECUTION TIME IS PROPORTIONAL * TO THE INTERLEAVE VALUE, SO FORMAT USES THIS FORMULA TO COMPUTE * A MAXIMUM REASONABLE EXECUTION TIME BEFORE IT REPORTS "NOT READY" * TO THE OPERATOR: EXEC TIME= 15*INTLV (SEC.) THE SLEEP ROUTINE * INTERPRETS THE A.REG AS THE # OF 5 SEC. POLLS TO ALLOW BEFORE * TAKING THE "NOT READY" RETURN. A 33% SAFETY MARGIN IS ADDED TO * THE ABOVE FORMULA, SO THE FORMULA IS: * # OF 5 SEC.POLLS = INTLV * 4 , WHICH IS MULTIPLIED BY 2 FOR * DOUBLE-SIDED FLOPPIES. * LDA INTLV GET THE INTERLEAVE VALUE MPY P4 X 20 SEC. (5 SEC PER POLL) LDB \DNSU GET NUMBER OF SURFACES(1 OR 2) SLB,RSS IS IT DOUBLE SIDED?? CLE,ELA YES-MULTIPLY EXECUTION TIME BY 2 CLB SET INITIAL SLEEP=0,POLL IMMEDIATELY. * 'CAUSE MAY RETURN WITH VRFY ERR ANY TIME. * JSB SLEEP POLL WITH A "DSJ" EVERY 5 SEC. JMP NFLOP TIMEOUT RET-SEND "READY DISC ..." JSB REQST OK RET-GET VALID STAT&CONTINUE * NFLOP JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * ENDX? JSB SKIP? SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP RDOF? * JSB XEND SEND END COMMAND DEF *+3 DEF \DLU+0 DEF \DUNT * RDOF? JSB SKIP? HÔ������þú SKIP IF TEMP1(0)=1 & ROTATE RIGHT JMP FRMT? TRY NEXT BIT * LDA \D#ST KLUDGE FOR 7910H(CAN'T RD W/ OFFSET) CPA P32 JMP RDF10 YES-IT'S A 10H-DO SPCL THING JSB XRDOF SEND A READ WITH OFFSET COMMAND DEF *+9 DEF \DLU DEF \DUNT DEF RBUFR USE REPONSE BUFFER, THEN MOVE DEF P128 TO \BUFA VIA BPTR DEF OFSET DEF STAT1 DEF STAT2 DEF IER JMP CKROF CHECK STATUS * RDF10 JSB XDRED GO DO REG READ FOR 7910H DEF *+8 DEF \DLU+0 DEF \DUNT+0 DEF RBUFR USE RESPONSE BUFR, THEN MOVE DEF P128 DEF STAT1 DEF STAT2 DEF IER * CKROF JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER JMP XEXIT ERROR RETURN * FRMT? JSB SKIP? JMP XEXIT * JSB XFRMT SEND FORMAT COMMAND TO FLOPPY DEF *+7 DEF \DLU DEF \DUNT DEF BPATT DEF FTYP DEF INTLV DEF IER * * WORST CASE EXECUTION TIMES FOR THE 88020 FORMAT COMMAND * ARE AS FOLLOWS: * SINGLE SIDED: 39 SEC. * DOUBLE SIDED: 77 SEC. * * THE FOLLOWING CODE CALLS THE SLEEP ROUTINE AND WAITS FOR * A "REASONABLE" LENGTH OF TIME BEFORE SENDING THE "READY DISC..." * MESSAGE. "REASONABLE" IS DEFINED AS FOLLOWS: * * SINGLE SIDED: 70 SEC. (30 SEC. INITIAL WAIT + 40 SEC. POLLING) * DOUBLE SIDED: 100 SEC. (60 SEC. INITIAL WAIT + 40 SEC. POLLING) * * THESE VALUES ARE CHOSEN VERY CONSERVATIVELY IN HOPES THAT THEY * WILL WORK FOR THE 9895A FLOPPY WHEN IT IS AVAILABLE. JJC 790917 * LDB P30 SLEEP FOR 30 SEC INITIALLY(SNGL SIDED) LDA \DNSU GET # OF SURFACES SLA,RSS CLE,ELB SLEEPX2 =70 SEC FOR DOUBLE SIDED LDA P8 WAIT (8X5)=40SEC MORE(POLL EVERY 5 SEC) JSB SLEEP GO TO SLEEP WHILE XFRMT FINISHES RSS TIMEOUT-SEND "NOT ä������þúRDY..."/ JMP FMTOK OK RETURN-GO GET STATUS * JSB NRDER SEND "READY DISC.." JMP XFOVR TRY THE WHOLE THING OVER * FMTOK JSB REQST GET STATUS FROM FORMAT JSB CKST1 JMP XFOVR PWR FAIL - TRY WHOLE THING OVER NOP ERROR RETURN * * XEXIT LDA ST1 GET 5 BIT FIELD FROM STAT1 WORD LDB STAT2 GET STAT2 WORD IN B FOR THE RETURN JMP XFER,I RETURN TO DRIVER W/ STATUS IN A&B * SPC 1 * END XFER ROUTINE * ********************************************************************** SPC 3 ********************************************************************** * SLEEP ROUTINE-FOR UNUSUALLY LONG FLOPPY OPERATIONS * SPC 1 * "SLEEP" DOES A DSJ COMMAND TO THE FLOPPY CONTROLLER TO FIND * OUT IF THE DISC HAS COMPLETED THE PREVIOUS OPERATION. IF THE * RETURNED DSJ=4, THIS IS A TIME-OUT AND WE KNOW THE CONTROLLER IS * STILL BUSY. IF DSJ=0 OR 1,WE KNOW THE OPERATION IS COMPLETE AND * RETURN. IF THE CONTROLLER IS BUSY ON ENTRY TO "SLEEP",WE SUSPEND * FORMT FOR THE NUMBER OF SECONDS IN THE B.REG. AFTER THE 1ST * INITIAL SLEEP (FOR B.REG SECS.) REPEATEDLY SLEEP FOR 5 SEC. AND * DO ANOTHER DSJ TO SEE IF THE CONTROLLER IS DONE. THIS 5 SEC POLLING * CONTINUES FOR A MAX. OF (A.REG) POLLS. AFTER THIS THE "NOT READY" * RETURN IS TAKEN. * * B.REG=NUMBER OF SECONDS TO SUSPEND FORMT BEFORE POLLING BEGINS * A.REG=NUMBER OF 5 SEC. POLLS ALLOWED BEFORE "NOT READY" RETURN * * RETURNS: * (P+1): DISC NOT READY-OPERATION TOOK LONGER THAN ALLOWED * (P+2): SUCCESSFUL COMPLETION ( IN ALLOWED TIME) * SLEEP NOP CMA SET # 5 SEC POLLS NEGATIVE STA WTCNT SAVE FOR LOOP COUNTER CMB,INB MAKE INITIAL WAIT NEG FOR EXEC. STB WTSEC * POLL JSB XDSJ ISSUE DSJ-SEE IF CONTROLLER IS TALKING DEF *+4 DEF \DLU›&������þú+0 DEF \DUNT+0 DEF IER EXPECT IER=4 UNTIL OPERATION COMPLETE * LDA IER CPA P4 JMP SNOOZ SUSPEND FORMT FOR (-WTSEC) SECS. ISZ SLEEP INCR RET TO (P+2)-NORMAL RET JMP SLEEP,I TAKE NORMAL COMPLETION * SNOOZ LDB WTSEC GET SLEEP TIME FOR EXEC SZB,RSS JMP GOPOL DON'T DO EXEC SLEEP IF TIME=0 JSB EXEC SUSPEND FORMT FOR -WTSEC SECONDS DEF *+6 DEF P12 OPCODE DEF P0 PROG NAME=0 (SAVE PT. OF SUSPEND) DEF P2 UNITS=2=SECONDS DEF P0 EXECUTION MULTIPLE (ONCE) DEF WTSEC SUSPEND TIME * GOPOL ISZ WTCNT BUMP WAIT LOOP COUNTER RSS HASN'T ROLLED OVER-WAIT AGAIN JMP SLEEP,I OUT OF TIME-(P+1) NRDY RETURN * LDA N5 POLL TIME= 5 SEC. STA WTSEC SET POLL JMP POLL DO DSJ AGAIN-WAIT 5 AGAIN * WTSEC NOP NEG # SEC TO SUSPEND WTCNT NOP # 5 SEC POLLS AFTER 1ST WAIT * SPC 1 * END SLEEP ROUTINE * ********************************************************************** SPC 3 ********************************************************************** * SKIP? ROUTINE-TEST & ROTATES TEMP1 * SPC 1 * RETURN: (P+1) - IF BIT0 TEMP1=0 * (P+2) - IF BIT0 TEMP1=1 * ALSO ROTATES TEMP1 RIGHT BEFORE RETURNING * SKIP? NOP LDA TEMP1 SLA,RAR ISZ SKIP? INCREMENT RETURN ADDRESS STA TEMP1 JMP SKIP?,I RETURN SPC 1 * * ********************************************************************** SPC 4 ********************************************************************** * CKST1 ROUTINE * SPC 1 * CKST1: 1) CHECKS IER TO SEE IF PWR. FAIL,DSJ^=0,OR¬Ô������þú TIME OUT IN LAST * DRIVER LIBRARY REQUEST. * -IF TIMEOUT(IERR=4):SEND NOT RDY ERROR&TAKE PWR FAIL RETURN * -IF PWR FAIL,DO STATUS TO CLR DSJ&TAKE PWR FAIL RETURN. * 2) SIFTS OUT THE 5 BIT S1 FIELD FROM STAT1 * 3) IF S1=37 (ATTENTION), REQUEST STATUS AGAIN UNTIL S1^=37. * * RETURN: (P+1): POWER FAIL/NOT READY RETURN * (P+2): STATUS ERROR RETURN-(ST1 NOT = 0) * (P+3): NORMAL RETURN- ST1=0 * CKST1 NOP STOVR LDA IER CPA P4 IS IT A TIMEOUT?? JMP PFAIL YEP. * CPA P2 IS IT A POWER FAIL?? JMP PFAIL YEP. * LDA STAT1 ALF,ALF AND B37 MASK S1 OFF STAT1 WORD CPA B37 ATTENTION?? RSS YES-ASK FOR STATUS AGAIN JMP RTNST NO-RETURN THE CURRENT STATUS * JSB REQST REQUEST STATUS JMP STOVR EXAMINE STATUS AGAIN * PFAIL JSB NRDER SEND "READY DISC ..ENTER " "RET" JSB REQST CLEAR DSJ WITH A REQ. STATUS COMMAND JMP CKST1,I TAKE POWER FAIL RETURN (P+1) * RTNST ISZ CKST1 STEP RETURN ADDR-INDICATES VALID STATUS LDB SK10H IS THIS A 7910H SEEK OPERATION?? SZB,RSS JMP NOT10 RETURN STANDARD STATUS * CLA LDB STAT2 CHECK STATUS 2 BEFORE IGNORING SSB LDA B23 FAKE A STATUS 2 ERR IN ST1 CLB STB SK10H RESET THE KLUDGE FLAG * NOT10 STA ST1 RETURN THE STATUS IN ST1 SZA,RSS ISZ CKST1 SET (P+2) RETURN- NORMAL JMP CKST1,I * SK10H NOP FLAG TO INDICATE 7910H SEEK- * IGNORE STATUS 1 WORD IN THIS CASE SPC 1 * END CKST1 * ********************************************************************** SPC 3 ********************************************************************** * STFIX ROUTINE øí������þú * * * STFIX -IS CALLED AFTER A READ FULL SECTOR IN ORDER TO * DETERMINE IF THE S OR D BIT IS SET ON THE CURRENT TRACK. * THIS USED TO BE DETERMINED BY DOING A FAKE WRITE FOR STATUS * IN RTEIVA SWTCH.SOME DISCS DO NOT SUPPORT FILE MASK,SO A * READ FULL SECTOR & JSB STFIX REPLACES THE OLD FAKE WRITE. * STFIX NOP CLB LDA HDSSP GET THE SPD/HEAD/SECTOR WORD RAL,SLA,RAL FROM THE PREAMBLE RETURNED BY XRDFS LDB ST20 FAKE A STATUS 20-ILLEGAL ACCESS TO SPARE RAL,SLA NOW TEST D BIT LDB ST21 FAKE A STATUS 21-DEFECTIVE TRACK STB ST1 SAVE IT AWAY AS JSB CKST1 WOULD DO * SZB,RSS ISZ STFIX INCR RETURN ADDR IF NO S OR D ERROR JMP STFIX,I RETURN SPC 1 * * ********************************************************************** SPC 4 ********************************************************************** * REQST ROUTINE * SPC 1 * REQST CALL THE DRIVER LIBRARY TO GET THE STATUS OF THE DISC DRIVE * REQST NOP JSB XSTAT DEF *+6 DEF \DLU+0 DEF \DUNT+0 DEF STAT1 DEF STAT2 DEF IER JMP REQST,I * SPC 1 * END REQST * ********************************************************************** SKP ********************************************************************** * NIXSP ROUTINE * SPC 1 * * NIXSP FINDS THE NEXT POTENTIAL SPARE ON THE CURRENT SUBCHANNEL * AND CONVERTS ITS LOGICAL ADDRESS TO PHYSICAL AND STORES * IT IN CYL#,HEAD#, AND UNIT#. * * CALLING SEQUENCE: * * * JSB NIXSP * A = IGNORED * B = IGNORED * * RETURN: * (P+1): ERÄ������þúROR RETURN - IE. OUT OF SPARES! * (P+2): NORMAL RETURN - NEXT POTENTIAL SPARE ADDR IN A&B * A = CYL# OF NEXT POTENTIAL SPARE * A = -1 IF OUT OF SPARES * B = HEAD# OF NEXT POTENTIAL SPARE * * NIXSP NOP LDA \DNSP GET NUMBER OF SPARES FOR THIS SUBCHANNEL CPA CRSP# ARE THERE NO MORE SPARES?? JMP NMORE NOPE- THEY'RE ALL GONE- SEND BAD SPEC MESSAGE. * LDA \DNTR GET LAST TRACK ON THIS SUBCHANNEL ADA CRSP# COMPUTE LOGICAL ADDRESS OF NEXT POTENTIAL SPARE * JSB DADTR GO SET UP PHYSICAL ADDRESS OF NEXT SPARE:CYL,HEAD,UNIT ISZ CRSP# ADVANCE CURRENT SPARE COUNTER ISZ NIXSP SET NORMAL RETURN ADDRESS : (P+2) JMP NIXSP,I RETURN WITH SUCCESSFUL STATUS * NMORE LDB P12 SEND MESSAGE: JSB PROMT "OUT OF SPARE TRACKS FOR THIS LU" CCA SEND ERROR FLAG TO CALLING ROUTINE. STA \RET SET ABORT FLAG SO MAIN KNOWS WHATS HAPPENING JMP NIXSP,I ERROR RETURN SPC 1 * END NIXSP * ********************************************************************** SKP ********************************************************************** * DADTR * SPC 1 * DADTR ROUTINE TO TRANSLATE A LOGICAL TRACK ADDRESS INTO * PHYSICAL CYL,HEAD,UNIT/ADDR ON THE DISC. * * CYL AT: CYL# * HEAD AT: HEAD# * UNIT AT: UNIT# * * CALLING SEQUENCE: * * LDA TRACK SET LOGICAL TRACK ADDRESS IN A. * JSB DADTR CALL * * RETURN: * * (P+1) * A = CYL# * B = HEAD# * * DADTR NOP CLB DIVIDE # TRACKS BY DIV \DNSU NUMBER OF HEADS/CYL ADA \DFTR ADD BASE CYLINDER ADDRESS STA CYL# SET THE CYLINDER ADDRESS * ADB \DSHD ADD THE BASE HEAD ADDRESS STB HEÚ[������þúAD# STORE IT AS PROMISED * JMP DADTR,I RETURN A= UNIT, B=HEAD * CYL# NOP HEAD# NOP * SPC 1 * * ********************************************************************** SPC 4 ********************************************************************** * CVLOG * SPC 1 * CVLOG CONVERTS PHYSICAL DISC ADDR IN A&B TO * A LOGICAL TRACK # IN REG. A * INPUTS: * A = PHYSICAL CYLINDER # * B = PHYSICAL HEAD# * * RETURN: * (P+1) * A = LOGICAL TRACK ON CURRENT SUBCHANNEL * CVLOG NOP STB TEMP1 SAVE HEAD # * LDB \DFTR FIRST CYLINDER # CMB,INB MAKE NEGATIVE ADA B COMPUTE LOGICAL CYL# MPY \DNSU MULT. BY # OF HEADS * LDB \DSHD GET STARTING HEAD CMB,INB MAKE NEG ADB TEMP1 GET LOGICAL HEAD# * ADA B ADD IT TO (CYL# X #HEADS) JMP CVLOG,I RETURN A=LOGICAL TRACK# SPC 1 * * ********************************************************************** SPC 5 ********************************************************************** * RPORT ROUTINE * SPC 1 * * RPORT SENDS THE MESSAGES: * FOR IDXPR=0: "BAD TRACK XXXX YYYY HH ZZZZ" * FOR IDXPR=1: "SPARED TO XXXX YYYY HH ZZZZ" * FOR IDXPR=2: "BAD SPARE XXXX YYYY HH ZZZZ" * FOR IDXPR=3: "TARGT TRACK XXXX YYYY HH ZZZZ" * * WHERE: * XXXX IS THE LOGICAL TRACK # OF THE CURRENT SUBCHANNEL * YYYY IS THE PHYSICAL CYLINDER # * HH IS THE HEAD# * ZZ IS THE UNIT#/ADDRESS SELECT# * * INPUTS: * A = PHYSICAL CYLINDER # * B =üÖ������þú PHYSICAL HEAD# * RPCYL - PHYSICAL CYLINDER TO REPORT * RPHD - PHYSICAL HEAD TO REPORT * * USED# - I.E. THE NUMBER OF SPARES IS BUMPED IF BAD TRACK * IT ALSO SENDS A HEADER IF THIS IS THE FIRST BAD TRACK ON THIS * SUBCHANNEL: * LU XX LOGICAL CYL HEAD ADDR/UNIT * SPC 1 RPORT NOP DST RPCYL SAVE THE DISC ADDR FOR LATER * JSB CVLOG CONVERT ADDR TO LOGICAL TRACK# JSB ASDEC CONVERT TRACK # TO ASCII LDB MSA9. AND STORE IN MESSAGE JSB .MVW DEF P2 NOP * LDA IDXPR IF REPORTING A ... SZA BAD TRACK OR.. CPA P2 BAD SPARE .. ISZ USED# THEN BUMP # SPARES USED * * A REG. HAS MESSAGE TYPE ADA MEFGH "BAD TRACK", "SPARED TO", LDA A,I "BAD SPARE", OR "TARGT TRACK" TO MSG LDB MS09. GET DESTINATION FOR PREAMBLE-WHATEVER IT MAY BE JSB .MVW STUFF THE PREAMBLE IN THE MESSAGE DEF P6 NOP * LDA RPCYL NOW CONVERT JSB ASDEC CONVERT CYLINDER TO ASCII LDB MSB9. JSB .MVW DEF P2 NOP * LDA RPHD CONVERT THE HEAD# TO ASCII AND JSB ASDEC STUFF IT IN MESSAGE INA LDB MSC9. JSB .MVW DEF P1 NOP * LDA \DUNT NOW THE UNIT JSB ASDEC INA LDB MSD9. JSB .MVW DEF P1 NOP * LDA IDXPR IF TARGT TRACK MODE THEN CPA P3 DON'T PRINT THAT JMP NOHD FIRST HEADING * ISZ \BADH HAVE WE OUTPUT THE HEADER YET? JMP RPRT YES...GO OUPUT MESSAGE: XXXXXXXXXX XXXX YYYY HH ZZ * LDA \DSUB INSERT THE SUBCHANNEL # JSB ASDEC IN THE MESSAGE INA LDB MS07. JSB .MVW DEF P1 NOP * LDB P7 JSB PROMT "BAD TRACKS SUBCHANNEL XX" * NOHD LDA \DLU NOW CONVN������þúERT AND STUFF JSB ASDEC THE LU # IN THE MESSAGE INA LDB MS08. JSB .MVW DEF P1 NOP * LDB P8 SEND THE MESSAGE: JSB PROMT LU XX LOGICAL CY HD UNIT" AND PRINT IT JSB \BLIN BLANK LINE HERE SINCE NOT DONE AT RPRT * RPRT LDB N9 NEGATIVE SO NO \BLIN CALL JSB PROMT SEND "(BAD TRACK/SPARED) TO XXXX YYYY HH ZZ" * JMP RPORT,I RETURN SPC 1 * END RPORT * ********************************************************************** SPC 5 ********************************************************************** * SPECR ROUTINE * SPC 1 * * SPECR SENDS THE MESSAGE: "INVALID DISC SPECIFICATIONS XX" * * ENTRY CONDITIONS (EXCEPT MODE 5): * STATUS ERRORS 2 (SEEK CHECK ONLY),11,& 14 FROM EOCYL * STATUS ERROR 27 FROM UWAIT * SPECR NOP LDA \DSUB STUFF THE MESSAGE WITH SUBCHANNEL # JSB ASDEC INA LDB MS20. JSB .MVW DEF P1 NOP LDB P20 SEND THE MESSAGE: JSB PROMT "INVALID DISC SPECIFICATIONS XX" JMP SPECR,I RETURN SPC 1 * END SPECR * ********************************************************************** SPC 5 ********************************************************************** * CYLER ROUTINE * SPC 1 * * CYLER SENDS THE MESSAGE: "CYLINDER COMPARE ERROR" * LU XX LOGICAL CYL HEAD ADDR/UNIT * TARGT TRACK XXXX YYYY HH ZZ * * (SEE RPORT FOR EXPLANATIONS) * CYLER NOP LDB P22 DISPLAY MESSAGE JSB PROMT LDA P3 STA IDXPR SET FLAG FOR RPORT TO MOVE "TARGT TRACK" * DLD ARCYL GET SUSPECTED ADDRESS 6u������þúJSB RPORT JMP CYLER,I SPC 1 * END CYLER * ********************************************************************** SPC 5 ********************************************************************** * NRDER ROUTINE * SPC 1 * NRDER SENDS THE MESSAGE: "READY DISC - ENTER " ",CR" * NRDER NOP NROVR LDB P19 JSB PROMT JSB INBLK WAIT FOR THEIR RESPONSE JMP NROVR BAD RESPONSE-PROMT 'EM AGAIN JMP NRDER,I " "CR RESPONSE OK SPC 1 * END NRDER * ********************************************************************** SPC 5 ********************************************************************** * FRMER ROUTINE * SPC 1 * * FRMER SENDS THE MESSAGE: "TURN ON FORMAT SWITCH - ENTER " ",CR" * FRMER NOP FROVR LDB P18 JSB PROMT JSB INBLK JMP FROVR BAD RESPONSE-PROMPT AGAIN JMP FRMER,I " "CR RESPONSE OK SPC 1 * END FRMER * ********************************************************************** SPC 5 ********************************************************************** * PROTR ROUTINE * SPC 1 * * PROTR SENDS THE MESSAGE: "TURN OFF DISC PROTECT - ENTER " ",CR" * PROTR NOP PROVR LDB P17 JSB PROMT JSB INBLK WAIT FOR THEIR RESPONSE JMP PROVR BAD RESPONSE- REPROMPT JMP PROTR,I " "CR RESPONSE OK SPC 1 * END PROTR * ********************************************************************** SPC 5 ********************************************************************** * INBLK `������þú * SPC 1 * INBLK CALLS \RDIN TO INPUT A MAX OF ONE WORD, SO THAT THE * OPERATOR CAN SIGNAL SWITCH WHEN THEY ARE READY,AFTER THEY * FLIPPED A SWITCH ON THE DRIVE OR WHATEVER. SPC 1 * RETURNS: (P+1): ERROR RETURN- " "CR RESPONSE WAS NOT GIVEN * (P+2): NORMAL RETURN- VALID " "CR RESPONSE * (JMP DONE?): ABORT TASK AND CLEANUP LOCKS, ETC. SPC 1 INBLK NOP JSB PRESP CHECK RESPONSE JMP INBLK,I NUMERIC-ERROR RETURN JMP DONE? /E,EN,EX JMP INBLK,I "NO"- ERROR RETURN JMP INBLK,I "YES"- ERROR RETURN ISZ INBLK " "CR-- NORM RETURN-INCR TO (P+2) JMP INBLK,I "??"- ERROR RETURN SPC 1 * END INBLK * ********************************************************************** SPC 5 ********************************************************************** ********************************************************************** ** ** * END DRIVER SUBROUTINES * ** ** ********************************************************************** ********************************************************************** SKP ********************************************************************** ********************************************************************** **  VARIABLES,CONSTANTS,MESSAGES,BUFFERS ** SPC 2 BATCH NOP =7 IF BATCH MODE; BITS 210 = PARM2/PARM3/PARM4 BSIZE NOP BUFFER SIZE BASED ON AVAILABLE MEMORY N#SP NOP NEG # OF SPARES FOR CURRENT SUBCHANNEL BPTR NOP BUFR POINTER SLOOP NOP LOOP COUNTER WARNG NOP WARNING FLAG WHEN SPARING ONE TRACK INDEX NOP PROMPT/EXPLANATION MODE INDEX TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP ¥������þú " TEMP4 NOP " TEMP5 NOP " * IEQT4 NOP IEQT5 NOP * SKP DBLNK DEF BLNK BLNK OCT 20040 * * \TMT DEF *+1 BSS 8 * * CONSTANTS * N2 DEC -2 N3 DEC -3 N5 DEC -5 N8 DEC -8 N9 DEC -9 N10 DEC -10 N10B DEC 138 NEGATIVE 10: SIGN/MAGNITUDE FORM IN LOW BYTE N60B DEC 188 NEGATIVE 60: SIGN/MAGNITUDE FORM IN LOW BYTE N16 DEC -16 N30 DEC -30 N17 DEC -17 N29 DEC -29 N31 DEC -31 N2001 DEC -2001 * P0 DEC 0 P2 DEC 2 P5 DEC 5 P11 DEC 11 P17 DEC 17 P18 DEC 18 P20 DEC 20 P22 DEC 22 P23 DEC 23 P24 DEC 24 P25 DEC 25 P30 DEC 30 P48 DEC 48 P70 DEC 70 P76 DEC 76 P77 DEC 77 P64 DEC 64 P128 DEC 128 P145 DEC 145 P161 DEC 161 * B17 OCT 17 ST20 OCT 20 FAKE STATUS1 WORD ST21 OCT 21 FAKE STATUS1 WORD B21 EQU P17 B23 OCT 23 B32 OCT 32 B37 OCT 37 B40 EQU BLANK B60 EQU P48 B77 OCT 77 B100 EQU P64 B377 OCT 377 ST.1 NOP *BC B400 OCT 400 B1774 OCT 177400 B2200 OCT 2200 B7700 OCT 177700 M10 OCT 177770 *WL M30 OCT 177750 *WL N64 EQU B7700 DEC -64 * * \ACTN VALUES AND THEIR MEANINGS: * A017 EQU B17 XDRED, XFMSK, XADRC, XSEEK A024 EQU P20 XRDFS, XFMSK A067 OCT 67 STFIX, XRDFS, XFMSK, XADRC, XSEEK A201 OCT 201 XINIT, XSEEK A207 OCT 207 XINIT, XFMSK, XADRC, XSEEK A401 OCT 401 XVRFY, XSEEK A407 OCT 407 XVRFY, XFMSK, XADRC, XSEEK A1000 OCT 1000 XEND A1004 OCT 1004 XEND , XFMSK A2007 OCT 2007 XRDOF, XFMSK, XADRC, XSEEK A4000 OCT 4000 XFRMT ONLY A4001 OCT 4001 XFRMT, XSEEK * S001 EQU P1 D-BIT ONLY S100 EQU P4 S-BIT ONLY * FWA NOP * \SYST NOP SYSTEM TYPE FLAG *WL \ACTN NOP ACTION FLAG WORD TO DRIVE XFER ROUTINE \RET NOP STATUS RETf������þúURNED TO MAIN -1/0/1: * -1=ERROR; 0=LOOP DRIVER AGAIN; 1=OK \R/W NOP 0/1 = WRITE/READ \MODE NOP R/W MODE PASSED FROM MAIN MADDR NOP BUFFER ADDRESS� FOR DATA PHASE NOP CURRENT PHASE FLAG FOR LOOPING THRU DRIVER CRSP# NOP CURRENT SPARE NUMBER (RANGE= 0 TO \DNSP) USED# NOP # SPARES CONSUMED ON THIS SUBCH ERCNT NOP DISC OPERATION ERROR COUNTER (RANGE:-10 TO 0) OFSET NOP OFFSET VALUE OF READ W/ OFFSETS (-60 TO 60) STRAK NOP SPARE TRACK RETRIEVED FROM XSPAR CALL FLMSK NOP FILE MASK BITS: 4/0 = AUTO-SEEK TO SPARE/NO AUTO SEEK SKCYL NOP PHYSICAL CYLINDER # FOR SEEK COMMAND SKHD NOP PHYSICAL HEAD# FOR SEEK COMMAND ARCYL NOP PHYSICAL CYLINDER # FOR ADDRESS RECORD COMMAND ARHD NOP PHYSICAL HEAD# FOR ADDRESS RECORD COMMAND BDCYL NOP PHYSICAL CYLINDER # FOR CURRENT DEFECTIVE TRACK BDHD NOP PHYSICAL HEAD # FOR CURRENT DEFECTIVE TRACK RPCYL NOP PHYSICAL CYLINDER # FOR REPORT ROUTINE RPHD NOP PHYSICAL HEAD# FOR REPORT ROUTINE ST1 NOP 5-BIT S1 FIELD FROM STAT1 STAT1 NOP STATUS WORD 1 RETURNED FROM DRIVER LIBRARY STAT2 NOP STATUS WORD 2 RETURNED FROM DRIVER LIBRARY IER NOP ERROR INDICATOR FOR DRIVER LIBRARY CALLS SPD NOP INITIALIZE FLAG BITS SPARE/PROTECT/DEFECTIVE LEN NOP POSITIVE # OF WORDS TO TRANSFER * BPATT NOP CURRENT FORMAT BIT PATTERN BPAT1 OCT 0306 PATTERN C6H BPAT2 OCT 0143 PATTERN 63H BPAT3 OCT 0155 PATTERN 6DH BPAT4 OCT 0210 PATTERN 88H BPAT5 EQU P0 PATTERN 00H FTYP NOP HP TYPE=2, BIT7=0/1 FOR NO/YES FORMAT OVERRIDE INTLV NOP SECTOR INTERLEAVE VALUE, 1-29 LGCYL NOP CYLINDER# FOR REQUEST LOGICAL ADDR LGHD NOP HEAD# FOR REQUEST LOGICAL ADDR LGSCT NOP SECTOR# FOR REQUEST LOGICAL ADDR \FILL NOP †(������þú USER REQUESTED FILL VALUE YOVRD OCT 202 NEW FORMAT (YES=OVERRIDE), WITH TYPE= 2 NOVRD EQU P2 PRESERVE OLD FORMAT (NO=OVERRIDE),TYPE=2 BADFT NOP # BAD TRACKS ENCOUNTERED BFTBL DEF *+1 ALLOW A MAXIMUM OF 20 BAD TRACKS BSS 40 FOR A FLOPPY DISC (SAVE CYL & HEAD) * \BADH DEC -1 BAD TRACKS HEADER FLAG * SKP ********************************************************************** ********************************************************************** ** FORMT MESSAGES AS DISPLAYED BY PROMT ** SPC 1 * MES00 ASC 3,TASK? MES01 ASC 4,DISC LU? MES02 ASC 20,DO YOU REALLY WANT TO FORMAT THIS DISC? MES03 ASC 9,# OF FILL SECTORS? MES04 ASC 10,TRACK TO BE SPARED? MES05 ASC 19,DATA WILL BE DESTROYED, OK TO PROCEED? MES06 ASC 12,# OF GOOD TRACKS = XXXX MS06. DEF MES06+10 MES07 ASC 12,BAD TRACKS SUBCHANNEL XX IFN,IFZ??? *WL MS07. DEF MES07+11 MES08 ASC 5,LU ASC 14, LOGICAL CYL HEAD UNIT/ADDR MES09 ASC 6, STORAGE FOR "BAD TRACK/SPARED TO" MESA9 ASC 3, " TRACK MESB9 ASC 3, " CYL MESC9 ASC 3, " HEAD MESD9 ASC 1, " UNIT/ADDR MESE9 ASC 6,BAD TRACK MESF9 ASC 6,SPARED TO MESG9 ASC 6,BAD SPARE MESH9 ASC 6,TARGT TRACK * MS08. DEF MES08+2 LOCATION OF LU MSA9. DEF MESA9 " TRACK MSB9. DEF MESB9 " CYL MSC9. DEF MESC9 " HEAD MSD9. DEF MESD9 " UNIT/ADDR MEFGH DEF *+1 DEF MESE9 DEF MESF9 DEF MESG9 DEF MESH9 * MES10 ASC 14,XXXX SPARE TRACKS AVAILABLE MES11 ASC 19,WARNING! ALL INFORMATION ON TRACK NOT ASC 13,SUCCESSFULLY RECOVERED MES12 ASC 16,OUT OF SPARE TRACKS FOR THIS LU MES13 ASC 8,INVALID TRACK # MES14 ASC 8,INVALID DISC LU MES15 ASC 7,FORMT FINISHED MES16 ASC 7,FORMT ABORTED MES17 ASC 18,TURN OFF PROTEC†<������þúT OR READ-ONLY SWITCH ASC 8, - ENTER " ",CR MES18 ASC 18,TURN ON FORMAT SWITCH - ENTER " ",CR MES19 ASC 13,READY DISC - ENTER " ",CR MES20 ASC 15,INVALID DISC SPECIFICATIONS XX MS20. DEF MES20+14 MES21 ASC 16,NOT ENOUGH ROOM FOR TRACK BUFFER *WL MES22 ASC 11,CYLINDER COMPARE ERROR  MES23 ASC 17,WARNING! POSSIBLE BAD FLOPPY MEDIA ASC 18, RETRY FORMT OR DISCARD FLOPPY DISC MES24 ASC 15,MAX OF 20 BAD TRACKS EXCEEDED MES25 ASC 8,FORMAT PASS # XX MS25. DEF MES25+7 MES26 ASC 12,OUTDATED SYSTEM SOFTWARE MES27 ASC 13,UNAUTHORIZED LU2,3 ACCESS *BC ASC 10,- (COMMAND IGNORED) *BC MES28 ASC 16,DO YOU REALLY WANT TO RE-FORMAT *BC ASC 8,THE SYSTEM DISC? *BC MES29 ASC 14,UNEXPECTED HARDWARE FAILURE *BC ASC 7,- TASK ABORTED *BC * XPL00 ASC 19,ENTER FO(RMAT), IN(ITIALIZE), SP(ARE), *BC ASC 14, VE(RIFY), RE(FORMAT), EN(D) *BC XPL01 ASC 9,ENTER DISC LU < 64 XPL02 ASC 6,ENTER YE,NO XPL03 ASC 14,ENTER FILL SECTOR VALUE 0-28 XPL04 ASC 13,ENTER BAD TRACK # 0 - XXXX XP04. DEF XPL04+11 * * * BUFFERS * \BUFI NOP ADDR HPIB COMMAND BUFFER PRECEEDING \BUFA \BUFA NOP ADDRESS OF TRACK BUFFER FOR I/O WITH DISC * RBUFR BSS 144 RESP BUFFER,RD WITH OFFSET,& GETST BUFF PSBUF EQU RBUFR+80 33 WORD PARAM BUFF FOR PARSE PTYP2 EQU PSBUF+4 TYPE WORD FOR PARM2 PTYP3 EQU PSBUF+8 TYPE WORD- PARM3 PTYP4 EQU PSBUF+12 TYPE WORD- PARM4 0/1/2=NULL/NUM/ASCII * OPLU DEC 1 DEFAULT OPERATOR LU PARM2 BSS 1 TASK PARAMETER- IN,SP,FO PARM3 BSS 1 DISC LU PARAMETER- < 64 REQ'D PARM4 BSS 1 FILL OR TRACK# TO SPARE PARAMETER PARM5 BSS 1 SPARE PARAM FOR RMPAR TO FILLETER * DPBUF EQU RBUFR HPIB COMMAND BUFFER FOR READ FULL SECT CYLSP EQU RBUFR+17 CYLINDER ADDRESS STORED IN SPARE HDSSP EQU RBUFR+18 HEAD/SECTOR ADDRESS STORED IN SPARE * **********^Q���Ô����Ò�Î************************************************************ ********************************************************************** END EQU * END FORMT ����������������������������������������.IÔ�������ÿÿ����� ���� ÿý�÷�RJ ���������ÿ��92067-18555 2040� S C0122 �&AF06H �7906/20H GFR ANSWER FILE � � � � � � � � � � � � �H0101 Áæ�����þú&LI20H::10 ***LIST FILE NAME ** ANSWER FILE &AF06H 92067-18555 2040 RTE4B 7906H 801001 YES *ECHO ON !SY20H::10::4000 ***SYSTEM FILE - STORED ON LU 10 7906H *SYSTEM DISC TYPE: 7906H/20H 11 *SYSTEM DISC SELECT CODE * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 7920H,256,0,0,2,0,8 *SUBCHANNEL 0 7920H,203,132,0,2,0,5 *SUBCHANNEL 1 7920H,203,236,0,2,0,5 *SUBCHANNEL 2 7920H,138,340,0,2,0,4 *SUBCHANNEL 3 7920H,203,0,2,1,0,5 *SUBCHANNEL 4 7920H,198,208,2,1,0,5 *SUBCHANNEL 5 7920H,400,0,3,1,0,11 *SUBCHANNEL 6 7920H,400,0,4,1,0,11 *SUBCHANNEL 7 7920H,1024,411,0,5,0,26 *SUBCHANNEL 8 7920H,985,621,0,5,0,25 *SUBCHANNEL 9 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 64 *MEMORY SIZE !BO20H::10 ***BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IVB OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * Π������þúREL,%DVR00::32767 *TTY/PUNCH/PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH CTU) REL,%DVR32::32767 *7905/06/20/25/ DISC DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR12::32767 *2767A LINE PRINTER DRIVER REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%$TB32::32767 *7905/06/20/25/ AUX TRACK MAP REL,%DVA32::32767 *7906H/20H/25H/9895 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *CURRENT PAGE LINKING LOADER REL,$LDRLB::32767 *LOADER LIBRARY REL,%WHZAT::32767 *WHZAT REL,%BMPG1::32767 *FILE MANAGER REL,%BMPG2::32767 *D.RTR DIRECTORY MGR REL,%RT4GN::32767 *GENERATOR REL,%SSTCH::32767 *SWITCH PROGRAM REL,%FORMT::32767 *MAC/ICD DISC INITIALIZATION PROGRAM REL,%LSAVE::32767 *MAC/ICD DISC LU SAVE PROGRAM REL,%USAVE::32767 *MAC/ICD DISC UNIT SAVE PROGRAM REL,%LCOPY::32767 *MAC/ICD DISC COPY PROGRAM REL,%RESTR::32767 *MAC/ICD DISC RESTORE PROGRAM REL,%HELP ::32767 *HELP PROGRAM REL,%SMON1::32767 *SESSION MONITOR SOFTWARE REL,%SMON2::32767 *SESSION MONITOR SOFTWARE * ********************** LIBRARIES * REL,$DSCLB::32767 *DISC DRIVER LIBRARY REL,$DKULB::32767 *DISC BACKUP LIBRARY REL,%DBKLB::32767 *7900 DISx������þúC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%BMPG3::32767 *BATCH LIBRARY REL,%UTLIB::32767 *UTILITIES LIBRARY REL,$MLIB1::32767 *SYSTEM INDEPENDENT LIBRARY PT.1 REL,$MLIB2::32767 *SYSTEM INDEPENDENT LIBRARY PT.2 * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * FORMT,4 SWTCH,4 RT4GN,4 LCOPY,4 D.RTR,3,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 Z$DBL,RP,3 *3(4)=3-WORD(4-WORD) FLOATING POINT * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 *** ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVA32,D,T=200 *EQT # 1 - 7906H/20H DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER 25,DVB12,B,X=5 *EQT # 9 - 2608 LINE PRINTER 24,DVR32,D *EQT #10 - 7905/06/20/25 DISC /E *TERMINATE THISŠ'������þú PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7906H/20H SUBCHANNEL 1 1,2 *LU # 11 - 7906H/20H SUBCHANNEL 2 1,3 *LU # 12 - 7906H/20H SUBCHANNEL 3 1,4 *LU # 13 - 7906H/20H SUBCHANNEL 4 1,5 *LU # 14 - 7906H/20H SUBCHANNEL 5 1,6 *LU # 15 - 7906H/20H SUBCHANNEL 6 1,7 *LU # 16 - 7920H SUBCHANNEL 7 1,8 *LU # 17 - 7920H SUBCHANNEL 8 1,9 *LU # 18 - 7920H SUBCHANNEL 9 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER 9,0 *LU # 21 - 2608 LINE PRINTER 10,0 *LU # 22 - 7905/06/20/25 DISC LU * ****DISC SUBCHANNEL 00 OF $TB32 /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,PRG,PRMPT 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 24,EQT,10 25,EQT,9 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *oŠ�����CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 14,BG 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,20 RT4GN,20 FORMT,17 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT ��������������������������������������������������������������������������������������������������������������#3������ÿÿ����� ���� ÿý�ø�  ���������ÿ��92067-18556 2001� S C0122 �&MTOK �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 ÑÂ�����FTN4,L SUBROUTINE MTOK(MTLU,IER),92067-1X556 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: MTOK C SOURCE: 92067-18556 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C C C C THIS ROUTINE CHECKS IF MT IS ON LINE AND THE LU IS NOT DOWN C ELSE IT WILL PRINT MESSAGES ON LU 1 AND SET IER=1 C IER=0 LOG=1 CALL EXEC(13,MTLU,IEQT5,ISTAT1,ISTAT2) C C LOOK AT EQT4 BITS 14,15 TO SEE IF DOWN C IF(IAND(IEQT5,40000B).EQ.40000B) GO TO 88 IF(IAND(ISTAT2,100000B).EQ.100000B) GO TO 88 C C DYNAMIC STATUS TO MT TO SEE IF ON LINE C CALL EXEC(3,600B+MTLU) CALL ABREG(IA,IB) IF(IAND(IA,1).NEQ.1) RETURN CALL EXEC(2,LOG+200B,17HMAG TAPE OFF-LINE,-17) IER=1 RETURN 88 CALL EXEC(2,LOG+200B,13HMAG TAPE DOWN,-13) CALL EXEC(2,LOG,12HTYPE '*UP,5',-12) CALL EXEC(2,LOG,26HAND '*RU,DISK' TO RE-START,-26) STOP END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������?������ÿÿ����� ���� ÿý�ù�ÿ ���������ÿ��92067-18557 2001� S C0122 �&CLRSP �$DKULB SUBROUTINE � � � � � � � � � � � � �H0101 Òë�����þúFTN4,L SUBROUTINE CLRSP(LU,ITMT),92067-1X557 REV.2001 791101 C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: CLRSP C SOURCE: 92067-18557 C RELOC: PART OF 92067-12003 C PGMR: J.S.W C DIMENSION ITMT(1),IXBUF(1) COMMON IXBUF,IHDR,ICMD C C C THIS SUBROUTINE CLEARS S BIT OF ALL THE SPARE TRACKS DEFINED C IN THE SUBCHHANEL TRACK MAP ENTRY ITMT (5 WORDS) C C COMPUTE TRACK SIZE, FIRST SPARE TRACK AND # OF SPARES C C ISTRK=ITMT(4) ISIZE=ITMT(1)*64 NSPAR=IAND(ITMT(5),377B) IF(NSPAR.EQ.0) RETURN C C GO THRU EACH TRACK IN THE SPARE POOL TO SEE IF S BIT IS SET C IF YES CLEAR THE S BIT AND PRESERVE THE D BIT C DO 50 I=1,NSPAR ISEC=0 CALL MXGTA(LU,IDVID,ISTRK,ISEC,ICYL,IHD,ISEC,ITMT) C C D WRITE(1,9999) NSPAR,ISTRK,ICYL,IHD,ISEC,IDVID D9999 FORMAT("#SPAR,STRK,ICYL,HD,SEC",5I7,@8) MSK=0 D WRITE(1,5555) LU,IDVID,MSK,IER CALL XFMSK(LU,IDVID,MSK,IER) D WRITE(1,5555) LU,IDVID,MSK,IER D5555 FORMAT("LU,DVID,MSK,IER",4@8) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,IS1,IS2,IER) C D WRITE(1,6666) IDVID,IS1,IS2,IER D6666 FORMAT("DVID,IS1,IS2,IER",4@7) C NOW DO A READ FULL SECTOR TO SEE IF S BIT SET C CALL XRDFS(LU,IDVID,IXBUF,128,IS1,IS2,IER) D WRITE(1,7777) IXBUF(19) D7777 FORMAT("BUF19=",@7) IF(IAND(IXBUF(19),100000B).EQ.0) GO TO 50 IDBIT=IAND(IXBUF(19),20000B) ;y��� ��  CALL XFMSK(LU,IDVID,MSK,IER) CALL XSEEK(LU,IDVID,ICYL,IHD,ISEC,IS1,IS2,IER) D WRITE(1,9999) NSPAR,ISTRK,ICYL,IHD CALL XINIT(LU,IDVID,IXBUF,ISIZE,IDBIT,IS1,IS2,IER) 50 ISTRK=ISTRK+1 RETURN END END$ ��������������é+ ������ÿÿ����� ���� ÿý�ú� ���������ÿ��92067-18558 2026� S C0122 �&IDSGM SUBROUTINE � � � � � � � � � � � � � �H0101 fy�����þúFTN4,L SUBROUTINE IDSGM(LU,IFMPT,ILU,IERR),92067-1X558 REV.2026 800131 C C C NAME: IDSGM C SOURCE: 92067-18558 C RELOC: 92067-16558 C PGMR: R.D. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C IMPLICIT INTEGER(A-Z) DIMENSION INAM(3),MESG1(20),MESG2(22),MESG3(24),MESG4(10) DATA MESG1/2HTH,2HE ,2HFO,2HLL,2HOW,2HIN,2HG ,2HPR,2HOG,2HRA,2HMS, & 2H H,2HAV,2HE ,2HID,2H S,2HEG,2HME,2HNT,2HS / DATA MESG2/2HPO,2HIN,2HTI,2HNG,2H T,2HO ,2HTH,2HE ,2HFM,2HP ,2HTR, & 2HAC,2HKS,2H Y,2HOU,2H'R,2HE ,2HRE,2HPL,2HAC,2HIN,2HG./ DATA MESG3/2HTH,2HES,2HE ,2HPR,2HOG,2HRA,2HMS,2H M,2HUS,2HT ,2HBE, & 2H R,2HEM,2HOV,2HED,2H B,2HEF,2HOR,2HE ,2HRE,2HAD,2HT , & 2HWI,2HLL/ DATA MESG4/2HRE,2HPL,2HAC,2HE ,2HTH,2HE ,2HTR,2HAC,2HKS,2H. / C C LU IS WHERE READT IS RESTORING THE FMP TRACKS LU 2 OR LU 3 C IFMPT IS THE START OF THE FMP TRACKS C ILU IS THE LIST DEVICE. C IERR = 0 WHEN THERE ARE NO ID SEGMENTS POINTING TO FMP TRACKS C ON THE SPECIFIED DISC LU. C IERR <> 0 WHEN THERE ARE ID SEGMENTS. C C C C THIS SUBROUTINE SEARCHES THROUGH THE ID SEGMENTS VIA C THE KEYWORD TABLE. ALL ID SEGMENTS THAT POINT TO FMP C TRACKS WILL BE IDENTIFIED (LU 2 OR LU 3). THIS C WILL GIVE THE USER AN OPPORTUNITY TO "OF" ID SEGMENTS C SO THAT ON A RESTORE OF LU 2 OR LU 3 THE SYSTEMS INTEGRITY C WILL BE MAINTAINED. C C C GET FWA OF KEYWORD TABLE C IFWA=IXGET(1657B) C C GET ID SEGMENT ADDRESS C ICNTR=-1 IXERR=0 C 100 ICNTR=ICNTz8������þúR+1 C IDSEG=IXGET(IFWA+ICNTR) C C IF ENTRY IS 0 THEN EXIT (END OF TABLE). C IF(IDSEG.EQ.0)GO TO 300 C C C GET PROGRAM NAME C INAM=IXGET(IDSEG+12) INAM(2)=IXGET(IDSEG+13) INAM(3)=IXGET(IDSEG+14) C C READ DISC ADDRESS FROM ID SEGMENT C CHECK WHETHER IT'S LONG OR SHORT ID C IOFF=26 IF ((IAND(INAM(3),20B)).NE.0) IOFF=19 C C IF PROGRAM TYPE IS ONE THEN CAN'T RESIDE ON FMP TRACKS C IF(IAND(INAM(3),17B).EQ.1)GO TO 100 C C GET DISC ADDRESS FROM ID SEGMENT C IDSCA=IXGET(IDSEG+IOFF) C IF(LU.EQ.2)GO TO 200 C C THIS IS A CHECK FOR ID SEGS. ON LU 3 C IF BIT 15 IS 0 THEN DISC ADDR. IS ON LU 2 C OR IF THE DISC ADDR. IS LESS THAN THE START OF THE FMP TRACKS, C GET ANOTHER ID SEGMENT. C IF(IAND(IDSCA,100000B).EQ.0)GO TO 100 C C IDSCA=(IAND(77600B,IDSCA))/128 C IF(IDSCA.LT.IFMPT)GO TO 100 C C KEEP CHECK OF ID SEGS. POINTING TO FMP TRACKS C IF THERE AREN'T ANY RETURN IERR=0 C OTHERWISE IERR <> 0 C C C FOUND AN ID SEGMENT - PRINT PROGRAM NAME C C PAD FIRST SEVEN BITS OF THIRD WORD IN PROGRAM NAME. IF(IXERR.NE.0)GO TO 170 C CALL EXEC(2,ILU,MESG1,20) CALL EXEC(2,ILU,MESG2,22) CALL EXEC(2,ILU,MESG3,24) CALL EXEC(2,ILU,MESG4,10) C IERR=-1 C 170 IXERR=IXERR+1 C C INAM(3)=IOR(IAND(77400B,INAM(3)),40B) C CALL EXEC(2,ILU,INAM,3) C C GET ANOTHER ID SEGMENT C GO TO 100 C C THIS IS THE CHECK OF ID SEGS. POINTING TO FMP TRACKS ON LU 2 C C IF THE BIT 15 IS 1,THEN DISC ADDR. POINTS TO LU 3 C THEREFORE DON'T BOTHER TO LOOK. C 200 IF(IDSCA.LT.0)GO TO 100 C IDSCA=(IAND(77600B,IDSCA))/128 C IF(IDSCA.LT.IFMPT)GO TO 100 C C KEEP CHECK OF ID SEGS. POINTING TO FMP TRACKS ON LU 2 C IF THERE AREN'T ANY, RETURN IERR=0 C OTHERWISE IERR <> 0 C PRINT PROGRAM NAME C :§����� PAD THIRD WORD OF PROGRAM NAME WITH A BLANK C INAM(3)=IOR(IAND(77400B,INAM(3)),40B) C C GIVE MESSAGE TO REMOVE ID SEGMENTS C IF(IXERR.NE.0)GO TO 220 C CALL EXEC(2,ILU,MESG1,20) CALL EXEC(2,ILU,MESG2,22) CALL EXEC(2,ILU,MESG3,24) CALL EXEC(2,ILU,MESG4,10) C IERR=-1 C C 220 IXERR=IXERR+1 C CALL EXEC(2,ILU,INAM,3) C C GET ANOTHER ID SEGMENT C GO TO 100 C C 300 RETURN END ����������������������������Å������ÿÿ����� ���� ÿý�û� ���������ÿ��92067-18559 2026� S C0122 �&COMRD SUBROUTINE � � � � � � � � � � � � � �H0101 }d�����FTN4,L BLOCK DATA COMRD,92067-1X559 REV.2026 800116 C C ******************************************************************* C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS RESERVED. C * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C * CONSENT OF HEWLETT-PACKARD COMPANY. C ******************************************************************* C * C * NAME : COMRD C * SOURCE: 92067-18559 C * RELOC: 92067-16559 C * PGMR : R.D. C * COMMON/COMRD/ ILU,ITAPE,NDIR,IDISC,MTLU,TSIZE,IBUF(8193) END ��������������������������������������������������������������������������������������������������������������������������ÿ ������ÿÿ����� ���� ÿý�ü� ���������ÿ��92067-18560 2026� S C0122 �&PCIBF � � � � � � � � � � � � � �H0101 mŠ�����þúASMB,R,L,C * NAME: PCIBF * SOURCE: 92067-18560 * RELOC: 92067-16185 * PGMR: D.L.B. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED "PCIBF" ROUTINE TO PUT BUFFER IN FMGR'S BUFFER LIST 7-78 (DLB) NAM PCIBF,8 92067-16185 REV.2026 800428 ENT PCIBF EXT .ENTR EXT TPSK.,NXTK.,EDSK.,CRSK. SPC 1 A EQU 0 B EQU 1 TOPSK EQU TPSK. ADDRESS OF TOP OF BUFFER LIST BUFFER NXTSK EQU NXTK. NEXT AVAILABLE WORD IN BUFFER LIST BUFFER ENDSK EQU EDSK. END + 0 WORD OF BUFFER LIST BUFFER CURSK EQU CRSK. CURRENT DISPLAY POINTER SPC 1 * PURPOSE: TO PUT CALLERS BUFFER (FMGR COMMAND) INTO THE * FMGR BUFFER LIST. * CALLED: * JSB PCIBF * DEF *+3 * DEF BUFFER * DEF BUFFERLENGTH * WHERE: * BUFFER = ADDRESS OF THE BUFFER TO PUT. * BUFFERLENGTH = LENGTH OF BUFFER IN WORDS. * NOTES: * BUFFER WILL HAVE LITTLE USE UNLESS IT IS A LEGAL FMGR * COMMAND WITHOUT THE LEADING ":". SPC 1 PCIBA NOP TEMP FROM BUFFER ADDRESS POINTER PCIBB NOP TEMP NEG. FROM BUFFER LENGTH (WORDS) SPC 1 PCIBC NOP BUFFER ADDRESS PCIBD NOP BUFFER LENGTH IN WORDS PCIBF NOP ENTRY TO PUT A BUFFER INTO BUFFER LIST JSB .ENTR GET BUFFER ADDRESS AND LENGTH DEF PCIBC TOP OF ADDRESS STACK SPC 1 * 1ST SEARCH WHOLE LIST FOR MATCHING BUFFER & DELETE IF MATCH. SPC 1 LDB TOPSK GET THE 1ST BUFFER ADDRESS STB CURSK AND SAVE CURRENT BUFFER POINTER NEXT0 LDA PCIBC GET CALLERS BUFFER4������þú ADDRESS STA PCIBA AND SAVE AS POINTER FOR SEARCH LDA CURSK,I GET 1ST BUFFER LENGTH AND O377 MASK TO JUST FORWARD LENGTH POINTER CPA PCIBD,I CHECK IF MATCHES CALLERS LENGTH? CMA,INA,SZA,RSS YES, NEGATE & CHECK FOR NON-ZERO. JMP NEXT2 NO MATCH LENGTH, TRY NEXT BUFFER IN LIST. STA PCIBB SAVE NEGATED LENGTH OF BUFFER LDB CURSK GET ADDRESS-1 OF BUFFER IN LIST NEXT1 INB BUMP TO DIRECT ADDRESS LDA B,I GET THE CONTENTS OF BUFFER CPA PCIBA,I CHECK IF MATCHES CALLERS? RSS YES, CONTINUE JMP NEXT2 NO, TRY NEXT BUFFER IN LIST ISZ PCIBA BUMP TO NEXT WORD IN CALLERS BUFFER ISZ PCIBB CHECK IF ALL WORDS CHECKED? JMP NEXT1 NO, KEEP ON TRUCKING SPC 1 * MATCHING BUFFER, DELETE BUFFER IN THE BUFFER LIST SPC 1 LDA CURSK GET ADDRESS OF BUFFER TO DELETE JSB DELIN AND TAKE IT OUT OF THE BUFFER LIST JMP NEXT0 AND GO TRY NEXT BUFFER IN THE BUFFER LIST SPC 1 * BUFFER DOES NOT MATCH, ADVANCE THE CURRENT BUFFER LIST POINTER & CONT. SPC 1 NEXT2 JSB ADVSK MOVE "CURSK" POINTER TO NEXT BUFFER JMP PCIBY REACHED END, NOW DO THE MOVE JMP NEXT0 GO TRY NEXT BUFFER IN THE BUFFER LIST SPC 1 * NOW CHECK IF ENOUGH ROOM FOR BUFFER TO BE PUT INTO BUFFER LIST SPC 1 PCIBZ LDA TOPSK DELETE OLDEST ENTRY OFF BUFFER LIST JSB DELIN POP BUFFER LIST FOR MORE ROOM PCIBY LDA PCIBD,I GET THE BUFFER LENGTH AND O77 CHECK LENGTH IS KOSHER CPA PCIBD,I (1-63 WORDS) SZA,RSS AVOID PUTTING ZERO LENGTH JMP PCIBF,I RECORDS IN STACK ADA NXTSK CHECK IF OVERFLOWS THE BUFFER LIST BUFFER CMA NEGATE - 1 ADA ENDSK AND CHECK IF OVERFLOWS BUFFER LIST SSA IF OVERFLOW, POP OLDEST ENTRY & TRY AGAIN JMP PCIBZ OVERFLOW, GO MAKE MORE ROOM SPC 1 ÿ‰������þú * NOW PUT CALLERS BUFFER INTO THE BUFFER LIST SPC 1 LDA NXTSK,I GET THE LENGTH WORD OF THE "TO" BUFFER IOR PCIBD,I MERGE IN THE LENGTH OF CALLERS BUFFER STA NXTSK,I AND PUT BACK AND O377 GET THE BUFFER LENGTH CMA,INA NEGATE STA PCIBB SAVE AS COUNTER FOR MOVE LDA NXTSK SET UP THE CURRENT STACK POINTER STA CURSK WHEN ADDING NEW BUFFER ISZ NXTSK BUMP TO WHERE TO PUT BUFFER NEXT3 LDA PCIBC,I GET NEXT WORD OF "FROM" BUFFER STA NXTSK,I AND MOVE INTO BUFFER LIST ISZ PCIBC BUMP FROM ADDRESS WORD ISZ NXTSK BUMP TO ADDRESS WORD ISZ PCIBB AND BUMP COUNTER JMP NEXT3 GO TRY NEXT WORD LDA PCIBD,I GET BUFFER LENGTH ALF,ALF POSITION STA NXTSK,I AND SET THE END WORD IN BUFFER LIST JMP PCIBF,I AND EXIT TO CALLER SPC 1 * IF THE FOLLOWING THREE LINES WERE ADDED TO BUFFER LIST * IT WOULD LOOK LIKE THIS: * (1) MESSAGE * (2) TWO * (3) THREE * * BIT !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0! * TOPSK ! (0) ! (4) ! * ! M ! E ! * ! S ! S ! * ! A ! G ! * ! E ! (SPACE) ! * ! (4) ! (2) ! * ! T ! W ! * ! O ! (SPACE) ! * CURSK ** ! (2) ! (3) ! * ! T ! H ! * ! R ! E ! * ! E ! (SPACE) ! * NXTSK ** ! (3) ! (0) ! * ! THIS IS BEYOND THE END OF THE BUFFER ! * ¬]������þú ! LIST AND WILL CONTAIN GARBAGE DATA ! * ENDSK ! THIS IS LAST WORD IN BUFFER LIST BUFFER ! * * ** THESE WORDS ARE DYNAMIC POINTERS INTO LIST BUFFER SPC 1 * TAKE BUFFER POINTED TO BY A-REG OUT OF BUFFER LIST SPC 1 DELIA NOP "FROM" POINTER DELIB NOP "TO" POINTER DELIN NOP ENTRY TO DELETE A BUFFER FROM BUFFER LIST STA DELIB SAVE POINTER TO BUFFER TO DELETE CPA NXTSK CHECK IF AT END? JMP DELIN,I YES, IGNORE DELETE REQUEST LDA DELIB,I GET THE OFFSET VALUE AND O377 MASK TO OFFSET BITS STA B SAVE IN B-REG THE DELETE BUFFER LENGTH BLF,BLF POSITION TO HIGH BITS ADB A B-REG = DELETE BUFFER LENGTH IN HI & LO-BITS ADA DELIB BUMP TO LENGTH WORD OF NEXT BUFFER-1 INA BUMP TO LENGTH WORD OF NEXT BUFFER STA DELIA SAVE "FROM" ADDRESS FOR MOVE LDA DELIA,I GET LENGTH WORD AT END-CURR/BEG-NEXT BUFFER XOR DELIB,I WITH BEG-CURR/END OF PREVIOUS BUFFER LENGTH XOR B TAKE OUT DELETE BUFFER LENGTHS LDB NXTSK GET END ADDRESS OF LAST BUFFER LENGTH WORD DELI1 STA DELIB,I AND PUT HIGHER IN BUFFER LIST CPB DELIA CHECK IF FINISHED PACKING MOVE? JMP DELI2 YES, EXIT ISZ DELIA BUMP "FROM" BUFFER ADDRESS ISZ DELIB BUMP "TO" BUFFER ADDRESS LDA DELIA,I GET NEXT WORD TO MOVE UP JMP DELI1 CONTINUE TO NEXT WORD SPC 1 DELI2 LDA DELIB MOVE THE NXTSK POINTER STA NXTSK TO ITS NEW VALUE JMP DELIN,I AND EXIT P+1 SPC 1 * ADVANCE CURRENT DISPLAY POINTER * CALLED: JSB ADVSK * <RETURN IF UNSUCCESSFUL> * <RETURN IF SUCCESSFUL> SPC 1 SAVA NOP A-REG SAVE FOR BOTTOM SUBROUTINES ADVSK NOP GET CURRENT DISPLAY BUFFER STA SAVA SAVE A-REG FOR RETURN LDA CURSK,I GET THE LENGTH AND O377 MASKÎF����� TO LENGTH SZA CHECK IF AT END? INA BUMP ONE FOR GOOD MEASURE ADA CURSK SET NEW DISPLAY BUFFER POINTER CPA NXTSK CHECK IF AT END OF BUFFER LIST? JMP ADVS1 YES, SKIP ADVANCE STA CURSK FOR NEXT TIME ISZ ADVSK P+2 EXIT >> MOVED ADVS1 LDA SAVA RESTORE A-REG JMP ADVSK,I YES, EXIT SPC 1 SPC 1 O77 OCT 77 O377 OCT 377 END ������������������������������������������������������������������������������.r������ÿÿ����� ���� ÿý�ý�  ���������ÿ��92067-18561 2026� S C0122 �&IDRP � � � � � � � � � � � � � �H0101 }f�����þúASMB,R,Q,C HED "IDRP" FTN/SPL SUBR TO DO A FMGR ":RP,PROG" FROM ANY CART. * SOURCE: 92067-18561 * RELOC: 92067-16185 * PGMR: D.L.B., D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IDRP,7 92067-16185 REV.2026 800305 * * MODIFICATION RECORD: * DATE REASON BY WHOM * 1) 2-2-76 TO ADD PRIVILEDGE READ CODE TO EXEC CALL TO * THE DISC CALL TO THE FILE. (DLB) * 2) 8-16-77 TO ZERO THE 5 TEMP WORDS IN THE RESTORED * ID SEGMENT * 3) 10-14-77 TO SUPPORT EXTENDED ID SEGMENT * 4) 1-6-78 TO NOT USE DYNAMIC BASE PAGE WORDS IN CALCULATION * OF SYSTEM CHECKSUM (RTE-IV ONLY). (GLM) * 5) 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 6) 5-31-78 TO PRESERVE WORD 32 OF NEW ID SEGMENT (BL) * 7) 9-20-78 TO SET "I'M A COPY" FLAG (GLM) * 8) 1-22-79 TO RETURN NEW IDSEG ADDR., TO PRESERVE DON'T COPY * FLAG, AND TO SKIP ERR 23 IF DISC ADDRESSES MATCH * 9) 2-22-79 TO REMOVE ID SEGMENT IF EMA PGM AND NO ID EXTENSIONS * ARE AVAILABLE * 10) 7-26-79 TO RESTORE TIME LIST WORD (WD 18) SST #4429 * 11) 10-16-79 TO TEST IF PROTECTED TYPE 6 PGM BEFORE RESTORING * 12) 12-19-79 TO :RP FROM ANY CARTRIDGE. IF TYPE 6 NOT ON LU * 2 OR 3 THEN COPY INTO POOL TRACKS (FAKE A TEMPORARY * PROGRAM LOAD). THIS SUBROUTINE WAS MADE BY * MODIFYING THE 2001 REV. OF <IDRPL>. (DCL) * 13) 12-27-79 FIXED ORIGINAL BUG IN <IDRPL>. DIDN'T SETUP * "DONÛÄ������þú'T COPY" BIT IN IDSEG CORRECTLY. (DCL) * 14) 3-5-80 CLEANED UP FOR RELEASE (DCL) * * SUP PRESS EXTRANEOUS LISTINGS * ENT IDRP 791219 EXT EXEC,.ENTR,$LIBR,$LIBX,IDSGA,NAM..,$OPSY,$IDEX EXT .OWNR,$SMCA,$SMGP,$SMID,ISMVE,SESSN A EQU 0 B EQU 1 KEYWD EQU 1657B RTDRA EQU 1750B 780106 GLM BGDRA EQU 1754B 780106 GLM TATLG EQU 1755B 780106 GLM TAT EQU 1656B TAT BASE ADDR 791219 TATSD EQU 1756B # TRACKS ON LU2 791219 SECT2 EQU 1757B # SECTORS/TRACK ON LU2 791219 SECT3 EQU 1760B # SECTORS/TRACK ON LU3 791219 BPA1 EQU 1742B XEQT EQU 1717B EQTA EQU 1650B SKP * * PURPOSE: * * TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. * AND TO ALLOW THE TYPE 6 FILE TO RESIDE ON ANY CARTRIDGE. * IF THE TYPE 6 FILE IS ON LU2 OR LU3 THEN AN ID SEGMENT IS * CONSTRUCTED WHICH POINTS DIRECTLY TO THE TYPE 6 FILE. * IF THE TYPE 6 FILE IS NOT ON LU2 OR LU3, THE PROGRAM IMAGE PART * OF THE FILE IS COPIED INTO SYSTEM POOL TRACKS AND AN ID SEGMENT * IS CONSTRUCTED WHICH POINTS TO THESE TRACKS. (THIS SIMULATES * A TEMPORARY PROGRAM LOAD.) * * CALLED: * * CALL IDRP (IDCB,IERR,NAME,IBUF,IBUFL,NID) * -OR- * IF (IDRP (IDCB,IERR,NAME,IBUF,IBUFL,NID).NE.0) GO TO IERROR * * WHERE: * * IERR = RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * IDCB = AN OPEN DCB OF THE TYPE 6 FILE * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT * IBUF = BUFFER FOR DISK TRANSFER IF FILE IS NOT ON LU2 OR LU3 * IBUFL= LENGTH OF "IBUF" (MUST BE AT LEAST 64 WORDS, * BUT SHOULD BE LARGE FOR EFFICIENT TRANSFERS) * NID = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT * * SKELETON ID: (1ST 37 €´������þúWORDS IN FILE) * * ID(1) = NOT USED, NOR CHANGED IN SYSTEM * ID(2) - ID(6) = XTEMP(1) - XTEMP(5) IN DEFAULT CASE. (I.E. '*RU,PROG') * ID(7) = PRIORITY OF PROGRAM IF PROGRAM TYPE IS 2 OR 3, ELSE NOT USED * ID(8) = ENTRY ADDRESS OF PROGRAM * ID(9) - ID(12) = NOT USED (ID(11) 'XB' IS SET TO XTEMP(1)) * ID(13) - ID(14) = NOT USED * ID(15) = PROG TYPE BITS 0-3, BITS 4-15 NOT USED * ID(16) - ID(21) = NOT USED (ID(19),ID(20) = 25000B,177574B) * ID(18) = TIME PARAMETERS * ID(22) = 0 IF RTE-II, ??? IF RTE-III. (SEE RTE-III MANUAL) * ID(23) = LOW MAIN MEMORY LOAD ADDRESS * ID(24) = HI MAIN MEMORY LOAD ADDRESS + 1 * ID(25) = LOW BASE PAGE LOAD ADDRESS * ID(26) = HI BASE PAGE LOAD ADDRESS + 1 * ID(27) = DISC ADDR - LU(15),TRK(14-7),SECTOR(6-0) * ID(28) = NOT USED * ID(29) = EMA SIZE (BITS 0-9), ID EXT# (BITS 10-15) * ID(30) = HI-ADDR + 1 OF LARGEST SEGMENT * ID(31) = * ID(32) = * ID(33) = * ID(34) = ARITHMETIC SUM OF ID(1) THRU ID(33) * ID(35) = SYSTEM SET UP CODE (SUM 1650-1657 + 1742-1764) * ID(36) = ID EXTENSION WORD 0 * ID(37) = ID EXTENSION WORD 1 * ID(39) = USER ID REQUIRED TO RUN OR RP IF SIGN BIT SET * ID(40) = GROUP ID REQUIRED TO RUN OR RP IF SIGN BIT SET * ID(41) = CAPABILITY LEVEL REQUIRED TO RUN OR RP * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR SPL FRETURN) * IERR = -1 > DISC ERROR * IERR = -11 > IDCB NOT OPEN * IERR = 14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE * IERR = -15 > ILLEGAL NAME * IERR = 16 > FILE NOT ON DISC LU = 2 OR LU = 3 * AND INSUFFICIENT SYSTEM POOL TRACKS * AVAILABLE FOR COPY * IERR = 19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY. * IERR = 23 > DUPLICATE PROGRAM NAME. * IERR = 75 > TYPE 6 PGM IS PROTECTED ON USER ID * IERR = 76 > TYPE 6 PGM IS PROTECTED ON GROUP ID * IERR = 77 > TYPE 6 PGM IS PROTECTED ON CAh ������þúPABILITY LEVEL * IERR = 78 > IBUFL < 64 WORDS OR INTERNAL CONSISTENCY * CHECKS HAVE FAILED. CAN'T RP PROGRAM. * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) IDRP DOES NOT CLOSE THE FILE. * (3) RECOMMEND FILE BE NON-EXCLUSIVELY OPENED * (4) E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL) * (5) ONLY THE 1ST 10 WORDS OF THE DCB ARE USED BY THIS SUBROUTINE. * * TEST PROGRAM: *FTN,L * PROGRAM TYRP(2,99) * DIMENSION NAME(3),LU(5),NUNAM(3),IDCB(144),IBUF(6144) * DATA IBUFL/6144/ * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT PROGRAM FILE NAME? _") * READ (LU,12) NAME * IF (NAME.EQ.2H/E) GO TO 9999 * WRITE (LU,13) * 13 FORMAT ("INPUT NEW NAME FOR PROG? _") * READ (LU,12) NUNAM * IF (NUNAM.EQ.2H/E) GO TO 9999 * 12 FORMAT (3A2) * IF(OPEN(IDCB,IERR,NAME,1).LT.0) GO TO 33 * IF(IDRP(IDCB,IERR,NUNAM,IBUF,IBUFL).EQ.0) GO TO 9999 * 33 WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 END * END$ SKP IDCB NOP OPEN DCB ADDRESS IERR NOP RETURNED ERROR CODE NAME NOP FIVE CHAR ASCII NAME TO GIVE PROGRAM IBUF NOP DISK TRANSFER BUFFER 791219 IBUFL NOP DISK TRANSFER BUFFER LENGTH 791219 NID NOP ADDRESS OF NEW ID SEGMENT * IDRP NOP ENTRY JSB .ENTR DEF IDCB * CCA SET FLAG TO INDICATE 791219 STA ITRAK NO POOL TRACKS ALLOCATED YET 791219 * LDA IDCB,I GET TRACK-LU WORD FROM DCB LDB IDCB CALCULATE FILE TRACK/SECTOR WORD ADB O3 ADDRESSES STB DCB3 INB STB DCB4 AND SET INTO EXEC CALL ADB O4 BUMP TO SECT/TRACK WORD STB DCB8 AND SAVE IDCB(9) ADDRESS 791219 CCE,INB PRMÄ������þúEPARE E-REG IN CASE OF ERROR LDB B,I GET OPEN FLAG CPB XEQT DCB OPEN? RSS YES, CHECK DISC LU JMP ERR11 NO, ERROR -11 AND O77 MASK TO JUST LU OF DISC STA DLU SAVE DISK LU # 791219 IOR PRC MERGE IN PRIVILEDGED CODE STA FDLU SAVE FOR EXEC CALL 791219 AND O77 TAKE IT OUT CLE,ERA SAVE LU=2 OR LU=3 FLAG IN E-REG CPA O1 CHECK IF EQUAL TO 2 OR 3? ERA,SLA YES, PUT FLAG IN BIT 15 & SKIP CLA NO, FILE NOT ON LU 2 OR 3 <IGNORE> 791219 STA TEMP1 SAVE DISC LU FOR LATER USE JSB EXEC READ 1ST 41 WORDS OF FILE DEF *+7 DEF O1 READ DEF FDLU DISC LU 791219 DEFID DEF IDBUF DESTINATION BUFFER ADDRESS DEF D41 BUFFER LENGTH DCB3 DEF * DISC TRACK DCB4 DEF * DISK SECTOR CLA,CCE JSB SUM CALCULATE CHECKSUM DEF IDBUF OF THE 1ST 33 WORDS OF FILE DEC -33 CPA ID+34 EQUAL TO WORD 34? CLA,RSS YES JMP ERR19 NO JSB SUM 1650B TO 1657B DEF EQTA DEC -8 JSB SUM 1742B TO 1747B 780106 GLM DEF BPA1 780106 GLM OCT -6 780106 GLM JSB SUM 1755B TO 1764B 780106 GLM DEF TATLG 780106 GLM DEC -8 780106 GLM * * IF NOT RTE-IV, WE MUST INCLUDE LOCATIONS 1750B TO 1754B. 780106 GLM * LDB $OPSY FETCH SYSTEM 780106 GLM CPB M9 IF RTE-IV 780106 GLM JMP IDOK? THEN JUST CHECK IT. 780106 GLM * JSB SUM 780106 GLM DEF RTDRA INCLUDE 1750B TO 1754B (ª`������þúRTE-II&III ONLY)780106 GLM OCT -5 780106 GLM * IDOK? CPA ID+35 COMPARE? JMP DORP YES, CONTINUE ERR19 LDA D19 NO, FMGR ERROR 19 JMP EREXT ERR01 CCA DISK ERROR 800305 JMP EREXT 800305 ERR75 LDA D75 TYPE 6 PGM IS PROTECTED ON USER ID JMP EREXT ERR76 LDA D76 TYPE 6 PGM IS PROTECTED ON GROUP ID JMP EREXT ERR77 LDA D77 TYPE 6 PGM IS PROTECTED ON CAPABILITY LEVEL JMP EREXT ERR78 LDA D78 INTERNAL CONSISTENCY CHECK FAILED 800305 JMP EREXT 800305 ERR11 LDA D11 CMA,INA,RSS MAKE NEGATIVE ERR16 LDA O20 GET DEC 16 EREXT CCE ERROR EXIT E-REG = 1 EXIT STA IERR,I TELL CALLER RETURN CODE * STA TEMP1 SAVE A-REG 791219 ELA 791219 STA TEMP2 SAVE E-REG 791219 * * RELEASE ANY TRACKS THIS SUBROUTINE HAS ALLOCATED * WHICH IS STILL OWNS. * LDA ITRAK LOAD TRACK ALLOCATE FLAG 791219 SSA TRACKS ALLOCATED? 791219 JMP .L2 -NO 791219 * JSB EXEC RELEASE TRACKS 791219 DEF *+1+4 791219 DEF O5 791219 DEF NTRAK 791219 DEF ITRAK 791219 DEF IDISC 791219 * .L2 LDA TEMP2 791219 ERA RESTORE E-REG 791219 LDA TEMP1 RESTORE A-REG 791219 * CLB STB ˜ô������þúNID CLEAR OPTIONAL PARAMETER JMP IDRP,I RETURN IERR = A-REG SPC 1 DORP LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE SAVE FOR LOADA,STORA ROUTINES *780403* LDA DCB3,I GET START TRACK NUMBER *780403* LSL 7 PUT IN BITS 7-14 OF A-REG LDB DCB4,I GET STARTING SECTOR NUMBER ADB O2 BUMP TO SECOND BLOCK OF FILE CPB DCB8,I CHECK IF TRACK CROSSING?(IDCB(9)) 791219 LDB O200 YES, BUMP TRACK>SET SECTOR=0 ADA B MERGE SECTOR OR BUMP TRACK IOR TEMP1 MERGE IN DISC LU STA ID+27 PUT IN THE SKELETON IDSEG SPC 1 LDA ID+18 GET TIME LIST WORD STA DEFTM+3 SAVE IT LDA ID+15 GET PROGRAM TYPE AND O7 MASK DOWN TO 2,3 OR 5 STA ID+1 SPC 1 LDB D99 SET PRIORITY TO 99 IF CPA O5 PROGRAM IS TYPE 5 STB ID+7 SPC 1 * CHECK THAT NAME IS AS LEGAL AS A FILE NAME SPC 1 JSB NAM.. USE FMP NAME CHECKING ROUTINE DEF *+2 DEF NAME,I SZA NAME OK? JMP EREXT NO, FMGR ERROR -15 SPC 1 * THE FOLLOWING CODE TESTS WHETHER THE TYPE 6 PROGRAM IS PROTECTED * BY A USER ID, A GROUP ID, OR BY A MINIMUM CAPABILITY LEVEL SPC 1 JSB SESSN CHECK IF IN SESSION DEF *+2 DEF XEQT ID SEGMENT ADDRESS SEZ IN SESSION (E=0)? JMP PRIV NO, SO SKIP TESTS SPC 1 STB SESWD SAVE ID SEGMENT SESSION WORD JSB ISMVE GET USER ID FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMID SCB OFFSET TO USER ID DEF TEMP RETURN CALLER'S USER ID DEF O1 ONE WORD LDA TEMP CHECK CALLER'S USER ID CPA O7777 SYSTEM MANAGER? JMP PRIV YES, SO ALLOW RP SPC ì9������þú1 LDA ID+39 GET USER ID FROM TYPE 6 FILE, WORD 39 ELA ISOLATE SIGN BIT (SET MEANS USER ID MUST MATCH) SEZ,RSS SIGN BIT SET? JMP GTGID NO, NOT PROTECTED ON USER ID SPC 1 CLE,ERA CLEAR SIGN BIT FROM USER ID WORD CPA TEMP DOES USER ID REQUIRED MATCH CALLER'S USER ID? JMP GTCAP YES, NOW CHECK IF MINIMUM CAPABILITY REQUIRED JMP ERR75 NO, ERROR - TYPE 6 PGM PROTECTED BY USER ID SPC 1 GTGID LDA ID+40 GET GROUP ID FROM TYPE 6 FILE, WORD 40 ELA ISOLATE SIGN BIT (SET MEANS GROUP ID MUST MATCH) SEZ,RSS SIGN BIT SET? JMP GTCAP NO, NOT PROTECTED ON GROUP ID SPC 1 JSB ISMVE GET GROUP ID FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMGP SCB OFFSET TO GROUP ID DEF TEMP RETURN CALLER'S GROUP ID DEF O1 ONE WORD LDA ID+40 GET GROUP ID FROM TYPE 6 FILE ELA,CLE,ERA CLEAR SIGN BIT CPA TEMP DOES GROUP ID REQUIRED MATCH CALLER'S GROUP ID? RSS YES, NOW CHECK IF MINIMUM CAPABILITY REQUIRED JMP ERR76 NO, ERROR - TYPE 6 PGM PROTECTED BY GROUP ID SPC 1 GTCAP JSB ISMVE GET CAPABILITY FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMCA SCB OFFSET TO CAPABILITY DEF TEMP RETURN CALLER'S CAPABILITY DEF O1 ONE WORD LDA TEMP USER'S CAPABILITY LEVEL CMA ADA ID+41 SSA,RSS CALLER'S CAPABILITY GREATER OR EQUAL? JMP ERR77 NO, ERROR - INSUFFICIENT CAPABILITY SPC 1 * GO PRIVILEDGED TO PREVENT CONFLICTS WITH OTHER PROGRAMS OF DIFFERENT * PRIORITY USING THIS SUBROUTINE. SPC 1 * IF TYPE 6 FILE IS ON LU2 OR LU3 THEN SKIP SPECIAL PROCESSING * PRIV LDA DLU A = DISK LU OF TYPE 6 FILE 791219 CPA O2 IF DISK LU = 2 q������þú 791219 RSS OR 791219 CPA O3 IF DISK LU = 3 791219 JMP PRIV2 THEN SKIP SPECIAL PROCESSING 791219 * JSB $LIBR GO PRIVILEDGED TO PREVENT NOP CONFLICTS WITH OTHER ROUTINE USING SAME SUB SPC 1 JSB FIDSG CHECK ID SEG AVAILABILITY 791219 RSS -MAYBE ALREADY RP'D 791219 JMP COPYF -ID SEG IS AVAILABLE 791219 * * AT THIS POINT EITHER: * * 1) (A=23, E=1) THERE EXISTS AN ID SEGMENT WITH THE SAME * NAME, BUT WHOSE DISK ADDRESS WORD DOES NOT POINT TO OUR * TYPE 6 FILE. * => RETURN FMGR ERROR 23: DUPLICATE PROGRAM NAME * * 2) (A=E=0) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME * AND WHOSE DISK ADDRESS WORD SEEMS TO POINT TO OUR TYPE 6 * FILE. * IF TYPE 6 FILE IS ON LU2 OR LU3 THEN THIS FILE IS * ALREADY RP'D. * => RETURN SUCCESS * ELSE DISK ADDRESS WORD CAN'T POINT TO OUR TYPE 6 FILE. * => RETURN FMGR ERROR 23: DUPLICATE PROGRAM NAME * LDB DLU B = DISK LU OF FILE 791219 SZA,RSS IF A = NON-ZERO ERROR THEN DO ERROR RETURN 791219 CPB O2 FILE ON LU2 ? 791219 RSS OR 791219 CPB O3 IS FILE ON LU3 ? 791219 JMP PEXIT -YES, RETURN A & E = STATUS 791219 * * TYPE 6 FILE NOT ON LU2 OR LU3, => DUPLICATE PROGRAM NAME * LDA D23 A = ERROR = 23 791219 CCE E = ERROR = 1 791219 JMP PEXIT RETURN 791219 * * * WE'RE GOING TO COPY THE PROGRAM IMAGE PART OF THE TYPE 6 FILE * INTO SYSTEM POOL TRACKS TO MAKE IT LOOK LIKE A TEMPORARY LOAD. * * * COMPUTE MINIMUÒy������þúM NUMBER OF SECTORS PER TRACK ON TRACK POOL DISKS * BECAUSE WE DON'T KNOW WHICH DISK OUR POOL TRACKS WILL COME FROM. * COPYF JSB $LIBX GO UNPRIVILEDGED 791219 DEF *+1 791219 DEF *+1 791219 * LDA SECT2 A = # SECTORS/TRACK ON LU2 791219 STA SECTR SAVE AS DEFAULT MINIMUM 791219 * CMA,INA CALCULATE DIFFERENCE BETWEEN 791219 ADA SECT3 LU2 & LU3 SECTORS/TRACK 791219 LDB SECT3 791219 SZB,RSS IS THERE AN LU3? 791219 JMP .L1 -NO 791219 SSA FEWER SECTORS/TRACK ON LU3 ? 791219 STB SECTR -YES, SET NEW MINIMUM 791219 * .L1 EQU * 791219 * * USE MINIMUM NUMBER OF SECTORS/TRACK TO CALCULATE HOW MANY * TRACKS TO ASK FOR, = (FILE SIZE) - (2 SECTORS OF DCB INFO) * * ***** ASSUME FILE IS NOT AN "EXTENDED FILE" ***** * ***** WHOSE FILE SIZE IS IN "CHUNKS". ***** * LDA IDCB 791219 ADA O5 CALCULATE ADDR OF IDCB(6) 791219 * LDA A,I A = FILE SIZE (SECTORS) 791219 ADA M2 IGNORE DCB INFO SECTORS 791219 STA PSIZE SAVE PROGRAM SIZE (SECTORS) 791219 * CLB (B = 0 FOR DIVISION) 791219 DIV SECTR CALCULATE MAX # TRACKS REQUIRED 791219 SZB PARTIAL TRACK? 791219 INA -YES, ROUND UP 791219 IOR O1S SET NO WAIT BIT 791219 STA NTRAK SAVE FOR ALLOCATION CALL 791219 * * ALLOCATE POO;›������þúL TRACKS * (ALLOCATE LOCALLY FOR NOW IN CASE WE'RE ABORTED) * JSB EXEC REQUEST TRACKS 791219 DEF *+1+5 791219 DEF O4 791219 DEF NTRAK (# TRACKS REQUESTED) 791219 DEF ITRAK (RETURNED STARTING TRACK ADDR) 791219 DEF IDISC (RETURNED DISK LU #) 791219 DEF ISETR (RETURNED # SECTORS/TRACK) 791219 * LDA ITRAK 791219 SSA DID I GET TRACKS? 791219 JMP ERR16 -NO, ERROR RETURN 791219 * LDA NTRAK LOAD # TRACKS REQUESTED 791219 AND MASK CLEAR SIGN (NO ABORT) BIT 791219 STA NTRAK SAVE # TRACKS RECEIVED 791219 * * RETURN ANY UNNEEDED DISK SPACE * LDA PSIZE A = PROGRAM SIZE (SECTORS) 791219 CLB (B = 0 FOR DIVISION) 791219 DIV ISETR CALCULATE # TRACKS ACTUALLY REQUIRED 791219 SZB PARTIAL TRACK? 791219 INA -YES, ROUND UP 791219 STA TEMP1 SAVE FOR LATER 791219 * CMA,INA NEGATE 791219 ADA NTRAK A = # EXTRA TRACKS RECEIVED 791219 SZA,RSS EXTRA TRACKS? 791219 JMP NRLSE -NO, SO DON'T RETURN ANY 791219 * SSA IF # EXTRA TRACKS < 0 800305 JMP ERR78 THEN NOT ENOUGH TRACKS ?!?! 800305 * STA NTRAK SAVE # EXTRA TRACKS 791219 * LDA TEMP1 A = # TRACKS ACTUALLY NEEDED 791219 ADA ITRAK CALCULATE STARTING TRACK TO RETURN 791219 •������þú STA TEMP2 SAVE FOR SYSTEM CALL 791219 * JSB EXEC RETURN THE EXTRA TRACKS 791219 DEF *+1+4 791219 DEF O5 791219 DEF NTRAK 791219 DEF TEMP2 791219 DEF IDISC 791219 * LDA TEMP1 LOAD ACTUAL # OF TRACKS TO USE 791219 STA NTRAK SAVE 791219 * NRLSE EQU * * * * * UPDATE SKELETON ID SEGMENT DISK ADDRESS WORD * TO POINT TO POOL TRACKS. * * * CONSTRUCT DISK LU PART OF ADDRESS WORD (SIGN BIT) * CCA A = -1 (FOR PARANOID CHECK) 791219 LDB IDISC B = POOL TRACK DISK LU 791219 * CPB O2 LU2 ? 791219 CLA -YES, CLEAR SIGN BIT 791219 * CPB O3 LU3 ? 791219 LDA O1S -YES, SET SIGN BIT 791219 * SLA PARANOID CHECK: LU2 OR LU3 ? 791219 JMP ERR78 -NO, BARF 800305 * * INCLUDE TRACK ADDR IN BITS 14-7 * (SECTOR ADDR = 0 IN BITS 6-0) * LSR 7 POSITION 791219 IOR ITRAK INCLUDE TRACK ADDR 791219 LSL 7 POSITION BACK 791219 STA ID+27 SET INTO SKELETON ID SEGMENT 791219 * * * * COPY THE PROGRAM IMAGE FROM THE TYPE 6 FILE INTO * THE SYSTEM POOL TRACKS. * * (IGNORE THE FIRST TWO SECTORS OF THE FILE WHICH * CONTAIN ID SEGMENT INFORMATION.) * * * * SETUP SOURCE PARAMETER ARRAY FOR SUBROUTINE <ZXFER> * LDB DCB3,I LOAD FILE TRACK ADDR 791219 STB .TRKI SAœŸ������þúVE 800305 * LDA DCB4,I LOAD FILE SECTOR ADDR 791219 ADA O2 SKIP ID SEG INFO 791219 STA .SECI SAVE 800305 * CPA DCB8,I TRACK CROSSING? 791219 RSS -YES 791219 JMP NOCRS -NO 791219 * ISZ .TRKI INCREMENT TRACK ADDRESS 800305 CLA ZERO THE 791219 STA .SECI SECTOR ADDRESS 800305 * NOCRS EQU * 800305 * * SETUP DESTINATION PARAMETER ARRAY FOR SUBROUTINE <ZXFER> * LDA ITRAK 791219 STA .TRKO TRACK ADDRESS 800305 * CLA 791219 STA .SECO SECTOR ADDRESS 800305 * * SET UP OTHER INFO FOR SUBROUTINE <ZXFER> * LDA PSIZE GET PROGRAM SIZE (SECTORS) 791219 STA .NSCI SAVE AS COPY SIZES 800305 STA .NSCO 800305 * * CALL SUBROUTINE <ZXFER> TO DO THE TRANSFER * FILOP JSB ZXFER READ FROM FILE 800305 DEF *+1+8 800305 DEF O1 (1:READ 2:WRITE) 800305 DEF FDLU (DISK LU) 791219 DEF IBUF,I (BUFFER) 791219 DEF IBUFL,I (BUFFER LENGTH) 791219 DEF .TRKI (TRACK ADDRESS) 800305 DEF .SECI (SECTOR ADDRESS) 800305 DEF .NSCI (# SECTORS TO COPY) 800305 DEF DCB8,I (# SECTORS PERq¼������þú TRACK) 791219 * JSB ZXFER WRITE TO POOL TRACKS 800305 DEF *+1+8 800305 DEF O2 800305 DEF IDISC 791219 DEF IBUF,I 791219 DEF IBUFL,I 791219 DEF .TRKO 800305 DEF .SECO 800305 DEF .NSCO 800305 DEF ISETR 791219 * * IF NOT DONE WITH COPY THEN LOOP * LDA .NSCO LOAD # SECTORS LEFT TO COPY 800305 SZA DONE ? 800305 JMP FILOP -NO, LOOP 800305 * * * * GET ID SEGMENT AND SETUP TO POINT TO FILE OR POOL TRACKS * PRIV2 JSB $LIBR GO PRIVILEDGED TO PREVENT 791219 NOP CONFLICTS WITH OTHER ROUTINES 791219 * JSB FIDSG CHECK ID SEG AVAILABILITY: 791219 JMP PEXIT -ALREADY RP'D 791219 * LDB ID+29 GET ID SEG EMA WORD 800305 LDA $OPSY GET OP SYSTEM IDENTIFIER 800305 * CPA M9 IF RTE-IV 800305 SZB,RSS AND PROGRAM USES EMA 800305 RSS THEN 800305 JSB FIDEX GET AN ID SEG EXTENSION 800305 * * WE GOT AN ID SEGMENT, LET'S GO... * * FIRST, IF WE COPIED THE FILE INTO SYSTEM POOL TRACKS, * WE MUST ASSIGN OWNERSHIP OF THE TRACKS TO THE SYSTEM * SO THAT THIS WHOLE THING LOOKS JUST LIKE A TEMPORARY * PROGRAM LOAD. TO DO THIS WE MODIFY THE TAT (TRACK * ASSIGNMENT TABLE) WHILE IN PRIVILEDGÔy������þúED MODE. * LDA B1000 INITIALIZE THE 791219 STA CPY "I'M A COPY" BIT FLAG 791219 * LDA ITRAK LOAD POOL TRACK ADDRESS 791219 SSA WERE POOL TRACKS ALLOCATED? 791219 JMP TRDON -NO, SKIP SPECIAL PROCESSING 791219 * * CALCULATE INDEX INTO TAT * CLB OFFSET = 0 791219 LDA IDISC A = POOL TRACK DISK LU 791219 CPA O3 LU3 ? 791219 LDB TATSD -YES, OFFSET = # TRACKS ON LU2 791219 ADB TAT ADD TAT BASE ADDR 791219 ADB ITRAK ADD STARTING TRACK NUMBER 791219 * * CHANGE OWNERSHIP OF TRACKS IN TAT * LDA NTRAK LOAD # TRACKS 791219 CMA,INA NEGATE 791219 STA TEMP2 SAVE FOR LOOP COUNTER 791219 * LDA O1S A = SYSTEM OWNERSHIP FLAG 791219 * TROWN JSB STORA CHANGE TAT OWNERSHIP FOR A TRACK 791219 INB INCREMENT TAT ADDR 791219 ISZ TEMP2 DONE WITH TRACKS? 791219 JMP TROWN -NO, LOOP 791219 * CCA SET FLAG TO INDICATE WE NO 791219 STA ITRAK LONGER HAVE TRACKS ALLOCATED 791219 * CLA CLEAR THE "I'M A COPY" FLAG SO THAT 791219 STA CPY TRACKS WILL BE RELEASED ON PROG :OF 791219 * TRDON EQU * * * SPC 1 * FOUND BLANK IDSEG, SET IT UP SPC 1 LDA DID32,I GET IDSEG WORD32 *791227 AND B2000 EXTRACT DON'T COPY BIT *791227 STA NOCPY SAVE IT *791227 * JSB .OWNR FETCH THE OWNER ID *780920* Ï–������þú IOR CPY AND SET "I'M A COPY" FLAG *780920*791219 STA OWID SAVE FOR ID BUILD *780920* LDB ID+17 GET IDSEG(1) ADDRESS *780403* JSB LOADA *780403* STA B *780403* STA NID,I SAVE ADDRESS OF NEW ID SEGMENT LDA TEMP RESTORE TRACK INDICATOR *780403* CLE,SZA NOW MOVE INTO SYSTEM JMP SHOR1 SHORT ID, SKIP SOME OF MOVE CCE,INB BUMP TO XTEMP STB ID+11 SET UP XB WORD LDA DEFZ ZERO THE 5 XTEMP WORDS JSB MOVE MOVE TO THE BLANK ID SEG. OCT 5 LDA DEFID GET BUFFER ADA D6 OFFSET TO 7TH WORD LDA A,I GET CONTENTS AND JSB STORA RESTORE TO BLANK ID SEG. *780403* INB BUMP DESTINATION ADDRESS ISZ ID+18 SPC 1 * E-REG = 0 FOR LONG ID, E-REG=1 FOR SHORT ID SPC 1 RSS SHOR1 ADB D11 CORRECT FOR SHORT ID LDA ID+8 GET PROGRAM ENTRY POINT ADDRESS JSB STORA AND PUT *780403* SEZ,INB,RSS BUMP TO ID(9) IF LONG JMP SHOR2 YES, SHORT ID LDA DID9 GET DEF TO ID(9) JSB MOVE MOVE ID(9) TO ID(12) O4 OCT 4 SHOR2 STB ADNAM SAVE ADDRESS OF IDSEG WORD 13 (NAME) LDA NAME GET NAME(1) JSB MOVE MOVE NAME(1),NAME(2) O2 OCT 2 LDA ID+18,I GET NAME(3) AND OM400 MASK OFF 6TH CHAR XOR ID+15 MERGE IN PROGRAM TYPE AND OM20 MASK OFF BITS 4-15 XOR ID+15 IOR O200 PUT IN TEMP BIT SEZ,RSS CHECK IF SHORT ID BIT IOR O20 PUT IN SHORT ID IF SHORT JSB STORA STORE ID(15) *780403* SEZ,INB,RSS ZERO OUT ID(16),ID(17) JMP SHOR3 SKIP IF SHORT ID LDA DEFTM MOVE SIX WORDS JSB MOVE INTO IDSEG(16) - IDSEG(21) D6 DEC ï������þú6 LDA ID+22 GET THE RTE-III THING JSB STORA IDSG(22)! CALLER BETTER KNOW P'S,Q'S *"* INB POINT ID(23) SHOR3 LDA DID23 GET ADDRESS OF LOW MAIN ADDRESS JSB MOVE A-REG = SOURCE ADDRESS, B-REG=DEST O5 OCT 5 NUMBER OF WORDS TO MOVE CLA,SEZ,CCE,RSS IF SHORT ID (E=0), JMP ERR14 THEN DONE JSB STORA ZERO ID(28) FOR LONG ID *780403* * * CHECK PROGRAM TYPE (SAVED IN ID+1). IF PROGRAM SEGMENT * (TYPE = 5), SKIP THE ID EXTENSION WORK. *780407* * LDA ID+1 FETCH PROG TYPE *780407* CPA O5 IF SEGMENT, *780407* JMP CNT.5 SKIP ID EXT WORK *780407* * SPC 1 LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? JMP CONT1 YES, SAVE RTE-IV WORDS CNT.5 CLA RESET A (E=1 !!!) JMP ERR14 EXIT CONT1 INB POINT TO ID(29) STB NEWID SAVE DESTINATION ADDRESS * LDA ID+29 GET ID SEG EMA WORD 800305 SZA,RSS PROGRAM USES EMA ? 800305 JMP NOEMA -NO, EMA WORD IS ZERO * * PROGRAM USES EMA. SETUP THE ID SEG EXTENSION * LDA INDX GET FOUND ID SEG EXT # 800305 CLB *780403* RRR 6 RESTORE ID EXT# TO HIGH 6 BITS *780403* * *780403* LDA DID29,I GET ID SEGMENT EMA WORD AND O1777 MASK OFF HIGH 6 BITS IOR B MERGE TO CREATE NEW EMA WORD LDB NEWID *780403* JSB STORA RESTORE TO NEW ID SEGMENT (29) *780403* ISZ NEWID BUMP DESTINATION ADDRESS LDA DID36 RESTORE ID EXTENSION WORDS LDA A,I GET SAVED ID EXT WORD 0 *780403* LDB IDEXT *780403* JSB STORA SAVE¨6������þú IN NEW ID EXT WORD 0 *780403* INB BUMP TO NEXT WORD OF NEW ID EXT *780403* LDA DID36 *780403* INA POINT TO ID(37) LDA A,I GET SAVED ID EXT WORD 1 *780403* JSB STORA SAVE IN NEW ID EXT WORD 1 *780403* INB BUMP TO WORD 2 OF NEW ID EXT *780403* CLA *780403* JSB STORA ZERO NEW ID EXT WORD 2 *780403* LDB NEWID SET UP ID30 ADDRESS *780508* JMP SETUP CONTINUE SPC 1 NOEMA LDB NEWID *780403* JSB STORA ZERO EMA WORD IN NEW ID SEG *780403* INB BUMP POINTER TO NEW ID SEGMENT *780403* SETUP LDA DID29 POINTER TO ID(29) INA BUMP TO ID(30) LDA A,I GET SAVED HI-ADDR+1 OF SEGMENT *780403* JSB STORA RESTORE TO NEW ID SEGMENT *780403* INB BUMP POINTER TO NEW ID SEG *780403* CLA JSB STORA ZERO ID(31) *780403* INB *780403* JSB LOADA FETCH ID 32 *780920* AND B170K SAVE SEQUENCE COUNTER *780920* IOR OWID MERGE IN COPY FLAG *780920* IOR NOCPY MERGE IN DONT' COPY BIT JSB STORA RESTORE ID 32 *780920* INB *780403* CLA JSB STORA ZERO ID(33) *780403* ERR14 SEZ,CME,RSS CHANGE SO E=1, IF ERROR, ELSE = 0 LDA D14 RETURN IDSEGMENT NOT FOUND PEXIT JSB $LIBX DONE A=0,E=0 FOR GOOD EXIT DEF *+1 DEF EXIT SKP * * * SUBROUTINE TO FIND AN AVAILABLE, SUITABLE ID SEGMENT * * * CALLING ROUTINE MUST BE PRIVILEDGED: * * JSB $LIBR * NOP * JSB FIDSG * <RETURN: DUPLICATE PROGRAM NAME> * ¿[������þú<RETURN: SUCCESS> * * OTHER POSSIBLE SUBROUTINE EXITS: * * JMP ERR14 (IF NO BLANK ID SEGMENTS) * * * RETURNED PARAMETERS: * * <SUCCESS RETURN>: * ADDRESS OF KEYWD BLOCK ENTRY FOR FOUND ID SEGMENT * RETURNED IN ID+17 * TEMP CONTAINS THE TRACKS & LONG/SHORT ID SEG INDICATOR * * <DUPLICATE PROGRAM NAME RETURN>: EITHER * (A=23,E=1) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME, * BUT WHOSE DISK ADDRESS WORD DOES NOT MATCH ID+27. * (A DIFFERENT PROGRAM WITH THE SAME NAME.) * (A=E=0) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME, * AND WHOSE DISK ADDRESS WORD MATCHES ID+27. * (THIS PROGRAM IS ALREADY RP'D.) * * FIDSG NOP JSB IDSGA SEARCH FOR NAME ALREADY EXISTS DEF *+2 DEF NAME,I SEZ,CME IF NOT FOUND, CLEAR E-REG & A-REG JMP SERCH AND GO FIND A BLANK IDSEGMENT STA NID,I RETURN ADDR OF NEW ID SEGMENT ADA D26 OFFSET TO DISC ADDRESS WORD (ID27) STA B SAVE IN B JSB LOADA GET DISC ADDRESS TO A CPA ID+27 COMPARE WITH ADDRESS OF TYPE 6 FILE JMP LABL1 MATCH, SO RETURN AS IF WE DID IT LDA D23 NO MATCH, ERROR 23 CCE,RSS RETURN WITH E=1 LABL1 CLA,CLE GOOD RETURN, A=E=0 JMP FIDSG,I SPC 1 * BLANK ID'S ARE SEARCHED IN FOLLOWING PRECEDENCE * * TYPE 2 OR 3 PROG TYPE 5 PROG (SEGMENT) * 1)LONG BLANK WITHOUT TRACKS 1)SHORT BLANK WITHOUT TRACKS * 2)LONG BLANK & DON'T CARE 2)LONG BLANK WITHOUT TRACKS * <RETURN FMGR ERROR 14> 3)SHORT BLANK & DON'T CARE IF HAS TRACKS * 4)LONG BLANK & DON'T CARE IF HAS TRACKS * <RETURN FMGR ERROR 14> SPC 1 LOOP1 LDA ID+16 GET LONG/SHORT ID FLAG (0/20B) SEZ,SZA,RSS IF DOWN TO LONG BLANK & DONT CARE JMP ERR14 THEN GÍÿ������þúET OUT FMGR ERROR 14 SPC 1 SERCH SZA,RSS TOGGLE E-REG WHEN A= 0 CME LDB ID+1 GET PROGRAM TYPE CPB O5 CAN IT HAVE A SHORT ID? XOR O20 YES, THEN CHANGE SEARCH TO OTHER KIND STA ID+16 AND PUT BACK IN TEMP LDA KEYWD RESET FOR KEYWORD SEARCH STA ID+17 RSS SKIP 1ST ISZ SPC 1 * ID+16=0 > SEARCH LONG ID ID+16=20B > SEARCH SHORT ID * E-REG=1 > SEARCH ID WITHOUT TRACKS E-REG=0 > DON'T CARE ABOUT TRACKS SPC 1 LOOP2 ISZ ID+17 BUMP AND CHECK IF DONE WITH LDB ID+17 KEYWORD SEARCH *780403* JSB LOADA *780403* SZA,RSS DONE? *780403* JMP LOOP1 YES, TRY NEXT TYPE OF BLANK ID STA B *780403* ADB D14 BUMP TO WORD 15 IN IDSEG (NAME/TYPE) JSB LOADA GET VALUE *780403* AND OM360 MASK TO CHAR 5 & SHORT/LONG BIT(177420B) CPA ID+16 NULL AND SHORT/LONG? RSS FOUND ONE BLANK, CHECK JMP LOOP2 NO, TRY NEXT IDSEG ADB O5 IF HAS TRACKS SZA,RSS CHECK IF SHORT OR LONG? ADB O7 LONG, BUMP TO WORD 27 STA TEMP SAVE TRACKS INDICATOR *780403* JSB LOADA EQUAL TO 0 IF NO TRACKS *780403* SEZ,SZA CHECK IF HAS TRACKS & CARE FLAG *780403* JMP LOOP2 WELL THIS DUDE HAS TRACKS, SKIP * ISZ FIDSG POINT TO NORMAL RETURN 791219 JMP FIDSG,I EXIT SUBROUTINE 791219 SKP * * * SUBROUTINE TO FIND AN AVAILABLE ID SEGMENT EXTENSION * * * CALLING ROUTINE MUST BE PRIVILEDGED: * * JSB $LIBR * NOP * JSB FIDEX * <RETURN: SUCCESS> * * OTHER POSSIBLE SUBROUTINE EXITS: * * JMP ERR14 (IF NO FREE ID SEGMENT EXTENSIONS) * * * RETURNED gk������þúPARAMETERS: * * IDEXT CONTAINS THE ADDRESS OF THE FOUND ID * SEGMENT EXTENSION * * INDX CONTAINS THE INDEX INTO THE ID EXTENSION * LIST OF THE FOUND ID SEGMENT EXTENSION * * FIDEX NOP CLA INITIALIZE INDEX INTO STA INDX THE ID EXTENSION LIST * XLB $IDEX LOAD ID EXTENSION LIST HEAD STB IDEXT SAVE * GTEX1 LDB IDEXT XLA B,I GET NEXT ENTRY IN ID EXT LIST * SZA,RSS END OF ID EXTENSION BLOCK ? JMP GTEX2 -YES, NO AVAILABLE ID EXTENSIONS * STA B XLA B,I GET WORD ZERO OF ID EXTENSION * SZA,RSS AVAILABLE ? JMP GTEX3 -YES, FOUND ONE * ISZ INDX BUMP INDEX INTO ID EXT LIST ISZ IDEXT BUMP ID EXTENSION ADDRESS * JMP GTEX1 TRY THE NEXT ID EXTENSION * * CAN'T FIND AN ID SEGMENT EXTENSION * GTEX2 CLE SET FOR ERROR EXIT JMP ERR14 TAKE ERROR EXIT * * FOUND AN ID SEGMENT EXTENSION * GTEX3 STB IDEXT SAVE RESULT JMP FIDEX,I EXIT * * IDEXT BSS 1 ID EXTENSION ADDRESS INDX BSS 1 ID EXTENSION LIST INDEX SKP * * TRANSFER DATA BETWEEN DISK AND A BUFFER * * CALLING SEQUENCE: * * CALL ZXFER (ZDIR,ZLU,ZBUF,ZBUFL,ZTRK,ZSEC,ZNSEC,ZNSPT) * * ZDIR = 1 (READ FROM DISK) OR 2 (WRITE TO DISK) * ZLU = DISK LU * ZBUF = BUFFER * ZBUFL = BUFFER LENGTH (WORDS). MUST BE AT LEAST 64 WORDS LONG. * ZTRK = STARTING TRACK ADDRESS * ZSEC = STARTING SECTOR ADDRESS * ZNSEC = TOTAL NUMBER OF SECTORS ON DISK TO TRANSFER * ZNSPT = NUMBER OF SECTORS PER TRACK ON DISK * * ERROR EXITS: IF ZBUFL < 64 WORDS: JMP ERR78 * IF DISK I/O ERROR: JMP ERR01 * * NOTE: ZTRK AND ZSEC ARE MODIFIED BY THIS ROUTINE TO ALWAYS POINT * TO THE NEXT POSITION ON DISK TO TRANSFER TO/FROM. * ZNSEC IS MODIFIED BY THIS ROUTINE TO ALWAYS INDICATE THE * iv������þú NUMBER OF SECTORS REMAINING TO BE TRANSFERED. * * ZXFER SHOULD BE CALLED ITERATIVELY UNTIL ZNSEC DROPS TO ZERO. * * ZDIR NOP TRANSFER DIRECTION ZLU NOP DISK LU ZBUF NOP BUFFER ADDRESS ZBUFL NOP BUFFER LENGTH ZTRK NOP TRACK ADDRESS ZSEC NOP SECTOR ADDRESS ZNSEC NOP NUMBER OF SECTORS ON DISK TO COPY ZNSPT NOP NUMBER OF SECTORS PER TRACK * ZXFER NOP JSB .ENTR PICKUP PARAMETERS DEF ZDIR * * PICKUP PARAMETERS * LDA ZDIR,I A = READ (1) OR WRITE (2) AND O3 CLEAR UNUSED BITS IOR O1S SET "NO ABORT" BIT STA ZDIR SAVE FOR EXEC CALL * LDA ZBUFL,I LOAD BUFFER LENGTH AND FLOOR FORCE TO BE A MULTIPLE OF SECTOR SIZE STA ZBUFL SAVE AS "REMAINING BUFFER LENGTH" * SZA IF BUFFER LENGTH IS ZERO SSA OR NEGATIVE JMP ERR78 THEN TAKE ERROR EXIT * (NOTE: LEAVE A-REG UNALTERED FOR USAGE BELOW.) * * REMAINING BUFFER LENGTH = * MINIMUM (SUPPLIED BUFFER LENGTH, REMAINING FILE LENGTH) * LDB ZNSEC,I B=REMAINING FILE LENGTH (SECTORS) BLF MULTIPLY BY 64 WORDS/SECTOR BLS,BLS B=REMAINING FILE LENGTH (WORDS) * CMA,INA A=NEGATIVE REMAINING BUF LENGTH (WORDS) ADA B A=(FILE LENGTH) - (BUFFER LENGTH) * SSA FILE LENGTH < BUFFER LENGTH ? STB ZBUFL -YES, RESET REMAINING BUFFER LENGTH * * TRANSFER LENGTH = * MINIMUM (REMAINING BUFFER LENGTH, REMAINING TRACK LENGTH) * ZLOOP LDA ZSEC,I A=CURRENT SECTOR ADDR CMA,INA NEGATE ADA ZNSPT,I A=REMAINING TRACK LENGTH (SECTORS) * ALF MULTIPLY BY 64 WORDS/SECTOR ALS,ALS A=REMAINING TRACK LENGTH (WORDS) * LDB ZBUFL B=REMAINING BUFFER LENGTH (WORDS) STB ZXLEN SAVE AS DEFAULT TRANSFER LENGTH CMB,INB NEGAÑ;������þúTE ADB A B=(TRACK LENGTH) - (BUFFER LENGTH) * SSB TRACK LENGTH < BUFFER LENGTH ? STA ZXLEN -YES, RESET TRANSFER LENGTH * * DO THE DISK TRANSFER * JSB EXEC DEF *+1+6 DEF ZDIR (TRANSFER DIRECTION) DEF ZLU,I (DISK LU) DEF ZBUF,I (BUFFER) DEF ZXLEN (TRANSFER LENGTH) DEF ZTRK,I (TRACK ADDRESS) DEF ZSEC,I (SECTOR ADDRESS) JMP ERR01 (NO-ABORT ERROR RETURN) * * UPDATE SECTOR AND TRACK ADDRESSES * LDA ZXLEN A=TRANSFER LENGTH (WORDS) ARS,ARS DIVIDE BY 64 WORDS/SECTOR ARS,ARS ARS,ARS A=TRANSFER LENGTH (SECTORS) LDB A (SAVE IN B-REG) * ADA ZSEC,I CALCULATE NEW SECTOR ADDRESS STA ZSEC,I UPDATE CURRENT SECTOR ADDRESS * CPA ZNSPT,I END OF TRACK ? RSS -YES JMP ZSKIP -NO * ISZ ZTRK,I INCREMENT TRACK ADDRESS CLA STA ZSEC,I RESET SECTOR ADDRESS * ZSKIP EQU * * * UPDATE REMAINING FILE LENGTH * CMB,INB B=NEGATIVE TRANSFER LENGTH (SECTORS) ADB ZNSEC,I CALCULATE NEW REMAINING FILE LENGTH STB ZNSEC,I SAVE * * UPDATE BUFFER ADDRESS * LDA ZBUF A = OLD BUFFER ADDRESS ADA ZXLEN ADD TRANSFER LENGTH STA ZBUF UPDATE CURRENT BUFFER ADDRESS * * UPDATE REMAINING BUFFER LENGTH * LDA ZXLEN A=TRANSFER LENGTH (WORDS) CMA,INA NEGATE ADA ZBUFL CALCULATE NEW BUFFER LENGTH STA ZBUFL SAVE * * LOOP UNTIL BUFFER IS EMPTY * SZA BUFFER EMPTY ? JMP ZLOOP -NO, LOOP JMP ZXFER,I -YES, EXIT * * ZXLEN BSS 1 STORAGE FOR TRANSFER LENGTH (WORDS) FLOOR OCT 177700 MASK TO INSURE MULTIPLE OF 64 SKP * * MISC. UTILITY SUBROUTINES * * * MOVE NOP ENTRY A=SOURCE,B=DEST ADDRESS STA ID+18 SAVE SOURCE ADDRESS LDA MOVEÞU������þú,I GET COUNTER CMA,INA STA ID+19 ISZ MOVE SET RETURN TO P+2 MORE LDA ID+18,I GET NEXT WORD JSB STORA PUT *780403* INB ISZ ID+18 ISZ ID+19 JMP MORE E-REG UNMODIFIED!!!!!!!!!!!! JMP MOVE,I RETURN DONE B=NEXT ADDRESS SPC 1 SUM NOP P+1=ADDRESS,P+2=# OF WORDS LDB SUM,I ISZ SUM STB MOVE SAVE START SUMMING ADDRESS LDB SUM,I GET NUMBER OF WORDS ISZ SUM BUMP TO P+3 ADA MOVE,I ACCUMULATE THE SUM ISZ MOVE BUMP TO NEXT WORD INB,SZB DONE? JMP *-3 JMP SUM,I RETURN P+3, E-REG = 1!!!!!! SPC 1 STYPE NOP *780403* LOADA NOP DOES XLA B,I IF MAPPED SYS *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAPSY YES *780403* LDA B,I NO, DO DIRECT LOAD *780403* JMP LOADA,I RETURN *780403* MAPSY XLA B,I DO CROSS-LOAD (2-WD INSTRUCT.) *780403* JMP LOADA,I RETURN *780403* SPC 1 STORA NOP DOES XSA B,I IF MAPPED SYS *780403* STA STSAV SAVE TEMPORARILY *780403*791219 LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAP YES *780403* LDA STSAV RESTORE TEMP WORD *780403*791219 STA B,I NON-MAPPED, DO DIRECT LOAD *780403* JMP STORA,I RETURN *780403* MAP LDA STSAV RESTORE TEMP WORD *780403*791219 XSA B,I DO CROSS-STORE(2-WD INSTRUCT.) *780403* JMP STORA,I RETURN *780403* * STSAV BSS 1 <Sú������þúTORA> TEMPORARY STORAGE 791219 * SPC 1 DEFZ DEF *+1 DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEFTM DEF *+1 DEC 0 DEC 0 DEC 0 OCT 25000 TIME = ONE DAY OCT 177574 DEC 0 SPC 1 * PRC OCT 74000 FMP PRIV CODE FOR WRITE ON FMP TRACKS * O1S OCT 100000 791219 O1 OCT 1 O3 OCT 3 O7 OCT 7 M2 DEC -2 791219 M9 DEC -9 D11 DEC 11 D14 DEC 14 D19 DEC 19 D23 DEC 23 D26 DEC 26 D41 DEC 41 D75 DEC 75 D76 DEC 76 D77 DEC 77 D78 DEC 78 D99 DEC 99 O20 OCT 20 O77 OCT 77 O200 OCT 200 O1777 OCT 1777 MASK OCT 77777 B170K OCT 170000 B1000 OCT 1000 B2000 OCT 2000 O7777 OCT 7777 OM20 OCT -20 OM360 OCT -360 OM400 OCT -400 DID9 DEF ID+9 DID23 DEF ID+23 DID29 DEF ID+29 DID32 DEF ID+32 DID36 DEF ID+36 * IDBUF BSS 41 ID EQU IDBUF-1 TEMP NOP *780403* TEMP1 NOP OWID NOP ADNAM NOP NEWID NOP NOCPY NOP CPY BSS 1 "I'M A COPY" FLAG 791219 SESWD NOP * TEMP2 BSS 1 791219 IDISC BSS 1 POOL DISK LU # 791219 ITRAK BSS 1 STARTING POOL TRACK # 791219 ISETR BSS 1 # SECTORS/TRACK ON "IDISC" 791219 NTRAK BSS 1 NUMBER OF POOL TRACKS DESIRED/RECEIVED 791219 * DCB8 DEF *-* ADDR OF IDCB(9) 791219 DLU BSS 1 FILE DISK LU # 791219 FDLU BSS 1 FILE DISK LU # WITH FMP PRIV. CODE 791219 SECTR BSS 1 MIN # SECTORS/TRACK ON POOL DISKS 791219 PSIZE BSS 1 PROGRAM SIZE (IN SECTORS) 791219 * * PARAMETER STORAGE FOR CALLS TO SUBROUTINE <ZXFER> * .TRKI BSS 1 INPUT TRACK ADDR 800305 P<���œ��š–.SECI BSS 1 INPUT SECTOR ADDR 800305 .NSCI BSS 1 INPUT # SECTORS TO READ 800305 .TRKO BSS 1 OUTPUT TRACK ADDR 800305 .SECO BSS 1 OUTPUT SECTOR ADDR 800305 .NSCO BSS 1 OUTPUT # SECTORS TO WRITE 800305 * * END ����������������������������������������������3»œ������ÿÿ����� ���� ÿý�þ� ���������ÿ��92067-18562 2026� S C0122 �&FMGRB � � � � � � � � � � � � � �H0101 ‰z�����ASMB,R,L HED FMGRB * NAME: FMGRB * SOURCE: 92067-18562 * RELOC: 92067-16185 * PGMR: D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FMGRB,5 92067-16185 REV.2026 800221 EXT SEG.R,.IDAD SPC 1 FMGRB STA .IDAD LDA TABL JMP SEG.R SPC 1 TABL DEF *+1 SPC 1 EXT RP.. DEF RP.. EXT RU.. DEF RU.. EXT HE.. DEF HE.. EXT WH.. DEF WH.. END FMGRB ��������������������������������������������������������������������������������������������������������������������������������������������������������øÞ������ÿÿ����� ���� ÿý�ÿ� ���������ÿ��92067-18563 2026� S C0122 �&..BF � � � � � � � � � � � � � �H0101 _;�����ASMB,R,L HED "..BF. , ..BL." DISK COPY BUFFER FOR RP OPERATION * SOURCE: 92067-18563 * RELOC: 92067-16185 * PGMR: D.C.L. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM ..BF.,8 92067-16185 REV.2026 800305 * ENT ..BF.,..BL. * * THIS IS A BUFFER USED FOR CALLS TO SUBROUTINE "IDRP". * IT IS USED BY IDRP TO COPY TYPE 6 FILES FROM DISK CARTRDIGES * OTHER THAN LU 2 OR 3 INTO SYSTEM POOL TRACKS. * * THIS BUFFER IS REFERENCED BY "RP.." & "RU.." * * SIZE EQU 2048 # WORDS IN BUFFER * ..BF. BSS SIZE BUFFER ..BL. ABS SIZE BUFFER LENGTH * * END ������������������ê������ÿÿ����� ���� ÿý��� ���������ÿ��92067-18564 2026� S C0122 �&XMTBU BACKUP UTILITY �SUBROUTINE � � � � � � � � � � � � �H0101 Ÿ¤�����þúASMB,Q,C NAM XMTBU,7 92067-1X564 REV.2026 800430 * * * SOURCE PART NO.: 92067-18564 * RELOC. PART NO.: 92067-1X564 * NAME: XMTBU * PART OF $DKULB(92067-12003) * * * PROGRAMMER: JRS * ******************************************************************* * * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * * ******************************************************************* * * * * THIS SUBROUTINE TAKES AN LU IN A RTE-IVB SYSTEM AND BUFFERS * OR UNBUFFERS THE ASSOCIATED EQT. IT WORKS BOTH IN SESSION AND * NON-SESSION ENVIROMENTS. * * CALL XMTBU(LU,FLAG) * * * LU: THE LU WHOSE EQT NEEDS TO BE ADJUSTED * FLAG: ON CALLING: * FLAG = -1 => BUFFER THE EQT * FLAG = 0 => UNBUFFER THE EQT * ON RETURN: * FLAG = -1 => EQT WAS BUFFERED * FLAG = 0 => EQT WAS NOT BUFFERED * * * EXT .ENTR,LUTRU,$LIBR,$LIBX ENT XMTBU LU NOP FLAG NOP XMTBU NOP JSB .ENTR DEF LU * LDA LU,I GET THE ALLEGED LU STA LU SAVE IT FOR THE INQUISITION JSB LUTRU THIS IS THE INQUISITION DEF *+2 DEF LU CONFESS,THE ANSWER IS IN THE A REG * JSB $LIBR HIT THE SYSTEM ON THE HEAD NOP * XLB DRTI GET THE HEAD OF THE DRT ADA B ADD IT TO THE REAL LU ADA DM1 SUBTRACT 1 FOR GOOD MEASURE XLA A,I GET THE DRT ENTRY FOR MY LU AND B77 KEEP ONLY THE EQT PART ADA DM1 SUBTRACT 1 TO OFFSET EQT# MPY D15 MULTIPLYr÷��� ��  EQT BY 15 FOR OFFSET XLB EQTA GET THE HEAD OF THE EQT LIST ADB A ADD HEAD AND OFFSET INTO EQT ADB D3 ADD 3 TO GET TO EQT4 STB EQT4A SAVE IT FOR LATER XLB B,I GET THE EQT4 WORD LDA FLAG,I GET THE FLAG PARAMETER CLE,SZA IS FLAG SET??? CCE YES...SET E REG TO BUFFER EQT RBL,RBL GET BIT 14 OUT IN THE OPEN ERB,RBR PUT THE NEW B BIT IN BIT 14 XSB EQT4A,I PUT IT BACK IN ITS HOME CLA,SEZ WAS B BIT SET PREVIOUSLY?? CCA YES STA FLAG,I SEND IT BACK TO THE CALLER JSB $LIBX YOO HOO SYSTEM....WAKE UP DEF *+1 DEF *+1 * JMP XMTBU,I BLOW THIS TACO STAND! * A EQU 0 B EQU 1 DRTI EQU 1652B HEAD OF THE DRT TABLE EQTA EQU 1650B HEAD OF THE EQT TABLE EQT4A NOP EQT4 SAVE ADDRESS B77 OCT 77 D15 DEC 15 D3 DEC 3 DM1 DEC -1 END ������������������������������Rª ������ÿÿ����� ���� ÿý�� ���������ÿ��92067-18586 2040� S C0122 �&DL1B4 �DSCLB/RTEIVB INTERFACE � � � � � � � � � � � � �H0101 �����þúFTN4,Q,C C***************************************************************** C* * C* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C* RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C* REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE * C* WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD * C* COMPANY. * C* * C***************************************************************** C C NAME: DL1B4 C SOURCE: 92067-18586 C RELOC: PART OF 92067-12003 C PGMR: JRS C SUBROUTINE ZSENS(LU,IBUFR,L),92067-1X586 REV.2040 800717 INTEGER LU,IBUFR,L CALL EXEC(1,LU+2200B,IBUFR,L,2,0) RETURN END SUBROUTINE ZCTRL(LU,IBUFR),92067-1X586 REV.2040 800717 INTEGER LU,IBUFR CALL EXEC(1,LU+2200B,IBUFR,1,1,0) RETURN END SUBROUTINE ZDSJ(LU,HPIB,KDSJ),92067-1X586 REV.2040 800717 INTEGER LU,HPIB,KDSJ CALL EXEC(1,LU+2200B,KDSJ,1,5,HPIB) RETURN END SUBROUTINE ZTMAP(LU,IBUFR,L),92067-1X586 REV.2040 800717 INTEGER LU,IBUFR,L CALL EXEC(1,LU+2200B,IBUFR,L,0,0) RETURN END SUBROUTINE ZWRIT(LU,IBUFR,L),92067-1X586 REV.2040 800717 INTEGER LU,IBUFR,L CALL EXEC(1,LU+2200B,IBUFR,L,4,0) RETURN END SUBROUTINE ZREAD(LU,IBUFR,L),92067-1X586 REV.2040 800717 INTEGER LU,IBUFR,L CALL EXEC(1,LU+2200B,IBUFR,L,3,0) RETURN END SUBROUTINE ZPPOL(LU,IPPOL),92067-1X586 REV.2040 800717 INTEGER LU,IPPOL CALL EXEC(1,LU+2200B,IPPOL,1,6,0) RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‚`��� ���� �������� �������ÿÿ����� ���� ÿý�� ���������ÿ��92067-18589 2040� S C0122 �&$CNFH �CONFIG HEADER � � � � � � � � � � � � �H0101 rK�����ASMB,R,L * NAME: $CNFH * SOURCE: 92067-18589 * RELPC: 92067-16516 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $CNFH,0 92067-16516 REV.2040 800801 * * * * * * * * * * * * * * * * * * END ����������������������������������������������������������������������������������������������������������î«������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18002 2013� S C0122 �&%SSW � � � � � � � � � � � � � �H0101 :�����ASMB,R,L HED CALL BY ANME TO ISSW * * NAME: %SSW * SOURCE: 92068-18002 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM %SSW,7 92068-1X002 REV.2013 750701 ENT %SSW EXT ISSW %SSW NOP ISZ %SSW LDB %SSW,I LDA 1,I LOAD PARAMETER INTO A JSB ISSW ISZ %SSW JMP %SSW,I RETURN END * * ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������K«������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18003 2013� S C0122 �&%WRIS � � � � � � � � � � � � � �H0101 †l�����þúASMB,R,L,C HED "%WRIS" RTE SOURCE FILE WRITE IN "LS" FORMAT * * NAME: %WRIS * SOURCE: 92068-18003 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM %WRIS,7 92068-1X003 REV.2013 750701 ENT %WRIS,%WRIN,%WEOF EXT EXEC SPC 1 SPC 1 * PURPOSE: * THIS ROUTINE WILL WRITE SOURCE DATA ON AN RTE DISC IN "LS" * FORMAT. SPC 1 * USES: * THIS ROUTINE IS USED BY COMPILERS, EDITORS, ASSEMBLERS TO * WRITE SOURCE ONTO A DISC SUCH THAT THEY CAN READ IT OVER * AGAIN FOR ANOTHER PASS OF THE SOURCE. THE DATA IS WRITTEN * IN " LS " FORMAT AND THE TRACKS ARE OWNED BY THE CALLING * PROGRAM. THE CALLING PROGRAM SHOULD RELEASE THE TRACKS * WHEN IT IS DONE WITH THEM. SPC 1 * CALLED: * ASSEMBLY ONLY * JSB %WRIN INITIALIZES * <ERROR RETURN> NO DISC SPACE A=-1 * <RETURN> A-REG = !15 DISCLU 8!7 TRACK# 0! * * ASSEMBLY ONLY * IF BUFFER LENGTH IS = 0, THEN IMBEDDED FILE MARK IS WRITTEN * IF BUFFER LENGTH IS > 0, THEN TRUE END OF FILE MARK IS WRITTEN * IF BUFFER LENGTH IS < 0, THEN -(BUFLN-1)/2 WORDS ARE WRITTEN * JSB %WRIS WRITES RECORD ON DISC * DEF *+4 GOOD RETURN * DEF BUFFR POINTER TO 1ST WORD OF BUFFER * DEF BUFLN NEG. NUMBER OF CHARS IN BUFFER * <ERROR RETURN> SORRY OUT OF DISC SPACE * <RETURN> A-REG. = LAST WRITTEN LU/TRACK * ASSEMBLY ONLY * JSB %WEOF WRITES ½ ������þúOUT AN END OF FILE MARK * <RETURN> A-REG = SAME AS %WRIS SPC 1 * RETURN: * A-REG = DISC LOGICAL UNIT IN BITS 7-8 (LU= 2 OR 3) * TRACK NUMBER IN BITS 0-7 (TRACK = 0 TO 255) * -1 IF NO TRACK AVAILABLE SPC 1 * NOTES: * THE " %WRIN " ENTRY POINT IS IN THIS ROUTINE PRIMARLY TO * RE-INITIALIZE A NEW FILE WRITE TO THE DISK. THE " %WEOF " * ENTRY POINT IS TO WRITE A FILE MARK AND POST THE IN MEMORY * BUFFER. A FILE MARK WRITE WITH " %WRIS " WILL WRITE A FILE * MARK, BUT WILL NOT POST THE POSSIBLE IN MEMORY BUFFER. * CAUTION!, ALWAYS SPECIFY AN EVEN CHARACTER COUNT (OR PAD ODD * CHARACTER COUNT WITH TRAILING SPACE) WHEN WRITTING A RECORD. * THIS ROUTINE WILL WRITE ASCII RECORDS ON PROGRAM OWNED * TRACKS OF AN RTE SYSTEM IN "LS" FORMAT. THE BASE PAGE * LS POINTER IS NOT SET HOWEVER. SPC 1 * ERRORS: * THE ERROR RETURN FROM " %WRIS " IS NOT RECOVERABLE, THEREFORE * ANY TRACKS WRITTEN ON BEFORE SHOULD BE GIVEN BACK TO SYSTEM SPC 1 %WRIS NOP ENTRY FOR UNIT RECORD WRITE LDA %WRIS,I GET NORMAL RETURN ADDRESS STA GEXIT SAVE IN GOOD EXIT ISZ %WRIS LDB %WRIS LDB B,I GET WRITE BUFFER ADDRESS RBL,CLE,SLB,ERB TRACK DOWN INDIRECTS JMP *-2 ISZ %WRIS GET THE LENGTH OF BUFFER IN NEG. LDA %WRIS,I CHARACTERS, OR 0 IF IMBEDDED FILE MARK LDA A,I OR >1 IF TRUE END OF FILE. ARS CONVERT TO -WORDS. JSB WRITE WRITE THE RECORD ON DISC JMP %WRIS,I ERROR RETURN (OUT OF DISC SPACE) JMP GEXIT,I GOOD RETURN A=LS WORD. (LU*256+TRACK) SPC 1 GEXIT NOP SPC 1 %WRIN NOP INITIALIZATION ENTRY POINT FOR NEW FILE JSB GETRK GET A TRACK FROM SYSTEM JMP %WRIN,I NO DISC SPACE EXIT ISZ %WRIN BUMP TO GOOD EXIT JSB MFTAS MOVE FORWARD TRACK AND SECTOR NUMBERS JSd������þúB POST SET-UP BUFFERS & COUNTERS JMP %WRIN,I GOOD EXIT A=LS WORD (DISKLU*265+TRACK#) SPC 1 %WEOF NOP WRITE TRUE END OF FILE MARK CLA,INA SET BUFFER LEN POSITIVE JSB WRITE GO WRITE FILE MARK JMP *-2 IF OUT OF DISC TRY AGAIN JSB POST FORCE WRITE OF IN CORE BUFFER JMP %WEOF,I A=LAST TRACK+DISC LU SPC 1 WRITE NOP ENTRY A=-WORD COUNT,B=BUFFER ADDRESS IFST JMP FIRST CHECK IF 1ST CALL TO %WRIN STB SBUFR SAVE SOURCE BUFFER ADDRESS CCB SET B=-1 ADA B DECREMENT A-REG CLB SET UP B, JUST IN CASE SSA,RSS CHECK IF WAS > 0? CCA,RSS YES, FORCE FILE MARK STA B SAVE IN B CMB B= WORD COUNT BLF,BLF POSITION FOR HEDDER WORD ON DISC STA SRCNT SAVE A FOR # WORDS PUT ON DISC JMP BEGRC BEGIN RECORD WRITE SPC 1 MORE LDB SBUFR,I GET NEXT WORD FROM CALLER ISZ SBUFR BUMP ADDRESS TO NEXT WORD BEGRC STB DSBFR,I PUT IN DISC BUFFER ISZ DSBFR BUMP ITS POINTER ISZ DSCNT DISC BUFFER FULL? JMP BUFNF NO, BUFFER NOT FULL LDA SECTR YES, CHECK IF LAST SECTR ON TRACK ADA D2 BUMP BY TWO CPA SE/TK EQUAL TO NUMB SECTRS PER TRACK? JMP EOTRK YES, PROCESS END OF TRACK JSB POST NO, POST THE SECTOR STA SECTR UPDATE THE SECTOR WORD JMP BUFNF CONTINUE ON SPC 1 EOTRK STB WRIT1 SAVE LAST WORD ON TRACK JSB GETRK GET ANOTHER TRACK JMP WRITE,I NO TRACKS, ERROR RETURN STA BUFFR+127 SAVE NEW TRACK ADDR IN LAST STA LUNTR WORD OF OLD TRACK+LET CALL KNOW JSB POST WRITE OUT LAST SECTOR OF OLD JSB MFTAS MOVE FORWARD NEW TRACK ADDRESS LDB WRIT1 GET THE WORD THAT MISSED JMP BEGRC STORE IT IN 1ST WORD OF NEW TRACK SPC 1 BUFNF ISZ SRCNT MORE’������þú WORDS IN CALLERS BUF? JMP MORE YES LDA LUNTR NO, RETURN A= DISCLU*256+TRACK ISZ WRITE GOOD RETURN P+2 JMP WRITE,I SPC 1 SBUFR NOP SRCNT NOP DSBFR NOP DSCNT NOP D2 DEC 2 WRIT1 NOP LUNTR NOP SPC 1 POST NOP WRITE OUT THE 128 WORD SECTOR STA POST1 SAVE THE A-REG JSB EXEC EXEC>>DO IT DEF *+7 DEF D2 WRITE DEF OLDLU DISC LOGICAL UNIT DEFBF DEF BUFFR DEF D128 128 WORDS DEF OLDTK TRACK ADDRESS DEF SECTR SECTOR ADDRESS LDA DEFBF RESET THE DISC BUFFER STA DSBFR LDA DM128 AND THE COUNT STA DSCNT LDA POST1 RESTORE A-REG JMP POST,I RETURN SPC 1 POST1 NOP TEMP FOR POST ROUTINE D128 DEC 128 DM128 DEC -128 SPC 1 MFTAS NOP ROUTINE TO BRING FORWARD GETRK'S LDB NEWTK DISC ADDRESSES STB OLDTK TRACK ADDRESS LDB NEWLU DISC LU STB OLDLU CLB SECTOR ADDRESS STB SECTR JMP MFTAS,I RETURN SPC 1 OLDTK NOP NEWTK NOP OLDLU NOP NEWLU NOP SECTR NOP SE/TK NOP SPC 1 GETRK NOP ROUTINE TO GET A TRACK FROM SYSTEM JSB EXEC REQUEST TRACK WITHOUT WAIT DEF *+6 DEF D4 PROGRAM OWNED TRACK DEF NUMTK ONE TRACK, NO WAIT DEF NEWTK RETURNED TRACK NUMBER DEF NEWLU DISC LU NUMBER 2 OR 3 DEF SE/TK NUMBER SECTORS PER TRACK LDA NEWTK GET THE TRACK # OR -1 IF NONE LDB NEWLU GET DISC LU BLF,BLF POSITION IOR B MIRGE IN WITH TRACK NUMBER SSA,RSS CHECK IF GOT ONE? ISZ GETRK YES, P+2 EXIT JMP GETRK,I NO, P+1 EXIT SPC 1 NUMTK OCT 100001 D4 DEC 4 BUFFR BSS 128 ORG BUFFR OCT -1 FIRST STA SAVA STB SAVB LDA %WRIN CHECK IF EVER CALLED SZA JMP ˆI�����SKIP JSB %WRIN INITIALIZE 1ST TIME JMP WRITE,I ERROR EXIT SKIP CLA STA IFST NO MORE CALLS LDA SAVA RESTORE REGISTERS LDB SAVB JMP IFST+1 SPC 1 SAVA NOP SAVB NOP ORR A EQU 0 B EQU 1 END * * ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Òœ������ÿÿ����� ���� ÿý��  ���������ÿ��92068-18004 2013� S C0122 �&%WRIT � � � � � � � � � � � � � �H0101 ‡m�����þúASMB,R,L,C HED REAL-TIME, DOS, AND IOMEC/DOS WRITE LOAD/GO DISK FILE * * NAME: %WRIT * SOURCE: 92068-18004 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM %WRIT,7 92068-1X004 REV.2013 771116 ENT %WRIT,%WRIF ENT %WBUF EXT EXEC EXT $OPSY SPC 1 SPC 1 * PURPOSE: * THIS ROUTINE WRITES RELOCATABLE RECORDS ON DISK. SPC 1 * USES: * THIS ROUTINE IS USED BY COMPILERS TO WRITE THE RELOCATABLE * RECORDS IT PRODUCES ON A DOS, DOS-M, DOS-III, OR RTE * DISC BASED SYSTEM. IN DOS SYSTEMS, THE AREA OF THE DISC IS * CALLED THE "JBIN". IN RTE SYSTEMS, THIS AREA IS CALLED THE * "LG" AREA. THE FORMAT ON DISC IS SAME AS PAPER TAPE FORMAT. SPC 1 * CALLED: * ASSEMBLY ONLY * JSB %WRIT (ALL INITIALIZATION DONE BY SYSTEM) * DEF *+3 * DEF BUFFR FIRST WORD ADDRESS OF WRITE BUFFER * DEF RLEN ADDRESS OF NUMBER OF WORDS TO WRITE * <RETURN> P+4 * * ASSEMBLY ONLY * JSB %WRIF POST ANY PARTIAL RECORD IN MEMORY * <RETURN> P+1 SPC 1 * ERRORS: * IN DOS, DOS-M, DOS-III SYSTEMS THE MESSAGE "JBIN OVF" WILL * APPEAR ON LOGICAL UNIT ONE, IF THE THE JBIN OVERFLOWS. * IN RTE, THE SYSTEM WILL ABORT THE CALLING PROGRAM WITH * AN "IO06" ERROR IF THE "LG" AREA WAS NOT DEFINED, OR * AN "IO09" ERROR IF THE "LG" AREA OVERFLOWS. SPC 1 * NOTES: * "NAM" RELOCATABLE RECORDS MŒo������þúUST ALWAYS START ON A SECTOR BOUNDRY, * THEREFORE, WHENEVER AN "END" RELOCATABLE RECORD IS WRITTEN, THE * ENTRY POINT " %WRIF " MUST BE CALLED TO POST ANY PARTIAL RECORD * STILL IN MEMORY ONTO THE DISK. SPC 1 * THIS ROUTINE COULD BE SHORTEN TO ABOUT 404(8) SPC 1 WROVF CCA LDB O101 ADDR OF JBINS= 101B JSB EXEC SET JBINS=-1 DEF *+2 DEF .M19 -19 JSB EXEC DEF *+5 DEF M2OR2 DEF .1 LUN=1 FOR SYSTEM TTY DEF OVMES FWA OF MESSAGE DEF .M8 -8 FOR 8 CHARS. JMP %WRIF,I EXIT OVMES ASC 4,JBIN OVF .WRIN NOP DOS1 JMP RTEIN * LDA DM8 * STA N LDA 102B JBINC CLB SZA,RSS ANY JBIN TRACKS ? JMP WROVF NO,OVERFLOW ERROR LSL 8 * CLE,ELA * ELB,CLE LSL 8 - SHIFT TRACK NO INTO B * ISZ N * JMP *-3 ALF,ALF (A) = SECTOR NO STB TRACK CLB ALWAYS EVEN JMP DOSC1 RTEIN LDA 1766B LGOC= CURRENT LOAD/GO CODEWORD LDB M2OR2 SSA INB STB WLUN LUN=2 IF SIGN=0, =3 OTHERWISE ALF,ALF RAL AND O377 STA TRACK SET TRACK NO. LDA 1766B LGOC= CURRENT LOAD/GO CODE-WORD AND O177 STA B DOSC1 STA SECTR SET SECTOR NO. LDA MSIZE SLB CHECK IF ODD SECTOR IN RTE ARS YES, DIVIDE SECTOR TO 64 WORDS STA BCOUN SECTOR-BUFFER COUNT = -64 CMA,INA SET THE SECTOR SIZE STA PSIZE MAY BE 64 OR 128 WORDS IF RTE LDA BFWA STA BFRAD SET SECTOR BUFFER ADDR = FWA BFR JMP .WRIN,I *%WRIF OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR *ON DISK, UPDATES THE CURRENT SECTOR NO. *%WRIF IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT. SPC 1 %WRIF NOP DOS2 JMP RTEIF LDA 101B JBINS CPA DM1 NO JBIN LEFT ? (DUM GUY) JMP %WRIF,I YES,EXŒÒ������þúIT. RTEIF CCA CHECK HOW MANY SECTORS TO POST ADA BCOUN ADA PSIZE A=# WORDS WRITTEN -1 IOR O77 MIRGE IN 63 SSA,INA CHECK IF ANY & BUMP JMP %WRIF,I NONE, JUST RETURN STA SSIZE EITHER 64 OR 128 CLA STA BFRAD,I 0 FOR END OF SUBPROGRAM JSB EXEC WRITE SECTOR DEF *+7 DEF M2OR2 CODE FOR WRITE CDOS DEF WLUN LUN BFWA DEF %WBUF FWA OF BUFFER DEF SSIZE 64 OR 128 WORDS DEF TRACK TRACK NO DEF SECTR SECTOR NO DOS3 JMP RTEFC * LDA DM8 * STA N LDA 102B LGOC WORD INA ISZ SECTR BUMP SECTOR LDB SECTR CPB 116B NO OF SECTORS IN TRACK CLB,RSS JMP WRIF2 RRL 8 * CLE,SSA * CCE * ELB RRL 8 - TRACK NO TO B * ELA * ISZ N * JMP *-5 WRIF1 ADB DM1 STB TRACK NEW TRACK NO JSB EXEC STATUS REQUEST DEF *+5 DEF .16 CODE = 16 DEF .1 1 TRACK DEF TRACK STARTING TRACK NO. DEF STRAK ACTUAL GOOD TRACK RETURNED LDA STRAK SZA,RSS OVERFLOW ? JMP WROVF YES * LDB DM8 * STB N LDB TRACK CPB STRAK GOOD TRACK ? CLA,RSS JMP WRIF1 NO, TRY NEXT LOWER TRACK CPB RTRAK WORK TRACK ? JMP WROVF YES,OVERFLOW RRR 8 * CLE,ERB * ERA RRR 8 - TRACK TO UPPER A * ISZ N * JMP *-3 WRIF2 LDB O102 ADDR OF JBINC JSB EXEC SET JFILC = TRACK,O (AT 125B) DEF *+2 DEF .M19 -19 RTEFC JSB .WRIN RE-INITIALIZE FOR NEXT WRITE JMP %WRIF,I EXIT SPC 1 RTRAK EQU 267B SSIZE NOP O77 OCT 77 O101 OCT 101 *DM8 DEC -8 O377 OCT 377 O177 OCT 177 DM1 DEC -1 O102 OCT 102 SPC 1 %WRIT NOP LDA %WRIT,I STA EXIT SET RETURN ADR STA %WRIF ALSO FOR ÷�������þúWROVF INITI JMP INITL INITIALIZE AT 1ST ENTRY DOS4 JMP WRIT1 RTE LDA 101B JBINS CPA DM1 NO JBIN LEFT ? JMP EXIT,I YES,EXIT WRIT1 ISZ %WRIT LDA %WRIT LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 STA WBFAD SOURCE-BUFFER FWA ISZ %WRIT LDA %WRIT,I LDA 0,I CMA,INA STA COUNT SET COUNT WMOVE LDA WBFAD,I STA BFRAD,I MOVE WORD ISZ BFRAD POINTERS ISZ BCOUN BUMP SECTOR-BUFFER COUNT RSS JSB %WRIF END OF BUFFER, WRITE SECTOR ISZ WBFAD BUMP ISZ COUNT BUMP COUNTER JMP WMOVE CONTINUE TRANSFER JMP EXIT,I READY, EXIT SPC 1 EXIT NOP RETURN ADDR STRAK NOP TEMP FOR NEXT GOOD TRACK PSIZE DEC 64 MSIZE DEC -64 .M19 DEC -19 .16 DEC 16 .1 EQU 54B .M8 EQU 43B M2OR2 DEC 2 *N NOP WLUN NOP LUN TRACK NOP CURRENT TRACK NO SECTR NOP CURRENT SECTOR NO BFRAD NOP CURRENT ADDR IN WRITE-BUFFER WBFAD NOP CURRENT SOURCE-BUFFER ADDR COUNT NOP TRANSFER COUNT %WBUF BSS 128 ORG %WBUF+64 I DON'T WHY THIS IS AN ENTRY POINT INITL CLA NOP TO AVOID 2ND ENTRY STA INITI LDA $OPSY FIND OUT WHAT SYSTEM, DOS,DOSM,RTE SSA RTE = -1 OR -2 JMP RWRIN RTE LDB TDM2 DISC WRITE = -2 IN DOS-DOSM STB M2OR2 LDB TO55 GET OCT 55 STB CDOS LU FOR DISC IS ON BASE PAGE CLB TURN INTO DOS CODE STB DOS1 STB DOS2 STB DOS3 STB DOS4 LDB PSIZE DEC 64 SZA SEE IF DOS OR DOSM? RWRIN LDB TD128 CHANGE TO 128 WORD SECTORS STB PSIZE CMB,INB STB MSIZE JSB .WRIN SET UP TRACK/SECTOR ADDRESS JMP INITI+1 CONTINUE PROCESSING SPC 1 TO55 OCT 55 TD128 DEC 128 TDM2 DEC -2 ˆ§����� SPC 1 ORR BCOUN NOP DON'T MOVE, YOU BE SORRY B EQU 1 END * * ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Y¢������ÿÿ����� ���� ÿý��  ���������ÿ��92068-18005 2013� S C0122 �&.DIV � � � � � � � � � � � � � �H0101 ‚9�����ASMB,R,L HED ".DIV" DUMMY ENTRY FOR DOS-M/DOS-III SYSTEMS * * NAME: .DIV * SOURCE: 92068-18005 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .DIV,7 92068-1X005 REV.2013 750701 ENT .DIV EXT .MAC. SPC 1 * SPC 1 * SEE THE LISTING OF ".MAC." FOR EXPLANATION OF THIS ROUTINE .DIV NOP JSB .MAC. DO THE STORE OF NEXT CORE VALUE OCT 100400 IN THE "JSB .DIV" END * ��������������������������������������������������������������������������������������������������������������������tö������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18006 2013� S C0122 �&.DLD � � � � � � � � � � � � � �H0101 q<�����ASMB,R,L HED ".DLD" DUMMY ENTRY FOR DOS-M/DOS-III SYSTEMS * * NAME: .DLD * SOURCE: 92068-18006 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .DLD,7 92068-1X006 REV.2013 750701 ENT .DLD EXT .MAC. SPC 1 * SPC 1 * SEE THE LISTING OF ".MAC." FOR EXPLANATION OF THIS ROUTINE .DLD NOP JSB .MAC. DO THE STORE OF NEXT CORE VALUE OCT 104200 IN THE "JSB .DLD" END * ����������������������������������������������������������������������������������������������������������������������V~������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18007 2013� S C0122 �&.DST � � � � � � � � � � � � � �H0101 ‚C�����ASMB,R,L HED ".DST" DUMMY ENTRY FOR DOS-M/DOS-III SYSTEMS * * NAME: .DST * SOURCE: 92068-18007 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .DST,7 92068-1X007 REV.2013 750701 ENT .DST EXT .MAC. SPC 1 * SPC 1 * SEE THE LISTING OF ".MAC." FOR EXPLANATION OF THIS ROUTINE .DST NOP JSB .MAC. DO THE STORE OF NEXT CORE VALUE OCT 104400 IN THE "JSB .DST" END * ����������������������������������������������������������������������������������������������������������������������ŠØ������ÿÿ����� ���� ÿý� � ���������ÿ��92068-18008 2013� S C0122 �&.LBT � � � � � � � � � � � � � �H0101 ‹2�����ASMB,R,L,C * * NAME: .LBT * SOURCE: 92068-18008 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .LBT,6 92068-1X008 REV.2013 770518 ENT .LBT EXT .ZPRV * THIS ROUTINE PROVIDES SOFTWARE SIMULATION OF THE LBT * INSTRUCTION IN THE 21MX EXTENDED INSTRUCTION GROUP. B EQU 1 E.O NOP CHAR NOP * .LBT NOP JSB .ZPRV DEF .LBTX ERA,ALS SOC INA STA E.O SAVE E AND O REGISTERS CLE,ERB SHIFT BYTE INDICATOR TO E LDA B,I WORD CONTAINING CHARACTER TO A. SEZ,RSS IF E=0, ROTATE TO GET THE CHAR- ALF,ALF ACTER IN A[7:0]. AND =B377 MASK OUT EXTRANEOUS BITS. STA CHAR SAVE IT ELB INB STEP TO NEXT BYTE CLO LDA E.O SLA,ELA RESTORE E AND O REGISTERS STO LDA CHAR .LBTX JMP .LBT,I RETURN WITH CHAR IN A. DEF .LBT END ������������������������������������������������������������������������������������������������������������������B������ÿÿ����� ���� ÿý� � ���������ÿ��92068-18009 2013� S C0122 �&.MPY � � � � � � � � � � � � � �H0101 ’@�����ASMB,R,L HED ".MPY" DUMMY ENTRY FOR DOS-M/DOS-III SYSTEMS * * NAME: .MPY * SOURCE: 92068-18009 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .MPY,7 92068-1X009 REV.2013 750701 ENT .MPY EXT .MAC. SPC 1 * SPC 1 * SEE THE LISTING OF ".MAC." FOR EXPLANATION OF THIS ROUTINE .MPY NOP JSB .MAC. DO THE STORE OF NEXT CORE VALUE OCT 100200 IN THE "JSB .MPY" END * ����������������������������������������������������������������������������������������������������������������������ˆ������ÿÿ����� ���� ÿý� � ���������ÿ��92068-18010 2013� S C0122 �&.OPSY � � � � � � � � � � � � � �H0101 …z�����ASMB,R,L,C HED OP SYSTEM IDENTIFICATION SUBROUTINE * * NAME: .OPSY * SOURCE: 92068-18010 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .OPSY,7 92068-1X010 REV.2013 771116 ENT .OPSY EXT $OPSY SPC 2 * CALLING SEQUENCE: * JSB .OPSY * RESULT IN A REGISTER : * 1 = DOS * -7 = RTE-MI * -15 = RTE-MII * -5 = RTE-MIII * -3 = RTE-II * -1 = RTE-III * -9 = RTE-IV SPC 2 .OPSY NOP LDA $OPSY SYSTEM ENTRY POINT JMP .OPSY,I END * * ������������������������������������������������������������������������������������������������������������������Ùø������ÿÿ����� ���� ÿý� � ���������ÿ��92068-18011 2013� S C0122 �&.SBT � � � � � � � � � � � � � �H0101 ‹3�����ASMB,R,L,C * * NAME: .SBT * SOURCE: 92068-18011 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .SBT,6 92068-1X011 REV.2013 770518 ENT .SBT EXT .ZPRV * THIS ROUTINE PROVIDES SOFTWARE SIMULATION OF THE SBT * INSTRUCTION IN THE 21MX EXTENDED INSTRUCTION GROUP. B EQU 1 E.O NOP CHAR NOP ASAVE NOP * .SBT NOP JSB .ZPRV DEF .SBTX STA ASAVE SAVE A AND =B377 STA CHAR CHARACTER TO BE STORED ERA,ALS SOC INA STA E.O SAVE E AND O REGISTERS CLE,ERB LDA B,I GET PREVIOUS WORD SEZ,RSS ALF,ALF AND =B177400 SAVE ONE BYTE IOR CHAR SEZ,RSS ALF,ALF POSITION STA B,I ELB INB SET FOR NEXT STORE LDA E.O CLO SLA,ELA RESTORE E AND O REGISTERS STO LDA ASAVE .SBTX JMP .SBT,I RETURN DEF .SBT * END ����������������������������������������������������������������������������������������������ù¹������ÿÿ����� ���� ÿý� � ���������ÿ��92068-18012 2013� S C0122 �&.TAPE � � � � � � � � � � � � � �H0101 ‰W�����ASMB,R,L,C * * NAME: .TAPE * SOURCE: 92068-18012 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .TAPE,7 92068-1X012 REV.2013 750701 ENT .TAPE EXT EXEC * * * THIS ROUTINE IS USED TO INITIATE TAPE OPERATIONS * FOR FORTRAN COMPILED PROGRAMS * WHEN .TAPE IS INVOKED, REGISTER A CONTAINS 030XYY. * X=4 --- REWIND * X=2 --- BACKSPACE * X=1 --- ENDFILE * YY ---- LOGICAL UNIT NUMBER * * .TAPE NOP AND MASK ISOLATE FUNCTION CODE AND UNIT # STA FUNCT STORE IN FUNCTION CONTROL WORD JSB EXEC TRANSFER TO EXEC WITH COMMAND DEF *+3 RETURN ADDRESS DEF RCODE ADDRESS OF REQUEST CODE DEF FUNCT ADDRESS OF FUNCTION CONTROL WORD JMP .TAPE,I * RCODE DEC 3 I/O CONTROL REQUEST CODE FUNCT NOP FUNCTION CONTROL WORD MASK OCT 7777 MASK FOR FORMING CONTROL WORD END * * ��������������������������������������������������������������������������������������������N������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18013 2013� S C0122 �&ABREG � � � � � � � � � � � � � �H0101 m}�����ASMB,R,L,C HED "ABREG" FORTRAN A&B REGISTER GET ROUTINE (DLB) * * NAME: ABREG * SOURCE: 92068-18013 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ABREG,7 92068-1X013 REV.2013 750701 ENT ABREG SPC 2 * * CALLING SEQUENCE: * * CALL ABREG (IA,IB) * * WHERE: IA WILL BE THE VALUE OF A-REGISTER BEFORE CALL * IB WILL BE THE VALUE OF B-REGISTER BEFORE CALL * REGISTERS ARE LEFT UNMODIFIED. * * WARNING!!!!!! * * IA & IB MUST NOT BE ARRAY ELEMENTS IN FORTRAN OR ALGOL * BECAUSE THE REGISTERS WILL HAVE BEEN MODIFIED IN THE * ARRAY CALCULATIONS AFTER THE EXECUTION OF THE PREVIOUS * STATEMENT. SPC 2 ABREG NOP ENTRY ".ENTR" STYLE STA AREG STB BREG LDB ABREG,I GET RETURN ADDRESS ISZ ABREG LDA ABREG,I GET ADDRESS OF IA STA IA ISZ ABREG LDA ABREG,I GET ADDRESS OF IB STB ABREG LDB BREG GET B-REGISTER STB A,I PUT IN IB LDA AREG GET A-REGISTER STA IA,I PUT IN IA JMP ABREG,I IA NOP AREG NOP BREG NOP A EQU 0 END * ������������������������������������������������������������������������������������������������������������������������������CÉ������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18014 2013� S C0122 �&BINRY � � � � � � � � � � � � � �H0101 ‚Œ�����þúASMB,R,L,C HED REAL TIME, DOS, AND IOMEC/DOS BINARY READ/WRITE * * NAME: BINRY * SOURCE: 92068-18014 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM BINRY,7 92068-1X014 REV.2013 771116 ENT BREAD,BWRIT EXT EXEC EXT $OPSY * NOTE: ONLY CHANGE OF 7-26-75 IS NOTED IN CODE (DLB) *BINARY READ/WRITE ROUTINES: BREAD/BWRIT *CALLING SEQUENCE : JSB BREAD(BWRIT) * DEF *+7 * DEF A = FWA OF BUFFER * DEF N (NO. OF WORDS) * DEF LUN (LOG.UNIT NO.) * DEF TRACK * DEF SECTR * DEF OFSET (OFFSET IN SECTR) * (RETURN) * *FORTRAN CALL: CALL BREAD(A,N,LUN,ITRAK,ISECT,IOFST) * * SINCR NOP LDA $OPSY IF SSA,RSS IN JMP LDOS LDA LUN,I RTE, THEN CPA .2 CHECK IF LOGICAL UNIT =2? JMP *+3 YES LDA 1760B NO, L.U.=3 GET SCTRS/TRACK JMP *+4 AND PROCEED LDA 1757B L.U.=2,GET SCTRS/TRACK JMP *+2 AND PROCEED LDOS LDA 116B WE'RE IN DOS/DOSM,GET SCTRS/TRACK CPA SECTR SECTR=MAX? JMP *+3 YES ISZ SECTR NO,BUMP SECTOR AND JMP SINCR,I RETURN CLA SECTR=MAX SO STA SECTR SET SECTR TO 1ST SECTR OF ISZ TRACK NEXT TRACK AND JMP SINCR,I RETURN GTPAR NOP LDA IFLAG FIRST TIME ? SZA JMP INITL üO������þú NO. ISZ IFLAG YES. BUMP FLAG LDA $OPSY A: 0=DOS, 1=IOMEC/DOS, -2=RTE CPA =D1 CHANGED FROM SLA,RSS 7-26-75 RSS THIS WAS ADDED 7-26-75 JMP INITL DOS OR RTE LDA =D128 IOMEC/DOS. BUFFR = 128 STA PSIZE CMA,INA STA MSIZE LDA BIGED STA BFRND INITL INB LDA 1 LDA 0,I BUFFER ADDRESS ? RAL,CLE,SLA,ERA PEEL OFF INDIRECT BIT JMP *-2 LOOP AS LONG AS INDIRECT STA ADDRS FWA OF USER BUFFER INB LDA 1,I LDA 0,I NUMBER OF WORDS CMA,INA STA COUNT SET COUNT INB LDA 1,I STA LUN ADDRESS OF LOGICAL UNIT NUMBER INB LDA 1,I LDA 0,I STA TRACK TRACK NO. INB LDA 1,I LDA 0,I STA SECTR SECTOR NO. INB LDA 1,I LDA 0,I OFFSET ADA MSIZE -64 OR -128 SSA,RSS OFFSET GE SECTOR SIZE? JMP *-2 YES, OFFSET MODULO SECTOR SIZE ADA PSIZE RESTORE OFFSET ADA BFFWA FWA OF BUFFER STA BFRAD SET BUFFER ADDRESS JMP GTPAR,I EXIT BREAD NOP LDB *-1 LDA 1,I STA BREAD SET RETURN ADDR JSB GTPAR GET PARAMETERS JSB READ READ SECTOR RMOVE LDA BFRAD,I STA ADDRS,I MOVE DATA-WORD ISZ COUNT END OF TRANSFER ? RSS NO,CONTINUE JMP BREAD,I EXIT LDA BFRAD CPA BFRND END OF SECTOR JMP *+4 YES, RE-INIT. AND READ NEXT SECT ISZ BFRAD BUMP SECTOR-BUFFER ADDRS ISZ ADDRS BUMP TARGET LOC JMP RMOVE CONTINUE XFER LDA BFFWA STA BFRAD SET READ-BUFFER ADDR AT FWA JSB SINCR BUMP SECTOR NUMBER ISZ ADDRS BUMP TARGET LOC JMP RMOVE-1 READ NEXT SECTOR AND CONTINUE READ NOP JSB EXEC READ SECTOR DEF *+7 DEF .1 RCOD&����� E= 1 FOR READ DEF LUN,I LOGICAL UNIT NUMBER BFFWA DEF BUFFR BUFFER FWA DEF PSIZE 64 OR 128 WORDS DEF TRACK TRACK NO. DEF SECTR SECTOR NO. JMP READ,I EXIT BWRIT NOP LDB *-1 LDA 1,I STA BWRIT SET RETURN ADDR JSB GTPAR GET PARAMETERS JSB READ READ BEFORE WRITE WMOVE LDA ADDRS,I STA BFRAD,I ISZ COUNT READY ? JMP *+3 NO, CONTINUE XFER JSB WRITE YES, WRITE SECTOR JMP BWRIT,I EXIT LDA BFRAD CPA BFRND END OF BUFFER ? JMP *+4 YES, WRITE SECTOR AND RE-INIT ISZ BFRAD BUMP WRITE-BUFFER ADDRS ISZ ADDRS BUMP SOURCE ADDR. JMP WMOVE CONTINUE XFER JSB WRITE WRITE SECTOR JSB SINCR BUMP SECTOR NUMBER LDA BFFWA STA BFRAD SET BUFFER ADDR AT FWA ISZ ADDRS BUMP SOURCE ADDRESS JMP WMOVE-1 DO NEXT SECTOR WRITE NOP JSB EXEC WRITE SECTOR DEF *+7 DEF .2 RCODE=2 FOR WRITE DEF LUN,I LOGICAL UNIT NUMBER DEF BUFFR BUFFER FWA DEF PSIZE 64 OR 128 WORDS DEF TRACK TRACK NO. DEF SECTR SECTOR NO. JMP WRITE,I EXIT ADDRS NOP PARAMETER ADDRS COUNT NOP WORD COUNT LUN NOP LOGICAL UNIT NUMBER TRACK NOP TRACK NO. SECTR NOP SECTOR NO. BFRAD NOP POINTER IN SECTOR-BUFFER BFRND DEF BUFFR+63 LWA 64 WORD SECTOR-BUFFER BIGED DEF BUFFR+127 LWA 128 WORD SECTOR-BUFFER PSIZE DEC 64 MSIZE DEC -64 .1 DEC 1 .2 DEC 2 IFLAG DEC 0 BUFFR BSS 128 SECTOR - BUFFER (MOVED 7-75) END * * ����������������������������������������Ö"������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18015 2013� S C0122 �&DBKPT � � � � � � � � � � � � � �H0101 z†�����ASMB,R,L,C HED * <DBKPT> DEBUG DUMMY SUBROUTINE * * * NAME: DBKPT * SOURCE: 92068-18015 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBKPT,7 92068-1X015 REV.2013 771116 * ENT $DBP2,$MEMR * * DUMMY ROUTINE TO SATISFY LOADER EXTERNALS FOR DEBUG. $DBP2 EQU * $MEMR EQU * * END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������…µ������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18016 2013� S C0122 �&DEBUG � � � � � � � � � � � � � �H0101 ƒp�����þúASMB,R,L,C HED *** RTE/2100 DEBUG *** * * NAME: DEBUG * SOURCE: 92068-18016 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DEBUG,7 92068-1X016 REV.2013 771123 ENT DEBUG ENT $DBP1 * EXT DBGLU,$DBP3 EXT $LIBR,$LIBX EXT EXEC,REIO EXT IFBRK * XTEMP EQU 1721B FENCE EQU 1775B BGLWA EQU 1777B * SUP * * * RTE 'DEBUG' IS A UTILITY-TYPE PROGRAM * PROVIDED WITH MEMORY BASED AND DISC BASED * OPERATING SYSTEMS. * * THE FUNCTION OF THIS PROGRAM IS TO PROVIDE * CHECKOUT FACILITIES FOR USER PROGRAMS LOADED * ON-LINE BY THE RELOCATING LOADER. * DEBUG IS COMBINED WITH A USER PROGRAM DURING * THE LOADING PROCESS. THE PRIMARY ENTRY * POINT OF THE ABSOLUTE PROGRAM UNIT IS SET * TO "INIT" IN DEBUG. THE TRANSFER POINT OF * THE USER PROGRAM IS STORED AT THE ENTRY POINT * "DEBUG" BY THE RELOCATING LOADER. THIS ALLOWS * DEBUG TO BE IN CONTROL WHEN THE USER PROGRAM * IS SCHEDULED AND INITIATED BY THE OPERATOR. * * THE USER PROGRAM (INCLUDING 'DEBUG') IS * SCHEDULED BY THE "RU" OR "ON" STATEMENT * * AN EXTERNAL ROUTINE, "DBGLU," * INITIALLY SETS THE LOGICAL UNIT # OF A * CONSOLE TO BE USED FOR OPERATOR/ * DEBUG COMMUNICATION IN "$DBP3". * "DBGLU" IS NOT APPENDED TO EACH SEGMENT * (ONLY TO THE MAIN) AND IS CALLED ONLY * ONCE (FROM THE MAIN). IF THE USER * DOES NOT ASSEMBLE HIS OWN "DBGLU," * THE LIBRARY VERSION USES THE * FIRST "RU" PARAMETER. * THE "$DBP3" ENTRY POINT IS ALSO USED TO * STORE THE LIST DEVICE LU AFTER INITIAL ENTRY. •3������þú* * WHEN DEBUG IS ENTERED, THE MESSAGE * "BEGIN 'DEBUG' OPERATION" IS TYPED AND AN * INPUT REQUEST IS MADE FOR THE FIRST STATEMENT * FROM THE OPERATOR. * SKP * * THE FOLLOWING STATEMENTS ARE VALID DEBUG COMMANDS. * * VALUES INDICATED BY THE SYMBOLS D1, D2, ..., DN * ARE OCTAL DATA VALUES. * VALUES INDICATED BY THE SYMBOLS A1 AND A2 ARE INTERPRETED * AS ADDRESSES. THE PROGRAM RELOCATION BASE (SEE * 'M' COMMAND) IS ADDED TO EACH TO FORM THE ACTUAL ADDRESS. * THE SIGN BIT OF THE RESULT MUST NOT BE SET. * * * * 0) A ABORT PROGRAM * * 1) B,A1 SET AN INSTRUCTION BREAKPOINT AT ADDRESS A1. * * * 2) D,A,A1[,A2][,H] ASCII DUMP OF CORE ADDRESS A1, * OR FROM A1 THRU A2. DISPLAY CONTROL * CHARACTERS IF 'H' ENTERED (HONESTY MODE). * D,B,A1[,A2] BINARY DUMP OF CORE ADDRESS A1, * OR FROM A1 THRU A2. * * 3) M,D1 SET ABSOLUTE BASE OF RELOCATABLE PROGRAM * TO D1. (ADDED TO ADDRESS INPUTS * AND SUBTRACTED FROM DISPLAYED ADDRESSES.) * * 4) R,A1 EXECUTE USER PROGRAM STARTING AT A1. * R EXECUTE STARTING AT CURRENT P-REGISTER. * (USED AFTER A BREAKPOINT TO CONTINUE PROGRAM * OR TO INITIATE PROGRAM EXECUTION.) * * 5) S,A1,D1 SET "D1" IN LOCATION "A1". * S,A1,D1,,DN SET "D1" TO "DN" IN SUCCESSIVE * MEMORY LOCATIONS BEGINNING AT * LOCATION "A1". * (AN OMITTED VALUE CAUSES A MEMORY * LOCATION TO REMAIN UNCHANGED.) * * 6) W,A,D1 SET A REGISTER TO DATA D1 * W,B,D1 SET B REGISTER TO DATA D1 * W,E,D1 SET E REGISTER (0=OFF, ELSE ON) * W,O,D1 SET OVERFLOW (0=OFF, ELSE ON) * * 7) X,A1 C�������þúLEAR BREAKPOINT AT ADDRESS A1. * * * AN ILLEGAL REQUEST OR OPERAND CAUSES THE MESSAGE * "ENTRY ERROR" TO BE TYPED AND THE INPUT REQUEST * REPEATED. SKP ORB BASE PAGE LINKS DBA DEF DEBUG DBA.I DEF DEBUG,I ORR INIT JSB SAVR SAVE REGISTERS * (LOADER PUTS PRIMARY ENTRY POINT IN 'DEBUG'.) LDA DEBUG STA PREG LDA INITS LDB DBGLU IF THE CONSOLE LU IS KNOWN, SZB JMP INIT1 DO NOT CALL DBGLU JSB RSTR RESTORE REGISTERS JSB DBGLU FETCH CONSOLE LU LDA $DBP3 SZA,RSS OR ZERO, USE "1" CLA,INA FOR SYSTEM CONSOLE. STA $DBP3 SET FOR OUTPUT CALL. IOR =B400 SET K BIT FOR KEYBOARD STA DBGLU INPUT CALL. LDA INITA * * INIT1 LDB =D-14 MPERP STB NOSIM NO INSTRUCTION TO SIMULATE ERP JSB OUT * START LDA QUESA REQUEST DATA ENTRY. LDB =D-2 JSB OUT PROMPT * JSB REIO REQUEST INPUT DEF *+5 DEF B1 DEF DBGLU IDATX DEF IDATA DEF M72 * SZB,RSS JMP START NO INPUT, ASK AGAIN STB INCNT CLA STA INC INITIALIZE POINTERS JSB GETAS GET ASCII INPUT CPA =B101 "A" JMP TERM TERMINATE DEBUG OPERATION. CPA =B102 'B' JMP BA SET BREAKPOINT CPA D JMP DA DUMP MEMORY CPA M JMP MA SET MODULE MEMORY BASE CPA R JMP RA RUN PROGRAM CPA S JMP SA SET VALUES IN MEMORY CPA W JMP WA SET REGISTERS CPA X JMP XA CLEAR BREAKPOINT * INER LDA INERX LDB =D-12 JMP ERP * * TERM JSB EXEC "COMPLETION" DEF *+2 REQUEST DEF B6 TO SYSTEM. * * INITA DEF *+1 ASC 7, BEGIN 'DEBUG' INITS DEF *+1 ASC 7, BEGIN SEGMENT QUESA DEF *+1 .»������þú ASC 1,?_! * * INIT2 CLA JSB $FORM "P=NNNNN JSB DEBUG" DEF INITJ DEF PREG JSB $PRNT CCB STB NOSIM JMP START * * INITJ ASC 8, P=@ JSB DEBUG! SKP * ************ - LIST - **** LIST DATA * * * THIS ROUTINE LISTS INFO ON DEVICE GIVEN BY $DBP3 * * * ON ENTRY, A=DATA ADDRESS, B=CHARACTER COUNT * * * LIST NOP STA LSTB SAVE ADDRESS STB OUT * JSB REIO OUTPUT IT DEF *+5 DEF B2 WRITE REQUEST CODE DEF $DBP3 LIST DEVICE LSTB NOP BUFFER ADDRESS DEF OUT COUNT * JMP LIST,I * * ******** - OUT - **** OUTPUT DATA * * * THIS ROUTINE OUTPUTS A BLOCK OF DATA ON THE CONSOLE * * * * * INPUT: * A= DATA ADDRESS * B= CHARACTER COUNT (- #) * * * OUT NOP STA OUTB SAVE ADDRESS STB LIST SAVE CHARACTER COUNT. * JSB REIO WRITE DEF *+5 CALL DEF B2 DEF DBGLU OUTB NOP -BUFFER ADDRESS. DEF LIST * JMP OUT,I EXIT. SKP * *** *** -BA- ** ** -BREAKPOINT- * * THIS ROUTINE IS ENTERED WHEN A BREAKPOINT STATEMENT * IS RECOGNIZED. THE STATEMENT FORMAT IS: * * B,A INSTRUCTION BREAKPOINT AT (A). * * A TOTAL OF 15 BREAKPOINT SELECTIONS CAN BE * IN EFFECT AT ONE TIME. THE SELECTIONS ARE * STORED IN THE BKPTB (BREAKPOINT TABLE) ALONG * WITH THE INSTRUCTION AT (A). THERE ARE 2 WORDS * PER ENTRY. THE LENGTH OF THE TABLE MAY BE * MODIFIED BY CHANGING THE TERMINATOR (BKPLG) AND * THE VALUE OF THE REP STATEMENT AND RE-ASSEMBLING. * * BA JSB CONVA GET THE BREAKPOINT ADDRESS. JMP INER ADDRESS REQUIRED SZA CPA B1 JMP INER CAN'T PUT BREAK IN A- OR B-REGISTER STA TEMP SAVE ABSOLUTE ADDRESS. JSB MPCHK CHECK FOR MEMORY PROTECT * JSB SERCH SEARCH BREAKPOINT TABLE =������þú CLA,RSS SET TO SEARCH FOR EMPTY SLOT JMP INER THIS BREAKPOINT IS ALREADY SET JSB SERCH JMP INER NO EMPTY SLOTS IN BREAKPOINT TABLE * LDA TEMP SET INSTR. ADDRESS STA B,I IN WORD 1 OF ENTRY. LDA A,I SET INSTRUCTION INB IN WORD 2 STA B,I OF ENTRY. LDA JSBDB SET 'JSB DEBUG' STA TEMP,I TO REPLACE FIRST WORD OF CODE JMP START -GET NEXT ENTRY. * * SKP * *** *** -DA- *** *** -DUMP- * * THIS ROUTINE IS ENTERED WHEN A DUMP STATEMENT * HAS BEEN ENTERED BY THE USER. THE ACCEPTABLE * ENTRIES ARE AS FOLLOWS: * * * * * * D,A,A1[,A2][,H] A= ASCII OUTPUT * D,B,A1[,A2] B= BINARY OUTPUT ***************************** * DA JSB GETAS GET A CH, (A) OR (B). LDB $! CPA =B101 'A' LDB "! ASCII DUMP STB BLANK+1 * JSB CONVA GET 1ST DUMP ADDRESS. LDA MEMOR DEFAULT TO MEMORY BASE STA DSA SAVE ACTUAL DUMP STARTING ADDRESS. JSB CONVA NO, GET NEXT ADDRESS LDA DSA DEFAULT TO FIRST ADDRESS STA SAVR SAVE LAST DUMP ADDRESS. LDA DSA CMA,INA ADA SAVR SSA JMP INER FIRST > LAST JSB GETC INPUT HONESTY MODE CHAR JMP *+2 NO INPUT STA HMODE * CLA JSB $FORM DUMP HEADING DEF DMHD DEF MEMOR MEMORY BASE JSB $PRNT PRINT LINE * NEXTA LDA =D-8 STA CONVA CLA JSB $FORM PRINT ADDRESS DEF DMADD DEF DSA * NEXTV CCA JSB $FORM PRINT DATA VALUE DEF BLANK DSA DEF * * LDA DSA ISZ DSA BUMP TO NEXT VALUE CPA SAVR JMP DONE LAST VALUE ISZ CONVA JMP NEXTV JSB IFBRK ABORT LISTING IF 'BR' COMMAND ENTERED DEF *+1 SZA JMP DONE JSB $PRNT PRINT LINES‹������þú JMP NEXTA START NEW LINE * BLANK ASC 2, XX DMHD ASC 7, DUMP--BASE = $! ASC 1,$! "! ASC 1,"! DMADD ASC 2, @ ! * * DONE JSB $PRNT PRINT LAST LINE JMP START * *** *** -MA- *** *** -MEMORY ORIGIN- * * THIS ROUTINE IS ENTERED WHEN A MEMORY ORIGIN STATEMENT * HAS BEEN ENTERED BY THE USER. THIS ESTABLISHES THE * BASE TO BE ADDED TO ALL SUBSEQUENT ADDRESS ENTRIES * MADE BY THE USER IN ALL STATEMENTS. THE ACCEPTABLE * ENTRY IS: * * * * * M,A A = THE OCTAL BASE ADDRESS. * * EXIT: MEMOR CONTAINS THE MEMORY ORIGIN (BASE) ADDRESS. * * MA JSB CONV GET THE ADDRESS CLA SSA JMP INER CANNOT HAVE INDIRECT BIT SET STA MEMOR SET USER BASE ADDRESS. JMP START INPUT NEXT STATEMENT. SKP *** *** -RA- *** *** -RUN- * * THIS ROUTINE IS ENTERED WHEN A RUN STATEMENT HAS * BEEN ENTERED BY THE USER. THIS STATEMENT RESULTS * IN THE PROGRAM RUNNING AT THE SPECIFIED ADDRESS. * IF NO ADDRESS IS SPECIFIED THE PROGRAM WILL RUN * AT THE ADDRESS OF THE NEXT PROGRAM INSTRUCTION. * ENTRIES ARE AS FOLLOWS: * * * * * R RUN AT NEXT PROGRAM ADDRESS. * (THE FIRST TIME, THE B-REGISTER * WILL BE SET UP TO RETRIEVE THE * 'RU' PARAMETERS.) * R,A1 RUN AT ADDRESS A1. * (BREAK INSTRUCTION IS NOT SIMULATED.) * * RA JSB CONVA FETCH RUN ADDRESS JMP RA1 SZA CPA B1 JMP INER CANNOT EXECUTE A- OR B-REGISTER JSB MPCHK CHECK FOR MEMORY PROTECT STA PREG SET NEW RUN ADDRESS AS 'PREG' RA0 JSB RSTR DO NOT SIMULATE BREAK INSTRUCTION JMP PREG,I GO FOR FULL EXECUTION * RA1 LDB NOSIM SSB JMP RA0 SKIP INSTRUCTION SIMULATION LDA PREG INA STA JSBAD,I STORE RETURN ADDRESS FOR JSB * (IF NOT A JSB INSTRUCTION, STORES ADDRESS IN A-REGISTER.Îm������þú) JSB RSTR -RESTORE PROGRAM REGISTERS. INSTR NOP SIMULATE BREAK INSTRUCTION * * * RSS (OVERLAID BY 2-WORD INSTRUCTIONS) ISZ PREG INCREMENT P IF A SKIP RESULTED. ISZ PREG NORMAL P-REGISTER INCREMENT JMP PREG,I GO TO PROGRAM. * * * RSTR NOP RESTORE DATA REGISTERS LDB IDTMP FROM SAVE AREA LDA XTEMP TO ID SEGMENT JSB MOVE5 LDA EOVRG CLO SLA,ELA STO DLD DLD AREG JMP RSTR,I * * * SAVR NOP SAVE DATA REGISTERS DST DST AREG ERA,ALS SOC INA STA EOVRG LDB XTEMP FROM ID SEGMENT LDA IDTMP TO SAVE AREA JSB MOVE5 JMP SAVR,I * * MPCHK NOP CHECK FOR MEMORY PROTECT JSB CHK JMP INER OUTPUT ERROR MESSAGE JMP MPCHK,I * * CHK NOP CHECK FOR MEMORY PROTECT SZA CPA B1 JMP OK A- & B-REG LEGAL STA IDRST LDA FENCE CMA,INA ADA IDRST CHECK FOR ADDRESS UNDER FENCE SSA JMP CHK,I BELOW FENCE LDA IDRST CMA,INA ADA BGLWA SSA JMP CHK,I BEYOND LAST WORD OF MEMORY LDA IDRST OK ISZ CHK GOOD RETURN JMP CHK,I * * ACHK NOP MEMORY PROTECT ON CURRENT INSTR JSB CHK RSS BAD ADDRESS JMP ACHK,I OK MPERR LDA MPDF LDB =D-12 JMP MPERP * * * MPDF DEF *+1 ASC 6, MEM PROTECT SKP *** *** *** -SA- *** -SET MEMORY- * * THIS ROUTINE IS ENTERED WHEN A SET MEMORY STATEMENT * HAS BEEN ENTERED BY THE USER. THIS STATEMENT ALLOWS * THE USER TO SET ONE OR SEVERAL CONSECUTIVE MEMORY * ADDRESS'S TO SPECIFIED VALUES. THE ACCEPTABLE * ENTRIES ARE AS FOLLOWS: * * * * * S,A1,D1 STORE D1 IN A1 * S,A1,D1,D2 STORE D1 IN A1, D2 IN A1+1 * S,A1,D1,,D2 STORE D1 IN A1, D2 Iû¦������þúN A1+2 * (OMITTED VALUES SKIP ONE ADDRESS.) * * THE NUMBER OF DATA ENTRIES IS LIMITED * BY LINE LENGTH (72 CH'S). * * SA JSB CONVA FETCH THE MEMORY ADDRESS. JMP INER STA TEMP * SA1 JSB CONV INPUT DATA WORD JMP SA2 IF DEFAULT, DO NOT STORE STA CONV LDA TEMP JSB CHK CHECK FOR MEMORY PROTECT JMP MPER SZA,RSS JMP WA10 SET A-REGISTER CPA B1 JMP WA20 SET B-REGISTER JSB SERCH CHECK FOR BREAK INSTRUCTION JMP STUFF NO INB LDA CONV STA B,I CHANGE BREAK TABLE SA2 LDA INC NUMBER OF CHARACTERS PROCESSED ISZ TEMP CPA INCNT DONE IF ALL CHARACTERS READ JMP SA3 JMP SA1 * STUFF LDA CONV STA TEMP,I JMP SA2 * WA10 STA AREG JMP SA2 * WA20 STA BREG JMP SA2 * * MPER CLA JSB $FORM 'ADDR XXXXX ILLEGAL' DEF ILGL DEF TEMP JSB $PRNT * SA3 LDA NOSIM SSA JMP START NO INSTRUCTION TO SIMULATE LDA PREG SIMULATED INSTRUCTION MAY HAVE CHANGED JMP ANLYZ RE-EVALUATE IT * * ILGL ASC 8, ADDR @ ILLEGAL! * SKP *** *** -WA- *** -SET REGISTER- * * THIS ROUTINE IS ENTERED WHEN A SET REGISTER * STATEMENT HAS BEEN ENTERED BY THE USER. THIS * STATEMENT ALLOWS THE USER THE ABILITY TO * MODIFY REGISTERS AS DEFINED IN THE FOLLOWING * ACCEPTABLE ENTRIES: * * * * * W,A,D1 SET AREG = D1 * W,B,D1 BREG = D1 * W,E,D1 EREG = D1 * W,O,D1 OREG = D1 (OVERFLOW) * * WA JSB GETAS FETCH THE REGISTER ID STA TEMP JSB CONV GET REGISTER DATA WORD. CLA LDB TEMP CPB =B101 SET A REGISTER? JMP WA1 YES CPB =B102 SET B REGISTER? JMP WA2 YES CLE,SZA CCE CPB ¬������þúE SET E REGISTER? JMP WA3 YES CPB O SET OVERFLOW? JMP WA5 YES JMP INER NO, REGISTER ID ERROR. * WA1 STA AREG SET A REGISTER JMP SA3 * WA2 STA BREG SET B REGISTER JMP SA3 * WA3 LDB EOVRG SAVED REGISTERS RBL,ERB WA4 STB EOVRG JMP START * WA5 LDB EOVRG RBR,ELB E TO LEAST BIT JMP WA4 * SKP * *** *** -XA- ** ** - CLEAR BREAKPOINT - * * THIS ROUTINE IS ENTERED WHEN A CLEAR BREAKPOINT * STATEMENT IS RECOGNIZED. THE STATEMENT FORMAT IS: * * X,A1 CLEAR BRKPT AT ADDRESS "A1". * * A SCAN OF THE BREAKPOINT TABLE IS MADE TO * FIND A MATCHING BP ADDRESS TO "A1". IF NO MATCH * IS FOUND, "ENTRY ERROR" IS TYPED. * * IF A MATCH IS FOUND, THE USER INSTRUCTION IS * RESTORED IN (A1), THE BREAKPOINT TABLE ENTRY IS * CLEARED AND CONTROL TRANSFERRED TO "START". * * XA JSB CONVA GET BREAKPOINT ADDRESS JMP INER ADDRESS REQUIRED STA TEMP AND SAVE IT. JSB SERCH SEARCH BREAKPOINT TABLE JMP INER NOT FOUND * CLA SET WORD 1 OF STA B,I ENTRY = 0. INB GET USER INSTR. LDA B,I FROM WORD 2. STA TEMP,I RESTORE IN USER PROGRAM. JMP START -GET NEXT ENTRY. * SKP * * * INSTRUCTION BREAKPOINT PROCESSOR * * * THE BREAK COMMAND SETS 'JSB DEBUG' INSTRUCTIONS * IN PLACE OF EXISTING CODE AND SAVES THE REPLACED * INSTRUCTION IN THE BREAK TABLE. * * WHEN 'DEBUG' IS ENTERED BY A 'JSB' * THE ADDRESS OF THE BREAKPOINT IS DETERMINED * BY SCANNING THE BREAKPOINT TABLE TO * FIND A MATCH. * 'DEBUG' CAN ALSO BE ENTERED BY A JUMP TO 'ANLYZ'. * THIS ENTRY POINT RE-EVALUATES THE CURRENT INSTRUCTION * IN CASE IT HAS BEEN CHANGED BY THE 'S' COMMAND. * * THE INSTRUCTION TO BE SIMULATED IS DECODED, AND * THE REGISTERS AND MEMORY VALUES ARE DISPLAYED. * THE INSTRUCTION AT THE BREAKp4������þúPOINT ADDRESS IS * SET IN 'INSTR'. THE FINAL ADDRESS OF * A MEMORY REFERENCE INSTRUCTION IS SET * IN 'DEBUG'. CONTROL IS THEN TRANSFERRED * TO 'START'. * * $DBP1 EQU * DEBUG NOP JSB SAVR SAVE DATA REGISTERS CLA STA SW1 STA IOCHK PRINT REGISTERS ONLY ONCE CCA ADA DEBUG STA PREG SAVE BREAK ADDRESS AS P-REGISTER. * ANLYZ JSB SERCH SEARCH BREAKPOINT TABLE JMP INIT2 NOT FOUND, DIRECT JSB TO DEBUG INB SET TO WORD 2 OF ENTRY. LDA B,I GET INSTRUCTION * STA INSTR LDA RSS STA INSTR+1 CLA STA NOSIM ALLOW INSTRUCTION SIMULATION STA JSBAD DEFAULT TO 'NOT A JSB' JSB DECOD DECODE INSTRUCTION STA SFLAG STB OP * SZA,RSS JMP PSTD NOT MEMORY REFERENCE LDB =D-24 STB DEBUG * INA,SZA JMP WORD1 1-WORD INSTRUCTION LDB PREG INB LDB B,I GET UNRESOLVED ADDRESS JSB INDIR CLEAR INDIRECTS LDA DEF.I STA INSTR+1 JMP DBP4 * WORD1 LDA IDRST ALF,RAL ELA Z OR C BIT IN E LDA IDRST AND =B101777 PAGE OFFSET AND INDIRECT BIT STA B CLA,SEZ LDA PREG ADDRESS OF INSTRUCTION AND =B76000 PAGE PREFIX ADB A B CONTAINS ADDRESS JSB INDIR CLEAR INDIRECTS * LDA IDRST AND =B74000 CPA JSB JSB COMMAND? RSS JMP DBP3 NO STB JSBAD LOCATION OF RETURN ADDRESS LDA JMP.I SIMULATE JMP INSTRUCTION INB,RSS ADDRESS OF JUMP DBP3 IOR DEF.I MAKE IT REFERENCE 'DEBUG' STA INSTR DBP4 CPB DEFA CLB USE REAL A-REGISTER CPB DEFB CLB,INB USE REAL B-REGISTER STB DEBUG SAVE MEMORY ADDRESS * SKP * * * THIS ROUTINE PRINTS THE CONTENTS OF * THE SAVED P-REGISTER, INSTRUCTIO¾������þúN REGISTER, * A-, B-, E-, AND O-REGISTERS. IF THE * INSTRUCTION IS A MEMORY REFERENCE INSTRUCTION, * THE MEMORY ADDRESS AND CONTENTS ARE ALSO * DISPLAYED. THE A- AND B-REGISTERS AND THE * MEMORY CONTENTS ARE DISPLAYED. * PSTD LDB BLK0 SET E AND O TO ZERO IN MESSAGE STB E1 STB O1 LDB BLK1 LDA EOVRG SSA STB E1 SET E TO 1 SLA STB O1 SET O TO 1 * CLA JSB $FORM OUTPUT REGISTERS DEF REGMS DEF PREG PREG NOP DEFA DEF AREG DEFB DEF BREG * LDA SFLAG SZA,RSS JMP IOCHK NOT MEMORY REFERENCE LDB DEBUG SSB JMP IND INDIRECT LOOP JSB $FORM DEF MAMS PRINT MEMORY ADDRESS DEF DEBUG DEF.I DEF DBA.I,I AND CONTENTS SW1 NOP JSB $PRNT PRINT SECOND LINE LDA RSS STA SW1 PRINT ONLY ONCE * LDA JSBAD JSB ACHK CHECK FOR MEMORY PROTECT LDA DEBUG LDB SFLAG CPB =B70000 IF 'STA' OR 'STB' JSB ACHK CHECK FOR MEMORY PROTECT LDB INSTR CPB DST OR DOUBLE STORE JMP BCHK NO DOUBLE STORE TO B-REGISTER CPB ISZ.I OR ISZ JSB ACHK CPB JMP.I OR 'JMP' OR 'JSB' RSS JMP START DONE SZA NO JUMP TO A- OR B-REGISTER BCHK CPA B1 JMP MPERR JSB ACHK JMP START * * IOCHK NOP JSB $PRNT LDA RSS STA IOCHK PRINT ONLY ONCE LDA OP SSA JMP UNDEF UNRECOGNIZED INSTRUCTION SZA JMP START LDA INSTR I/O INSTRUCTION AND =B77 CPA B1 RSS RSS JMP MPERR SELECT CODE NOT 1 LDA INSTR AND =B700 SZA,RSS JMP MPERR HALT JMP START * REGMS ASC 10, P=@ I=$ A=$ B=$ E= E1 ASC 2,XXO= O1 ASC 2,XX ! MAMS ASC 5,MA=@ MC=$! * * UNDEF LDA INST? LDB =D-10 à¸������þú JMP MPERP UNRECOGNIZED INSTRUCTION * INST? DEF *+1 ASC 5, ? INSTR ? * IDRST NOP * * * * SKP * * INDIR NOP RESOLVE INDIRECT ADDRESS RBL,CLE,ERB SZB,RSS LDB DEFA A-REGISTER REFERENCE CPB B1 LDB DEFB B-REGISTER REFERENCE SEZ,RSS JMP INDIR,I DONE LDB B,I ISZ DEBUG JMP INDIR+1 * * TOO MANY LEVELS OF INDIRECT ADDRESSES!! * * STB NOSIM DO NOT SIMULATE INSTRUCTION JMP DBP4 SAVE ADDRESS * * * * IND JSB $FORM 'INDIRECT LOOP' DEF TIN JMP DONE * SKP * * * THIS ROUTINE DECODES AN HP 2100 INSTRUCTION. * THE A-REG IS SET TO ZERO FOR REGISTER REFERENCE * INSTRUCTIONS, TO -1 FOR 2-WORD MEMORY REFERENCE * INSTRUCTIONS, AND GREATER THAN ZERO FOR 1-WORD MEMORY * REFERENCE INSTRUCTIONS. IN ADDITION, THE * B-REGISTER IS SET TO A VALUE INDICATING MORE * EXACTLY THE TYPE OF INSTRUCTION, AS FOLLOWS: * 00-I/O GROUP * 01-EAU GROUP * 02-MPY * 03-DIV * 04-DLD * 05-DST * 06-SHIFT-ROTATE GROUP (A) * 07-SHIFT-ROTATE GROUP (B) * 08-ALTER-SKIP GROUP (A) * 09-ALTER-SKIP GROUP (B) * 10-AND * 11-JSB * 12-XOR * 13-JMP * 14-IOR * 15-ISZ * 16-ADA * 17-ADB * 18-CPA * 19-CPB * 20-LDA * 21-LDB * 22-STA * 23-STB * 24-FIX * 25-FLT * 26-FAD * 27-FSB * 28-FMP * 29-FDV * * -1-XXX (UNRECOGNIZED) * * * 5Â������þúON ENTRY, B= ADDRESS OF INSTRUCTION * DECOD NOP DECODE INSTRUCTION LDA B,I STA IDRST AND =B70000 STA INDIR SZA JMP MRFIN ONE-WORD MEMORY REFERENCE LDA IDRST CLB,INB CPA DST OP=5 INB,RSS CPA DLD OP=4 INB,RSS CPA DIV OP=3 WD2 INB,RSS CPA MPY OP=2 INB,RSS JMP DCD2 ONE WORD REGISTER REFERENCE OR I/O CCA JMP DECOD,I * DCD2 AND =B177760 MASK OFF SHIFT COUNT CPA ASR JMP DCDEX CPA ASL JMP DCDEX CPA LSR JMP DCDEX CPA LSL JMP DCDEX CPA RRR JMP DCDEX CPA RRL JMP DCDEX RAL,SLA,ALF JMP DCD3 LDB B6 SSA SHIFT-ROTATE? ADB B2 NO, ALTER-SKIP SLA A-REGISTER? INB NO, B-REGISTER JMP DCDEX * DCD3 CLB I-O GROUP? SSA JMP DCDEX YES LDB =D24 CHECK FOR FLOATING POINT LDA IDRST CPA FLT INB,RSS CPA FIX JMP DCDEX NO ADDRESS REQUIRED * CPA FDV INB,RSS CPA FMP INB,RSS CPA FSB INB,RSS CPA FAD JMP WD2 2-WORD MEMORY REFERENCE * CCB JMP DCDEX UNRECOGNIZED * MRFIN LDA IDRST AND =B74000 ISOLATE OP CODE ALF,RAL ADA =B10 STA B DCDEX LDA INDIR JMP DECOD,I * ASR ASR 16 ASL ASL 16 LSR LSR 16 LSL LSL 16 RRR RRR 16 RRL RRL 16 MPY OCT 100200 DIV OCT 100400 FIX OCT 105100 FLT OCT 105120 FAD OCT 105000 FSB OCT 105020 FMP OCT 105040 FDV OCT 105060 * SKP * *CALLING SEQUENCE: * CLA IF START OF MESSAGE * OR * CCA(NON-ZERO) IF CONTINUATION OF PREVIOUS MESSAGE * JSB $FORM * DEF MSG ADDRESS OF MESSAGE * DEF V1 FIRST VALUE * DEF V2ç˜������þú SECOND VALUE * (ANY NUMBER OF VALUES TO LIMIT OF BUFFER SPACE) * * JSB $PRNT SEND TO LIST DEVICE * *THE MESSAGE IS SCANNED AND MOVED TO THE OUTPUT BUFFER A CHARACTER *AT A TIME. THE FOLLOWING CHARACTERS CAUSE SPECIAL ACTION TO OCCUR: * * " CAUSES TWO ASCII CHARACTERS TO BE OUTPUT. * * $ CAUSES AN OCTAL VALUE TO BE CONVERTED TO ASCII * AND MOVED TO THE OUTPUT BUFFER (6 DIGITS OUTPUT). * * @ CAUSES AN OCTAL VALUE TO BE INTERPRETED AS A * 'DEBUG' ADDRESS WITH OFFSET 'MEMOR' IN MEMORY. * ONLY 5 DIGITS ARE OUTPUT. * * * ! TERMINATES THE LINE OF OUTPUT. * * *FOR EXAMPLE: * CLA * JSB $FORM * DEF SAMP * DEF OCT * DEF ASC * JSB $PRNT * . * . * . *OCT OCT 100001 *ASC ASC 1,$. * *SAMP ASC 2,$ "! * *WILL PRINT THE FOLLOWING: *100001$. * * * $FORM NOP OUTPUT FORMATTER SZA,RSS STA CNTT LDA $FORM ISZ $FORM LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA DEFF CLA STA CNTF NEXT JSB FECH GET A CHARACTER FROM MESSAGE CPA $ JMP CVT DOLLAR, CONVERT SPECIAL VALUE CPA " JMP CVT CPA @ JMP CVT CPA ! JMP $FORM,I JSB PUTC MOVE CHARACTER TO OUTPUT BUFFER JMP NEXT * CVT LDB $FORM ISZ $FORM LDB B,I RBL,CLE,SLB,ERB JMP *-2 CPA @ JMP ADDRS @, 5 DIGIT ADDRESS CLE,SZB,RSS LDB DEFA USE DEBUG A-REGISTER CPB B1 LDB DEFB USE DEBUG B-REGISTER STA FECH LDA B JSB SERCH IF VALUE IN BREAK TABLE JMP *+2 INB,RSS USE TABLE ADDRESS TO FETCH VALUE LDB A LDA FECH CPA " JMP ASCII TWO ASCII CHARACTERS * LDB B,I OCTAL CONVERSION CLA RRR 2 JSB DIGIT OUTPUT BIT FIFTEEN OUT5 REP 5 AND REMAINÁ¯������þúING CHARACTERS JSB DIGIT JMP NEXT * * * $PRNT NOP OUTPUT LINE TO LIST DEVICE LDB CNTT CMB,INB NEGATE CHARACTER COUNT LDA MSAD BUFFER ADDRESS JSB LIST OUTPUT TO LIST DEVICE JMP $PRNT,I * * ADDRS LDA B,I STA $PRNT LDB MEMOR CMB,INB CHECK FOR BELOW MEMORY BASE ADB A SSB,RSS ABSOLUTE ADDRESS IF B NEGATIVE, OR BASE=0 CPB A JMP ABS STB $PRNT PRINT OFFSET, NOT ABSOLUTE ADDRESS LDA M JSB PUTC 'M' LDA =B53 '+' JMP OUT2 * ABS LDA =B40 JSB PUTC LDA =B40 OUT2 JSB PUTC CLA LDB $PRNT RBL DO NOT PRINT SIGN DIGIT JMP OUT5 * * ASCII LDA HMODE CPA H HONESTY MODE? JMP HA1 YES LDA B,I ALF,ALF AND =B177 CPA =B177 'DELETE' CHARACTER? JMP RP1 YES, REPLACE IT AND =B140 SZA NON-PRINTING CHAR? JMP HA1 NO RP1 LDA =B40 YES, REPLACE WITH SPACE JMP PUT1 HA1 LDA B,I ALF,ALF AND =B377 PUT1 JSB PUTC OUTPUT FIRST CHAR * LDA HMODE CPA H HONESTY MODE? JMP HA2 YES LDA B,I AND =B177 CPA =B177 'DELETE' CHARACTER? JMP RP2 YES, REPLACE IT AND =B140 SZA NON-PRINTING CHAR? JMP HA2 NO RP2 LDA =B40 YES, REPLACE WITH SPACE JMP PUT2 HA2 LDA B,I AND =B377 PUT2 JSB PUTC SECOND CHAR JMP NEXT * * * * FECH NOP LDA CNTF ISZ CNTF CLE,ERA ADA DEFF LDA A,I SEZ,RSS ALF,ALF AND =B377 JMP FECH,I * $ OCT 44 " OCT 42 @ OCT 100 ! OCT 41 * * * DIGIT NOP RRL 3 SHIFT THREE BITS INTO A IOR =B60 ADD ASCII PREFIX JSB PUTC CLA ¯«������þú SET FOR NEXT CHARACTER JMP DIGIT,I * * * * * * PUTC NOP STB FECH LDB CNTT CPB MAX JMP PUTEX TOO MANY CHARCTERS FOR BUFFER - IGNORE IT ISZ CNTT CLE,ERB ADB MSAD SEZ IOR B,I ADD PREVIOUS CHAR SEZ,CLE,RSS ALF,ALF ROTATE TO UPPER CHAR STA B,I PUTEX LDB FECH JMP PUTC,I * * * CNTF NOP NUMBER OF CHARS ALREADY READ CNTT NOP NUMBER OF CHARACTERS OUTPUT MAX DEC 80 MAX NUMBER OF CHARACTERS OUTPUT MSAD DEF $MSBF ADDRESS OF CHARACTER COUNT $MSBF BSS 40 80 CHAR BUFFER DEFF NOP ADDRESS OF MESSAGE * * * ******* MOVE5 *********** * * * THIS ROUTINE MOVES THE ID SEGMENT TEMPORARY VALUES * TO THE SAVE AREA WHEN A BREAK IS ENCOUNTERED, AND * RESTORES THEM BEFORE RETURNING TO THE PROGRAM. * * * CALLING SEQUENCE: * * LDB FROM * LDA TO * JSB MOVE5 * * * MOVE5 NOP JSB $LIBR TURN OFF INTERRUPTS DEC 0 TO PREVENT MEMORY PROTECT VIOLATION STA GETC SAVE DESTINATION ADDRESS LDA =D-5 STA GETAS * RMPLP LDA B,I STA GETC,I INB ISZ GETC ISZ GETAS JMP RMPLP JSB $LIBX RESTORE INTERRUPTS DEF MOVE5 * IDTMP DEF *+1 BSS 5 IDSEG PARAMETERS * SKP ****** ** GETC ** * * THIS ROUTINE EXTRACTS A CHARACTER FROM THE * INPUT OPTION STATEMENT AND RETURNS TO THE * CALLER WITH THE CHARACTER RIGHT JUSTIFIED IN "A". * GETC NOP LDA INC CPA INCNT JMP GETC,I NO MORE CHARACTERS ISZ INC CLE,ERA ADA IDATX LDA A,I SEZ,RSS ALF,ALF SHIFT TO RIGHT BYTE AND =B377 CPA =B40 JMP GETC+1 IGNORE ALL SPACES CPA COMA JMP GETC,I ISZ GETC GOOD RETURN JMP GETC,I * * INC NOP INCNT NOP SKP * * THÊ������þúIS ROUTINE RETURNS A SINGLE ASCII CHARACTER * FROM THE INPUT BUFFER. * GETAS NOP GET ONE ASCII CHARACTER CLB JSB GETC THIS IS IT JMP ASCEX NO INPUT, DEFAULT TO ZERO STA B JSB GETC THROW AWAY COMMA RSS JMP *-2 NOT A COMMA ASCEX LDA B JMP GETAS,I * * SKP * * ********* -CONV- ************ * * THIS ROUTINE CONVERTS THE NEXT INPUT VALUE * TO BINARY. THE VALUE IS RETURNED IN THE * A- AND B-REGISTERS. * ALL SPACES ARE SKIPPED. * VALUES MUST BE IN THE RANGE 0 TO 177777. * EACH DIGIT MUST BE IN THE RANGE 0 TO 7. * * * CALLING SEQUENCE: * JSB CONV * *** NO INPUT * *** INPUT VALUE IN A- AND B-REGISTER * * CONV NOP JSB GETC GET FIRST CHARACTER JMP CONV,I NONE,EXIT ISZ CONV CLB CONLP AND =B7 BLF,CLE,RBR ADB A JSB GETC GET NEXT CHARACTER RSS DONE JMP CONLP LDA B JMP CONV,I ******* -CONVA- ********* * THIS ROUTINE CHANGES AN INPUT VALUE TO * A MEMORY ADDRESS BY ADDING THE ABSOLUTE * MEMORY BASE TO IT (SEE 'M' COMMAND). * IF THE INDIRECT BIT IS SET ON THE ORIGINAL * VALUE, OR ON THE CONVERTED VALUE, AN ERROR * MESSAGE IS OUTPUT. * * CALLING SEQUENCE: * JSB CONVA * *** NO INPUT * *** ADDRESS IN A * * CONVA NOP GET AN ADDRESS JSB CONV INPUT VALUE JMP CONVA,I NO INPUT SSA JMP INER NEGATIVE VALUE ADA MEMOR SSA JMP INER INDIRECT BIT SET ISZ CONVA JMP CONVA,I * * * * * ********* -SERCH- *********** * THIS ROUTINE SEARCHES THE BREAKPOINT TABLE FOR * THE MEMORY ADDRESS IN THE A-REGISTER. * THE ADDRESS OF THE BREAKPOINT TABLE ENTRY IS * RETURNED IN B. * * CALLING SEQUENCE: * LDA ADDRESS * Ó™���l��jfJSB SERCH * *** NOT FOUND * *** TABLE ENTRY IN B * SERCH NOP LDB BKPTA START OF BREAKPOINT TABLE SERLP CPA B,I JMP SEREX FOUND ADB B2 CPB BKPLG JMP SERCH,I END OF BREAKPOINT TABLE JMP SERLP * SEREX ISZ SERCH JMP SERCH,I * SKP A EQU 0 B EQU 1 * AREG OCT 0 SIMULATED A REGISTER BREG OCT 0 SIMULATED B REGISTER B1 OCT 1 B2 OCT 2 B6 OCT 6 BLK0 ASC 1,0 0,BLK BLK1 ASC 1,1 1,BLK * COMA OCT 54 COMMA (,) * D OCT 104 E OCT 105 EOVRG OCT 0 E REG = BIT 15; OV = BIT 0 * H OCT 110 HMODE NOP HONESTY MODE FOR ASCII OUTPUT IDATA BSS 37 INPUT DATA BUFFER INERR ASC 6,ENTRY ERROR INERX DEF INERR ORIGIN OF ENTRY ERROR MESSAGE. ISZ.I ISZ DBA.I,I * JMP.I JMP DBA.I,I JSB JSB 0 JSBAD NOP RETURN ADDRESS STORAGE LOCATION JSBDB JSB DBA,I * M OCT 115 M72 DEC -72 MEMOR OCT 0 MEMORY ORIGIN OR BASE ADDRESS * NOSIM NOP * O OCT 117 OP NOP R OCT 122 S OCT 123 SFLAG OCT 0 INSTRUCTION OP-CODE STORAGE. * TEMP NOP TIN ASC 7,INDIRECT LOOP! W OCT 127 X OCT 130 BKPTA DEF BKPT BREAKPOINT TABLE * BKPT REP 30 NOP BKPLG DEF * * * END INIT ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������^fl������ÿÿ����� ���� ÿý��) ���������ÿ��92068-18017 2013� S C0122 �&IGET � � � � � � � � � � � � � �H0101 …Q�����ASMB,R,L,C HED "IGET" FORTRAN ABS. CORE GET ROUTINE (DLB) * * NAME: IGET * SOURCE: 92068-18017 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IGET,7 92068-1X017 REV.2013 770501 ENT IGET SPC 2 * * CALLING SEQUENCE: * * IVALUE = IGET (IADRS) * * WHERE: IADRS IS THE ADDRESS OF THE CORE LOCATION DESIRED. * IVALUE IS THE VALUE OF "IADRS" SPC 2 IGET NOP ENTRY ".ENTR" STYLE LDB IGET,I GET RETURN ADDRESS ISZ IGET NOW GET VALUE ADDRESS LDA IGET,I GET VALUE ADDRESS LDA A,I GET VALUE CONTENTS LDA A,I GET VALUE JMP B,I RETURN DONE A EQU 0 B EQU 1 END * ������������������������������������������������������������������������������������������2v������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18018 2013� S C0122 �&ATACH � � � � � � � � � � � � � �H0101 ‚m�����þúASMB,R,Q,C HED ATACH 92068-1X018 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM ATACH,6 92068-1X018 REV.2013 800103 RTE-IVB SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT ATACH EXT $LIBR,$LIBX,LUSES,.ENTR,$DSCS * * * NAME: ATACH * SOURCE: 92068-18018 * RELOC: PART OF 92067-16268 * PGMR: G.L.M. * * * CALLING SEQUENCE : JSB ATACH * DEF *+2 OR 3 * DEF SESSION ID * DEF IERR (OPT.) * * RETURN: (A) = IERR = 0 MEANS SUCCESSFUL ATTACH, * = -1 MEANS SCB NOT FOUND. * * SID NOP ADDRESS OF SESSION ID. IERR NOP ADDRESS OF USER ERROR PARAM. * ATACH NOP JSB .ENTR GET ADDR OF PASSED PARAMS. DEF SID * CLA INITIALIZE RETURNED ERROR CODE. LDB IERR SZB STA IERR,I * LDB $DSCS IF NOT A SESSION MONITOR NODE, SSB THE SID MIGHT BE AN MTM LU, JMP ATACH,I SO DON'T ATTEMPT ATTACH. * LDB SID,I IF SPECIFIED SESSION ID SZB IS ZERO CPB D254 OR RESERVED DS/1000 VALUE, JMP ATACH,I RETURN WITHOUT ATTACHING. * JSB $LIBR GO PRIV NOP * JSB LUSES GO FIND SCB DEF *+2 DEF SID,I POINTER TO THE ID * SZA,RSS IF A=0 JMP NOSCB SCB NOT FOUND. * * A= SCB ADDR (SST LENGTH WORD) * LDB 1717B FETCH ID ADDR ADB D32 ADVANCE TO SESSION WORD XSA B,I STUFF SESSION POINTER INTO SESSION WORD ì§��� ��  * CLA,RSS OK RETURN NOSCB CCA ERROR RETURN LDB IERR OPTIONALLY RETURN IERR. SZB STA IERR,I RETURN WITH (A) = ERROR CODE. * JSB $LIBX DEF ATACH * D254 DEC 254 DS/1000: SID FOR NON-SESSION ACCESS. D32 DEC 32 B EQU 1 * END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¹€ ������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18019 2013� S C0122 �&ISSR � � � � � � � � � � � � � �H0101 ‘_�����ASMB,R,L,C HED "ISSR" SET THE SWITCH REGISTER ROUTINE * * NAME: ISSR * SOURCE: 92068-18019 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ISSR,7 92068-1X019 REV.2013 750701 ENT ISSR SPC 1 * * CALLING SEQUENCE: * CALL ISSR(IVAL) * JSB ISSR * DEF *+2 * DEF IVAL * <RETURN> SPC 2 ISSR NOP ENTRY, .ENTR STYLE LDB ISSR,I GET ADDRESS OF RETURN ISZ ISSR BUMP TO VALUE LDA ISSR,I GET DEF IVAL LDA A,I GET IVAL OTA 1 OUTPUT TO S.R. JMP B,I RETURN A EQU 0 B EQU 1 END * ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Nµ������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18020 2013� S C0122 �&MAGTP � � � � � � � � � � � � � �H0101 xˆ�����þúASMB,R,L,C HED MAG. TAPE FUNCTION REQUESTS * * NAME: MAGTP * SOURCE: 92068-18020 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MAGTP,7 92068-1X020 REV.2013 750701 ENT IEOF,IERR,IEOT,IWRDS,LOCAL,ISOT,RWSTB EXT .ENTR,EXEC SKP UNIT. NOP UNIT-REFERENCE NUMBER PARAMETER. IEOF NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF UNIT. LDA UNIT.,I LOAD THE UNIT-REFERENCE NUMBER. LDB DSTCD LOAD DYNAMIC STATUS CODE JSB STAT. GO GET THE UNIT STATUS. ALF,CLE,ALF SHIFT THE "EOF" BIT TO 15. JMP IEOF,I RETURN. SPC 2 .UNIT NOP UNIT-REFERENCE NUMBER PARAMETER. IERR NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF .UNIT LDA .UNIT,I LOAD THE UNIT-REFERENCE NUMBER. LDB DSTCD LOAD DYNAMIC STATUS CODE JSB STAT. GO GET THE UNIT STATUS. AND =B000022 SAVE THE ERROR BITS ONLY. CCE,SZA WERE THERE ANY ERRORS? ELA,CLE,RAR YES, SO MAKE "A" NEGATIVE. JMP IERR,I NO, RETURN. SPC 2 U.5 NOP UNIT-REFERENCE NUMBER PARAMETER. IEOT NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF U.5 LDA U.5,I LOAD THE UNIT-REFERENCE NUMBER. LDB DSTCD LOAD DYNAMIC STATUS CODE JSB STAT. GO GET THE UNIT STATUS. ALF,CLE,ALF SHIFT THE "EOT" BIT TO 15. RAL,CLE,RAL SHIFT THE "EOT" BIT TO 15. JMP IEOT,I RETURN. „¦������þú SPC 2 UNITI NOP UNIT-REFERENCE NUMBER PARAMETER. IWRDS NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF UNITI LDA UNITI,I LOAD THE UNIT-REFERENCE NUMBER. STA REQST LOGICAL UNIT JSB EXEC I/O STATUS DEF *+5 DEF STATC STATUS REQUEST CODE DEF REQST DEF STAT. DUMMY DEF STAT. DUMMY A EQU 00000B DEFINES THE ADDRESS OF "A". STB A STORE THE LOG IN "A" FOR RETURN. ELA,CLE,ERA REMOVE THE MODE FLAG. JMP IWRDS,I RETURN. SPC 2 UN.RF NOP UNIT-REFERENCE NUMBER PARAMETER. LOCAL NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF UN.RF LDA UN.RF,I LOAD THE UNIT-REFERENCE NUMBER. LDB DSTCD LOAD DYNAMIC STATUS CODE JSB STAT. GO GET THE UNIT STATUS. RAR,CLE SHIFT THE "LOCAL" BIT TO 15. JMP LOCAL,I RETURN. SPC 2 U.0 NOP UNIT-REFERENCE NUMBER PARAMETER. ISOT NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF U.0 LDA U.0,I LOAD THE UNIT-REFERENCE NUMBER. LDB DSTCD LOAD DYNAMIC STATUS CODE JSB STAT. GO GET THE UNIT STATUS. ALF,ALF SHIFT THE "SOT" BIT TO 15. RAL,CLE SHIFT THE "SOT" BIT TO 15. JMP ISOT,I RETURN. SPC 2 U.1 NOP UNIT-REFERENCE NUMBER PARAMETER. RWSTB NOP ENTRY POINT. JSB .ENTR "CALL" WITH ONE(1) PARAMETER. DEF U.1 LDA U.1,I LOAD THE UNIT-REFERENCE NUMBER. LDB RSBCD LOAD REWIND/STANDBY CODE JSB STAT. GO EXECUTE THE REQUEST. JMP RWSTB,I RETURN. SPC 2 STAT. NOP ENTRY POINT. SZA IS THE UNIT-REFERENCE ZERO(0)? SSA NO - IS IT NEGATIVE ? JMP STAT.,I YES - RETURN AND =B000077 SAVE THE UNIT NUMBER ONLY. B EQU 00001B DEFINE?U����� S THE ADDRESS OF "B". IOR B INCLUDE THE OPERATION CODE. STA REQST SETUP THE REQUEST CODE. JSB EXEC DEF *+3 DEF RCODE DEF REQST JMP STAT.,I RETURN. SPC 3 * BEGIN "LOCAL STORAGE". SPC 1 STATC DEC 13 RCODE DEC 3 DSTCD OCT 000600 RSBCD OCT 000500 REQST OCT 0 REQUEST CODE SPC 1 * END OF "LOCAL STORAGE". SPC 1 END * * ��������������������������������������������������������������™÷������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18021 2013� S C0122 �&NAMR � � � � � � � � � � � � � �H0101 w_�����þúASMB,R,L,C HED "NAMR" RTE FMGR "NAMR" PARSING ROUTINE 2-9-75 (DLB) * * NAME: NAMR * SOURCE: 92068-18021 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM NAMR,7 92068-1X021 REV.2013 750701 ENT NAMR EXT .ENTR SPC 1 * TIRED OF TRYING TO PARSE A "NAMR" IN FORTRAN OR ASSEMBLY ?????????? SPC 1 * THIS ROUTINE WILL DO A CAREFULL AND COMPLETE PARSE OF A BUFFER * JUST LIKE THE RTE-II FILE MANAGER "FMGR" ROUTINE WILL. IT WAS * WRITTEN TO BEHAVE EXACTLY LIKE THE "FMGR" DOES. I WISH THE PEOPLE * THAT WROTE SXL, SCEGN, AND DISTRIBUTED SYSTEMS WOULD GET THE IDEA. * ALSO, IT WOULDN'T BE VERY HARD TO ALLOW SPACES ALONG WITH * COMMAS TO BE DELIMITERS OF "NAMR'S". (I.E. HP 3000 & FTN4) * THIS ROUTINE WILL READ AN INPUT BUFFER OF ANY LENGTH AND PRODUCE * A PARAMETER BUFFER 10 WORDS LONG. SPC 1 * THE TEN WORDS ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * WORD 1 = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * WORD 1 = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 7 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET. (FMGR?) * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR ,FNAME : P1 : P2 : P3 : P4 : P5 : P6 , * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 * WOR»E������þúD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH SUB-PARAM. (FOR POSSIBLE FUTURES I.E. SYSTEM #) SKP * CALLED: * IF( NAMR (IPBUF,INBUF,LENTH,ISTRC)) 10,20 * * WHERE: * IPBUF = TEN WORD DESTINATION PARAMETER BUFFER * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * LENTH = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "NAMR" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER.(FTN) * * 10 BRANCH = A-REG RETURNS NEG IF NOT PASSED A BUFFER OF * GREATER THAN ZERO LENGTH TO PARSE. (I.E. LENTH < ISTRC) * 20 BRANCH = THIS ROUTINE WAS PASSED A BUFFER OF AT LEAST ONE * CHARACTER IN LENGTH. (MAY BE A ASCII SPACE, BUT IT IS THERE) SKP * EXAMPLES THAT CAN BE PARSED: * * +12345, DOUG:DB:-12B:,,GEORGE: A, &PARSE:JB::4:-1:1775:123456B * * WHERE: * * NAMR # W1 W2 W3 W4 W5 W6 W7 W8 W9 W10 * * 1 12345 0 0 00001B 0 0 0 0 0 * 2 DO UG 00037B DB -10 0 0 0 0 * 3 0 0 0 00000B 0 0 0 0 0 0 * 4 GE OR GE 00017B A 0 0 0 0 0 * 5 &P AR SE 12517B JB 0 4 -1 1775 -22738 * * TEST PROGRAM *FTN,L * PROGRAM TESTN * DIMENSION IB(36),IDMY(2),IPBUF(10) * EQUIVALENCE (IDMY,DMY),(LEN,IDMY(2)) * 1 WRITE (1,100) * 100 FORMAT ("INPUT ASCII NAMR'S TO PARSE ?") * DMY = EXEC (1,401B,IB,-72) * <É������þú ISCR = 1 * DO 200 I=1,10 * IF ( NAMR(IPBUF,IB,LEN,ISCR)) 1,210 * 210 WRITE (1,220) ISCR,IPBUF,IPBUF * 220 FORMAT (" "/,I3,10(X,I6)/" "3A2,7(X,O6)) * 200 CONTINUE * STOP * END * END$ SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 IPBUF NOP TEN WORD DEST BUFFER*NMPMS) INBUF NOP INPUT BUFFER ADDRESS LENTH NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF NAMR NOP JSB .ENTR GET PARAMS ADDRESS DPBUF DEF IPBUF LDB IPBUF NOW CLEAR OUT DEST BUFFER LDA D10 GET DEST BUFFER LENGTH CMA,INA MAKE NEG. STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB LENTH,I GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC,I GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DIDN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - LENTH -1 CCA,SEZ TEST E FOR ERROR JMP NAMR,I RETURN A= -1 FOR ERROR LDA IPBUF GET DESTINATION BUFFER LDB D3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER LDB IPBUF GET DEST. PARAM. ADDRESS ADB D3 BUMP TO WORD 4 STB IPBUF SAVE AS BUFFER POINTER STB WORD4 SAVE AS PARAM. TYPE POINTER RAR,RAR POSITION "TYPE BITS" STA B,I AND INITIALIZE LDB DM6 NOW SCAN FOR NEXT 5 SUB-PARAMS STB SUBCT MORE1 ISZ IPBUF LDA IPBUF GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN ÞW������þú GET NEXT SUB PARAM IOR WORD4,I MIRGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL SIX? JMP MORE1 NO, CONTINUE RAR,RAR PUT IN CORRECT POSITION STA WORD4,I FOR !!!SIX!!! SUB-PARAMETERS MORE2 CLB,INB NOW SCAN UNTIL "," OR EOB. LDA DPBUF GET DUMMY BUFFER ADDRESS JSB SCAN DATA WILL BE STORED LOCALLY CPB EOFBF CALL SCAN UNTIL "," OR EOB. JMP NAMR,I REACHED COMMA OR END OF BUFFER JMP MORE2 DUMGUY, MORE COLONS SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+LENTH SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+LENTH = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU LENTH ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *- ADB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA FSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINU������þúS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR,I CHARACTER AMORE STB FSTCA SAVE THE 1ST CHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR,I ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP TERMC AND DUMMY UP END OF BUFFER CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER ISZ ISTAR,I ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECK IT SPC 1 TERMC STB EOFBF IGNORE FUTHER CALLS TO SCAN SPC 1 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERS€������þúION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, RETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER * NOTE: * THE REV B RTE-II FMGR DOES NOT ACCOUNT FOR NUMBER OVERFLOWS. * THE LINES OF CODE MARKED WITH "*" MAY BE DELETED IF YOU * WANT THIS CODE TO ACCOUNT FOR NUMBER OVERFLOWS. (DLB) SPC 1 MMORE MPY BASE1 TRY CONVERSION * SSA,RSS * CHECK IF OVERFLOWED? * SZB * CHECK IF OVERFLOWED? * STO * YES, SET FLAG FOR LATER USE STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA D3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS CLE,ELB FORM CHAu‚������þúRACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 D3 DEC 3 O10 OCT 10 D10 DEC 10 DM6 DEC -6 SUBCT NOP HOLDS SUB-PARAM. COUNTER WORD4 NOP HOLDS ADDRESS OF IPBUF(4) A EQU 0 B EQU 1 END * * ������������������������������������������������������������������������������������������������������������7Ó���0����.�*�������������������������������������������*0�������ÿÿ����� ���� ÿý�� $ ���������ÿ��92068-18022 2013� S C0122 �&OVF � � � � � � � � � � � � � �H0101 [Y�����ASMB,R,L,C * * NAME: OVF * SOURCE: 92068-18022 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OVF,7 92068-1X022 REV.2013 750701 ENT OVF * CALLED: * * IF (OVF(IDMY)) 10,20 * 10 <BRANCH IF O-REG. SET> * 20 <BRANCH IF O-REG IS CLEAR> * * NOTE: THIS ROUTINE CLEARS O-REGISTER * OVF NOP CLA SET A TO 0 ASSUMING NO OVERFLOW SOC C IF THERE IS OVERFLOW CCA SET THE SIGN BIT. LDB OVF,I GET RETURN ADDRESS JMP B,I RETURN THRU P+1 DEF B EQU 1 END * * ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������9È������ÿÿ����� ���� ÿý�� ���������ÿ��92068-18024 2013� S C0122 �&PTAPE � � � � � � � � � � � � � �H0101 ‹z�����þúASMB,R,L,C HED RTE AND DOS TAPE POSITIONING ROUTINE * * NAME: PTAPE * SOURCE: 92068-18024 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PTAPE,7 92068-1X024 REV.2013 750701 ENT PTAPE EXT EXEC,.ENTR SPC 2 * CALLING SEQUENCE * CALL PTAPE(UNIT, #FILES, #RECORDS) * * UNIT ------ EQT ORDINAL FOR EXEC CALL * #FILES ---- > 0 FOR FORWARD * < 0 FOR REVERSE * #RECORDS -- > 0 FOR FORWARD * < 0 FOR REVERSE * (A FILE MARK ENCOUNTERED DURING RECORD * SPACING COUNTS AS ONE RECORD) * * A BACKSPACE FILE LEAVES THE TAPE AT THE BEGINNING OF THE FILE. * AN END-OF-TAPE CONDITION CAUSES IMMEDIATE RETURN TO THE USER. SPC 2 UNIT NOP ADDRESS OF LOGICAL UNIT NUMBER FILES DEF ZERO ADDRESS OF FILE COUNT RECS DEF ZERO ADDRESS OF RECORD COUNT SPC 1 PTAPE NOP ENTRY POINT JSB .ENTR TRANSFER DEF UNIT PARAMETERS LDA UNIT,I GET EQT ORDINAL (UNIT NUMBER) SZA IF ZERO SSA OR NEGATIVE: JMP EXIT UNIT NUMBER IN ERROR: RETURN AND B77 ISOLATE UNIT NUMBER IOR B200 CONFIGURE BACKSPACE CONTROL WORD STA BSR AND STORE IT IOR B100 CONFIGURE FORWARD SPACE CONTROL * WORD STA FSR AND STORE IT XOR B500 CONFIGURE DYNAMIC STATUS REQUEST * +î������þú CONTROL WORD STA DSTAT AND STORE IT LDA RECS,I GET NUMBER OF RECORDS STA RECS AND SAVE IT LDB FILES,I GET NUMBER OF FILES JSB ABS GO SET UP FOR FILE SPACING JMP RCRD RETURNS HERE IF NO FILES: * GO DO RECORDS JSB SPACE GO SPACE A RECORD JMP *-1 FILE MARK NOT FOUND: DO ANOTHER ISZ COUNT FILE MARK FOUND: ENOUGH SPACED? JMP *-3 NO: REPEAT LDA FILES,I GET ORIGINAL FILE COUNT AGAIN SSA HAVE WE BEEN BACKSPACING? ISZ RECS YES: ADD 1 TO THE RECORD COUNT RSS IF NOT ZERO, GO SPACE RECORDS JMP EXIT ELSE GO RETURN TO USER RCRD LDB RECS GET NUMBER OF RECORDS JSB ABS GO SET UP FOR RECORD SPACING JMP EXIT NO RECORDS: RETURN TO USER JSB SPACE GO SPACE A RECORD OR * TO FILE MARK NOP FILE MARK NOT FOUND ISZ COUNT ENOUGH RECORDS SPACED? JMP *-3 NO: GO SPACE ANOTHER EXIT LDA ZERO CLEAR FILE STA FILES AND RECORD STA RECS ADDRESS WORDS JMP PTAPE,I RETURN TO USER SPC 1 SPACE NOP ENTRY POINT TO * TAPE MOTION SECTION JSB EXEC GO GET DYNAMIC STATUS DEF *+3 RETURN ADDRESS DEF RCODE ADDRESS OF I/O CONTROL * REQUEST CODE DEF DSTAT ADDRESS OF DYNAMIC STATUS * CONTROL WORD AND B40 ISOLATE EOT BIT SZA END OF TAPE? JMP EXIT YES: RETURN IMMEDIATELY TO USER JSB EXEC NO: SPACE THE TAPE DEF *+3 RETURN ADDRESS DEF RCODE ADDRESS OF I/O CONTROL * REQUEST CODE DEF FUNCT ADDRESS OF Fú«����� UNCTION CONTROL WORD JSB EXEC GET DYNAMIC STATUS AGAIN DEF *+3 RETURN DEF RCODE REQUEST CODE DEF DSTAT CONTROL WORD RAL SHIFT SOT BIT ALF,ALF TO POSITION 15 SSA START OF TAPE? JMP EXIT YES: RETURN TO USER SLA NO: END OF FILE MARK FOUND? ISZ SPACE YES: INCREMENT RETURN ADDRESS * BY 1 BEFORE RETURNING JMP SPACE,I RETURN SPC 1 ABS NOP ENTRY TO SPACE SET UP ROUTINE LDA FSR GET FORWARD SPACE CONTROL WORD SSB IS COUNT NEGATIVE? LDA BSR YES: GET BACKSPACE CONTROL WORD STA FUNCT STORE CONTROL WORD * AT CORRECT ADDRESS SSB,RSS IS COUNT POSITIVE? CMB,INB YES: TAKE 2'S COMPLIMENT STB COUNT STORE NEGATIVE COUNT SZB IS COUNT ZERO? ISZ ABS NO: INCREMENT RETURN ADDRESS JMP ABS,I RETURN SPC 1 ZERO NOP ZERO WORD FSR OCT 000300 FORWARD SPACE CONTROL WORD BSR OCT 000200 BACKSPACE CONTROL WORD RCODE DEC 3 I/O CONTROL REQUEST CODE DSTAT OCT 000600 DYNAMIC STATUS CONTROL WORD FUNCT NOP DEFINED ADDRESS OF CONTROL WORD COUNT EQU UNIT 'UNIT' DOUBLES AS RECORD COUNT B77 OCT 77 UNIT NUMBER MASK B40 OCT 40 EOT BIT MASK B100 OCT 100 FORWARD SPACE CONWD COMPONENT B200 OCT 200 BACKSPACE CONWD COMPONENT B500 OCT 500 STATUS CONWD COMPONENT END * * ������������������������������������������������������������������������������������������������������������������������������������������������������šÔ������ÿÿ����� ���� ÿý��! ���������ÿ��92068-18025 2013� S C0122 �&RMPAR � � � � � � � � � � � � � �H0101 v˜�����þúASMB,R,L,C * * NAME: RMPAR * SOURCE: 92068-18025 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RMPAR,7 92068-1X025 REV.2013 781106 * * GENERAL UTILITY ROUTINE TO LOAD OPERATOR * CONTROL PARAMETERS INTO A CALLERS BUFFER * OP SYSTEM SETS UP B-REG TO POINT TO ID SEGMENT TEMPS * FORTRAN CALLING SEQUENCE: * DIMENSION IBUF(5) * CALL RMPAR(IBUF) * ASSEMBLY LANGUAGE CALLING SEQUENCE * JSB RMPAR * DEF *+2 * DEF IBUF WHERE IBUF IS BSS 5 * (NORMAL RETURN) * * * IN RTE-IV, THE PARAMETERS ARE IN THE SYSTEM MAP ONLY. * ENT RMPAR * EXT $OPSY XTEMP EQU 1721B * * RMPAR NOP ISZ RMPAR LDA RMPAR GET P+2 ADDRESS LDA A,I GET POSSIBLE VALUE RAL,CLE,SLA,ERA JMP *-2 GOT DIRECT YET? STA TEMP1 SAVE AS POINTER TO IBUF ISZ RMPAR LDA $OPSY CPA =D-9 IF RTE-IV JMP RTEIV LOAD FROM SYSTEM MAP LDA =D-5 STA TEMP2 RMPLP LDA B,I STA TEMP1,I INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP JMP RMPAR,I * * RTEIV LDA XTEMP LDB TEMP1 STX TEMP2 (SAVE & RESTORE X) LDX =D5 MWF MOVE 5 WORDS FROM SYSTEM MAP LDX TEMP2 JMP RMPAR,I * TEMP1 NOP TEMP2 NOP A EQU 0 B EQU 1B END * * ����������������������������������������������������������������������������������������������������������������������������������������º]��� ���� �������� �������ÿÿ����� ���� ÿý��! ���������ÿ��92068-18026 2013� S C0122 �&RSFLG � � � � � � � � � � � � � �H0101 ˆƒ�����ASMB,R,L,C HED <<SAVE RESOURCES FLAG ROUTINE>> * * NAME: RSFLG * SOURCE: 92068-18026 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RSFLG,7 92068-1X026 REV.2013 800129 * ENT RSFLG,#RSFG EXT .ENTR * * * THIS ROUTINE IS USED BY CERTAIN BASIC DEVICES SUBROUTINES TO * SET A FLAG(#RSFG). THIS FLAG IS INTEROGATED BY 'CALSB' WHICH IS * THE BASIC SUBROUTINE PARAMETER PASSING MODULE. IF THIS * PLAG IS SET BY CALLING THIS ROUTINE THEN BASIC WILL * PERFORM A SAVE RESOURCES TERMINATION. IF THIS ROUTINE IS NOT * CALLED (WHICH IS THE NORMAL CASE) THEN BASIC WILL PERFORM A * SERIAL RE-USABLE TERMINATION. * * THE ROUTINES THAT NEED TO CALL THIS ROUTINE ARE DEFINED AS * THOSE THAT STORE VARIABLES LOCALLY OR MODIFY THEMSELVES IN * ANY WAY WHAT-SO-EVER. AN EXAMPLE OF THIS WHERE A USER CALLS * A DEVICE SUBROUTINE TO STORE A DEVICE LOGICAL UNIT NUMBER * LOCALLY FOR USE BY SUBSEQUENT SUBROUTINE CALLS. * * RSFLG NOP JSB .ENTR DEF RSFLG CLA,INA SET FLAG FOR SAVE RESOURCE STA #RSFG TERMINATION JMP RSFLG,I * #RSFG DEC -1 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÿÿ����� ���� ÿý��! ���������ÿ��92068-18027 2013� S C0122 �&SREAD � � � � � � � � � � � � � �H0101 }€�����þúASMB,R,L,C HED "SREAD" DOS ':JF,' -OR- RTE 'LS, READ SOURCE ROUTINE (DLB) * * NAME: SREAD * SOURCE: 92068-18027 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SREAD,7 92068-1X027 REV.2013 771116 ENT %READ,%JFIL,%RDSC EXT $OPSY,EXEC SPC 1 * SPC 1 * PURPOSE: * THIS ROUTINE READS SOURCE DEVICE OR DISC IF LOGICAL UNIT = 2 SPC 1 * USES: * THIS ROUTINE IS USED BY COMPILERS, EDITORS, ASSEMBLERS TO * READ SOURCE FROM DEVICES OR FROM RTE/DOS SOURCE DISK FILE * AREAS. I.E. DOS IN "JFILE" FORMAT, RTE IN "LS" FORMAT. SPC 1 * CALLED: * ASSEMBLY ONLY * JSB %JFIL INITIALIZE FOR :JF, OR *LS, POINTER * <RETURN> * ASSEMBLY ONLY * LDA LUTRK INITIALIZE FOR GIVEN DISCLU/TRACK * JSB %RDSC (IN RTE B-REG MUST = 0) * <RETURN> * ASSEMBLY ONLY * JSB %READ DEFAULT :JF,*LS IF %JFIL,%RDSC NOT CALLED * DEF *+5 * DEF LUN LOGICAL UNIT OF INPUT DEVICE * DEF BUFFR POINTER TO 1ST WORD OF BUFFER * DEF RLEN -(NUMBER CHARACTERS IN BUFFER) * <EOF RETURN> END OF FILE RETURN (DISC ONLY) * <RETURN> A-REG = !15 DISCLU 8!7 TRACK# 0! LAST READ * B-REG = CHARACTER TRANSMISSION LOG. (POS.) SPC 1 * NOTES: * THE B-REGISTER WILL RETURN = 0 IF END OF TAPE IS READ OR * AN IMMBEDDED FILE MARK WHEN READING DISC. IF READING DISC * AN EVEN CHA(ô������þúRACTER COUNT IS ALWAYS RETURNED. THE " %JFIL " * AND " %RDSC " ENTRY POINTS MAY BE USED TO RE-INITIALIZE * (REWIND) A READ FROM DISC. SPC 1 %READ NOP FTST1 JSB FTEST INITIALIZE IF FIRST TIME LDA %READ,I STA EXIT RETURN ADDRESS ISZ %READ LDA %READ,I STA LUNAD ADDR FOR LUN OF INPUT ISZ %READ LDA %READ LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 INDIRECT, GO ON THRU INDIR.CHAIN STA RBFAD FWA OF READ-BUFFER ISZ %READ LDA %READ,I STA RLGTH RECORD-LENGTH ADDR ISZ %READ BUMP RETURN ADDR FOR EOF RETURN LDA LUNAD,I CPA .2 LUN = 2 JMP READ1 YES JSB EXEC READ FROM OTHER THAN DISK DEF *+5 DEF M1OR1 CODE = 1 OR -1 FOR READ LUNAD NOP ADDR OF INPUT-LUN OF CONTROL CARD FTEST EQU LUNAD ENTRY 1ST TIME ONLY RBFAD JMP BUFFR ADDR OF READ-BUFFER RLGTH NOP ADDR OF ASKED-FOR RECD LENGTH SAVA EQU RLGTH JMP EXIT,I EXIT EXIT NOP EXIT POINT SAVB EQU EXIT SPC 1 * JSB %JFIL DEFAULT THE :JF = *LS AREA READ1 JSB GETWD GET RECORD HEAD ALF,ALF (A)= NO OF WORDS LDB 0 SZA,RSS END OF TAPE ? JMP EXIT,I YES, EXIT WITH (B)=0 CMA,SSA,INA,RSS EOF? JMP %READ,I YES, EOF RETURN RBL A= -(WORDS IN RECORD) STB ALGTH RECORD LGTH IN +CHARS LDB RLGTH,I ASKED-FOR RECORD-LENGTH (-) BRS CONVERT TO -(WORD COUNT) STA RCOUN SET CURRENT-RECORD COUNT STB ACOUN SET ASKED-FOR RECORD COUNT MORE1 JSB GETWD GET WORD FROM DISK STA RBFAD,I WORD TO USER-S BUFFER ISZ RBFAD BUMP BUFFER ADDR ISZ ACOUN BUMP COUNT RSS JMP READ2 READY,FINISH UP ISZ RCOUN BUMP RECORD COUNT JMP MORE1 CONTINUE LDB ALGTH RETURN ACTUAL RECORD-L²������þúENGTH JMP MORE2 SPC 1 READ2 ISZ RCOUN SKIP TO END OF RECORD JMP MORE3 LDB RLGTH,I READY, RETURN ASKED-FOR REC.LGTH CMB,INB POS LGTH MORE2 LDA CODE !15 LU 8!7 TRACK 0! JMP EXIT,I SPC 1 MORE3 JSB GETWD GET NEXT WORD JMP READ2 AND SKIP SPC 1 BFRAD NOP POINTER FOR INTERNAL BUFFER SPC 1 GETWD NOP LDA BFRAD,I ISZ BFRAD ISZ BCOUN BUMP BUFFER COUNTER JMP GETWD,I EXIT ISZ SECTR BUMP SECTOR NO. DOS1 JMP RTECD STA SAVE LDB SECTR CPB 116B END OF TRACK? CLB,RSS YES,SECTOR = 0 JMP GETW1+1 STB SECTR SECTOR NO = 0 ISZ TRACK BUMP TRACK NO. JSB EXEC DEF *+5 DEF .M16 CODE = -16 FOR STATUS DEF .1 1 TRACK DEF TRACK STARTING TRACK DEF TRACK NEXT GOOD TRACK JMP GETW1+1 SPC 1 RTECD ISZ SECTR BUMP THE SECTOR 1 MORE TIME LDB O1755 ADB RLUN =1757B FOR SYST, 1760B FOR AUX. LDB 1,I CPB SECTR END OF TRACK? CLB,RSS YES, SECTOR NO.= 0 JMP GETW1 STA CODE !15 LU 8!7 TRACK 0! STB SECTR SECTOR NO =0 LSL 8 * LDA =D-8 * STA N * LDA CODE * CLE,ELA SHIFT UPPER 8 BITS OF * ELB,CLE A INTO B, OR LSL 8 * ISZ N * JMP *-3 ALF,ALF STA TRACK SET TRACK NO STB RLUN SET LUN JSB READS READ SECTOR JMP GETWD+1 GET RECORD WORD SPC 1 GETW1 STA SAVE JSB READS READ NEXT SECTOR LDA SAVE JMP GETWD,I SPC 1 READS NOP LDA BFWA STA BFRAD BUFFER-POINTER= FWA BUFFER LDA MSIZE -64 OR -128 STA BCOUN BUFFER COUNTER JSB EXEC READ SECTOR DEF *+7 DEF M1OR1 CODE = 1 OR -1 FOR READ DEF RLUN LUN BFWA DEF BUFFR FWam������þúA OF READ-BUFFER DEF PSIZE 64 OR 128 WORDS DEF TRACK TRACK NO. DEF SECTR SECTOR NO. JMP READS,I EXIT SPC 1 SAVE JSB %JFIL TEMP (PART OF INIT) ACOUN LDA SAVA ASKED-FOR RECD COUNT RCOUN LDB SAVB CURRENT-RECORD COUNT ALGTH JMP FTEST,I RECD LGTH TRACK NOP CURRENT TRACK NO SECTR NOP CURRENT SECTOR NO BCOUN NOP SECTOR-BUFFER COUNTER RLUN NOP LUN OF CURRENT TRACK CODE NOP *STYPE NOP SAVES SYSTEM TYPE CODE FROM OPSY *N NOP COUNTER M1OR1 DEC 1 SET FOR RTE, MAY CHANGE .M16 DEC -16 .2OR3 DEC 2 .2 DEC 2 .1 DEC 1 D3 DEC 3 O1755 OCT 1755 PSIZE DEC 64 CHANGE TO 128 IF DOS-III OR RTE MSIZE DEC -64 CHANGE TO -128 IF DOS-III TO RTE * *%RDSC READS A SECTOR *CALLING SEQUENCE: LDA CODE * LDB SECTR SECTOR NO. * JSB %RDSC * RETURN (A)= LAST WORD IN SECTOR %RDSC OCT -1 INITIALIZED FLAG FTST2 JSB FTEST INIT 1ST CAL STB SECTR SECTOR NO. CLB FIX GJ 6/76 LSL 8 * LDB =D-8 * STB N * CLB * CLE,ELA * ELB,CLE LSL 8 * ISZ N * JMP *-3 ALF,ALF STA TRACK DOS2 JMP *+3 DONT CHANGE UNIT FOR RTE CPB D3 SET LU NEG IF = 3 CMB,INB STB RLUN LUN= 2 OR 3 JSB READS READ SECTOR * LDB STYPE * LDA BUFFR+63 LAST WORD IN 64 WORD SECTOR * SLB * LDA BUFFR+127 LAST WORD IN 128 WORD SECTOR LDA LBUFA,I GET LAST WORD IN ETC. JMP %RDSC,I SPC 1 *%JFIL GETS SOURCE-FILE CODEWDRD FROM BASE PAGE, FORMS A WORD= *LUN,TRACK AND CALLS %RDIN WITH IT. SPC 1 %JFIL OCT -1 INITIALIZED FLAG FTST3 JSB FTEST INITIALIZE IF FIRST TIME * LDA =D-8 * STA N DOS3 JMP RTEFL RTE LDB 124B DOS OR IOMEC/DOS LDA .2OR3 LUN = [�����2 OR 3 RRL 8 * JSB RRL RRL 8 BLF,BLF JMP CONTU SPC 1 RTEFL LDA 1767B SOURCE-FILE CODE WORD RAL POSITION !TRACK! LU! IOR .2 CONVERT LU= 2 OR 3 ALF,ALF NOW ! LU!TRACK! STA CODE SAVE LUN, TRACK NO. CLB SECTOR NUMBER CONTU JSB %RDSC READ SECTOR JMP %JFIL,I EXIT SPC 1 LBUFA DEF BUFFR+63 SPC 1 BUFFR BSS 128 ORG BUFFR STA SAVA STB SAVB LDA $OPSY * STA STYPE 0 = DOS, 1 = IOMEC/DOS, -2 = RTE SSA JMP RTE RTE CLB STB DOS1 STB DOS2 STB DOS3 CCB DOS OR IOMEC/DOS STB M1OR1 SET M1OR1 = -1 SLA,RSS JMP DOS DOS DOSM LDB D3 IF DOS-III, SET LU=3 STB .2OR3 RTE LDB TD128 IOMEC/DOS. BUFFER SIZE = 128 STB PSIZE CMB,INB STB MSIZE LDA DF128 SET LAST WORD IN BUFFER POINTER STA LBUFA DOS CLA NOP THE 2ND ENTRY PTS. STA FTST1 STA FTST2 STA FTST3 LDA %JFIL FIND OUT IF PRE-INITIALIZED CPA %RDSC IF BOTH = -1, THEN NOT SSA,RSS DO THE JSB %JFIL OUTSIDE OF BUFFER JMP SAVE+1 JMP SAVE SPC 1 DF128 DEF BUFFR+127 TD128 DEC 128 *RL NOP PERFORMS RRL N * CLE,SSA IF MSB = 0, E=0 * CCE ELSE E=1 * ELB SHIFT E INTO B * ELA SHIFT E INTO A * ISZ N * JMP RRL+1 * JMP RRL,I SPC 1 ORR END * ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������¯þ������ÿÿ����� ���� ÿý�� & ���������ÿ��92068-18028 2013� S C0122 �&.MAC. � � � � � � � � � � � � � �H0101 {A�����þúASMB,R,L,C HED ".MAC." ROUTINE TO REPLACE "JSB'S" WITH MACRO INSTRUCTIONS * * NAME: .MAC. * SOURCE: 92068-18028 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .MAC.,7 92068-1X028 REV.2013 750701 ENT .MAC. SPC 1 * * * NOTE: THIS ROUTINE CANNOT BE A TYPE 6 ROUTINE BECAUSE IT * CANNOT BE CALLED BY A TYPE 6 ROUTINE. (DLB) * CALLED AS SHOWN IN MIDDLE EXAMPLE: * BEFORE CALL CALLED SUBROUTINE AFTER CALL * * ABCDE NOP ABCDE NOP * --- .MPY NOP --- * JSB .MPY JSB .MAC. OCT 100200 * DEF XXX OCT 100200 DEF XXX * --- END --- * JMP ABCDE,I JMP ABCDE,I * * NOTE: ALL REGISTERS ARE RESTORED BY THIS ROUTINE * .MAC. NOP STA TEMP SAVE ALL REGISTERS LDA .MAC. GET P+1 OF DUMMY CMA,INA SUBTRACT TWO TO GET INA THE "NOP" OF DUMMY CMA ADDRESS LDA A,I GET IT'S P+1 ADDRESS CMA,INA SUBTRACT ONE TO GET CMA THE REAL ADDRESS OF THE 'JSB' STA ADRS LDA .MAC.,I GET THE MACRO OP STA ADRS,I AND PUT LDA TEMP RESTORE ALL REGISTERS JMP ADRS,I SPC 1 ADRS NOP TEMP NOP A EQU 0 END * ����������������������������������������������������������������������������������������������������������������������������������������½›��� ���� �������� �������ÿÿ����� ���� ÿý��$ ���������ÿ��92068-18029 2013� S C0122 �&DBGLU � � � � � � � � � � � � � �H0101 z„�����ASMB,R,L * * NAME: DBGLU * SOURCE: 92068-18029 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBGLU,7 92068-1X029 REV.2013 771116 ENT DBGLU ENT $DBP3 * XTEMP EQU 1721B * * DBGLU NOP LDA XTEMP,I STA $DBP3 JMP DBGLU,I * $DBP3 NOP END ��vG������ÿÿ����� ���� ÿý��$ ���������ÿ��92068-18032 2013� S C0122 �&ISSW � � � � � � � � � � � � � �H0101 a�����ASMB,R,L,C * * NAME: ISSW * SOURCE: 92068-18032 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * RETURNS WITH THE SETTING OF THE SWITCH REGISTER IN A * ROTATED TO PUT THE IMAGE OF THE SWITCH TO BE TESTED * INTO THE SIGN POSITION - A(15) * NAM ISSW,7 92068-1X032 REV.2013 750701 ENT ISSW ISSW NOP FUNCTION SENSE SWITCH CMA CALL BY VALUE LIB 1 N = SWITCH # RBR INA,SZA JMP *-2 LDA 1 JMP ISSW,I END * * ����������������������������¬U������ÿÿ����� ���� ÿý��% ���������ÿ��92068-18035 2013� S C0122 �&PNAME � � � � � � � � � � � � � �H0101 ƒ{�����þúASMB,L,C HED -PNAME- FETCH PROGRAM NAME * * NAME: PNAME * SOURCE: 92068-18035 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PNAME,7 92068-1X035 REV.2013 771121 ENT PNAME * EXT .ENTR,$OPSY * A EQU 0 B EQU 1 XEQT EQU 1717B (RTE) EXPG EQU 141B (DOS) * * PURPOSE: * TO EXTRACT THE NAME OF THE CURRENT PROGRAM * FROM ITS ID SEGMENT, WHICH IS IN THE SYSTEM * MAP IN RTE-IV. * * * CALLING SEQUENCE: * JSB PNAME * DEF *+2 * DEF IARAY * * *IARAY BSS 3 * * * IARAY NOP PNAME NOP ENTRY POINT JSB .ENTR DEF IARAY LDB $OPSY LDA XEQT ADA =D12 ADDRESS OF NAME FOR RTE CPB =D-9 JMP RTEIV SPECIAL HANDLING FOR RTE-IV SSB,RSS LDA DEXPG ADDRESS OF NAME FOR DOS LDB A,I STB IARAY,I STORE FIRST 2 CHARS INA ISZ IARAY BUMP POINTERS LDB A,I STB IARAY,I STORE NEXT 2 CHARS INA ISZ IARAY BUMP LDA A,I AND =B177400 MASK OFF SYSTEM FLAGS IOR =B40 AND ADD SPACE STA IARAY,I JMP PNAME,I * * * RTEIV LDB IARAY DESTINATION ADDRESS RRL 1 CHANGE BOTH ADDRESSES TO BYTE ADDRESSES LDX =D5 MBF MOVE 5 CHARACTERS LDA =B40 SBT ADD FINAL SPACE JMP PNAME,I * * DEXPG DEF EXPG * END ������������������������������������������������������������������������������������������������Í>��� ���� �������� �������ÿÿ����� ���� ÿý� �' ���������ÿ��92068-18036 2013� S C0122 �&.FDV � � � � � � � � � � � � � �H0101 …7�����þúASMB,R,L,C HED ".FDV" - FLOATING-POINT DIVIDE ROUTINE. * * NAME: .FDV * SOURCE: 92068-18036 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .FDV,6 92068-1X036 REV.2013 790418 ENT .FDV EXT .PACK,.ZPRV * * * CALLING SEQUENCE: DLD <DIVIDEND> * JSB .FDV * DEF <DIVISOR> * (RESULT IN (A,B)) * * IF UNDERFLOW OCCURS, ZERO IS RETURNED. * IF OVERFLOW OCCURS, (077777,177777) IS RETURNED. * IF UNDERFLOW OR OVERFLOW OCCUR, THE OVERFLOW BIT IS * SET, OTHERWISE IT IS CLEARED. SPC 3 * UNPACK OPERANDS, SUBTRACT EXPONENTS. * .FDV NOP JSB .ZPRV DEF LIBX STA A SAVE HIGH PART OF DIVIDEND. STB C (IN CASE DIVIDEND IS (A,B) ) ERA SAVE "E". STA ESAVE LDA 1 GET LO-MAN + EXP AND OM400 MASK OFF EXP STA B SAVE LOW PART OF DIVIDEND MANT. XOR 1 PRODUCE EXPONENT SLA,RAR POSITION IOR OM200 AND FORM STA EXPON LDA .FDV,I GET ADDRESS OF DIVISOR. ISZ .FDV BUMP RETURN ADDRESS. STA D BE CAREFUL, MAY BE ZERO. LDA A RESTORE (A,B) LDB C DLD D,I GET DIVISOR. SZA,RSS TEST FOR DIVIDE BY ZERO JMP DVZRO STA C SAVE HIGH PART OF DIVISOR. LDA 1 GET LO-MAN+EXP AND OM400 MASK TO LO-MAN STA D SAVE LOW PART :ì��� �� OF DIVISOR MANT. XOR 1 FORM EXP SLA,RAR IOR OM200 CMA,INA COMPUTE EXPONENT DIFFERENCE LARGE INA PLUS 1 ADA EXPON STA EXPON & STORE. SKP * DIVIDE THE MANTISSAS. * LDB A (B,A) = DIVIDEND MANTISSA. LDA B ASR 2 DIVIDE BY 4 TO AVOID OVERFLOW. DIV C FORM UPPER QUOTIENT. STA Q SAVE. ASR 3 DIVIDE REM BY 8 & SAVE. STB R LDA D DIVIDE LOWER DIVISOR BY 8. CLE,ERA TO MATCH REMAINDER AND SO THAT ARS,ARS THE SIGN IS INTERPRETED RIGHT. MPY Q FORM FULL REMAINDER: CMB,INB REM - QUOTIENT * (LOWER DIVISOR) ADB R (BUT DIVIDED BY 8) DIV C FORM NEXT WORD OF QUOTIENT. (/8) LDB 0 ALIGN WITH FIRST WORD. ASR 13 ADB Q ADD TO FORM FULL QUOTIENT. SWP IN (A,B). * * PACK, NORMALIZE & EXIT. * NORM JSB .PACK PACK RESULT EXPON NOP STA A RESTORE "E". LDA ESAVE ELA LDA A LIBX JMP .FDV,I DEF .FDV * * HANDLE DIVIDE BY ZERO. * DVZRO LDA LARGE ANY OLD LARGE + NUMBER. STA EXPON JMP NORM * * TEMPS & CONSTANTS. * A NOP B NOP C NOP D NOP Q EQU A R EQU B ESAVE NOP OM400 OCT -400 OM200 OCT -200 * END ��������������/H ������ÿÿ����� ���� ÿý�!�( ���������ÿ��92068-18037 2013� S C0122 �&.FMP � � � � � � � � � � � � � �H0101 €@�����þúASMB,R,L,C HED ".FMP" - FLOATING-POINT MULTIPLY ROUTINE. * * NAME: .FMP * SOURCE: 92068-18037 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .FMP,6 92068-1X037 REV.2013 790418 * ENT .FMP EXT .PACK,.ZPRV * * * CALLING SEQUENCE: DLD <ARG1> * JSB .FMP * DEF <ARG2> * (RESULT IN (A,B)) * * IF UNDERFLOW OCCURS, ZERO IS RETURNED. * IF OVERFLOW OCCURS, (077777,177777) IS RETURNED. * IF UNDERFLOW OR OVERFLOW OCCUR, THE OVERFLOW BIT IS * SET, OTHERWISE IT IS CLEARED. SPC 3 * UNPACK OPERANDS, ADD EXPONENTS. * .FMP NOP JSB .ZPRV DEF LIBX STA A1 SAVE HIGH PART OF MULTIPLICAND. STB A2 (IN CASE WE ARE SQUARING) ERA SAVE "E". STA ESAVE LDA 1 GET LO-MAN+EXP AND OM400 MASK OF EXP STA B1 XOR 1 FORM EXPONENT SLA,RAR IOR OM200 STA EXPON SAVE EXPONENT. LDA .FMP,I GET ADDRESS OF MULTIPLIER. STA B2 GET MULTIPLIER WITH CARE. LDA A1 LDB A2 DLD B2,I THIS WORKS EVEN IF SQUARING OPERAND. STA A2 SAVE HIGH PART LDA 1 GET LO-MAN+EXP AND OM400 MASK OFF EXP STA B2 SAVE TEMP XOR 1 GET EXPONENT SLA,RAR AND POS+FORM IOR OM200 INA ADA EXPON STA EXPON SKP * MULTIPLYÒò��� ��  MANTISSAS. * LDA B2 FIRST CROSS PRODUCTS. THEY ARE HALVED SO THAT RAR THE MULTIPLY IS EASY AND THE SUM DOESN'T OVERFLOW. MPY A1 COMPUTE FIRST CROSS PRODUCT. STB B2 SAVE UPPER PART ONLY. LDA B1 COMPUTE SECOND CROSS PRODUCT. RAR MPY A2 ADB B2 ADD THE 2 CROSS PRODUCTS. CLE,ELB LEFT SHIFT & REMEMBER SIGN. STB B2 SAVE IT. LDA A1 COMPUTE UPPER * UPPER. MPY A2 SEZ IF SUM OF CROSS PRODUCTS IS NEGATIVE, ADB KM1 MUST ACCOUNT FOR ITS SIGN EXTENSION. CLE NOW ADD CROSS PRODUCTS. ADA B2 SEZ AND PROPOGATE CARRY. INB SWP RESTORE NORMAL ORDER. * * NORMALIZE, PACK & EXIT. * JSB .PACK NORMALIZE AND PACK EXPON NOP ISZ .FMP STA A1 RESTORE "E". LDA ESAVE ELA LDA A1 LIBX JMP .FMP,I EXIT. DEF .FMP * * TEMPS & CONSTANTS. * A1 NOP A2 NOP B1 NOP B2 NOP ESAVE NOP KM1 DEC -1 OM400 OCT -400 OM200 OCT -200 * END ��������������������������������������������������������������������������������—È ������ÿÿ����� ���� ÿý�"�) ���������ÿ��92068-18038 2013� S C0122 �&IFIX � � � � � � � � � � � � � �H0101 ‰W�����þúASMB,R,L,C HED "IFIX" INTEGERIZE REAL TO 16 BIT NUMBER * * NAME: IFIX * SOURCE: 92068-18038 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFIX,6 92068-1X038 REV.2013 750701 ENT IFIX EXT .ZPRV * * * CALL WITH FLOATING POINT NUMBER IN A&B. RETURN WITH * INTEGER EQUIVALENT IN A. IF OVERFLOW, SET OVFF AND * RETURN 77777. IFIX NOP JSB .ZPRV DEF LIBX STA HIMAN SAVE MANTISSA. LDA B GET LO-MAN+EXP AND OM400 MASK TO GET LO-MAN CLE,SZA SET E-REG AS FLAG FOR CCE BITS IN LOW MAN XOR B GET EXPONENT CLO SLA,RAR FORM EXPONENT JMP UNFLO RETURN ZERO. ADA M16 COMPUTE SHIFT COUNT. SSA,RSS IF EXP 16 OR MORE, JMP OVFLO OVERFLOW. STA B SAVE SHIFT COUNT IN B. LDA HIMAN JMP CONT LOOP SLA,ARS SHIFT RITHT & TEST BIT LOST? CCE SET E-REG IF BIT LOST CONT ISZ B ANY MORE SHIFTS? JMP LOOP YES SEZ,SSA NO,BITS LOST? INA YES,BUMP IF ALSO NEG. JMP LIBX RETURN A= ANS UNFLO CLA JMP LIBX OVFLO LDA INFIN STF 1 LIBX JMP IFIX,I DEF IFIX OM400 OCT -400 HIMAN NOP M16 DEC -16 INFIN OCT 77777 B EQU 1 END * ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¸��� ���� �������� �������ÿÿ����� ���� ÿý�#�* ���������ÿ��92068-18039 2013� S C0122 �&.FADS � � � � � � � � � � � � � �H0101 vg�����þúASMB,R,L,C HED ".FADS" 2-WORD FLOATING-POINT ADD & SUBTRACT. * * NAME: .FADS * SOURCE: 92068-18039 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .FADS,6 92068-1X039 REV.2013 790417 ENT .FAD,.FSB EXT .PACK,.ZPRV * * * CALLING SEQUENCE * * DLD X DLD X * JSB .FAD JSB .FSB * DEF Y DEF Y * * FLOATING RESULT (X+Y) OR (X-Y) IN A AND B REGISTERS. * "E" BIT PRESERVED. SPC 3 * ADD: UNPACK, GO ADD. * * .FAD NOP ENTRY FOR FLOATING ADD. JSB .ZPRV DEF LIBX STA A1 SAVE (A). LDA .FAD COPY ENTRY POINT. STA .FSB LDA A1 RESTORE (A). JSB UNPAK GET ARGUMENTS UNPACKED JMP ADMUP GO TO COMMON SECTION * * SUBTRACT: UNPACK, NEGATE, GO ADD. * .FSB NOP ENTRY FOR FSB. EXIT FOR FAD/FSB. JSB .ZPRV DEF LIBX STA A1 SAVE (A). JSB UNPAK GET ARGUMENTS UNPACKED. LDA A2 (A,B) = SECOND MANTISSA. LDB B2 CMA DOUBLE LENGTH TWOS COMPLEMENT. CMB,INB,SZB IF LOW PART NOT ZERO, THEN ALL JMP FSB01 DONE. SSA,INA,RSS OTHERWISE BUMP A. IF A WAS NEGA- SSA,RSS TIVE, AND REMAINS SO, JMP FSB01 RAR THEN SHIFT IT DOWN & ISZ X2 BUMP THE EXPONENT. (SKIP O.K.) FSB01 STB B2 STA A2 SKP * COMMON: FIRST, ENSURE FIRST ARG HAS LARGERäs������þú EXPONENT. * ADMUP ISZ .FSB BUMP RETURN ADDRESS. LDA X2 COMPUTE EXPONENT DIFFERENCE. CMA,INA ADA X1 CMA,SSA,INA IF ARG1 IS LARGER, GO TO ADD JMP ADDEM SECTION. LDA A1 OTHERWISE, EXCHANGE THE ARGS. LDB A2 STA A2 STB A1 LDA B1 LDB B2 STA B2 STB B1 LDA X2 RE-COMPUTE EXPONENT DIFFERENCE, CMA,INA BUT DON'T NEGATE. ADA X1 LDB X2 RESET X1. STB X1 * * SHIFT SMALLER ARGUMENT RIGHT. * ADDEM ADA K24 IF SHIFT COUNT IS 25 OR MORE, CMA,SSA,INA,RSS THEN IGNORE SMALLER ARGUMENT. JMP TAKIT ADA K24 RESTORE SHIFT COUNT. CLE,ERA DIVIDE BY TWO. SZA WAS IT ZERO OR ONE ? ADA ASR00 NO, CONSTRUCT SHIFTS (ELSE NOPS) STA XEQ1 STORE THEM. STA XEQ2 LDB A2 (B,A) = SMALLER ARGUMENT. LDA B2 XEQ1 NOP ** VARIABLE SHIFT ** XEQ2 NOP ** VARIABLE SHIFT ** SEZ,CLE EXTRA SHIFT ? ASR 1 YES. DO IT. * * ADD LARGER ARGUMENT TO (B,A). * ADA B1 ADD LOWERS. CLO WILL CHECK FOR OFL. SEZ,RSS CARRY OUT OF LOWER ADD ? JMP FAD05 NO. JUST GO ADD UPPERS. CLE,SSB YES. CHECK SIGN OF UPPER IN B. JMP FAD04 B<0. ADD THE CARRY TO IT. ADB A1 B>=0. ADD THE OTHER UPPER, INB THEN THE CARRY. JMP FAD06 FAD04 INB ADD CARRY. FAD05 ADB A1 ADD OTHER UPPER. SKP * COMPENSATE FOR MANTISSA OVERFLOW. SWAP. * FAD06 SOS OVERFLOW ? JMP FAD07 NO. ISZ X1 YES. BUMP EXPONENT. NOP DON'T REMOVE !! ERB AND RIGHT SHIFT. ERA FAD07 SWP * * PACK, RESTORE "E" & EXIT. * DONE JSB .PACK PACK IT. X1 NOP STA A1 Õl����� RESTORE "E". LDA ESAVE ELA LDA A1 LIBX JMP .FSB,I DEF .FSB * * SHIFT > 24, JUST RETURN LARGER NUMBER. * TAKIT LDA A1 LDB B1 JMP DONE SKP * COMMON UNPACK FOR ADD & SUBTRACT. * UNPAK NOP UNPACKING SECTION STB A2 (IN CASE SECOND ARG IN (A,B) ) SZA,RSS IF FIRST ARGUMENT = 0, CLB,INB SET ITS EXPONENT TO MAX NEG. ERA SAVE "E". STA ESAVE LDA 1 GET LO-MAN+EXP AND OM400 MASK OF EXP STA B1 SAVE LOW PART OF ARG1 XOR 1 GET EXPONENT SLA,RAR FORM AND POSITION IOR OM200 STA X1 SAVE EXP. OF ARG1 LDA .FSB,I (A) = ADDRESS OF SECOND ARGUMENT. STA B2 BE CAREFUL. LDA A1 RESTORE A,B LDB A2 DLD B2,I GET SECOND ARGUMENT STA A2 SAVE HIGH PART SZA,RSS IF SECOND ARGUMENT = 0, CLB,INB SET ITS EXPONENT TO MAX NEG. LDA 1 GET LO-MAN+EXP AND OM400 MASK TO GET LO-MAN STA B2 SAVE LOW PART XOR 1 GET EXPONENT SLA,RAR IOR OM200 STA X2 SAVE EXP JMP UNPAK,I * * CONSTANTS & TEMPS. * A1 NOP UPPER OF FIRST / LARGER. B1 NOP LOWER OF FIRST / LARGER. A2 NOP UPPER OF SECOND / SMALLER. B2 NOP LOWER OF SECOND / SMALLER. X2 EQU .FAD SECOND EXPONENT. ESAVE NOP "E" BIT IN SIGN. * K24 DEC 24 OM400 OCT -400 OM200 OCT -200 ASR00 ASR 16 * END ����������������������������������������������������������������������������������������������������������lÌ������ÿÿ����� ���� ÿý�$�, ���������ÿ��92068-18040 2013� S C0122 �&FLOAT � � � � � � � � � � � � � �H0101 p�����ASMB,R,L,C HED "FLOAT" CONVERT INTEGER TO REAL * * NAME: FLOAT * SOURCE: 92068-18040 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FLOAT,6 92068-1X040 REV.2013 750701 ENT FLOAT EXT .PACK EXT .ZPRV * * * CALL WITH INTEGER IN A. * RETURN WITH FLOATING POINT EQUIVALENT IN A & B. FLOAT NOP JSB .ZPRV DEF LIBX CLB SET UP AS FLOATING POINT UNNOR- JSB .PACK DEC 15 LIBX JMP FLOAT,I DEF FLOAT END * ��������������������������������������������������Ýá������ÿÿ����� ���� ÿý�%�+ ���������ÿ��92068-18041 2013� S C0122 �&.PACK � � � � � � � � � � � � � �H0101 w`�����þúASMB,R,L,C HED ".PACK" PACKS A&B DOUBLE INTEGER WITH EXPONENT INTO REAL * * NAME: .PACK * SOURCE: 92068-18041 * RELOC: PART OF 92067-16268 AND 92067-16035 * PGMR: R.A.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .PACK,6 92068-1X041 REV.2013 750701 ENT .PACK EXT .ZPRV * * * ENTER WITH A SIGNED 31 BIT MANTISSA IN A&B. * EXIT WITH A FLOATING POINT, NORMALIZED, NUMBER IN A&B. * CALL: JSB .PACK * X BSS 1 (CONTAINS EXPONENT) * <RETURN POINT> X MAY BE CHANGED .PACK NOP ENTRY POINT JSB .ZPRV DEF LIBX STA A SAVE A REGISTER. CLA STA EXPON SET EXPON TO ZERO. LDA A SZA,RSS IF A AND B ARE BOTH ZERO SZB RETURN IMMEDIATELY. JMP NORML ELSE GO TO NORMALIZING SECTION. BACK CLO CLEAR OVERFLOW FOR GOOD RETURN. ISZ .PACK BUMP RETURN ADDRESS PAST X. JMP LIBX * NORMALIZING SECTION * SHIFT ISZ EXPON COUNTS # OF LEFT SHIFTS. NORML CLE,ELB ROTATE A&B LEFT INTO E. ELA SEZ,SSA,RSS TEST THE ORIGINAL 2 HIGH BITS. JMP SHIFT BOTH WERE 0--# WAS +UNNORMALIZED. SEZ,SSA JMP SHIFT BOTH WERE 1--# WAS - " ERA UNDO THE SHIFT, PRODUCING A ERB,CLE NORMALIZED MANTISSA. * ROUNDING SECTION * ADB .177 ADD IN SUFFICIENT ROUND FOR NEG- SSA,RSS ATIVE NUMBERS. INB IF POSITIVE, 1 MORE IS NECESSARY. CLO CLEAR TO TEST FOR A-REG. OVFLOW. SEZ TEST FOR OVERFLOW OUT OF B. CLE,INA IF SO, BŒ������þúUMP A REGISTER. SOS IF THE BUMP CAUSES OVERFLOW,, RAL SKIP THIS SHIFT (A=100000,B=0). SSA,SLA,RSS TEST FOR TOP 2 BITS=1. JMP *+3 * THIS LAST TEST IS NECESSARY TO OBTAIN THE CORRECT RESULT * WHEN THE UNROUNDED MANTISSA WAS 101...1 AND A ROUND OCCURRED, * PRODUCING 110...0, WHICH IS UNNORMALIZED. THIS IS THE RESULT * WE HAVE IF WE GET HERE. ISZ EXPON BECAUSE WE ARE GOING TO SHIFT LEFT. ARS,SLA,ALS PRODUCES A=10...0 AND SKIPS. RAR UNDOES THE RAL ABOVE. * AT THIS POINT, A&B ARE NORMALIZED&ROUNDED, AND THE * TRUE EXPONENT IS .PACK,I-EXPON(+1 IF OVFF=1). STA A SAVE A REGISTER. LDA 1 REMOVE LOW ORDER 8 BITS OF B. AND MASKH STA 1 LDA EXPON COMPUTE TRUE EXPONENT AS DESCRIBED CMA,INA ADA .PACK,I SOC ADD 1 MORE IF OVERFLOW OCCURRED INA ADA P200 TEST FOR EXPONENT UNDERFLOW. SSA JMP XUNDR ADA M400 TEST FOR EXPONENT OVERFLOW SSA,RSS JMP XOVER ADA P200 RESTORE ORIGINAL EXPONENT. RAL POSITION SIGN TO LSB. AND MASKL MASK TO 8 BITS. ADB 0 PACK INTO B. LDA A RESTORE HIGH PART JMP BACK * OVERFLOW UNDERFLOW SECTION * XUNDR CLA RETURN ZERO FOR UNDERFLOW. CLB JMP SETOV XOVER LDA INF1 RETURN +INFINITY FOR OVERFLOW LDB INF2 SETOV STF 1 SET OVERFLOW FLAG FOR OVERFLOW JMP BACK+1 OR UNDERFLOW. LIBX JMP .PACK,I DEF .PACK EXPON REP 1 NOP A REP 1 NOP .177 OCT 177 P200 OCT 200 M400 OCT -400 MASKL OCT 377 MASKH EQU M400 (177400) INF1 OCT 77777 INF2 OCT 177776 END * ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‰%�������� ������������� �������ÿÿ����� ���� ÿý�&�. ���������ÿ��92068-18042 2040� S C0122 �&$SUB2 � � � � � � � � � � � � � �H0101 }N�����ASMB,R,L * NAME : $SUB2 * SOURCE: 92068-18042 * RELOC: 92067-16268 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * THIS MODULE CONTAINS SPECIAL ENTRY POINTS IN TABLE AREA II FOR * HEWLETT-PACKARD SUPPORTED SUBSYSTEMS. SPECIAL CARE SHOULD BE * TAKEN IN ADDING ENTRY POINTS TO THIS MODULE SINCE EACH ENTRY * SUBTRACTS FROM SAM AND FROM THE USER'S ADDRESSING SPACE FOR * TYPE 2(RT) AND TYPE 3(BG) PROGRAMS. NO ENTRY POINT SHOULD BE * LARGER THAN ONE WORD. IF THE ENTRY POINT COULD BE PUT SOMEWHERE * ELSE WITH LESS IMPACT ON THE GENERAL SYSTEM, THEN PUT IT THERE. * PLEASE DATE CODE AND INITIAL ANY ADDITIONS TO THIS MODULE. * * BEST WISHES AND HAVE A GOOD DAY. * NAM $SUB2,13 92068-1X042 REV.2040 800724 * ENT $DIGL,$B$RB ENT $$DLS * $DIGL NOP *2013 DLS* ENTRY POINT FOR GRAPHICS/1000 $B$RB NOP *2040 DLS* ENTRY POINT FOR ROBIN BASIC * $$DLS BSS 5 *2040 DLS* RESERVED,SEE DLS FOR USAGE * END ����������������������������������������������������������������������������������������������������������¦g������ÿÿ����� ���� ÿý�'�- ���������ÿ��92068-18048 2026� S C0122 �DIREC1 �SRC TAPE #1 DIRECTORY � � � � � � � � � � � � �H0101 L—�����þú ************************************************************** * RTE-IVB SOURCE PRODUCT * * 92068X * * AND * * RTE-IVB DRIVER SOURCE PRODUCT * * 92062X * * REV. 2026 * * TAPE # 1 * * * * DATE: 5/15/80 * ************************************************************** * REL. PART # REL.NAME SRC. PART # SRC.NAME REV LANG. * ************************************************************** 09580-16079 %DVM72 09580-18079 &DVM72 2026 ASMB 09580-16126 %DSCHD 09580-18126 &DSCHD A ASMB 09601-16021 %DVR15 09601-18021 &DVR15 1901 ASMB 29028-60002 %DVR12 29028-80002 &DVR12 1805 ASMB 29029-60001 %DVR00 29029-80001 &DVR00 1740 ASMB 29030-60001 %DVR11 29030-80001 &DVR11 1710 ASMB 59310-12026 %IB4A 59310-18012 &IB4A1 2026 ASMB 59310-18013 &IB4A2 2026 ASMB 59310-18014 &IB4A3 2026 ASMB 59310-18015 &IB4A4 1940 ASMB 59310-16002 %DVR37 59310-18005 &DVR37 2026 ASMB 59310-16005 %SRQ.P 59310-18007 &SRQ.P 1805 ASMB 91200-16001 %DVA13 91200-18001 &DVR13 1648 ASMB 91200-16002 %TVLIB 91200-18002 &TVLIB 1648 ASMB 91200-16004 %TVVER 91200-18004 &TVVER 1648 ASMB 92001-16020 %DVA12 92001-18020 &DVA12 1826 ASMB 92001-16027 %4DV05 92001-18026 &DVR05 1926 ASMB 92001-16035 %DVA05 92001-18035 &DVA05 1913 ASMB 92062-16003 %LP31 92062-18009 &LP31 1805 ì¾��� �� ASMB 92062-16004 %DVB12 92062-18010 &DVB12 1926 ASMB 92067-16330 %DVR32 92067-18330 &DVR32 2013 ASMB 92067-16466 %DVR31 92067-18466 &DVR31 1903 ASMB 92067-16467 %DVR33 92067-18467 &DVR33 1903 ASMB 92067-16553 %DVA32 92067-18553 &DVA32 2013 ASMB 92202-16001 %DVR23 92202-18001 &DVR23 A ASMB 92900-16002 %DVA47 92900-18002 &DVA47 1913 ASMB ������������������������������������������������������������������������������q› ������ÿÿ����� ���� ÿý�(�/ ���������ÿ��92068-18049 2040� S C0122 �DIREC2 SOURCE TAPE #2 �DIRECTORY � � � � � � � � � � � � �H0101 Y�����þú ************************************************************** * RTE-IVB SOURCE PRODUCT * * 92068X * * REV. 2040 * * TAPE # 2 * * * * DATE: 9/12/80 * ************************************************************** * REL. PART # REL.NAME SRC. PART # SRC.NAME REV LANG. * ************************************************************** 92060-16045 %RDNAM 92060-18045 &RDNAM 1926 SPL 92060-16052 %KEYS 92060-18052 &KEYS 1707 FTN4 92060-16053 %KYDMP 92060-18053 &KYDMP 1707 FTN4 92064-16086 %MSAFD 92064-18232 &MSAFD 2001 FTN4 92067-12002 $DSCLB 92067-18517 &DSCLB 2040 ASMB 92067-18518 &XPRTY 2040 ASMB 92067-18519 &ISHL 2001 ASMB 92067-18520 &XIDEN 2040 FTN4 92067-18521 &XSTAT 2040 FTN4 92067-18522 &XSEEK 2040 FTN4 92067-18523 &XLGAD 2040 FTN4 92067-18524 &XINIT 2040 FTN4 92067-18525 &XDRED 2040 FTN4 92067-18526 &XDWRT 2040 FTN4 92067-18527 &XFMSK 2040 FTN4 92067-18528 &XRCAL 2040 FTN4 92067-18529 &XADRC 2040 FTN4 92067-18530 &XVRFY 2040 FTN4 92067-18531 &XRDFS 2040 FTN4 92067-18532 &XWRFS 2040 FTN4 92067-18533 &XRDOF 2040 FTN4 92067-18534 &XRDNV 2040 FTN4 Ôq������þú 92067-18535 &XPHAD 2040 FTN4 92067-18536 &XFRMT 2040 FTN4 92067-18537 &XSPAR 2040 FTN4 92067-18538 &XGTAD 2040 FTN4 92067-18539 &XEND 2040 FTN4 92067-18540 &XTTBL 2040 FTN4 92067-18541 &XDSJ 2040 FTN4 92067-18542 &IFDVR 2040 FTN4 92067-18552 &XSECA 2040 FTN4 92067-18586 &DLIB4 2040 FTN4 92067-12003 $DKULB 92067-18349 &DKULB 2026 ASMB 92067-18543 &XDCAS 2001 ASMB 92067-18544 &DATCO 2001 ASMB 92067-18545 &RDATK 2001 FTN4 92067-18546 &WRTRK 2001 FTN4 92067-18547 &COMPR 2001 FTN4 92067-18548 &XGTPM 2001 FTN4 92067-18549 &EOTAP 2001 FTN4 92067-18550 &WREOT 2001 FTN4 92067-18551 &MXGTA 2001 FTN4 92067-18556 &MTOK 2001 FTN4 92067-18557 &CLRSP 2001 FTN4 92067-18564 &XMTBU 2026 ASMB 92067-16004 %4DP43 92067-18004 &4DP43 1926 ASMB 92067-16008 %LGTAT 92067-18008 &LGTAT 1926 ASMB 92067-16013 %#EMA 92067-18013 &#EMA1 1805 ASMB 92067-16118 %4AUTR 92067-18456 &4AUTR 1903 FTN 92067-16315 %RT4GN 92067-18315 &RT4GN 2026 ASMB 92067-18316 &RT4G1 2001 ASMB 92067-18317 &RT4G2 2001 ASMB 92067-18318 &RT4G3 2001 ASMB 92067-18319 &RT4G4 2001 ASMB 92067-18320 &RT4G5 2001 ASMB qŽ����� 92067-18321 &RT4G6 2001 ASMB 92067-18322 &RT4G7 2026 ASMB 92067-18323 &RT4G8 2001 ASMB 92067-16332 %READT 92067-18332 &READT 2026 FTN4 92067-16333 %WRITT 92067-18333 &WRITT 2026 FTN4 92067-16334 %MERGE 92067-18334 &MERGE 2013 FTN4 92067-16335 %SAVE 92067-18335 &SAVE 2013 ASMB 92067-16336 %RSTOR 92067-18336 &RSTOR 1903 ASMB 92067-16337 %VERFY 92067-18337 &VERFY 1903 ASMB 92067-16338 %COPY 92067-18338 © 1903 ASMB 92067-16339 %DBKLB 92067-18339 &DBKLB 2013 ASMB 92067-16340 !DSKUP 92067-18340 &DSKUP 2013 ASMB 92067-16344 %LSAVE 92067-18344 &LSAVE 2026 FTN4 92067-16345 %USAVE 92067-18345 &USAVE 2026 FTN4 92067-16346 %RESTR 92067-18346 &RESTR 2026 FTN4 92067-16347 %LCOPY 92067-18347 &LCOPY 2013 FTN4 92067-16348 !DISK 92067-18348 &DISK 2026 FTN4 92067-16501 %WHZAT 92067-18501 &WHZAT 2001 ASMB 92067-16512 !MTLDR 92067-18512 &MTLDR 2001 ASMB 92067-16513 %SSTCH 92067-18513 &SWTCH 2001 ASMB 92067-18514 &SWSG1 2001 ASMB 92067-18515 &SWSG2 2001 ASMB 92067-16554 %FORMT 92067-18554 &FORMT 2040 ASMB ����������������������������������������������������������������������������������������������������������������������������¯1������ÿÿ����� ���� ÿý�)�1 ���������ÿ��92068-18050 2040� S C0122 �DIREC3 SOURCE TAPE #3 �DIRECTORY � � � � � � � � � � � � �H0101 P�����þú ************************************************************** * RTE-IVB SOURCE PRODUCT * * 92068X * * REV. 2040 * * TAPE # 3 * * * * DATE: 09/10/12 * ************************************************************** * REL. PART # REL.NAME SRC. PART # SRC.NAME REV LANG. * ************************************************************** 92067-16001 %4PVMP 92067-18001 &4PVMP 1805 ASMB 92067-16003 %4MTM 92067-18003 &4MTM1 1926 ASMB 92067-16102 %CR4S1 92067-18103 &$CSY4 2040 ASMB 92067-18104 &DISP4 2040 ASMB 92067-18105 &RTIM4 2040 ASMB 92067-18106 &ASCM4 1903 ASMB 92067-18107 &RTIO4 2040 ASMB 92067-18108 &EXEC4 2001 ASMB 92067-16103 %CR4S2 92067-18096 &$BITM 1903 ASMB 92067-18097 &$MCON 1903 ASMB 92067-18098 &$OSAM 2001 ASMB 92067-18109 &TRN4 1903 ASMB 92067-18110 &SCHD4 2040 ASMB 92067-18111 &ALC4 1903 ASMB 92067-18112 &OCMD4 1903 ASMB 92067-18113 &PERR4 1903 ASMB 92067-18114 &$CNFG 2040 ASMB 92067-18115 &$$TB1 2013 ASMB 92067-18116 &$$TB2 2001 ASMB 92067-16124 %BMPG2 92067-18124 &D.RTR 2026 ASMB 92067-16125 %BMPG3 92067-18088 &.CLGN 1903 ASMB 92067-18089 &.CACT 1903 ASMB ó������þú 92067-18090 &.UACT 1903 ASMB 92067-18091 &.LGON 2001 ASMB 92067-18092 &.UNAM 1903 ASMB 92067-18125 &BALB 2026 ASMB 92067-18126 &CREAT 2026 ASMB 92067-18127 &OPEN 2001 ASMB 92067-18128 &PURGE 2001 ASMB 92067-18129 &NAMF 2001 ASMB 92067-18130 &READF 2001 ASMB 92067-18131 &FSTAT 1903 ASMB 92067-18132 &RWNDF 1903 ASMB 92067-18133 &POSNT 1903 ASMB 92067-18134 &APOSN 1903 ASMB 92067-18135 &FCONT 1903 ASMB 92067-18136 &LOCF 1903 ASMB 92067-18137 &CLOSE 2001 ASMB 92067-18138 &POST 1903 ASMB 92067-18139 &NAM.. 1903 ASMB 92067-18140 &IDCBS 1903 ASMB 92067-18141 &$OPEN 1903 ASMB 92067-18142 &P.PAS 1903 ASMB 92067-18143 &RW$UB 1903 ASMB 92067-18144 &RWND$ 1903 ASMB 92067-18145 &R/W$ 1903 ASMB 92067-18146 &SPOPN 1940 ASMB 92067-18147 &WRLG. 1903 ASMB 92067-18148 &J.PUT 1903 ASMB 92067-18149 &IPUT 1903 ASMB 92067-18150 &FID. 1903 SPL 92067-18151 &FD.CK 1940 ASMB 92067-18152 &MSC. 2001 SPL 92067-18153 &LOCK. 1903 SPL 92067-18154 &FM.UT 1903 SPL ð#������þú 92067-18155 &OVRD. 1903 ASMB 92067-18156 &ICAPS 1903 ASMB 92067-18157 &CREA. 1903 SPL 92067-18158 &CK.SM 1903 SPL 92067-18159 &CK.ID 1903 ASMB 92067-18161 &WRIS$ 1903 ASMB 92067-18162 &CNT. 1940 SPL 92067-18163 &BUMP. 1903 ASMB 92067-18164 &SET.T 1903 ASMB 92067-18165 &TL. 1903 ASMB 92067-18166 &ST.TM 1903 ASMB 92067-18167 &B.FLG 1903 ASMB 92067-18168 &LULU. 1903 ASMB 92067-18169 &RANGE 1903 ASMB 92067-18170 &ONOFF 1903 ASMB 92067-18171 &EX.TM 1903 ASMB 92067-18172 &FREE 1903 ASMB 92067-18173 &LU.CL 1903 ASMB 92067-18174 &AVAIL 1903 ASMB 92067-18175 &READ. 1903 ASMB 92067-18176 &DCMC 2001 ASMB 92067-18177 &UT.BF 1903 ASMB 92067-18178 &OPENF 1940 ASMB 92067-18179 &FG.LU 1903 ASMB 92067-18180 &SELUR 1903 ASMB 92067-18181 &SM.BF 1903 ASMB 92067-18182 &CL.BF 1903 ASMB 92067-18183 &PGS. 1903 ASMB 92067-18184 &ACNAM 1903 ASMB 92067-18259 &IFMTM 1903 ASMB 92067-18267 >SCB 2013 ASMB 92067-18449 &SM.SB 2026 ASMB 92067-18450 &ME.SB 2013 ASMBIQ������þú 92067-18451 &SESSN 2013 ASMB 92067-18452 &PARSN 2013 ASMB 92067-18453 &IPRSN 2013 ASMB 92067-18463 &XQPRG 2013 FTN4 92067-18464 &CLONE 2013 FTN4 92067-18502 &CRETS 2013 ASMB 92067-16185 %BMPG1 92067-18185 &$BMON 2040 ASMB 92067-18186 &FMGR 2026 ASMB 92067-18187 &FMGR0 2013 ASMB 92067-18188 &FMGR1 2013 ASMB 92067-18189 &FMGR2 2013 ASMB 92067-18190 &FMGR3 2013 ASMB 92067-18191 &FMGR4 2013 ASMB 92067-18192 &FMGR5 2026 ASMB 92067-18193 &FMGR6 2013 ASMB 92067-18194 &FMGR7 2013 ASMB 92067-18195 &FMGR8 2013 ASMB 92067-18196 &FMGR9 2013 ASMB 92067-18197 &FMGRA 2013 ASMB 92067-18200 &CA.. 2013 ASMB 92067-18201 &C.TAB 2026 ASMB 92067-18202 &??.. 2026 ASMB 92067-18203 &FM.CM 2026 SPL 92067-18204 &PK.. 2013 SPL 92067-18205 &CR.. 2040 SPL 92067-18206 &CN.. 2013 SPL 92067-18207 &.PARS 2013 SPL 92067-18208 &REA.C 2026 ASMB 92067-18209 &EE.. 2013 SPL 92067-18210 &TR.. 2013 SPL 92067-18211 &SA.. 2026 SPL 92067-18212 &MR.. 2013 SPL 92067-18213 &SE.. 2013 Ôî������þúSPL 92067-18214 &IF.. 2013 SPL 92067-18215 &AB.. 2026 SPL 92067-18216 &IN.IT 2026 SPL 92067-18217 &IN.. 2040 SPL 92067-18218 &MC.. 2013 ASMB 92067-18219 &RC.. 2013 ASMB 92067-18221 &LI.. 2013 SPL 92067-18222 &DL.. 2013 SPL 92067-18223 &F.SET 2013 ASMB 92067-18224 &PU.. 2013 SPL 92067-18225 &DP.. 2013 SPL 92067-18226 &RU.. 2026 SPL 92067-18227 &ST.DU 2040 SPL 92067-18228 &CO.. 2013 SPL 92067-18229 &SP.. 2026 SPL 92067-18230 &MS.. 2013 SPL 92067-18231 &RP.. 2026 ASMB 92067-18232 &.RENM 2013 ASMB 92067-18234 &IDDUP 2013 ASMB 92067-18235 &IDRPL 2040 ASMB 92067-18236 &IDRPD 2040 ASMB 92067-18237 &SY.. 2013 SPL 92067-18238 &CL.. 2013 SPL 92067-18239 &F.UTM 2013 SPL 92067-18240 &OPMES 2013 SPL 92067-18241 &JO.. 2013 SPL 92067-18242 &EO.. 2013 SPL 92067-18243 &OF.. 2013 SPL 92067-18244 &NX.JB 2013 SPL 92067-18245 &LG.. 2013 SPL 92067-18246 &LU.. 2013 SPL 92067-18247 &TL.. 2013 SPL 92067-18248 &CS.. 20×Ë������þú13 SPL 92067-18249 &HE.. 2013 SPL 92067-18250 &WH.. 2013 SPL 92067-18251 &SM.. 2013 SPL 92067-18252 &ME.. 2013 SPL 92067-18254 &CT.. 2013 SPL 92067-18255 &AC.. 2013 ASMB 92067-18560 &PCIBF 2026 ASMB 92067-18561 &IDRPF 2026 ASMB 92067-18562 &FMGRB 2026 ASMB 92067-18563 &..BF. 2026 ASMB 92067-16268 %4SYLB 92067-18268 &$YSLB 2040 ASMB 92067-18269 &RNRQ 2013 ASMB 92067-18270 &LURQ 2013 ASMB 92067-18271 &$ALRN 2013 ASMB 92067-18272 &PRTN 2013 ASMB 92067-18273 &EQLU 2013 ASMB 92067-18275 &REIO 2013 ASMB 92067-18276 &IFBRK 2013 ASMB 92067-18277 &COR.A 2013 ASMB 92067-18278 &COR.B 2013 ASMB 92067-18279 &KCVT 2013 ASMB 92067-18281 &PARSE 2013 ASMB 92067-18282 &$PARS 2013 ASMB 92067-18283 &TMVAL 2013 ASMB 92067-18284 &CNUMD 2013 ASMB 92067-18285 &CNUMO 2013 ASMB 92067-18286 &INPRS 2013 ASMB 92067-18287 &$CVT3 2013 ASMB 92067-18289 &GETST 2013 ASMB 92067-18290 &.EMAP 2013 ASMB 92067-18291 &.EMIO 2013 ASMB 92067-18292 &.EMAS 2013 ASMB 92067-18293 &MMAP æä������þú 2013 ASMB 92067-18294 &EMAST 2013 ASMB 92067-18295 &IFTTY 2013 ASMB 92067-18296 &TRMLU 2013 ASMB 92067-18297 &LOGLU 2013 ASMB 92067-18298 &IDGET 2013 ASMB 92067-18299 &IXGET 2013 ASMB 92067-18300 &IXPUT 2013 ASMB 92067-18301 &FTIME 2013 ASMB 92067-18302 &.IAE. 2013 ASMB 92067-18303 &.RAE. 2013 ASMB 92067-18304 &.XAE. 2013 ASMB 92067-18305 &.ZAE. 2013 ASMB 92067-18306 &.STDB 2013 ASMB 92067-18307 &DTACH 2013 ASMB 92067-18308 &LUTRU 2013 ASMB 92067-18309 &FNDLU 2013 ASMB 92067-18310 &CAPCK 2013 ASMB 92067-18311 &$BALC 2013 ASMB 92067-18324 &.OWNR 2013 ASMB 92067-18328 &.SETB 2013 ASMB 92067-18329 &KHAR 2013 ASMB 92067-18331 &INAMR 2013 ASMB 92067-18341 &SYCON 2013 ASMB 92067-18454 &$ESTB 2013 ASMB 92067-18474 &.TAE. 2013 ASMB 92067-18475 &.ERES 2013 ASMB 92067-18476 &SEGLD 2013 ASMB 92067-18477 &LIMEM 2013 ASMB 92067-18478 &EQRQ 2040 ASMB 92067-18479 &CHEL 2040 ASMB 92067-18481 &LUSES 2013 ASMB 92067-18483 &$SMVE 2013 ASMB 92067-18484 &PTEA–���0��.*RR 2013 ASMB 92067-18485 >ERR 2013 ASMB 92067-18491 &SAVST 2013 ASMB 92068-18002 &%SSW 2013 ASMB 92068-18003 &%WRIS 2013 ASMB 92068-18004 &%WRIT 2013 ASMB 92068-18010 &.OPSY 2013 ASMB 92068-18012 &.TAPE 2013 ASMB 92068-18013 &ABREG 2013 ASMB 92068-18014 &BINRY 2013 ASMB 92068-18015 &DBKPT 2013 ASMB 92068-18016 &DEBUG 2013 ASMB 92068-18017 &IGET 2013 ASMB 92068-18018 &ATACH 2013 ASMB 92068-18019 &ISSR 2013 ASMB 92068-18020 &MAGTP 2013 ASMB 92068-18021 &NAMR 2013 ASMB 92068-18022 &OVF 2013 ASMB 92068-18024 &PTAPE 2013 ASMB 92068-18025 &RMPAR 2013 ASMB 92068-18026 &RSFLG 2013 ASMB 92068-18027 &SREAD 2013 ASMB 92068-18028 &.MAC. 2013 ASMB 92068-18029 &DBGLU 2013 ASMB 92068-18032 &ISSW 2013 ASMB 92068-18035 &PNAME 2013 ASMB 92068-18041 &.PACK 2013 ASMB 92068-18042 &$SUB2 2040 ASMB 92068-18061 &RPLIB 2040 ASMB ��������������������������������������������������������������������������������_c0������ÿÿ����� ���� ÿý�*� 7 ���������ÿ��92068-18051 2026� S C0122 �DIREC4 �SRC TAPE #4 DIRECTORY � � � � � � � � � � � � �H0101 H›�����þú ************************************************************** * RTE-IVB SOURCE PRODUCT * * 92068X * * REV. 2026 * * TAPE # 4 * * * * DATE: 5/15/80 * ************************************************************** * REL. PART # REL.NAME SRC. PART # SRC.NAME REV LANG. * ************************************************************** 24306-60001 %DECAR 24306-18004 &ADD 2026 ASMB 24306-18005 &A2DE 2026 ASMB 24306-18006 &CARY 2026 ASMB 24306-18007 &JSCOM 2026 ASMB 24306-18008 &DCAR 2026 ASMB 24306-18009 &DEA2 2026 ASMB 24306-18010 &DIV 2026 ASMB 24306-18011 &EDIT 2026 ASMB 24306-18012 &D1D2 2026 ASMB 24306-18013 &D2D1 2026 ASMB 24306-18014 &FILL 2026 ASMB 24306-18015 &GET 2026 ASMB 24306-18016 &MOVE 2026 ASMB 24306-18017 &MPY 2026 ASMB 24306-18018 &PUT 2026 ASMB 24306-18019 &SIGN 2026 ASMB 24306-18020 &SUB 2026 ASMB 24306-18021 &ZONE 2026 ASMB 24306-18022 &S.GET 2026 ASMB 24998-12001 $MLIB1 24998-18200 &$MLB1 2013 ASMB 24998-18230 &FMTIO 2013 ASMB 24998-18231 &FRMTR 2013 ASMB |À������þú 24998-18232 &FMT.E 2013 ASMB 24998-18233 &#COS 2013 ASMB 24998-18234 &#EXP 2013 ASMB 24998-18235 &#LOG 2013 ASMB 24998-18236 &#SIN 2013 ASMB 24998-18237 &%AN 2013 ASMB 24998-18238 &%IN 2013 ASMB 24998-18239 &%LOG 2013 ASMB 24998-18240 &%LOGT 2013 ASMB 24998-18241 &%OS 2013 ASMB 24998-18242 &%TAN 2013 ASMB 24998-18243 &%XP 2013 ASMB 24998-18244 &$EXP 2013 ASMB 24998-18245 &$LOG 2013 ASMB 24998-18246 &$LOGT 2013 ASMB 24998-18247 &$SQRT 2013 ASMB 24998-18248 &CLRIO 2013 ASMB 24998-18249 &ER0.E 2013 ASMB 24998-18250 &ERR0 2013 ASMB 24998-18251 &IND.E 2013 ASMB 24998-18252 &INDEX 2013 ASMB 24998-18253 &PAUSE 2013 ASMB 24998-18254 &PAU.E 2013 ASMB 24998-18255 &%QRT 2013 ASMB 24998-12002 $MLIB2 24998-18013 &$SETP 2013 ASMB 24998-18014 &$TAN 2013 ASMB 24998-18015 &%ABS 2013 ASMB 24998-18016 &%AND 2013 ASMB 24998-18017 &%ANH 2013 ASMB 24998-18018 &%BS 2013 ASMB 24998-18019 &%FIX 2013 ASMB 24998-18020 &%IGN 2013 ASMB 24998-18021 &%INT 2013 ASMB¡†������þú 24998-18022 &%LOAT 2013 ASMB 24998-18023 &%NT 2013 ASMB 24998-18024 &%OR 2013 ASMB 24998-18025 &%OT 2013 ASMB 24998-18026 &%SIGN 2013 ASMB 24998-18028 &..CCM 2013 ASMB 24998-18029 &..MAP 2013 ASMB 24998-18030 &.ABS 2013 ASMB 24998-18031 &.CDBL 2013 ASMB 24998-18032 &.CHEB 2013 ASMB 24998-18033 &.CINT 2013 ASMB 24998-18034 &.CTBL 2013 ASMB 24998-18035 &.CTOI 2013 ASMB 24998-18036 &.DADS 2013 ASMB 24998-18037 &.DCO 2013 ASMB 24998-18038 &.DCPX 2013 ASMB 24998-18039 &.DDE 2013 ASMB 24998-18040 &.DDI 2013 ASMB 24998-18041 &.DDS 2013 ASMB 24998-18042 &.DIN 2013 ASMB 24998-18043 &.DINT 2013 ASMB 24998-18044 &.DIS 2013 ASMB 24998-18045 &.DMP 2013 ASMB 24998-18046 &.DNG 2013 ASMB 24998-18047 &.DRCT 2013 ASMB 24998-18048 &.DTOI 2013 ASMB 24998-18049 &.DTOR 2013 ASMB 24998-18050 &.FLTD 2013 ASMB 24998-18051 &.GOTO 2013 ASMB 24998-18052 &.ICPX 2013 ASMB 24998-18053 &.IDBL 2013 ASMB 24998-18054 &.IENT 2013 ASMB 24998-18055 &.ITOI 2013 *ó������þúASMB 24998-18056 &.MANT 2013 ASMB 24998-18057 &.MAP. 2013 ASMB 24998-18058 &.MOD 2013 ASMB 24998-18059 &.MXMN 2013 ASMB 24998-18060 &.PCAD 2013 ASMB 24998-18061 &.PRAM 2013 ASMB 24998-18062 &.RTOD 2013 ASMB 24998-18063 &.RTOI 2013 ASMB 24998-18064 &.RTOR 2026 ASMB 24998-18065 &.RTOT 2013 ASMB 24998-18066 &.SIGN 2013 ASMB 24998-18067 &.SWCH 2013 ASMB 24998-18068 &.TANH 2013 ASMB 24998-18069 &.TCPX 2013 ASMB 24998-18070 &.TTOI 2013 ASMB 24998-18071 &.TTOR 2013 ASMB 24998-18072 &.XCOM 2013 ASMB 24998-18073 &.XFTD 2013 ASMB 24998-18074 &.XFXD 2013 ASMB 24998-18075 &/ATA2 2013 ASMB 24998-18076 &/COS 2013 ASMB 24998-18077 &/EXP 2013 ASMB 24998-18078 &/LOG 2013 ASMB 24998-18079 &/LOG0 2013 ASMB 24998-18080 &/SIN 2013 ASMB 24998-18081 &/SQRT 2013 ASMB 24998-18082 &/TAN 2013 ASMB 24998-18083 &/TINT 2013 ASMB 24998-18084 &AIMAG 2013 ASMB 24998-18085 &AMOD 2013 ASMB 24998-18086 &CADD 2013 ASMB 24998-18087 &CDIV 2013 ASMB 24998-18088 &CMPY 20vR������þú13 ASMB 24998-18089 &CONJG 2013 ASMB 24998-18090 &CSQRT 2013 ASMB 24998-18091 &CSUB 2013 ASMB 24998-18092 &DABS 2013 ASMB 24998-18093 &DATN2 2013 ASMB 24998-18094 &DCOS 2013 ASMB 24998-18095 &DIM 2013 ASMB 24998-18096 &DMOD 2013 ASMB 24998-18097 &DTANH 2013 ASMB 24998-18098 &ENTIE 2013 ASMB 24998-18099 &FIXDR 2013 ASMB 24998-18100 &FLTDR 2013 ASMB 24998-18101 &GETAD 2013 ASMB 24998-18102 &IAND 2013 ASMB 24998-18103 &IDIM 2013 ASMB 24998-18104 &IDINT 2013 ASMB 24998-18105 &IOR 2013 ASMB 24998-18106 &IXOR 2013 ASMB 24998-18107 &MOD 2013 ASMB 24998-18108 &MXMND 2013 ASMB 24998-18109 &MXMNI 2013 ASMB 24998-18110 &MXMNR 2013 ASMB 24998-18111 &REAL 2013 ASMB 24998-18112 &XADD 2013 ASMB 24998-18113 &XDIV 2013 ASMB 24998-18114 &XMPY 2013 ASMB 24998-18115 &XSUB 2013 ASMB 24998-18116 &Z$DBL 2013 ASMB 24998-18117 &..DLC 2013 ASMB 24998-18118 &.ATA2 2013 ASMB 24998-18119 &.CADD 2013 ASMB 24998-18120 &.CDIV 2013 ASMB 24998-18121 &.CMPY òÊ������þú 2013 ASMB 24998-18122 &.CSUB 2013 ASMB 24998-18123 &.DTOD 2013 ASMB 24998-18124 &.FPWR 2013 ASMB 24998-18125 &.LOG0 2013 ASMB 24998-18126 &.NGL 2013 ASMB 24998-18127 &.RCNG 2013 ASMB 24998-18128 &.SQRT 2013 ASMB 24998-18129 &.TAN 2013 ASMB 24998-18130 &.TPWR 2013 ASMB 24998-18131 &.TSCS 2013 ASMB 24998-18132 &.TTOT 2013 ASMB 24998-18133 &.YINT 2013 ASMB 24998-18134 &AINT 2013 ASMB 24998-18135 &ALOGT 2013 ASMB 24998-18136 &CEXP 2013 ASMB 24998-18137 &CLOG 2013 ASMB 24998-18138 &CMPLX 2013 ASMB 24998-18139 &CSNCS 2013 ASMB 24998-18140 &DATAN 2013 ASMB 24998-18142 &DLOGT 2013 ASMB 24998-18143 &DSIGN 2013 ASMB 24998-18144 &DSIN 2013 ASMB 24998-18145 &DSQRT 2013 ASMB 24998-18146 &DTAN 2013 ASMB 24998-18147 &IABS 2013 ASMB 24998-18148 &INT 2013 ASMB 24998-18149 &ISIGN 2013 ASMB 24998-18150 &SNGM 2013 ASMB 24998-18151 &TAN 2013 ASMB 24998-18152 &TANH 2013 ASMB 24998-18153 &..DCM 2013 ASMB 24998-18154 &.ATAN 2013 ASMB 24998-18155 &.ENšK������þúTC 2013 ASMB 24998-18156 &.EXP 2013 ASMB 24998-18157 &.ITBL 2013 ASMB 24998-18158 &.LOG 2013 ASMB 24998-18159 &.SNCS 2013 ASMB 24998-18160 &.TENT 2013 ASMB 24998-18161 &.TINT 2013 ASMB 24998-18162 &ALOG 2013 ASMB 24998-18163 &ATAN2 2013 ASMB 24998-18164 &CABS 2013 ASMB 24998-18165 &DEXP 2013 ASMB 24998-18166 &DLOG 2013 ASMB 24998-18167 &EXP 2013 ASMB 24998-18168 &XPOLY 2013 ASMB 24998-18169 &..TCM 2013 ASMB 24998-18170 &.BLE 2013 ASMB 24998-18171 &.CMRS 2013 ASMB 24998-18172 &.XDIV 2013 ASMB 24998-18173 &/ATLG 2013 ASMB 24998-18174 &/CMRT 2013 ASMB 24998-18175 &/EXTH 2013 ASMB 24998-18176 &ABS 2013 ASMB 24998-18177 &ATAN 2013 ASMB 24998-18178 &DBLE 2013 ASMB 24998-18179 &DDINT 2013 ASMB 24998-18180 &SIGNM 2013 ASMB 24998-18181 &SQRT 2013 ASMB 24998-18182 &..FCM 2013 ASMB 24998-18183 &.4ZRO 2013 ASMB 24998-18184 &.PWR2 2013 ASMB 24998-18185 &.TFTD 2013 ASMB 24998-18186 &.TFXD 2013 ASMB 24998-18187 &.XMPY 2013 ASMB 24998-18188 z ������þú&DPOLY 2013 ASMB 24998-18189 &ENTIX 2013 ASMB 24998-18190 &SNGL 2013 ASMB 24998-18191 &XADSB 2013 ASMB 24998-18192 &.ENTR 2013 ASMB 24998-18193 &.FIXD 2013 ASMB 24998-18194 &.TMTH 2013 ASMB 24998-18195 &.XPAK 2013 ASMB 24998-18196 &.CFER 2013 ASMB 24998-18197 &.FLUN 2013 ASMB 24998-18198 &.XFER 2013 ASMB 24998-18199 &.DFER 2013 ASMB 24998-18201 &$MLB2 2026 ASMB 92002-16010 %EDITR 92002-18010 &EDITR 2026 ASMB 92060-16092 %FTN4 92060-18092 &FTN4 2026 ASMB 92060-16093 %FFTN4 92060-18093 &FFTN4 1913 ASMB 92060-16094 %0FTN4 92060-18094 &0FTN4 2026 ASMB 92060-16095 %1FTN4 92060-18095 &1FTN4 2001 ASMB 92060-16096 %2FTN4 92060-18096 &2FTN4 2026 ASMB 92060-16097 %3FTN4 92060-18097 &3FTN4 1913 ASMB 92060-16098 %4FTN4 92060-18098 &4FTN4 2026 ASMB 92060-16099 %5FTN4 92060-18101 &5FTN4 1913 ASMB 92067-12001 %CLIB 92060-18054 &OPN.C 1926 ASMB 92060-18055 &CLO.C 1913 ASMB 92060-18056 &RED.C 1926 ASMB 92060-18057 &WRT.C 2013 ASMB 92060-18058 &SPC.C 1901 ASMB 92060-18059 &RWN.C 1901 ASMB 92060-18060 &EOF.C 1901 ASMB 92060-18061 &GMM.C 1901 ASMB 92060-18062 &OLY.C 1901 ASMB 92060-18064 &END.C 1901 ASMB 92060-18065 &PRM.C 1901 ASMB 92060-1806e������þú6 &GMS.C 1901 ASMB 92060-18067 &WARC. 1901 ASMB 92060-18068 &GES.C 1901 ASMB 92060-18070 &CRE.C 1901 ASMB 92060-18071 &ADS.C 1901 ASMB 92060-18072 &C.BS2 1901 ASMB 92060-18073 &ID.AD 1901 ASMB 92060-18074 &C.TRN 1901 ASMB 92060-18075 &C.SAU 1901 ASMB 92060-18076 &C.SOR 1901 ASMB 92060-18077 &C.BIN 1901 ASMB 92060-18078 &C.LST 1901 ASMB 92060-18079 &C.SC0 1901 ASMB 92060-18080 &C.SC1 1901 ASMB 92060-18081 &C.SC2 1901 ASMB 92060-18082 &C.BNS 1901 ASMB 92060-18083 &C.BSA 1901 ASMB 92060-18086 &C.BS0 1901 ASMB 92060-18087 &C.BBI 1901 ASMB 92060-18088 &C.BLI 1901 ASMB 92060-18089 &C.BS0 1901 ASMB 92060-18090 &C.BS1 1901 ASMB 92060-18091 &SUP.C 1901 ASMB 92060-18100 &C.BIA 1901 ASMB 92060-18102 &C.RP 1926 ASMB 92067-18084 &GETBF 1913 ASMB 92067-18085 &RETBF 1913 ASMB 92067-18086 &TRIM 1913 ASMB 92067-18087 &MEMBF 1913 ASMB 92067-18100 &$CLBS 1926 ASMB 92067-18101 &GEX.C 9126 ASMB 92067-16011 %4ASMB 92067-18011 &4ASMB 2013 ASMB 92067-16012 %4XREF 92067-18012 &4XRF1 2001 ASMB 92067-16070 %4ASB0 92067-ÆU���<��:618070 &4ASB0 1940 ASMB 92067-16071 %4ASB1 92067-18071 &4ASB1 1940 ASMB 92067-16072 %4ASB2 92067-18072 &4ASB2 1940 ASMB 92067-16073 %4ASB3 92067-18073 &4ASB3 1940 ASMB 92067-16074 %4ASB4 92067-18074 &4ASB4 1940 ASMB ��������������������������������µ<������ÿÿ����� ���� ÿý�+�: ���������ÿ��92068-18052 2040� S C0122 �DIREC5 SOURCE TAPE #5 �DIRECTORY � � � � � � � � � � � � �H0101 R�����þú ************************************************************** * RTE-IVB SOURCE PRODUCT * * 92068X * * REV. 2040 * * TAPE # 5 * * * * DATE: 9/12/80 * ************************************************************** * REL. PART # REL.NAME SRC. PART # SRC.NAME REV LANG. * ************************************************************** 92067-16104 %UTLIB 92067-18314 &UTLIB 2026 ASMB 92067-18357 &MT1OK 1903 ASMB 92067-18423 &FESSN 1926 ASMB 92067-18424 &NMCHK 1903 ASMB 92067-18459 &GETSP 1903 ASMB 92067-18465 &CLERR 1903 FTN4 92067-18503 &VALID 2026 FTN4 92067-18504 &REDIR 2026 FTN4 92067-18505 &REFMT 2026 FTN4 92067-18558 &IDSGM 2026 FTN4 92067-18559 &COMRD 2026 FTN4 92067-16121 %HELP 92067-18121 &HELP 1903 ASMB 92067-16260 %SMON1 92067-18260 &LOGON 2026 FTN4 92067-18261 &LGOF 1940 FTN4 92067-18262 &PRMPT 2026 ASMB 92067-18263 &R$PN$ 2001 ASMB 92067-18264 &LSUBC 1903 ASMB 92067-18265 &LSUB1 2026 ASMB 92067-18266 &LSUB2 1903 ASMB 92067-18312 &SMO1N 2026 ASMB 92067-18442 &$YCOM 1903 ASMB 92067-16261 %SMON2 92067-18313 &SMO2N 2001 ASMB M¦������þú 92067-18443 &MESSS 1903 ASMB 92067-18444 &MKSCB 1903 ASMB 92067-18445 &RLSCB 1903 ASMB 92067-18455 &$SALC 2001 ASMB 92067-18457 &$CMND 1940 ASMB 92067-18482 &VSCBA 1903 ASMB 92067-16350 %SPO2B 92067-18350 &SPOLH 2013 ASMB 92067-18351 &SMP 1940 ASMB 92067-18352 &DVS43 2013 ASMB 92067-18353 &EXTND 1903 ASMB 92067-18354 &JOB 1903 ASMB 92067-18355 &SPOUT 1903 ASMB 92067-18356 &$SPCL 1903 ASMB 92067-16358 %CLOAD 92067-18358 &CLOAD 1903 FTN4 92067-16359 %COMPL 92067-18359 &COMPL 1903 FTN4 92067-16361 %ACCTS 92067-18360 &ACCT1 2013 FTN4 92067-18362 &ACMND 2013 FTN4 92067-18363 &ACALT 1940 FTN4 92067-18364 &ACALU 1940 FTN4 92067-18365 &ACCRE 1940 ASMB 92067-18366 &ACOPN 2001 ASMB 92067-18367 &ACWRH 1940 ASMB 92067-18368 &ACINT 1940 ASMB 92067-18369 &ACLIU 1940 FTN4 92067-18370 &ACLIA 2001 FTN4 92067-18371 &ACLOA 2001 FTN4 92067-18372 &ACNWG 1940 FTN4 92067-18373 &ACNWU 2013 FTN4 92067-18374 &ACPAS 2013 FTN4 92067-18375 &ACPUA 1940 FTN4 92067-18376 &ACSDN 1940 ASMB 92067-18377 &ACPUU 1940 FTN4 92067-18378 &ACTEL 1940 FTN4 ƒ������þú 92067-18379 &ACUNL 1940 FTN4 92067-18380 &ACAST 1940 FTN4 92067-18381 &ACSTR 1940 FTN4 92067-18382 &ACACP 2001 FTN4 92067-18383 &ACNVS 1940 FTN4 92067-18384 &ACTIM 1940 FTN4 92067-18385 &ACNFG 1940 FTN4 92067-18386 &ACFDF 1940 FTN4 92067-18387 &ACGSP 1940 FTN4 92067-18388 &ACGTG 1940 FTN4 92067-18389 &ACGTU 1940 FTN4 92067-18390 &ACGID 1940 FTN4 92067-18391 &ACSID 1940 FTN4 92067-18392 &ACGBT 1940 ASMB 92067-18393 &ACSBT 1940 ASMB 92067-18394 &ACASB 1940 FTN4 92067-18395 &ACINM 2001 ASMB 92067-18396 &ACLNK 1940 FTN4 92067-18397 &ACLTM 1940 ASMB 92067-18398 &ACMSN 1940 FTN4 92067-18399 &ACOPL 2001 FTN4 92067-18400 &ACNXA 1940 FTN4 92067-18401 &ACFID 1940 ASMB 92067-18402 &ACPGA 1940 FTN4 92067-18403 &ACTRM 2001 FTN4 92067-18404 &ACDDV 1940 ASMB 92067-18405 &ACDIR 1940 FTN4 92067-18406 &ACFDA 1940 FTN4 92067-18407 &ACFMT 1940 ASMB 92067-18408 &ACCLL 1940 FTN4 92067-18409 &ACPRM 1940 FTN4 92067-18410 &ACREI 1940 FTN4 92067-18411 &ACHLP 1940 FTN4ëÅ������þú 92067-18412 &ACERR 1940 FTN4 92067-18413 &ACWRL 1940 FTN4 92067-18414 &ACREL 1940 FTN4 92067-18415 &ACITA 1940 ASMB 92067-18416 &ACXFR 1940 FTN4 92067-18417 &ACTIN 1940 FTN4 92067-18418 &ACWRI 1940 FTN4 92067-18419 &ACSES 2001 ASMB 92067-18420 &IFBNR 1940 FTN4 92067-18421 &MBYTE 1940 ASMB 92067-18422 &IVBUF 1940 ASMB 92067-16425 %SPO1B 92067-18425 &GASPH 2013 ASMB 92067-18426 &GASP 1903 SPL 92067-18427 &G1CEX 1903 SPL 92067-18428 &ST.LU 1903 ASMB 92067-18429 &G1ROT 1940 ASMB 92067-18430 &G0QIP 1903 ASMB 92067-18431 &GASP1 1940 ASMB 92067-18432 &G1CDJ 1903 SPL 92067-18433 &G1CCJ 1903 SPL 92067-18434 &G1CKS 2013 SPL 92067-18435 &G1CDS 2013 ASMB 92067-18436 &G1STM 1903 ASMB 92067-18437 &GASP2 1903 ASMB 92067-18438 &G1CSD 2013 ASMB 92067-18439 &G1C?? 2013 ASMB 92067-18440 &G1CIN 2013 SPL 92067-18441 &G1CDA 2013 SPL 92067-18488 &G1CUP 2013 ASMB 92067-16456 %NSESN 92067-18447 &NSESN 1903 ASMB 92067-18472 &MESSA 1913 ASMB 92067-18473 &NCMND 2013 ASMB 92067-16469 %T5IDM 92067-18469 &T5IDM 1903 õ4�����ASMB 92067-16470 $LDRLB 92067-18470 &LDRLB 2026 ASMB 92067-16471 %4LDR 92067-18471 &4LDR 2040 ASMB 92067-16516 %$CNFX 92067-18006 &$CNFX 2001 ASMB ����������������������������������������������������������������������������������������B������ÿÿ����� ���� ÿý�,� 6 ���������ÿ��92068-18061 2040� S C0122 �&RPLIB � � � � � � � � � � � � � �H0101 €…�����þúASMB,B,Q,C HED M-SERIES RPL LIBRARY * * NAME: RPLIB * SOURCE: 92068-18061 * RELOC: 92068-16268 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RPLIB 92068-1X061 REV.2040 807029 * **************************************************************** * * * EXTENDED ARITHMETIC MEMORY INSTRUCTIONS * * * **************************************************************** * ENT .DIV,.MPY,.DLD,.DST * .DIV RPL 100400B .MPY RPL 100200B .DLD RPL 104200B .DST RPL 104400B SKP * **************************************************************** * * * EXTENDED INSTRUCTION GROUP * * * **************************************************************** * ENT .ADX,.ADY,.CAX,.CAY,.CBS ENT .CBT,.CBX,.CBY,.CMW,.CXA,.CXB ENT .CYA,.CYB,.DSX,.DSY,.ISX ENT .ISY,.JLY,.JPY,.LAX,.LAY,.LBT ENT .LBX,.LBY,.LDX,.LDY,.MBT ENT .MVW,.SAX,.SAY,.SBS,.SBT,.SBX ENT .SBY,.SFB,.STX,.STY,.TBS ENT .XAX,.XAY,.XBX,.XBY * .ADX RPL 105746B .ADY RPL 105756B .CAX RPL 101741B .CAY RPL 101751B .CBS RPL 105774B .CBT RPL 105766B .CBX RPL 105741B .CBY RPL 105751B .CMW RPL 105776B .CXA RPL 101744B .CXB RPL 105744B .CYA RPL 101754B .CYB RPL 105754B .DSX RPL 105761B .DSY RPL 105771B .ISX RPL 105760B .ISY RPL 105770B .JLY RPL 105762BB)��� ��  .JPY RPL 105772B .LAX RPL 101742B .LAY RPL 101752B .LBT RPL 105763B .LBX RPL 105742B .LBY RPL 105752B .LDX RPL 105745B .LDY RPL 105755B .MBT RPL 105765B .MVW RPL 105777B .SAX RPL 101740B .SAY RPL 101750B .SBS RPL 105773B .SBT RPL 105764B .SBX RPL 105740B .SBY RPL 105750B .SFB RPL 105767B .STX RPL 105743B .STY RPL 105753B .TBS RPL 105775B .XAX RPL 101747B .XAY RPL 101757B .XBX RPL 105747B .XBY RPL 105757B SKP * **************************************************************** * * * FLOATING POINT INSTRUCTIONS * * * **************************************************************** * ENT .FAD,.FDV,.FIX,IFIX,.FLT,FLOAT,.FMP,.FSB * .FAD RPL 105000B .FDV RPL 105060B .FIX RPL 105100B IFIX RPL 105100B .FLT RPL 105120B FLOAT RPL 105120B .FMP RPL 105040B .FSB RPL 105020B * **************************************************************** * * * L-SERIES IMPLEMENTED DYNAMIC MAPPING SYSTEM INSTRUCTIONS * * * **************************************************************** * ENT .MBF,.MBI,.MBW,.MWF,.MWI,.MWW,.XCA,.XCB,.XLA,.XLB ENT .XSA,.XSB,.XST,.XLD * .MBF RPL 105703B .MBI RPL 105702B .MBW RPL 105704B .MWF RPL 105706B .MWI RPL 105705B .MWW RPL 105707B .XCA RPL 101726B .XCB RPL 105726B .XLA RPL 101724B .XLB RPL 105724B .XSA RPL 101725B .XSB RPL 105725B .XST RPL 101725B SAME AS XSA .XLD RPL 101724B SAME AS XLA * **************************************************************** * END ��������������òð ������ÿÿ����� ���� ÿý�-�4 ���������ÿ��92068-18999 2040� S C0122 �A92068 �SOFTWARE NUMBERING FILE � � � � � � � � � � � � �H0101 D�����þúA92068 SOF NUM CAT REV 2040 92068-18999 MODULE DESCRIPTION DATE CODE PART NUMBER A92068 IVB SOFTWARE NUM. CAT. 2040 92068-18999 !DISK ICD/MAC OFFLN DISC BK 2026 92067-16348 !DSKUP OFF-LINE DISC BACKUP 2013 92067-16340 !MTLDR MT LOADER FOR !DISK 2001 92067-16512 "HELP HELP FILE PT 1 2026 92067-18122 "HELPA HELP FILE PT 2 2026 92067-18489 "HELPB HELP FILE PT 3 2026 92067-18490 $DKULB ICD/MAC DISC BKUP LIB 2026 92067-12003 $DSCLB ICD/MAC DISC UT LIB 2040 92067-12002 $LDRLB RTE LOADER LIB 2026 92067-16470 $MLIB1 IVB SYSTEM IND. LIB. 1 2013 24998-12001 $MLIB2 IVB SYSTEM IND. LIB. 2 2026 24998-12002 %#EMA RTE4 EMA FIRMWARE VER 1805 92067-16013 %$CNFX RTE4 CONFIGURATOR 2040 92067-16516 %$TA32 ICD/DVA32 TRACK MAP 2001 92067-16507 %$TB32 MAC/DVR32 TRACK MAP 2001 92067-16509 %0DV05 2640A/B DVR (CTU) 1926 92001-16028 %0FTN4 RTE FORTRAN IV, SEG 0 2026 92060-16094 %1DV37 RTE HPIB DVR W/O SRQ 2026 59310-16002 %1FTN4 RTE FORTRAN IV, SEG 1 2001 92060-16095 %2DV37 RTE HPIB DVR WITH SRQ 2026 59310-16003 %2DV47 92900A DVR W/O DMS 1913 92900-16002 %2FTN4 RTE FORTRAN IV, SEG 2 2026 92060-16096 %3DV47 92900A(3070) DMS DVR 1913 92900-16003 %3FTN4 RTE FORTRAN IV, SEG 3 1913 92060-16097 %4ASB0 RTE4 ASSEMBLER, SEG 0 1940 92067-16070 %4ASB1 RTE4 ASSEMBLER, SEG 1 1940 92067-16071 %4ASB2 RTE4 ASSEMBLER, SEG 2 1940 92067-16072 %4ASB3 RTE4 ASSEMBLER, SEG 3 1940 92067-16073 %4ASB4 RTE4 ASSEMBLER, SEG 4 1940 92067-16074 %4ASMB RTE4 ASSEMBLER, MAIN 2013 92067-16011 %4AUTR RTE-IVB AUTO RESTART 1903 92067-16118 %4DP43 RTE-IVB POWER FAIL 1926 92067-16004 %4DV05 2644/45 DVR (CTU) 1926 92001-16027 %4FTN4 RTE FOR¼¹������þúTRAN IV, SEG 4 2026 92060-16098 %4LDR RTE4B C.P.L. LOADR 2040 92067-16471 %4MTM RTE4 MULTI TERM MON 1926 92067-16003 %4PVMP RTE4 PRIV MAPPING 1805 92067-16001 %4SYLB RTE4B SYSTEM LIBRARY 2040 92067-16268 %4XREF RTE4 CROSS REF GEN 2001 92067-16012 %5FTN4 RTE FORTRAN IV, SEG 5 1913 92060-16101 %ACCTS ACCOUNTS PROGRAM PT.1 2013 92067-16361 %ACCTT ACCOUNTS PROGRAM PT.2 2013 92067-16362 %ACCTU ACCOUNTS PROGRAM PT.3 2013 92067-16363 %BMPG1 RTE-IVB FMGR SES MON 2040 92067-16185 %BMPG2 DIRECTORY MANAGER 2026 92067-16124 %BMPG3 RTE BATCH LIBRARY 2026 92067-16125 %CLIB RTE-IVB COMPILER LIB 2013 92067-12001 %CLOAD COMPL & LOAD INTF 1903 92067-16358 %COMPL COMPILER INTF 1903 92067-16359 %COPY RTE DISC COPY PROG 1903 92067-16338 %CR4S1 IVB MEM RES OP SYS 1 2040 92067-16102 %CR4S2 IVB MEM RES OP SYS 2 2040 92067-16103 %DBKLB RTE DISC BACKUP LIB 2013 92067-16339 %DBUGR RTE4 DEBUG SUBROUTINE 2013 92067-16075 %DECAR RTE DEC STRNG ARITH 2026 24306-60001 %DSCHD RTE MTIS TRAP ROUTINE A 09580-16126 %DVA05 264X(CTU) MODEM DVR 2013 92001-16035 %DVA12 26XX LINE PRINTER DVR 1826 92001-16020 %DVA13 91200A TV MONITOR DVR 1648 91200-16001 %DVA32 ICD DISC DRIVER 2013 92067-16553 %DVB12 2608A LINE PRNTR DVR 2013 92062-16004 %DVC32 ICD DISC DVR COPY #2 2013 92067-16506 %DVM72 RTE MTIS DRIVER 2026 09580-16079 %DVP32 MAC DISC DVR COPY #2 2013 92067-16508 %DVR00 TTY/PUNCH/CD RDR DVR 1740 29029-60001 %DVR11 2892A CARD READER DVR 1710 29030-60001 %DVR12 2767A/9866A LP DVR 1805 29028-60002 %DVR15 RTE 7261A CARDRDR DVR 1901 09601-16021 %DVR23 7970 9-TRK MT DVR 1913 92202-16001 %DVR31 RTE 7900A DISC DVR 1903 ZN������þú 92067-16466 %DVR32 MAC DISC DRIVER 2013 92067-16330 %DVR33 RTE FLEXIBLE DISC DVR 1903 92067-16467 %EDITA EDIT/1000 EDITOR PT. 1 2040 92074-12001 %EDITB EDIT/1000 EDITOR PT. 2 2040 92074-12002 %EDITR RTE EDITOR 2026 92002-16010 %FFTN4 RTE FTN IV, SEG ID 1913 92060-16093 %FORMT ICD/MAC DISC FORMAT 2040 92067-16554 %FTN4 RTE FTN IV, MAIN 2026 92060-16092 %HELP HELP UTILITY 1903 92067-16121 %IB4A HPIB RTE4 LIBRARY 2026 59310-12001 %KEYS RTE SOFT KEY UTILITY 1707 92060-16052 %KYDMP RTE SF KEY DUMP UTIL 1707 92060-16053 %LCOPY ICD/MAC DISC LU COPY 2013 92067-16347 %LGTAT RTE4 TAT LOG 1926 92067-16008 %LP31 RTE 2631A LP SUB 1805 92062-16003 %LSAVE ICD/MAC DISC LU SAVE 2026 92067-16344 %MERGE MERGE FILE UTILITY 2013 92067-16334 %MSAFD RTE FLEX DISC BACKUP 1740 92064-16086 %NSESN NON-SESSION LIB 2013 92067-16456 %RDNAM RTE READ NAMR PROG 1926 92060-16045 %READT RESTORE DISC UTILITY 2026 92067-16332 %RESTR ICD/MAC DISC RESTR 2026 92067-16346 %RSTOR RTE IVB RESTORE PROG 1903 92067-16336 %RT4GN RTE4B GENERATOR 2026 92067-16315 %SAVE RTE SAVE PROGRAM 2013 92067-16335 %SMON1 SESSION MONITOR #1 2026 92067-16260 %SMON2 SESSION MONITOR #2 2001 92067-16261 %SPO1B RTE4B SPOOL #1, GASP 2013 92067-16425 %SPO2B RTE4B SPOOL #2, GASP 2013 92067-16350 %SRQ.P SRQ.P TRAP UTILITY 1805 59310-16005 %SSTCH RTE4B SWTCH PROGRAM 2001 92067-16513 %T5IDM ID SEGMENT HANDLER 1903 92067-16469 %TVLIB RTE 91200A TV MON LIB 1648 91200-16002 %TVVER 91200A TV MON INT VER 1648 91200-16004 %USAVE ICD/MAC DISC UNIT SAVE 2026 92067-16345 %UTLIB UTILITY LIBRARY 2026 92067-16104 %VERFY RTE(é������þú VERIFY PROGRAM 1903 92067-16337 %WHZAT RTE-IVB WHZAT 2001 92067-16501 %WRITT SAVE DISC UTILITY 2026 92067-16333 &$CMND COMMAND TABLE (S) 1903 92067-18457 &$TA32 ICD/DVA32 TMT SOURCE 2001 92067-18507 &$TB32 MAC/DVA32 TMT SOURCE 2001 92067-18509 &4AUTR RTE4B AUTO RESTART(S) 1903 92067-18456 &AF06H 7906H/20H G.F.D. ANS 2040 92067-18555 &AF25H 7925H G.F.D. ANS FILE 2040 92067-18487 &AN425 7925 GRNDF ANS FILE 2040 92067-18486 &AN4F0 7900 GRNDF ANS FILE 2040 92067-18342 &AN4F5 -05/06/20 GF ANS FILE 2040 92067-18343 &C.TAB COMMAND TABLE (S) 1903 92067-18201 &PKDIS RTE PACK DISC TR FILE 1926 92060-18047 &UPDAT RTE UPDATE TR FILE 1740 92060-18046 LIST OF SOFTWARE MANUALS * THE FOLLOWING IS A LIST OF THE 92068A SOFTWARE MANUALS. * THE PRINT DATE SHOWN IS THE MOST CURRENT VERSION OF THE * MANUAL FOR THE DATE CODE SHOWN AT THE BEGINNING OF THIS * FILE. THE DATE SHOWN IS THE EDITION OR THE LATEST UPDATE * PRINT DATE. IN THE CASE OF A REPRINTED MANUAL WITH * PREVIOUS UPDATES INCORPORATED, THE PRINT DATE SHOWN REFLECTS * THE LATEST UPDATE INCORPORATED. SOFTWARE MANUALS P/N EDITION UPDATE # PRINTED EDT/UPDATE GETTING ACQUAINTED W/RTE-IVB 92068-90001 N/A 4/80 RTE-IVB TERM USER'S REF 92068-90002 3 3 10/80 RTE-IVB PROGRAMMER'S REF 92068-90004 2 3 10/80 RTE-IVB BATCH AND SPOOLING REF 92068-90005 2 1 4/80 RTE-IVB SYS MANAGER'S MANUAL 92068-90006 2 3 10/80 RTE-IVB ON-LINE GENERATOR REF 92068-90007 2 1 4/80 RTE-IVB UTILITY PROGRAMS REF 92068-90010 2 3 10/80 RTE-IVB SOFTWARE NUM CAT 92068-90011 N/A 10/80 g����� RTE-IVB QUICK REF GUIDE 92068-90003 1 2 10/80 (BINDER:02177-90007) RTE-IV DEBUG SUBROUTINE REF 92067-90005 3 2/80 RTE-IV ASSEMBLER REF 92067-90003 3 2 10/80 RTE-IV FORTRAN REF 92060-90023 7 1 7/80 DOS/RTE RELOCATABLE LIB REF 24998-90001 5 3 7/80 DECIMAL STRING ARITH ROUTINES 02100-90140 3 10/79 RTE OP SYS DVR WRITING MANUAL 92200-93005 5 4/80 DVM72 (RTE UNIV IF DVR) P/O 09580-93027 2 6/79 DVR47 (SER LINK DR) P/O 92900-90005 5 2/80 DVR37 (59310B IF BUS) P/O 59310-90063 4 1 7/80 DVR33 (12732A/12733A DISC) 12732-90001 3 10/79 DVR32/DVA32 (MAC/IC DISC) REF 92068-90012 1 1 4/80 DVR23 (7970 MAG TAPE UNITS) REF 92202-93001 4 11/79 DVA13 (91200B) P/O 91200-90005 2 11/79 DVA12 (RTE LP) REF 92001-90010 2 2 10/80 DVB12 (2608A LP) REF 92062-90004 3 1 4/80 DVR12 (2607A LP) REF 92200-93001 1 8/74 DVR11 (2892A CR) REF 09600-83010 2 6/78 DVR05 (264X TERM) 92001-90015 7 1 10/80 DVR00 (MULTI-DEV SYS CONT) REF 29029-95001 3 10/78 HP-IB IN HP 1000 COMPUTER SYS 59310-90064 3 1 7/80 2631/35 SUBROUTINE REF 92062-90003 2 2/80 EDIT/1000 REFERENCE MANUAL 92074-90001 1 9/80 ����������������������������������������������������������������������������������‚›������ÿÿ����� ���� ÿý�.� 8 ���������ÿ��92069-18001 1912� S C0122 �&BDHDR �BDHR SOURCE � � � � � � � � � � � � �H0101 =g�����FTN SUBROUTINE BDHDR,92069-16001 REV.1912 790202 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18001 C RELOC: 92069-16001 C C C****************************************************************: C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ C C I=I END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������øØ������ÿÿ����� ���� ÿý�/�5 ���������ÿ��92069-18002 1912� S C0122 �&DBBLD �DBBLD SOURCE � � � � � � � � � � � � �H0101 iH�����þúFTN PROGRAM DBBLD(4,90),92069-16001 REV.1912 781120 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18002 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C DBBLD LOADS A DATA BASE FROM CARDS,MAG TAPE,PAPER TAPE, OR DISK FILE C CALLING SEQUENCE C :RU,DBBLD,INPUT,LIST [,OPTIONS LIST] C C WHERE C C INPUT C IS THE LU, OR NAMR OF THE INPUT FILE, DEFAULT IS LU 1. C C LIST C IS THE LU OR FMP NAMR OF THE LIST UNIT, DEFAULT IS LU 6. C C OPTIONS LIST C IS A LIST OF OPTIONS SEPARATED BY COMMAS. THE OPTIONS C MAY BE ENTERED IN ANY ORDER. THE OPTION DESCRIPTION C IS LISTED BELOW, C C ADD C REQUESTS THE ERROR FREE ENTRIES TO BE ADDED TO THE C DATA BASE. WHEN THIS OPTION IS NOT SPECIFIED ALL C ENTRIED ARE CHECKED FOR ERRORS, BUT ARE NOT PLACED C IN THE DATA BASE. C C ERRHLT C REQUESTS THE PROCESSING TO STOP WHEN AN ERROR IS C DISCOVERED. WHEN THIS OPTION IS NOT SELECTED, C ERRORS ARE REPORTED AND PROCESSING CONTINUES, UNLESS C A FATAL ERROR IS DISCOVERED. C C NOLIST C REQUESTS THE OUTPUT LISTING TO BE SUPRESSED C WHEN THIS OPTION IS NOT SELECTED, ONLY ERRORS C ARE LISTED ALONG WITH THE OFFENDING INPUT. C C N C IS AN INTEGER FROM 1 TO 512 INCLUSIVELY WHICH C SPECIFIES[������þú THE INPUT AND PRINT WIDTH. WHEN N IS C NOT SPECIFIED, THE DEFAULT INPUT AND PRINT WIDTH C IS 72. C C C C C C EACH DATA SET MUST BE PROCEEDED WITH THIS CARD: C $SET:<SET NAME> C WHERE $ IS IN COLUMN1 AND <SET NAME> THE NAME OF THE DATA SET C THE DATA BASE MUST BE FOLLOWED BY THIS CARD: C $END C WHERE $ IS IN COLUMN 1 C THE DATA BASE MUST BE PRECEEDED BY THIS CARD: C <DATA BASE NAME>:<SECURITY CODE>; C OR THIS CARD: C <DATA BASE NAME>:<SECURITY CODE>:<CARTRIDGE NO>; C OR THIS CARD: C <DATA BASE NAME>:<SECURITY CODE>:<CARTRIDE NO>,<LEVEL WORD>; C EACH $SET CARD IS FOLLOWED BY THE RECORDS TO BE PUT IN THAT SET C EACH RECORD MUST START ON A NEW CARD C X-TYPE ITEMS MUST BE CONTAINED IN THE EXACT NUMBER OF COLUMNS C SPECIFIED IN THE SCHEMA;ITEMS ARE CONCATONATED C I-TYPE ITEMS MUST BE CONTAINED IN 6 COLUMNS C R-TYPE ITEMS MUST BE CONTAINED IN 13 COLUMNS C C IF AN ITEM FIELD WERE TO RUN PAST THE LAST SPECIFIED COLUMN, C IT MUST INSTEAD START ON THE NEXT RECORD C C IF A X-TYPE ITEM IS SPECIFIED MORE THAN THE PRINT LIMIT IN THE C SCHEMA IT MUST START ON A NEW CARD, AND CONTINUE ON THE C THE NEXT CARD,(AND THE NEXT). C C NULL ITEMS MUST BE REPRESENTED AS ALL BLANKS C*********************************************************************** C C INTEGER BBLD(3) INTEGER SEGM(9) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144)¾á����� ,LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA SEGM/2HSE,2HGM,2HEN,2HT ,2HNO,2HT ,2HFO,2HUN,2HD / DATA BBLD/2HBB,2HLD,2H2 / C C C CALL FIRST SEGMENT OF DATA BASE BUILD C CALL GETST(P,40,PLEN) PLEN = PLEN*2 C C DEFAULT LIST TO LOG C LIST = 1 C C LOAD AND EXECUTE THE NEXT SEGMENT C CALL SEGLD(BBLD,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BBLD,3) STOP C C MAKE A CALL TO DBBUF SO THAT A COPY OF IMAGE'S MEMORY C POINTERS WILL BE LOADED WITH THE MAIN C 7777 CALL DBBUF END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������jý������ÿÿ����� ���� ÿý�0�8 ���������ÿ��92069-18003 1912� S C0122 �&BBLD2 �BBLD2 SOURCE � � � � � � � � � � � � �H0101 X6�����þúFTN PROGRAM BBLD2(5,90),92069-16001 REV.1912 790202 C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18003 C RELOC: 92069-16001 C C C************************************************************ C C C C THIS SEGMENT PROCESSES THE RUN STRING , OPENING OR LOCKING THE C INPUT AND LIST FILES OR DEVICES C SETS THE OPTIONS FLAGS C AND OPENS THE DATA BASE C LOGICAL IFTTY INTEGER IBUF(10) INTEGER I248 REAL SIZE(2) INTEGER BCLOS(3),BINF(3) INTEGER ILEVL(10),ISTAT(10) INTEGER ADD,ERR,NOLST INTEGER HD(17),HDZ INTEGER ILLST(13) INTEGER ILLU(6) INTEGER ILINP(14) INTEGER SEGM(9) INTEGER LOCKED(13) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ EXTERNAL IFTTY C DATA ADD/2HAD/ DATA ERR/2HER/ DATA NOLST/2HNO/ DATA I248/248/ C DATA SEGM/2HSE,2HGM,2HEN,2HT ,2HNO,2HT ,2HFO,2HUN,2HD / DATAJ������þú LOCKED/2H D,2HBB,2HLD,2H W,2HAI,2HTI,2HNG,2H O,2HN , & 2HLI,2HST,2H L,2HU / C IMAGE/1000 DATA BASE BUILD UTILITY DATA HD/2HIM,2HAG,2HE/,2H10,2H00,2H D,2HAT,2HA ,2HBA,2HSE, &2H B,2HUI,2HLD,2H U,2HTI,2HLI,2HTY/ DATA ILLST/2H L,2HIS,2HT ,2HFI,2HLE,2H E,2HRR,2HOR,2H I, &2HS ,2HXX,2HXX,2HXX/ DATA ILLU/2H I,2HLL,2HEG,2HAL,2H L,2HU / DATA ILINP/2H I,2HNP,2HUT,2H F,2HIL,2HE ,2HER,2HRO,2HR , &2HIS,2H ,2HXX,2HXX,2HXX/ DATA HDZ/17/ C DATA BCLOS/2HBC,2HLO,2H2 / DATA BINF/2HBI,2HNF,2H2 / DATA I203,I218/203,218/ DATA IBLNK/2H / C C C C DEFAULT PARAMETERS C PRTLM = 72 CHECK = TRUE QTFLAG = FALSE LST = TRUE ERROR = 0 C C PROCESS INPUT NAME C IPTR = 1 CALL NAMR(IBUF,P,PLEN,IPTR) C C SET INPUT LU TO ZERO AND ERROR CODE TO ZERO IN CASE C INPUT NAMR IS AN LU C INPUT = -1 IERR = 0 C C IS INPUT NAMR A FILE? C IF (IAND(IBUF(4),000003B) .NE. 3) GOTO 10 C C YES, OPEN THE FILE C CALL OPEN(IDCB,IERR,IBUF,0,IBUF(5),IBUF(6) ) GO TO 20 C C NO, THEN INPUT IS AN LU C 10 CONTINUE INPUT = IBUF(1) C C DEFAULT LU IF NECESSARY C IF(INPUT .EQ. 0) INPUT = 1 IF(INPUT .GT. 0) GOTO 12 IERR = -200 GOTO 20 C C LOCK INPUT LU IF NOT AN INTERACTIVE DEVICE C 12 CONTINUE IF(IFTTY(INPUT)) GOTO 15 CALL LURQ(1,INPUT,1) C C SET CONTROL WORD TO ECHO COMMANDS FROM A KEYBOARD C 15 CONTINUE INPUT = INPUT + 400B C C GET THE LIST PARAMETER C 20 CONTINUE CALL NAMR(IBUF,P,PLEN,IPTR) C C IS LIST A FILE? C LIST = -1 IERR2 = 0 IF (IAND(IBUF(4),000003B) .NE. 3) GOTO 30 C C YES, OPEN THE FILE C CALL OPEN (LDCB,IERR2,IBUF,0,IBUF(5),IBUF(6) ) C C IF NOT FOUND THEN CREATE THE LIST FILE C IF(IERR2 .NE. -6) GOTO 25 SIZE = DBLEI(10) CALL ECREA(LDCB,IERR2,IBUF,SIZE,4,IBUF(5),IBUF(6) ) Õ7������þú C C IF ERROR THEN ABORT C 25 CONTINUE IF (IERR2 .GE. 0) GOTO 40 C C OUTPUT ERROR MESSAGE WITH FMP ERROR CODE C LIST = 1 CALL CITA(IERR2,ILLST(11)) CALL OUTLN(ILLST,13) C C CLOSE INPUT FILE C 27 CONTINUE CALL ECLOS(IDCB) STOP C C NO, THEN LIST IS A LU C 30 CONTINUE LIST = IBUF(1) C C DEFAULT LIST TO LU 6 IF NECESSARY C IF (IBUF(4) .EQ. 0) LIST = 6 IF(LIST .GE. 0) GOTO 34 LIST = 1 CALL OUTLN(ILLU,6) GOTO 27 C C LOCK THE LU C SKIP TO TOP OF PAGE C 34 CONTINUE IF(IFTTY(LIST) ) GOTO 35 C C LOCK THE LU C CALL LURQ(100001B,LIST,1) CALL ABREG(IA,IB) IF(IA .EQ. 0) GOTO 35 CALL EXEC(2,1,LOCKED,13) 341 CALL EXEC(12,0,2,0,-10) CALL LURQ(100001B,LIST,1) CALL ABREG(IA,IB) IF(IA .NE. 0) GOTO 341 C C OUTPUT TOP OF PAGE C 35 CALL EXEC(3,1100B+LIST,-1) C C OUTPUT A HEADING C 40 CONTINUE CALL OUTLN(IBLNK,1) CALL OUTLN(IBLNK,1) CALL OUTLN(HD,HDZ) CALL OUTLN(IBLNK,1) CALL OUTLN(IBLNK,1) CALL OUTLN(IBLNK,1) C C CHECK FOR INPUT OPEN ERROR C C IF (IERR .GE. 0) GOTO 50 C C IS THIS AN ILLEGAL LU? C IF(IERR .NE. -200) GOTO 45 CALL OUTLN(ILLU,6) CALL HALT C C INPUT FILE ERROR C 45 CONTINUE CALL CITA(IERR,ILINP(12)) CALL OUTLN(ILINP,14) CALL HALT C C OPEN OK, C C C C C C C C C C PROCESS THE OPTIONS C C C C C C C 50 CONTINUE CALL NAMR(IBUF,P,PLEN,IPTR) IFLAG = IAND(IBUF(4),3B) IF(IFLAG .EQ. 0) GOTO 150 IF (IFLAG .NE. 1) GOTO 100 C C PROCESS THE PRINT LIMIT C PRTLM = IBUF IF(PRTLM .GT. 0 .AND. PRTLM .LT. 513) GOTO 50 CALL ERROT(I218) PRTLM = 72 GOTO 50 C C PROCES THE ADD OPTION C 100 CONTINUE IF(IFLAG .NE. 3) GOTO 140 IF(IBUF .NE. ADD) GOTO 120 CH”©�����ECK = FALSE GOTO 50 C C PROCESS ERRHLT OPTION C 120 CONTINUE IF(IBUF .NE. ERR) GOTO 130 QTFLAG = TRUE GOTO 50 C C PROCESS NOLST OPTION C 130 CONTINUE IF(IBUF .NE. NOLST) GOTO 140 LST = FALSE GOTO 50 C C ERROR - ILLEGAL OPTION C 140 CONTINUE CALL ERROT(I218) CALL OUTLN(IBUF,3) GOTO 50 C C C C C C C C START PROCESSING THE FILE C C C C C C C GET FIRST RECORD C 150 CONTINUE CALL CRDIM(IERR) IF(IERR .NE. 0) CALL HALT C C GET DATA BASE NAME C IBASE(1) = IBLNK CALL KEYWD(IBASE(2) ) C C DEFAULT LEVEL WORD C DO 160 I = 1,3 160 ILEVL(I) = IBLNK C C WAS A LEVEL WORD GIVEN C IF(CHAR .EQ. SEMI) GOTO 170 IF (CHAR .NE. COMMA) GOTO 170 CALL KEYWD(ILEVL) C C OPEN THE DATA BASE C 170 CONTINUE CALL DBOPN(IBASE,ILEVL,3,ISTAT) IF(ISTAT .EQ. 0) GOTO 180 CALL ERROT(ISTAT) CALL HALT C C C C C IF NEXT RECORD .NE. $SET: THEN ERROR C 180 CONTINUE IVAL = 0 CALL SETD(IVAL) IF(IVAL .EQ. -1) GOTO 185 IF(IVAL .EQ. 0) GOTO 190 CALL ERROT(I203) C C LOAD AND EXECUTE BCLOS C 185 CONTINUE CALL SEGLD(BCLOS,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BCLOS,3) CALL HALT C C C C C LOAD AND EXECUTE BINF C 190 CONTINUE CALL SEGLD(BINF,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BINF,3) ERROR = ERROR + 1 GOTO 185 END END$ END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¡������ÿÿ����� ���� ÿý�1�: ���������ÿ��92069-18004 1912� S C0122 �&BINF2 �BINF2 SOURCE � � � � � � � � � � � � �H0101 dA�����þúFTN4 PROGRAM BINF2(5,90),92069-16001 REV.1912 790115 C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18004 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C BINF IS THE SEGMENT OF DBBLD WHICH READS THE DATA RECORDS AND C PUTS THEM IN THE DATA BASE C INTEGERS AND REALS ARE CONVERTED FROM ASCII C INTEGER SETNM,COLBG,RTYPE,COLED,IBLNK INTEGER ISTAT INTEGER XTYPE,BCLOS,BPUT INTEGER TTYPE DIMENSION SETNM(10),INFO(110) DIMENSION ISTAT(10) DIMENSION M2(24),IA(3) DIMENSION NUM(40) INTEGER SEGM(9) INTEGER BCLOS(3),BPUT(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA SEGM/2HSE,2HGM,2HEN,2HT ,2HNO,2HT ,2HFO,2HUN,2HD / DATA XTYPE/130B/ DATA IBLNK/2H / DATA I1/1/ DATA I211/211/ DATA ITYPE/111B/Å������þú DATA RTYPE/122B/ DATA M2/2H ,2H ,2H ,2H ,2H I,2HN ,2HCO,2HLU,2HMN,2HS ,2H , 12H ,2H T,2HHR,2HOU,2HGH,2H ,2H ,2H ,2H I,2HS ,2HTY,2HPE,2H / DATA NUM/2H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90/ DATA BPUT/2HBP,2HUT,2H2 / DATA BCLOS/2HBC,2HLO,2H2 / C C C C C C C GET <SET NAME> C 100 COL=6 CALL KEYWD(SETNM) C C GET DATA SET NUMBER C CALL DBINF (IBASE,SETNM,201,ISTAT,SETNO) IF (ISTAT.EQ.0) GO TO 103 C C OUTPUT ERROR CODE, SET THE SET-ERROR FLAG AND CLOSE THE DATA BASE C 101 CALL ERROT(ISTAT) SETERR=-1 GO TO 122 C C IF SETNO IS POSITIVE THE USER HAS NO WRITE ACESS C IF LIST OPTION ON, SKIP A LINE ON LISTING DEVICE C 103 CONTINUE ISTAT = 100 IF(SETNO .GE. 0) GOTO 101 SETNO = -SETNO IF(LST.EQ.TRUE) CALL OUTLN(IBLNK,1) C C GET DATA ITEM COUNT AND DATA ITEM NUMBERS IN ITEM C CALL DBINF(IBASE,SETNO,104,ISTAT,ITEM) IF(ISTAT .NE. 0) GOTO 101 C C ICNT IS DATA ITEM COUNT C ICNT=ITEM(1) C C INITIALIZE PTR TO BEGINNING OF NEXT DATA ITEM ON RECORD C COLBG=1 C C START LOOP TO GET TYPE AND LENGTH OF EACH ITEM AND C CALCULATE BEGINNING AND ENDING COLUMNS OF EACH ITEM AND C PRINT THIS INFORMATION C DO 107 I=2,ICNT+1 C C GET INFO ABOUT ITEM AND PUT IN INFO (DATA ITEM NO IS ITMNO) C IF(ITEM(I) .LT. 0) GOTO 1031 ISTAT = I211 GOTO 101 C C C 1031 ITMNO = -ITEM(I) ITEM(I) = ITMNO CALL DBINF(IBASE,ITMNO,102,ISTAT,INFO) IF (ISTAT .NE. 0) GOTO 101 C C GET ITEM TYPE AND ITEM LENGTH C CALL SGET(INFO,17,TYPE(I)) LENTH(I)=INFO(10) ELECT(I) = INFO(11) IF (â¸����� TYPE(I).EQ.ITYPE)LENTH(I)=6 IF (TYPE(I).EQ.RTYPE)LENTH(I)=13 C C CALCULATE BEGINNING AND ENDING COLUMNS OF EACH ITEM C IF(COLBG+LENTH(I)-1 .GT. PRTLM) COLBG = 1 C C CALCULATE NUMBER OF ELEMENT FIELDS ON CURRENT CARD C AND SET COLED TO LENGTH OF ELEMENTS THAT DON'T FIT C ON THE CURRENT CARD C COLED = COLBG - 1 DO 3012 N = 1,ELECT(I) COLED = COLED + LENTH(I) IF(COLED .LE. PRTLM) GOTO 3012 COLED = LENTH(I) IF(COLED .GT. PRTLM) COLED = MOD(COLED,PRTLM) 3012 CONTINUE C C IF LIST TURNED ON WRITE ITEM NAMES AND THEIR COLUMNS C 104 IF(LST.EQ.FALSE) GO TO 107 M2(2) = INFO(1) M2(3)=INFO(2) M2(4)=INFO(3) CALL CITA(COLBG,IA) M2(11)=IA(2) M2(12)=IA(3) CALL CITA(COLED,IA) M2(18)=IA(2) M2(19)=IA(3) TTYPE=TYPE(I) CALL SPUT(TTYPE,I1,IBLNK) M2(24)=TTYPE CALL OUTLN(M2,24) COLBG = COLED + 1 107 CONTINUE C C IF LIST ON, SKIP A LINE AND WRITE COL NO'S ACROSS THE PAGE C IF(LST .EQ. FALSE) GOTO 108 CALL OUTLN(IBLNK,1) CALL OUTLN(NUM,40) C C C LOAD AND EXECUTE BPUT C C 108 CONTINUE CALL SEGLD(BPUT,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BPUT,3) ERROR = ERROR + 1 C C C C ERROR EXIT C C 122 CONTINUE CALL SEGLD(BCLOS,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BCLOS,3) CALL HALT END ������������������������������������������������ã������ÿÿ����� ���� ÿý�2�: ���������ÿ��92069-18005 1912� S C0122 �&BPUT2 �BPUT2 SOURCE � � � � � � � � � � � � �H0101 ]�����þúFTN4 PROGRAM BPUT2(5,90),92069-16001 REV.1912 790115 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18005 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C BPUT IS THE SEGMENT OF DBBLD WHICH READS THE DATA RECORDS AND C PUTS THEM IN THE DATA BASE C INTEGERS AND REALS ARE CONVERTED FROM ASCII C INTEGER RTYPE,COLED,IBLNK,BUF,BPTR INTEGER ISTAT INTEGER XTYPE,BCLOS,BINF DIMENSION ISTAT(10) DIMENSION BCLOS(3) DIMENSION BINF(3) DIMENSION BUF(2048) INTEGER SEGM(9) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA SEGM/2HSE,2HGM,2HEN,2HT ,2HNO,2HT ,2HFO,2HUN,2HD / DATA XTYPE/130B/ DATA IBLNK/2H / DATA I1,I2,I4/1,2,4/ DATA I204,I206,I207/204,206,207/ DATA ITYPE/111B/ DATA RTYPE/122B/ DATA BCLOS/2HBC,2HLO6¼������þú,2H2 / DATA BINF/2HBI,2HNF,2H2 / C C C C C C C C C GET NEXT CARD C IVAL=2 CALL SETD(IVAL) IF(IVAL .EQ. -1) GOTO 122 C C IF $SET: OR $END WRITE ERR NO 204 C "CARD PRESENT WHERE RECORD EXPECTED" IF (IVAL.EQ.2) GO TO 110 109 CALL ERROT(I204) GO TO 121 C INITIALIZE DBPUT BUFFER PTR 110 BPTR=1 IEFLG=0 C C C C C C C C C START LOOP TO ENTER EACH ITEM IN DBPUT BUFFER,BUF C C C C C C DO 119 I=2,ITEM(1)+1 DO 119 J = 1,ELECT(I) C CALCULATE LAST COLUMN OF ITEM COLED=COL+LENTH(I)-1 C C IF ITEM STARTS ON A NEW CARD,READ NEXT CARD AND CALCULATE C NEW ENDING COLUMN. IF ITEM>PRTLM COLS,MOVE THE WHOLE CARD C INTO DBPUT BUFFER,BUF,(AND NEXT CARD) C LEN=LENTH(I) IF (COLED.LE.PRTLM) GO TO 113 IF (BPTR .EQ. 1) GOTO 112 IVAL=2 111 CALL SETD(IVAL) IF(IVAL .EQ. -1) GOTO 122 IF (IVAL.NE.2) GO TO 109 IF (LEN.GT.PRTLM) GO TO 112 COLED=LEN GO TO 113 112 CALL SMOVE(CARD,I1,PRTLM,BUF,BPTR) BPTR=BPTR+PRTLM LEN=LEN-PRTLM GO TO 111 C C IF ITEM TYPE IS X MOVE ITEM TO BUF AND UPDATE BPTR (BUF PTR) C 113 IF (TYPE(I).NE.XTYPE) GO TO 114 CALL SMOVE(CARD,COL,COLED,BUF,BPTR) BPTR=BPTR+LEN GO TO 118 C C IF ITEM TYPE IS INTEGER,CONVERT TO INTEGER,MOVE TO BUF, C AND INCREMENT BPTR C 114 IF (TYPE(I).NE.ITYPE) GO TO 116 CALL CATI(CARD,COL,COLED-COL+1,INT,ISTAT) IF (ISTAT.GE.0) GO TO 115 C C IF ILLEGAL WRITE ERROR NO 206 C "NON-NUMERIC INTEGER IN FIELD" C CALL ERROT(I206) IF (QTFLAG.EQ. TRUE) GO TO 122 IEFLG=1 C C C 115 CONTINUE CALL SMOVE(INT,I1,I2,BUF,BPTR) BPTR=BPTR+2 GO TO 118 C C CONVERT TYPE REAL TO A REAL NUMBER,MOVE TO BUF,INCREMENT BPTR C SCREEN FIELDS THAT ARE ALL BLANK BECAUSE CATR DOESN'T ”æ����� HANDLE IT C 116 CONTINUE DO 1161 K = COL,COLED CALL SGET(CARD,K,ICHAR) IF(ICHAR .NE. 40B) GOTO 1162 1161 CONTINUE REAL = 0 GOTO 117 C C CONVERT REAL NUMBER C 1162 CONTINUE REAL=CATR(CARD,COL,COLED,ISTAT) IF (ISTAT.GE.0) GO TO 117 C C IF ILLEGAL REAL, WRITE ERROR NO. 207 C "NON-NUMERIC IN REAL FIELD" C CALL ERROT(I207) IF (QTFLAG.EQ. TRUE) GO TO 122 IEFLG=1 C C MOVE THE VALUE INTO THE BUFFER C 117 CALL SMOVE(REAL,I1,I4,BUF,BPTR) BPTR=BPTR+4 C C SET UP BEGINNING COLUMN OF NEXT ITEM C 118 COL=COLED+1 119 CONTINUE C C C*****IF UPDATE OR CREATE IS SPECIFIED AND THERE ARE NO ERRORS, C*****PUT RECORD IN DATA BASE C C IF (CHECK.EQ. TRUE) GO TO 120 IF (IEFLG.EQ.1) GO TO 120 CALL DBPUT(IBASE,SETNO,1,ISTAT,ITEM,BUF) C C IF ERROR IN PUTTING WRITE DBPUT ERROR NO. C IF (ISTAT.EQ.0) GO TO 120 CALL ERROT(ISTAT) IF (QTFLAG.EQ.0) GO TO 122 C C GET NEXT CARD. IF NOT $SET: OR $END GO TO ENTER NEXT RECORD C 120 IVAL=2 CALL SETD(IVAL) IF (IVAL.EQ.2) GO TO 110 C C IF $SET: GO TO PROCESS NEXT SET C 121 IF (IVAL.EQ.0) GO TO 200 C C IF $END OR AN ERROR WAS ENCOUNTERED C CALL NEXT SEGMENT TO CLOSE DATA SET C 122 CONTINUE CALL SEGLD(BCLOS,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BCLOS,3) CALL HALT C C C LOAD AND EXECUTE BINF C C C 200 CONTINUE CALL SEGLD(BINF,IERR) CALL OUTLN(SEGM,9) CALL OUTLN(BINF,3) ERROR = ERROR + 1 GOTO 122 END END$ ����������������������������������������������������������������������������������������������������������£×������ÿÿ����� ���� ÿý�3�; ���������ÿ��92069-18006 1912� S C0122 �&BCLO2 �BCLO2 SOURCE � � � � � � � � � � � � �H0101 gB�����þúFTN4 PROGRAM BCLO2(5,90),92069-16001 REV.1912 780814 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18006 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C BCLOS PERFORMS TERMINATION ACTIONS C THE DATA BASE IS CLOSED C IF NO ERRORS OCCURRED, THE MESSAGE IS PRINTED OUT: C DATA BASE SUCCESSFULLY BUILT OR UPDATED C*********************************************************************** INTEGER M3(11),M4(22),M5(22),IA(3),M6(24),M7(36),M8(22),M9(29) INTEGER DUMMY,ISTAT(10) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA I0,I1/0,1/ DATA I2,I208/2,208/ DATA N22,N40,N44,N48,N58,N72/-22,-40,-44,-48,-58,-72/ DATA M3/2H N,2HUM,2HBE,2HR ,2HOF,2H E,2HRR,2HOR,2HS:,2H ,2H / DATA M4/2H D,2HAT,2HA ,2HBA,2HSE,2H S,2HUC,2HCE,2HSS,2HFU, 12HLL,2HY ,2HBU,2HIL,2HT ,2HO%g������þúR,2H U,2HPD,2HAT,2HED/ DATA M5/2H F,2HAT,2HAL,2H E,2HRR,2HOR,2H. ,2HTH,2HE ,2HDA,2HTA, 12H B,2HAS,2HE ,2HHA,2HS ,2HBE,2HEN,2H P,2HUR,2HGE,2HD./ DATA M6/2H O,2HNL,2HY ,2HER,2HRO,2HR-,2HFR,2HEE,2H E,2HNT,2HRI, 12HES,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H D,2HAT,2HA ,2HBA,2HSE,2H. / DATA M7/2H O,2HNL,2HY ,2HTH,2HOS,2HE ,2HEN,2HTR,2HIE,2HS , 12HEN,2HCO,2HUN,2HTE,2HRE,2HD ,2HBE,2HFO,2HRE,2H T,2HHE,2H E, 12HRR,2HOR,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H D,2HAT,2HA , 12HBA,2HSE,2H. / DATA M8/2H C,2HAN,2HNO,2HT ,2HPR,2HOC,2HES,2HS ,2HTH,2HIS,2H S, 12HET,2H. ,2HON,2HLY,2H T,2HHO,2HSE,2H E,2HNT,2HRI,2HES/ DATA M9/2H E,2HNC,2HOU,2HNT,2HER,2HED,2H B,2HEF,2HOR,2HE ,2HTH, 12HIS,2H E,2HRR,2HOR,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H T,2HHE, 12H D,2HAT,2HA ,2HBA,2HSE,2H. / C C C C C C C CLOSE THE DATA BASE C CALL DBCLS(IBASE,DUMMY,1,ISTAT) IF(ERROR .EQ. -1) STOP IF(ISTAT .NE. 0) CALL ERROT(ISTAT) C C C WRITE "NUMBER OF ERRORS:" ERROR C CALL CITA(ERROR,IA) M3(10)=IA(2) M3(11)=IA(3) CALL OUTLN(M3,11) C C WRITE TERMINATION MESSAGES C IF (CHECK.EQ. TRUE) GOTO 110 IF (ERROR.NE.0) GO TO 105 C C WRITE "DATA BASE SUCCESSFULLY BUILT OR UPDATED" C CALL OUTLN(M4,20) GOTO 110 C C C 105 IF (QTFLAG.EQ. TRUE) GO TO 106 IF (SETERR.EQ.-1) GO TO 108 C C WRITE "ONLY ERROR-FREE ENTRIES WERE PUT IN DATA BASE" C CALL OUTLN(M6,24) GOTO 110 C C WRITE "ONLY THOSE ENTRIES ENCOUNTERED BEFORE THE ERROR WERE C PUT IN THE DATA BASE" C 106 CALL OUTLN(M7,36) GOTO 110 C C WRITE "CANNOT PROCESS THIS SET. ONLY THOSE ERROR-FREE ENTRIES C ENCOUNTERED BEFORE THIS ERROR WERE PUT IN THE DATA BASE" C 108 CALL OUTLN(M8,22) CALL OUTLN(M9,29) 110 CALL HALT END END$ ��������������������������������������������������������������������������������������������&�������� ������������� �������ÿÿ����� ���� ÿý�4�< ���������ÿ��92069-18007 1912� S C0122 �&SETD �SETD SOURCE � � � � � � � � � � � � �H0101 aE�����þúFTN4 SUBROUTINE SETD(IVAL),92069-16001 REV.1912 780814 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18007 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C SETD GETS THE NEXT CARD IMAGE AND C RETURNS IVAL=0 IF '$SET:' FOUND STARTING IN COL 1 C IVAL=1 IF '$END' FOUND STARTING IN COL 1 C IVAL = -1 IF I O ERROR OCCURED C IVAL = 2 OTHERWISE C C IF IVAL = -1 THEN AN I/O ERROR OCCURED C IF IVAL=1 SCANS TO THE NEXT '$SET:' OR '$END' CARD C AND SETS IVAL AS ABOVE C IF IVAL=0 PRINTS ERROR MESSAGE IF NEITHER '$SET:' OR '$END' C IS FOUND ON NEXT CARD, AND C SCANS TO THE NEXT '$SET:' OR '$END' CARD C AND SETS IVAL AS ABOVE. C IF IVAL=2 AND NEITHER '$SET:' OR '$END' IS PRESENT ON THE C NEXT CARD, IVAL IS SET TO 2. C C CALLING SEQUENCE C CALL SETD(IVAL) C*********************************************************************** C C INTEGER PRINT INTEGER SET(3),END(2) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(1ÇM��� �� 29),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA I1,I4,I5,I205/1,4,5,205/ DATA SET/2H$S,2HET,2H: / DATA END/2H$E,2HND/ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C C C C C IERR=0 C C INITIALIZE PRINT FLAG C PRINT=0 C C GET NEXT CARD, IF I O ERROR SET IVAL -1 AND RETURN C 103 CALL CRDIM(IERR) IF(IERR .EQ. 0) GOTO 1031 IVAL = -1 RETURN C C IF "$SET:", SET IVAL TO 0 AND RETURN C 1031 CONTINUE IF ( JSCOM(CARD,I1,I5,SET,I1,IERR).NE.0) GO TO 101 IVAL=0 RETURN C IF "$END", SET IVAL TO 1 AND RETURN C 101 IF ( JSCOM(CARD,I1,I4,END,I1,IERR).NE.0 ) GO TO 102 IVAL=1 RETURN C C IF IVAL=2, NEITHER FOUND, RETURN C 102 IF (IVAL.EQ.2) RETURN C C SCAN TO NEXT CARD AND.CHECK AGAIN C IF IVAL=0 AND FIRST TIME AROUND, PRINT ERROR MESSAGE 205, C "$SET: OR $END EXPECTED." C IF (IVAL.NE.0) GO TO 103 IF (PRINT.NE.0) GO TO 103 CALL ERROT(I205) PRINT=1 GO TO 103 END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������Ó^ ������ÿÿ����� ���� ÿý�5�< ���������ÿ��92069-18008 1912� S C0122 �&ERROT �ERROT SOURCE � � � � � � � � � � � � �H0101 £|�����þúFTN4 SUBROUTINE ERROT(N),92069-16001 REV.1912 780809 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18008 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C ERROT GENERATES THE ERROR MESSAGE:*****ERROR NO. XXXXXX C WHERE XXX IS THE ERROR MESSAGE NO. C IF LIST OPTION IS TURNED OFF , IT LISTS THE ERROR LINE C IT INCREMENTS THE ERROR COUNT,ERROR C CALLING SEQUENCE C CALL ERROT(N) C N IS THE MESSAGE NO. C*********************************************************************** C C C INTEGER OUTCHR DIMENSION MESS(10),IA(3) DIMENSION IOBUF(41) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA I2,N20/2,-20/ DATA MESS/2H *,2H**,2H**,2HER,2HRO,2HR ,2HNO,2H. / C C C C C C C IF END OF FILE DO NOT LIST C IF (N.LT.0) N=-N IF (N.LT.100) GOTOL��� ��  101 IF (N.EQ.209) GO TO 101 C C IF LISTING TURNED OFF, LIST ERROR LINE C IF (LST .EQ. TRUE) GO TO 101 C MOVE RECORD TO OUTPUT BUFFER AND LIST, LINE BY LINE NCHAR=LOG ICHAR=1 100 JCHAR=NCHAR IF (NCHAR.GT.80) JCHAR=80 OUTCHR=JCHAR+1 CALL SMOVE(CARD,ICHAR,(ICHAR+JCHAR-1),IOBUF,I2,OUTCHR) OUTCHR=-OUTCHR CALL OUTLN(IOBUF,OUTCHR/2+1) IF (NCHAR.LE.80) GO TO 101 NCHAR=NCHAR-80 ICHAR=ICHAR+80 GO TO 100 C CONVERT N TO ASCII AND ENTER N IN MESS (ERROR MESSAGE) 101 CALL CITA(N,IA) MESS(9)=IA(2) MESS(10)=IA(3) C WRITE ERROR MESSAGE ON LIST DEVICE CALL OUTLN(MESS,10) C INCREMENT ERROR COUNT ERROR=ERROR+1 RETURN END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������U3 ������ÿÿ����� ���� ÿý�6�= ���������ÿ��92069-18009 1912� S C0122 �&KEYWD �KEYWD SOURCE � � � � � � � � � � � � �H0101 œt�����þúFTN4 SUBROUTINE KEYWD(IARAY),92069-16001 REV.1912 780809 INTEGER IARAY(19) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18009 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C KEYWD SCANS A DATA BASE NAME, SECURITY CODE, OR SET NAME C AND ENTERS IT IN IARAY, LEFT-JUSTIFIED,BLANK-FILLED,IN A2 C SCANS PAST ALL LEADING BLANKS C TERMINATES AT THE FIRST SEMICOLON,COMMA,OR BLANK C SETS L TO LENGTH C SETS COL TO POINT TO TERMINATING COMMA,SEMICOLON,OR BLANK C CALLING SEQUENCE C CALL KEYWD(IARAY) C*********************************************************************** C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA IBLNK,ICOMA,ISEMI,I1,I6/40B,54B,73B,1,6/ C C C C C C C BLANK-FILL IARAY C CALL SFILL(IARAY,I1,18,IBLNK) C C SCAN PAST LEADING BLANKS04��� ��  C 101 CALL SGET(CARD,COL,CHAR) COL=COL+1 IF (CHAR.EQ.IBLNK) GO TO 101 C C HAVE FOUND FIRST NON-BLANK, ENTER GLOB IN IARAY C L=1 C C COMMA, SEMICOLON OR BLANK? C 102 IF ( (CHAR.EQ.ICOMA).OR.(CHAR.EQ.ISEMI).OR.(CHAR.EQ.IBLNK) )RETURN CALL SPUT(IARAY,L,CHAR) L=L+1 CALL SGET(CARD,COL,CHAR) COL=COL+1 C C GLOB TOO LONG? IF SO, STOP AT 9 C IF (L.GT.18) RETURN GO TO 102 END END$ ����������������‘ú ������ÿÿ����� ���� ÿý�7�> ���������ÿ��92069-18010 1912� S C0122 �&&OUTL �OUTL SOURCEE � � � � � � � � � � � � �H0101 pƒ�����þúFTN SUBROUTINE OUTLN(IBUF,ILEN),92069-16001 REV. 1912 781120 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18010 C RELOC: 92069-16001 C C C****************************************************************: C C ABSTRACT: C C OUTLN IS A GENERALIZED OUTPUT ROUTINE. IT OUTPUTS A RECORD C TO A DEVICE OR A FILE. WHEN THE VARIABLE LIST IS SET TO C A NEGITIVE ONE, THE RECORD IS WRITEN TO THE FILE DESIGNATED C IN THE LIST DCB (LDCB). OTHERWISE, THE RECORD IS LISTED C TO THE DEVICE SPECIFIED IN LIST. C C OUTLN IS USED WHENEVER RECORDS ARE TO BE WRITTEN TO THE C LISTING PARAMETER. C C CALLING SEQUENCE: C C CALL OUTLN(IBUF,ILEN) C C WHERE: C C IBUF IS THE BUFFER CONTAINING THE MESSAGE TO BE WRITTEN C ILEN IS THE LENGTH OF THE BUFFER IN WORDS C C C C C C C INTEGER INUM(2) INTEGER IOERR(10),ABORT(6),ISTAT(10) INTEGER DUMMY INTEGER BCLOS(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$&��� �� $$$$$$$$ OCTOBER 16,1978 $$ DATA BCLOS/2HBC,2HLO,2H2 / DATA IOERR/2HDB,2HBL,2HD ,2HLI,2HST,2H I,2H/O,2H E,2HRR, &2HOR/ DATA ABORT/2HDB,2HBL,2HD ,2HEN,2HDE,2HD / DATA INUM/0,0/ C C OUT PUT OF A LINE SUBROUTINE C C IF(LIST .EQ. -1) GOTO 20 CALL EXEC(2+100000B,LIST+200B,IBUF,ILEN) GOTO 50 7000 GOTO 40 C C LIST IS A FILE C 20 CONTINUE CALL EWRIT(LDCB,IERR,IBUF,ILEN,INUM) IF(IERR .LT. 0) GOTO 50 40 CONTINUE RETURN C C I/O ERROR CLEAN UP AND TERMINATE C 50 CONTINUE CALL EXEC(2+100000B,1+200B,IOERR,10) GOTO 60 7001 CALL EXEC(2,1+200B,ABORT,6) 60 CONTINUE ERROR = -1 CALL SEGLD(BCLOS,IERR) STOP END ��������ë ������ÿÿ����� ���� ÿý�8�? ���������ÿ��92069-18011 1912� S C0122 �&HALT �HALT SOURCE � � � � � � � � � � � � �H0101 T?�����þúFTN SUBROUTINE HALT,92069-16001 REV.1912 790202 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18011 C RELOC: 92069-16001 C C C****************************************************************: C C C C HALT CLOSES THE INPUT AND OUTPUT FILES, OR RELEASES THE C LOCK ON THE OUTPUT DEVICE C C C C LOGICAL IFTTY C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ EXTERNAL IFTTY C IF(INPUT .NE. -1) GOTO 10 CALL ECLOS(IDCB,IERR) 10 IF(LIST .EQ. -1) GOTO 20 C C WRITE EOF TO OUTPUT DEVICE C IF(IFTTY(LIST) .OR. IFTTY(INPUT) ) GOTO 30 CALL EXEC(3,LIST + 100B) CALL LURQ(140000B,IDUMY,IDUMY) GOTO 30 15 GOTO 30 20 CONTINUE CALL ECLOS(LDCB) 30 CONTINUE STOP END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¬e��� ���� �������� �������ÿÿ����� ���� ÿý�9�@ ���������ÿ��92069-18012 1912� S C0122 �&CRDIM �CRDIM SOURCE � � � � � � � � � � � � �H0101 €`�����þúFTN4 SUBROUTINE CRDIM(IFLAG),92069-16001 REV.1912 781120 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18012 C RELOC: 92069-16001 C C C************************************************************ C C*********************************************************************** C CRDIM GETS A CARD IMAGE FROM CARDS, PAPER TAPE, MAG TAPE, OR DISK FILE C AND RETURNS IT IN CARD. C COL IS SET TO 1. C IF THE LIST OPTION IS TURNED ON, IT LISTS CARD ON THE LIST DEVICE. C PARAMETERS SET BY CALLER: C INPUT=INPUT DEVICE # C LIST=DEVICE # OF LISTING DEVICE C LST =TRUE IF LIST OPTION REQUESTED C C CALLING SEQUENCE C CALL CRDIM(IFLAG) C C WHERE: C C IFLAG = 0 IF NO ERROR C = -1 IF ERROR C C*********************************************************************** C C INTEGER RECNO(2) INTEGER IOBUF(41),IA INTEGER OUTCHR C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1:¡������þú978 $$ DATA IBLNK/2H / DATA I1/1/ DATA I2/2/ DATA I13/13/ DATA I209,I220/209,220/ DATA RECNO/0,0/ C C C C C C C C CLEAR THE ERROR INDICATOR C IFLAG = 0 C C C BLANK FILL THE CARD DO 100 IMOVE=1,256 100 CARD(IMOVE)=IBLNK C INPUT FROM DISK? C IF (INPUT .EQ.-1) GOTO 104 C C READ A RECORD FROM CARDS, PAPER TAPE, MAG TAPE INTO CARD 101 CONTINUE NCHAR = -PRTLM C C MAKE I/O CALL WITH NO ABORT BIT SET C CALL REIO(I1+100000B,INPUT,CARD,NCHAR) GOTO 109 7000 CALL ABREG(IA,NCHAR) LOG=NCHAR CALL EXEC(I13+100000B,INPUT,ISTAT) GOTO 109 C C END OF FILE? C 7001 IF (IAND(ISTAT,40B).NE.0) GO TO 108 C C IF LIST OPTION TURNED ON, LIST CARD ON LIST DEVICE C 102 IF (LST.NE. TRUE) GO TO 103 C MOVE CARD IMAGE TO OUTPUT BUFFER AND LIST LINE BY LINE ICHAR=1 1020 JCHAR=NCHAR IF(NCHAR .LE. 0) GOTO 108 IF (NCHAR.GT.80) JCHAR=80 OUTCHR=JCHAR CALL SMOVE(CARD,ICHAR,(ICHAR+JCHAR-1),IOBUF,I1,OUTCHR) CALL OUTLN(IOBUF,(OUTCHR+1)/2) IF (NCHAR.LE.80) GO TO 103 NCHAR=NCHAR-80 ICHAR=ICHAR+80 GO TO 1020 C INITIALIZE COLUMN POINTER 103 COL=1 RETURN C C GET CARD IMAGE FROM DISK C 104 CALL EREAD(IDCB,IERR,CARD,(PRTLM/2)+1,ILEN,RECNO) NCHAR=ILEN*2 LOG=NCHAR IF (IERR .LT.0) GOTO 107 IF (LOG .LE. 0) GOTO 108 GOTO 102 C IF ERROR DETECTED WRITE ERROR MESSAGE 107 CALL ERROT(IERR) IFLAG = -1 RETURN C C OUT PUT END OF FILE DETECTED C 108 CALL ERROT(I209) IFLAG = -1 RETURN C C OUTPUT SYSTEM TRIED TO ABORT INPUT I/O C 109 CONTINUE CALL ERROT(I220) IFLAG = -1 RETURN END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ï=�������� ������������� �������ÿÿ����� ���� ÿý�:�B ���������ÿ��92069-18013 1912� S C0122 �&BDDAT �BDDAT SOURCE � � � � � � � � � � � � �H0101 qP�����FTN BLOCK DATA,92069-16001 REV.1912 780814 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18013 C RELOC: 92069-16001 C C C****************************************************************: C C C C C THIS MODULE INITIALIZES CONSTANTS C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ AUGUST 10,1978 $$$ INTEGER ERROR,P,PLEN,CARD,LOG,COL INTEGER ELECT,ITEM,LENTH,TYPE INTEGER IDCB,LDCB,LIST,INPUT,PRTLM,CHECK,LST INTEGER IBASE INTEGER SETERR INTEGER TRUE,FALSE,SEMI,COMMA INTEGER L,CHAR INTEGER SETNO INTEGER QTFLAG C COMMON ERROR,P(40),PLEN,CARD(256),LOG,COL COMMON ELECT(129),ITEM(129),LENTH(129),TYPE(129) COMMON IDCB(144),LDCB(144),LIST,INPUT,PRTLM,CHECK,LST COMMON IBASE(10) COMMON SETERR COMMON L,CHAR COMMON SETNO COMMON QTFLAG COMMON/CONST/TRUE,FALSE,SEMI,COMMA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ OCTOBER 16,1978 $$ DATA TRUE/0/ DATA FALSE/-1/ DATA SEMI/73B/ DATA COMMA/54B/ END ��������������������������������������������������������¡‹������ÿÿ����� ���� ÿý�;�A ���������ÿ��92069-18015 2026� S C0122 �&DBHDR &DBHDR � � � � � � � � � � � � � �H0101 îÐ�����þúFTN SUBROUTINE DBHDR,92069-16015 REV.2026 800123 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18015 C RELOC: 92069-16015 C C ALTERED: JANUARY 23, 1980 FOR SORTED CHAINS AND MULTIPLE C LINKING FEATURES - CEJ C C C****************************************************************: C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OV„������þúREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DAT±i������þúA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,¨E�����1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C I=I END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������7������ÿÿ����� ���� ÿý�<�E ���������ÿ��92069-18016 2026� S C0122 �&DBDS &DBDS � � � � � � � � � � � � � �H0101 Û–�����þúFTN PROGRAM DBDS(4,90),92069-16015 REV.2026 800123 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18016 C RELOC: 92069-16015 C C C****************************************************************: C C THIS IS THE MAIN PROGRAM FOR THE DATA BASE DEFINITION SUBSYSTEM C FOR IMAGE 1000. IT BUILDS THE ROOT FILE AND DATA SET FILES. C THE CALLING SEQUENCE IS AS FOLLOWS, C C :RU,DBDS,INPUT,LIST C C WHERE: C C C INPUT C IS THE FMP NAMR OF THE SCHEMA INPUT. IT MAY BE A FILE NAME C OR AN LU. C C LIST C IS THE FMP NAMR OF THE LISTING DEVICE, OR FILE. C C C INTEGER INIT(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITEs ������þúCT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR‹j������þú, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) î‡�����COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA INIT/2HIN,2HIT,2H2 / C C C C GET THE RUN STRING C DO 10 I = 1,36 10 CARD(I) = 2H C C C CALL GETST(CARD,CRDLM,ICNT) ICNT = ICNT*2 C C DEFAULT LIST TO LOG DEVICE C LIST = 1 C C LOAD THE INITIALIZATION ROUTINE C CALL SEGLD(INIT,IERR) C C IF RETURN FROM SEGLD THEN ERROR C CALL OUTLN(INIT,3) CALL ERXIT(NOSEG) END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#”������ÿÿ����� ���� ÿý�=�F ���������ÿ��92069-18017 2026� S C0122 �&INIT2 &INIT2 � � � � � � � � � � � � � �H0101 òÒ�����þúFTN PROGRAM INIT2(5,90),92069-16015 REV.2026 800425 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18017 C RELOC: 92069-16015 C C C****************************************************************: C C C ABSTRACT: C C INIT GETS THE RUN STRING AND OPENS THE FILES OR LOCKS THE C LU'S AS REQUIRES. C C INIT THEN OUTPUTS IT'S HEADING - "IMAGE/1000 DATA DEFINITION C UTILITY". C C INIT INITIALIZES GLOBALS, THEN DETERMINES WHETHER TO LOAD C THE "BEGIN DATA BASE" PROCESSOR OR THE "$CONTROL:" PROCESSOR. C C C C C INTEGER CNTR(3),HEAD(3) INTEGER PURGE(3) INTEGER IBUF(10) INTEGER SIZE(4) INTEGER HD(32),HDZ INTEGER ROTMX INTEGER LOCKED(12) LOGICAL IFTTY C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C æ´������þú ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,IpY������þúTM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMX������þúON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB EXTERNAL IFTTY DATA CNTR/2HCN,2HTR,2H2 / DATA HEAD/2HHE,2HAD,2H2 / DATA PURGE/2HPU,2HRG,2HE / DATA SIZE/0,10,0,0/ DATA HD/2H ,2H ,2H ,2HHE,2HWL,2HET,2HT-,2HPA,2HCK,2HAR, 12HD ,2HIM,2HAG,2HE/,2H10,2H00,2H D,2HAT,2HA ,2HBA, 22HSE,2H D,2HEF,2HIN,2HIT,2HIO,2HN ,2HPR,2HOC,2HES, 32HSO,2HR / DATA LOCKED/2H D,2HBD,2HS ,2HWA,2HIT,2HIN,2HG ,2HON,2H L, & 2HIS,2HT ,2HLU/ DATA HDZ/32/ C C C C INITIALIZATION C C C C C GET INPUT PARAMETER C CRDPR = 1 CALL NAMR(IBUF,CARD,ICNT,CRDPR) C C SET INPUT LU TO ZERO AND ERROR CODE TO ZERO IN CASE C INPUT NAMR IS AN LU C INPUT = -1 IERR = 0 C C IS INPUT NAMR A FILE? C IF (IAND(IBUF(4),000003B) .NE. 3) GOTO 10 C C YES, OPEN THE FILE C CALL OPEN(IDCB,IERR,IBUF,0,IBUF(5),IBUF(6) ) GO TO 20 C C NO, THEN INPUT IS AN LU C 10 CONTINUE INPUT = IBUF(1) C C DEFAULT LU IF NECESSARY C IF(INPUT .EQ. 0) INPUT = 1 IF(INPUT .GT. 0) GOTO 12 IERR = -1 GOTO 20 C C LOCK THE INPUT DEVIVE WHEN NECESSARY C 12 CONTINUE IF(IFTTY(INPUT) ) GOTO 15 CALL LURQ(40001B,INPUT,1) GOTO 13 8000 GOTO 15 13 IERR = -1 C C SET CONTROL WORD TO ECHO COMMANDS FROM A KEYBOARD C 15 CONTINUE INPUT = INPUT + 400B C C GET THE LIST PARAMETER C 20 CONTINUE CALL NAMR(IBUF,CARD,ICNT,CRDPR) C C IS LIST A FILE? C LIST = -1 m~������þú IERR2 = 0 IF (IAND(IBUF(4),000003B) .NE. 3) GOTO 30 C C YES, OPEN THE FILE C CALL OPEN (LDCB,IERR2,IBUF,0,IBUF(5),IBUF(6) ) C C IF NOT FOUND THEN CREATE THE LIST FILE C IF(IERR2 .NE. -6) GOTO 25 CALL ECREA(LDCB,IERR2,IBUF,SIZE,4,IBUF(5),IBUF(6) ) C C IF ERROR THEN ABORT C 25 CONTINUE IF (IERR2 .LT. 0) CALL ERXIT(0) GO TO 40 C C NO, THEN LIST IS A LU C 30 CONTINUE LIST = IBUF(1) C C DEFAULT LIST TO LU 6 IF NECESSARY C IF (IBUF(4) .EQ. 0) LIST = 6 IF(LIST .LT. 0) CALL ERXIT(0) C C LOCK THE LU C SKIP TO TOP OF PAGE C IF(IFTTY(LIST) ) GOTO 35 CALL LURQ(140001B,LIST,1) GOTO 31 8010 GOTO 32 C C LU REQUEST ABORTED - TERMINATE DBDS C 31 CONTINUE CALL ERXIT(0) C C WAIT ON LIST LU C 32 CONTINUE CALL ABREG(IA,IB) IF(IA .EQ. 0) GOTO 35 CALL EXEC(2,1,LOCKED,12) C C WAIT ON THE LU C 34 CONTINUE CALL EXEC(12,0,2,0,-10) CALL LURQ(140001B,LIST,1) GOTO 31 8020 CALL ABREG(IA,IB) IF(IA .NE. 0) GOTO 34 C C OUTPUT TOP OF PAGE C 35 CALL EXEC(100003B,1100B+LIST,-1) GOTO 31 C C GET THE OPTIONS LIST. IF THE OPTION IS NOT "PURGE", THEN C OUTPUT "ILLEGAL OPTION" AND TERMINATE. C 40 CONTINUE PRGFLG = 0 CALL NAMR(IBUF,CARD,ICNT,CRDPR) IF(IBUF(4) .EQ. 0) GOTO 50 IF(IAND(IBUF(4),3B) .NE. 3) CALL ERXIT(ILOPT) IF(JSCOM(IBUF,1,2,PURGE,1) .NE. 0) CALL ERXIT(ILOPT) PRGFLG = 1 C C OUTPUT A HEADING C 50 CONTINUE CALL OUTLN(HD,HDZ) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C CHECK FOR INPUT OPEN ERROR C C SET PRINT OPTION TO PRINT ERRONEOUS LINE C NDX = NFONX(NOLST) INFO(NDX) = NFO(NOLST) C IF (IERR .LT. 0) CALL ERXIT(OPNER) C C OPEN OK, C C INITIALIZE ERROR COUNT C ERROR = 0 C NDX = NFONX(LST) INFO(NDX) = NFO(LST) C +Æ���$��" NDX = NFONX(ERR) INFO(NDX) = NFO(ERR) C C C GET ALL AVAILABLE MEMORY C CALL LIMEM(0,FWAM,ROTMX) IF (ROTMX .EQ. 0) CALL ERXIT(NOMEM) C C MAKE SURE IT IS ALL ADDRESSIBLE BY BYTES. C IF (ROTMX .GT. 15360) ROTMX=15360 LWAM = FWAM + ROTMX - 1 C C INITIALIZE MEMORY TO ZERO C DO 70 I = 0,ROTMX-1 CALL SROOT(I,0) 70 CONTINUE C C INITIALIZE INPUT BUFFERS C CRDPR = CRDLM*2 CALL GCHAR CALL GGLOB C C DECIDE WHAT SEGMENTS TO LOAD C C C IS COMMAND $CONTROL ? C IF (RESNO .NE. CNTRL) GOTO 80 CALL SEGLD(CNTR,IERR) C C IF RETURN FROM SEGLD THEN ERROR C CALL OUTLN(CNTR,2) CALL ERXIT(NOSEG) C C NO, SO LOAD HEAD C 80 CONTINUE CALL SEGLD(HEAD,IERR) C C IF RETURN FROM SEGLD THEN ERROR - ABORT C CALL OUTLN(HEAD,3) CALL ERXIT(NOSEG) END ������������������������������������������������������������������������������������������������������������������������������ÁÁ$������ÿÿ����� ���� ÿý�>� I ���������ÿ��92069-18018 2026� S C0122 �&CNTR2 &CNTR2 � � � � � � � � � � � � � �H0101 öÕ�����þúFTN PROGRAM CNTR2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18018 C RELOC: 92069-16015 C C C****************************************************************: C C C C C $CONTROL PROCESSOR C C ABSTRACT: C C THIS MODULE PROCESSES THE "$CONTROL:" COMMAND. C WHEN A "$CONTROL:" COMMAND IS USED, IT MUST BE THE FIRST RECORD C IN THE SCHEMA COMMAND FILE. C C CNTR PARSES EACH PARAMETER AND SETS THE APPROPRIATE TOGGLE C ON/OFF IN THE ARRAY "INFO". IF AN ERROR IS ENCOUNTERED AFTER C THE "$CONTROL:" COMMAND, AN ERROR IS ISSUED AND THAT CONTROL C OPTION IS SKIPPED. PROCESSING FOR CONTROL OPTIONS CONTINUES C UNTIL A " " IS ENCOUNTERED. C C EACH CONTROL OPTION IS ASSIGNED A "RESNO" BY THE MODULE GGLOB. C THIS RESNO IS USED TO INDEX INTO AN ARRAY CALL "NFO" WHICH C CONTAINS THE TOGGLE VALUE FOR THAT PARTICULAR PAAMETER. THE C RESNO IS ALSO USED TO INDEX INTO AN ARRAY CALLED "NFONX" WHICH C CONTAINS THE INDEX VALUE INTO "INFO" FOR THAT PARTICULAR C PARAMETER. "INFO" IS THE TOGGLE ARRAY ACCESSED BY OTHER C SUBROUTINES. ( FOR MORE DETAILED DESCRIPTIONS OF RESNO'S C SEE THE MODULE GGLOB.) C C NOTE: TYPE, RESNO AND IGLOB ARE RETURNED BY GGLOB WHO C CALLS GGLOB, WHO CALLS GCHAR, WHO CALLS GCARD. C C TYPE IS THE TYPE OF VALUE IN IGLOB C RESNO IS THE COMMAND WORD NUMBER C IGLOB IS THE VALUE ITSELF C C (SEE GGLOB FOR MORE DETAIL) C C C NOTE: CODE, AND CHAR ARE RETURNED FROM GCHAR C C CODE IS THE TYPE OF CHARACTER C CHAR IS THE LAST CHARACTER EXAMIN¤Ç������þúED C (CHAR IS NOT DUPLICATED IN IGLOB, BUT IS THE C NEXT CHARACTER TO BE PROCESSED) C C (SEE GCHAR FOR MORE DETAIL) C C C C COMMAND FORAMT: C C $CONTROL: [OPTIONS LIST] C C WHERE: C C OPTIONS LIST C IS A LIST OF OPTIONS SEPARATED BY COMMAS C C ROOT - REQUESTS THE ROOT FILE TO BE CREATED C NOROOT- REQUESTS THE ROOT FILE NOT TO BE CREATED. C C WHEN NEITHER OPTIONS IS GIVEN ROOT IS ASSUMED. C WHEN NOROOT IS GIVEN NO DATA SETS ARE CREATED. C C SET - REQUESTS DATA SETS TO BE CREATED C NOSET - REQUEST NO DATA SETS TO BE CREATED. C C WHEN NEITHER OPTIONS IS GIVEN SET IS ASSUMED C WHEN NOROOT IS GIVEN, THE SET OPTION IS IGNORED. C C LIST - REQUESTS A LISTING OF THE SCHEMA AS IT IS PROCESSED. C NOLIST - REQUESTS THE SCHEMA LISTING TO BE SUPPRESSED, C ONLY RECORDS IN ERROR ARE LISTED. C C WHEN NEITHER OPTIONS IS GIVEN LIST IS ASSUMED. C C C TABLE - REQUESTS A TABLE DESCRIBING THE DATA SETS C TO BE PRINTED. C NOTABLE - REQUESTS THE TABLE TO BE SUPPRESSED. C C WHEN NEITHER OPTIONS IS GIVEN NOTABLE IS ASSUMED. C C C FIELD - REQUESTS A TABLE DESCRIBING EACH SET'S ITEM'S C OFFSETS INTO THE DATA RECORD. WHEN THIS OPTION C IS NOT INCLUDED NO TABLE IS PRINTED. C C ERRORS = N - REQUESTS ERROR PROCESSING TO TERMINATE C ON THE NTH ERROR. N MUST BE BETWEEN 1 AND 999. C WHEN THIS OPTION IS NOT INCLUDED N IS SET TO 100. C C C C C C C C INTEGER HEAD(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY* ������þú,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB œý������þú INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX,º¸������þú 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA HEAD/2HHE,2HAD,2H2 / C C C C VERIFY THAT THIS IS A "$CONTROL" COMMAND C IF IT IS NOT OUTPUT "$CONTROL EXPECTED" C IF (RESNO .NE. CNTRL) CALL ERXIT(XCNTR) C C GOOD, PROCESS CONTROL OPTIONS C CALL GGLOB C C WHILE NOT(SEMICOLN OR BEGIN DATA BASE ) C 10 CONTINUE IF (TYPE .EQ. SEMI) GOTO 50 IF (RESNO .EQ. BEGIN) GOTO 60 C C VERIFY OPTION IS LEGAL C IF ((RESNO .LT. LST) .OR. (RESNO .GT. FIELD)) GOTO 7010 C C HANDLE "ERROR = N" OPTION SPECIALLY C IF (RESNO .NE. ERR) GOTO 20 CALL GGLOB IF (TYPE .NE. EQUAL) GOTO 7010 CALL GGLOB IF ((TYPE .NE. INTGR) .OR. (IGLOB .GT. 999)) GOTO 7010 C C PUT ERROR COUNT IN INFO C NDX = NFONX(ERR) INFO(NDX) = IGLOB GO TO 30 C C GET INDEX INTO INFO FROM NFONX C 20 CONTINUE NDX = NFONX(RESNO) C C GET CORRECT FLAG FROM NFO AND PUT IT INTO IN?¾���$��"FO C INFO(NDX) = NFO(RESNO) C C VERIFY THE COMMA OR SEMICOLON C IF NOT THEN OUTPUT "ILLEGAL SEPARATOR" C 30 CONTINUE CALL GGLOB IF((TYPE .NE. COMMA) .AND. (TYPE .NE. SEMI) ) CALL EMESS(ILSEP) C C SKIP PAST THE COMMA, OR UPTO A SEMICOLN C AND RETURN TO TOP OF WHILE LOOP C 40 CONTINUE CALL SCAN(COMMA) GOTO 10 C C SCAN PAST THE SEMICOLON C 50 CONTINUE CALL SCAN(SEMI) C C LOAD AND EXECUTE HEAD C 60 CONTINUE CALL SEGLD(HEAD,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(HEAD,2) CALL ERXIT(NOSEG) C C C C ERROR HANDLERS C C C C OUTPUT "ILLEGAL CONTROL OPTION" C 7010 CALL EMESS(ILCTR) GOTO 40 END ������������������������������������������•j$������ÿÿ����� ���� ÿý�?� J ���������ÿ��92069-18019 2026� S C0122 �&HEAD2 � � � � � � � � � � � � � �H0101 wa�����þúFTN PROGRAM HEAD2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-16015 C RELOC: 92069-16015 C C C****************************************************************: C C C C "BEGIN DATA BASE" COMMAND PROCESSOR C C C C ABSTRACT: C C HEAD HANDLES THE "BEGIN DATA BASE:" CONTROL STATEMENT. IT SAVES TEH DATA C BASE NAME, SECURITY CODE, AND CARTRIDGE NUMBER IN THE DATA BASE. C C COMMAND FORMAT: C C BEGIN DATA BASE: <DATA BASE NAMR> ; C C WHERE: C C DATA BASE NAMR C IS AN FMP NAMR WHICH CONTAINS THE FILE NAME, SECURITY CODE C AND CARTRIDGE NUMBER - NO MORE AND NO LESS. C C THE SECURITY CODE, AND THE CARTRIDGE NUMBER MAY BE C TWO ASCII CHARACTERS, OR AN INTEGER BETWEEN 1 AND C 32,767. C C C INTEGER LEVEL(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEÜC������þúGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,C’������þúRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG C+������þú COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA LEVEL/2HLE,2HVL,2H2 / C C C VERIFY "BEGIN DATA BASE" C IF (RESNO .NE. BEGIN) GOTO 7010 CALL GGLOB IF (RESNO .NE. DATA) GOTO 7010 CALL GGLOB IF (RESNO .NE. BASE) GOTO 7010 C C GOOD, PROCESS DATA BASE NAME C NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. C CALL DBNMR(RFILE,DSEC,DCRN,IERR) IF (IERR .LT. 0) GOTO 20 IF(DSEC .EQ. 0) CALL EMESS(ILNMR) C C VERIFY THE SEMICOLN C IF NOT OUTPUT MESSAGE C AND CONTINUE CALL GGLOB IF(TYPE .NE. SEMI) CALL EMESS(ILTRM) C C PUT DATA BASE NAME IN ROOT C INDX = DBNAM DO 10 I=1,3 CALL SROOT(INDX,RFILE(I) ) INDX = INDX + 2 10 CONTINUE C C PUT SECURITY NUMBER IN ROOT C CALL SROOT(DBSCD,DSEC) C C PUT CARTRIDGE NUMBER IN THE DATA BASE CONTROL BLOCK C CALL SROOT(DBCRN,DCRN) C C INITIALIZE NODE NUMBER TO -1 C CALL SROOT(DBDSN,-1) C C SCAN PAST SEMICOLN C 20 CONTINUE CALL SCAN(SEMI) C C LOAD AND EXECUTE NEXT SEGMENT C 30 CONTINUE CALL SEGLD(LEVEL,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(LEVEL,3) CALL ERXIT(NOSEG) C C OUTPUT "'BEGIN DATA BASE' EXPECTED." C 7010 CALL EMESS(XBEGN) IF (RESNO .EQ. LEVL ) GO TO 30 GO TO 20 END ����������������������������������������������������������������'6����������������������������������������ÿÿ����� ���� ÿý�@� J ���������ÿ��92069-18020 2026� S C0122 �&LEVL2 &LEVL2 � � � � � � � � � � � � � �H0101 êÒ�����þúFTN PROGRAM LEVL2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18020 C RELOC: 92069-16015 C C C****************************************************************: C C C C LEVEL SEGEMENT C C C C ABSTRACT: C C LEVEL PROCESSES THE "LEVELS:" COMMAND. ALL THE NAMES OF THE LEVELS C ARE PUT INTO THE DATA BASE CONTROL BLOCK. THE LEVEL NUMBERS MUST C RANGE FROM 1 TO 15 INCLUSIVE. ALL LEVEL NAMES MUST BE UNIQUE TO C EACH OTHER. LEVELS MAY BE DEFINED IN ANY ORDER, THAT IS LEVEL C FIFTEEN MAY BE DEFINED BEFORE LEVEL TEN. LEVEL FIFTEEN NEED NOT C BE DEFINED AS IT WAS IN THE PREVIOUS DBDS. C C COMMAND FORMAT: C C LEVELS: <LEVEL LIST>; C C WHERE: C C LEVEL LIST C IS A LIST OF LEVEL DEFINITIONS SEPARATED BY ";" C C C C INTEGER ITEM(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DB² ������þúSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, í2������þú 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMONkz������þú FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA ITEM/2HIT,2HEM,2H2 / C C C C C BLANK THE LEVEL WORDS C DO 5 I=DBLVL,DBLVE,2 CALL SROOT(I,BLANK) 5 CONTINUE C C SET LEVEL FLAG TO INDICATE THAT NONE ARE PRESENT C CALL SROOT(DBLMD,-1) C C VERIFY THAT THIS IS A LEVEL COMMAND C IF(RESNO .NE. LEVL) GOTO 7030 C C PROCESS THE LEVEL DEFINITIONS C CALL GGLOB C C WHILE NOT( SEMICOLON OR ITEM:) C 10 CONTINUE IF(TYPE .EQ. SEMI) GOTO 80 IF(RESNO .EQ. ITM) GOTO 90 C C GET THE LEVEL NUMBER C IF ((TYPE .NE. INTGR) .OR. (IGLOB .LT. 1) .OR. (IGLOB .GT. 15)) 1 GOTO 7010 C C GET INDEX INTO LEVEL WORD IN ROOT C INDX = (IGLOB-1) * 6 + DBLVL C C GET LEVEL NAME C 20 CONTINUE NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. IF (TYPE .NE. NAM) GOTO 7020 C C SEARCH FOR DUPLICATE ITEM NAME C DO 40 I=DBLVL,DBLVE,6 LNDX = I DO 30 I2=1,3 IF(IGLOB(I2) .NE. ROOTA(LNDX)) GOTO 40 LNDX = LNDX + 2 30 CONTINUE C C DUPLICATE NAME FOUND C GOTO 7040 40 CONTINUE C C CHECK THAT THIS LEVEL IS NOT ALREADY SPECIFIED C IF ( ROOTA(INDX) .NE. BLANK) GOTO 7050 C C PUT LEVEL NAME IN ROOT C DO 50 I=1,3 CALL SROOT(INDX,IGLOB(I) ) INDX = INDX + 2 50 CONTINUE C C SET LEVEL FLAG TO INDICATE THAT THERE IS A LEVEL WORD C CAÐy�����LL SROOT(DBLMD,0) C C C VERIFY SEMI-COMMA C 55 CONTINUE CALL GGLOB IF(TYPE .NE. SEMI) CALL EMESS(ILTRM) 60 CONTINUE CALL SCAN(SEMI) GOTO 10 C C C C C SCAN PAST SEMICOLON C 80 CONTINUE CALL SCAN(SEMI) C C LOAD AND EXECUTE ITEM PROCESSOR C 90 CONTINUE CALL SEGLD(ITEM,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(ITEM,2) CALL ERXIT(NOSEG) C C C C ERROR PROCESSORS C C OUTPUT "LEVEL OUT OF RANGE" C 7010 CALL EMESS(ILRNG) GOTO 60 C C OUTPUT "ILLEGAL LEVEL WORD" C 7020 CALL EMESS(ILLVN) GOTO 60 C C OUTPUT "LEVEL: EXPECTED" C 7030 CALL EMESS(XLEV) IF (RESNO .EQ. ITM) GOTO 90 CALL SCAN (SEMI) GOTO 90 C C OUTPUT "DUPLICATE LEVEL WORD" C 7040 CALL EMESS(DUPLV) GOTO 55 C C OUTPUT "LEVEL NUMBER ALREADY DEFINED" C 7050 CALL EMESS(LVDEF) GOTO 55 END ��������������������������������������������������������������������������¢À������ÿÿ����� ���� ÿý�A� K ���������ÿ��92069-18021 2026� S C0122 �&ITEM2 &ITEM2 � � � � � � � � � � � � � �H0101 çÎ�����þúFTN PROGRAM ITEM2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18021 C RELOC: 92069-16015 C C C****************************************************************: C C C C ITEM: PROCESSOR C C ABSTRACT: C C THIS SEGMENT PROCESSES THE "ITEMS:" COMMAND. THE SYNTAX OF THE C ITEM DEFINITION FIELD IS AS FOLLOWS: C C ITEMS: C C ITEM NAME, [ELEMENT COUNT] ITEM TYPE [(READ LEVEL,WRITE LEVEL)] ; C C THE PROCESSING IS TERMINATED WHEN A "SETS:" IS FOUND INSTEAD OF AN ITEM C NAME. C C C INTEGER SETS(3) C INTEGER ECNT C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG"+������þú,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, ò¤������þú 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OuV������þúVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA SETS/2HSE,2HTS,2H2 / C C VERIFY THIS IS AN ITEM: COMMAND C IF (RESNO .NE. ITM) CALL ERXIT(XITM) C C INITIALIZE ITEM TABLE POINTER C CALL SROOT(DBITP,ITMST) ITMTB = ITMST * 2 ICNT = 0 C C GET THE ITEM NAME, TURNING OFF THE CHECK FOR RESERVED WORDS C 10 CONTINUE NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. C C C SINCE KEYWORDS WERE NOT CHECKED, THE "SETS:" COMMAND C MUST BE MANUALLY CHECKED. C C IF (LGLOB .NE. 2) GOTO 15 IF( JSCOM(IGLOB,1,4,SETS,1) .NE. 0) GOTO 15 C C VERIFY THE COLON C CALL SGET(CARD,CRDPR,ICHK) IF(ICHK .NE. 72B) GOTO 15 C C SKIP PAST THE COLON AND SET THE RESNO TO INDICATE A "SETS:" COMMAND C WAS FOUND C CALL GGLOB RESNO = SET GOTO 50 C C ARE THERE TOO MANY ITEMS SPECIFIED ? C 15 CONTINUE IF(ICNT .GE. MXITM) GO TO 7010 C C IS THIS A VALID ITEM NAME? C IF(TYPE .NE. NAM) GOTO 7020 C C SEARCH FOR DUPLICATE ITEM NAME C CALL ISRCH(ICNT,INUM) C FOUND? IF(INUM .NE. 0) GOTO 7030 C NO, CALCULATE INDEX INTO ITEM TABLE INDX = ICNT*ITMSZ + ITMTB INDX2 = INDX C C ZERO THE CURRENT ITEM TABLE ENTRY C DO 20 I= INDX,INDX+ITMSZ,2 CALL SROOT(I,0) 20 CONTINUE C C PUT SET NAME INTO THE SET TABLES C DO 30 I =1,3 CALL SROOT(INDX2,IGLOB(I) ) INDX2 = INDX2 + 2 30 CONTINUE C C VERIFY A COMMA EXISTS C CALL GGLOB IF(TYPE .NE. COMMA) GOTO 7040 C C PROCESS THE ELEMENT COUNT C CALL ELEMT (ECNT,INDX,IERR) IF (IERR .LT. 0) GOTO 40 C C PROCESS zb�����TYPE SPECIFICATION C CALL ITMT(ECNT,INDX,IERR) IF (IERR .LT. 0) GO TO 40 C C PROCESS READ/WRITE LEVELS C CALL RDWRL(INDX,IERR) IF (IERR .LT. 0) GO TO 40 C C PUT ITEM ENTRY INTO SORT TABLE C CALL SSORT(ICNT,SORTI,ITMSZ,ITMTB) IF (IERR .LT. 0) GO TO 40 C C INCREMENT COUNTER IN PREPERATION FOR NEXT ITEM C ICNT = ICNT + 1 C C SCAN PAST THE SEMICOLON C 40 CONTINUE IF(TYPE .EQ. SEMI) GOTO 10 IF(RESNO .EQ. END) CALL ERXIT(UEND) CALL GGLOB GOTO 40 C C C PUT ITEM COUNT IN ROOT C 50 CONTINUE IF(ICNT .EQ. 0) CALL ERXIT(DEFIT) CALL SROOT(DBICT,ICNT) C C PUT ADDRESS OF SET TABLE IN ROOT C SETTB = (ICNT * ITMSZ + ITMTB) / 2 CALL SROOT(DBSTP,SETTB) C C LOAD AND EXECUTE SEGEMENT SETS C CALL SEGLD(SETS,IERR) CALL OUTLN(SETS,3) CALL ERXIT(NOSEG) C C C C ERROR PROCESSORS C C C OUTPUT "TOO MANY ITEMS" C 7010 CALL EMESS(ITLIM) C C SCAN TO THE SETS: COMMAND C 7015 CONTINUE IF(RESNO .EQ. SET) GOTO 50 CALL GGLOB GOTO 7015 C C OUTPUT "ILLEGAL NAME" C 7020 CALL EMESS(ILNAM) GOTO 40 C C OUTPUT "DUPLICATE ITEM NAME" C 7030 CALL EMESS(DUPIT) GOTO 40 C C OUTPUT "ILLEGAL SEPARATOR" C 7040 CALL EMESS(ILSEP) GO TO 40 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������U+������ÿÿ����� ���� ÿý�B� L ���������ÿ��92069-18022 2026� S C0122 �&SETS2 &SETS2 � � � � � � � � � � � � � �H0101 øÞ�����þúFTN PROGRAM SETS2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18022 C RELOC: 92069-16015 C C C****************************************************************: C C C C SETS: COMMAND PROCESSOR C C C ABSTRACT: C THE "SETS:" COMMAND PROCESSOR IS BROKEN INTO THREE SEGMENTS: C NAME, WHICH IS THE "NAME" COMMAND PROCESSOR; ENTRY, WHICH IS C THE "ENTRY:" COMMAND PROCESSOR; AND CAPAC, WHICH IS THE C "CAPACITY:" COMMAND PROCESSOR. THEY ARE LOADED IN THE ORDER C DESCRIBED IN THE DIAGRAM BELOW. C C C SETS C ! C ! C --> NAME ---> RAPUP C ! ! C ! ! C ! ENTRY C ! ! C ! ! C --- CAPAC C C C C INTEGER NAME(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C À������þú C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,B&������þúADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR /–����� COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA NAME/2HNA,2HME,2H2 / C C C INITIALIZE THE NUMBER OF SETS TO 0 C INITIALIZE THE END OF MEMORY POINTER (THIS IS USED TO C STORE INFORMATION TABLES WHILE BUILDING DATA SETS) C INITIALIZE THE BASE ADDRESS OF THE SET TABLES C C SCNT = 0 INFPT = (LWAM - FWAM) * 2 SETTB = ROOTA(DBSTP) * 2 C C VERIFY THAT THIS IS A "SETS:" COMMAND C IF (RESNO .NE. SET) CALL ERXIT(SETX) C C LOAD AND EXECUTE "NAME:" COMMAND PROCESSOR C CALL GGLOB CALL SEGLD(NAME,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(NAME,2) CALL ERXIT(NOSEG) END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Gh������ÿÿ����� ���� ÿý�C�L ���������ÿ��92069-18023 2026� S C0122 �&NAME2 &NAME2 � � � � � � � � � � � � � �H0101 ÛÀ�����þúFTN PROGRAM NAME2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18023 C RELOC: 92069-16015 C C C****************************************************************: C C C "NAME:" COMMAND PROCESSOR C C C ABSTRACT: C C THE "NAME:" PROCESSOR VERIFIES THAT THE DATA SET NAME IS A C LEGAL DATA BASE NAMR, THAT THE SET NAME IS UNIQUE TO THIS DATA C BASE, THEN BEGINS BUILDING THE DATA SET TABLE ENTRY. (NOTE THAT C THIS SEGMENT DOES NOT CHECK TO SEE IF THE DATA SET IS UNIQUE C TO THE CARTRIDGE. THAT IS DONE IN THE SEGMENT "ROOT".) THIS C SEGMENT DETERMINES THE DATA SET TYPE AND PUTS IT IN THE SET C TABLE. THEN LOADS AND EXECUTES THE SEGMENT WHICH PROCESSES THE C "ENTRY:" COMMAND. THE SYNTAX OF THE SCHEMA "NAME:" COMMAND IS C AS FOLLOWS: C C NAME: SETNAME::CRN,SETTYPE; C C C THIS SEGMENT ALSO RECOGNIZES THE "END." COMMAND AND WILL LOAD C AND EXECUTE THE SEGMENT WHICH WRAPS UP ALL THE DETAILS FOR THE C SCHEMA PROCESSOR. C C C C C C INTEGER SNAM(3) INTEGER ENTRY(3) INTEGER RAPUP(3) INTEGER STYPE C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,N2î������þúM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STY}¾������þúPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT•<������þú, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA ENTRY/2HEN,2HTY,2H2 / DATA RAPUP/2HRA,2HPP,2H2 / C C C C C C CHECK FOR "END." COMMAND C IF (RESNO .EQ. END) GOTO 80 C C VERIFY THIS IS A "NAME:" COMMAND C IF (RESNO .NE. NM) GOTO 7060 C C INTIALIZE THE GLOBAL ERROR INDICATOR C GGERR = 0 C C VERIFY THERE IS ROOM FOR MORE SETS C IF (SCNT .GE. SMAX) GOTO 7010 C C PROCESS THE ITEM NAME C NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. C CALL DBNMR(SNAM,ISC,ICR,IERR) IF(IERR .LT. 0) GOTO 70 C C IF THE SECURITY CODE IS NOT ZERO C THEN WARN THE USER IT WILL BE IGNORED C IF(ISC .NE. 0) CALL OUTPT(IGNSC) C C VERIFY THIS IS A UNIQUE SET NAME C CALL SSRCH(SCNT,INUM,SNAM) C C SET INDEX TO NEXT SET TABLE ENTRY C SINDX = SCNT*SETSZ+SETTB C C ZERO OUT THE MEMORY OF THE NEW SET C DO 10 I = SINDX,SINDX+SETSZ,2 CALL SROOT(I,0) 10 CONTINUE C C WAS THE SET NAME UNIQUE C IF (INUM .EQ. 0) GOTO 15 C C OUTPUT " DUPLICATE DATA SET NAME" C GGERR = -1 CALL EMESS(DUPST) GOTO 25 C C PUT SET NAME INTO THE TABLE Ä«������þú C 15 CONTINUE NMX = SINDX DO 20 I = 1,3 CALL SROOT(NMX,SNAM(I) ) NMX = NMX + 2 20 CONTINUE C C PUT CARTRIDGE NUMBER INTO SET TABLE C CALL SROOT(SINDX+DSCRN,ICR) C C VERIFY THE COMMA C 25 CONTINUE CALL GGLOB IF (TYPE .NE. COMMA) GOTO 7040 C C PROCESS THE SET TYPE C CALL GGLOB C C VERIFY THIS IS A VALID SET TYPE AND SAVE TYPE IN STYPE C FOR LATER PROCESSORS. STYPE IS IDENTICAL TO THE FLAG IN C THE SET TABLE. C IF((RESNO .NE. ASET) .AND.(RESNO .NE. AUSET) )GOTO 30 STYPE = AUTO GOTO 50 C 30 CONTINUE IF ((RESNO .NE. MSET) .AND. (RESNO .NE. MASET)) GOTO 40 STYPE = MANU GOTO 50 C 40 CONTINUE IF ((RESNO .NE. DSET) .AND. (RESNO .NE. DESET)) GOTO 7050 STYPE = DETAIL C C SAVE TYPE IN THE SET TABLE C 50 CONTINUE CALL RSPUT(SINDX+DSTYP,STYPE) C C VERIFY THE SEMICOLN C CALL GGLOB IF(TYPE .NE. SEMI) GOTO 7080 C C SCAN PAST THE SEMICOLON C 70 CONTINUE CALL SCAN(SEMI) C C LOAD AND EXECUTE "ENTRY:" PROCESSOR C 75 CONTINUE CALL SEGLD(ENTRY,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(ENTRY,3) CALL ERXIT(NOSEG) C C SAVE THE NUMBER OF SETS DEFINED C 80 CONTINUE CALL SROOT(DBSCT,SCNT) IF(SCNT .EQ. 0) GOTO 7070 C C LOAD AND EXECUTE THE "END." PROCESSOR C 90 CONTINUE CALL SEGLD(RAPUP,IERR) C C IF SEGLD RETURNS THE ERRROR C CALL OUTLN(RAPUP,2) CALL ERXIT(NOSEG) C C C C ERROR PROCESSORS C C C C OUTPUT "TOO MANY DATA SETS" C 7010 CALL EMESS(STLIM) 7015 CALL GGLOB IF (RESNO .NE. END) GOTO 7015 GOTO 80 C C OUTPUT "ILLEGAL SEPARATOR" C 7040 CALL EMESS(ILSEP) GOTO 7055 C C OUTPUT "BAD TYPE DESIGNATOR." C 7050 CALL EMESS(ILITP) 7055 GGERR = -1 GOTO 70 C C OUTPUT "NAME: EXPECTED" C 7060 CALL EMESS(NAMX) GGERR = -1 IFÖ=���$��" (RESNO .EQ. ENTY) 75,70 C C OUTPUT "DATA BASE HAS NO DATA SETS" C 7070 CALL EMESS(EMPTY) GGERR = -1 GOTO 90 C C OUTPUT "ILLEGAL TERMINATOR" C 7080 CALL EMESS(ILTRM) GOTO 7055 END ��������������������������������������������������������¼-$������ÿÿ����� ���� ÿý�D� O ���������ÿ��92069-18024 2026� S C0122 �&ENTY2 &ENTY2 � � � � � � � � � � � � � �H0101 ûß�����þúFTN PROGRAM ENTY2(5,90),92069-16015 REV.2026 800124 C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18024 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C "ENTRY:" COMMAND PROCESSOR C C ABSTRACT: C C THE "ENTRY:" PROCESSOR WILL PROCESS ALL THE ITEM NAMES IN A C DATA SET ALLOWING A ITEM NAME TO BE USED ONLY ONCE PER DATA C SET. IT BUILDS THE RECORD DEFINITION TABLE AND THE PATH TABLE C IN TEMPORARY BUFFERS CALLED "RDEF" AND "PTHTB". IT DETERMINES C THE SIZE OF THE MEDIA RECORD AND THE DATA RECORD, AND PUTS THIS C IN THE SET TABLE. BEFORE LOADING THE "CAPACITY:" PROCESSOR, THIS C SEGMENT WILL INSURE THAT ALL MASTER DATA SETS HAVE A PATH ITEM, C THAT ALL DATA SETS HAVE AT LEAST 1 ITEM, AND AUTOMATIC MASTERS C HAVE ONLY 1 ITEM WHICH MUST BE A PATH ITEM. C C C C C C INTEGER CAPAC(3) INTEGER CAPC(4) INTEGER PTHCT,FLDCT,SIIDX,SITNM C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ºÙ������þú ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C ¥‹������þú CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C …«������þúVARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA CAPAC/2HCA,2HPC,2H2 / DATA CAPC/2HCA,2HPA,2HCI,2HTY/ C C C INITIALIZE POINTERS C C FLDCT IS THE INDEX INTO THE RECORD DEFINITION TABLE BEING C BUILT IN A TEMPORARY BUFFER C C ENTL IS THE LENGTH OF ALL THE ITEMS IN THIS SET C C PTHCT IS THE NUMBER OF PATHS IN THIS SET. IT IS ALSO USED C AS A WORD POINTER INTO THE TEMPOARAY PATH TABLE. C C RDEF IS THE TEMPORARY RECORD DEFINITION TABLE C C PTHTB IS THE TEMPORARY PATH TABLE C C IF (RESNO .NE. ENTY) GOTO 7010 FLDCT = 1 IERR = 0 ENTL = 0 PTHCT = 0 SINDX = SCNT*SETSZ+SETTB C DO 5 I = 1,(MXENT+1)/2 5 RDEF(I) = 0 C DO 6 I=1,PMAX*2 6 PTHTB(I) = 0 C C C MEDIA IS THE LENGTH OF THE MEDIA RECORD FOR THIS SET. C THE FIXED MEDIA RECORD OVERHEAD FOR DETAILS IS 3, C FOR MASTERS IT IS 5 C MEDIA = 3 IF (STYPE .NE. DETAIL) MEDIA = 5 C C GET THE ITEM NAME TURNING OFF THE CHECK FOR RESERVE WORDS C 10 CONTINUE CALL NWITM C C STOP LOOP ON SEMICOLON, "CAPACITY:", OR WHEN MAXIMUM C NUMBER OF ITEMS IS REACHED. C 20 CONTINUE IF (TYPE .EQ. SEMI) GOTO 70 IF (RESNO .EQ. CAP) GOTO 80 IF(FLDCT .GT. MXENT) GOTO 7020 C C PROCESS TH×v������þúE ITEM NAME C IERR = 0 CALL GITEM (INDX,INUM,IERR) IF(IERR .NE. 0) GOTO 60 C C IS THERE A PATH? C GET THE ITEM TURNING OFF THE CHECK FOR RESERVED WORDS. C "NWITM" RETURNS THE SAME VALUES AS "GGLOB". C CALL NWITM IF ( (TYPE .NE. SEMI) .AND. (TYPE .NE. COMMA) ) GOTO 25 IF(STYPE .EQ. AUTO) 7070,45 C C CHECK TO SEE IF THIS IS A PATH ITEM. A PATH WILL BE ENCLOSED C IN PARENTHESIS. C "NWITM" RETURNS THE SAME VALUES AS "GGLOB" BUT IT DOES C NOT CHECK FOR RESERVE WORDS. THIS ALLOWS ANY ITEM TO C BE A PATH ITEM. C 25 CONTINUE IF (TYPE .NE. LPARN) GOTO 7030 C C MAKE SURE A NAME OR A NUMBER FOLLOWS. C CALL NWITM IF ((TYPE .NE. NAM) .AND. (TYPE .NE. ICODE)) GOTO 7030 C C VERIFY PATH ITEM IS NOT AN ARRAY C CALL RSGET (INDX+ITECT,I) IF(I .EQ. 1) GOTO 27 C C OUTPUT "PATH ITEM MUST BE SIMPLE" C IERR = -1 CALL EMESS(SIMPT) GOTO 35 C C PROCESS THIS PATH ACCORDING TO SET TYPE C 27 CONTINUE IF(STYPE .NE. DETAIL) GOTO 30 CALL DPTH(INUM,INDX,PTHCT,IERR) C C CHECK TO SEE IF THIS PATH IS SORTED C 35 CONTINUE CALL GGLOB IF (TYPE .NE. LPARN) GOTO 37 C C PROCESS SORT ITEM C CALL NWITM CALL STITM(INUM,PTHCT,IERR) C C VERIFY RIGHT PARENTHESIS C CALL GGLOB IF (TYPE .NE. RPARN) GOTO 7030 GOTO 36 C C C 30 CONTINUE CALL MPTH(INUM,PTHCT,IERR) C C VERIFY RIGHT PAREN C 36 CONTINUE CALL GGLOB 37 CONTINUE IF(TYPE .NE. RPARN) GOTO 7030 C C VERIFY COMMA OR SEMICOLON C CALL GGLOB IF ( (TYPE .NE. COMMA) .AND. (TYPE .NE. SEMI) ) GOTO 7080 C C IF NO ERROR C THEN PUT VALUES IN TABLES C IF THE SET IS A DETAIL, INCREMENT THE PATH COUNT C IF (IERR .LT. 0) GOTO 60 IF (STYPE .EQ. DETAIL) PTHCT = PTHCT+1 C C UPDATE MEDIA RECORD LENGTH C IF (STYPE .NE. DETAIL) GOTO 42 MEDIA = MEDIA + í������þú4 GOTO 45 C C GET MEDIA FOR MASTER C 42 CONTINUE MEDIA = MEDIA + PTHCT*6 C C PUT ITEM NUMBER IN RECORD DEFINITION TABLE C CHECK TO BE SURE THIS ITEM HAS NOT ALREADY BEEN DEFINED IN THIS SET C 45 CONTINUE IF (FLDCT .EQ. 1) GO TO 47 DO 46 I = 1,FLDCT-1 CALL SGET(RDEF,I,ICHK) IF(ICHK .EQ. INUM) GOTO 7040 46 CONTINUE 47 CONTINUE C C PUT THE ENTRY INTO THE RECORD DEFINITION TABLE C CALL SPUT(RDEF,FLDCT,INUM) FLDCT = FLDCT + 1 C C UPDATE ENTRY LENGTH C ENTL = ENTL + ROOTA(INDX+ITLNG) C C MAKE SURE RECORD ISN'T TOO LARGE C IF(ENTL+MEDIA .GT. MAXRC) GOTO 7090 C C INCREASE SET COUNT IN ITEM TABLE C CALL RSGET (INDX + ITSCT, N) N = N+1 CALL RSPUT(INDX+ITSCT,N) C C IF THIS IS FIRST SET TO USE ITEM PUT NUMBER IN TABLE C CALL RSGET(INDX+ITSNO,N) IF(N .EQ. 0) CALL RSPUT(INDX+ITSNO,SCNT+1) C C SCAN PAST COMMA C 60 CONTINUE GGERR = GGERR + IERR C C SCAN PAST COMMA UPTO SEMICOLN C 64 CONTINUE IF(TYPE .EQ. COMMA) GOTO 63 IF(TYPE .EQ. SEMI) GOTO 65 CALL NWITM GOTO 64 C C SCAN PAST THE COMMA C 63 CALL NWITM C C RETURN TO TOP OF LOOP C 65 GOTO 20 C C SCAN PAST SEMICOMMA C 70 CONTINUE CALL SCAN(SEMI) C C DONE WITH "ENTRY:" COMMAND C C VERIFY THAT PATHS ARE DEFINED IN MASTER SETS C 80 CONTINUE IF (STYPE .EQ. DETAIL) GOTO 81 CALL RSGET(SINDX+DSCCT,INUM) IF(INUM .EQ. 0) 7060,85 C C VERIFY THAT ALL SORT ITEMS ARE DEFINED IN DETAIL DATA SET C 81 CONTINUE IF (PTHCT .EQ. 0) GOTO 85 DO 83 I=2,PTHCT*2,2 INUM = PTHTB(I) IF (INUM .EQ. 0) GOTO 83 DO 82 J=1,FLDCT-1 CALL SGET(RDEF,J,ICHK) IF (INUM .EQ. ICHK) GOTO 83 82 CONTINUE GOTO 7110 83 CONTINUE C C PUT MEDIA + ENTRY LENGTH IN SET TABLE C 85 CONTINUE CALL RSPUT(SINDX+DSMDL,MEDIA) CALL SROOT(SIN"÷���*��($DX+DSDRL,ENTL) C C PUT FIELD COUNT IN SET TABLE C FLDCT = FLDCT - 1 IF(FLDCT .EQ. 0) GOTO 7100 CALL RSPUT(SINDX+DSFCT,FLDCT) C C PUT THE PATH COUNT IN THE SET TABLE C CALL RSPUT(SINDX+DSPCT,PTHCT) C C LOAD AND EXECUTE "CAPACITY:" COMMAND PROCESSOR C 90 CONTINUE GGERR = IERR+GGERR CALL SEGLD(CAPAC,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(CAPAC,3) CALL ERXIT(NOSEG) C C C C ERROR PROCESSORS C C C C OUTPUT "ENTRY: EXPECTED" C 7010 CALL EMESS(ENTYX) IF (RESNO .EQ. CAP) 80,70 C C OUTPUT "TOO MANY ITEMS" C 7020 CALL EMESS(ITLIM) IERR = -1 GOTO 70 C C OUTPUT "ILLEGAL SEPARATOR" C 7030 CALL EMESS(ILSEP) IERR = -1 GOTO 60 C C OUTPUT "DUPLICATE ITEM NAME" C 7040 CALL EMESS(DUPIT) IERR = -1 GOTO 60 C C OUTPUT "MASTER MUST HAVE A PATH C 7060 CALL EMESS(NOPTH) IERR = -1 GOTO 85 C C OUTPUT "AUTOMATIC MASTER MUST HAVE KEY ITEM ONLY" C 7070 CALL EMESS(AERR) IERR = -1 GOTO 60 C C OUTPUT "ILLEGAL TERMINATOR" C 7080 CALL EMESS(ILTRM) IERR = -1 GOTO 60 C C OUTPUT "RECORD TOO BIG" C 7090 CALL EMESS(RCLIM) IERR = -1 GOTO 60 C C OUTPUT "DATA SET MUST HAVE AN ITEM" C 7100 CALL EMESS(MORIT) IERR = -1 GOTO 90 C C OUTPUT "SORT ITEM NOT DEFINED IN SET" C 7110 CALL EMESS(UNDST) IERR = -1 GOTO 85 END ����������������������������BI*������ÿÿ����� ���� ÿý�E� Q ���������ÿ��92069-18025 2026� S C0122 �&CAPC2 &CAPC2 � � � � � � � � � � � � � �H0101 Ó¶�����þúFTN PROGRAM CAPC2(5,90),92069-16015 REV.2026 800122 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18025 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C "CAPACITY:" COMMAND PROCESSOR C C C ABSTRACT: C C THE "CAPACITY:" COMMAND PROCESSOR VERIFIES THAT THE CAPACITY C COUNT IS WITHIN RANGE. IT THEN INCREMENTS THE SET COUNT, UNLESS C THERE WERE ERRORS IN ANY EARLIER PROCESSING. IT WRITES OUT THE PATH C TABLE AND THE RECORD DEFINITION TABLE FOR THE CURRENT SET, AND C PUTS A POINTER TO THEM IN THE SET TABLE. IT PUTS THE SET NUMBER C IN THE SET INDEX (SORT) TABLE IN THE CORRECT SORT ORDER. THEN C LOADS AND EXECUTES THE NAME PROCESSOR. C C C C C C VARIABLES: C C PTHCT - IS THE NUMBER OF PATHS FOR THIS DATA SET C FLDCT - IS THE NUMBER OF FIELDS (ITEMS) IN THIS SET. C C INTEGER NAME(3) INTEGER PTHCT,FLDCT INTEGER PTR C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ¥Æ������þú ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C ‚‹������þúC CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C ¨«������þú VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA NAME/2HNA,2HME,2H2 / C C C VERIFY THIS IS THE CAPACITY COUNT C IF (RESNO .NE. CAP) GOTO 7010 C C GET CAPACITY COUNT C CALL GGLOB IF (TYPE .NE. INTGR) GOTO 7020 C C TRANSFORM SINGLE TO DOUBLE WORD C IF(LGLOB .EQ. 2) GOTO 10 IGLOB(2) = IGLOB(1) IGLOB(1) = 0 10 CONTINUE IF ((IGLOB(1) .EQ. 0) .AND. (IGLOB(2) .EQ. 0) ) GOTO 7020 IF (IGLOB(1) .GT. MXCAP(1)) GOTO 7020 C C PUT CAPACITY COUNT IN SET TABLE C CALL SROOT(SINDX+DSCAP,IGLOB(1) ) CALL SROOT (SINDX+DSCAP+2,IGLOB(2) ) C C VERIFY THE SEMICOLN C CALL GGLOB IF(TYPE .NE. SEMI) GOTO 7030 C C SCAN PAST SEMICOLON C 20 CONTINUE CALL SCAN(SEMI) C C IF THIS SET WAS SUCESSFULLY PROCESSED C THEN WRITE THE INFORMATION TABLES TO THE END OF MEMORY C AND INCREMENT THE SET COUNT C IF(GGERR .LT. 0) GOTO 30 C CALL RSGET(SINDX+DSPCT,PTHCT) CALL RSGET(SINDX+DSFCT,FLDCT) C CALL PINFO (PTHTB,PTHCT*4,SINDX+SETSZ,PTR) CALL PINFO (RDEF,FLDCT,SINDX+SETSZ,PTR) C C PUT POINTER TO TABLES IN SET TABLE C CALL SROOT(SINDX+DSITP,PTR/2) C C PUT THE SET NUMBER IN THE SET'S SORT TABLE C CALL SSORT(SCNT,SORTS,SEj+�����TSZ,SETTB) C C INCREMENT THE SET COUNTER C SCNT = SCNT +1 C C LOAD AND EXECUTE THE "NAME:" COMMAND PROCESSOR C 30 CONTINUE CALL SEGLD(NAME,IERR) C C C C ERROR PROCESSORS C C C C OUTPUT "CAPACITY EXPECTED" C THEN TERMINATE PROCESSING C 7010 CALL ERXIT(CAPX) C C OUTPUT "BAD CAPACITY COUNT" C 7020 CALL EMESS(ILCAP) 7025 GGERR = -1 GOTO 20 C C OUTPUT "ILLEGAL TERMINATOR" C 7030 CALL EMESS(ILTRM) GOTO 7025 END ����������������������������¿������ÿÿ����� ���� ÿý�F� P ���������ÿ��92069-18026 2026� S C0122 �&RAPP2 &RAPP2 � � � � � � � � � � � � � �H0101 ðÒ�����þúFTN PROGRAM RAPP2(5,90),92069-16015 REV.2026 800122 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18026 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C "END." COMMAND PROCESSOR C C C ABSTRACT: C C THIS SEGMENT PROCESSES THE "END." COMMAND. IT SETS THE FLAG C TO SUPPRESS THE ECHOING OF THE RECORD IN ERROR SINCE ALL RECORDS C HAVE BEEN PROCESSED BY NOW. IT VERIFIES THAT EVERY ITEM WAS C USED. IT COMPRESSES ANY UNUSED MEMORY BETWEEN THE LAST SET TABLE C AND THE RECORD DEFINITION AND PATH TABLES. (REMEBER THAT THE C RECORD DEFINITION AND PATH TABLES WERE BEING BUILT AT THE C END OF MEMORY TOWARDS THE MAIN PART OF THE RUN TABLE. THIS C WAS BECAUSE RECORD DEFINITION AND PATH TABLES ARE VARIABLE LENGTH.) C C THIS SEGMENT THEN PUTS THE SORT TABLES AFTER THE RECORD DEFINITION C AND PATH TABLES. THEN IT CREATES THE FREE RECORD TABLES, THEN THE C OVERHEAD RECORD. C C C ------------------ ------------------ C ! ! ! ! C ! RUN TABLE ! ! RUN TABLE ! C ! ! C ! ! ! ! C ! ! ! ! C ! ! ! ! C ------------------ ------------------ C ! ! ! ! C ! . ! ! RECORD DEFIN. ! C ! . ! áH������þú ! & PATH TABLE ! C ! ! ! ! C ! ! ------------------ C ! . ! ! ! C ! . ! ! ITEM & SET SORT! C ! ! ! TABLES ! C ! ! ------------------ C ! . ! ! ! C ! . ! ! FREE SPACE PTRS! C ! . ! ! ! C ! ! ------------------ C ! ! ! OVERHEAD RECORD! C ------------------ ------------------ C ! RECORD DEFIN. ! ! ! C ! & SORT TABLES! ! . ! C ! ! ! . ! C ------------------ ------------------ C C C C THIS SEGMENT THEN GATHERS UP INFORMATION NECESSARY FOR THE C "TABLE" AND "FIELD" OPTIONS. THEN LOADS AND EXECUTES THE C SUMARY SEGMENT. C C C C LOGICAL OVF INTEGER NPACK INTEGER IDMAX(2) REAL DMAX INTEGER PPTR,PCNT INTEGER INAM(3) INTEGER RCAP(2) INTEGER SPACE INTEGER SUMRY(3) INTEGER RCNT,RECSZ INTEGER PACK INTEGER ENDM INTEGER DI1(2),DI128(2) INTEGER IBUF(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET=1������þú, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES x^������þúC C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIM0°������þúPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C EQUIVALENCE (DMAX,IDMAX) C C DATA IDMAX/077777B,177777B/ DATA SUMRY/2HSU,2HMY,2H2 / DATA DI1/0,1/ DATA DI128/0,128/ C C VERIFY THIS IS AN "END." COMMAND C IF (RESNO .NE. END) GOTO 7010 C C ANY EMPTY MEMORY C C TURN THE LISTING FLAG ON, SO THE LAST RECORD WILL NOT C PRINTED ON ERRORS. C NDX = NFONX(LST) INFO(NDX) = NFO(LST) CRDPR = 0 C C MAKE SURE EVERY ITEM IS USED C IFLAG = 0 ICNT = ROOTA(DBICT) ITMTB = ROOTA(DBITP)*2 IF(ICNT .LT. 1) GOTO 6 DO 5 I=ITMTB,(ICNT-1)*ITMSZ+ITMTB,ITMSZ IF(ROOTA(I+ITSCT) .NE. 0) GOTO 5 C C IF THIS IS THE FIRST UNUSED ITEM C OUTPUT "THE FOLLOWING ITEM(S) ARE UNUSED." C FOLLOWED BY THE ITEM NAME C IF(IFLAG .EQ. 0) CALL EMESS(UNITM) IFLAG = -1 C C OUTPUT ITEM NAME C II=I DO 4 J=1,3 IBUF(J) = ROOTA(II) 4 II = II+2 CALL OUTLN(IBUF,3) 5 CONTINUE 6 CONTINUE C C GET SET COUNT AND SET TABLE ADDRESS C SCNT = ROOTA(DBSCT) IF ( SCNT .LE. 0) GOTO 100 SETTB = ROOTA(DBSTP) * 2 ENDM = (LWAM-FWAM) * 2 C C GET POINTER TO MEMORY JUST PAST THE SET TABLES C CHM™������þúECK IF THERE ARE ANY PATH TABLES C NOTE: INFPT POINTS TO THE LAST UNUSED WORD, ABOVE C THE INFORMATION TABLES C RINDX = SETTB + SCNT * SETSZ IF(INFPT .LT. RINDX) GOTO 25 IF(INFPT .EQ. ENDM) GOTO 25 C C YES, MOVE THE INFORMATION TABLES UNDER THE SET TABLES C SPACE = ((INFPT+2) - RINDX) / 2 C C DO 10 I= (INFPT+2),ENDM,2 CALL SROOT(RINDX,ROOTA(I) ) RINDX = RINDX + 2 10 CONTINUE C C UPDATE POINTERS IN SET TABLES C DO 20 I=0,SCNT-1 SINDX = I*SETSZ + SETTB IVAL = ROOTA(SINDX + DSITP) - SPACE CALL SROOT(SINDX+DSITP,IVAL) 20 CONTINUE C C PUT POINTER TO SORT TABLE IN MEMORY C 25 CONTINUE CALL SROOT(DBSOP,RINDX/2) C C PUT ITEM SORT TABLE IN MEMORY C ICNT = ROOTA(DBICT) IF (ICNT .LE. 0) GOTO 35 DO 30 I=1,ICNT CALL SROOT (RINDX,SORTI(I) ) RINDX = RINDX + 2 30 CONTINUE C C PUT SET SORT TABLE IN MEMORY C 35 CONTINUE DO 40 I = 1,SCNT CALL SROOT(RINDX,SORTS(I) ) RINDX = RINDX + 2 40 CONTINUE C C SAVE THE START OF THE OVERHEAD RECORD C AND INITIALIZE OVERHEAD C OVRHD = RINDX C C GET START RECORD NUMBER OF ROOT FILE C START REC. # = 1 REC FOR OVERHEAD + # REC. NEEDED FOR C FREE SPACE POINTERS + 1 FOR DISPLACEMENT C N = (SCNT*4+127)/128 + 2 IF( ( N.LT.3) .OR. (N .GT.4) ) CALL ERXIT(ABORT) CALL SROOT(RINDX,N) RINDX = RINDX +2 C C PUT LENGTH OF ROOT FILE IN OVERHEAD C CALL SROOT(RINDX,OVRHD/2) RINDX = RINDX +2 C C PUT LENGTH OF FREE SPACE POINTERS IN ROOT FILE C N= SCNT*4 CALL SROOT(RINDX,N) RINDX =RINDX +2 C C LEAVE ROOM FOR MAXIMUM DCB, AND MAXIMUM RECORD SIZE C CALL SROOT(RINDX,0) RINDX = RINDX+2 CALL SROOT(RINDX,0) RINDX = RINDX+2 C C RINDX IS POINTING TO EMPTY FREE SPACE TABLE C PUT THE WORD OFFSET TO THE FREE SPACE TABLE IN THE DAT;7������þúA BASE CONTROL C BLOCK FOR THE SUBROUTINE "DBCRT" - NOTE: THE DBMS ROUTINES DO NOT C USE THIS VALUE FOR THE FREE TABLE POINTER BUT INITIALIZES THE POINTER C UPON A DBOPN CALL. C CALL SROOT(DBFRP,RINDX/2) C C VERIFY EACH MASTER DATA SET HAS ALL ITS PATHS C C SELECT THE MAXIMUM NUMBER OF PATHS IN ANY DATA SET C C SELECT THE MAXIMUM RECORD SIZE OF ANY DATA SET C NPACK = 0 MAXP = 1 MAXR = 0 IFLAG = 0 C C INITIALIZE BUFFERS FOR SUMRY C DO 47 I= 1,SCNT KPACK(I) = 0 NSETS(I) = 0 CPACK(I) = 0 47 CONTINUE C C VERIFY DATA SETS AND SET UP PRINT BUFFER C C DO 90 J=0,SCNT-1 C GET THE INDEX FOR THE CURRENT SET SINDX = J*SETSZ+SETTB C GET THE PATH COUNT FOR THE CURRENT SET CALL RSGET(SINDX+DSPCT,PCNT) C GET THE DATA TYPE FOR THE CURRENT SET CALL RSGET(SINDX+DSTYP,STYPE) IF(STYPE .EQ. DETAIL) GOTO 55 C GET THE ADDRESS TO THE PATH TABLE PPTR = ROOTA (SINDX+DSITP) * 2 CALL RSGET(SINDX+DSFCT,RCNT) C MAKE PPTR ON A WORD BOUNDRY PPTR = PPTR + (RCNT+1)/2*2 C C VERIFY THAT EACH PATH HAS BEEN DEFINED C IF (PCNT .EQ. 0) GOTO 55 DO 50 I=1,PCNT IF(ROOTA(PPTR) .EQ.0) GOTO 7020 PPTR = PPTR + 4 50 CONTINUE C C SELECT THE MAXIMUM PATH COUNT C 55 CONTINUE IF (MAXP .LT. PCNT+1) MAXP = PCNT+1 C C SELECT THE MAXIMUM RECORD SIZE C CALL RSGET(SINDX+DSMDL,MEDIA) RECSZ = ROOTA(SINDX + DSDRL) + MEDIA IF (MAXR .LT. RECSZ) MAXR = RECSZ C C WRITE THE CAPACITY COUNT FOR CURRENT SET TO ROOT C C WRITE THE CAPACITY COUNT FOR CURRENT RECORD C RCAP(1) = ROOTA(SINDX + DSCAP) RCAP(2) = ROOTA(SINDX + DSCAP + 2) CALL SROOT(RINDX,RCAP(1) ) RINDX = RINDX + 2 CALL SROOT(RINDX,RCAP(2) ) RINDX = RINDX + 2 CALL SROOT(RINDX,0) RINDX = RINDX +2 N = 0 IF(STYPE .EQ. DETAIL) N = 1 CALL SROOT(RINDX,N) RINDX = RINDX + 2 ©·���0��.* C C C CALCULATE THE SET LENGTHS AND ADD THEM TO THE ACCUMULATOR FOR C ITS CARTRIDGE NUMBER. ( THESE TABLES WILL BE PRINTED IN SUMRY) C WLEN = SIZE(RCAP,RECSZ,IERR) WLEN = DAD(WLEN,DI1) IF((IERR .NE. 0) .OR. OVF(IDMY) ) WLEN = DMAX C C SAVE PACK FOR FUTURE PRINT OUT C C PACK = ROOTA(SINDX + DSCRN) IF(NPACK .EQ. 0) GOTO 60 DO 60 I = 1, NPACK IF (KPACK(I) .NE. PACK) GOTO 60 NSETS(I) = NSETS(I) + 1 CPACK(I) = DAD(CPACK(I),WLEN) IF(OVF(IDMY)) CPACK(I) = DMAX GOTO 90 60 CONTINUE NPACK = NPACK + 1 KPACK(NPACK) = PACK NSETS(NPACK) = 1 CPACK(NPACK) = WLEN C C END OF DO LOOP C 90 CONTINUE C C PUT MAXIMUM DCB, AND RECORD SIZE IN OVERHEAD C CALL SROOT(OVRHD+OVDCB,MAXP) CALL SROOT(OVRHD+OVREC,MAXR) C C CHECK THAT A FMP WRITE TO TYPE 1 FILE WON'T C GENERATE A MEMORY PROTECT ERROR - THIS IS A C KLUDGE FOR RTE-IV'S FILE MANAGEMENT C I = (RINDX - OVRHD +10 + 254)/256 * 256 CALL SROOT(OVRHD + 10 + I,0) C C LOAD AND EXECUTE SUMRY C 100 CONTINUE CALL SEGLD(SUMRY,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(SUMRY,3) CALL ERXIT(NOSEG) C C C C ERROR PROCESSORS C C C C OUTPUT " 'END.' EXPECTED" C 7010 CALL EMESS(ENDX) GOTO 100 C C OUTPUT "NOT ENOUGH PATHS DEFINED IN MASTER" C 7020 CONTINUE IF(IFLAG .EQ. 0) CALL EMESS(PDEFC) IFLAG = -1 PPTR = SINDX + DSNME DO 7025 I = 1,3 INAM(I) = ROOTA(PPTR) PPTR = PPTR+2 7025 CONTINUE CALL OUTLN(INAM,3) GOTO 55 END ����������������������������������������������������������������������������������������������������������������������������������������������������mÜ0������ÿÿ����� ���� ÿý�G� T ���������ÿ��92069-18027 2026� S C0122 �&SUMY2 � � � � � � � � � � � � � �H0101 šy�����þúFTN PROGRAM SUMY2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18027 C RELOC: 92069-16015 C C C****************************************************************: C C C C C C C C C INTEGER ROOT(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTÇÐ������þúR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN¤»������þú,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB &Ì����� DATA ROOT/2HRO,2HOT,2H2 / C C C C SKIP THE SUMRY IF THERE WERE ERRORS C IF(ERROR .NE. 0) GOTO 10 C C PROCESS THE TABLE OPTION C CALL TABLE C C PROCESS THE ELEMENT OPTION C CALL FLDTB C C PROCESS THE SUMRY INFORMATION C CALL SUM C C LOAD AND EXECUTE ROOT C 10 CONTINUE CALL SEGLD(ROOT,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(ROOT,3) CALL ERXIT(NOSEG) END ��������������������������������������������������������ž ������ÿÿ����� ���� ÿý�H�Q ���������ÿ��92069-18028 2026� S C0122 �&ROOT2 &ROOT2 � � � � � � � � � � � � � �H0101 ã�����þúFTN PROGRAM ROOT2(5,90),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18028 C RELOC: 92069-16015 C C C****************************************************************: C C C ABSTRACT: C C THIS IS THE FINAL SEGMENT OF DBDS C IT CREATES THE SET FILES AND ROOT FILE C WHEN "ROOT", AND "SETS" ARE SPECIFIED. C C ROOT WILL NOT CREATE THE DATA SETS WHEN THE "NOROOT" OPTION C OR THE "NOSET" OPTIONS ARE USED. C C ROOT FIRST CREATES THE DATA SETS AND WRITES ZEROS IN ALL C THE RECORDS IN THE MASTER DATA SETS AND LINKS THE FREE C SPACE LIST TOGETHER IN THE DETAIL DATA SETS. C C ROOT THEN CREATES THE DATA BASE ROOT FILE AND WRITES THE C OVERHEAD RECORD TO THE FIRST 128 WORD RECORD AND THE C FREE SPACE POINTERS IN THE SECOND ( AND POSSIBLIY THIRD) C RECORDS OF THE ROOT FILE, THEN WRITES THE RUN TABLE C TO THE REST OF THE FILE. C C C C INTEGER BUFF(144) INTEGER SPTR INTEGER ERR1(20) INTEGER INAM(3) INTEGER IERR(4) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 R9Ã������þúOOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C ¥Y������þú CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VA»Ì������þúRIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C IS THE ROOT FILE REQUESTED? C NDX = NFONX(ROOTR) IF (INFO(NDX) .NE. NFO(ROOTR)) GOTO 20 C C YES, THEN WAS THERE ANY ERRORS? C IF (ERROR .NE. 0) CALL ERXIT(RTERR) C C WERE SETS REQUESTED? C NDX = NFONX(OPSET) IF (INFO(NDX) .EQ. NFO(OPSET)) GOTO 10 C C CREATE THE DATA SET FILES C CALL DBCRT(FWAM,BUFF,PRGFLG,IERR) IF (IERR .LT. 0) GOTO 7010 CALL OUTPT(GOODS) C C CREATE THE ROOT FILE C 10 CONTINUE IF(PRGFLG .EQ. 0) GOTO 15 CALL PURGE(BUFF,IERR,RFILE,DSEC,DCRN) C C 15 CONTINUE SIZE = DBLEI(((OVRHD/2)+127)/128+3) CALL ECREA(BUFF,IERR,RFILE,SIZE,1,DSEC,DCRN) IF (IERR .LT.0) GOTO 7020 C C WRITE THE ROOT FILE OUT C CALL WRITR(IERR,BUFF) C C CLOSE THE ROOT FILE C CALL CLOSE(BUFF) IF(IERR .LT. 0) GOTO 7020 CALL OUTPT(GOODR) C C TERMINATE THE PROCESSING C 20 CONTINUE CALL ERXIT(0) C C C ERROR PROCESSORS C C C C PURGE ALL THE DATA SETS CREATED BY DBCRT C OUTPUT "I/O ERROR XX ON DATA SET XXXXXX" C OUTPUT "I/O ERROR - ALL DATA SETS NOT CREATED" C 7010 CONTINUE CALL EMESS(BADS) C C DELETE ALL THE DATA SETS C 7011 CONTINUE SPTR = ROOTA(D‡�����BSTP) * 2 ISCT = ROOTA(DBSCT) C C PURGE ALL THE DATA SETS CREATED BY DBCRT, STARTING WITH THE C FIRST DATA SET IN THE DATA SET TABLE. STOP WHEN THE C DATA SET IN ERROR IS REACHED. C DO 7012 I = 0,ISCT-1 INAM = ROOTA(SPTR+DSNME) INAM(2) = ROOTA(SPTR+DSNME+2) INAM(3) = ROOTA(SPTR+DSNME+4) ICR = ROOTA(SPTR+DSCRN) SPTR = SPTR+SETSZ C C IF THIS IS NOT THE DATA SET WITH THE ERROR THEN PURGE IT C IF(JSCOM(IERR,3,8,INAM,1,IERR2) .EQ. 0) GOTO 7013 CALL PURGE(BUFF,IERR2,INAM,DSEC,ICR) 7012 CONTINUE C C TELL THE USER THE BAD DATA SET C GET THE MESSAGE USING GMESS C PUT THE CONVERTED I/O ERROR CODE INTO THE MESSAGE C PUT THE DATA SET NAME INTO THE MESSAGE C THEN PRINT THE MESSAGE C 7013 CONTINUE CALL GMESS(IOERR,ERR1,ISZ) CALL CITA(IERR,ERR1(7)) CALL SMOVE(IERR,3,8,ERR1,29) CALL OUTLN(ERR1,ISZ) GOTO 20 C C OUTPUT "ROOT NOT CREATED" C AND TERMINATE C 7020 CALL EMESS(BADR) CALL SMOVE(RFILE,1,6,IERR,3) GOTO 7011 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������üy������ÿÿ����� ���� ÿý�I� S ���������ÿ��92069-18029 2026� S C0122 �&GGLOB &GGLOB � � � � � � � � � � � � � �H0101 ùØ�����þúFTN SUBROUTINE GGLOB,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18029 C RELOC: 92069-16015 C C C****************************************************************: C C C C C ABSTRACT: C C GGLOB IS THE MOST FUNDAMENTAL OF THE DBDS ROUTINES. IT EXTRACTS C A WORD AT A TIME FROM THE INPUT SCHEMA DESCRIPTION AND ASSIGNS A C TYPE AND A RESNO TO THE WORD. INTEGERS ARE CONVERTED BEFORE THEY C ARE RETURNED TO THE CALLER. DOUBLE INTEGERS HAVE A LENGTH OF 2. C C ALL DATA BASE NAMES, LEVEL WORDS, ITEM NAMES AND SET NAMES C ARE PROCESSED IDENTICALLY. CERTAIN TERMINATORS, C SUCH AS ";", ",", ":", "(", ")", AND "=" ARE TREATED AS A WORD AND C EACH CHARACTER HAS A UNIQUE TYPE ASSOCIATED WITH IT. KEYWORDS ARE C RECOGNIZED BY GGLOB AND ARE GIVEN A SINGLE TYPE, BUT EACH KEYWORD C HAS A UNIQUE RESNO. WHEN A WORD IS NOT AN INTEGER, TERMINATOR, OR C RESERVE WORD IT IS RETURNED AS A NAME. C C C C CALLING SEQUENCE: C C CALL GGLOB C C ON EXIT: C C IGLOB - CONTAINS THE WORD ITSELF C LGLOB - CONTAINS THE LENGTH IN WORDS OF IGLOB C RESNO - CONTAINS A RESERVED NUMBER INDICATING THE C KEYWORD PROCESSED C TYPE - CONTAINS THE TYPE OF KEYWORD C C C C RESNO'S C C C RESNO RESERVE WORD C C 0 NAME OR INTEGER C 1 LIST C 2 NOLIST C 3 ERROR C 4 ROOT C 5 NOROOT C 6 TABLE C 7 NOTABLE C 8 SET C 9 âõ������þú NOSET C 10 FIELD C 11 $CONTROL C 12 UNUSED C 13 BEGIN C 14 DATA C 15 BASE C 16 END. C 17 LEVELS C 18 ITEMS C 19 SETS C 20 NAME C 21 ENTRY C 22 CAPACITY C 23 A C 24 AUTOMATIC C 25 M C 26 MANUAL C 27 D C 28 DETAIL C C C C C************************************************************ C C C C TYPE NUMBERS C C TYPE MEANING C C 0 ILLEGAL WORD C 1 INTEGER C 2 NAME C 3 RESERVE WORD C 4 = C 5 ( C 6 : C 7 UNUSED C 8 , C 9 [ BLANK ] C 10 ) C 11 ; C C C C C C C C INTEGER GLOBZ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 8������þú DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, S,������þú 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10)¥W������þú,INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA GLOBZ/20/ C C C C INITIALIZE RETURN PARAMETERS C LGLOB = 0 RESNO = 0 TYPE = 0 C C SHIP LEADING BLANKS C 10 CONTINUE IF (CODE .NE. BLKCD) GOTO 20 CALL GCHAR GOTO 10 C C BLANK THE RETURN BUFFER C 20 CONTINUE DO 30 I = 1,GLOBZ/2 IGLOB(I) = BLANK 30 CONTINUE C C IF FIRST CHARACTER IS AN INTEGER THEN PROCESS IT C IF (CODE .NE. ICODE) GOTO 40 CALL PINTG(GLOBZ) GOTO 60 C C ELSE SEE IF IT IS A SPECIAL CHARACTER C 40 CONTINUE IF ( (CODE .NE. COMMA) .AND. (CODE .NE. SEMI) .AND. 1 (CODE .NE. LPARN) .AND. (CODE .NE. RPARN) .AND. 2 (CODE .NE. COLON) .AND. (CODE .NE. EQUAL) ) GOTO 45 TYPE = CODE LGLOB = 1 IGLOB = CHAR CALL GCHAR GOTO 60 C C NOT A SPECIAL CHARACTER C IS IT AN ILLEGAL CHARACTER? C 45 CONTINUE IF((CODE .NE. ELSE) .AND. (CODE .NE. BADC) ) GOTO 50 LGLOB = LGLOB+1 CALL SPUT(IGLOB,LGLOB,CHAR) CALL GCHAR GOTO 55 C C PICK UP NAME C 50 CONTINUE TYPE = NAM IF ((CODE .GE. EQUAL) .OR. (LGLOB .GT. GLOBZ) ) GOTO 55 LGLOB = LGLOB + 1 CALL SPUT(IGLOB,LGLOB,CHAR) CALL GCHAR GOTO 50 C C CHECK FOR RESERVE WORD C 55 CONTINUE IF( .NOT. NMFLG) CALL RESRV C C IF THIS IS A NAME BE SURE IT IS SIX CHARACTERS OR LESS C IF((LGLOB .GT. 6) .AND.(TYPE .EQ. NAM)) TYPE = 0 C C TURN LGLOB INTÀÕ���$��"O A WORD COUNT C LGLOB = (LGLOB + 1)/2 60 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������F°$������ÿÿ����� ���� ÿý�J� U ���������ÿ��92069-18030 2026� S C0122 �&RESRV &RESRV � � � � � � � � � � � � � �H0101 ������þúFTN SUBROUTINE RESRV,92069-16015 REV.2026 800124 C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18030 C RELOC: 92069-16015 C C C****************************************************************: C C C PROCESS RESERVE WORD FOR GGLOB C INTEGER RESTA(112) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C ™Y������þú INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD„$������þú,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREAD�����SE SIZE OF PTHTB C RESTA IS THE TABLE OF RESERVED WORDS DATA RESTA/2HLI,2HST,2H ,2H ,2HNO,2HLI,2HST,2H , 12HER,2HRO,2HRS,2H ,2HRO,2HOT,2H ,2H , 12HNO,2HRO,2HOT,2H ,2HTA,2HBL,2HE ,2H , 12HNO,2HTA,2HBL,2HE ,2HSE,2HT ,2H ,2H , 12HNO,2HSE,2HT ,2H ,2HFI,2HEL,2HD ,2H ,2H$C,2HON,2HTR,2HOL, 12H ,2H ,2H ,2H ,2HBE,2HGI,2HN ,2H , 12HDA,2HTA,2H ,2H ,2HBA,2HSE,2H ,2H , 12HEN,2HD ,2H ,2H ,2HLE,2HVE,2HLS,2H , 12HIT,2HEM,2HS ,2H ,2HSE,2HTS,2H ,2H , 12HNA,2HME,2H ,2H ,2HEN,2HTR,2HY ,2H , 12HCA,2HPA,2HCI,2HTY,2HA ,2H ,2H ,2H , 12HAU,2HTO,2HMA,2HTI,2HM ,2H ,2H ,2H , 12HMA,2HNU,2HAL,2H ,2HD ,2H ,2H ,2H , 12HDE,2HTA,2HIL,2H / C C COMPARE WORD AGAINEST RESERVE WORD C DO 10 I=0,NORES-1 M = 8*I+1 IF (JSCOM(IGLOB,1,8,RESTA,M,IERR) .EQ. 0) GOTO 50 10 CONTINUE C C RESERVE WORD NOT FOUND C GOTO 90 C C FOUND A RESERVE WORD VERIFY IT HAS ALL TRAILING SPECIAL C CHARACTERS C 50 CONTINUE IF(I+1 .NE. END) GOTO 70 IF(CHAR .NE. DOT) GOTO 90 GOTO 75 70 CONTINUE IF((I+1 .NE. CNTRL) .AND. (I+1 .LT. LEVL) & .AND. (I+1 .NE. BASE) ) GOTO 80 IF(I+1 .GE. ASET) GOTO 80 IF(CODE .NE. COLON) GOTO 90 C C SAVE THE SPECIAL CHARCTER C 75 CONTINUE LGLOB = LGLOB + 1 CALL SPUT(IGLOB,LGLOB,CHAR) CALL GCHAR C C PUT THE RESERVE WORD NUMBER IN RESNO C 80 CONTINUE RESNO = I+1 TYPE = RSRV 90 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ÊF������ÿÿ����� ���� ÿý�K�T ���������ÿ��92069-18031 2026� S C0122 �&PINTG &PINTG � � � � � � � � � � � � � �H0101 ð�����þúFTN SUBROUTINE PINTG(IGLBZ),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18031 C RELOC: 92069-16015 C C C****************************************************************: C C C C PROCESS INTEGERS FOR GGLOB C C ABSTRACT: C C PINTG CONVERTS ASCII NUMBERS INTO BINARY. IT GATHERS UP C NUMBERS, THEN DECIDES WHETHER THE NUMBER SHOULD BE CONVERTED C TO A DOUBLE WORD INTEGER OR A SINGLE WORD INTEGER. C C C CALLING SEQUENCE: C C CALL PINTG C C PINTG PUTS THE CHARACTERS INTO IGLOB C C ON EXIT: C C IGLOB = BINARY INTEGER C LGLOB = SIZE OF INTEGER IN IGLOB, EITHER 1, OR 2 C TYPE = INTEGER C C C C C C C INTEGER N(2) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLEÍ������þú OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,Ά������þúLST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCBÕ�����B(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C SET TYPE TO INTEGER C TYPE = INTGR C C PICK UP ALL THE INTEGERS C 10 CONTINUE IF ((LGLOB .GT. IGLBZ) .OR. (CODE .NE. ICODE) ) GOTO 20 LGLOB = LGLOB + 1 CALL SPUT(IGLOB,LGLOB,CHAR) CALL GCHAR GOTO 10 C C CONVERT THE INTEGER C 20 CONTINUE CALL DCATI(IGLOB,1,LGLOB,N) IF(N(1) .EQ. 0) GOTO 30 IGLOB(1) = N(1) IGLOB(2) = N(2) LGLOB = 2 GOTO 40 30 CONTINUE IGLOB = N(2) LGLOB = 1 40 CONTINUE RETURN END ��������������������������¨]������ÿÿ����� ���� ÿý�L�U ���������ÿ��92069-18032 2026� S C0122 �&SCAN &SCAN � � � � � � � � � � � � � �H0101 Ï°�����þúFTN SUBROUTINE SCAN(ITYP),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18032 C RELOC: 92069-16015 C C C****************************************************************: C C C C C C C SCAN PROCESSOR C C C C C ABSTRACT: C C SCAN SKIPS ALL INPUT UNTIL THE REQUESTED "TYPE" C IS RETURNED FROM GGLOB, OR UNTIL A C "END." COMMAND OR A SEMICOLN IS DISCOVERED. C WHEN THE REQUESTED TYPE IS FOUND, THAT RESNO C IS SKIPPED, AND THE INPUT STREAM IS POSITIONED PAST IT. C C CALLING SEQUENCE: C C CALL SCAN(ITYP) C C WHERE: C C ITYP C IS A LEGAL TYPE NUMBER. SEE "GGLOB" FOR THE LIST C OF LEGAL TYPES AND THEIR MEANINGS C C ON EXIT: C C IF AN "END." COMMAND IS FOUND, SCAN TERMINATES DBDS !!!! C OTHERWISE, SCAN STOPS ON A SEMICOLN OR THE REQUESTED TYPE. C C IF A SEMICOLN WAS FOUND BEFORE THE REQUESTED TYPE, C SCAN STOPS ON THE SEMICOLN, OTHERWISE SCAN STOPS ONE CALL C TO "GGLOB" PAST THE REQUESTED TYPE. C C SCAN IS USED TO FIND THE END OF A COMMAND LINE, IE. TO SEARCH C FOR A SEMICOLN, OR SCAN IS USED TO FIND THE NEXT COMMAND C SUCH AS "ITEMS:", OR "SETS:". C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, “¥������þú 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSW­������þúETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C ë����� BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C C 10 CONTINUE IF(TYPE .EQ. ITYP) GOTO 20 IF(TYPE .EQ. SEMI) GOTO 30 IF(RESNO .EQ. END) CALL ERXIT(UEND) CALL GGLOB GOTO 10 C C SCAN PAST THE HALT CHARACTER C 20 CONTINUE CALL GGLOB 30 CONTINUE RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WT������ÿÿ����� ���� ÿý�M�V ���������ÿ��92069-18033 2026� S C0122 �&ERXIT &ERXIT � � � � � � � � � � � � � �H0101 ú�����þúFTN SUBROUTINE ERXIT(N),92069-16015 REV.2026 800124 C 2/1 (QA-14) ADDED WRITTING OF EOF TO LIST DEVICE C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18033 C RELOC: XXXXX-XXXXX C C C****************************************************************: C C C ERROR EXIT ROUTINE C C ABSTRACT: C ERXIT OPTIONALLY WRITES A MESSAGE TO THE LOG, THEN C WRITES A GOOD BYE MESSAGE AND RELEASES THE INPUT AND C OUTPUT FILES (OR DEVICES). C C ERXIT THEN TERMINATES THE DATA BASE DEFINITION PROGRAM. THERE C IS NO RETURN FROM ERXIT!!!!! C C CALLING SEQUENCE: C C CALL ERXIT(N) C C WHERE: C C N C IS THE INDEX INTO THE ERROR TABLE. THESE CONSTANTS C ARE SET UP IN A COMMON BLOCK. SEE "DATA" FOR MORE C DETAILS. C C C LOGICAL IFTTY C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DB$<������þúITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOTç0������þú, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR Û����� COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB EXTERNAL IFTTY C C C IF (N .EQ. 0) GOTO 10 CALL EMESS(N) C C OUTPUT "END DATA BASE DEFINITION" C 10 CONTINUE CALL OUTPT(ABORT) CALL ECLOS(IDCB) IF(LIST .LT.0) GOTO 20 C C WRITE EOF TO LIST DEVICE C CALL EXEC(3,LIST+100B) GOTO 30 C C CLOSE LIST FILE C 20 CALL ECLOS(LDCB) C C UNLOCK ALL LU'S C 30 CONTINUE CALL LURQ(100000B,IDMY,IDMY) STOP END ¼£������ÿÿ����� ���� ÿý�N�W ���������ÿ��92069-18034 2026� S C0122 �&EMESS &EMESS � � � � � � � � � � � � � �H0101 ë�����þúFTN SUBROUTINE EMESS(N),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18034 C RELOC: 92069-16015 C C C****************************************************************: C C C C ERROR REPORTING ROUTINE C EMESS C C C ABSTRACT: C C EMESS LISTS OUT THE LINE IN ERROR WHEN THE LISTING OPTION IS C TURNED OFF. IT THEN OUTPUTS A POINTER TO THE CURRENT LOCATION C IN THE LINE. THIS WILL USUALLY POINT OUT THE PROBLEM AREA. C THEN EMESS OUTPUTS THE REQUESTED ERROR MESSAGE, INCREMENTS THE C ERROR COUNT AND TERMINATES IF THE ERROR LIMIT HAS BEEN REACHED. C OTHERWISE IT RETURNS TO THE CALLING PROGRAM. C C CALLING SEQUENCE: C C CALL EMESS(N) C C WHERE: C C N C IS AN INDEX INTO THE ERROR MESSAGE TABLE. CONSTANTS C FOR THESE ERROR MESSAGES ARE SET UP IN A COMMON BLOCK. C ALL CALLING ROUTINES SHOULD USE THE CORRECT CONSTANT. C C C C C INTEGER HAT INTEGER MESS(40) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX,ÊI������þú 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ðQ������þúROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C 'â����� VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA HAT/136B/ C C C IF LIST TURNED OFF THEN PRINT RECORD C NDX = NFONX(LST) IF (INFO(NDX) .EQ. NFO(LST)) GOTO 20 CALL OUTLN(CARD,CRDLM) C C OUTPUT A POINTER TO THE ERROR C 20 CONTINUE DO 30 I=1,CRDLM MESS(I) = BLANK 30 CONTINUE CALL SPUT(MESS,CRDPR,HAT) CALL OUTLN(MESS,CRDLM) C C GET MESSAGE FROM TABLE C 40 CONTINUE CALL OUTPT(N) C C INCREASE NUMBER OF ERRORS C ERROR = ERROR +1 NDX = NFONX(ERR) IF(ERROR .LT. INFO(NDX) ) RETURN C C OUTPUT "TOO MANY ERRORS" C CALL OUTPT(MXERR) CALL ERXIT(0) END ����������������������������������������������������������������������������������������������������������������������������µÙ������ÿÿ����� ���� ÿý�O�X ���������ÿ��92069-18035 2026� S C0122 �&GMESS &GMESS � � � � � � � � � � � � � �H0101 í�����þúASMB NAM GMESS,7 92069-16015 REV.2026 800122 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18035 * RELOC: 92069-16015 * * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * * *****************************************************************: * ************************************************************ * GMESS RETURNS AN ERROR MESSAGE * * THE ERROR MESSAGES ARE IN A ARRAY, EACH ENTRY REQUIRES 20 WORDS. * ALL THE ERROR NUMBERS ARE IN BLOCK COMMON IN ORDER TO FACILITATE * CHANGES. ALL ROUTINES USE THE MNEMONIC CONSTANTS. * * CALLING SEQUENCE: * * CALL GMESS(N,MESS,ISZ) * * N * IS THE INDEX INTO THE MESSAGE TABLE. NOTE THESE CONSTANTS ARE * SET UP IN A BLOCK COMMON AREA. THE MNEMONIC FOR EACH MESSAGE * IS DOCUMENTED DIRECTLY BEFORE THE MESSAGE. * * MESS * IS A BUFFER OF 20 WORDS. THE ERROR MESSAGE WILL BE RETURNED * IN THIS BUFFER * * ISZ * IS AN INTEGER WHICH WILL CONTAIN THE SIZE OF THE MESSAGE IN WORDS. * CURRENTLY THIS NUMBER IS ALWAYS 20. * * ************************************************************ * * GMESS SUBROUTINE * *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * * * CONSTANTS IN COMMON * * * COM CARD(36),CHAR,CODE,CPACK(100),CRDPR COM DSEC,DCRN COM ENTL,ERROR COM NMFLG COM FWAM COM GGERR COM ICNT,IDCB(144),INDX COM INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COM KPACK(50) COM LDCB(144),LGLOB,LIST,LWAM COM MEDIA COM NPACK(50),NSETS(50) COM OVRHD COM PTHTB(32) WÔ������þúCOM RDEF(64),RESNO,RFILE(3),RINDX COM SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COM TYPE,PRGFG * *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * CHANGED TO INCREASE SIZE OF PTHTB ENT GMESS EXT .ENTR SUP PRESS PARAM BSS 1 MESS BSS 1 ISZ BSS 1 GMESS NOP JSB .ENTR TRANSFER PARAMETERS DEF PARAM LDA T20 STA ISZ,I CCA ADA PARAM,I ENDX=20*(N-1) MPY T20 ADA EADDR STA ENDX CLA STA J J=0 OVER LDA MESS MESS(J)=ERTAB(ENDX) ADA J LDB ENDX,I STB 0,I LDA J ADA NEG19 SSA,RSS IF J<19,RETURN JMP GMESS,I ISZ J J=J+1 ISZ ENDX ENDX=ENDX+1 JMP OVER T20 DEC 20 NEG19 DEC -19 ENDX BSS 1 J BSS 1 EMESJ BSS 1 EADDR DEF ERTAB ERTAB EQU * * ILCTR ASC 20, ILLEGAL CONTROL OPTION. * ILCRN ASC 20, ILLEGAL CARTRIDGE NUMBER. * ILSEC ASC 20, ILLEGAL SECURITY CODE. * XBEGN ASC 20, 'BEGIN DATA BASE:' EXPECTED. * XLEV ASC 20, 'LEVELS:' EXPECTED. * DUPIT ASC 20, DUPLICATE ITEM NAME. * ITLIM ASC 20, TOO MANY DATA ITEMS. * ILITP ASC 20, BAD TYPE DESIGNATOR. * FLDER ASC 20, ITEM TOO LONG. * ILXTP ASC 20, TOTAL ITEM LENGTH NOT INTEGRAL WORDS. * ILWR ASC 20, BAD WRITE LEVEL. * ILTRM ASC 20, BAD TERMINATOR - ';' EXPECTED. * NAMX ASC 20, 'NAME:' EXPECTED. * DUPST ASC 20, SET NAME ALREADY USED. * STLIM ASC 20, TOO MANY DATA SETS. * ENTYX ASC 20, 'ENTRY:' EXPECTED. * NOITM ASC 20, UNDEFINED ITEM REFERENCED. * BDSET ASC 20, UNDEFINED SET REFERE§È������þúNCED. * BDKEY ASC 20, KEY ITEMS NOT OF SAME LENGTH, OR TYPE. * DUPHS ASC 20, TOO MANY PATHS. * NOPTH ASC 20, MASTER DATA SET LACKS KEY ITEM. * AERR ASC 20, AUTO-MASTER MUST HAVE KEY ITEM ONLY. * RCLIM ASC 20, ENTRY TOO BIG. * CAPX ASC 20, 'CAPACITY:' EXPECTED. * ILCAP ASC 20, BAD CAPACITY COUNT. * EMPTY ASC 20, DATA BASE HAS NO DATA SETS. * MXERR ASC 20, MAX ERRORS-SCHEMA PROCESSING TERMINATED. * EOF ASC 20, END OF FILE ENCOUNTERED. * NOSEG ASC 20, MISSING PROGRAM SEGMENTS. * NOMEM ASC 20, NOT ENOUGH MEMORY TO CREATE ROOT FILE. * DUPLV ASC 20, DUPLICATE LEVEL WORD. * ILNAM ASC 20, ILLEGAL NAME. * ILNMR ASC 20, INCOMPLETE NAME. * LVDEF ASC 20, LEVEL NUMBER ALREADY DEFINED. * ILSEP ASC 20, ILLEGAL SEPARATOR. * ILRD ASC 20, BAD READ LEVEL. * ILRNG ASC 20, LEVEL OUT OF RANGE. * SETX ASC 20, 'SETS:' EXPECTED. * IGNSC ASC 20, WARNING - SECURITY CODE IGNORED. * INMX ASC 20, ITEM NAME EXPECTED. * PTDUP ASC 20, PATH TO MASTER ALREADY DEFINED. * DBKEY ASC 20, AUTO-MASTER NEEDS MORE WRITE CAPABILITY * ENDX ASC 20, 'END.' EXPECTED. * PDEFC ASC 20, ALL PATHS TO MASTER ARE NOT DEFINED. * SIMPT ASC 20, PATH ITEM CAN NOT BE AN ARRAY. * BDCNT ASC 20, AUTO-MASTERS MUST HAVE AT LEAST 1 PATH. * RTERR ASC 20, ROOT FILE NOT CREATED - SCHEMA ERRORS. * GOODS ASC 20, DATA SET FILES CREATED. * GOODR ASC 20, ROïb������þúOT FILE CREATED. * BADS ASC 20, I/O ERROR - DATA SETS NOT CREATED. * BADR ASC 20, ROOT FILE I/O ERROR, DATA SETS PURGED. * ABORT ASC 20, END DATA BASE DEFINITION * OPNER ASC 20, CAN NOT OPEN SCHEMA FILE. * XCNTR ASC 20, '$CONTROL:' EXPECTED. * ILLVN ASC 20, ILLEGAL LEVEL WORD. * NOPTH ASC 20, MASTER MUST HAVE A PATH. * SRCH2 ASC 20, SEARCH ITEM ALREADY DEFINED. * UEND ASC 20, UNEXPECTED 'END.' * XITM ASC 20, 'ITEMS:' EXPECTED. * ELERR ASC 20, TOO MANY ELEMENTS. * ROTER ASC 20, ROOT FILE OVERHEAD RECORD ERROR. * UNITM ASC 20, THE FOLLOWING ITEM(S) ARE UNUSED. * IOAIN ASC 20, I/O WAS ABORTED ON INPUT * IOAOT ASC 20, I/O WAS ABORTED ON OUTPUT * UNRDL ASC 20, READ LEVEL WORD FOR LEVEL NOT DEFINED * UNWRL ASC 20, WRITE LEVEL WORD FOR LEVEL NOT DEFINED * IOERR * BE CAREFUL TO CHANGE ROOT IF THIS EVER CHANGES ASC 20, I/O ERROR XXXXXX, ON FILE XXXXXX. * ILOPT ASC 20, ILLEGAL OPTION. * ILLSC ASC 20, ILLEGAL SECURITY CODE. * MORIT ASC 20, DATA SET MUST HAVE AN ITEM. * ILPTH ASC 20, NON-NUMERIC PATH COUNT. * DEFIT ASC 20, AT LEAST 1 ITEM MUST BE DEFINED. * ILSRT ASC 20, ILLEGAL SORT DESIGNATOR * SIMPS ASC 20, SORT ITEM MUST BE SIMPLE * UNDST ASC 20, SORT ITEM NOT DEFINED IN SET END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Î����������������������������������������ÿÿ����� ���� ÿý�P� Z ���������ÿ��92069-18036 2026� S C0122 �&OUTPT &OUTPT � � � � � � � � � � � � � �H0101 ( �����þúFTN SUBROUTINE OUTPT(N),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18036 C RELOC: 92069-16015 C C C****************************************************************: C C C ABSTRACT: C C OUTPT WRITES A MESSAGE TO THE LIST DEVICE. IT IS USUALLY USED C TO OUTPUT WARNINGS - THAT IS, ERRORS THAT DO NOT REQUIRE THE C THE ERROR COUNT TO BE INCREASED. C C C CALLING SEQUENCE: C C CALL OUTPT(N) C C WHERE N IS THE NUMBER OF AN ERROR MESSAGE IN GMESS C C C INTEGER MESS(20) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS œï������þúC C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), W"������þú C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),R Œ�����INDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C OUTPUT ROUTINE C C CALL GMESS(N,MESS,ISZ) CALL OUTLN(MESS,ISZ) RETURN END ������������������������������������������������������������������������������������������������������������������|M������ÿÿ����� ���� ÿý�Q�Z ���������ÿ��92069-18037 2026� S C0122 �&OUTLN � � � � � � � � � � � � � �H0101 ™�����þúFTN SUBROUTINE OUTLN(IBUF,ILEN),92069-16015 REV.2026 800124 C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18037 C RELOC: 92069-16015 C C C****************************************************************: C C ABSTRACT: C C OUTLN IS A GENERALIZED OUTPUT ROUTINE. IT OUTPUTS A RECORD C TO A DEVICE OR A FILE. WHEN THE VARIABLE LIST IS SET TO C A NEGITIVE ONE, THE RECORD IS WRITEN TO THE FILE DESIGNATED C IN THE LIST DCB (LDCB). OTHERWISE, THE RECORD IS LISTED C TO THE DEVICE SPECIFIED IN LIST. C C OUTLN IS USED WHENEVER RECORDS ARE TO BE WRITTEN TO THE C LISTING PARAMETER. C C CALLING SEQUENCE: C C CALL OUTLN(IBUF,ILEN) C C WHERE: C C IBUF IS THE BUFFER CONTAINING THE MESSAGE TO BE WRITTEN C ILEN IS THE LENGTH OF THE BUFFER IN WORDS C C C C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP,.Ü������þú 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, †Ú������þú 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR "ñ�����COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C OUT PUT OF A LINE SUBROUTINE C C IF(LIST .EQ. -1) GOTO 20 CALL EXEC(100002B,LIST+200B,IBUF,ILEN) GOTO 50 10 GOTO 40 C C LIST IS A FILE C 20 CONTINUE CALL EWRIT(LDCB,IERR,IBUF,ILEN,DUMY) IF(IERR .LT. 0) GOTO 50 40 CONTINUE RETURN C C I/O ABORTED ERROR RECOVERY C 50 CONTINUE LIST = 1 CALL ERXIT(IOAOT) END ��������������������������������������������������������ö·������ÿÿ����� ���� ÿý�R�[ ���������ÿ��92069-18038 2026� S C0122 �&ISRCH � � � � � � � � � � � � � �H0101 ƒ‹�����þúFTN SUBROUTINE ISRCH(LAST,INUM),92069-16015 REV.2026 800124 INTEGER LAST C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18038 C RELOC: 92069-16015 C C C****************************************************************: C C*********************************************************************** C ISRCH COMPARES EACH SUCCESSIVE ITEM IN THE ITEM TABLE WITH THE C CONTENTS OF IGLOB. THE ITEM LIST IS SEARCHED THROUGH ITEM C NUMBER LAST. IF A MATCH IS FOUND, INUM IS SET TO THE ITEM C NUMBER OF THE MATCHING ITEM. IF NO MATCH IS FOUND, INUM C IS SET TO 0. C CALLING SEQUENCE C CALL ISRCH(LAST,INUM) C WHERE LAST IS THE ITEM # OF THE LAST ITEM TO BE SEARCHED C INUM IS SET TO THE ITEM # OF THE MATCHING ITEM OR 0 C*********************************************************************** C C ISRCH SUBROUTINE C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,ßj������þúDBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DEÝ������þúTAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COy?�����MMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C INUM=0 IF(LAST .EQ. 0) GOTO 40 C C SEARCH THE ITEM TABLE FROM THE BEGINING UPTO C BUT NOT INCLUDING THE CURRENT ITEM TABLE ENTRY C BECAUSE IT IS EMPTY AT THIS POINT C DO 30 ICTR = 0,LAST-1 IPTR = ICTR*ITMSZ+ITMTB DO 20 J=1,3 IF (ROOTA(IPTR) .NE. IGLOB(J)) GO TO 30 IPTR=IPTR+2 20 CONTINUE INUM = ICTR + 1 GOTO 40 30 CONTINUE 40 CONTINUE RETURN END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ñ!������ÿÿ����� ���� ÿý�S�\ ���������ÿ��92069-18039 2026� S C0122 �&ELEMT &ELEMT � � � � � � � � � � � � � �H0101 å�����þúFTN SUBROUTINE ELEMT(ECNT,IINDX,IERR),92069-16015 REV.2026 800124 INTEGER ECNT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18039 C RELOC: 92069-16015 C C C****************************************************************: C C C C ABSTRACT: C C THIS SUBROUTINE PROCESSES THE ELEMENT COUNT DEFINITION IN AN C "ITEMS:" COMMAND. WHEN NO ELEMENT COUNT IS GIVEN, THE COUNT IS C DEFAULTED TO 1. C C THE SUBROUTINE WILL DO ITS OWN CALL TO THE SUBROUTINE "GGLOB", AND C WILL PLACE THE ELEMENT COUNT INTO THE ITEM TABLE, AFTER THE COUNT C HAS BE CALCULATED. C C C CALLING SEQUENCE: C C CALL ELEMT(ECNT,IINDX,IERR) C C WHERE: C C ECNT C IS RETURNED BY THE SUBROUTINE. IT WILL CONTAIN THE NUMBER OF C ELEMENTS BEING DEFINED. C C IINDX C IS THE INDEX INTO THE ITEM TABLE FOR THE ITEM BEING PROCESSED. C C IERR C IS RETURNED BY THE SUBROUTINE TO INDICATE ERRORS. C 0 INDICATES NO ERROR C -1 INDICATES ERRORS C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMA ‡������þúX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGEö]������þúR ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C Yâ����� VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C PROCESS THE ELEMENT COUNT C ECNT = 1 C C SEE IF THERE IS AN ELEMENT COUNT C IF THERE IS NOT THEN DEFAULT IT TO 1 C CALL GGLOB IF(TYPE .NE. INTGR) GOTO 20 C IS NUMBER GREATER THAN MAXIMUM NUMBER OF ELEMENTS ALLOWED? IF ((IGLOB .GT. MXELE) .OR. (IGLOB .LT. 0)) GOTO 7010 ECNT = IGLOB C C GET THE ITEM TYPE C CALL GGLOB C C PUT ELEMENT COUNT IN ITEM TABLE C 20 CONTINUE CALL SROOT(IINDX+ITECT,ECNT) C C RETURN NO ERROR C IERR = 0 40 CONTINUE RETURN C C C C ERROR PROCESSORS C C C C OUTPUT "TOO MANY ELEMENTS" C 7010 CALL EMESS(ELERR) IERR = -1 C C GET THE ITEM TYPE C CALL GGLOB GOTO 40 END ����������������������Td������ÿÿ����� ���� ÿý�T�] ���������ÿ��92069-18040 2026� S C0122 �&ITMT &ITMT � � � � � � � � � � � � � �H0101 ûµ�����þúFTN SUBROUTINE ITMT(ECNT,IINDX,IERR),92069-16015 REV.2026 800124 INTEGER ECNT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18040 C RELOC: 92069-16015 C C C****************************************************************: C C C C ABSTRACT: C C THIS SUBROUTINE PROCESSES THE TYPE PARAMETER OF THE "ITEMS:" COMMAND. C THE ITEM TYPE AND THE ITEM LENGTH IS PUT INTO THE ITEM TABLE FOR THE C SPECIFIED ITEM. THE SUBROUTINE INSURES THE CALLER THAT THE LENGTH C OF THE ENTIRE ITEM FIELD IS NOT LARGER THAN THE MAXIMUM SIZE. C C THE SYNTAX OF THE "ITEMS:" COMMAND IS AS FOLLOWS: C C ITEMS: C ITEM NAME, [ELEMENT COUNT] ITEM TYPE [(READ LEVEL,WRITE LEVEL)] ; C C C WHERE: C C ITEM TYPE C IS ONE OF THE FOLLOWING: C C I1 - SINGLE WORD INTEGER C R2 - SINGLE PRECISION REAL C XN - ASCII STRING C N IS THE NUMBER OF CHARACTERS IN THE STRING C N * ELEMENT COUNT MUST BE EVEN. C C C C C CALLING SEQUENCE: C C CALL ITMT(ECNT,IINDX,IERR) C C WHERE: C C ECNT C IS THE ELEMENT COUNT RETURNED FROM THE SUBROUTINE ELEMT C C IINDX C IS THE INDEX INTO THE ITEM TABLE C C IERR C IS RETURNED BY THE SUBROUTINE. IT INDICATES ERRORS. C 0 INDICATES NO ERROR C C -1 INDICATES AN ERROR. THE ERROR MESSAGE IS WRITTEN C TO THE LIST DEVICE BEFORE THIS SUBROUTINE RETURNS C TO THE CALLER. C C C C INTEGER R,II,X C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C z¥������þúC C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODEV������þú,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 0—������þú 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA R/000122B/ DATA II/00111B/ DATA X/00130B/ C C SET ERROR RETURN TO INDICATE AN ERROR C IERR = -1 C C VERIFY THAT A TYPE SPECIFICATION WAS GIVEN C IF (TYPE .NE. NAM ) GOTO 7010 C C PUT FIRST CHARACTER OF TYPE SPEC IN ITEM TABLE C CALL SGET(IGLOB,1,ITYPE) CALL RSPUT(IINDX+ITTYP,ITYPE) C C C CONVERT IGLOB TO AN INTEGER C CALL CATI(IGLOB,2,2*LGLOB,NUM,IIERR) IF(IIERR .LT.0) GOTO 7010 C C LENGTH OF ITEM = LENGTH OF FIELD * # OF ELEMENTS C I = NUM*ECNT C C VERIFY TYPE SPECIFICATION C IF ( (ITYPE .EQ. R) .AND. (NUM .EQ. 2) ) GOTO 80 IF ( (ITYPE .EQ. II) .AND. (NUM .EQ. 1) ) GOTO 80 IF ((IŠ¶�����TYPE .NE. X) .OR. (NUM .GT.MXSTR) )GOTO 7010 C C SET I2 TO INDICATE ODD OR EVEN C I2 = 0 IMPLIES EVEN C I2 = 1 IMPLIES ODD C I2 = I - (I/2 * 2) C C SET I TO WORD COUNT C I = I/2 IF((I2 .NE. 0) .OR. (I .LT. 1) ) GOTO 7020 IF (I .GT. MAXRC-1 ) GOTO 7010 C C PUT THE ITEM LENGTH IN THE ITEM TABLE C 80 CONTINUE CALL SROOT(IINDX+ITLNG,I) IERR = 0 90 CONTINUE RETURN C C C C ERROR PROCESSORS C C C OUTPUT "BAD TYPE DESIGNATOR" C 7010 CALL EMESS(ILITP) GOTO 90 C C OUTPUT "TOTAL ITEM LENGTH NOT INTEGRAL WORDS" C 7020 CALL EMESS(ILXTP) GOTO 90 END ��������������������������������������������������������������������������������������������������������������6‡������ÿÿ����� ���� ÿý�U� _ ���������ÿ��92069-18041 2026� S C0122 �&RDWRL &RDWRL � � � � � � � � � � � � � �H0101 ú�����þúFTN SUBROUTINE RDWRL(IINDX,IERR),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18041 C RELOC: 92069-16015 C C C****************************************************************: C C C SUBROUTINE RDWRL C ABSTRACT: C C THIS SUBROUTINE PROCESSED THE OPTIONAL READ/WRITE LEVEL OF THE C "ITEMS:" COMMAND. THE READ LEVEL IS DEFAULTED TO 0 AND THE WRITE C LEVEL IS DEFAULTED TO 15 WHEN THEY ARE NOT SPECIFIED. THE READ C LEVEL MUST ALWAYS BE LESS THAN OR EQUAL TO THE WRITE LEVEL. THIS C SUBROUTINE CHECKS THAT A WORD HAS BEEN SPECIFIED FOR THE LEVELS C BEING USED AS THE READ/WRITE LEVELS. C C CALLING SEQUENCE: C C CALL RDWRL(INDX,IERR) C C WHERE: C C IINDX C IS THE INDEX INTO THE ITEM TABLE FOR THE ITEM BEING PROCESSED. C C IERR C IS RETURNED BY RDWRL AND INDICATES ERROR CONDITIONS. C C 0 INDICATES NO ERROR C C -1 INDICATES ERROR. WHEN AN ERROR IS DETECTED THE C ERROR MESSAGE IS WRITTEN TO THE LIST DEVICE. C C C INTEGER RLEV INTEGER WLEV C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,V›������þúNFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE€×������þú INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, q������þú 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C SET FLAG TO INDICATE NO ERRORS C IERR = 0 C C PUT DEFAULT READ/ WRITE LEVELS IN TEMP WORD C ILEV = 17B CALL GGLOB C C IS A READ/WRITE LEVEL SPECIFIED? C IF NOT THEN DEFAULT TO READ TO 0 AND WRITE TO 15 C IF (TYPE .EQ. SEMI) GOTO 30 C YES IF(TYPE .NE. LPARN) GOTO 7050 C C PROCESS READ LEVEL C CALL GGLOB IF (TYPE .NE. INTGR ) GOTO 7010 RLEV = IGLOB IF ( (RLEV .LT. 1) .OR. (RLEV .GT.15) ) GOTO 7020 C C VERIFY LEVEL WORD EXIST FOR LEVEL C CALL RSGET(DBLMD,IFLAG) CALL RSGET( (RLEV-1)*6 + DBLVL,ICHAR) IF(ICHAR .EQ. 40B .AND. IFLAG .EQ. 0) GOTO 7070 C C PUT READ LEVEL IN TEMP WORD BITS 3-5 C ILEV = RLEV*2**4 C C VERIFY COMMA C 20 CONTINUE CALL GGLOB IF (TYPE .NE. COMMA) GOTO 7050 C C PROCESS WRITE LEVEL C CALL GGLOB IF(TYPE .NE. INTGR) GOTO 7030 IF( (IGLOB .LT. RLEV) .OR. (IGLOB .GT. 15) ) GOTO 7040 C C VERIFY WRITE LEVEL WORD IS DECLARED C CALL RSGET(DBLMD,IFLAG) CALL RSGET( (IGLOB-1)*6+DBLVL,ICHAR) IF(ICHAR .EQ. 40B .AND. IFLAG .EQ. 0) GOTO 7,&�����080 ILEV = ILEV + IGLOB C C VERIFY RIGHT PAREN C 25 CONTINUE CALL GGLOB IF (TYPE .NE. RPARN) GOTO 7050 C C VERIFY SEMICOLON C CALL GGLOB IF (TYPE .NE. SEMI) GOTO 7060 30 CONTINUE CALL RSPUT(IINDX+ITINF,ILEV) 40 CONTINUE RETURN C C C C ERROR PROCESSORS C C C OUTPUT "BAD READ LEVEL" C 7010 CALL EMESS(ILRD) GOTO 7065 C C OUTPUT "LEVEL OUT OF RANGE" C 7020 CALL EMESS(ILRNG) ILEV = 20B IERR = -1 GOTO 20 C C OUTPUT "BAD WRITE LEVEL" C 7030 CALL EMESS(ILWR) GOTO 7065 C C OUTPUT "LEVEL OUT OF RANGE" C 7040 CALL EMESS(ILRNG) 7045 ILEV = ILEV+15 IERR = -1 GOTO 25 C C OUTPUT "ILLEGAL SEPARATOR" C 7050 CALL EMESS(ILSEP) GOTO 7065 C C OUTPUT "ILLEGAL TERMINATOR" C 7060 CALL EMESS(ILTRM) C C SET FATAL ERROR OCCURED C 7065 IERR = -1 GOTO 40 C C OUTPUT READ LEVEL WORD FOR LEVEL IS NOT DEFINED C 7070 CALL EMESS(UNRDL) GOTO 7065 C C OUTPUT WRITE LEVEL WORD FOR LEVEL IS NOT DEFINED C 7080 CONTINUE CALL EMESS(UNWRL) GOTO 7045 END ��������������������������������������������������������������������������������������������������������������������‹²������ÿÿ����� ���� ÿý�V� ` ���������ÿ��92069-18042 2026� S C0122 �&SSORT &SSORT � � � � � � � � � � � � � �H0101 # �����þúFTN SUBROUTINE SSORT(INUM,ITBL,ISIZE,IBASE),92069-16015 REV.2026 800124 INTEGER ITBL(255) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18042 C RELOC: 92069-16015 C C C****************************************************************: C C C C ABSTRACT: C C THIS SUBROUTINE SORTS A TABLE WHICH CONTAINS POINTERS C TO EITHER SET TABLES OR ITEM TABLES, WHILE MAKING AN C ENTRY TO IT. C C SSORT STARTS AT THE BOTTOM OF THE SORT TABLE MOVING EACH ENTRY DOWN C ONE SLOT UNTIL THE ENTRY WHICH WAS PASSED TO SSORT FITS IN SORTED C ORDER. THE ENTRY PASSED TO SSORT IS AN INDEX INTO THE ITEM OR SET C TABLE. SSORT EXPECTS THE NAME OF THE ITEM OR SET TO BE THE FIRST C 6 CHARACTERS OF THE ENTRY IN THE ITEM TABLE OR SET TABLE. C C C CALLING SEQUENCE: C C CALL SSORT(INUM,ITBLE,ISIZE,IBASE) C C WHERE: C C INUM C IS THE INDEX INTO THE ITEM OR SET TABLES C C ITBL C IS THE ITEM OR SET SORT TABLE. THE SORT TABLE IS C 1 WORD PER ENTRY, WHERE EACH ENTRY IS A INDEX INTO C AN ENTRY IN THE ITEM OR SET TABLE. INUM * ISIZE + IBASE C IS THE ADDRESS OF THE ENTRY IN THE ITEM OR SET TABLE. C C ISIZE C IS THE SIZE OF AN ENTRY IN THE ITEM TABLE OR SET TABLE. C C IBASE C IS THE BASE ADDRESS FOR THE ITEM TABLES OR THE SET TABLES. C C C ON EXIT: C C ITBL IS IN SORTED ORDER. C C C C LOCAL VARIABLES: C C TNMX - ADDRESS OF THE NAME FOR THE CURRENT ITEM OR SET C BEING EXAMINED C NMX - ADDRESS OF ¹¬������þúTHE NAME FOR THE ITEM OR SET C THAT IS BEING SORTED. C C C C C C INTEGER TNMX C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 U³]������þúNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVRECez������þú C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C IF(INUM .EQ. 0) GOTO 20 NMX = INUM*ISIZE + IBASE C C MOVE ALL ENTRIES DOWN ONE AND SEE IF THE EMPTY SLOT C JUST CREATED IS THE CORRECT SLOT FOR THE NEW ENTRY C DO 20 I=INUM,1,-1 TNMX = (ITBL(I)-1)*ISIZE+IBASE C C C DO 10 I2=0,4,2 IF(ROOTA(TNMX + I2) - ROOTA(NMX + I2) ) 30,10,15 10 CONTINUE C C MOVE THE CURRENT ENTRY DOWN ONE SLOT C AND GET ANOTHER ENTRY C 15 CONTINUE ITBL(I+1) = ITBL(I) 20 CONTINUE C C THE NEW ENTRY IS THE SMALLEST NA¯ô�����ME IN THE TABLE C ITBL(1) = INUM+1 GOTO 50 C C THE NEW ENTRY GOES IN THE NEXT SLOT C 30 CONTINUE ITBL(I+1) = INUM + 1 C C RETURN TO CALLER C 50 CONTINUE RETURN END ��������������������������������������������������������׊������ÿÿ����� ���� ÿý�W� a ���������ÿ��92069-18043 2026� S C0122 �&GITEM &GITEM � � � � � � � � � � � � � �H0101 þå�����þúFTN SUBROUTINE GITEM(IINDX,INUM,IERR) & ,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18043 C RELOC: 92069-16015 C C C****************************************************************: C C C GITEM SUBROUTINE C C C ABSTRACT: C THIS SUBROUTINE PROCESSES THE ITEM NAME IN AN "ENTRY:" C COMMAND. C C INPUT PARAMETERS: C IERR IS SET IN THE CALLING PROGRAM C C OUTPUT PARAMETERS: C INDX IS THE INDEX INTO THE ROOT TABLE FOR THE ITEM TABLE C INUM IS THE ITEM NUMBER OF THE SPECIFIED ITEM C IERR IS AN ERROR INDICATOR C -1 IMPLIES ERRORS C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITE€á������þúCT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR‹j������þú, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) î‡�����COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C VERIFY THIS IS A NAME C IF (TYPE .NE. NAM) GOTO 7030 C C FIND ITEM NAME IN ROOT C CALL ISRCH (ROOTA(DBICT),INUM) IF(INUM .EQ.0) GOTO 7010 C C CALCULATE INDEX INTO ITEM TABLE FOR ITEM ENTRY C IINDX = (INUM-1) * ITMSZ + ROOTA(DBITP) * 2 L = ROOTA(IINDX+ITLNG) C C VERIFY THAT MAXIMUM RECORD LENGTH IS NOT EXCEEDED C IF(ENTL+MEDIA+L .GT. MAXRC) GOTO 7020 20 CONTINUE RETURN C C C ERROR PROCESSORS C C C OUTPUT "UNDEFINED ITEM NAME" 7010 CALL EMESS(NOITM) GOTO 7035 C C OUTPUT "ENTRY TOO BIG." C 7020 CALL EMESS(RCLIM) GOTO 7035 C C OUTPUT "ITEM NAME EXPECTED" C 7030 CALL EMESS(INMX) 7035 CONTINUE IERR = -1 GOTO 20 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������þ×������ÿÿ����� ���� ÿý�X�a ���������ÿ��92069-18044 2026� S C0122 �&DPTH &DPTH � � � � � � � � � � � � � �H0101 ß¹�����þúFTN SUBROUTINE DPTH(INUM,IINDX,PTHCT,IERR),92069-16015 REV.2026 800421 INTEGER PTHCT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18044 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS AND MULTIPLE C LINKING FEATURES - CEJ C C C****************************************************************: C C SUBROUTINE DPTH C C C ABSTRACT: C DPTH PROCESSES THE PATH DEFINITION IN AN ENTRY: COMMAND C FOR DETAIL DATA SETS. C C INPUT: C INUM IS THE ITEM NUMBER FOR WHICH THIS PATH IS SPECIFIED C IINDX IS THE ITEM TABLE INDEX INTO ROOT FOR THE ABOVE C PTHCT IS THE CURRENT COUNT OF PATHS DEFINED C IERR IS THE ERROR INDICATOR FOR ALL THAT HAS HAPPENED C IN THE ENTRY PROCESSOR C 0 IMPLIES NO ERROR C -1 IMPLIES ERRORS C C OUTPUT: C IERR CONTAINS AN ERROR INDICATOR C 0 IMPLIES NO ERROR C -1 IMPLIES ERRORS C C INTEGER SNDX2,STYP,SNUM,HASH INTEGER WLEV,WLEV2 INTEGER STYP2 INTEGER PCNT,PTR C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, S„������þú 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C ^������þúC INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,U].������þúNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C C IS THERE ROOM FOR ANOTHER PATH? C IF (PTHCT .GE. PMAX) GOTO 7060 C C VERIFY SET NAME EXISTS AND IS A MASTER C CALL SSRCH(SCNT,SNUM,IGLOB) IF (SNUM .LE. 0) GOTO 7020 SNDX2 = (SNUM-1) * SETSZ + SETTB CALL RSGET(SNDX2+DSTYP,STYP2) C C VERIFY PATH SET IS A MASTER C IF (STYP2 .EQ. DETAIL) GOTO 7030 C C VERIFY ITEM'S SPECIFICATIONS MATCH THE MASTER'S HASH ITEM'S C CALL RSGET(SNDX2+DSCCT,HASH) HASH = (HASH-1) * ITMSZ + ITMTB C CALL RSGET(IINDX+ITTYP,ITYP) CALL RSGET(HASH+ITTYP,ITYP2) IF (ITYP2 .NE. ITYP) GOTO 7070 C IF (ROOTA(HASH + ITLNG) .NE. ROOTA(IINDX+ITLNG) ) GOTO 7070 C C VERIFY IF MASTER IS AN AUTOMATIC MASTER C THAT THIS ITEM'S WRITE LEVEL IS LESS THAN OR EQUAL TO C THE MASTER'S HASH ITEM'S WRITE LEVEL C IF (STYP2 .NE. AUTO) GOTO 30 CALL RSGET(HASH+ITINF,WLEV2) CALL RSGET(IINDX+ITINF,WLEV) IF( IAND(WLEV2,17B) .GT. IAND(WLEV,17B) ) GOTO 7050 C C GET INDEX INTO MASTER'S PATH TABLE C 30 CONTINUE PCNT = 0 PTR = ROOTA(SNDX2+DSITP)*2 IF(PTR .EQ. 0) GOTO 7060 C C SKIP THE RECORD DEFINITION TABLE C CALL RSGET(SNDX2+DÐ%�����SFCT,N) PTR = PTR + (N+1)/2 * 2 C CALL RSGET(SNDX2+DSPCT,N) IF(N .EQ. 0) GOTO 7060 C C FIND AN EMPTY SLOT IN PATH TABLE C DO 22 I = 1,N IF(ROOTA(PTR) .EQ. 0) GOTO 25 PTR = PTR+4 22 CONTINUE GOTO 7060 C C PUT ITEM & SET INTO MASTER'S PATH TABLE C 25 CONTINUE CALL RSPUT(PTR,INUM) CALL RSPUT(PTR+1,SCNT+1) C C PUT ITEM AND SET INTO DETAIL PATH TABLE C CALL SPUT(PTHTB,PTHCT*4+1,INUM) CALL SPUT(PTHTB,PTHCT*4+2,SNUM) C C INCREASE THE PATH COUNT C 40 CONTINUE RETURN C C C C ERROR PROCESSOR C C C C OUTPUT "UNDEFINED SET REFERENCE." C 7020 CALL EMESS(BDSET) GOTO 7055 C C OUTPUT "ILLEGAL TYPE DESIGNATOR." C 7030 CALL EMESS(ILITP) GOTO 7055 C C OUTPUT "AUTO-MASTER'S WRT LEV LESS THAN DETAIL." C 7050 CALL EMESS(DBKEY) 7055 IERR = -1 GOTO 40 C C OUTPUT "TOO MANY PATHS" C 7060 CALL EMESS(DUPHS) GOTO 7055 C C OUTPUT "KEY ITEMS NOT OF SAME LENGTH, OR TYPE" C 7070 CALL EMESS(BDKEY) GOTO 7055 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������M������ÿÿ����� ���� ÿý�Y� c ���������ÿ��92069-18045 1912� S C0122 �&PSRCH �PSRCH SOURCE � � � � � � � � � � � � �H0101 ”t�����þúFTN SUBROUTINE PSRCH(ITBL,CNT,NUM,IERR),92069-16015 REV. 1912 780711 INTEGER ITBL(3),CNT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18045 C RELOC: 92069-16015 C C C****************************************************************: C C C C SUBROUTINE PSRCH ( PATH TABLE SEARCH ) C C C ABSTRACT: C PSRCH SEARCHS A PATH TABLE FOR A PARTICULAR DATA SET. C C INPUT: C CNT IS THE NUMBER OF PATHS IN THE TABLE C ITBL IS THE PATH TABLE ITSELF C NUM IS THE DATA SET NUMBER C C OUTPUT: C IERR IS THE ERROR INDICATOR C 0 INDICATES SET WAS FOUND C 1 INDICATES SET WAS NOT FOUND C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ DECEMBER 18,1978 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, ªå������þú 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 ü©������þú NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(16) COMMONa����� RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 9,1979 IERR = 0 DO 10 I = 0,CNT*2,2 CALL SGET(ITBL,I+2,N) IF (N .EQ. NUM) GOTO 20 10 CONTINUE IERR = -1 20 RETURN END ������������������������������������������������������������������������������������������������������������������@%������ÿÿ����� ���� ÿý�Z�c ���������ÿ��92069-18046 2026� S C0122 �&MPTH &MPTH � � � � � � � � � � � � � �H0101 áË�����þúFTN SUBROUTINE MPTH(INUM,PTHCT,IERR),92069-16015 REV.2026 800124 INTEGER PTHCT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18046 C RELOC: 92069-16015 C C C****************************************************************: C C C MASTER PATH PROCESSOR FOR ENTRY: PROCESSOR C C C ABSTRACT: C C "MPTH" PROCESSES THE NUMBER OF PATHS WHICH ARE DEFINED FOR A MASTER C DATA SET. IT VERIFIES THAT AUTOMATIC MASTERS HAVE AT LEAST 1 DETAIL C AND THAT NO OTHER HASH KEY HAS BEEN DEFINED FOR THIS MASTER DATA SET. C C CALLING SEQUENCE: C C CALL MPTH(INUM,PTHCT,IERR) C C WHERE: C C INUM C IS THE ITEM NUMBER OF THE PATH ITEM C C PTHCT C IS THE NUMBER OF PATHS CURRENTLY DEFINED C C IERR C IS AN ERROR INDICATOR FOR THE ENTIRE "ENTRY" PROCESSOR. C IT IS NOT CHANGED UNLESS THERE IS AN ERROR. C C 0 INDICATES NO ERROR C -1 INDICATES ERROR C C NOTE: IERR IS NOT MODIFIED UNLESS THERE IS AN ERROR C C C INTEGER PNUM C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, ç8������þú 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNA×V������þúL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 “o����� ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C IF (TYPE .NE. INTGR) GOTO 7040 IF( (IGLOB .EQ. 0) .AND. (STYPE .EQ. AUTO) ) GOTO 7010 IF( (IGLOB .LT. 0) .OR. (IGLOB .GT. PMAX) ) GOTO 7020 C C HAS A HASH KEY ALREADY BEEN DEFINED? C CALL RSGET(SINDX+DSCCT,PNUM) IF(PNUM .NE. 0) GOTO 7030 PTHCT = IGLOB C C PUT HASH KEY IN SET TABLE C CALL RSPUT (SINDX+DSCCT,INUM) 30 RETURN C C C C ERROR PROCESSORS C C C OUTPUT "AUTOMATIC MASTERS MUST HAVE PATH COUNT OF 1" C 7010 CALL EMESS(BDCNT) GOTO 7035 C C OUTPUT "TOO MANY PATHS" C 7020 CALL EMESS(DUPHS) GOTO 7035 C C OUTPUT "SEARCH ITEM ALREADY DEFINED" C 7030 CALL EMESS(SRCH2) 7035 IERR = -1 GOTO 30 C C OUTPUT "NON-NUMERIC PATH COUNT" C 7040 CALL EMESS(ILPTH) GOTO 7035 END ������������������������������������������������������������������������������������������������������������������������������������������������������������š‡������ÿÿ����� ���� ÿý�[�d ���������ÿ��92069-18047 2026� S C0122 �&PINFO &PINFO � � � � � � � � � � � � � �H0101 ë�����þúFTN SUBROUTINE PINFO(ITBL,CNT,UPLIM,IPTR),92069-16015 REV.2026 800124 INTEGER CNT,UPLIM,ITBL(3) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18047 C RELOC: 92069-16015 C C C****************************************************************: C C C PINFO SUBROUTINE C C C ABSTRACT: C PINFO PUTS THE INFORMATION TABLES AT THE END OF THE C AVAILABLE MEMORY, WHEN THERE IS ROOM. C C INPUT: C ITBL IS THE TABLE TO BE SAVED C CNT IS THE BYTE COUNT OF THE LENGTH OF THE TABLE C UPLIM IS THE UPPER LIMIT OF MEMORY C C OUTPUT: C IPTR POINTS TO THE FIRST WORD OF THE TABLE AFTER IT IS MOVED C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, Ù������þú 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENTÓ°������þú,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50)Ð�����,NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C MAKE COUNT EVEN C IPTR = INFPT IF (CNT .EQ. 0) GOTO 10 N = (CNT+1) / 2 * 2 C C IS THERE ENOUGH ROOM? C IPTR = INFPT-N IF (IPTR .LT. UPLIM) CALL ERXIT(NOMEM) INFPT = IPTR IPTR = IPTR + 2 I2= IPTR DO 10 I=1,N/2 CALL SROOT(I2,ITBL(I)) I2= I2 + 2 10 CONTINUE RETURN END ����…ï������ÿÿ����� ���� ÿý�\�e ���������ÿ��92069-18048 2026� S C0122 �&SSRCH &SSRCH � � � � � � � � � � � � � �H0101 ò�����þúFTN SUBROUTINE SSRCH(ISCT,SETNO,INAM),92069-16015 REV.2026 800124 C 1/2 (QA-15) WAS NOT CHECKING FOR DATA BASE NAME ON FIRST DATA SET. INTEGER INAM(3) INTEGER SETNO C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18048 C RELOC: 92069-16015 C C C****************************************************************: C C*********************************************************************** C SSRCH COMPARES EACH SUCCESSIVE SET NAME IN THE SET TABLE WITH C THE CONTENTS OF INAM. THE SET TABLE IS SEARCHED THROUGH ENTRY C NUMBER ISCT. IF A MATCH IS FOUND, SETNO IS SET TO THE SET C NUMBER OF THE MATCHING SET NAME. IF NO MATCH IS FOUND, SETNO C IS SET TO 0. C CALLING SEQUENCE C CALL SSRCH(ISCT,SETNO,INAM) C WHERE ISCT IS THE SET # OF THE LAST SET TO BE SEARCHED C SETNO IS SET TO THE SET# OF THE MATCHING SET OR 0 C INAM IS THE NAME OF THE SET BEING SEARCHED FOR C*********************************************************************** C C SSRCH SUBROUTINE C INTEGER SCTR,SPTR C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 o������þú PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INÈd������þúTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C ¥B����� C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C SETNO=0 IF(ISCT .EQ. 0) GOTO 30 C C SEARCH FROM THE BEGINING OF THE SET TABLE, OMITTING C THE CURRENT SET, WHICH HAS NO NAME AS OF YET C DO 30 SCTR = 0,ISCT-1 SPTR = SCTR*SETSZ+SETTB DO 20 J=1,3 IF(ROOTA(SPTR) .NE. INAM(J) ) GOTO 30 SPTR = SPTR + 2 20 CONTINUE SETNO = SCTR+1 GOTO 40 C C BE SURE NAME IS NOT THE DATA BASE NAME C 30 CONTINUE DO 35 J = 1,3 IF(INAM(J) .NE. RFILE(J)) GOTO 40 35 CONTINUE SETNO = -1 40 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������†ÿ������ÿÿ����� ���� ÿý�]�f ���������ÿ��92069-18049 2026� S C0122 �&TABLE &TABLE � � � � � � � � � � � � � �H0101 ö×�����þúFTN4 SUBROUTINE TABLE,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18049 C RELOC: 92069-16015 C C C****************************************************************: C INTEGER A,M,D INTEGER RCAP(2) INTEGER TBLH(40),TBLHZ INTEGER NUM(5) INTEGER PRTLN(40),PRTLM C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC çv������þú C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BAŸe������þúSE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980ŽM������þú C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA PRTLM/40/ DATA A/101B/ DATA D/104B/ DATA M/115B/ DATA TBLH/2H ,2HSE,2HT ,2HNA,2HME,2H ,2H ,2HTY, 12HPE,2H ,2H ,2H# ,2HIT,2HEM,2HS ,2H ,2H #,2H P, 22HAT,2HHS,2H ,2H D,2HAT,2HA ,2H ,2H M,2HED,2HIA, 32H ,2H ,2HCA,2HPA,2HC ,2H ,2H ,2H C,2HAR,2HTR, 42HID,2HGE/ DATA TBLHZ/40/ C C C IS TABLE REQUESTED IN CONTROL OPTIONS? C NDX = NFONX(NOTAB) IF (INFO(NDX) .EQ. NFO(NOTAB) ) GOTO 60 C C SKIP TO TOP OF PAGE C IF(LIST .NE. -1) CALL EXEC(3,1100B+LIST,-1) C C YES, GET INDEX INTO SET TABLES C SCNT = ROOTA(DBSCT) SETTB = ROOTA(DBSTP) * 2 C C OUTPUT HEADING AND TWO BLANK LINES C CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) CALL OUTLN(TBLH,TBLHZ) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C OUTPUT EACH DATA SET C IF(SCNT .LE. 0) GOTO 60 DO 50 J = 0,SCNT-1 SINDX = J*SETSZ+SETTB C C BLANK THE PRINT BUFFER C DO 10 I= 1,PRTLM PRTLN(I) = BLANK 10 CONTINUE C C PUT SET NAME IN BUFFER C DO 20 I= 0,2 PRTLN(I+3) = ROOTA(SINDX+DSNME+I*2) 20 CONTINUE C C PUT SET TYPE IN BUFFER C CALL RSGET(SINDX+DSTYP,STYPE) IF (STYPE .EQ. AUTO) STYPE = A IF(STYPE .EQ. MANU) STYPE = M IF(STYPE .EQ. DETAIL) STYPE = D CALL SPUT(PRTLN,17,STYPE) C C PUT FIELD COUNT IN BUFFER C CALL IFRM(SINDX+DSFCT,4,6,PRTLN,25) C C PUT PATH COUNT IN BUFFER C CALL IFRM(SINDX+DSPCT,5,6,PRTLN,36) C C PUT ENTRY LENGTH IN BUFFER C CALL CITA(ROOTA(SINDX+DSDRL),NUM) CALL SMOVE(NUM,3,6,PRTLN,44) C C PUT MEDIA RECORD IN BUFFER C CALL IFRM(SINDX+DSMDL,3,6,PRTLN,52) C C PUT CAPACITY COUNT IN BUFFER C RCAP(1) = ROOTA(SINDX+DSCAP) RCAP(2) = ROOTA(SINDX+DSCAP+2) CALL DCITA(RCAP,NUM) CALL SMOVE(NUM,1,10,PRTLN,59) C C PUT CARTRIDGE Ú�����NUMBER IN BUFFER C N = ROOTA(SINDX+DSCRN) CALL CITA(N,NUM) CALL SMOVE(NUM,2,6,PRTLN,74) C C OUTPUT THE LINE C 40 CONTINUE CALL OUTLN(PRTLN,PRTLM) 50 CONTINUE C C RETURN TO CALLER C 60 CONTINUE RETURN END C C C C C SUBROUTINE IFRM(IINDX,ISTRT,IEND,IBUF,IOUT) & ,92069-16015 REV.1912 790130 INTEGER NUM(5) CALL RSGET(IINDX,N) CALL CITA(N,NUM) CALL SMOVE(NUM,ISTRT,IEND,IBUF,IOUT) RETURN END ����íÉ������ÿÿ����� ���� ÿý�^� h ���������ÿ��92069-18050 2026� S C0122 �&FLDTB &FLDTB � � � � � � � � � � � � � �H0101 ñÜ�����þúFTN SUBROUTINE FLDTB,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18050 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C C INTEGER PCNT,PINDX,PN INTEGER NUM(10) INTEGER RPTR,PPTR INTEGER START INTEGER TBLH(40),TBLHZ INTEGER YES(2) INTEGER PRTLN(40),PRTLM C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 ƒ������þú DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, ĵ������þú 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON T»B������þúYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA PRTLM/40/ C 12 34 56 78 90 12 34 56 78 90 DATA TBLH/2H ,2HSE,2HT ,2HNA,2HME,2H ,2HSE,2HT ,2HNO, C 90 12 34 56 78 90 12 34 56 78 12H ,2HIT,2HEM,2H N,2HAM,2HE ,2H I,2HTE,2HM ,2HNO,2H , C 12 34 56 78 90 12 34 56 78 90 12HTY,2HPE,2H ,2HST,2HAR,2HT ,2HWD,2H ,2HEN,2HD , 22HWD,2H ,2HPA,2HTH,2H? ,2H S,2HOR,2HT ,2HIT,2HEM/ C DATA TBLHZ/40/ DATA YES/2HYE,2HS / C C IS ELEMENT REQUESTED? C NDX = NFONX(FIELD) IF(INFO(NDX) .NE. NFO(FIELD)) GOTO 90 C C OUTPUT A TOP OF PAGE C IF(LIST .NE. -1) CALL EXEC(3,1100B+LIST,-1) C C OUTPUT HEADING C CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) CALL OUTLN(TBLH,TBLHZ) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C SET UP CONSTANTS C ITMTB = ROOTA(DBITP) * 2 SCNT = ROOTA(DBSCT) IF(SCNT .LE. 0) GOTO 90 SETTB = ROOTA(DBSTP) * 2 C C PROCESS EACH SET TABLE C DO 90 J = 0,SCNT-1 SINDX = J*SETSZ+SETTB START = 1 CALL OUTLN(BLANK,1) C C BLANK THE PRINT LINE C DO 10 I=1,PRTLM PRTLN(I) = BLANK 10 CONTINUE C C FORMAT THE SET NAME C DO 20 I = 0,2 20 PRTLN(I+2) = ROOTA(SINDX+DSNME+I*2) C C FORMAT SET NUMBER C CALL CITA(J+1,NUM) CALL SMOVE(NUM,5,6,PRTLN,15) C C GET THE SET TYPE C CALL RSGET(SINDX+DSTYP,STYPE) C C GET ALL THE ITEMS IN THE SET C C GET THE ITEM COUNT FROM THE SET TABLE C CALL RSGET(SINDX+DSFCT,ICNT) C GET THE ADDRESS TO THE RECORD DEFINITION TABLE RPTR = ROOTA(DSITP+SINDX)*2 C C GET THE ADDRESS TO THE PATH TABLE C C THE ITEM COUNT MUST BE ROUNDED TO EVEN WORDS THEN IT C MUST BE q5������þúTURNED BACK INTO A BYTE COUNT FOR THE ROOT C ACCESS ROUTINES (SROOT,RSGET,ETC.). C THEN IT MUST BE ADDED TO THE RECORD DEFINITION TABLE ADDRESS. C PPTR = (ICNT+1) / 2 * 2 + RPTR C GET THE PATH COUNT CALL RSGET(SINDX+DSPCT,PCNT) C C C C IF(ICNT .LT. 1) GOTO 90 DO 80 K=1,ICNT CALL RSGET(RPTR,N) RPTR = RPTR+1 INDEX = (N-1)*ITMSZ+ITMTB C C OUTPUT ITEM NAME C DO 40 I=0,2 PRTLN(I+12) = ROOTA(INDEX+I*2) 40 CONTINUE C C OUTPUT ITEM NUMBER C CALL CITA(N,NUM) CALL SMOVE(NUM,4,6,PRTLN,34) C C OUTPUT ITEM TYPE C CALL RSGET(INDEX+ITTYP,ITYPE) CALL SPUT(PRTLN,43,ITYPE) C C OUTPUT START COLUMN C CALL CITA(START,NUM) CALL SMOVE(NUM,3,6,PRTLN,49) C C OUTPUT END COLUMN C START = START + ROOTA(INDEX+ITLNG) - 1 CALL CITA(START,NUM) CALL SMOVE(NUM,3,6,PRTLN,58) START = START + 1 C C IS THIS A PATH ITEM ? C C GET THE PATH COUNT C IF(STYPE .NE. DETAIL) GOTO 55 C IF(PCNT .LT. 1) GOTO 65 DO 50 I=0,(PCNT-1)*4,4 CALL RSGET (PPTR+I,PN) IF(PN .EQ. N) GOTO 60 50 CONTINUE GOTO 65 C C IS THIS THE HASH ITEM FOR A MASTER DATA SET? C 55 CONTINUE CALL RSGET(SINDX+DSCCT,PN) IF(PN .NE. N) GOTO 65 C C OUTPUT A "YES" TO INDICATE THIS ITEM IS A PATH C 60 CONTINUE CALL SMOVE(YES,1,3,PRTLN,66) C C IF A DETAIL C C IS THE PATH SORTED? C IF (STYPE .NE. DETAIL) GOTO 65 CALL RSGET(PPTR+I+3,PN) IF (PN .EQ. 0) GOTO 65 C C OUTPUT SORT ITEM NAME C INDEX = (PN - 1) * ITMSZ + ITMTB DO 63 I=0,2 PRTLN(I+37) = ROOTA(INDEX+I*2) 63 CONTINUE C C PRINT FORMATTED LINE C 65 CONTINUE CALL OUTLN(PRTLN,PRTLM) C C BLANK THE PRINT LINE C DO 70 I=1,PRTLM PRTLN(I) = BLANK 70 CONTINUE 80 CONTINUE 90 CONTINUE RETURN END ��������������������������������������������GÐ���$����"��������������������������������$�������ÿÿ����� ���� ÿý�_� j ���������ÿ��92069-18051 2026� S C0122 �&SUM &SUM � � � � � � � � � � � � � �H0101 »¥�����þúFTN SUBROUTINE SUM,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18051 C RELOC: 92069-16015 C C C****************************************************************: C C C C INTEGER NITM(10),NITMZ INTEGER NERR(16),NERRZ INTEGER NSET(19),NSETZ INTEGER LMSG(20),LMSGZ INTEGER HTBL(32),HTBLZ INTEGER NUM(10) INTEGER PRTLN(40),PRTLM C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C Ö@������þú OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 ²ù������þú SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C Ql������þú EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA PRTLM/40/ DATA NERR /2HNU,2HMB,2HER,2H O,2HF ,2HER,2HRO,2HR ,2HME,2HSS, 1 2HAG,2HES,2H: ,2HXX,2HXX,2H / DATA NITM /2HNU,2HMB,2HER,2H O,2HF ,2HIT,2HEM,2HS:,2H X,2HXX/ DATA NSET/2HNU,2HMB,2HER,2H O,2HF ,2HSE,2HTS,2H: ,2HXX/ DATA LMSG/2HRO,2HOT,2H F,2HIL,2HE:,2H X,2HXX,2HXX,2HX ,2HWO, &2HRD,2HS,,2H X,2HXX,2HXX,2HX ,2HBL,2HOC,2HKS,2H / DATA HTBL/2HCA,2HRT,2HRI,2HDG,2HE ,2HNU,2HMB,2HER,2H ,2H , 12H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , 12HNU,2HMB,2HER,2H B,2HLO,2HCK,2HS ,2HRE,2HQU,2HIR, 22HED,2H / C DATA NERRZ/16/ DATA NITMZ/10/ DATA NSETZ/9/ DATA LMSGZ/20/ DATA HTBLZ/32/ C C OUTPUT TOP OF PAGE C IF(LIST .NE. -1) CALL EXEC(3,1100B+LIST,-1) C C OUTPUT TWO BLANK LINES C CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C OUTPUT "NUMBER OF ERRORS: NNNN " C CALL CITA(ERROR,NUM) CALL SMOVE(NUM,3,6,NERR,27) CALL OUTLN(NERR,NERRZ) C C OUTPUT "NUMBER ITEMS: NNN" C CALL CITA (ROOTA(DBICT),NUM) CALL SMOVE(NUM,4,6,NITM,18) CALL OUTLN(NITM,NITMZ) C C OUTPUT "NUMBER OF SETS: NN" C CALL CITA (ROOTA(DBSCT),NUM) CALL SMOVE(NUM,5,6,NSET,17) CALL OUTLN(NSET,NSETZ) C C OUTPUT "ROOT FILE: NNNNNN WORDS, NNNNNN BLOCKS " C ISECT = ((OVRHD/2)+127) / 128 + 3 CALL CITA(ISECT,NUM) CALL SMOVE(NUM,1,6,LMSG,26) C CALL CITA(RINDX/2-5,NUM) CALL SMOVE(NUM,1,6,LMSG,12) C CALL OUTLN(LMSG,LMSGZ) C C OUTPUT "CARTRIGE REFERENCE NUMBER BLOCKS REQUIRED" C CALL OUTLN(BLANK,1) CALL OUTLN(HTBL,HTBLZ) IF(NPACK .EQ. 0) GOTO 30 DO 20 I=1,NPACK C DO 10 J=1,PRTLM PRTLN(J) = BLANK 10 CONTINUE C C C CALL CITA(KPACK(I),NUM) CALL SMOVE(NUM—+�����,2,6,PRTLN,10) CALL DCITA(CPACK(I),NUM) CALL SMOVE(NUM,1,10,PRTLN,47) CALL OUTLN(PRTLN,PRTLM) 20 CONTINUE 30 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������9ú������ÿÿ����� ���� ÿý�`� j ���������ÿ��92069-18052 2026� S C0122 �&WRITR &WRITR � � � � � � � � � � � � � �H0101 �����þúASMB NAM WRITR,7 92069-16015 REV.2026 800124 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18052 * RELOC: 92069-16015 * * *****************************************************************: * ***************************************************************** * WRITR WRITES THE ROOT TABLE TO THE DISC * THE ROOT TABLE IS LOCATED IN THE SPACE AFTER THE LONGEST * PROGRAM SEGMENT * * THE RUN TABLE SHOULD PRECEES THE OVERHEAD RECORD, AND THE * OVERHEAD RECORD SHOULD PRECEED THE FREESPACE POINTERS. * * --------------- * ! ! * ! ! * ! RUN TABLE ! * ! ! * ! ! * --------------- * ! OVERHEAD ! * ! (5 WORDS) ! * --------------- * ! FREE SPACE ! * ! POINTERS ! * --------------- * * * THE WORD OVRHD IS THE BYTE OFFSET TO THE FIRST WORD OF THE * OVERHEAD RECORD. THE WORD RINDX IS THE BYTE OFFSET WHICH POINTS TO * ONE WORD PAST THE END OF THE FREE SPACE POINTERS. RINDX * AND OVRHD ARE SET UP IN THE MODULE RAPUP. * * * CALLING SEQUENCE: * * CALL WRITR(IERR,IDCB) * WHERE IERR = FMGR ERROR CODE * IDCB = THE FMP FILE CONTROL BLOCK * * ***************************************************************** * * ENT WRITR EXT EWRIT,.ENTR EXT ROOTA * *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * * Ï«������þú * CONSTANTS IN COMMON * * * COM CARD(36),CHAR,CODE,CPACK(100),CRDPR COM DSEC,DCRN COM ENTL,ERROR COM NMFLG COM FWAM COM GGERR COM ICNT,IDCB(144),INDX COM INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COM KPACK(50) COM LDCB(144),LGLOB,LIST,LWAM COM MEDIA COM NPACK(50),NSETS(50) COM OVRHD COM PTHTB(32) COM RDEF(64),RESNO,RFILE(3),RINDX COM SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COM TYPE,PRGFG * *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * CHANGED TO INCREASE SIZE OF PTHTB * * * IERR NOP DCB NOP WRITR NOP JSB .ENTR DEF IERR * LDA OVRHD GET ADDRESS OF OVERHEAD RECORD ARS TURN BYTE OFFSET TO WORD OFFSET ADA FWAM ADD TO FIRST WORD OF AVAILABLE MEMORY STA ADDR * JSB EWRIT WRITE OVERHEAD RECORD DEF *+6 DEF DCB,I DEF IERR,I DEF ADDR,I DEF .5 SIZE OF OVERHEAD DEF ONE * LDA IERR,I SSA JMP WRITX * LDA OVRHD GET SIZE OF FREE SPACE POINTERS CMA,INA ADA RINDX BYTE OFFSET 1 WORD PAST FREE SPACE PTRS ARS ADA M5 STA III * LDA ADDR GET ADDRESS TO FREE SPACE POINTERS ADA .5 SKIP OVERHEAD STA ADDR * JSB EWRIT WRITE THE FREE SPACE POINTERS DEF *+6 DEF DCB,I DEF IERR,I DEF ADDR,I DEF III DEF TWO * LDA IERR,I WAS THERE AN ERROR? SSA JMP WRITX * JSB ROOTA GET THE RUN TABLE RECORD NUMBER DEF *+2 DEF OVRHD STA B CLA DST IV * LDA OVRHD ARS STA II * JSB EWRIT WRITE OUT THE ROOT FILE DEF *+6 DEF DCB,I DEF IERR,I DEF FWAM,I DEF II DEF IV * WRITX JMP WRITR,I * * * ­����� ADDR DEF *-* II DEF *-* III DEF *-* IIII DEF *-* IV BSS 2 * * THIS IS A DOUBLE INTEGER ONE * ONE DEC 0 DEC 1 * * * * * THIS IS A DOUBLE INTEGER TWO * TWO DEC 0 DEC 2 .5 DEC 5 M5 DEC -5 * * * A AND B REGISTER EQUATES * * A EQU 0 B EQU 1 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¶è������ÿÿ����� ���� ÿý�a�i ���������ÿ��92069-18053 2026� S C0122 �&GCHAR � � � � � � � � � � � � � �H0101 l‹�����þúFTN SUBROUTINE GCHAR,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18053 C RELOC: 92069-16015 C C C****************************************************************: C C ABSTRACT: C C C GCHAR RETURNS THE NEXT CHARACTER IN CHAR AND THE CODE FOR THE C CHARACTER IN CODE. GCHAR SKIPS COMMENTS. C C C C C CODTA IS A BUFFER WHICH MAPS THE CHARACTER INTO A CODE C C CODE CHARACTERS REPRESENTED C C 1 NUMBERS ( 0-9 ) C 2 UPPERCASE ( A-Z ) C 3 #%&'*/?@!"<>$# C 4 = C 5 ) C 6 : C 7 +-. C 8 , C 9 [ BLANK ] C 10 ) C 11 ; C 12 EVERYTHING ELSE C C C C C C C CALLING SEQUENCE C CALL GCHAR C C C C ON EXIT: C C CODE - CONTAINS A CODE REPRESENTING TYPE OF CHARACTER C CHAR - CONTAINS THE CHARACTER C C C C*********************************************************************** C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DES^¼������þúET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTSn´������þú,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,IyE�����LOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C GCHAR SUBROUTINE INTEGER CODTA(128) C C CODTA IS THE TABLE OF CODES FOR ASCII CHARS, INDEXED INTO BY C THE ASCII CODE+1 DATA CODTA/32*12,9,7*3,5,10,3,7,8,7,7,3,10*1,6,11, 1 3,4,3*3,26*2,4*3,33*12/ C C C C C C C GET NEXT CHAR C 10 CALL GCARD C GET CODE FOR CHAR CODE=CODTA(CHAR+1) IF (CHAR.NE.74B) GOTO 20 C IF CHAR='<' SCAN PAST COMMENT CALL GCARD IF (CHAR.EQ.74B) GO TO 30 CODE= CODTA(75B) CRDPR = CRDPR-1 20 CONTINUE RETURN 30 CONTINUE CALL GCARD C CHAR='>'? IF (CHAR.NE.76B) GO TO 30 CALL GCARD IF (CHAR.NE.76B) GO TO 30 GO TO 10 END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������x������ÿÿ����� ���� ÿý�b�k ���������ÿ��92069-18054 2026� S C0122 �&GCARD � � � � � � � � � � � � � �H0101 ~v�����þúFTN SUBROUTINE GCARD,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18054 C RELOC: 92069-16015 C C C****************************************************************: C C*********************************************************************** C GCARD SCANS THE NEXT CHARACTER AND PUTS IT IN CHAR C READS AND LISTS NEXT CARD; IGNORES COLUMNS 73-80 C IF INPT > 63 SCHEMA IS READ FROM DISK C CALLING SEQUENCE C CALL GCARD C*********************************************************************** C C GCARD SUBROUTINE C C C C C INTEGER ISETS(3) INTEGER INUM(4) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 I©^������þúTSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLR������þúEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50)Ÿe����� COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB DATA ISETS/2HSE,2HTS,2H: / DATA ICOMT/2H<</ C C IF(CRDPR.GE.CRDLM*2) GO TO 10 CRDPR=CRDPR+1 GO TO 60 C C BLANK FILE CARD BUFFER C 10 CONTINUE DO 20 I=1,CRDLM CARD(I)=BLANK C C READ NEW INPUT LINE C 20 CONTINUE IF (INPUT .EQ.-1) GOTO 30 CALL EXEC(100001B,INPUT,CARD,CRDLM) GOTO 70 25 GOTO 40 30 CONTINUE CALL EREAD(IDCB,IERR,CARD,CRDLM,IL,DUMY) C "END OF FILE ENCOUNTERED" IF (IERR.EQ.-12) CALL ERXIT(EOF) C C PRINT INPUT WHEN LIST IS ON C 40 CONTINUE CRDPR=1 NDX = NFONX(LST) IF (INFO(NDX).NE. NFO(LST) ) GOTO 60 C C IF LIST IS TURNED ON , LIST NEXT CARD C CALL OUTLN(CARD,CRDLM) C C PUT NEXT CHARACTER IN CHAR C 60 CALL SGET(CARD,CRDPR,CHAR) RETURN C C ERROR ON ABORTED I/O C 70 CONTINUE CALL ERXIT(IOAIN) END END$ �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� s������ÿÿ����� ���� ÿý�c�l ���������ÿ��92069-18055 2026� S C0122 �&RMOVE � � � � � � � � � � � � � �H0101 �����þúASMB NAM RMOVE,7 92069-16015 REV.2026 800124 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18055 * RELOC: 92069-16015 * * *****************************************************************: * ***************************************************************** * THESE ROUTINES MOVE INFORMATION TO AND FROM THE ROOT TABLE * WHICH IS LOCATED IN THE SPACE AFTER THE LONGEST PROGRAM SEGMENT ***************************************************************** * * * SROOT * * CALLING SEQUENCE: * * CALL SROOT(I,VALUE) * * WHERE: I = BYTE OFFSET IN THE TABLE * NOTE: OFFSETS START WITH ZERO * VALUE = WORD TO BE STORED IN THE TABLE * * * ENT SROOT,RSGET,RSPUT,ROOTA EXT SGET,SPUT,.ENTR,ERXIT,EXEC,ERRM *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * * * CONSTANTS IN COMMON * * * COM CARD(36),CHAR,CODE,CPACK(100),CRDPR COM DSEC,DCRN COM ENTL,ERROR COM NMFLG COM FWAM COM GGERR COM ICNT,IDCB(144),INDX COM INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COM KPACK(50) COM LDCB(144),LGLOB,LIST,LWAM COM MEDIA COM NPACK(50),NSETS(50) COM OVRHD COM PTHTB(32) COM RDEF(64),RESNO,RFILE(3),RINDX COM SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COM TYPE,PRGFG * *$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 * CHANGED TO INCREASE SIZE OF PTHTB * OFFST NOP VALUE NOP SROOT NOP JSB .ENTR DEF OFFST * LDA OFFST,I COMPUTE ARS WO<������þúRD ADA FWAM ADDRESS STA 1 OF ROOT TABLE CMB,INB IS THERE ROOM? ADB LWAM SSB JMP ERR NO! LDB VALUE,I GET DATA STB 0,I AND STORE IT JMP SROOT,I AND RETURN * ERR JSB ERXIT ERROR DEF *+2 DEF NOMEM * **************************************************************** * * GET * GET RETRIEVES A CHARACTER FROM ROOT TABLE * * CALLING SEQUENCE: * * CALL RSGET(INDEX,CHRX) * * WHERE: IINDX = CHARACTER INDEX IN ROOT TABLE * NOTE: INDEXING STARTS AT ZERO * CHRX = THE CHARACTER * **************************************************************** * INDEX NOP CHRX NOP RSGET NOP JSB .ENTR DEF INDEX LDA INDEX,I INA STA II * JSB SGET DEF *+4 DEF FWAM,I DEF II DEF CHRX,I * LDA CHRX,I MASK OFF ANYTHING IN THE LEFT BYTE AND LOW STA CHRX,I * JMP RSGET,I * * LOW OCT 377 II DEF *-* **************************************************************** * * PUT * PUT STORES A CHARACTER INTO THE ROOT TABLE * * CALLING SEQUENCE: * * CALL RSPUT(IINDX,CHR) * * WHERE IINDX = CHARACTER INDEX IN THE ROOT TABLE * NOTE: INDEXING STARTS AT ZERO * CHR = IS THE CHARACTER * **************************************************************** * IINDX NOP CHR NOP RSPUT NOP JSB .ENTR DEF IINDX LDA IINDX,I GET BYTE OFFSET FOR SPUT INA STA I2 GET WORD ADDRESS CCB ADA 1 ARS ADA FWAM IS THERE ROOM CMA,INA ADA LWAM SSA JMP E7010 * JSB SPUT PUT THE BYTE IN MEMORY DEF *+4 DEF FWAM,I DEF I2 DEF CHR,I JMP RSPUT,I * E7010 JSB ERXIT DEF *+2 DEF NOMEM * øn����� I2 DEF *-* * **************************************************************** * * ROOTA * ROOTA IS A FUNCTION THAT RETURNS A SPECIFIED WORD OF THE * ROOT TABLE. * * CALLING SEQUENCE: * * A=ROOTA(X) * * WHERE: X = THE BYTE OFFSET IN THE ROOT TABLE * NOTE: OFFSETTING STARTS AT ZERO * **************************************************************** * X NOP ROOTA NOP JSB .ENTR DEF X * LDA X,I ARS ADA FWAM LDA 0,I JMP ROOTA,I VALUE IS IN A REGISTER * .6 DEF 6 NOMEM DEF 30 END ����������������������������������������������������������������������������������������������������������������������������������������������������7&������ÿÿ����� ���� ÿý�d�l ���������ÿ��92069-18056 2026� S C0122 �&DBNMR &DBNMR � � � � � � � � � � � � � �H0101 þã�����þúFTN SUBROUTINE DBNMR(INM,ISC,ICRN,IERR),92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18056 C RELOC: 92069-16015 C C C****************************************************************: C C DBNMR PROCESSES DATA BASE AND DATA SET NAMES. SYNTAX IS C AS FOLLOWS, C C FILENM:SECURITY:CARTRIDGE C OR C FILENM::CARTRIDGE C C C INTEGER INM(3) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFû¹������þúFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 S„������þúEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXvq�����TERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C C INITIALIZE ERROR RETURN TO "NO ERROR" C IERR = 0 C C INITIALIZE SECURITY CODE TO 0 C ISC = 0 C C INITIALIZE FILE NAME TO BLANKS C DO 10 I=1,3 INM(I) = BLANK 10 CONTINUE C C GET FILE NAME C IF (TYPE .NE. NAM) GOTO 7010 DO 15 I=1,LGLOB INM(I) = IGLOB(I) 15 CONTINUE C C VERIFY COLON C CALL GGLOB IF (TYPE .NE. COLON) GOTO 7040 C C GET SECURITY CODE C 20 CONTINUE CALL GGLOB IF(TYPE .EQ. COLON) GOTO 35 IF (LGLOB .GT. 1) GO TO 7050 ISC = -IGLOB C C VERIFY COLON C CALL GGLOB 30 CONTINUE IF (TYPE .NE. COLON) GOTO 7040 C C GET CARTRIDGE NUMBER C 35 CONTINUE CALL GGLOB IF (LGLOB .NE. 1) GOTO 7030 ICRN = IGLOB 40 CONTINUE RETURN C C C C C ERROR RETURNS C C C C OUTPUT "ILLEGAL FILE NAME" C 7010 CALL EMESS(ILNAM) GOTO 7045 C C OUTPUT "ILLEGAL CARTRIDGE NUMBER" C 7030 CALL EMESS(ILCRN) GOTO 7045 C C OUTPUT " INCOMPLETE NAME" C 7040 CALL EMESS(ILNMR) 7045 CONTINUE IERR = -1 GO TO 40 C C OUTPUT "ILLEGAL SECURITY CODE" C 7050 CONTINUE CALL EMESS(ILLSC) GOTO 7045 END ����������������������������������������������������������������������������������������������������������Y������ÿÿ����� ���� ÿý�e�n ���������ÿ��92069-18057 2026� S C0122 �&DATA � � � � � � � � � � � � � �H0101 nb�����þúFTN BLOCK DATA,DATA,92069-16015 REV.2026 800122 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18057 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C CONSTANT INITIALIZATION C C THESE CONSTANTS ARE SET UP TO FACILITATE CHANGES TO CERTAIN VALUES C THAT NOW APPEAR TO BE FIXED, BUT THAT MAY CHANGE BEFORE TOTAL C DEVELOPEMENT IS COMPLETED. C C C CONST C IS A COMMON BLOCK WHICH DEFINES RESNO, DATA BASE MAXIMUMS, C AND ARRAYS OF CONSTANTS SUCH AS "NFO", AND "NFONX". "NFO" AND C "NFONX" ARE USED TO SET AND TEST CONTROL OPTION TOGGLES IN "INFO". C SEE THE SEGMENT "CNTR" FOR MORE DETAILS. C C C DBCB C IS THE DATA BASE CONTROL BLOCK OFFSETS IN BYTES. NOTE THAT THEY C START WITH 0. C C -------------------------------- C 0 ! ! DBNAM C ----- ------ C 2 ! DATA BASE NAME ! C ----- ------- C 4 ! ! C -------------------------------- C ! ! DBSCD C -------------------------------- C ! CARTRIDGE NUMBER ! DBCRN C -------------------------------- C ! NODE NUMBER ! DBDSN C -------------------------------- C ! RESOURCE NUMBER ! DBRSN C -------------------------------- C ! DATA ITEM COUNT ! DBICT C -------------------------------- C ! WORDå������þú OFFSET FOR ITEM TABLE ! DBITP C -------------------------------- C ! DATA SET COUNT ! DBSCT C -------------------------------- C ! WORD OFFSET TO SET TABLE ! DBSTP C -------------------------------- C ! WORD OFFSET TO SORT TABLE ! DBSOP C -------------------------------- C ! WORD OFFSET TO FREE RECORD TBL ! DBFRP C --------------------------------- C ! LEVEL FLAG ! DBLMD C -------------------------------- C ! LEVEL WORD1 ! DBLVL C ---- ---- C ! ! C ---- ---- C ! ! C ------------------------------- C ! LEVEL WORD2 ! C ---- --- C ! ! C ---- --- C ! ! C ------------------------------- C ! ! C ! . ! C ! . ! C ! . ! C ! ! C -------------------------------- C ! LEVEL WORD15 ! C ---- --- C ! ! C ------ ---- C 116 ! ! DBLVE = END OF LEVEL WORDS C ------------------------------- C ITMST IS THE WORD OFFSET C FOR THE START OF THE ITEM C TABLE WHICH IS ALWAYS AT C THE END OF THE DBCB. C C ITCB C IS THE OFFSETS INTO AN ITEM TABLE. NOTE THESE OFFSETS ARE IN BYTES C AND BEGIN WITH 0. C C C ----------------------------«ˆ������þú----- C 0 ! ! ITNME C ---- ---- C 2 ! ITEM NAME ! C ---- ---- C 4 ! ! C ---------------------------------- C 6 !READ !WRITE ! ITEM TYPE ! ITINF, ITTYP C ---------------------------------- C 8 ! DATA SET CNT ! SET NUMBER ! ITSCT,ITSNO C ---------------------------------- C ! ! ELEMENT COUNT ! ITWRC,ITECT C ---------------------------------- C 12 ! ITEM LENGTH IN WORDS ! ITLNG C --------------------------------- C C ITMSZ = BYTE SIZE OF ITEM TABLE C READ LVL = READ LEVEL DEFINED, RANGE 0-15 C WRITE LVL = WRITE LEVEL FOR ITEM, RANGE 0-15 C C C DSCB C IS THE DATA SET TABLE. C C C C C --------------------------------- C ! ! DSNME C ---- ---- C ! DATA SET NAME ! C ---- -- C ! ! C --------------------------------- C ! CARTRIDGE NUMBER ! DSCRN C --------------------------------- C ! ! ! ! !TYP! ! ! MEDIA LENGTH ! DSINF,DSMDL C --------------------------------- C ! DATA RECORD LENGTH ! DSDRL C --------------------------------- C ! FIELD/ENTRY ! PATHS/ENTRY ! DSFCT,DSPCT C --------------------------------- C ! INFO TABLE POINTER ! DSITP C --------------------------------- C ! DOUBLE WORD CAPACITY COUNT ! DSCAP C ! ! C --------------------------------- C ! HASH ITEM NO. ! ! DSCCT,DSPAN C --------------------------------- C ! DOUBLE WORD RCURENT ! DSRCN C ! !i.������þú C --------------------------------- C ! DOUBLE WORD PREVIOUS ! DSBWN C ! RECORD NUMBER ! C --------------------------------- C ! DOUBLE WORD NEXT ! DSFWN C ! RECORD NUMBER ! C --------------------------------- C C C SETSZ = BYTE SIZE OF A SET TABLE C TYP = 2 BITS, BIT POSITION 10,11 C 0 IMPLIES AUTOMATIC C 1 IMPLIES MANUAL C 2 IMPLIES DETAIL C C C OVCB C IS THE OVERHEAD CONTROL BLOCK C C ------------------------- C ! START REC # OF RUN TABLE ! OVRRC C ----------------------------- C ! SIZE OF RUN TABLE (WORDS) ! OVRTL C ---------------------------- C ! SIZE OF FREE SPACE (WORDS) ! OVFRL C ----------------------------- C ! MAXIMUM # DCB'S ! OVDCB C ----------------------------- C ! MAXIMUM SIZE OF RECORD ! OVREC C ----------------------------- C C C ERRM C IS A TABLE OF CONSTANTS THAT INDEX INTO THE ERROR MESSAGE C TABLE. THESE CONSTANTS SHOULD BE USED FOR ALL ERROR REPORTING, C AS THEY MAY CHANGE IN THE FUTURE. C C C THE UNLABLED COMMON CONTAINS DIFFERENT GLOBALS. C C CARD - IS A INPUT BUFFER C CHAR - CONTAINS THE LAST CHARACTER PROCESSED BY GCARD C CRDPR - POINTS TO CHARACTER JUST PROCESSED C DSEC - IS THE DATA BASE SECURITY CODE C DCRN - IS THE DATA BASE'S ROOT FILE'S CARTRIDGE NUMBER C ENTL - IS THE CURRENT ENTRY LENGTH, USED IN "PROCESSING "SETS:" C ERROR - IS THE COUNT OF ERRORS C GGERR - IS A GLOBAL ERROR INDICATOR USED IN PROCESSING OF "SETS:" C ICNT - IS THE CURRENT COUNT OF ITEMS, IT BEGINS AS ZERO AND C IS INCREMENTED AFTER AN ITEM IS COMPLETELY PROCESSED. C IDCB - IS THE INPUT DCB WHEN THE INPUT IS FROM FILES C INDX - IS USUALLY THE INDEX TO THE CURRENT ITEM TABLE C INFPT - C INFO - IS A BUFFER USED TO HOLD THE "CONTROL:" TOGGLES C IGLOB -‡¿������þú IS USED TO HOLD THE KEYWORD JUST GATHER UP BY "GGLOB" C INPUT - IS THE INPUT LU NUMBER WHEN INPUT IS FROM A DEVICE C ITMTB - IS THE BASE POINTER TO THE BEGINING OF THE ITEM TABLES C LDCB - IS THE LIST DCB WHEN LISTING IS TO A FILE C LGLOB - IS THE LENGTH IN WORDS OF IGLOB C LIST - IS THE LIST LU WHEN THE LISTING IS TO A DEVICE C LWAM - IS THE LAST WORD OF AVAILABLE MEMORY C MEDIA - IS THE CURRENT SIZE OF THE MEDIA RECORD C OVRHD - IS THE BYTE OFFSET IN THE ROOT TABLE FOR THE OVERHEAD C RECORD. C PTHTB - IS THE PATH TABLE FOR THE CURRENT DATA SET WHEN THE DATA C SET IS A DETAIL DATA SET. C RDEF - IS THE RECORD DEFINITION TABLE FOR THE CURRENT DATA SET C RESNO - IS THE RESERVED NUMBER OF THE GLOBAL RETURNED IN IGLOB C RFILE - IS THE FILE NAME OF THE ROOT FILE C RINDX - IS THE BYTE OFFSET INTO THE ROOT TABLE. IT IS THE CURRENT C POSITION IN THE ROOT TABLE C SCNT - IS THE DATA SET COUNT, IT BEGINS AT ZERO AND IS INCREMENTED C AFTER THE SET IS COMPLETELY PROCESSED. C SETTB - IS THE BASE ADDRESS OF THE BEGINNING OF THE SET TABLES C SINDX - IS THE BYTE POINTER TO THE CURRENT SET TABLE C SORTI - IS THE ITEM SORT TABLE C SORTS - IS THE SET SORT TABLE C STYPE - IS THE SET TYPE OF THE CURRENT DATA SET C TRAIL - IS A TRACE INDICATOR --- IT IS NO LONGER USED C TYPE - IS A GLOBAL RETURNED BY "GGLOB" C C C C C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, .;������þú 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C ^������þú C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS=ã������þú,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C DATA SET FLAG FOR AUTOMATIC MASTER DATA AUTO/0/ C CHARACTER CODE FOR BAD CHARACTERS "+", "-", "." DATA BADC/7/ C RESNO FOR BASE OF BEGIN DATA BASE DATA BASE/15/ C RESNO FOR BEGIN OF "BEGIN DATA BASE" DATA BEGIN/13/ C ASCII BLANKS DATA BLANK/2H / C CODE IN CODTA FOR BLANK DATA BLKCD/9/ C RESNO FOR "CAPACITY:" DATA CAP/22/ C RESNO FOR "$CONTROL" DATA CNTRL/11/ C TYPE NUMBER FOR COLON DATA COLON/6/ C TYPE NUMBER FOR COMMA DATA COMMA/8/ C MAXIMUM NUMBER OF WORDS READ FROM INPUT DATA CRDLM/36/ C RESNO FOR DAT OF "BEGIN DATA BASE" DATA DATA/14/ C FLAG FOR DETAIL SET DATA DETAIL/10B / C CHARACTER CODE FOR DOLLAR SIGN ($) DATA DOLLR/44B/ C CHARACTER CODE FOR PERIOD DATA DOT/56B/ C C CODE FOR ILLEGAL CHARACTERS C DATA ELSE/12/ C RESNO FOR END. COMMAND DATA END/16/ C RESNO FOR "ENTRY:" COMMAND DATA ENTY/21/ C RESNO FOR "ERROR=N" CONTROL OPTION DATA ERR/3/ C CODE FOR EQUAL SIGN (=) DATA EQUAL/4/ C RESNO FOR FIELD CONTROL OPTION DATA FIELD/10/ C CODE IN CODTA FOR INTEGERS DATA ICODE/1/ C TYPE NUMBER FOR INTEGERS DATA INTñN������þúGR/1/ C RESNO FOR "ITEM:" COMMAND DATA ITM/18/ C RESNO FOR "LEVEL:" COMMAND DATA LEVL/17/ C TYPE FOR LEFT PAREN DATA LPARN/5/ C RESNO FOR LIST OPTION DATA LST/1/ C DATA SET FLAG FOR MANUAL MASTERS DATA MANU/04B / C MAXIMUM CAPCACITY COUNT DATA MXCAP(1),MXCAP(2)/077777B,177777B/ C MAXIMUM WORDS PER RECORD DATA MAXRC/2048 / C MAXIMUM NUMBER OF ELEMENTS IN AN ARRAY DATA MXELE/255/ C MAXIMUM CHARACTERS IN A STRING ITEM DATA MXSTR/255/ C MAXIMUM DATA RECORD SIZE DATA MXENT/127/ C MAXIMUM NUMBER OF ITEMS IN THE DATA BASE DATA MXITM/255/ C MAXIMUM READ/WRITE LEVEL DATA MXLEV/15/ C TYPE NUMBER FOR NAMES DATA NAM/2/ C TYPE NUMBER OF RESERVED WORDS DATA RSRV/3/ C RESNO FOR "A" AND "AUTOMATIC" DATA ASET/23/ DATA AUSET/24/ C RESNO FOR "M" AND "MANUAL" DATA MSET/25/ DATA MASET/26/ C RESNO FOR "D" AND "DETAIL" DATA DSET/27/ DATA DESET/28/ C RESNO FOR "NAME:" COMMAND DATA NM/20/ C RESNO FOR NOLIST CONTROL OPTION DATA NOLST/2/ C NUMBER OF RESNO DATA NORES/28/ C RESNO FOR "NOSET" DATA OPSET/9/ C RESNO FOR "NOTABLE" DATA NOTAB/7/ C MAXIMUM NUMBER OF PATHS PER DATA SET DATA PMAX/16/ C RESNO FOR "ROOT" DATA ROOTR/4/ C TYPE NUMBER FOR RIGHT PARAN DATA RPARN/10/ C TYPE NUMBER OF SEMICOLON DATA SEMI/11/ C RESNO FOR "SETS:" COMMAND DATA SET/19/ C MAXIMUM NUMBER OF SETS PER DATA BASE DATA SMAX/50/ C CODE IN CODTA FOR UPPER CASE DATA UPPER/2/ C C C DATA BASE OFFSETS C C C DATA DBNAM/0/ DATA DBSCD/6/ DATA DBCRN/8/ DATA DBDSN/10/ DATA DBRSN/12/ DATA DBICT/14/ DATA DBITP/16/ DATA DBSCT/18/ DATA DBSTP/20/ DATA DBSOP/22/ DATA DBFRP/24/ DATA DBLMD/26/ DATA DBLVL/28/ DATA DBLVE/116/ C C C ITEM TABLE OFFSE±Ñ������þúTS C C C DATA ITNME/0/ DATA ITINF/6/ DATA ITTYP/7/ DATA ITSCT/8/ DATA ITSNO/9/ DATA ITECT/11/ DATA ITLNG/12/ DATA ITMSZ/14/ DATA ITMST/59/ C C C C DATA SET TABLE OFFSETS C C C DATA DSNME/0/ DATA DSCRN/6/ DATA DSTYP/8/ DATA DSMDL/9/ DATA DSDRL/10/ DATA DSFCT/12/ DATA DSPCT/13/ DATA DSITP/14/ DATA DSCAP/16/ DATA DSCCT/20/ DATA DSPAN/21/ DATA SETSZ/34/ C C C OVERHEAD TABLE OFFSETS C C C DATA OVRRC/0/ DATA OVRTL/2/ DATA OVFRL/4/ DATA OVDCB/6/ DATA OVREC/8/ C C C C C ERROR MESSAGE CONSTANTS C C C C DATA ILCTR /1 / DATA ILCRN /2 / DATA ILSEC /3 / DATA XBEGN /4 / DATA XLEV /5 / DATA DUPIT /6 / DATA ITLIM /7 / DATA ILITP /8 / DATA FLDER /9 / DATA ILXTP /10/ DATA ILWR /11/ DATA ILTRM /12/ DATA NAMX /13/ DATA DUPST /14/ DATA STLIM /15/ DATA ENTYX /16/ DATA NOITM /17/ DATA BDSET /18/ DATA BDKEY /19/ DATA DUPHS /20/ DATA NOPTH /21/ DATA AERR /22/ DATA RCLIM /23/ DATA CAPX /24/ DATA ILCAP /25/ DATA EMPTY /26/ DATA MXERR /27/ DATA EOF /28/ DATA NOSEG /29/ DATA NOMEM /30/ DATA DUPLV /31/ DATA ILNAM /32/ DATA ILNMR /33/ DATA LVDEF /34/ DATA ILSEP /35/ DATA ILRD /36/ DATA ILRNG/37/ DATA SETX /38/ DATA IGNSC /39/ DATA INMX /40/ DATA PTDUP /41/ DATA DBKEY /42/ DATA ENDX /43/ DATA PDEFC /44/ DATA SIMPT /45/ DATA BDCNT /46/ DATA RTERR /47/ DATA GOODS /48/ DATA GOODR /49/ DATA BADS /50/ DATA BADR /51/ DATA ABORT /52/ dÒ���B��@< DATA OPNER /53/ DATA XCNTR /54/ DATA ILLVN /55/ DATA NOPTH /56/ DATA SRCH2 /57/ DATA UEND/58/ DATA XITM/59/ DATA ELERR/60/ DATA ROTER/61/ DATA UNITM/62/ DATA IOAIN/63/ DATA IOAOT/64/ DATA UNRDL/65/ DATA UNWRL/66/ DATA IOERR/67/ DATA ILOPT/68/ DATA ILLSC/69/ DATA MORIT/70/ DATA ILPTH/71/ DATA DEFIT/72/ DATA ILSRT/73/ DATA SIMPS/74/ DATA UNDST/75/ C C C VARIABLE INITIALIZATION C C C C CONTROL OPTION INDEX INTO INFORMATION TABLE C LIST,NOLIST,ERRORS,ROOT,NOROOT,TABLE,NOTABLE, C SETS,NOSETS,FIELD DATA NFONX/ 1 , 1, 5, 2, 2, 3, 3, & 4, 4, 6/ C LIST,NOLIST,ERRORS,ROOT,NOROOT,TABLE,NOTABLE , C SETS,NOSETS,FIELD DATA NFO/ 0, 1, 100, 0, 1, 1, 0, & 0, 1, 1/ END ������������������������������������������hÄB������ÿÿ����� ���� ÿý�f�v ���������ÿ��92069-18058 2026� S C0122 �&NWITM � � � � � � � � � � � � � �H0101 ˜Ž�����þúFTN SUBROUTINE NWITM,92069-16015 REV.2026 800124 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18058 C RELOC: 92069-16015 C C C****************************************************************: C C C ABSTRACT: C C NWITM GETS A GLOBAL VARIABLE FOR THE SEGMENT ENTY2 C IT TURNS OFF THE SEARCH FOR RESERVE WORDS SO THAT ANY C ITEM IN THE "ENTRY:" SECTION MAY BE A RESERVE WORD. C C CALLING SEQUENCE: C C CALL NWITM C C INTEGER CAPC(4) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSIà¦������þúTP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, ‘h������þú 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,~�����PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C C C C DATA CAPC/2HCA,2HPA,2HCI,2HTY/ C C C C C C C C C C C C C BEGIN C NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. C C SEE IF THIS WAS THE RESERVED WORD "CAPACITY:" C A COLN IS EQUAL TO "72B" C IF(LGLOB .NE. 4) GOTO 20 IF(JSCOM(IGLOB,1,8,CAPC,1,IERR) .NE. 0) GOTO 20 CALL SGET(CARD,CRDPR,ICHK) IF(ICHK .NE. 72B) GOTO 20 C C THIS IS "CAPACITY:", SO SKIP PAST THE COLN AND SET RESNO TO CAPACITY C CALL GGLOB RESNO = CAP C C RETURN C 20 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ž=������ÿÿ����� ���� ÿý�g�p ���������ÿ��92069-18059 2026� S C0122 �&STITM � � � � � � � � � � � � � �H0101 –“�����þúFTN4 SUBROUTINE STITM(INUM,PTHCT,IERR),92069-16015 REV.2026 800124 INTEGER PTHCT C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18059 C RELOC: 92069-16015 C C C************************************************************* C C C SUBROUTINE STITM C C ABSTRACT: C STITM PROCESSES THE SORT ITEM DEFINITION OF A PATH DEFINITION C IN AN ENTRY: COMMAND FOR DETAIL DATA SETS. C C INPUT: C C INUM C IS THE ITEM NUMBER OF THE KEY ITEM FOR THE PATH C C PTHCT C IS THE CURRENT COUNT OF PATHS DEFINED C C IERR C IS THE ERROR INDICATOR FOR ALL THAT HAS HAPPENED C C OUTPUT: C C IERR C CONTAINS AN ERROR INDICATOR C 0 IMPLIES NO ERROR C -1 IMPLIES AN ERROR C C C INTEGER PTR,SINUM,SIIDX,SNUM,SNDX2 C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 ðå������þú DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ™ò������þú ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNÅ¿������þúT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C C C VERIFY THIS IS A NAME C IF (TYPE .NE. NAM) GOTO 7010 C C FIND ITEM IN ROOT C CALL ISRCH(ROOTA(DBICT),SINUM) IF (SINUM .EQ. 0) GOTO 7010 C C CALCULATE INDEX INTO ITEM TABLE FOR ITEM ENTRY C SIIDX = (SINUM - 1) * ITMSZ + ROOTA(DBITP) * 2 C C VERIFY THAT ITEM IS SIMPLE C CALL RSGET(SIIDX+ITECT,I) IF (I .NE. 1) GOTO 7020 C C VERIFY SORT ITEM IS NOT PATH'S KEY ITEM C IF (SINUM .EQ. INUM) GOTO 7010 C C GET MASTER SET NUMBER FOR THIS PATH C CALL SGET(PTHTB,PTHCT*4+2,SNUM) IF (SNUM .EQ. 0) GOTO 30 C C GET MASTER'S PATH TABLE ENTRY FOR THIS PATH C START WITH FIELD TABLE AND SKIP OVER 1 BYTE C FOR EACH FIELD C SNDX2 = (SNUM - 1) * SETSZ + SETTB PTR = ROOTA(SNDX2+DSITP) * 2 CALL RSGET(SNDX2+DSFCT,N) PTR = PTR + (N + 1) / 2 * 2 C C SCAN THROUGH PATH TABLE ENTRIES LOOKING FOR A DATA C SET, ITEM PAIR THAT MATCHES THIS DETAIL AND KEY C ITEM. IF MASTER HAS NO PATHS OR THE PAIR IS NOT C MATCHED, JUST RETURN. C CALL RSGET(SNDX2+DSPCT,N) IF (N .EQ. 0) GOTO 20 J = IOR((INUM*256),SCNT+1) DO 10 I=1,N IF (ROOTA(PTR) .EQ. J) GOTO 20 PTR = PTR + 4 10 CONTINUE GOTO 30 C C PUT SORT ITEM NUMBER IN MASTER AND DETAIL SET C PATH TABLES C 20 CONTINUE CALL RSPUT(PTR+3,SINUM) CALL SPUT(PTHTB,PTHCT*4+4,SINUM) 30 CONTINUE RETURN C ¦ó����� C OUTPUT "ILLEGAL SORT DESIGNATOR" C 7010 CALL EMESS(ILSRT) IERR=-1 GOTO 30 C C OUTPUT "SORT ITEM MUST BE SIMPLE" C 7020 CALL EMESS(SIMPS) IERR=-1 GOTO 30 END ��������������������������������������������������������������½a������ÿÿ����� ���� ÿý�h� r ���������ÿ��92069-18060 2026� S C0122 �&QYHDR &QYHDR � � � � � � � � � � � � � �H0101 ù�����ASMB NAM QYHDR,7 92069-16060 REV.2026 800129 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18060 * RELOC: 92069-16060 * * *****************************************************************: * * * * * END ����������������������������������������������������������������������������������������������������������������������������������������������������������š¬������ÿÿ����� ���� ÿý�i�o ���������ÿ��92069-18061 1912� S C0122 �&QUERY �QUERY SOURCE � � � � � � � � � � � � �H0101 ¦Œ�����þúFTN4 PROGRAM QUERY(4,90),92069-16060 REV.1912 790111 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18061 C RELOC: 92069-16060 C C C************************************************************ C C C C GENERAL COMMENTS ABOUT THE SEGMENTS AND SUBROUTINES USED BY QUERY: C C COMMON DECLARATIONS - ALL COMMON IS DECLARED IDENTICALLY SO C IT MAY BE MODIFIED AND EVERY SEGMENT AND SUBROUTINE WILL C REFLECT THE CHANGE. SINCE HP DOES NOT YET HAVE A "COPY" C FUNCTION IN THE FORTRAN COMPLIER, A PROGRAM CALLED "MERGE" C HAS BEEN WRITTEN TO REPLACE STATEMENTS BETWEEN ANY TWO C SPECIAL CHARACTERS, (C$ IN QUERY'S CASE). C C C C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SEß(��� �� CNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C CALL GETST(PARM,40,LPARM) SNAM = 2HQY SNAM(2) = 2H21 SNAM(3) = 2H C C ASSUME EVERYTHING IS LOCAL C RMOTE = -1 C C DEFAULT LOG TO THE CONSOL C ITTY = 401B C C INDICATE THAT NO DATA BASES ARE OPEN C DBNAM = 2H DBNAM(2) = 2H C C LOAD AND EXECUTE THE STRING PROCESSOR C CALL LOAD(SNAM) C C BE SURE THE DATA BASE BUFFERS ARE IN THE MAIN C CALL DBBUF END $ ����������������¤Ú ������ÿÿ����� ���� ÿý�j�q ���������ÿ��92069-18062 1940� S C0122 �&QY �QY SOURCE � � � � � � � � � � � � �H0101 �����þúFTN4 PROGRAM QY(5,90),92069-16060 REV.1940 790523 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18062 C RELOC: 92069-16060 C C C************************************************************ C C C QUERY SUBSYSTEM MAIN MODULE C COMMAND INTERPRETER C C LOGICAL IFTTY INTEGER SPACE INTEGER JSEC(4) INTEGER EDITOR(3) INTEGER DUMMY(2) INTEGER CMDTBL(89) INTEGER INVAL(9) INTEGER NDEF(6) INTEGER ISTAT(10) INTEGER MODE(4) INTEGER LEVEL(5) INTEGER IERR1(17) INTEGER IERR2(9) INTEGER IERR3(15) INTEGER IERR4(11) INTEGER IERR5(7) INTEGER IERR6(8),IERR7(9),IERR8(9) INTEGER MSG(11) INTEGER YES(2),NO INTEGER NEXT(3) INTEGER IWAIT(25) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARÜ0������þúM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C DATA SPACE/2H / DATA INVAL(1)/2H I/ DATA INVAL(2)/2HNV/ DATA INVAL(3)/2HAL/ DATA INVAL(4)/2HID/ DATA INVAL(5)/2H C/ DATA INVAL(6)/2HOM/ DATA INVAL(7)/2HMA/ DATA INVAL(8)/2HND/ DATA INVAL(9)/6412B/ C DATA NDEF/2HNO,2HT ,2HDE,2HFI,2HNE,2HD / DATA CMDTBL/2HFI,2HND,2H ,2H ,2H ,2H , & 2HRE,2HPO,2HRT,2H ,2H ,2H , & 2HUP,2HDA,2HTE,2H ,2H ,2H , & 2HCR,2HEA,2HTE,2H ,2H ,2H , & 2HDE,2HST,2HRO,2HY ,2H ,2H , & 2HDI,2HSP,2HLA,2HY ,2H ,2H , & 2HFO,2HRM,2H ,2H ,2H ,2H , & 2HEX,2HIT,2H ,2H ,2H ,2H , & 2HHE,2HLP,2H ,2H ,2H ,2H , & 2HLI,2HST,2H ,2H ,2H ,2H , & 2HEX,2HEC,2HUT,2HE ,2H ,2H , & 2HSE,2HLE,2HCT,2H-F,2HIL,2HE , & 2HDA,2HTA,2H-B,2HAS,2HE ,2H , & 2HXE,2HQ ,2H ,2H ,2H ,2H / DATA MODE/2HMO,2HDE,2H =,2H _/ DATA LEVEL/2HLE,2HVE,2HL ,2H= ,2H_ / DATA IMODE/0/ DATA IERR1/2H ,2HIL,2HLE,2HGA,2HL ,2HSE,2HLE,2HCT,2H F,2HIL, 12HE ,2HSI,2HZE,2H O,2HR ,2HTY,2HPE/ DATA IERR2/2H I,2HNV,2HAL,2HID,2H R,2HEQ,2HUE,2HST,2H / DATA IERR3/2H E,2HRR,2HOR,2H R,2HEL,2HEA,2HSI,2HNG, & 2H S,2HYS,2HTE,2HM ,2HTR,2HAC,2HKS/ DATA IERR4/2H I,2HLL,2HEG,2HAL,2H L,2HOC,2À>������þúHK ,2HRE,2HQU, & 2HES,2HT / DATA IERR5/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / DATA IERR6/2H L,2HIS,2HT ,2HFI,2HLE,2H E,2HRR,2HOR/ DATA IERR7/2H S,2HEL,2HEC,2HT ,2HFI,2HLE, 2H E,2HRR,2HOR/ DATA IERR8/2H B,2HAT,2HCH,2H F,2HIL,2HE ,2HER,2HRO,2HR / DATA MSG/2H W,2HAI,2HTI,2HNG,2H O,2HN ,2HDA,2HTA,2H B, & 2HAS,2HE / DATA NEXT/2HNE,2HXT,2H_ / DATA YES/2HYE,2HS / DATA NO /2HNO/ DATA IWAIT/2H D,2HAT,2HA ,2HBA,2HSE,2H I,2HS ,2HLO,2HCK,2HED, 12H O,2HR ,2HOP,2HEN,2H, ,2HDO,2H Y,2HOU,2H W,2HAN,2HT ,2HTO, 22H W,2HAI,2HT?/ DATA EDITOR/2HED,2HIT,2HR / C C C C C C C C C C C BEGIN C C CLOSE THE PROCEDURE FILE C CALL ECLOS(IDCB(2)) C C CLEAR THE PROCEDURE FLAG C IPFLAG = 0 C C CLEAR THE ECHO PROCEDURE FLAG C IOFLAG = 0 C C UNLOCK THE LIST LU C CALL LUREQ(RMOTE,0,ILP,IERR) C C RELEASE ALL SYSTEM TRACKS C CALL EXEC(5+100000B,-1) GOTO 7100 C C GET THE NEXT INPUT C 20 CONTINUE IF(.NOT. BATCH) CALL QRIO(2,INLU,NEXT,-5) C C DECODE COMMAND C WHEN THE INPUT IS A SEMICOLN ONLY IT IS ASSUMED THAT C A BATCH FILE JUST COMPLETED AND THE NEXT COMMAND IS C GOTTEN C CALL INPUT CALL LSCAN (IB,I,J,K) IF( K .EQ. 5) GOTO 20 CALL SFILL(IMA,1,12,40B) CALL SMOVE(IB,I,J,IMA,1) C C LOOK THE COMMAND UP IN THE TABLE C N = 0 DO 30 I2 = 1,14*12,12 N = N + 1 IF (JSCOM(CMDTBL,I2,I2+11,IMA ,1,IERR ) .EQ. 0) GOTO 40 30 CONTINUE C C INVALID COMMAND C CALL ERIO(2,ITTY,INVAL,9) GOTO 20 C C JUMP TABLE C C FIND ,REPORT,UPDATE,CREATE,DESTROY 40 GOTO(50, 100, 150, 200, 250, C DISPLAY,FORM ,EXIT ,HELP & 300, 350, 400, 450, C LIST ,EXECUTE,SELECT ,DATA-BASE,XEQ & 500, 500, 500, 500, 500) N C C C C C C C COMMAND PROCESSORS C C C C m[������þúC C C C FIND C 50 SNAM(2) = 2H00 GOTO 800 C C REPORT C 100 SNAM(2) = 2H02 GOTO 800 C C UPDATE C 150 SNAM(2) = 2H07 GOTO 800 C C CREATE PROCEDURE C 200 SNAM(2) = 2H09 GOTO 800 C C DESTROY PROCEDURE C 250 SNAM(2) = 2H11 GOTO 800 C C DISPLAY C 300 SNAM(2) = 2H10 GOTO 460 C C FORM C 350 SNAM(2) = 2H08 GOTO 460 C C EXIT C 400 SNAM(2) = 2H16 GOTO 800 C C HELP C 450 SNAM(2) = 2H13 C C LOCK THE LIST DEVICE C 460 CONTINUE CALL LUREQ(RMOTE,1,ILP,IERR) IF(IERR .NE. 0) GOTO 7080 GOTO 800 C C LIST, EXECUTE, SELECT-FILE, DATA-BASE C 500 CONTINUE N = N-9 CALL LSCAN(IB,I,J,K) IF(K .NE. 6 .AND. N .EQ. 2) GOTO 550 IF(K .NE. 6) GOTO 7010 C LIST ,EXECUTE,SELECT ,DATA-BASE , XEQ GOTO(520, 550, 600, 650, 700) N C C C LIST C 520 CONTINUE IF(ILP .LT. 0) CALL ECLOS(ILP(2)) CALL LSCAN(IB,I,J,K) CALL GTPRM(IMA,IB,J,I,ILP,ILP(2),.TRUE.,IERR) IF(IERR .LT. 0 .OR. ILP .EQ. 0) GOTO 7020 IF(ILP .GT.0) ILP = ILP+600B GOTO 20 C C EXECUTE C 550 CONTINUE S = K SNAM(2) = 2H24 GOTO 800 C C SELECT-FILE= C 600 CONTINUE CALL SFILL(SELECT,1,12,40B) CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 7010 C C GET THE FILE NAME C CALL NAMR(IMA,IB,J,I) IF(IAND(IMA(4),3B) .NE. 3) GOTO 7010 CALL OPEN(JDCB,IERR,IMA,0,IMA(5),IMA(6) ) IF(IERR .GE. 0) GOTO 610 IF(IERR .NE. -6) GOTO 7040 IF(IMA(8) .EQ. 0) IMA(8) = 6 CALL ECREA(JDCB,IERR,IMA,DBLEI(IMA(8)),1,IMA(5),IMA(6)) IF(IERR .LT. 0) GOTO 7040 C C VERIFY TYPE C 610 CONTINUE CALL ELOCF(JDCB,ISTAT,DUMMY,DUMMY, & DUMMY,JSEC,DUMMY,JTYP,JREC) IF((DCO(JSEC,DBLEI(6)).LT. 0) .OR. (JTYP .NE. 1) ) GOTO 7035 CALL SMOVE(IMA,1,12,SELECT,1) GOTO 20 C ������þú C DATA-BASE= C 650 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 7010 C C CLOSE THE DATA BASE IF NECESSARY C IF(DBNAM(2) .EQ. SPACE) GOTO 660 CALL DBCLS(DBNAM,DUMMY,1,ISTAT) IF(ISTAT .NE. 0) GOTO 7070 C C PUT NAME IN BUFFER C 660 CONTINUE CALL SFILL(DBNAM,1,20,40B) CALL SMOVE(IB,I,J,DBNAM,3) C C VERIFY SEMICOLN C CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 7050 C C GET LEVEL WORD, SUPRESSING THE ECHO WHEN INTERACTIVE C IF(BATCH) GOTO 665 CALL QRIO(2,INLU,LEVEL,-9) INLU = INLU - 400B 665 CALL LSCAN(IB,I,J,K) IF(.NOT. BATCH) INLU = INLU + 400B C C SEE IF A ";" WAS ENTERED C CALL SFILL(DBLEV,1,6,40B) IF(K .EQ. 5) GOTO 667 IF(J-I+1 .GT. 6) GOTO 7050 CALL SMOVE(IB,I,J,DBLEV,1) C C VERIFY SEMICOMMA C CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 7050 C C GET THE MODE C 667 CONTINUE IF(.NOT. BATCH) CALL QRIO(2,INLU,MODE,4) CALL LSCAN(IB,I,J,K) IF(I .NE. J) GOTO 7050 CALL SGET(IB,I,IMODE) IMODE = IMODE - 60B IF( (IMODE .LT. 1) .OR. ( IMODE .GT. 8) ) GOTO 7050 C C VERIFY SEMICOMMA C CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 7050 C C OPEN THE DATA BASE C CALL DBOPN(DBNAM,DBLEV,IMODE,ISTAT) IF(ISTAT .EQ. 0) GOTO 690 IF(ISTAT .NE. 129) GOTO 7070 C C DATA BASE IS LOCKED C 670 CONTINUE IF(BATCH) GOTO 680 CALL QRIO(2,INLU,IWAIT,25) CALL INPUT CALL LSCAN(IB,I,J,K) IF(JSCOM(IB,I,I+1,YES,1,IERR) .EQ. 0) GOTO 680 IF(JSCOM(IB,I,I+1,NO,1,IERR) .EQ. 0) GOTO 7055 GOTO 670 C C WAIT A WHILE C 680 CONTINUE CALL QRIO(2,ITTY,MSG,11) 685 CONTINUE CALL EXEC(12,0,2,0,-10) CALL DBOPN(DBNAM,DBLEV,IMODE,ISTAT) IF(ISTAT .EQ. 129) GOTO 685 IF(ISTAT .NE. 0) GOTO 7070 C C DONE WITH THE OPEN, SAVE THE LEVEL WORD NUMBER C 690 CONTINUE DBLEV = ISTAT(2) GOTO 2ÏÚ������þú0 C C C C C C C C C C C XEQ C 700 CONTINUE IF(XEQ .NE. 0) GOTO 710 C C SAVE THE INPUT DCB C CALL SMOVE(INLU,1,290,XEQ,1) XQBCH = BATCH GOTO 720 C C CLOSE THE DATA BASE C 710 CONTINUE CALL ECLOS(INLU(2)) C C OPEN THE FILE C 720 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 7010 CALL GTPRM(IMA,IB,J,I,INLU,INLU(2),.FALSE.,IERR) IF(IERR .LT. 0) GOTO 7090 C C ONLY ALLOW FILES AS XEQ INPUT C IF(INLU .GT. -1) GOTO 7090 C C SET THE BATCH FLAG C BATCH = .TRUE. GOTO 20 C C C C C C C C C C C C C C LOAD AND EXECUTE A SEGEMENT C 800 CONTINUE CALL LOAD(SNAM) C C SYNATAX ERROR C 7010 CONTINUE IP = 1 7014 IF(IEND .LE. 72) GOTO 7017 CALL QRIO(2,ITTY,IB(IP),-72) IEND = IEND - 72 IP = IP + 36 GOTO 7014 C C WRITE LAST LINE OUT C 7017 CALL QRIO(2,ITTY,IB(IP),-IEND) C C CALL SFILL(IMA,1,72,40B) IF(I .GT. 72) I = I - I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,IERR5,7 ) GOTO 20 C C BAD LIST FILE C 7020 CONTINUE CALL ERIO(2,ITTY,IERR6,8) GOTO 7095 C C IVALID REQUEST C 7030 CONTINUE CALL ERIO(2,ITTY,IERR2,9) GOTO 20 C C BAD SELECT FILE C 7035 CONTINUE CALL ERIO(2,ITTY,IERR1,17) SELECT=2H GOTO 20 C C SELECT FILE ERROR C 7040 CONTINUE CALL ERIO(2,ITTY,IERR7,9) SELECT = 2H GOTO 7095 C C ILLEGAL LEVEL WORD,OR MODE WORD C OUTPUT "INVALID REQUEST" C 7050 CONTINUE CALL ERIO(2,ITTY,IERR2,9) 7055 DBNAM = 2H DBNAM(2) = 2H GOTO 20 C C DBMS - ERROR C 7070 CONTINUE DBNAM = 2H DBNAM(2) = 2H QSERR = ISTAT SNAM(2) = 2H23 GOTO 800 C C ILLEGAL LOCK C 7080 CONTINUE CALL ERIO(2,ITTY,IERR4,11) GOTO 20 C C ILLEGAL XEQ FILEÙ›���*��($ C 7090 CONTINUE CALL ERIO(2,ITTY,IERR8,9 ) CALL SMOVE(XEQ,1,290,INLU,1) XEQ = 0 BATCH = XQBCH C C FMP ERROR C 7095 CONTINUE QSERR = IERR SNAM(2) = 2H23 GOTO 800 C C OUTPUT "ERROR RELEASING SYSTEM TRACKS" C 7100 CONTINUE CALL ERIO(2,ITTY,IERR3,15) GOTO 20 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������YÃ*������ÿÿ����� ���� ÿý�k� w ���������ÿ��92069-18063 1940� S C0122 �&QY00 �QY00 SOURCE � � � � � � � � � � � � �H0101 :#�����þúFTN4 PROGRAM QY00(5,90),92069-16060 REV.1940 790523 C C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18063 C RELOC: 92069-16060 C C C************************************************************ C C C FIND COMMAND SERVICE MODULE C QS00 C QS01 C C THE PURPOSE OF THIS MODULE IS TO BREAK DOWN C A FIND PROCEDURE (IN DISJUNCTIVE NORMAL FORM) C INTO A TABLE OF ELEMENTARY CONJUNCTS AND C DISJUNCTS. THIS TABLE WILL BE USED BY A C 'SEARCH' MODULE TO RETRIEVE RECORDS FROM A C DATA BASE. C LOGICAL ISPTH,MEMBR INTEGER IBUF(51) INTEGER BUFF(130) INTEGER SAVBF(130) INTEGER SAVE(5) INTEGER ISTAT(10) INTEGER FIND(2) INTEGER NAME(2) INTEGER AND(2),OR,END(2) INTEGER INE(2),ILT(2),INLT(2),IGT(2),INGT(2) INTEGER INA(3) INTEGER IREG(2) INTEGER ERR1(14) INTEGER ERR2(12) INTEGER ERR3(15) INTEGER ERR4(14) INTEGER ERR6(22) INTEGER ERR7(16) INTEGER ERR8(14) INTEGER ERR9(13) INTEGER ERR10(19) INTEGER ERR11(12) INTEGER ERR12(19) INTEGER ERR13(13) INTEGER ERR16(19) INTEGER ERR18(7) INTEGER ERR19(27) INTEGER ERR20(15) INTEGER R,X,D INTEGER FIND INTEGER VALUE(11) C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INÃ1������þúTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE (REG,IREG,IA),(IREG(2),LEN) DATA AND(1),AND(2)/2HAN,2HD / DATA OR/2HOR/ DATA END/2HEN,2HD;/ DATA IS/2HIS/ DATA IE/2HIE/ DATA INE(1),INE(2)/2HIN,2HE / DATA ILT(1),ILT(2)/2HIL,2HT / DATA INLT(1),INLT(2)/2HIN,2HLT/ DATA IGT(1),IGT(2)/2HIG,2HT / DATA INGT(1),INGT(2)/2HIN,2HGT/ DATA INA(1),INA(2),INA(3)/2HIS,2HNO,2HT / DATA ERR1/2H N,2HO ,2H A,2HVA,2HIL,2HAB,2HLE,2H S,2HYS,2HTE,2HM , & 2HTR,2HAC,2HKS/ DATA ERR2/2H F,2HIN,2HD ,2HPR,2HOC, 1 2HED,2HUR,2HE ,2HTO,2HO ,2HLO,2HNG/ DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE , 2 2HXX,2HXX,2HXX/ DATA ERR4/2H R,2HEL,2HAT,2HIO,2HNA,2HL , 1 2HOP,2HER,2HAT,2HOR,2H I,2HNV,2HAL,2HID/ DATA ERR6/2H I,2HNV,2HAL,2HID,2H #,2H O, 1 2HF ,2HVA,2HLU,2HES,2H F,,)������þú2HOR,2H R,2HEL, 2 2HAT,2HIO,2HNA,2HL ,2HOP,2HER,2HAT,2HOR/ DATA ERR7/2HIN,2HVA,2HLI,2HD ,2HLO,2HGI, 1 2HCA,2HL ,2HCO,2HNN,2HEC,2HTO,2HR , 2 2HXX,2HXX,2HXX/ DATA ERR8/2H N,2HOT,2H E,2HNO,2HUG,2HH ,2HSE,2HCT,2HOR,2HS ,2HIN, 12H Q,2HSK,2HIB/ DATA ERR9/2H S,2HEL,2HEC,2HT-,2HFI,2HLE, ERR9 1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD / ERR9 DATA ERR10/2H R,2HET,2HRI,2HEV,2HAL, ERR10 1 2H F,2HRO,2HM ,2HMO,2HRE,2H T,2HHA, ERR10 2 2HN ,2HON,2HE ,2HDA,2HTA,2H-S,2HET/ ERR10 DATA ERR11/2H D,2HAT,2HA-,2HBA,2HSE, 1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD / DATA ERR12/2H N,2HON,2H-N,2HUM,2HER,2HIC,2H I, 1 2HN ,2HRE,2HAL,2H O,2HR ,2HIN,2HTE,2HGE,2HR , 1 2HVA,2HLU,2HE / DATA ERR13/2H D,2HAT,2HA ,2HIT,2HEM,2H V,2HAL, 1 2HUE,2H T,2HOO,2H L,2HON,2HG / DATA ERR16/2H I,2HNV,2HAL,2HID,2H D,2HAT, & 2HA ,2HIT,2HEM,2H V,2HAL,2HUE,2H O,2HR , & 2HTE,2HRM,2HIN,2HAT,2HOR/ DATA ERR18/2H B,2HAD,2H D,2HAT,2HA ,2HSE,2HT / DATA ERR19/2H I,2HTE,2HM ,2HNO,2HT ,2HME,2HMB,2HER, & 2H O,2HF ,2HDA,2HTA,2H S,2HET,2H O,2HR ,2HDA,2HTA, & 2H S,2HET,2H N,2HOT,2H S,2HPE,2HCI,2HFI,2HED/ C CAN'T ACCESS AUTOMATIC MASTER DATA ERR20/2H C,2HAN,2H'T,2H A,2HCC,2HES,2HS ,2HAU,2HTO, & 2HMA,2HTI,2HC ,2HMA,2HST,2HER/ DATA NAME/2HNA,2HME/ DATA FIND/2HFI,2HND/ DATA X/130B/ DATA R/122B/ DATA D/104B/ DATA VALUE/2HWH,2HAT,2H I,2HS ,2HTH, 1 2HE ,2HVA,2HLU,2HE ,2HOF,2H _/ DATA IQSEC/6/ DATA MAXLN/255/ C C C C C C C C C C C C BEGIN C DO 1 J=1,50 DO 1 I=1,15 S(I,J) = 0 1 CONTINUE RRCNT = 0 IF(DBNAM.NE.2H ) GOTO 5 C ERROR DATA-BASE NOT DECLARED CALL ERIO(2,ITTY,ERR11,12) GOTO 10 5 CONTINUE C C GET SYSTï®������þúEM TRACKS C C RELEASE ANY PREVIOUS QSKIB TRACKS C CALL EXEC(100005B,1,TRKNM,IDILU) I=I GOTO 6 C C GET A NEW TRACK FOR QSKIB C 6 CALL EXEC(4,1,TRKNM,IDILU,NSEC) NSEC=NSEC/2 IF (TRKNM.GE.0)GOTO15 C ERROR - NOT ANY TRACKS AVAILABLE FOR QSKIB CALL ERIO(2,ITTY,ERR1,14) C C EXIT FIND WITH ERROR C 10 CONTINUE SNAM(2)=2H CALL LOAD(SNAM) C C VERIFY THE SELECT FILE C 15 IF(SELECT.NE.2H ) GOTO 110 C ERROR - SELECT-FILE NOT DECLARED CALL ERIO(2,ITTY,ERR9,13) GO TO 10 C C C C BEGIN PROCESSING FIND COMMAND C C C FIND SETNM.ITEM <RELATIONAL OPERATOR> "VALUE" END; C OR C FIND SETNM.ITEM <RELATIONAL OPERATOR> "VALUE","VALUE" END; C OR C FIND SETNM.ITEM <RELATIONAL OPERATOR> "VALUE" <CONNECTOR> C ITEM <RELATIONAL OPERATOR> "VALUE" END; C C C 110 CONTINUE IOFF=1 NOWSEC=0 R3 = 1 DSNUM = 0 IDISP = 1 C C C C C LOOP TO SET UP S-ARRAY C C C C 200 CONTINUE IF (R3.LE.50) GO TO 230 C ERROR - FIND PROCEDURE TOO LONG CALL ERIO(2,ITTY,ERR2,12) GO TO 10 230 CALL LSCAN(IB,I,J,K) I1 = I J1 = J C SYMBOL? IF (K.EQ.2) GO TO 280 C ERROR - ILLEGAL DATA ITEM NAME 250 DO 251 M=13,15 251 ERR3(M)=2H IF ((J1-I1+1).GT.6) J1=I1+5 CALL SMOVE(IB,I1,J1,ERR3,25) CALL ERIO (2,ITTY,ERR3,15) GO TO 10 C ERROR - RETRIEVAL FROM MORE THAN ONE DATA-SET 260 CALL ERIO(2,ITTY,ERR10,19) GO TO 10 C C ERROR - BAD SET C 265 CALL ERIO(2,ITTY,ERR18,7) GOTO 10 C C OUTPUT "ITEM NOT MEMBER OF DATA SET" C 267 CALL ERIO(2,ITTY,ERR19,27) GOTO 10 C C VERIFY VALID DATA-ITEM C 280 CALL SFILL(DINAM,1,6,40B) IF(J-I.GT.5) GOTO 250 CALL SMOVE(IB,I,J,DINAM,1) C CHECK FOR PROCEDURE C "NAME="? C SCAN FOR "=" C CALL LSCAN(IB,I,J,K) IF (R3.NE.1) GO TO 281 IF (J1-I1+1.NE.4) GO TO 281 ½<������þú IF (JSCOM(NAME,1,4,DINAM,1,IERR).NE.0) GO TO 281 IF (K .NE. 6) GOTO 281 C C GET THE PROCEDURE NAME C CALL GTPRC(FIND,4,IERR) IF(IERR .NE. 0) GOTO 10 IOFLAG = 1 GOTO 110 C C WAS A DATA SET GIVEN WITH THE ITEM? C 281 CONTINUE IF(K .NE. 7) GOTO 283 CALL DBINF(DBNAM,DINAM,201,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 265 IBUF = IABS(IBUF) C C VERIFY THAT THIS DATA SET IS THE FIRST TO BE DEFINED, C OR ELSE MATCHES THE DATA SET ALREADY DEFINED C IF(DSNUM .EQ. 0) DSNUM = IBUF IF(DSNUM .NE. IBUF) GOTO 260 C C GET THE ITEM NAME C CALL LSCAN(IB,I,J,K) I1=I J1=J C COMMA? IF(K .NE. 2) GOTO 250 CALL SFILL(DINAM,1,6,40B) IF(J-I .GT. 5) GOTO 250 CALL SMOVE(IB,I,J,DINAM,1) CALL LSCAN(IB,I,J,K) C C GET THE ITEM'S NUMBER C 283 CONTINUE CALL DBINF(DBNAM,DINAM,101,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 250 DINUM = IABS(IBUF) S(1,R3) = DINUM C C VERIFY ITEM BELONGS TO DECLARED SET C IF ( MEMBR(DBNAM,DSNUM,DINUM,ISTAT) .EQ. .FALSE. ) GOTO 267 C C GET ITEM'S CHARACTERISTICS C CALL DBINF(DBNAM,DINUM,102,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 250 C C GET THE ITEM TYPE C CALL SGET(IBUF,17,ITYPE) S(8,R3) = ITYPE C C GET ITEM LENGTH C S(9,R3) = IBUF(10) S(15,R3) = IBUF(11) C C CALCULATE OFFSET INTO RECORD C IF(R3 .LE. 1) GOTO 35 DO 30 INDX = R3-1,1,-1 IF(S(1,INDX) .EQ. DINUM) GOTO 40 30 CONTINUE 35 CONTINUE S(10,R3) = IDISP INDX = IBUF(10) * IBUF(11) IF(ITYPE .EQ. X) INDX = INDX/2 IDISP = IDISP + INDX GOTO 45 C C OFFSET IS THE SAME AS THE EARLIER DECLARED ITEM C 40 S(10,R3) = S(10,INDX) C C SET PATH FLAG C 45 CONTINUE S(12,R3) = 1 IF(ISPTH(DBNAM,DSNUM,DINUM,ISTAT) .EQ. .FALSE.) S(12,R3) = 0 IF(ISTAT .NE. 0) GOTO 250 C C GET CAPACTY AND TYPE C \æ������þú CALL DBINF(DBNAM,DSNUM,202,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 265 CALL SGET(IBUF,17,S(11,R3) ) S(13,R3) =IBUF(14) S(14,R3) = IBUF(15) C C DECODE RELATIONAL OPERATOR C 290 CONTINUE GO TO (291,292,293,294,295) (J-I+1) C C ERROR - RELATIONAL OPERATOR INVALID C 291 CALL ERIO(2,ITTY,ERR4,14) GO TO 10 292 S(2,R3)=1 IF(JSCOM(IB,I,J,IS,1,IERR).EQ.0) GO TO 300 IF(JSCOM(IB,I,J,IE,1,IERR).EQ.0) GO TO 300 GO TO 291 293 S(2,R3)=2 IF(JSCOM(IB,I,J,INE,1,IERR).EQ.0) GO TO 300 S (2,R3) = 3 IF(JSCOM(IB,I,J,ILT,1,IERR).EQ.0) GO TO 300 S(2,R3) = 5 IF(JSCOM(IB,I,J,IGT,1,IERR).EQ.0) GO TO 300 GO TO 291 294 S(2,R3)=4 IF(JSCOM(IB,I,J,INLT,1,IERR).EQ.0) GO TO 300 S(2,R3) = 6 IF(JSCOM(IB,I,J,INGT,1,IERR).EQ.0) GO TO 300 GO TO 291 295 S(2,R3)=2 IF (JSCOM(IB,I,J,INA,1,IERR).NE.0) GO TO 291 C GET DATA ITEM VALUE AND PUT IN QSKIB FILE C ENTER SECTOR AND WORD OFFSET OF VALUE 300 S(3,R3)=IOFF S(6,R3)=NOWSEC 350 CALL LSCAN(IB,I,J,K) IF (K.EQ.3) GO TO 400 C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR CALL ERIO(2,ITTY,ERR16,19) GO TO 10 400 LEN=J-I+1 IF (LEN.EQ.0) GO TO 405 C MOVE VALUE FOR CONVERSION IF (LEN.LE.MAXLN) GO TO 421 C DATA ITEM VALUE TOO LONG CALL ERIO(2,ITTY,ERR13,13) GO TO 10 421 CALL SMOVE(IB,I,J,BUFF,1) GO TO 410 C C REQUEST VALUE FORM USER C THE FOLLOWING CODE IS KLUDGED UP BECAUSE THE SUBROUTINES C INPUT AND LSCAN GET THEIR PARAMETERS FROM COMMON AND ARE C VERY INFLEXIBLE. SINCE INPUT READS INTO THE BUFFER IB C UNTIL IT REACHES THE CHARACTER LIMIT IBSZ, MODIFYING ISCAN C AND IEND, THE BUFFER IB, ISCAN, AND IEND MUST BE SAVED. C IBSZ WILL BE MODIFIED TO INDICATE THE LENGTH OF THE SECONDARY C BUFFER CALLED BUFF, SO IBSZ MUST ALSO BE SAVED. THERE IS NO C NEED TO ECHO THE INPUT BECAUSE THE INPUT IS NOT FROM A PROCEDURE ¦8������þúC FILE, SO IPFLAG AND IOFLAG MUST BE SAVED THEN SET TO ZERO. C ALL THE PARAMETERS MUST BE RESTORED BEFORE CALLING THE SUBROUTINE C ERIO, BECAUSE ERIO RETURNS TO QS WHENEVER A BATCH FILE IS BEING C EXECUTED. C C C 405 CONTINUE CALL SFILL(BUFF,1,260,40B) CALL SMOVE(IB,1,260,SAVBF,1) SAVE(1) = IBSZ SAVE(2) = ISCAN SAVE(3) = IEND SAVE(4) = IPFLAG SAVE(5) = IOFLAG C C RESET IBSZ TO INDICATE THE SMALL BUFFER C IBSZ = 130 IPFLAG = 0 IOFLAG = 0 C C IF THIS IS BATCH SKIP THE PROMPT C IF(BATCH) GOTO 4052 CALL QRIO(2,INLU,VALUE,11) CALL QRIO(2,INLU,DINAM,3) C C GET THE INPUT C 4052 CONTINUE CALL INPUT CALL LSCAN(IB,I,J,K) LEN = 0 IF(K .EQ. 5) GOTO 4054 IF(K .EQ. 3) GOTO 4053 C C ERROR - RESTORE THE PARAMETERS C CALL SMOVE(SAVBF,1,260,IB,1) IBSZ = SAVE(1) ISCAN = SAVE(2) IEND = SAVE(3) IPFLAG = SAVE(4) IOFLAG = SAVE(5) C CALL ERIO(2,ITTY,ERR16,19) GOTO 405 C C PUT THE BUFFER INTO BUFF FOR PROCESSING C 4053 CONTINUE LEN = J-I+1 IF(LEN .EQ. 0) GOTO 4054 CALL SMOVE(IB,I,J,BUFF,1) C C RESTORE THE ORIGINAL INPUT BUFFER C 4054 CONTINUE CALL SMOVE(SAVBF,1,260,IB,1) IBSZ = SAVE(1) ISCAN = SAVE(2) IEND = SAVE(3) IPFLAG = SAVE(4) IOFLAG = SAVE(5) C C IF THE INPUT IS NULL THEN DEFAULT IT C IF (LEN.EQ.0) LEN = 1 C C FILL LAST BYTE WITH BLANK C 410 CALL SPUT(BUFF,(LEN+1),40B) C C CONVERT REAL OR INTEGER VALUE FORM ASCII C IF (ITYPE.EQ.X) GO TO 416 IF (ITYPE.EQ.R) GO TO 417 C CONVERT TO INTEGER CALL CATI(BUFF,1,LEN,INT,ISTAT) IF (ISTAT.EQ.0) GO TO 418 C NON-NUMERIC IN REAL OR INTEGER VALUE 419 CALL ERIO (2,ITTY,ERR12,19) GO TO 10 418 CONTINUE BUFF(1)=INT LEN=2 GO TO 416 C CONVERT TO REAL 417 REAL=CATR(BUFF,1,LEN,ISTAT{¨������þú) IF (ISTAT.NE.0) GO TO 419 CALL SMOVE (REAL,1,4,BUFF,1) LEN=4 C ENTER VALUE 416 LENFLG=0 C LENGTH IN WORDS LEN=(LEN+1)/2 DO 411 MOVE=0,LEN IF (LENFLG.EQ.1) GO TO 414 IBUFF(IOFF)=LEN LENFLG=1 GO TO 415 414 IBUFF(IOFF)=BUFF(MOVE) 415 IOFF=IOFF+1 IF (IOFF.LE.IBSZ) GO TO 411 C BUFFER FULL - WRITE TO QSKIB IF ((NOWSEC+IQSEC).LE.NSEC) GO TO 412 C NOT ENOUGH SECTORS IN QSKIB 413 CALL ERIO(2,ITTY,ERR8,14) GO TO 10 412 CALL EXEC (2,IDILU,IBUFF,IBSZ,TRKNM,NOWSEC) NOWSEC=NOWSEC+IQSEC IOFF=1 411 CONTINUE S(4,R3)=S(4,R3)+1 S(7,R3)=S(7,R3)+1 IF (S(2,R3).LT.3) GO TO 620 IF (S(4,R3).EQ.1) GO TO 620 C ERROR - INVALID # OF VALUES FOR RELATIONAL OPERATOR CALL ERIO(2,ITTY,ERR6,22) GO TO 10 C C C C ERROR - INVALID LOGICAL CONNECTOR C 610 DO 611 M=14,16 611 ERR7(M)=2H M=J IF((M-I+1).GT.6) M=I+5 CALL SMOVE(IB,I,M,ERR7,27) C C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR C CALL ERIO(2,ITTY,ERR7,16) GO TO 10 C C C 620 CONTINUE CALL LSCAN (IB,I,J,K) IF (K.EQ.4) GO TO 350 IF (K.EQ.2) GO TO 500 C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR CALL ERIO (2,ITTY,ERR16,19) GO TO 10 C C IS THIS AN "AND" CONNECTOR? C 500 IF (J-I+1.NE.3) GO TO 640 IF (JSCOM(IB,I,J,AND,1,IERR).NE.0) GO TO 650 S(5,R3) = 1 630 R3 = R3 + 1 GO TO 200 C C IS THIS AN "OR" CONNECTOR C 640 IF (J-I+1.NE.2) GO TO 610 IF (JSCOM(IB,I,J,OR,1,IERR).NE.0) GO TO 610 S(5,R3) = 2 GO TO 630 C C IS THIS AN "END" STATEMENT C 650 IF(JSCOM(IB,I,J,END,1,IERR).NE.0) GO TO 610 CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 610 S(5,R3) = 3 C C MOVE VALUES ARRAY, IBUFF, TO BUFF C DO 720 J=1,(IOFF-1) IMA(J)=IBUFF(J) 720 CONTINUE C C C IF (NOWSEC.EQ.0) GO TO 750 C ŒQ���6��40 WRITE LAST SECTORS TO QSKIB FILE IF ((NOWSEC+IQSEC).GT.NSEC) GO TO 413 CALL EXEC (2,IDILU,IBUFF,IBSZ,TRKNM,NOWSEC) C SAVE CURRENT SECTOR NUMBER OF QSKIB 750 SECNO =NOWSEC C C CALL SEARCH TO RETRIEVE RECORDS C SNAM(2) = 2H01 CALL LOAD(SNAM) END $ ��/q6������ÿÿ����� ���� ÿý�l� z ���������ÿ��92069-18064 1912� S C0122 �&QY01 �QY01 SOURCE � � � � � � � � � � � � �H0101 9&�����þúFTN4 PROGRAM QY01(5,90),92069-16060 REV. 1912 790112 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18064 C RELOC: 92069-16060 C C C************************************************************ C C C*********************************************************************** C C SEARCH SERVICE MODULE C C QS01 ENTERS RECORD NUMBERS OF RECORDS WHICH SATISFY THE FIND C IN THE SELECT FILE, AND PRINTS ON TTY THE TOTAL NUMBER OF C QUALIFYING RECORDS. QS01 OBTAINS INFORMATION ABOUT THE C FIND FROM THE S-ARRAY, WHICH IS BUILT BY QS00 C S IS A 12,50 ARRAY. EACH ROW CONTAINS THE FOLLOWING C INFORMATION ABOUT A RELATION: C 1. DATA ITEM NUMBER C 2. RELATION CODE C 1-IS,IE C 2-INE,ISNOT C 3-ILT C 4-INLT C 5-IGT C 6-INGT C 3. QSKIB WORD OFFSET. QSKIB IS A RTE DISC TRACK C WHICH CONTAINS ALL DATA ITEM VALUES IN A FIND, C EACH VALUE IS C PRECEEDED BY ITS CHARACTER LENGTH. THIS PARAMETER C POINTS TO THE WORD OFFSET OF THE FIRST VALUE C FOR THIS RELATION, FROM THE BEGINNING OF A BLOCK. C 4. NUMBER OF DATA ITEM VALUES FOR THIS RELATION C 5. LOGICAL CONNECTOR CODE C NEXT CONNECTOR IS: C 1-AND C 2-OR C 3-END C 6. QSKIÁQ������þúB SECTOR OFFSET. CONTAINS THE SECTOR NUMBER, C OF THE FIRST SECTOR IN THE BLOCK, OF THE FIRST C VALUE FOR THIS RELATION C 7. NUMBER OF DATA ITEM VALUES FOR THIS RELATION, C LESS VALUES FOR DUPLICATE KEYS. QS00 SETS THIS C PARAMETER TO NUMBER OF DATA ITEM VALUES (SAME C AS ROW 4). IF A CHAINED OR KEYED READ IS C POSSIBLE, QS01 SEARCHES FOR DUPLICATE KEYS C WITH DUPLICATE ITEM VALUES. WHEN ONE IS FOUND, C THIS PARAMETER IS DECREMENTED. C 8. DATA ITEM TYPE. ASCII CODE IN R1 FORMAT: C "I"-INTEGER C "R"-REAL C "X"-ASCII C 9. LENGTH OF DATA ITEM AS RETURNED FROM DBMS C 10. OFFSET IN WORDS OF THIS ITEM FROM BEGINNING OF C RECORD. C 11. DATA SET TYPE C 12. KEY CODE C 0-ITEM IS NOT A KEY C 1-ITEM IS A KEY C 13. FIRST WORD OF DOUBLE WORD CAPACITY C 14. SECOND WORD OF DOUBLE WORD CAPACITY C 15. NUMBER OF SUBITEMS C C C STRATEGY C C C THERE ARE A FEW RULES FOR DETERMINING WHEN A CHAINED C READ WILL BE USED VERUS A DIRECTED READ. THE RULES C ARE AS FOLLOWS, C C EVERY "AND" PHRASE MUST CONTAIN A KEY ITEM C REFERENCE WITH A "IE" RELATION AND: C C WHEN THE DATA SET IS A MASTER, ALL VALUES IN C EACH RELATION MUST NOT EXCEED THE "IBUFF" BUFFER. C C WHEN THE DATA SET IS A DETAIL, ALL VALUES IN C EACH RELATION MUST NOT EXCEED THE "IBUFF" BUFFER, C AND THE NUMBER OF DIFFERENT KEY ITEMS USED MUST C NOT EXCEED ONE, AND THERE MUST NOT BE MORE THAN C FIVE DIFFERENT VALUES FOR THE KEY ITEM. C C Ïi������þú THESE RULES WILL ALLOW QUERY TO DETERMINE WHETHER C A RECORD QUALIFIES TO BE PLACED IN THE SELECT FILE C WITHOUT HAVING TO SELECT A RECORD TWICE, IE. C IF A DETAIL DATA SET WERE TO HAVE TWO DIFFERENT C KEY ITEMS ONE RECORD MIGHT EXIST IN BOTH CHAINS. C C ASSUME AN "AND STRING" IS THE LONGEST STRING OF <RETRIEVE C STATEMENTS> PRECEEDING ANY "OR" OR "END" <LOGICAL CONNECTOR>. C IF THERE IS AT LEAST ONE KEY ITEM WITH AN "IS" RELATION C IN EVERY "AND STRING" C 1. A KEYED READ WILL BE PERFORMED IF THE SET IS MASTER C 2. CHAIN READ(S) WILL BE PERFORMED IF THE SET IS DETAIL C AND IF THE # OF CHAIN DOES NOT EXCEED A SPECIFIED MAXIMUM. C THE CHAIN OR KEYED READ WILL BE PERFORMED FOR EACH VALUE C OF THE KEY SPECIFIED IN THE RELATION C NOTE: THE KEY WILL BE THE FIRST KEY ENCOUNTERED ON KEY "IS" C IN THE "AND STRING". FOR MAX EFFICIENCY, THE USER SHOULD C SPECIFY THE KEY WHOSE VALUES HAVE THE SHORTEST CHAIN(S) C AS THE FIRST KEY IN AN "AND STRING" C C IF THERE IS AT LEAST ONE "AND STRING" WHICH DOES NOT CONTAIN C AT LEAST ONE KEY ITEM WITH AN "IS" RELATION, A SERIAL C READ IS PERFORMED. C A KEYED READ GETS ONLY ONE RECORD WITH THE SPECIFIED C KEY ITEM VALUE IN THE MASTER SET. C A CHAIN READ GETS EVERY RECORD WITH THE KEY ITEM C VALUE IN THE DETAIL SET. C A SERIAL READ GETS EVERY RECORD IN THE DATA SET. C EVERY RECORD IS EVALUATED FOR THE ENTIRE <RETRIEVE STATEMENT>. C IF IT QUALIFIES, THE RECORD # IS PLACED IN THE SELECT FILE. C IF CHAIN OR CERTAIN KEYED READS ARE BEING PERFORMED, THE C QUALIFYING RECORD # IS ORED INTO A BITMAP TO PREVENT C DUPLICATION. UPON COMPLETION OF ALL RECORD READS, C QUALIFYING RECORD NUMBERS IN THE BIT MAP ARE PLACED IN C THE SELEf^������þúCT FILE. C C DEFINITION OF VARIABLES C KEYS-ARRAY OF INDICES TO S-ARRAY FOR ITEMS IN CHAIN OR KEYED C READS C NKEYS-COUNT OF KEY ITEMS FOR CHAIN READS C SELT-128-WORD BUFFER CONTAINING QUALIFYING RECORD #S. C WHEN FULL, IT IS WRITTEN TO NEXT SECTOR OF SELECT BUFFER C IPTR-POINTER TO SELT C RSEC-SECTOR POINTER TO SELT C RRCNT-NUMBER OF RECORDS RETRIEVED C IMA-CORE BUFFER CONTAINING VALUES (BLOCK FROM QSKIB) C SECNO -SECTOR # SPECIFYING QSKIB BLOCK CURRENTLY IN IMA C IBUFF-BUFFER INTO WHICH DBMS DATA RECORD IS READ C BUFPTR-IBUFF POINTER. POINTS TO HALF OF IBUFF INTO WHICH C RECORD IS READ C KEYPTR-IF A KEY "IS" IS FOUND IN "AND STRING", KEYPTR C IS COLUMN NDX TO S-ARRAY FOR THAT RELATION, ELSE C KEYPTR IS 0 C MAXCHN-MAX # OF CHAINS FOR CHAIN READS IN DETAILS C DSNUM-DATA SET #, SET BY QS00 C DINUM-DATA ITEM # C ITYPE-DATA ITEM TYPE C *LOOP1* KEYNDX-NDX IN DO LOOP FOR CHAIN OR KEYED READS. POINTS TO C KEY ENTRY IN KEY ARRAY, ONE PASS THRU LOOP FOR EVERY KEY C I-NDX TO S-ARRAY FOR CURRENT KEY ON KEY OR CHAIN READ, C POINTED TO BY KEYNDX C *LOOP2* VALPTR-NDX IN DO LOOP FOR VALUES IN CHAIN OR KEY READS. C ONE PASS FOR EACH VALUE IN RELATION. C NVAL-TERMINAL VALUE FOR DO LOOP. # OF VALUES FOR KEY IN C RELATION. C IOFF1-WORD OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN C CHAIN OR KEYED READ C ISEC1-SECTOR OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN C CHAIN OR KEYED READ C IARG1-ARRY CONTAINING DATA ITEM VALUE USED AS VALUE ARG C IN CHAIN OR KEYED READ. ENTERED BY VALUE SUBROUTINE C *LOOP3* ITEM-NDX IN DO LOOP WHICH READS AND EVALUATES: C 1.EACH RECORD IN CHAIN ON A CHAIN READ C 2.1 RECORD ON A KEYED READ ©Õ������þúC 3.EACH RECORD IN THE DATA SET ON A SERIAL READ C LOOP-TERMINAL VALUE FOR LOOP. C 1.ON CHAIN READ-# OF RECORDS IN CHAIN C 2.ON KEYED READ-1 C 3.ON SERIAL READ-CAPACITY OF DATA SET C RECNO-RECORD # OF CURRENT RECORD BEING EVALUATED C AND-0 IF "AND STRING" FALSE C 1 IF "AND STRING" TRUE C *LOOP4* RDB-NDX TO DO LOOP FOR EVALUATING CURRENT RECORD FOR C EVERY RELATION IN S-ARRAY. RDB IS COLUMN NDX C TO S-ARRAY C R3-TERMINAL VALUE IN DO LOOP. # OF ENTRIES IN S-ARRAY. C SET BY QS00. C LOGIC-0 IF RELATION FALSE IN <RETRIEVE STATEMENT> C (RELATION) IN CURRENT RECORD C 1 IF RELATION TRUE IN CURRENT RECORD C FOR MULTIVALUE: IS OR IE-SET TO 1 IF TRUE FOR AT LEAST C 1 DATA ITEM VALUE C INE OR ISNOT-SET TO 1 IF TRUE FOR EVERY C DATA ITEM VALUE C *LOOP5* IVAL-NDX TO DO LOOP FOR EVALUATING RECORD FOR EVERY C VALUE IN THE RELATIONAL. VALUE COUNTER C IARG2-ARRAY CONTAINING DATA ITEM VALUE FOR EVALUATION C OF RELATION. ENTERED BY VALUE SUBROUTINE. C *LOOP5* END C *LOOP4* END C *LOOP3* END C *LOOP2* END C *LOOP1* END C BITMAP-BITMAP OF RETRIEVED RECORDS.CORRESPONDING BIT SET TO 1 C IF RECORD QUALIFIES. C C*********************************************************************** C INTEGER RDB INTEGER LLIST(128) INTEGER YES(2) INTEGER VALPTR INTEGER SPTR1,SPTR2,VALNDX INTEGER CHANCT INTEGER VALSIZ INTEGER AND INTEGER OFFSET INTEGER COMP1,COMP2 INTEGER DISK,OVFLO INTEGER QUALFY(17) INTEGER R,X C INTEGER KEYS(50) INTEGER PROCED(12) INTEGER IANS(2) INTEGER IARG1(128),IARG2(128) INTEGER OVFLO(11) INÛ™������þúTEGER ISTAT(10) INTEGER ITEMP(2) INTEGER IRRCNT(2),LOOP(2) INTEGER IRECN(2) REAL ARG,RECNO,RARG C LOGICAL DDS C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE(ITEMP(1),RSORT),(IARG2(2),RARG) EQUIVALENCE(RECNO,IRECN) EQUIVALENCE(LLIST,LIST) C DATA PROCED/2H S,2HER,2HIA,2HL ,2HRE,2HAD,2H I,2HN ,2HPR, & 2HOG,2HRE,2HSS / DATA YES/2HYE,2HS / DATA NO/2HNO/ DATA MAXCHN/5/ DATA VALSIZ/128/ DATA ISPACE/2H / DATA DISK/2/ DATA R/122B/ DATA X/130B/ C SELECT FILE OVERFLOW DATA OVFLO/2H S,2HEL,2HEC,2HT ,2HFI,2HLE,2ç������þúH E,2HRR,2H0R,2H ,2H / DATA QUALFY/2H ,2HXX,2HXX,2HXX,2HXX,2HXX,2H E,2HNT,2HRI,2HES, &2H Q,2HUA,2HLI,2HFI,2HED/ C C C C C C C C C C C BEGIN C C C C INITIALIZE PARAMETERS C NKEYS=0 RSEC = DBLEI(1) RRCNT=0 C C PUT OVERHEAD IN SELECT BUFFER C C OVERHEAD CONSISTS OF 18 BYTES OF DATA BASE NAME C 2 BYTES CONTAINING DATA SET NUMBER C 4 BYTES CONTAINING DOUBLE INTEGER COUNT C 8 BYTES FOR FUTURE USE C C CALL SMOVE(DBNAM,3,20,SELT,1) CALL SMOVE(DSNUM,1,2,SELT,19) CALL SMOVE(RRCNT,1,4,SELT,21) CALL SFILL(SELT,25,32,0) IPTR = 8 C C CREATE THE LIST PARAMETER FOR THE DBMS CALLS C LLIST(1) = 0 DO 110 I=1,R3 IF(LLIST .LE. 0) GOTO 117 DO 115 I2 = 2,LLIST(1) + 1 IF(LLIST(I2) .EQ. S(1,I) ) GOTO 110 115 CONTINUE 117 LLIST = LLIST + 1 LLIST(LLIST + 1) = S(1,I) 110 CONTINUE C C C DETERMINE WHETHER CHAIN OR KEY READ POSSIBLE, AND SAVE KEY PTRS C IN KEYS ARRAY C KEYPTR=0 DO 100 RDB=1,R3 C IS ITEM A KEY? IF (S(12,RDB).EQ.0) GO TO 1 C IS RELATION 'IS'? IF (S(2,RDB).NE.1) GO TO 1 C KEY "IS" ENCOUNTERED YET? IF NOT, SAVE PTR TO KEY ENTRY IN S. IF(KEYPTR.EQ.0) KEYPTR=RDB C AND CONNECTOR? 1 IF (S(5,RDB).EQ.1) GO TO 100 C IF NO KEY "IS" IN "AND STRING" GO TO SERIAL READ. IF(KEYPTR.EQ.0) GO TO 2 C ENTER S-ARRAY NDX OF KEY IN KEYS ARRAY NKEYS=NKEYS+1 KEYS(NKEYS)=KEYPTR KEYPTR=0 100 CONTINUE C KEYED OR CHAIN READ POSSIBLE GO TO 7 C C SERIAL READ C "SERIAL READ IN PROGRESS " 2 CALL QRIO(2,ITTY,PROCED,12) GOTO 6 C SET RETRIEVE COUNT TO ZERO C C C C RETURN TO NEXT? C C 4 SNAM(2)=2H CALL LOAD(SNAM) C C SELECT FILE OVERFL]k������þúOW C 41 CONTINUE CALL QRIO(2,ITTY,OVFLO,11) C C ERROR - DBMS OR FMP ERROR PROCESSOR C 5 CONTINUE RRCNT = 0 QSERR = ISTAT SNAM(2) = 2H23 CALL LOAD(SNAM) C C DO DIRECTED READ TO RESET RECORD PTR C 6 IMODE=2 ARG = 0 CALL DBGET(DBNAM,DSNUM,4,ISTAT,LLIST,IBUFF,ARG) IF (ISTAT.NE.0) GO TO 5 C INITIALIZE DO-LOOP PARAMETERS TO GO THRU KEYED READ LOOPS ONCE C SET LOOP COUNT TO CAPACITY LOOP = S(13,1) LOOP(2) = S(14,1) KEYNDX=0 NKEYS=0 VALPTR=1 NVAL=1 GO TO 14 C C CHAINED OR HASHED READ C C C C C SEARCH FOR DUPLICATE KEYS IF # OF KEYS>1 AND ALL VALUES IN CORE C NOTE: SECNO IS PASSED TO QS01 BY QS00, IT IS THE C CURRENT SECTOR # OF QSKIB. IF IT IS ZERO THEN C EVERYTHING IS STILL IN MEMORY. C C C 7 IF (NKEYS.EQ.1) GO TO 9 IF (SECNO.NE.0) GO TO 9 C LOOP FOR EACH KEY IN KEYS ARRAY DO 600 KEYPT1=1,(NKEYS-1) SPTR1=KEYS(KEYPT1) ITEM1=S(1,SPTR1) C LOOP FOR ALL FOLLOWING KEYS IN KEYS ARRAY DO 500 KEYPT2=(KEYPT1+1),NKEYS SPTR2=KEYS(KEYPT2) ITEM2=S(1,SPTR2) IF (ITEM1.NE.ITEM2) GO TO 500 C TWO KEYS HAVE SAME ITEM #, NOW SEE IF VALUES MATCH IOFF1=S(3,SPTR1) C LOOP FOR ALL VALUES OF 1ST ITEM DO 400 IVAL1=1,S(4,SPTR1) LEN1=IABS(IMA(IOFF1)) IOFF2=S(3,SPTR2) C LOOP FOR ALL VALUES OF 2ND ITEM DO 300 IVAL2=1,S(4,SPTR2) LEN2=IABS(IMA(IOFF2)) IF (LEN1.NE.LEN2) GO TO 8 IPTR1=IOFF1+1 IPTR2=IOFF2+1 C COMPARE VALUES DO 200 VALNDX=1,LEN1 IF (IMA(IPTR1).NE.IMA(IPTR2)) GO TO 8 •¶������þú IPTR1=IPTR1+1 IPTR2=IPTR2+1 200 CONTINUE C***** IDENTICAL VALUES HAVE BEEN FOUND - NEGATE C LENGTH FOR 2ND VALUE AND DECREMENT # OF VALUES C IN S ARRAY IMA(IOFF2)=-IMA(IOFF2) S(7,SPTR2)=S(7,SPTR2)-1 8 IOFF2=IOFF2+LEN2+1 300 CONTINUE IOFF1=IOFF1+LEN1+1 400 CONTINUE 500 CONTINUE 600 CONTINUE C C IF DETAIL SET AND CHAIN READS CAN BE PERFORMED, CHECK WHETHER C TOTAL # OF CHAINS EXCEEDS MAX. IF SO, DO SERIAL READ. C 9 IF (S(11,1).NE. 104B) GOTO 10 CHANCT=0 DO 700 KEYCNT=1,NKEYS RDB=KEYS(KEYCNT) CHANCT=CHANCT+S(7,RDB) IF (CHANCT.GT.MAXCHN) GO TO 2 700 CONTINUE C C DO SERIAL READ IF MORE THAN 1 KEY AND C A. DETAIL OR C B. MASTER WITH ALL VALUES NOT IN CORE (IN WHICH CASE C DUPLICATE KEY VALUES NOT ELIMINATED) C 10 IF (NKEYS.EQ.1) GO TO 12 IF (S(11,1) .EQ. 104B) GOTO 11 IF (SECNO.EQ.0) GO TO 12 11 GOTO 2 C C C THE FOLLOWING SERIES OF LOOPS READS RECORDS,EVALUATES THEM C FOR THE FIND, AND PUTS THEM IN SELECT FILE IF C THEY QUALIFY C C LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH KEY IN KEYS ARRAY 12 DO 1500 KEYNDX=1,NKEYS I=KEYS(KEYNDX) IOFF1=S(3,I) ISEC1=S(6,I) NVAL=S(4,I) C C LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH VALUE C ASSOCIATED WITH KEY ITEM DO 1400 VALPTR=1,NVAL DO 800 J1=1,VALSIZ 800 IARG1(J1)=ISPACE C PICK UP VALUE OF KEY ITEM IN IARG1 CALL VALUE(IARG1,ISEC1,IOFF1) C IF KEY VALUE DUPLICATE, LOOP TO GET NEXT VALUE IF (IARG1(1).LT.0) GO TO 1400 IF (S(11,I) .EQ. 104B) C+������þúGOTO 13 C FOR MASTER, CHAIN COUNT IS ALWAYS 1, SET MODE FOR KEYED C READ C IMODE = 7 LOOP(1) = 0 LOOP(2) = 1 GO TO 14 13 IMODE = 5 DINUM=S(1,I) C C FOR DETAIL,SET UP FOR CHAIN READ AND PICK UP CHAIN COUNT C CALL DBFND(DBNAM,DSNUM,1,ISTAT,DINUM,IARG1(2) ) IF(ISTAT .EQ. 156 .OR. ISTAT .EQ. 107) GOTO 1400 IF (ISTAT.NE.0) GO TO 5 LOOP(1) = ISTAT(5) LOOP(2) = ISTAT(6) C C LOOP TO READ EACH RECORD IN A CHAIN OR, ON SERIAL READ, C EACH RECORD IN THE DATA SET C 14 CONTINUE IF (IFBRK(IDUM).NE.0) GOTO 4 CALL DBGET(DBNAM,DSNUM,IMODE,ISTAT,LLIST,IBUFF, & IARG1(2) ) C C END OF SERIAL READ? C IF (ISTAT.EQ.12) GO TO 26 IF(ISTAT .EQ. 107 .OR. ISTAT .EQ. 155) GOTO 1400 IF(ISTAT .NE. 0) GOTO 5 C C RECORD # C IRECN(1) = ISTAT (3) IRECN(2) = ISTAT (4) C C INITIALIZE EVALUATOR FOR "AND STRING" C AND=1 C C LOOP TO EVALUATE ALL RELATIONS FOR THIS RECORD C DO 1200 RDB=1,R3 C C INITIALIZE RELATION INDICATOR C LOGIC=0 OFFSET=S(10,RDB) LEN=S(9,RDB) IOFF2=S(3,RDB) ISEC2=S(6,RDB) C C LOOP FOR MULTI-VALUE RELATION C DO 1100 IVAL=1,S(4,RDB) DO 900 J2=1,VALSIZ 900 IARG2(J2)=ISPACE C C PICK UP VALUE IN IARG2 C ‘������þú CALL VALUE(IARG2,ISEC2,IOFF2) IF (S(8,RDB).EQ.R) GO TO 170 COMP1 = OFFSET * 2 - 1 IF(S(8,RDB) .EQ.X) GOTO 150 C C COMPARE INTEGER RECORD VALUE WITH FIND VAL C INTGR = IBUFF(OFFSET) INTGR2 = IARG2(2) IF(INTGR) 910,920,920 910 IF(INTGR2) 930,15,15 920 IF(INTGR2) 16,930,930 930 IF(INTGR-INTGR2) 15,17,16 C C COMPARE ASCII VALUES C 150 IF(JSCOM(IBUFF,COMP1,COMP1+LEN-1, & IARG2,3,IERR) ) 15,17,16 C C COMPARE REAL RECORD VAL WITH REAL FIND VAL C 170 ITEMP(1)=IBUFF(OFFSET) ITEMP(2)=IBUFF(OFFSET+1) IF(RSORT) 171,172,172 171 IF(RARG) 173,15,15 172 IF(RARG) 16,173,173 173 IF(RSORT-RARG) 15,17,16 C C REC VAL < FIND VAL AND ILT,INGT - TRUE C 15 GOTO (1100,1100,18,1100,1100,18)S(2,RDB) C C REC VAL > FIND VAL AND INLT,IGT - TRUE C 16 GOTO(1100,1100,1100,18,18,1100)S(2,RDB) C C REC VAL=FIND VAL---IS,INLT,INGT-TRUE; C ILT,IGT,ISNOT-FALSE 17 GO TO (18,19,19,18,19,18) S(2,RDB) C C TRUE FOR AT LEAST 1 VALUE,JUMP OUT OF LOOP C 18 LOGIC=1 GO TO 19 C C NOT TRUE FOR THIS VALUE C 1100 CONTINUE C C RELATION FALSE FOR ALL VALUES, SO TRUE ô/������þúIF ISNOT C IF (S(2,RDB).EQ.2) LOGIC=1 C C SUCCESSIVELY EVALUATE "AND STRING" C 19 AND=AND*LOGIC IF (S(5,RDB).EQ.1) GO TO 1200 C C END OF "AND STRING". IF TRUE FOR 1 "AND STRING" C RECORD QUALIFIES, SO JUMP OUT OF LOOP C IF (AND.EQ.1) GO TO 20 AND=1 1200 CONTINUE C C ALL RELATIONS FALSE FOR THIS RECORD C GO TO 1300 C C RECORD QUALIFIES, SAVE RECORD C 20 CONTINUE IPTR=IPTR+1 IF (IPTR.LT.65) GO TO 22 CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC) IF (ISTAT.LT.0) GOTO 41 RSEC=DIN(RSEC) IPTR=1 22 SELT(IPTR)=RECNO C C INCREMENT RECORD COUNT C RRCNT = DIN(RRCNT) 1300 CONTINUE IF( DDS(LOOP)) GOTO 1400 GOTO 14 C 1400 CONTINUE C 1500 CONTINUE C C C FINAL WRAPUP - ALL RECORDS HAVE BEEN COMPARED C C IF ANY RECORDS QUALIFY WRITE BUFFER TO SELECT FILE C 26 CONTINUE IF(IPTR .EQ. 0) GOTO 30 CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC) IF(ISTAT.LT.0)GOTO 41 C C PUT COUNT IN OVERHEAD C 30 CONTINUE RSEC = DBLEI(1) CALL EREAD(JDCB,ISTAT,SELT,128,LEN,RSEC) IF(ISTAT .LT. 0) GOTO 41 CALL SMOVE(RRCNT,1,4,SELT,21) CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC) IF(ISTAT .LT.0) GOTO 41 C C OUTPUT THE RECORD COUNT TO THE USER C CALL DCITA(RRCNT,QUALFY(2)) CALL QRIO(2,ILP,QUALFY,15) GO TO 4 C END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ È���N����L�H�������������������������������������������������������������������������HN�������ÿÿ����� ���� ÿý�m� ���������ÿ��92069-18065 1940� S C0122 �&QY02 �QY02 SOURCE � � � � � � � � � � � � �H0101 >%�����þúFTN4 PROGRAM QY02(5,90),92069-16060 REV.1940 790523 C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18065 C RELOC: 92069-16060 C C C************************************************************ C C C REPORT SERVICE ROUTINE C MADE UP OF C 1. QS02 C 2. QS03 C 3. QS04 C 4. QS05 C 5. QS06 C 6. QS15 C 7. QS12 C 8. QS19 C 9. QS20 C C C C C THE STRUCTURE OF THE SEGEMENTS IS DIAGRAMED BELOW. C C C QS02 - PICKS UP THE REPORT STATEMENTS C ! C -----------! C ! ! C QS03 ! REPORT ALL INITIALIZE C ! ! C QS18 ! PRINT ALL C ! ! C QS ! C QS04 - VERIFIES SYNTAX OF EACH STATEMENT C ! C -------- C ! ! C QS05 ! PREPARES FOR SORT C ! ! C QS19 ! SORTS THE RECORDS C ! ! C -------- C ! C QS06 PREPARES TO PRINT C ! C ----> QS15 --> QS CHECKS FOR LEVEL BREAKS C ! ! C ! -------- C ! ! ! C ! QS12 ! PRINTS TOTALS ON BREAKS C ! ! ! C ! -------- C ! ! C ! QS20 TOTALS EACH FIELD AND PRINTS C ! ! DETAILS OR GROUP BREAKS C <------- C C C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C Tó·������þúHIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY IS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAI=™������þúN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C C C C C C C C C C C C C C C C ANY CHANGE TO IBSZ MUST CHANGE THE SIZE OF ISORT C INTEGER ISTAT(10) DIMENSION INFO(13) INTEGER R7,Z,Z1,R5 INTEGER PAGE(3) INTEGER A,B,D,E,F,G,H,TCHAR,ASTER,DOLLAR,X INTEGER DZERO(2) INTEGER ERR1(15) INTEGER ERR2(20) INTEGER ERR3(21) INTEGER ERR4(7) INTEGER ERR5(13) INTEGER ERR6(16) INTEGER ERR7(14) DIMENSION NAME(2) INTEGER END(2) INTEGER ALL(2) INTEGER REPORT(3) C LOGICAL MEMBR C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6)E\������þú,L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA PAGE/2HPA,2HGE,2HNO/ DATA A/101B/ DATA B/102B/ DATA D/104B/ DATA E/105B/ DATA F/106B/ DATA G/107B/ DATA H/110B/ DATA IS/123B/ DATA TCHAR/124B/ DATA IZ/132B/ DATA DOLLAR/44B/ DATA X/130B/ DATA ASTER/52B/ DATA NINE/71B/ DATA DZERO/0,0/ C RECORD HAS NOT YET BEEN FOUND DATA ERR1/2H R,2HEC,2HOR,2HD ,2HHA,2HS ,2HNO, 1 2HT ,2HYE,2HT ,2HBE,2HEN,2H F,2HOU,2HND/ C COMAND TABLE OVERFLOW REISSUE COMMAND DATA ERR2/2H C,2HOM,2HMA,2HND,2H T,2HAB, 1 2HLE,2H O,2HVE,2HRF,2HLO,2HW,,2H R, 2 2HEI,2HSS,2HUE,2H C,2HOM,2HMA,2HND/ C ILLEGAL DATA ITEM NAME OR TOO LOW ACCESS DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE , 2 2HOR,2H T,2HOO,2H L,2HOW,2H A,2HCC,2HES,2HS / C SYNTAX ERROR DATA ERR4/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / C EDIT MASK TABLE OVERFLOW DATA ERR5/2H E,2HDI,2HT ,2HMA,2HSK,2H T, 1 2HAB,2HLE,2H O,2HVE,2HRF,2HLO,2HW / C CONSTANT LITERAL TABLE OVERFLOW DATA ERR6/2H C,2HON,2HST,2HAN, 1 2HT ,2HLI,2HTE,2HRA,2HL ,2HTA, 2 2HBL,2HE ,2HOV,2HER,2HFL,2HOW/ C NO AVAILABLE SYSTEM TRACKS DATA ERR7/2H N,2HO ,2H A,2HVA,2HIL,2HAB,2HLE,2H S,2HYS,2HTE,2HM , & 2HTR,2HAC,2HKS/ C CAN NOT TOTAL ASCII VALUES C BAD SEGMENT DATA NAME/2HNA,2HME/ DATA END/2HEN,2HD;/ DATA ALL/2HAL,2HL / DATA REPORT/2HRE,2HPO,2HRT/ C C C C C C C C C C C THIS PROGRAM IS A REPORT GENERATOR. THE C SELECT-FILE CONTAINS THE RECORD NUMBERS C OF THE RECORDS WHICH ARE TO BE REPORTED. C C THE ARRAY S IS A 7*100 ARRAY WHICH C CONTAINS ENCODED REPORT COMMANDS. C C R3 - IS THE COUNTER FOR THE NUMBER OF C COMMANDS ENTERED C R6 - IS THg²������þúE CONSTANT LITERAL AND C EDIT MASK DISK STORAGE INDEX IN BYTES C R7 - IS THE EDIT MASK COUNT C C C C C C C C C C BEGIN C IOFLAG = 0 C CHECK FOR PROCEDURE CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GOTO 30 IF(JSCOM(NAME,1,4,IB,I,IERR).NE.0) GO TO 30 C SCAN ACROSS = CALL LSCAN(IB,I,J,K) IF(K.NE.6) GO TO 180 C C GET PROCEDURE NAME C CALL GTPRC(REPORT,6,IERR) IF(IERR .NE. 0) GOTO 140 IOFLAG = 0 CALL LSCAN(IB,I,J,K) C C IS THE PROCEDURE SUPPOSE TO BE PRINTED? C 30 CONTINUE IF(K .NE. 4) GOTO 35 CALL LSCAN(IB,I,J,K) IOFLAG = 1 CALL LSCAN(IB,I,J,K) C C IS THIS A "REPORT ALL [,NL] " ? C 35 CONTINUE IF(K .EQ. 5) GOTO 40 IF(J-I .NE. 2) GOTO 180 IF(JSCOM(IB,I,J,ALL,1,IERR) .NE. 0) GOTO 180 SNAM(2) = 2H03 GOTO 310 C C REPORT ; C 40 CONTINUE IF(DCO(RRCNT,DZERO))50,50,60 50 CALL ERIO(2,ITTY,ERR1,15) GOTO 140 C C GET SYSTEM TRACKS C 60 CONTINUE CALL EXEC(100004B,1,TRKNM,IDILU,NSEC) GOTO 65 C C SEE IF ANY TRACKS WERE RETURNED BY THE EXEC CALL C 63 IF (TRKNM .GE. 0) GOTO 67 C C OUTPUT "NO AVAILABLE SYSTEM TRACKS" C 65 CONTINUE CALL ERIO(2,ITTY,ERR7,14) GOTO 140 C C INITIALIZE S-ARRAY C 67 CONTINUE DO 70 J=1,100 DO 70,I=1,7 SS(I,J) = 0 70 CONTINUE C C INITIALIZE COUNTERS C R3 = 1 R6 = 1 R7 = 0 C C IS THIS AN "END;" ? C 80 CALL LSCAN(IB,I,J,K) CALL SGET(IB,I,ICHAR) IF(J-I.NE.2) GOTO 90 IF(JSCOM(IB,I,J,END,1,IERR).EQ.0) GO TO 290 C C MUST BE REPORT STATEMENT C 90 CONTINUE IF(J-I.GT.1) GO TO 180 C C SORT STATEMENT C C IS ICHAR AN "S"? C IF (ICHAR.NE.IS) GO TO 190 C C IS THERE A LEVEL # C IF (I.NE.J) GO TO 100 SS(1,R3) = 10 GO TO 110 C C GET SORT LEVEL C 100 CALL SGET(IB,J,ICHAR) ª˜������þú ICHAR = ICHAR - 60B IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 SS(1,R3) = 10 + ICHAR C C SCAN FOR COMMA C 110 CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 180 C C GET DATA ITEM NAME C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 180 IF (J-I.GT.5) GO TO 180 CALL SFILL(DINAM,1,6,40B) CALL SMOVE(IB,I,J,DINAM,1) CALL DBINF(DBNAM,DINAM,101,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 160 DINUM = IABS(INFO) C C IS THIS A MEMBER OF THE SET? C IF(MEMBR(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 130 120 IF(ISTAT .EQ. 0) GOTO 160 C C DBMS - ERROR C QSERR = ISTAT SNAM(2) = 2H23 GOTO 300 C C PUT ITEM NUMBER IN THE SS-ARRAY C 130 CONTINUE SS(2,R3) = DINUM C C C PROCESSOR FOR SEMICOLN C AT END OF EACH REPORT STATEMENT C C C SCAN TO ; CALL LSCAN(IB,I,J,K) IF (K.NE.5) GO TO 180 135 R3 = R3 +1 IF (R3.LE.100) GO TO 80 C ERROR - COMMAND TABLE OVERFLOW CALL ERIO(2,ITTY,ERR2,20) 140 SNAM(2) = 2H GOTO 300 C C C C ERROR PROCESSORS C C C C C ERROR - CONSTANT LITERAL OVERFLOW 150 CALL ERIO(2,ITTY,ERR6,16) GO TO 140 C ERROR - ILLEGAL DATA ITEM NAME 160 CALL QRIO(2,ITTY,IB,-IEND) CALL ERIO(2,ITTY,ERR3,21) GOTO 140 C RETURN TO TTY FOR INPUT C ERROR - SYNTAX ERROR 180 CALL SFILL(IMA,1,72,40B) C C OUTPUT ERROR LINE IN MULTIPLE OF 72 COLUMNS C IP = 1 185 CONTINUE IF (IEND .LE. 72) GOTO 187 CALL QRIO(2,ITTY,IB(IP),-72) IP = IP + 36 IEND = IEND - 72 GOTO 185 C C WRITE LAST LINE C 187 CONTINUE CALL QRIO(2,ITTY,IB(IP),-IEND) IF(I .GT.72) I = I-I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,ERR4,7) GO TO 140 C C HEADER STATEMENT C 190 IF (ICHAR.NE.H) GO TO 240 C C GET LEVEL NUMBER C CALL SGET(IB,J,ICHAR) ICHAR = ICHAR - 60B IF (RB������þúICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 SS(1,R3) = 20 + ICHAR C C SCAN FOR COMMA C CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 180 C C GET HEADER DATA TYPE C CALL LSCAN(IB,I,J,K) C C LITERAL ? C IF (K.EQ.3) GO TO 210 C C PAGE DECLARATION? C IF(J-I.NE.5) GOTO 180 IF (JSCOM(PAGE,1,6,IB,I,IERR).NE.0) GO TO 180 SS(2,R3) = 1 C C THIS IS THE PRINT POSITION AND PRINT OPTION PROCESSOR C FOR TOTAL, GROUP, AND DETAIL STATEMENTS C C SCAN FOR COMMA C 200 CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 180 C C END PRINT POSITION C CALL LSCAN(IB,I,J,K) CALL CATI(IB,I,J-I+1,INT,ISTAT) IF(ISTAT.LT.0) GOTO 180 IF (INT.LT.1 .OR. INT.GT.132) GO TO 180 SS(4,R3) = INT C C CHECK FOR SEMI-COLON C CALL LSCAN(IB,I,J,K) IF (K.EQ.5) GO TO 135 C C FORM REPORT OPTIONS C PUT OPTIONS IN SS(5,N) AND SS(6,N) C CALL REPOP(I,J,IERR) IF (IERR) 180,135 C C LITERAL PROCESSOR C 210 LEN = J - I + 1 IF(LEN.GT.0) GOTO 220 I=J+2 GOTO 180 220 CONTINUE IF(LEN.GT.COLLIM) GOTO 180 IF(R6+LEN+2 .GT. IBSZ*2) GOTO 150 C C MOVE LITERAL TO BUFFER C SS(3,R3) = R6 CALL SMOVE(LEN,1,2,IBUFF,R6) R6 = R6 + 2 CALL SMOVE(IB,I,J,IBUFF,R6) R6 = R6 + LEN GO TO 200 C C TOTAL STATEMENT C 240 K2 = 30 IF (ICHAR.NE.TCHAR) GO TO 270 CALL SGET(IB,J,ICHAR) C C IS THIS A "TF" STATEMENT? C IF (ICHAR.NE.F) GO TO 250 ICHAR = 6 GO TO 260 C C GET LEVEL NUMBER C 250 ICHAR = ICHAR - 60B IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 180 260 SS(1,R3) = K2 + ICHAR C SCAN ACROSS TERMINATOR CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 180 C GET TOTAL DATA TYPE CALL LSCAN(IB,I,J,K) C TOTAL LITERAL IF (K.EQ.3) GO TO 210 C DATA ITEM IF (J-I.GT.5) GO TO 180 CALL SFILLfj������þú(DINAM,1,6,40B) CALL SMOVE(IB,I,J,DINAM,1) CALL DBINF(DBNAM,DINAM,101,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 160 DINUM = IABS(INFO) SS(2,R3) = DINUM C C VERIFY THAT ITEM IS A MEMBER OF THE CORRECT SET C 265 CONTINUE IF(MEMBR(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 200 GOTO 120 C C GROUP STATEMENT C 270 K2 = 40 IF (ICHAR.NE.G) GO TO 280 CALL SGET(IB,J,ICHAR) GO TO 250 C C DETAIL STATEMENT C 280 IF(ICHAR.NE.D) GO TO 320 K2 = 50 C C DOES THIS DETAIL STATEMENT HAVE A LEVEL C ICHAR = 0 IF(I .EQ. J) GOTO 260 C C NO, GET THE LEVEL NUMBER C CALL SGET(IB,J,ICHAR) ICHAR = ICHAR-60B IF(ICHAR .LT. 1 .OR. ICHAR .GT. 9) GOTO 180 GOTO 260 C C C C "END;" PROCESSOR C C CHECK FOR ; 290 CALL LSCAN(IB,I,J,K) IF (K.NE.5) GO TO 180 R3 = R3 - 1 IF(R3.LE.0) GOTO 140 C C WRITE IBUFF TO QSKIB C CALL EXEC(2,IDILU,IBUFF,-R6,TRKNM,0) C C CALL LOGIC C SNAM(2) = 2H04 300 CONTINUE 310 CONTINUE CALL LOAD(SNAM) C C C EDIT STATEMENT C 320 IF(ICHAR.NE.E) GO TO 180 CALL SGET(IB,J,ICHAR) ICHAR = ICHAR - 60B IF (ICHAR.LT.0 .OR. ICHAR.GT.9) GO TO 180 SS(1,R3) = 60 + ICHAR C SCAN PAST COMMA CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 180 C GET EDIT MASK CALL LSCAN(IB,I,J,K) IF (K.NE.3) GO TO 180 Z = 0 DO 370 Z1=J,I,-1 CALL SGET (IB,Z1,ICHAR) C CHAR AN X - THEN ALPHA EDIT MASK IF(ICHAR.EQ.130B) GOTO 380 C CHECK FOR 'Z' IF (ICHAR.NE.IZ) GO TO 340 IF (Z.NE.1 .AND. Z.NE.0) GO TO 180 Z = 1 GO TO 370 C C CHECK FOR '*' 340 IF (ICHAR.NE.ASTER) GO TO 350 IF (Z.NE.2 .AND. Z.NE.0) GO TO 180 Z = 2 GO TO 370 C C CHECK FOR '$' 350 IF (ICHAR.NE.DOLLAR) GO TO 360 IF (Z.NE.3 .AND. Z.NE.0) GO TO 180 Z = 3 GODþ���6��40 TO 370 C C CHECK FOR '9' 360 IF (ICHAR.NE.NINE) GO TO 370 IF (Z.NE.0) GO TO 180 370 CONTINUE C C C C C C C C C NUMERIC EDIT MASK C CHECK FOR NO MORE THAN 20 CHARACTERS IF(J-I.GT.19) GOTO 180 IF(J-1.LT.0) GOTO 180 GOTO 390 C C ALPHA EDIT MASK - MAX 132 CHARS C 380 IF(J-I+1 .GT. COLLIM) GOTO 180 C C EDIT MASK C 390 CONTINUE LEN = J - I + 1 IF(R6 + LEN + 2 .GT. IBSZ*2) GOTO 150 IF(LEN .LT. 1) GOTO 180 C C MOVE MASK TO BUFFER C SS(3,R3) = R6 CALL SMOVE(LEN,1,2,IBUFF,R6) R6 = R6 + 2 CALL SMOVE(IB,I,J,IBUFF,R6) R6 = R6 + LEN C C INCREASE THE EDIT MASK COUNT C R7 = R7 + 1 IF (R7.LE.10) GO TO 410 C ERROR - EDIT MASK OVERFLOW CALL ERIO(2,ITTY,ERR5,13) GO TO 140 C SCAN TO ';' 410 CALL LSCAN(IB,I,J,K) IF (K.EQ.5) 135,180 END $ ����������������������������������������������������������������������������������������������������������������������Fv6������ÿÿ����� ���� ÿý�n� | ���������ÿ��92069-18066 1912� S C0122 �&QY03 �QY03 SOURCE � � � � � � � � � � � � �H0101 =(�����þúFTN4 PROGRAM QY03(5,90),92069-16060 REV.1912 790205 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18066 C RELOC: 92069-16060 C C C************************************************************ C C C THIS MODULE WILL REPORT "ALL" DATA RECORDS C WITHOUT REPORT FORMATING OR EDITING C C THE "REPORT ALL" PROCESSOR IS BROKEN INTO THREE MODULES: C C QS03 - BUILDS THE SCOOP TABLE WHICH CONTAINS INFORMATION C ABOUT EACHITEM IN THE DATA SET. C QS17 - READS THE DATA RECORD FROM THE DATA SET C QS18 - FORMATS AND PRINTS EACH DATA ITEM'S VALUE C C C NULL ASCII DATA-ITEMS WILL BE FILLED C WITH " "S; INTEGER AND REAL DATA-ITEMS WILL C PRINT AS ZEROS(0). C C RRCNT IS A COUNT OF RETRIEVED RECORDS C WITHIN SELECT-FILE. C LOGICAL IFTTY INTEGER ITEMS(128) INTEGER INFO(13) INTEGER DZERO(2) INTEGER ISTAT(10) INTEGER ERR1(13) INTEGER ERR2(12) INTEGER ERR3(9) INTEGER BLANK INTEGER SCOOP(128,6) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN Ì������þú INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C SCOOP IS A 128 BY 6 ARRAY, WHICH CONTAINS AN ENTRY FOR C EACH ITEM IN THE DATA SET. THE FIRST ENTRY CONTAINS C THE RCOUNT OF CURRENT ENTRIES. THE OTHERS CONTAIN THE C FOLLOWING INFORMATION: C C WORD 1-3 CONTAINS THE ITEM NAME C WORD 4 CONTAINS THE ITEM TYPE C WORD 5 CONTAINS THE ITEM LENGTH C WORD 6 CONTAINS THE ELEMENT COUNT C C ITEMS IS A 128 WORD ARRAY WHICH CONTAINS THE INFORMATION RETURNED C FROM A DBINF MODE 104. C C SELT CONATINS A RECORD FROM THE SELECT FILE. C C RCOUNT IS THE NUMBER OF DBMS RECORDS SELECTED IN THE SELECT FILE. C C RSEC IS THE CURRENT RECORD NUMBER OF THE SELECT FILE C C IPTR IS THE OFFSET INTO THE SELECT FILE RECORD IN SELT C C LIST IS A FLAG C 0 INDICATES PRINT ITEM NAME C 1 SUPPRESSES THE PRINTING OF THE ITEM NAME C C C EQUIVALENCE(SCOOP,IB) EQUIVALENCE(ITEMS,IB(769)) EQUIVALENCE(LLIST,S(1,1) ) C C RECORD NOT YET BEEN FOUND DATA ERR1/2H R,2HEC,2HOR,2HD ,2HNO,2HT ,2HYE,2HT ,2HBE,2HEN, & 2H F,2HOU,2HND/ C ULLEGAL LOCK REQUEST DATA ERR2/2H I,2HLL,2HEG,2HAL,2H L,2HU ,2HLO,2HCK,2H R,2HEQ, & 2HUE,2HST/ C SELECT-FILE ERROR DAi������þúTA ERR3/2H S,2HEL,2HEC,2HT-,2HFI,2HLE,2H E,2HRR,2HOR/ C BAD SEGMENT C DATA DZERO/0,0/ DATA BLANK/2H / C C C C C C C C C C C C C C C C C BEGIN C LLIST = 0 CALL LSCAN(IB,I,J,K) IF(K .NE. 5) LLIST = 1 C C INTIALIZE SECTOR NUMBER, AND OFFSET INTO SECTOR FOR SELECT FILE C RSEC = DBLEI(1) C C READ THE FIRST RECORD OF THE SELECT FILE C CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 135 RCOUNT = SELT(6) RRCNT = SELT(6) CALL SMOVE(SELT,19,20,DSNUM,1) IPTR = 9 RSEC = DIN(RSEC) C C VERIFY THAT RECORDS ARE SELECTED C IF(DCO(RRCNT,DZERO) )5,5,10 5 CALL ERIO(2,ITTY,ERR1,13) GOTO 130 C C GET ALL ITEMS IN THIS DATA SET C 10 CONTINUE CALL DBINF(DBNAM,DSNUM,104,ISTAT,ITEMS) IF(ISTAT .NE. 0) GOTO 140 IF(ITEMS .LE. 0) GOTO 130 C C PUT THE INFORMATION NECESSARY FOR PRINTING OUT THE ITEM VALUES C IN THE ARRAY "SCOOP". SCOOP IS 128 BY 6. THERE IS A ROW FOR C EACH POSSIBLE ITEM IN A DATA ENTRY. C C WORD 1-3 CONTAINS THE ITEM NAME C WORD 4 CONTAINS THE ITEM TYPE C WORD 5 CONTAINS THE ITEM LENGTH C WORD 6 CONTAINS THE ITEM ELEMENT COUNT C SCOOP(1,1) = ITEMS DO 20 ITM = 2,ITEMS+1 C C GET THE ITEM NUMBER IGNORING THE TYPE OF ACCESS C MODIFY THE "ITEMS" TO CONTAIN ONLY POSITIVE ENTRIES SO IT C CAN BE USED BY DBGET C DINUM = IABS(ITEMS(ITM)) ITEMS(ITM) = DINUM C C GET THE ITEM CHARACTERISTICS C CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 140 SCOOP(ITM,1) = INFO(1) SCOOP(ITM,2) = INFO(2) SCOOP(ITM,3) = INFO(3) CALL SGET(INFO,17,SCOOP(ITM,4)) SCOOP(ITM,5) = INFO(10) SCOOP(ITM,6) = INFO(11) 20 CONTINUE C C LOCK THE PRINT DEVICE C CALL LUREQ(RMOTE,1,ILP,IERR) IF(IERR .NE. 0) GOTO 150 CALL TOPAG(RMOTE,ILP,IERR) C C LOAD AND EXECUTE SEGEMENT TO GET DATA ÇÔ�����ITEM C 30 CONTINUE SNAM(2) = 2H17 CALL LOAD(SNAM) C C LOAD THE COMMAND INTERPETER SEGMENT C 130 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) C C SELECT-FILE ERROR C 135 CONTINUE CALL QRIO(2,ITTY,ERR3,9) C C C DBMS ERROR AND FMP ERRORS C 140 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 CALL LOAD(SNAM) C C ILLEGAL LU LOCK REQUEST C 150 CONTINUE CALL ERIO(2,ITTY,ERR2,12) GOTO 130 END $ ����������������������������Ý»������ÿÿ����� ���� ÿý�o�x ���������ÿ��92069-18067 2026� S C0122 �&QYO4 &QYO4 � � � � � � � � � � � � � �H0101 ÌË�����þúFTN4 PROGRAM QY04(5,90),92069-16060 REV.2026 800507 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18067 C RELOC: 92069-16060 C C ALTERED: FEBRUARY 21, 1980 TO INCREASE SIZE OF X - CEJ C C C************************************************************ C C C THIS PROGRAM PERFORMS ALL THE LOGIC C CHECKING FOR REPORT PROCEDURE C C C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY IS USED TO HOLD IN2Õ������þúDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. OFFSET INTO LIST-ARRAY (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C C C C C C C C C C C C INTEGER X(7),Q(255),R5 INTEGER XASCII INTEGER R INTEGER INFO(13) INTEGER ISTAT(10) INTEGER ERR1(19) INTEGER ERR2(23) INTEGER ERR3(14) INTEGER ERR4(13) INTEGER ERR5(25) INTEGER ERR6(22) INTEGER ERR7(17) INTEGER ERR8(20) INTEGER ERR9(21) INTEGER ERR10(14) INTEGER ERR11(18) INTEGER ERR12(13) INTEGER ERROR(8) C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILUrI������þú INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C SORT LEVEL XX IS MISSING OR DUPLICATED DATA ERR1/2H S,2HOR,2HT ,2HLE,2HVE, 1 2HL ,2HXX,2H I,2HS ,2HMI,2HSS,2HIN, 2 2HG ,2HOR,2H D,2HUP,2HLI,2HCA,2HTE/ C DUPLICATE DATA ITEM NAMES IN SORT STATEMENTS DATA ERR2/2H D,2HUP,2HLI,2HCA,2HTE,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HES, 2 2H I,2HN ,2HSO,2HRT,2H S,2HTA,2HTE,2HME,2HNT,2HS / C CONTROL BREAK INCONSISTENCY DATA ERR3/2H C,2HON,2HTR,2HOL,2H B,2HRE, 1 2HAK,2H I,2HNC,2HON,2HSI,2HST,2HEN,2HCY/ C DUPLICATE EDIT STATEMENTS DATA ERR4/2H D,2HUP,2HLI,2HCA,2HTE,2H E, 1 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/ C INCONSISTENCY BETWEEN OPTIONS AND EDIT STATEMENTS DATA ERR5/2H I,2HNC,2HON,2HSI, 1 2HST,2HEN,2HCY,2H B,2HET,2HWE,2HEN, 2 2H O,2HPT,2HIO,2HNS,2H A,2HND,2H E, 3 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/ C SAME LINES HAVE CONFLICTING REPORT OPTIONS DATA ERR6/2H S,2HAM,2HE ,2HLI,2HNE,2HS , 1 2HHA,2HVE,2H C,2HON,2HFL,2HIC,2HTI,2HNG, 2 2H R,2HEP,2HOR,2HT ,2HOP,2HTI,2HON,2HS / C CONSTANT LITERAL AS EDIT OPTION DATA ERR7/2H C,2HON,2HST,2HAN,2HT , 1 2HLxÅ������þúI,2HTE,2HRA,2HL ,2HHA,2HS , 2 2HED,2HIT,2H O,2HPT,2HIO,2HN / C MORE THAN 5 FIELDS ARE BEING SORTED ON DATA ERR8/2H M,2HOR,2HE ,2HTH,2HAN,2H 5, 1 2H F,2HIE,2HLD,2HS ,2HAR,2HE ,2HBE, 2 2HIN,2HG ,2HTO,2HTA,2HLE,2HD ,2HON/ C REPORT CAN NOT BE GENERATED DUE TO ERRORS DATA ERR9/2H R,2HEP,2HOR,2HT ,2HCA,2HNN, 1 2HOT,2H B,2HE ,2HGE,2HNE,2HRA,2HTE,2HD , 2 2HDU,2HE ,2HTO,2H E,2HRR,2HOR,2HS / C DETAIL LEVEL XX IS MISSING DATA ERR10/2H D,2HET,2HAI,2HL ,2HLE,2HVE,2HL ,2HXX,2H I,2HS , & 2HMI,2HSS,2HIN,2HG / C CAN NOT ADD OR AVERAGE ASCII VALUES DATA ERR11/2H C,2HAN,2H N,2HOT,2H A,2HDD,2H O,2HR ,2HAV,2HER, & 2HAG,2HE ,2HAS,2HCI,2HI ,2HVA,2HLU,2HES/ C ERROR NO. XXXXXX DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C CAN NOT EDIT REAL VALUES DATA ERR12/2H C,2HAN,2H N,2HOT,2H E,2HDI,2HT ,2HRE,2HAL, & 2H V,2HAL,2HUE,2HS / C DATA XASCII/130B/ DATA R/122B/ C C C C C C C C C C C C C BEGIN C C CLEAR ERROR INDICATOR C IE = 0 C C SORT ARRAY SS(7 * 100) BY REPORT STATEMENT C INDEX AND END PRINT POSITION C IF(R3.EQ.1) GOTO 65 DO 60 N = 1,R3-1 DO 50 I = N+1,R3 DO 10 J=1,7 X(J) = SS(J,N) 10 CONTINUE IF (X(1) - SS(1,I)) 50,20,30 20 IF (X(4) - SS(4,I)) 50,50,30 30 DO 40 J=1,7 SS(J,N) = SS(J,I) SS(J,I) = X(J) X(J) = SS(J,N) 40 CONTINUE 50 CONTINUE 60 CONTINUE C C CHECK TO SEE IF SORT LEVELS ARE C 1) CONTIGUOUS, C 2) ONLY ONE STATEMENT APPEARS FOR C A NON-EMPTY SORT LEVEL, AND C 3) DATA ITEM NAMES DISTINCT C 65 R5 = 0 N = 11 DO 70 I=1,255 Q(I) = 0 70 CONTINUE C C C C C C C C C DO 78 I=1,R3 C C PROCESS SORT LEVELS (10 - 15) C IF(SS(1,I).GT.15) GO TO 80 C C MORE THAN ONE SORT STATEMENT WITHOUT A LEVEL C IS ALLOWED. ALL SORT STATEMENTS WITH LEVELS MU“E������þúST BE UNIQUE C IF (SS(1,I).EQ.10) GO TO 74 IF (SS(1,I).EQ.N) GO TO 72 IN = N - 10 C C ERROR - SORT LEVEL MISSING OR DUPLICATE C CALL CITA(IN,IMA) ERR1(7) = IMA(3) CALL QRIO(2,ITTY,ERR1,19) IE = 1 N = SS(1,I) C C INDICATE NEXT EXPECTED LEVEL IN N C 72 N = N + 1 C C BE SURE THIS ITEM HAS NOT ALREADY BEEN USED AS A SORT ITEM C 74 J = SS(2,I) IF (Q(J).EQ.0) GO TO 76 C ERROR - DUPLICATE DATA ITEM NAMES CALL QRIO(2,ITTY,ERR2,23) IE = 1 76 Q(J) = 1 C C COUNT SORT STATEMENTS IN R5 C R5 = R5 + 1 78 CONTINUE C C C C C C C CHECK FOR A MATCH BETWEEN SORT LEVELS, C GROUPS, AND TOTALS (OTHER THAN FINAL) C 80 N = N - 11 DO 85 I=1,R3 C C PICK OFF SORT AND HEADING STATEMENTS C IF (SS(1,I).LT.30) GO TO 85 C C PICK OFF DETAIL AND EDIT STATEMENTS C IF (SS(1,I).GT.45) GO TO 90 C C PROCESS TOTAL AND GROUP STATEMENTS C J = SS(1,I) - SS(1,I)/10 * 10 IF (J.EQ.6) GO TO 85 IF (J.LE.N) GO TO 85 C ERROR - CONTROL BREAK INCONSISTENCY CALL QRIO(2,ITTY,ERR3,14) IE = 1 85 CONTINUE C C C C C C C C C C C CHECK THAT EDIT MASKS ARE SEPARATE AND C DISTINCT, AND THAT EDIT MASKS SPECIFIED C IN A DETAIL, GROUP, OR TOTAL STATEMENT C APPEAR AS REPORT STATEMENTS C 90 DO 91 I=1,255 Q(I) = 0 91 CONTINUE C C C DO 95 I=1,R3 C C SKIP OVER SORT AND HEADING STATEMENTS C IF (SS(1,I).LT.30) GO TO 95 C C PICK OFF TOTAL, GROUP, AND DETAIL STATEMENTS C IF (SS(1,I).GT.59) GO TO 94 J = SS(6,I) - SS(6,I)/100 * 100 IF (J .LT. 60) GOTO 95 N = J - 59 Q(N) = J GOTO 95 C C PROCESS EDIT STATEMENTS VERIFYING UNIQUE EDIT LEVELS C 94 IF (SS(1,I).NE.Q(11))GO TO 92 C ERROR - DUPLICATE EDIT STATEMENTS CALL QRIO(2,ITTY,ERR4,13) IE = 1 92 Q(11) = SS(1,I) DO 93 úq������þúJ=1,10 IF (Q(11).NE.Q(J))GO TO 93 Q(J) = 0 GO TO 95 93 CONTINUE C C EDIT STATEMENT IS NOT USED C GO TO 97 95 CONTINUE C C C C C C C C C C VERIFY EACH EDIT STATEMENT WAS USED C DO 96 I=1,10 IF (Q(I).NE.0) GO TO 97 96 CONTINUE GO TO 100 C C ERROR - INCONSISTENCY BETWEEN OPTION AND EDIT STATEMENTS C 97 CALL QRIO(2,ITTY,ERR5,25) IE = 1 C C C C C C VERIFY DETAIL STATEMENTS IN ORDER C 100 CONTINUE N = 51 DO 320 I =1,R3 NLEV = SS(1,I) C C PICK OUT DETAIL STATEMENTS C IF(NLEV .LT. 51) GOTO 320 IF(NLEV .GT. 59) GOTO 330 C C VERIFY THIS STATEMENT IS IN ORDER C IF(N .EQ. NLEV .OR. N+1 .EQ. NLEV) GOTO 300 CALL CITA(N+1-50,IMA) ERR10(8) = IMA(3) CALL QRIO(2,ITTY,ERR10,14) IE = -1 C C SET N TO CURRENT LEVEL C 300 CONTINUE N = NLEV 320 CONTINUE C C C C C C CHECK THAT THE SAME LINES DO NOT HAVE C DUPLICATE REPORT OPTIONS (SAME LINES C OR ALSO WHERE ALL GROUPS AND DETAILS C WOULD CONFLICT OR TOTALS AT THE SAME C LEVEL WOULD CONFLICT). C C NOTE: C 1. EDIT STATEMENTS MAY BE IN CONFLICT C ON THE SAME LINE SINCE THEY APPLY TO C DIFFERENT FIELDS. C C 2. CONSTANT LITERALS AND EDIT MASKS C CANNOT APPEAR IN THE SAME STATEMENT. C 330 CONTINUE N = 0 DO 335 I = 1,10 335 Q(I) = 0 C C C C DO 118 J=1,R3 C C SKIP OVER SORT, AND EDIT STATEMENTS C NLEV = SS(1,J) IF (NLEV.LT.20 .OR. NLEV.GT.59) GO TO 118 C C PICK OFF TOTAL, GROUP,DETAIL, AND HEADING STATEMENTS C IF (NLEV.EQ.N) GO TO 104 C C GROUP BREAKS AND D[NULL] STATEMENTS MUST HAVE COMPATIBLE PRINT C OPTIONS. DO NOT INTIALIZE THE Q ARRAY BETWEEN PROCESSING. C BUT DO INITIALIZE THE Q ARRAY THE FIRST TIME A STATEMENT IS C A GROUP BREAK OR A D[NULL]. C IF ((NLEV.GT.40).AND.(NLEV .LT1f������þú. 51).AND.(N .GT. 40))GO TO 104 C C C CHECK THAT THERE ARE NO CONFLICTING PRINT OPTIONS ( SKIP BEFORE, C SKIP AFTER, ETC.) IN TOTALS. AFTER TOTALS HAVE BEEN CHECKED SEE C THAT GROUPS AND D [NULL] HAVE COMPATIBLE PRINT OPTIONS. C C ZERO THE Q-ARRAY FOR EACH NEW LEVEL OF HEADR, TOTAL, AND C FOR THE FIRST GROUP BREAK. CLEAR Q(5) FOR EACH NEW STATEMENT C REGUARDLESS OF THE LEVEL. Q(5) IS A FLAG THAT INDICATES THAT C A TOTAL OPTION (ADD,COUNT, OR AVERAGE) HAS ALREADY BEEN C SELECTED FOR THIS STATEMENT. NO TOTAL STATEMENT CAN REQUEST C MORE THAN ONE OPTION BUT ALL OPTIONS CAN BE CHOOSEN AT ANY C PARTICULIAR LEVEL OF TOTAL STATEMENTS. C C C DO 102 I=1,10 Q(I) = 0 102 CONTINUE C C 104 CONTINUE N = NLEV Q(5) = 0 C C C C C I = SS(5,J) IF (I.EQ.0) GO TO 110 DO 108 I4=1,4 IF (I.EQ.0) GO TO 110 IFAC = 10**I4 I7 = I - I/IFAC * IFAC I = I - I7 IF (I7.EQ.0) GO TO 108 IF (Q(I4).EQ.0) GO TO 106 C ERROR - CONFILICTING REPORT OPTIONS CALL QRIO(2,ITTY,ERR6,22) IE = 1 106 Q(I4) =1 108 CONTINUE IF (I .NE. 0) Q(5) = 1 C C C C C C CHECK THAT TOTALS,GROUPS, AND DETAILS DO NOT HAVE EDIT MASKS C WITH REAL VALUES. C 110 CONTINUE IF(NLEV .LT.30 .OR. NLEV .GT. 59) GOTO 111 ITM = SS(2,J) IF(ITM .EQ. 0) GOTO 111 C C IS THERE AN EDIT MASK? C NN = SS(6,J) IF(NN - NN/100*100 .EQ. 0) GOTO 111 C C GET THE ITEM TYPE C CALL DBINF(DBNAM,ITM,102,ISTAT,INFO) IF(ISTAT .EQ. 0) GOTO 109 C C ERROR - LOAD AND EXECUTE ERROR PROCESSOR C QSERR = ISTAT SNAM(2) = 2H23 GOTO 150 C C GET THE ITEM TYPE FROM THE BUFFER C 109 CONTINUE CALL SGET(INFO,17,ITYPE) IF(ITYPE .NE. R) GOTO 111 C C C C OUTPUT "CAN NOT EDIT REAL VALUES" C CALL QRIO(2,ITTY,ERR12,13) IE = -1 C C C C C C C C TOTAL, GROUPS, HEAò¸������þúDING STATEMENTS C VERIFY THAT EDIT MASKS DON'T EXIST WITH LITERALS C 111 CONTINUE I3 = SS(6,J) IF (I3.EQ.0) GO TO 118 DO 116 I4=2,3 IF (I3.EQ.0) GO TO 118 IFAC = 10**I4 I7 = I3 - I3/IFAC * IFAC I3 = I3 - I7 IF (I7.EQ.0) GO TO 116 C C VERIFY THAT A LITERAL DOES NOT HAVE AN EDIT MASK C IF (I4.NE.2) GO TO 112 IF (SS(3,J).EQ.0) GO TO 116 C ERROR - LITERAL HAS EDIT OPTION CALL QRIO(2,ITTY,ERR7,17) IE = 1 GO TO 116 C C VERIFY THAT THE TOTAL STATEMENT ONLY HAS ONE OF THE C ACTION OPTIONS (ADD,AVERAGE, OR COUNT) C C NOTE: C C ONLY TOTAL STATEMENTS WILL HAVE THE FLAG SET C 112 IF (Q(5).EQ.0) GO TO 114 C ERROR - CONFLICTING REPORT OPTIONS CALL QRIO(2,ITTY,ERR6,22) IE = 1 114 Q(5) = I3 116 CONTINUE IF ((I3 .EQ. 0) .OR. (Q(5) .EQ. 0)) GOTO 118 CALL QRIO(2,ITTY,ERR6,22) IE = 1 118 CONTINUE C C C C C C C C C CHECK TO SEE THAT NOT MORE THAN 5 C FIELDS ARE BEING TOTALED ON. C ALSO VERIFY THAT ASCII VALUES ARE C ONLY BEING COUNTED, AND NOT ADDED OR AVERAGED. C C C C C DO 120 I=1,255 Q(I) = 0 120 CONTINUE C C C C DO 122 J=1,R3 C C PICK OFF SORT, AND HEADING STATEMENTS C NLEV = SS(1,J) IF (NLEV.LT.30) GO TO 122 C C PICK OFF GROUP, DETAIL, AND EDIT STATEMENTS C IF (NLEV.GT.40) GO TO 124 C C SET INDICATOR THAT THIS ITEM IS BEING TOTALED ON C N = SS(2,J) IF (N.EQ.0) GO TO 122 Q(N) = 1 C C VERFY THAT ASCII VALUES ARE ONLY BEING COUNTED C IF ((SS(5,J)/10000 .EQ. 0) .AND. (SS(6,J)/1000 .EQ. 0)) GOTO 122 CALL DBINF(DBNAM,N,102,ISTAT,INFO) IF(ISTAT .EQ. 0) GOTO 209 C C DBMS ERROR - LOAD AND EXECUTE THE DBMS ERROR HANDLING SEGMENT C QSERR = ISTAT SNAM(2) = 2H23 GOTO 150 C C GET THE ITEM TYPE C 209 CALL SGET(INFO,17,ITYPE) IF(ITYPE .NE. XASCII) ˜������þúGOTO 122 C C OUTPUT "CAN NOT ADD OR AVERAGE ON ASCII VALUES" C CALL QRIO(2,ITTY,ERR11,18) IE = 1 122 CONTINUE C C C C C C C ADD # OF DIFFERENT ITEMS C 124 N = 0 DO 126 J=1,255 IF (Q(J).NE.0) N = N + 1 126 CONTINUE IF (N.LE.5) GO TO 130 C ERROR - > 5 FIELDS TOTALED ON CALL QRIO(2,ITTY,ERR8,20) IE = 1 C C C C C C CHECKING COMPLETE - WAS THERE ANY ERRORS C 130 IF (IE.EQ.0) GO TO 140 C ERROR - NO REPORT GENERATED CALL ERIO(2,ITTY,ERR9,21) C CALL MAIN PROGRAM (QS) C 135 CONTINUE SNAM(2) = 2H GO TO 150 C C BUILD THE LIST ARRAY C C LIST IS A 101 BY 6 ARRAY C C THE FIRST ENTRY IS AS FOLLOWS C WORD 1 - NUMBER OF ENTRIES IN THE ARRAY C WORD 7 - NUMBER OF SORT ITEMS IN THE ARRAY C C NOTE: THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C THE OTHER ENTRIES LOOK AS FOLLOWS C C WORD 1 - ITEM NUMBER C WORD 2 - ITEM TYPE C WORD 3 - ITEM LENGTH IN BYTES C WORD 4 - ELEMENT COUNT C WORD 5 - OFF SET INTO RECORD IN BYTES C WORD 6 - ITEM NUMBER REPEATED C C NOTE: THIS ARRAY IS SET UP IN THE ABOVE MANNER SO THAT C COLUMN 1 AND 6 OF THE LIST ARRAY MAY BE USED WHEN MAKING C DBGET CALLS. C C THE SORT PROCESSOR AND OTHER PROCESSORS USE THE INFORMATION IN C THE TABLE TO FORMAT THE REPORT IN THE CORRECT MANNER. C 140 CONTINUE DO 170 I = 1,101 DO 170 J = 1,6 170 LIST(I,J) = 0 C C BE SURE THERE IS ONLY ONE ENTRY IN THE LIST ARRAY FOR EVERY C UNIQUE ITEM. C IOFF = 1 LIST = 0 LIST(1,6) = 0 C C C DO 220 I = 1,R3 NLEV = SS(1,I) C C BE SURE TO SKIP HEADERS C IF(NLEV .GT. 20 .AND. NLEV .LT. 29) GOTO 220 C C DO NOT LOOK AT STATEMENTS THAT DON'T HAVE ITEM NUMBERS C DINUM = SS(2,I) IF(DINUM .EQ. 0) GOTO 220 C C SEE IF IT ALREADY EXITS IN THE LIST C IF(LIST .EQ. 0) GOTOœ���<��:6 200 DO 190 J = 2,LIST +1 IF (LIST(J,1) .EQ. DINUM) GOTO 180 190 CONTINUE C C C C PUT ITEM IN LIST ARRAY C INCREASE THE COUNT OF ENTRIES IN THE LIST ARRAY C SET J TO THE INDEX INTO THE LIST ARRAY FOR THAT ENTRY C 200 CONTINUE LIST = LIST+1 J = LIST + 1 LIST(J,1) = DINUM C C GET THE ITEM INFORMATION C CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO) IF (ISTAT .EQ. 0) GOTO 210 C C DBMS ERROR C QSERR = ISTAT SNAM(2) = 2H23 GOTO 150 210 CONTINUE CALL SGET(INFO,17,ITYPE) LIST(J,2) = ITYPE IF(ITYPE .NE. XASCII) INFO(10) = 2 * INFO(10) LIST(J,3) = INFO(10) LIST(J,4) = INFO(11) LIST(J,5) = IOFF IOFF = IOFF+ INFO(11) * INFO(10) C C IF THIS IS A SORT STATEMENT C INCREASE THE SORT COUNT C PUT THE ITEM NUMBER AS A FLAG INDICATING THAT THIS IS A SORT ITEM C IF(SS(1,I) .GT. 15) GOTO 180 LIST(1,6) = LIST(1,6) + 1 LIST(J,6) = DINUM C C PUT LIST ARRAY OFFSET IN SS-ARRAY C 180 CONTINUE SS(7,I) = J 220 CONTINUE C C C C C C C C CALL REPORT GENERATOR PROGRAM C IF(R5 .NE. 0) GOTO 160 SNAM(2) = 2H06 C C C 150 CONTINUE CALL LOAD(SNAM) C C C C CALL PRE-SORT C 160 SNAM(2) = 2H05 GO TO 150 END $ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������:8<������ÿÿ����� ���� ÿý�p� ���������ÿ��92069-18068 1940� S C0122 �&QY05 �QY05 SOURCE � � � � � � � � � � � � �H0101 D(�����þúFTN4 PROGRAM QY05(5,90),92069-16060 REV.1940 790523 C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18068 C RELOC: 92069-16060 C C C************************************************************ C C C C THIS IS A MAIN PROGRAM MODULE THAT IS CALLED BY QS04 AND QS19 UPON THE C RECOGNITION OF SORT STATEMENT(S) IN THE REPORT. QS05 WILL BUILD THE C WORK AREA WITH RECORD NUMBERS AND THEIR ASSOCIATED SORT KEYS IN C ACCORDANCE WITH THE REQUIREMENTS OF THE SORT SUBROUTINE.(IF THE WORK C AREA IS NOT OF SUFFICIENT SIZE, QS05 WILL PRINT AN ERROR MESSAGE AND C RETURN TO QS) C C IMPORTANT VARIABLES AND ARRAYS USED: C C C RRCNT IS AN INTEGER VARIABLE,PASSED IN COMMON,WHICH CONTAINS C THE RETRIEVED RECORD COUNT. C C C LOGICAL DDS REAL RECORD REAL CURBLK INTEGER SECTRK,BLKTRK INTEGER DZERO(2) INTEGER ISTAT(10) INTEGER ISORT(42) INTEGER ID1(2) INTEGER ERR1(16) INTEGER ERR2(9) INTEGER ERR3(15) C&&&&&&&&&&&& QS5COM &&&&&&&&&&&&&&&&& OCT 4 1978 &&&&&&&&& INTEGER IFTRK,ISIZE,SECBLK,WRDBLK,RECBLK,LENGTH,KEY INTEGER NTRAK,ILU REAL BLKS C&&&&&&&&&&&& QS5COM &&&&&&&&&&&&&&&&& OCT 4 1978 &&&&&&&&& C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLENÏÛ������þú,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C%%%%%%% QS5EQU %%%%%%%%%%%%%%%%%%%%%%%%%%%% OCT 5, 1978 %%%%%%%% EQUIVALENCE(IB,IFTRK) EQUIVALENCE(IB(2),ISIZE) EQUIVALENCE(IB(3),SECBLK) EQUIVALENCE(IB(4),WRDBLK) EQUIVALENCE(IB(5),RECBLK) EQUIVALENCE(IB(6),LENGTH) EQUIVALENCE(IB(7),KEY) EQUIVALENCE(IB(8),NTRAK) EQUIVALENCE(IB(9),ILU) EQUIVALENCE(IB(10),BLKS) EQUIVALENCE(IB(12),XXXXX) C%%%%%%% QS5EQU %%%%%%%%%%%%%%%%%%%%%%%%%%%% OCT 5, 1978 %%%%%%%% EQUIVALENCE (D1,ID1) C C INSUFFICIENT WORK AREA DATA ERR1/2H I,2HNS,2HUF,2HFI, ERR1 1 2HCI,2HEN,2HT ,2HWO,2HRK,2H A, ERR1 2 2HRE,2HA ,2HFO,2HR ,2HSO,2HRT/ ERR1 C SORT VALUE SIZES EXCEED LIMIT DATA ERR3/2H S,2HOR,2HT ,2HVA,2HLU,2HE ,2HSI,2HZE,2HS ,2HEX,2HCE, ERR3 12HED,2H L,2HIM,2HIT/ DATA ID1/0,1/ DATA DZERO/0,0/ C C SECBLK - SECTORS PER BLOCK ó������þúC WRDBLK - WORDS PER BLOCK C SECTRK - SECTORS PER TRACK C RECBLK - RECORDS PER BLOCK C BLKTRK - BLOCKS PER TRACK C RECLF - RECORDS LEFT IN LAST BLOCK C BLKS - TOTAL NUMBER OF BLOCKS NEEDED C C C C C C C C C C C C BEGIN C C INITIALIZE THE NUMBER OF 128 WORD SECTORS PER BLOCK C SECBLK = 5 WRDBLK = 5 * 128 C C INITIALIZE THE SIZE OF THE KEY FIELD AND THE SIZE OF THE SORT C RECORD C C SIZE OF KEY = OFFSET OF LAST KEY + IT'S LENGTH * # ELELMENTS -1 C LENGTH OF RECORD IS LENGTH OF KEY + SIZE OF D-INTEGER RECORD # C I = LIST(1,6) + 1 KEY = LIST(I,5) + LIST(I,3) * LIST(I,4) -1 LENGTH = KEY + 4 C C VERIFY THAT THE SORT RECORDS DO NOT EXCEED THE BUFFERS IN QSORT C IF(LENGTH .LE. 84) GOTO 20 CALL ERIO(2,ITTY,ERR3,15) GOTO 310 C C GET THE NUMBER OF 128 WORD SECTORS PER TRACK C 20 CONTINUE CALL EXEC(4,107777B,IFTRK,ILU,ISIZE) SECTRK = ISIZE/2 RECBLK = WRDBLK/(LENGTH/2) IWRDS = RECBLK * LENGTH / 2 C C GET THE NUMBER OF BLOCKS NEEDED TO HOLD ALL THE SORT DATA C BLKS = DDI(RRCNT,DBLEI(RECBLK) ) IF(DCO(BLKS,DZERO))25,25,24 C C ALLOW FOR EXTRA C 24 IF(DCO(DSB(RRCNT, DMP(BLKS,DBLEI(RECBLK))),DZERO)) 26,26,25 25 BLKS = DIN(BLKS) 26 BLKTRK = SECTRK/SECBLK NTRAK = ISNGL(DDI(BLKS,DBLEI(BLKTRK))) + 1 IF(NTRAK .LE. 0) NTRAK = 1 CALL EXEC(4,NTRAK+100000B,IFTRK,ILU,ISIZE) ISIZE = BLKTRK * SECBLK * 2 IF(IFTRK .GE. 0) GOTO 30 C C NEED MORE SYSTEM TRACKS C CALL ERIO(2,ITTY,ERR1,16) GOTO 310 C C C READ THE SELECT FILE C 30 CONTINUE RSEC = D1 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 280 IPTR = 9 RSEC = DIN(RSEC) C C C READ ALL THE SORT RECORDS AND PUT THEM ON THE TRACKS C C C INITIALIZE THE WORK AREA C CALL INITX(IFTRK,ISIZE,SECBLK,ILU) C C GET SORT RECORDS ON DISC C a’����� RCOUNT = RRCNT IOFF = 1 CURBLK = D1 C C WRITE THE BLOCK WHEN IT IS FULL C 40 CONTINUE IF(IOFF .LT. IWRDS+IWRDS) GOTO 45 CALL WORKX(2,IBUFF,IWRDS,CURBLK) IOFF = 1 CURBLK = DIN(CURBLK) C C GET THE SELECTED RECORD # FROM THE SELECT FILE C 45 CONTINUE IF(IPTR .LT. 65) GOTO 50 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 280 IPTR = 1 RSEC = DIN(RSEC) C C GET RECORD # FROM SELECT FILE C 50 CONTINUE RECORD = SELT(IPTR) IPTR = IPTR + 1 C C READ RECORD FROM DATA SET C CALL DBGET(DBNAM,DSNUM,4,ISTAT,LIST(1,6), & IBUFF((IOFF+1)/2),RECORD) IF(ISTAT .NE. 0) GOTO 280 C C PUT RECORD IN SORT TRACKS C IOFF = IOFF + KEY CALL SMOVE(RECORD,1,4,IBUFF,IOFF) IOFF = IOFF+4 IF(DDS(RCOUNT)) GOTO 80 GOTO 40 C C C C C C 80 CONTINUE CALL WORKX(2,IBUFF,IWRDS,CURBLK) SNAM(2) = 2H19 GOTO 320 C C DBMS ERROR AND FMP ERROR C 280 CONTINUE CALL EXEC(5,NTRAK,IFTRK,ILU) QSERR = ISTAT SNAM(2) = 2H23 GOTO 320 C C C 300 CALL EXEC(5,NTRAK,IFTRK,ILU) 310 SNAM(2) = 2H C C C EXIT C C 320 CONTINUE CALL LOAD(SNAM) END $ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Âç������ÿÿ����� ���� ÿý�q�z ���������ÿ��92069-18069 1912� S C0122 �&QY06 �QY06 SOURCE � � � � � � � � � � � � �H0101 C+�����þúFTN4 PROGRAM QY06(5,90),92069-16060 REV.1912 790111 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18069 C RELOC: 92069-16060 C C C************************************************************ C C C REPORT GENERATION MODULE #1 C C THIS IS THE INITIALIZATION MODULE C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS AND GROUP/DETAILS C 3) QS12 - TOTALS C 4) QS20 - GROUPS/DETAILS C C THE PURPOSE OF THESE MODULES IS TO C GENERATE A REPORT BASED ON THE S TABLE. C IT IS ASSUMED THAT ALL LOGIC AND SYNTAX C ERRORS HAVE BEEN CORRECTED. C C REPORT TABLE FORMAT IN ARRAY S(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C Uó§������þúNITS PLACE = 0 IMPLIES EDIT LEVEL 0 C 1 IMPLIES ZERO SUPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C T ARRAY IS USED TO HOLD SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C C C LOGICAL IFTTY INTEGER CS(66) INTEGER ERR1(8) INTEGER ERR2(12) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA ERR1/2H8������þú I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR / DATA ERR2/2H I,2HLL,2HEG,2HAL,2H L,2HU ,2HLO,2HCK, & 2H R,2HEQ,2HUE,2HST/ C C C C C C C C C C C C BEGIN C C LOCK THE LIST LU C CALL LUREQ(RMOTE,1,ILP,IERR) IF(IERR .NE. 0) GOTO 7010 CALL TOPAG(RMOTE,ILP,IERR) C C INITIALIZE THE RECORD COUNT C 1 CONTINUE RCOUNT = RRCNT C C C C C C DO 2 J=1,5 DO 2 I=1,6 2 ATOTAL(I,J) = 0 C C C C C CHECK IF "PAGENO" EXISTS AMONG HEADERS C PAGCNT = -1 DO 160 J=1,R3 IF (SS(1,J).LT.20) GO TO 160 IF (SS(1,J).GT.30) GO TO 170 IF (SS(2,J).EQ.0) GO TO 160 PAGCNT = 1 160 CONTINUE C C C 170 DO 171 J=1,5 T(J) = -1 U(1,J) = 0 DO 171 I=2,7 U(I,J) = 0 171 CONTINUE C C INITIALIZE STRINGS TO NULL C DO 200 I = 1,5 LEVLEN(I) = 0 200 CONTINUE C C PUT SORT LIST-ARRAY OFFSET IN "T" C R5 = 0 DO 330 J=1,R3 I = SS(1,J) IF (I.GT.20) GO TO 240 IF (I.EQ.10) GO TO 330 N = I - 10 T(N) = SS(7,J) GO TO 330 240 IF (I.GT.40) GO TO 335 IF (I.LT.30) GO TO 330 IF (SS(7,J).EQ.0) GO TO 330 C C PUT TOTAL LIST-ARRAY OFFSET IN "U" C IDATA = SS(7,J) DO 310 J1=1,5 I = U(1,J1) IF(I.EQ.0) GO TO 320 IF(I.EQ.IDATA) GO TO 330 310 CONTINUE C C INTERNAL ERROR C CALL ERIO(2,ITTY,ERR1,8) GOTO 330 C C C 320 CONTINUE U(1,J1) = IDATA C C END OF LOOP C 330 CONTINUE C C C C C C C C C C L(7) IS A SWITCH WHICH IS SET TO NOT RECOGNIZE C A CONTROL BREAK ON FIRST DETAIL RECORD READ C (TOTAL PRINTING SUPPRESSION). C C L(1) TO L(5) ARE RESET WHEN A CONTROL BREAK C OCCURS AT THAT LEVEL. C L(6) IS RESET WHEN THE LAST RECORD C IS ENCOUNTERED. C 335 CONTINUE DO 340 I = 1,7 L(I) = -1 340 CONTINUE C C REAaÜ�����D QSKIB INTO 'IB' C CALL EXEC(1,IDILU,IB,-R6,TRKNM,0) C C INITIALIZE PROPER COUNTERS C LNCNT = 0 CALL SFILL(CS,1,COLLIM,40B) CALL PHDRI(CS) C C INITIALIZE SELT BUFFER C RCOUNT = RRCNT RSEC = DBLEI(1) CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .GE. 0) GOTO 350 CALL FMERR(ISTAT,ITTY) SNAM(2) = 2H GOTO 360 C C C 350 CONTINUE RSEC = DIN(RSEC) IPTR = 9 C C LOAD REPORT MODULE QS15 C SNAM(2) = 2H15 360 CALL LOAD(SNAM) C C C C ILLEGAL LU LOCK REQUEST C C 7010 CONTINUE CALL ERIO(2,ITTY,ERR2,12) SNAM(2) = 2H GOTO 360 END $ ������������������������������������������������������������������������������~^������ÿÿ����� ���� ÿý�r�{ ���������ÿ��92069-18070 2026� S C0122 �&QYO7 &QYO7 � � � � � � � � � � � � � �H0101 ËÌ�����þúFTN4 PROGRAM QY07(5,90),92069-16060 REV.2026 800122 C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18070 C RELOC: 92069-16060 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C************************************************************ C C C UPDATE SERVICE MODULE (PART I) C HAS BEEN SPLIT INTO TWO (2) MODULES C IN ORDER TO FIT INTO 16K MEMORY C C QS07 CONTAINS THE OPERATOR INTERFACE C QS14 CONTAINS THE REPLACE, ADD, AND DELETE ROUTINES C LOGICAL ISPTH LOGICAL ISSRT LOGICAL MEMBR INTEGER ERR1(7) INTEGER ERR2(14) INTEGER ERR4(15) INTEGER ERR5(12) INTEGER ERR7(14) INTEGER ERR8(13) INTEGER ERR9(14) INTEGER ERR10(14) INTEGER ERR11(16) INTEGER PRMPT(3) INTEGER REPLC(4),ADD(4),DELT(4) INTEGER NAME(2) INTEGER A,R,D INTEGER INFO(13) INTEGER ITEMS(128) INTEGER INBR(128) INTEGER ASK(5) INTEGER DZERO(2) INTEGER P2,ELCNT INTEGER ISTAT(10) INTEGER IMODE(4) INTEGER UPDATE(3) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGEâè������þúR R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE(S(1,1),ICHAR) EQUIVALENCE(S(3,1),INBR) C C C C C C C C C C C DATA DZERO/0,0/ DATA ASK/2H ,2H ,2H ,2H =,2H _/ DATA NAME/2HNA,2HME/ C SYNTAX ERROR DATA ERR1/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / C ILLEGAL ACCESS TO DATA SET DATA ERR2/2H I,2HLL,2HEG,2HAL, & 2H A,2HCC,2HES,2HS ,2HTO,2H D,2HAT,2HA ,2HSE,2HT / C RECORD NOT YET BEEN FOUND DATA ERR4/2H R,2HEC,2HOR,2HD ,2HNO,2HT , & 2HYE,2HT ,2HBE,2HEN,2H F,2HOU,2HND/ C ILLEGAL DATA ITEM NAME DATA ERR5/2H I,2HLL,2HEG,2HAL,2H D,2HAT,2HA , & 2HIT,2HEM,2H N,2HAM,2HE / C MUST ENTER PATH ITEM VALUE DATA ERR7/2H M,2HUS,2HT ,2HEN,2HTE,2HR , &2HPA,2HTH,2H I,2HTE,2HM ,2HVA,2HLU,2HE / DATA ERR8/2H I,2HLL,2HEG,2HAL,2H P,2HAT,2HH ,2HMO,2HDI,2HFI, &2HCA,2HTI,2HON/ C USER ACCESS NOT HIGH ENOUGH DATA ERR9/2H U,2HSE,2HR ,2HAC,2HCE,2HSS,2H N,2HOT,2H H, & 2HIG,2HH ,2HEN,2HOU,2HGH/ C MUST ENTER SORT ITEM VALUE DATA ERR10/2H M,2HUS,2HT ,2HEN,2HTE,2HR ,2HSO,2HRT, & 2H I,2HTE,2HM ,2HVA,2HLU,2HE / C ILLEGAL SORT ITEM MODIFICATIù†������þúON DATA ERR11/2H I,2HLL,2HEG,2HAL,2H S,2HOR,2HT ,2HVA, & 2HLU,2HE ,2HMO,2HDI,2HFI,2HCA,2HTI,2HON/ DATA PRMPT/2H I,2HTE,2HM_/ DATA A/101B/ DATA D/104B/ DATA R/122B/ DATA INTGR/111B/ DATA REPLC/2HRE,2HPL,2HAC,2HE / DATA ADD/2HAD,2HD ,2H ,2H / DATA DELT/2HDE,2HLE,2HTE,2H / C UPDATE C C DATA UPDATE/2HUP,2HDA,2HTE/ C C C C C C UPDATE NAME = <PROCEDURE NAME>; C A[DD],<DATA SET NAME>; C C QUERY PROMPTS THE USER WITH EACH ITEM NAME TO C WHICH HE HAS ACCESS. THE USER MAY ENTER A VALUE C OR A SEMICOLN. WHEN A SEMICOLN IS ENTER QUERY C PUTS A NULL VALUE IN THE DATA RECORD. QUERY PROHIBITS C NULL VALUES FOR PATH ITEMS. A USER CAN TERMINATE THE C UPDATE WITH THE BR[EAK] COMMAND. C C D[ELETE]; C C R[EPLACE]; C <DATA ITEM NAME> = "<VALUE>" [,"<VALUE>","<VALUE>"] ; C WHERE ARRAY VALUES ARE ENTERED IN AS A LIST OF C VALUES SEPARATED BY COMMAS AND TERMINATED C BY A SEMICOLN. WHEN TWO COMMAS ARE ENTERED C ADJACENT A NULL VALUE IS ENTERED FOR THAT C ELEMENT. C C C C C C BEGIN C C INBR = 0 P2 = 1 C C CHECK FOR PROCEDURE C CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 50 IF(J-I.NE.3) GOTO 30 IF(JSCOM(NAME,1,4,IB,I,IERR).NE.0) GOTO 30 C SCAN ACROSS = CALL LSCAN(IB,I,J,K) IF(K.NE.6) GOTO 50 C C GET PROCEDURE NAME C CALL GTPRC(UPDATE,6,IERR) IF(IERR .NE. 0) GOTO 70 IOFLAG = 1 C C GET UPDATE TYPE C CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 50 C C VERIFY THAT THE UPDATE TYPE IS LEGAL C 30 CALL SGET(IB,I,ICHAR) IF(J-I+1 .NE. 1) GOTO 40 C C A = UPDATE ADD C D = UPDATE DELETE C R = UPDATE REPLACE C IF(ICHAR.EQ.A) GOTO 110 IF(ICHAR.EQ.D) GOTO 610 IF(ICHAR.EQ.R) GOTO 50z������þú0 GOTO 50 C C ADD = UPDATE ADD C DELETE = UPDATE DELETE C REPLACE = UPDATE REPLACE C 40 CONTINUE IF(J-I+1 .GT. 8) GOTO 50 CALL SFILL(IMODE,1,8,40B) CALL SMOVE(IB,I,J,IMODE,1) IF(JSCOM(IMODE,1,8,ADD,1) .EQ. 0) GOTO 110 IF(JSCOM(IMODE,1,8,REPLC,1) .EQ. 0) GOTO 500 IF(JSCOM(IMODE,1,8,DELT,1) .EQ. 0) GOTO 610 C C ERROR - SYNTAX ERROR C 50 CONTINUE IP = 1 54 IF(IEND .LE. 72) GOTO 57 CALL QRIO(2,ITTY,IB(IP),-72) IEND = IEND - 72 IP = IP + 36 GOTO 54 C C WRITE LAST LINE OUT C 57 CALL QRIO(2,ITTY,IB(IP),-IEND) C C CALL SFILL(IMA,1,72,40B) IF(I .GT. 72) I = I-I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,ERR1,7) C C RETURN TO NEXT? C 70 SNAM(2) = 2H GOTO 100 C C ERROR - DBMS C 80 QSERR = ISTAT SNAM(2) = 2H23 GOTO 100 C C LOAD MODULE QS14 FOR REPLACE,ADD, AND DELETE UPDATES C 90 SNAM(2) = 2H14 100 CALL LOAD(SNAM) C C C C C C C C C C ADD STATEMENT C C SCAN ACROSS "," C 110 CONTINUE CALL LSCAN(IB,I,J,K) IF(K.NE.4) GOTO 50 CALL LSCAN(IB,I,J,K) C C GET DATA SET NAME C IF(J-I.GT.5) GOTO 50 CALL SFILL(DSNAM,1,6,40B) CALL SMOVE(IB,I,J,DSNAM,1) C C VERIFY THE SEMICOLN C CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 50 C C VERIFY DATA SET NAME C CALL DBINF(DBNAM,DSNAM,201,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 80 IF(INFO .LT. 0) GOTO 130 C C ERROR - ILLEGAL ACCESS TO DATA SET C 120 CONTINUE CALL ERIO(2,ITTY,ERR2,14) GOTO 70 C C GET THE DATA SET NUMBER C 130 DSNUM = -INFO IPFLAG = 0 IOFLAG = 0 C C GET ALL DATA ITEM #S FOR THIS SET C CALL DBINF(DBNAM,DSNUM,104,ISTAT,ITEMS) IF(ISTAT .NE. 0) GOTO 80 IF(ITEMS .EQ. 0) GOTO 120 C C LOOP ON ITEM COUNT AND GET VALUE C 140 CONTINUE DO®´������þú 320 LOOP=2,ITEMS+1 C C IF NO READ/WRITE ACCESS THEN SKIP ITEM C IF(ITEMS(LOOP) .GE. 0) GOTO 320 DINUM = -ITEMS(LOOP) C C GET ITEM CHARACTERISTICS C CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 80 CALL SGET(INFO,17,ITYPE) LEN = INFO(10) IF(ITYPE .EQ. R .OR. ITYPE .EQ. INTGR) LEN = LEN * 2 ELCNT = INFO(11) C C GET VALUE FROM USER C CALL SMOVE(INFO,1,6,ASK,3) 160 IF(.NOT. BATCH) CALL QRIO(2,INLU,ASK(1),5) C C SEE IF BREAK WAS REQUESTED C CALL INPUT IF (BREAK) GOTO 70 C C C SEE IF ONLY A SEMICOLN WAS ENTERED C NOTE: LSCAN MUST NOT BE USED HERE BECAUSE C GETVL EXPECTS TO TO THE CALL TO LSCAN C DO 165 I = ISCAN,IEND CALL SGET(IB,I,ITERM) IF( ITERM .EQ. 40B) GOTO 165 IF(ITERM .NE. 73B) 180,167 165 CONTINUE C C IF THIS IS A PATH - A VALUE MUST BE ENTERED C 167 CONTINUE IF(.NOT. ISPTH(DBNAM,DSNUM,DINUM,ISTAT) ) GOTO 170 CALL ERIO(2,ITTY,ERR7,14) GOTO 182 C C BE SURE THERE WERE NO DBMS ERRORS C 170 CONTINUE IF(ISTAT) 80,175,80 C C IF THIS IS A SORT ITEM - A VALUE MUST BE INTERED C 175 CONTINUE IF (.NOT. ISSRT(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 178 CALL ERIO(2,ITTY,ERR10,14) GOTO 182 C C BE SURE THERE WERE NO DBMS ERRORS C 178 CONTINUE IF (ISTAT) 80,180,80 C C PUT THE ITEM VALUE INTO THE DATA BUFFER C 180 CONTINUE CALL GETVL(DSNUM,DINUM,ITYPE,LEN,ELCNT,IBUFF,P2,IB,ITTY,IERR) IF(IERR .EQ. 0) GOTO 185 C C IF THIS IS A BATCH FILE TERMINATE ELSE GO ASK AGAIN C 182 CONTINUE IF(BATCH) 70,160 C C PUT ITEM IN PUT LIST C 185 CONTINUE C C LEAVE ENOUGH ROOM FOR ALL THE ELEMENTS C P2 = LEN * ELCNT + P2 INBR = INBR + 1 INBR(INBR+1) = DINUM C C BE SURE THAT AN ITEM IS TO BE ADDED C 320 CONTINUE IF(INBR .EQ. 0) GOTO 120 SNAM(2) = 2H22 GOTO 100 C C C C C ³Ÿ������þúC C C C REPLACE STATEMENT C C C C C C VERIFY SEMICOLN C 500 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 50 C C VERIFY THAT THE SELECT FILE IS NOT EMPTY C IF(DCO(RRCNT,DZERO) )505,505,510 505 CALL ERIO(2,ITTY,ERR4,13) GOTO 70 C C GET THE INPUT FROM THE USER C IF THIS IS A PROCEDURE FILE GET THE INPUT C FROM THE PROCEDURE. C 510 CONTINUE IF((IPFLAG .EQ. 0).AND.(.NOT. BATCH)) CALL QRIO(2,INLU,PRMPT,3) C C GET THE ITEM NAME C CALL LSCAN(IB,I,J,K) IF(BREAK) GOTO 70 C C A SEMICOLN INSTEAD OF AN ITEM NAME TERMINATES THE INPUT C IF(K .EQ. 5) GOTO 90 C C VERIFY LEGAL NAME C IF(K .NE. 2) GOTO 530 IF(J-I.GT.5) GOTO 530 CALL SFILL(DINAM,1,6,40B) C CALL SMOVE(IB,I,J,DINAM,1) C C GET THE "=" FROM THE INPUT LINE C CALL LSCAN(IB,I,J,K) IF(K .EQ. 6) GOTO 520 C C GET DATA ITEM NUMBER C 520 CONTINUE CALL DBINF(DBNAM,DINAM,101,ISTAT,INFO) IF(ISTAT .EQ. 0) GOTO 540 C C ERROR - ILLEGAL DATA ITEM NAME C 530 CONTINUE CALL ERIO(2,ITTY,ERR5,12) GOTO 590 C C VERIFY THAT A PATH IS NOT BEING CHANGED C 540 CONTINUE IF(INFO .LT. 0) GOTO 541 CALL ERIO(2,ITTY,ERR9,14) GOTO 590 C C C 541 CONTINUE DINUM = -INFO IF( .NOT. ISPTH(DBNAM,DSNUM,DINUM,ISTAT) ) GOTO 542 CALL ERIO(2,ITTY,ERR8,13) GOTO 590 C C VERIFY THAT A SORT VALUE IS NOT BEING CHANGED C 542 CONTINUE IF (ISTAT .NE. 0) GOTO 530 IF (.NOT. ISSRT(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 543 CALL ERIO(2,ITTY,ERR11,16) GOTO 590 C C MAKE SURE NO DBMS ERROR OCCURRED C 543 CONTINUE IF (ISTAT .NE. 0) GOTO 530 C C VERIFY THIS IS A MEMBER OF THE DECLARED DATA SET C 545 CONTINUE IF(MEMBR(DBNAM,DSNUM,DINUM,ISTAT)) GOTO 550 CALL ERIO(2,ITTY,ERR5,12) GOTO 590 C C GET DATA ITEM CHARACTERISTICS C 550 CONTINUE CALL DF���*��($BINF(DBNAM,DINUM,102,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 530 C C GET THE ITEM TYPE, LENGTH, AND ELEMENT COUNT C CALL SGET (INFO,17,ITYPE) LEN = INFO(10) IF((ITYPE .EQ. R) .OR. (ITYPE .EQ. INTGR)) LEN = LEN*2 ELCNT = INFO(11) C C GET THE VALUE FROM THE USER C CALL GETVL(DSNUM,DINUM,ITYPE,LEN,ELCNT,IBUFF,P2,IB,ITTY,IERR) IF(IERR .NE. 0) GOTO 590 C C VERIFY INPUT STRING ENDED WITH A SEMICOLN C C C PUT ITEM IN LIST C 560 CONTINUE P2 = P2 + LEN * ELCNT INBR = INBR + 1 INBR(INBR+1) = DINUM 580 CONTINUE GOTO 510 C C C C C C REPLACE ERROR PROCESSOR C 590 CONTINUE IF((BATCH) .OR. (IPFLAG .NE. 0)) GOTO 70 C C SCAN FOR SEMICOLN C 595 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 5) GOTO 595 GOTO 510 C C C C C C C C DELETE RECORD C C C C C 610 CONTINUE IF(DCO(RRCNT,DZERO) )630,620,630 620 CALL ERIO(2,ITTY,ERR4,13) GOTO 70 C C BE SURE THIS SET HAS DELETE ACCESS C 630 CONTINUE CALL DBINF(DBNAM,DSNUM,201,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 80 IF( INFO .LT.0) GOTO 90 CALL ERIO(2,ITTY,ERR9,14) GOTO 70 END ������������������������������������������������������½l*������ÿÿ����� ���� ÿý�s�  ���������ÿ��92069-18071 2026� S C0122 �&QYO8 &QYO8 � � � � � � � � � � � � � �H0101 ÎÌ�����þúFTN4 PROGRAM QY08(5,90),92069-16060 REV.2026 800312 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18071 C RELOC: 92069-16060 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C************************************************************ C C C FORM SERVICE MODULE C C DISPLAYS DATA-SET AND C DATA-ITEM NAMES C LOGICAL ISPTH LOGICAL IFBRK INTEGER D INTEGER STYPE INTEGER SETBF(51) INTEGER IBUF(256) INTEGER INFO(17) INTEGER BLANK INTEGER SUBHD(38) INTEGER NUM(5) INTEGER ISTAT(10) INTEGER YES(2) INTEGER TITLE(21) INTEGER NOTE(15) INTEGER STITL(22) INTEGER ERR2(12) INTEGER ERR3(12) C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMÕ������þúON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA D/104B/ DATA YES/2HYE,2HS / DATA BLANK/2H / C ITEM NAME ITEM TYPE ITEM LENGTH PATH ITEM # ARRAY ELE. WRT ACCESS DATA SUBHD/2H ,2H ,2HIT,2HEM,2H N,2HAM,2HE ,2H , & 2HTY,2HPE,2H ,2H L,2HEN,2HGT,2HH ,2H ,2HKE,2HY , & 2HIT,2HEM,2H ,2H S,2HOR,2HT ,2HIT,2HEM,2H ,2H #, & 2H E,2HLE,2HMT,2HS ,2H ,2HWR,2HT ,2HAC,2HCE,2HSS/ C * * * * IMAGE/1000 SCHEMA * * * * DATA TITLE/2H ,2H ,2H ,2H ,2H* ,2H* ,2H* ,2H* , & 2HIM,2HAG,2HE/,2H10,2H00,2H S,2HCH,2HEM,2HA ,2H* , & 2H* ,2H* ,2H* / C (USING XX AS THE LEVEL WORD) DATA NOTE/2H ,2H ,2H ,2H ,2H ,2H ,2H(U,2HSI, & 2HNG,2H L,2HEV, & 2HEL,2H X,2HX ,2H )/ C C DATA STITL/2H ,2HDA,2HTA,2H S,2HET,2H -,2H X,2HXX, & 2HXX,2HX,,2H ,2H C,2HAP,2HAC,2HIT,2HY ,2H= , & 2HXX,2HXX,2HXX,2HXX,2HXX/ C C C DATA ERR2/2H D,2HAT,2HA-,2HBA,2HSE,2H N,2HOT,2H D,2HEC, & 2HLA,2HRE,2HD / DATA ERR3/2H N,2HO ,2HAC,2HCE,2HSS,2H T,2HO ,2HDA,2HTA, & 2H S,2HET,2HS / C C IMAGE/1000 SCHEMA C C MAX SETS - 50 C MAX ITEMS - 255 C MAX NAMES - 6 CHARS C MAX LENGTH - 2048 C C C C C C C BEGIN C C BE SURE DATA BASE IS DECLARED C IF(DBNAM .EQ. 2H ) GOTO 100 C C SKIP TO TOP OF PAGE C CALL TOPAG(RMOTE,ILP,IERR) C C OUTPUT TITLE - "* * * * IMAGE/1000 SCHEMA * * * *" C " (USING XXlt������þúXXXX AS THE LEVEL WORD) " C CALL QRIO(2,ILP,TITLE,21) CALL CITA(DBLEV,INFO) CALL SMOVE(INFO,5,6,NOTE,26) CALL QRIO(2,ILP,NOTE,15) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) C C GET ALL DATA SETS IN DATA BASE C CALL DBINF(DBNAM,IDMY,203,ISTAT,SETBF) IF(ISTAT .NE. 0) GOTO 90 IF(SETBF .LE. 0) GOTO 110 C C GET ALL THE ITEMS FOR EACH DATA SET C DO 70 ISET = 2,SETBF+1 ISNUM = IABS(SETBF(ISET) ) C C OUTPUT TITLE FOR DATA SET C CALL DBINF(DBNAM,ISNUM,202,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 90 C C GET SET NAME AND PUT IT IN THE MESSAGE C CALL SMOVE(INFO,1,6,STITL,14) C C GET SET TYPE AND PUT IT IN THE MESSAGE C CALL SGET(INFO,17,STYPE) CALL SPUT(STITL,21,STYPE) C C PUT CAPACITY IN MESSAGE C CALL DCITA(INFO(16),STITL(18)) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,STITL,22) CALL QRIO(2,ILP,BLANK,1) C C ITEM NAME TYPE LENGTH KEY ITEM SORT ITEM # ELEMTS WRT ACCESS C CALL QRIO(2,ILP,SUBHD,37) CALL QRIO(2,ILP,BLANK,1) C C GET ALL THE ITEMS ASSOCIATED WITH THIS SET C CALL DBINF(DBNAM,ISNUM,104,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 90 IF(IBUF .LE. 0) GOTO 70 C C GET EACH ITEM IN SET C DO 80 ITM=2,IBUF+1 CALL SFILL(IB,1,80,40B) DINUM = IBUF(ITM) C C INDICATE WRITE ACCESS C IF(DINUM .GT. 0) GOTO 50 CALL SMOVE(YES,1,3,IB,69) DINUM= -DINUM C C GET ITEM CHARACTERISTICS C 50 CONTINUE CALL DBINF(DBNAM,DINUM,102,ISTAT,INFO) IF(ISTAT .NE. 0) GOTO 90 C C PUT NAME IN PRINT BUFFER C CALL SMOVE(INFO,1,6,IB,7) C C PUT ITEM TYPE IN PRINT BUFFER C CALL SGET(INFO,17,ITYPE) CALL SPUT(IB,19,ITYPE) C C PUT ITEM LENGTH IN PRINT BUFFER C CALL CITA(INFO(10),NUM) CALL SMOVE(NUM,3,6,IB,25) C C OUTPUT ELEMENT COUNT C CALL CITA(INFO(11),N©�����UM) CALL SMOVE(NUM,4,6,IB,59) C C INDICATE WHETHER OR NOT A PATH ITEM C IF( .NOT. ISPTH(DBNAM,ISNUM,DINUM,ISTAT) ) GOTO 65 CALL SMOVE(YES,1,3,IB,35) C C OUTPUT SORT ITEM IF ANY C IF (STYPE .NE. D) GOTO 65 CALL GTSRT(DBNAM,ISNUM,DINUM,INFO) CALL SMOVE(INFO,1,6,IB,46) C C WRITE OUTPUT BUFFER C 65 CALL QRIO(2,ILP,IB,37) IF(IFBRK(IDMY)) GOTO 75 80 CONTINUE 70 CONTINUE 75 CONTINUE SNAM(2) = 2H 77 CALL LOAD(SNAM) C C DBMS ERROR C 90 CONTINUE SNAM(2) = 2H23 GOTO 77 C C DATA SET NOT DECLARED 100 CONTINUE CALL ERIO(2,ITTY,ERR2,12) GOTO 75 C C NO ACCESS TO DATA SETS C 110 CONTINUE CALL ERIO(2,ITTY,ERR3,12) GOTO 75 END $ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������UX������ÿÿ����� ���� ÿý�t�} ���������ÿ��92069-18072 1912� S C0122 �&QY09 �QY09 SOURCE � � � � � � � � � � � � �H0101 ?/�����þúFTN4 PROGRAM QY09(5,90),92069-16060 REV.1912 790209 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18072 C RELOC: 92069-16060 C C C************************************************************ C C C CREATE PROCEDURE SERVICE ROUTINE INTEGER END(2) DIMENSION NAME(2) INTEGER ERR3(7) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C .=��� ��  EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE (REG,ISTAT) DATA NAME/2HNA,2HME/ DATA END/2HEN,2HD;/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / C C C C C C C C C C C C C C C C BEGIN C C C C CREATE NAME = <PROCEDURE NAME> ; <PROCEDURE SPEC> C C C RETURN TO NEXT? C C SCAN FOR NAME C CALL LSCAN(IB,I,J,K) IF (JSCOM(NAME,1,4,IB,I,ISTAT).EQ.0) GO TO 35 C C SYNTAX ERROR C 30 CONTINUE IP = 1 34 IF(IEND .LE. 72) GOTO 37 CALL QRIO(2,ITTY,IB(IP),-72) IEND = IEND - 72 IP = IP + 36 GOTO 34 C C WRITE LAST LINE OUT C 37 CALL QRIO(2,ITTY,IB(IP),-IEND) IF (I .GT. 72) I = I- I/72*72 CALL SFILL(IMA,1,72,40B) CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,ERR3,7) GO TO 10 C C SCAN ACROSS = C 35 CONTINUE CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 IPTR = I CALL GTPRM(IMA,IB,J,IPTR,IDCB,IDCB(2),.TRUE.,ISTAT) IF(ISTAT .EQ. -200) GOTO 30 IF (ISTAT.LT.0) GOTO 85 IF(IDCB .GE. 0) GOTO 30 C C GET NEXT WORD OR INPUT C 50 CONTINUE CALL INPUT C C WRITE INPUT TO FILE C REG = QRIO(2,IDCB,IB,-IEND) IF(ISTAT .LT. 0) GOTO 85 IF (JSCOM(IB,IEND-3,IEND,END,1,ISTAT).EQ.0) GO TO 90 GO TO 50 C C FMGR ERROR C 85 CONTINUE CALL FMERR(ISTAT,ITTY) C C CLOSE THE PROCEDURE FILE C 90 CONTINUE CALL ECLOS(IDCB(2)) C C EXIT C 10 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) END $ ��. ������ÿÿ����� ���� ÿý�u�| ���������ÿ��92069-18073 1912� S C0122 �&QY10 �QY10 SOURCE � � � � � � � � � � � � �H0101 8'�����þúFTN4 PROGRAM QY10(5,90),92069-16060 REV.1912 790209 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18073 C RELOC: 92069-16060 C C C************************************************************ C C C DISPLAY SERVICE ROUTINE C DIMENSION NAME(2) INTEGER ERR2(22) INTEGER ERR3(7) INTEGER IERR(2),IL C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) t ������þú COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE (REG,IERR),(IERR(2),IL) DATA NAME/2HNA,2HME/ DATA ERR2/2H P,2HRO,2HCE,2HDU, 1 2HRE,2H N,2HAM,2HE ,2H ,2H , 2 2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H N,2HOT,2H F,2HOU,2HND/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / C C C C C C C C C C C C C C BEGIN C C C C C DISPLAY NAME = <PROCEDURE NAME> C C C SCAN FOR NAME C CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GO TO 30 IF (JSCOM(NAME,1,4,IB,I,IERR).EQ.0) GO TO 35 C C 30 CONTINUE IP = 1 34 IF(IEND .LE. 72) GOTO 37 CALL QRIO(2,ITTY,IB(IP),-72) IEND = IEND - 72 IP = IP + 36 GOTO 34 C C WRITE LAST LINE OUT C 37 CALL QRIO(2,ITTY,IB(IP),-IEND) C C CALL SFILL(IMA,1,72,40B) IF(I .GT. 72) I = I-I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) C ERROR - SYNTAX CALL ERIO(2,ITTY,ERR3,7) GO TO 10 C C SCAN ACROSS = C 35 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 IPTR = I CALL GTPRM(IMA,IB,J,IPTR,IDCB,IDCB(2),.FALSE.,IERR) IF(IERR .EQ. -200) GOTO 30 IF(IERR .EQ. -6) GOTO 40 IF(IERR .LT. 0) GOTO 90 IF(IDCB .GE. 0) GOTO 30 C C READ THE PROCEDURE FILE C 39 CONTINUE REG = QRIO(1,IDCB,IB,-74) IF (IL.LT. 0) GOTO 50 IF (IERR.LT.0) GOTO 90 C C ECHO THE PROCEDURE FILE TO THE LIST DEVICE C CALL QRIO(2,ILP,IB,-IL) GOTO 39 C C PROCEDURE FILE NOT DEFINED C 40 CONTINUE CALL SMOVE(IB,I,J,ERR2,17) CALL ERIO(2,ITTY,ERR2,22) C C C FMGR ERROR C 90 CALL FMERR(IERR,ITTY) C C CLOSE PROCEDURE C 50 CONTINUE CALL ECLOS(IDCB(2)) GOTO 10 C C C EXIT C 10 CONTINUE SNAM(2) = 2H œœ����� CALL LOAD(SNAM) END $ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������—u������ÿÿ����� ���� ÿý�v�~ ���������ÿ��92069-18074 1912� S C0122 �&QY11 �QY11 SOURCE � � � � � � � � � � � � �H0101 :(�����þúFTN4 PROGRAM QY11(5,90),92069-16060 REV.1912 790202 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18074 C RELOC: 92069-16060 C C C************************************************************ C C C DESTROY SERVICE ROUTINE C DIMENSION NAME(2) INTEGER ERR2(22) INTEGER ERR3(7) C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C >������þú EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA NAME/2HNA,2HME/ DATA ERR2/2H P,2HRO,2HCE,2HDU, 1 2HRE,2H N,2HAM,2HE ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H , 2 2H ,2H N,2HOT,2H F,2HOU,2HND/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / C C C C C C C C C C C C BEGIN C C C C DESTROY NAME =<PROCEDURE NAME> C C RETURN TO NEXT? C C C SCAN FOR NAME C CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GO TO 30 IF (JSCOM(NAME,1,4,IB,I,IERR).EQ.0) GO TO 35 30 CONTINUE IP = 1 34 IF(IEND .LE. 72) GOTO 37 CALL QRIO(2,ITTY,IB(IP),-72) IEND = IEND - 72 IP = IP + 36 GOTO 34 C C WRITE LAST LINE OUT C 37 CALL QRIO(2,ITTY,IB(IP),-IEND) C C CALL SFILL(IMA,1,72,40B) IF(I .GT. 72) I = I- I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) C ERROR - SYNTAX CALL ERIO(2,ITTY,ERR3,7) GO TO 10 C C FMGR ERROR C 25 CALL FMERR(IERR,ITTY) GOTO 10 C C PROCEDURE NOT FOUND C 40 CONTINUE CALL SMOVE(IB,I,J,ERR2,17) CALL ERIO(2,ITTY,ERR2,22) GO TO 10 C C SCAN ACROSS = C 35 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME C GTPRM RETURNS A -1 IN IDCB WHEN THE NAME IS A FILE C 0 IN IDCB WHEN THERE WAS NO INPUT C LU IN IDCB WHEN A DEVICE WAS SPECIFIED C RETURNS A DCB IN WORDS 2-145 OF IDCB C OPENS THE FILE AND RETURNS THE ERROR CODE IN IERR C RETURNS THE FILE NAME IN WORDS 1-3 OF IMA C SECURITY CODE IN WORDS 5 OF IMA C CARTRIDGE NUMBER IN WORD 6 OF IMA C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 IPTR = I CALL GTPRM(IMA,IB,J,IPTR,IDCB,IDCB(2),.FALSE.,IERR) IF(IERR .EQ. -200) GOTO 30 IF(IERR .EQ. -6) GOTO 40 IF(IERR .LT. 0) GOTO 25 IF(Iƒ¦����� DCB .GE. 0) GOTO 30 C C PURGE FILE C CALL PURGE(IDCB(2),IERR,IMA,IMA(5),IMA(6) ) IF (IERR.LT.0) GOTO 25 C C EXIT C 10 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) END $ ������������������������������������������������Òã������ÿÿ����� ���� ÿý�w� ���������ÿ��92069-18075 1912� S C0122 �&QY12 �QY12 SOURCE � � � � � � � � � � � � �H0101 <)�����þúFTN4 PROGRAM QY12(5,90),92069-16060 REV.1912 790123 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18075 C RELOC: 92069-16060 C C C************************************************************ C C C C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS C 3) QS12 - TOTALS C 4) QS20 - GROUPS/DETAILS C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY ·+������þúIS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C LOGICAL HDFLG,LEVBRK INTEGER ERR1(8),ERR2(8) REAL DINT INTEGER R INTEGER DS(66),LDS,CS(66),V(8) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSE*������þúRR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA ERR1/2H I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR / DATA ERR2/2H B,2HRE,2HAK,2H R,2HEQ,2HUE,2HST,2HED/ DATA HDFLG/.FALSE./ DATA INTGR/111B/ DATA R/122B/ C C C C C C C C C C C C C C C BEGIN C C PRINT TOTALS C BREAK = .FALSE. NTST = 0 LEVBRK = .FALSE. C C INITIALIZE THE PRINT BUFFER C CALL SFILL(CS,1,COLLIM,40B) C C C DO 210 I = 1,R3 N = SS(1,I) IF(N .LT. 30) GOTO 210 IF(N .GT. 39) GOTO 220 C C THIS IS A PRINT. HAS THE LEVEL CHANGED? C IF((NTST .EQ. N) .OR. (NTST .EQ. 0).OR. .NOT. LEVBRK) GOTO 10 C C YES, PRINT THE LINE AND CHECK THE BREAK REQUEST C CALL PRTLN(CS,COLLIM,V,HDFLG) IF(BREAK) GOTO 240 C C PUT THIS TOTAL IN THE PRINT BUFFER C 10 CONTINUE NTST = N LEVBRK = .FALSE. N = N-30 IF(L(N) .NE. 0) GOTO 210 LEVBRK = .TRUE. C C IS THIS A LITERAL? C IF(SS(3,I) .NE. 0) GOTO 205 C C NO, THEN A ADD, COUNT, OR AVERAGE, OR PRINT ITEM VALUE REQUESTED C C FIND IT'S PLACE IN THE COUNT ARRAY C CALL SPLIT(SS(5,I),SS(6,I),V) LNDX = SS(7,I) C C C DO 30 I2 = 1,5 IF(U(1,I2).EQ. LNDX) GOTO 40 30 CONTINUE C C ERROR - THIS SHOULD NEVER HAPPEN C CALL ERIO(2,ITTY,ERR1,7) GOTO 250 C C IS THE ADD OPTION SET? C 40 CONTINUE IF(V(5) .EQ. 0) GOTO 90 V(5) = 0 C ’������þúC INITIALIZE FROM THE LIST ARRAY C ITYPE = LIST(LNDX,2) LEN = LIST(LNDX,3) IOFF = LIST(LNDX,5) IOFF2 = IOFF + LEN + 1 C C INTEGER ADD PROCESSOR C IF(ITYPE .NE. INTGR) GOTO 50 DINT = ATOTAL(N,I2) GOTO 130 C C REAL ADD PROCESSOR C 50 CONTINUE REAL = ATOTAL(N,I2) GOTO 150 C C COUNT OPTION PROCESSOR C 90 CONTINUE IF(V(7) .EQ. 0) GOTO 120 V(7) = 0 INUM = U(N+1,I2) IF(INUM .LT. 0) GOTO 210 CALL CITA(INUM,DS) LDS = 6 GOTO 160 C C AVERAGE OPTION PROCESSOR C 120 CONTINUE IF(V(8) .EQ. 0) GOTO 205 V(8) = 0 C C GET THE NUMBER OF OCCURANCES C INUM = U(N+1,I2) C C GET INFORMATION FROM THE LIST ARRAY C ITYPE = LIST(LNDX,2) LEN = LIST(LNDX,3) IOFF = LIST(LNDX,5) IOFF2 = IOFF + LEN -1 C C INTEGER AVERAGE C IF(ITYPE .NE. INTGR) GOTO 140 DINT = DDI(ATOTAL(N,I2),DBLEI(INUM) ) C C CONVERT AND SCAN OFF ZEROS C 130 CONTINUE CALL DCITA(DINT,DS) LDS = 10 C C ACCOUNT FOR MINUS C IF(DCO(DINT,DBLEI(0)))132,160,160 C C IF EDIT MASK IS NOT PRESENT THEN PUT MINUS IN C 132 CONTINUE IF(V(6) .NE. 0) GOTO 135 DO 133 I3 =10,1,-1 CALL SGET(DS,I3,ICHAR) CALL SPUT(DS,I3+1,ICHAR) 133 CONTINUE CALL SPUT(DS,1,55B) LDS =�11 GOTO 160 C C ZONE THE LAST CHARACTER C 135 CONTINUE CALL SZONE(DS,10,2,NOZ) GOTO 160 C C AVERAGE REALS C 140 CONTINUE REAL = ATOTAL(N,I2)/INUM C C CONVERT REAL TO ASCII C 150 CONTINUE CALL CRTA(REAL,DS) LDS = 13 C C EDIT FIELD WHEN NECESSARY C 160 CONTINUE IF(V(6) .EQ. 0 .OR. ITYPE .EQ. R) GOTO 190 CALL EDIT(V(6),DS,LDS) C C FIGURE START COLUMN C 190 CONTINUE I3 = SS(4,I) JBEG = 1 ISTRT = I3 - LDS + 1 C C DOES THE FIELD UNDER FLOW PRINT LINE ? C IF(ISTRT .GT. 0) GOTO 200 Á`����� ISTRT = 1 JBEG = LDS - I3 + 1 LDS = I3 C C PUT THE VALUE IN THE PRINT LINE C 200 CONTINUE CALL SMOVE(DS,JBEG,LDS,CS,ISTRT) GOTO 210 C C NO OPTIONS REQUESTED - PRINT THE ITEM VALUE C 205 CONTINUE CALL BUFLN(I,V,CS) C C C END OF LOOP C C 210 CONTINUE C C C C C PRINT THE LAST LINE C 220 CONTINUE IF(.NOT. LEVBRK .OR. NTST .EQ. 0) GOTO 221 CALL PRTLN(CS,COLLIM,V,HDFLG) IF(BREAK) GOTO 240 C C C C C C C C ZERO OUT THE NECESSARY TOTALS AND COUNTS C 221 CONTINUE DO 225 I = 1,R3 N = SS(1,I) IF( N .LT. 30) GOTO 225 IF(N .GT. 39) GOTO 230 C C THIS IS A GROUP STATEMENT, SEE IF THERE WAS A LEVEL BREAK C N = N-30 IF(L(N) .NE. 0) GOTO 225 C C GET THE INDEX INTO THE LIST ARRAY C LNDX = SS(7,I) IF(LNDX .EQ. 0) GOTO 225 C C FIND THE ENTRY IN THE U-ARRAY FOR THIS ITEM C DO 223 I2 = 1,5 IF(U(1,I2) .EQ. LNDX) GOTO 224 223 CONTINUE GOTO 225 C C ZERO OUT THE TOTALED VALUE AND THE COUNT VALUE C 224 CONTINUE ATOTAL(N,I2) = 0 U(N+1,I2) = 0 225 CONTINUE C C LOAD AND EXECUTE GROUP/DETAIL PROCESSOR C 230 CONTINUE SNAM(2) = 2H20 IF(DCO(RCOUNT,DBLEI(0)))250,260,260 C C BREAK EXIT C 240 CONTINUE CALL ERIO(2,ITTY,ERR2,8) C C ERROR EXIT C 250 CONTINUE SNAM(2) = 2H C C SEGMENT LOAD C 260 CONTINUE CALL LOAD(SNAM) END ������������������¿v������ÿÿ����� ���� ÿý�x� ‚ ���������ÿ��92069-18076 1912� S C0122 �&QY13 �QY13 SOURCE � � � � � � � � � � � � �H0101 >*�����þúFTN4 PROGRAM QY13(5,90),92069-16060 REV.1912 781114 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18076 C RELOC: 92069-16060 C C C************************************************************ C C C HELP SERVICE ROUTINE C INTEGER CMND(2),FILE(3),DIR(128) INTEGER KDCB(144) INTEGER IBUF(128) INTEGER ERR1(9),ERR2(7) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5®������þú),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C DATA FILE/2HQS,2HHE,2HLP/ DATA CMND/2H ,2H / C C COMMAND NOT FOUND DATA ERR1/2H C,2HOM,2HMA,2HND,2H N,2HOT,2H F,2HOU,2HND/ C SYNTAX ERROR DATA ERR2/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / C C C C C BEGIN C C LIST = 0 C C SCAN FOR ; OR NAME C CALL LSCAN(IB,I,J,K) IF(K .EQ. 2) GOTO 10 IF(K .EQ. 5) GOTO 60 GOTO 7010 C C MOVE NAME TO CMND C 10 CONTINUE CALL SFILL(CMND,1,4,40B) IF(I+3 .LT. J) J = I + 3 CALL SMOVE(IB,I,J,CMND,1) 15 CALL LSCAN(IB,I,J,K) IF(K .EQ. 2) GOTO 20 IF(K .EQ. 5) GOTO 60 GOTO 7010 20 IF (JSCOM(IB,I,I+1,2HAL,1,IERR).NE.0) GO TO 30 LIST = 111 GO TO 60 30 IF (JSCOM(IB,I,I+1,2HFU,1,IERR).NE.0) GO TO 40 LIST = LIST + 100 GO TO 15 40 IF (JSCOM(IB,I,I+1,2HSY,1,IERR).NE.0) GO TO 50 LIST = LIST + 10 GO TO 15 50 IF (JSCOM(IB,I,I+1,2HOP,1,IERR).NE.0) GO TO 15 LIST = LIST + 1 GO TO 15 60 IF (LIST.EQ.0 .OR. LIST.EQ.111) LIST = 111 C C GET DIRECTORY C CALL OPEN(KDCB,IERR,FILE) 61 IF (IERR.GE.0) GOTO 65 CALL FMERR(IERR,ITTY) GOTO 120 65 CALL READF(KDCB,IERR,DIR,128,ILEN,1) IF (IERR.LT.0) GOTO 61 C C LSEC DATA FILE SECTOR LIMIT C NWDS NO OF WORDS/DIRENTRY ENTRY C NEXT NO OF DIRECTORY ENTRIES C ILIM IDRECTORY LIMIT IN WORDS C IPNT POINTER TO REL SECTOR OF DATA C LSEC=DIR(2) NENT=DIR(3) - 1 NWDS=DIR(4) ILIM=NWDS*NENT + 7 IF (CMND(1).NE.2H ) GO TO 80 70 IOUT=1 ISEC=DIR(7) GO TO 170 80 DO 110 J=8,ILIM,NWDS IF (DIR(J)-CMND(1)) 110,90,110 90 IF (DIR(J+1)-CMND(2)) 110,100,110 100 IPNT=J+2 GO TO 130 110 CONTINUE C C OUTPUT "COMMAND NOT FOUND" C 115 CALL ERIO(2,ITTY,ERR1,9) C 12ж����� 0 CALL CLOSE(KDCB) SNAM(2)=2H CALL LOAD(SNAM) C 130 IF (LIST.LT.100) GO TO 140 ISEC=DIR(IPNT) LIST=LIST-100 GO TO 160 140 IF (LIST.LT.10) GO TO 150 ISEC=DIR(IPNT+1) LIST=LIST-10 GO TO 160 150 IF (LIST.LT.1) GO TO 120 ISEC=DIR(IPNT+2) LIST=LIST-1 160 IOUT=2 C C READ 128 WORDS FROM THE DISC INTO IBUF AND C RESET THE POINTER TO THE START OF THE BUFFER C 170 IPNTR=1 CALL READF(KDCB,IERR,IBUF,128,ILEN,ISEC) IF(IERR.LT.0) GOTO 61 C C PICK UP RECORD LENGTH (WORDS) AND C SUBSTITUTE BLANKS C 180 ILGTH=IBUF(IPNTR) IBUF(IPNTR)=2H C C OUTPUT THE RECORD AND UPDATE THE POINTER C TO THE NEXT RECORD COUNT WORD C ILGTH=ILGTH+1 CALL QRIO(2,ILP,IBUF(IPNTR),ILGTH) IPNTR=IPNTR+ILGTH C C IF NEXT WORD COUNT = -1 INPUT NEXT SECTOR C 0 END OF DATA C + OUTPUT NEXT RECORD C IF (IBUF(IPNTR)) 190,200,180 190 ISEC=ISEC+1 GO TO 170 200 GO TO (120,130), IOUT C C C C C ERROR PROCESSOR C 7010 CONTINUE CALL QRIO(2,ITTY,IB,-IEND) IF(I .GT. 72) I = I-I/72*72 CALL SFILL(IMA,1,72,40B) CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,ERR2,7) GOTO 120 END $ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xa������ÿÿ����� ���� ÿý�y� ���������ÿ��92069-18077 1912� S C0122 �&QY14 �QY14 SOURCE � � � � � � � � � � � � �H0101 @+�����þúFTN4 PROGRAM QY14(5,90),92069-16060 REV.1912 781221 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18077 C RELOC: 92069-16060 C C C************************************************************ C C C UPDATE SERVICE MODULE (PART II) C REPLACE AND DELETE ROUTINES C SEE QS07 FOR ADD ROUTINE C LOGICAL DDS INTEGER A,R,D INTEGER INBR(128) INTEGER ISTAT(10) INTEGER ISTAT2(10) INTEGER ERR1(9) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 qé������þú COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE(S(1,1),ICHAR) EQUIVALENCE(S(3,1),INBR) C DATA A/101B/ DATA D/104B/ DATA R/122B/ DATA ERR1/2H S,2HEL,2HEC,2HT ,2HFI,2HLE,2H E,2HRR,2HOR/ C C UPDATE NAME = <PROCEDURE NAME>; C A,<DATA SET NAME>; C D; C R,<DATA ITEM NAME>="<VALUE>"; C C C C C C BEGIN C C C READ THE FIRST RECORD OF SELECT FILE AND SKIP THE OVERHEAD C RSEC = DBLEI(1) CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 70 RSEC = DIN(RSEC) IPTR = 9 C C TOP OF LOOP C 405 CONTINUE IF(IPTR.LT.65) GOTO 410 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 70 RSEC = DIN(RSEC) IPTR = 1 C C GET RECORD NUMBER IN SELECT FILE C 410 RCOUNT = SELT(IPTR) IPTR = IPTR + 1 C C GET RECORD VIA DIRECTED READ C 20 CONTINUE CALL DBLCK(DBNAM,DSNUM,1,ISTAT) IF(ISTAT .NE. 0) GOTO 60 C C POSITION THE DBMS TO THE CORRECT RECORD C CALL DBGET(DBNAM,DSNUM,4,ISTAT,0,IBUFF,RCOUNT) IF(ISTAT.EQ.0) GOTO 420 CALL DBUNL(DBNAM,DSNUM,1,ISTAT) GOTO 60 C C DELETE UPDATE C 420 CONTINUE IF(ICHAR.EQ.D) GOTO 300 C REPLACE UPDATE IF(ICHAR.EQ.R) GOTO 200 C C RETURN TO NEXT? C 50 SNAM(2) = 2H 55 CALL LOAD(SNAM) C C ERROR - DBMS C 60 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 GOTO 55 C C ERROR READING SELECT FILE C 70 CONTINUE CALL ERIO(2,ITTY,ERR1,9) GOTO 60 C C C UPDATE RECORD C 200 CALL DBUPD(DBNAM,DSNUM,1,ISTAT,INBR,IBUFF) GOTO 500 C C DELETE RECORD C 300 CALL DBDEL(DBNAM,DSNUM,1,ISTAT) 500 CALL DBUNL(DBNAM,DSNUM,1,ISTAT2) C C CHECK THE STATUS OF THE DELEÝ÷����� TE C IF(ISTAT .NE. 0) GOTO 60 C C CHECK THE STATUS OF THE UNLOCK C ISTAT= ISTAT2 IF(ISTAT .NE. 0) GOTO 60 IF(ICHAR .EQ. A) GOTO 50 IF(DDS(RRCNT) ) GOTO 50 GOTO 405 END END$ ����������������������������-z������ÿÿ����� ���� ÿý�z�‚ ���������ÿ��92069-18078 1912� S C0122 �&QY15 �QY15 SOURCE � � � � � � � � � � � � �H0101 B,�����þúFTN4 PROGRAM QY15(5,90),92069-16060 REV.1912 790206 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18078 C RELOC: 92069-16060 C C C************************************************************ C C C C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS C 3) QS12 - TOTALS C 4) QS20 - GROUPS/DETAILS C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY µ5������þúIS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C INTEGER ISTAT(10) REAL RECORD C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMèa������þúON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C C C C C C C C C C BEGIN C IF(IPTR .LT. 65) GOTO 10 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IPTR = 1 RSEC = DIN(RSEC) IF(ISTAT .LT. 0) GOTO 13 C C GET THE RECORD NUMBER OF SELECTED DBMS RECORD C 10 CONTINUE RECORD = SELT(IPTR) IPTR = IPTR + 1 C C GET THE DBMS RECORD, USING THE LIST ARRAY AS THE PARAMETER LIST C IF ALL TH RECORDS ARE REPORTED FORCE A FINAL LEVEL BREAK C I = 7 IF(DCO(RCOUNT,DBLEI(0))) 15,45,12 12 CALL DBGET(DBNAM,DSNUM,4,ISTAT,LIST,IBUFF,RECORD) RCOUNT = DDE(RCOUNT) IF(ISTAT .EQ. 0) GOTO 20 C C FMP AND DBMS ERROR C 13 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 GOTO 80 C C GO BACK TO COMMAND INTERPETER C 15 CONTINUE SNAM(2) = 2H GOTO 80 C C SEE IF THERE IS A LEVEL BREAK C 20 CONTINUE IF( T(1) .EQ. -1) GOTO 35 DO 30 I=1,5 L(I) = -1 CALL LVCHK(I,LEVSTR(1,I),LEVLEN(I) ) 30 CONTINUE C C SEE IF THERE WAS A LEVEL BREAK C 35 CONTINUE DO 40 I = 5,1,-1 IF ( L(I) .NE. -1) GOTO 50 40 CONTINUE C C NO LEVELS BREAKS C GOTO 70 C C SET RCOUNT SO THE TOTAL PROCESSOR WILL DO THE FINAL TOTALS C AND THEN EXECUTE THE COMMAND INTERPETER C 45 CONTINUE RCOUNT = DDE(RCOUNT) C C LEVEL BREAKS, SET BREAK FOR LOWER LEVELS C 50 CONTINUE DO 60 I = I,1,-1 L(I) = 0 60 CONTINUE C C LOAD THE CORRECT PROCESSOR C C IF THIS IS NOT To4�����HE FIRST TIME THRUGH OR THERE ARE NO LEVEL C BREAKS, THEN LOAD AND EXECUTE THE DETAIL/GROUP PROCESSOR (QS20) C ELSE LOAD AND EXECUTE THE TOTALS PROCESSOR (QS12) C C IF( L(7) .EQ. -1) GOTO 70 SNAM(2) = 2H12 GOTO 80 C C C LOAD AND EXECUTE THE GROUP/DETAIL PROCESSOR C THIS NEXT SEGMENT ALSO TOTALS THE NECESSARY FIELDS C C 70 CONTINUE SNAM(2) = 2H20 L(7) = 0 C C C 80 CONTINUE CALL LOAD(SNAM) END ��������������������������������������������<’������ÿÿ����� ���� ÿý�{�„ ���������ÿ��92069-18079 1912� S C0122 �&QY16 �QY16 SOURCE � � � � � � � � � � � � �H0101 D-�����þúFTN4 PROGRAM QY16(5,90),92069-16060 REV.1912 790326 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18079 C RELOC: 92069-16060 C C C************************************************************ C C C EXIT SERVICE MODULE C CLOSE DATA-BASE AND RETURN TO SYSTEM C INTEGER ISTAT(10) INTEGER ERROR(9) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2àK������þú048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C DATA ERROR/2H ,2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C C C C C C C C C BEGIN C C C IF(DBNAM(2) .EQ. 2H ) GOTO 100 CALL DBCLS(DBNAM,IDUM,1,ISTAT) IF(ISTAT .EQ. 0) GOTO 100 CALL CITA(ISTAT,ERROR(7)) CALL QRIO(2,ITTY,ERROR,9) C C RELEASE 'QSKIB' TRACK C 100 CONTINUE CALL EXEC(5,-1) C C CLOSE THE SELECT FILE C CALL ECLOS(JDCB) C C CLOSE THE PROCEDURE FILE C CALL CLEOF(RMOTE,IDCB) C C CLOSE THE INPUT FILE OR DEVICE C CALL CLEOF(RMOTE,INLU) C C CLOSE THE LIST FILE OR DEVICE C CALL CLEOF(RMOTE,ILP) C C CLOSE THE LOG DEVICE OR FILE C CALL CLEOF(RMOTE,ITTY) C C CLOSE THE XEQ FILE C CALL CLEOF(RMOTE,XEQ) STOP END C C C C SUBROUTINE CLEOF(NODE,LU),92069-16060 REV.1912 790220 INTEGER NODE,LU(145) C C C C ABSTRACT: C C THIS ROUTINE CLOSES FILES, OR WRITES AN EOF TO THE DEVICE THEN UNLOCKS C THE DEVICE. THE DEVICES MAY BE LOCAL OR REMOTE. WHEN NODE IS EQUAL C TO -1, THE DEVICE IS LOCAL TO QUERY, OTHERWISE THE DEVICE IS REMOTE. C THE FIRST WORD OF THE LU DATA STRUCTURE INDICATES WHETHER THIS IS A C FILE OR A DEVICE. WHEN THE FIRST WORD IS -1, THIS IS A FILE. OTHER- C WISE, THIS IS A DEVICE LU. C C C CALLING SEQUENCE: C C CALL CLEOF(NODE,LU) C C WHERE: C C NODE C IS THE NODE NUMBER. -1 INDICATES LOCAL NODE. C C LU C IS THE LU DATA STRUCTURE. C WORD 1 INDICATES FILE OR LU C -1 IMPLIES FILE C OTHERWISE IT IS AN LU C WORD 2-145 IS THE FMP DCB FOR THE FILE C C C C C C BEGIN C LU2 = IAND(LU,77B) + 100B C C IF THIS IS A FILE, GO CLOSE IT C IF(LU .LT. 0) GOTO 20 C C IF THIS IS A LOCAL LU, GO WRITE A LOCAL EOF ·=����� C IF(NODE .LT. 0) GOTO 10 C C WRITE A REMOTE EOF TO THE LU C CALL DEXEC(NODE,100003B,LU2) GOTO 30 777 GOTO 15 C C WRITE A LOCAL EOF C 10 CONTINUE CALL EXEC(100003B,LU2) GOTO 30 C C RELEASE THE LU LOCK C 15 CONTINUE CALL LUREQ(NODE,0,LU,IERR) GOTO 30 C C CLOSE THE FILE C 20 CONTINUE CALL ECLOS(LU(2)) C C EXIT C 30 CONTINUE RETURN END ��������������������������������������������������������������´Ã������ÿÿ����� ���� ÿý�|�„ ���������ÿ��92069-18080 1912� S C0122 �&QY17 �QY17 SOURCE � � � � � � � � � � � � �H0101 </�����þúFTN4 PROGRAM QY17(5,90),92069-16060 REV.1912 790125 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18080 C RELOC: 92069-16060 C C C************************************************************ C C C THIS MODULE WILL REPORT "ALL" DATA RECORDS C WITHOUT REPORT FORMATING OR EDITING C C THE "REPORT ALL" PROCESSOR IS BROKEN INTO THREE MODULES: C C QS03 - BUILDS THE SCOOP TABLE WHICH CONTAINS INFORMATION C ABOUT EACHITEM IN THE DATA SET. C QS17 - READS THE DATA RECORD FROM THE DATA SET C QS18 - FORMATS AND PRINTS EACH DATA ITEM'S VALUE C C C NULL ASCII DATA-ITEMS WILL BE FILLED C WITH " "S; INTEGER AND REAL DATA-ITEMS WILL C PRINT AS ZEROS(0). C C RRCNT IS A COUNT OF RETRIEVED RECORDS C WITHIN SELECT-FILE. C INTEGER ITEMS(128) INTEGER ERR1(9) INTEGER ISTAT(10) INTEGER BLANK INTEGER SCOOP(128,6) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144ôÊ������þú),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C EQUIVALENCE COMMENT C C SCOOP IS A 128 BY 6 ARRAY, WHICH CONTAINS AN ENTRY FOR C EACH ITEM IN THE DATA SET. THE FIRST ENTRY CONTAINS C THE NUMBER OF CURRENT ENTRIES. THE OTHERS CONTAIN THE C FOLLOWING INFORMATION: C C WORD 1-3 CONTAINS THE ITEM NAME C WORD 4 CONTAINS THE ITEM TYPE C WORD 5 CONTAINS THE ITEM LENGTH C WORD 6 CONTAINS THE ELEMENT COUNT C C ITEMS IS A 128 WORD ARRAY WHICH CONTAINS THE INFORMATION RETURNED C FROM A DBINF MODE 104. C C SELT CONATINS A RECORD FROM THE SELECT FILE. C C RCOUNT IS THE NUMBER OF DBMS RECORDS SELECTED IN THE SELECT FILE. C C RSEC IS THE CURRENT RECORD NUMBER OF THE SELECT FILE C C IPTR IS THE OFFSET INTO THE SELECT FILE RECORD IN SELT C C LIST IS A FLAG C 0 INDICATES PRINT ITEM NAME C 1 SUPPRESSES THE PRINTING OF THE ITEM NAME C C C EQUIVALENCE(SCOOP,IB) EQUIVALENCE(ITEMS,IB(769)) EQUIVALENCE(LLIST,S(1,1) ) C C BAD SEGMENT C DATA BLANK/2H / C SELECT-FILE ERROR DATA ERR1/2H S,2HEL,2HEC,2HT-,2HFI,2HLE,2H E,2HRR,2HOR/ C C C C C C C C C C C C C C C C C BEGIN C C C PICK UP THE SELECTED RECORD NUMBER C IF(IPTR .LT. 65) GOTO 50 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) RS`����� EC = DIN(RSEC) IPTR = 1 IF(ISTAT .GE. 0) GOTO 50 C C FMP ERROR C CALL QRIO(2,ITTY,ERR1,9) GOTO 140 C C GET THE DATA FROM THE DATA SET C 50 CONTINUE CALL DBGET(DBNAM,DSNUM,4,ISTAT,ITEMS,IBUFF,SELT(IPTR) ) IF(ISTAT .NE. 0) GOTO 140 IPTR = IPTR+1 C C LOAD AND EXECUTE THE SEGEMENT THAT FORMAT THE PRINT RECORD C SNAM(2) = 2H18 CALL LOAD(SNAM) C C LOAD THE COMMAND INTERPETER SEGMENT C 130 CONTINUE SNAM(2) = 2H GOTO 150 C C C DBMS ERROR C 140 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 C C LOAD AND EXECUTE SEGMENT C 150 CONTINUE CALL LOAD(SNAM) END $ ������������������������������������������������������������������������ú’������ÿÿ����� ���� ÿý�}�… ���������ÿ��92069-18081 1912� S C0122 �&QY18 �QY18 SOURCE � � � � � � � � � � � � �H0101 >0�����þúFTN4 PROGRAM QY18(5,90),92069-16060 REV.1912 781114 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18081 C RELOC: 92060-16060 C C C************************************************************ C C C THIS MODULE WILL REPORT "ALL" DATA RECORDS C WITHOUT REPORT FORMATING OR EDITING C C THE "REPORT ALL" PROCESSOR IS BROKEN INTO THREE MODULES: C C QS03 - BUILDS THE SCOOP TABLE WHICH CONTAINS INFORMATION C ABOUT EACHITEM IN THE DATA SET. C QS17 - READS THE DATA RECORD FROM THE DATA SET C QS18 - FORMATS AND PRINTS EACH DATA ITEM'S VALUE C C C NULL ASCII DATA-ITEMS WILL BE FILLED C WITH " "S; INTEGER AND REAL DATA-ITEMS WILL C PRINT AS ZEROS(0). C C RRCNT IS A COUNT OF RETRIEVED RECORDS C WITHIN SELECT-FILE. C LOGICAL IFBRK LOGICAL DDS INTEGER ITEMS(128) INTEGER ELCNT INTEGER INTGR,R,X INTEGER BLANK INTEGER SCOOP(128,6) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(14V ������þú5),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C EQUIVALENCE COMMENT C C SCOOP IS A 128 BY 6 ARRAY, WHICH CONTAINS AN ENTRY FOR C EACH ITEM IN THE DATA SET. THE FIRST ENTRY CONTAINS C THE NUMBER OF CURRENT ENTRIES. THE OTHERS CONTAIN THE C FOLLOWING INFORMATION: C C WORD 1-3 CONTAINS THE ITEM NAME C WORD 4 CONTAINS THE ITEM TYPE C WORD 5 CONTAINS THE ITEM LENGTH C WORD 6 CONTAINS THE ELEMENT COUNT C C ITEMS IS A 128 WORD ARRAY WHICH CONTAINS THE INFORMATION RETURNED C FROM A DBINF MODE 104. C C SELT CONATINS A RECORD FROM THE SELECT FILE. C C RCOUNT IS THE NUMBER OF DBMS RECORDS SELECTED IN THE SELECT FILE. C C RSEC IS THE CURRENT RECORD NUMBER OF THE SELECT FILE C C IPTR IS THE OFFSET INTO THE SELECT FILE RECORD IN SELT C C LIST IS A FLAG C 0 INDICATES PRINT ITEM NAME C 1 SUPPRESSES THE PRINTING OF THE ITEM NAME C C C EQUIVALENCE(SCOOP,IB) EQUIVALENCE(ITEMS,IB(769)) EQUIVALENCE(LLIST,S(1,1) ) C BAD SEGMENT C DATA BLANK/2H / DATA INTGR/111B/ DATA R/122B/ DATA X/130B/ C C C C C C C C C C C C C C C C C BEGIN C C C INITIALIZE OFFSET INTO DATA RECORD C IOFF = 1 C C PRINT THE VALUE FOR EACH ITEM IN THE SET C P5������þúCALL SFILL(IMA,1,72,40B) DO 110 ITM = 2,SCOOP(1,1) + 1 C C PRINT THE ITEM NAME IF THE PRINT OPTION IS ON C 0 IMPLIES DISPLAY C 1 IMPLIES SUPRESS DISPLAY C IF(LLIST .EQ. 1) GOTO 60 IMA(2) = SCOOP(ITM,1) IMA(3) = SCOOP(ITM,2) IMA(4) = SCOOP(ITM,3) CALL SPUT(IMA,9,75B) C C CONVERT THE ITEM VALUE FOR EACH ITEM IN THE ARRAY C 60 CONTINUE ITYPE = SCOOP(ITM,4) LEN = SCOOP(ITM,5) ELCNT = SCOOP(ITM,6) C C NUMERIC OFFSETS ARE IN WORDS C ASCII OFFSETS ARE IN BYTES C IOFF2 = IOFF IF(ITYPE .EQ. X) IOFF2 = IOFF2*2-1 DO 100 I = 1,ELCNT C C INTEGER PROCESSOR C IF(ITYPE .NE. INTGR) GOTO 70 CALL CITA(IBUFF(IOFF2),IMA(6) ) IOFF2 = IOFF2 + 1 IL = 6 GOTO 90 C C REAL PROCESSOR C 70 CONTINUE IF(ITYPE .NE. R) GOTO 80 CALL CRTA(IBUFF(IOFF2),IMA(6) ) IOFF2 = IOFF2 + 2 IL = 13 GOTO 90 C C ASCII PROCESSOR C 80 CONTINUE IL = LEN C C ACCOUNT FOR LONG ASCII ITEMS C 83 CONTINUE IF(IL .LE. 60) GOTO 85 CALL SMOVE(IBUFF,IOFF2,IOFF2+59,IMA,11) IOFF2 = IOFF2 + 60 CALL QRIO(2,ILP,IMA,36) IF(IFBRK(IDUM)) GOTO 130 IL = IL-60 CALL SFILL(IMA,1,72,40B) GOTO 83 C C ADJUST THE OFFSET C 85 CONTINUE CALL SMOVE(IBUFF,IOFF2,IOFF2+IL-1,IMA,11) IOFF2 = IOFF2 + IL C C PRINT THE ITEM VALUE C 90 CONTINUE CALL QRIO(2,ILP,IMA,-(IL + 12) ) IF(IFBRK(IDUM)) GOTO 130 CALL SFILL(IMA,1,72,40B) 100 CONTINUE LEN = LEN * ELCNT IF(ITYPE .EQ. X) LEN = LEN/2 IOFF = IOFF + LEN CALL QRIO(2,ILP,BLANK,1) 110 CONTINUE CALL QRIO(2,ILP,BLANK,1) IF(DDS(RCOUNT) ) GOTO 130 C C C LOAD AND EXECUTE SEGEMENT THAT GETS DATA RECORDS C SNAM(2) = 2H17 CALL LOAD(SNAM) C LOAD THE COMMAND INTERPETER SEGMENT C 130 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) C Q™�������� END $ ����ô�������ÿÿ����� ���� ÿý�~�‡ ���������ÿ��92069-18082 2001� S C0122 �&QY19 �&QY19 � � � � � � � � � � � � �H0101 ÏŒ�����þúFTN4 PROGRAM QY19(5,90),92069-16060 REV.2001 791011 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18082 C RELOC: 92069-16060 C C C************************************************************ C C C C C C ABSTRACT: C C QY19 SORTS THE BLOCKS WHICH WERE WRITTEM TO THE DISC IN THE SEGMENT C QY05, THEN REWRITES THE SELECT FILE ACCORDING TO THE SORTED ORDER. C C THE SORT IS DONE ON TWO LEVELS: MAJOR AND MINOR. THE MODULE QSORT C IS RESPONSIBLE FOR THE MINOR SORT. THEREFORE, SEE IT MORE MORE C DESCRIPTION AT THE DETAIL LEVEL. C C MAJOR SORT: C C THE MAJOR SORT, SORTS THREE BLOCKS FROM THE DISC IN MEMORY C AT ONCE. C C C TOPBLK CURBLK ENDBLK C --------------------------------------------- C ! ! ! ! ! ! ! C DISC ! ! ! ! ! ! ! C ! ! ! ! ! ! ! C --------------------------------------------- C ! ! ! C ------- ------------- ! C ! ! -------------- C ! ! ! C --------------------- C ! ! ! ! C SORT BUFFER C ! ! ! ! C --------------------- C LOWER MID UPPER C C C C WHEN THE SELECTED THREE BLOCKS FROM THE DISC ARE SORTED THE C MIDDLE BLOCK FROM THE SORT BUFFER IS WRITTEN BACK TO ITS C ORIGINAL SLOT AND THE NEXT BLOCK ON THEÔ)������þú DISC IS SELECTED. C C C TOPBLK CURBLK ENDBLK C --------------------------------------------- C ! ! ! ! ! ! ! C DISC ! ! ! ! ! ! ! C ! ! ! ! ! ! ! C --------------------------------------------- C ! ! ! C ------- ------ ! C ! ! -------------- C ! ! ! C --------------------- C ! ! ! ! C SORT BUFFER C ! ! ! ! C --------------------- C LOWER MID UPPER C C C WHEN ALL OF THE BLOCKS ON THE DISC HAVE BEEN SELECTED, THE C TOPBLK AND THE ENDBLK IN THE SORT BUFFER ARE SORTED ACCORDING C TO ALL OF THE BLOCKS ON THE DISC. (THIS IS BECAUSE ALL RECORDS C IN EACH BLOCK ON THE DISC HAVE HAD THEIR OPPORTUNITY TO MIGRATE C TO THE TOP BLOCK AND THE END BLOCK. C C THEREFORE, IT IS NO LONGER NECESSARY TO KEEP THEM IN THE SORT C PARTITION. SO REMOVE THEM FROM CONSIDERATION - THAT IS TAKE C THEM OUT OF THE SORT PARTITION. C C C C C TOPBLK CURBLK ENDBLK C --------------------------------------------- C ! !! ! ! ! !! ! C DISC ! !! ! ! ! !! ! C ! !! ! ! ! !! ! C --------------------------------------------- C ! ! ! C -- ----- ! C ! ! ------ C ! ! ! C --------------------- C ! ! ! ! C SORT BUFFER C ! ! ! ! C --------------------- C LOWEêÅ������þúR MID UPPER C C C NOW SORT THE BUFFERS RECURSIVELY UNTIL THE SORT PARTITION C REDUCES TO 1 OR 2 BLOCKS. ( IT WILL REDUCE TO 1 BUFFER WHEN THE C TOTAL NUMBER OF BUFFERS IS ODD, 2 OTHERWISE.) C C WHEN THE PARTITION REDUCES ITSELF TO 1 BUFFER, SORT IT AND WRITE C IT OUT. C WHEN THE PARTITION REDUCES TO 2, SORT THEM AND WRITE THEM OUT. C C BE AWARE THAT THE TOTAL NUMBER OF BLOCKS MAY ONLY BE ONE OR TWO. C C THE FOLLOWING CODE IS OPTIMIZED SO THAT DISC ACCESSES ARE C REDUCED AS MUCH AS POSSIBLE. THE ABOVE DESCRIPTION IS NOT C A FLOW CHART, BUT SIMPLY THE GENERAL ALGORITHM. C C C C C C C RRCNT IS AN INTEGER VARIABLE,PASSED IN COMMON,WHICH CONTAINS C THE RETRIEVED RECORD COUNT. C C C LOGICAL DDS INTEGER UPPER REAL RECORD REAL BLOCKS REAL CURBLK,TOPBLK,ENDBLK INTEGER RECLF INTEGER ISTAT(10) INTEGER ID1(2),ID2(2) INTEGER ERR2(8) INTEGER ERR3(8) C C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& INTEGER IFTRK,ISIZE,SECBLK,WRDBLK,RECBLK,LENGTH,KEY INTEGER NTRAK,ILU REAL BLKS C&&&&&&&&&&&& QS5COM &&&&&&&&&&&&&&&&& OCT 4 1978 &&&&&&&&& C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(1w������þú0),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C%%%%%%% QS5EQU %%%%%%%%%%%%%%%%%%%%%%%%%%%% OCT 5, 1978 %%%%%%%% EQUIVALENCE(IB,IFTRK) EQUIVALENCE(IB(2),ISIZE) EQUIVALENCE(IB(3),SECBLK) EQUIVALENCE(IB(4),WRDBLK) EQUIVALENCE(IB(5),RECBLK) EQUIVALENCE(IB(6),LENGTH) EQUIVALENCE(IB(7),KEY) EQUIVALENCE(IB(8),NTRAK) EQUIVALENCE(IB(9),ILU) EQUIVALENCE(IB(10),BLKS) EQUIVALENCE(IB(12),XXXXX) C%%%%%%% QS5EQU %%%%%%%%%%%%%%%%%%%%%%%%%%%% OCT 5, 1978 %%%%%%%% EQUIVALENCE (D1,ID1),(D2,ID2) C C INTERNAL ERROR DATA ERR2/2H I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR / C BREAK REQUESTED DATA ERR3/2H B,2HRE,2HAK,2H R,2HEQ,2HUE,2HST,2HED/ C DATA ID1/0,1/ DATA ID2/0,2/ C C C SECBLK - SECTORS PER BLOCK C WRDBLK - WORDS PER BLOCK C SECTRK - SECTORS PER TRACK C RECBLK - RECORDS PER BLOCK C BLKTRK - BLOCKS PER TRACK C RECLF - RECORDS LEFT IN LAST BLOCK C BLKS - TOTAL NUMBER OF BLOCKS NEEDED C C C C C C C C C C C C BEGIN C C INITIALIZE WORK AREA C CALL INITX(IFTRK,ISIZE,SECBLK,ILU) C C BLOCK = LOOP COUNTER C N1 = THE NUMBER OF WORDS IN THE LAST BLOCK C IWRDS = THE NUMBER OF WORDS IN THE OTHER BLOCKS C TOPBLK = THE FIRST BLOCK IN THE PARTITION TO BE SORTED C ENDBLK = THE LAST BLOCK IN THE PARTITION TO BE SORTE[¸������þúD C C UPPER = THE LAST RECORD IN THE SORT BUFFER TO BE SORTED (FOR QSORT) C LOWER = THE FIRST RECORD IN THE SORT BUFFER TO BE SORTED(FOR QSORT) C C MID = WORD OFFSET IN THE SORT BUFFER FOR THE MIDDLE BLOCK C IEND = WORD OFFSET IN THE SORT BUFFER FOR THE LAST BLOCK C C C BLOCKS = BLKS C C RECORDS LEFT = RRCNT - RRCNT / RECBLK * RECBLK C RB = DBLEI(RECBLK) IF(DCO(RB,RRCNT))10,20,20 10 RECLF = ISNGL(DSB(RRCNT,(DMP(DDI(RRCNT,RB),RB)))) IF(RECLF .EQ. 0) RECLF = RECBLK GOTO 30 C C THE # OF RECORDS IS LESS THAN OR EQUAL TO THE BLOCK SIZE C 20 CONTINUE RECLF = ISNGL(RRCNT) C C N1 = # OF WORDS IN THE LAST BLOCK C IWRDS = # OF WORDS IN THE REST OF THE BLOCKS C 30 CONTINUE N1 = RECLF * LENGTH / 2 IWRDS = LENGTH * RECBLK / 2 C C READ FIRST BLOCK C TOPBLK = D1 UPPER = RECLF CALL WORKX(1,IBUFF,IWRDS,TOPBLK) IF(DCO(BLOCKS,ID1)) 330,90,100 C C SORT FOR JUST 1 BLOCK C 90 CONTINUE CALL QSORT(IBUFF,1,UPPER,KEY,LENGTH,LIST,ISTAT) IWRDS = N1 GOTO 210 C C PREPARE TO SORT ONLY TWO BLOCKS C C MID POINTS TO THE MIDDLE BLOCK IN THE SORT BUFFER C IEND POINTS TO THE LAST BLOCK IN THE SORT BUFFER C C UPPER POINTS TO THE LAST RECORD - WHEN THE NUMBER OF BLOCKS IS 2 C ENDBLK POINTS TO THE LAST BLOCK WHICH IS TO BE SORTED. C 100 CONTINUE MID = 1 + IWRDS IEND = MID + IWRDS UPPER = UPPER + RECBLK ENDBLK = BLOCKS IF(DCO(BLOCKS,ID2)) 330,200,120 C C SORT 3 BLOCKS OR MORE C C C C READ END BLOCK C C UPPER NOW POINTS TO THE LAST RECORD IN THE SORT BUFFER C CURBLK IS USED TO POINT TO THE BLOCK ON THE DISC WHICH IS CURRENTLY C BEING USED AS THE MIDDLE BLOCK IN THE SORT BUFFER C C 120 CONTINUE UPPER = UPPER + RECBLK CALL WORKX(1,IBUFF(IEND),N1,ENDBLK) CURBLK = DDE(ENDBLK) C C READ IN NEXT TO LAST BLOCK AND PUT IT IN THE MIDDLE ¨“������þú C 150 CONTINUE CALL WORKX(1,IBUFF(MID),IWRDS,CURBLK) C C DO A QUICK SORT ON THE THREE BUFFERS C CALL QSORT(IBUFF,1,UPPER,KEY,LENGTH,LIST,ISTAT) C C IS BREAK REQUESTED C IF(IFBRK(IDUM) .NE. 0) GOTO 340 C C HAS CURRENT BLOCK AND TOP BLOCK RUN INTO EACH OTHER C IF(DCO(TOPBLK,DDE(CURBLK)))160,170,170 C C NO, WRITE OUT MIDDLE BLOCK C 160 CONTINUE CALL WORKX(2,IBUFF(MID),IWRDS,CURBLK) CURBLK = DDE(CURBLK) GOTO 150 C C THE END BLOCKS ARE NOW ABSOLUTELY SORTED, SO WRITE THEM OUT C 170 CONTINUE CALL WORKX(2,IBUFF,IWRDS,TOPBLK) CALL WORKX(2,IBUFF(IEND),N1,ENDBLK) C C SINCE THE TOP AND THE BOTTOM BLOCK IN THE SORT BUFFER HAVE C BEEN SORTED AGAINEST EVERY BLOCK ON THE DISC, THEY ARE ABSOLUTELY C SORTED. THEREFORE THEY NO LONGER NEED TO BE USED IN FUTURE PASSES. C C DECREASE THE NUMBER OF BLOCKS BY TWO C BLOCKS = DSB(BLOCKS,ID2) C C THE CURBLK WAS LEFT POINTING TO THE BLOCK UNDER THE TOPBLK C SINCE THE TOPBLK MUST BE MOVED DOWN ONE BLOCK SIMPLY SET IT C TO THE CURBLK. C TOPBLK = CURBLK C C MOVE THE END BLOCK UP ONE C ENDBLK = DDE(ENDBLK) C C SET THE SIZE OF THE LAST BLOCK IN THE SORT BUFFER TO THE C SIZE OF THE REST OF THE BLOCKS, SINCE THE PARTIAL BLOCK HAS C ALREADY BEEN SORTED. C N1 = IWRDS C C SET THE UPPER (WHICH REALLY POINTS TO THE LAST RECORD IN THE C SORT BUFFER) TO THE LAST RECORD SINCE ALL THE BLOCKS WILL BE FULL C FROM NOW ON. C UPPER = 2 * RECBLK C C MOVE THE MIDDLE BLOCK IN THE SORT BUFFER TO THE TOP BLOCK C SO TWO DISC ACCESSES MAY BE AVOIDED. C I = MID * 2 -1 CALL SMOVE(IBUFF,I,I+(IWRDS*2)-1,IBUFF,1) C C SEE HOW MANY MORE BLOCKS TO SORT C IF THERE IS ONLY ONE - GO WRITE OUT THE BLOCK C IF THERE IS ONLY TWO - HANDLE THEM SPECIALLY C IF(DCO(BLOCKS,ID2)) 210,200,120 C C SORT THE LAST TWO BLOCKS C 200 CONTINUE CALL WORKX(1,IBUFF(MID),N1,ENDBLK) CALL QSORT(IY”���*��($BUFF,1,UPPER,KEY,LENGTH,LIST,ISTAT) C C WRITE OUT THE MIDDLE BLOCK C CALL WORKX(2,IBUFF(MID),N1,ENDBLK) C C WRITE OUT THE TOP BLOCK C 210 CONTINUE CALL WORKX(2,IBUFF,IWRDS,TOPBLK) C C C WRITE RECORDS TO SELECT FILE C C RSEC = D1 CALL EREAD(JDCB,ISTAT,SELT,128,IL,RSEC) IF(ISTAT .LT. 0) GOTO 280 IPTR = 9 C C C RCOUNT = RRCNT IOFF = IWRDS+IWRDS CURBLK = D1 C C C 220 CONTINUE IF(IOFF .LT. IWRDS+IWRDS) GOTO 230 CALL WORKX(1,IBUFF,IWRDS,CURBLK) CURBLK = DIN(CURBLK) IOFF = KEY + 1 C C C 230 CONTINUE IF(IPTR .LT. 65) GOTO 250 CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC) IF(ISTAT .LT. 0) GOTO 280 IPTR = 1 RSEC = DIN(RSEC) C C C 250 CONTINUE CALL SMOVE(IBUFF,IOFF,IOFF+3,RECORD,1) IOFF = IOFF + LENGTH SELT(IPTR) = RECORD IPTR = IPTR + 1 C C C IF (DDS(RCOUNT)) GOTO 260 GOTO 220 C C WRITE OUT THE LAST RECORD C 260 CONTINUE IF(IPTR .EQ. 1) GOTO 270 CALL EWRIT(JDCB,ISTAT,SELT,128,RSEC) IF(ISTAT .LT. 0) GOTO 280 C C C C C C RELEASE TRACKS C 270 CONTINUE CALL EXEC(5,NTRAK,IFTRK,ILU) SNAM(2) = 2H06 GOTO 320 C C C DBMS ERROR AND FMP ERROR C C 280 CONTINUE CALL EXEC(5,NTRAK,IFTRK,ILU) QSERR = ISTAT SNAM(2) = 2H23 GOTO 320 310 SNAM(2) = 2H 320 CALL LOAD(SNAM) C C INTERNAL ERROR C 330 CONTINUE CALL ERIO(2,ITTY,ERR2,7) GOTO 345 C C BREAK REQUESTED C 340 CONTINUE CALL ERIO(2,ITTY,ERR3,8) 345 CALL EXEC(5,NTRAK,IFTRK,ILU) GOTO 310 END $ ����������������������������������������������������������������������������������������€L*������ÿÿ����� ���� ÿý�� ‹ ���������ÿ��92069-18083 1912� S C0122 �&QY20 �QY20 SOURCE � � � � � � � � � � � � �H0101 9)�����þúFTN4 PROGRAM QY20(5,90),92069-16060 REV.1912 790109 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18083 C RELOC: 92069-16060 C C C************************************************************ C C C C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS C 3) QS12 - TOTALS C 4) QS20 - GROUPS/DETAILS C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY ·-������þúIS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C LOGICAL HDFLG LOGICAL LEVBRK INTEGER CS(66),V(8),NTST,N REAL DINT,REAL INTEGER INTGR,R C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR óÁ������þú COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA INTGR/111B/ DATA R/122B/ DATA HDFLG/.FALSE./ C C C C C C C C C C C C C C C BEGIN C C ACCUMULATE COUNTS AND TOTALS C DO 50 I = 1,5 IF( U(1,I) .EQ. 0) GOTO 60 C C INCREASE COUNT ON EACH LEVEL C DO 10 I2 = 2,7 U(I2,I) = U(I2,I) + 1 10 CONTINUE C C ACCUMULATE C LNDX = U(1,I) IOFF = LIST(LNDX,5) IOFF2 = IOFF + LIST(LNDX,3) - 1 ITYPE = LIST(LNDX,2) C C INTEGER? C IF(ITYPE .NE. INTGR) GOTO 30 CALL SMOVE(IBUFF,IOFF,IOFF2,INUM,1) DINT = DBLEI(INUM) C C C DO 20 I3 = 1,6 ATOTAL (I3,I) = DAD(ATOTAL(I3,I),DINT) 20 CONTINUE GOTO 50 C C REAL C 30 CONTINUE IF(ITYPE .NE. R) GOTO 50 CALL SMOVE(IBUFF,IOFF,IOFF2,REAL,1) DO 40 I3 = 1,6 ATOTAL(I3,I) = ATOTAL(I3,I) + REAL 40 CONTINUE C C C END OF MAJOR LOOP C C 50 CONTINUE C C C C C C C C C PRINT GROUPS WITH DETAIL STATEMENTS C 60 CONTINUE CALL SFILL(CS,1,COLLIM,40B) BREAK = .FALSE. LEVBRK = .FALSE. C C C DO 90 I = 1,R3 N = SS(1,I) IF(N .EQ. 50) GOTO 75 IF(N .LT. 40 .OR. N .GT. 49) GOTO 90 C C BUFFER THE INPUT LINE C IF(L(N-40) .NE. 0) GOTO 90 C C SET LEVBRK TRUE SO IF LAST LINE IT WILL BE PRINTED C 75 CONTINUE LEVBRK = .TRUE. C C BUFFER THE FIELD C CALL BUFLN(IÅ�����,V,CS) C C C C END OF LOOP C 90 CONTINUE C C PRINT THE LAST LINE IF NECESSARY C IF( .NOT. LEVBRK) GOTO 120 CALL PRTLN(CS,COLLIM,V,HDFLG) IF(BREAK) GOTO 180 C C PRINT ALL THE DETAIL LINES C 120 CONTINUE NTST = 0 DO 150 I = 1,R3 N = SS(1,I) IF(N .LT. 51 ) GOTO 150 IF(N .GT. 59 ) GOTO 160 IF(NTST .EQ. N .OR. NTST .EQ. 0) GOTO 140 CALL PRTLN(CS,COLLIM,V,HDFLG) IF(BREAK) GOTO 180 C C BUFFER THE FIELD C 140 CONTINUE NTST = N CALL BUFLN(I,V,CS) 150 CONTINUE C C PRINT THE LAST LINE C 160 CONTINUE IF(NTST .EQ. 0) GOTO 170 CALL PRTLN(CS,COLLIM,V,HDFLG) IF(BREAK) GOTO 180 C C C 170 CONTINUE SNAM(2) = 2H15 C C LOAD AND EXECUTE SEGMENT C 175 CONTINUE CALL LOAD(SNAM) C C ERROR EXIT C 180 CONTINUE SNAM(2) = 2H GOTO 175 END ����������������������������������������������������������������������������������������������P������ÿÿ����� ���� ÿý�€�‰ ���������ÿ��92069-18084 1912� S C0122 �&QY21 �QY21 SOURCE � � � � � � � � � � � � �H0101 ;*�����þúFTN4 PROGRAM QY21(5,90),92069-16060 REV.1912 790205 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18084 C RELOC: 92069-16060 C C C************************************************************ C C C ABSTRACT: C C THIS SEGMENT PARSES THE RUN STRING AND SETS THE FLAG INDICATING C REMOTE OR LOCAL (RMOTE). C C THE RUN STRING IS AS FOLLOWS C C RU,QUERY,INPUT,LIST,LOG,OPTION,NODE C C WHERE: C C INPUT C IS AN FMP NAMR OR LU. WHEN THE INPUT IS A NON-INTERACTIVE DEVICE C OR WHEN IT IS A FILE , QUERY ASSUMES BATCH COMMANDS, AND C DOES NOT PROMPT THE USER FOR INPUT. WHEN NO INPUT PARAMETER IS C GIVEN LU 1 IS ASSUMED. C C LIST C IS AN FMP NAMR OR LU. IT IS THE UNIT TO WHICH ALL OUTPUT FROM C THE COMMANDS ARE DIRECTED. ERRORS ARE NOT LISTED TO THE LIST C UNIT, INSTEAD THEY AR LISTED TO THE LOG DEVICE. WHEN NO LIST C PARAMETER, THEN THE LIST UNIT DEFAULTS TO THE INTERACTIVE INPUT C UNIT. IF THE INPUT UNIT IS NOT INTERACTIVE THEN IT DEFAULTS TO C LU 1. C C LOG C IS AN FMP NAMR OF LU. IT IS THE UNIT TO WHICH ALL ERROR MESSAGES C ARE LISTED. IT ALSO IS THE UNIT TO WHICH THE ECHO OF THE COMMANDS C IS LISTED. WHEN NO LOG PARAMETER IS ENTERED, THE LOG UNIT IS C DEFAULTED TO THE INTERACTIVE INPUT UNIT. WHEN THE INPUT UNIT C IS NOT INTERACTIVE, THE LOG UNIT DEFAULTS TO LU 1. C C OPTION C IS THE WORD "ECHO". THIS INDICATES THAT QUERY SHOULD ECHO C EVERY COMMAND TO THE LOG UNIT. C C NODE C IS THE NODE NUMBER AT WHICH THE REMOTE INTERACTIVE USER IS SITTING. C (Qµ¯������þúUERY DOES NOT RECOGNIZE NON-INTERACTIVE REMOTE DEVICES, BECAUSE C THERE IS NOT A REMOTE EQUIVALENCE TO THE SUBROUTINE "IFTTY".) C C C LOGICAL LUREQ INTEGER IMSG(15) INTEGER BLANK INTEGER XECW(3) INTEGER ERR1(12),ERR2(12),ERR3(11) INTEGER ERR4(8) INTEGER ERR5(12) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA ERR1/2H I,2HLL,2HEG,2HAL,2H I,2HNP,2HUT,2H P,2HAR,2HAM, & 2HET,2HER/ DATA ERR2/2H I,2HLL,2HEG,2HAL,2H L,2HIS,2HT ,2HPA,2HRA,2HME, & 2HTE,2HR / DATA ERR3/2H I,2HLL,2HEG,2HAL,2H L,2HOG,2H P,2HAR,2HAM,2HET, & 2HER/ DATA ERR4/2H I,2HLL,ŠÜ������þú2HEG,2HAL,2H O,2HPT,2HIO,2HN / DATA ERR5/2H I,2HLL,2HEG,2HAL,2H L,2HOC,2HK ,2HON, & 2HIN,2HPU,2HT ,2HLU/ C C C CR/LF/LF/LF IMAGE 1000 QUERY CR/LF/LF/LF DATA IMSG/2H ,2H ,2HIM,2HAG,2HE/,2H10,2H00, &2H Q,2HUE,2HRY,2H ,2H ,2H ,2H ,2H / DATA XECW/2HEX,2HEC,2HW / DATA BLANK/2H / C C C C C C C C C C C C C C C BEGIN C C C C TURN THE STRING LENGTH INTO CHARACTERS C ICNT = 2 * LPARM IPTR = 1 C C GET THE REMOTE STRING LENGTH INTO CHARACTERS C RMOTE = -1 DO 10 I=1,5 CALL NAMR(IMA,PARM,ICNT,IPTR) 10 CONTINUE C C IF 5TH PARAMETER IS AN INTEGER ASSUME IT TO BE GOOD C IF((IAND(IMA(4),3) .EQ. 1).AND.(IMA .NE. NODE(IDMY)))RMOTE = IMA IPTR = 1 C C GTPRM CALLS NAMR WITH THE FIRST FOUR PARAMETERS C RETURNING THE LU IN THE FIFTH OR THE OPENED DCB IN THE SIXTH C THE FLAG IS SET TO INDICATE THAT THE FILE SHOULD NOT C BE CREATED, AND THE LAST PARAMETER INDICATES ERRORS. C CALL GTPRM(IMA,PARM,ICNT,IPTR,INLU,INLU(2),.FALSE.,IERR) IF(IERR .LT. 0) GOTO 7010 C C DEFAULT INPUT TO LOG C IF(INLU .EQ. 0) INLU = 1 C C LUREQ IS TRUE ONLY IF THE LU IS A LOCAL DEVICE, OR IS A LOCAL FILE C WHEN THE INPUT UNIT IS A LOCAL DEVICE OR FILE BATCH IS ASSUMED C C BATCH = LUREQ(RMOTE,1,INLU,IERR) IF(IERR .LT. 0) GOTO 7005 C C GET THE LIST DEVICE C CALL GTPRM(IMA,PARM,ICNT,IPTR,ILP,ILP(2),.TRUE.,IERR) IF(IERR .LT. 0) GOTO 7020 C C DEFAULT TO THE LINE PRINTER C IF(ILP .NE. 0) GOTO 17 ILP = 6 IF(.NOT. BATCH) ILP = INLU C C SET THE ECHO BIT IF THIS IS A FILE C 17 CONTINUE IF(ILP .GT. 0) ILP = ILP + 600B C C GET THE LOG DEVICE C CALL GTPRM(IMA,PARM,ICNT,IPTR,ITTY,ITTY(2),.TRUE.,IERR) IF(IERR .LT. 0) GOTO 7030 C C DEFAULT THE LOG TO THE INPUT DEVICE C IF(ITTY .NE. 0) GOTO 20 ITTY = 1 IF(.NOT. BATCH) ITTY = INLU C c6������þú C SET THE ECHO BIT C 20 CONTINUE IF(ITTY .GT. 0) ITTY = ITTY + 600B C C SET THE ECHO BIT ON THE INPUT C IF(.NOT. BATCH) INLU = INLU + 400B C C GET THE ECHO OPTION C CALL NAMR(IMA,PARM,ICNT,IPTR) ECHO = 0 IF(IAND(IMA(4),3) .NE. 3) GOTO 30 IF(IMA .NE. 2HEC) GOTO 7050 ECHO = 1 C C C INITIALIZE THE GLOBALS C C C PAGLEN = MAXIMUM LINES PER PAGE C COLLIM = MAXIMUM CHARACTERS PER LINE C 30 CONTINUE PAGLEN = 54 COLLIM = 132 C C DINUM = DATA ITEM NUMBER C DSNUM = DATA SET NUMBER C DBNAM = DATA BASE NAME C DSNAM = DATA SET NAME C DINAM = DATA ITEM NAME C DINUM = 0 DSNUM = 0 DBNAM = 2H DBNAM(2) = 2H DINAM = 2H DSNAM = 2H C C C RRCNT = NUMBER OF ENTRIES IN SELECT FILE C SELECT = SELECT FILE NAME C RRCNT = 0 SELECT = 2H C C IBSZ = SIZE OF THE INPUT BUFFER "IB" C IBSZ = 893 C C PRINT THE HEADING C CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,IMSG,15) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) CALL QRIO(2,ILP,BLANK,1) C C LOAD AND EXECUTE COMMAND INTERPRETER C SNAM(2) = 2H CALL LOAD(SNAM) C C C C C C ERROR PROCESSORS C C OUTPUT "ILLEGAL LOCK ON INPUT LU" C 7005 CONTINUE CALL QRIO(2,ITTY,ERR5,12) GOTO 7045 C C OUTPUT "ILLEGAL INPUT PARAMETER" C 7010 CONTINUE CALL QRIO(2,ITTY,ERR1,12) IF(IERR .EQ. -200)7045,7040 C C ILLEGAL LIST PARAMETER C 7020 CONTINUE CALL QRIO(2,ITTY,ERR2,12) IF(IERR .EQ. -200)7045,7040 C C ILLEGAL LOG DEVICE C 7030 CONTINUE ITTY = 401B CALL QRIO(2,ITTY,ERR3,11) IF(IERR .EQ. -200) 7045,7040 C C STOP EXECUTION C 7040 CONTINUE CALL FMERR(IERR,ITTY) 7045 SNAM(2) = 2H16 CALL LOAD(SNAM) C C OUTPUT "ILLEGAL OPTION" C 7050 CONTINUE CALL QRIû«�����O(2,ITTY,ERR4,8) GOTO 7040 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������˜z������ÿÿ����� ���� ÿý�� ‹ ���������ÿ��92069-18085 1912� S C0122 �&QY22 �QY22 SOURCE � � � � � � � � � � � � �H0101 =+�����þúFTN4 PROGRAM QY22(5,90),92069-16060 REV.1912 781221 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18085 C RELOC: 92069-16060 C C C************************************************************ C C C UPDATE SERVICE MODULE (PART III) C UPDATE ADD ROUTINE C INTEGER INBR(128) INTEGER ISTAT(10) INTEGER ISTAT2(10) INTEGER ERROR(8) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMM™ß��� �� ON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE(S(1,1),ICHAR) EQUIVALENCE(S(3,1),INBR) C DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C C C C UPDATE NAME = <PROCEDURE NAME>; C A,<DATA SET NAME>; C D; C R,<DATA ITEM NAME>="<VALUE>"; C C C C C C BEGIN C C C C C C LOCK THE DATA BASE C CALL DBLCK(DBNAM,DSNUM,1,ISTAT) IF(ISTAT .EQ. 0) GOTO 70 C C DBMS ERROR C 30 CONTINUE QSERR = ISTAT SNAM(2) = 2H23 GOTO 55 C C EXIT C 50 CONTINUE SNAM(2) = 2H 55 CALL LOAD(SNAM) C C C ADD THE RECORD TO THE DATA BASE C C 70 CONTINUE CALL DBPUT(DBNAM,DSNUM,1,ISTAT,INBR,IBUFF) C C UNLOCK THE DATA BASE C CALL DBUNL(DBNAM,DSNUM,1,ISTAT2) C C CHECK THE STATUS OF THE ADD C IF(ISTAT .NE. 0) GOTO 30 C C CHECK THE STATUS OF THE UNLOCK C ISTAT= ISTAT2 IF(ISTAT .NE. 0) GOTO 30 GOTO 50 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������ ������ÿÿ����� ���� ÿý�‚�‰ ���������ÿ��92069-18086 1912� S C0122 �&QY23 �QY23 SOURCE � � � � � � � � � � � � �H0101 ?,�����þúFTN4 PROGRAM QY23(5,90),92069-16060 REV.1912 781129 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18086 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C C QY23 IS THE SEGMENT OF QUERY/1000 WHICH TAKES THE CODE OF AN ERROR C ENCOUNTERED BY ANY OTHER SEGMENT AND PRINTS OUT AN APPROPRIATE ERROR C MESSAGE. THE ERROR CODE IS IN QSERR IN COMMON, THE MESSAGE IS PRINT- C ED OUT ON THE LU IN ITTY WHICH IS ALSO IN COMMON. C C INTEGER IQSER C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR ž��� ��  COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C C C C BEGIN C C C SEE IF THE ERROR IS FROM THE FMP. ANY FMP ERROR CODE WILL BE LESS THAN C 100. IF SO, CALL FMERR TO PRINT THE ERROR MESSAGE AND RETURN TO COM- C MAND PROMPT. C IF (QSERR .GE. 100) GO TO 10 C C FMERR EXPECTS A NEGATIVE CODE. C IQSER = -IABS(QSERR) CALL FMERR(IQSER,ITTY) GO TO 20 C C ELSE THE ERROR IS FROM THE DBMS. CALL DBERR TO PRINT THE ERROR MESSAGE C AND RETURN TO COMMAND PROMPT. C 10 CALL DBERR(QSERR,ITTY) C 20 SNAM(2) = 2H CALL LOAD(SNAM) END END$ ��������������������������������������������������������������������������������������������������������������������������������������IÉ ������ÿÿ����� ���� ÿý�ƒ�Š ���������ÿ��92069-18087 2001� S C0122 �&QY24 �&QY24 � � � � � � � � � � � � �H0101 ÊŽ�����þúFTN4 PROGRAM QY24(5,90),92069-16060 REV.2001 791008 C REV.2001 - DOCUMENTATION CHANGE C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18087 C RELOC: 92069-16060 C C C************************************************************ C C C QUERY SUBSYSTEM MAIN MODULE C COMMAND INTERPRETER C C LOGICAL IFTTY INTEGER EDITOR(3) INTEGER IERR5(7) INTEGER ISTAT(10) INTEGER IERR2(9) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) ›É������þú COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C DATA IERR2/2H I,2HNV,2HAL,2HID,2H R,2HEQ,2HUE,2HST,2H / DATA IERR5/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / DATA EDITOR/2HED,2HIT,2HR / C C C C C C C C C C C BEGIN C C C EXECUTE C C SEE IF DEFAULT OF "EDITR" IS REQUESTED C C PARAMETER 1 - INPUT LU C PARAMETER 2 - MAXIMUM LINE C PARAMETER 3 - NODE LOCAL TO THE EDITR C PARAMETER 4 - NODE REMOTE TO THE EDITR, LOCAL TO USER C PARAMETER 5 - LU NUMBER TO APPEND TO THE EDITRTO USER C CALL SFILL(IMA,1,6,40B) IF(S.NE. 5) GOTO 560 CALL SMOVE(EDITOR,1,6,IMA,1) ISTAT(1) = INLU ISTAT(2) = 0 ISTAT(3) = NODE(IDMY) ISTAT(4) = RMOTE ISTAT(5) = INLU GOTO 570 C C GET NAME OF PROGRAM C 560 CONTINUE CALL LSCAN(IB,I,J,K) IF(K .NE. 2) GOTO 7010 CALL SMOVE(IB,I,J,IMA,1) C C PASS THE ORIGINAL PRAMETERS C ISTAT(1) = INLU ISTAT(2) = ILP ISTAT(3) = ITTY ISTAT(4) = ECHO ISTAT (5) = 0 C C XQPRG RENAMES, LOADS AND EXECUTES A PROGRAM C C PARAMETERS: C C DCB THAT XQPRG USES TO FIND THE PROGRAM C EXEC CALL (DO NOT SET THE NO ABORT BIT) C NAME OF PROGRAM C ARRAY CONTAINING THE 5 RMPAR PARAMETERS C ARRAY CONTAINING THE PARAMETER STRING C LENGTH OF STRING( MINUS FOR BYTES, PLUS FOR WORDS) C RETURN PARAMETER LIST (MUST NOT BE SAME ARRAY AS INPUT C PARAMETER LIST) C ERROR WORD SCHEDULING ERROR CODE) C 570 CALL XQPRG(IDCB(2),23,IMA,ISTAT,PARM,-LPARM,ISTAT(6),IERR) IF(IERR .NE. 0) GOTO 7030 20 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) C C SYNTAX ERROR C 7010 CONTINUE CALL SFILL(IMA,1,72,40B) CALL”=����� QRIO(2,ITTY,IB,-IEND) IF(I .GT. 72) I = I - I/72*72 CALL SPUT(IMA,I,136B) CALL QRIO(2,ITTY,IMA,-I) CALL ERIO(2,ITTY,IERR5,7 ) GOTO 20 C C IVALID REQUEST C 7030 CONTINUE CALL ERIO(2,ITTY,IERR2,9) GOTO 20 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������¡Ì������ÿÿ����� ���� ÿý�„�Œ ���������ÿ��92069-18090 2026� S C0122 �&QYHD2 &QYHD2 � � � � � � � � � � � � � �H0101 íÜ�����ASMB NAM QYHD2,7 92069-16061 REV.2026 800129 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18090 * RELOC: 92069-16061 * * *****************************************************************: * * * * * END ����������������������������������������������������������������������������������������������������������������������������������������������������������~­������ÿÿ����� ���� ÿý�…�‹ ���������ÿ��92069-18091 1912� S C0122 �&LSCAN �LSCAN SOURCE � � � � � � � � � � � � �H0101 j�����þúFTN4 SUBROUTINE LSCAN(KARS,I,J,K),92069-16061 REV.1912 781107 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18090 C RELOC: 92069-16060 C C C************************************************************ C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DIMENSƒ������þúION KARS(1) C C VALUE OF K INDICATES ROUTINE IS PROCESSING C BLANKS(1), SYMBOLS(2), LITERALS(3), TERMINATORS(4) C K = 1 80 CONTINUE J = ISCAN - 1 99 J = J + 1 C GET CHARACTER FROM KARS STRING IF (J.LE.IEND) GOTO 70 CALL INPUT GO TO 80 C C C C BRANCH ON CHARACTER TYPE C 1 = IGNORE C 2 = ALPHABETIC CHARACTER C 3 = NUMBER OR SPECIAL SYMBOL C 4 = SEPARATOR OR TERMINATOR C 5 = ILLEGAL CHARACTER C 6 = START OF LITERAL C 70 CALL SGET(KARS,J,KAR) KAR = KAR - 37B GO TO (1,3,6,3,3,3,3,3, C ! " # $ % & ' C 1 3,3,3,3,4,3,4,3, C ( ) * + , - . / C 2 3,3,3,3,3,3,3,3, C 0 1 2 3 4 5 6 7 C 3 3,3,3,4,3,4,3,3, C 8 9 : ; < = > ? C 4 3,2,2,2,2,2,2,2, C @ A B C D E F G C 5 2,2,2,2,2,2,2,2, C H I J K L M N O C 6 2,2,2,2,2,2,2,2, C P Q R S T U V W C 7 2,2,2,3,3,3,3,5), KAR C X Y Z [ \ ] ^ C C BLANK 1 GO TO (99,24,99), K C LETTER 2 GO TO (21,99,99), K C DIGIT OR B-CHAR 3 GO TO (21,99,99), K C TERMINATOR ,/;/= 4 GO TO (23,24,99), K C OTHER CHARACTR 5 GO TO (25,25,99), K C QUOTE 6 GO TO (22,25,26), K C START OF SYMBOL 21 I = J K = 2 GO TO 99 C START OF LITERAL VALUE 22 I = J + 1 K = 3 GO TO 99 C TERMINATOR 23 I = J ISCAN = J + 1 C COMMA IF (KAR.EQ.13) K = 4 C SEMI-COLON IF (KAR.EQ.28) K = 5 C EQUALS IF (KAR.EQ.30) K = 6 C PERIOD IF(KAR .EQ. 15) K=7 RETURN C TERMINATE SYMBOL 24 J = J - 1 ISCAN = J + 1 RETURN C ILLEGAL CHARACTER 25 I = J ISCAN = J + 1 K = -1 RETURN C TERMINATE LITERAL VALUE 26 ISCAN = J + 1 CALL SGET(KARS,ISCAN,KAR) IF(KAR.EÔ����� Q.42B) GO TO 30 J = J - 1 RETURN 30 CALL SMOVE(KARS,ISCAN+1,IEND,KARS,ISCAN) IEND = IEND - 1 GO TO 99 END $ ������������������������������������������������������������������������������������������������������������������lG������ÿÿ����� ���� ÿý�†�Ž ���������ÿ��92069-18092 1912� S C0122 �&LOAD �LOAD SOURCE � � � � � � � � � � � � �H0101 Q9�����þúFTN SUBROUTINE LOAD(INAM),92060-16061 REV.1912 790112 INTEGER INAM(3) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18092 C RELOC: 92069-16060 C C C****************************************************************: C C C INTEGER SEGER(6) INTEGER LFTOPN(14) C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$Im��� �� $$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA SEGER/2H B,2HAD,2H S,2HEG,2HME,2HNT/ DATA LFTOPN/2H D,2HAT,2HA ,2H B,2HAS,2HE , & 2HMA,2HY ,2HBE,2H L,2HEF,2HT ,2HOP,2HEN/ C C C BEGIN C CALL SEGLD(INAM,IERR) CALL QRIO(2,ITTY,SEGER,6) CALL QRIO(2,ITTY,INAM,3) INAM(2) = 2H16 CALL SEGLD(INAM,IERR) CALL QRIO(2,ITTY,SEGER,6) CALL QRIO(2,ITTY,INAM,3) CALL QRIO(2,ITTY,LFTOPN,14) STOP END ����������õ) ������ÿÿ����� ���� ÿý�‡�Ž ���������ÿ��92069-18093 1912� S C0122 �>PRC �GTPRC SOURCE � � � � � � � � � � � � �H0101 ’y�����þúFTN SUBROUTINE GTPRC(ITEST,ISIZE,IERR),92069-16061 REV.1912 781206 INTEGER ITEST(3),IERR,ISIZE C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18093 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C THIS SUBROUTINE GETS THE NAME OF A PROCEDURE FILE IF ONE C IS DECLARED AND OPENS IT AND SCANS THE PROCEDURE FILE C FOR THE 6 CHARACTER KEYWORD IN ITEST. C C CALLING SEQUENCE: C C CALL GTPRC(ITEST,IERR) C C WHERE: C C ITEST C IS A KEYWORD NO LONGER THAN SIX CHARACTERS C C ISIZE C IS THE SIZE IN BYTES OF THE KEYWORD C C IERR C IS AN ERROR INDICATOR, 0 IMPLIES NO ERROR C -1 IMPLIES ERROR C C ON EXIT: C C IDCB IS OPENED TO THE PROCEDURE FILE C IERR CONTAINS AN ERROR CODE C WHEN THERE IS AN ERROR THE PROPER ERROR MESSAGE C IS WRITTEN TO THE LIST DEVICE BY GTPRC C IPFLAG IS SET TO 3 WHEN THERE IS A SUCESSFUL OPEN C OTHERWISE IPFLAG IS SET TO 0 C C C INTEGER ERR14(12),ERR15(8),ERR17(11) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER þª������þúS,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA ERR14/2H I,2HNV,2HAL,2HID,2H P,2HRO,2HCE,2HDU,2HRE, &2H N,2HAM,2HE / DATA ERR15/2H X,2HXX,2HXX,2HX ,2HEX,2HPE,2HCT,2HED/ DATA ERR17/2H P,2HRO,2HCE,2HDU,2HRE,2H N,2HOT,2H D, &2HEF,2HIN,2HED/ C C C C C BEGIN C C C GET THE PROCEDURE C IERR = 0 IPFLAG = 3 CALL LSCAN(IB,I,J,K) IF(K .EQ. 2) GOTO 20 C C ERROR - INVALID PROCEDURE NAME C CALL ERIO(2,ITTY,ERR14,12) GOTO 70 20 CONTINUE IPTR = I CALL GTPRM(IMA,IB,J,IPTR,IDCB,IDCB(2),.FALSE.,IERR2) IF(IDCB .GE. 0) GOTO 25 IF(IERR2 .NE. -6) GOTO 30 C C OUTPUT "PROCEDURE NOT DEFINED" C 25 CONTINUE CALL ERIO(2,ITTY,ERR17,11) GOTO 70 C C MAKE SURE THERE WERE NOT FMP ERRORS C 30 CONTINUE IF(IERR2 .GE. 0) GOTO 50 CALL FMERR(IERR2,ITTY) GOTO 70 C C SCAN ACROSS TO THE KEYWORD C 50 CONTINUE CALL INPUT CALL LSCAN(IB,I,J,K) IF(J-I+1 .NE. ISIZE) GOTO 60 IF(JSCOM (ITEST,1,ISIZE,IB,I,IERR2) .EQ. 0) GOTO 80 C C ERROR - KEYWORD NOT FOUND C 60 1h����� CONTINUE CALL SFILL(ERR15,2,7,40B) IF(ISIZE .GT. 6) ISIZE = 6 CALL SMOVE(ITEST,1,ISIZE,ERR15,2) CALL ERIO(2,ITTY,ERR15,8) CALL ECLOS(IDCB(2)) 70 CONTINUE IPFLAG = 0 IERR = -1 80 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������‰É������ÿÿ����� ���� ÿý�ˆ� ���������ÿ��92069-18094 1912� S C0122 �>PRM �GTPRM SOURCE � � � � � � � � � � � � �H0101 ƒ�����þúFTN SUBROUTINE GTPRM(IRSLT,ISTNG,ICNT,IPTR,ILU,IDCB,CRFLG,IERR) & ,92069-16061 REV.1912 790129 INTEGER IRSLT(10),ISTNG,ICNT,IPTR,ILU,IDCB(144),IERR LOGICAL CRFLG C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18094 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C GTPRM GETS A PARAMETER AND OPENS IT WHEN IT IS A FILE C THE FILE IS OPENED SHARED EXCEPT WHEN THE CREATE FLAG IS TRUE. C C C CALLING SEQUENCE: C C CALL GTPRM(IRSLT,ISTNG,ICNT,IPTR,ILU,IDCB,CRFLG,IERR) C C WHERE: C C IRSLT C IS A 10 WORD BUFFER C C ISTNG C IS THE PARAMETER STRING AS RETURNED FROM "GETST" C C ICNT C IS THE CHARACTER COUNT OF THE STRING C C IPTR C IS THE CURRENT POSITION IN THE STRING C C ILU C IS THE WORD IN WHICH THE LU IS RETURNED C ILU = -1 WHEN THE PARAMETER IS A FILE C C IDCB C IS THE DCB USED TO OPEN THE FILE C C CRFLG C IS A FLAG INDICATING AUTO-CREATE, IE CREATE THE FILE C IF IT DOES NOT EXIST. C C IERR C IS THE FMP ERROR INDICATOR C C C C C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C NO COMMON C C C C C C C C BEGIN C IERR = 0 ILU = 0 CALL NAMR(IRSLT,ISTNG,ICNT,IPTR) IFLAG = IRSLT(4) IF(IFLAG .EQ. 0) GOTO 30 IF(IAND(IFLAG,3B) .E-Q��� �� Q. 3) GOTO 20 C C PARAMETER IS AN LU C IF(IRSLT .LT. 0) IERR = -200 IF(IRSLT .GT. 0) ILU = IRSLT GOTO 30 C C PARAMETER IS A FILE C 20 CONTINUE ILU = -1 C C OPEN THE FILE WITH SHARED ACCESS UNLESS THE CREATE FLAG IS TRUE C IMODE = 1 IF(CRFLG) IMODE = 0 CALL OPEN(IDCB,IERR,IRSLT,0,IRSLT(5),IRSLT(6) ) IF(IERR .GE. 0) GOTO 30 C C IS THIS AN AUTO-CREATE? C IF(IERR .NE. -6) GOTO 30 IF( .NOT. CRFLG) GOTO 30 CALL ECREA(IDCB,IERR,IRSLT,DBLEI(10),4,IRSLT(5),IRSLT(6) ) C C C RETURN C 30 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������������òX ������ÿÿ����� ���� ÿý�‰� ���������ÿ��92069-18095 1912� S C0122 �&GETVL �GETVL SOURCE � � � � � � � � � � � � �H0101 –{�����þúFTN4 SUBROUTINE GETVL(ISET,ITMNO,ITYPE,LEN,ELCNT,IVALU,P2,INBUF, & LU,IERR),92069-16061 REV.1912 790129 INTEGER ELCNT,IVALU(2048),P2,INBUF(40),LU C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18095 C RELOC: 92069-16060 C C C************************************************************ C C C THIS SUBROUTINE GETS AN ITEM VALUE FROM THE BUFFER "INBUF" AND C PUTS IT IN THE BUFFER PASTED IN THE CALLING SEQUENCE. C C QUOTES MUST BE AROUND ALL INPUT C C C CALLING SEQUENCE: C C CALL GETVL(ISET,ITMNO,LEN,ELCNT,IVALU,P2,IERR) C C WHERE: C C ISET C IS THE DATA SET NUMBER C C ITMNO C IS THE DATA ITEM NUMBER C C LEN C IS THE DATA ITEM LENGTH C C ELCNT C IS THE NUMBER OF ELEMENTS IN THE ITEM'S ARRAY C C IVALU C IS A BUFFER WHICH WILL CONTAIN THE VALUES ON EXIT C FROM GETVL. ALL NUMERIC VALUES WILL BE CONVERTED C TO THEIR BINARY EQUIVALENTS. C C P2 C IS THE COLUMN DISPLACEMENT INTO THE IVALU BUFFER. C C INBUF C IS A BUFFER WHICH CONTAINS THE VALUE TO BE CONVERTED C C LU C IS THE LISTING LU C C C IERR C IS AN ERROR INDICATOR C IERR = 0 IMPLIES NO ERROR C IERR = -1 IMPLIES ERROR C C C INTEGER ERR4(15) INTEGER ERR5(11) INTEGER ERR6(19) INTEGER ERR7(10) INTEGER ILTERM(10) INTEGER X,R INTEGER PP2 C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C ¢������þú DATA SPACE/2H / C INPUT TOO LONG - TRUNCATED DATA ERR4/2H V,2HAL,2HUE,2H T,2HOO,2H L, 1 2HON,2HG ,2H- ,2HIT,2HEM,2H I,2HGN,2HOR,2HED/ C NON-NUMERIC INTEGER VALUE DATA ERR5/2H I,2HLL,2HEG,2HAL, 1 2H I,2HNT,2HEG,2HER, 1 2H V,2HAL,2HUE/ C VALUE MUST HAVE QUOTES - ITEM IGNORED DATA ERR6/2H V,2HAL,2HUE,2H M,2HUS,2HT , &2HHA,2HVE,2H Q,2HUO,2HTE,2HS ,2H- ,2HIT,2HEM,2H I,2HGN, &2HOR,2HED/ C NON-NUMERIC IN REAL VALUE DATA ERR7/2H I,2HLL,2HEG,2HAL, & 2H R,2HEA,2HL ,2HVA,2HLU,2HE / DATA R/122B/ DATA X/130B/ C ILLEGAL TERMINATOR DATA ILTERM/2H I,2HLL,2HEG,2HAL,2H T,2HER,2HMI,2HNA,2HTO,2HR / C C C C C C C BEGIN C C C CLEAR ERROR C IERR = 0 C C SELECT THE CORRECT NULL VALUE C NULL = 0 IF(ITYPE .EQ. X) NULL = 40B CALL SFILL(IVALU,P2,P2+LEN*ELCNT-1,NULL) C C GET A VALUE FOR EVERY ELEMENT OF THE ARRAY C PP2 = P2 DO 300 ICNT = 1,ELCNT CALL LSCAN(INBUF,I,J,K) C C CHECK FOR SEMI C IF(K .EQ. 5) GOTO 310 C C IF COMMA CONTINUE TO INCREMENT POINTER UNTIL THERE ARE NO MORE C IF(K .NE. 4) GOTO 200 PP2 = PP2 + LEN GOTO 300 C C VERIFY VALUE IS ENCLOSED IN QUOTES C 200 CONTINUE IF(K .EQ. 3) GOTO 205 CALL ERIO(2,LU,ERR6,19) GOTO 305 C C CONVERT TYPE C 205 CONTINUE IF(ITYPE.EQ.X) GOTO 240 IF(ITYPE.EQ.R) GOTO 230 C C CONVERT DATA TO INTEGER C INT = 0 IF(J-I .LT. 0) GOTO 220 CALL CATI(INBUF,I,J-I+1,INT,ISTAT) IF(ISTAT.EQ.0) GOTO 220 C C INTEGER VALUE ERROR - ITEM IGNORED C 210 CALL ERIO(2,LU,ERR5,11) GOTO 305 220 CONTINUE CALL SMOVE(INT,1,2,IVALU,PP2) GOTO 270 C C REAL ITEM - CONVERT FROM ASCII C 230 CONTINUE VAR = 0.0 IF(J-I .LT. 0) GOTO 235 VAR = CATR(INBUF,I,J,ISTAT) C C IF ERROR OUTPUT "NON-NUMERIC VALUE IN REAL NUMBER" C IF (ISTAT.Ñj����� EQ.0) GOTO 235 CALL ERIO(2,LU,ERR7,10) GOTO 305 C C MOVE VALUE TO OUTPUT BUFFER C 235 CALL SMOVE(VAR,1,4,IVALU,PP2) GOTO 270 C C ASCII INPUT C C C TRUNCATE IF NECESSARY C 240 CONTINUE IF(J-I .LT. 0) GOTO 270 IF(J-I.LT.LEN) GOTO 260 C ERROR - INPUT TOO LONG CALL ERIO(2,LU,ERR4,15) GOTO 305 260 CONTINUE CALL SMOVE(INBUF,I,J,IVALU,PP2) C C UPDATE POINTER C 270 CONTINUE PP2 = PP2 + LEN C C VERIFY THAT THERE IS A LEGAL SEPARATOR C CALL LSCAN(INBUF,I,J,K) IF(K .EQ. 5) GOTO 310 IF(K .EQ. 4) GOTO 300 275 CALL ERIO(2,LU,ILTERM,10) GOTO 305 C C C 300 CONTINUE C C C C END OF DO LOOP C BE SURE THE LIST ENDED WITH A SEMICOLN C IF(K .EQ. 5) GOTO 310 CALL ERIO(2,LU,ILTERM,10) C C DONE WITH ITEM C 305 IERR = -1 310 CONTINUE RETURN END $ ��������������������������������������������������������������������������������������������Ÿ������ÿÿ����� ���� ÿý�Š�’ ���������ÿ��92069-18096 2026� S C0122 �&ISPTH &ISPTH � � � � � � � � � � � � � �H0101 ü�����þúFTN FUNCTION ISPTH(IBASE,DSNUM,DINUM,ISTAT),92069-16061 REV.1912 781112 LOGICAL ISPTH INTEGER IBASE(10),DSNUM,DINUM,ISTAT(10) C C 9/15 CHANGE DUE TO CORRECTION OF DBINF'S 102, AND 202 CALLS C C CHANGE TO TAKE THE ABSOLUTE VALUE OF ITEMS RETURNED FROM DBINF C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18096 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C ISPTH IS A LOGICAL FUNCTION THAT DETERMINES WHETHER A C ITEM IS A PATH OF A SET. C C CALLING SEQUENCE: C C CALL ISPTH(IBASE,DSNUM,DINUM,ISTAT) C C WHERE: C C IBASE C IS THE BSE PARAMETER FOR THE DATA BASE C C DSNUM C IS THE DATA SET NUMBER C C DINUM C IS THE ITEM NUMBER C C ISTAT C IS A TEN WORD INTEGER ARRAY USED FOR ERROR RETURNS C FROM DBMS. ISTAT IS ZERO WHEN THERE ARE NO DBMS ERRORS C ELSE ISTAT CONTAINS THE ERROR CODE FROM DBMS. C C C ON EXIT: C C TRUE - DINUM IS A PATH OF DSNUM C FALSE - DINUM IS NOT A PATH OF DSNUM C C C C C INTEGER IBUF(49),D C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C NEEDS NO COMMON DECLARATION C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C DOES NOT NEED COMMON DATA D/104B/ C C C C C C BEGIN C C CALCULATE WHETHER THIS IS A PATH ITEM C ISPTH = .TRUE. CALL DBINF(IBASE,DSNUM,202,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 265 CALL SGET (IBUF,17,ITYPE) IF(ITYPE .EQ. D) GOTO 282 C C MAKE CALL TO GÖ��� �� ET MASTER'S HASH KEY C CALL DBINF(IBASE,DSNUM,302,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 265 IF(IABS(IBUF).NE. DINUM) GOTO 265 GOTO 284 C C GET ALL PATHS ASSOCIATED WITH DETAIL AND C SEE IF THIS ITEM IS ONE OF THEM C 282 CONTINUE CALL DBINF(IBASE,DSNUM,301,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 265 DO 285 I=3,3*IBUF(1),3 IF( IABS(IBUF(I)) .EQ. DINUM) GOTO 284 285 CONTINUE 265 ISPTH = .FALSE. 284 CONTINUE RETURN END ������������äà ������ÿÿ����� ���� ÿý�‹�’ ���������ÿ��92069-18097 1912� S C0122 �&MEMBR �MEMBR SOURCE � � � � � � � � � � � � �H0101 ‰l�����þúFTN FUNCTION MEMBR(IBASE,DSNUM,DINUM,ISTAT),92069-16061 REV.1912 780915 LOGICAL MEMBR INTEGER IBASE(10),DSNUM,DINUM,ISTAT(10) C C C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18097 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C THIS IS A LOGICAL FUNCTION THAT DETERMINES WHETHER A ITEM IS C A MEMBER OF A DATA SET. C C CALLING SEQUENCE: C C CALL MEMBR(IBASE,DSNUM,DINUM,ISTAT) C C WHERE: C C IBASE C IS THE BASE PARAMETER OF THE DATA BASE C C DSNUM C IS THE DATA SET NUMBER OR IS ZERO WHEN THE DATA SET IS C NOT YET DECLARED. C C DINUM C IS THE ITEM NUMBER C C ISTAT C IS A TEN WORD INTEGER ARRAY USED FOR A DBMS STATUS C ARRAY C C C ON EXIT: C C MEMBR = .TRUE. WHEN THE ITEM IS A MEMBER OF THE DATA SET C MEMBR = .FALSE. WHEN IT IS NOT C C DSNUM = DATA SET NUMBER WHEN THE DATA SET IS IMPLIED C FROM THE ITEM NUMBER. THE DATA SET CAN ONLY C BE IMPLIED FROM THE DATA ITEM WHEN THE ITEM BELONGS C TO ONLY ONE SET. C C ISTAT WILL CONTAIN A DBMS ERROR CODE IN THE FIRST WORD C C INTEGER IBUF(51) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C DOES NOT NEED COMMON C C C C C C C BEGIN C C C VERIFY ITEM BELONGS TO DECLARED SET C MEMBR = .FALSE. CALL DBINF(IBASE,DINUM,204,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 50 C C IF Tº¿��� �� HERE ISN'T A SET DECLARED YET, THEN LET THIS C ITEM NUMBER DETERMINE THE SET NAME C IF(DSNUM .NE. 0) GOTO 20 IF(IBUF .NE. 1) GOTO 50 DSNUM = IABS(IBUF(2) ) GOTO 40 C C BE SURE ITEM BELONGS TO SET WHEN IT IS ALREADY DECLARED C 20 CONTINUE DO 30 I=2,IBUF(1) + 1 IF(DSNUM .EQ. IABS(IBUF(I))) GOTO 40 30 CONTINUE GOTO 50 C C ITEM'S SET IS GOOD C 40 CONTINUE MEMBR = .TRUE. 50 CONTINUE RETURN END ������������������æ¤ ������ÿÿ����� ���� ÿý�Œ�“ ���������ÿ��92069-18098 1912� S C0122 �&INPUT �INPUT SOURCE � � � � � � � � � � � � �H0101 §‰�����þúFTN4 SUBROUTINE INPUT,92069-16061 REV.1912 790215 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18098 C RELOC: 92069-16060 C C C************************************************************ C C C ABSTRACT: C C THIS MODULE GETS INPUT AND PUTS IT INTO THE BUFFER IB. C IT IS RESPONSIBLE FOR PROMPTING THE USER WITH A QUESTION MARK C WHENEVER THE INPUT IT FROM AN INTERACTIVE TERMINAL. IT KNOWS C FROM CHECKING THE REMOTE FLAG WHETHER TO MAKE AN REMOTE OR LOCAL C PROMPT. C C WHEN THIS ROUTINE ENCOUNTERS AN END-OF-FILE IN A BATCH STREAM, C IT WILL SWITCH THE INPUT FILE TO THE ORIGINAL INPUT FILE. THE C ORIGINAL INPUT FILE IS THAT LU OR FILE WHICH WAS ENTERED AS THE C FIRST PARAMETER IN THE RUN STRING. C C WHENEVER AN ERROR IS ENCOUNTERED THE MODULE WILL RETURN TO THE C COMMAND INTERPRETER. C C C C LOGICAL IFBRK INTEGER ASK(2) INTEGER IREG(2) INTEGER SCOLON INTEGER ERR1(8) INTEGER ERR2(6) INTEGER ERR3(31) INTEGER ERR6(11) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN j������þú INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE (REG,IREG),(IREG(2),INLEN) C DATA SCOLON/73B/ DATA ASK/2H? ,2H_ / C INPUT TOO LONG DATA ERR1/2H I,2HNP,2HUT,2H T, 1 2HOO,2H L,2HON,2HG / C END OF FILE DATA ERR2/2H E,2HND,2H O,2HF ,2HFI,2HLE/ C INPUT MUST BE CONTAINED WITHIN MULTIPLE LINES OF 72 COLUMNS DATA ERR3/2H I,2HNP,2HUT,2H M,2HUS,2HT ,2HBE,2H C, & 2HON,2HTA,2HIN,2HED,2H W,2HIT,2HHI,2HN , & 2HMU,2HLT,2HIP,2HLE,2H L,2HIN,2HES,2H O,2HF ,2H 7,2H2 , & 2HCO,2HLU,2HMN,2HS / C INPUT I/O WAS ABORTED DATA ERR6/2H I,2HNP,2HUT,2H I,2H/O,2H W,2HAS,2H A,2HBO,2HRT,2HED/ C C C C C C C C C C C C C BEGIN C IEND = 1 ISCAN = 1 ICNT = 0 C C SEE IF INPUT IS FROM A PROCEDURE FILE C IF IPFLAG IS NOT EQUAL TO 0, THEN IT IS A PROCEDURE FILE C 5 CONTINUE IF(IPFLAG .NE. 0) GOTO 10 C C IF THIS IS BATCH ASSUME INPUT IS LOCAL AND NO PROMPT IS C NECESSARY. C IF(BATCH) GOTO 6 C C IF THIS IS LOCAL MAKE A LOCAL PROMPT C IF(RMOTE .NE. -1) GOTO 7 CALL QRIO(2,INLU,ASK,-3) C C GET THE LOCAL INPUT (WHETHER BATCH OR INTERACTIVE) C 6 CONTINUE REG = QRIO(1,INLU,IMA,-74) GOTO5R������þú 9 C C MAKE A REMOTE CALL USING THE READ WRITE FEATURE C 7 CONTINUE CALL DEXEC(RMOTE,1+100000B,INLU+4000B,IMA,-72,ASK,-3) GOTO 7060 8 CALL ABREG(IREG,INLEN) C C C C IF END-OF-FILE C THEN IF XEQ FILE C THEN GO BACK TO ORIGINAL FILE C 9 CONTINUE IF(INLEN .GE. 0 .OR. INLU .GT. 0) GOTO 20 C C AN END OF FILE WAS FOUND ON A BATCH FILE C (THIS WAS DETERMINED BY THE FACT THE INPUT LENGTH WAS LESS THAN 0 C AND THE DCB/LU DATA STRUCTURE HAS A -1 IN THE FIRST WORD) C WHEN THE CURRENT INPUT FILE IS A SECONDARY BATCH FILE, CLOSE IT C (XEQ WILL EQUAL 0 WHEN THE CURRENT INPUT FILE IS THE PRIMARY BATCH C FILE) C PUT THE ORIGINAL INPUT FILE, WHICH IS SAVED IN THE DCB/LU STRUCTURE C CALLED XEQ, INTO THE CURRENT DCB/LU STRUCTURE, WHICH IS CALLED INLU C RESTORE THE BATCH FLAG TO THE ORIGINAL BATCH FLAG, WHICH WAS SAVED IN C XQBCH. C GO DEFAULT THE INPUT TO A SEMICOLN C IF(XEQ .EQ. 0) GOTO 7010 CALL ECLOS(INLU(2)) CALL SMOVE(XEQ,1,290,INLU,1) BATCH = XQBCH XEQ = 0 GOTO 25 C C THIS IS A PROCEDURE FILE - GET THE INPUT AND CHECK FOR EOF C 10 CONTINUE REG = QRIO(1,IDCB,IMA,-74) IF(INLEN .LT. 0) GOTO 7010 C C IS AN ECHO REQUIRED? C 20 CONTINUE IF((IOFLAG .NE. 0) .OR. (ECHO .NE. 0)) & CALL QRIO(2,ITTY,IMA,-INLEN) C C BE SURE INPUT LINE IS LEGAL C IF(INLEN .GT. 72) GOTO 7030 C C IF THIS IS A ZERO LENGTH RECORD ASSUME SEMICOLN C IF(INLEN .GT. 0) GOTO 30 25 CALL SPUT(IMA,1,SCOLON) INLEN = 1 C C CONCATENATE THE INPUT INTO THE IB BUFFER C 30 CONTINUE IF(IEND+INLEN+1 .GT. IBSZ*2) GOTO 7040 C C COUNT QUOTES C DO 40 I = 1,INLEN CALL SGET (IMA,I,ICHAR) IF(ICHAR .EQ. 42B) ICNT = ICNT + 1 40 CONTINUE ICNT = ICNT - ICNT/2*2 C C FIND LAST NON-BLANK CHARACTER C DO 50 I = INLEN,1,-1 CALL SGET(IMA,I,ICHAR) IF(ICHAR .NE. 40B) G²Ì�����OTO 55 50 CONTINUE C C PUT THE INPUT IN THE BUFFER C 55 CONTINUE CALL SMOVE (IMA,1,INLEN,IB,IEND) IEND = IEND+INLEN C C WHEN THE LAST CHARACTER WAS A SEMICOLN AND QUOTES ARE CLOSED C RETURN TO THE CALLER, OTHERWISE GET MORE INPUT C IF(ICNT .NE. 0) GOTO 5 IF(ICHAR .EQ. SCOLON ) GOTO 60 C C PUT A BLANK AFTER LAST CHARACTER WHEN THE LINE IS TO BE CONTINUED C CALL SPUT(IB,IEND,40B) IEND = IEND + 1 GOTO 5 C C END OF INPUT C C NOTE: CREATE PROCEDURE FILE (QY09) EXPECTS IEND TO BE SET UP C IN JUST THIS MANNER. BE SURE TO CHANGE QY09 SOMETHING C PREVENTS "END;" FROM BEING THE LAST 4 CHARACTERS OF A LINE. C C 60 CONTINUE IEND = IEND - 1 RETURN C C C C C ERROR PROCESSING C C C C OUTPUT "END OF FILE" C 7010 CALL ERIO(2,ITTY,ERR2,6) GOTO 7060 C C OUTPUT "INPUT MUST BE CONTAINED WITHIN MULTIPLE LINES C OF 72 COLUMNS C 7030 CALL QRIO(2,ITTY,IMA,-72) CALL ERIO(2,ITTY,ERR3,31) GOTO 7060 C C OUTPUT "INPUT TOO LONG" C 7040 CALL ERIO(2,ITTY,ERR1,8) GOTO 7060 C C OUTPUT "I/O WAS ABORTED" C 7050 CALL ERIO(2,ITTY,ERR6,11) C C LOAD AND EXECUTE COMMAND INTERPERTER C 7060 CONTINUE SNAM(2) = 2H CALL LOAD(SNAM) END $ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������w������ÿÿ����� ���� ÿý��– ���������ÿ��92069-18099 1912� S C0122 �&REPOP �REPOP SOURCE � � � � � � � � � � � � �H0101 ž�����þúFTN4 SUBROUTINE REPOP(I,J,IERR),92069-16061 REV. 1912 781017 INTEGER I,J,IERR C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18099 C RELOC: 92069-16060 C C C************************************************************ C C INTEGER R8,R9 INTEGER SPACE(3),SKIP(2),ADD(2),COUNT(3),AVER(4) INTEGER A1,A2,A3,A4,A5,B1,B2,B3,B4,B5 INTEGER EZ,E0,E1,E2,E3,E4,E5,E6,E7,E8,E9 INTEGER A,B C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTA������þúL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA SPACE/2HSP,2HAC,2HE / DATA SKIP/2HSK,2HIP/ DATA ADD/2HAD,2HD / DATA COUNT/2HCO,2HUN,2HT / DATA AVER/2HAV,2HER,2HAG,2HE / DATA A1/2HA1/ DATA A2/2HA2/ DATA A3/2HA3/ DATA A4/2HA4/ DATA A5/2HA5/ DATA B1/2HB1/ DATA B2/2HB2/ DATA B3/2HB3/ DATA B4/2HB4/ DATA B5/2HB5/ DATA EZ/2HEZ/ DATA E0/2HE0/ DATA E1/2HE1/ DATA E2/2HE2/ DATA E3/2HE3/ DATA E4/2HE4/ DATA E5/2HE5/ DATA E6/2HE6/ DATA E7/2HE7/ DATA E8/2HE8/ DATA E9/2HE9/ DATA A/101B/ DATA B/102B/ C C FORM REPORT OPTIONS C C IERR = 0 NORMAL RETURN C IERR =-1 ERROR RETURN C I2 = 0 I3 = 0 I4 = 0 I5 = 0 I6 = 0 I7 = 0 I8 = 0 I9 = 0 R8 = 0 C C GET OPTION 10 CALL LSCAN(IB,I,J,K) C IF SEMI-COLON - WRAPUP IF (K.EQ.5) GO TO 55 20 IF(J-I.NE.4) GOTO 90 IF (JSCOM(SPACE,1,5,IB,I,IERR).NE.0) GO TO 90 C C SPACE OPTION C C GET SPACE CONTROL CALL LSCAN (IB,I,J,K) C C ONE OR TWO CHARACTERS IF (I.NE.J) GO TO 80 C C ONE CHARACTER C IS IT A "B" C CALL SGET(IB,I,ICHAR) IF (ICHAR.NE.B) GO TO 60 IF (I2.NE.0) GO TO 70 I2 = 1 50 R8 = 1 C GET TERMINATOR CHAR (, OR ;) CALL LSCAN(IB,I,J,K) C COMMA IF (K.EQ.4) GO TO 10 C SEMI-COLON IF (K.NE.5) GO TO 70 55 I2 = I2+I3+I4+I5+I6 SS(5,R3) = I2 I7 = I7+I8+I9 SS(6,R3) = I7 IERR = 0 RETURN C C IS IT AN "A" C 60 IF (ICHAR.NE.A) GO TO 70 IF (I3.NE.0) GO TO 70 I3 = 10 GO TO 50 C C ERROR RETURN 70 IERR = -1 <������þú RETURN C C TWO CHARACTERS - THEN "AX" OR "BX" 80 R9 = 10 IF(J-I.NE.1) GOTO 70 IF (JSCOM(A1,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A2,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A3,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A4,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A5,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = 1 IF (JSCOM(B1,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 +1 IF (JSCOM(B2,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B3,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B4,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B5,1,2,IB,I,IERR).EQ.0) GO TO 84 81 IF (R8.EQ.1) GO TO 20 GO TO 70 82 IF (I3.NE.0) GO TO 70 I3 = R9 GO TO 50 84 IF (I2.NE.0) GO TO 70 I2 = R9 GO TO 50 C C SKIP OPTION C 90 IF(J-I.NE.3) GOTO 100 IF (JSCOM(SKIP,1,4,IB,I,IERR).NE.0) GO TO 100 C C ERROR IF HEADER STATEMENT IF (SS(1,R3).GT.20 .AND. SS(1,R3).LT.30) GO TO 70 R8 = 0 C C GET SKIP CONTROL ("A" OR "B") CALL LSCAN(IB,I,J,K) IF(I.NE.J) GOTO 70 CALL SGET (IB,I,ICHAR) C IS IT "B" IF (ICHAR.NE.B) GO TO 92 IF (I4.NE.0) GO TO 70 I4 = 100 GO TO 50 C C MUST BE "A" OR ELSE ERROR 92 IF (ICHAR.NE.A) GO TO 81 IF (I5.NE.0) GO TO 70 I5 = 1000 GO TO 50 C C ADD OPTION C 100 IF(J-I.NE.2) GOTO 110 IF (JSCOM(ADD,1,3,IB,I,IERR).NE.0) GO TO 110 IF (I6.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 C MUST BE TOTAL OR ELSE ERROR I6 = 10000 GO TO 50 C C COUNT OPTION C 110 IF(J-I.NE.4) GOTO 120 IF (JSCOM(COUNT,1,5,IB,I,IERR).NE.0) GO TO 120 IF (I8.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 I8 = 100 GO TO 50 C C AV¿Ò�����ERAGE OPTION C 120 IF(J-I.NE.6) GOTO 130 IF (JSCOM(AVER,1,7,IB,I,IERR).NE.0) GO TO 130 IF(I9.NE.0) GO TO 70 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.40) GO TO 70 I9 = 1000 GO TO 50 C C EDIT OPTION C 130 IF (SS(1,R3).LT.30 .OR. SS(1,R3).GT.59) GO TO 70 IF (J-I.GT.1) GO TO 70 R9 = 1 CALL SMOVE (IB,I,J,ID,1) IF (ID.EQ.EZ) GO TO 132 R9 = 60 IF (ID.EQ.E0) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E1) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E2) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E3) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E4) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E5) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E6) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E7) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E8) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E9) GO TO 132 GO TO 70 132 IF (I7.NE.0) GO TO 70 I7 = R9 GO TO 50 END $ ��������������������н������ÿÿ����� ���� ÿý�Ž�— ���������ÿ��92069-18100 1912� S C0122 �&VALUE �VALUE SOURCE � � � � � � � � � � � � �H0101 m�����þúFTN4 SUBROUTINE VALUE(IARG,ISEC,IOFF),92069-16061 REV. 1912 781027 INTEGER IARG(128) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18100 C RELOC: 92069-16060 C C C************************************************************ C C*********************************************************************** C VALUE RETURNS A DATA ITEM VALUE IN THE IARG ARRAY. C IF THE VALUE IS IN THE PART OF QSKIB THAT IS CURRENTLY C IN CORE (IN IMA AND IB BUFFERS) THEN THE VALUE IS TRANSFERRED C DIRECTLY FROM IMA STARTING AT POSITION IOFF. IF THE VALUE C IS NOT IN THE PART OF QSKIB CURRENTLY IN CORE, THEN THE C PART OF QSKIB CONTAINING THE VALUE IS READ INTO IMA, AND C THE TRANSFER EFFECTED. C C CALLING PARAMETERS: C IARG - THE ARRAY IN WHICH THE DATA ITEM VALUE WILL BE RETURNED C ISEC - THE STARTING SECTOR NUMBER OF THE QSKIB BLOCK WHICH C CONTAINS THE VALUE. ISEC RETURNS THE SECTOR OF THE NEXT VALUE. C IOFF - THE WORD OFFSET OF THE VALUE,FROM THE BEGINNING OF ISEC C IOFF RETURNS THE OFFSET OF THE NEXT VALUE C C DEFINITION OF SYMBOLS C QSKIB - THE TRACK CONTAINING DATA ITEM VALUES. EACH VALUE IS C PRECEEDED BY ITS WORD LENGTH.(IF THE LENGTH IS NEGATIVE, THE C VALUE IS A DUPLICATE KEY ITEM VALUE) C IQSEC - THE NUMBER OF SECTORS OF THIS IN-CORE BUFFER (IMA AND IB C BUFFERS ARE LONG ENOUGH FOR SEVEN PHYSICAL DISC SECTORS C WHERE EACH SECTOR IS 128 WORDS LONG) C IMA - THE BUFFER CONTAINING PART OF QSKIB. IF QSKIB IS NO LONGER C THAN IBSZ, ALL VALUES ALWAYS REMAIN CORE IN IMA AND THE C VALUESv¹������þú ARE NEVER REALLY IN QSKIB. (NOTE:THE BUFFER CONSISTS OF C THE IMA AND IB ARRAYS WHICH MUST ALWAYS BE ADJACENT) C TRKNM - THE TRACK NUMBER OF QSKIB C NOTE: THE STARTING SECTOR NUMBER OF THE CURRENT BLOCK OF C QSKIB PRESENTLY IN CORE IS CONTAINED IN SECNO C*********************************************************************** C C C C C C ****************** THIS MODULE NEEDS TO BE CHANGED TO DOUBLE ************ C ****************** INTEGER ************ C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER RC1 C DATA RC1/1/ DATA IQSEC/7/ C C IF BLOCK CONTAINw|����� ING VALUE NOT IN CORE, READ IT INTO IMA IF (ISEC.EQ.SECNO) GO TO 20 CALL EXEC(RC1,IDILU,IMA,IQSEC*128,TRKNM,ISEC) SECNO=ISEC C LEN IN WORDS 20 LEN=IABS(IMA(IOFF)) C MOVE VALUE INTO IARG LENALL=LEN+1 DO 30 MOVE=1,LENALL IARG(MOVE)=IMA(IOFF) IOFF = IOFF + 1 C IF END OF BUFFER, READ NEXT BLOCK FROM QSKIB IF (IOFF.LE.IBSZ) GO TO 30 ISEC=ISEC+IQSEC CALL EXEC (RC1,IDILU,IMA,IQSEC*128,TRKNM,ISEC) IOFF = 1 30 CONTINUE RETURN END $ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������)y������ÿÿ����� ���� ÿý��— ���������ÿ��92069-18101 1912� S C0122 �&WORKR �WORKR SOURCE � � � � � � � � � � � � �H0101 ¦…�����þúASMB NAM WORKR,7 92069-16061 REV.1912 790208 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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. * ************************************************************** * * * SOURCE: 92069-18101 * RELOC: 92069-16060 * * ************************************************************* * ENT INITX,WORKX EXT .ENTR,EXEC,.DMP,.DDI,.DDE,.DSBR FTRK BSS 1 FIRST TRACK OF WORK AREA. SIZE BSS 1 SECTORS PER TRACK JSECT BSS 1 SECTORS PER BLOCK. CONWD BSS 1 DISC LU INITX NOP JSB .ENTR DEF FTRK LDA FTRK,I STA FTRK CLA LDB SIZE,I DST ISIZE LDB JSECT,I ADB JSECT,I DST SECTR LDA CONWD,I SET DISC IOR =B100 LOGICAL UNIT STA CONWD JMP INITX,I * RORW BSS 1 1=READ; 2=WRITE. BUF BSS 1 BUFFER ADDRESS. WORDS BSS 1 POSITIVE NUMBER OF WORDS. BLKNO BSS 1 BLOCK NUMBER. WORKX NOP JSB .ENTR DEF RORW DLD BLKNO,I CONVERT BLOCK NUMBER TO JSB .DDE JSB .DMP DEF SECTR DST TEMP JSB .DDI GET TRACK NUMBER DEF ISIZE STB TRK * JSB .DMP GET SECTOR NUMBER DEF ISIZE JSB .DSBR DEF TEMP STB SECT * LDA TRK ADA FTRK STA TRK * JSB EXEC START TRANSFER TO/FROM DEF *+7 THE WORK AREA. DEF RORW,I DEF CONWD DEF BUF,I DEF WORDS,I DEF TRK DEF SECT * JMP WORKX,I * TRK BSS 1 SECT BSS 1 ISIZE À-��� ��  BSS 2 SECTR BSS 2 TEMP BSS 2 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������iÚ ������ÿÿ����� ���� ÿý��— ���������ÿ��92069-18102 1912� S C0122 �&QSORT �QSORT SOURCE � � � � � � � � � � � � �H0101 «‰�����þúASMB NAM QSORT,7 92069-16061 REV.1912 781012 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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. * ************************************************************** * * * SOURCE: 92069-18102 * RELOC: 92069-16060 * * ************************************************************* * * * * OVERALL STRATEGY: * * QSORT IS A MODIFICATION OF A QUICK SORT AS DOCUMENTED IN KNUTH VOLUME III. * * THE OBJECT IS TO RECURSIVELY PARTITION THE RECORDS TO BE SORTED INTO * TWO PARTITIONS, EVERYTHING IN THE LEFT PARTITION SHOULD BE LESS THAN * EVERYTHING IN THE RIGHT PARTITION, AND EVERY RECORD IN THE LEFT PARTITION * SHOULD BE LESS THAN THE LAST RECORD IN THE PARTITION AND EVERY RECORD * IN THE RIGHT PARTITION SHOULD BE GREATER THAN THE FIRST RECORD IN THE * PARTITION. ALSO IT MUST BE INSURED THAT THE LAST RECORD OF THE LEFT * PARTITION IS LESS THAN THE FIRST RECORD OF THE RIGHT PARTITION. * * * * ---------------------------------------------------- * ! ! !! ! ! * ! LEFT PARTITION !X !!Z ! RIGHT PARTITION ! * ! ! !! ! ! * ---------------------------------------------------- * * EVERY RECORD .LE. X EVERY RECORD .GE. Z * * AND X .LT. Z * * * * IF ALL THE ABOVE CRITERIA IS MEET X AND Z ARE IN THEIR FINAL * POSITIONS AND NEED NOT BE EXAMINED IN FUTURE PASSES. THEREFORE * THE ALGORITHM CAN BE USED RECURSIVELY ON THE SMALLER * OF THE LEFT AND RIGHT PARTITIONS, * THEN RECURSIVELY ON THE LARGER PARTITIONS UNTIL THE ENTIRE BUFFER * IS SORTED. * * WHEN THIS ALGORITHM IS USED WITH QS05 THE PERFORMANCE CAN BE MESR������þúASURED * AS FOLLOWS, * * W = # BYTES IN CORE * B = # BYTES PER RECORD * N = # RECORDS PER FILE * * # OF I/O REQUESTS = (2B/W)2 - 2BN/W+2 * * * SKP * * * * * VARIABLES AND THEIR MEANINGS * * * * XX - CONTAINS AN UPPER LIMIT VALUE FOR THE LEFT PARTITION * ZZ - CONTAINS A LOWER LIMIT VALUE FOR THE RIGHT PARTITION * X - CONTAINS A CURRENT VALUE FROM THE LEFT PARTITION. ALL * VALUES TO THE LEFT OF X MUST BE LESS THAN/ EQUAL TO XX. * Z - CONTAINS A CURRENT VALUE FROM THE RIGHT PARTITION. ALL * VALUES TO THE RIGHT OF Z MUST BE GREATER THAN/ EQUAL TO * ZZ. * P - POINTS TO THE PLACE X CAME FROM * Q - POINTS TO THE PLACE ZERO CAME FROM * IZ - POINTS TO THE PLACE ZZ CAME FROM * IX - POINTS TO THE PLACE XX CAME FROM * L - POINTS TO THE LOW END OF THE LEFT PARTITION * U - POINTS TO THE HIGH END OF THE LEFT PARTITION * L1 - POINTS TO THE LOW END OF THE RIGHT PARTITION * U1 - POINTS TO THE HIGH END OF THE RIGHT PARTITION * * * * * ALGORITHM * * * STEP 1. * EXAMINE THE LOWEST AND THE HIGHEST RECORDS AND PUT THE LESSER * IN THE FIRST RECORD. PUT THE GREATER IN THE LAST * RECORD. * X FIRST RECORD * Z LAST RECORD * * STEP 2. * SET THE LEFT LIMIT (XX) TO X * SET THE RIGHT LIMIT(ZZ) TO Z * * STEP 3. * SCAN FROM LEFT TO RIGHT UNTIL A RECORD IS FOUND THAT IS GREATER * THAN/ EQUAL TO THE LEFT LIMIT. PUT THIS RECORD IN X. * * STEP 4. * SCAN RIGHT END TO THE LEFT UNTIL A RECORD IS FOUND LESS THAN/ EQUAL * TO THE RIGHT LIMIT. PUT THIS RECORD IN Z. * * STEP 5. * INSURE X < Z * * STEP 6. * INSURE XX .LE. X AND ZZ .LE. Z * * STEP 7. * CONTINUE EXECUTING STEPS 3 THROUGH 6 UNTIL THE RECORDS IN X AND * Z ARE ADJACENT IN THE BUFFER. * * STEP 8. * AT THIS TIME X AND Z WILL BE IN THEIR FINAL POSITIONS SINCE * EVERY RECORD TO THE RIGHT OF Z IS GREATER Tôn������þúHAN Z. AND EVERY RECORD * TO THE LEFT OF X IS LESS THAN X, AND X < Z. * * STEP 9. * DIVID THE BUFFER INTO 2 PARTITIONS. THE LEFT PARTITION IS FROM THE * FIRST RECORD UPTO BUT NOT INCLUDING X. THE SECOND PARTITION IS * FROM THE LAST RECORD DOWN TO BUT NOT INCLUDING Z. * * STEP 10. * DECIDE WHICH PARTITION IS SMALLER AND STACK ITS UPPER AND LOWER LIMITS. * * STEP 11. * EXECUTE STEPS 1-10 UNTIL ALL RECORDS ARE SORTED IN THAT PARTITION. * * STEP 12. * POP THE STACK * * STEP 13. * EXECUTE STEPS 1-12 UNTIL EVERYTHING IS SORTED. * * * * * SKP ENT QSORT EXT .ENTR EXT CMP,.MVW AA BSS 1 BUFFER ADDRESS L1 BSS 1 LOWER LIMIT OF THE BUFFER U1 BSS 1 UPPER RECORD LIMIT OF THE BUFFER KEY BSS 1 SIZE OF KEY IN BYTES REC BSS 1 SIZE OF RECORD IN BYTES LIST BSS 1 ADDRESS OF LIST ARRAY STAT BSS 1 STATUS RETURN QSORT NOP JSB .ENTR DEF AA LDA REC,I ARS STA REC REC = SIZE OF RECORD LDA L1,I ADA NEG1 MPY REC ADA AA STA L1 L1 = BASE ADDRESS FOR LOWER RECORD LDA U1,I ADA NEG1 MPY REC ADA AA STA U1 U1 = BASE ADDRES FOR UPPER RECORD LDA REC CMA,INA STA RECN NEGETIVE RECORD SIZE LDA KEY,I ARS CMA,INA STA KEY CLA STA STAT,I STA K REENT ISZ K LDA L1 STA L LDA U1 STA U * * * PART *************** * PART LDA L STA P P = LOWER ADDRESS LDA U U = LEFT LOWER LIMIT STA Q Q = UPPER ADDRESS LDB Z PUT HIGH RECORD IN Z JSB MOVE LDA P LDB X JSB MOVE LDB AA ADB RECN STB II LDA P CMA,INA ADA Q ½������þú ADA RECN STA JJ LDA X LDB Z JSB COMP JMP LA60 X = Z JMP LA60 X < Z LDA Q X > Z STA M M = UPPER ADDRESS LDA P STA J J = LOWER ADDRESS LDA X LDB Z JSB SWICH LA60 LDA L CMA,INA ADA U ADA RECN ADA NEG1 SSA ARE X AND Z BUFFERS ADJACENT IN THE BUFFER JMP LA370 YES LDA X NO, SET XX = X LDB XX JSB MOVE LDA Z LDB ZZ SET ZZ = Z JSB MOVE LDA P STA IX IX = POINTS TO XX BUFFER LDA Q STA IZ IZ POINTS TO ZZ * * * LEFT *************** * SCAN FROM LEFT TO RIGHT UNTIL A RECORD IS FOUND .GE. X * LEFT LDA P ADA REC STA P LDA Q CMA,INA ADA P SSA,RSS JMP LA100 LDA P LDB X JSB MOVE LDA X LDB XX JSB COMP RSS X = XX JMP LEFT X < XX * X > XX * * RIGHT *************** * SCAN FROM RIGHT TO LEFT UNTIL A RECORD IS FOUND .LE. Z * RIGHT LDA Q ADA RECN STA Q CMA,INA ADA P SSA,RSS JMP LA140 LDA Q LDB Z JSB MOVE LDA Z LDB ZZ JSB COMP JMP DIST Z = ZZ JMP DIST Z < ZZ JMP RIGHT Z > ZZ LA140 LDA P LEFT AND RIGHT HAVE RUN INTO EACH OTHER STA Q ADA RECN BACK LEFT OFF BY ONE STA P LDA X LDB Z JSB MOVE LDA P LDB X JSB MOVE * * * DIST *************** * DIST LDA X LDB Z JSB COMP JMP LA200 X = Z JMP LA200 X < Z LDA Q Bƒ������þú X > Z STA M LDA P STA J LDA X LDB Z JSB SWICH LA200 LDA X INSURE XX .LE. X LDB XX JSB COMP JMP LA240 X = XX JMP LA240 X < XX LDA X X > XX LDB XX JSB MOVE LDA II ADA REC STA II LDA P STA IX LA240 LDA ZZ INSURE THAT ZZ .LE. Z LDB Z JSB COMP JMP LEFT ZZ = Z JMP LEFT ZZ < Z LDA Z ZZ > Z LDB ZZ JSB MOVE LDA II ADA REC STA II LDA Q STA IZ JMP LEFT LA100 LDA Q X AND Z ARE ADJACENT ADA RECN STA P * * * OUT *************** * OUT LDA P CPA IX JMP LA320 LDA X LDB XX JSB CHECK JMP LA320 X = XX LDA XX X # XX LDB P JSB MOVE LDA X LDB IX JSB MOVE LA320 LDA Q CPA IZ JMP LA348 LDA Z LDB ZZ JSB CHECK JMP LA348 Z = ZZ LDA ZZ Z # ZZ LDB Q JSB MOVE LDA Z LDB IZ JSB MOVE LA348 LDA Q CMA,INA ADA U CMA,INA ADA P DECIDE WHICH BUFFER IS SMALLER AND LDB L PUT THE UPPER AND LOWER BOUNDS CMB,INB ON THE STACK ADA B SSA,RSS JMP LA350 LDA L STA L1 LDA P ADA RECN STA U1 LDA Q ADA REC STA L JMP LA360 LA350 LDA U STA U1 LDA Q ADA REC STA L1 LDA P ADA RECN STA U LA360 LDA II CPA JJ JMP LA370 LDB U1 CMB,INB ADB L1 SSB JMP RECUR POP LDA U POP THE STAÜa������þúCK CMA,INA ADA L SSA JMP PART LA370 LDA K DONE WITH STACK? CPA ONE JMP QSORT,I YES, EXIT ADA NEG1 STA K ADA BA LDB A,I STB L LDA K ADA CA LDB A,I STB U JMP POP RECUR LDA K NO, GO DO IT AGAIN ADA BA LDB L STB A,I LDA K ADA CA LDB U STB A,I JMP REENT * * * SUBROUTINES FOLLOW. * SKP * * * * MOVE NOP JSB .MVW DEF REC NOP JMP MOVE,I * COMP NOP STA TEMP1 STB TEMP2 JSB CMP DEF *+4 DEF LIST,I DEF TEMP1,I DEF TEMP2,I SZA,RSS JMP COMPX SSA,RSS ISZ COMP ISZ COMP COMPX JMP COMP,I SKP * CHECK NOP JSB COMP JMP CHCKX NOP ISZ CHECK CHCKX JMP CHECK,I * SKP * * * * * * ABSTRACT: * * SWITCH INTERCHANGES 2 RECORDS ADDRESSED BY THE A AND B REGISTERS * A COPY OF THE A-REG IS MOVED TO M * A COPY OF THE B-REG IS MOVED TO J * * CALLING SEQUENCE: * * A-REG - RECORD ADDRESS * B-REG - RECORD ADDRESS * J - LOWER ADDRESS * M - UPPER ADDRESS * * SWICH NOP STA TEMP1 STB TEMP2 LDB RECN LOOPD LDA TEMP1,I STA Y LDA TEMP2,I STA J,I STA TEMP1,I LDA Y STA M,I STA TEMP2,I ISZ TEMP1 ISZ TEMP2 ISZ J ISZ M INB,SZB JMP LOOPD JMP SWICH,I SKP * * * BUFFER AREA. * X DEF XM Z DEF ZM XX DEF XXM ZZ DEF ZZM XM BSS 42 ZM BSS 42 XXM BSS 42 ZZM BSS 42 I BSS 1 J BSS 1 L BSS 1 M BSS 1 P BSS 1 Q BSS 1 U BSS 1 Y BSS 1 ñ÷���*��($ II BSS 1 IX BSS 1 JJ BSS 1 IZ BSS 1 TEMP1 BSS 1 TEMP2 BSS 1 RECN BSS 1 K BSS 1 CA DEF * CC BSS 30 BA DEF * BB BSS 30 NEG1 DEC -1 ONE DEC 1 A EQU 0 B EQU 1 END ����������������������EÇ*������ÿÿ����� ���� ÿý�‘�  ���������ÿ��92069-18103 1912� S C0122 �&CMP �CMP SOURCE � � � � � � � � � � � � �H0101 3�����þúFTN INTEGER FUNCTION CMP(LIST,ABUF,BBUF),92069-16061 REV.1912 781027 INTEGER LIST(101,6),ABUF(42),BBUF(42) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18103 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C C C C ABSTRACT: C C CMP COMPARES A DATA RECORD ASSOCIATED WITH THE INFORMATION IN C THE TABLE LIST. LIST IS A ARRAY IN WHICH IS THE FOLLOWING C INFORMATION, C C WORD 1 - ITEM NUMBER C WORD 2 - ITEM TYPE C WORD 3- ITEM LENGTH IN BYTE C WORD 4 - NUMBER OF ELEMENTS C WORD 5 - OFFSET IN BYTES INTO THE BUFFERS C WORD 6 - FLAG INDICATING SORT KEY C 0 IMPLIES NOT A SORT KEY C N IS THE ITEM NUMBER OF THE SORT KEY C ALL THE SORT KEYS ARE AT THE FIRST OF THE LIST-ARRAY C C C C THE FIRST ENTRY OF THE LIST ARRAY IS DIFFERENT THAN THE REST. C C WORD 1 - NUMBER OF ENTRIES IN THE ARRAY C WORD 6 - NUMBER OF SORT ITEMS C C THE LIST ARRAY IS ARRANGED FROM THE LEAST SIGNIFICANT SORT FIELD C (S[NULL]) TO THE MOST SIGNIFICANT SORT FIELD (S[5]), THEREFORE C EACH RECORD CONTAINS INFORMATION FROM THE LEAST SIGNIFICANT FIELD C TO THE MOST SIGNIFICANT FIELD, WHICH IS REALLY IN REVERSE SORT C ORDER. (THE FACT THAT THE DATA IS IN REVERSE SORT ORDER IS BECAUSE C THE LIST ARRAY IS USED WITH THE DBGET CALL.) THEREFORE, C CMP COMPARES FROM THE BOTTOM OF THE LIST ARRAY TO THE TOP. THIS C WILL ASSURE THAT THE SORT IS FROM THE MOST SIGNIFICANT FIELD TO THE C LEAST SIGNIFICANT FIELD. DO NOT GET CONFUSED BECAUSE THE RECORD C IS BEING SORT FROM RIGHT TO Ô¥������þúLEFT - HOW THE PHYSICAL RECORD IS ARRANGED C IS NOT IMPORTANT, ONLY HOW THE SORT FIELDS ARE SORTED. C C CALLING SEQUENCE: C C CALL CMP(LIST,ABUF,BBUF) C C WHERE: C C ABUF C IS A DATA BUFFER WHICH CORRESPONDS TO THE LIST ARRAY C C BBUF C IS A DATA BUFFER WHICH CORRESPONDS TO THE LIST ARRAY C C LIST C IS DESCRIBED ABOVE C C C ON EXIT: C C CMP IS LESS THAN ZERO WHEN ABUF .LT. BBUF C IS ZERO WHEN ABUF .EQ. BBUF C IS GREATER THAN WHEN ABUF .GT. BBUF C C C IF(CMP(LIST,ABUF,BBUF)) <,=,> C C C C C INTEGER L,I,IA,IB,ITEM REAL A,B INTEGER R C C C C C DATA INTGR/111B/ DATA R/122B/ C C C C C C C C C C BEGIN C DO 70 ITEM = LIST(1,6)+1,2,-1 C C GET ITEM TYPE C ITYPE = LIST(ITEM,2) C C GET BYTE OFFSET C I = LIST(ITEM,5) C C GET END OF ITEM C L = I + LIST(ITEM,3) - 1 C C PROCESS INTEGERS C IF(ITYPE .NE. INTGR) GOTO 35 I = (I+1)/2 IA=ABUF(I) IB = BBUF(I) C C THIS IS A KLUDGE BECAUSE FORTRAN CANNOT HANDLE COMPARISONS C OF VERY LARGE AND VERY SMALL INTEGERS. (IE, 100000B AND 000001B) C IF(IA) 10,20,20 10 IF(IB) 30,80,80 20 IF(IB) 90,30,30 30 IF(IA-IB) 80,70,90 C C PROCESS REALS C 35 CONTINUE IF(ITYPE .NE. R) GOTO 65 CALL SMOVE(ABUF,I,L,A,1) CALL SMOVE(BBUF,I,L,B,1) C C KLUDGE TO HANDLE REALS FOR THE SAME REASON AS ABOVE C IF(A) 40,50,50 40 IF(B) 60,80,80 50 IF(B) 90,60,60 60 IF(A-B) 80,70,90 C C PROCESS STRINGS C 65 CONTINUE IF(JSCOM(ABUF,I,L,BBUF,I,IERR)) 80,70,90 70 CONTINUE C C C EQUAL C C CMP = 0 GOTO 100 C C C LESS THAN C C 80 CONTINUE CMP = -1 GOTO 100 C C C GREATER THAN C C 90 CONTINUE CMP = 1 C C C EXIT C C 100 CONTINUE RETURN END ��������������������������������¢*�������� ������������� �������ÿÿ����� ���� ÿý�’�š ���������ÿ��92069-18104 1912� S C0122 �&LVCHK �LVCHK SOURCE � � � � � � � � � � � � �H0101 Œh�����þúFTN SUBROUTINE LVCHK(INDX,STRNG,LEN),92069-16061 REV.1912 781025 INTEGER INDX,STRNG(66),LEN C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18104 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C LVCHK CHECKS TO SEE IF THERE IS A LEVEL BREAK, AND SETS THE L-ARRAY C ACCORDINGLY. C C CALLING SEQUENCE: C C CALL LVCHK(INDX,STRNG,LEN) C C WHERE: C C INDX C IS THE INDEX INTO THE T-ARRAY AND L-ARRAY C T-ARRAY CONTAINS INDEX INTO THE LIST-ARRAY C L-ARRAY INDICATES LEVEL BREAKS C -1 INDICATES NO BREAK C 0 INDICATES BREAK C LIST-ARRAY CONTAINS GOOD INFORMATION ABOUT THE C DBMS BUFFER, (ITEM NUMBER, ITEM TYPE, ITEM C LENGTH, # ELEMENTS, OFFSET INTO DBMS BUFFER, C A FLAG INDICATING WHETHER IT IS A SORT ITEM OR NOT) C C C C STRNG C IS THE BUFFER IN WHICH THE CURRENT LEVEL'S STRING C IS PLACED. C C LEN C IS THE LEVELS CURRENT LENGTH C C ON EXIT: C C STRNG - CONTAINS CURRENT LEVEL BREAK STRING C LEN - CONTAINS LENGTH OF CURRENT STRING C L-ARRAY ENTRY IS SET TO ZERO IF THE STRING CHANGED C C C INTEGER DS(66),LDS C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSoT������þúZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C BEGIN C C T(N) IS EQUAL TO -1 WHEN THERE ARE NO MORE LEVELS C IF(T(INDX) .EQ. -1) GOTO 20 C C CONVERT THE ITEM TO ASCII C NOTE: THAT A ZERO IS BEING SENT AS AN EDIT MASK C THIS WILL INSURE THAT ALL INTEGERS COME BACK C WITH THEIR SIGN ON THE LEFT HAND SIDE. C THIS IS OK SINCE THE LEVEL STRINGS NEVER GET C PRINTED. AS A MATTER OF FACT LEVEL STRINGS ARE C ASSOCIATED WITH SORT LEVELS AND SORT LEVELS DO C NOT NECESSARILY GET PRINTED. C C CALL FIELD(LIST,T(INDX),0,IBUFF,DS,LDS) IF(LDS .NE. LEN) GOTO 10 IF(JSCOM(DS,1,LDS,STRNG,1) .EQ. 0) GOTO 20 C C A LEVEL BREAK HAS OCCURED C 10 CONTINUE LEN = LDS CALL SMOVE(DS,1,LDS,STRNG,1) L(INDX) = 0 C C EXIT C 20 CONTINUE RETURN END ������öó�������� ������������� �������ÿÿ����� ���� ÿý�“�› ���������ÿ��92069-18105 1912� S C0122 �&FIELD �FIELD SOURCE � � � � � � � � � � � � �H0101 yT�����þúFTN SUBROUTINE FIELD(LST,LNDX,EMSK,IBUF,RESULT,LEN),92069-16061 REV. &1912 781027 INTEGER LST(101,6),LNDX,EMSK,IBUF(2048),RESULT(66),LEN C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18105 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C FIELD GETS A VALUE FROM THE DBMS BUFFER ACCORDING THE INFORMATION C IN THE LIST ARRAY. THE ITEM VALUE IS CONVERTED TO ASCII AND C PLACED IN THE RESULT BUFFER. ASCII FIELDS ARE TRUNCATED TO C THE COLLUMN LIMIT SO THEY WON'T OVER RUN THE BUFFER. REALS ARE C IN G13.5 FORMAT. INTEGERS ARE ZONED WHENEVER AN EDIT MASK IS C ASSOCITED WITH THE REPORT STATEMENT. OTHERWISE INTEGERS HAVE C THEIR SIGN IN THE LEFTMOST CHARACTER WHEN THE INTEGER IS C NEGETIVE. C C CALLING SEQUENCE: C C CALL FIELD(LST,LNDX,EMSK,IBUFF,RESULT,LEN) C C WHERE: C C LST C IS THE LIST ARRAY IN COMMON C C LNDX C IS THE INDEX IN TO THE LIST ARRAY - THIS VALUE C USUALLY IS SS(7,N) C C EMSK C IS THE EDIT MASK NUMBER C C IBUF C IS THE DBMS BUFFER C C RESULT C IS THE ASCII VALUE C C LEN C IS THE LENGTH OF THE STRING C C ON EXIT: C C RESULT - CONTAINS THE ASCII VALUE C LEN - LENGTH OF THE ASCII VALUE IN BYTES C C C C C INTEGER INTGR,R INTEGER IOFF,IOFF2,INT,NOZ,N C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DIöŸ������þúNAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA INTGR/111B/ DATA R/122B/ C C C C C C C C C C BEGIN C IF(LNDX .EQ. 0) GOTO 30 C C BLANK THE RESULT BUFFER C CALL SFILL(RESULT,1,COLLIM,40B) C C GET THE LENGTH OF THE ITEM VALUE IN BYTES C LEN = LST(LNDX,3) IF(LEN .GT. COLLIM) LEN = COLLIM C C GET THE OFFSET INTO THE DBMS BUFFER C IOFF = LST(LNDX,5) IOFF2 = IOFF + LEN - 1 C C GET THE ITEM TYPE C ITYPE = LST(LNDX,2) C C PROCESS INTEGERS C IF(ITYPE .NE. INTGR) GOTO 10 CALL SMOVE(IBUF,IOFF,IOFF2,INT,1) CALL CITA(INT,RESULT) C C IF THERE IS NOT AN EDIT MASK THEN LEAVE THE SIGN ON THE LEFT C LEN = 6 IF(EMSK .EQ. 0) GOTO 30 C C OTHERWISE ZONE T'×����� HE LAST CHARACTER FOR THE "SEDIT" ROUTINE C CALL SZONE(RESULT,1,4,NOZ) C C OVERLAY THE SIGN WITH THE REST OF THE NUMBER, C BE SURE TO OVERLAY THE LAST CHARACTER WITH A BLANK C FROM THE SEVENTH POSITION C CALL SMOVE(RESULT,2,7,RESULT,1) CALL SZONE(RESULT,5,NOZ,N) LEN = 5 GOTO 30 C C PROCESS REALS C 10 CONTINUE IF(ITYPE .NE. R) GOTO 20 CALL SMOVE(IBUF,IOFF,IOFF2,REAL,1) CALL CRTA(REAL,RESULT) LEN = 13 GOTO 30 C C ASCII C 20 CONTINUE CALL SMOVE(IBUF,IOFF,IOFF2,RESULT,1) C C EXIT C 30 CONTINUE RETURN END ����������������������������������������������������������������������������������������������������������������������������������������U������ÿÿ����� ���� ÿý�”�œ ���������ÿ��92069-18106 1912� S C0122 �&SKIP �SKIP SOURCE � � � � � � � � � � � � �H0101 mG�����þúFTN SUBROUTINE SKIP(SKPPG,SPACE,HDFLG),92069-16061 REV.1912 790119 INTEGER SKPPG,SPACE LOGICAL HDFLG INTEGER BLANK C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18106 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C SKIP APPLIES THE FIRST FOUR PRINT OPTIONS C C CALLING SEQUENCE: C C CALL SKIP(SKPPG,SPACE,HDFLG) C C WHERE: C C SKPPG C INDICATES WHETHER TO SKIP A PAGE C C SPACE C NUMBER OF LINES TO SPACE C C HDFLG C THIS INDICATES WHETHER A HEADER IS BEING PRINTED C HDFLG = .TRUE. INDICATES A HEADER IS BEING PRINTED C HDFLG = .FALSE. INDICATES OTHERWISE C C NOTE: HDFLG HAS BEEN OBSOLETED, AND NO LONGER USED C BECAUSE PHDRI NO LONGER CALLS SKIP. 1/19/79 C C C C ON EIXT: C C THE CORRECT NUMBER OF LINES WILL BE SKIPPED C WHEN HDFLG IS .FALSE. A HEADER IS ALSO PRINTED C OTHERWISE IT IS NOT C C C C C C C INTEGER STRNG(66) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGE3ì��� �� R R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA BLANK/2H / C C C BEGIN C C IF(SKPPG .EQ. 0) GOTO 10 C C SKIP A PAGE C 5 CONTINUE IF(PAGCNT .GE. 0) PAGCNT = PAGCNT + 1 CALL TOPAG(RMOTE,ILP,IERR) C C SET SKIP PAGE INDICATOR TO ZERO C SKPPG = 0 LNCNT = 0 C C DON'T OUTPUT HEADING WHEN PRINTING A HEADER C IF( HDFLG) GOTO 10 CALL SFILL(STRNG,1,COLLIM,40B) CALL PHDRI(STRNG) C C SPACE C 10 CONTINUE IF(LNCNT .GE. PAGLEN) GOTO 5 IF(SPACE .LE. 0) GOTO 30 CALL QRIO(2,ILP,BLANK,1) SPACE = SPACE -1 LNCNT = LNCNT + 1 GOTO 10 C C EXIT C 30 CONTINUE RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ƒ¡ ������ÿÿ����� ���� ÿý�•�œ ���������ÿ��92069-18107 2013� S C0122 �&PRTLN � � � � � � � � � � � � � �H0101 Š”�����þúFTN SUBROUTINE PRTLN(STRNG,LEN,V,HDFLG),92069-16061 REV.2013 791119 INTEGER STRNG(37),LEN,V(8) LOGICAL HDFLG C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18107 C RELOC: 92069-16060 C C C****************************************************************: C C C C C CALLING SEQUENCE: C C CALL PRTLN(STRNG,LEN,V,HDFLG) C C WHERE: C C STRNG C IS THE ASCII STRING TO BE PRINTED C C LEN C IS THE POSITIVE LENGTH OF THE STRING IN BYTES C C V C IS AN ARRAY CONTAINING THE PRINT OPTIONS ACCORDING C TO THE SUBROUTINE SPLIT. C C HDFLG C TRUE = THIS IS A HEADER PRINT STATEMENT C FALSE = THIS IS A SIMPLE LINE C C HDFLG IS USED TO KEEP THIS SUBROUTINE FROM BECOMING C RECURSIVE. C C C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145)tÒ��� ��  COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C C C C BEGIN C C C C SET THE BREAK FLAG TO FALSE C BREAK = .FALSE. C C SKIP THE CORRECT NUMBER OF PAGES AND LINES C CALL SKIP(V(3),V(1),HDFLG) C C SCAN OFF THE BLANKS C DO 10 I = LEN,2,-1 CALL SGET(STRNG,I,ICHAR) IF(ICHAR .NE. 40B) GOTO 20 10 CONTINUE C C THIS IS A TOTALLY EMPTY LINE C C PRINT A BLANK C C C PRINT THE LINE C 20 CONTINUE CALL QRIO(2,ILP,STRNG,-I) LNCNT = LNCNT + 1 C C CHECK THE BREAK FLAG C 30 CONTINUE IF(IFBRK (IDUM) .NE. 0) GOTO 50 C C SKIP THE APPROPRIATE LINES AFTER THE LINE C CALL SKIP(V(4),V(2),HDFLG) C C BLANK THE STRING C CALL SFILL(STRNG,1,COLLIM,40B) GOTO 60 C C C SET BREAK TO TRUE C 50 CONTINUE BREAK = .TRUE. 60 RETURN END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������<à ������ÿÿ����� ���� ÿý�–� ���������ÿ��92069-18108 1912� S C0122 �&HDLN �HDLN SOURCE � � � � � � � � � � � � �H0101 ^6�����þúFTN SUBROUTINE HDLN(STRNG,LEN,V,HDFLG),92069-16061 REV.1912 790129 INTEGER STRNG(37),LEN,V(8) INTEGER BLANK LOGICAL HDFLG C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18108 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C ø·��� �� EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C DATA BLANK/2H / C C C C C C BEGIN C C C C SET THE BREAK FLAG TO FALSE C BREAK = .FALSE. C C SKIP THE CORRECT NUMBER OF PAGES AND LINES C IF(V(1) .EQ. 0) GOTO 6 DO 5 I = 1,V(1) CALL QRIO(2,ILP,BLANK,1) LNCNT = LNCNT + 1 5 CONTINUE V(1) = 0 C C SCAN OFF THE BLANKS C 6 CONTINUE DO 10 I = LEN,1,-1 CALL SGET(STRNG,I,ICHAR) IF(ICHAR .NE. 40B) GOTO 20 10 CONTINUE C C THIS IS A TOTALLY EMPTY LINE C I = 1 C C PRINT THE LINE C 20 CONTINUE CALL QRIO(2,ILP,STRNG,-I) LNCNT = LNCNT + 1 C C CHECK THE BREAK FLAG C IF(IFBRK (IDUM) .NE. 0) GOTO 50 C C SKIP THE APPROPRIATE LINES AFTER THE LINE C IF(V(2) .EQ. 0) GOTO 45 DO 40 I = 1,V(2) CALL QRIO(2,ILP,BLANK,1) LNCNT = LNCNT + 1 40 CONTINUE V(2) = 0 C C BLANK THE STRING C 45 CONTINUE CALL SFILL(STRNG,1,COLLIM,40B) IF(LNCNT .LT. PAGLEN) GOTO 60 CALL TOPAG(NODE,ILP,IERR) LNCNT = 0 GOTO 60 C C C SET BREAK TO TRUE C 50 CONTINUE BREAK = .TRUE. 60 RETURN END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ù× ������ÿÿ����� ���� ÿý�—�ž ���������ÿ��92069-18109 1912� S C0122 �&EDIT �EDIT SOURCE � � � � � � � � � � � � �H0101 _6�����þúFTN SUBROUTINE EDIT(EMSK,STRNG,LEN),92069-16061 REV.1912 790112 INTEGER EMSK,STRNG,LEN C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18109 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C EDIT GETS AN EDIT MASK AND USES IT ON THE DS STRING C C CALLING SEQUENCE: C C CALL EDIT(EMSK,STRNG,LEN) C C WHERE: C C EMSK C IS THE EDIT MASK NUMBER C C STRNG C IS THE STRING TO BE EDITED AND IN WHICH WILL BE C RETURNED THE EDITED STRING C C LEN C IS THE LENGTH OF THE STRING C C C C ON EXIT: C C STRNG IS EDITED ACCORDING TO THE EDIT MASK IN EMSK C C C C C C INTEGER AS(66),LAS INTEGER ERR1(8) INTEGER ZZZ(8 ) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6µ��� �� ),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA ERR1/2H I,2HNT,2HER,2HNA,2HL ,2HER,2HRO,2HR / DATA ZZZ/2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZZ,2HZ9/ C C C C C BEGIN C C C IS THEIS AN "EZ" EDIT? C IF(EMSK .NE. 1) GOTO 5 IF(LEN .GT. 14) LEN = 14 CALL SMOVE(ZZZ,1,LEN+2,AS,1) LAS = LEN+2 GOTO 25 C C FIND THE EDIT MASK C 5 CONTINUE DO 10 I = 1,R3 IF(SS(1,I) .EQ. EMSK ) GOTO 20 10 CONTINUE C C INTERNAL ERROR C CALL REIO(2,ITTY,ERR1,8) GOTO 30 C C GET THE EDIT MASK C 20 CONTINUE CALL LIT(SS(3,I),AS,LAS) C C EDIT THE STRING C 25 CONTINUE CALL SEDIT(STRNG,1,LEN,AS,1,LAS) CALL SMOVE(AS,1,LAS,STRNG,1) LEN = LAS 30 RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������Î ������ÿÿ����� ���� ÿý�˜�Ÿ ���������ÿ��92069-18110 1912� S C0122 �&BUFLN �BUFLN SOURCE � � � � � � � � � � � � �H0101 ‡h�����þúFTN SUBROUTINE BUFLN(INDX,VOPT,STRNG),92069-16061 REV.1912 781025 INTEGER VOPT(8),STRNG(66) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18110 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C BUFLN BUFFERS A ITEM VALUE INTO A PRINT LINE ACCORDING C TO INFORMATION IN THE SS-ARRAY. THE V-ARRAY WILL BE C MODIFIED TO CONTAIN THE NECESSARY INFORMATION FOR SKIPPING C LINES AND PAGES. C C CALLING SEQUENCE: C C CALL BUFLN(INDX,VOPT,STRNG) C C WHERE: C C INDX IS THE INDEX INTO THE SS-ARRAY C C VOPT C IS THE BUFFER CONTAINING THE SPLIT APART PRINT OPTIONS C C STRNG C IS THE STRING TO WHICH THE FIELD IS BUFFERED C C ON EXIT: C C VOPT-ARRAY CONTAINS INFORMATION FOR PRINT OPTIONS C C STRNG CONTAINS THE ASCII VALUE OF THE ITEM C C C C C C C C C INTEGER DS(66) INTEGER LEN,JBEG,ISTRT,R C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SSÐ������þú(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA R/122B/ C C C C C C C C BEGIN C C C PUT THE PRINT OPTIONS IN THE VOPT-ARRAY C CALL SPLIT( SS(5,INDX), SS(6,INDX), VOPT) C C CHECK WHETHER LITERAL OR ITEM VALUE C I = SS(3,INDX) IF (I .EQ. 0) GOTO 10 C C THIS IS A LITERAL VALUE C CALL LIT(I,DS,LEN) GOTO 20 C C PROCESS ITEM VALUE C C GET THE ASCII VALUE IN THE DS STRING C 10 CONTINUE LNDX = SS(7,INDX) IF(SS(2,INDX) .EQ. 0) GOTO 40 CALL FIELD (LIST,LNDX,VOPT(6),IBUFF,DS,LEN) C C IS THERE AN EDIT MASK? C IF(VOPT(6) .EQ. 0 .OR. LIST(LNDX,2) .EQ. R ) GOTO 20 CALL EDIT(VOPT(6),DS,LEN) C C FIND THE START COLUMN FOR THE STRING C 20 CONTINUE I = SS(4,INDX) JBEG = 1 ISTRT = I - LEN + 1 IF (ISTRT .GT. 0) GOTO 30 ISTRT = 1 JBEG = LEN - I + 1 LEN = I C C PUT THE STRING IN THE PRINT STRING C 30 CONTINUE CALL SMOVE(DS,JBEG,LEN,STRNG,ISTRT) C C EXIT C 40 CONTINUE RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������uu�������� ������������� �������ÿÿ����� ���� ÿý�™�¡ ���������ÿ��92069-18111 1912� S C0122 �&PHDRI �PHDRI SOURCE � � � � � � � � � � � � �H0101 ˆh�����þúFTN SUBROUTINE PHDRI(STRNG),92069-16061 REV.1912 790208 C 1/2 (AUDREY) QUIT USING L AS A VARIABLE, USE LENTH INSTEAD. INTEGER STRNG(66) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18111 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS C 3) QS12 - TOTALS C 4) QS20 - GROUPS/DETAILS C C C REPORT TABLE FORMAT IN ARRAY SS(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50-59 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C ù}������þú C 7. OFFSET INTO THE LIST-ARRAY C C C C C C C C C C C T ARRAY IS USED TO HOLD INDEX INTO LIST-ARRAY FOR SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD 10*5 C NOTE: THERE CAN BE NO MORE THAN 10 ITEMS TOTALED ON C C LIST ARRAY CONTAINS INFORMATION ABOUT THE DBMS DATA BUFFER C C FIRST ENTRY IS DIFFERENT THAN THE OTHERS C 1. CONTAINS # OF ENTRIES IN ARRAY C 2 - 5. ARE EMPTY C 6. CONTAINS THE # OF SORT ITEMS C NOTE: ALL THE SORT ITEMS ARE AT THE TOP OF THE ARRAY C C OTHER ENTRIES C 1. ITEM NUMBER C 2. ITEM TYPE C 3. ITEM LENGTH C 4. ELEMENT COUNT C 5. OFFSET INTO DBMS BUFFER C 6. CONTAIN THE ITEM NUMBER IFF IT IS A SORT ITEM C C C C LEVSTR ARRAY IS AN 66 BY 5 ARRAY WHICH CONTAINS THE LEVEL BREAK C STRINGS C C LEVLEN ARRAY CONTAINS THE LENGTHS OF EACH STRING C C C C C C C C C C C C C C C C C C C C C C C C C C C ABSTRACT: C C PHDRI PRINTS THE HEADER LINES C C CALLING SEQUENCE: C C CALL PHRDI(STRNG) C C WHERE: C C STRNG C IS THE BUFFER USED TO HOLD THE HEADER LINE C C C C C LOGICAL HDFLG INTEGER LEVN,N INTEGER INUM(3) INTEGER V2(8) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGEÖ������þúR S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ DATA HDFLG/.TRUE./ C C BEGIN C LNCNT = 0 LEVN = 0 C C PICK OUT THE HEADER COMMANDS C DO 50 I = 1,R3 N = SS(1,I) IF(N .LT. 21) GOTO 50 IF( N .GT. 29) GOTO 60 IF( LEVN .EQ. 0 .OR. LEVN .EQ. N) GOTO 5 CALL HDLN(STRNG,COLLIM,V2,HDFLG) C C IF THIS IS A LITERAL THEN BUFFER IT C 5 CONTINUE LEVN = N IF(SS(3,I) .EQ. 0) GOTO 10 CALL BUFLN(I,V2,STRNG) GOTO 50 C C IS ARE PAGE NUMBERS REQUESTED C 10 CONTINUE IF (SS(2,I) .EQ. 0) GOTO 50 CALL CITA(PAGCNT,INUM) LENTH = 5 C C C DO 20 I2 = 2,6 CALL SGET(INUM,I2,ICHAR) IF(ICHAR .NE. 60B) GOTO 30 LENTH = LENTH-1 20 CONTINUE C C C 30 CONTINUE ITMP = SS(4,I) ISTRT = ITMP-LENTH+1 IF(ISTRT .GT. 0) GOTO 35 ISTRT = 1 I2 = LENTH - ITMP + 1 LENTH = ITMP C C PUT THE PAGE NO. IN THE PRINT LINE C 35 CONTINUE CALL SMOVE(INUM,I2,I2 + LENTH -1,STRNG, ISTRT) CALL SPLIT(SS(5,I),SS(6,I),V2) C C C 50 CONTINUE 60 CO3ý�����NTINUE IF(LEVN .NE.0) CALL HDLN(STRNG,COLLIM,V2,HDFLG) RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ìœ������ÿÿ����� ���� ÿý�š�£ ���������ÿ��92069-18112 1912� S C0122 �&QRIO �QRIO SOURCE � � � � � � � � � � � � �H0101 mL�����þúFTN FUNCTION QRIO(ICODE,IFILE,IBUF,IL),92069-16061 REV.1912 781128 INTEGER IFILE(145) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18112 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C QRIO IS A ROUTINE WRITTEN TO REPLACE "REIO". IT ALLOWS QUERY TO C USE LOCAL AND REMOTE FILES WITHOUT DISTRUBING THE QUERY CODE C C QRIO WILL PAD AN ODD BYTE COUNT TO A FILE WITH A BLANK. C C C CALLING SEQUENCE: C C CALL QRIO(ICODE,IFILE,IBUF,IL) C C WHERE: C C ICODE C IS THE OPERAND CODE C 1 INDICATES READ C 2 INDICATES WRITE C C IFILE C IS THE FILE DCB OR LU OF THE DEVICE C WORD 1 = POSITIVE LU AND LU CONTROL C OR, IS NEGETIVE WHICH INDICATES C THAT A DCB IS IN WORDS 2 - 145 C WORD 2-145 = DCB C C C IBUF C IS THE READ/WRITE BUFFER C C IL C IS THE LENGTH C NEGETIVE INDICATES BYTE COUNT C POSITIVE INDICATES WORD COUNT C C C C C C C INTEGER IQRA,IQRB INTEGER IRIO(2) REAL RIO INTEGER ERR1(13),ERR2(18),ERR4(12) INTEGER ERR5(13) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER ™Ì������þúPAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ EQUIVALENCE ( RIO,IRIO) EQUIVALENCE (IRIO,IQRA) EQUIVALENCE (IRIO(2),IQRB) DATA ERR1/2H Q,2HUE,2HRY,2H D,2HEV,2HIC,2HE ,2HI/,2HO ,2HAB, & 2HOR,2HTE,2HD / DATA ERR2/2H Q,2HUE,2HRY,2H- ,2HIL,2HLE,2HGA,2HL ,2HI/ & ,2HO ,2HCO,2HNT,2HRO,2HL ,2HOP,2HER,2HAN,2HD / DATA ERR4/2H Q,2HUE,2HRY,2H- ,2HIN,2HPU,2HT ,2HFI,2HLE,2H E, & 2HRR,2HOR/ DATA ERR5/2H Q,2HUE,2HRY,2H- ,2HOU,2HTP,2HUT,2H F,2HIL,2HE , & 2HER,2HRO,2HR / C C C C C C C C C C C C BEGIN C C CHECK TO SEE IF THE INPUT IS A FILE C IF(IFILE .LT. 0) GOTO 10 C C SEE IF THIS IS A REMOTE CALL C IF(RMOTE .EQ. -1) GOTO 2 CALL DEXEC(RMOTE,ICODE+100000B,IFILE,IBUF,IL) GOTO 40 1 GOTO 5 C C MAKE LOCAL DEVICE CALL C 2 CONTINUE CALL REIO(ICODE+100000B,IFILE,IBUF,IL) GOTO 40 5 CALL ABREG(IQRA,IQRB) GOTO 30 C C GET INPUT FROM A FILE ‘����� C 10 CONTINUE IF(ICODE .NE. 1)GOTO 20 LEN = IL IF(IL .LT. 0)LEN = -(IL+1/2) CALL EREAD(IFILE(2),IQRA,IBUF,LEN,IQRB,DUMY) IF(IQRA .LT. 0) GOTO 70 IF(IL .LT. 0) IQRB = IQRB*2 GOTO 30 C C WRITE TO A FILE C 20 CONTINUE IF(ICODE .NE. 2) GOTO 50 LEN = IL C C PAD ODD WRITE COUNTS WITH A BLANK C IF(IL .GT. 0) GOTO 25 LEN = - LEN/2 IL = -IL IF(IL-LEN*2 .EQ. 0) GOTO 25 LEN = LEN + 1 CALL SPUT(IBUF,IL+1,40B) C C WRITE THE RECORD C 25 CONTINUE CALL EWRIT(IFILE(2),IQRA,IBUF,LEN,DUMY) IF(IQRA .LT. 0) GOTO 70 IQRB= IL C C EXIT C 30 CONTINUE QRIO = RIO RETURN C C C C ERROR PROCESSOR C C 40 CONTINUE IQRA = -1 CALL REIO(2,1,ERR1,13) GOTO 100 C C OUTPUT "ILLEGAL I/O CONTROL OPERAND" C 50 CONTINUE CALL REIO(2,1,ERR2,18) GOTO 100 C C OUTPUT "INPUT FILE ERROR" C 70 CALL REIO(2,1,ERR4,12) GOTO 90 C C OUTPUT "OUTPUT FILE ERROR" C 80 CALL REIO(2,1,ERR5,13) C C OUTPUT FMP ERROR C 90 CALL FMERR(IQRA,1) C C END QUERY C 100 CONTINUE SNAM(2) = 2H16 CALL LOAD(SNAM) END ������������������žŽ������ÿÿ����� ���� ÿý�›�£ ���������ÿ��92069-18113 1912� S C0122 �&TOPAG �TOPAG SOURCE � � � � � � � � � � � � �H0101 Žl�����þúFTN SUBROUTINE TOPAG(NODE,LU,IERR),92069-16061 REV.1912 790116 INTEGER NODE,LU(145),IERR LOGICAL IFTTY C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18113 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C TOPAG CAUSES A LIST DEVICE OR FILE TO GO TO THE TOP OF PAGE C IT HANDLES FILES, LOCAL DEVICES, AND REMOTE DEVICES. IT DOES C NOT HANDLE REMOTE FILES. C C C C CALLING SEQUENCE: C C CALL TOPAG(NODE,LU,IERR) C C WHERE: C C NODE C IS THE DISTRIBUTE NODE NUMBER. WHEN THE NODE IS THE C LOCAL NODE, THEN NODE SHOULD EQUAL -1. C C LU C IS THE LU/DCB STRUCTURE. LU IS THE LOGICAL UNIT PLUS C THE FUNCTION CODE 600B, ( LU + 600B). C C WHEN THE FIRST WORD OF LU IS GREATER THAN 0 C THE LIST UNIT IS CONSIDERED TO BE A DEVICE. C C WHEN THE FIRST WORD OF LU IS -1, THEN THE LIST C UNIT IS CONSIDERED TO BE A FILE AND WORDS 2-145 C MUST BE THE DCB. C C C IERR C IS THE ERROR INDICATOR C 0 INDICATES NO ERROR C -1 INDICATES ERROR C C C C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C NO COMMON IS NEEDED C C C C C C C BEGIN C IERR = 0 C C IS THIS A REMOTE NODE? C IF(NODE .NE. -1) GOTO 20 C C IS THIS A FILE? C IF(LU .NE.ª��� ��  -1) GOTO 10 C C THIS IS A LOCAL FILE C WRITE A 1 IN COLUMN 1 C CALL QRIO(2,LU,2H1 ,1) GOTO 30 C C THIS IS A LOCAL DEVICE C 10 CONTINUE IF(IFTTY(LU)) GOTO 30 CALL EXEC(3+100000B,LU+1100B-600B,-1) GOTO 7010 15 GOTO 30 C C THIS IS A REMOTE DEVICE C 20 CONTINUE CALL DEXEC(NODE,3+100000B,LU+1100B,-1) GOTO 7010 C C EXIT C 30 CONTINUE RETURN C C C C C ERROR CONDITIONS C 7010 CONTINUE IERR = -1 GOTO 30 END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������d ������ÿÿ����� ���� ÿý�œ�£ ���������ÿ��92069-18114 1912� S C0122 �&LUREQ �LUREQ SOURCE � � � � � � � � � � � � �H0101 z�����þúFTN LOGICAL FUNCTION LUREQ(NODE,ICNTL,LU,IERR) & ,92069-16061 REV.1912 790205 INTEGER NODE,ICNTL,LU(145),IERR C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18114 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C LUREQ LOCKS AN LU WHEN THE LU IS A LOCAL DEVICE. C LUREQ IS TRUE WHEN THE UNIT IS A NON-INTERACTIVE DEVICE OR IS A C LOCAL FILE. C C CALLING SEQUENCE: C C CALL LUREQ(NODE,ICNTL,LU,IERR) C C WHERE: C C NODE C IS THE DISTRIBUTED NODE NUMBER. WHEN THE NODE IS THE C LOCAL NODE, THEN NODE SHOULD EQUAL -1. C C ICNTL C IS THE CONTROL WORD C 0 INDICATES TO UNLOCK THE LU C 1 INDICATES TO LOCK IT C C LU C IS THE LU/DCB STRUCTURE. C C WHEN THE FIRST WORD OF LU IS GREATER THAN 0, C THE LIST UNIT IS CONSIDERED TO BE A DEVICE. C C WHEN THE FIRST WORD OF LU IS -1, THEN THE LIST C UNIT IS CONSIDERED TO BE A FILE AND WORDS 2-145 C MUST BE THE DCB. C C IERR C IS THE ERROR INDICATOR C 0 INDICATES NO ERROR C -1 INDICATES ERROR C C C C C C C C C C C C LOGICAL IFTTY INTEGER NUM(6),LOCKED(12) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ DATA LOCKED/2H Q,2HUE,2HRY,2H W,2HAI,2HTI,2HNG,2H O, & 2HN ,2HLU,2H ,2HXX/ C NO[��� ��  COMMON IS NECESSARY C C C C C C C C C BEGIN C IERR = 0 LUREQ = .FALSE. C C IS THE REQUEST DIRECTED AT A FILE? C IF(LU .EQ. -1) GOTO 10 C C IS THIS A REMOTE NODE C IF(NODE .NE. -1) GOTO 20 C C IS THE LOCAL DEVICE INTERACTIVE? C IF(IFTTY(LU)) GOTO 20 C C THIS IS A NON-INTERACTIVE LOCAL DEVICE, SO LOCK IT C IF(ICNTL .NE. 1) GOTO 5 CALL LURQ(140000B+ICNTL,LU,1) GOTO 7010 8000 CALL ABREG(IA,IB) IF(IA .EQ. 0) GOTO 10 CALL CITA(IAND(LU,77B),NUM) LOCKED(12) = NUM(3) CALL QRIO(2,1,LOCKED,12) C C WAIT ON LU C 3 CONTINUE CALL EXEC(12,0,2,0,-10) CALL LURQ(140000B+ICNTL,LU,1) GOTO 7010 8010 CALL ABREG(IA,IB) IF(IA .NE. 0)3,10 C C UNLOCK LU C 5 CALL LURQ(040000B+ICNTL,LU,1) GOTO 7010 10 LUREQ = .TRUE. C C RETURN C 20 CONTINUE RETURN C C C C C C C ERROR PROCESSOR C 7010 CONTINUE IERR = -1 GOTO 20 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������7 ������ÿÿ����� ���� ÿý��¤ ���������ÿ��92069-18115 1912� S C0122 �&ERIO �ERIO SOURCE � � � � � � � � � � � � �H0101 d@�����þúFTN SUBROUTINE ERIO(ICODE,IFILE,IBUF,IL),92069-16061 REV.1912 790216 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18115 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C THIS IS A ERROR WRITING ROUTINE. IT WRITES THE ERROR MESSAGE C AND TERMINATES WHEN THE ERROR OCCURED IN THE BATCH FILE THAT C WAS DECLARED AT RUN TIME. C C IT RETURNS TO THE COMMAND INTERPRETER WHEN THE ERROR OCCURED IN C A XEQ FILE. C C OTHERWISE IT RETURNS TO THE CALLING ROUTINE C C C C C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,ISCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT ûä��� ��  COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C C C C C C C BEGIN C CALL QRIO(ICODE,IFILE,IBUF,IL) IF(.NOT. BATCH) RETURN C C C BATCH IS THIS THE ORIGINAL BATCH FILE C C IF(XEQ .EQ. 0) GOTO 20 CALL ECLOS(INLU(2)) CALL SMOVE(XEQ,1,290,INLU,1) BATCH = XQBCH XEQ = 0 C C IF THE ORIGINAL INPUT WAS BATCH TERMINATE C IF(BATCH) GOTO 20 C C IF THIS IS AN XEQ FILE AND THE INPUT IS INTERACTIVE C SO GO BACK TO THE COMMAND INTERPRETER C SNAM(2) = 2H GOTO 30 C C ORIGINAL BATCH FILE C C TERMINATE QUERY C 20 CONTINUE SNAM(2) = 2H16 30 CALL LOAD(SNAM) END ��������������㣠������ÿÿ����� ���� ÿý�ž�¥ ���������ÿ��92069-18116 1912� S C0122 �&DBERR �DBERR SOURCE � � � � � � � � � � � � �H0101 …`�����þúFTN4 SUBROUTINE DBERR(ICODE,ITTY),92069-16061 REV.1912 781221 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18116 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C DBERR IS A UTILITY SUBROUTINE FOR QUERY WHICH ACCEPTS A DBMS ERROR C CODE AND PRINTS OUT AN APPROPRIATE ERROR MESSAGE FOR THE ERROR C RECEIVED. C C THE CALLING SEQUENCE FOR DBERR IS: C C CALL DBERR(ICODE,ITTY) C C WHERE C C ICODE C IS THE DBMS ERROR CODE FOR WHICH A MESSAGE IS TO BE PRINTED. C C ITTY C IS THE LU OF THE DEVICE ON WHICH THE ERROR MESSAGE IS TO BE PRINTED. C C INTEGER ICODE,ITTY INTEGER IEARY(63),IMESS(21),IEMES(9) C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C DOES NOT NEED COMMON DATA IEARY/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 1 16,17,18,19,20,21,22,23,24,25,26,0, 2 0,27,28,0,29,30,0,31,32,33,34,0,0, 3 35,0,0,0,0,0,0,0,0,0,36,0,37,38,39, 4 40,41,42,43,44,45,46,47/ DATA IEMES/2H E,2HRR,2HOR,2H N,2HO ,2H ,2H ,2H ,2H / C C C C C C C C C C BEGIN C C C BOUND CHECK THE ERROR CODE (ICODE). ONLY 100 THROUGH 162 ERROR CODES C ARE RECOGNIZED BY THIS ROUTINE. C IF (ICODE .LT. 100 .OR. ICODE .GT. 162) GO TO 10 C C DETERMINE THE INDEX INTO THE ERROR CODE TABLE IN DBMES FOR THIS ERROR. C THIS INDEX IS THE ENTRY IN THE ARRAY IEARY SUBSCRIPTED BY: C ICODE - 99. C INDEX = IEARY(ICODE - 99) µ��� ��  C C IF THE INDEX IS ZERO, THIS IS AN ERROR CODE WHICH FALLS WITHIN RANGE C BUT IS UNRECOGNIZABLE BECAUSE THERE ARE HOLES IN THE DBMS ERROR CODE C SEQUENCE. C IF (INDEX .EQ. 0) GO TO 10 C C ERROR CODE RECOGNIZABLE, CALL DBMES TO GET ITS CORRESPONDING ASCII MES- C SAGE, PRINT IT, AND RETURN. C CALL DBMES(INDEX,IMESS,ISZ) CALL ERIO(2,ITTY,IMESS,ISZ) GO TO 20 C C ERROR CODE UNRECOGNIZABLE. SET UP MESSAGE: C ERROR NO XXX C WHERE XXX IS THE ASCII OF THE ERROR CODE. PRINT THE MESSAGE AND C RETURN. C 10 CALL CNUMD(ICODE,IEMES(7)) CALL ERIO(2,ITTY,IEMES,9) C 20 RETURN END ����������������������������������������������������������������������������������������������������`Š ������ÿÿ����� ���� ÿý�Ÿ�¦ ���������ÿ��92069-18117 1912� S C0122 �&DBMES �DBMES SOURCE � � � � � � � � � � � � �H0101 ‚\�����þúASMB NAM DBMES,7 92069-16061 REV.1912 781221 * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18117 * RELOC: 92069-16060 * * *****************************************************************: * * * * * DBMES RETURNS AN ERROR MESSAGE FOR ANY DBMS ERROR CODE. * THE ERROR MESSAGES ARE IN AN ARRAY, EACH ENTRY REQUIRES 20 WORDS. * * THE CALLING SEQUENCE FOR DBMES IS: * * CALL DBMES(N,MESS,ISZ) * * WHERE * * N * IS THE INDEX INTO THE MESSAGE TABLE. THE DBMS ERROR CODE FOR EACH * MESSAGE IS DOCUMENTED DIRECTLY BEFORE THE MESSAGE. * * MESS * IS A BUFFER OF AT LEAST 21 WORDS. THE ERROR MESSAGE WILL BE RETURNED * IN THIS BUFFER. * * ISZ * IS AN INTEGER WHICH WILL CONTAIN THE SIZE OF THE MESSAGE IN WORDS. * CURRENTLY THIS NUMBER IS ALWAYS 21. * * ********************************************************************** * * SKP * * DBMES SUBROUTINE * * BEGIN * * ENT DBMES EXT .ENTR,.MVW * SUP PRESS EXTRANEOUS LISTINGS * * N BSS 1 MESS BSS 1 ISZ BSS 1 * DBMES NOP JSB .ENTR TRANSFER PARAMETERS. DEF N * LDA T21 STA ISZ,I * CCA ERROR MESSAGE ADA N,I ADDRESS = MPY T21 20*(N-1). ADA EADDR LDB MESS * JSB .MVW MOVE ERROR MESSAGE DEF T21 INTO CALLER'S BUFFER. DEC 0 * JMP DBMES,I RETURN. * * T21 DEC 21 EADDR DEF ERTAB SKP ERTAB EQU * * 100 ASC 21, INVALID DATA SET NAME OR NUMBER. * 101 ASC 21, INm������þúVALID DATA ITEM NAME OR NUMBER. * 102 ASC 21, INVALID OR MISSING SEARCH ITEM. * 103 ASC 21, DATA BASE NOT OPENED. * 104 ASC 21, OPEN MODE DOES NOT ALLOW THAT OPERATION. * 105 ASC 21, DETAIL DATA SET IS FULL. * 106 ASC 21, MASTER DATA SET IS FULL. * 107 ASC 21, NO MASTER ENTRY WITH KEY ITEM VALUE. * 108 ASC 21, REQUEST DIRECTED AT AN AUTOMATIC MASTER. * 109 ASC 21, ITEM NOT WRITE ENABLED. * 110 ASC 21, A MASTER ENTRY WITH KEY VALUE EXISTS. * 111 ASC 21, NO CURRENT CHAIN OR BAD RECORD NUMBER. * 112 ASC 21, CANNOT ALTER THE VALUE OF AN ITEM. * 113 ASC 21, ENTRY BEING DELETED HAS NON-EMPTY CHAINS. * 114 ASC 21, RECORD IS EMPTY. * 115 ASC 21, INVALID MODE. * 116 ASC 21, FILE SPECIFIED IS NOT A ROOT FILE. * 117 ASC 21, ILLEGAL SECURITY CODE. * 118 ASC 21, DATA SET IS NOT WRITE ENABLED. * 119 ASC 21, ROOT FILE CANNOT BE FOUND. * 120 ASC 21, DATA SET FOR OPERATION MUST BE A DETAIL. * 121 ASC 21, DETAIL DATA SET HAS NO PATHS. * 122 ASC 21, CANNOT PERFORM A CHAIN READ. * 123 ASC 21, DATA SET FOR OPERATION MUST BE A MASTER. * 124 ASC 21, INVALID DBINF MODE. * 125 ASC 21, BAD DATA SET OR DATA ITEM IN DBINF CALL. * 128 ASC 21, PARTITION IS TOO SMALL. * 129 ASC 21, DATA BASE OPEN EXCLUSIVELY. * 131 ASC 21, NO ROOM FOR DATA BASE ENTRY IN DBCOP. * 132 ASC 21, NO RESURCE NUMBER AVAILABLE. * 134 ASC 21, DATA BASE NOT ENABLED FOR LOCKING. * 135 ASC 21, DATA BASE CANNOT BE CLOSED DUE TO LOCK. * 136 ASC 21, DATA BASE ALREADY LOCKED TO ANOTHER USER. * 137 ASC 21, DATA BASE RN IS BE¥û����� ING USED ILLEGALLY. * 140 ASC 21, UNABLE TO SCHEDULE DBCOP. * 150 ASC 21, DATA BASE ALREADY OPEN. * 152 ASC 21, UNOBTAINABLE OPEN MODE. * 153 ASC 21, DATA BASE INACCESSIBLE WITH THAT LEVEL. * 154 ASC 21, DATA BASE CORRUPT - BAD CHAIN POINTER. * 155 ASC 21, BEGINNING OR END OF CHAIN ENCOUNTERED. * 156 ASC 21, DETAIL CHAIN IS EMPTY. * 157 ASC 21, NO CURRENT RECORD FOR OPERATION. * 158 ASC 21, DATA ITEM IS NOT PART OF GIVEN DATA SET. * 159 ASC 21, DATA BASE MUST BE LOCKED. * 160 ASC 21, INTERNAL BUFFERS ARE CORRUPT. * 161 ASC 21, INTERNAL DBCOP ERROR. * 162 ASC 21, INTERNAL IMAGE CALL IS INVALID. END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������: ������ÿÿ����� ���� ÿý� �¨ ���������ÿ��92069-18118 1912� S C0122 �&FMERR �FMERR SOURCE � � � � � � � � � � � � �H0101 ”m�����þúASMB NAM FMERR,7 92069-16061 REV.1912 790209 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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. * ************************************************************** * * * SOURCE: 92069-18118 * RELOC: 92069-16060 * * ************************************************************* * * * * ENTRY POINTS AND EXTERNS * ENT FMERR * * EXT ERIO,.ENTR,CITA * SUP PRESS LISTING * * CALLING SEQUENCE: * * CALL FMERR(FMP ERROR #,LOGICAL UNIT #) * * WHERE: ERROR # IS NEG # RETURNED BY FMP * LOG UNIT # IS THE DEVICE THE ERROR MESSAGE * IS TO BE PRINTED ON * * * * * ERNUM NOP LU NOP FMERR NOP JSB .ENTR DEF ERNUM * LDA ERNUM,I GET ERROR NUMBER STA LCNTR SAVE ERROR NUMBER FOR COUNTER LDB FMESA GET ADDRESS OF FMP ERRORS PRMS1 LDA 1,I GET LENGTH OF MESSAGE INB MOVE PNTR TO MESSAGE ISZ LCNTR INDEX ERROR CNTR, IS IT = 0? RSS NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG * * * LDA FMEND IS THIS THIS THE LAST MESSAGE? CMA,INA ADA 1 SSA JMP PRMS1 NO, GO GET NEXT MESSAGE * PRMS3 JSB CITA CONVERT ERROR CODE DEF *+3 DEF ERNUM,I DEF FMNO * LDB FMEND LDA 1,I INB * PRMS2 SZA,RSS JMP PRMS3 * STB BUF SET UP MESSAGE ADDRESS CMA,INA STA IL SET UP MESSAGE LENGTª������þúH * LDA LU,I IOR B200 STA LIST JSB ERIO PRINT DEF *+5 DEF .2 THE ERROR DEF LIST DEF BUF,I MESSAGE DEF IL * JMP FMERR,I * * .2 DEC 2 B200 OCT 200 LIST NOP LCNTR NOP MESSAGE COUNTER BUF NOP ADDRESS OF MESSAGE IL NOP LENGTH OF MESSAGE *********************** * * * ERROR MESSAGE TABLE * * * *********************** * FMESA DEF *+1 DEC 10 ASC 5, DISC DOWN DEC 15 ASC 8, DUPLICATE NAME DEC 0 DEC 39 ASC 20, MORE THAN 32, 767 RECORDS IN TYPE 2 FILE DEC 38 ASC 19, READ OR WRITE TO A RECORD NOT WRITTEN DEC 15 ASC 8, FILE NOT FOUND DEC 52 ASC 26, INVALID SECURITY CODE OR ILLEGAL WRITE ON LU 2 OR 3 DEC 50 ASC 25, FILE CURRENTLY OPEN OR EXCLUSIVE OR LOCK REJECTED DEC 0 DEC 0 DEC 13 ASC 7, DCB NOT OPEN DEC 26 ASC 13, SOF OR EOF READ OR SENSED DEC 17 ASC 9, CARTRIDGE LOCKED DEC 15 ASC 8, DIRECTORY FULL DEC 13 ASC 7, ILLEGAL NAME DEC 25 ASC 13, ILLEGAL TYPE OR SIZE = 0 DEC 32 ASC 16, ILLEGAL READ OR WRITE ON TYPE 0 DEC 11 ASC 6, ILLEGAL LU DEC 30 ASC 15, ILLEGAL ACCESS TO SYSTEM DISC DEC 18 ASC 9, ILLEGAL ACCESS TO LU DEC 23 ASC 12, ILLEGAL DESTINATION LU DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 30 ASC 15, VALUE TOO LARGE FOR PARAMETER DEC 0 DEC 25 ASC 13, DISC CARTRIDGE NOT FOUND DEC 34 ASC 17, NOT ENOUGH ROOM ON DISC CARTRIDGE DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 26 ASC 13, CONFLICT IN SST DEFINITION DEC 20 ASC 10, LU NOT FOUND IN SST šƒ����� DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEC 25 ASC 13, GREATER THAN 255 EXTENTS FMLST DEC 18 ASC 6, ERROR NO. FMNO ASC 3,XXXXXX * FMEND DEF FMLST * END ������������������������������������������������������;������ÿÿ����� ���� ÿý�¡�© ���������ÿ��92069-18119 1912� S C0122 �&SPLIT �SPLIT SOURCE � � � � � � � � � � � � �H0101 ¥}�����þúFTN SUBROUTINE SPLIT(FLAG1,FLAG2,V),92069-16061 REV.1912 781023 INTEGER FLAG1,FLAG2,V(8) C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18119 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C SPLIT BREAKS THE PRINT OPTIONS APPART AN PUTS THEM INTO THE C SPECIFIED ARRAY. C C CALLING SEQUENCE: C C CALL SPLIT(FLAG1,FLAG2,V) C C WHERE: C C FLAG1 - IS USUALLY THE SS(5,N) ENTRY C FLAG2 - IS USUALLY THE SS(6,N) ENTRY C V - IS AN 8 WORD ARRAY C C ON EXIT: C C THE V-ARRAY WILL CONTAIN THE FOLLOWING VALUES C C WORD 1 - SPACE BEFORE COUNT (0-5) C WORD 2 - SPACE AFTER COUNT (0-5) C WORD 3 - SKIP BEFORE (0-1) C WORD 4 - SKIP AFTER (0-1) C WORD 5 - ADD FLAG (0-1) C WORD 6 - EDIT MASK LEVEL NUMBER (60-69) C WORD 7 - COUNT FLAG (0-1) C WORD 8 - AVERAGE FLAG (0-1) C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C NO COMMON IS NEEDED C C BEGIN C DO 10 I = 5,8 10 V(I) = 0 C C GET THE VALUES FROM FLAG1 C I= FLAG1 IF(I .EQ. 0) GOTO 30 DO 20 I1 = 1,4 N = I - I/10*10 IF( N .EQ. 0) GOTO 15 V(I1) = N 15 I = I/10 20 CONTINUE C C C C IF(I .EQ. 0) GOTO 30 V(5) = 1 C C GET THE VALUES FROM FLAG2 C 30 CONTINUE I = FLAG2 IF(I .EQ. 0) GOTO 50 DO 40 I1 = 2,4 IFAC = 10 ** I1 N = I - I/IFAC*IFAC IF( N .EQ. 0JÚ��� �� ) GOTO 40 V(I1 + 4) = N I = I-N 40 CONTINUE 50 CONTINUE RETURN END ����������������������������������������������������������������������������������������������������������������������������������������������������������q% ������ÿÿ����� ���� ÿý�¢�© ���������ÿ��92069-18120 1912� S C0122 �&LIT �LIT SOURCE � � � � � � � � � � � � �H0101 9�����þúFTN SUBROUTINE LIT(IOFF,STRNG,LEN),92069-16061 REV.1912 781025 INTEGER IOFF,STRNG(66),LEN C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18120 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C C ABSTRACT: C C LIT GETS AN STRING FROM THE LITERAL BUFFER AND PUTS INTO THE C STRING REQUESTED. C C CALLING SEQUENCE: C C CALL LIT(IOFF,STRNG,LEN) C C WHERE: C C IOFF - IS THE INDEX INTO THE LITERAL BUFFER C STRNG - IS THE STRING IN WHICH THE LITERAL IS RETURNED C LEN - THE LENGTH OF THE STRING C C C C ON EXIT: C C STRNG - CONTAINS THE STRING C LEN - IS THE LENGTH OF THE STRING C C C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ INTEGER INLU,ITTY,ILP,IDCB,JDCB,XEQ INTEGER DBNAM,DBLEV,DSNAM,DINAM,SELECT,SNAM INTEGER DSNUM,DINUM,PARM,LPARM,ECHO,QSERR INTEGER IMA,IB,IBSZ,SECNO,IEND,ISCAN LOGICAL BREAK INTEGER IPFLAG,IOFLAG,RMOTE LOGICAL BATCH,XQBCH INTEGER PAGCNT,LNCNT INTEGER PAGLEN,COLLIM REAL RRCNT REAL SELT,RSEC INTEGER IPTR REAL RCOUNT INTEGER S,R3,TRKNM,IDILU INTEGER R6 REAL ATOTAL INTEGER LIST,L,T,U INTEGER LEVSTR,LEVLEN INTEGER IBUFF INTEGER SS(7,100) C COMMON INLU(145),ITTY(145),ILP(145),IDCB(145),JDCB(144),XEQ(145) COMMON DBNAM(10),DBLEV(3),DSNAM(3),DINAM(3),SELECT(6),SNAM(3) COMMON DSNUM,DINUM,PARM(40),LPARM,ECHO,QSERR COMMON IMA(37),IB(896),IBSZ,SECNO,IEND,Iµ��� �� SCAN COMMON BREAK COMMON IPFLAG,IOFLAG,RMOTE COMMON BATCH,XQBCH COMMON PAGCNT,LNCNT COMMON PAGLEN,COLLIM COMMON RRCNT COMMON SELT(64),RSEC COMMON IPTR COMMON RCOUNT COMMON S(15,50),R3,TRKNM,IDILU COMMON R6 COMMON ATOTAL(6,5) COMMON LIST(101,6),L(7),T(5),U(7,5) COMMON LEVSTR(66,5),LEVLEN(5) COMMON IBUFF(2048) C EQUIVALENCE (S,SS) C$$$$$$$$$$$$$$$$$$$ NOVEMBER 3,1978 $$$$$$$$$$$$$$$$$$$$$ C C C C C BEGIN C CALL SMOVE(IB,IOFF,IOFF+1,LEN,1) IF(LEN .GT. COLLIM) LEN = COLLIM CALL SMOVE(IB,IOFF+2,IOFF+2+LEN-1,STRNG) RETURN END ����������������������������������������������������������������������������ci ������ÿÿ����� ���� ÿý�£�ª ���������ÿ��92069-18121 2026� S C0122 �&ISSRT &ISSRT � � � � � � � � � � � � � �H0101 �����þúFTN4 FUNCTION ISSRT(IBASE,DSNUM,DINUM,ISTAT),92069-16061 REV.2026 800122 LOGICAL ISSRT INTEGER IBASE(10),DSNUM,DINUM,ISTAT(10) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18121 C RELOC: 92069-16061 C C C************************************************************* C C C ISSRT IS A LOGICAL FUNCTION THAT DETERMINES WHETHER AN ITEM C IS A SORT ITEM FOR A DETAIL DATA SET C C CALLING SEQUENCE: C C LOGIC = ISSRT(IBASE,DSNUM,DINUM,ISTAT) C C WHERE: C C IBASE C IS THE BASE PARAMETER FOR THE DATA BASE C C DSNUM C IS THE DETAIL DATA SET NUMBER C C DINUM C IS THE ITEM NUMBER C C ISTAT C IS A TEN WORD INTEGER ARRAY USED FOR ERROR RETURNS FROM C DBMS. ISTAT IS ZERO WHEN THERE ARE NO DBMS ERRORS, ELSE C ISTAT CONTAINS THE ERROR CODE FROM DBMS C C C ON EXIT: C C TRUE - DINUM IS A SORT ITEM FOR SOME DETAIL PATH C C FALSE - DINUM IS NOT A SORT ITEM C C C INTEGER IBUF(49),D C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C NEEDS NO COMMON DECLARATION C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C DATA D/104B/ C C C BEGIN C C C DETERMINE IF THE DATA SET IS A DETAIL C ISSRT =.FALSE. CALL DBINF(IBASE,DSNUM,202,ISTAT,IBUF) IF (ISTAT .NE. 0) GOTO 30 CALL SGET(IBUF,17,ITYPE) IF (ITYPE .NE. D) GOTO 30 C C MAKE DBINF CALL TO GET DETAIL PATH INFO C CALL DBINF(IBASE,DSNUM,301,ISTAT,IBUF) IF (ISTAT .NE. 0) GOTO 30 C C SEARCH PATH INFO TO SEEíÓ��� ��  IF ITEM IS USED AS A SORT ITEM C DO 10 I=4,3*IBUF+1,3 IF (IABS(IBUF(I)) .EQ. DINUM) GOTO 20 10 CONTINUE GO TO 30 C 20 CONTINUE ISSRT = .TRUE. C 30 CONTINUE RETURN END ������������������������������à ������ÿÿ����� ���� ÿý�¤�« ���������ÿ��92069-18122 1912� S C0122 �&QSHLP �HELP FILE SOURCE � � � � � � � � � � � � �H0101 ³Â�����þúHELP 1 QSHELP - 92069-16122 REV.1912 790220 1 QUERY LANGUAGE COMMANDS 1 CREATE STORE A PROCEDURE BY NAME IN A 'FMGR' FILE DATA-BASE NAMES THE DATA BASE TO BE USED SELECT-FILE NAMES THE SELECT FILE TO BE USED DESTROY DELETES A PROCEDURE FILE DISPLAY DISPLAYS A PROCEDURE FILE EXECUTE SCHEDULE A PROGRAM TO BE RUN FROM QUERY EXIT TERMINATE QUERY SYSTEM FIND SELECT RECORDS FROM DATA-BASE FORM DISPLAY DATA-BASE SETS AND ITEMS HELP INVOKE HELP PROCESSOR LIST CHANGE LIST LOGICAL UNIT REPORT GENERATE A REPORT UPDATE ALTER DATA-BASE ITEMS XEQ CHANGE INPUT TO BATCH FILE 1 FOR MORE INFORMATION ENTER THE FOLLOWING COMMAND, 1 HELP HELP; 1 %% HELP HELP 1 FUNCTION - THE HELP COMMAND PROVIDES FUNCTION, SYNTAX, AND OPERAND INFORMATION ON COMMANDS 1 SYNTAX - HELP ['COMMAND NAME'[ 'TYPE OF HELP']] ; 1 REQUIRED - NONE DEFAULTS - "ALL" IF FUNCTION, SYNTAX, OR OPERANDS NOT SPECIFIED NOTE - IF HELP IS ENTERED WITHOUT ANY OPERANDS A LIST OF AVAILABLE COMMANDS WITH A SHORT DESCRIPTION OF EACH WILL BE DISPLAYED 1 SYNTAX INTERPRETATION - 1. USER SUPPLIED VALUES ARE IN APOSTROPHES. 2. WORDS WITHOUT APOSTROPHES ARE TO BE ENTERED AS SHOWN 3. COMMAS AND QUOTES ARE TO BE ENTERED AS SHOWN 4. BRACKETS ( [,] ) DESCRIBE OPTIONAL PARAMETERS 5. KEYWORDS ARE SEPARATED BY ONE OR MORE BLANKS 1 OPERANDS - 'COMMAND NAME' - NAME OF THE COMMAND TO BE EXPLAINED 'TYPE OF HELP' - ONE OR MORE OF THE FOLLOWING WORDS MAY BE USED FU [NCTION] - FUNCTION IS TO BE DISPLAYED SY [NTAX] - FORMAT IS TO BE DISPLAYED OP [ERANDS] - OPERAND DESCRIPTION IS TO BE DISPLAYED AL [L] - FUNCTION, SYNTAX, AND OPERAND ºÔ������þú DESCRIPTIONS ARE TO BE DISPLAYED 1 NOTE - THE TYPE OF HELP, THE COMMAND NAME , AND THE HELP COMMAND ITSELF MUST BE SEPARATED FROM EACH OTHER WITH A BLANK. 1 %% HELP EXECUTE 1 FUNCTION - THE EXECUTE COMMAND ALLOWS THE USER TO EXECUTE A PROGRAM FROM QUERY. THIS COULD BE USED TO SCHEDULE THE 'EDITR' TO EDIT A PROCEDURE. 1 SYNTAX - EXECUTE [ = 'PROGRAM NAME']; 1 OPERANDS - 'PROGRAM NAME' IS THE NAME OF THE PROGRAM TO BE SCHEDULED. THE PARAMETERS FROM THE RUN STRING USED TO EXECUTE QUERY ARE PASSED TO THE PROGRAM BEING SCHEDULED. 1 WHEN NO NAME IS SPECIFIED DEFAULT IS 'EDITR'. 1 %% HELP CREATE 1 FUNCTION - THE CREATE COMMAND IS USED TO STORE A FIND, REPORT OR UPDATE PROCEDURE BY A SPECIFIC NAME INTO A FMGR DISC FILE. 1 SYNTAX - CREATE NAME = 'PROCEDURE NAME'; 'PROCEDURE SPECIFICATION'; END; 1 NOTE - EACH ENTRY IN THE PROCEDURE SPECIFICATION MUST BE TERMINATED BY A SEMICOLON. 1 OPERANDS - 'PROCEDURE NAME' - FMP FILE DESCRIPTOR (IE, FILENAME [:SECURITY [:CARTRIDGE]]) 'PROCEDURE SPECIFICATION' - FIND, UPDATE, OR REPORT PROCEDURE 1 %% HELP LIST 1 FUNCTION - THE LIST COMMAND ALLOWS THE LIST LOGICAL UNIT TO BE CHANGED TO THE DESIRED OUTPUT DEVICE, OR OUTPUT FILE. 1 SYNTAX - LIST='OUTPUT NAME'; 1 OPERANDS - 'OUTPUT NAME' - INTEGER NUMBER OR - FMP FILE DESCRIPTOR. 1 %% HELP DATA-BASE 1 FUNCTION - THE DATA-BASE COMMANDS DEFINES THE DATA-BASE AND OPENS IT ACCORDING TO THE SECURITY LEVEL SPECIFIED. 1 SYNTAX - DATA-BASE = 'DATA-BASE NAME' ; 1 THE USER IS THEN PROMPTED FOR THE LEVEL CODE WORD, AS FOLLOWS: 1 LEVEL? 'LEVEL CODE WORD' ; MODE? 'OPEN ACCESS MODE' ; 1 THE USER MUST^1������þú ENTER THE LEVEL CODE WORD. WHEN HE IS ON AN INTERACTIVE DEVICE THE LEVEL CODE WORD IS NOT DISPLAYED AS IT IS ENTERED. 1 THE USER MUST ALSO ENTER THE OPEN ACCESS MODE. 1 OPERANDS - 'DATA-BASE NAME' - FMP FILE DESCRIPTOR OF THE DATA BASE. THE SECURITY CODE MUST BE INCLUDED, (IE., FILENAME:SECURITY [:CARTRIDGE] ) 'LEVEL CODE WORD' - 1 TO 6 CHARACTER WORD SPECIFING THE READ/WRITE ACCESS THE USER HAS. THE LEVEL CODE WORDS ARE DEFINED FOR THE DATA BASE WHEN IT IS FIRST CREATED. THE LEVEL CODE WORD REPRESENTS A READ/WRITE LEVEL FROM 1 TO 15. WHEN AN ILLEGAL LEVEL CODE WORD IS ENTERED, THE USER HAS A LEVEL OF 0. 'OPEN ACCESS MODE' - AN INTEGER SELECTED FROM THE TABLE BELOW. THIS INTEGER DEFINES THE TYPE OF ACCESS THE USER HAS TO THE DATA BASE. 1 1 INDICATES SHARED READ/WRITE 3 INDICATES EXCLUSIVE READ/WRITE 8 INDICATES SHARED READ ONLY 1 %% HELP SELECT-FILE 1 FUNCTION - THE SELECT-FILE SPECIFIES A WORK FILE FOR THE FIND COMMAND. 1 SYNTAX - SELECT-FILE = 'DATA FILE NAME' ; 1 OPERAND - 'DATA FILE NAME' - FMP FILE DESCRIPTOR, (IE., FILENAME [:SECURITY [:CARTRIDGE]]) - WHEN THE FILE DOES NOT EXITS, IT IS CREATED. WHEN THE FILE DOES ALREADY EXIST IT MUST BE A TYPE 1 FILE OF AT LEAST THREE BLOCKS. 1 %% HELP DESTROY 1 FUNCTION - THE DESTROY COMMAND WILL DELETE A STORED PROCEDURE OR BATCH FILE FROM THE DISC.(PURGE) 1 SYNTAX - DESTROY NAME = 'FILE NAME' ; 1 OPERANDS - 'FILE NAME' - FMP FILE DESCRIPTOR, (IE. FILENAME [:SECURITY [:CARTRIDGE]]) THE FILE NAME MAY BE ANY FMP FILE. 1 CAUTION - AVOID DELETING THE CURRENTLY DECLARED SELECT ö„������þúFILE. 1 %% HELP DISPLAY 1 FUNCTION - THE DISPLAY COMMAND WILL DISPLAY A STORED PROCEDURE FILE, OR BATCH FILE. 1 SYNTAX - DISPLAY NAME = 'PROCEDURE NAME' ; 1 OPERANDS - 'PROCEDURE NAME' - FMP FILE DESCRIPTOR,(IE. FILENAME [:SECURITY [:CARTRIDGE]]) THE FILE MUST BE AN ASCII. 1 %% HELP EXIT 1 FUNCTION - THE EXIT COMMAND CAUSES IMMEDIATE TERMINATION OF THE QUERY SYSTEM. IT CLOSES ALL FILES AND THE DATA BASE. 1 SYNTAX - EXIT ; 1 OPERANDS - NONE 1 %% HELP FORM 1 FUNCTION - THE FORM COMMAND WILL DISPLAY A LIST OF DATA-SET AND DATA-ITEM NAMES ALONG WITH THE ITEM LENGTH, AND ACCESS LEVEL OF EACH ITEM. 1 SYNTAX - FORM ; 1 OPERANDS - NONE 1 %% HELP REPORT 1 FUNCTION - THE REPORT COMMAND WILL GENERATE A REPORT USING THE DATA RECORDS FOUND BY A FIND COMMAND. 1 SYNTAX - REPORT NAME = 'PROCEDURE NAME' ; OR REPORT ALL[,'CHAR'] ; OR REPORT [,<CHAR>] ; 'REPORT PROCEDURE' END; 1 OPERANDS - 'REPORT PROCEDURE' - CONSIST OF ONE OR MORE OF THE REPORT STATEMENT TYPES. EACH STATEMENT MUST BE TERMINATED BY A SEMICOLON. 1. DETAIL 2. EDIT 3. GROUP 4. HEADER 5. SORT 6. TOTAL 1 1 'PROCEDURE NAME' - FMP FILE DESCRIPTOR, (IE., FILENAME [:SECURITY [:CARTRIDGE]]) <CHAR> - ANY ASCII CHARACTER WILL LIST REPORT PROCEDURE DEFAULT: NO LIST ALL - LISTS ALL FOUND RECORDS WITHOUT ANY FORMATTING 'CHAR' - ANY ASCII CHARACTER - WILL LIST ALL FOUND RECORDS WITHOUT ANY FORMATTING OR DATA-ITEM NAME 1 %% HELP FIND 1 FUNCTION - THE FIND COMMAND WILL RETRIEVE DATA RECORDS FROM j_������þúTHE DATA-BASE AS SPECIFIED IN THE FIND STATEMENT 1 SYNTAX - FIND 'RETRIEVE PROCEDURE' END; OR FIND NAME = 'PROCEDURE NAME' ; 1 OPERANDS - 'RETRIEVE PROCEDURE' - CONSISTS OF ['SET NAME'.]'DATA ITEM NAME' 'RELATIONAL OPERATOR''DATA ITEM PHRASE' 'LOGICAL CONNECTOR' 'PROCEDURE NAME' - FMP FILE DESCRIPTOR, (IE., FILENAME [:SECURITY [:CARTRIDGE]]) WHICH CONTAINS A FIND COMMAND. 'DATA ITEM NAME' - 1 TO 6 CHARACTER STRING 'SET NAME' - 1 TO 6 CHARACTER STRING SPECIFYING A DATA SET. THE DATA SET MUST BE SPECIFIED ON THE FIRST ITEM IN A FIND COMMAND. WHEN THE DATA ITEM BELONGS TO ONLY ONE SET, THE SET NAME MAY BE OMITTED. ALL OTHER ITEMS IN A FIND COMMAND MUST BELONG TO THE DATA SET. 'RELATIONAL OPERATOR' - IS/IE/ISNOT/INE/ILT/ INLT/IGT/INGT 'DATA ITEM PHRASE' - "DATA ITEM VALUE" 'LOGICAL CONNECTOR' - AND/OR 1 %% HELP UPDATE 1 FUNCTION - THE UPDATE COMMAND ALLOWS THE USER TO ALTER DATA-BASE ITEMS BY DELETING, REPLACING, OR ADDING ENTRIES TO THE DATA BASE. 1 THE UPDATE ADD COMMAND PROMPTS THE USER FOR THE VALUE OF EACH ITEM IN THE DATA SET. THE VALUE MAY BE DEFAULTED BY ENTERING A SEMICOLON ONLY. PATH ITEMS MAY NOT BE DEFAULTED. 1 THE UPDATE REPLACE COMMAND MUST BE USED AFTER A FIND COMMAND, BECAUSE IT REPLACES THE ITEM VALUES IN EACH RECORD FOUND WITH THE NEW VALUE. THE REPLACE COMMAND PROMPTS THE USER FOR THE NAME OF THE ITEM TO BE REPLACED AND THE ITEM'S VALUE. 1 THE UPDATE DELETE COMMAND MUST BE USED AFTER A FIND COMMAND, BECAUSE IT DELETES FROM THE DATA BASE ALL ENTRIES PLACED IN THE SELECT-FILE BY THE FIND COMMAND. 1 CAUTION - ONLY DELETE ONE RECORD AT A TIME FROM A MASTER DATA “T������þúSET. 1 SYNTAX - UPDATE A[DD], 'SET NAME' ; OR UPDATE D[ELETE] ; OR UPDATE R[EPLACE]; OR UPDATE 'PROCEDURE NAME' ; 1 THE UPDATE ADD COMMAND PROMPTS THE USER FOR THE ITEM VALUE BY PRINTING THE ITEM NAME FOLLOWED BY A QUESTION MARK. THE USER MUST ENTER A VALUE FOR EACH PATH ITEM, BUT MAY DEFAULT ANY OTHER ITEM VALUE BY ENTERING A SEMICOLON ONLY. 1 THE UPDATE REPLACE COMMAND PROMPTS THE USER FOR THE NAME OF THE ITEM TO UPDATE BY PRINTING "ITEM?". THE USER MUST ENTER THE FOLLOWING, 1 'ITEM NAME' = 'VALUE' ; 1 THE UPDATE REPLACE COMMAND IS TERMINATED BY ENTERING A SEMICOLON ONLY IN RESPONSE TO THE "ITEM?" PROMPT. 1 OPERANDS - 'PROCEDURE NAME' - FMP FILE DESCRIPTOR, (IE., FILENAME [:SECURITY [:CARTRIDGE]]) 'DATA SET NAME' - 1 TO 6 CHARACTER STRING 'ITEM NAME' - 1 TO 6 CHARACTER STRING 'VALUE' - THE ITEM VALUE MUST BE ENCLOSED IN QUOTES, AND TERMINATED WITH A SEMICOLON. ARRAY ITEMS MAY BE ENTERED WITH EACH ARRAY ELEMENT VALUE ENCLOSED IN QUOTES, SEPARATED BY COMMAS, TERMINATED BY A SEMICOLON. FOR EXAMPLE, 1 "ITEM VALUE" [,"ITEM VALUE" [, ... [,ITEM VALUE]]] ; 1 %% HELP XEQ 1 FUNCTION - THE XEQ COMMAND EXECUTES A QUERY BATCH FILE. A QUERY BATCH FILE CONSISTS OF COMMANDS, AND COMMAND PARAMETERS. A COMMAND PARAMETER IS ANY INFORMATION FOR WHICH QUERY WOULD NORMALLY PROMPT AN INTER- ACTIVE USER. THE COMMAND PARAMETERS MUST IMMEDIATELY FOLLOW THE COMMAND. FOLLOWING IS AN EXAMPLE OF A BATCH FILE WHICH OPENS A DATA BASE CALLED "BASE" WITH SECURITY CODE "SC", USING LEVEL CODE WORD "L10", IN MODE 1. THE BATCH FILE ALSO CONTAINS THE COMMAND TO DEFINE THE SELECT-FILE CALLED "SELT". DATA-BASE=BASE:SC; L10; 1; SELECT-FILE=SELTéŒ���*��($; 1 SYNTAX - XEQ = 'BATCH FILE NAME' ; 1 OPERANDS - 'BATCH FILE NAME' - FMP FILE DESCRIPTOR, (IE., FILENAME [:SECURITY [:CARTRIDGE]]) 1 %% ** &QSHLP - 92069-18122 REV.1912 790220 ����������������������������������������������������-Ý*������ÿÿ����� ���� ÿý�¥� ± ���������ÿ��92069-18123 2026� S C0122 �>SRT >SRT � � � � � � � � � � � � � �H0101 �����þúFTN4 SUBROUTINE GTSRT(IBASE,DSNUM,DINUM,INFO),92069-16061 REV.2026 800122 INTEGER IBASE(10),DSNUM,DINUM,INFO(3) C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18123 C RELOC: 92069-16061 C C C************************************************************* C C C GTSRT IS A SUBROUTINE THAT DETERMINES THE SORT ITEM NAME FOR C A DETAIL PATH. C C CALLING SEQUENCE: C C CALL GTSRT(IBASE,DSNUM,DINUM,INFO) C C WHERE: C C IBASE C IS THE BASE PARAMETER FOR THE DATA BASE C C DSNUM C IS THE DETAIL DATA SET'S NUMBER C C DINUM C IS THE ITEM NUMBER OF THE KEY ITEM FOR THE PATH C C INFO C IS A 3 WORD INTEGER ARRAY IN WHICH THE NAME OF THE C SORT ITEM FOR THE PATH, OR BLANKS, IS RETURNED C C INTEGER IBUF(49),ISTAT(10) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C NEEDS NO COMMON DECLARATION C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C C C BEGIN C C C BLANK-FILL INFO C DO 10 I=1,3 INFO(I)=2H 10 CONTINUE C C MAKE DBINF CALL TO GET PATH INFORMATION C CALL DBINF(IBASE,DSNUM,301,ISTAT,IBUF) IF (ISTAT .NE. 0) GO TO 60 C C SEARCH EACH PATH FOR KEY ITEM NUMBER C DO 30 I=3,3*IBUF(1),3 IF (IABS(IBUF(I)) .EQ. DINUM) GOTO 40 30 CONTINUE GOTO 60 C C GET SORT ITEM NUMBER FROM PATH INFO AND IF ITS NON-ZERO C CALL DBINF TO GET THE ITEM'S NAME C 40 ITEM=IABS(IBUF(I+1)) IF (ITEM .EQ. 0) GOTO 60 C CALL DBINF(IBASE,ITEM,102,ISTAT,IBUF) IF (ISTAT .NE. 0) GOTO 60 B.��� �� C C MOVE NAME INTO INFO C DO 50 I=1,3 INFO(I)=IBUF(I) 50 CONTINUE 60 CONTINUE RETURN END ��������������������������������������������������������������������������������������������������������������������������������@Æ ������ÿÿ����� ���� ÿý�¦�­ ���������ÿ��92069-18125 2013� S C0122 �&DBSTX � � � � � � � � � � � � � �H0101 €“�����þúFTN4 PROGRAM DBSTR(4,90),92069-16125 REV.2013 790514 C*************************************************************** C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18125 C RELOC: 92069-16125 C C C****************************************************************: C C C DBSTR SAVES A DATA BASE FROM DISC FILES TO MAG TAPE. C IT SAVES THE ROOT FILE AND ALL DATA SETS SECTOR BY SECTOR. C C RUN SEQUENCE: C :RU,DBSTR,LU1,TAPE,ROOT,LVLWD,ABORT C C WHERE: C C LU1 = INTERACTIVE CONSOLE LU C TAPE= TAPE LU AT WHICH TO SAVE DATA C ROOT= ROOT FILE NAMR OF DATA BASE TO BE SAVED. C LVLWD= HIGHEST LEVEL WORD DEFINED FOR DATA BASE. C ABORT= WHETHER TO ABORT OR NOT ON EOT C C LU1, TAPE, ROOT,LVLWD AND P5 ARE ARRAYS THAT LOOK LIKE THIS: C 1. INTEGER LU OR FIRST TWO CHARACTERS C 2. 0 OR SECOND TWO CHARACTERS C 3. 0 OR THIRD TWO CHARACTERS C 4. TYPE. 0=NULL, 1=INTEGER, 3=ASCII NAMR C 5. SECURITY CODE IF NAMR(FORCED TO A NEGATIVE NUMBER) C 6. CARTRIDGE NUMBER IF NAMR C C LU= LU THAT SCHEDULED PROGRAM(USED IF LU1 IS NONINTERACTIVE) C C VARIABLES IN NAMED COMMON(DECLARED IN MAIN AND SUBROUTINE TAPEW): C HDR = TAPE AND REELHEADER THAT TAPEH PRINTS OUT. C TDCB = DCB THAT TAPEW USES TO WRITE DATA. C TDSZ = SIZE OF TDCB. C C C SET= NAMR OF DATA SET YOU'RE CURRENTLY SAVING C SETNUM = TOTAL NUMBER OF DATA SETS IN DATA BASE( NOT COUNTING ROOT) C C RTDCB=DCB USED TO READ ROOT FILE TO GET INFO AS NEEDED. C BUF1= BUFFER USED TO HOLD DATA FROM ROOT FILE TO LOOK AT. C BUF1 IS 256 (NOT 128) IN CASE AN ELEMENT FROM THE C ROOT FILE 'SPILLS OVER' FROM ONE 128-WORD RECORD C INTO THEÂ������þú NEXT 128-WORD RECORD. C BUFR= LARGE BUFFER USED TO HOLD DATA FROM DISC FILES IN TRANSIT C TO MAG TAPE. C************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ C*************************************************************** COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C*************************************************************** C LOCAL VARIABLES. C INTEGER LU,RTDCBS,BUFSZ INTEGER STRING(40),LENGTH INTEGER BUFR(2072),RTDCB(144) INTEGER BUF1(256),BUF1SZ INTEGER SET(6),SETNUM DATA RTDCBS/128/,BUFSZ/2072/ DATA BUF1SZ/256/ C**************************************************************** C GET THE SCHEDULING LU TO USE IN CASE LU1 IS BAD. C RETRIEVE AND-OR DEFAULT THE RUN PARAMETERS. C LU=LOGLU(IDUMY) CALL STPLU(LU) CALL GETST(BUF1,BUF1SZ,LENGTH) CALL GTPRN(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR) IF (IERR .LT. 0) STOP C****************************************************************** C CHANGE THE LU THE STOP MESSAGES WILL GO TO. C CALL STPLU(LU1) C***************************************************************** C BRANCH ON WHETHER TAPE IS A DISC FILE OR A TAPE LU. C IF (TAPE(4) .EQ. 3) +CALL NWFIL(LU1,IERR,TDCB,TDSZ,TAPE,DBLEI(-1),3,P5(2)) IF (IERR .LT. 0) STOP IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) STOP IF (TAPE(4) .EQ. 1) CALL RING(LU1,TAPE,P5,IERR) IF (IERR .LT. 0) STOP C**************************************************************** C OPEN ROOT FILE EXCLUSIVELY( VERIFIES QUIET DATA BASE), CHECK C SECURITY CODE WITH CALL TO OPEN1. C CALL OPEN1(LU1,ROOT,RTDCB,RTDCBS,IERR) IF (IERR .LT. 0) STOP C**************************************************************** C READ RECORD 1 AND VE´b������þúRIFY THAT ITS A ROOT FILE. C CALL EREAD(RTDCB,IERR,BUF1) CALL DBER2(LU1,IERR,ROOT,6HDBRSX ,2HXX) IF (IERR .LT. 0) GO TO 9500 C IF ((BUF1(1) .EQ. 3) .OR. (BUF1(1) .EQ. 4)) GO TO 70 CALL DBER2(LU1,116,ROOT,6HDBRSX ,2HXX) GO TO 9500 C 70 IF ((BUF1(4) .GE. 1) .AND. (BUF1(4) .LE. 17)) GO TO 80 CALL DBER2(LU1,116,ROOT,6HDBRSX ,2HXX) GO TO 9500 C**************************************************************** C VERIFY THE LEVEL WORD C 80 CALL LEVEL(LU1,RTDCB,ROOT,BUF1,LVLWD,IERR) IF (IERR .LT. 0) GO TO 9500 C**************************************************************** C GET NUMBER OF DATA SETS INTO SETNUM C CALL SETNO(LU1,RTDCB,ROOT,BUF1,SETNUM,IERR) IF (IERR .LT. 0) GO TO 9500 C************************************************************** C OPEN THE DCB TO THE TAPE DEVICE. C TYPE 0 FILE IF TAPE = MAG TAPE LU. C TYPE 3 FILE IF TAPE = DISC FILE. C IOPTN=100B ISECU=TAPE(5) ICR=TAPE(6) CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HDBST2 ,2HXX) IF (IERR .LT. 0) GO TO 9500 C***************************************************************** C SET UP TAPE HEADER IN COMMON BEFORE WRITING IT OUT. C HDR1(1)=8HDBSTORE HDR1(2)=8H21XX DO 210 J=1,6 HDR(J+8)=ROOT(J) 210 CONTINUE C****************************************************************** HDR(17)=LVLWD(1) HDR(18)=LVLWD(2) HDR(19)=LVLWD(3) HDR(20)=SETNUM HDR(21)=1 HDR(24)=2H** C**************************************************************** C WRITE OUT TAPE HEADER. C CALL TAPEW(LU1,TAPE,HDR,24,IERR) IF (IERR .LT. 0) GO TO 9000 C****************************************************************** C CLOSE ROOT FILE TO RTDCB, THEN WRITE IT OUT TO TAPE. (SETW DOES C AN EXCLUSIVE OPEN WITH ITS OWN DCB). C CALL ECLOS(RTDCB,IERR) IF(IERùÝ������þúR .GT. 0) IERR = 0 CALL DBER2(LU1,IERR,TAPE,6HDBST2 ,2HXX) IF (IERR .LT. 0) GO TO 9000 CALL SETW(LU1,TAPE,ROOT,0,BUFR,BUFSZ,IERR) IF (IERR .LT. 0) GO TO 9000 C****************************************************************** C OPEN UP THE ROOT FILE TO RTDCB AGAIN. C CALL OPEN1(LU1,ROOT,RTDCB,RTDCBS,IERR) IF (IERR .LT. 0) GO TO 9000 C****************************************************************** C GET THE NAMR FOR THE JTH DATA SET INTO SET, THEN CALL SETW TO C WRITE THE DATA SET OUT TO MAG TAPE. C DO 100 J=1,SETNUM CALL SETNM(LU1,RTDCB,ROOT,BUF1,J,SET,IERR) IF (IERR .LT. 0) GO TO 9000 CALL SETW(LU1,TAPE,SET,J,BUFR,BUFSZ,IERR) IF (IERR .LT. 0) GO TO 9000 100 CONTINUE C*************************************************************** C PRINT COMPLETION MESSAGE. C CALL REIO(2,LU1,27H DATA BASE STORE COMPLETED.,-27) C****************************************************************** C TIDY UP, AND LEAVE. C CALCULATE THE NUMBER OF BLOCKS TO DELETE FROM THE OUTPUT FILE C UPON ECLOS (TRUNC IS IGNORED IF IT'S A TYPE 0 FILE BEING CLOSED). C TRUNC=BLOCKS-XIRB-1.(THE SMALLER TRUNC IS, THE LARGER THE FILE.) C 8000 CONTINUE CALL ELOCF(TDCB,IERR,REC,XIRB,IOFF,SECTRS,JLU,JTY,JREC) BLOCKS=DDI(SECTRS,DBLEI(2)) TRUNC=DSB(DSB(BLOCKS,XIRB),DBLEI(1)) IF(DCO(TRUNC,DBLEI(0)))8010,8010,9500 8010 TRUNC = DBLEI(1) C************************************************************ C CLOSE THE ROOT DCB, TRUNCATE THE STORAGE FILE. C 9500 CONTINUE CALL ECLOS(RTDCB,IERR) IF (TAPE(4) .EQ. 1) CALL ECLOS(TDCB) IF (TAPE(4) .EQ. 3) CALL ECLOS(TDCB,IERR,TRUNC) IF(IERR .GT. 0) IERR = 0 CALL DBER2(LU1,IERR,TAPE,6HDBST2 ,2HXX) GO TO 9999 C**************************************************************** C ERROR POINT, PURGE THE DISC STORAGE FILE. C 9000 CONTINUE CALL ECLOS(RTDCB,IERR) IF (TAPE(4) .EQ. 3) CALL PURGE(TDCB,Êú������þúIERR,TAPE,TAPE(5),TAPE(6)) GO TO 9999 9999 END C C C SUBROUTINE SETNO(LU1,DCB1,ROOT,BUF1,SETNUM,IERR) +,92069-16125 REV.2013 790413 C******************************************************** C SETNO RETURNS THE NUMBER OF DATA SETS IN THE DATA BASE C AS RECORDED IN THE ROOT FILE. C DBSCT= DATA BASE SET COUNT OFFSET IN ROOT FILE. C START= FIRST RECORD NUMBER IN ROOT FILE PAST OVERHEAD. C*********************************************************** INTEGER LU1,DCB(1),ROOT(1),BUF1(1),SETNUM,IERR INTEGER START INTEGER DBSCT DATA DBSCT/10/ C*********************************************************** C GET START FROM FIRST WORD OF ROOT FILE. C CALL EREAD(DCB1,IERR,BUF1,256,LEN,DBLEI(1)) CALL DBER2(LU1,IERR,ROOT,6HSETNO ,2HAB) IF (IERR .LT. 0) RETURN START=BUF1(1) C*********************************************************** C READ THE ROOT FILE TO GET THE NUMBER OF SETS C CALL EREAD(DCB1,IERR,BUF1,256,LEN,DBLEI(START)) CALL DBER2(LU1,IERR,ROOT,6HSETNO ,2HAB) IF (IERR .LT. 0) RETURN SETNUM=BUF1(DBSCT) RETURN END C C C SUBROUTINE SETW(LU1,TAPE,NAMR,J,BUFR,BUFSZ,IERR) +,92069-16125 REV.2013 790413 C**************************************************************** C SETW WRITES A FILE HEADER AND THE CONTENTS OF NAMR FROM A C DISC FILE TO A MAG TAPE. C C LU1=INTERACTIVE CONSOLE LU C TAPE= MAG TAPE LOGICAL UNIT C NAMR= THE NAMR TO BE STORED. C J = NUMBER OF THE DATA SET YOU'RE WRITING OUT. C BUFR= LARGE ARRAY USED TO HOLD DATA IN TRANSIT FROM DISC TO TAPE. C C SETW DOES AN EXCLUSIVE OPEN ON NAMR, USING ITS OWN DCB. AFTER C WRITING THE NAMR TO MAG TAPE, IT CLOSES THE DCB AND RETURNS. C C HDSZ = LENGTH OF DATA HEADER. C INDEX= POINTER TO LAST FILLED WORD IN BUFR. C C***************************************************************** INTEGER LU1,TAPE(1),NAMR(1),BUFR(1),BUFSZ,IERR INTEGER DCB2(272),DCB2SZ INTEñ������þúGER HDSZ C DOUBLE INTEGER SETSZ INTEGER SETSZ COMPLEX TAPEH4(6) INTEGER TAPEH1(24) EQUIVALENCE (TAPEH4(1),TAPEH1(1)) LOGICAL EOF DATA DCB2SZ/256/ DATA TAPEH4/8HDBSTORE ,8H21XX ,4*(0.,0.)/ C***************************************************************** C CALL FILEH TO WRITE OUT A FILE HEADER. C CALL FILEH(LU1,TAPE,NAMR,DCB2,DCB2SZ,J,IERR) IF (IERR .LT. 0) RETURN C**************************************************************** C OPEN NAMR EXCLUSIVELY AS TYPE 1 FILE. C SET UP DATA HEADER IN FIRST 24 WORDS OF BUFR (NO WRITE TO TAPE HERE) C CALL OPEN1(LU1,NAMR,DCB2,DCB2SZ,IERR) IF (IERR .LT. 0) RETURN CALL DATAH(LU1,NAMR,BUFR,BUFSZ,HDSZ,IERR) IF (IERR .LT. 0) CALL DBER2(LU1,7777,6HSETW ,2HAB) BUFR(17)=1 EOF=.FALSE. JREC=128 C*************************************************************** C LOOP POINT. INCR BLOCK COUNT AND FILL BUFR FROM INDEX+1. C SINCE OPEN AS TYPE 1 FILE, RECORD SIZE=128. C 20 CONTINUE INDEX=HDSZ CALL FILL1(LU1,DCB2,NAMR,BUFR,BUFSZ,INDEX,JREC,EOF,IERR) IF (IERR .LT. 0) RETURN C**************************************************************** C WRITE BUFR OUT TO TAPE. CHECK FOR SPECIAL CASE THAT FILL1 RETURNS C A DATA HEADER WITH NO MEANINGFUL INFORMATION (OCCURS IF THE PREVIOUS C CALL GOT THE LAST RECORD BUT DIDN'T SEE EOF). C IF (INDEX .GT. HDSZ) CALL TAPEW(LU1,TAPE,BUFR,INDEX,IERR) IF (INDEX .GT. HDSZ) BUFR(17)=BUFR(17)+1 IF (IERR .LT. 0) RETURN IF (EOF) GO TO 9999 GO TO 20 C**************************************************************** C CLOSE THE DCB, WRITE EOF ON TAPE, RETURN. C 9999 CALL ECLOS(DCB2,IERR) CALL DBER2(LU1,IERR,NAMR,6HSETW ,2HXX) CALL TAPEW(LU1,TAPE,IDUMY,0,IERR) RETURN END C C C SUBROUTINE SETNM(LU1,DCB1,ROOT,BUF1,J,SET,IERR) +,92069-16125 REV.2013 790313 C*********************************À—������þú********************* C SETNM RETURNS THE NAME, SECURITY CODE, AND CARTRIDGE REF C NUMBER OF THE JTH DATA SET IN PARAMETER SET. IT ASSUMES C THAT DCB1 IS OPEN TO THE ROOT FILE. C C START= FIRST RECORD IN ROOT FILE PAST THE OVERHEAD. C DBSTP=DATA BASE SET TABLE POINTER(POINTS TO SET INFO). C DSCRN=OFFSET FROM SET INFO THAT CONTAINS ICR FOR THAT SET. C DSLNG= LENGTH OF ONE SET TABLE ENTRY C DSSTRT= WORD OFFSET OF START OF DATA SET TABLE. C DSNME = OFFSET FOR NAME OF JTH DATA SET. C C ROOT= 6 WORD ROOT FILE PASSED IN BY CALLER. C PROG= 3 WORD ARRAY CONTAINING NAME OF THIS SUBR. C******************************************************** C FORMAL PARAMETERS AND LOCAL VARIABLES. C INTEGER LU1,DCB1(1),ROOT(1),BUF1(1),J,SET(1),IERR INTEGER START INTEGER DBSTP,DSCRN,DSLNG,DSSTRT,DSNME DATA DBSTP/11/,DSCRN/4/,DSLNG/17/ C********************************************************* C PUT THE START RECORD NUMBER INTO START. C CALL EREAD(DCB1,IERR,BUF1,256,LEN,DBLEI(1)) CALL DBER2(LU1,IERR,ROOT,6HSETNM ,2HXX) IF (IERR .LT. 0) RETURN START=BUF1(1) C********************************************************* C GET THE STARTING OFFSET OF THE SET TABLE INTO DSSTRT. C THEN GET THE START ADDRESS FOR THE JTH SET INTO DSNME. C CALL EREAD(DCB1,IERR,BUF1,256,LEN,DBLEI(START)) CALL DBER2(LU1,IERR,ROOT,6HSETNM ,2HXX) IF (IERR .LT. 0) RETURN DSSTRT=BUF1(DBSTP)+1 DSNME=DSSTRT+(J-1)*DSLNG C********************************************************* C CALCULATE AND READ THE RECORD POINTED AT BY DSNME. C IREC=START+(DSNME/128) IOFF=MOD(DSNME,128) CALL EREAD(DCB1,IERR,BUF1,256,LEN,DBLEI(IREC)) CALL DBER2(LU1,IERR,ROOT,6HSETNM ,2HXX) IF (IERR .LT. 0) RETURN C******************************************************* C PUT THE NAME AND ICR INTO SET. C SET(1)=BUF1(IOFF) SET(2)=BUF1(IOFF+1) SET(3)=BUF1(IOFF+2) SET(4)=3 SET(6)=BUF1(IOIE���0��.*FF+DSCRN-1) C******************************************************* C GET THE SECURITY CODE FROM THE ROOT FILE. C SET(5)=ROOT(5) 9999 RETURN END C C C SUBROUTINE FILL1(LU1,DCB2,NAMR,BUFR,BUFSZ,INDEX,JREC,EOF,IERR) +,92069-16125 REV.2013 790413 C************************************************************* C FILL1 FILLS BUFR STARTING AT THE NEXT WORD PAST INDEX. C IT READS RECORDS INTO BUFR USING FILE CALLS THROUGH THE DCB. C FILL1 ASSUMES THE DCB IS ALREADY OPEN, AND READS RECORDS C STARTING AT THE CURRENT RECORD POSITION. C C BUFSZ=TOTAL BUFR SIZE C INDEX=POSITION OF LAST WORD IN BUFR THATS ALREADY FULL. C JREC= WORD LENGTH OF A SINGLE RECORD. C EOF = LOGICAL FLAG RETURNED WHEN EOF IS ENCOUNTERED. C*************************************************************** C INTEGER LU1,BUFSZ,INDEX,JREC,IERR INTEGER DCB2(1),NAMR(1),BUFR(1) LOGICAL EOF C************************************************************** C MAKE SURE AT LEAST ONE RECORD FITS. C IF (JREC .GT. BUFSZ-INDEX) +CALL DBER2(LU1,7777,6HXXXXXX,6HFILL1 ,2HAB) C************************************************************** C START PACKING INTO BUFR C 10 CALL EREAD(DCB2,IERR,BUFR(INDEX+1),JREC,LEN) IF (IERR .EQ. -12) GO TO 2000 IF (LEN .EQ. -1) GO TO 2000 C IF (IERR .LT. 0) GO TO 3000 INDEX=INDEX+LEN IF (JREC .GT. BUFSZ-INDEX) RETURN GO TO 10 C************************************************************** C HANDLE EOF C 2000 EOF=.TRUE. IERR=0 RETURN C********************************************************** C CHECKING FOR OTHER NEGATIVE ERRORS. C 3000 CONTINUE CALL DBER2(LU1,IERR,NAMR,6HFILL1 ,2HXX) RETURN END ����������������������������*´0������ÿÿ����� ���� ÿý�§� ´ ���������ÿ��92069-18126 2013� S C0122 �&DBRSX � � � � � � � � � � � � � �H0101 €’�����þúFTN4 PROGRAM DBRST(3,80),92069-16126 REV.2013 790413 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18126 C RELOC: 92069-16126 C C C****************************************************************: C C C************************************************ C THIS FILE CONTAINS THE CODE FOR BOTH DBRST AND SETIN. C C DBRST RESTORES A DATA BASE FROM TAPE TO DISC. THE TAPE C MUST HAVE BEEN SAVED FROM DISC WITH PROGRAM DBSTR. C C CALLING SEQUENCE: C :RU,DBRST,CONSOLE,TAPE,ROOT,LEVEL,ABORT C C LU1, TAPE, ROOT, LVLWD, AND P5 ARE 6-WORD ARRAYS AS FOLLOWS: C 1) LU OR FIRST TWO CHARACTERS C 2) 0 OR SECOND TWO CHARACTERS IF NAMR. C 3) 0 OR THIRD TWO CHARACTERS IF NAMR. C 4) 0 IF NULL, 1 IF INTEGER(LU), 3 IF ASCII(NAMR) C 5) O OR SECURITY CODE IF NAMR. C 6) 0 OR CARTRIDGE NUMBER IF NAMR. C C HDR = TAPE AND REELHEADER WITH INFO ENTERED BY USER. C C BUFR = BUFFER USED THROUGHOUT PROGRAM FOR EVERYTHING. C BUFSZ= SIZE OF ABOVE BUFFER. C SETNUM= NUMBER OF DATA SETS TO RESTORE, NOT COUNTING ROOT FILE. C C HDR = TAPE AND REELHEADER AS DETERMINED BY USER PARAMETERS. C TDCB = DCB USED TO READ FROM THE MAG TAPE DEVICE (TYPE 0 OR TYPE 1) C TDSZ = SIZE OF ABOVE DCB. C C FIRST LEVEL SUBRS CALLED ARE: C GTPRM = GETS FIVE PARAMETERS AND DOES PRELIMINARY CHECKS. C P5STR = STORES ROOT AND P5 AWAY FOR LATER RETRIEVAL. C TLOCL = CHECKS IF THE TAPE DRIVE IS LOCAL OR ON-LINE. C CKTHD = CHECK TAPE HEADER. C SETIN = WRITES AN ENTIRE DATA SET FROM MAG TAPE TO DISC. C************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) šÃ������þú INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR1,HDR) INTEGER TDCB(144),TDSZ C******************************************************* COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C*************************************************** C LOCAL VARIABLES. C INTEGER BUFR(2072),BUFSZ INTEGER BUF1(256),BUF1SZ INTEGER SETNUM DATA BUFSZ/2072/ DATA BUF1SZ/256/ C**************************************************** C GET THE PARAMETERS. UNTIL YOU GET LU1, LOG ERRORS ON SCHEDULING LU. C LU=LOGLU(IDUMY) CALL STPLU(LU) CALL GETST(BUF1,BUF1SZ,LENGTH) CALL GTPRM(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR) IF (IERR .LT. 0) STOP C************************************************************* C CHANGE THE LU FOR STOP MESSAGES TO LU1, CHECK TAPE DEVICE. C CALL STPLU(LU1) IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) STOP C********************************************************** C SET UP THE HEADER WITH INFO USER ENTERED. C HDR1(1)=8HDBSTORE HDR1(2)=8H21XX C DO 11 J=1,6 HDR(J+8)=ROOT(J) 11 CONTINUE C HDR(17)=LVLWD(1) HDR(18)=LVLWD(2) HDR(19)=LVLWD(3) HDR(21)=1 HDR(24)=2H** C***************************************************** C OPEN UP THE TYPE 1 OR TYPE 0 FILE TO THE TAPE DEVICE. C IOPTN=0 ISECU=TAPE(5) ICR=TAPE(6) CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GE. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HDBRS2 ,2HAB) C****************************************************** C CHECK THE TAPEHEADER AGAINST THE INFO ENTERED. C CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR) IF (IERR .LT. 0) GO TO 9100 CALL CKTHD(LU1,HDR,BUFR,IERR) IF (IERR .LT. 0) GO TO 9100 C*************************************************************** C TRANSFER THE NUMBER OF SETS STORED ON THE TAPE FROM THE TAPE HEADER C INTO THE LOCAL H¹s������þúEADER, AND INTO SETNUM. C HDR(20)=BUFR(20) SETNUM=HDR(20) C************************************************************* C WRITE THE ROOT FILE FROM STORAGE DEVICE TO THE DISC. C IF SETIN ENCOUNTERS A DUPLICATE ROOT FILE THAT IT'S NOT C SUPPOSED TO PURGE, DON'T PURGE IT HERE EITHER. C CALL SETIN(LU1,TAPE,0,BUFR,BUFSZ,P5,IERR) IF (IERR .EQ. -2) GO TO 9100 IF (IERR .LT. 0) GO TO 9000 C************************************************************** C WRITE ALL THE DATA SETS FROM MAG TAPE TO C DISC. SETIN ASSUMES THE MAG TAPE IS LOCATED AT THE FILEHEADER C FOR THE JTH FILE WHEN ITS CALLED. C DO 10 J=1,SETNUM CALL SETIN(LU1,TAPE,J,BUFR,BUFSZ,P5,IERR) IF (IERR .LT. 0) GO TO 9000 10 CONTINUE C********************************************************** C WRITE MESSAGE AND GET OUT. C CALL REIO(2,LU1,29H DATA BASE RESTORE COMPLETED.,-29) IERR=0 GO TO 9100 C************************************************************** C PURGE ROOT FILE ON ERROR. C 9000 CONTINUE CALL PURGE(BUF1,IERR,ROOT,ROOT(5),ROOT(6)) 9100 IERR=0 CALL ECLOS(TDCB) 9999 END C C C SUBROUTINE SETIN(LU1,TAPE,J,BUFR,BUFSZ,P5,IERR) +,92069-16126 REV.2013 790413 C******************************************************** C SETIN WRITES THE JTH FILE FROM MAG TAPE TO DISC. IT C ASSUMES THAT THE TAPE IS POSITIONED AT THE FILE HEADER C FOR THE JTH FILE, AND THAT THE DATA FOR THE JTH FILE C IMMEDIATELY FOLLOWS THE FILE HEADER. C C NAMR = 6-WORD ARRAY HOLDING INFO ON FILE BEING WRITTEN TO DISC C DCB2 = THE DCB USED TO WRITE THE DATA TO THE FILE. C DCB2SZ = THE SIZE OF DCB2 C C JBLK= 4-WORD ARRAY USED IN ECREA CALL TO CREATE AN FMP FILE. C (=DOUBLE WORD NUMBER OF BLOCKS+2-WORD DUMMY) C HDSZ = LENGTH OF DATA HEADER. C BLKNO= THE BLOCK NUMBER OF THE BUFR YOU'RE TRANSFERRING. C EOF = LOGICAL FLAG TAPER SETS WHEN IT HITS EOF. C******************************************************* ì������þú INTEGER LU1,TAPE,J,BUFR(1),BUFSZ,P5,IERR INTEGER NAMR(6) INTEGER DCB2(272),DCB2SZ INTEGER JBLK(4) INTEGER HDSZ INTEGER BLKNO LOGICAL EOF DATA DCB2SZ/256/ DATA HDSZ/24/ C******************************************************* C CALL CKFHD TO DO THE FOLLOWING: C 1)READ THE FILE HEADER ON THE TAPE. C 2) VERIFY THAT ITS A FILEHEAD. C 3) RETURN INFO IN NAMR,JBLK,JREC,AND ITYPE. C CALL CKFHD(LU1,TAPE,BUFR,BUFSZ,NAMR,JBLK,JREC,ITYPE,IERR) IF (IERR .LT. 0) RETURN C****************************************************** C CALL NWFIL TO CREATE A NEW FILE (IF P5 .EQ. 'AB', NWFIL RETURNS C A NEGATIVE ERROR CODE ON DUPLICATE FILES. IF P5 .NE. 'AB', NWFIL C PURGES THE OLD FILE AND CREATES A NEW ONE.) C JBLK(3) AND JBLK(4) = THE RECORD SIZE FOR A TYPE TWO FILE CREATE. C JBLK(3)=0 JBLK(4)=JREC CALL NWFIL(LU1,IERR,DCB2,DCB2SZ,NAMR,JBLK,ITYPE,P5) IF (IERR .LT. 0) RETURN C******************************************************* C BY HERE, FILE IS CREATED. OPEN IT AS TYPE 1 FILE, C EXCLUSIVE USE, BINARY DATA. C IOPTN=104B ISECU=NAMR(5) ICR=NAMR(6) CALL OPENF(DCB2,IERR,NAMR,IOPTN,ISECU,ICR,DCB2SZ) IF (IERR .GE. 0) IERR=0 CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) IF (IERR .LT. 0) RETURN IERR=0 C************************************************** C READ IN DATA RECORD FROM TAPE TO BUFFER. C 10 EOF=.FALSE. CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR) IF (IERR .LT. 0) RETURN IF (EOF) GO TO 9000 CALL CKDHD(LU1,NAMR,BLKNO,BUFR,IERR) IF (IERR .LT. 0) RETURN BLKNO=BLKNO+1 C************************************************* C WRITE ALL WORDS PAST DATA HEAD INTO FILE. C CALL EWRIT(DCB2,IERR,BUFR(HDSZ+1),LEN-HDSZ,0.0) CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) IF (IERR .LT. 0) RETURN GO TO 10 C**************************************************** C EOF RETURNú ����� POINT. C 9000 CONTINUE CALL CLOSE(DCB2,IERR) CALL DBER2(LU1,IERR,NAMR,6HSETIN ,2HXX) EOF=.FALSE. IERR=0 RETURN END ����������������������������������������������������������������������������������������������������������������#8������ÿÿ����� ���� ÿý�¨� ² ���������ÿ��92069-18127 2013� S C0122 �&DBULX � � � � � � � � � � � � � �H0101 z•�����þúFTN4 PROGRAM DBULD(4,90),92069-16127 REV.2013 790511 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18127 C RELOC: 92069-16127 C C C****************************************************************: C C C*********************************************************** C DBULD BACKS UP A DATA BASE TO MAGNETIC TAPE. IT TRANSFERS C ALL THE MEANINGFUL DATA OUT OF THE DATA BASE AND STORES IT C TO TAPE. C C THE MAIN PROGRAM DOES THE FOLLOWING: C 1) DOES A GETST C 2) CALLS IN SEGMENT DBUL1. C C DBUL1 DOES THE FOLLOWING: C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING. C 2) CALLS DBOPN TO OPEN THE DATA BASE. C 3) CALLS IN SEGMENT DBUL2. C C DBUL2 DOES THE FOLLOWING: C 1) WRITES OUT A TAPEHEADER. C 2) WRITES ALL THE DATA IN ALL MANUAL AND DETAIL DATA SETS. C 3) CALLS IN SEGMENT DBUL9. C C DBUL9 DOES THE FOLLOWING: C 1) CLOSES THE DATA BASE. C 2) ENDS THE PROGRAM. C C C RUN STRING: C :RU,DBULD,CONSOLE,TAPE,ROOT,LEVEL,ABORT C C WHERE: C C CONSOLE= INTERACTIVE LU AT WHICH USER ENTERS COMMANDS. C TAPE = LU OF MAGNETIC TAPE UNIT ON WHICH DATA BASE IS SAVED. C ROOT = ROOT FILE NAMR ON THE DISC. C LVLWD = HIGHEST LEVEL WORD DEFINED FOR THE DATA BASE. C ABORT = AB TO ABORT PROGRAM AT END OF REEL C = XX TO ALLOW MULTIPLE TAPE REELS. C C THE ABOVE PARAMETERS ARE STORED INTERNALLY AS C 6-WORD ARRAYS AS FOLLOWS: C C 1) LU OR FIRST TWO CHARACTERS C 2) 0 OR SECOND TWO CHARACTERS. C 3) 0 OR THIRD TWO PARAMETERS. C 4) 0 IF NULL, 1 IF INTEGER, 3 IF ASCII PARAMETER. C 5) NEGATIVE SECURITY CODE IF NAMR PARAMETER. C 6) CARTRIDGE REF NUMBER IF NAMR PARAMETER. C >Á������þúC LENGTH = LENGTH IN WORDS OF THE PARAMETER STRING. C HDR = TAPE AND REEL HEADER INFORMATION TO BE WRITTEN TO TAPE. C C****************************************************************** C COMMON VARIABLES. THESE VARIABLES ARE DECLARED SIMILARLY IN ALL C THE OTHER SEGMENTS (IF YOU CHANGE THEM, YOU MUST CHANGE THEM ALL). C ALSO CHECK &TPWR2 FOR COMMON DECLARATIONS. C C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE C*************************************************************** C NAMED COMMON VARIABLES. C COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C START PROCESSING HERE. C BUF1SZ=256 CALL GETST(BUF1,BUF1SZ,LENGTH) CALL SEGLX(6HDBUL1 ,LU1) C*************************************************************** C DUMMY CALLS TO MAKE SURE THEY GET RELOCATED WITH THE MAIN. C 777 CALL DBBUF(IDUMY) CALL STPLU(IDUMY) HDR(1)=IDUMY C**************************************************************** END C C C SUBROUTINE SEGLX(INAME,LU1 ),92069-16127 REV.2013 790927 INTEGER INAME(3),LU1 INTEGER IERR INTEGER NOSEG(8 ),NOSGL DATA NOSEG/2H S,2HEG,2HME,2HNT,2H M,2HIS,2HSI,2HNG/ DATA NOSGL/8/ C C C C CALL SEGLD(INAME,IERR) CALL REIO(2,LU1,NOSEG,NOSGL) CALL REIO(2,LU1,INAME,3) STOP END C C C PROGRAM DBUL1(5,90) +,92069-16127 REV.2013 790413 C***************************************************************** C DBUL1 DOES THE FOLLOWING: C C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING HELD IN C BUF1 IN COMMON. C 2) SETS UP TDCB AS A DCB TO WRITE TO THE STORAGE DEVICE(EITHÕ²������þúER A C A TYPE 0 FILE FOR A MAG TAPE OR A TYPE 3 FILE FOR A FILE). C 3) CALLS DBOPN TO OPEN THE DATA BASE. C 4) IF OPEN SUCCESSFUL, WRITES OUT A TAPE HEADER. C 5) LOADS IN SEGMENT DBUL2. C C**************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C************************************************************** C LOCAL VARIABLES. C INTEGER ISTAT(10) INTEGER SETNUM C************************************************************* C GET THE PARAMETERS. C LU=LOGLU(IDUMY) CALL STPLU(LU) CALL GTPRN(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR) IF (IERR .NE. 0) STOP C*************************************************************** C CHANGE THE LU FOR THE STOP MESSAGES, AND RUN PRELIMINARY CHECKS C ON THE TAPE DRIVE (ONLY IF STORAGE IS TO TAPE UNIT). C CALL STPLU(LU1) IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) STOP IF (TAPE(4) .EQ. 1) CALL RING(LU1,TAPE,P5,IERR) IF (IERR .LT. 0) STOP C************************************************************** C MAKE SURE ITS A ROOT FILE, AND THAT C HE HAS THE HIGHEST LEVEL WORD. (USE TDCB TEMPORARILY). C CALL OPEN1(LU1,ROOT,TDCB,TDSZ,IERR) IF (IERR .LT. 0) STOP C CALL EREAD(TDCB,IERR,BUF1) CALL DBER2(LU1,IERR,ROOT,6HDBUL1 ,2HXX) IF (IERR .LT. 0) CALL ECLOS(TDCB,IERR) IF (IERR .LT. 0) STOP C IF ((BUF1(1) .LT. 3) .OR. (BUF1(1) .GT. 4)) GO TO 8900 IF ((BUF1(4) .LT. 1) .OR. (BUF1(4) .GT. 17)) GO TO 8900 CALL LEVEL(LU1,TDCB,ROOT,BUF1,LVLWD,IERR) C IF (IERR .LT. N†������þú0) STOP CALL ECLOS(TDCB,IERR) IF(IERR .GT. 0) IERR = 0 CALL DBER2(LU1,IERR,ROOT,6HDBUL1 ,2HAB) C**************************************************************** C BUILD UP IBASE USING DATA IN ROOT. C IBASE(1)=2H IBASE(2)=ROOT(1) IBASE(3)=ROOT(2) IBASE(4)=ROOT(3) IBASE(5)=2H : ISECU=IABS(ROOT(5)) CALL CNUMD(ISECU,IBASE(6)) IBASE(9)=2H : ICR=IABS(ROOT(6)) CALL CNUMD(ICR,IBASE(10)) C************************************************************ C CALL SQUSH TO DELETE BLANKS FROM IBASE. C 499 CONTINUE CALL SQUSH(IBASE(2),11) C************************************************************ C OPEN THE DATA BASE. C IMODE=3 CALL DBOPN(IBASE,LVLWD,IMODE,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBUL1 ,6HDBUL9 ) C************************************************************* C DB OPENED SUCCESSFULLY. BUILD UP AND WRITE THE TAPEHEADER. C C GET TOTAL NUMBER OF DATA SETS INTO TOTAL C CALL DBINF(IBASE,IDUMY,203,ISTAT,BUF1) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HDBUL1 ,6HDBUL9 ) TOTAL=BUF1(1) C************************************************************* C GET NUMBER OF MANUALS AND DETAILS INTO SETNUM. C DONT COUNT IT IF ITS EMPTY. C SETNUM=0 DO 100 J=1,TOTAL CALL DBINF(IBASE,J,202,ISTAT,BUF1) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HDBUL1 ,6HDBUL9 ) IF (BUF1(9) .EQ. 2HA ) GO TO 100 IF ((BUF1(14) .EQ. 0) .AND. + (BUF1(15) .EQ. 0)) GO TO 100 SETNUM=SETNUM+1 100 CONTINUE C************************************************************ C IF SETNUM=0 THERE'S NO DATA IN THE DATA BASE. C IF (SETNUM .EQ. 0) GO TO 9000 C************************************************************** C BUILD THE TAPEHEADER. C HDR1(1)=8HDBUNLOAD HDR1(2)=8H21XX DO 200 J=1,6 HDR(J+8)=ROOT(J) 200 CONTINUE HDR(20)=SETNUM HDR(21)=1 HDR(24)=2H** C***********************Ë������þú**************************************** C CREATE THE STORAGE FILE IF STORAGE IS TO A FILE. (DELAY TILL HERE C IN CASE IT HAS TO BE PURGED FOR SOME REASON.) C IF (TAPE(4) .EQ. 3) +CALL NWFIL(LU1,IERR,TDCB,TDSZ,TAPE,DBLEI(-1),3,P5(2)) IF (IERR .EQ. 0) GOTO 210 205 CALL SEGLX(6HDBUL9 ,LU1) C**************************************************************** C OPEN THE DCB TO THE STORAGE DEVICE, BE IT TAPE OR FILE. C 210 CONTINUE IOPTN=100B ISECU=TAPE(5) ICR=TAPE(6) CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HDBUL1 ,2HXX) IF (IERR .NE. 0) GOTO 205 IERR=0 C************************************************************* C WRITE OUT THE TAPEHEADER. C CALL TAPEW(LU1,TAPE,HDR,24,IERR) IF (IERR .NE. 0) GOTO 205 C************************************************************ C LOAD IN NEXT SEGMENT. C CALL SEGLX(6HDBUL2 ,LU1) C**************************************************************** C NOT A ROOT FILE. C 8900 CONTINUE CALL ECLOS(TDCB,IERR) CALL REIO(2,LU1,17H NOT A ROOT FILE.,-17) CALL DBER2(LU1,216,ROOT,6HDBUL1 ,2HXX) STOP C********************************************************** C NO DATA IN THE DATA BASE. C 9000 CALL REIO(2,LU1,26H NO DATA IN THE DATA BASE.,13) CALL DBER2(LU1,217,6HXXXXXX,6HDBUL1 ,2HXX) CALL SEGLX(6HDBUL9 ,LU1) END C C C PROGRAM DBUL2(5,90) +,92069-16127 REV.2013 790413 C****************************************************************** C DBUL2 DOES THE FOLLOWING: C C 1) WRITES THE DATA FROM ALL MANUAL AND DETAIL DATA SETS TO TAPE. C 2) LOADS IN SEGMENT DBUL9. C C ASSUMPTIONS: C 1) DATA BASE IS OPEN TO IBASE, WHICH IS STORED IN COMMON. C 2) BUF1 IN COMMON CAN BE USED AS A UTILITY BUFFER. C 3) TAPEW WAS RELOCATED WITH THE MAIN, SO CALLABLE FROM HERE. C C TOTAL = TOTAL NUMBER OF DATA SETS IN THE DATA BASE. ‰¦������þú C SETNUM= NUMBER OF MANUAL AND DETAIL DATA SETS IN THE DATA BASE. C C****************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C LOCAL VARIABLES C INTEGER TOTAL,SETNUM INTEGER BUFR(2072),BUFSZ INTEGER ISTAT(10) DATA BUFSZ/2072/ C**************************************************************** C GET TOTAL NUMBER OF DATA SETS INTO TOTAL. C CALL DBINF(IBASE,IDUMY,203,ISTAT,BUF1) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HDBUL2 ,6HDBUL9 ) TOTAL= BUF1(1) C*************************************************************** C SETW2 WRITES OUT THE DATA SET UNLESS ITS AUTOMATIC. C DO 20 K=1,TOTAL CALL SETW2(LU1,TAPE,IBASE,K,BUFR,BUFSZ,IERR) IF (IERR .NE. 0) GO TO 9000 20 CONTINUE C*************************************************************** C EVERYTHING'S HUNKY-DORY. C CALL REIO(2,LU1,2H ,1) CALL REIO(2,LU1,2H ,1) CALL REIO(2,LU1,28H DATA BASE UNLOAD COMPLETED.,-28) CALL SEGLX(6HDBUL9 ,LU1) C***************************************************************** C CALL DBUL9 IN SUCH A WAY AS TO PURGE THE STORAGE FILE. C 9000 CONTINUE CALL SEGLX(6HDBUL9 ,LU1) END C C C SUBROUTINE SETW2(LU1,TAPE,IBASE,K,BUFR,BUFSZ,IERR) +,92069-16127 REV.2013 790511 C**************************************************************** C 11-7-78 MIGHT WNAT TO LET SETW2 DECIDE WHETHER THIS IS A C AUTOMATIC MASTER AND THEN JUST RETURN, RATHER THAN HAVING HIGHER C LEVEL DECIDE. C C SETW2 WRITES THE D¬������þúATA FROM THE KTH DATA SET TO THE MAG TAPE. C C SETW2 DOES THE FOLLOWING: C C 1) USES DB CALL TO GET NAME,SIZE, JREC ETC OF DATA SET. C 1.5) IF DATA SET K IS AUTOMATIC MASTER, RETURNS. C 1.6) IF DATA SET K IS EMPTY, RETURNS. C 2) CALLS FLHD2 TO WRITE OUT A FILEHEADER. C 3) CALLS DTHD2 TO SET UP A DATA HEADER IN BUFR (NO WRITE TO TAPE). C 4) CALL FILL2 TO FILL UP BUFR USING DB CALLS. C 5) CALL TAPEW TO WRITE BUFR TO TAPE. C 6) CHECK FOR EOF, THEN LOOP OR EXIT. C 7) SET IERR=0 FOR NORMAL RETURN, IERR= DB ERROR ON ERROR RETURN. C C BUF3 = UTILITY BUFFER TO HOLD INFO RETURNED BY DBGET. C ISTAT= STATUS RETURN FROM DB CALLS. C NAME = NAME OF KTH DATA SET. C ENTRY= DOUBLE INTEGER NUMBER OF ENTRY IN DATA SET K. C C FILENO= NUMBER OF DATA SET STORED ON TAPE (K= NUMBER OF SET IN C DATA BASE, FILENO= NUMBER OF SET ON TAPE.) C INDEX = MOVING POINTER OF LAST FULL WORD IN BUFR. C HDSZ = LENGTH OF DATA HEADER. C C******************************************************************** INTEGER LU1,TAPE,IBASE(1),K,BUFR(1),BUFSZ,IERR INTEGER BUF3(17) INTEGER ISTAT(10) INTEGER NAME(3) INTEGER ENTRY(2) INTEGER FILENO INTEGER INDEX INTEGER HDSZ LOGICAL EOF INTEGER ZERO(2) C*************************************************************** C DATA STATEMENTS C DATA ZERO/0,0/ DATA FILENO/1/ C****************************************************************** C GET INFO ON DATA SET K INTO BUF3, MAKE SURE ITS NOT AUTOMATIC. C CALL DBINF(IBASE,K,202,ISTAT,BUF3) IF (ISTAT(1) .NE. 0) GO TO 9000 IF (BUF3(9) .EQ. 2HA ) RETURN C***************************************************************** C EXTRACT NEEDED INFO FROM BUF3. C DO 10 L=1,3 NAME(L)=BUF3(L) 10 CONTINUE JREC=BUF3(10) ENTRY(1)=BUF3(14) ENTRY(2)=BUF3(15) C*************************************************************** C RETURN IF THE DATA SET IS EMPTY. C IF ((ENTÃý������þúRY(1) .EQ. 0) .AND. (ENTRY(2) .EQ. 0)) RETURN C************************************************************** C WRITE OUT A FILEHEADER. C CALL FLHD2(LU1,TAPE,NAME,FILENO,JREC,ENTRY,IERR) IF (IERR .NE. 0) RETURN FILENO=FILENO+1 C************************************************************** C SET UP A DATAHEADER ( NO WRITE TO TAPE), INDEX POINTS TO LAST C WORD IN THE HEADER. C CALL DTHD2(LU1,NAME,BUFR,BUFSZ,HDSZ,IERR) IF (IERR .NE. 0) RETURN C**************************************************************** C INITIALIZE DATA SET TO FIRST SEQUENTIAL RECORD. C CALL DBGET(IBASE,K,4,ISTAT,0,IDUMY,ZERO) IF (ISTAT(1) .NE. 0) GO TO 9000 C**************************************************************** C INIT SOME THINGS AND FILL UP BUFR. C 100 EOF=.FALSE. INDEX=HDSZ CALL FILL2(LU1,IBASE,NAME,BUFR,BUFSZ,INDEX,JREC,EOF,IERR) IF (IERR .NE. 0) RETURN C************************************************************* C IF YOU DIDN'T GET ANY DATA FROM FILL2, YOURE DONE WITH THIS SET. C IF (INDEX .EQ. HDSZ) GO TO 2000 C*************************************************************** C WRITE BUFR OUT TO TAPE. C CALL TAPEW(LU1,TAPE,BUFR,INDEX,IERR) IF (IERR .NE. 0) RETURN IF (EOF) GO TO 2000 GO TO 100 C************************************************************ C FINISHED WITH THIS DATA SET. C 2000 CALL TAPEW(LU1,TAPE,DUMMY,0,IERR) RETURN C*************************************************************** C ERROR POINTS FOLLOW. C 9000 CONTINUE CALL REIO(2,LU1,23H ERROR FOR DATA SET # _,-23) CALL CNUMD(K,ISTAT(2)) CALL REIO(2,LU1,ISTAT(2),3) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HSETW2 ,2HXX) IERR=-ISTAT RETURN END C C C SUBROUTINE FILL2(LU1,IBASE,NAME,BUFR,BUFSZ,INDEX,JREC,EOF,IERR) +,92069-16127 REV.2013 790228 C****************************************************************** C FILL2 FILL¸4������þúS BUFR WITH AS MUCH DATA FROM DATA SET NAME AS POSSIBLE C WITHOUT EXCEEDING BUFSZ. C 11-7-78 MAKE SURE THAT JREC PASSED IN IS ONLY THE DATA LENGTH C AND DOESN'T INCLUDE THE MEDIA RECORD LENGTH. C C INDEX=MOVING INDEX OF LAST SPOT FILLED IN BUFR. C JREC = RECORD LENGTH OF DATA RECORD, NOT INCLUDING MEDIA RECORD. C EOF = RETURNED TRUE WHEN EOF IS FOUND. C NAME = DATA BASE SET NAME YOURE EXTRACTING DATA FROM. C IERR = 0 IF NORMAL RETURN, .NE. 0 IF ERROR RETURN. C****************************************************************** INTEGER LU1,IBASE(1),K,BUFR(1),BUFSZ,INDEX,JREC,IERR LOGICAL EOF INTEGER ISTAT(10) C****************************************************************** C CHECK IF NOT EVEN ONE RECORD FITS. C D IF (JREC .GT. BUFSZ-INDEX) D +CALL DBER2(LU1,7777,6HXXXXXX,6HFILL2 ,6HDBUL9 ) C****************************************************************** C START PACKING DATA FROM THE KTH DATA SET INTO BUFR USING SERIAL C READS. SET LIST SO THAT DBGET READS THE ENTIRE RECORD. C LIST=2H@ IMODE=2 100 CALL DBGET(IBASE,NAME,IMODE,ISTAT,LIST,BUFR(INDEX+1),IDUMY) IF (ISTAT(1) .EQ. 12) GO TO 9000 IF (ISTAT(1) .NE. 0) GO TO 9100 INDEX=INDEX+JREC IF (JREC .GT. BUFSZ-INDEX) RETURN GO TO 100 C****************************************************************** C HIT AN EOF ON ONE OF THE READS. C 9000 EOF=.TRUE. IERR=0 RETURN C****************************************************************** C FATAL DBGET ERROR. C 9100 CALL DBER2(LU1,ISTAT,NAME,6HFILL2 ,2HXX) IERR=-ISTAT RETURN END C C C PROGRAM DBUL9(5,90) +,92069-16127 REV.2013 790413 C******************************************************************* C DBUL9 CLOSES THE DATA BASE. C******************************************************************* C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGE–[���<��:6R LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C***************************************************************** C LOCAL VARIABLES. C INTEGER ISTAT(10) C**************************************************************** C CALL RMPAR TO GET PARAMETERS. (IF PARAMETER 1 = 1 PURGE THE STORAGE C FILE) CALL RMPAR(ISTAT) IFLAG=ISTAT(1) C***************************************************************** C CLOSE THE DATA BASE C CALL DBCLS(IBASE,IDUMY,1,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBUL9 ,2HXX) C************************************************************* C SEE IF YOU SHOULD PURGE THE STORAGE FILE. C IF (IFLAG .EQ. 1) GO TO 9000 C************************************************************** C CALCULATE THE NUMBER OF BLOCKS TO TRUNCATE FROM THE STORAGE FILE. C CALL ELOCF(TDCB,IERR,REC,XIRB,IOFF,SECTRS,JLU,JTY,JREC) BLOCKS=DDI(SECTRS,DBLEI(2)) TRUNC=DSB(DSB(BLOCKS,XIRB),DBLEI(1)) IF(DCO(TRUNC,DBLEI(0)))10,10,20 10 TRUNC = DBLEI(1) 20 IF (TAPE(4) .EQ. 3) CALL ECLOS(TDCB,IERR,TRUNC) IF (TAPE(4) .EQ. 1) CALL ECLOS(TDCB) IF (IERR .EQ. -11) GO TO 9999 IF(IERR .GT. 0) IERR = 0 CALL DBER2(LU1,IERR,TAPE,6HDBUL9 ,2HXX) GO TO 9999 C**************************************************************** C PURGE THE STORAGE FILE. C 9000 CONTINUE IF (TAPE(4) .EQ. 3) CALL PURGE(TDCB,IERR,TAPE,TAPE(5),TAPE(6)) GO TO 9999 9999 END ����������������������������������������������������������������������������������������������������������������%$<������ÿÿ����� ���� ÿý�©�¸ ���������ÿ��92069-18128 2013� S C0122 �&DBLOX � � � � � � � � � � � � � �H0101 ~Œ�����þúFTN4 PROGRAM DBLOD(4,90),92069-16128 REV.2013 790927 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18128 C RELOC: 92069-16128 C C C****************************************************************: C C C*********************************************************** C DBLOD LOADS DATA FROM A MAGNETIC TAPE INTO AN IMAGE DATA BASE C ACCORDING TO A SCHEMA STORED IN A ROOT FILE ON THE DISC. C C THE MAIN PROGRAM DOES THE FOLLOWING: C 1) DOES A GETST C 2) CALLS IN SEGMENT DBLO1. C C DBLO1 DOES THE FOLLOWING: C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING. C 2) CALLS DBOPN TO OPEN THE DATA BASE. C 3) CHECKS THE TAPE HEADER. C 4) CALLS IN SEGMENT DBLO2. C C DBLO2 DOES THE FOLLOWING: C 1) WRITES ALL THE DATA IN ALL MANUAL AND DETAIL DATA SETS C FROM THE MAG TAPE TO THE APPROPRIATE DAA SET. C 2) CALLS IN SEGMENT DBLO9. C C DBLO9 DOES THE FOLLOWING: C 1) CLOSES THE DATA BASE. C 2) ENDS THE PROGRAM. C C ASSUMPTIONS: C DBLOD ASSUMES THAT THE DATA FOR A MANUAL MASTER PRECEDES THE DATA C FOR ALL ASSOCIATED DETAILS. THIS IS A REASONABLE ASSUMPTION SINCE C IN ALL IMAGE SCHEMAS A MANUAL MASTER MUST BE DEFINED PRIOR TO ALL C OF ITS ASSOCIATED DETAILS). C C C RUN STRING: C :RU,DBLOD,CONSOLE,TAPE,ROOT,LEVEL,ABORT C C WHERE: C C CONSOLE= INTERACTIVE LU AT WHICH USER ENTERS COMMANDS. C TAPE = LU OF MAGNETIC TAPE UNIT ON WHICH DATA BASE IS SAVED. C ROOT = ROOT FILE NAMR ON THE DISC. C LVLWD = HIGHEST LEVEL WORD DEFINED FOR THE DATA BASE. C ABORT = AB TO ABORT PROGRAM AT END OF REEL C = XX TO ALLOW MULTIPLE TAPE REELS. C C THE ABOVE PARAMETERS ARE STORED INTEûŒ������þúRNALLY AS C 6-WORD ARRAYS AS FOLLOWS: C C 1) LU OR FIRST TWO CHARACTERS C 2) 0 OR SECOND TWO CHARACTERS. C 3) 0 OR THIRD TWO CHARACTERS. C 4) 0 IF NULL, 1 IF INTEGER, 3 IF ASCII PARAMETER. C 5) NEGATIVE SECURITY CODE IF NAMR PARAMETER. C 6) CARTRIDGE REF NUMBER IF NAMR PARAMETER. C C LENGTH = LENGTH IN WORDS OF THE PARAMETER STRING. C HDR = TAPE AND REEL HEADER INFORMATION TO BE WRITTEN TO TAPE. C C****************************************************************** C COMMON VARIABLES. THESE VARIABLES ARE DECLARED SIMILARLY IN ALL C THE OTHER SEGMENTS (IF YOU CHANGE THEM, YOU MUST CHANGE THEM ALL). C ALSO CHECK &TPWR2 FOR COMMON DECLARATIONS. C C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C START PROCESSING HERE. C BUF1SZ=256 CALL GETST(BUF1,BUF1SZ,LENGTH) CALL SEGLX(6HDBLO1 ,LU1) STOP 77 C*************************************************************** C DUMMY CALLS TO MAKE SURE THEY GET RELOCATED WITH THE MAIN. C 10 CALL DBBUF(IDUMY) CALL STPLU(IDUMY) HDR=IDUMY C**************************************************************** END C C C SUBROUTINE SEGLX(INAME,LU1 ),92069-16128 REV.2013 790927 C C C C C ABSTRACT: C C SEGLX LOADS A SEGMENT USING SEGLD. IF AN ERROR OCCURS THE C NAME OF THE SEGMENT IS PRINTED AND THE PROGRAM IS TERMINATED. C C CALLING SEQUENCE: C C CALL SEGLX(INAME,LU1) C C WHERE: C C INAME IS THE NAME OF THE SEGMENT. IT MUST BE C 6 CHARACTERS LONG. C C LU1 IS THE LOG LU. ON ERROR THE NAMEdU������þú OF THE C SEGMENT WILL BE PRINTED ON THIS LU. C C C C C INTEGER INAME(3),LU1 INTEGER IERR INTEGER NOSEG(8 ),NOSGL DATA NOSEG/2H S,2HEG,2HME,2HNT,2H M,2HIS,2HSI,2HNG/ DATA NOSGL/8 / C C C C CALL SEGLD(INAME,IERR) CALL REIO(2,LU1,NOSEG,NOSGL) CALL REIO(2,LU1,INAME,3) STOP END C C PROGRAM DBLO1(5,90) +,92069-16128 REV.2013 790927 C***************************************************************** C DBLO1 DOES THE FOLLOWING: C C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING HELD IN C BUF1 IN COMMON. C 2) CALLS DBOPN TO OPEN THE DATA BASE. C 3) CALLS DBCRT IN ONE OF TWO WAYS DEPENDING ON P5(THE ABORT WORD). C 1) IF P5=ABORT, CALLS DBCRT WITH NO PURGE OPTION. C 2) IF (P5 .NE. AB),CALLS DBCRT SO IT PURGES AND CREATES NEW FILES. C 4) LOADS IN SEGMENT DBLO2. C C**************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C************************************************************** C LOCAL VARIABLES. C INTEGER ISTAT(10) INTEGER IDCB(144) INTEGER IHEAD(24) EQUIVALENCE (IHEAD,TPHEAD) C************************************************************* C GET THE PARAMETERS. C LU=LOGLU(IDUMY) CALL GTPRM(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR) IF (IERR .NE. 0) STOP C**************************************************************** C PRELIMINARY CHECKS ON THE STORAGE DEVICE. C IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) STOP C*********************************0f������þú****************************** C OPEN THE STORAGE DEVICE. C IOPTN=0 ISECU=TAPE(5) ICR=TAPE(6) CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HDBLO1 ,2HAB) C************************************************************ C BUILD UP IBASE USING DATA IN ROOT. C IBASE=2H IBASE(2)=ROOT IBASE(3)=ROOT(2) IBASE(4)=ROOT(3) IBASE(5)=2H : ISECU=IABS(ROOT(5)) CALL CNUMD(ISECU,IBASE(6)) IBASE(9)=2H : ICR=IABS(ROOT(6)) CALL CNUMD(ICR,IBASE(10)) C************************************************************ C CALL SQUSH TO DELETE BLANKS FROM IBASE. C 499 CONTINUE CALL SQUSH(IBASE(2),11) C************************************************************ C OPEN THE DATA BASE. C IMODE=3 CALL DBOPN(IBASE,LVLWD,IMODE,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBLO1 ,2HAB) C************************************************************* C SET IMODE FOR DBCRT CALL. C IMODE = 0 FOR NO PURGE. C IMODE = 1 TO PURGE FILES AND CREATE NEW ONES. C IMODE = 1 IF (P5 .EQ. 2HAB) IMODE=0 CALL NEWFL(LU1,IDCB,IMODE,ISTAT) IF (ISTAT .NE. 0) GO TO 9500 C***************************************************************** C CHECK THE TAPE HEADER. C C******************************************************************* C READ IN THE TAPE HEADER. C CALL TAPER(LU1,TAPE,IHEAD,24,LEN,EOF,IERR) IF(IERR) 500,510,510 500 CALL SEGLX(6HDBLO9 ,LU1) STOP 77 C******************************************************************* C SET UP THE TAPE HEADER TO COMPARE AGAINST ONE OUT OF STORAGE DEVICE. C FORCE THE ROOT FILE PARTS TO BE THE SAME ( NEED THIS INFO IN HDR C BECAUSE SUBRS EOFRE AND EOTRE EXPECT IT THERE.) C 510 HDR=2HDB HDR(2)=2HUN HDR(3)=2HLO HDR(4)=2HAD HDR(5)=2H21 HDR(6)=2HXX C DO 600 J=9,14 HDR(J)=IHEAD(J) 600 ä'������þú CONTINUE C HDR(21)=1 C****************************************************************** C CHECK THE TAPE HEADER. GET NUMBER OF SETS TO RESTORE FROM INFO C OFF THE TAPE. C CALL CKTHD(LU1,HDR,IHEAD,IERR) IF (IERR .EQ. 0) GOTO 520 CALL SEGLX(6HDBLO9 ,LU1) STOP 77 520 HDR(20)=IHEAD(20) C************************************************************ C LOAD IN NEXT SEGMENT. C CALL SEGLX(6HDBLO2 ,LU1) STOP 77 C************************************************************* C DBCRT RETURNED AN ERROR. C 9500 CONTINUE CALL DBER2(LU1,ISTAT,ISTAT(2),6HDBLO1 ,6HDBLO9 ) END C C C PROGRAM DBLO2(5,90) +,92069-16128 REV.2013 790927 C****************************************************************** C DBLO2 READS AND CHECKS THE TAPE HEADER, GETS NUMBER OF DATA C SETS TO RESTORE OUT OF THE TAPE HEADER. C THEN DBLO2 LOADS THE DATA FROM THE TAPE INTO THE DATA BASE C ACCORDING TO THE ROOT FILE ON THE DISC. C C********************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ C****************************************************************** C COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C LOCAL DECLARATIONS. C INTEGER BUFR(2072),BUFSZ INTEGER SETNUM C*********************************************************** C DATA STATEMENTS C DATA BUFSZ/2072/ C***************************************************************** C GET THE NUMBER OF SETS INTO SETNUM FROM THE TAPE HEADER. C SETNUM=HDR(20) C*******************************************¹R������þú********************** C RESTORE ALL THE DATA SETS FROM TAPE TO DISC. C SETN2 ALWAYS RETURNS POSITIONED AT THE BEGINNING OF THE NEXT C FILE. IF IT RETURNS AN ERROR, IT ALWAYS RETURNS A DB ERROR. C DO 10 J=1,SETNUM CALL SETN2(LU1,TAPE,IBASE,J,BUFR,BUFSZ,BUF1,IERR) IF (IERR .NE. 0) GOTO 20 10 CONTINUE C***************************************************************** C WRITE MESSAGE AND CALL DBLO9 TO CLOSE UP. C CALL REIO(2,LU1,26H DATA BASE LOAD COMPLETED.,13) 20 CALL SEGLX(6HDBLO9 ,LU1) STOP 77 END C C C SUBROUTINE SETN2(LU1,TAPE,IBASE,J,BUFR,BUFSZ,BUF1,IERR) +,92069-16128 REV.1912 790126 C*************************************************************** C SETN2 TRANSFERS DATA FROM THE STORAGE DEVICE INTO THE DATA SET NAMED C IN THE TAPE HEADER ON THE TAPE. C C IF A DATA SET OF THAT NAME IS NOT DEFINED IN THE NEW SCHEMA, C SETN2 SKIP OVER ALL THE DATA FOR THAT SET ON THE TAPE. C C THERE ARE THREE CASES THAT SETN2 HANDLES AS FOLLOWS: C 1) IF THE DATA RECORDS ON THE TAPE ARE THE SAME LENGTH AS AN C ENTRY IN THE NEW DATA SET, THE ENTIRE RECORD FROM THE TAPE C IS LOADED INTO THE DATA ENTRY. C 2) IF THE DATA RECORDS ON THE TAPE ARE LONGER THAN AN ENTRY IN C THE NEW DATA SET, EACH TAPE RECORD IS TRUNCATED AND THE C SHORTENED RECORD IS LOADED INTO THE NEW DATA SET. C 3) IF THE DATA RECORDS ON THE TAPE ARE SHORTER THAN AN ENTRY IN C THE NEW DATA SET, N WORDS FROM THE TAPE RECORD ARE USED, WHERE C N IS CHOSEN SUCH THAT: C A) N <= TAPE RECORD LENGTH. C B) N=SUM OF THE LENGTHS OF THE FIRST SEVERAL ITEMS IN THE DATA SET. C A AND B TOGETHER ENSURE THAT ONLY MEANINGFUL DATA IS PUT FROM THE C TAPE INTO COMPLETE ITEMS IN THE DATA SET. C C ASSUMPTIONS: C 1) TAPE IS POSITIONED AT A FILE HEADER. C 2) BUFR AND BUF1 CAN BE USED FREELY. C C C VARIABLES: C J = THE NUMBER OF THE FILE ON THE TAPE. C NAMR = THE NAME OF THE DATA SET AS RECORDED ON THE FILE HEADER. C EOF = ý������þúLOGICAL VALUE RETURNED BY TAPER AT EOF. C LEN = LENGTH OF TAPE RECORD RETURNED BY TAPER(TAPE READ). C ENTRY = DOUBLE WORD NUMBER OF ENTRIES STORED ON THE TAPE C (I.E. NUMBER OF ENTRIES IN DATA SET IN OLD DATA BASE). C JREC1 = LENGTH OF DATA RECORD ON THE TAPE (I.E. IN OLD DATA BASE). C (JREC1 IS READ IN FROM THE FILE HEADER ON TAPE) C JREC2 = LENGTH OF DATA RECORD IN THE NEW DATA SET (IN NEW DATA BASE). C (JREC2 IS DERIVED USING A CALL TO DBINF IN NEW DATA BASE) C HDSZ = LENGTH OF DATA HEADER( LOCAL VARIABLE). C INDEX = INDEX INTO BUFR USED WHEN DBPUTTING TO GET SUCCESSIVE C RECORDS OUT OF BUFR (EFFECTIVELY UNPACKS BUFR). C C*********************************************************************** C PARAMETER DECLARATIONS C INTEGER LU1,TAPE,IBASE(1),J,BUFR(1),BUFSZ,BUF1(1),IERR C******************************************************************* C LOCAL VARIABLES. C INTEGER NAMR(6) LOGICAL EOF INTEGER LEN INTEGER ENTRY(2) INTEGER JREC1,JREC2 INTEGER ISTAT(10) INTEGER HDSZ INTEGER BLKNO INTEGER INDEX C************************************************************* C DATA STATEMENTS. C DATA HDSZ/24/ C***************************************************************** C READ AND CHECK THE FILE HEADER. C CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR) IF (IERR .LT. 0) RETURN CALL COMP(LU1,BUFR,12HFILEHEAD21XX,6,IERR) IF (IERR .NE. 0) GO TO 4000 C NAMR=BUFR(9) NAMR(2)=BUFR(10) NAMR(3)=BUFR(11) C JREC1=BUFR(19) ENTRY=BUFR(21) ENTRY(2)=BUFR(22) C******************************************************************* C MAKE SURE NAMR EXISTS IN NEW DATA BASE ,AND IS NOT AUTOMATIC MASTER. C CALL DBINF(IBASE,NAMR,202,ISTAT,BUF1) CALL DBER2(LU1,ISTAT,NAMR,6HSETN2 ,2HXX) IF (ISTAT .NE. 0) GO TO 3000 IF (BUF1(9) .EQ. 2HA ) GO TO 2000 C***********************************Œg������þú******************************* C GET ENTRY LENGTH INTO JREC2. C JREC2=BUF1(10) C****************************************************************** C ADJST LOOKS AT JREC1 AND JREC2 TO SET UP BUF1 SUCH THAT: C BUF1(1)=N (NUMBER OF ITEMS TO DBPUT). C BUF1(2) THROUGH BUF1(N+1) = ITEM NUMBERS TO USE IN DBPUT. C ADJST PICKS N SUCH THAT THE LENGTHS OF THE FIRST N ITEMS SUM TO LESS C THAN OR EQUAL TO THE LENGTH OF A TAPE RECORD. C CALL ADJST(LU1,IBASE,NAMR,JREC1,JREC2,BUF1,IERR) IF (IERR .NE. 0) GO TO 3000 C****************************************************************** C BY HERE, BUF1 IS SET UP FOR DBPUTS.READ RECORDS FROM TAPE, USE C DBPUTS TO PUT DATA INTO THE DATA SET. C 1000 CONTINUE EOF=.FALSE. CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR) IF (IERR .NE. 0) RETURN IF (EOF) RETURN C***************************************************************** C CHECK THE DATA HEADER. C CALL CKDHD(LU1,NAMR,BLKNO,BUFR,IERR) IF (IERR .NE. 0) GO TO 3000 C****************************************************************** C CHECK THAT THE DATA RECORD FROM TAPE CONTAINS AN INTEGRAL NUMBER C OF JREC1'S. C IMOD=MOD(LEN-HDSZ,JREC1) IF (IMOD .EQ. 0) GO TO 1499 CALL DBER2(LU1,7777,NAMR,6HSETN2 ,2HXX) GO TO 3000 C****************************************************************** C DO DBPUTS FROM THE BUFR. BY INCREMENTING INDEX, YOU'RE C EFFECTIVELY UNPACKING THE DATA SINCE DBPUT TAKES ITS DATA FROM C SUCCESSIVELY HIGHER LOCATIONS IN THE BUFR. C 1499 INDEX=HDSZ+1 1500 CALL DBPUT(IBASE,NAMR,1,ISTAT,BUF1,BUFR(INDEX)) CALL DBER2(LU1,ISTAT,NAMR,6HSETN2 ,6HDBLO9 ) INDEX=INDEX+JREC1 IF (INDEX .EQ. LEN+1) GO TO 1000 IF (INDEX .GT. LEN) +CALL DBER2(LU1,7777,NAMR,6HSETN2 ,6HDBLO9 ) GO TO 1500 C******************************************************************** C DATA SET IS AUTOMATIC IN THE NEW SCHEMA. C 2000 CONTINUE CALL REIO(2,LU1,32H DATAL{������þú SET IS AUTOMATIC MASTER: _,16) CALL REIO(2,LU1,NAMR,3) C********************************************************************** C DO A FORWARD FILE ON TAPE. C 3000 CALL REIO(2,LU1,21H SKIPPING DATA SET: _,-21) CALL REIO(2,LU1,NAMR,3) GO TO 9000 C***************************************************************** C HAD A BAD FILEHEAD. C 4000 CONTINUE CALL REIO(2,LU1,36H SKIPPING AN IRRECOVERABLE DATA SET.,18) GO TO 9000 C**************************************************************** C SKIP THE DATA SET. C 9000 CONTINUE IERR=0 CALL FF(LU1,TAPE,BUFR,BUFSZ,IERR) RETURN END C C C SUBROUTINE ADJST(LU1,IBASE,NAMR,JREC1,JREC2,BUF1,IERR) +,92069-16128 REV.1912 790126 C*************************************************************** C ADJST RETURNS BUF1 AS FOLLOWS: C 1) N (MAX NUMBER OF ITEMS FROM DATA SET NAMR WHOSE LENGTHS SUM C TO LESS THAN OR EQUAL JREC1) C 2) ABSOLUTE VALUE OF FIRST ITEM NUMBER. C 3) ABSOLUTE VALUE OF SECOND ITEM NUMBER. C : C N+1) ABSOLUTE VALUE OF NTH ITEM NUMBER. C C JREC1 = LENGTH OF ONE RECORD FROM TAPE. C JREC2 = LENGTH OF AN ENTRY IN THE DATA SET NAMED NAMR. C C LENGTH = RUNNING LENGTH OF ITEMS C INDEX = WHICH CONSECUTIVE ITEM IN NAMR YOU'RE CURRENTLY ON. C ITEMLN = LENGTH OF ONE SUBITEM. C ITEMCT = NUMBER OF SUBITEMS MAKING UP ONE ITEM. C TEMPLN = TOTAL LENGTH OF THIS ITEM (ITEMLN*ITEMCT) C**************************************************************** C PARAMETER DECLARATIONS. C INTEGER LU1,IBASE(1),NAMR(1),JREC1,JREC2,BUF1(1),IERR C****************************************************************** C LOCAL VARIABLES. C INTEGER ISTAT(10),TEMP(13) INTEGER LENGTH,INDEX,ITEMLN,ITEMCT,TEMPLN C***************************************************************** C GET ITEM NUMBERS FOR ENTIRE SET INTO BUF1. C CALL DBINF(IBASE,NAMR,104,ISTAT,BUF1) IF (ISTAT .NE. 0) GO TO 2000 C*****************************¯������þú******************************** C TAKE ABSOLUTE VALUES OF ALL ITEM NUMBERS. C DO 50 L=2,BUF1+1 BUF1(L)=IABS(BUF1(L)) 50 CONTINUE C************************************************************* C BRANCH ACCORDING TO RELATION OF JREC1 TO JREC2. C IF (JREC1 .EQ. JREC2) RETURN IF (JREC1 .GT. JREC2) GO TO 1000 IF (JREC1 .LT. JREC2) GO TO 1500 CALL DBER2(LU1,7777,NAMR,6HADJST ,6HDBLO9 ) C************************************************************* C TAPE RECORD .GT. DATA ENTRY. C 1000 CONTINUE CALL REIO(2,LU1,39H TRUNCATING DATA RECORDS FOR DATA SET _,-39) CALL REIO(2,LU1,NAMR,3) RETURN C*************************************************************** C TAPE RECORD .LT. DATA ENTRY. WANT TO USE AS MUCH OF TAPE RECORD AS C POSSIBLE, SO SET BUF1(1) TO USE AS MANY ITEMS AS POSSIBLE C WITHOUT EXCEEDING THE LENGTH OF A TAPE RECORD. C 1500 CONTINUE CALL REIO(2,LU1,41H DATA RECORD SMALLER THAN ENTRY FOR SET _,-41) CALL REIO(2,LU1,NAMR,3) LENGTH=0 INDEX=2 1550 CONTINUE CALL DBINF(IBASE,BUF1(INDEX),102,ISTAT,TEMP) IF (ISTAT .NE. 0) GO TO 2000 TEMPLN=TEMP(10)*TEMP(11) C************************************************************* C IF ASCII ITEM, ITS BYTE LENGTH SO DIVIDE BY 2 C IF (TEMP(9) .EQ. 2HX ) TEMPLN=TEMPLN/2 IF (LENGTH + TEMPLN .GT. JREC1) GO TO 1600 C*********************************************************** C NOT DONE YET, SO INCR AND LOOP. C LENGTH = LENGTH +TEMPLN INDEX=INDEX+1 GO TO 1550 C************************************************************ C HIT HERE YOU KNOW INDEX IS ONE TOO MANY. C 1600 CONTINUE BUF1=INDEX-1 IF (BUF1 .GT. 0) RETURN C*********************************************************** C ERROR IN THAT EVEN THE FIRST ITEM IS BIGGER THAN THE TAPE RECORD. C CALL REIO(2,LU1,33H DATA RECORD SMALLER THAN ITEM 1_,-33) CALL REIO(2,LU1,14H IN DATA SET _,7) CALLâx���B��@< REIO(2,LU1,NAMR,3) IERR=-243 CALL DBER2(LU1,IERR,NAMR,6HADJST ,2HXX) RETURN C*************************************************************** C ERROR POINTS C 2000 CONTINUE CALL DBER2(LU1,ISTAT,NAMR,6HADJST ,2HXX) IERR=-ISTAT RETURN END C C C PROGRAM DBLO9(5,90) +,92069-16128 REV.2013 790927 C******************************************************************** C DBLO9 CLOSES THE DATA BASE AND STOPS. C******************************************************************** C COMMON DECLARATIONS. C C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C***************************************************************** C LOCAL VARIABLES C INTEGER ISTAT(10) C****************************************************************** C CLOSE THE DATA BASE. C CALL DBCLS(IBASE,IDUMY,1,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBLO9 ,2HXX) CALL ECLOS(TDCB) 9999 END ��������������������������ƒmB������ÿÿ����� ���� ÿý�ª�º ���������ÿ��92069-18129 1912� S C0122 �&DBUPH �DBUPH SOURCE � � � � � � � � � � � � �H0101 Œe�����ASMB,L * * ****************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18129 * RELOC: 92069-16129 * * *****************************************************************: * * NAM DBUPH,7 92069-12001 REV.1912 790317 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������Š������ÿÿ����� ���� ÿý�«�± ���������ÿ��92069-18130 1912� S C0122 �&DBUP �DBUP SOURCE � � � � � � � � � � � � �H0101 VC�����þúFTN4,L C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18130 C RELOC: 92069-16130 C C C****************************************************************: C C PROGRAM DBUP() +,92069-16130 REV.1912 790425 C*********************************************************** C DBUP BACKS UP A 92063 DATA BASE TO A STORAGE DEVICE. C IT TRANSFERS ALL THE MEANINGFUL DATA FROM A 92063 DATA BASE TO C A STORAGE DEVICE IN A FORMAT SUITABLE FOR THE 92069 DBLOX PROGRAM C TO LOAD IT INTO A 92069 DATA BASE. THIS IS THE PROCESS USED TO C UPGRADE FROM A 92063 DATA BASE TO A 92069 DATA BASE. C C 1.FILE &DBUP CONTAINS ALL THE CODE SPECIFIC TO THE DBUP PROGRAM. C 2.FILE %DBUP CONTAINS THE COMPILED VERSION OF &DBUP. C 3.FILE *DBUP CONTAINS %DBUP PLUS CERTAIN RELOCATABLE SUBROUTINES C FROM THE IMAGE LIBRARY THAT DBUP USES. IN THIS WAY, THE USER C ONLY HAS TO SEARCH THE 92063 IMAGE LIBRARY WHEN HES LOADING C THE PROGRAM, AND DOESNT HAVE TO SEARCH THE 92069 IMAGE LIBRARY. C C THE MAIN PROGRAM DOES THE FOLLOWING: C 1) DOES A GETST C 2) CALLS IN SEGMENT DBUP1. C C DBUP1 DOES THE FOLLOWING: C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING. C 2) CALLS DBOPN TO OPEN THE DATA BASE. C 3) CALLS IN SEGMENT DBUP2. C C DBUP2 DOES THE FOLLOWING: C 1) WRITES OUT A TAPEHEADER. C 2) WRITES ALL THE DATA IN ALL MANUAL AND DETAIL DATA SETS. C 3) CALLS IN SEGMENT DBUP3. C C DBUP3 DOES THE FOLLOWING: C 1) CLOSES THE DATA BASE. C 2) ENDS THE PROGRAM. C C C RUN STRING: C :RU,DBUP,CONSOLE,TAPE,ROOT,LEVEL,ABORT C C WHERE: C C CONSOLE= INTERACTIVE LU AT WHICH USER ENTERS COMMANDS. C TAPE = LÄ������þúU OF MAGNETIC TAPE UNIT ON WHICH DATA BASE IS SAVED. C ROOT = ROOT FILE NAMR ON THE DISC. C LVLWD = HIGHEST LEVEL WORD DEFINED FOR THE DATA BASE. C ABORT = AB TO ABORT PROGRAM AT END OF REEL C = XX TO ALLOW MULTIPLE TAPE REELS. C C THE ABOVE PARAMETERS ARE STORED INTERNALLY AS C 6-WORD ARRAYS AS FOLLOWS: C C 1) LU OR FIRST TWO CHARACTERS C 2) 0 OR SECOND TWO CHARACTERS. C 3) 0 OR THIRD TWO PARAMETERS. C 4) 0 IF NULL, 1 IF INTEGER, 3 IF ASCII PARAMETER. C 5) NEGATIVE SECURITY CODE IF NAMR PARAMETER. C 6) CARTRIDGE REF NUMBER IF NAMR PARAMETER. C C LENGTH = LENGTH IN WORDS OF THE PARAMETER STRING. C HDR = TAPE AND REEL HEADER INFORMATION TO BE WRITTEN TO TAPE. C C****************************************************************** C COMMON VARIABLES. THESE VARIABLES ARE DECLARED SIMILARLY IN ALL C THE OTHER SEGMENTS (IF YOU CHANGE THEM, YOU MUST CHANGE THEM ALL). C ALSO CHECK &TPWR2 FOR COMMON DECLARATIONS. C C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE C*************************************************************** C NAMED COMMON VARIABLES. C COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C DATA STATEMENTS. C C******************************************************************** C START PROCESSING HERE. C BUF1SZ=256 CALL GETST(BUF1,BUF1SZ,LENGTH) C************************************************************** C LOAD IN SEGMENT 1. C CALL EXEC(8,6HDBUP1 ) C*************************************************************** C DUMMY CALLS TO MAKE SURE THEY GET RELOCATED WITH THE MAIN. C CALL DBINT(IDUMY) CALL STPLU(IDUMY) HDR(1)=IDUMY 0â������þúCALL OPENF(IDUMY) CALL REIO(IDUMY) C**************************************************************** END C C C C SUBROUTINE OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) +,92069-16130 REV.1912 790126 C************************************************************* C OPENF IS USED TO SIMULATE THE SESSION MONITOR OPENF ROUTINE. C IF THE STORAGE DEVICE IS ACTUALLY A TAPE DRIVE (NOT A TYPE 3 FILE), C OPENF OPENS THE TYPE 0 FILE NAMED MT THAT SHOULD EXIST ON C A CARTRIDGE ACCESSIBLE TO THE USER. C***************************************************************** INTEGER TDCB,IERR,TAPE(1),IOPTN,ISECU,ICR,TDSZ IF (TAPE(4) .EQ. 1) GO TO 1000 IF (TAPE(4) .EQ. 3) GO TO 3000 C**************************************************************** C OPEN UP THE TYPE 0 FILE TO THE TAPE DRIVE. C 1000 CONTINUE CALL OPEN(TDCB,IERR,6HMT ,IOPTN) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,6HMT ,6HOPENF ,2HXX) RETURN C****************************************************************** C OPEN UP THE TYPE 3 FILE. C 3000 CONTINUE CALL OPEN(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HOPENF ,2HXX) RETURN END C C C C PROGRAM DBUP1(5,90) +,92069-16130 REV.1912 790324 C***************************************************************** C DBUP1 DOES THE FOLLOWING: C C 1) RETRIEVES ALL THE PARAMETERS FROM THE RUN STRING HELD IN C BUF1 IN COMMON. C 2) SETS UP TDCB AS A DCB TO WRITE TO THE STORAGE DEVICE(EITHER A C A TYPE 0 FILE FOR A MAG TAPE OR A TYPE 3 FILE FOR A FILE). C 3) CALLS DBOPN TO OPEN THE DATA BASE. C 4) IF OPEN SUCCESSFUL, WRITES OUT A TAPE HEADER. C 5) LOADS IN SEGMENT DBUP2. C C**************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER TO%¯������þúTAL INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C************************************************************** C LOCAL VARIABLES. C INTEGER ILIST(13) INTEGER ISTAT(10) INTEGER SETNUM C************************************************************* C DATA STATEMENTS. C DATA ILIST/4,2HDB,2HUP,2H , + 2HDB,2HUP,2H1 , + 2HDB,2HUP,2H2 , + 2HDB,2HUP,2H9 / C************************************************************* C GET THE PARAMETERS. C LU=LOGLU(IDUMY) CALL GTPRN(LU,LU1,TAPE,ROOT,LVLWD,P5,BUF1,LENGTH,IERR) IF (IERR .NE. 0) STOP C*************************************************************** C CHANGE THE LU FOR THE STOP MESSAGES, AND RUN PRELIMINARY CHECKS C ON THE TAPE DRIVE (IF STORAGE IS TAPE UNIT). C CALL STPLU(LU1) IF (IERR .LT. 0) STOP IF (TAPE(4) .EQ. 1) CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) STOP IF (TAPE(4) .EQ. 1) CALL RING(LU1,TAPE,P5,IERR) IF (IERR .LT. 0) STOP C************************************************************ C OPEN THE DATA BASE. C CALL DBINT(ROOT,IABS(ROOT(5)),ILIST,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBUP1 ,2HAB) IMODE=3 ISECU=IABS(ROOT(5)) CALL DBOPN(ROOT,LVLWD,ISECU,IMODE,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBUP1 ,6HDBUP9 ) C************************************************************* C DB OPENED SUCCESSFULLY. BUILD UP AND WRITE THE TAPEHEADER. C C GET TOTAL NUMBER OF DATA SETS INTO TOTAL C CALL TOTL3(LU1,IERR,TOTAL,BUF1) IF (IERR .LT. 0) CALL EXEC(8,6HDBUP9 ) C************************************************************* C GET NUMBER OF MANUALS AND DETAILS INTO SETNUM. C SETNUM=0 DO 100 J=1‚������þú,TOTAL CALL DBINF(2HS ,2,J,BUF1) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HDBUP1 ,6HDBUP9 ) IF (BUF1(5) .EQ. 101B) GO TO 100 SETNUM=SETNUM+1 100 CONTINUE C************************************************************ C IF SETNUM=0 THERE ARE NO MANUALS OR DETAILS. C IF (SETNUM .EQ. 0) GO TO 9000 C************************************************************** C BUILD THE TAPEHEADER. (SAME FORMAT AS FOR DBULX. SEE TECH SPECS) C HDR1(1)=8HDBUNLOAD HDR1(2)=8H21XX C DO 10 J=1,6 HDR(J+8)=ROOT(J) 10 CONTINUE C HDR(20)=SETNUM HDR(21)=1 HDR(24)=2H** C*********************************************************** C CREATE THE STORAGE FILE (IF STORAGE IS TO FILE) (DELAY C CREATION TILL HERE IN CASE IT HAS TO BE PURGED.) C IF (TAPE(4) .EQ. 3) +CALL NWFIL(LU1,IERR,TDCB,TDSZ,TAPE,-1,3,P5(2)) IF (IERR .NE. 0) CALL EXEC(8,6HDBUP9 ,1) C******************************************************** C OPEN THE STORAGE FILE, BE IT TAPE OR FILE. C IOPTN=100B ISECU=TAPE(5) ICR=TAPE(6) CALL OPENF(TDCB,IERR,TAPE,IOPTN,ISECU,ICR,TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HDBUP1 ,2HXX) IF (IERR .NE. 0) CALL EXEC(8,6HDBUP9 ,1) C************************************************************* C WRITE OUT THE TAPEHEADER. C CALL TAPEW(LU1,TAPE,HDR,24,IERR) IF (IERR .NE. 0) CALL EXEC(8,6HDBUP9 ,1) C************************************************************ C LOAD IN NEXT SEGMENT. C CALL EXEC(8,6HDBUP2 ) C********************************************************** C NO DATA IN THE DATA BASE. C 9000 CALL EXEC(2,LU1,26HNO DATA IN THE DATA BASE. ,13) CALL DBER2(LU1,217,ROOT,6HDBUP1 ,2HXX) CALL EXEC(8,6HDBUL9 ,1) END C C C C SUBROUTINE NWFIL(LU1,IERR,IDCB,IDCBSZ,NAMR,JBLK,ITYPE,IABORT) +,92069-16130 REV.1912 790126 C***********************************************************›Q������þú********** C NWFIL CREATES A NEW FILE NAMED NAMR, OF SIZE ISIZE, AND TYPE ITYPE. C C IABORT = 'AB' TO RETURN NEGATIVE ERROR ON DUPLICATE FILE. C = ANYTHING ELSE TO ATTEMPT PURGE OF DUPLICATE FILE BEFORE CREATE. C C NAMR = C 1)1ST TWO CHARACTERS OF NAMR C 2)2ND TWO CHARS C 3)3RD TWO CHARS C 4)3 C 5)SECURITY CODE C 6)CARTRIDGE NUMBER C C BLK = DOUBLE INTEGER SIZE OF THE NEW FILE ON DISC. C JBLK = DOUBLE INTEGER SIZE OF FILE REQUESTED BY CALLING PROGRAM. C********************************************************************** C PARAMETER DECLARATIONS C INTEGER LU1,IERR,IDCB(1),IDCBSZ,NAMR(1),JBLK,ITYPE,IABORT REAL BLK C DOUBLE INTEGER BLK C******************************************************************** C MAKE SURE ITS A NAMR PARAMETER, GET ISECU AND ICR C IF (NAMR(4) .NE. 3) CALL DBER2(LU1,7777,NAMR,6HNWFIL ,2HAB) ISECU=NAMR(5) ICR=NAMR (6) C****************************************************************** C SEE IF YOU SHOULD SKIP THE PURGE. C IF (IABORT .EQ. 2HAB) GO TO 100 CALL PURGE(IDCB,IERR,NAMR,ISECU,ICR) IF (IERR .GE. 0) IERR=0 IF (IERR .EQ. -6) GO TO 100 CALL DBER2(LU1,IERR,NAMR,6HNWFIL ,2HXX) IF (IERR .LT. 0) RETURN C***************************************************************** C CREATE THE NEW FILE WITH INFO PASSED IN. C 100 CALL CREAT(IDCB,IERR,NAMR,JBLK,ITYPE,ISECU,ICR,IDCBSZ,BLK) IF (IERR .GE. 0) IERR=0 CALL DBER2(LU1,IERR,NAMR,6HNWFIL ,2HXX) RETURN END C C C C SUBROUTINE TOTL3(LU1,ISTAT,TOTAL,BUF1) +,92069-16130 REV.1912 790126 C**************************************************************** C TOTL3 RETURNS THE TOTAL NUMBER OF DATA SETS AN THE DATA BASE C IN PARAMETER TOTAL. IT USES BUF1 AS A UTILITY BUFFER. C**************************************************************** INTEGER LU1,ISTAT(1),TOTAL,BUF1(1) DO 10 J=1,51 CALL DBINF(2HS ,2,J,BUF1) IF (BUF1(1¯�������þú) .NE. 0) GO TO 1000 10 CONTINUE C******************************************************** C ERROR OCCURRED ON JTH DATA SET, SO TOTAL=J-1 C 1000 TOTAL=J-1 D WRITE(LU1,1005) TOTAL D1005 FORMAT(/"TOTL3: TOTAL DATA SETS = ",I6) ISTAT=0 RETURN END C C C C PROGRAM DBUP2(5,90) +,92069-16130 REV.1912 790228 C****************************************************************** C DBUP2 DOES THE FOLLOWING: C C 1) WRITES THE DATA FROM ALL MANUAL AND DETAIL DATA SETS TO TAPE. C 2) LOADS IN SEGMENT DBUP9. C C ASSUMPTIONS: C 1) DATA BASE IS OPEN TO IBASE, WHICH IS STORED IN COMMON. C 2) BUF1 IN COMMON CAN BE USED AS A UTILITY BUFFER. C 3) TAPEW WAS RELOCATED WITH THE MAIN, SO CALLABLE FROM HERE. C C TOTAL = TOTAL NUMBER OF DATA SETS IN THE DATA BASE. C SETNUM= NUMBER OF MANUAL AND DETAIL DATA SETS IN THE DATA BASE. C C****************************************************************** C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C****************************************************************** C LOCAL VARIABLES C INTEGER TOTAL,SETNUM INTEGER BUFR(2072),BUFSZ INTEGER ISTAT(10) DATA BUFSZ/2072/ C**************************************************************** C GET TOTAL NUMBER OF DATA SETS INTO TOTAL. C CALL TOTL3(LU1,ISTAT,TOTAL,BUF1) IF (ISTAT .NE. 0) CALL EXEC(8,DBUP9 ,1) C*************************************************************** C SETW2 WRITES OUT THE DATA SET UNLESS ITS AUTOMATIC. C DO 20 K=1,TOTAL CALL SETW2(LU1,TAPE,IBASE,K,BUFR,BUFSZ,ISTAT) IF (ISTAT .NE. 0) CALL EXEC(8,6HDBUP9 ,1õ������þú) 20 CONTINUE C*************************************************************** C EVERYTHING'S HUNKY-DORY. C WRITE(LU1,1000) 1000 FORMAT(//"DBUP: DATA BASE UNLOAD COMPLETE."//) CALL EXEC(8,6HDBUP9 ) END C C C C C**************************************************************** C SPECIAL SETW2 ONLY USED BY DBUP C**************************************************************** SUBROUTINE SETW2(LU1,TAPE,IBASE,K,BUFR,BUFSZ,ISTAT) +,92069-16130 REV.1912 790425 C**************************************************************** C C SETW2 WRITES THE DATA FROM THE KTH DATA SET TO THE MAG TAPE. C C SETW2 DOES THE FOLLOWING: C C 1) USES DB CALL TO GET NAME,SIZE, JREC ETC OF DATA SET. C 1.5) IF DATA SET K IS AUTOMATIC MASTER, RETURNS. C 2) CALLS FLHD2 TO WRITE OUT A FILEHEADER. C 3) CALLS DTHD2 TO SET UP A DATA HEADER IN BUFR (NO WRITE TO TAPE). C 4) CALL FILL2 TO FILL UP BUFR USING DB CALLS. C 5) CALL TAPEW TO WRITE BUFR TO TAPE. C 6) CHECK FOR EOF, THEN LOOP OR EXIT. C 7) SET IERR=0 FOR NORMAL RETURN, IERR= DB ERROR ON ERROR RETURN. C C C NOTE 4-25-79. BUFR IS NOW PASSED IN AS A PARAMETER TO THE LNGTH C SUBROUTINE. SINCE LNGTH DESTROYS ANY INFO THAT MIGHT BE IN BUFR, C THE CALL TO LNGTH MUST OCCUR IN THE BEGINNING OF SETW2, BEFORE C ANY IMPORTANT INFO IS PLACED IN BUFR. C C BUF3 = UTILITY BUFFER TO HOLD INFO RETURNED BY DBGET. C ISTAT= STATUS RETURN FROM DB CALLS. C NAME = NAME OF KTH DATA SET. C ENTRY= DOUBLE INTEGER NUMBER OF ENTRY IN DATA SET K. C C FILENO= NUMBER OF DATA SET STORED ON TAPE (K= NUMBER OF SET IN C DATA BASE, FILENO= NUMBER OF SET ON TAPE.) C INDEX = MOVING POINTER OF LAST FULL WORD IN BUFR. C HDSZ = LENGTH OF DATA HEADER. C C******************************************************************** INTEGER LU1,TAPE,IBASE(1),K,BUFR(1),BUFSZ,ISTAT(1) INTEGER BUF3(17) INTEGER NAME(3) INTEGER ENTRY(2) INTEGER FILENO INTEGER INDEX INTEGER HDIJ������þúSZ LOGICAL EOF INTEGER ZERO(2) C*************************************************************** C DATA STATEMENTS C DATA ZERO/0,0/ DATA FILENO/1/ C****************************************************************** C GET INFO ON DATA SET K INTO ISTAT, MAKE SURE ITS NOT AUTOMATIC. C NOTE: 101B = 0 IN BITS 15-8 AND AN ASCII A IN BITS 7-0. C CALL DBINF(2HS ,2,K,BUF3) IF (BUF3(1) .NE. 0) GO TO 8900 IF (BUF3(5) .EQ. 101B) RETURN C***************************************************************** C EXTRACT NEEDED INFO FROM BUF3. C DO 10 L=1,3 NAME(L)=BUF3(L+1) 10 CONTINUE C********************************************************************** C JREC2 CONTAINS BOTH THE MEDIA RECORD LENGTH AND THE DATA RECORD LENGTH. C JREC2=BUF3(7) CALL LNGTH(LU1,ISTAT,JREC2,JREC,K,BUFR) IF (ISTAT .NE. 0) RETURN ENTRY(1)=2H** ENTRY(2)=2H** C************************************************************** C WRITE OUT A FILEHEADER. C CALL FLHD2(LU1,TAPE,NAME,FILENO,JREC,ENTRY,ISTAT) IF (ISTAT .NE. 0) RETURN FILENO=FILENO+1 C************************************************************** C SET UP A DATAHEADER ( NO WRITE TO TAPE), INDEX POINTS TO LAST C WORD IN THE HEADER. C CALL DTHD2(LU1,NAME,BUFR,BUFSZ,HDSZ,ISTAT) IF (ISTAT .NE. 0) RETURN C**************************************************************** C INITIALIZE DATA SET TO FIRST SEQUENTIAL RECORD. C CALL DBGET(NAME,3,ISTAT,IDUMY,0) IF (ISTAT(1) .NE. 0) GO TO 9000 C**************************************************************** C INIT SOME THINGS AND FILL UP BUFR. C 100 EOF=.FALSE. INDEX=HDSZ CALL FILL2(LU1,IBASE,K,BUFR,BUFSZ,INDEX,JREC,EOF,ISTAT) IF (ISTAT .NE. 0) RETURN C************************************************************* C IF YOU DIDN'T GET ANY DATA FROM FILL2, YOURE DONE WITH THIS SET. C IF (INDEX .EQ. HDSZ) GO TO 2000 C*qˆ������þú************************************************************** C WRITE BUFR OUT TO TAPE. C CALL TAPEW(LU1,TAPE,BUFR,INDEX,ISTAT) IF (ISTAT .NE. 0) RETURN IF (EOF) GO TO 2000 GO TO 100 C************************************************************ C FINISHED WITH THIS DATA SET. C 2000 CALL TAPEW(LU1,TAPE,DUMMY,0,ISTAT) RETURN C*************************************************************** C ERROR POINTS FOLLOW. C C ERROR ON DBINF CALL. C 8900 CONTINUE ISTAT=BUF3(1) 9000 CALL DBER2(LU1,ISTAT,6HXXXXXX,6HSETW2 ,2HXX) IERR=-ISTAT RETURN END C C C C C*********************************************************** C THIS VERSION IS FOR THE DBUP PROGRAM. 1-3-79. C*********************************************************** SUBROUTINE FILL2(LU1,IBASE,K,BUFR,BUFSZ,INDEX,JREC,EOF,IERR) +,92069-16130 REV.1912 790126 C****************************************************************** C FILL2 FILLS BUFR WITH AS MUCH DATA FROM DATA SET K AS POSSIBLE C WITHOUT EXCEEDING BUFSZ. C 11-7-78 MAKE SURE THAT JREC PASSED IN IS ONLY THE DATA LENGTH C AND DOESN'T INCLUDE THE MEDIA RECORD LENGTH. C C INDEX=MOVING INDEX OF LAST SPOT FILLED IN BUFR. C JREC = RECORD LENGTH OF DATA RECORD, NOT INCLUDING MEDIA RECORD. C JREC2= TOTAL LENGTH OF RECORD INCLUDING MEDIA RECORD. C EOF = RETURNED TRUE WHEN EOF IS FOUND. C K = DATA BASE SET NUMBER YOURE EXTRACTING DATA FROM. C IERR = 0 IF NORMAL RETURN, .NE. 0 IF ERROR RETURN. C****************************************************************** INTEGER LU1,IBASE(1),K,BUFR(1),BUFSZ,INDEX,JREC,IERR LOGICAL EOF INTEGER ISTAT(10) INTEGER NAME(3) C***************************************************************** C GET TOTAL RECORD LENGTH INTO JREC2. C CALL DBINF(2HS ,2,K,ISTAT) IF (ISTAT(1) .NE. 0) GO TO 9100 NAME(1)=ISTAT(2) NAME(2)=ISTAT(3) NAME(3)=ISTAT(4) JREC2=ISTAT(7) IOFF=JREC2³ð������þú-JREC C****************************************************************** C CHECK IF NOT EVEN ONE RECORD FITS. C D IF (JREC2 .GT. BUFSZ-INDEX) D +CALL DBER2(LU1,7777,6HXXXXXX,6HFILL2 ,6HDBUL9 ) C****************************************************************** C START PACKING DATA FROM THE KTH DATA SET INTO BUFR USING SERIAL C READS. SET LIST SO THAT DBGET READS THE ENTIRE RECORD. C 100 CONTINUE CALL DBGET(NAME,2,ISTAT,BUFR(INDEX+1)) IF (ISTAT(2) .EQ. 0) GO TO 9000 IF (ISTAT(1) .NE. 0) GO TO 9100 C************************************************************* C MOVE THE DATA RECORD DOWN TO COVER THE MEDIA RECORD. C DO 200 L=1,JREC BUFR(INDEX+L)=BUFR(INDEX+L+IOFF) 200 CONTINUE C***************************************************************** C BUMP INDEX. C INDEX=INDEX+JREC IF (JREC2 .GT. BUFSZ-INDEX) RETURN GO TO 100 C****************************************************************** C HIT AN EOF ON ONE OF THE READS. C 9000 EOF=.TRUE. IERR=0 RETURN C****************************************************************** C FATAL DBGET ERROR. C 9100 CALL DBER2(LU1,ISTAT,6HXXXXXX,6HFILL2 ,2HXX) IERR=-ISTAT RETURN END C C C C SUBROUTINE LNGTH(LU1,ISTAT,JREC2,JREC,K,BUF3) +,92069-16130 REV.1912 790126 C*************************************************************** C LNGTH RETURNS THE LENGTH OF THE DATA RECORD FOR DATA SET K IN C PARAMETER JREC. BUF3 IS A UTILITY BUFFER AND JREC2 IS PASSED C IN AS THE LENGTH OF THE ENTIRE DATA RECORD (MEDIA + DATA RECORD) C*************************************************************** INTEGER LU1,ISTAT(1),JREC2,JREC,K,BUF3(1) C************************************************************ C GET THE DATA ITEM NUMBERS OF ITEMS IN SET K. C CALL DBINF(2HI ,1,K,BUF3) IF (BUF3(1) .NE. 0) GO TO 9000 ITEM1=IABS(BUF3(3)) C********************************************************* ×������þúC FIND THE OFFSET OF THE FIRST ITEM. C CALL DBINF(2HI ,2,ITEM1,BUF3) IF (BUF3(1) .NE. 0) GO TO 9000 IOFF=BUF3(8) JREC=JREC2-IOFF+1 RETURN C******************************************************** C ERROR POINT C 9000 CONTINUE ISTAT=BUF3(1) CALL DBER2(LU1,ISTAT,6HXXXXXX,6HLNGTH ,2HXX) RETURN END C C C C C********************************************************* C IMPORTANT NOTE: THIS IS A SPECIALIZED TAPEW THAT SHOULD ONLY C BE RELOCATED WITH DBUP. IT IS NOT THE SAME TAPEW THAT APPEARS C IN THE 92069 IMAGE LIBRARY. C****************************************************** SUBROUTINE TAPEW(LU1,TAPE,BUFR,BUF1,IERR) +,92069-16130 REV.1912 790305 C******************************************************************** C TAPEW WRITES DATA TO TAPE FROM BUFR. TAPEW ASSUMES THAT TDCB C (IN NAMED COMMON) IS OPEN TO TAPE AS A TYPE 0 FILE IF TAPE IS A MAG C TAPE LU, OR AS A TYPE 1 FILE IF TAPE IS A DISC FILE. C C TAPEW CHECKS FOR AN EOF AT THE END OF EACH WRITE, AND PROMPTS THE C USER TO MOUNT A NEW TAPE AT EOT, OR ABORTS AT THE END OF A TYPE 1 C FILE. C IF AN EOT OCCURS, THE RECORD IS WRITTEN ON THIS TAPE, NOT THE C NEW TAPE. THEN TAPEW WRITES AN EOF ON THE TAPE AND CALLS EOTWR C TO PROMPT FOR A NEW TAPE. C********************************************************************* C NAMED COMMON DECLARATIONS C INTEGER HDR(24),TDCB(144),TDSZ,P5(6) COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C******************************************************************** C FORMAL PARAMETERS. C INTEGER LU1,TAPE(1),BUFR(1),BUF1,IERR C********************************************************************* C INTEGER BUFL C BUFL=BUF1 C IF (IFBRK(IDUMY)) 9876,300 C********************************************************************* C FOR A 0-LENGTH RECORD TO A TAPE LU, HAVE TO WRITE AN EOF(LENGTH -1) C 300 IF ((BUFL .EQ. 0) .AND. (TAPE(4) .EQ. 1)) BUFL=-1 C***********-¿������þú****************************************************** C WRITE BUFR TO TAPE USING TDCB. C D WRITE(LU1,400) BUFL,(BUFR(L),L=1,30) D400 FORMAT(//"TAPEW: LEN=",I6,4X,12A2,/,18O8) CALL WRITF(TDCB,IERR,BUFR,BUFL) C******************************************************** C TRAP OUT AN EOF ON A TYPE 3 FILE. C IF ((IERR .EQ. -6) .OR. (IERR .EQ. -33)) GO TO 4000 CALL DBER2(LU1,IERR,TAPE,6HTAPEW ,2HXX) IF (TAPE(4) .NE. 1) RETURN C***************************************************************** C SPECIAL CHECK FOR AN EOT ON THE TAPE DEVICE. C 2000 IA=IEOT(TAPE) IF (IA .GE. 0) RETURN C************************************************************ C END OF TAPE ON A TAPE DEVICE. C WRITE EOF ON THIS TAPE(THE RECORD HAS BEEN WRITTEN OVER THE EOT MARK). C CALL EOTWR TO REQUEST NEW TAPE. C RETURN,KNOWING THAT THE NEW TAPE IS READY FOR NEXT WRITE. C CONTINUE CALL WRITF(TDCB,IERR,IDUMY,-1) CALL DBER2(LU1,IERR,TAPE,6HTAPEW ,2HXX) IF (IERR .LT. 0) RETURN CALL EOTWR(LU1,TAPE,HDR,TDCB,TDSZ,P5,IERR) RETURN C********************************************************* C TRAP FOR THE EOF ON A TYPE 3 FILE. C PERFORM THESE STEPS: C 1) CALL EOFWR TO CLOSE THE CURRENT FILE, THEN REQUEST AND OPEN C THE NEW FILE, WRITE A TAPE HEADER. C 2) GO TO THE TOP TO WRITE THE DATA RECORD INTO THE NEW FILE. C 4000 CONTINUE IF (TAPE(4) .NE. 3) CALL DBER2(LU1,7777,6HXXXXXX,6HTAPEW ,2HAB) CALL EOFWR(LU1,TAPE,HDR,TDCB,TDSZ,P5,IERR) IF (IERR .NE. 0) RETURN GO TO 300 C***************************************************************** C USER ENTERED BREAK COMMAND. C 9876 CONTINUE IERR=-247 CALL DBER2(LU1,IERR,6HXXXXXX,6HTAPEW ,2HXX) RETURN END C C C C SUBROUTINE EOTWR(LU1,TAPE,HDR,TDCB,TDSZ,P5,IERR) +,92069-16130 REV.1912 790126 C************************************************************* C EOTWR HANDLES AN EOT FOR A MAG TAPE LU. C C EOTWR ^i������þúASSUMES THAT THE HEADER PASSED IN IN HDR STILL HAS THE C REEL NUMBER OF THE OLD TAPE REEL IN HDR(21). C C IF P5=AB, A NEGATIVE ERROR IS RETURNED IN IERR. C IF P5 .NE. AB, THE USER IS PROMPTED ON LU1 TO MOUNT A NEW TAPE. C************************************************************** C FORMAL PARAMETERS C INTEGER LU1,TAPE(1),HDR(1),TDCB(1),TDSZ,P5,IERR C******************************************************** C LOCAL VARIABLES. C INTEGER RESPON C************************************************************** C IF (TAPE(4) .NE. 1) CALL DBER2(LU1,7777,6HXXXXXX,6HEOTWR ,2HAB) IF (P5 .EQ. 2HAB) GO TO 9000 C************************************************************ C REQUEST NEW TAPE BE MOUNTED. C WRITE(LU1,2510) TAPE,(HDR(L),L=9,11),HDR(21) 2510 FORMAT(//"SAVE TAPE ON LOGICAL DEVICE ",I3," AS ",3A2,1X,I3) 2525 WRITE(LU1,2520) TAPE 2520 FORMAT(/"MOUNT NEXT REEL ON LOGICAL DEVICE ",I3) CALL READY(LU1,RESPON,IERR) IF (IERR .LT. 0) GO TO 9000 C************************************************************* C BY HERE, YOU KNOW THE USER HAS MOUNTED NEW TAPE AND TYPED YES. C CHECK THAT THE NEW TAPE IS ALL SET TO GO. C CALL TLOCL(LU1,TAPE,IERR) IF (IERR .LT. 0) RETURN CALL RING(LU1,TAPE,2HXX,IERR) IF (IERR .LT. 0) RETURN C*********************************************************** C CHECK THAT YOU'RE AT LOAD POINT. C CALL SOT(LU1,TAPE,P5,IERR) IF (IERR .LT. 0) GO TO 9000 C*************************************************** C BY HERE, YOU KNOW THAT NEW TAPE HAS BEEN MOUNTED. C 3000 CONTINUE IERR=0 HDR(21)=HDR(21)+1 CALL WRITF(TDCB,IERR,HDR,24) CALL DBER2(LU1,IERR,TAPE,6HEOTWR ,2HXX) D WRITE(LU1,3005)(HDR(L),L=1,24) D3005 FORMAT(/"EOTWR:",12A2,/,12O8) RETURN C************************************************************ C ABORT AT EOT. C 9000 WRITE(LU1,9005) 9005 FORMAT(/"ABORTING AT END OF TAPE.") CALL DBER2(LU1,2ß ������þú36,6HXXXXXX,6HEOTWR ,2HXX) C REWIND THE TAPE AND DESTROY IT.(USER MAY HAVE REMOVED IT.) IERR=-236 RETURN END C C C C SUBROUTINE EOFWR(LU1,TAPE,HDR,TDCB,TDSZ,P5,IERR) +,92069-16130 REV.1912 790126 C**************************************************************** C EOFWR HANDLES AN EOF ON A WRITE TO A TYPE 3 FILE. C EOFWR DOES THESE STEPS: C 1) CALLS LOCF TO DETERMINE THE NEXT AVAILABLE RECORD (EOFWR C ASSUMES THAT LOCF RETURNS THE NEXT AVAILABLE RECORD IF THE C LAST WRITE RETURNED AN ERROR I.E. THAT THE LAST THING EWRIT DOES C IS UPDATE THE INFORMATION ON THE RECORD NUMBER). C 2) POSITIONS THE FILE TO THE NEXT AVAILABLE RECORD NUMBER. C 3) WRITES AN EOF MARK IN THIS POSITION, AND CLOSES THE FILE. C 4) PROMPTS THE USER FOR ANOTHER FILE NAME. C 5) CREATES A NEW FILE WITH THE NAME AND CARTRIDGE SPECIFIED THAT C TAKES UP THE ENTIRE REST OF THE CARTRIDGE (A DIFFERENT CARTRIDGE C THAN THE PREVIOUS ONE SINCE THERE'S NO ROOM LEFT ON THAT ONE.) C 6) OPENS THE FILE AND WRITES A TAPE HEADER INTO THE FILE. C***************************************************************** INTEGER LU1,TAPE(1),HDR(1),TDCB(1),TDSZ,P5,IERR C***************************************************************** C LOCAL VARIABLES. C INTEGER IREC(2) INTEGER FILE(20) DOUBLE PRECISION MESS1(6) INTEGER MESS2(18) EQUIVALENCE(MESS1,MESS2) C****************************************************************** C DATA STATEMENTS DATA MESS1/6H SAVE ,6HFILE ,6H ,6H AS ,6H ,6H / C****************************************************************** IF (TAPE(4) .NE. 3) CALL DBER2(LU1,7777,6HXXXXXX,6HEOFWR ,2HXX) C******************************************************************* C CALL LOCF TO GET WHERE THE LAST WRITE WAS ATTEMPTED. C CALL LOCF(TDCB,IERR,IREC) CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) C***************************************************************** C s2������þúPOSITION THE FILE TO WHERE THE WRITE SHOULD HAVE OCCURRED. C CALL RWNDF(TDCB,IERR) CALL POSNT(TDCB,IERR,IREC,1) CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) C************************************************************ C WRITE OUT AN EOF. C CALL WRITF(TDCB,IERR,IDUMMY,-1) CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) CALL POST(TDCB,IERR) CALL CLOSE(TDCB,IERR) CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) IF (IERR .LT. 0) RETURN C****************************************************************** C TELL USER TO REMEMBER THE OLD FILE. C MESS2(7)=TAPE(1) MESS2(8)=TAPE(2) MESS2(9)=TAPE(3) MESS2(13)=HDR(9) MESS2(14)=HDR(10) MESS2(15)=HDR(11) CALL CNUMD(HDR(21),MESS2(16)) CALL EXEC(2,LU1,MESS1,18) C******************************************************************* C REQUEST THE NEXT FILE NAME. C 1000 CALL EXEC(2,LU1,34HNEXT STORAGE FILE(AB TO ABORT) ? _,17) CALL REIO(1,LU1+400B,FILE,20) CALL ABREG(IA,IB) LNGTH2=2*IB IF ((LNGTH2 .EQ. 2) .AND. (FILE(1) .EQ. 2HAB)) GO TO 9000 ISTRC1=1 CALL PRAM(LU1,FILE,LNGTH2,ISTRC1,TAPE) IF (TAPE(4) .EQ. 3) GO TO 2000 CALL EXEC(2,LU1,28HPLEASE SPECIFY A FILE NAME. ,14) GO TO 1000 C************************************************************** C HAVE A GOOD FILE NAME. MAKE A NEW FILE AND OPEN IT. C 2000 CONTINUE CALL NWFIL(LU1,IERR,TDCB,TDSZ,TAPE,-1,3,P5) IF (IERR .LT. 0) GO TO 1000 IOPTN=100B CALL OPENF(TDCB,IERR,TAPE,IOPTN,TAPE(5),TAPE(6),TDSZ) IF (IERR .GT. 0) IERR=0 CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) IF (IERR .LT. 0) GO TO 1000 C*************************************************************** C WRITE OUT A TAPE HEADER ON THE NEW FILE. C HDR(21)=HDR(21)+1 CALL WRITF(TDCB,IERR,HDR,24) CALL DBER2(LU1,IERR,TAPE,6HEOFWR ,2HXX) RETURN C*************************************************—������þú**************** C ABORT POINT. C 9000 CONTINUE IERR=-235 CALL EXEC(2,LU1,24HABORTING AT END OF FILE.,12) CALL DBER2(LU1,235,TAPE,6HEOFWR ,2HXX) RETURN END C C C C PROGRAM DBUP9(5,90) +,92069-16130 REV.1912 790317 C******************************************************************* C DBUP9 CLOSES THE DATA BASE. C******************************************************************* C COMMON DECLARATIONS. C INTEGER LU1(6),TAPE(6),ROOT(6),LVLWD(6),P5(6) INTEGER BUF1(256),BUF1SZ INTEGER LENGTH INTEGER IBASE(12) INTEGER HDR(24) COMPLEX HDR1(6) EQUIVALENCE (HDR,HDR1) INTEGER TDCB(144),TDSZ COMMON LU1,TAPE,ROOT,LVLWD COMMON BUF1,BUF1SZ COMMON LENGTH COMMON IBASE COMMON/TPHDR/HDR,TDCB,TDSZ,P5 C***************************************************************** C LOCAL VARIABLES. C INTEGER ISTAT(10) INTEGER REC,XIRB,IOFF,SECTRS,JLU,JTY,JREC,ITRUNC C************************************************************ C IF THE SCHEDULING PARAMETER IS 1, PURGE THE STORAGE FILE. C CALL RMPAR(ISTAT) IFLAG=ISTAT(1) ISTAT=0 C***************************************************************** C CLOSE THE DATA BASE C CALL DBCLS(0,ISTAT) CALL DBER2(LU1,ISTAT,ROOT,6HDBUP9 ,2HXX) IF (IFLAG .EQ. 1) GO TO 9000 C************************************************************* C CALCULATE THE NUMBER OF BLOCKS TO ITRUNCATE FROM THE STORAGE FILE. C FOR A TYPE 0 FILE, ITRUNC IS IGNORED. C CALL LOCF(TDCB,IERR,REC,XIRB,IOFF,SECTRS,JLU,JTY,JREC) ITRUNC=SECTRS/2-XIRB-1 IF (TAPE(4) .EQ. 3) CALL CLOSE(TDCB,IERR,ITRUNC) IF (TAPE(4) .EQ. 1) CALL CLOSE(TDCB) IF (IERR .GE. 0) IERR=0 IF (IERR .EQ. -11) GO TO 9999 CALL DBER2(LU1,IERR,TAPE,6HDBUP9 ,2HXX) GO TO 9999 C************************************************************* C PURGE THE STORAGE FILE. C eê���l��jf9000 CONTINUE IF (TAPE(4) .EQ. 3) CALL PURGE(TDCB,IERR,TAPE,TAPE(5),TAPE(6)) GO TO 9999 9999 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������R±l������ÿÿ����� ���� ÿý�¬�à ���������ÿ��92069-18131 2026� S C0122 �A92069 �92069A SNC � � � � � � � � � � � � �H0101 Úé�����þú A92069 SOF NUM CAT REV 2026 (92069-18999) MODULE DESCRIPTION DATE CODE PART NUMBER MEDIUM P/N %BAIMX BASIC/IMAGE INTERFACE 2026 92069-16255 92069-13303 %DBBLX DBBLD - DATA BASE BUILD 1912 92069-16001 92069-13304 %DBCOP DATA BASE COORDINATING PROGRAM 1912 92069-16256 92069-13305 %DBDSX DBDS - SCHEMA PROCESSOR 2026 92069-16015 92069-13304 %DBLOX DBLOD - DATA BASE LOAD 2013 92069-16128 92069-13306 %DBMS IMAGE LOCAL SUBROUTINES 2026 92069-12002 92069-13301 %DBRSX DBRST - DATA BASE RESTORE 2013 92069-16126 92069-13304 %DBSPX DBSPA - DATA BASE SPACE UTILITY 1912 92069-16133 92069-13306 %DBSTX DBSTR - DATA BASE STORE 2013 92069-16125 92069-13304 %DBULX DBULD - DATA BASE UNLOAD 2013 92069-16127 92069-13306 %LOCAL LOCAL ONLY LIBRARY 1912 92069-12006 92069-13305 %NO/DS STUB LIBRARY 1912 92069-12005 92069-13305 %QRYX2 QUERY SUBROUTINES 2026 92069-16061 92069-13303 %QURYX QUERY SEGMENTS 2026 92069-16060 92069-13302 %RDBA IMAGE REMOTE LIBRARY 1912 92069-12003 92069-13305 %RDBAM REMOTE MONITOR 1912 92069-16258 92069-13305 %RDBAP REMOTE ACCESS PROGRAM 1912 92069-16259 92069-13305 %RD.TB REMOTE TABLE 1912 92069-16257 92069-13305 %RECVX RECOV - RECOVER UTILITY 1912 92069-16134 92069-13306 %REMOT RMT ONLY LIBRARY 1912 92069-12004 92069-13305 *DBUP UPGRADE UTILITY 1912 92069-12001 92069-13306 QSHELP QUERY HELP FILE 1912 92069-16122 92069-13303 ����������������������������������������������������������������������������������������������������������������������������������������������AÍ��� ���� �������� �������ÿÿ����� ���� ÿý�­�´ ���������ÿ��92069-18132 1912� S C0122 �&LOCHD �LOCHD SOURCE � � � � � � � � � � � � �H0101 |]�����ASMB HED HEADER FOR %LOCAL NAM LOCAL,7 92069-12006 REV.1912 790430 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18132 * RELOC: 92069-16132 * * PRGMR: CEJ * * ******************************************************************* * * END ����������������������������������������������������������������������������������������������������������uè������ÿÿ����� ���� ÿý�®�´ ���������ÿ��92069-18133 1912� S C0122 �&DBSPX �DBSPX SOURCE � � � � � � � � � � � � �H0101 ”t�����þúFTN4,L,C PROGRAM DBSPA(4,90),92069-16133 REV.1912 790130 C C C****************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18133 C RELOC: 92069-16133 C C PRGMR: CEJ C C C****************************************************************** C C C C C DATA BASE SPACE IS A UTILITY PROGRAM FOR IMAGE/1000 WHICH REPORTS THE C STATUS OF ANY DATA SET ACCESSIBLE BY THE USER INITIATING DBSPA. THE C REPORTED BY DBSPA INCLUDES THE CAPACITY OF THE DATA SET AND THE NUMBER C OF FREE RECORDS IN THE DATA SET AS DEFINED BY THE ROOT FILE. THE NUM- C BER OF USED RECORDS WHICH ACTUALLY EXIST IN THE DATA SET, AND THE DIF- C FERENCE BETWEEN THE CAPACITY OF THE DATA SET AND THE SUM OF ITS FREE C AND USED RECORDS. A NON-ZERO DIFFERENCE SHOWN FOR ANY OF THE DATA SETS C MAY INDICATE THAT THE DATA BASE IS CORRUPT AND SOME FORM OF RECOVERY C OF THE DATA BASE SHOULD BE ATTEMPTED. C C THE USER INITIATES DBSPA WITH THE COMMAND: C C :RU,DBSPA[,INPUT[,OUTPUT[,ROOT FILE NAMR[,LEVEL CODE WORD]]]] C C WHERE: C INPUT C IS THE LU OF THE DEVICE TO BE USED FOR ANY FURTHER INPUT NECESSARY C TO DBSPA. DEFAULT IS THE SCHEDULING LU. C C OUTPUT C IS THE LU OF THE DEVICE TO BE USED BY DBSPA FOR OUTPUT. DEFAULT C IS THE INPUT LU, IF INTERACTIVE, ELSE LU 6. C C ROOT FILE NAMR C IS THE FMP NAMR FOR THE ROOT FILE OF THE DATA BASE WHOSE STATUS C IS TO BE REPORTED. NO DEFAULT. C C LEVEL CODE WORD C IS THE USER'S LEVEL CODE WORD FOR THE DATA BASE. NO DEFAULT. C C IF EITHER, OR BOTH, OF THE LATTER TWO PARAMETERS ARE OMITTED, DBSPA C WILL EXPECT THEM FROM T«ë������þúHE INPUT DEVICE. IF THE INPUT DEVICE IS INTER- C ACTIVE, DBSPA WILL PROMPT THE USER FOR INPUT WITH: C C /DBSPA: ROOT FILE NAMR? C C AND/OR C C /DBSPA: LEVEL CODE WORD? C C ANY ERRORS ENCOUNTERED BY DBSPA WILL BE LOGGED ON THE INPUT DEVICE, C IF INTERACTIVE, ELSE LU 1. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SAMPLE OUTPUT. C CCCCC C C GOOD STATUS: C CCCCC C C IMAGE/1000 DATA BASE SPACE UTILITY C C DATA SET NAME CAPACITY FREE RECORDS RECORDS USED DIFFERENCE C ------------- -------- ------------ ------------ ---------- C C GOOD 1001 984 17 0 C BAD 1001 984 17 0 C UGLY 50 40 10 0 C C END DBSPA C CCCCC C C POSSIBLY BAD STATUS: C CCCCC C C IMAGE/1000 DATA BASE SPACE UTILITY C C DATA SET NAME CAPACITY FREE RECORDS RECORDS USED DIFFERENCE C ------------- -------- ------------ ------------ ---------- C C GOOD 1001 985 17 -1 C BAD 1001 984 16 1 C UGLY 50 40 10 0 C C DATA BASE MAY NOT BE GOOD C C END DBSPA C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DIMENSION IBUF(350),IBASE(11),LEVEL(3),ISTAT(10) DIMENSION URECS(50),DIFF(50),IOUTB(36) DIMENSION IHED1(36),IHED2(36),IWARN(13),IEND(5) DIMENSION IOERR(15),LKERR(17),IGTER(20),IOPER(15) DIMENSION IDSER(25) C INTEGER OUTLU LOGICAL IFTTY C COMMON IBUF,NSETS,IBASE COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG COMMON IOUTB C EQUIVALENCE (IDUM,LEVEL),(NAME,IOUTB(3)) C DATA MAXLN/-80/,IOUTL/-72/,IBLNK/2H / )‚������þú DATA IHED1/2H D,2HAT,2HA ,2HSE,2HT ,2HNA,2HME,2H ,2H ,2HCA, 2 2HPA,2HCI,2HTY,2H ,2H ,2HFR,2HEE,2H R,2HEC,2HOR, 3 2HDS,2H ,2H ,2HRE,2HCO,2HRD,2HS ,2HUS,2HED,2H , 4 2H ,2HDI,2HFF,2HER,2HEN,2HCE/ DATA IHED2/2H -,2H--,2H--,2H--,2H--,2H--,2H--,2H ,2H ,2H--, 2 2H--,2H--,2H--,2H ,2H ,2H--,2H--,2H--,2H--,2H--, 3 2H--,2H ,2H ,2H--,2H--,2H--,2H--,2H--,2H--,2H , 4 2H ,2H--,2H--,2H--,2H--,2H--/ DATA IWARN/2H D,2HAT,2HA ,2HBA,2HSE,2H M,2HAY,2H N,2HOT, 2 2H B,2HE ,2HGO,2HOD/ DATA IWRNL/13/ DATA IEND/2H E,2HND,2H D,2HBS,2HPA/ DATA IENDL/5/ DATA IOERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HOU, 2 2HTP,2HUT,2H: ,2H ,2H / DATA IOELN/15/ DATA LKERR/2H/D,2HBS,2HPA,2H -,2H U,2HNA,2HBL,2HE ,2HTO,2H L, 2 2HOC,2HK ,2HOU,2HTP,2HUT,2H L,2HU / DATA LKERL/17/ DATA IGTER/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H: ,2H ,2H , 2 2H ,2HON,2H D,2HAT,2HA ,2HSE,2HT ,2H ,2H ,2H / DATA IGTLN/20/ DATA IOPER/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H: ,2H ,2H , 2 2H ,2HON,2H D,2HBO,2HPN/ DATA IOPLN/15/ DATA IDSER/2H/D,2HBS,2HPA,2H -,2H U,2HNA,2HBL,2HE ,2HTO,2H O, 2 2HBT,2HAI,2HN ,2HIN,2HFO,2HRM,2HAT,2HIO,2HN ,2HON, 3 2H D,2HAT,2HA ,2HSE,2HTS/ DATA IDSLN/25/ DATA ICAPC/9/,IFREE/16/,IUSED/24/,IDIF/32/ C C C GET THE SCHEDULING PARAMETERS AND THE LENGTH OF THE PARAMETER STRING C IN POSITIVE BYTES. C CALL GETST(IBUF,MAXLN,LOGLN) C C ASK PARST TO PARSE THE PARAMETERS STRING. IT CAN CONTAIN UP TO FOUR C PARAMETERS WHICH ARE: C 1) INPUT LU C 2) OUTPUT LU C 3) DATA BASE ROOT FILE NAMR C 4) USER'S LEVEL CODE WORD C PARST STORES THESE PARAMETERS RESPECTIVELY IS: C 1) INLU C 2) OUTLU C .N������þú 3) IBASE C 4) LEVEL C IT WILL DEFAULT THE FIRST TWO IF UNSPECIFIED, AND PROMPT FOR THE LATTER C TWO IF UNSPECIFIED. IN ADDITION, PARST SETS UP THE VARIABLE LULOG TO C CONTAIN THE PROPER LU FOR ERROR MESSAGE LOGGING. IF IT ENCOUNTERS ANY C ERROR, PARST RETURNS A NON-ZERO VALUE IN ISTAT; >0 IF AN ILLEGAL LU C NUMBER SPECIFIED IN RUN STRING; <0 FOR ANY OTHER ERROR. C CALL PARST(ISTAT) IF (ISTAT(1).LT.0) GO TO 900 IF (ISTAT(1).GT.0) GO TO 1000 C C OPEN THE DATA BASE. TRY IT FIRST WITH MODE 1, IF THAT DOESN'T WORK, C TRY IT WITH MODE 8. IF NEITHER WORK, GIVE UP. C MODE=1 10 CALL DBOPN(IBASE,LEVEL,MODE,ISTAT) IF (ISTAT(1).EQ.0) GO TO 25 IF (MODE.EQ.8) GO TO 7000 IF (ISTAT(1).NE.152) GO TO 7000 MODE = 8 GO TO 10 C C GET THE NUMBER OF DATA SETS THE USER HAS ACCESS TO AND ALL THEIR CAPA- C CITIES THROUGH GETSZ. IT RETURNS THIS INFORMATION IN IBUF IN THE FOL- C LOWING FORMAT: C WORD +------------------------------+ C 1 | DOUBLE WORD NUMBER OF FREE | C 2 | RECORDS IN FIRST DATA SET | C -------------------------------- C 3 | FIRST DATA | C 4 | SET'S | C 5 | NAME | C -------------------------------- C 6 | DOUBLEWORD CAPACITY OF | C 7 | FIRST DATA SET | C -------------------------------- C . . C . . C . . C -------------------------------- C N*7-6 | DOUBLEWORD NUMBER OF FREE | C N*7-5 | RECORDS IN NTH DATA SET | C -------------------------------- C N*7-4 | NTH DATA ªw������þú | C N*7-3 | SET'S | C N*7-2 | NAME | C -------------------------------- C N*7-1 | DOUBLEWORD CAPACITY OF | C N*7 | NTH DATA SET | C +------------------------------+ C C WHERE N IS THE NUMBER OF DATA SETS THE USER HAS ACCESS TO. THERE IS C A MAXIMUM OF 50 DATA SETS. GETSZ RETURNS THE NUMBER OF DATA SETS C DESCRIBED IN IBUF IN NSETS. IF IT ENCOUNTERS ANY ERROR, GETSZ RETURNS C A NON-ZERO VALUE IN ISTAT. C 25 CALL GETSZ(ISTAT) IF (ISTAT(1).NE.0) GO TO 5000 IF (NSETS.LE.0) GO TO 5000 C C SET UP A LOOP, FOR EACH DATA SET ACCESSIBLE BY THE USER, TO DETERMINE C THE NUMBER OF USED RECORDS IN THE DATA SET. THIS NUMBER IS DETERMINED C BY DOING SERIAL READS ON THE DATA SET, COUNTING EACH RECORD RETURNED C AS A USED RECORD. C DO 100 I=1,NSETS URECS(I) = 0 50 CALL DBGET(IBASE,IBUF(I*7-4),2,ISTAT,0,IDUM,IDUM) IF (ISTAT(1).EQ.12) GO TO 100 IF (ISTAT(1).NE.0) GO TO 4000 URECS(I) = DAD(URECS(I),DBLEI(1)) GO TO 50 100 CONTINUE C C SET UP A LOOP, FOR EACH DATA SET ACCESSIBLE BY THE USER, TO DETERMINE C THE DIFFERENCE BETWEEN THE CAPACITY OF THE DATA SET AND THE SUM OF THE C NUMBER OF FREE RECORDS PLUS THE NUMBER OF USED RECORDS. IF ANY OF THE C DATA SET RECORDS DO NOT ADD UP, THEN SET A FLAG INDICATING POSSIBLE C CORRUPT DATA BASE. C IFLAG = 0 DO 200 I=1,NSETS DIFF(I) = DSB(IBUF(I*7-1),DAD(IBUF(I*7-6),URECS(I))) IF (DCO(DIFF(I),DBLEI(0))) 60,70,60 60 IFLAG = -1 70 CONTINUE 200 CONTINUE C C SET UP TO PRINT OUT THE ATTAINED INFORMATION. FIRST, FILL THE OUTPUT C BUFFER WITH BLANKS, THEN LOCK THE OUTPUT LU IF IT IS NOT A TTY-LIKE C DEVICE, AND FINALLY, PRINT OUT THE HEADER: C C DATA SET NAME CAPACITY FREE RECORDS RECOäÑ������þúRDS USED DIFFERENCE C ------------- -------- ------------ ------------ ---------- CALL SFILL(IOUTB,1,-IOUTL,IBLNK) IF (IFTTY(OUTLU)) GO TO 300 CALL LURQ(40001B,OUTLU,1) GO TO 3000 300 CALL EXEC(100002B,OUTLU,IHED1,IOUTL) GO TO 2000 310 CALL EXEC(100002B,OUTLU,IHED2,IOUTL) GO TO 2000 320 CALL EXEC(100002B,OUTLU,IBLNK,1) GO TO 2000 C C LOOP ON EACH DATA SET PRINTNG OUT: C 1) THE DATA SET'S NAME C 2) THE DATA SET'S CAPACITY C 3) THE NUMBER OF FREE RECORDS IN THE DATA SET C 4) THE NUMBER OF USED RECORDS IN THE DATA SET C 5) THE CALCULATED DIFFERENCE C AFTER EACH SET OF FIVE DATA SETS A BLANK LINE IS PRINTED FOR READABILITY. C 330 DO 500 I=1,NSETS C MOVE NAME INTO OUTPUT BUFFER CALL SMOVE(IBUF(I*7-4),1,6,NAME,1) C CONVERT CAPACITY INTO ASCII AND PUT INTO OUTPUT BUFFER. CALL CNVRT(IBUF(I*7-1),ICAPC) C CONVERT FREE RECORDS TO ASCII AND PUT INTO OUTPUT BUFFER. CALL CNVRT(IBUF(I*7-6),IFREE) C CONVERT USED RECORDS TO ASCII AND PUT INTO OUTPUT BUFFER. CALL CNVRT(URECS(I),IUSED) C CONVERT DIFFERENCE TO ASCII AND PUT INTO OUTPUT BUFFER. CALL CNVRT(DIFF(I),IDIF) C WRITE THIS DATA SET'S INFORMATION OUT. CALL EXEC(100002B,OUTLU,IOUTB,IOUTL) GO TO 2000 C AFTER FIFTH DATA SET, IN A ROW, WRITE A BLANK LINE. 400 IF (MOD(I,5).NE.0) GO TO 500 CALL EXEC(100002B,OUTLU,IBLNK,1) GO TO 2000 500 CONTINUE C C DONE WITH ALL DATA SET. IF IFLAG IS NON-ZERO, PRINT THE WARNING: C C DATA BASE MAY NOT BE GOOD - TRY PROGRAM 'RECOV' C IF (IFLAG.EQ.0) GO TO 700 CALL EXEC(100002B,OUTLU,IBLNK,1) GO TO 2000 550 CALL EXEC(100002B,OUTLU,IWARN,IWRNL) GO TO 2000 C C UNLOCK THE OUTPUT DEVICE, CLOSE THE DATA BASE, PRINT THE STOP MESSAGE: C C END DBSPA C C AND TERMINATE. C 700 CALL LURQ(100000B,OUTLU,1) 800 CALL DBCLS(IBASE,IDUM,1,i*������þúISTAT) 900 CALL EXEC(2,OUTLU,IBLNK,1) CALL EXEC(2,OUTLU,IEND,IENDL) 1000 STOP C C ERROR HANDLERS. C C OUTPUT ERROR. PRINT MESSAGE: C C /DBSPA - ERROR ON OUTPUT: AABB C WHERE AABB IS THE CONTENTS OF THE A & B REGISTERS FROM THE C EXEC WRITE CALL RESPECTIVELY. C 2000 CALL ABREG(IOERR(14),IOERR(15)) CALL EXEC(100002B,LULOG,IOERR,IOELN) GO TO 2050 2025 GO TO 700 C 2050 CALL EXEC(100002B,1,IOERR,IOELN) GO TO 700 2075 GO TO 700 C C LURQ ERROR. PRINT MESSAGE: C C /DBSPA - UNABLE TO LOCK OUTPUT LU C 3000 CALL EXEC(100002B,LULOG,LKERR,LKERL) GO TO 2000 3010 GO TO 800 C C DBGET ERROR. PRINT MESSAGE: C C /DBSPA - ERROR XXX ON DATA SET YYYYY C WHERE XXX IS THE ERROR CODE PASSED BACK BY DBGET IN ISTAT C AND YYYYY IS THE NAME OF THE DATA SET CURRENTLY BEING READ. C 4000 CALL CNUMD(ISTAT(1),IGTER(8)) DO 4050 J=1,3 IGTER(J+17) = IBUF(I*7-5+J) 4050 CONTINUE CALL EXEC(100002B,LULOG,IGTER,IGTLN) GO TO 2000 4060 GO TO 800 C C NO DATA SET ACCESSIBLE BY USER OR INFORMATION ON SETS UNOBTAINABLE. C PRINT MESSAGE: C C /DBSPA - UNABLE TO OBTAIN INFORMATION ON DATA SET C 5000 CALL EXEC(100002B,LULOG,IDSER,IDSLN) GO TO 2000 5010 GO TO 800 C C DBOPN ERROR. PRINT MESSAGE: C C /DBSPA - ERROR XXX ON DBOPN C WHERE XXX IS THE ERROR CODE PASSED BACK BY DBOPN IN ISTAT. C 7000 CALL CNUMD(ISTAT(1),IOPER(8)) CALL EXEC(100002B,LULOG,IOPER,IOPLN) GO TO 2000 7010 GO TO 900 END C C C SUBROUTINE CNVRT. THIS SUBROUTINE TAKES A DOUBLE WORD INTEGER VALUE C AND CONVERTS IT INTO A 10 CHARACTER ASCII STRING SUPPRESSING LEADING C ZEROES. THE ASCII VALUE IS PUT INTO THE OUTPUT BUFFER FOR DBSPA WITH C THE PROPER SIGN PRECEDING THE FIRST NON-ZERO CHARACTER. NEGATIVE C VALUES ARE PRECEDED BY A NEGATIVE SIGN, POSITIVE WITH A BLANK. C C THE CALLING SEQUENCE FOR CNVRT Ä������þúIS: C C CALL CNVRT(VALUE,INDEX) C C WHERE VALUE C IS THE DOUBLE WORD INTEGER VALUE TO CONVERT C INDEX C IS AN INTEGER INDEX INTO THE OUTPUT BUFFER FOR THE LOCATION AT C WHICH THE CONVERTED STRING IS TO BEGIN C SUBROUTINE CNVRT(VALUE,INDEX) C DIMENSION IOUTB(36),IBUF(350),IBASE(11),LEVEL(3) C INTEGER OUTLU C COMMON IBUF,NSETS,IBASE COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG COMMON IOUTB C C DETERMINE PROPER SIGN FOR ASCII STRING. ALSO, IF THE VALUE IS NEGATIVE, C MAKE IT POSITIVE FOR DCITA. C ISIGN = 40B IF (DCO(VALUE,DBLEI(0))) 10,20,20 10 VALUE = DNG(VALUE) ISIGN = 55B C C ASK DCITA TO DO THE DOUBLE INTEGER TO ASCII CONVERSION AND SET THE C RETURNED VALUE INTO THE PROPER POSITION IN THE OUTPUT BUFFER. THIS C VALUE MAY CONTAIN LEADING ZEROES. C 20 CALL DCITA(VALUE,IOUTB(INDEX)) C C REPLACE ALL LEADING ZEROES WITH BLANKS. C DO 50 I=1,9 CALL SGET(IOUTB(INDEX),I,ICHAR) IF (ICHAR.NE.60B) GO TO 60 CALL SPUT(IOUTB(INDEX),I,40B) 50 CONTINUE I = 9 C C INSERT PROPER SIGN INTO OUTPUT BUFFER. C 60 CALL SPUT(IOUTB(INDEX-1),I+1,ISIGN) RETURN END C C C SUBROUTINE GETSZ. GETSZ BUILDS AN INFORMATION BUFFER FOR DBSPA CON- C SISTING OF THE NAMES OF ALL THE DATA SETS ACCESSIBLE BY THE USER, THEIR C CAPACITIES, AND THE COUNTS OF THEIR FREE RECORDS. THE BUFFER THIS C INFORMATION IS PUT INTO IS IBUF AND THE NUMBER OF DATA SETS DESCRIBED C IN IBUF IS PUT INTO NSETS. THE INFORMATION IN IBUF IS FORMATTED AS C FOLLOWS: C WORD +------------------------------+ C 1 | DOUBLE WORD NUMBER OF FREE | C 2 | RECORDS IN FIRST DATA SET | C -------------------------------- C 3 | FIRST DATA | C 4 | SET'S | C 5 | “|������þú NAME | C -------------------------------- C 6 | DOUBLEWORD CAPACITY OF | C 7 | FIRST DATA SET | C -------------------------------- C . . C . . C . . C -------------------------------- C N*7-6 | DOUBLEWORD NUMBER OF FREE | C N*7-5 | RECORDS IN NTH DATA SET | C -------------------------------- C N*7-4 | NTH DATA | C N*7-3 | SET'S | C N*7-2 | NAME | C -------------------------------- C N*7-1 | DOUBLEWORD CAPACITY OF | C N*7 | NTH DATA SET | C +------------------------------+ C C WHERE N IS THE NUMBER OF DATA SETS THE USER HAS ACCESS TO. THERE IS C A MAXIMUM OF 50 DATA SETS. C C THE CALLING SEQUENCE FOR GETSZ IS: C C CALL GETSZ(ISTAT) C C WHERE ISTAT C IS AN INTEGER VARIABLE IN WHICH A STATUS CODE IS RETURNED C = 0 IF BUFFER SUCCESSFULLY BUILT C <> 0 IF ANY ERROR IS ENCOUNTERED. C SUBROUTINE GETSZ(ISTAT) C DIMENSION IBUF(350),ISTAT(10),IBASE(11),INFO(17) C COMMON IBUF,NSETS,IBASE C EQUIVALENCE (USED,INFO(14)),(CAPAC,INFO(16)) C NSETS = 0 C C GET THE COUNT OF ALL THE DATA SETS THE USER HAS ACCESS TO AND THEIR C RESPECTIVE DATA SET NUMBERS. C CALL DBINF(IBASE,0,203,ISTAT,IBUF(300)) IF (ISTAT(1).NE.0) GO TO 200 IF (IBUF(300).LE.0) GO TO 200 C C FOR EACH DATA SET IN THE LIST, GET ITS NAME, CAPACITY AND NUMBER OF C USED RECORDS. THEN, BUILD THE NEXT ENTRY IN IBUF DETERMINING THE C NUMBER OF FREE RECORDS BY SUBTRACTING THE NUMBER OF USED RECORDS FROM C THE CAPACITY. Á������þúC NSETS = IBUF(300) ICNT = 0 DO 100 I=1,NSETS ISNO = IABS(IBUF(300+I)) CALL DBINF(IBASE,ISNO,202,ISTAT,INFO) IF (ISTAT(1).NE.0) GO TO 200 FREE = DSB(CAPAC,USED) CALL SMOVE(FREE,1,4,IBUF(ICNT*7+1),1) CALL SMOVE(INFO,1,6,IBUF(ICNT*7+3),1) CALL SMOVE(CAPAC,1,4,IBUF(ICNT*7+6),1) ICNT = ICNT + 1 100 CONTINUE NSETS = ICNT 200 RETURN END C C C SUBROUTINE PARST. PARST TAKES THE RUN STRING GIVEN DBSPA AND PARSES C IT INTO ITS CONPONENTS. PARST ALSO RESOLVES ANY UNSPECIFIED PARAMETERS C AND DETERMINES THE LU TO USE IN LOGGING ERROR MESSAGES. THE RUN STRING C CAN CONTAIN UP TO FOUR PARAMETERS WHICH ARE AS FOLLOWS: C 1) INPUT LU C 2) OUTPUT LU C 3) DATA BASE ROOT FILE NAMR C 4) USER'S LEVEL CODE WORD C PARST STORES THESE PARAMETERS RESPECTIVELY IS: C 1) INLU C 2) OUTLU C 3) IBASE C 4) LEVEL C IT WILL DEFAULT THE FIRST TWO IF UNSPECIFIED, AND PROMPT FOR THE LATTER C TWO IF UNSPECIFIED. IN ADDITION, PARST SETS UP THE VARIABLE LULOG TO C CONTAIN THE PROPER LU FOR ERROR MESSAGE LOGGING. C C THE CALLING SEQUENCE FOR PARST IS: C C CALL PARST(ISTAT) C C WHERE ISTAT C IS A VARIABLE IN WHICH A STATUS CODE IS RETURNED C = 0 IF PARSE WAS SUCCESSFUL C > 0 IF AN ILLEGAL LU SPECIFIED IN RUN STRING C < 0 IF ANY OTHER ERROR WAS ENCOUNTERED C SUBROUTINE PARST(ISTAT) C DIMENSION IPBUF(10),IBUF(350),IBASE(11),LEVEL(3),IHEDR(18) DIMENSION INERR(15),INMRE(21),IOERR(15),IRFPT(13),ILCWP(13) DIMENSION ILLUE(10) C INTEGER OUTLU LOGICAL IFTTY C COMMON IBUF,NSETS,IBASE COMMON LOGLN,LEVEL,INLU,OUTLU,LULOG C DATA IBLNK/2H / DATA IHEDR/2H I,2HMA,2HGE,2H/1,2H00,2H0 ,2HDA,2HTA,2H B,2HAS, 2 2HE ,2HSP,2HAC,2HE ,2HUT,2HIL,2HIT,2HY / DA *������þúTA IHEDL/18/ DATA IRFPT/2H/D,2HBS,2HPA,2H: ,2HRO,2HOT,2H F,2HIL,2HE ,2HNA, 2 2HMR,2H? ,2H _/ DATA ILCWP/2H/D,2HBS,2HPA,2H: ,2HLE,2HVE,2HL ,2HCO,2HDE,2H W, 2 2HOR,2HD?,2H _/ DATA IPRML/13/ DATA INMRE/2H/D,2HBS,2HPA,2H -,2H I,2HLL,2HEG,2HAL,2H O,2HR , 2 2HMI,2HSS,2HIN,2HG ,2HRO,2HOT,2H F,2HIL,2HE ,2HNA, 3 2HMR/ DATA INMRL/21/ DATA INERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HIN, 2 2HPU,2HT:,2H ,2H ,2H / DATA IOERR/2H/D,2HBS,2HPA,2H -,2H E,2HRR,2HOR,2H O,2HN ,2HOU, 2 2HTP,2HUT,2H: ,2H ,2H / DATA IOELN/15/ DATA ILLUE/2H/D,2HBS,2HPA,2H -,2H I,2HLL,2HEG,2HAL,2H L,2HU./ DATA ILLUL/10/ C C C SET ERROR LOGGING LU TO 1. C LULOG = 1 C C DETERMINE THE INPUT LU FROM THE SCHEDULING STRING. IF UNSPECIFIED, C CALL LOGLU TO GET IT. IF SPECIFIED, MAKE SURE IT'S LEGAL. C ISTRT = 1 IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 20,10 10 IF ((IAND(IPBUF(4),003B).EQ.1).AND.(IPBUF(1).GE.0) & .AND.(IPBUF(1).LE.255B)) GO TO 30 IF (IPBUF(4).NE.0) GO TO 500 20 IPBUF(1) = LOGLU(IDUM) 30 INLU = IPBUF(1) C C DETERMINE OUTPUT LU FROM SCHEDULING STRING. IF UNSPECIFIED, THEN IF C THE INPUT LU IS INTERACTIVE, THEN DEFAULT THE OUTPUT LU TO THE INPUT C LU, ELSE DEFAULT THE OUTPUT LU TO 6. IF SPECIFIED, MAKE SURE ITS LEGAL. C IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 60,50 50 IF ((IAND(IPBUF(4),003B).EQ.1).AND.(IPBUF(1).GE.0) & .AND.(IPBUF(1).LE.255B)) GO TO 70 IF (IPBUF(4).NE.0) GO TO 500 60 IPBUF(1) = 6 IF (IFTTY(INLU)) IPBUF(1) = INLU 70 OUTLU = IPBUF(1) C C DETERMINE THE ERROR LOGGING LU. IF INPUT LU IS INTERACTIVE, THEN THE C LOGGING LU BECOMES THE INPUT LU, ELSE IT REMAINS LU 1. C IF (IFTTY(INLU)) LULOG = INLU C C PRINT OUT THE HEADER: C C IMAGE/1000 DATA BASE SPACE UTILITY C CALL EXEC(/Ø������þú100002B,OUTLU,IBLNK,1) GO TO 3000 80 CALL EXEC(100002B,OUTLU,IHEDR,IHEDL) GO TO 3000 85 CALL EXEC(100002B,OUTLU,IBLNK,1) GO TO 3000 C C GET THE DATA BASE ROOT FILE'S NAMR. IF NOT SPECIFIED IN THE RUN STRING, C THEN IF THE INPUT LU IS INTERACTIVE, PROMPT FOR THE NAMR AND READ THE C REPLY, ELSE JUST DO THE READ. C 90 IBASE(1) = IBLNK IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 110,100 100 IF (IAND(IPBUF(4),3).EQ.0) GO TO 110 NCHARS = 0 IF (INAMR(IPBUF,IBASE(2),20,NCHRS)) 1000,150 C 110 IF (IFTTY(INLU)) 120,130 120 CALL EXEC(100002B,INLU,IRFPT,IPRML) GO TO 2000 130 NCHRS = -20 CALL EXEC(100001B,INLU+400B,IBASE(2),NCHRS) GO TO 2000 135 CALL ABREG(IA,IB) IF (IB.NE.0) GO TO 140 IF (IFTTY(INLU)) 120,1000 140 NCHRS = IB 150 CALL SPUT(IBASE(2),NCHRS+1,IBLNK) C C GET THE USER'S LEVEL CODE WORD. IF NOT SPECIFIED IN THE RUN STRING, C THEN IF THE INPUT LU IS INTERACTIVE, PROMPT FOR THE WORD AND READ THE C REPLY, ELSE JUST DO THE READ. C IF (NAMR(IPBUF,IBUF,LOGLN,ISTRT)) 210,200 200 IF (IPBUF(4).EQ.0) GO TO 210 CALL SMOVE(IPBUF,1,6,LEVEL,1) GO TO 300 210 IF (IFTTY(INLU)) 220,230 220 CALL EXEC(100002B,INLU,ILCWP,IPRML) GO TO 2000 230 CALL SFILL(LEVEL,1,6,IBLNK) CALL EXEC(100001B,INLU,LEVEL,3) GO TO 2000 C C SET STATUS WORD TO ZERO UPON SUCCESSFUL COMPLETION AND RETURN. C 300 ISTAT = 0 RETURN C C ERROR HANDLERS. C C ILLEGAL LU IN RUN STRING. PRINT MESSAGE: C C /DBSPA - ILLEGAL LU. C 500 CALL EXEC(100002B,LULOG,ILLUE,ILLUL) GO TO 6000 750 GO TO 6000 C C UNABLE TO OBTAIN ROOT FILE NAMR OR NAMR SPECIFIED IS ILLEGAL. PRINT C MESSAGE: C C /DBSPA - ILLEGAL OR MISSING ROOT FILE NAMR C 1000 CALL EXEC(100002B,LULOG,INMRE,INMRL) GO TO 5000 1500 GO TO 5000 C C ERROR ON I/O CALL TO INPUGÝ���N��LHT DEVICE. PRINT MESSAGE: C C /DBSPA - ERROR ON INPUT AABB C WHERE AABB IS THE CONTENTS OF THE A & B REGISTERS FROM THE C EXEC I/O CALL RESPECTIVELY. C 2000 CALL ABREG(INERR(14),INERR(15)) CALL EXEC(100002B,LULOG,INERR,IOELN) GO TO 5000 2500 GO TO 5000 C C ERROR ON I/O CALL TO OUTPUT DEVICE. PRINT MESSAGE: C C /DBSPA - ERROR ON OUTPUT AABB C WHERE AABB IS AS ABOVE. C 3000 CALL ABREG(IOERR(14),IOERR(15)) CALL EXEC(100002B,LULOG,IOERR,IOELN) GO TO 5000 3500 GO TO 5000 C C SET STATUS WORD TO -1 ON ERROR AND RETURN. C 5000 ISTAT = -1 RETURN 6000 ISTAT = 1 RETURN END END$ ��������������������������������������������������������������������������������������������������������������������������6õN������ÿÿ����� ���� ÿý�¯�Á ���������ÿ��92069-18134 2013� S C0122 �&RECVX � � � � � � � � � � � � � �H0101 „’�����þúFTN4 PROGRAM RECOV(4,99),92069-16134 REV.2013 791214 C C C****************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN C CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18134 C RELOC: 92069-16134 C C PRGMR: JC,CEJ,CSN C C C****************************************************************** C C C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C ******************************************************************** C DECLARATIONS C INTEGER LUIN,LIST,LULOG INTEGER INBUF(561),NMBUF(10),LINE,PBUF(5) INTEGER DBCOP,COTBL,COSIZ,ENTSZ INTEGER DNODE,RDTBL,BPSIZ,BPNAM,BPNOD INTEGER ILENG,ISTRC,FCODE,ERROR,QWAIT,GET INTEGER NULL,DASH,BLANK,STAR,SHFT8 INTEGER MNAME(3),MNODE C LOGICAL QUIT,YES,IFTTY,RMOTE C INTEGER MSG1(27),MSG2(7),MSG5(13),MSG9(5),MSG10(10) COMPLEX MSG3(2),MSG4,MSG6(3),MSG7(6),MSG8(3) COMPLEX IMHDR(3) C C DATA QWAIT/23/,GET/21/,NULL/-1/,SHFT8/256/ DATA DASH/2H--/,BLANK/2H /,STAR/2H**/ C DATA IMHDR /8HIMAGE/10,8H00 RECOV,8H UTILITY/ DATA MSG1 /2HWO,2HUL,2HD ,2HYO,2HU ,2HLI,2HKE,2H T,2HO , & 2HCL,2HEA,2HN ,2HUP,2H A,2HFT,2HER,2H A,2H P, & 2HRO,2HGR,2HAM,2H (,2HYE,2HS/,2HNO,2H) ,2H _/ DATA MSG2 /2HPR,2HOG,2HRA,2HM ,2HNA,2HME,2H _/ DATA MSG3 /8HBAD PROG,8HRAM NAME/ DATA MSG4 [������þú/8HDONE. / DATA MSG5 /2HDA,2HTA,2H B,2HAS,2HE ,2H ,2H ,2H ,2H R, & 2HEL,2HEA,2HSE,2HD./ DATA MSG6 /8HCLEAN UP,8H UNSUCCE,8HSSFUL. / DATA MSG7 /8HUNABLE T,8HO OBTAIN,8H CURRENT,8H DATA BA, & 8HSE INFOR,8HMATION. / DATA MSG8 /8HUNABLE T,8HO LOCK L,8HIST LU. / DATA MSG9 /2HEN,2HD ,2HRE,2HCO,2HV./ DATA MSG10 /2H/R,2HEC,2HOV,2H -,2H I,2HLL,2HEG,2HAL,2H L,2HU./ C C ******************************************************************** C SUBROUTINES C C DSPLA -DISPLAYS THE CURRENT DATA BASE ENTRIES IN DBCOP'S C COORDINATING TABLE AND, IF AVAILABLE, THE REMOTE MASTERS C ASSOCIATED WITH RDBAP COPIES FROM RDBAM'S TABLE. C C FINDB -FINDS AND RETURNS ALL THE DATA BASE NAMES AND CRNS ASSOCIATED C WITH THE PROGRAM WHOSE NAME IS ENTERED BY THE USER IN RE- C SPONSE TO THE QUERY: PROGRAM NAME? C C SERCH -FINDS AND RETURNS THE NAME AND NODE NUMBER OF THE MASTER C PROGRAM ASSOCIATED WITH AN REBAP COPY. C C ANSWR -INPUTS A USER'S (YES/NO) RESPONSE AND RETURNS LOGICAL T/F. C C PUT -PERFORMS AN EXEC CALL FOR OUTPUT TO A DEVICE. C C INPUT -PERFORMS AN EXEC CALL FOR INPUT FROM A DEVICE. C C RMNF -GETS A COPY OF THE RDBAP SCHEDULING TABLE IF AVAILABLE C AND RETURNS THE VALUE TRUE, ELSE RETURNS THE VALUE FALSE C C RMCLN -SENDS A CLEAN-UP MESSAGE TO RDBAM FOR A SPECIFIC MASTER C PROGRAM. C C ******************************************************************** C *** SAMPLE OUTPUT *** C C *** C NO REMOTE DATA BASE ACCESS C *** C C IMAGE/1000 RECOV UTILITY C C *********************************************** C DB NAME CART # MODE OPEN TO C ----------------------------------------------- C C DB1 12 3 PROG1 C C DB2 49 1 PROG2 C ×K������þú PROG3 C PROG4 C C DB3 1003 8 DBSPA C C *********************************************** C C END RECOV C C *** C WITH REMOTE DATA BASE ACCESS C *** C IMAGE 1000 RECOV UTILITY C C ******************************************************************** C DB NAME CART # MODE OPEN TO MASTER NODE C -------------------------------------------------------------------- C C DB1 12 3 PROG1 C C RB4 4 1 RDB02 PROG8 8 C PROG2 C C RB9 9 8 RDB03 PROG2 2 C DBSPA C C ******************************************************************** C C END RECOV C C ******************************************************************** C *** INITIALIZATION *** COSIZ = 20 ENTSZ = 27 DBCOP(1) = 2HDB DBCOP(2) = 2HCO DBCOP(3) = 2HP BPSIZ = 8 BPNAM = 4 BPNOD = 3 C ******************************************************************** C *** MAIN *** C RETRIEVE INVOKING PARAMETERS FROM COMMAND STRING C CALL GETST(INBUF,-80,ILENG) ISTRC = 1 C C GET INPUT DEVICE C IF (NAMR(NMBUF,INBUF,ILENG,ISTRC)) 4,3 C C SKIP TO 5 IF NAMR(COMMAND STRING) YIELDED NON-NULL LEGAL LUIN DEVICE C 3 IF ((IAND(NMBUF(4),003B).EQ.1).AND.(NMBUF(1).GE.0) & .AND.(NMBUF(1).LE.255B)) GO TO 5 NMBUF(1) = -2 IF (NMBUF(4).NE.0) GO TO 5 C C SET THE INPUT DEVICE TO -1 FOR EASY DEFAULT LATER. C 4 NMBUF(1) = -1 5 LUIN = NMBUF(1) C C GET LIST DEVICE C IF (NAMR(NMBUF,INBUF,ILENG,ISTRC)) 9,8 C C SKIP TO 10 IF LIST NON-NULL AND LEGAL C 8 IF ((IAND(NMBUF(4),003qÔ������þúB).EQ.1).AND.(NMBUF(1).GE.0) & .AND.(NMBUF(1).LE.255B)) GO TO 10 NMBUF(1) = -2 IF (NMBUF(4).NE.0) GO TO 10 C C FOR DEFAULT OF LIST DEVICE BELOW, SET LIST DEVICE TO -1 NOW. C 9 NMBUF = -1 C 10 LIST = NMBUF(1) C GET SCHEDULER'S NODE NUMBER. IF DEFAULTED OR EQUAL TO THE LOCAL C NODE, SET IT TO -1. C CALL NAMR(NMBUF,INBUF,ILENG,ISTRC) IF (IAND(NMBUF(4),003B).NE.1) NMBUF(1) = -1 IF (NMBUF(1).EQ.NODE(IDUM)) NMBUF(1) = -1 15 DNODE = NMBUF(1) C C SET ERROR LOGGING LU TO 1 FOR NOW. C LULOG = 1 C C NOW SET THE DEFAULT INPUT DEVICE. IF LUIN IS -1, THEN IF REMOTE C SCHEDULE, DEFAULT IT TO 1, ELSE CALL LOGLU. IF LUIN IS -2, C BRANCH TO PRINT ERROR MESSAGE. C IF (LUIN.GE.0) GO TO 16 IF (LUIN.EQ.-2) GO TO 300 LUIN = 1 IF (DNODE.NE.-1) GO TO 16 LUIN = LOGLU(IDUM) C C NOW SET THE DEFAULT LIST DEVICE. IF LIST IS -1, THEN IF LUIN IS C INTERACTIVE OR REMOTE, SET LIST TO IT, ELSE SET LIST TO 6. C IF LIST IS -2, BRANCH TO PRINT ERROR MESSAGE. C 16 IF (LIST.GE.0) GO TO 18 IF (LIST.EQ.-2) GO TO 300 LIST = 6 IF (DNODE.NE.-1) GO TO 17 IF (.NOT.IFTTY(LUIN)) GO TO 18 17 LIST = LUIN C C DETERMINE THE LU OF THE DEVICE TO WHICH ANY ERRORS ARE LOGGED. C THIS IS LUIN, IF INTERACTIVE OR REMOTE, ELSE IT REMAINS LU 1. C 18 IF (DNODE.NE.-1) GO TO 19 IF (.NOT.IFTTY(LUIN)) GO TO 20 19 LULOG = LUIN C C IF THE INPUT DEVICE IS NOT INTERACTIVE AND NOT REMOTE, JUST PRINT C OUT THE TABLE AND TERMINATE. C 20 IF (DNODE.NE.-1) GO TO 25 IF (IFTTY(LUIN)) GO TO 25 CALL DSPLA(ERROR) GO TO 100 25 CONTINUE C C INPUT DEVICE IS INTERACTIVE. PUT OUT RECOV HEADER. C CALL PUT(BLANK,LUIN,1,ERROR) IF (ERROR.NE.0) GO TO 130 CALL PUT(IMHDR,LUIN,12,ERROR) IF (ERROR.NE.0) GO TO 130 QUIT =�Å������þú .FALSE. C C DO WHILE(QUITFLAG=FALSE) C 30 IF (QUIT) GO TO 120 C C DISPLAY THE CURRENT COORDINATING TABLE- EXIT WHILE ON ERROR C CALL DSPLA(ERROR) IF (ERROR.NE.0) GO TO 100 C C ASK IF USER WANTS TO CLEAN UP AFTER A PROGRAM. C CALL PUT(MSG1,LUIN,27,ERROR) IF (ERROR.NE.0) GO TO 130 CALL ANSWR(YES,ERROR) IF (ERROR.NE.0) GO TO 130 IF (.NOT.YES) GO TO 80 C C ASK FOR PROGRAM NAME. C DO 35 I=1,3 NMBUF(I) = 2H 35 CONTINUE CALL PUT(MSG2,LUIN,7,ERROR) IF (ERROR.NE.0) GO TO 130 ILENG = 3 CALL INPUT(NMBUF,ILENG,ERROR) IF (ERROR.NE.0) GO TO 130 C C MAKE SURE PROGRAM IS IN OUR LIST AND GET ITS ASSOCIATED DATA BASE C NAMES AND CRNS. C CALL FINDB(NMBUF,INBUF,ERROR) IF (ERROR.NE.0) GO TO 78 C C SEE IF PROGRAM TO CLEAN-UP AFTER IS AN RDBAP COPY. THE FIRST C THREE CHARACTERS OF THE NAME ARE 'RDB' IN THIS CASE. C IF (.NOT.RMOTE) GO TO 50 IF (NMBUF(1).NE.2HRD) GO TO 50 IF (IOR(IAND(NMBUF(2),177400B),40B).NE.2HB ) GO TO 50 C C AN RDBAP COPY, GET ITS MASTER'S NAME AND NODE NUMBER THEN SEND A C MESSAGE TO RDBAM TO REMOVE IT. C CALL SERCH(NMBUF,MNAME,MNODE,ERROR) IF (ERROR.NE.0) GO TO 50 CALL RMCLN(MNAME,MNODE,ERROR) IF (ERROR.NE.0) GO TO 70 C C FOR EACH DATA BASE NAME IN INBUF: C C SCHEDULE DBCOP(NO ABORT) TO DELETE COORD TABLE ENTRY C 50 CONTINUE DO 67 K=1,561,4 IF (INBUF(K).EQ.NULL) GO TO 68 FCODE = 3 * SHFT8 CALL EXEC(QWAIT+100000B,DBCOP,FCODE,INBUF(K),INBUF(K+1), & INBUF(K+2),INBUF(K+3),NMBUF,3) GO TO 70 60 ERROR = 0 CALL RMPAR(PBUF) C C CHECK PBUF(1) ERROR FLAG C IF (PBUF(1).EQ.0) GO TO 65 IF (PBUFÁ;������þú(1).NE.103) GO TO 70 GO TO 67 C C PRINT DB RELEASED IF #USERS=0 C 65 IF (PBUF(2).GT.0) GO TO 67 CALL SMOVE(INBUF(K),1,6,MSG5,11) CALL PUT(MSG5,LUIN,13,ERROR) IF (ERROR.NE.0) GO TO 130 67 CONTINUE C C PRINT CLEAN-UP DONE MESSAGE. C 68 CONTINUE CALL PUT(MSG4,LUIN,4,ERROR) IF (ERROR.NE.0) GO TO 130 GO TO 90 C C PRINT CLOSURE UNSUCCESSFUL MESSAGE. C 70 CALL PUT(MSG6,LUIN,12,ERROR) IF (ERROR.NE.0) GO TO 130 GO TO 90 75 CONTINUE CONTINUE C C PRINT BAD PROGRAM NAME MESSAGE. C 78 CALL PUT(MSG3,LUIN,8,ERROR) IF (ERROR.NE.0) GO TO 130 GO TO 90 C C ELSE (IF DON'T WANT TO CLEAN UP AFTER A PROGRAM) C 80 QUIT = .TRUE. CONTINUE 90 CONTINUE GO TO 30 C C END WHILE C 100 CONTINUE IF (ERROR.EQ.0) GO TO 120 C C INCASE(ERROR) C IF (ERROR.NE.1) GO TO 110 CALL PUT(MSG7,LULOG,24,ERROR) GO TO 120 C 110 IF (ERROR.NE.2) GO TO 130 CALL PUT(MSG8,LULOG,12,ERROR) 120 CONTINUE C C END INCASE C C PRINT END MESSAGE IF LUIN IS REMOTE AND/OR INTERACTIVE. C IF (RMOTE) GO TO 125 IF (.NOT.IFTTY(LUIN)) GO TO 130 125 CALL PUT(MSG9,LUIN,5,ERROR) 130 CONTINUE STOP C C HERE ON AN ILLEGAL LU NUMBER IN RUN STRING. PRINT ERROR MESSAGE: C C /RECOV - ILLEGAL LU. C C AND STOP. C 300 CALL PUT(MSG10,LULOG,10,ERROR) GO TO 130 END C C C C SUBROUTINE DSPLA(ERR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C ****************˜ò������þú**************************************************** C INTEGER COTBL,COSIZ,ENTSZ,LINE,PBUF(5),DBCOP INTEGER DNODE,RDTBL,BPSIZ,BPNAM,BPNOD INTEGER ASCII(3),FCODE,QWAIT,GET,CLASS,EBASE,NULL,ERR,LIST INTEGER TBLEN,SHFT8 INTEGER ENAME,UNLCK LOGICAL RMNF,RMOTE,IFTTY COMPLEX TBHDR(6) C DIMENSION MNAME(3) C C ******************************************************************** C DATA LOCK/040001B/,UNLCK/140000B/ DATA QWAIT/23/,GET/21/,DASH/2H--/,BLANK/2H /,STAR/2H**/ DATA NULL/-1/,SHFT8/256/ DATA TBHDR/8HDB NAME ,8H CART # ,8H MODE ,8H OPEN TO, & 8H MASTER,8H NODE / C ******************************************************************** C C C SCHEDULE DBCOP TO ACCESS COORDINATING TABLE. C FCODE = -1 CALL EXEC(QWAIT+100000B,DBCOP,FCODE) GO TO 50 10 CALL RMPAR(PBUF) C C TEST FOR DBCOP ERROR C IF (PBUF(1).NE.0) GO TO 50 CLASS = IAND(PBUF(2),017777B) C C GET COPY OF COORD TABLE FROM SAM. C CALL EXEC(GET+100000B,CLASS,COTBL,COSIZ*ENTSZ) GO TO 50 C C IF OUTPUT DEVICE NON-INTERACTIVE, LOCK IT. C 20 IF (IFTTY(LIST)) GO TO 21 IF (DNODE.NE.-1) GO TO 21 CALL LURQ(LOCK,LIST,1) GO TO 55 C C DETERMINE IF WE CAN PRINT REMOTE DATA BASE ACCESS INFORMATION. C IF SO, MAKE A COPY OF THE RDBAP COPY TABLE AND SET OUR FLAGS, C AND OUTPUT LENGTH. C 21 RMOTE = RMNF(RDTBL) LINLN = 16 IF (RMOTE) LINLN = 24 C C PRINT HEADER: C C ***********************************************[*******************] C DB NAME CART # MODE OPEN TO [ MASTER NODE ] C -----------------------------------------------[-------------------] C C WHERE THE CHARACTERS IN BRACKETS ([]) ARE PRINTED ONLY IF WE CAN C REPORT ON REMOTE ACCESS. 2 ������þúC CALL PUT(BLANK,LIST,1,ERR) IF (ERR.NE.0) GO TO 60 CALL SFILL(LINE,1,LINLN*2,STAR) CALL PUT(LINE,LIST,LINLN,ERR) IF (ERR.NE.0) GO TO 60 CALL PUT(TBHDR,LIST,LINLN,ERR) IF (ERR.NE.0) GO TO 60 CALL SFILL(LINE,1,LINLN*2,DASH) CALL PUT(LINE,LIST,LINLN,ERR) IF (ERR.NE.0) GO TO 60 CALL PUT(BLANK,LIST,1,ERR) IF (ERR.NE.0) GO TO 60 C CALL SFILL(LINE,1,LINLN*2,BLANK) C C PRINT COORDINATING TABLE C C PRINT EVERY NON-NULL ENTRY OF THE COORD TABLE C TBLEN = COSIZ*ENTSZ DO 40 EBASE=1,TBLEN,ENTSZ IF (COTBL(EBASE).EQ.NULL) GO TO 40 C BUFF UP DBNAME CALL SMOVE(COTBL(EBASE),1,6,LINE,2) C BUF UP CARTRIDGE # CALL CNUMD(COTBL(EBASE+3),ASCII) CALL SMOVE(ASCII,1,6,LINE,10) C BUFF UP OPEN MODE (IN LEFT BYTE) CALL CNUMD(COTBL(EBASE+4)/SHFT8,ASCII) CALL SMOVE(ASCII,1,6,LINE,17) C BUFF UP FIRST USER PROGRAM NAME IN THIS LINE DO 30 ENAME=EBASE+6,EBASE+ENTSZ-3,3 IF (COTBL(ENAME).EQ.NULL) GO TO 30 CALL SMOVE(COTBL(ENAME),1,6,LINE,27) C IF WE ARE PRINTING REMOTE MONITOR PROGRAMS, SEE IF A MASTER C FOR THIS PROGRAM EXISTS. IF (.NOT.RMOTE) GO TO 25 CALL SERCH(COTBL(ENAME),MNAME,MNODE,ERR) IF (ERR.NE.0) GO TO 25 C A MASTER PROGRAM, BUFF UP ITS NAME CALL SMOVE(MNAME,1,6,LINE,35) C BUFF UP MASTER'S NODE NUMBER CALL CNUMD(MNODE,ASCII) CALL SMOVE(ASCII,1,6,LINE,42) C PRINT OUT LINE OF INFORMATION 25 CONTINUE CALL PUT(LINE,LIST,LINLN,ERR) IF (ERR.NE.0) GO TO 60 C FILL LINE WITH BLANKS CALL SFILL(LINE,1,LINLN*2,BLANK) C CONTINUE FOR ALL NAMES IN THIS ENTRY 30 CONTINUE C PRINT ONE BLANK LINE AFTER EACH DATA BAS•ƒ������þúE CALL PUT(BLANK,LIST,1,ERR) IF (ERR.NE.0) GO TO 60 40 CONTINUE C C END DO C CALL SFILL(LINE,1,LINLN*2,STAR) CALL PUT(LINE,LIST,LINLN,ERR) IF (ERR.NE.0) GO TO 60 CALL PUT(BLANK,LIST,1,ERR) IF (ERR.NE.0) GO TO 60 ERR = 0 C C UNLOCK LIST DEVICE C CALL LURQ(UNLCK,LIST,1) GO TO 60 48 GO TO 60 C C BRANCH HERE FOR DSPLA ERROR CASE: ERR = 1 C 50 ERR = 1 GO TO 60 C C BRANCH HERE FOR LU LOCK ERROR CASE: ERR = 2 C 55 ERR = 2 60 CONTINUE RETURN END C C C C SUBROUTINE FINDB(NMBUF,INBUF,ERROR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C ******************************************************************** C C INTEGER ERROR,EBASE,ENTSZ,COSIZ,INBUF INTEGER DNODE,DBCOP,RDTBL,BPSIZ,BPNAM,BPNOD INTEGER NMBUF,ENAME,COTBL C LOGICAL RMOTE C DIMENSION NMBUF(3),INBUF(80) C DATA NULL/-1/ C ERROR = -1 J = 1 DO 50 EBASE=1,ENTSZ*COSIZ,ENTSZ IF (COTBL(EBASE).EQ.NULL) GO TO 50 DO 40 ENAME=EBASE+6,EBASE+ENTSZ-3,3 IF (COTBL(ENAME).EQ.NULL) GO TO 40 IF (JSCOM(COTBL(ENAME),1,6,NMBUF,1,ERROR).NE.0) GO TO 40 CALL SMOVE(COTBL(EBASE),1,8,INBUF,J) ERROR = 0 J = J + 8 40 CONTINUE 50 CONTINUE INBUF((J+1)/2) = -1 RETURN END C C C C SUBROUTINE SERCH(PNAME,MNAME,MNODE,ERROR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C **¼r������þú****************************************************************** C INTEGER PNAME,ERROR,ENTRY INTEGER COTBL,COSIZ,ENTSZ,DNODE,DBCOP INTEGER RDTBL,BPSIZ,BPNAM,BPNOD C LOGICAL RMOTE C DIMENSION PNAME(3),MNAME(3) C DO 50 ENTRY=1,BPSIZ*COSIZ,BPSIZ IF (RDTBL(ENTRY).EQ.0) GO TO 50 IF (JSCOM(RDTBL(ENTRY+BPNAM),1,6,PNAME,1,ERROR).NE.0) GO TO 50 CALL SMOVE(RDTBL(ENTRY),1,6,MNAME,1) MNODE = RDTBL(ENTRY+BPNOD) ERROR = 0 GO TO 100 50 CONTINUE ERROR = -1 100 RETURN END C C C C SUBROUTINE PUT(BUF,DEST,LEN,ERROR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C ******************************************************************** C INTEGER BUF(40),DEST,LEN,FCODE,ERROR INTEGER COTBL,COSIZ,ENTSZ,DNODE,DBCOP INTEGER RDTBL,BPSIZ,BPNAM,BPNOD C LOGICAL RMOTE COMPLEX ERMSG(2) DATA ERMSG /8HRECOV OU,8HTPUT ERR/ FCODE = 2 IF (DNODE.NE.-1) GO TO 7 CALL EXEC(FCODE+100000B,DEST+200B,BUF,LEN) GO TO 10 5 ERROR = 0 RETURN C 7 CONTINUE CALL DEXEC(DNODE,FCODE+100000B,DEST+200B,BUF,LEN) GO TO 10 8 ERROR = 0 RETURN C 10 ERROR = -1 IF (DNODE.EQ.-1) GO TO 15 CALL DEXEC(DNODE,FCODE+100000B,201B,ERMSG,8) GO TO 15 13 GO TO 20 15 CALL EXEC(FCODE,201B,ERMSG,8) 20 RETURN END C C C SUBROUTINE INPUT(BUF,LEN,ERROR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTŒ“������þúBL(160),BPSIZ,BPNAM,BPNOD C C ******************************************************************** C INPUTS A MAXIMUM OF (+LEN) WORDS OR (-LEN) CHARACTERS INTEGER BUF(40),ERROR,LEN,AREG,BREG,QMARK INTEGER COTBL,COSIZ,ENTSZ,DNODE,DBCOP INTEGER RDTBL,BPSIZ,BPNAM,BPNOD C LOGICAL RMOTE C COMPLEX ERMSG(2) DATA ERMSG /8HRECOV IN,8HPUT ERR / DATA QMARK/2H?_/ C C TRUNCATE INPUT REQUEST IF LARGER THAN BUFFER C IF (LEN.GT.40) LEN = 40 IF (LEN.LT.-80) LEN = -80 C IF (DNODE.NE.-1) GO TO 3 CALL EXEC(100002B,LUIN,QMARK,1) GO TO 10 1 CALL EXEC(100001B,LUIN+400B,BUF,LEN) GO TO 10 2 GO TO 5 C 3 CALL DEXEC(DNODE,100001B,LUIN+4400B,BUF,LEN,QMARK,1) GO TO 10 5 CALL ABREG(AREG,BREG) LEN = BREG ERROR = 0 RETURN C 10 ERROR = -1 CALL EXEC(2,201B,ERMSG,8) RETURN END C C C SUBROUTINE ANSWR(REPLY,ERROR) C C ******************************************************************** C *** COMMON *** C COMMON COTBL(540),COSIZ,ENTSZ,LINE(40),DNODE,RMOTE,DBCOP(3) COMMON LUIN,LIST,LULOG,RDTBL(160),BPSIZ,BPNAM,BPNOD C C ******************************************************************** C INTEGER YES,NO,RESP(2),ERROR INTEGER COTBL,COSIZ,ENTSZ,DNODE,DBCOP INTEGER RDTBL,BPSIZ,BPNAM,BPNOD C LOGICAL REPLY,RMOTE C DATA YES/2HYE/ DATA NO /2HNO/ C REPLY = .FALSE. 10 LEN=2 CALL INPUT(RESP,LEN,ERROR) IF (ERROR.NE.0) RETURN IF ((RESP.EQ.YES).OR.(RESP.EQ.NO)) GO TO 20 GO TO 10 20 CONTINUE IF (RESP.EQ.YES) REPLY= .TRUE. RETURN END END$ ����������������������������������������������������������������������������– ���H����F�B�������������������������������������������������������������������BH�������ÿÿ����� ���� ÿý�°�Á ���������ÿ��92069-18135 2040� S C0122 �&DBHD1 �&DBHD1 %DBMS HEADER � � � � � � � � � � � � �H0101 Œ„�����ASMB HED HEADER FOR %DBMS NAM DBMS,7 92069-12002 REV.2040 800730 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18135 * RELOC: 92069-16135 * * PRGMR: CEJ * * ******************************************************************* * * END ��������������������������������������������������������������������������������������������������������������|������ÿÿ����� ���� ÿý�±�· ���������ÿ��92069-18136 2040� S C0122 �&DBOPN �&DBOPN DBOPN SUBROUTINE � � � � � � � � � � � � �H0101 k�����þúASMB,L,C,R HED DBOPN SUBROUTINE OF IMAGE/1000 NAM DBOPN,7 92069-16136 REV.2040 800730 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18136 * RELOC: 92069-16136 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * JANUARY 25, 1980 TO RELEASE UNUSED FRT SPACE - CEJ * FEBRUARY 22, 1980 TO ADD RA BIT TO DSCB - CEJ * JULY 30, 1980 TO CLOSE FILE AFTER OPEN IF NOT A * TYPE 1 FILE - CEJ * * ******************************************************************* * * * * Data Base OPeN is one of the ten user callable subroutines in the IMAGE/ * 1000 DBMS Library. Its function is to open the data base root file, * and prepare the necessary main memory buffers for future access to the * data base. * * The buffers that DBOPN need initialize are : * 1) The Run Table - * an in main memory copy of the root file with additional inform- * ation on the access capabilities to the entities of the data * base and some size parameters set. * 2) The Record Buffer - * for reading and writing entries in the data base. * 3) Data Set DCBs - * again for reading and writing entries in the data base. * * The user is given three access options for opening a data base. These * are identified by the DBOPN mode as follows: * mode meaning * ---- ------- * 1 shared read/write access * 3 exclusive read/write access * 8 shared read-only access ŽÔ������þú* * The calling sequence for DBOPN is: * * JSB DBOPN * DEF *+5 return point * DEF BASE an array containing: * two ASCII blanks or a DS/1000 node # in the * first word followed by an FMP namr string * specifying at least the data base name and * security code. * On a successful return, DBOPN stores a data * base number in the first word of the array. * DEF LEVEL an array containing the user's levelcode word * three words long, padded by trailing blanks * if necessary. * DEF MODE Open mode as described above. * DEF STAT a ten word array in which status information * is returned to the user. This subroutine * uses only the first three words which are * as follows: * word contents * ---- -------- * 1 status code (0 if successful) * if successful: * 2 user's assigned access level * 3 word length of Run Table * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * m¦������þú 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level$ô������þú DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set i˜O������þúnfo table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * :L������þú * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBOPN EXT .CMW,.ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDCT,DBIDS EXT DBDMX,DBDSZ,DBFDI,DBFDS,DBFRT,DBFWZ,DBPAR,DBRBL EXT DBRBP,DBRTP,EXEC,GETBF,OPEN,PNAME,RBOPN,RETBF EXT ECLOS,EREAD,RMPAR,TRIM * BASE NOP LEVEL NOP MODE NOP STAT NOP * * Get true parameter and return point addresses. * DBOPN NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA STAT SZA,RSS JMP OPN28 Missing parameter. * * Ask DBIDS to check the BASE parameter to see if the data base is on * a remote machine. * CLA A = 0 signifies DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - invalid BASE param. JMP LOCAL Data base is local return. * ä������þú JSB RBOPN Data base is remote return. DEF *+5 Ask RBOPN to handle DEF BASE,I this request. DEF LEVEL,I DEF MODE,I DEF STAT,I JMP OPN28 Return to user. * * The data base parameter contains a root file namr in its 2nd through * ? words. Parse it into its components. The file name and security * code must be there, cartridge number is optional. * LOCAL JSB DBPAR DBPAR does the parse. DEF *+3 DEF NAME DEF BASE,I JMP E103 Error return - illegal base param. * * Ask DBFRT to see if the data base specified by the user in BASE is al- * ready open to this program. If so, we cannot open it again. If not, * DBFRT will pass us the index into the Run Table pointer table for the * first free space in the table. This we save off as the data base num- * ber on a successful open. * CLA A = 0 tells DBFRT we JSB DBFRT are DBOPN. DEF *+4 DEF BASE,I DEF NAME DEF CRN * SSA,RSS Did DBFRT find the R.T.? JMP E150 Yes - cannot open it again. * LDA AIRUN No - get index from AIRUN STA DBNUM and save. CLA STA AIRUN * * Check that the open mode specified by the user is valid, i.e. that it * is in the set [1,3,8]. * LDA MODE,I CPA D1 RSS CPA D3 RSS CPA D8 RSS JMP E115 No match - bad mode. * * Merge the open mode in with the function code for DBCOP. * LDB D1 Function code for a check is 1. BLF,BLF Function code in 1st byte, IOR B open mode in 2nd. STA FC/MD * * Ask DBCOP to check the data base open mode for obtainability. DBCOP * supervises data base opens for the proper mix of open modes. * JSB EXEC Schedule DBCOP DEF *+8 on queue with wait DEF NA23 and no abort. 3z������þú DEF DBCOP DEF FC/MD DBCOP needs: function code/open mode DEF NAME data base name DEF NAME+1 DEF NAME+2 DEF CRN cartridge number JMP E140 Here on abortion. * * * Get returned status code from DBCOP. If zero all is go. If non-zero * it is proper IMAGE error code to return to user. * JSB RMPAR DEF *+2 DEF ERROR * LDA ERROR SZA JMP ERREX * * Set up the data base DCB for the open call for this root file by zero * filling its first 16 words. * JSB DBFWZ DEF *+3 DEF D16 DEF DBDCB * * Set up the OPEN call by checking the open MODE specified by the user. * If mode 3, the root file is open exclusively, else the root file is * opened non-exclusively. Root file always opened with update option. * LDA IOPTN LDB MODE,I CPB D3 RSS IOR NEXCL STA PATCH * * Ask the FMP to open the root file for us. * JSB OPEN DEF *+7 DEF DBDCB,I DEF ERROR DEF NAME DEF PATCH options stored in PATCH DEF SC DEF CRN * CPA D1 Did OPEN succeed in JMP OPN1 opening a type 1 file? * SSA,RSS No - error encountered? JMP E116 No - invalid root file. * CPA M8 Yes - locked or open root file? JMP E129 Yes CPA M7 No - security violation? JMP E117 Yes CPA M6 No - non-existant file? JMP E119 Yes JMP ERREX No - return FMP error * * From this point on we will jump to a clean-up routine in case of an * error. CLNUP uses SAVE as a check on the record buffer. We will set * it to -1 at this point to inform CLNUP we do not need to rewind the re- * cord buffer in case of an error. CLNUP also uses DCBFL as a flag tha±Ó������þút * DCBs have been allocated. We will set it to zero to signify that no * DCB space has been allocated for this data base. * OPN1 CLA STA DCBFL CMA STA SAVE * * Now, read in the five overhead words from the first record of the root * file. These words contain: * 1) The record number (single integer) at which the data base direc- * tory starts. * 2) The length of the directory. * 3) The length of the Free Record Table. * 4) The optimum number of DCBs for the data base. * 5) The length of the longest entry in the data base. * JSB EREAD DEF *+5 DEF DBDCB,I DEF ERROR DEF RTREC+1 DEF D5 * SSA Any error? JMP CLNUP Yes - go clean up. * * We will do a couple of checks to see if the root file we just opened * is valid. First, the 1st word of overhead (read into RTREC+1) should * be either 3 or 4. Second, the 4th word of overhead (read into #DCBS) * should be within [1,17]. * LDA D116 LDB RTREC+1 CPB D3 RSS CPB D4 RSS JMP CLNUP * LDB #DCBS CMB,INB SSB,RSS JMP CLNUP ADB D17 SSB JMP CLNUP * * RTLEN now contains the length of the Run Table minus the Free Record * Table. FRTLN contains the Free Record Table length, round this up to * the nearest multiple of 128. Total the two (i.e. RTLEN and rounded * FRTLN). Get the primary pointer address for the Run Table by adding the * data base number (passed to us long ago by DBFRT) to the address of the * Run Table pointer table and subtracting one. Then ask GETBF for a * slice of memory large enough for the total Run Table. * CCA The reason we need to round up to a ADA FRTLN multiple of 128 is that the FMP expects ADA D128 a multiple of 128 words to be written to CLB a type 1 file. We get the extra memory …Q������þú DIV D128 (even though it is wasted) in order MPY D128 to avoid aborting with a memory error ADA RTLEN when writing the FRT to disc. STA TEMP * CCA ADA DBRTP ADA DBNUM STA RTPTR * JSB GETBF DEF *+4 DEF TEMP DEF RTPTR,I DEF ERROR * SSA,RSS Did GETBF succeed? JMP OPN2 Yes - continue on. LDA D128 No - not enough room JMP CLNUP for Run Table. * * We've got the space, so trim off any excess allocated for the Free * Record Table. To do this, compute the space we will actually use * and call TRIM to trim off the rest. * OPN2 LDA FRTLN ADA RTLEN STA TEMP TEMP = actual size of used space * JSB TRIM TRIM trims off the excess DEF *+3 DEF RTPTR,I It needs: pointer to allocated space DEF TEMP length to keep * SSA,RSS If TRIM returns any error, JMP OPN2A LDA D128 no memory error! JMP CLNUP * * Read the Run Table into the remaining space. First, we bring in the * directory (that is the Run Table minus FRT) then we bring in the * Free Record Table. * OPN2A LDA RTPTR STA AIRUN Point AIRUN to the pointer. LDA A,I Point RTPTR to the Run Table. STA RTPTR * JSB EREAD DEF *+7 DEF DBDCB,I DEF ERROR DEF RTPTR,I DEF RTLEN DEF TEMP DEF RTREC * SSA If any error JMP CLNUP clean up the process. * LDA RTPTR Calculate address for FRT. ADA RTLEN STA RTPTR * JSB EREAD DEF *+7 DEF DBDCB,I DEF ERROR DEF RTPTR,I DEF FRTLN DEF TEMP DEF FRTRC FRT starts in record # 2. * SSA Any error? JMP CLNUP Yes - clean up! * LDB AIRUN,I No - set up the pointe°²������þúr to the ADB DBFRP FRT in the Run Table (12th word). LDA RTLEN This is same as directory length. STA B,I * * Now, we have the root file in memory. Check that the security code * specified by the user matches the one in the root file to make sure * no-one has tampered with it and get the cartridge number from the Run * Table and put it in CRN. * LDB AIRUN,I ADB DBSCD LDA SC CPA B,I JMP OPN3 LDA D117 JMP CLNUP Not the same. * OPN3 INB Security codes the same, LDA B,I make sure we've got the STA CRN cartridge number. * * Now, we need to get a record buffer of the proper size. First, let's * see if one already exists and if so, if it is large enough. The record * buffer must be as long as the longest entry in the data base. The * length is in ENTLN from the overhead read. * LDA DBRBL Record buffer length is zero STA SAVE if no record buffer. SZA,RSS JMP OPN4 * CMA Not zero - is it big enough? ADA ENTLN SSA JMP OPN6 Yes - skip reallocation. * JSB RETBF No - deallocate it. DEF *+2 DEF DBRBP * SSA,RSS Did deallocate succeed? JMP OPN4 Yes LDA D160 No - corrupt memory error JMP CLNUP clean up. * * Join processing here for allocation of record buffer from no record * buffer and from deallocation of existing record buffer. Old record * size was saved for CLNUP above, so now set the record buffer length to * zero. Then try to allocate one of the proper size. * OPN4 CLA STA DBRBL * JSB GETBF DEF *+4 DEF ENTLN DEF DBRBP DEF ERROR * SSA,RSS Did GETBF succeed? JMP OPN5 LDA D128 No - go clean up. JMP CLNUP * OPN5 LDA ENTLN Yes - set DBRBL to length of F������þú STA DBRBL new record buffer. * * Now, we want to allocate as many 272 word DCBs as possible up to the * optimal number of DCBs for this data base. First, we'll check the * number of DCBs already allocated. If this is greater than or equal * to the number we would like (#DCBS from root file overhead) we are * all set. If there are no DCBs already allocated we must be able to * allocate at least one DCB for DBOPN to succeed. Also, if there are * no DCBs allocated, we set DCBFL to -1 to signify to CLNUP that all * DCBs allocated when it is called must be deallocated, otherwise no * deallocation is done. * OPN6 CCB LDA DBDCT SZA,RSS STB DCBFL CMA ADA #DCBS SSA Are there enough DCBs alreadY? JMP OPN10 Yes - need allocate no more. * * Loop on the number of DCBs we would like over the number we have, * searching for an empty DCB pointer in the DCB pointer table then call- * ing GETBF to allocate the new DCB. If GETBF ever comes back unsuc- * cessful and we started with none allocated, we check to make sure that * we were able to allocate at least one DCB. If not, we cannot complete * the DBOPN and undo everything we have already done. * * First, we need to set up the loop parameters. * INA Use negative of # of DCBs we CMA,INA would like over the # we STA CNTR have now as loop counter. * LDB DBDCP Get address of DCB STB TEMP pointer table. * LDB DBDMX Use negative # of entries CMB,INB in DCB pointer table as STB CNTR2 loop counter also. * * BEGIN LOOP * For each DCB we would like: * 1) Find an empty DCB pointer, 1st word of DCB pointer table entry * is zero if pointer empty. * OPN7 LDA TEMP,I SZA,RSS JMP OPN8 * ISZ TEMP ISZ TEMP ISZ CNTR2 End of pointer table? JMP OPN7 No - tryC'������þú this entry JMP OPN9 Yes - cannot allocate more DCBs * * 2) Try to allocate DCB * OPN8 ISZ TEMP TEMP -> DCB pointer. JSB GETBF DEF *+4 DEF DBDSZ Changeable size of DCBs DEF TEMP,I DEF ERROR * * 3) If DCB allocated, set first word of entry to -1 to indicate a * DCB pointer there and zero-fill the first 16 words of the DCB * to avoid conflicts with whatever may be in memory and legitimate * FMP values. If DCB not allocated jump to check for at least one * DCB allocated. * SSA JMP OPN9 * CCB CCA ADA TEMP STB A,I * JSB DBFWZ DEF *+3 DEF D16 DEF TEMP,I * * 4) Continue with next DCB we would like. * ISZ TEMP ISZ DBDCT Increment DCB count. ISZ CNTR Done with number we want? JMP OPN7 JMP OPN10 Yes success! * * END OF LOOP * * * We come here when: 1) end of DCB pointer table is found before we could * allocate all the DCBs we wanted or 2) end of free memory is found be- * fore we could allocate all the DCBs we wanted. Make sure there is at * least one DCB allocated. * OPN9 LDA D128 If not even one DCB LDB DBDCT a not enough memory error. SZB,RSS JMP CLNUP * * All memory allocation is done, there should be no more compaction. * So, we want AIRUN to contain the Run Table address (rather than the * address of the address it contains now) but need to save the address * of the address in case of a future clean up. So, first set AIRUN then * we want to initialize the Run Table for this particular user and open. * Put the first word of the base parameter in the 6th word of the DBCB. * Then save the words/no level words flag in the 14th word of the DBCB and * put the open mode in the same word of the DBCB (low order byte) zeroing * the lock flag (high order byte of same word). * OPÐ������þúN10 LDB AIRUN STB RTPTR LDB B,I STB AIRUN * ADB DBDSN LDA BASE,I STA B,I * ADB D8 LDA B,I STA TEMP * LDA MODE,I STA B,I * * Determine user's access level by comparing the level code word given * us in LEVEL to the code words in the DBCB. The first match gives us * the level. If no match, the user has level zero. If no level code * words in DBCB, the user has level 15. We can check for no level code * words by looking at the flag we saved in TEMP. If flag = TRUE (0) * there are level code words and we must do comparison search. If flag * = FLASE (-1) there are no level code words and the user automatically * has level of 15. * LDA D15 ISZ TEMP CMA,INA,RSS JMP OPN15 No code words. STA CNTR Set loop counter to -15. * * If the first word of the user supplied LEVEL code word is blank, we * will assign an access level of zero. We make this check in case the * entire code word array is blank filled so the blanks will not match * the first level in the DBCB which does not contain a code word. DBDS * fills undefined level code words with blanks. * CLA LDB LEVEL,I CPB BLNKS JMP OPN15 * * There are levels and user specified code word appears okay. Try to * find a match. * LDB AIRUN Loop on each level code word ADB DBLVL (15 in all) comparing user specified STB TEMP word with that in DBCB. * OPN13 LDA LEVEL JSB .CMW DEF D3 DEC 0 JMP OPN14 Code words match. * NOP LDB TEMP No match try next one. ADB D3 STB TEMP * ISZ CNTR If there is a next one. JMP OPN13 * CLA No match - user has level of zero. JMP OPN15 * OPN14 LDA CNTR A match - get level by adding ADA D16 16 to loop counter. * OPN15 STA LEVEL Save acces<"������þús level in LEVEL. * * Now, we need to determine the access the user has to each item in the * data base and set the Write and Read bits in the item's entry in the * Item Table. We do this by setting up a loop on the number of items * in the Run Table. * CLA,INA Set 1st item # to one. STA ITEM * LDB AIRUN Use negative of # of items ADB DBICT in data base as a loop counter. LDA B,I CMA,INA STA CNTR * CCA Set an accessible item flag STA NACC to FALSE. * * BEGIN LOOP * For each item in data base: * * 1) Get relative Item Table entry address through DBFDI. Then get * true address by adding to address of Run Table. * OPN16 JSB DBFDI DEF *+5 DEF ITEM DEF ITMNO DEF TEMP DEF ADDRS * LDB AIRUN ADB ADDRS * * 2) Check read and write levels in entry against LEVEL. If LEVEL < * read level, leave both W & R bits in entry clear. If LEVEL >= * read level set an accessible item flag to TRUE, then if LEVEL >= * write level set both W & R bits in entry, else clear W bit and * set R bit. * ADB ITINF LDA B,I ALF AND NIBBL CMA,INA ADA LEVEL LEVEL >= read level? SSA JMP OPN18 No - leave bits clear. * ISZ NACC Yes - make an accessible item NOP flag non-negative. * LDA MODE,I If open mode = 8, CPA D8 JMP OPN17 no need to check write level. * LDA B,I ALF,ALF AND NIBBL CMA,INA ADA LEVEL LEVEL >= write level? SSA JMP OPN17 * LDA WRITE Yes - set both bits. RSS OPN17 LDA READ No - set R bit only. * ADB D2 IOR B,I STA B,I * OPN18 ISZ ITEM Get next item's number ISZ CNTR if there is one JMP OPN16 and chuå������þúeck it. * * END OF LOOP * * If an accessible item flag is still FALSE (-1), user has no access to * anything in the data base * ISZ NACC RSS JMP E153 * * Now, we need to determine the access the user has to each data set in * the data base and set the Write and Read bits in the set's entry in the * Data Set Control Block Table entry for the set. We do this by setting * up a loop on the number of sets in the Run Table. * CLA,INA Set 1st set # to one. STA SET * LDB AIRUN Use negative of # of sets ADB DBSCT in base as a loop counter. LDA B,I CMA,INA STA CNTR * * BEGIN LOOP * For each set in data base: * * 1) Get relative DSCB address through DBFDS then get true address by * adding to address of Run Table. * OPN19 JSB DBFDS DEF *+5 DEF SET DEF SETNO DEF TEMP DEF ADDRS * LDB ADDRS ADB AIRUN STB ADDRS * * 2) Get # fields/entry of data set for an inner loop counter. * ADB DSFCT LDA B,I ALF,ALF AND LOBYT CMA,INA STA CNTR2 * * 3) Get address of set's Record Definition Table * INB LDA B,I ADA AIRUN STA RDTAD * * 4) Set non-writeable flag, clear inaccessible flag, set all * readable flag. * CLA STA NACC CMA STA NWRT STA ALRED * * 5) For each item in RDT, check accessibility of item through DBFDI. * If item non-writeable, clear non-writeable flag. If item readable * set inaccessible flag. If item not readable, clear all readable * flag. * OPN20 STA FIRST Set using 1st byte flag. * LDA RDTAD,I Each item in RDT takes one byte ALF,ALF get item # from 1st byte. OPN21 AND LOBYT STA ITEM * JSB DBFDI DEF *+5 DEF ITEM DEF ITMNO DEF TYPE DGÆ������þúEF TEMP * LDA TYPE If TYPE > 0 CMA,INA item is inaccessible. SSA,RSS JMP OPN2B ISZ ALRED Since it's inaccessible, NOP clear all readable flag. JMP OPN22 OPN2B SZA,RSS If TYPE < 0 ISZ NWRT item is writeable NOP CCA STA NACC * OPN22 ISZ CNTR2 Done with all items? RSS No JMP OPN24 Yes - get out of inner loop. * ISZ FIRST Were we on first byte? JMP OPN23 LDA RDTAD,I Yes - get 2nd byte JMP OPN21 and try it. * OPN23 ISZ RDTAD No - get 1st byte of next CCA word and try it. JMP OPN20 * * 5) If inaccessible flag still clear leave both W & R bits clear. * If open mode = 8, no need to check NWRT flag since user cannot * write anything. Else, if NWRT is clear, set R bit only else * set both bits. If all readable flag still set, set RA bit also. * OPN24 LDB NACC SZB,RSS JMP OPN26 * LDB MODE,I CPB D8 JMP OPN25 * LDB NWRT SSB,RSS JMP OPN25 LDA WRITE RSS OPN25 LDA READ LDB ALRED SSB IOR AREAD * LDB ADDRS ADB DSINF IOR B,I STA B,I * OPN26 ISZ SET Get next set's number ISZ CNTR if there is one JMP OPN19 and check it. * * All there is left to initializing the Run Table now is setting the root * file overhead and 16 FMP words in the DBCB * LDB AIRUN ADB DBFRL Free Record Table legnth LDA FRTLN in 15th word. STA B,I * INB Optimal # of DCBs LDA #DCBS in 16th word. STA B,I * INB Length of longest entry LDA ENTLN in 17th word. STA B,I * INB 16 FMP words from DCB LDA DBDCB in 18th through 33nd JSB .ML ������þúVW words. DEF D16 DEC 0 * * Run Table initialization is complete. Now, we need to schedule DBCOP * to add us to the co-ordinating table. If this succeeds, we are home * free. If it does not succeed, we need to undo everything we've done * so far. * * First, to call DBCOP, we need to merge the open mode in with the func- * tion code for adding an entry to the co-ordinating table. * LDB D2 Function code for adding an BLF,BLF entry is 2. Function code LDA MODE,I in 1st byte, open mode IOR B in 2nd byte. STA FC/MD * * Next, get this program's name. We send this to DBCOP as the optional * buffer in the EXEC scheduling call. * JSB PNAME DEF *+2 DEF PROGN * JSB EXEC DEF *+10 DEF NA23 DEF DBCOP DEF FC/MD DEF NAME DEF NAME+1 DEF NAME+2 DEF CRN DEF PROGN DEF D3 JMP ADDER Abortion return point. * JSB RMPAR DEF *+2 DEF ERROR * LDA ERROR If DBCOP returns an error - SZA it is proper IMAGE code. JMP COPER * * If the open mode is 1, DBCOP also returned the data base RN in RN. * Put it into the DBCB (7th word). * LDA MODE,I CPA D1 RSS JMP OPN27 LDB AIRUN ADB DBRSN LDA RN STA B,I * * We have a successful DBOPN. Put the data base pointer table index in * the first word of the base parameter and set up the status array as * follows: * word contents * ---- -------- * 1 zero * 2 user's assigned access level * 3 word length of Run Table * * Then, return to the user. * OPN27 LDA DBNUM STA BASE,I * CLA STA STAT,I ISZ STAT LDA LEVEL STA STAT,I ISZ STAT LDA RTLEN ADA FRTL±������þúN STA STAT,I * OPN28 CLA Set STAT to zero STA STAT for param check on next call. JMP DBOPN,I * * Error return points before clean up. * ERREX SSA A = error code, if negative CMA,INA make it positive. RSS E103 LDA D103 Illegal BASE parameter. RSS E115 LDA D115 Illegal DBOPN mode. RSS E117 LDA D117 Bad security code. RSS E119 LDA D119 Root file non-existant. RSS E129 LDA D129 Root file opened exclusively. RSS E140 LDA D140 Cannot schedule DBCOP. RSS E150 LDA D150 Data base already open to user. STA STAT,I JMP OPN28 * * The following error return point is seperated from the others because * the file which we opened expecting a root file must be closed. * E116 JSB ECLOS DEF *+2 DEF DBDCB,I * LDA D116 File specified is not a root file. STA STAT,I JMP OPN28 * * The following error return points are separate from all the others * because they are errors which occur after AIRUN has been set to the * address of the Run Table (rather than the address of the address) yet * the clean up routine expects AIRUN in the latter state. * E153 LDA D153 User has NO access to anything in d.b. RSS ADDER LDA D140 Abortion on a DBCOP schedule. COPER LDB RTPTR Restore AIRUN to address of address of STB AIRUN Run Table and branch to CLNUP. JMP CLNUP SKP * * The following code is the clean up routine which rewinds everything * DBOPN has done to change memory and disc data structures. There are * four major points at which we can enter the clean up routine. The * first is after the root file has been opened but no memory has been * allocated for the data base. The second is after the memory for the * Run Table has been allocated but before the record buffer has been * altered. The third i3#������þús after the record buffer has been altered. The * forth is after any DCB has been allocated and there were no DCB(s) from * any previous DBOPN. * * These points are signified by: * 1) AIRUN = 0 * 2) AIRUN NE 0, and SAVE = -1 * 3) SAVE NE -1, and SAVE NE DBRBL and DCBFL = 0 * 4) DCBFL = -1 * * We will process these backwards since 3 presupposes the rewind for 2 * which presupposes the rewind for 1. * CLNUP SSA On entry to clean up CMA,INA A = error code STA STAT,I make sure it's positive. * * First ,see if DCBFL = -1. If so, any DCBs allocated must be deallocated. * ISZ DCBFL JMP CLN0 No DCB clean up. * * Deallocation will be done by looping on each entry in the DCB pointer * table. If a DCB is pointed to by the entry (1st word of entry = -1) * the DCB is deallocated. * LDA DBDMX Use # entries in table CMA,INA as loop counter. STA CNTR * LDA DBDCP Get address of DCB STA TEMP pointer table. * * BEGIN LOOP * CLND1 LDA TEMP,I ISZ TEMP INA,SZA JMP CLND2 * JSB RETBF DEF *+2 DEF TEMP,I * SSA JMP CLND2 Ignore any errors. CLA CCB If no error, set 1st word ADB TEMP of entry to zero. STA B,I * CCA ADA DBDCT Decrement DCB count STA DBDCT * CLND2 ISZ TEMP Get next entry if there ISZ CNTR is one, and continue. JMP CLND1 * * END LOOP * * * Second, see if SAVE NE -1, and if so, see if SAVE = DBRBL. If not, * record buffer has been altered. * CLN0 LDA SAVE INA,SZA,RSS JMP CLN2 Save = -1 * LDA SAVE CPA DBRBL JMP CLN2 SAVE = DBRBL * * Record buffer has been altered. Deallocate the new one and if old * record buffer size non-zero, allocate a record buffer of old size. * JSB RETBF ÿ������þú DEF *+2 DEF DBRBP * SSA If any error, JMP CLN3 ignore and go to point 2. * LDB SAVE If no old record buffer SZB,RSS need not reallocate one. JMP CLN1 * JSB GETBF Else, get a record buffer DEF *+4 of old size. DEF SAVE DEF DBRBP DEF ERROR * CLB If any error ignore and SSA,RSS set record buffer size LDB SAVE to zero. Else set record CLN1 STB DBRBL buffer size to old size. JMP CLN3 * * Third, see if AIRUN = 0. If not, Run Table space has been allocated. * CLN2 LDA AIRUN SZA,RSS JMP CLN4 * * Run Table allocated, deallocate it ignoring any errors. * CLN3 JSB RETBF DEF *+2 DEF AIRUN,I * * The root file has always been opened by the time we reach CLNUP, so * no check is necessary, just close it ignoring any errors and return to * user. * CLN4 JSB ECLOS DEF *+2 DEF DBDCB,I * JMP OPN28 SKP * * Constants and variables. * M8 DEC -8 M7 DEC -7 M6 DEC -6 D1 EQU ZERO+1 D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D8 EQU ZERO+8 D15 EQU ZERO+15 D16 EQU ZERO+16 D17 EQU ZERO+17 D103 DEC 103 D115 DEC 115 D116 DEC 116 D117 DEC 117 D119 DEC 119 D128 DEC 128 D129 DEC 129 D140 DEC 140 D150 DEC 150 D153 DEC 153 D160 DEC 160 * NIBBL OCT 17 NA23 OCT 100027 LOBYT OCT 377 BLNKS ASC 1, DBCOP ASC 3,DBCOP WRITE OCT 140000 READ OCT 040000 AREAD OCT 020000 NEXCL OCT 1 IOPTN OCT 2 * DBNUM NOP FIRST NOP ITEM NOP SET NOP ADDRS NOP STCAR NOP TEMP NOP CNTR NOP FC/MD NOP NAME BSS 3 } NOTE: Do not change the order TYPE NOP } of these parameters. This SC NOP } is the 10 word array for CRN NOP } NAMR and parameters for ERROR NOP } return fÅ£���„��‚~rom DBCOP. RN NOP } NWRT NOP } NACC NOP } PATCH NOP } PROGN EQU ERROR Used for name from PNAME call. RTREC DEC 0,0 } NOTE: Do not change the order RTLEN NOP } of these parameters. FRTLN NOP } Overhead words from #DCBS NOP } root file put here. ENTLN NOP } DCBFL NOP RTPTR NOP FRTRC DEC 0,2 ALRED NOP SAVE NOP CNTR2 NOP RDTAD NOP ITMNO NOP SETNO NOP END ����������������������������������������������������������������������������������������������������������������������������������������������xþ„������ÿÿ����� ���� ÿý�²�Í ���������ÿ��92069-18137 2026� S C0122 �&DBINF &DBINF � � � � � � � � � � � � � �H0101 ðÑ�����þúASMB,L,C,R HED DBINF SUBROUTINE OF IMAGE/1000 NAM DBINF,7 92069-16137 REV.2026 800125 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18137 * RELOC: 92069-16137 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * JANUARY 22, 1980 TO ALLOW FOR SAVING OF CURRENT * RECORDS IN A MASTER SET - CEJ * * ******************************************************************* * * * * Data Base INFormation is one of the ten user callable IMAGE/1000 * library subroutines. DBINF's function is to reference the Run Table * to return information on the structure and current state of the data * base. DBINF has four general catagories of information it returns. * These are: * * 100 Series: Data Item Information * 200 Series: Data Set Information * 300 Series: Data Path Information * 400 Series: Current Path Information * * Each category contains specific requests. Each request is assigned a * DBINF mode. The modes allowed for DBINF are: * * 101 - determine data item number and accessibility. * 102 - describe data item * 103 - enumerate all accessible data items in the data base. * 104 - enumerate all accessible data items in a specific data set. * 201 - determine data set number and accessibility. * 202 - describe data set. * 203 - enumerate all accessible data sets in the data base. * 204 - enumerate all accessible data sets which containe a specific * data item. * 301 - enumerate all data sets linked to specific data set, the * ©>������þú detail data set search item numbers used for the links and * the sort item (if any) for the link. * 302 - determine the search item number of a specific master data set. * 401 - save current record information for a specific data set. * 402 - restore current record information for a specific data set * * The calling sequence for DBINF is: * * JSB DBINF * DEF *+6 return point * DEF IBASE data base about which information is to be returned. * This must be the same parameter as used in a * successful DBOPN call for the data base. * DEF ID a data set name or number or * a data item name or number * (When the mode calls for a specific set or item.) * DEF MODE request mode, legal values are as described above. * DEF STAT status return array of the form: * 1st word always the status word, zero on a suc- * cessful return * 2nd word contains the word length of the informa- * tion in the BUF parameter when 1st word is * zero. * DEF BUF buffer to contain returned information (supplied * information on a 402 call). A description of * the returned information in BUF precedes each * mode process in the following code. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) „µ������þú Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: opÉÜ������þúen mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSu1������þúFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** )A������þú *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * ENT DBINF EXT .DSBR,.ENTR,.MVW EXT AIRUN,DBFDI,DBFDS,DBIDS,RBINF A EQU 0 B EQU 1 * BASE NOP ID NOP MODE NOP STAT NOP BUF NOP * * Get true parameter and return point addresses. * DBINF NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA BUF SZA,RSS JMP E162 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is * on a remote machine, and to set up its Run Table as the current Run * Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * Uå������þú JSB RBINF Remote data base retunrn. DEF *+6 Ask RBINF to handle this request. DEF BASE,I DEF ID,I DEF MODE,I DEF STAT,I DEF BUF,I JMP INF2 Return to caller. * * Do a case on the mode parameter (MODE) to determine what kind of in- * formation the user requests and where to process the request. The case * is performed by dividing the mode parameter by 100 and checking the * bounds of the quotient and remainder. The quotient must be within * [1,4], the remainder within [1,4]. Then, use the two values as an index * into a jump table. Four entries in this table are actually error re- * turns since any combination of quotient within [3,4] and remainder * within [3,4] is invalid. * LOCAL LDA MODE,I SSA Is mode < 0? JMP E124 Yes - illegal mode. CLB DIV D100 * SZA,RSS Is quotient > 0 JMP E124 CMA,INA and <= 4? ADA D4 SSA JMP E124 No - illegal mode. * SZB,RSS Is remainder > 0 JMP E124 CMB,INB and <= 4? ADB D4 SSB JMP E124 No - illegal mode. * * Put quotient into bits 2 & 3 of A register and remainder in bits 0 & 1. * This becomes, then, a four bit index within [0,15] into the jump table. * The index numbers 0,1,4, and 5 are illegal. * ALS,ALS IOR B * ADA JMPTB JMP A,I * JMPTB DEF *+1 JMP E124 mode = 404 JMP E124 mode = 403 JMP M412 mode = 402 JMP M412 mode = 401 * JMP E124 mode = 304 JMP E124 mode = 303 JMP M302 mode = 302 JMP M301 mode = 301 * JMP M204 mode = 204 JMP M203 mode = 203 JMP M202 mode = 202 JMP M201 mode = 201 * JMP M104 mode = 104 JMP M103 mode = 103 JMP M102 mode = 102 JMP M101¨u������þú mode = 101 SKP * * Mode = 101. * BUF returned with: * word contents * ---- -------- * 1 + or - data item number, * positive if item read-only * negative if item readable and writeable * * ID should contain an item name or number. Ask DBFDI to get the item's * number and accessibility. * M101 JSB DBFDI DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS JMP M101A * * Mode = 201. * BUF returned with: * word contents * ---- -------- * 1 + or - data set number * (positive if set readable, and possibly updateable * negative if entries may be added or deleted from * the set.) * * ID should contain a data set name or number. Ask DBFDS to get the * set's number and accessibility for us. * M201 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * * If DBFDI (or DBFDS) returns a zero item (or set) number or sets the ac- * cessibility FLAG to > 0, the user gave us a bad item (or set) name or * number. Else if FLAG was set < 0 the item (or set) is writeable, negate * its number. * M101A LDA NUMBR SZA,RSS JMP E125 Bad item (or set) parameter. * LDB FLAG If the flag was set > 0 CMB,INB then this will set it < 0 SSB JMP E125 Bad item (or set) parameter. * SZB If item (or set) writeable, CMA,INA negate its number. * * Put the number in BUF array and set the length of the information in * BUF to 1 word. Then take the successful reply exit. * STA BUF,I CLB,INB JMP INF1 SKP * * Mode = 102. * BUF returned with: * word contents * ---- ----������þú---- * 1-8 data item name, left-justified and padded with * trailing blanks. * 9 bits 0-7 an ASCII blank * bits 8-15 ASCII data item type: either I, R, or X * 10 element length in words if type is I or R, * in bytes if type is X * 11 element count * 12-13 zero * * ID should contain an item name or number. Ask DBFDI to get the item's * number, accessibility and Item Table entry address (relative to begin- * ning of Run Table) for us. * M102 JSB DBFDI DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * * If DBFDI returned a zero item number or set the accessibility FLAG to * > 0, the user gave us a bad item parameter. * LDA NUMBR SZA,RSS JMP E125 Bad item parameter. * LDA FLAG CMA,INA SSA JMP E125 * * Item parameter okay. Move the item name (first 3 words of item's entry) * item type (low order byte of 4th word of item entry) and element count * (low order byte of 6th word of item entry) into the return buffer, pad- * ding the name to 16 characters with trailing blanks. Then calculate * the element length by dividing the item's length (7th word of item * entry) by the element count and store it in BUF. * LDA AIRUN Get true address of item's Item Table ADA ADDRS entry by adding to Run Table address. STA ADDRS LDB BUF Get address of BUF JSB .MVW and move the item name into it. DEF D3 DEC 0 * LDA M5 Pad it with 5 words of blanks. STA CNTR LDA BLNKS M102A STA B,I INB ISZ CNTR JMP M102A STB BUF Save place in BUF for later. * CCA Set item type is X FLAG STA FLAG to FALSE. LDB ADDRS Get item's type. ADB ITTYP LDA B,I AND LOBY”á������þúT ALF,ALF IOR ABLNK Pad it on bottom with a blank and STA BUF,I put it into BUF. ISZ BUF * CPA /X If item type is X, RSS JMP M102B CLA set FLAG to TRUE. STA FLAG * M102B ADB D2 Get element count LDA B,I AND LOBYT STA TEMP and save for divide. * INB Get item length in A & B regs. LDA B,I CLB ISZ FLAG If item type = X ALS (FLAG = TRUE) get length in bytes. * DIV TEMP Divide it by the element count. STA BUF,I A = element length. ISZ BUF * LDA TEMP STA BUF,I Put element count into BUF ISZ BUF * CLA CLB DST BUF,I End with two zeroes in BUF. * * BUF complete. Now set length of returned data to 13 and take the * successful reply exit. * LDB D13 JMP INF1 SKP * * Mode = 103. * BUF returned with: * word contents * ---- -------- * 1 n = data item count * 2 + or - data item number * . (positive if item read-only * . negative if item readable and writeable) * . * n+1 + or - data item number * * Ignore ID parameter. Get the uumber of items in the data base (7th * word of the DBCB) and loop for each item calling DBFDI to determine * accessibility of the item. If accessible, then store the current item * number (or the negative of the current item number if the item is * writeable) in the buffer array (BUF) and increment the accessible item * count. If inaccessible, just continue with next item. * M103 LDA AIRUN First get item count. ADA DBICT LDB A,I JMP M103A * * Mode = 203. * BUF returned with: * word contents * ---- -------- * ‚������þú 1 n = number of data sets * 2 + or - data set number * . (positive if entries may 'not' be added or deleted, * . negative if entries may be added or deleted.) * . * n+1 + or - data set number * * ID is ignored. Get the number of data sets in the data base (9th word * of the DBCB) and loop for each set calling DBFDS to determine the ac- * cessibility of the set. If accessible, then store the current set * number (or the negative of the set number if the set is writeable) in * BUF, and increment the accessible set count. If inaccessible, just * continue with next set. * M203 LDA AIRUN First get set count. ADA DBSCT LDB A,I * * Initialize loop parameters. * M103A CMB,INB Loop counter = STB CNTR negative of item (or set) count. CLB STB LENTH Zero to length of returned data. INB STB ID A 1 to first item (or set) number LDB BUF Save address of 1st word in BUF STB TEMP for later ISZ BUF then point BUF to its 2nd word. * * BEGIN LOOP * M103B LDA MODE,I If MODE = 103 CPA D103 call DBFDI JMP M103C else call DBFDS * JSB DBFDS Ask DBFDS to define the set's DEF *+5 accessibility for us. DEF ID DEF NUMBR DEF FLAG DEF ADDRS JMP M103D * M103C JSB DBFDI Ask DBFDI to define item's accessibility DEF *+5 for us. DEF ID DEF NUMBR DEF FLAG DEF ADDRS * M103D LDA NUMBR Item (or set) number can't be zero or SZA,RSS we've got a bad Run Table. JMP E160 * LDB FLAG If item (or set) inaccessible (FLAG > 0) CMB,INB SSB JMP M103E just continue on with next one. * SZB Else, if item (or set) writeable CMA,INA negate its number.òÖ������þú * STA BUF,I Put the number in the BUF array. ISZ BUF ISZ LENTH Bump the length/count parameter. M103E ISZ ID Continue with next item (or set), ISZ CNTR if there is one. JMP M103B * * LENTH now contains the number of accessible items (or sets) as well as * the combined word length of their numbers. Put the number of items (or * sets) in the first word of BUF (remember we saved it above in TEMP), and * increment the word length again for the word taken by the count. Then * take the successful reply exit. * LDB LENTH STB TEMP,I INB JMP INF1 SKP * * Mode = 104. * BUF returned with: * word contents * ---- -------- * 1 n = data item count * 2 + or - data item number * . (positive if item read-only * . negative if item readable and writeable) * . * n+1 + or - data item number * * ID should contain a data set name or number. Ask DBFDS to check ID * for validity and return us the accessibility of the set and its entry * address in the Data Set Control Block Table (relative to the start of * the Run Table) if it is valid. * M104 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If the returned set number SZA,RSS is zero JMP E125 * LDA FLAG or the asseccibility FLAG > 0 CMA,INA SSA JMP E125 then the user gave us a bad set reference. * * ID okay. Now, determine the number of items in the data set (high * order byte of the 7th word in the DSCB), and the address of the data * set's Record Definition Table. This is: * address of Run Table (in AIRUN) + * pointer to the data set's Info Table entry (in 8th word of the DSCB). * LDB ADDRS Address returned by DBFDS is rð%������þúelative ADB AIRUN to beginning of Run Table. ADB DSFCT LDA B,I ALF,ALF AND LOBYT A = # fields (items) in data set. CMA,INA Negate it for a loop counter. STA CNTR * INB LDA B,I ADA AIRUN A = set's RDT address STA NEXT save for loop. * * Now, for each item in the RDT, ask DBFDI to determine the accessibi- * lity of the item. If the item accessible, then if the item is write- * able, negate the item number, put item number in BUF. (Remember that * each item number in the RDT is stored in a byte. Therefore, each word * in the RDT is processed twice, once for its high byte item number, and * once for its low byte item number.) * LDA BUF Save address of 1st word in BUF STA TEMP array for later and ISZ BUF point BUF to its 2nd word. CLA Zero to the returned length/ STA LENTH item count word. * M104A CCA Set first flag to minus one, STA FIRST signifies that we are processing high byte. * LDA NEXT,I Get next item number ALF,ALF from high byte in RDT entry. M104B AND LOBYT STA ID * JSB DBFDI Ask DBFDI to check the item's DEF *+5 accessibility. DEF ID DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If item number returned as zero, SZA,RSS JMP E160 we have a bad Run Table. * LDB FLAG If accessibility FLAG set > 0 CMB,INB SSB JMP M104C just continue with next item. * SZB Else, if accessibility FLAG set < 0 CMA,INA negate item number. STA BUF,I Put number in BUF ISZ BUF and increment both BUF address ISZ LENTH and the item count. * M104C ISZ CNTR Are we through with all items? RSS JMP M104E Yes - wrap up this requeN°������þúst. * ISZ FIRST No - were we processing high order byte? JMP M104D No - get next word LDA NEXT,I Yes - get low order byte JMP M104B and process it. * M104D ISZ NEXT JMP M104A * * We are done with each item in the data set. LENTH contains the item * count. Put it in the first word of BUF, then increment it for the first * word and it is the word length of the information in BUF. Then return * successful to the user. * M104E LDB LENTH STB TEMP,I INB JMP INF1 SKP * * Mode = 202. * BUF returned with: * word contents * ---- -------- * 1-8 data set name, left-justified and padded with * trailing blanks * 9 bits 0-7: an ASCII blank * bits 8-15: ASCII data set type, either M, A, or D * 10 length of entry in words * 11-13 zero * 14-15 doubleword number of entries in set * 16-17 doubleword capacity of set * * ID should contain a set name or number. Ask DBFDS to get the set's * accessibility and Set Control Block Table entry address (relative to * beginning of Run Table). * M202 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * * If DBFDS returned a set number of zero or set the accessibility FLAG * to > 0, the user gave us a bad set reference. * LDA NUMBR SZA,RSS JMP E125 * LDA FLAG CMA,INA SSA JMP E125 * * Set reference okay. Move set name (first 3 words of DSCB) padded to * 8 words with blanks, set type (code in second nibble of high order byte * in 5th word of DSCB), and data record length (6th word of DSCB) into * BUF, then pad BUF with three zeroes. * LDA AIRUN Set's entry address of relative to ADA ADDRS beginning of Run Table. ‰d������þú STA ADDRS LDB BUF JSB .MVW DEF D3 DEC 0 * LDA M5 Pad name with 5 words of blanks. STA CNTR M202A LDA BLNKS STA B,I INB ISZ CNTR JMP M202A STB BUF * LDB ADDRS ADB DSTYP LDA B,I ALF,RAL Get two bit type code in sign and LDB /D least significant bits of reg. A. SLA,RSS If code = 0 (neither bit set) LDB /A data set an auto. master. SSA If code = 1 (sign bit set) LDB /M data set a manual master. STB BUF,I Else, data set a detail. ISZ BUF * LDB ADDRS Finally, get the data ADB DSDRL record length LDA B,I STA BUF,I Put it into BUF ISZ BUF and pad BUF with three zeroes. CLA STA BUF,I ISZ BUF STA BUF,I ISZ BUF STA BUF,I ISZ BUF * * Get capacity from DSCB (16th and 17th words) and save. Then determine * the number of records used in data set by: * number of records used = capacity of data set - * number of free records in set (1st & 2nd words in the data set's * entry in the free record table). * Store both the number of used records and the capacity (both double- * words) in BUF. * ADB D3 DLD B,I DST CAPAC * CCA Set's relative (to beginning of FRT) free record ADA NUMBR table entry is: (set # -1) * FRLNG. CLB MPY FRLNG * LDB AIRUN FRT's relative (to start of RT) address ADB DBFRP is in the 13th word of the DBCB. LDB B,I ADB AIRUN * ADA B Get FRT entry. DLD A,I # free records in first two words. JSB .DSBR Then subtract is from the capacity of set DEF CAPAC and A & B will be the # of used records. * DST BUF,I Put number of used records ISZ BUF ¤D������þú ISZ BUF DLD CAPAC and capacity of data set DST BUF,I into BUF. * * BUF complete. Set word length of returned data to 17 and take the * successful reply exit. * LDB D17 JMP INF1 SKP * * Mode = 204. * BUF returned with: * word contents * ---- -------- * 1 n = number of data sets * 2 + or - data set number * . (positive if entries may 'not' be added or deleted * . negative if entries may be added or deleted) * . * n+1 + or - data set number * * ID should contain an item name or number. Ask DBFDI to check it for * validity and accessibility. If valid, we also get the item's Item * Table entry address relative to the beginnig of the Run Table. * M204 JSB DBFDI DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR Item is invalid if SZA,RSS returned item number is zero. JMP E125 STA TEMP * LDA FLAG Item is inaccessible if CMA,INA returned accessibility FLAG > 0. SSA JMP E125 * * Get the number of sets this item is in (high order byte of 5th word * of item's entry) and first set's number (low order byte of 5th word * in entry). * LDB AIRUN ADB ADDRS ADB ITSET * LDA B,I ALF,ALF AND LOBYT CMA,INA Will use the negative of the # of STA CNTR sets as a loop counter. * LDA B,I AND LOBYT STA ID The loop starts with the 1st set for item. * CLA Set length/set count word to zero. STA LENTH * LDA BUF Save address of 1st word of BUF STA SAVE ISZ BUF and point BUF to its 2nd word. * * Will use the number of data sets in the data base - all data sets * previous to the first data set Tc������þúcontaining the data item as a loop * counter to tell us when all the data sets in the data base have * been checked. * LDA AIRUN ADA DBSCT LDA A,I CMA ADA ID STA CNTR2 * * Now, loop on each data set starting with the first set number and con- * tinuing in a serially increasing fashion, checking to see if the item * is in the data set's Record Definition Table until the number of data * sets the item is in is matched by the number of data sets in which the * item appears in the RDT. For each set the item appears in, determine * the set's accessibility (Note: if the set is totally inaccessible the * Run Table is corrupt since we know at least one item in the set which * is accessible). Put the number of the set (negated if set writeable) * in BUF. This loop also keeps a running count of the number of sets * containing the item. * M204A JSB DBFDS Ask DBFDS to get set's entry address DEF *+5 (relative to start of Run Table) DEF ID and accessibility. DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR Returned set number can't be zero SZA,RSS JMP E160 else Run Table is corrupt. * LDB AIRUN Get data set's item count (high ADB ADDRS order byte of 7th word of DSCB) ADB DSFCT LDA B,I ALF,ALF AND LOBYT CMA,INA and negate it for a loop counter STA ITCNT * INB and get data set's Record Definition LDA B,I Table address from pointer (in 8th word ADA AIRUN of DSCB) added to the address of the STA ADDRS Run Table. * * Each item in the RDT takes only one byte. Therefore each word in the * RDT is checked twice, once for the item in the high order byte and * once for the item in the low order byte. * M204B CCA Set processing first byte flag. STA FIRST LDA ADDRS,I ALF,‹°������þúALF Get item # from first byte. AND LOBYT * M204C CPA TEMP Does it match the one the user gave? JMP M204E Yes * ISZ ITCNT No - is it last in RDT? RSS JMP M204F Yes * ISZ FIRST No - were we processing 1st byte? JMP M204D No - get next word * LDA ADDRS,I Yes - get low byte. AND LOBYT JMP M204C * M204D ISZ ADDRS JMP M204B * * We come here when an item in the RDT matched the item the user gave us. * Determine if the set is writeable (NUMBR and FLAG from DBFDS have not * been changed) and store the appropriately signed set number in BUF. * M204E LDA NUMBR LDB FLAG SSB CMA,INA STA BUF,I ISZ BUF ISZ LENTH ISZ CNTR Found them all? JMP M204F No * * All data sets with the item found. Put set count (in LENTH remember) * into first word of BUF. Increment the count and it is the word length * of the information in BUF. Then take the successful reply exit. * LDB LENTH STB SAVE,I Save set to 1st word of BUF above. INB JMP INF1 * * Here when we are through with this data set. * M204F ISZ ID Continue on with next data set ISZ CNTR2 if there is one left. JMP M204A JMP E160 If not, the Run Table is corrupt! SKP * * Mode = 301. * BUF returned with: * word contents * ---- -------- * 1 n = number of paths * 2 data set number of related data set * 3 detail's search item number * 4 path's sort item number * . * . * . * 3n-1 data set number of related data set * 3n detail's search item number * 3n+1 path's sort item number * * ID should contian a data set name or number. Ask DBFDS to valiÀa������þúdify * ID and if valid to give us the data set's Data Set Control Block Table * entry address (relative to start of Run Table). * M301 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If the set # returned by DBFDS SZA,RSS is zero, JMP E125 user gave us a bad set reference. * LDB FLAG If the returned accessibility FLAG CMB,INB is > 0 SSB JMP E125 user gave us a bad set reference. * * Get the set's number of paths from the DSCB (low order byte of the * 7th word). Then calculate the Path Table address by: * Path Table address = Pointer to Info Table (8th word of DSCB) + * (# of fields in set <<high order byte of 7th word of DSCB>> - 1) / 2 + * address of Run Table. * LDB AIRUN ADB ADDRS ADB DSPCT LDA B,I AND LOBYT SZA,RSS If path count is zero JMP M301D skip around the processing below. CMA,INA Negate # paths for a loop counter. STA CNTR * LDA B,I Get # fields ALF,ALF AND LOBYT INA increment and divide by two ARS INB add in the relative address of the Info Table ADA B,I ADA AIRUN then add in the address of the Run Table. STA NEXT * * Loop on each path, determining if its search item number in the Path * Table entry is accessible. (Note: this item always belongs to the * detail.) If so, put related data set's number (2nd byte of the PT * entry) and the detail search item number (1st byte of the PT entry) * in BUF followed with the number of the item on which the path is * sorted. The sort item is in the second word of the path table entry. * It is put into BUF only if it is accessible by the user. Each time * an accessible path is incountered, the path counter is also increased. * LDA BUF SaqQ������þúve address of 1st word in BUF for later. STA TEMP ISZ BUF Point BUF to its 2nd word. * CLA Set path count to zero. STA LENTH M301A LDA NEXT,I Get search item # from PT entry. ALF,ALF AND LOBYT STA ID * JSB DBFDI Ask DBFDI to determine the DEF *+5 item's accessibility. DEF ID DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If DBFDI returned a zero item # SZA,RSS JMP E160 the Run Table is corrupt. * LDB FLAG If DBFDI set the accessibility CMB,INB FLAG to > 0 SSB then item is inaccessible, JMP M301C skip this path * LDA NEXT,I Else, store related data set # AND LOBYT STA BUF,I ISZ BUF LDA NUMBR and detail's item # into BUF STA BUF,I ISZ BUF * LDB NEXT Get sort item's number. INB LDA B,I * SZA,RSS If zero, JMP M301B no sort item. * STA ID JSB DBFDI Ask DBFDI to determine DEF *+5 sort item's accessibility. DEF ID DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If DBFDI returned a zero, SZA,RSS the Run table is corrupt! JMP E160 * LDB FLAG If FLAG > 0, CMB,INB item is inaccessible. SSB CLA * M301B STA BUF,I Store sort item # or zero in BUF. ISZ BUF * ISZ LENTH Bump the path count M301C ISZ NEXT and the Path Table entry address. ISZ NEXT ISZ CNTR Are we through with all paths? JMP M301A No - continue with next path. * * We come here at the end of the Path Table processing. LENTH contains * the number of paths that had accessible search items (and therefore * the number of paths whose description is in BUF. Put the count in the * first word #À������þúof BUF. Then multiply the count by three and add 1, this * gives us the word length of the information in BUF, and take the suc- * cessful reply exit. * LDA LENTH Address of 1st word of BUF STA TEMP,I saved above in TEMP. CLB MPY D3 INA LDB A JMP INF1 * * We come here when the data set has no paths. Set the path count in * BUF to zero and the length of returned data to one, then take the * successful reply exit. * M301D STA BUF,I CLB,INB JMP INF1 SKP * * Mode = 302. * BUF returned with: * word contents * ---- -------- * 1 master's search item number * 2 zero * * ID should contain a master data set name or number. Ask DBFDS to check * the validity of the data set reference and five us the set's Set Control * Block Table entry address (relative to start of Run Table) if the set * is valid. * M302 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If DBFDS returned a set # of zero SZA,RSS JMP E125 * LDB FLAG or an accessibility FLAG of > 0 CMB,INB (i.e. set inaccessible) SSB JMP E125 user gave us a bad set reference. * * Now check if the data set is a master. The set type code is in the * 2nd nibble of the 5th word of the DSCB. If it is a master get its * search item number (high order byte of 11th word of DSCB). * LDB AIRUN ADB ADDRS ADB DSTYP LDA B,I ALF If type = 2 SSA (sign bit set after the rotate) JMP E123 the data set is a detail. * ADB D6 LDA B,I ALF,ALF AND LOBYT STA ID * * Ask DBFDI to check accessibility of search item. If it is accessible, * put the search item followed by a zero in BUF. If not, pòÈ������þúut two zeroes * in BUF. * JSB DBFDI DEF *+5 DEF ID DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If DBFDI returned a zero item # SZA,RSS JMP E160 the Run Table is corrupt. * LDB FLAG If DBFDI returned a > 0 accessibility FLAG, CMB,INB SSB CLA item is inaccessible. * STA BUF,I ISZ BUF CLA STA BUF,I * * Set returned data word length to two and take the successful reply * exit. * LDB D2 JMP INF1 SKP * * Mode = 401 or 402 * For mode 401 BUF returned with: * word contents * ---- -------- * 1-2 doubleword record number of the most recently * accessed record * 3-4 doubleword record number of previous record in * chain if a detail, zero if a master * 5-6 doubleword record number of next record in chain * if a detail, zero if a master * 7 path number of current chain if a detail, zero * if a master * * For mode 402 BUF is passed to us with the above information. * * ID should contain a data set name or number. Ask DBFDS to check * it for validity and pass us the data set's entry in the Data Set Control * Block Table (relative to start of Run Table). * M412 JSB DBFDS DEF *+5 DEF ID,I DEF NUMBR DEF FLAG DEF ADDRS * LDA NUMBR If DBFDS returned a zero SZA,RSS set number JMP E125 * LDA FLAG or an accessibility FLAG CMA,INA of > 0 SSA JMP E125 the set reference is bad. * * Get the data set's DSCB address and index into record information. * LDB AIRUN ADB ADDRS STB ADDRS ADB DSRCN * * If mode is 401, move the current, previous and next r± ������þúecord numbers * from the DSCB (12th through 17th words) and the current path number * (low order byte of 11th word of the DSCB) into BUF. * LDA MODE,I CPA D402 JMP M402 * LDA B Get current chain info LDB BUF and put into BUF. JSB .MVW DEF D6 This puts record #s into BUF. DEC 0 STB BUF Save place in BUF. * LDB ADDRS Now get current path number. ADB DSPAN LDA B,I AND LOBYT STA BUF,I JMP M412B * * If mode 402, move the three record numbers from BUF into the 12th * through 17th words of the DSCB, and put the path number in BUF into * the DSCB (low order byte of 11th word). * M402 LDA BUF Move the record numbers JSB .MVW into the DSCB. DEF D6 DEC 0 * STA BUF Save adress of current path # in BUF. LDB ADDRS ADB DSPAN Get its word in DSCB LDA B,I Save off the serach item # in AND HIBYT high byte of word and IOR BUF,I put in path number STA B,I then restore it in DSCB. * * Set length of given information in BUF to 7 and take the successful * reply exit. * M412B LDB D7 SKP * * Successful return point - set status word in STAT array to zero and * put length (in B register) into 2nd word of STAT. * INF1 CLA STA STAT,I ISZ STAT STB STAT,I INF2 CLA Set BUF to zero for STA BUF param check on next entry. JMP DBINF,I * * Error returns * E103 LDA D103 Data base not properly opened. RSS E123 LDA D123 Data set not a master. RSS E124 LDA D124 Illegal DBINF mode. RSS E125 LDA D125 Invalid or inaccessible data RSS item or data set. E160 LDA D160 Corrupt Run Table. RSS E162 LDA D162 Missing parameter. STA STAT,I Put error code into STAT JMP ÑN�����ŽŠINF2 and return to user. * * Constants and variables * M5 DEC -5 D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D6 EQU ZERO+6 D7 EQU ZERO+7 D13 EQU ZERO+13 D17 EQU ZERO+17 D100 DEC 100 D103 DEC 103 D123 DEC 123 D124 DEC 124 D125 DEC 125 D160 DEC 160 D162 DEC 162 D402 DEC 402 * LOBYT OCT 377 HIBYT OCT 177400 * ABLNK OCT 040 BLNKS ASC 1, /D ASC 1,D /A ASC 1,A /M ASC 1,M /X ASC 1,X * FLAG NOP NUMBR NOP ADDRS NOP LENTH NOP CNTR NOP CNTR2 NOP TEMP NOP } Note: Do NOT change the order of these unless NEXT NOP } you make sure CAPAC (a doubleword) will not CAPAC EQU TEMP } overwrite some valuable information. * CAPAC is used in mode 202. ITCNT NOP FIRST NOP SAVE NOP END ����������������������������������������"������ÿÿ����� ���� ÿý�³�Ð ���������ÿ��92069-18138 2026� S C0122 �&DBFND &DBFND � � � � � � � � � � � � � �H0101 ìÌ�����þúASMB,L,C,R HED DBFND SUBROUTINE OF IMAGE/1000 NAM DBFND,7 92069-16138 REV.2026 800121 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18138 * RELOC: 92069-16138 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base FiND is one of the ten user callable subroutines in the * IMAGE/1000 library. DBFND performs the function of preparing a detail * data set for future chain reads. It does this by using the key item * number and value specified by the user to determine the path in the * detail data set specified by the user and the master to which this path * is linked. It then performs a hashed-read into the master data set * using the key item value to find the entry in the master which has that * key item. The chain information in the master entry's media record * is then used to initialize the current path information in the detail's * Data Set Control Block. * * The calling sequence for DBFND is: * * JSB DBFND * DEF *+7 return point * DEF IBASE data base parameter used in succesful DBOPN call * for the data base in which the set to be ini- * tialized resides. * DEF SET the name or number of the detail data set to * be prepared for chain reads. * DEF MODE DBFND mode = 1 * DEF STAT returned 10 word status array which is of the * form: * }n������þú 1st word - status code (0 if successful) * 2nd word - zero * 3rd & 4th words - doubleword current record * number set to zero * 5th & 6th words - doubleword count of detail * entries in the chain * 7th & 8th words - doubleword record number of * chain foot * 9th & 10th words - doubleword record number * of chain head * DEF ITEM detail's key item number for desired chain * DEF ARG key item's value for desired chain * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow.  —������þú * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 éF������þú item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * tP������þú * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** ±–������þú *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * ENT DBFND EXT .ENTR,.MVW,AIRUN,DBFDI,DBFDS,DBHRD,DBIDS EXT DBRBP,RBFND A EQU 0 B EQU 1 * BASE NOP SET NOP MODE NOP STAT NOP ITEM NOP ARG NOP * * Get true parameter and return point addresses. * DBFND NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA ARG SZA,RSS JMP E162 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is * on a remote machine, and to set up its Run Table as the current Run * Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * JSB RBFND Remote data base return. DEF *+7 Ask RBFND to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF ITEM,I DEF ARG,I JMP FND7 Return to caller. * * Set should contain a detail data set name. Ask DBFDS to validify the * set reference and, if valid, return us the set's Data Set Control Block * Table entry address (relative to beginning of Run Table). * LOCAL JSB DBFDS DEF *+5 DEF SET,I DEF DSNUM DEF FLAG DEF STADR * LDA DSNUM If DBFDS returned a set number of zero SZA,RSS JMP E100 * LDB FLAG or set the accessibility FLAG > 0 CMB,INB ž������þú (data set inaccessible) SSB JMP E100 then the user gave us a bad set reference. * * Check if the set is a detail (type code in 2nd nibble of high order * byte of the 5th word of the DSCB). If so, ITEM should contain the * name or number of a key item in the detail data set. Ask DBFDS to * check the validity of the item reference and, if valid, pass us the * item number and Item Table entry address (relative to the beginning of * the Run Table). * LDB AIRUN ADB STADR STB STADR ADB DSTYP LDA B,I If type = 2 (sign bit set after rotate) ALF SSA,RSS the set is a detail. JMP E120 * JSB DBFDI Set is a detail, now check DEF *+5 item for validity. DEF ITEM,I DEF ITNUM DEF FLAG DEF ITADR * LDA ITNUM If DBFDI returned a data item SZA,RSS number of zero JMP E101 ALF,ALF (Put item # in high byte for later.) STA ITNUM * LDB FLAG or set the accessibility FLAG > 0 CMB,INB SSB JMP E101 then the user gave us a bad item reference. * * Now that we have the item's number, check that the Find mode is equal * to 1. If it is, get the data set's path count (low order byte of 7th * word of DSCB) and calculate the Path Table's relative pointer by: * Path Table pointer = Info Table pointer (8th word of DSCB) + * (number of items in data set <<high order byte of 7th word of DSCB>> * +1) / 2. * LDA MODE,I CPA D1 RSS JMP E115 * LDB STADR ADB DSFPC LDA B,I AND LOBYT A = # paths for data set. SZA,RSS If # paths = zero JMP E121 data set has no chain to initialize. * STA PTNUM Save path count for later. CMA,INA Use negative # paths STA CNTR for a loop counter. * LDA B,I CalculS2������þúate address of path table ALF,ALF AND LOBYT A = # items in data set INA add one ARS divide by two INB ADA B,I add in pointer to Info Table ADA AIRUN and resolve with address of Run Table STA PTADR * * Check if item is in the data set's Path Table (and is therefore a key * item) by looping on each entry in the Path Table comparing the item * number to the key item number (in high order byte of entry) for the * path. * FND1 LDA PTADR,I Get next entry's item # AND HIBYT CPA ITNUM and do the compare. JMP FND2 A match! * ISZ PTADR No match - get next entry ISZ PTADR ISZ CNTR if there is one JMP FND1 and try it. * * We fall through loop to here when the item could not be found in the * path table. Return error to user. * JMP E102 * * We come here when a match is found between the user specified item * and a key item. The current Path Table entry has the master's set * number (low order byte). Get it and save for hash read call. Then, * get the path number for this key by adding what is left of the loop * counter to the data set's path count + 1 and save this for a successful * wrap up. * FND2 LDA PTADR,I AND LOBYT STA SET * LDA PTNUM ADA CNTR INA STA PTNUM * * Call DBHRD to find the master's record number countaing the key item * value. DBHRD signifies a successful read by returning a zero in the * ERROR parameter and a zero (TRUE) in the read FLAG. * JSB DBHRD DEF *+7 DEF BASE,I It needs the data base number DEF SET master data set number DEF ARG,I and key item value. DEF FLAG DEF RECRD Returns record number here. DEF ERROR * LDA ERROR If DBHRD encountered an error SZA JMP ERREX retu1š������þúrn it to the user. * LDA FLAG If it couldn't find a master record SZA with the key item value JMP E107 let the user know. * * Now that we have the record, determine the master's path for this * detail. First we need to get the master's Data Set Control Block. * JSB DBFDS DEF *+5 DEF SET DEF STNUM DEF FLAG DEF MSADR * LDA STNUM If DBFDS returned a zero set number SZA,RSS JMP E160 the Run Table is corrupt. * * Get the master's path count and Path Table address. * (PT address calculated as above for detail.) * LDB AIRUN ADB MSADR ADB DSFPC LDA B,I AND LOBYT CMA,INA Use negative of path count STA CNTR for a loop counter. * LDA B,I ALF,ALF AND LOBYT INA ARS INB ADA B,I ADA AIRUN STA PTADR * * Loop on each entry in the Path Table, calculating an index into the * media record of the master's entry, until the detail's set and key * item numbers are matched by the set and item number in the Path Table * entry. * LDB D5 Set index initially to five * (skips over synonym pointers). LDA ITNUM Merge detail's set and IOR DSNUM item numbers. STA TEMP * FND3 LDA PTADR,I CPA TEMP JMP FND4 Sets matched. * ADB D6 No match - add length of this path's ISZ PTADR pointers to the index ISZ PTADR ISZ CNTR and check next path. JMP FND3 * * We fall through loop here if there is no match - * means we have a corrupt Run Table. * JMP E160 * * Sets matched. B-reg contains proper index. Add it to the record * buffer address to get this path's count and pointers in the master * data set media record. * FND4 LDA DBRBP ADA B õË������þúSTA PTADR * * If path count = zero, this detail has no records on the chain of this * key value. * DLD PTADR,I Path count is a doubleword value. SZB,RSS SZA JMP FND5 JMP E156 * * Path count not zero. Move chain information into the detail's Data * Set Control Block and the status array as follows: * * current search item # -> high order byte of 11th word of DSCB * current path number -> low order byte of 11th word of DSCB * current record # = 0 -> 3rd & 4th words of STAT array * and 12th & 13th words of DSCB * path count -> 5th & 6th words of STAT array * previous record # = * record # of chain foot-> 7th & 8th words of STAT array * and 14th and 15th words of DSCB * next record # = * record # of chain head-> 9th & 10th words of STAT array * and 16th & 17th words of DSCB * FND5 LDA STAT Set TEMP to point to the 2nd INA word of the STATus array. STA TEMP * LDB STADR ADB DSCPN LDA ITNUM } Combined key item number IOR PTNUM ] and path number in DSCB STA B,I * INB Bump place in DSCB to STB STADR record number holders. * CLA CLB STA TEMP,I Pad 2nd word of STAT with a zero ISZ TEMP and bump to current record # holder. * DST STADR,I Current record # = 0. DST TEMP,I * LDA PTADR Path count, chain foot, and chain head LDB TEMP into STAT array. ADB D2 JSB .MVW DEF D6 DEC 0 * LDA PTADR Chain foot and chain head ADA D2 LDB STADR into DSCB ADB D2 JSB .MVW DEF D4 DEC 0 * * Return successful to user. * CLA Zero to status word in STAT. FND6 STA STAT,I FND7 CLA Set ARG to zero for ST> ���B��@<A ARG param check on next entry. JMP DBFND,I * * Error return points. * ERREX SSA Here on an error from DBHRD, CMA,INA if negative make it positive. JMP FND6 E100 LDA D100 Invalid data set reference. JMP FND6 E101 LDA D101 Invalid data item reference. JMP FND6 E102 LDA D102 Invalid search (key) item. JMP FND6 E103 LDA D103 Improperly opened data base. JMP FND6 E107 LDA D107 No master record with key value. JMP FND6 E115 LDA D115 Illegal DBFND mode. JMP FND6 E120 LDA D120 Data set not a detail JMP FND6 E121 LDA D121 Detail has no paths. JMP FND6 E156 LDA D156 No detail records on chain. JMP FND6 E160 LDA D160 Corrupt Run Table. JMP FND6 E162 LDA D162 Missing parameter. JMP FND6 * * Constants and variables. * D1 EQU ZERO+1 D2 EQU ZERO+2 D4 EQU ZERO+4 D5 EQU ZERO+5 D6 EQU ZERO+6 D100 DEC 100 D101 DEC 101 D102 DEC 102 D103 DEC 103 D107 DEC 107 D115 DEC 115 D120 DEC 120 D121 DEC 121 D156 DEC 156 D160 DEC 160 D162 DEC 162 * LOBYT OCT 377 HIBYT OCT 177400 * FLAG NOP ERROR NOP STNUM NOP DSNUM NOP STADR NOP ITNUM NOP ITADR NOP PTADR NOP CNTR NOP PTNUM NOP RECRD BSS 2 MSADR NOP TEMP NOP END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������^B������ÿÿ����� ���� ÿý�´�Ä ���������ÿ��92069-18139 2026� S C0122 �&DBGET &DBGET � � � � � � � � � � � � � �H0101 õÔ�����þúASMB,L,C,R HED DBGET SUBROUTINE OF IMAGE/1000 NAM DBGET,7 92069-16139 REV.2026 800222 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18139 * RELOC: 92069-16139 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * ALTERED: FEBRUARY 22, 1980 TO SPEED UP DBGET WHEN PASSED * IN AN "@ " FOR AN ITEM LIST - CEJ * * ******************************************************************* * * * * Data Base GET is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to retrieve data from the data * base. It does this by reading an entry of the data set specified by * the user, pulling the vlues for any items the user specified out of the * data record of the entry and putting them into a user specified buffer. * * The user can specify which entry in the data set is to be read in seven * different way. Each method of reading corresponds to a DBGET mode. * These modes (and methods) are: * * 1 - reread the most recently accessed entry of the data set. * 2 - find and read the next non-empty entry in the data set from the * most recently accessed entry and proceding in a serial mono- * tonically increasing fashion. * 3 - find and read the previous non-empty entry in the data set to * the most recently accessed entry and proceding in a serial * monotonically decreasing fashion. * 4 - read the entry number specified by the user. * 5 - read the next record, along the current path of the detail data * set, from the mosK:������þút recently accessed record. * 6 - read the previous record, along the current path of the detail * data set, to the most recently accessed record. * 7 - find and read the record of the manual master data set contain- * ing the user specified value. * * There is one special function performed by DBGET in mode 4. If the * record number specified by the user is zero, the data set is effect- * ively rewound by setting the most recently accessed entry number in * the data set to zero. In this case, no data is transfered to the user. * * The calling sequence for DBGET is: * * JSB DBGET * DEF *+8 return point * DEF IBASE the data base parameter used on a successful * DBOPN call for the data base from which * data is to be retrieved. * DEF ISET the name or number of the detail or manual * master data set from which data is to be * retrieved. * DEF IMODE DBGET mode, values are as described above. * DEF ISTAT a ten word array in which the following is * returned to the user: * word contents * ---- -------- * 1 error code (zero if successful) * If successful: * 2 word length of data returned. * 3-4 record # of entry read * 5-6 zero * 7-8 record # of predecessor of entry * read along current chain * 9-10 record # of successor of entry * read along current chain * DEF LIST ¡7������þú a list of item names or numbers whose values * are to be returned to the user from the * entry read * DEF IBUF the buffer into which the item values of the * items specified in LIST are to be put con- * catenated together in the order of the * items in LIST * DEF IARG a doubleword record number for mode 4 * or * the key item value for mode 7 * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** PÛ������þú *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type Þß������þúITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * 2y������þú * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * åc������þú * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBGET EXT .DCO,.DDS,.DIS,.DSBR,.ENTR,.MVW,AIRUN EXT DBFDS,DBHRD,DBIDS,DBPIL,DBRBP,DBRED,RBGET,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP ARG NOP * * Get true parameter and return point addresses * DBGET NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA ARG SZA,RSS JMP E162 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is on * a remote machine, and to set up its Run Table as the current Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * JSB RBGET Remote data base return. DEF *+8 Ask RBGET to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I DEF ARG,I JMP GET9 Return to caller. * * Ask DBFDS to check the validity of SET. If it is valid, DBFDS will * return the set number, accessibility and Data Set Control Block Table * entry address (relative to beginning of Run Table). * LOCAL JSB DBFDS DEF *+5 DEF SET,I DEF DSNUM DEF FLAG DEF DSADR * LDA DSNUM If returned set # = zero SZA,RSS (invalid set reference) JMP E100 * LDB FLAG or accessibility FLAG > 0 CMB,INB (set inaccessible) SSB JMP E100 user gave us a bad set reference. * * Now, set FLAG t÷*������þúo signify what data set type we have. Type code 0 or * 1 is a master and FLAG is set to -1. Type code 2 is a detail and FLAG * is set to zero. * CCA Set FLAG to -1 to start out. STA FLAG * LDB AIRUN Then get true address of DSCB, ADB DSADR ADB DSTYP and bump to type word LDA B,I Put type bits in sign & least ALF,RAL significant bits of A reg. SLA If least sig. bit set - we have a detail JMP GET1 JMP GET2 Else - a master data set. * GET1 ISZ FLAG NOP * * If the user gave us an "@ " in the item list, then check if the set's * all readable bit (bit 13 of the 5th word of the DSCB) is set. If so, * put an "@ ", the length of the data record, and two zeros in the first * four words of TEMPX. If bit not set, return an error 101 to the user. * If the list does not contain an "@ ", ask DBPIL to process the item * list the user gave us. * GET2 LDA LIST,I The first word of LIST contains the "@ " CPA AT if it is there. RSS JMP GET2A * LDA B,I An "@ " given, is RA bit set? RAL,RAL SSA,RSS JMP E101 No - error 101 * LDA AT Yes - set up TEMPX STA TEMPX,I INB LDA B,I LDB TEMPX INB STA B,I CLA INB STA B,I INB STA B,I JMP GET2B Branch around call to DBPIL. * GET2A JSB DBPIL DEF *+4 DEF LIST,I DEF DSADR DEF PATH# * SZA JMP ERREX No - inform user of error. * GET2B LDB AIRUN Yes - get true address of DSCB ADB DSADR and save for later. STB DSADR * * Do a CASE on the mode of DBGET. Mode should be within [1,7] so check * its bounds then use the mode as an index into a jump table which puts * us at the proper process for the mode. * LDA MODE,I SSA ¾Ô������þú Is mode < 0? JMP E115 Yes - error! SZA,RSS No - is mode = 0? JMP E115 Yes - error! * CMA,INA No - is mode > 7? ADA D7 SSA JMP E115 Yes - error! * ADA JMPTB No - index into jump table JMP A,I and perform jump. * JMPTB DEF *+1 JMP MOD7 mode = 7 JMP MD56 mode = 6 JMP MD56 mode = 5 JMP MOD4 mode = 4 JMP MD23 mode = 3 JMP MD23 mode = 2 JMP MOD1 mode = 1 SKP * * Mode = 1, reread current record in data set. * Get current record number from the DSCB (12th & 13th words), and ask * DBRED to do a directed read on it. * MOD1 LDB DSADR Get address of DSCB ADB DSRCN bump to current record # address DLD B,I and pick it up. * SZB,RSS Is it zero? SZA RSS JMP E157 Yes - no current record DST RECRD No - put it in DBRED call. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base number DEF DSNUM data set number DEF RECRD and record number. * SZA If any error, JMP ERREX pass it to the user. * * Check to see that the entry is not empty. (Flag in first word of media * record non-zero.) If it is empty give the user an error. If its not, * go to process the items the user desires. * LDA DBRBP,I SZA,RSS JMP E114 Entry is empty. JMP GET5 Non-empty, a successful read. SKP * * Mode = 2 or 3, get (next or previous) record by serially reading data * set. * To do either of these we set up a loop which read from the current * record (+1 or -1) until a non-empty entry or the (end or beginning) * of the data set is found. * * First prepare the loop parameters. * MD23 LDB DSADR ADB DSCAP Get and save data set's STB =ˆ������þúARG capacity address. ADB D3 Pick up current record number. DLD B,I DST RECRD * LDA MODE,I If we are processing a mode 3 request CPA D2 JMP MD23B LDA RECRD Make sure that the current record number SZB,RSS is not zero. SZA JMP MD23C DLD ARG,I It's zero, set it to the DST RECRD capacity of the data set. JMP MD23D * * BEGIN LOOP * While record number (+1 or -1) is (LE capacity of data set or GT zero) * read record number (+1 or -1). If record empty continue with (next or * previous) record number. If record non-empty, wrap up the serial read * and process the items the user desires. If (end or beginning) of set * found before a non-empty record is, return an error to the user. * MD23A LDA MODE,I CPA D3 If mode = 3 JMP MD23C jump to record decrement. * MD23B JSB .DIS Else, increment record. DEF RECRD RSS JMP E12 (In case of wrap around.) * DLD ARG,I If record # now GT JSB .DCO capacity of data set DEF RECRD RSS JMP E12 return EOF error. JMP MD23D * MD23C JSB .DDS DEF RECRD RSS If previous record is zero JMP E12 BOF error. * MD23D JSB DBRED Ask DBRED to read this record. DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to the user. * LDA DBRBP,I No - is this entry empty? SZA,RSS JMP MD23A Yes - continue in loop * JMP GET3 No - we've got the record we want. SKP * * Mode = 4, read the record the user specified in ARG or if ARG = 0, * reset the current record number in DSCB to zero. * ARG should be a doublewLË������þúord record number. If it is not zero, make sure * it falls within the bounds of [1,capacity of data set]. If it is zero, * set the current record number in the DSCB to zero and the current path * number to zero and return successful to the user. * MOD4 DLD ARG,I DST RECRD SZB,RSS SZA JMP MOD4A It's non-zero, go to next process. * LDB DSADR It's zero - ADB DSPAN set current path # (low order byte LDA B,I of 11th word of DSCB) to zero AND HIBYT STA B,I * INB and set the current record # CLA (12th & 13th words of DSCB) STA B,I to zero INB STA B,I * STA LENTH Set returned data length to zero JMP GET7 and take the successful serial read exit. * * ARG was non-zero, make sure it is non-negative and less than or equal * to the data set's capacity as well. * MOD4A SSA JMP E111 Negative! * LDB DSADR Get data set's capacity ADB DSCAP STB ARG LDB RECRD+1 Get 2nd word of value back JSB .DSBR and do compare. DEF ARG,I SSA JMP E111 Greater than capacity! * * Record number okay. Read the entry. If it is non-empty wrap up as * if this were a serial read. If it is empty, that's an error. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did we get an error from DBRED? JMP ERREX Yes - pass it back to user. * LDA DBRBP,I No - is entry empty? SZA,RSS JMP E114 Yes - inform user of error. * JMP GET3 No - a successful read. SKP * * Mode = 5 or 6, read (next or previous) record along current chain. * The data set must be a detail (FLAG set long ago to zero) and there * must be a current5Ä������þú chain. The current path # (low order byte of 11th * word of DSCB) will be non-zero if there is one. * MD56 ISZ FLAG If FLAG = -1 RSS JMP E120 set is a master. * LDB DSADR Now, ADB DSPAN is there a current path? LDA B,I AND LOBYT SZA,RSS JMP E111 No - inform user. * STA PATH# Yes - save path # for (much) later. * * Data set okay so far, now get (next or previous) record along current * chain from DSCB (next is in 16th & 17th words of DSCB, previous in * 14th & 15th). If it is zero, we've reached another error condition - * (end or beginning) of chain. * LDA MODE,I Pointer to previous in 14th & 15th CPA D6 Pointer to next record in 16th & 17th LDA D3 words of DSCB. * ADB A DLD B,I SZB,RSS SZA RSS JMP E155 EOC or BOC! DST RECRD * * Record checks out. Ask DBRED to read it for us. If it is empty, the * data base is corrupt. If it is non-empty, wrap up chain read and pro- * cess the items the user desires. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: the data base # DEF DSNUM data set number DEF RECRD and record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it back to user. * LDA DBRBP,I No - is the entry empty SZA,RSS JMP E154 Yes - bad chain pointers! * JMP GET4 No - a successful read. SKP * * Mode = 7, hash-read into a master. * Data set must be a master (FLAG set long ago to -1) and ARG should * contain its key value. * MOD7 ISZ FLAG Check that data set is a master. JMP E123 It's not - error. * JSB DBHRD It is - ask DBHRD to do the DEF *+7 hash-read for us. DEF BASE,I It needs: the data base # DEF DSNUM data sHÜ������þúet number DEF ARG,I key item value DEF FLAG Returned read flag. DEF RECRD Returned record number. DEF STAT,I Returned error code. * * Check for any errors. First, check STAT for a returned error code. * If it is not zero, pass the error on to the user. Then check the read * FLAG. If it is not zero, a master with the specified key value could * not be found, so tell the user. If all okay, wrap up this process as * if this were a serial read. * LDA STAT,I SZA JMP ERREX DBHRD encountered an error. * LDA FLAG SZA JMP E107 No master with that key value. SKP * * We come here at the end of a successful serial, directed or hashed * read. Set the current path number in the DSCB (low order byte of 11th * word) to zero. * GET3 LDB DSADR ADB DSPAN First, the path number. LDA B,I Make sure we don't wipe out the AND HIBYT search item # in the high byte. STA B,I JMP GET5 Go to process the item values. * * We come here at the end of a successful chain read. Determine * the index of the current path into the media record of the entry. * This will be used to move the backward (previous) and forward (next) * record pointers into the DSCB. * GET4 LDB DSADR ADB DSBWN B = addr. for previous & next record #s CCA Saved path number long ago in PATH#. ADA PATH# Index for this path = ALS,ALS (path # - 1) * 4 ADA D3 + 3 (for used/unused flag & free pointer. ADA DBRBP Get true address of path pointers. * * Now, move backward & forward pointers (address in A register) into * previous & next record number places in DSCB (address in B register). * These are both doublewords. * JSB .MVW DEF D4 DEC 0 SKP * * We join most of the processes here (excluding a mode 4 call with a * record nu¢Ó������þúmber of zero) to set the current record number in the DSCB * (12th and 13th words) to the number of the record just read and set * up the return value BUFfer. * GET5 LDB DSADR First, the current record #. ADB DSRCN LDA RECRD STA B,I INB LDA RECRD+1 STA B,I * * Now, we need to move the values of the items the user desires from * the data record of the entry into the buffer the user supplied for * us. We have each of the items' numbers, word lengths, and indices * into the data record in the TEMPX table set up by DBPIL. Each entry * in this table looks like: * * word * +-----------------------------------+ * 1 |W |K |S | | item # | -> entire word * ------------------------------------- is zero at * 2 | word length of item | end of list * ------------------------------------- * 3 | index into data record of entry | * +-----------------------------------+ * 15 14 13 8 7 0 bit * * W, K, & S are ignored in this subroutine but if set mean: * W - item is writeable * K - item is a key item * S - item is a sort item * * We are going to set up a loop which takes each entry in the table and * moves the specified number of words from the data record address + * index of item into the current position of the BUFfer array. First * we must initialize a few parameters for the loop. * CLA Set length of returned STA LENTH data to zero. * LDB DSADR Determine data record address = ADB DSMDL length of media record (low LDA B,I order byte of 5th word of DSCB) AND LOBYT + address of record buffer. ADA DBRBP STA DRADR Save address for loop. * LDA TEMPX Get ¡<������þúTEMPX table address & STA ITTAB LDB BUF BUFfer address for loop. * * BEGIN LOOP * While item # NE zero, move item length number of words from data * record + item index into current BUFfer location. LENTH = LENTH + * item length. * GET6 LDA ITTAB,I If item # = 0 SZA,RSS JMP GET7 we are through with move of data. * ISZ ITTAB Else, get length of data LDA ITTAB,I to be moved, STA MVLEN * ISZ ITTAB get index of item in LDA ITTAB,I data record then ADA DRADR get its address * JSB .MVW then perform the move. DEF MVLEN DEC 0 * LDA LENTH Update returned data length ADA MVLEN STA LENTH ISZ ITTAB get next entry in TEMPX table JMP GET6 and continue. SKP * * We come here at the end of the value move process or the end of a suc- * cessful mode 4 call with record number of zero. Set up the first six * words of the STATus return array as follows: * word contents * ---- -------- * 1 zero * 2 word length of data transfered * 3-4 doubleword current record number (in RECRD) * 5-6 doubleword zero * GET7 CLA STA STAT,I ISZ STAT * LDA LENTH STA STAT,I ISZ STAT * LDA RECRD STA STAT,I ISZ STAT LDA RECRD+1 STA STAT,I ISZ STAT * CLA STA STAT,I ISZ STAT STA STAT,I ISZ STAT * * Now we split up return processing between chained read and non-chained * reads. For a chained read the remaining four words of STATus array * contain the following: * word contents * ---- -------- * 7-8 doubleword record # of predecessor of current record * along current chain * êB������þú 9-10 doubleword record # of successor of current record * along current chain. * * For a non-chained read, both of these doubleword values are zero. * LDB MODE,I CPB D5 Forward chained read? JMP GET8 or CPB D6 Backward chained read? JMP GET8 Yes - separate processing. * STA STAT,I No - pad rest of STATus array ISZ STAT with zeroes. STA STAT,I ISZ STAT STA STAT,I ISZ STAT STA STAT,I * JMP GET9 Return to user. * * Chained read - return previous and next record numbers (14th through * 17th words of DSCB) in remainder of STATus array. * GET8 LDB STAT LDA DSADR ADA DSBWN JSB .MVW DEF D4 DEC 0 * GET9 CLA Set ARG to zero for STA ARG param check on next entry. JMP DBGET,I Return to user. * * Error return points * ERREX SSA If error returned from another subroutine CMA,INA is negative - make it positive. RSS E12 LDA D12 EOF or BOF error. RSS E100 LDA D100 Bad set reference. RSS E101 LDA D101 Bad item list. RSS E103 LDA D103 Improperly opened data base. RSS E107 LDA D107 No master entry with key value. RSS E108 LDA D108 Request directed at an auto master. RSS E111 LDA D111 Chain not set up (modes 5 & 6) RSS or record # illegal (mode 4). E114 LDA D114 Record accessed is empty. RSS E115 LDA D115 Invalid DBGET mode. RSS E120 LDA D120 Data set not a detail. RSS E123 LDA D123 Data set not a master. RSS E154 LDA D154 Data Base corrupt. RSS E155 LDA D155 Beginning or end of chain. RSS E157 LDA D157 No current record RSS E162 LDA D162 Missing parameter. STA STAT,I Set statÍ,���f��d`us word in array JMP GET9 and return to user. * * Constants and variables. * D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D6 EQU ZERO+6 D7 EQU ZERO+7 D12 EQU ZERO+12 D100 DEC 100 D101 DEC 101 D103 DEC 103 D107 DEC 107 D108 DEC 108 D111 DEC 111 D114 DEC 114 D115 DEC 115 D120 DEC 120 D123 DEC 123 D154 DEC 154 D155 DEC 155 D157 DEC 157 D162 DEC 162 * LOBYT OCT 377 HIBYT OCT 177400 AT ASC 1,@ * FLAG NOP DSNUM NOP DSADR NOP RECRD BSS 2 PATH# NOP LENTH NOP DRADR NOP MVLEN NOP ITTAB NOP END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Ÿf������ÿÿ����� ���� ÿý�µ�Ë ���������ÿ��92069-18140 2026� S C0122 �&DBUPD &DBUPD � � � � � � � � � � � � � �H0101 õÞ�����þúASMB,L,C,R HED DBUPD SUBROUTINE OF IMAGE/1000 NAM DBUPD,7 92069-16140 REV.2026 800121 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18140 * RELOC: 92069-16140 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base UPDate is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to replace non-key item values * for items which the user has write access in the current record of the * specified manual master or detail data set with the values supplied * by the user. * * The calling sequence for DBUPD is: * * JSB DBUPD * DEF *+7 return point * DEF BASE the data base parameter used in a successful DBOPN * on the data base in which an entry is to be up- * dated. The data base must have been opened in * either mode 1 or mode 3. * DEF SET data set name or number of the data set in which * the current entry is to be updated. * DEF MODE DBUPD mode = 1. * DEF STAT a ten word array in which the status of the call * is returned. This subroutine only uses the first * two words in which it returns: * word contents * ---- -------- * 1 error code (zero if successful) * I’~������þúf successful: * 2 word length of data in BUF * DEF LIST a list of items whose values in the data record * of the current entry in SET are to be replaced * by the values in BUF. Non-writeable and key * items may appear in this list but their values * in BUF must be identical to their values in the * data record. * DEF BUF the values of the items to replaced concatenated * together and in the same order as the items in * LIST. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * **********************u)������þú************************************************* *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item:ë������þú write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * ÒQ������þú * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPT?*������þúR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBUPD EXT .CMW,.ENTR,.MVW,AIRUN,DBFDS,DBIDS EXT DBPIL,DBRBP,DBRED,DBWRT,RBUPD,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP * * Get true parameter and return addresses. * DBUPD NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA BUF SZA,RSS JMP E162 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is on * a remote machine, and to set up its Run Table as the current Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param JMP LOCAL Local data base return. * JSB RBUPD Remote data base return. DEF *+7 Ask RBUPD to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I JMP UPD6 Return to caller. * * Make sure that the data base is open in a proper mode for updating the * open mode (low order byte of 14th word of DBCB) must be either 1 or 3. * Also, if the open mode is 1, make sure the data base is locked to the * user (lock flag is high order byte of 14th word of DBCB). The lock * flag will be negative if the data base is locked. * LOCAL LDB AIRUN DBFRT puts address of Run Table in ADB DBMOD AIRUN - bump to open mode. LDA B,I AND LOBYT CPA D1 Mode = 1? JMP UPD0 Yes CPA D3 Mode = 3? JMP UPD1 `†������þú Yes JMP E104 No - open mode improper. * UPD0 LDA B,I Open mode is 1, SSA,RSS is data base locked? JMP E159 No - cannot do Update. * * Now make sure the Update MODE = 1. * UPD1 CLA,INA CPA MODE,I RSS JMP E115 Not one, illegal update mode. * * Ask DBFDS to check the validity of the SET parameter and if valid to * give us the set's accessibility and Set Control Block Table entry ad- * dress relative to beginning of Run Table. * JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set parameter DEF STNUM returns: set number DEF FLAG accessibility DEF STADR entry address * LDA STNUM If returned set # = 0 SZA,RSS (set invalid) JMP E100 * LDA FLAG or accessibility FLAG > 0 CMA,INA (set inaccessible) SSA JMP E100 user gave us a bad set reference. * * Now, check that the set is not an automatic master and that there is * a current record number for the set. Type code (2nd nibble of high * order byte of 5th word of DSCB) will be zero for an automatic master. * The current record number in the DSCB (12th and 13th words) will be * non-zero if a current record exists. * LDB AIRUN Add Run Table address to set's ADB STADR relative address to get true ADB DSTYP address - bump to type code. LDA B,I ALF,RAL Type code in sign & least sig. bits of A SSA,RSS after rotate - are they now SLA both zero? RSS JMP E108 Yes - user cannot update an auto. master. * ADB D7 Point to current record # DLD B,I and pick it up. SSA Is it negative? JMP E160 Yes - Run Table corrupt! SZB,RSS Is it zero? SZA RSS JMP E157 Yes - no c›¢������þúurrent record to update * DST RECRD No - save for later * * Ask DBPIL to process the item LIST given to us by the user. * JSB DBPIL DEF *+4 DEF LIST,I DBPIL needs: item list DEF STADR set's entry address DEF FLAG returns: # keys * SZA Did DBPIL encounter an error? JMP ERREX Yes - pass it to the user. * * DBPIL successfully processed item list. Now, ask DBRED to reread the * current record for us. It puts the record into the record buffer * pointed to by DBRBP. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF RECRD record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to user. * LDA DBRBP,I No - Is the entry empty? SZA,RSS (i.e. Flag in media record = 0?) JMP E114 Yes - inform user of error. * * Everything checks out so far. Now, we are going to build a loop to * transfer the data item values from the user's buffer into the data * record. DBPIL set up all the information we need for the data trans- * fer in the TEMPX table. This table has one entry for each item speci- * fied by the user, and each entry is of the form: * * word +-----------------------------------+ * 1 |W |K |S | | item number | * ------------------------------------- * 2 | word length of item | * ------------------------------------- * 3 | index into data record of entry | * +-----------------------------------+ * * 15 14 13 8 7 0 bit * * where: * W if set means the item is writeable * K if set means the item is a key item * S if set means the item is a sort item * * The loop looks at the first word of each entry. If the wÒû������þúord is zero, * the process is stopped. If either the W bit is not set or the K or S * bit is, a comparison of the user supplied value with the value in the * data record for this item is done. If the two values do not match, we * halt processing and pass the user an error. If they match, no data * transfer is made and we just continue on with the next item. If the W * bit is set and the K and S bits are not, we just blindly transfer the * value for the item supplied by the user into the word(s) in the data * record for the item, and continue on with the next entry. In addition, * the loop maintains a running total of the lengths of the items in the * TEMPX table, whether or not a data transfer occurs. * * First, set up the loop parameters. * CLA A zero to the total word length STA LENTH of the values in BUF. * LDA TEMPX STA ITTAB Set up the TEMPX table address. * LDB STADR Determine the address of the ADB AIRUN data record = ADB DSMDL length of media record LDA B,I (low order byte of 5th word of DSCB) AND LOBYT ADA DBRBP + address of record buffer. STA DRADR * LDA BUF Get address of user's buffer. * * BEGIN LOOP * While item # is non-zero: If item writeable and not a key or sort item, * move item length number of words from user buffer into data record * address + index of item. If item not writeable or item is a key or sort * item, compare item length number of words from user buffer to data * record address + index of item - if not a match, error. LENTH := LENTH * + item length. * UPD2 LDB ITTAB,I Item number = 0? SZB,RSS JMP UPD5 Yes - done with data transfer STB FLAG No - save W, K, & S bits for later. * ISZ ITTAB Set up move or compare length. LDB ITTAB,I STB CM/MV * ISZ ITTAB Bump ITTAB to index word/&������þú. * LDB FLAG Get W, K, & S bits again. SSB,RSS Item writeable? JMP UPD3 No - do compare. RBL Yes - SSB item a key? JMP UPD3 Yes - do a compare. RBL No - item a sort item? SSB JMP UPD3 Yes - do a compare. * LDB ITTAB,I No - get address of item ADB DRADR in data record. * JSB .MVW Do a move of the item value DEF CM/MV from user's buffer DEC 0 into data record. JMP UPD4 * UPD3 LDB ITTAB,I Get address of item in ADB DRADR data record. * JSB .CMW Do a compare of the item value DEF CM/MV in the user's buffer DEC 0 with that in the data record. JMP UPD4 The values are equal. NOP Unequal values - JMP E112 error. * UPD4 LDB LENTH Move or compare successful. ADB CM/MV Add length of item STB LENTH to total. ISZ ITTAB Get next entry in TEMPX JMP UPD2 and continue. * * The transfer and/or compare of all item vlaues succeeded. Ask DBWRT * to write and post the updated record to disc. * UPD5 JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF STNUM data set # DEF RECRD record number * SZA Did DBWRT encounter an error? JMP ERREX Yes - pass it to user. * * Update successful. Set up STATus array to contain the following: * word contents * ---- -------- * 1 zero * 2 word length of data in BUF * * and return to the user. * STA STAT,I LDA LENTH ISZ STAT STA STAT,I * UPD6 CLA Set BUF to zero for STA BUF param check on next entry. JMP DBUPD,I * * Error retur‘4���B��@<n points. * ERREX SSA If error returned by another CMA,INA subroutine < 0, make it > 0. RSS E100 LDA D100 Invalid set reference. RSS E103 LDA D103 Improperly opened data base. RSS E104 LDA D104 Improper open mode for an update. RSS E108 LDA D108 Set referenced is an auto. master. RSS E112 LDA D112 Attempt to change a key, sort, or RSS non-writeable item value. E114 LDA D114 Record accessed is empty. RSS E115 LDA D115 Invalid DBUPD mode. RSS E157 LDA D157 No current record number. RSS E159 LDA D159 Data base not locked to user. RSS E160 LDA D160 Corrupt Run Table. RSS E162 LDA D162 Missing parameter. * STA STAT,I Set error code in STAT JMP UPD6 and return to user. * * Constants and variables. * D1 EQU ZERO+1 D3 EQU ZERO+3 D7 EQU ZERO+7 D100 DEC 100 D103 DEC 103 D104 DEC 104 D108 DEC 108 D112 DEC 112 D114 DEC 114 D115 DEC 115 D157 DEC 157 D159 DEC 159 D160 DEC 160 D162 DEC 162 * LOBYT OCT 377 * FLAG NOP STNUM NOP STADR NOP RECRD BSS 2 ITTAB NOP DRADR NOP LENTH NOP CM/MV NOP END ��������������������������½FB������ÿÿ����� ���� ÿý�¶�Æ ���������ÿ��92069-18141 2026� S C0122 �&DBPUT &DBPUT � � � � � � � � � � � � � �H0101 î�����þúASMB,L,C,R HED DBPUT SUBROUTINE OF IMAGE/1000 NAM DBPUT,7 92069-16141 REV.2026 800125 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18141 * RELOC: 92069-16141 * * PRGMR: CEJ * ALTERED: JANUARY 21, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base PUT is one of the ten user callable subroutines in the IMAGE/ * 1000 DBMS library. Its function is to add a new entry to a manual * master or detail data set. For a detail data set this possibly in- * cludes adding a new entry to any automatic master data sets related * to the detail. * * The calling sequence for DBPUT is: * * JSB DBPUT * DEF *+7 return point * DEF BASE the data base parameter used in a successful * DBOPN call for the data base in which an * entry is to be added. The data base must * have been opened in either mode 1 or 3, and * if mode 1 must have been previously locked * to the user. * DEF SET the name or number of the manual master or * detail data set in which the entry is to * be added. * DEF MODE DBPUT mode = 1. * DEF STAT a ten word status array in which the follow- * ing is returned: * word contents * ---- 4������þú-------- * 1 status code (0 if successful) * If successful: * 2 word length of contents of BUF * 3-4 new entry's record number * 5-6 count of entries in * - last chain if detail * - synonym chain if master * 7-8 record number of predecessor in * - last chain if detail * - synonym chain if master * 9-10 record number of successor in * - last chain if detail * - synonym chain if master (zero) * DEF LIST a list of item names or numbers of the items * in the data set which are to receive values * in the new entry. Must contain all key * items in the data set. * DEF BUF the values for the items in LIST concatenated * together and in the same order as the items * in LIST. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table õë������þú * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10  Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a da¿‡������þúta entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN C¤������þú 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * ùw������þú * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBPUT EXT .CMW,.DCO,.DDE,.DDS,.DIN,.DIS,.ENTR,.FSB,.MVW EXT AIRUN,DBBAM,DBCBI,DBCIX,DBDME,DBFDI,DBFDS,DBFWZ EXT DBHRD,DBIDS,DBMST,DBPIL,DBRED,DBRBL,DBRBP,DBWFR EXT DBWRT,RBPUT,TEMPX * BASE NOP SET NOP MODE NOP STAT NOP LIST NOP BUF NOP * * Get true parameter and return point addresses * DBPUT NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA BUF SZA,RSS JMP E162 Missing parameter. * * Ask DBIDS to check the data base specified by the BASE parameter to * see if it is on a remote machine, and to set up its Run Table as the * Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * JSB RBPUT Remote data base returW–������þún. DEF *+7 Ask RBPUT to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I DEF LIST,I DEF BUF,I JMP PUT6 Return to caller. * * Make sure that the open mode allows a DBPUT, that is that the open * mode is either 1 or 3. (Open mode is in low order byte of 13th word * of the DBCB.) Also, if the open mode is 1, make sure the data base is * locked to the user. (Lock flag in high order byte of 13th word of * DBCB.) The lock flag will be negative if the data base is locked. * LOCAL LDB AIRUN DBFRT puts address of Run Table ADB DBLMD in AIRUN - bump to open LDA B,I mode / lock flag word. AND LOBYT CPA D1 Is open mode = 1? JMP PUT1 Yes CPA D3 Is open mode = 3? JMP PUT2 Yes JMP E104 No - invalid open mode for a PUT. * PUT1 LDA B,I Open mode = 1, SSA,RSS Is data base locked? JMP E159 No - cannot do PUT. * * Data base checks out. Ask DBFDS to check the validity of SET for us * and, if valid, to give us the set's accessibility and Set Control Block * Table entry address (relative to start of Run Table). * PUT2 JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set parameter DEF STNUM returns: data set number DEF FLAG accessibility flag DEF STADR and entry address * LDA STNUM If returned set # = 0 SZA,RSS (set invalid) JMP E100 * LDA FLAG or accessibility FLAG > 0 CMA,INA (set inaccessible) SSA JMP E100 user gave us a bad set reference. * * Now, make sure the set is writeable (returned accessibility FLAG < 0) * and that the set is not an automatic master. Type code (2nd nibble * of high order byte of 5th word of DSCB) is zero if the set is an auto- * ml¡������þúatic master. If not an auto. master, set FLAG to indicate if it is * a manual master or detail data set. Type code = 1 for a manual master * and FLAG will be set to -1. Type code = 2 for a detail and FLAG will * be set to zero. * SZA,RSS If FLAG is non-zero now, JMP E118 CCA set is writeable. STA FLAG Make set type FLAG < 0. * LDB AIRUN Get true address of DSCB. ADB STADR ADB DSTYP Bump to type word. LDA B,I Put type code in sign and ALF,RAL least sig. bits of A reg. SLA If least sig. bit is set, JMP PUT3 type = 2, set a detail. SSA,RSS If sign bit is set, JMP E108 type = 1, set a MM. RSS * PUT3 ISZ FLAG Detail type FLAG = 0. NOP * * Now make sure the DBPUT MODE is 1 and that the set has a free entry * to put a record in. * LDA MODE,I CMA,INA INA,SZA Is MODE = 1? JMP E115 No - bad PUT mode * CCA Yes - calculate address of set's ADA STNUM entry in Free Record Table = ALS,ALS (set number - 1) * 4 LDB AIRUN + pointer to FRT in DBCB ADB DBFRP (12th word) ADA B,I ADA AIRUN + address of Run Table * DLD A,I 1st doubleword of entry SZB,RSS contains # of free records. SZA Is it zero? JMP PUT4 No - set okay ISZ FLAG Yes - if this is a detail set JMP E105 return error # 105 JMP E106 else return error # 106. * * Set checks out. Ask DBPIL to process the item list the user gave us * setting up the TEMPX table with the information we need to perform a * data transfer on the items and returning the number of keys the user * specified in the list. * PUT4 JSB DBPIL DEF *+4 DEF LIST,I DBPIL needs: the item list VÔ������þú DEF STADR set's entry address DEF KEYS returns: the # of keys * SZA Did DBPIL encounter an error? JMP ERREX Yes - pass it to user. * * All combined initial error checking done, now split processing between * manual master and detail data set types. * ISZ FLAG If FLAG = 0 JMP PUTD a detail, else a manual master. SKP * * Manual master data set Put. * * A manual master entry may only be added if the user specified the mas- * ter's key item in the item LIST and if an entry containing the value * the user specified for the key item does not already exist in the data * set. First we want to check that the number of keys the user specified * in the item LIST is 1 (passed to us by DBPIL in KEYS). If this check * succeeds, get the master's key item number from its DSCB (high order * byte of 11th word of DSCB) and ask DBCBI to determine the index of the * item into the value BUFfer the user passed us. * LDA KEYS CMA,INA INA,SZA Is # keys = 1? JMP E102 No - cannot put the new record. * LDB AIRUN Yes - get set's key item # ADB STADR ADB DSCCT LDA B,I ALF,ALF AND LOBYT STA KEYS * JSB DBCBI Ask DBCBI to compute its DEF *+3 INDEX into BUF. DEF KEYS DBCBI needs: key item # DEF INDEX returns: INDEX into BUF * LDA INDEX Did DBCBI succeed? SSA (i.e. is INDEX >= 0?) JMP E160 No - Run Table is corrupt! * * Compute adress of key item value by adding the index to the address * of BUF and ask DBHRD to see if there is another entry with this key * item value. * ADA BUF STA KEYS KEYS = address of key item value * JSB DBHRD DEF *+7 DEF BASE,I DBHRD needs: data base # DEF STNUM data set # DEF KEYS,Ë������þúI key item value DEF READ returns: READ flag DEF RECRD record # of last entry read DEF STAT,I any error it received * * For us, and for us alone, DBHRD returns the number of synonyms on the * chain in the A & B registers. Save them for a successful return. * DST SYCNT * LDA STAT,I Did DBHRD encounter an error? SZA JMP ERREX Yes - pass it to user. * LDA READ No - did it match an entry? SZA,RSS (i.e. is READ flag = 0?) JMP E110 Yes - cannot put new record. * * The new entry may be added now. DBHRD in its process of looking for * an entry with the user specified key value also performed more ser- * vices for us. If it found no matching record, the record number it * passed to us is either the record number for the new record or the * record number of the last record on the new record's synonym chain. * In addition, the record corresponding to the record number it passed * us is still in the record buffer. We will pass all of this informa- * tion to DBMST. It will determine the record number for the new mas- * ter and prepare the new master's media record for us, zero-filling * the remainder of the entry. It returns any error condition code in * the A register, zero if successful. * JSB DBMST DEF *+5 DEF BASE,I Pass DBMST all the info DEF STNUM given us by DBHRD. DEF READ Will return new record # in RECRD DEF RECRD (-1 if no free record). * SZA Did DBMST encounter an error? JMP ERREX Yes - pass it to user. * LDA RECRD No - did it get us the SSA new record? JMP E160 No - but the R.T. says it's there! * * Now that the media record is built, the data record for the entry is * moved into the record buffer by calling DBMDR. It uses the TEMPX t7U������þúable * set up by DBPIL to do this. When DBMDR returns to us, we write the * new entry to disc. * * Then, if the new record is a synonym, we update the old synonym chain * foot by setting its forward pointer to the new record number. * Then, the free record table is updated to show that another record has * been used by decrementng the free record count in the first two words * of the data set's entry in the free record table, and then writing and * posting the table back to the root file through DBWFR. * * At this point, if all disc accesses were successful, we return to the * user with a successful DBPUT status array. * JSB DBMDR Ask DBMDR to move the DEF *+2 data values from the user's buffer DEF STADR into the data record for us. * JSB DBWRT Put the new record out to disc. DEF *+4 DEF BASE,I DBWRT needs: data base # DEF STNUM data set # DEF RECRD record number * SZA Did DBWRT encounter an error? JMP ERREX Yes - pass it to the user. * CLB No - zero synonym save areas. DST SYNYM DST SAVE1 * LDB DBRBP Is the new record an LDA B,I end of a synonym chain? SSA,RSS JMP PUTM6 * INB Yes - get the old end of DLD B,I synonym chain. DST SYNYM * JSB DBRED Ask DBRED to get the entry DEF *+4 from disc. DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF SYNYM record number * SZA Did DBRED encounter an error? JMP ERREX Yes - pass it to the user. * LDA DBRBP No - make old synonym chain ADA D3 foot's forward synonym chain STA TEMP pointer the new record's DLD RECRD record number. DST TEMP,I * JSB DBWRž������þúT Then, write the updated DEF *+4 synonym back to disc. DEF BASE,I DEF STNUM DEF SYNYM * SZA If any error - JMP ERREX pass it to the user. * PUTM6 CCA Calculate set's entry in ADA STNUM Free Record Table = ALS,ALS (set number - 1) * 4 LDB AIRUN ADB DBFRP + pointer to FRT in DBCB ADA B,I (12th word) ADA AIRUN + address of Run Table STA TEMP * JSB .DDS Decrement free record count DEF TEMP,I (1st & 2nd words of FRT entry) NOP * JSB .DIS Increment number of records DEF SYCNT on the synonym chain NOP * JMP PUT5 then write FRT to disc & return to user. SKP * * Detail Data Set Put. * * A detail data set entry may be added if the user specified all the * detail's key items and sort items (if any) in the item LIST, and if * all manual master data sets related to the detail have an existant * entry with the associated key's item value, and all automatic master * data sets related to the detail either have an existant entry or have * have room to create an entry with the associated key item value. * * First, make sure that the number of keys the user specified in the * item LIST (passed to us by DBPIL in KEYS) is equal to the # paths/entry * in the DSCB (low order byte of 7th word). * PUTD LDB AIRUN ADB STADR ADB DSPCT LDA B,I AND LOBYT CPA KEYS If not equal - RSS JMP E102 missing search item. * * We are going to take a shortcut in processing the detail in the case * of a successful non-sorted Put. First, for each path in the detail, * we update its associated master entry. This involves either updating * a manual or automatic master entry chain pointers or putting a new * automatic master entry for this chain. * * During tháõ������þúis path processing, we are building the new entry's media re- * cord in temporary storage. When the path processing for all the mas- * ters for the new entry's chains has been completed, the new entry's * media record is moved into the record buffer and its data record is * built in the record buffer then written onto disc. * * Then, for each path in the detail, we update any old records in the * detail data set to point forward or backward to the new record. * * During the processing of the master entries, we are keeping a list of * the data set and record numbers and media record index for each master * entry we have successfully updated or added. Should an error occur * (either hard (disc) or soft such as a manual master does not contain * an entry with the key value) we step backward in the processing un- * doing everything we have done up to this point which altered the data * on the disc. We do this, instead of running through the error check- * ing on each related master before putting the new record and then up- * dating each master, in the hope that in the general case of a successful * non-sorted Put, there will be less disc accesses and therefore the Put * will take less time. * * First, we need to initialize the temporary storage areas for the media * record and master record numbers to zero. Then set up their addresses * for the path processing. * JSB DBFWZ DEF *+3 media record storage is 64 words DEF D113 master record # storage is 49 words DEF MEDST these are concatenated in memory. * LDA MEDST STA PATHI LDA MSTST STA MSTRI * * Get address of next free record number in the detail data set. It's * the 3rd and 4th words of the detail's entry in the Free Record Table. * This address is: (detail data set # - 1) * 4 + pointer to FRT in DBCB * (12th word) + address of Run Table. * CCA ADA STNUM ALS,ALS LDB AIRUN %O������þú ADB DBFRP ADA B,I ADA AIRUN ADA FRPTR STA NEXT * DLD NEXT,I If the next free record is zero SZB,RSS we have a corrupt Run Table. SZA RSS JMP E160 * * Set up loop for master chain update. # paths/entry in detail is same * as the contents of KEYS, negate it for a loop counter. Get the detail's * Path Table address to pull out the values for the loop. Path table * address = (# fields/entry in detail <<high order byte of 7th word of * DSCB>> + 1) / 2 + pointer to Info Table entry <<8th word of DSCB>> + * address of Run Table. * LDA KEYS If detail has no paths SZA,RSS JMP PTD10 jump around the master update. * CMA,INA STA CNTR1 * LDB AIRUN Calculate Path Table address. ADB STADR ADB DSFCT LDA B,I ALF,ALF AND LOBYT INA ARS INB ADA B,I ADA AIRUN STA PTADR * * BEGIN MASTER UPDATE LOOP * For each path in the detail: * * 1) Get the detail's key item number from the Path Table entry (high * order byte) and the master's set number (low order byte). * PTD1 LDA PTADR,I ALF,ALF AND LOBYT STA DKEY * LDA PTADR,I AND LOBYT STA MNUM * * 2) Determine the address of the key item's value in the user's BUFfer * = index into BUFfer + address of BUFfer. * JSB DBCBI DBCBI will calculate index. DEF *+3 DEF DKEY It needs: item number DEF INDEX returns: index into BUFfer * LDA D160 LDB INDEX If INDEX came base < 0 SSB (i.e. item not found in user's list) JMP REWND we have a corrupt Run Table. * ADB BUF STB KVAL * * 3) Hash-read into the master data set. If any disc error, rewind process. * JSB DBHRD DBHRD does the hash-read. DEF *+7 DEF BASE,1:������þúI It needs: data base # DEF MNUM data set # DEF KVAL,I key item value DEF READ returns: READ flag DEF RECRD record # of last entry read DEF STAT,I any error encountered * LDA STAT,I Any error? SZA JMP REWND Yes! * * 4) Determine the address for this detail chain in the master's media * record = Record buffer address + 5 + ((master's path # - 1) * 6). * JSB DBFDS DBFDS will give us the master's DEF *+5 DSCB pointer. DEF MNUM It needs: data set reference DEF TEMP returns: data set number DEF FLAG accessibility flag DEF MADR DSCB pointer * LDA D160 LDB TEMP It set# came back as zero SZB,RSS JMP REWND we have a corrupt Run Table. * LDB AIRUN Calculate master's PT ADB MADR address as done above for detail. ADB DSFPC LDA B,I * AND LOBYT (save # paths/entry in master CMA,INA as a counter for following loop.) STA CNTR2 LDA B,I * ALF,ALF (then back to PT AND LOBYT address calculation.) INA ARS INB ADA B,I ADA AIRUN STA TEMP * LDA DKEY Set up combined detail item and ALF,ALF set numbers for master path IOR STNUM table search. STA SAVE1 * LDB D5 Determine index into master's PTD4 LDA TEMP,I media record for this path = CPA SAVE1 5 + (# paths before the one JMP PTD5 we seek * 6). ADB D6 ISZ TEMP ISZ TEMP ISZ CNTR2 JMP PTD4 * LDA D160 If path never found, JMP REWND corrupt Run Table. * PTD5 STB INDEX * * 6) If hash-read unsuccessful (i.e. READ flag <> 0) then if master is * a manual, error U������þúcode = 107 and rewind the process. Else an auto- * matic master, try to create a new entry. * LDA READ SZA,RSS JMP PTD8 * PTD6 LDB AIRUN ADB MADR Data set type code in 2nd ADB DSTYP nibble of 5th word of DSCB LDA B,I type = 0 is an auto master ALF,RAL type = 1 is a manual master SSA,RSS JMP PTD7 If sign (A) = 0, type = 0 LDA D107 If sign (A) <> 0, type = 1 JMP REWND * PTD7 JSB DBBAM DBBAM will build the new DEF *+6 automatic master entry. DEF BASE,I It needs: data base # DEF MNUM data set # DEF KVAL,I key item value DEF READ values from DBHRD DEF RECRD returns: record # or -1 * * 7) If auto create unsuccessful, error # in A, rewind process. * Else, put master's set number, index, and record number in * storage area in case of clean-up. * SZA JMP REWND * LDA MNUM ALF,ALF IOR INDEX STA MSTRI,I LDA MSTRI INA STA TEMP DLD RECRD DST TEMP,I * * 8) Join process of successful auto create or master record existant. * Determine if this is a sorted chain. If so, get its sort item * number and the index into the user's buffer for the sort item's * value. If the sort item value is not there, error code = 102 and * rewind the process. * PTD8 ISZ PTADR If sort item number LDA PTADR,I in path table entry STA SITNO SZA,RSS is zero, JMP ADD1 chain is not sorted. * JSB DBCBI Get sort item's index into values. DEF *+3 DEF SITNO DEF SINDX * LDA D102 If sort item index came back LDB SINDX in SINDX SSB less than zero, JMP REWND error - missing sort item. * * 9) If the current chain count in the master…������þú's media record is zero, * add the record as the chain head and chain foot. * ADD1 LDB DBRBP Current chain count is ADB INDEX the first two words of STB TEMP path info in media record. DLD TEMP,I SZB,RSS SZA JMP ADD2 * ISZ TEMP Chain foot is next two words. ISZ TEMP DLD NEXT,I DST TEMP,I * ISZ TEMP Chain head is last two words. ISZ TEMP DST TEMP,I JMP ADDX Branch to end of master update. * * 10) If the path is unsorted, add the record as the chain foot, saving * old chain foot as backward pointer in media record storage. * ADD2 LDA SITNO SITNO = zero if chain unsorted. SZA JMP ADD3 * ISZ TEMP Chain foot in 2nd doubleword ISZ TEMP of path info in master's DLD TEMP,I media record. DST PATHI,I * DLD NEXT,I DST TEMP,I JMP ADDX Branch around sort processing. * * 11) Path is sorted: * a) get length of sort item, type of sort item, and its address * in BUF. * ADD3 JSB DBFDI DBFDI will return item table entry. DEF *+5 DEF SITNO It need: data item reference DEF WLEN It returns: data item number DEF FLAG accessibility flag DEF ITTAB item table reference * LDA D160 If item # came back zero, LDB WLEN SZB,RSS JMP REWND corrupt Run Table. * LDB ITTAB Item's type is low byte of ADB ITTYP 4th word of item table entry. ADB AIRUN LDA B,I AND LOBYT STA FLAG * ADB D3 Item's length is 7th word LDA B,I or item table entry. STA WLEN * LDA SINDX Sort item's address = ADA BUF index + address of BUFfer. STA KVAL * * b) determine address in record for sort item. * JSB DBCIX DBCIX iD������þúreturns index relative to DEF *+4 beginning of data record for set. DEF SITNO It needs: item number DEF STADR data set address DEF SINDX It returns: index * LDA KEYS Address = address of data record ALS,ALS in record buffer ADA D3 (skip media record) ADA DBRBP ADA SINDX + index. STA SADDR * * c) determine address in media record for this path. * LDA CNTR1 This is current path - 1 ADA KEYS ALS,ALS * 4 ADA D3 + 3 ADA DBRBP + address of record buffer STA PADDR * * d) loop through each record in detail chain until the first record * with a sort item value greater than the one given for this entry * or the end of chain is found. First record in chain is the * chain head found in the master's media record. Succeeding records * are found in the forward pointer for the chain in the detail's * media record. At any error, processing is rewound. * LDA PATHI Set up DRECD to point to forward ADA D2 pointer in media record storage area. STA DRECD * LDA TEMP ADA D4 DLD A,I * SZB,RSS If chain head is zero, SZA JMP ADD4 LDA D154 corrupt chain! JMP REWND * ADD4 DST DRECD,I JSB DBRED DBRED reads the detail record. DEF *+4 DEF BASE,I It needs: data base number DEF STNUM data set number DEF DRECD,I record number * SZA Error code returned in JMP REWND A register. * * e) compare sort item values. Get the item type from FLAG and * branch to the proper compare routine. All routines return: * P+1 if values are equal * P+2 if value in record just read > * new record's value * Ue������þú P+3 if value in record just read < * new record's value * LDA FLAG CPA I JMP ADINT Item an integer CPA X JMP ADCHR Item a character string * * item a real, do a real compare * JSB RCMP DEF *+1 RSS Values equal - continue JMP ADD5 Found spot! JMP ADD45 Value less than - continue * * item an integer, do an integer compare * ADINT JSB ICMP DEF *+1 RSS Values equal - continue JMP ADD5 Found spot! JMP ADD45 Value less than - continue * * item a character string, do a word compare * ADCHR LDA KVAL LDB SADDR JSB .CMW DEF WLEN DEC 0 RSS Values equal - continue JMP ADD5 Found spot! * ADD45 LDA PADDR Get forward pointer in chain ADA D2 (2nd doubleword of path info) DLD A,I SZB,RSS If it is zero, SZA we've found the spot. JMP ADD4 Else, continue search. * DLD DRECD,I When at end of chain, DST PATHI,I save off old chain foot as CLA backward pointer and CLB zero as the forward pointer. DST DRECD,I JMP ADD55 * * f) when the new record's spot is found, move the backward chain * pointer of most recently read record into backward chain pointer * in media record storage area. The record number is already * saved as the forward chain pointer (indirect through DRECD). * ADD5 DLD PADDR,I Backward pointer is 1st DST PATHI,I doubleword of path info. * * g) reread the associated master record. * ADD55 JSB DBRED DBRED performs the read. DEF *+4 DEF BASE,I DEF MNUM DEF RECRD * SZA If any error, JMP REWND rewind process. * * h) Now, if the backward pointer in the media reco=û������þúrd storage area * is zero, put the new record's number as chain head in the * master's media record. If the forward pointer is zero, put * the new record as chain foot. * DLD PATHI,I 1st doubleword in media record SZB,RSS storage is backward pointer. SZA JMP ADD6 * LDA TEMP Chain head is 3rd doubleword ADA D4 of path info in master's STA TEMP media record. DLD NEXT,I DST TEMP,I JMP ADDX * ADD6 LDA PATHI 2nd doubleword in media storage ADA D2 is forward pointer. DLD A,I SZB,RSS SZA JMP ADDX * ISZ TEMP Chain foot is 2nd doubleword ISZ TEMP of path info in master's DLD NEXT,I media record DST TEMP,I * * 12) Join all successful path processing here. Increment the chain * count in the master's media record. * ADDX LDB DBRBP Chain count is 1st doubleword ADB INDEX of path infor in master's STB TEMP media record. DLD TEMP,I JSB .DIN Increment it, DST TEMP,I DST SYCNT and save for successful return * * 13) Write updated master entry to disc. * PTD9 JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF MNUM data set # DEF RECRD record # * * 14) If an error, rewind process. If no error, put master data set * number, record number, and index into media record in the temp. * master record number storage area, update the temp. media record * storage to point to the next path's storage and continue with the * next path. * SZA JMP REWND * LDA MNUM ALF,ALF IOR INDEX STA MSTRI,I ISZ MSTRI * DLD RECRD DST MSTRI,I ISZ MSTRI ISZ MSTRI * LDA D4 ADA PATHI STA PATHI * £������þú ISZ PTADR ISZ CNTR1 JMP PTD1 * * END OF MASTER UPDATE LOOP * * * We come here when all masters have been successfully updated or if the * detail had no path to begin with. Read in the record for the new de- * tail entry in order to get its forward free record list pointer. Save * this pointer for a future update of the Free Record Table entry for * the detail data set. * PTD10 JSB DBRED DBRED will perform the read. DEF *+4 DEF BASE,I It needs: data base # DEF STNUM data set # DEF NEXT,I record # * SZA Any error? JMP REWND Yes - rewind process * LDA D160 LDB DBRBP,I Was this truely a free record? SZB (i.e. is used/unused flag = 0?) JMP REWND No - Run Table is corrupt. * PTD11 LDB DBRBP Yes - get and save next free INB DLD B,I record number. DST SAVE1 * * Now, build the new detail entry by zeroing the record buffer, moving * the media record from temp. storage into the record buffer then asking * DBMDR to move the data record into the record buffer. * JSB DBFWZ DEF *+3 DEF DBRBL DBFWZ needs: length of area to zero DEF DBRBP address of area to zero * LDB AIRUN Get length of media record ADB STADR from low order byte of ADB DSMDL 5th word of DSCB LDA B,I for the move. AND LOBYT ADA M3 Subtract the free record info space. STA TEMP * LDA MEDST Then, move the chain pointers LDB DBRBP into the media record. ADB D3 JSB .MVW DEF TEMP DEC 0 * CLA,INA Set used/unused flag STA DBRBP,I in media to used (1). * JSB DBMDR Ask DBMDR to move in DEF *+2 the data record. DEF STADR * * Write the new record out to disc. If an erX­������þúror, rewind process. If * no error, update the free record information for the detail data set * by putting the free pointer saved in SAVE1 into the free list head * pointer and decrementing the free list count. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF NEXT,I * SZA Any error? JMP REWND Yes! * DLD NEXT,I No - save the new record's #. DST RECRD * DLD SAVE1 Update the FRT. DST NEXT,I LDA M2 ADA NEXT STA NEXT JSB .DDS DEF NEXT,I NOP * * Now, update all related entries in the detail data set. * From this point on no rewind of the process is performed. The data * base on the disc is left in its current state should an error occur. * * Set up the loop for this update by negating the number of keys in the * detail as a loop counter, setting KEYS to one <<KEYS will contain the * current path number>>, and setting up the pointer to the temp. media * storage in PATHI. * CLA Zero out predecessor and CLB successor save areas. DST SYNYM DST SAVE1 * LDA KEYS SZA,RSS If detail has no paths, JMP PUT5 jump around path processing * CMA,INA STA CNTR1 * CLA,INA STA KEYS * LDA MEDST STA PATHI * * BEGIN DETAIL UPDATE LOOP * For each path in the detail: * * 1) If backward pointer in temp. media storage is non-zero, read back- * ward pointer record number, else continue with forward pointer. * PTD12 DLD PATHI,I DST SYNYM Save bckwrd ptr. for successful return SZB,RSS SZA RSS JMP PTD13 * JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA If any error, JMP ERREX pass it to user. * * 2) Calculate address for the forward pointer for this path in¡������þú media * record of detail entry = (path# - 1) * 4 + 5 + address of record * buffer. * CCA ADA KEYS ALS,ALS ADA D5 ADA DBRBP STA TEMP * * 3) Put new record's number in entry's forward chain pointer. * DLD RECRD DST TEMP,I * * 4) Write updated entry to disc. If any error, return it to user. If * no error, continue with forward pointer. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA JMP ERREX * * 5) If forward pointer in temp. media storage is non-zero, read forward * pointer record number, else continue with next path. * PTD13 ISZ PATHI ISZ PATHI DLD PATHI,I DST SAVE1 Save frwd ptr for successful return * SZB,RSS SZA RSS JMP PTD14 * JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA If any error, JMP ERREX pass it to user. * * 6) Calculate address for backward pointer for this path in media record * of detail entry = (path# - 1) * 4 + 3 + address of record buffer. * CCA ADA KEYS ALS,ALS ADA D3 ADA DBRBP STA TEMP * * 7) Put new record's number in entry's backward chain pointer. * DLD RECRD DST TEMP,I * * 8) Write updated entry to disc. If any error, return it to user. If * no error, continue with next path. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF PATHI,I * SZA JMP ERREX * PTD14 ISZ PATHI ISZ PATHI ISZ KEYS ISZ CNTR1 JMP PTD12 * * END OF DETAIL UPDATE LOOP * SKP * * We come here at the end of a successful master or detail put. We need * to write the Free Record Table to disc to complete the process. Then * we can build a successful return STATus array. * PUT5 JSB DBWFR DBiÊ������þúWFR does the FRT write. * SZA Any error? JMP ERREX Yes - pass it to user. * * Now we build the successful reply STATus array. * This looks like: * word contents * ---- -------- * 1 zero * 2 word length of data entry in BUF * 3-4 new record' number * 5-6 doubleword count of entries in * - last chain if detail * - synonym chain if master * 7-8 doubleword record number of predecessor in * - last chain in detail * - synonym chain if master * 9-10 doubleword record number of successor in * - last chain if detail * - synonym chain if master (always zero) * * STA STAT,I Error code = 0 * ISZ STAT DBMDR set WLEN to length LDA WLEN of data in BUFfer for us. STA STAT,I * ISZ STAT DLD RECRD New record number DST STAT,I * ISZ STAT ISZ STAT DLD SYCNT # records on chain DST STAT,I * ISZ STAT ISZ STAT DLD SYNYM Predecessor on chain DST STAT,I * ISZ STAT ISZ STAT DLD SAVE1 Successor on chain DST STAT,I * * Return to user. * PUT6 CLA Set BUF to zero for STA BUF param check on next entry. JMP DBPUT,I * * Error return points * ERREX SSA If error code given by another CMA,INA routine < 0, make it > 0. RSS E100 LDA D100 Invalid data set. RSS E102 LDA D102 Improper or missing key or sort item. RSS E103 LDA D103 Improperly opened data base. RSS E104 LDA D104 Invalid open mode for PUT. RSS E105 LDA D105 Detail data set full. RSS E106 LDA D106 Master data set full. RSS E108 LDA D108 RequP������þúest directed at an automaster. RSS E110 LDA D110 Master with key value already exists. RSS E115 LDA D115 PUT mode invalid. RSS E118 LDA D118 Data set is not writeable. RSS E159 LDA D159 Data base not locked. RSS E160 LDA D160 Run Table corrupt. RSS E162 LDA D162 Missing parameter. STA STAT,I JMP PUT6 SKP * * The following routines perform comparisons of integers and reals for * sorting chains. Each routine returns: * P+1 if the sort values are equal * P+2 if the sort value in the record buffer is > * the sort value in the user's buffer * P+3 if the sort value in the record buffer is < * the sort value in the user's buffer * * The first is ICMP. It compares integers by subtracting the value of * the sort item in the user's buffer (pointed to by KVAL) from the value * of the sort item in the record buffer (pointed to by SADDR) and * checking the overflow. If the A reg is zero after the subtract, the * values are equal. If the A reg is positive, SADDR's value is greater * than KVAL's. If the A reg is negative, KVAL's value is greater than * SADDR's. * ICMP NOP JSB .ENTR DEF ICMP * CLO LDA KVAL,I CMA ADA SADDR,I SOS CMA * SZA,RSS JMP ICMP,I ISZ ICMP SSA,RSS ISZ ICMP JMP ICMP,I * * The second routine is RCMP. It compares reals by first comparing the * sign of the sort value in the user's buffer (pointed to by KVAL) to * the sign of the sort value in the record buffer (pointed to by SADDR). * If the signs differ, then if KVAL's sign is negative, KVAL's value is * less than SADDR's, else SADDR's value is less than KVAL's. If the signs * are the same, it subtracts KVAL's value from SADDR's checking for over- * flow. If no overflow occurs, then the A reg Ÿ.������þúdetermines the comparison * of the values. If an overflow occurs, the exponents of the sort items * are incremented by one, and the subtract is retried. After successful * completion of the subtraction, the A reg determines the comparison of * the values as follows. If the A reg is zero, the values are equal. * If the A reg is negative, SADDR's value is greater than KVAL's. If * the A reg is positive, SADDR's value is less than KVAL's. * RCMP NOP JSB .ENTR DEF RCMP * LDA KVAL,I XOR SADDR,I SSA JMP RCMP2 * DLD KVAL,I RCMP1 JSB .FSB DEF SADDR,I SOS JMP RCMP3 * DLD SADDR,I INB DST SADDR,I DLD KVAL,I INB JMP RCMP1 * RCMP2 LDA KVAL,I JMP RCMP4 RCMP3 SZA,RSS JMP RCMP,I RCMP4 ISZ RCMP SSA,RSS ISZ RCMP JMP RCMP,I SKP * * The following section performs the rewind of a detail data set PUT in * the case of an error occurring after the first master has been updated * and before the new detail entry is written successfully to disc. It * does this by looping on the temp. master record number storage area * picking up each entry in the area undoing the update on the path re- * lated to the detail. Each entry in the storage area looks like: * * word +--------------------------------+ * 1 | master's set # | index into media record for path * ---------------------------------- * 2 | master record | * -- -- * 3 | number | * +--------------------------------+ * * The end of the meaningful data in the area is signified by the first * zero in the master data set word. The last word of the area is al- * ways zero as a safety catch. * * When this clean-up routine is entered, the error code of the error which * brought us here is in the A r›Š������þúegister. If it's negative, set it posi- * tive and put the error code in the STATus array. * REWND SSA CMA,INA STA STAT,I * * Set up the loop parameters. * LDA MEDST Address of temp. media record STA PATHI * LDA MSTST Address of temp. master STA MSTRI record number storage. * * For each entry in temp. master record number storage area: * * 1) If set number = 0, return to user. * RWND0 LDA MSTRI,I SZA,RSS JMP PUT6 * * 2) Else, read entry whose record number follows master's set number * into record buffer. * AND LOBYT Save index into media STA TEMP record for later. * LDA MSTRI,I Get master set's number. ALF,ALF AND LOBYT STA MNUM ISZ MSTRI * JSB DBRED DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * SZA If any error just ignore JMP RWND8 and continue with next entry. * * 3) Calculate address for this path in master's media record by adding * the index to the address of the record buffer. * LDB TEMP ADB DBRBP STB TEMP * * 4) Decrement chain count. * DLD TEMP,I JSB .DDE DST TEMP,I SSA JMP RWND1 SZB,RSS SZA JMP RWND3 * * 5) If chain count <= 0: * A) Zero-fill chain head and chain foot pointers. * RWND1 CLA CLB DST TEMP,I ISZ TEMP ISZ TEMP DST TEMP,I ISZ TEMP ISZ TEMP DST TEMP,I * * B) If set an auto master, see if all chain counts are zero. * JSB DBFDS Ask DBFDS to get the DEF *+5 DSCB for us. DEF MNUM DEF TEMP DEF READ DEF MADR * LDA TEMP If it returns a set# of 0 SZA,RSS ignore this error and just JMP RWND8 continue with next entry. * LDB MADR Set type code in 2°������þúnd nibble ADB AIRUN of high order byte of 5th ADB DSTYP word of DSCB. If set LDA B,I type = 0 then set is ALF,RAL an automatic master. SSA JMP RWND7 * ADB D2 Loop on each path in media record LDA B,I checking for zero chain counts. AND LOBYT Use negative of #paths/entry CMA,INA as the loop counter. STA CNTR1 * LDA DBRBP Get first chain pointer address ADA D5 STA TEMP * RWND2 DLD TEMP,I First non-zero chain count SZB,RSS gets us out of loop SZA and to the record write. JMP RWND7 * LDA TEMP ADA D6 STA TEMP ISZ CNTR1 JMP RWND2 * * C) If all chain counts are zero, delete the automatic master entry. * CLA Let DBDME know record is JSB DBDME in record buffer. DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * JMP RWND8 Ignore any errors. * * If chain foot pointer in master's media record = new record's number, * put backward pointer from temp. media storage there. * RWND3 ISZ TEMP ISZ TEMP DLD TEMP,I JSB .DCO DEF NEXT,I JMP RWND4 NOP JMP RWND5 * RWND4 DLD PATHI,I DST TEMP,I * * If chain head pointer in master's media record = new record's number, * put forward pointer from temp. media storage there. * RWND5 ISZ TEMP ISZ TEMP DLD TEMP,I JSB .DCO DEF NEXT,I JMP RWND6 NOP JMP RWND7 * RWND6 LDA PATHI ADA D2 DLD A,I DST TEMP,I * * 7) Write the updated record to disc. * RWND7 JSB DBWRT DEF *+4 DEF BASE,I DEF MNUM DEF MSTRI,I * * 8) Continue with next entry. * RWND8 LDA MSTRI Get next entry's address. ADA D2 STA MSTRI LDA PATHI Get next path in tem¦������þúp. ADA D4 media record storage. STA PATHI JMP RWND0 * SKP * * Move Data Record is a utility subroutine which moves the data item * values supplied by the user into the data record (of the data set whose * DSCB is passed to us) in the record buffer. DBPIL set up all the in- * formation we need for the data transfer in the TEMPX table. This table * has on entry for each item specified by the user, and each entry is * of the form: * * word +----------------------------------------------+ * 1 |W |K |S | | item number | * ------------------------------------------------ * 2 | word length of item | * ------------------------------------------------ * 3 | index into data record of entry | * +----------------------------------------------+ * * 15 14 13 8 7 0 bit * * W, K, & S are ignored by this subroutine but if set mean: * W - item is writeable * K - item is a key item * S - item is a sort item * * We are going to build a loop which looks at the first word of each * entry. If the word is zero, the process is stopped. If non-zero, we * blindly transfer the value for the item supplied by the user into the * word(s) in the data record for the item and continue on with the next * entry. In addition, the loop maintains a running total of the word * length of all the items in the TEMPX table. * * First, get the true parameter and return point addresses for this call. * DSCB NOP * DBMDR NOP JSB .ENTR DEF DSCB * * Set up the loop parameters. * CLA A zero to the totl word length STA WLEN of the values in BUF. * LDA TEMPX Set up TEMPX table address. STA ITTAB * LDB DSCB,I DeterminQ¿������þúe the address of the ADB AIRUN data record = ADB DSMDL length of media record LDA B,I (low order byte of 5th word of DBCB) AND LOBYT ADA DBRBP + address of record buffer. STA DRADR * LDA BUF Get address of user's buffer * * BEGIN LOOP * While item # not zero: Move item length number of words from user * buffer into data record address + index of item. WLEN := WLEN + * length of item. * MDR1 LDB ITTAB,I Item # = 0? SZB,RSS JMP DBMDR,I Yes - return to caller. * ISZ ITTAB No - set up move length LDB ITTAB,I STB MVLEN * ISZ ITTAB and get address of item LDB ITTAB,I in data record. ADB DRADR * JSB .MVW Then, do the move of the item value. DEF MVLEN DEC 0 * LDB MVLEN Add in this item's length ADB WLEN to the running total. STB WLEN ISZ ITTAB Get next entry in TEMPX JMP MDR1 and continue. * * Constants and variables. * M3 DEC -3 M2 DEC -2 D1 EQU ZERO+1 D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D6 EQU ZERO+6 D100 DEC 100 D102 DEC 102 D103 DEC 103 D104 DEC 104 D105 DEC 105 D106 DEC 106 D107 DEC 107 D108 DEC 108 D110 DEC 110 D113 DEC 113 D115 DEC 115 D118 DEC 118 D154 DEC 154 D159 DEC 159 D160 DEC 160 D162 DEC 162 * LOBYT OCT 377 I OCT 111 X OCT 130 * FLAG NOP KEYS NOP STADR NOP STNUM NOP INDEX NOP READ NOP RECRD BSS 2 SYNYM BSS 2 SYCNT BSS 2 SAVE1 BSS 2 TEMP NOP SITNO NOP SINDX NOP PADDR NOP SADDR NOP DRECD NOP ITTAB NOP DRADR NOP MVLEN NOP WLEN NOP CNTR1 NOP PTADR NOP NEXT NOP DKEY NOP MNUM NOP MADR NOP KVAL NOP CNTR2 NOP PATHI NOP MSTRI NOP MEDST DEF *+1 } Do not separate these BSS 64 } BSS instruction unless you vh���º����¸�´ BSS 49 } change the call to DBFWZ MSTST DEF MEDST+65 END ������������������������������������������������������������������������������������������������\fº�������ÿÿ����� ���� ÿý�·�#Û ���������ÿ��92069-18142 2026� S C0122 �&DBDEL &DBDEL � � � � � � � � � � � � � �H0101 ãÊ�����þúASMB,L,C,R HED DBDEL SUBROUTINE OF IMAGE/1000 NAM DBDEL,7 92069-16142 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18142 * RELOC: 92069-16142 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS AND MULTIPLE * LINKING FEATURES - CEJ * * ******************************************************************* * * * * Data Base DELete is one of the ten user callable subroutines in the * IMAGE/1000 DBMS library. Its function is to delete the most recentrly * accessed entry from a manual master or detail data set. For a detail * set, this includes deleting any automatic master data set entry whose * chain counts for all paths become zero upon the removal of the detail * entry. * * The calling sequence for DBDEL is: * * JSB DBDEL * DEF *+5 return point * DEF BASE the data base parameter used in a successful * DBOPN for the data base from which the entry * is to be removed. The data base must have * been opened in mode 1 or 3, and if mode 1 must * have been previously locked to the user. * DEF SET the name or number of the manual master or detail * data set from which the current entry is to be * deleted. * DEF MODE DBDEL mode = 1 * DEF STAT a 10 word status array of which only the first * word is used by this subroutine to return to * r������þú the user a status code, zero if successful. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 DaxÁ������þúta Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * Vq������þú * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * Ê7������þú * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBDEL EXT .DDE,.DIS,.ENTR,.MVW,AIRUN,DBCIX,DBDME,DBFDI,DBFDS EXT DBFWZ,DBHRD,DBIDS,DBRBL,DBRBP,DBRED,DBWFR,DBWRT EXT RBDEL * BASE NOP SET NOP MODE NOP STAT NOP * * Get true parameter fV������þúand return point addresses. * DBDEL NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA STAT SZA,RSS JMP DEL7 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is on * a remote machine, and to set up its Run Table as the current Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * JSB RBDEL Remote data base return. DEF *+5 Ask RBDEL to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I JMP DEL7 Return to caller. * * Check open mode of data base. It must be 1 or 3, and if mode 1, must * have been locked to the user. Open mode is in low order byte of 13th * word of DBCB, lock flag is in the high order byte of the same word. * LOCAL LDB AIRUN ADB DBLMD LDA B,I AND LOBYT CPA D1 mode = 1? JMP DEL1 Yes - check lock flag CPA D3 No - mode = 3? JMP DEL2 Yes - continue JMP E104 NO - illegal open mode for a DEL. * DEL1 LDA B,I Lock flag is negative SSA,RSS if data base locked to user. JMP E159 * * Now, make sure that the MODE the user specified for DBDEL is 1. * DEL2 LDA MODE,I CPA D1 = 1? RSS JMP E115 NO - illegal DBDEL mode. * * Ask DBFDS to check the validity of the set reference in SET and to * give us the pointer to the Data Set Control Block for the set if it * is valid. * JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set reference DEF STNUM returns: data set # DEF FLAG accessibility flag DEF STADR DSCB pointer * LDA STNUM nE������þú If DBFDS returned a set # SZA,RSS of zero (set invalid) JMP E100 * LDA FLAG or an accessibility FLAG CMA,INA of > 0 (set inaccessible) SSA JMP E100 user gave us a bad set reference. * * The data set must be writeable (accessibility FLAG returned < 0) for * us to do a DBDEL. * SZA,RSS JMP E118 * * The data set must be a manual master (type code = 1) or a detail (type * code = 2) for us to do a DEL. Type code is in 2nd nibble of high order * byte of 5th word of DSCB. If the set is an MM, make FLAG = -1, if * set a detail, make FLAG = 0. * CCA STA FLAG * LDB AIRUN DSCB pointer passed by DBFDS ADB STADR is relative to start of Run Table ADB DSTYP LDA B,I Get type code in sign and ALF,RAL least sig. bits of A reg. SLA If least sig. bit set, JMP DEL3 type = 2. SSA If sign bit set, JMP DEL4 type = 1 JMP E108 else set an auto-master. * DEL3 ISZ FLAG NOP * * DBDEL deletes the current record in the data set. Make sure that there * is a current record (i.e. current record number in 12th and 13th words * of DSCB non-zero). * DEL4 ADB D7 DLD B,I SZB,RSS SZA RSS JMP E157 No current record to delete. * DST RECRD Save current as record to delete. * * Read in the current record and see if it is already empty. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF RECRD record number * SZA If any error, JMP ERREX pass code to user. * LDA DBRBP,I Else, check entry type word. SZA,RSS If zero, JMP E114 entry is empty. * * All joint error checking is done. Now, split up processing between4`������þú * master and detail deletes. * ISZ FLAG Is this an MM? JMP DELD No - a detail SKP * * Delete a manual master data entry. * * In order for us to delete a manual master data set entry, all chain * counts for the paths in the related detail data sets must be zero. * So, the first order of business is to check all the chain counts in the * master's media record for zero. Set up the loop parameters: * Will use the negative of the number of paths/entry in the master * (low order byte of 17th word of DSCB) as the loop counter. * LDB AIRUN ADB STADR ADB DSPCT LDA B,I AND LOBYT SZA,RSS If manual has no chains, JMP DELM2 we can skip chain count check. CMA,INA STA CNTR1 * * Skip over entry type word and synonym pointers in media record. * LDB DBRBP ADB D5 STB MRADR * * Now, loop on each path in the media making sure the chain count for * the path is zero. The first non-zero path count causes an error. * DELM1 DLD MRADR,I SZB,RSS SZA JMP E113 A non-empty chain. * LDA MRADR ADA D6 STA MRADR ISZ CNTR1 JMP DELM1 * * We fall through loop here if all chain counts are zero or jump here if * the set has no chains. Entry may be deleted. Ask DBDME to do the de- * lete. It performs all the necessary synonym updates and also alters * the Free Record Table to reflect the deleted record if it is success- * ful. If successful, we merely jump to joint FRT posting. * DELM2 CLA Let DBDME know that JSB DBDME record is in record buffer DEF *+4 so it doesn't do a read. DEF BASE,I DBDME needs: data base # DEF STNUM data set # DEF RECRD returns: record number * SZA Any error? JMP ERREX Yes - pass it to user. JMP DEL5 No - go post³Ò������þú FRT. SKP * * Delete a detail data entry. * * The detail data entry may be deleted if we reach this point since all * necessary error checking has been done. However, we have a problem * in deleting a detail data set entry in that we must update all master * entries. To do this we must hash-read into the master set and there- * fore we must have the key item value in memory for DBHRD to compare * with the value in the master entry. But, the only buffer we have which * contains the key item value is the data record in the record buffer * itself and the record buffer gets overlaid by DBHRD during the read * of the data entry. So, we set up a buffer which can contain at least * one of the key item values and possibly all of the values. * * This buffer is a hard coded 127 words (largest possible key item is * 127 words). In addition, in order to organize this buffer, we need to * keep a count of the number of key items in the buffer and a pointer * to the current location in this buffer. The buffer is initialized by * moving as many of the key item values as possible into it from the re- * cord buffer in the order of their occurance in the Path Table of the * data set. The count is then set to the number of key item values which * fit in the buffer and the pointer starts at the first word of the buf- * fer. We then hash-read into each master data set for each path (in * order) using our current position in the buffer as the address of the * key item value and update the master entry. The count of the key * item values is decremented and the pointer is moved to its current posi- * tion plus the length of the key item just used. When the count reaches * zero, if we are not done with the master updating for each path of the * detail, we read the detail entry back into the record buffer and move * as many key item values as possible from the record buffer into the key * item buffer starting with the key item of the next path uÈÓ������þúpto, and in- * cluding, the key item of the last path in the data set. The count and * pointer are reset and master updating is continued. This process con- * tinues until all masters are updated. * * Then, the detail record is deleted by writing a zero-filled record with * the free list pointer set to the disc. The Free Record Table is updated * and posted and we return to the user. Any error during the master or * detail updating causes us to halt processing and return an error code * to the user. * * First, determine if the data set has any paths. If not, we can skip * around this entire key item rigamarole. # paths/entry is in low order * byte of the 7th word of the DSCB. * DELD LDB AIRUN ADB STADR ADB DSPCT LDA B,I AND LOBYT STA PTCNT Save path count for later. SZA,RSS JMP DELD9 * * It has paths, initialize the loop parameters: * CMA,INA Use path count as the STA CNTR1 loop counter. * CLA,INA Start with path # 1 STA PATH# * LDA B,I Get data set's Path ALF,ALF Table address = AND LOBYT (# fields/entry <<high order INA byte of 7th word of DSCB>> + 1) ARS / 2 INB + pointer to Info Table ADA B,I <<8th word of DSCB>> ADA AIRUN + address of Run Table. STA PTADR * ADB M3 Move detail's chain pointers LDA B,I into temp. media record AND LOBYT storage. Media record ADA M3 length is low order byte STA MVLEN of 5th word of DSCB. LDA DBRBP ADA D3 LDB MEDST JSB .MVW DEF MVLEN DEC 0 * STA DRADR A now points to data record, LDB MEDST save it for DBKEY. STB PATHI * * BEGIN MASTER UPDATE LOOP * For each path in the detail: * * 1) Get address of key item ŠÝ������þúvalue. * DBKEY is the routine which does all the key item value buffer * manipulations and puts the address of the key's value in CURNT. * DELD1 JSB DBKEY * * 2) Get master data set's number and detail's key item number from * the Path Table entry for this path: * (low order byte of entry whose address = Path Table address + * (path # - 1) * 2). * CCB ADB PATH# BLS ADB PTADR LDA B,I AND LOBYT STA MSNUM * LDA B,I Get and save key item AND HIBYT number for later STA CMPAR * * 3) Hash-read into master to get entry with key value. * JSB DBHRD DEF *+7 DEF BASE,I DBHRD needs: data base # DEF MSNUM data set # DEF CURNT,I key item value DEF FLAG returns: read flag DEF MSTRC record number DEF STAT,I error code * LDA STAT,I If any error, SZA JMP ERREX pass code to user. * LDA FLAG If returned read flag NE 0 SZA (i.e. no entry with hash value) JMP E154 Corrupt Data Base! * * 4) Determine the index into the master's media record for this data * set by: * A) Get master's DSCB pointer. * JSB DBFDS DEF *+5 DEF MSNUM DEF TEMP DEF FLAG DEF MSADR * LDA TEMP Just a check for SZA,RSS JMP E160 a bad Run Table. * * B) Get Path Table address of master (same process as above for * detail. * LDB MSADR ADB AIRUN ADB DSFPC LDA B,I As a side effect, get # of AND LOBYT paths/entry in master and STA TEMP save for later. * LDA B,I ALF,ALF AND LOBYT INA ARS INB ADA B,I ADA AIRUN STA MRADR * * C) LU������þúoop on each entry in master's Path Table comparing the set# * and item # in the entry to the detail's set # and key item #. * If not a match, add 6 to index. If a match, index is computed. * Before loop, initialize index to 5 skipping over entry type * word and synonym pointers in media record and merge the detail's * key item and set numbers. * LDA TEMP Use negative of # of paths in CMA,INA master as the loop counter. STA CNTR3 * LDA CMPAR Merge item and set #s IOR STNUM STA CMPAR * LDB D5 Initialize index. * DELD2 LDA MRADR,I CPA CMPAR JMP DELD3 * ADB D6 ISZ MRADR If we run out of paths in ISZ MRADR ISZ CNTR3 master before a match is JMP DELD2 found - JMP E160 Run Table is corrupt! * * 5) Index into master data set's media record to get this path's count * and pointer addresses. * DELD3 ADB DBRBP STB MRADR * * 6) Get path count and decrement. * DLD MRADR,I JSB .DDE DST MRADR,I * * 7) If path count is now zero: * A) zero-fill path pointers also. * SZB,RSS SZA JMP DELD5 * ISZ MRADR Chain foot ISZ MRADR DST MRADR,I * ISZ MRADR Chain head ISZ MRADR DST MRADR,I * * B) If an automatic master (type code in 2nd nibble of high order * byte of 5th word of DSCB = 0), see if all chains are zero. * If so, delete the entry. * LDB AIRUN ADB MSADR ADB DSTYP LDA B,I ALF,RAL SSA JMP DELD7 * LDB TEMP TEMP set to # paths long ago. CMB,INB Use negative as loop counter. STB CNTR3 * LDB DBRBP Skip over entry type word & ADB D5 synonym pointers in STB MRADR media record. * DELD4 DLrn������þúD MRADR,I For each path in master, SZB,RSS if chain count NE 0, SZA JMP DELD7 cannot delete entry. * LDA D6 ADA MRADR STA MRADR ISZ CNTR3 JMP DELD4 * CLA All paths are zero. Ask JSB DBDME DBDME to delete entry DEF *+4 The A reg. = 0 tells DEF BASE,I DBDME that the record DEF MSNUM is already in memory. DEF MSTRC * SZA Did DBDME succeed? JMP ERREX No - inform user JMP DELD8 Yes - continue with next master. * * 8) Path count still non-zero. If chain foot in master's media re- * cord = record # of detail entry to delete, set the chain foot to * the detail's backward pointer for this path (in temp. media sto- * rage pointed to by PATHI). * DELD5 ISZ MRADR MRADR points to chain count, ISZ MRADR move it to chain foot. DLD MRADR,I CPB RECRD+1 RSS JMP DELD6 CPA RECRD RSS JMP DELD6 * DLD PATHI,I DST MRADR,I * * 9) If chain head in master's media record = record # of detail entry * to delete, set the chain head to the detail's forward pointer for * this path. * DELD6 ISZ MRADR Point MRADR to chain head, ISZ MRADR it's currently at chain foot. DLD MRADR,I CPB RECRD+1 RSS JMP DELD7 CPA RECRD RSS JMP DELD7 * LDB PATHI Get this path's forward ADB D2 pointer, in 2nd doubleword DLD B,I of media storage. DST MRADR,I SKP * * Write updated master entry to disc. If successful, continue with next * master, else return error to user. * DELD7 JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF MSNUM data set # DEF MSTRC record number * SZA JMP ERREº������þúX * DELD8 LDB PATHI Update media record pointer ADB D4 STB PATHI ISZ PATH# and path number. ISZ CNTR1 If more to do JMP DELD1 go do them. * * END OF MASTER UPDATE LOOP * SKP * * We come here when all master entries for the detail's path have been * successfully update, or if the detail has no paths. Delete the detail * entry by writing a zero-filled entry to the disc. That is, zero ex- * cept for the 2nd & 3rd words which contain the forward free list pointer * which is the current free list head pointer from the 3rd & 4th words * of the detail's Free Record Table entry. * DELD9 JSB DBFWZ Ask DBFWZ to zero out DEF *+3 the record buffer. DEF DBRBL It needs: length of area to zero DEF DBRBP address of area to zero * LDA DBRBP Get address of free list pointer in INA STA MRADR detail's media record. * CCA Set's entry in FRT is: ADA STNUM data set # - 1 ALS,ALS * 4 LDB AIRUN + pointer to FRT ADB DBFRP (12th word of DBCB) ADA B,I ADA AIRUN + address of Run Table. STA TEMP Save for later. * ADA FRPTR Bump to freelist head pointer DLD A,I pick it up & put it in 2nd & DST MRADR,I 3rd words of record buffer. * JSB DBWRT Write unused entry to disc. DEF *+4 DEF BASE,I DEF STNUM DEF RECRD * SZA If any error JMP ERREX return code to user. * * Update the FRT entry for the detail data set to reflect the deletion * of the record by incrementing the free record count (in 1st two words) * and storing the deleted record's number as the new free record list * head pointer (in 3rd & 4th words). * JSB .DIS DEF TEMP,I NOP ISZ TEMP ISZ TEMP DLD RECRD L‚������þú DST TEMP,I SKP * * Now, we need to update any detail records which reference the deleted * record through their chain pointers. We do this by looping on each * path in the detail checking the backward and forward pointers for the * path in the temp. media record storage area. If the backward pointer * is non-zero, we read in the record whose number the pointer contains * and set its forward pointer for the path (which we blindly assume cur- * rently contains the record number of the record just deleted) to the * contents of the forward pointer for the path in the deleted record * and write it out to disc. Then, if the forward pointer (in temp. media * storage) is non-zero, we read in the record corresponding to the for- * ward pointer's contents, set its backward pointer for the path (again, * blindly assuming its current content is the record number of the record * just deleted) to the contents of the backward pointer for the path in * the deleted record. * * First, let's check the path count for the detail again. We set PTCNT * to the path count long ago. If it's zero, we can skip over this de- * tail path updating. * LDA PTCNT SZA,RSS JMP DEL5 * * It has paths, so initialize the loop parameters. * CMA,INA Use negative # paths STA CNTR1 as loop counter. * CLA Zero for 1st path's STA INDEX media record index. * * BEGIN DETAIL UPDATE LOOP * For each path in the detail: * * 1) Get the backward pointer. * DED10 LDB MEDST ADB INDEX STB PATHI DLD B,I * * 2) If backward pointer non-zero, read it into the record buffer. * SZB,RSS SZA RSS JMP DED11 * DST MSTRC JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF MSTRC * SZA Was read successful? JMP ERREX No - give user error code. * * 3) Set the backwa������þúrd pointer's forward pointer to deleted record's * forward pointer. * LDA DBRBP ADA INDEX ADA D5 STA TEMP * LDA PATHI ADA D2 DLD A,I DST TEMP,I * * 4) Write updated backward pointer to disc. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF MSTRC * SZA If an error, JMP ERREX give error code to user. * * 5) Get forward pointer. * DED11 LDA PATHI ADA D2 DLD A,I * * 6) If forward pointer non-zero, read it into record buffer. * SZB,RSS SZA RSS JMP DED12 * DST MSTRC JSB DBRED DEF *+4 DEF BASE,I DEF STNUM DEF MSTRC * SZA If any error, JMP ERREX pass code to user. * * 7) Set the forward pointer's backward pointer to the deleted record's * backward pointer. * LDA DBRBP ADA INDEX ADA D3 STA TEMP * DLD PATHI,I DST TEMP,I * * 8) Write updated forward pointer to disc. * JSB DBWRT DEF *+4 DEF BASE,I DEF STNUM DEF MSTRC * SZA If any error, JMP ERREX pass code to user. * * 9) Continue with next path. * DED12 LDA INDEX Update path index. ADA D4 STA INDEX ISZ CNTR1 JMP DED10 SKP * * We come here after a successful deletion from either a manual master * or detail data set to post the Free Record Table to disc and return * to the user. * DEL5 JSB DBWFR DBWFR posts the FRT. * DEL6 STA STAT,I Returns status in A reg. DEL7 CLA Set STAT to zero for STA STAT param check on next entry. JMP DBDEL,I * * Error return points. * ERREX SSA If error from some other CMA,INA routine < 0, make it > 0. JMP DEL6 E100 LDA D100 Invalid data set JMP ½D������þúDEL6 E103 LDA D103 Improperly opened data base. JMP DEL6 E104 LDA D104 Invalid open mode for a DEL. JMP DEL6 E108 LDA D108 Request directed to an auto-master. JMP DEL6 E113 LDA D113 Master entry still has JMP DEL6 non-zero chains. E114 LDA D114 Current record is empty. JMP DEL6 E115 LDA D115 Invalid DBDEL mode. JMP DEL6 E118 LDA D118 Data set not writeable. JMP DEL6 E154 LDA D154 Corrupt data base. JMP DEL6 E157 LDA D157 No current record. JMP DEL6 E159 LDA D159 Data base not locked. JMP DEL6 E160 LDA D160 Corrupt Run Table. JMP DEL6 * * Constants and variables. * M3 DEC -3 M2 DEC -2 D1 EQU ZERO+1 D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D5 EQU ZERO+5 D6 EQU ZERO+6 D7 EQU ZERO+7 D100 DEC 100 D103 DEC 103 D104 DEC 104 D108 DEC 108 D113 DEC 113 D114 DEC 114 D115 DEC 115 D118 DEC 118 D154 DEC 154 D157 DEC 157 D159 DEC 159 D160 DEC 160 * LOBYT OCT 377 HIBYT OCT 177400 * FLAG NOP STNUM NOP STADR NOP RECRD BSS 2 CNTR1 NOP CNTR2 NOP CNTR3 NOP MRADR NOP PATH# NOP CMPAR NOP ITEM1 NOP ITEM2 NOP PTADR NOP ITADR NOP MVLEN NOP INDEX NOP DRADR NOP MSNUM NOP MSADR NOP TEMP NOP MSTRC BSS 2 PTCNT NOP CURNT NOP PATHI NOP #KEYS NOP PTAD2 NOP MEDST DEF *+1 BSS 64 KEYBF DEF *+1 BSS 127 BFEND DEF * SKP * * DBKEY is a utility subroutine for a detail delete which does all the * necessary buffering of key item values. * * All the parameters it uses are global to DBPUT. * DBKEY NOP * * First time we are called, PATH# contains the value 1. If first time, * we need to do a little initialization. * LDA PATH# CPA D1 RSS JMP KEY1 * * Initialization * Need: # keys in buffer = zero. * copy of # paths negated for loop counter. * å¿������þú copy of detail's Path Table address. * CLA STA #KEYS * LDA CNTR1 STA CNTR2 * LDA PTADR STA PTAD2 * JMP KEY2 * * Here after 1st time through. See if there is another key value still * in buffer. If not we must restock buffer. * KEY1 ISZ #KEYS JMP KEY5 One there - get its address * * No more keys left in buffer, we need to restock it from the detail * record. If this is first time through, we already have the detail * record in the record buffer. Else we must reread it. * JSB DBRED DEF *+4 DEF BASE,I DBRED needs: data base # DEF STNUM data set # DEF RECRD record number * SZA If an error, JMP ERREX pass code to user. * * Join procesing for 1st & nth time through. Loop on the remainder of * the Path Table (count is in CNTR2) picking up the detail's key item * for the path. Call DBFDI to give us the item's Item Table pointer * then get the item's length from the 7th word of the entry. * KEY2 LDA KEYBF Set current key item pointer STA CURNT to beginning of buffer. * KEY3 LDA PTAD2,I ALF,ALF AND LOBYT STA ITEM1 * JSB DBFDI DEF *+5 DEF ITEM1 DBFDI needs: item reference DEF ITEM2 returns: item number DEF FLAG accessibility flag DEF ITADR Item Table entry pointer * LDA ITEM2 If DBFDI returned an item # SZA,RSS of zero (item invalid) JMP E160 Run Table is corrupt. * LDB ITADR ADB AIRUN ADB ITLNG LDA B,I Save item length for bound STA MVLEN checking & data move. * * Determine if the item will fit in the buffer by adding the length of * the item to the current position in the buffer, then subtracting the * result from the end of the buffer. If ¢������þúthe final result is non-negative * the item will fit. Else the buffer is as full as we can get it. * ADA CURNT CMA,INA ADA BFEND SSA JMP KEY4 * * Ask DBCIX to determine the index of the key item into the data record. * JSB DBCIX DEF *+4 DEF ITEM2 DBCIX needs: item number DEF STADR DSCB DEF INDEX returns: index (-1 if error) * LDA INDEX If index < 0 SSA JMP E160 Run Table corrupt! * * Get address of key item in data record in A register and address of * current position in buffer in B register. Then move the item into * the buffer. * ADA DRADR LDB CURNT JSB .MVW DEF MVLEN DEC 0 * STB CURNT B = new current address. * * Continue until buffer is full, or all keys are in it. * ISZ PTAD2 ISZ PTAD2 ISZ #KEYS Increment # keys in buffer. ISZ CNTR2 JMP KEY3 * * We fall through loop here at end of paths in data set or jump here at * end of room in buffer. Negate the number of keys in the buffer for * a counter. Put the address of the buffer as current pointer and re- * turn it as key item address. * KEY4 LDA #KEYS CMA,INA STA #KEYS * LDA KEYBF STA CURNT JMP KEY6 SKP * * We come here when we only need to get the next key item's address and * it is in the buffer. The current path number (in PATH#) is used to in- * dex into the Path Table by: (PATH# - 2) * 2 + PTADR. This entry then * contains the item number of the last key item accessed in its first byte. * KEY5 LDB M2 ADB PATH# BLS ADB PTADR LDA B,I ALF,ALF AND LOBYT STA ITEM1 * * Ask DBFDI to get the item's Item Table entry for us. From this we get * the item's length (7th word of entry). * JSB DBFDI DEF *+5 DEF ITEM1 DEF ITET³���x��vrM2 DEF FLAG DEF ITADR * LDA ITEM2 SZA,RSS If returned item # = 0, JMP E160 Run Table is corrupt. * LDA ITADR ADA AIRUN ADA ITLNG LDB A,I * * Add the item's length to our current position to get the next key item's * address (the new current position). * ADB CURNT STB CURNT * * Return to caller. * KEY6 JMP DBKEY,I END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������àÃx������ÿÿ����� ���� ÿý�¸�Ñ ���������ÿ��92069-18143 2026� S C0122 �&DBLCK &BDLCK � � � � � � � � � � � � � �H0101 çÑ�����þúASMB,L,C,R HED DBLCK AND DBUNL SUBROUTINES OF IMAGE/1000 NAM DBLCK,7 92069-16143 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18143 * RELOC: 92069-16143 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base LoCK is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to lock a data base opened in * mode 1 using the RN for the data base set up in DBOPN in order to * allow the user exclusive use of the data base. In addition to lock- * ing the data base, DBLCK brings in a fresh copy of the free record * table from the root file and rewinds all currently used data sets in * the data base to guarantee the user has the most current information * on the state of the data sets. * * The calling sequence for DBLCK is: * * JSB DBLCK * DEF *+5 return point * DEF IBASE data base to be locked - must be the same para- * meter as used in a successful DBOPN call. * DEF ISET (currently unused - place holder) * DEF MODE =1 for a lock with wait * =2 for a lock without wait * DEF ISTAT ten word status array (only first word is used * by this subroutine * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local maϯ������þúchine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEqK������þúC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type a·¤������þúnd media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG µ<������þúEQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * ENT DBLCK,DBUNL EXT .ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDMX,DBIDS,EREAD EXT RBLCK,RBUNL,RNRQ,RWNDF A EQU 0 B EQU 1 * LBASE NOP LSET NOP LMODE NOP LSTAT NOP * * Get true addresses of parameters and return point. * DBLCK NOP JSB .ENTR DEF LBASE * * Make sure all the parameters are there. * LDA LSTAT SZA,RSS JMP LCK4 Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is on * a remote machinù������þúe, and to set up its Run Table as the current Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF LBASE,I * JMP L103 Error return - illegal BASE parameter. JMP LLOCL Local data base return. * JSB RBLCK Remote data base return. DEF *+5 Ask RBLCK to handle DEF LBASE,I this request. DEF LSET,I DEF LMODE,I DEF LSTAT,I JMP LCK4 Return to caller. * * Initialize the LSTAT parameter. * LLOCL CLA Set status word to zero STA LSTAT,I for facility in a successful return. * * Get open mode from Run Table (low order byte of 14th word in DBCB) and * the lock flag (high order byte of the same word). User must have * opened data base in mode 1 and cannot already have locked the data * base in order for us to lock it now. Note: mode 3 open or data base * already locked to user will return as successful lock anyway. * LDB AIRUN AIRUN has address of current Run Table. ADB DBLMD LDA B,I AND LOBYT A = open mode. * CPA D3 If open mode = 3, ignore lock call. JMP LCK4 CPA D1 Else, if open mode NE 1 RSS we cannot lock the data base. JMP L134 * LDA B,I Open mode okay - now check lock flag. SSA Will be positive if data base unlocked. JMP LCK4 It's not - data base already locked to user. * * Open mode & lock flag checked out, now get RN from DBCB (word 6). * Then determine if the lock is to be with or without wait (lock modes * 1 and 2, respectively) and set up the RNRQ call accordingly. * ADB M7 STB LRN Put RN in RNRQ call. * LDA CNTRL Get the RN lock control word. LDB LMODE,I It already has no abort, CPB D1 lock locally bits set. JMP LCK1 If mode = 1, leave no wait bit clear. CPB D2������þú If mode - 2, RSS set no wait bit (bit 15). JMP L115 If neither 1 or 2, illegal DBLCK mode. IOR NWAIT * LCK1 STA LCODE Put control word in RNRQ call. * * Perform the RNRQ call. When it returns, the status word will contain * a 2 if successful. If it aborts or the status word is not 2, return * an error code to the user. * JSB RNRQ DEF *+4 DEF LCODE LRN ABS *-* DEF FLAG JMP L137 abort return point * LDA FLAG Request succeed? CPA D2 JMP LCK2 Yes - continue with processing. * CPA D6 No - RN already locked? JMP L136 Yes - tell user. JMP L137 No - illegal RN usage elsewhere. * * RN lock succeeded. Set lock flag in DBCB (high order byte of word 13). * Then determine Free Record Table location (pointer in word 12 of DBCB), * and length (word 14 of DBCB) and put both in the FMP EREAD call to read * the free record information into the Run Table. * LCK2 LDB AIRUN ADB DBLFG LDA B,I IOR NWAIT Set lock flag to negative. STA B,I * INB Get free record table length first. LDA B,I STA LENTH * ADB M2 Get true address of free record table LDA B,I by adding the relative pointer ADA AIRUN to the address of the Run Table STA BUFFR * * Put the 16 FMP word (start in 17th word of the DBCB) into the data * base root file DCB for the EREAD call. * LDA AIRUN ADA DCBWS LDB DBDCB JSB .MVW DEF D16 DEC 0 * * Ask FMP to read in the free record table. If it succeeds, we are done. * If it is unsuccessful, we must backtrack everything we have done so far * and return the ABS(FMP error) to the user. * JSB EREAD DEF *+7 DEF DBDCB,I DEF FLAG BUFFR NOP DEF LENTH DEF DUMMY DEF FRTRC FRT ‘w������þúalways starts in record 2. * SSA Call succeed? JMP LCK3 No - go unlock the RN. * * Rewind all data sets in the data base to beginning of file to guarantee * a disc access the next time the set is accessed. We do this by search- * ing the DCB table for all DCBs currently open with a set in the data * base and calling the RWNDF FMP subroutine for each DCB found. Each entry * in the DCB table contains two words in the format: * * +-------------------------------------+ * | data base # | data set # | -> -1 if DCB unused, * --------------------------------------- 0 if entry empty * | DCB address | * +-------------------------------------+ * * We will search on the high order byte of the first word of each entry * comparing it against the current data base's number. * * Set up for search by getting data base number from LBASE into the high * order byte, getting -(maximum # of DCBs) as a counter, and making a * copy of the DCB table address. * LDA LBASE,I ALF,ALF STA TEMP * LDA DBDMX CMA,INA STA CNTR * LDA DBDCP STA PTADR * * Now, for each entry in table, if there is a DCB associated with the * entry, and that DCB is being used for this data base, rewind the DCB. * SRCH1 LDA PTADR,I ISZ PTADR AND HIBYT CPA TEMP RSS JMP SRCH2 * LDA PTADR,I STA RWNAD JSB RWNDF DEF *+2 RWNAD ABS *-* Ignore any errors. * SRCH2 ISZ PTADR ISZ CNTR JMP SRCH1 * * When completed, return successful to user. * JMP LCK4 * * Here when an error occurred on reading the FRT into memory, release * RN and return ABS(FMP error code) to user. * LCK3 CMA,INA No - make error positive STA LSTAT,I and put into status word. * LDB AIRUN Clear lock flag in Run Table. ADB DB"µ������þúLFG LDA B,I AND LOBYT STA B,I * JSB RNRQ Tell RNRQ to unlock the RN. DEF *+4 DEF UCODE Unlock, no wait, no abort DEF LRN,I DEF DUMMY NOP Ignore any errors. * LCK4 CLA Set LSTAT to zero for STA LSTAT param check on next entry. JMP DBLCK,I Return to user. * * Error return points. * L103 LDA D103 Data base not properly opened. RSS L115 LDA D115 Illegal DBLCK mode. RSS L134 LDA D134 Improper open mode for a lock. RSS L136 LDA D136 Data base locked to someone else. RSS L137 LDA D137 Illegal RN usage. STA LSTAT,I Put error in status word JMP LCK4 and return to user. * * Constants and variables. * M2 DEC -2 D2 EQU ZERO+2 D6 EQU ZERO+6 D16 EQU ZERO+16 D134 DEC 134 D136 DEC 136 * HIBYT OCT 177400 * CNTRL OCT 040001 NWAIT OCT 100000 * LCODE NOP LENTH NOP DUMMY NOP TEMP EQU DUMMY CNTR NOP PTADR NOP FRTRC DEC 0,2 SKP * * Data Base UNLock is one of the ten user callable subroutines in the * IMAGE/1000 library. Its function is to unlock a data base openend in * mode 1 using the RN for the data base set up in DBOPN in order to * allow the user to relinquish exclusive use of the data base. * * The calling sequence for DBUNL is: * * JSB DBUNL * DEF *+5 return point * DEF IBASE data base to be unlocked - must be the same para- * meter as used in a successful DBOPN call. * DEF ISET (currently unused - place holder) * DEF MODE = 1 * DEF ISTAT ten word status array (only the first word is * used by this subroutine * UBASE NOP USET NOP UMODE NOP USTAT NOP * * Get true parmeter and return point addresses. * DBUNL NOP JSB .ENTR DEF UBASE * * Make sure allÈ¢������þú the parameters are there. * LDA USTAT SZA,RSS JMP UNL1 Missing parameter. * * Ask DBIDS to check the data base specified in UBASE to see if it is * on a remote machine, and to set up its Run Table as the current Run * Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF UBASE,I * JMP U103 Error return - illegal UBASE param. JMP ULOCL Local data base return. * JSB RBUNL Remote data base return. DEF *+5 Ask RBUNL to handle DEF UBASE,I this request. DEF USET,I DEF UMODE,I DEF USTAT,I JMP UNL1 Return to caller. * * Initialize the USTAT parameter. * ULOCL CLA Set status word to zero for STA USTAT,I facility in a successful return. * * Get open mode from Run Table (low order byte of word 13 in the DBCB) * and the lock flag (high order byte of the same word). User must have * opened the data base in mode 1 and must have previously locked the data * base in order for us to unlock it now. Note: A non mode 1 open and * data base already unlocked will return as a successful unlock anyway. * LDB AIRUN AIRUN has address of current Run Table ADB DBLMD LDA B,I AND LOBYT A = open mode. * CPA D1 If open mode NE 1, RSS we cannot unlock data base JMP UNL1 (It couldn't be locked!) * LDA B,I Open mode okay - now check lock flag, SSA,RSS must be negative. JMP UNL1 It's not - data base already unlocked. * * All okay. Make sure unlock mode 1. If so, get RN from DBCB (6th word) * and put it into RNRQ call. * LDA UMODE,I CPA D1 RSS JMP U115 Illegal unlock mode (NE 1). * ADB M7 Put RN in RNRQ call. STB URN * * Ask RNRQ to unlock RN for us. If we are unable to unlock the RN or * t']���B��@<he request is aborted, someone else is illegally using the RN. * JSB RNRQ DEF *+4 DEF UCODE Unlock, no wait, no abort URN ABS *-* DEF FLAG JMP U137 Abortion return point. * LDA FLAG Returned status must be 1, CPA D1 else unlock did not succeed. RSS JMP U137 * * Unlock succeeded. Clear the lock flag in the DBCB (high order byte * of the 13th word) and return successfully to the user. * LDB AIRUN ADB DBLFG LDA B,I AND LOBYT STA B,I * UNL1 CLA Set USTAT to zero for STA USTAT param check on next entry. JMP DBUNL,I * * Error return points. * U103 LDA D103 Data base not properly opened. RSS U115 LDA D115 Illega DBUNL mode. RSS U137 LDA D137 Illegal RN usage. STA USTAT,I Set status word and JMP UNL1 return to user. * * Constants and variables. * M7 DEC -7 D1 EQU ZERO+1 D3 EQU ZERO+3 D103 DEC 103 D115 DEC 115 D137 DEC 137 * LOBYT OCT 377 UCODE OCT 140004 * FLAG NOP END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������Ï­B������ÿÿ����� ���� ÿý�¹�É ���������ÿ��92069-18144 2026� S C0122 �&DBCLS &DBCLS � � � � � � � � � � � � � �H0101 ò×�����þúASMB,L,C,R HED DBCLS SUBROUTINE OF IMAGE/1000 NAM DBCLS,7 92069-16144 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18144 * RELOC: 92069-16144 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Data Base CLoSe is one of the ten user callable subroutines in the * IMAGE/1000 DML Library. It provides two services to the user. These * services correspond to the mode of close and are as follows: * mode service * ---- ------- * 1 Close data base - * terminates all access to the data base by the * user and deallocates any memory used solely * by the data base being closed. * 2 Close the specified data set. * * The calling sequence for DBCLS is: * * JSB DBCLS * DEF *+5 * DEF BASE data base parameter used in a successful * DBOPN call for the data base which is to * be closed or which contains the data set * to be closed. * DEF SET the name or number of the data set to be * closed if a mode 2 close. * DEF MODE DBCLS mode, legal values are as described * above. * DEF STAT a ten word array in which status information * is re•·������þúturned to the user. This subroutine * uses only the first word of this array in * which is stores an error code, zero if * successful. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 CoŒú������þúntrol Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * ‡K������þú * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n õ������þúRDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBCLS EXT .ENTR,.MVW,AIRUN,DBDCB,DBDCP,DBDCT,DBDEX … ������þú EXT DBDMX,DBFDS,DBIDS,DBRBL,DBRBP,DBRTM,DBRTP EXT EXEC,PNAME,RBCLS,RETBF,RMPAR,RNRQ,ECLOS * BASE NOP SET NOP MODE NOP STAT NOP * * Get true parameter and return point addresses. * DBCLS NOP JSB .ENTR DEF BASE * * Make sure all the parameters are there. * LDA STAT SZA,RSS JMP CLST Missing parameter. * * Ask DBIDS to check the data base specified in BASE to see if it is on * a remote machine, and to set up its Run Table as the current Run Table. * CCA A = -1 signifies not DBOPN calling. JSB DBIDS DEF *+2 DEF BASE,I * JMP E103 Error return - illegal BASE param. JMP LOCAL Local data base return. * JSB RBCLS Remote data base return. DEF *+5 Ask RBCLS to handle DEF BASE,I this request. DEF SET,I DEF MODE,I DEF STAT,I JMP CLST Return to caller. * * CASE on the DBCLS mode * LOCAL LDA MODE,I CPA D1 MODE = 1? JMP CLSM1 Yes CPA D2 No - MODE = 2? JMP CLSM2 Yes JMP E115 No - illegal mode. * * DBCLS mode = 1. * User wants us to terminate access to this data base. In order for us * to do this, the data base must not be locked. If it is, we will try * to unlock it for the user. If we do not succeed we cannot close. * The data base is locked if the lock flag (high order byte of 14th word * of the DBCB) is negative. * CLSM1 LDB AIRUN ADB DBLFG LDA B,I SSA,RSS JMP CLS12 Data base not locked. * * The data base is locked to the user. To unlock it we need to get the * RN from the 7th word of the DBCB and call RNRQ to release the RN. If * RNRQ succeeds, we clear the lock flag in the DBCB and continue with * the close. If not, we return a data base locked error to the user. * LDB AIRUN Put the address of the ADB DBRS,������þúN RN in the unlock call. STB RN * JSB RNRQ DEF *+4 DEF RNCOD Unlock, no wait, no abort. RN ABS *-* DEF STAT,I JMP E135 Abortion return point. * LDA STAT,I Did unlock succeed? CMA,INA (i.e. is status = 1?) INA,SZA JMP E135 No - data base locked error. * LDB AIRUN Yes - clear lock flag. ADB DBLFG LDA B,I AND LOBYT STA B,I * * Data base may be closed. First we must close all data sets in the data * base that are open. To do this, we will loop on each set asking DBCDS * to close the data set for us. So, set up the loop. * CLS12 ADB M4 Use negative of data set count LDA B,I (10th word of DBCB) CMA,INA as the loop counter. STA CNTR * CLA,INA Start with data set # 1. STA STNUM * * BEGIN LOOP * M11 JSB DBCDS DBCDS parameters are global. * ISZ STNUM Continue for all sets. ISZ CNTR JMP M11 * * END LOOP * * Second, we close the root file itself. So, set up for the FMP ECLOS * call. * LDA AIRUN Move 16 FMP words from ADA DCBWS DBCB (18th thru 33rd words) LDB DBDCB into data base DCB. JSB .MVW DEF D16 DEC 0 * * Ask FMP to close data base root file. * JSB ECLOS DEF *+2 DEF DBDCB,I * SSA If any error - JMP ERREX pass code to user. * * Ask DBDEX to release any record buffer or DCB memory used solely by * this data base. * JSB DBDEX DEF *+1 JMP E160 ERROR RETURN, MEMORY CORRUPT. * * Release the data base Run Table memory space. * CCA ADA BASE,I Get primary pointer to Run ADA DBRTP Table by adding data base # STA PTRAD to address of pointer table - 1. * JSB RETBF DEF *+2 DEF PTRAD,I * ~£������þú SSA Did RETBF succeed? JMP E160 No - someone's walked on our memory. * * Schedule DBCOP to remove us from the data base user co-ordinating * table. (Must move the data base name, CRN, and this program's name into * the EXEC call first.) AIRUN still points to the Run Table, first three * words of which contain the data base name. * LDA AIRUN STA NAME INA STA NAME+1 INA STA NAME+2 ADA D2 STA CRN * JSB PNAME DEF *+2 DEF PROGN * JSB EXEC DEF *+10 DEF NA23 DEF DBCOP DEF B1400 First byte = 3 (DBCOP close code). NAME ABS *-* ABS *-* ABS *-* CRN ABS *-* DEF PROGN DEF D3 JMP E140 Abortion return point. * * Get error code returned by DBCOP. If zero, a successful close. * JSB RMPAR DEF *+2 DEF ERROR * LDA ERROR SZA JMP ERREX Not successful. * * A successful close, replace first word of BASE parameter with its old * value (stored in 6th word of DBCB to which AIRUN still points) then * return successful to user. * LDB AIRUN ADB DBDSN LDA B,I STA BASE,I * JMP CLSE SKP * * DBCLS mode = 2. * Close the data set specified in SET. * * Ask DBFDS to confirm the set reference for us and give us the set's * number. * CLSM2 JSB DBFDS DEF *+5 DEF SET,I DBFDS needs: data set reference DEF STNUM returns: data set number DEF FLAG accessibility flag DEF STADR entry address * LDA STNUM If set # came back SZA,RSS as zero JMP E100 * LDA FLAG or set is inaccessible CMA,INA (FLAG > 0) SSA JMP E100 user gave us a bad set reference. * * Set reference okay. Ask DBCDS to perform the close. If it returÂ������þúns * to us, just return successful to user. * JSB DBCDS * CLSE CLA CLSX STA STAT,I CLST CLA Set STAT to zero for STA STAT param check on next entry. JMP DBCLS,I * * Error return points. * ERREX SSA Error code in A reg. CMA,INA make sure its positive. JMP CLSX E100 LDA D100 Bad set reference JMP CLSX E103 LDA D103 Improperly opened data base. JMP CLSX E115 LDA D115 Illegal DBCLS mode. JMP CLSX E135 LDA D135 Data base locked. JMP CLSX E140 LDA D140 Unable to schedule DBCOP. JMP CLSX E160 LDA D160 Corrupt Run Table or JMP CLSX SKP * * Close Data Set is a utility subroutine for DBCLS. Its function is to * search through the DCB pointer table for a DCB opened to the file spe- * cified by the base/set number pair found in BASE,I and STNUM, and if it * finds one, to call ECLOS to close the file and sets the DCB to unused. * No error occurs if the file is not open. * * Each entry in the DCB pointer table looks like: * word * ---- +---------------------------------------------+ * 1 | data base # | data set # |-> -1 if * ----------------------------------------------- DCB empty * 2 | DCB address | 0 if entry * +---------------------------------------------+ empty * 15 8 7 0 bit * * All parameters used by DBCDS are global to DBCLS. * * Set up for the loop. * DBCDS NOP LDA BASE,I Get base/set combination. ALF,ALF IOR STNUM STA NUMBR * LDA DBDMX Use negative of # of entries CMA,INA in pointer table as STA CNTR2 the loop counter. * LDA DBDCP STA PTRAD * * BEGIN LOOP * For each entry in pointer table: * * 1) If 1st wà5���<��:6ord of entry = NUMBR, get DCB address from 2nd word and * close file. * CDS1 LDA PTRAD,I CPA NUMBR RSS JMP CDS3 * ISZ PTRAD LDA PTRAD,I STA CDS10 JSB ECLOS DEF *+2 CDS10 NOP * SSA If ECLOS returns an error JMP ERREX pass it to user. * CCA Else, set 1st word of pointer CCB table entry to -1 to ADB PTRAD signify DCB is unused. STA B,I * CDS2 JMP DBCDS,I Then, return to the user. * CDS3 ISZ PTRAD If not the entry we want ISZ PTRAD try next one, ISZ CNTR2 if there is one. JMP CDS1 JMP CDS2 * * END LOOP * SKP * * Constants and variables. * M4 DEC -4 D1 EQU ZERO+1 D2 EQU ZERO+2 D3 EQU ZERO+3 D16 EQU ZERO+16 D100 DEC 100 D103 DEC 103 D115 DEC 115 D135 DEC 135 D140 DEC 140 D160 DEC 160 B1400 OCT 1400 * NA23 OCT 100027 LOBYT OCT 377 RNCOD OCT 140004 DBCOP ASC 3,DBCOP * STNUM NOP PTRAD NOP NUMBR NOP ERROR NOP } NOTE: Do not change the FLAG NOP } order of these variables STADR NOP } used in RMPAR call for CNTR2 NOP } return from DBCOP. CNTR NOP } PROGN EQU ERROR Program name buffer for PNAME call. END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������§Û<������ÿÿ����� ���� ÿý�º�É ���������ÿ��92069-18145 1912� S C0122 �&DBPAR �DBPAR SOURCE � � � � � � � � � � � � �H0101 ~]�����þúASMB,L,C,R HED DBPAR UTILITY SUBROUTINE FOR IMAGE/1000 NAM DBPAR,7 92069-16145 REV.1912 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18145 * RELOC: 92069-16145 * * PRGMR: CEJ * * ******************************************************************* * * * * DBPAR is a utility subroutine for DBOPN which parses the data base * parameter (BASE) into its namr components. DBPAR puts the name of the * root file into the first three words of the NAME array, the negative * of the cesurity code into the 5th word of NAME, and, if present, the * cartridge number into the 6th word. * * DBPAR performs the parse by searching through the data base parameter * for the first blank or semi-colon counting the number of bytes in the * namr string. It then calls NAMR with the byte count and the string * allowing it to do the parse. DBPAR then picks up the security code * and negates it and returns to the caller (DBOPN). * * The calling sequence for DBPAR is: * * JSB DBPAR * DEF *+3 return point * DEF NAME ten word return value array * DEF BASE data base parameter from call * <error return point> * A EQU 0 B EQU 1 * ENT DBPAR EXT .ENTR,NAMR * NAME NOP BASE NOP * * Get true parameter and return point addresses. * DBPAR NOP JSB .ENTR DEF NAME * * There should be no more than 20 characters in the string, but we will * set a loop counter to avoid an infinite loop if user forgot trailing * blank or semi-colon. * LDA M20 STA CNTR˜��� ��  * LDB BASE Get namr string address by INB skipping over 1st word of param. STB TEMP * CLA A zero to byte count. STA BYTCT * CCA Set processing 1st byte flag. STA FIRST * PAR1 LDA B,I Get 1st byte. ALF,ALF PAR2 AND LOBYT * CPA ABLNK Is it a blank? JMP PAR4 Yes - we are done. CPA SEMI No - is it a semi-colon? JMP PAR4 Yes - we are done. * ISZ CNTR No - are we still within legal RSS string bounds? JMP EREXT No - illegal BASE parameter. * ISZ BYTCT Yes - up the byte count. ISZ FIRST 1st byte processing? JMP PAR3 LDA B,I Yes - get 2nd byte JMP PAR2 and process it. * PAR3 INB No - get next word of namr CCA and process first byte. STA FIRST JMP PAR1 * * We come here when end of string found, call NAMR. * PAR4 CLA,INA Set starting character to 1. STA STCAR * JSB NAMR DEF *+5 DEF NAME,I DEF TEMP,I DEF BYTCT DEF STCAR * LDA NAME Negate security code ADA D4 LDB A,I CMB,INB STB A,I * ISZ DBPAR EREXT JMP DBPAR,I and return to DBOPN. * * Constants and variables. * M20 DEC -20 D4 DEC 4 ABLNK OCT 040 SEMI OCT 073 LOBYT OCT 377 * CNTR NOP TEMP NOP BYTCT NOP FIRST NOP STCAR NOP END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������õ$ ������ÿÿ����� ���� ÿý�»� ���������ÿ��92069-18146 1912� S C0122 �&DBDEX �DBDEX SOURCE � � � � � � � � � � � � �H0101 }[�����þúASMB,L,C,R HED DBDEX UTILITY SUBROUTINE FOR IMAGE/1000 NAM DBDEX,7 92069-16146 REV.1912 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18146 * RELOC: 92069-16146 * * PRGMR: CEJ * * ******************************************************************* * * * * Deallocate EXtras is a utility subroutine for DBCLS. Its function is * to trim off any extra words in the record buffer and dealocate any * DCBs needed solely by the data base being closed. We will deallocate * only DCBs that are not currently in use even if the DCBs are extra to * other data bases. * * All parameters used by DBDEX are global. * * The calling sequence for DBDEX is: * * JSB DBDEX * DEF *+1 return point * <error return point> * <normal return point> * ENT DBDEX EXT .ENTR,AIRUN,DBDCP,DBDCT,DBDMX,DBRBL,DBRBP,DBRTM EXT DBRTP,RETBF,TRIM * A EQU 0 B EQU 1 * * First we want to determine the maximum record buffer size and number * of DCBs needed by any other data base open to the program. We do this * by looping through all the entries in the Run Table pointer table and * for each entry which contains a Run Table pointer (entry NE 0) which * is not the same as the pointer to the current Run Table, we compare * the optimal number of DCBs (16th word of DBCB) and maximum entry length * (17th word of DBCB) to those which we have already saved. If greater * than the saved, we replace that saved with this Run Table's value. * DBDEX NOP JSB .ENTR DEF DBDEX * ·K������þú * Set up for loop. * LDA DBRTP Get address of R.T. STA PTRAD pointer table. * LDA DBRTM Use negative of number of CMA,INA entries in table as STA CNTR the loop counter. * CLA A zero to both STA MXLEN saved length STA #DCBS and number of DCBs * * BEGIN LOOP * DEX1 LDA PTRAD,I SZA,RSS JMP DEX3 * CPA AIRUN JMP DEX3 * ADA DBOPT First compare # of DCBs. LDB A,I CMB,INB ADB #DCBS SSB,RSS JMP DEX2 * LDB A,I STB #DCBS * DEX2 INA Then, the entry length. LDB A,I CMB,INB ADB MXLEN SSB,RSS JMP DEX3 * LDB A,I STB MXLEN * DEX3 ISZ PTRAD Continue for all Run ISZ CNTR Table pointer table entries. JMP DEX1 * * END LOOP * * Now determine the amount of the record buffer we want to keep and trim * off rest by : * EXTRA = MXLEN - length needed by data base being closed * IF (EXTRA.GE.0) THEN skip trim * ELSE Call TRIM with amount to keep = MXLEN. * LDA AIRUN ADA DBMAX LDB A,I CMB,INB ADB MXLEN SSB,RSS JMP DEX4 * JSB TRIM DEF *+3 DEF DBRBP DEF MXLEN * SSA If TRIM gave us an error JMP DEXER memory has been destroyed. * LDA MXLEN Else, set record buffer length STA DBRBL to new length. * * Finally, determine the number of DCBs we want to deallocate and for * each DCB to deallocate find an unused DCB and call RETBF, then signi- * fy in the DCB pointer table that the entry is empty by: * EXTRA = #DCBS - DCB allocated count * IF (EXTRA.GE.0) THEN Return to caller * ELSE FOR i = 1 to -(EXTRA) * WHILE an entry remains in DCB pointer table DO * IF (entry in pointer table shows an unused DCÀ·������þúB i.e. if first * word of entry .EQ. zero) * THEN Deallocate DCB pointed to by entry * END WHILE * END FOR * * Each entry in the DCB pointer table looks like: * word +---------------------------------+ * 1 | data base # | data set # |-> -1 if DCB unused * ----------------------------------- 0 if entry empty * 2 | DCB address | * +---------------------------------+ * 15 8 7 0 bit * DEX4 LDB DBDCT CMB,INB ADB #DCBS B = EXTRA SSB,RSS JMP DEXE * * Set up loop * STB CNTR Major loop counter = -(EXTRA) * LDB DBDMX Minor loop counter= CMB,INB negative of # of entries STB CNTR2 in DCB pointer table. * LDB DBDCP Get address of DCB STB PTRAD pointer table. * * BEGIN MAJOR LOOP * * BEGIN MINOR LOOP * DEX5 LDA PTRAD,I Does this entry contain ISZ PTRAD an unused DCB? SSA JMP DEX7 * DEX6 ISZ PTRAD No - get next entry address ISZ CNTR2 if there is another JMP DEX5 and try it. * * END OF MINOR LOOP * JMP DEXE * DEX7 JSB RETBF Yes - deallocate its DCB. DEF *+2 DEF PTRAD,I * SSA If any error, JMP DEXER memory is bad. * CCA Set first word of ADA PTRAD pointer table entry CLB to zero (unused entry). STB A,I * CCA ADA DBDCT Decrement the DCB count. STA DBDCT * ISZ CNTR If more to deallocate JMP DEX6 go try. * * END OF MAJOR LOOP * * * Return to caller (DBCLS). * DEXE ISZ DBDEX DEXER JMP DBDEX,I * * Constants and variables. * DBOPT DEC 15 DBMAX DEC 16 * #DCBS NOP MXLEN NOP CNTR NOP CNTR2 NOP #Ô�����PTRAD NOP END END$ ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������€ô������ÿÿ����� ���� ÿý�¼�Å ���������ÿ��92069-18147 1912� S C0122 �&DBIDL �DBIDL SOURCE � � � � � � � � � � � � �H0101 vS�����þúASMB,L,C,R HED DBIDS UTILITY SUBROUTINE FOR IMAGE/1000 NAM DBIDS,7 92069-16147 REV.1912 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18147 * RELOC: 92069-16147 * * PRGMR: CEJ * * ******************************************************************* * * * * If DS is a subroutine used by the DBMS subroutine which accepts the * BASE parameter from the DBMS call and determines if the data base is * on a remote machine. This version of DBIDS is used by the local only * subroutines. Its function is to check the BASE parameter for validity. * This includes: For DBOPN - checking the first word of the BASE param- * eter for two blanks. * For all other DBMS subroutines - making sure the Run * Table for the data base specified in BASE exists and setting it up * as the current Run Table. * * The calling sequence for DBIDS is: * * CLA (for DBOPN meaning data base is not already open) * or * CCA (for all other subs., data base is already open) * JSB DBIDS * DEF *+2 return point * DEF BASE base parameter from call * <error return point> * <local data base return point> * <remote data base return point> * A EQU 0 B EQU 1 * ENT DBIDS EXT .ENTP,DBFRT * * Get true parameter and return point addresses. * BASE NOP * DBIDS NOP STA SAVE Save A reg. for later. NOP Note: this NOP is needed for .ENTP JSB .ENTP DEF BASE * * If DBOPN calling us, check the first word of the BASE pk��� �� arameter for * two blanks. * LDA SAVE SZA JMP NOPEN * LDB BLNKS CPB BASE,I JMP LOCAL Blanks there, parameter valid. JMP EXIT Blanks missing, invalid parameter. * * If not DBOPN, ask DBFRT to find and set up the Run Table for this data * base as the current Run Table. * NOPEN JSB DBFRT DEF *+2 DEF BASE,I * SSA,RSS Did DBFRT succeed? * LOCAL ISZ DBIDS Yes - bump return address. EXIT JMP DBIDS,I * * Constants and variables. * BLNKS ASC 1, SAVE NOP END END$ ������������������������������������������������������������������������������������������������������������������������������������������������������������������������» ������ÿÿ����� ���� ÿý�½�Ä ���������ÿ��92069-18148 2026� S C0122 �&DBSAM &DBSAM � � � � � � � � � � � � � �H0101 õÖ�����þúASMB,L,C,R HED DBBAM IMAGE/1000 UTILITY SUBROUTINE NAM DBBAM,7 92069-16148 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18148 * RELOC: 92069-16148 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Build Automatic Master is a utility subroutine for DBPUT. It pro- * vides the service of creating a new automatic master entry for a spe- * cified key value. The process for building an auto-master entry is * identical to that of building a manual master entry except for the * fact that the only item in the auto-master is the key item and its value * is passed to us by DBPUT rather than the user. It must be called * before any of the values passed back from DBHRD have been altered. * * DBBAM does alter the Free Record Table but does not post it after ad- * ding the new entry as DBPUT will if it successfully completes. * * The calling sequence for DBBAM is: * * JSB DBBAM * DEF *+6 return point * DEF BASE,I data base number from first word of * user supplied BASE parameter * DEF MNUM automatic master's data set number * DEF KVAL key item value * DEF READ READ flag from DBHRD * DEF RECRD doubleword record number from DBHRD * * Any error code encountered by DBBAM is returned in the A register. * SKP *********************************************************************** * A]������þú * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data IteL������þúm Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ISSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name{������þú - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * GÈ������þú * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * A EQU 0 B EQU 1 * ENT DBBAM EXT .DDS,.ENTR,.MVW,AIRUN,DBDME,DBFDS,DBMST,DBRBL EXT DBRBP,DBRED,DBWRT * BASE NOP MNUM NOP KVAL NOP READ NOP RECRD NOP * * Get true parameter and return point addresses. * DBBAM NOP JSB .ENTR DEF BASE * * First thing we need to do is determine if the data set has a free re- * cord in which to create the new entry. Ê(������þú If not, return error number * 106 to the caller. The free record count is the first doubleword of * the data set's FRT entry. FRT entry address = * (data set # - 1) * 4 + pointer to FRT from DBCB (12th word) + * address of Run Table. * CCA ADA MNUM,I ALS,ALS LDB AIRUN ADB DBFRP ADA B,I ADA AIRUN STA FRADR * DLD FRADR,I SZB,RSS SZA RSS JMP E106 * * We know (think) that a free record is there. Ask DBMST to get that * free record and build the new entry's blank (except entry type and * synonyn pointers) media record and zero out the data record. * JSB DBMST DEF *+5 DEF BASE,I DBMST needs everything DEF MNUM,I passed to us except DEF READ,I the key item value. DEF RECRD,I * SZA Did DBMST encounter an error? JMP BAM3 Yes - pass it to caller. * LDA RECRD,I No - did it get our new entry? SSA (i.e. is RECRD # >= 0?) JMP E160 No - but the R.T. says it's there! * * Now, get the DBCB for MNUM, then get its data record length (key item * length from the 6th word of the DSCB) and its media record length (from * the low order byte of the 5th word). * JSB DBFDS Ask DBFDS to get the DSCB for us. DEF *+5 DEF MNUM,I It needs: data set reference DEF TEMP1 returns: data set number DEF TEMP2 accessibility flag DEF MADR DSCB pointer * LDA TEMP1 Just a check for a SZA,RSS screwy Run Table. JMP E160 * LDB MADR Get DSCB true address. ADB AIRUN ADB DSDRL Bump to key item length. LDA B,I STA MVLEN * ADB M1 Back up to media record length LDA B,I AND LOBYT Get the length LDB A in B register. * * Determine the address of the daÔP������þúta record in the record buffer by: * Data record address = media record length + address of record * buffer. * Then move the key item value into the data record. * ADB DBRBP LDA KVAL JSB .MVW DEF MVLEN DEC 0 * * Write the new record to disc. If any error pass it to caller. Else * decrement the auto-master free record count. * JSB DBWRT DEF *+4 DEF BASE,I DBWRT needs: data base # DEF MNUM,I data set # DEF RECRD,I record number * SZA Any error? JMP BAM3 Yes! * JSB .DDS DEF FRADR,I NOP * * Now, if the new entry is a synonym chain foot (entry type is first word * of the media record < 0) we need to update the old end of synonym chain * foot to point forward to this record. The old synonym chain foot's * record is in the 2nd & 3rd words of the new entry's media record. * LDA DBRBP,I SSA,RSS If it's not a synonym, CLA,RSS return successful to caller. RSS JMP BAM3 * LDB DBRBP INB Save off the old synonym DLD B,I chain foot. DST SYNYM * JSB DBRED Read in old synonym DEF *+4 chain foot DEF BASE,I DEF MNUM,I DEF SYNYM * SZA Any error? JMP BAM2 Yes - delete new entry. * LDA DBRBP No - set its forward synonym ADA D3 STA TEMP1 pointer to new record's #. DLD RECRD,I DST TEMP1,I * JSB DBWRT Then write it out to disc. DEF *+4 DEF BASE,I DEF MNUM,I DEF SYNYM * SZA Any error? JMP BAM2 Yes - remove new entry. * * Synonym update successful. Get the new entry back into the record * buffer for DBPUT. * JSB DBRED DEF *+4 DEF BASE,I DEF MNUM,I DEF RECRD,I * ®���0��.* SZA,RSS JMP BAM3 * * On an error after the new record was written, this part deletes the * newly created auto-master entry by calling DBDME with the new record * number. We will ignore any more errors. * BAM2 STA TEMP1 Save error code. * CCA Let DBDME know it has to read entry. JSB DBDME DEF *+4 DEF BASE,I DEF MNUM,I DEF RECRD,I * LDA TEMP1 Return original error JMP BAM3 code to user. * * Other error returns. * E106 LDA D106 Master set full. RSS E160 LDA D160 Corrupt Run Table. * * Return to caller * BAM3 JMP DBBAM,I * * Constants and variables * M1 DEC -1 D3 EQU ZERO+3 D106 DEC 106 D160 DEC 160 LOBYT OCT 377 * FRADR NOP TEMP1 NOP TEMP2 NOP MADR NOP MVLEN NOP SYNYM BSS 2 END ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������b¹0������ÿÿ����� ���� ÿý�¾� Ë ���������ÿ��92069-18149 2026� S C0122 �&DBHRD &DBHRD � � � � � � � � � � � � � �H0101 óÓ�����þúASMB,L,C,R HED DBHRD IMAGE/1000 UTILITY SUBROUTINE NAM DBHRD,7 92069-16149 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18149 * RELOC: 92069-16149 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Hash ReaD entry is a subroutine which finds the record in a master * data set which contains a specified key value. * * DBHRD first hashes into the specified master data set then reads the * hashed record into the record buffer. If the hashed record is a pri- * mary and contains the specified kay value, DBHRD returns with the read * flag set to zero. If the hashed record is a sysnonym, DBHRD returns * with the read flag > 0. A synonym in the primary location for a key * can occur when a record containing the key value has not already been * entered. Since DBPUT call DBHRD to make sure a record containing a * certain key value does not already exist before putting a new master * record, this occurrance does not signify an error in DBHRD. However, * all other callers will treat this return (i.e. read flag > 0) as an * error. * * If the hashed record is a primary but does not contain the specified * key value, DBHRD chases down any synonyms to the primary, searching * for a record containing the specified key value. If a match is found, * DBHRD returns with the read flag set to zero and the matching record * in the record buffer. If no match, DBHRD returns with the read flag * < 0 and the sysnonym chain foot in the re7a������þúcord buffer. * * DBHRD also returns the number of synonyms on the chain in the A & B * registers. * * The calling sequence for DBHRD is: * * JSB DBHRD * DEF *+7 return point * DEF BASE data base # (1st word of ibase parameter) * DEF SET master data set's number * DEF KEY key item value * DEF READ returned read flag: * <0 if no matching record found * =0 if record found * >0 if synonym in primary location * DEF RECRD returned doubleword record number of record * in record buffer. * DEF ERROR returned FMP or IMAGE error code * zero if no error * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set Control Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of eac8ú������þúh * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBs DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length b³������þúITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZERO+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set ÿ������þú * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry per item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * §Œ������þú * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * EXT .CMW,.DDI,.DIS,.DMP,.DSBR,.ENTR EXT AIRUN,DBCIX,DBFDI,DBFDS EXT DBRBP,DBRED,HASH ENT DBHRD A EQU 0 B EQU 1 * BASE NOP SET NOP KEY NOP READ NOP RECRD NOP ERROR NOP * * Get true addresses of parameters and return point * DBHRD NOP JSB .ENTR DEF BASE * * Set synonym count to zero. * CLA STA SYCNT STA SYCNT+1 * * Set read flag to < 0. * CMA STA READ,I * * Get data set entry address in Run Table (this will be relative to the * start of the Run Table). * JSB DBFDS DEF *+5 DEF SET,I DEF SETNO DEF FLAG DEF DSADR * * If SETNO came back as zero, caller (i.e. other IMAGE subroutine) gave * us an errorneous data set number. * LDA SETNO SZA,RSS JMP E160 Error 160--Run Table corrupt * * Get master's media record length, capacity and key item number from * data set control block. * LDB DSADR Must add relative set entry address to ADB AIRUN beginning of Run Table to get true address. ADB DSMDL Increment to word containing media record LDA B,I length. AND LOBYT (In low order byte of this word.) STA DAINX Save it for computing key item's address. * ADB D4 Increment to capacity words. STB CAPAC Save address for later. * ADB D2 Increment to word containingf6������þú key item #. LDA B,I In high order byte of this word. ALF,ALF Make it an integer AND LOBYT (i.e. put it into low order byte). SZA,RSS If zero - currupt Run Table. JMP E160 STA ITEM * * Get the item's Item Table entry address. This will be relative to the * start of the Run Table. * JSB DBFDI DEF *+5 DEF ITEM DEF ITMNO DEF FLAG DEF ITADR * * If ITMNO came back as zero, Run Table is corrupt. * LDA ITMNO SZA,RSS JMP E160 * * Get item's length, and location in data record of master. * LDB ITADR Get true address of item table entry. ADB AIRUN * ADB ITLNG Increment to word containing item length. LDA B,I STA LENTH Save for HASH. * JSB DBCIX Call DBCIX to compute location DEF *+4 of key item in data record of DEF ITMNO master's data entry. DEF DSADR DEF INDEX * LDA INDEX If the item could not be found in SSA the data set's record definition JMP E160 table - corrupt Run Table. * * Determine the primary record number of the key item value in the master * data set. First, call the subroutine HASH to get a doubleword posi- * tive integer value (returned in the A & B registers) then take the * MOD of the returned value and the capacity of the data set and add 1. * JSB HASH DEF *+3 DEF LENTH DEF KEY,I DST SAVE Save returned value (dividend). * JSB .DDI Doubledivide returns quotient DEF CAPAC,I in A & B registers. * JSB .DMP Multiply the quotient by the divisor DEF CAPAC,I * JSB .DSBR and substract it from the dividend DEF SAVE to get the remainder (MOD). * INB,SZB,RSS Add one to the B reg., INA if carry add one to the A reg. * DST RE™ý������þúCRD,I This is the primary record #. CCA STA PRMRY Set reading primary flag. * * ENTER MAIN LOOP HERE * This section reads a record from the master, determines if it contains * the key item value sought. If so, returns successful to the caller. * If not, then if the record was to be the key's primary but is not a * primary (i.e. synonym flag set in entry) then retruns special case flag * to caller. Else, if key's primary empty, then returns unsuccessful to * caller. If key's primary a primary record (i.e. primary flag set in * entry) then traces through any synonyms to find a record containing * the key item value. If no synonyms or end or synonym chain is found * before a record containing the key item value is found, returns un- * successful to caller. If any of the synonyms turn up empty, the data * base is corrupt and an error is returned. (Afterall, we only read a * synonym if it is pointed to by the record we just read.) * HRD1 JSB DBRED Ask DBRED to get the record for us. DEF *+4 DEF BASE,I data base number DEF SET,I data set number DEF RECRD,I doubleword record number * SZA JMP HRD6 return unsuccessful to caller. * LDA DBRBP,I Get record flag type from record SZA in record buffer. If zero - JMP HRD2 record is empty. ISZ PRMRY Check read type: JMP E154 If a synonym read - data base corrupt! JMP HRD5 If a primary read - return unsuccessful. * HRD2 SSA,RSS If a synonym, JMP HRD3 ISZ PRMRY then if this was supposed to be the JMP HRD3 key's primary -- CLA,INA return special flag. STA READ,I (READ > 0 means synonym found JMP HRD5 in primary location.) * * Special cases taken care of, now increment synonym count and check * record for matching key item value. * HRD3 JSB .DIS DEF'���6��40 SYCNT NOP * LDA DBRBP Get address of data record part ADA DAINX of set's entry. ADA INDEX Add in the key item's index and we * are at the compare point in the entry. LDB KEY Get the address of the specified key value JSB .CMW and compare the two values. DEF LENTH DEC 0 JMP HRD4 A match!! * NOP } unequal, LDA D3 } get forward synonym pointer ADA DBRBP from entry. DLD A,I (in 2nd & 3rd words of record) SZB,RSS If forward synonym pointer = 0 SZA (i.e. A & B both zero) RSS JMP HRD5 return unsuccessful to caller. * DST RECRD,I Else, make this the next record to read CLA and jump up to beginning of loop. But first, STA PRMRY make sure primary flag is cleared. JMP HRD1 * * Exit routines for DBHRD * HRD4 CLA Record with key value found, STA READ,I read flag = 0. HRD5 CLA Whether found or not found, if no HRD6 STA ERROR,I error exit, set ERROR to zero. DLD SYCNT Get synonym count JMP DBHRD,I and return. * E154 LDA D154 Error exit - corrupt data base RSS E160 LDA D160 Error exit - corrupt Run Table JMP HRD6 * * Constants and variables * D2 EQU ZERO+2 D3 EQU ZERO+3 D4 EQU ZERO+4 D154 DEC 154 D160 DEC 160 LOBYT OCT 377 * SETNO NOP FLAG NOP DSADR NOP DAINX NOP CAPAC BSS 2 SAVE BSS 2 SYCNT BSS 2 ITEM NOP ITMNO NOP ITADR NOP LENTH NOP INDEX NOP PRMRY EQU FLAG END ��������������������������������������������������������������������������������������������Ò¸6������ÿÿ����� ���� ÿý�¿� Í ���������ÿ��92069-18150 2026� S C0122 �&DBWFR &DBWFR � � � � � � � � � � � � � �H0101 ûå�����þúASMB,L,C,R HED DBWFR IMAGE/1000 UTILITY SUBROUTINE NAM DBWFR,7 92069-16150 REV.2026 800122 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18150 * RELOC: 92069-16150 * * PRGMR: CEJ * ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ * * ******************************************************************* * * * * Write Free Record table is a subroutine which transfers the free re- * cord table information of the current Run Table in memory to its pro- * per record(s) in the root file of the data base. * * DBWFR first retrieves the length in words of the free record table * from the data base control block then transfers the 16 FMP words from * the conrtol block to the data base DCB in DBBUF. DBWFR then performs * a write of the free record table, starting in the second record of the * root file, and returns to the caller. * * DBFWR does not have any input parameters. It passes back an error * code, zero if successful, in the A register. * SKP *********************************************************************** * * * Run Table for IMAGE/1000 Local machine. * * * * The Run Table is comprised of the following sections: * * * * 1) Data Base Control Block * * 2) Item Table * * 3) Data Set e¬������þúControl Block Table * * 4) Data Set Info Table * * A) Record Definition Table * * B) Path Table * * 5) Sort Table * * 6) Free Record Table * * * * These sections appear in the order described. Details of each * * section follow. * * * *********************************************************************** *** *** * * * Data Base Control Block - one 59 word entry per data base * * * *** *** DBCBS DEC 59 Control Block Size DBNAM DEC 0 Data Base name - 3 words DEC 1 DEC 2 DBSCD DEC 3 Data Base Security Code (FMP) DBCRN DEC 4 Data Base Cartridge Number (FMP) DBDSN DEC 5 Data Base node number (DS/1000) DBRSN DEC 6 Data Base resource number DBICT DEC 7 Data Item Count DBITP DEC 8 Data item table pointer DBSCT DEC 9 Data set count DBSTP DEC 10 Data set control block table pointer DBSOP DEC 11 Sort table pointer DBFRP DEC 12 Free record table pointer DBLMD DEC 13 Data Base lock flag and open mode DBLFG EQU DBLMD 1st byte: lock flag DBMOD EQU DBLMD 2nd byte: open mode DBLVL DEC 14 Access level words - 3 words per level DBFRL EQU DBLVL Free record table length DBOPT DEC 15 Optimal number of DCBsJÑ������þú DBMAX DEC 16 Maximum size of a data entry DCBWS DEC 17 DCB storage area * ZERO EQU DBNAM base of zero for future equates *** *** * * * Data Item Table - one 7-word entry per item * * * *** *** ITELN EQU ZERO+7 item table entry length ITNME EQU ZERO item name - 3 words ITINF EQU ZERO+3 item write/read level and type ITRDL EQU ITINF 1st nibble: item read level ITWRL EQU ITINF 2nd nibble: item write level ITTYP EQU ITINF 2nd byte: item type ITSET EQU ZERO+4 set count and 1st set number ITSCT EQU ITSET 1st byte: set count ITSNO EQU ITSET 2nd byte: set number ITWRC EQU ZERO+5 write/read bits and element count ITECT EQU ITWRC 2nd byte: element count ITLNG EQU ZERO+6 item length in words *** *** * * * Data Set Control Block Table - one 17 word entry per set * * * *** *** DSLNG EQU ZERO+17 table entry length DSNME EQU ZERO set name - 3 words DSCRN EQU ZERO+3 cartridge reference number DSINF EQU ZERO+4 W/R bits, set type and media length DSTYP EQU DSINF 1st byte, 2nd nibble: set type DSMDL EQU DSINF 2nd byte: media record length DSDRL EQU ZERO+5 data record length DSFPC EQU ZERO+6 field and path counts DSFCT EQU DSFPC 1st byte: # fields per entry DSPCT EQU DSFPC 2nd byte: # paths per entry DSITP EQU ZERO+7 data set info table entry pointer DSCAP EQU ZERO+8 doubleword data set capacity DSCPN EQU ZEROç������þú+10 current path info DSCCT EQU DSCPN 1st byte: search item number DSPAN EQU DSCPN 2nd byte: path # of search item DSRCN EQU ZERO+11 doubleword current record number DSBWN EQU ZERO+13 doubleword previous record number DSFWN EQU ZERO+15 doubleword next record number *** *** * * * Data Set Info Table - one Record Definition Table and one Path * * Table per data set * * * *** *** * * * Record Definition Table - one 1-byte entry per field * * * *** *** RDLNG EQU ZERO+1 entry length (number of words) RDINF EQU ZERO field info (two fields per word) RDIT1 EQU RDINF 1st byte: item # for field n RDIT2 EQU RDINF 2nd byte: item # for field n+1 *** *** * * * Path Table - one 2-word entry per path * * * *** *** PTLNG EQU ZERO+2 entry length PTINF EQU ZERO path information - item & set numbers PTSIN EQU PTINF 1st byte: detail's search item # for path PTDSN EQU PTINF 2nd byte: related set's number PTSRT EQU ZERO+1 sort item for path *** *** * * * Sort Table - one 1-word entry p© ������þúer item and set * * * *** *** STITS EQU ZERO beginning of item entries STSTS NOP beginning of set entries *** *** * * * Free Record Table - one 4-word entry per set * * * *** *** FRLNG EQU ZERO+4 length of entry FRRCT EQU ZERO doubleword free record count FRPTR EQU ZERO+2 doubleword first free record * * *********************************************************************** *** *** * * EXT .MVW,AIRUN,DBDCB,EWRIT ENT DBWFR A EQU 0 B EQU 1 * DBWFR NOP * * Get free record table address length of free record table and move * the 16 FMP words into the root file DCB. * LDA AIRUN Get free record table pointer from ADA DBFRP data base control block. LDB A,I ADB AIRUN STB BUFFR Put into EWRIT call. * ADA D2 Bump to word with length of free record STA LENTH table and put it into EWRIT call. * ADA D3 Get address of stored DCB words LDB DBDCB and address of data base DCB. JSB .MVW Move the 16 words into DEF D16 the DCB. DEC 0 * * Perform the FMP EWRIT on the root file, and return to the caller. * JSB EWRIT DEF *+6 DEF DBDCB,I root file DCB DEF ERROR error parameter BUFFR ABS *-* free record table addrõê���$��"ess LENTH ABS *-* length of free record table DEF FRRCD doubleword record # of first * record containing free record table * SSA,RSS If an error - code already in A CLA else clear it. JMP DBWFR,I * * Constants and variables * D2 EQU ZERO+2 D3 EQU ZERO+3 D16 EQU ZERO+16 FRRCD DEC 0,2 * ERROR NOP END ��������������������������������������������������������������������������������������������������������������i‚$������ÿÿ����� ���� ÿý�À� Ë ���������ÿ��92069-18151 1912� S C0122 �&DBDCB �DBDCB SOURCE � � � � � � � � � � � � �H0101 `D�����ASMB,L,C HED DBDCB ROOT FILE DCB STORAGE AREA FOR IMAGE/1000 NAM DBDCB,7 92069-16151 REV.1912 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18151 * RELOC: 92069-16151 * * PRGMR: CEJ * * ******************************************************************* * * * * Root file DCB * ENT DBDCB * DBDCB DEF *+1 BSS 144 END END$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ŠÖ������ÿÿ����� ���� ÿý�Á�Ç ���������ÿ��92069-18152 1912� S C0122 �&DBCBI �DBCBI SOURCE � � � � � � � � � � � � �H0101 fI�����þúASMB,L,C,R HED DBCBI IMAGE/1000 UTILITY SUBROUTINE NAM DBCBI,7 92069-16152 REV.1912 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 92069-18152 * RELOC: 92069-16152 * * PRGMR: CEJ * * ******************************************************************* * * * * Compute Buffer Index determines the index of the specified item into * the buffer parameter (ibuf) passed by the user to an IMAGE subroutine. * * DBCBI searches through the information table (TEMPX) set up by DBPIL * calculating the index as follows: * * Index = 0 + word length of all items preceding the specified item in * the information table. * * The calling sequence for DBCBI is: * * JSB DBCBI * DEF *+3 return point * DEF ITEM data item number * DEF INDEX returned index into ibuf parameter, * -1 if item not in information table * EXT .ENTR,TEMPX ENT DBCBI A EQU 0 B EQU 1 * ITEM NOP INDEX NOP * * Get true addresses of parameters and return point. * DBCBI NOP JSB .ENTR DEF ITEM * * Initialize search parameters. * CLA STA TOTAL Zero to running length. CMA STA INDEX,I -1 to INDEX * LDA TEMPX Set up information table address STA NEXT for loop. * * Loop on each entry in information table until a zero item number is * found or the specified item is found, adding each item's length to * the running length. * CBI1 LDA NEXT,I Get next item number. 9§��� ��  SZA,RSS If zero - return unsuccessful to caller. JMP CBI3 * AND LOBYT CPA ITEM,I If same as specified item - JMP CBI2 return successful to user. * ISZ NEXT Else get address of length of item LDA NEXT,I then get length and add to ADA TOTAL running length. STA TOTAL * ISZ NEXT Get next entry ISZ NEXT JMP CBI1 and check it. * * When (if) item found, put running length in INDEX. * CBI2 LDA TOTAL STA INDEX,I CBI3 JMP DBCBI,I and return. * * Constants and variables * LOBYT OCT 377 TOTAL NOP NEXT NOP END ������������������������������������������������������������������������������������›u ������ÿÿ����� ���� ÿý�Â�É �����������